+TITLE. MAGBOLTZ 7.07 /00 040408 00.00 C PROGRAM MAGBOLTZ 2 VERSION 7.1 JUNE 2004 C Last updated on 4 Apr 2008 C -------------------------------------------------------------------- C COPYRIGHT 2004 STEPHEN FRANCIS BIAGI C -------------------------------------------------------------------- C VERSION 7.1 INCREASED SOME ARRAY SIZES AND REDUCED DIFFUSION ARRAY C WITH SHORTER CORRELATIONS (BACK TO VERSION 6.1) THE LONGER C CORRELATION INTRODUCED PROBLELMS WITH ROUNDING ERRORS ON C DIFFUSION CALCULATIONS ON 32 BIT PCS. C INTRODUCED SAMPLING OF MOST SIGNIFICANT BITS IN COLLISION C ARRAY IN ORDER TO REDUCE COMPUTATION TIME FOR COMPLEX C MIXTURES WITH MANY LEVELS. C -------------------------------------------------------------------- C VERSION 6.1 NEW CO2 X-SECTION SET INCLUDED C VESRION 6.2 UPDATES OF N2O AND CD4 X-SECTIONS C VERSION 6.3 UPDATES CH4 X-SECTIONS (ONLY CHANGES FANO FACTORS AND HAS C NO EFFECT ON DRIFT DIFFUSION COMPARED TO 2002 DATA SET) C VERSION 6.4 INCREASED DIFFUSION ARRAY TO ALLOW LONGER DECORRELATION C--------------------------------------------------------------------- C VERSION 6: REMOVED ALL RESTRICTIONS ON ANGULAR SCATTERING , ALL C ELASTIC AND INELASTIC SCATTERING PROCESSES CAN NOW HAVE ANGULAR C DISTRIBUTIONS ( IF INCLUDED IN DATA BASE) C IF THE ELASTIC ANGULAR DISTRIBUTION EXISTS THEN PROGRAM USES THIS AS C AN APPROXIMATION TO THE ANGULAR DISTRIBUTION OF THE PRIMARY C IONISATION ELECTRON ( SECONDARIES ALWAYS HAVE ISOTROPIC SCATTERING). C THE ANGULAR DISTRIBUTION OF THE PRIMARY IS TAKEN TO BE THE SAME AS C THE ANGULAR DISTRIBUTION OF AN ELASTIC SCATTERED ELECTRON WITH THE C SAME FINAL ENERGY. C THIS ALGORITHM FOR THE ANGULAR DISTRIBUTION OF THE PRIMARY IONISATION C ELECTRON REPRODUCES EXPERIMENTAL IONISATION ANGULAR DISTRIBUTIONS C AND ALSO GIVES THE CORRECT RANGES FOR HIGH ENERGY ELECTRONS C IN GASES . RANGES ARE ACCURATE UP TO 100KEV. C N.B IF USING WATER MIXTURES YOU WILL SEE AN INCREASE IN COMPUTING C TIME COMPARED TO PREVIOUS VERSIONS SINCE NOW 210 ROTATIONAL C TRANSITIONS ARE INCLUDED IN THE DATA BASE. C--------------------------------------------------------------------- C CALCULATES DRIFT,DIFFUSION,GAIN AND ATTACHMENT OF ELECTRONS IN C GASES WITH APPLIED ELECTRIC AND MAGNETIC FIELDS AT ARBITRARY ANGLES. C THE COMMON BLOCK STRUCTURE OF THE RESULTS IS OUTLINED BELOW. C PLEASE QUOTE THE DATA BASE REVISION YEAR FOR THE GAS USED IN THE DATA C BASE, ( E.G. KRYPTON (2002) ) , IN ANY PUBLICATIONS. C --------------------------------------------------------------------- C LINUX PC VERSION USES DRAND48 DOUBLE PRECISION RANDOM NO GENERATOR C (CAN ALSO USE RNDM2 FROM CERNLIB WITH THE SAME PRECISION ). C -------------------------------------------------------------------- C THE PROGRAM ALLOWS ANISOTROPIC ELASTIC AND INELASTIC SCATTERING : C REF : NIM A 421 (1999) 234-240 C THE GAS DATA BASE LIST BELOW SHOWS THOSE X-SECTIONS WHICH CONTAIN C ANISOTROPIC SCATTERING DATA. C NB ANISOTROPIC VERSIONS OF HELIUM,NEON AND ARGON ARE AS ACCURATE AS C THE ISOTROPIC VERSIONS . BUT ANISOTROPIC KRYPTON AND XENON NOT YET C AS GOOD AS ISOTROPIC VERSIONS. C POSTSCRIPT PLOTS OF THE DATABASE X-SECTIONS CAN BE OBTAINED ON:- C HTTP://CONSULT.CERN.CH/WRITEUPS/MAGBOLTZ/CROSS/ C---------------------------------------------------------------------- C THIS VERSION ALLOWS SPATIAL GRADIENTS TO BE INCLUDED IN THE SOLUTION C FOR THE TOWNSEND GAIN AND ATTACHMENT COEFICIENTS. C THE PROGRAM AUTOMATICALLY GIVES A SOLUTION WITH SPATIAL GRADIENTS C FOR BOTH TIME OF FLIGHT (TOF), PULSED TOWNSEND (PT) AND STEADY STATE C TOWNSEND (SST) PARAMETERS. C THE NOMENCLATURE IS SIMILAR TO SAKAI ET AL. J.PHYS.D10 (1977) 1035. C THE SIMULATION OF AVALANCHE GAIN DETECTORS AT HIGH FIELD REQUIRES THE C USE OF SST TOWNSEND PARAMETERS. C THE PROGRAM AUTOMATICALLY UPDATES THE COMMON BLOCKS /CTOWNS/ AND C /CTWNER/ WITH THE SST PARAMETERS IF THE SPATIAL GRADIENTS ARE C GREATER THAN : ABS (ALPHA-ATT) = 60/CM AT NTP. C WHERE ABS= MAGNITUDE , ALPHA=GAIN COEFICIENT AND ATT=ATTACHMENT. C ( FOR SMALLER VALUES OF ABS(ALPHA-ATT) < 60/CM , THE CHANGE OF THE C GAIN OR ATTACHMENT IS TYPICALLY LESS THAN 3% FOR THE SOLUTION WITHOUT C SPATIAL GRADIENTS ). C----------------------------------------------------------------------- C ESTIMATES OF THE PENNING EFFECT AT HIGH FIELD CAN BE OBTAINED BY C INSPECTION OF THE DETAILED COLLISION FREQUENCIES FOR EXCITED STATES C IN THE GAS MIXTURES. PENNING EFFECTS CAN OCCUR BETWEEN EXCITED STATES C IN THE GAS MIXTURE WHICH ARE HIGHER IN ENERGY THAN THE LOWEST C IONISATION POTENTIAL IN THE MIXTURE. C PREVIOUS RESULTS IN ARGON HYDROCARBON MIXTURES SHOW A TRANSFER C EFFICIENCY OF ABOUT 25% FROM EXCITED STATES IN ARGON TO IONISATION OF C HYDROCARBONS.. C ********************************************************************* C THE PROGRAM SHOULD ALWAYS CONVERGE TO A SOLUTION. THE ERROR ON THE C INTEGRATION SHOULD SCALE WITH THE SQUARE ROOT OF THE NUMBER OF C COLLISIONS (PARAMETER NMAX) . THE OUTPUT SHOULD ALWAYS BE CHECKED TO C ENSURE THAT THE NUMBER OF COLLISIONS IN THE LAST ENERGY BIN IS SMALL, C ANY VALUE LESS THAN 500 SHOULD GIVE REASONABLE SYSTEMATIC ERRORS C IF THE NUMBER OF COLLISIONS IS GREATER THAN 500 THEN THE INTEGRATION C ENERGY RANGE SHOULD BE INCREASED. C*********************************************************************** C THE PROGRAM IS LIMITED IN PRECISION BY THE STATISTICAL ACCURACY C OF THE RESULTS. IT IS POSSIBLE TO OBTAIN A STATISTICAL ACCURACY C OF BETTER THAN 0.1% ON THE DRIFT VELOCITY AND 1% ON THE C DIFFUSION COEFICIENTS IN MOST COUNTING GAS MIXTURES IN ABOUT C 1 MINUTE OF COMPUTING TIME ON A PC , ALPHA OR WORKSTATION. C AT HIGH FIELD WHEN THE TOWNSEND COEFICIENT IS INCLUDED IN THE SPATIAL C GRADIENT THE COMPUTATION TIME MAY BE REQUIRED TO INCREASE TO A FEW C MINUTES. C WHEN VELOCITY VECTORS ARE SMALL SUCH AS THE CASE WITH SMALL LORENTZ C ANGLES THE PARAMETER NMAX WILL NEED TO BE INCREASED TO 20 OR MORE. C C-------------------------------------------------------------------- C GEOMETRY: C-------------- C THE ELECTRIC FIELD IS TAKEN ALONG THE Z-AXIS AND THE C MAGNETIC FIELD IS TAKEN IN THE Z-X PLANE AT AN ANGLE, BTHETA , C TO THE ELECTRIC FIELD. C C THE RESULTS OF THE CALCULATION ARE LOADED INTO COMMON BLOCKS: C COMMON/VEL/WX,WY,WZ C COMMON/VELERR/DWX,DWY,DWZ C COMMON/DIFLAB/DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ C COMMON/DIFERB/DXXER,DYYER,DZZER,DYZER,DXYER,DXZER C COMMON/DIFVEL/DIFLN,DIFTR C COMMON/DIFERL/DFLER,DFTER C COMMON/CTOWNS/ALPHA,ATT C COMMON/CTWNER/ALPER,ATTER C C WX,WY,WZ ARE THE DRIFT VELOCITY VECTORS C DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ ARE THE VALUES OF THE DIFFUSION C TENSOR IN THE CARTESIAN COORDINATE SYSTEM. C ------------------------------- C NOTE : OFF-DIAGONAL ELEMENTS ARE DEFINED SO THAT THE COEFFICIENTS C ARE EQUAL : DIFXY=DIFYX , DIFXZ=DIFZX AND DIFYZ=DIFZY . C ----------------------------- C DIFLN,DIFTR,DIFXX ARE THE DIFFUSION COEFFICIENTS IN THE COORDINATE C SYSTEM ALIGNED ALONG THE DRIFT DIRECTION (IT IS ONLY CALCULATED C FOR THE CASE WHERE THE MAGNETIC FIELD IS AT 90 DEGREES TO EFIELD). C IF THERE IS NO MAGNETIC FIELD THE VALUES DIFLN AND DIFTR C REPRESENT THE LONGITUDINAL AND TRANSVERSE DIFFUSION. C C OUTPUT UNITS IN COMMON BLOCKS: C : VELOCITY : CM/SEC C DIFFUSION : CM**2/SEC C ALPHA : 1/CM. C ATT : 1/CM. C CALCULATION ERRORS : % OF VALUE. C C NB . OBSERVED ALPHA = ALPHA-ATT C FOR MAGNETIC FIELDS ALPHA AND ATT ARE DEFINED PARALLEL TO THE C ELECTRIC FIELD...... C---------------------------------------------------------------- C--------------------------------------------------------------- C INPUT CARDS : C---------------------------------------------------------- C FIRST CARD: 2I10,F10.5 : NGAS,NMAX,EFINAL C NGAS: NUMBER OF GASES IN MIXTURE C NMAX: NUMBER OF REAL COLLISIONS ( MULTIPLE OF 1*10**7 ) C USE NMAX = BETWEEN 2 AND 5 FOR INELASTIC GAS TO OBTAIN 1% ACCURACY C NMAX = ABOVE 10 FOR BETTER THAN 0.5% ACCURACY. C NMAX = AT LEAST 10 FOR PURE ELASTIC GASES LIKE ARGON C HIGHER VALUES THAN NMAX=214 CAN ONLY BE USED ON COMPUTERS SUCH C AS DEC ALPHAS WITH TRUE 64 BIT INTEGERS. PCS ARE LIMITED TO C 31 BIT INTEGERS... C EFINAL = UPPER LIMIT OF THE ELECTRON ENERGY IN ELECTRON VOLTS. C EFINAL = 0.0 (PROGRAM AUTOMATICALLY CALCULATES UPPER INTEGRATION C ENERGY LIMIT) C------------------------------------------------------------- C SECOND CARD : 6I5 : NGAS1 , NGAS2, NGAS3 , NGAS4 , NGAS5 , NGAS6 C NGAS1,ETC : GAS NUMBER IDENTIFIERS (BETWEEN 1 AND 80) C SEE GAS LIST BELOW FOR IDENTIFYING NUMBERS. C C------------------------------------------------------------- C THIRD CARD: 8F10.4 : FRAC1,FRAC2,FRAC3,FRAC4,FRAC5,FRAC6,TEMP,TORR C FRAC1,ETC : PERCENTAGE FRACTION OF GAS1,ETC C TEMP : TEMPERATURE OF GAS IN CENTIGRADE C TORR : PRESSURE OF GAS IN TORR C ------------------------------------------------------------ C FOURTH CARD : 6F10.3 : EMAG,BMAG,BTHETA C EMAG : ELECTRIC FIELD IN VOLTS/ CM. C BMAG : MAGNITUDE OF THE MAGNETIC FIELD IN KILOGAUSS C BTHETA : ANGLE BETWEEN THE ELECTRIC AND MAGNETIC FIELDS IN DEGREES. C----------------------------------------------------------------------- C CARD 4*N+1 USES NGAS=0 TO TERMINATE CORRECTLY C-------------------------------------------------------------------- C DATA BASE: C C GAS NUMBER: STAR RATING: C----------------------------------------------------------------- C GAS1 : CF4 (2001) (ANISOTROPIC SCATTERING ONLY) 5* C GAS2 : ARGON (2002) 5* C GAS3 : HELIUM 4 (1997) 5* C GAS4 : HELIUM 3 (1992) 5* C GAS5 : NEON (2003) 5* C GAS6 : KRYPTON (2001) 4* C GAS7 : XENON (2003) 4* C GAS8 : METHANE (2004) NEW ANISTROPIC VERSION 5* C GAS9 : ETHANE (1999) 5* C GAS10 : PROPANE (1999) 4* C GAS11 : ISOBUTANE (1999) 4* C GAS12 : CO2 (2004) NEW IMPROVED X-SECTIONS 5* C GAS13 : NEO-PENTANE (2003) C(CH3)4 4* C GAS14 : H20 (2004) 210 ROTATIONAL STATES INCLUDED 4* C GAS15 : OXYGEN (2004) 3-BODY ATTACHMENT INCLUDED 4* C GAS16 : NITROGEN (2004) PITCHFORD AND PHELPS MOD ISOTRPC 4* C GAS17 : NITRIC OXIDE (1995) ATTACHING GAS 2* C GAS18 : NITROUS OXIDE (2004) ATTACHING GAS (SEE DATA FILE) 4* C GAS19 : ETHENE (1999) C2H4 4* C GAS20 : ACETYLENE (2002) C2H2 4* C GAS21 : HYDROGEN (2001) 5* C GAS22 : DEUTERIUM (1998) 5* C GAS23 : CARBON MONOXIDE (2003) ANISOTROPIC ROTATIONAL STATES 5* C GAS24 : METHYLAL (1988) 2* C GAS25 : DME (1998) 4* C GAS26 : REID STEP MODEL (ANISOTROPIC VERSION) C GAS27 : MAXWELL MODEL C GAS28 : REID RAMP MODEL C GAS29 : C2F6 (1999) (ANISOTROPIC ) 4* C GAS30 : SF6 N.B. DO NOT USE HIGH PERCENTAGE 3* C GAS31 : NH3 AMMONIA (2004) 120 ROTATIONAL LEVELS 4* C GAS32 : C3H6 PROPENE (1999) 4* C GAS33 : C3H6 CYCLOPROPANE (1999) 4* C GAS34 : CH3OH METHANOL (1999) 3* C GAS35 : C2H5OH ETHANOL (1999) 3* C GAS36 : C3H7OH ISO PROPANOL(1999) 3* C GAS37 : CESIUM (2001) (NO DIMERS) 2* C GAS38 : FLOURINE (MORGAN) 2* C GAS39 : CS2 (2001) ( ION DRIFT,DARK MATTER ) 2* C GAS40 : COS (2001) 2* C GAS41 : CD4 (2004) TPCS IN NEUTRON BACKGROUND ENVIRONMENT 4* C GAS42 : BF3 BORON TRIFLOURIDE (2001) (ANISOTROPIC) 4* C GAS43 : C2HF5 OR C2H2F4 (ESTIMATED NO DATA) (ANISOTROPIC) 2* C GAS44 : HELIUM 3 (2002) (ANISOTROPIC) 5* C GAS45 : HELIUM 4 (2002) (ANISOTROPIC) 5* C GAS46 : NEON (2003) (ANISOTROPIC) 5* C GAS47 : ARGON (2002) (ANISOTROPIC) 5* C GAS48 : KRYPTON (2002) (ANISOTROPIC) 4* C GAS49 : XENON (2003) (ANISOTROPIC) 4* C GAS50 : CHF3 (2001) 3* C GAS51 : CF3BR (2002) MAGIC GAS CONSTITUENT 3* C GAS52 : C3F8 (2002) (ANISOTROPIC) 3* C GAS53 : OZONE (2002) RAD HARD (REMOVES CARBON DEPOSITS) 3* C GAS54 : MERCURY (2003) INCLUDES DIMER X-SECTION 2* C GAS55 : H2S (2003) POOR QUALITY DATA 2* C GAS56 : N-BUTANE (2003) LINEAR CHAIN C-C-C-C 4* C GAS57 : N-PENTANE(2003) LINEAR CHAIN C-C-C-C-C 4* C GAS58 : NITROGEN (2004) P+PHELPS MOD ANISOTROPIC ELASTIC SCATT 4* C GAS59 : GEH4 (2005) GERMANE BETTER TRANSPORT DATA NEEDED 3* C GAS60 : SIH4 (2005) SILANE ANISOTROPIC 4* C GAS59-80 :DUMMY ROUTINES C------------------------------------------------------------------ C +PATCH,*MAGGARF. Pilot patch +USE,MAGCOM. +USE,GARFCOM. +USE,MAGINTER. +USE,MAGBOL7. +USE,MAGGAS. +PATCH,MAGCOM. Common blocks for Magboltz +KEEP,MAGBPARM. *----------------------------------------------------------------------- * MAGPAR - Interface parameters for gas mixing with Magboltz. * (Last changed on 2/ 3/08.) *----------------------------------------------------------------------- INTEGER MXGNAM PARAMETER(MXGNAM=60) DOUBLE PRECISION FRAMIX LOGICAL LF0PLT,LCSPLT,LGKEEP,LBMCPR COMMON /MAGPAR/ FRAMIX(MXGNAM),LF0PLT,LCSPLT,LGKEEP,LBMCPR +KEEP,MAGBDIM. * Array dimensions. integer mxngas parameter(mxngas=6) +KEEP,ANIS. * Is in effect the old ANCT common. DOUBLE PRECISION PSCT,ANGCT INTEGER INDEX,NISO COMMON/ANIS/PSCT(2048,512),ANGCT(2048,512),INDEX(512),NISO +KEEP,BFLD. DOUBLE PRECISION EOVB,WB,BTHETA,BMAG COMMON/BFLD/EOVB,WB,BTHETA,BMAG +KEEP,CION. DOUBLE PRECISION ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL INTEGER ITFINAL,IPRIM COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM +KEEP,CNSTS. DOUBLE PRECISION PIR2,ECHARG,EMASS,AMU,BOLTZ,BOLTZJ, - AWB,ALOSCH,ABZERO,ATMOS PARAMETER(PIR2=8.79735534D-17) PARAMETER(ECHARG=1.602176462D-19) PARAMETER(EMASS=9.10938188D-31) PARAMETER(AMU=1.66053873D-27) PARAMETER(BOLTZ=8.617342D-5) PARAMETER(BOLTZJ=1.3806503D-23) PARAMETER(AWB=1.758820174D10) PARAMETER(ALOSCH=2.6867775D19) PARAMETER(ABZERO=273.15D0) PARAMETER(ATMOS=760.0D0) +KEEP,CNSTS1. DOUBLE PRECISION CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 +KEEP,CTCALC. DOUBLE PRECISION ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, - ZPLANE7,ZPLANE8 INTEGER IZFINAL COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, - ZPLANE7,ZPLANE8,IZFINAL +KEEP,FRED. DOUBLE PRECISION FCION,FCATT COMMON/FRED/FCION(2048),FCATT(2048) +KEEP,GASN. INTEGER NGASN COMMON /GASN/ NGASN(mxngas) +KEEP,INPT. INTEGER NGAS,NSTEP,IDBG DOUBLE PRECISION EFINAL,ESTEP,AKT,ARY,TEMPC,TORR PARAMETER(ARY=13.60569172) COMMON/INPT/NGAS,NSTEP,EFINAL,ESTEP,AKT,TEMPC,TORR,IDBG +KEEP,IPS. DOUBLE PRECISION XSS,YSS,ZSS,TSS,ESS,DCXS,DCYS,DCZS INTEGER IPLS COMMON/IPS/XSS(200),YSS(200),ZSS(200),TSS(200),ESS(200), - DCXS(200),DCYS(200),DCZS(200),IPLS(200) +KEEP,IPT. DOUBLE PRECISION XS,YS,ZS,TS,ES,DCX,DCY,DCZ INTEGER IPL COMMON/IPT/XS(200),YS(200),ZS(200),TS(200),ES(200), - DCX(200),DCY(200),DCZ(200),IPL(200) +KEEP,LARGE. * Sometimes IPLAST is called LAST DOUBLE PRECISION CF,EIN,TCF,RGAS,WPL INTEGER IARRY,IPN,IPLAST,ISIZE COMMON/LARGE/CF(2048,512),EIN(512),TCF(2048),IARRY(512), - RGAS(512),IPN(512),WPL(512),IPLAST,ISIZE +KEEP,MAGBOUT. DOUBLE PRECISION ALPHA,ATT COMMON /CTOWNS/ ALPHA,ATT DOUBLE PRECISION ALPER,ATTER COMMON /CTWNER/ ALPER,ATTER DOUBLE PRECISION DXXER,DYYER,DZZER,DYZER,DXYER,DXZER COMMON /DIFERB/ DXXER,DYYER,DZZER,DYZER,DXYER,DXZER DOUBLE PRECISION DFLER,DFTER COMMON /DIFERL/ DFLER,DFTER DOUBLE PRECISION DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ COMMON /DIFLAB/ DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ DOUBLE PRECISION DIFLN,DIFTR COMMON /DIFVEL/ DIFLN,DIFTR DOUBLE PRECISION WX,WY,WZ COMMON /VEL/ WX,WY,WZ DOUBLE PRECISION DWX,DWY,DWZ COMMON /VELERR/ DWX,DWY,DWZ +KEEP,MIX. * Grouped QIN1 ... QIN6 in QINN DOUBLE PRECISION QELM,QSUM,QION,QINN,QSATT COMMON /MIX1/ QELM(2048),QSUM(2048),QION(mxngas,2048), - QINn(220,2048,mxngas),QSATT(2048) * EVECT is originally called E or ES depending on the routine. DOUBLE PRECISION Evect,EROOT,QTOT,QREL,QINEL,QEL COMMON /MIX2/ Evect(2048),EROOT(2048),QTOT(2048),QREL(2048), - QINEL(2048),QEL(2048) * Extensively reduced. INTEGER NINn * ,LION,LIN1,LIN2,LIN3,LIN4,LIN5,LIN6 * DOUBLE PRECISION ALION,ALIN1,ALIN2,ALIN3,ALIN4,ALIN5,ALIN6 COMMON /MIX3/ NINn(mxngas) * ,LION(6),LIN1(220), * - LIN2(220),LIN3(220),LIN4(220),LIN5(220),LIN6(220),ALION(6), * - ALIN1(220),ALIN2(220),ALIN3(220),ALIN4(220),ALIN5(220), * - ALIN6(220) +KEEP,MRATIO. * Grouped VAN1 ... VAN6 in VANn DOUBLE PRECISION VANn,VAN COMMON /MRATIO/ VANn(mxngas),VAN +KEEP,NAMES. * Changed name of common from /NAMES/ to /MBGNAM/ for Mac OS X CHARACTER*15 NAMEG COMMON /MBGNAM/ NAMEG(mxngas) +KEEP,OUTPT. * Adjusted size of ICOLL DOUBLE PRECISION TIME,SPEC,TMAX1,AVE,DEN,XID,X,Y,Z,ST INTEGER ICOLL,NNULL,ICOLN COMMON/OUTPT/TIME(300),ICOLL(5*mxngas),SPEC(2048),TMAX1, - AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) +KEEP,PTTOF. * Combined /PTTOF/, /PTTOFG/ and /PTTOFH/ in a single common. DOUBLE PRECISION RI,EPT,VZPT,VYPT,VXPT,TTEST COMMON /PTTOF/ RI(8),EPT(8),VZPT(8),VYPT(8),VXPT(8),TTEST(8) +KEEP,RATIO. * Grouped AN1 ... AN6 in ANn DOUBLE PRECISION ANn,AN,FRAC COMMON /RATIO/ ANn(mxngas),AN,FRAC(mxngas) +KEEP,ROTS. DOUBLE PRECISION RCS,RSN,EFZ100,EFX100,F1,EOVBR COMMON/ROTS/RCS,RSN,EFZ100,EFX100,F1,EOVBR +KEEP,SCRIP. CHARACTER*30 DSCRPT COMMON/SCRIP/DSCRPT(512) +KEEP,SETP. DOUBLE PRECISION TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX,RSTART, - EMAG INTEGER NMAX COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, - EMAG,NMAX +KEEP,SINT. DOUBLE PRECISION SIMF COMMON/SINT/SIMF(2048) +KEEP,SPLOUT. DOUBLE PRECISION ESPL,XSPL,YSPL,ZSPL,TSPL,XXSPL,YYSPL,ZZSPL, - VZSPL,TSSUM,TSSUM2,ATTOION,ATTIOER,ATTATER INTEGER NESST COMMON/SPLOUT/ESPL(8),XSPL(8),YSPL(8),ZSPL(8),TSPL(8),XXSPL(8), - YYSPL(8),ZZSPL(8),VZSPL(8),TSSUM(8),TSSUM2(8),ATTOION, - ATTIOER,ATTATER,NESST(9) +KEEP,SPL1. DOUBLE PRECISION TMSPL,TTMSPL,RSPL,RRSPL,RRSPM COMMON/SPL1/TMSPL(8),TTMSPL(8),RSPL(8),RRSPL(8),RRSPM(8) +KEEP,SSTOUT. DOUBLE PRECISION VDOUT,VDERR,WSOUT,WSERR,DLOUT,DLERR,DTOUT,DTERR, - ALPHSST,ALPHERR,ATTSST,ATTERR COMMON/SSTOUT/VDOUT,VDERR,WSOUT,WSERR,DLOUT,DLERR,DTOUT,DTERR, - ALPHSST,ALPHERR,ATTSST,ATTERR +KEEP,THRM. DOUBLE PRECISION CON INTEGER ITHRM COMMON /THRM/ CON,ITHRM +KEEP,TOFOUT. * Combined /TOFOUT/, /TOFGOUT/ and /TOFHOUT/ in a single common. DOUBLE PRECISION RALPHA,RALPER,TOFENE,TOFENER,TOFWV,TOFWVER, - TOFWVZ,TOFWVZER,TOFWVY,TOFWVYER,TOFWVX,TOFWVXER, - TOFDL,TOFDLER,TOFDT,TOFDTER,TOFWR,TOFWRER, - TOFDZZ,TOFDZZER,TOFDXX,TOFDXXER,TOFDYY,TOFDYYER, - TOFDYZ,TOFDYZER,TOFDXY,TOFDXYER,TOFDXZ,TOFDXZER, - TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER,TOFWRX,TOFWRXER, - RATTOF,RATOFER COMMON /TOFHOUT/ RALPHA,RALPER,TOFENE,TOFENER,TOFWV,TOFWVER, - TOFWVZ,TOFWVZER,TOFWVY,TOFWVYER,TOFWVX,TOFWVXER, - TOFDL,TOFDLER,TOFDT,TOFDTER,TOFWR,TOFWRER, - TOFDZZ,TOFDZZER,TOFDXX,TOFDXXER,TOFDYY,TOFDYYER, - TOFDYZ,TOFDYZER,TOFDXY,TOFDXYER,TOFDXZ,TOFDXZER, - TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER,TOFWRX,TOFWRXER, - RATTOF,RATOFER +KEEP,TPLOUT. * Combined /TPLOUT/, /TPLOUTG/, /TPLOUTH/ in a single common. DOUBLE PRECISION ETPL,XTPL,YTPL,ZTPL,TTPL,XXTPL,YYTPL,ZZTPL, - YZTPL,XZTPL,XYTPL,VZTPL,VYTPL,VXTPL,ATTOINT,ATTERT,AIOERT INTEGER NETPL COMMON /TPLOUT/ ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), - YYTPL(8),ZZTPL(8),YZTPL(8),XZTPL(8),XYTPL(8), - VZTPL(8),VYTPL(8),VXTPL(8),ATTOINT,ATTERT,AIOERT,NETPL(8) +KEEP,TTRM. DOUBLE PRECISION ZTOT,TTOT,ZTOTS,TTOTS COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS +PATCH,MAGINTER. +DECK,GASBMC. SUBROUTINE GASBMC(IFAIL) *----------------------------------------------------------------------- * GASBMC - Interface routine for Magboltz 7 called from Garfield. * (Last changed on 4/ 4/08.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,GASDATA. +SEQ,BFIELD. +SEQ,PRINTPLOT. +SEQ,GLOBALS. +SEQ,MATDATA. +SEQ,MAGBPARM. +SEQ,CONSTANTS. DOUBLE PRECISION FRTOT REAL AUX,EPMIN,EPMAX,EPMINR,EPMAXR,SSTTHR,SSTHRR, - BANGMN,BANGMX,BAMINR,BAMAXR,BTABMN,BTABMX,BTMINR,BTMAXR, - VAR(MXVAR),RES(1),EFLDR,BFLDR,ANGR, - VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL,SBOL(6), - EXBOL(MXEXG),IOBOL(MXIOG) INTEGER INPTYP,INPCMP,MODVAR(MXVAR),MODRES(1),NCMOB,ISLOT, - I,J,K,L,IFAIL,IFAIL1,IFAIL2,INEXT,NGASR,NBANGR,NBTABR, - NWORD,NCOUT,NRES,NC,IENTRY,NNMAX,NMAXR,IGLB,NCSTR, - MATSLT LOGICAL EPLOG,USE(MXVAR),OK,ESET,BSET,ASET CHARACTER*(MXCHAR) STRING CHARACTER*500 STR CHARACTER*20 OUTSTR CHARACTER*10 VARLIS(MXVAR) EXTERNAL INPTYP,INPCMP,MATSLT *** Identify. IF(LIDENT)PRINT *,' /// ROUTINE GASBMC ///' PRINT *,' ------ GASBMC MESSAGE : Calling interfaced Magboltz'// - ' version 7.08, last changed on 1/3/12.' *** Initial values for the E/p scale. EPMIN=100.0/PGAS EPMAX=100000.0/PGAS EPLOG=.TRUE. NGAS=20 ESET=.FALSE. * E-B angles. IF(MAGOK)THEN BANGMN=0 BANGMX=PI/2 NBANG=4 ELSE BANGMN=PI/2 BANGMX=PI/2 NBANG=1 ENDIF ASET=.FALSE. * B field magnitude. IF(MAGOK)THEN IF(ABS((BFMIN-BFMAX)*BSCALE).LT.0.0001)THEN BTABMN=BFMIN*BSCALE BTABMX=BFMAX*BSCALE NBTAB=1 ELSE BTABMN=BFMIN*BSCALE BTABMX=BFMAX*BSCALE NBTAB=6 ENDIF ELSE BTABMN=0 BTABMX=0 NBTAB=1 ENDIF BSET=.FALSE. * Plotting distribution functions. LF0PLT=.FALSE. * Cross section plot. LCSPLT=.FALSE. * Saving cross section and energy distribution data. LGKEEP=.FALSE. * Printing Magboltz output. LBMCPR=.FALSE. * Mobility. VARLIS(1)='EP' NCMOB=0 * MC accuracy parameters. NNMAX=2 * SST threshold. C SSTTHR=60 * Next line changed at the request of Steve Biagi (6/9/2007) SSTTHR=30.0D0 *** Prepare for progress printing. CALL PROINT('MAGBOLTZ',1,6) *** Preset failure flag to 0: success. IFAIL=0 *** Preset the gas mixture fractions. DO 10 I=1,MXGNAM FRAMIX(I)=0.0 10 CONTINUE *** Read the command line. CALL PROFLD(1,'Reading command',-1.0) CALL PROSTA(1,0.0) CALL INPNUM(NWORD) INEXT=2 * Control of whether to proceed. OK=.TRUE. DO 20 I=2,NWORD IF(I.LT.INEXT)GOTO 20 *** Fractions, CF4 (current data). IF(INPCMP(I,'CF4')+ - INPCMP(I,'FREON-#14')+ - INPCMP(I,'TETRAFLUOROMETHANE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(1)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Argon (isotropic). ELSEIF(INPCMP(I,'AR#GON-ISO#TROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(2)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Helium 4 (isotropic). ELSEIF(INPCMP(I,'HE#LIUM-4-ISO#TROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(3)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Helium 3 (isotropic). ELSEIF(INPCMP(I,'HE#LIUM-3-ISO#TROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(4)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Neon (isotropic). ELSEIF(INPCMP(I,'NEON-ISO#TROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(5)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Krypton (isotropic). ELSEIF(INPCMP(I,'KR#YPTON-ISO#TROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(6)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Xenon (isotropic). ELSEIF(INPCMP(I,'XE#NON-ISO#TROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(7)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methane (only version, isotropic). ELSEIF(INPCMP(I,'METHANE')+ - INPCMP(I,'CH4').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(8)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethane. ELSEIF(INPCMP(I,'ETHANE')+ - INPCMP(I,'C2H6').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(9)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Propane. ELSEIF(INPCMP(I,'PROPA#NE')+ - INPCMP(I,'C3H8').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(10)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Isobutane. ELSEIF(INPCMP(I,'ISO#BUTANE')+ - INPCMP(I,'IC4H10')+ - INPCMP(I,'ISO-C4H10')+ - INPCMP(I,'C4H10').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(11)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CO2 (isotropic). ELSEIF(INPCMP(I,'CO2')+ - INPCMP(I,'CARB#ON-DIOX#IDE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(12)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Neopentane (current data) ELSEIF(INPCMP(I,'NEOPENT#ANE')+ - INPCMP(I,'NEO-PENT#ANE')+ - INPCMP(I,'NEO-C5H12')+ - INPCMP(I,'C5H12').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(13)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Water (current data). ELSEIF(INPCMP(I,'WA#TER-#VAPOUR')+ - INPCMP(I,'H2O').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(14)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Oxygen (current data). ELSEIF(INPCMP(I,'OX#YGEN')+ - INPCMP(I,'O2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(15)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitrogen (isotropic). ELSEIF(INPCMP(I,'NI#TROGEN-ISO#TROPIC')+ - INPCMP(I,'N2-ISO#TROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(16)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitric oxide (NO). ELSEIF(INPCMP(I,'NITRI#C-OX#IDE')+ - INPCMP(I,'NITROGEN-MONOXIDE')+ - INPCMP(I,'NO').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(17)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitrous oxide (N2O). ELSEIF(INPCMP(I,'NITRO#US-OX#IDE')+ - INPCMP(I,'DINITROGEN-MONOXIDE')+ - INPCMP(I,'LAUGHING-GAS')+ - INPCMP(I,'N2O').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(18)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethene (C2H4). ELSEIF(INPCMP(I,'ETHE#NE')+ - INPCMP(I,'ETHYLENE')+ - INPCMP(I,'C2H4').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(19)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Acetylene (C2H2). ELSEIF(INPCMP(I,'ACETYL#ENE')+ - INPCMP(I,'ETHYNE')+ - INPCMP(I,'C2H2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(20)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Hydrogen. ELSEIF(INPCMP(I,'HYDROGEN')+ - INPCMP(I,'H2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(21)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Deuterium. ELSEIF(INPCMP(I,'DEUTERIUM')+ - INPCMP(I,'D2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(22)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Carbon monoxide (CO). ELSEIF(INPCMP(I,'CO')+ - INPCMP(I,'CARB#ON-MONOX#IDE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(23)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methylal (dimethoxymethane, CH3-O-CH2-O-CH3, "hot" version). ELSEIF(INPCMP(I,'METHY#LAL-#HOT')+ - INPCMP(I,'DIMETHOXYMETHANE-#HOT')+ - INPCMP(I,'DMM-#HOT')+ - INPCMP(I,'C3H8O2-#HOT').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(24)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * DME. ELSEIF(INPCMP(I,'DME')+ - INPCMP(I,'DIMETHYL-ETHER')+ - INPCMP(I,'METHOXYMETHANE')+ - INPCMP(I,'METHYL-ETHER')+ - INPCMP(I,'WOOD-ETHER')+ - INPCMP(I,'C2H6O').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(25)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Reid step. ELSEIF(INPCMP(I,'REID-STEP').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(26)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Maxwell model. ELSEIF(INPCMP(I,'MAXWELL-MODEL').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(27)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Reid ramp. ELSEIF(INPCMP(I,'REID-RAMP').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(28)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * C2F6. ELSEIF(INPCMP(I,'C2F6')+ - INPCMP(I,'FREON-116')+ - INPCMP(I,'ZYRON-116-#N5')+ - INPCMP(I,'HEXAFLUOROETHANE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(29)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * SF6. ELSEIF(INPCMP(I,'SF6')+ - INPCMP(I,'SULPHUR-HEXAFLUORIDE')+ - INPCMP(I,'SULFUR-HEXAFLUORIDE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(30)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * NH3. ELSEIF(INPCMP(I,'AMMONIA')+ - INPCMP(I,'NH3').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(31)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Propene. ELSEIF(INPCMP(I,'PROPE#NE')+ - INPCMP(I,'PROPYLENE')+ - INPCMP(I,'C3H6').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(32)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Cyclopropane. ELSEIF(INPCMP(I,'C#YCLO-PROPA#NE')+ - INPCMP(I,'CYCLOPROPA#NE')+ - INPCMP(I,'C#YCLO-C3H6').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(33)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methanol. ELSEIF(INPCMP(I,'METHANOL')+ - INPCMP(I,'METHYL-ALCOHOL')+ - INPCMP(I,'WOOD-ALCOHOL')+ - INPCMP(I,'CH3OH').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(34)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethanol. ELSEIF(INPCMP(I,'ETHANOL')+ - INPCMP(I,'ETHYL-ALCOHOL')+ - INPCMP(I,'GRAIN-ALCOHOL')+ - INPCMP(I,'C2H5OH').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(35)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Propanol. ELSEIF(INPCMP(I,'PROPANOL')+ - INPCMP(I,'2-PROP#ANOL')+ - INPCMP(I,'ISO-PROP#ANOL')+ - INPCMP(I,'ISOPROP#ANOL')+ - INPCMP(I,'ISOPROPYL-#ALCOHOL')+ - INPCMP(I,'C3H7OH').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(36)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Cesium / Caesium. ELSEIF(INPCMP(I,'CE#SIUM')+ - INPCMP(I,'CAE#SIUM')+ - INPCMP(I,'CS').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(37)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Fluorine. ELSEIF(INPCMP(I,'FLUOR#INE')+ - INPCMP(I,'F2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(38)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CS2. ELSEIF(INPCMP(I,'CS2')+ - INPCMP(I,'C#ARBON-DISULPH#IDE')+ - INPCMP(I,'C#ARBON-DISULF#IDE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(39)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * COS. ELSEIF(INPCMP(I,'COS')+ - INPCMP(I,'C#ARBONYL-SULPH#IDE')+ - INPCMP(I,'C#ARBONYL-SULF#IDE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(40)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Deuterated methane. ELSEIF(INPCMP(I,'DEUT#ERIUM-METHANE')+ - INPCMP(I,'DEUT#ERATED-METHANE')+ - INPCMP(I,'CD4').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(41)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * BF3. ELSEIF(INPCMP(I,'BF3')+ - INPCMP(I,'BORON-TRIFLUORIDE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(42)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * C2HF5 and C2H2F4. ELSEIF(INPCMP(I,'C2HF5')+ - INPCMP(I,'C2H2F4')+ - INPCMP(I,'C2F5H')+ - INPCMP(I,'C2F4H2')+ - INPCMP(I,'FREON-134-#A')+ - INPCMP(I,'FREON-125')+ - INPCMP(I,'ZYRON-125')+ - INPCMP(I,'TETRAFLUOROETHANE')+ - INPCMP(I,'PENTAFLUOROETHANE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(43)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Helium 3 (anisotropic). ELSEIF(INPCMP(I,'HE#LIUM-3-#ANISOTROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(44)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Helium 4 (anisotropic). ELSEIF(INPCMP(I,'HE#LIUM-#4-#ANISOTROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(45)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Neon (anisotropic). ELSEIF(INPCMP(I,'NEON-#ANISOTROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(46)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Argon (anisotropic). ELSEIF(INPCMP(I,'AR#GON-#ANISOTROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(47)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Krypton (anisotropic). ELSEIF(INPCMP(I,'KR#YPTON-#ANISOTROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(48)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Xenon (anisotropic). ELSEIF(INPCMP(I,'XE#NON-#ANISOTROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(49)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CHF3. ELSEIF(INPCMP(I,'CHF3')+ - INPCMP(I,'FREON-23')+ - INPCMP(I,'TRIFLUOROMETHANE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(50)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CF3Br. ELSEIF(INPCMP(I,'CF3BR')+ - INPCMP(I,'TRIFLUOROBROMOMETHANE')+ - INPCMP(I,'HALON-1301')+ - INPCMP(I,'FREON-13B1').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(51)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * C3F8. ELSEIF(INPCMP(I,'C3F8')+ - INPCMP(I,'OCTAFLUOROPROPANE')+ - INPCMP(I,'R218')+ - INPCMP(I,'FREON-218')+ - INPCMP(I,'PERFLUOROPROPANE')+ - INPCMP(I,'RC-218')+ - INPCMP(I,'PFC-218').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(52)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ozone. ELSEIF(INPCMP(I,'OZONE')+ - INPCMP(I,'O3').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(53)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Mercury. ELSEIF(INPCMP(I,'MERCURY')+ - INPCMP(I,'HG')+ - INPCMP(I,'HG2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(54)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * H2S. ELSEIF(INPCMP(I,'H2S')+ - INPCMP(I,'HYDROGEN-SULPHIDE')+ - INPCMP(I,'HYDROGEN-SULFIDE')+ - INPCMP(I,'HEPATIC-ACID')+ - INPCMP(I,'SEWER-GAS')+ - INPCMP(I,'SULFUR-HYDRIDE')+ - INPCMP(I,'DIHYDROGEN-MONOSULFIDE')+ - INPCMP(I,'DIHYDROGEN-MONOSULPHIDE')+ - INPCMP(I,'SULPHUR-HYDRIDE')+ - INPCMP(I,'STINK-DAMP')+ - INPCMP(I,'SULFURETED-HYDROGEN ').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(55)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * n-butane. ELSEIF(INPCMP(I,'N-BUTANE')+ - INPCMP(I,'N-C4H10').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(56)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * n-pentane. ELSEIF(INPCMP(I,'N-PENTANE')+ - INPCMP(I,'N-C5H12').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(57)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitrogen. ELSEIF(INPCMP(I,'NI#TROGEN-#ANISOTROPIC')+ - INPCMP(I,'N2-#ANISOTROPIC').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(58)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Germane, GeH4. ELSEIF(INPCMP(I,'GERM#ANE')+ - INPCMP(I,'GERMANIUM-HYDRIDE')+ - INPCMP(I,'GERMANIUM-TETRAHYDRIDE')+ - INPCMP(I,'GERMANOMETHANE')+ - INPCMP(I,'MONOGERMANE')+ - INPCMP(I,'GEH4').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(59)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Silane, SiH4. ELSEIF(INPCMP(I,'SIL#ANE')+ - INPCMP(I,'SILICON-HYDRIDE')+ - INPCMP(I,'SILICON-TETRAHYDRIDE')+ - INPCMP(I,'SILICANE')+ - INPCMP(I,'MONOSILANE')+ - INPCMP(I,'SIH4').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(60)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Range of E/p. ELSEIF(INPCMP(I,'E/P-RAN#GE').NE.0)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPCHK(I+2,2,IFAIL2) IF(IFAIL1.EQ.0.AND.IFAIL2.EQ.0.AND.NWORD.GE.I+2)THEN CALL INPRDR(I+1,EPMINR,EPMIN) CALL INPRDR(I+2,EPMAXR,EPMAX) IF(EPMINR.NE.EPMAXR.AND.EPMINR.GT.0.0.AND. - EPMAXR.GT.0.0)THEN EPMIN=MIN(EPMINR,EPMAXR) EPMAX=MAX(EPMINR,EPMAXR) ELSE CALL INPMSG(I+1,'Zero range and negative values') CALL INPMSG(I+2,'are not permitted in RANGE. ') OK=.FALSE. ENDIF ELSE CALL INPMSG(I,'Missing or invalid arguments. ') OK=.FALSE. ENDIF ESET=.FALSE. INEXT=I+3 * Listed E/p values. ELSEIF(INPCMP(I,'E/P').NE.0)THEN IF(INPTYP(I+1).EQ.0)THEN CALL INPSTR(I+1,I+1,STRING,NCSTR) DO 250 IGLB=1,NGLB IF(STRING(1:NCSTR).EQ.GLBVAR(IGLB))THEN ISLOT=MATSLT(NINT(GLBVAL(IGLB))) IF(GLBMOD(IGLB).NE.5)THEN CALL INPMSG(I+1,'Not of type Matrix.') OK=.FALSE. ELSEIF(ISLOT.LE.0)THEN CALL INPMSG(I+1,'Matrix inaccessible.') OK=.FALSE. ELSEIF(MLEN(ISLOT).GT.MXLIST)THEN CALL INPMSG(I+1,'More than MXLIST elements.') OK=.FALSE. ELSE NGAS=MLEN(ISLOT) DO 270 J=1,NGAS IF(MVEC(MORG(ISLOT)+J).LE.0)THEN CALL INPMSG(I+1,'Contains values <= 0.') OK=.FALSE. GOTO 260 ELSE EGAS(J)=MVEC(MORG(ISLOT)+J) ENDIF 270 CONTINUE ESET=.TRUE. ENDIF GOTO 260 ENDIF 250 CONTINUE CALL INPMSG(I+1,'Not a global variable.') OK=.FALSE. 260 CONTINUE INEXT=I+2 ELSEIF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN NGAS=0 DO 280 J=I+1,NWORD IF(INPTYP(J).NE.1.AND.INPTYP(J).NE.2)THEN INEXT=J GOTO 290 ELSEIF(NGAS+1.GT.MXLIST)THEN CALL INPMSG(J,'Too many values, ignored.') OK=.FALSE. GOTO 280 ENDIF CALL INPCHK(J,2,IFAIL1) IF(IFAIL1.EQ.0)THEN CALL INPRDR(J,EFLDR,0.0) IF(EFLDR.GT.0.0)THEN NGAS=NGAS+1 EGAS(NGAS)=EFLDR ELSE CALL INPMSG(J,'Not strictly positive.') OK=.FALSE. ENDIF ELSE CALL INPMSG(J,'Invalid field value.') OK=.FALSE. ENDIF 280 CONTINUE INEXT=NWORD+1 290 CONTINUE ESET=.TRUE. ELSE CALL INPMSG(I,'Invalid field specification.') OK=.FALSE. INEXT=I+2 ENDIF * Range of E. ELSEIF(INPCMP(I,'E#LECTRIC-RAN#GE')+ - INPCMP(I,'E#LECTRIC-F#IELD-RAN#GE').NE.0)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPCHK(I+2,2,IFAIL2) IF(IFAIL1.EQ.0.AND.IFAIL2.EQ.0.AND.NWORD.GE.I+2)THEN CALL INPRDR(I+1,EPMINR,EPMIN*PGAS) CALL INPRDR(I+2,EPMAXR,EPMAX*PGAS) IF(EPMINR.NE.EPMAXR.AND.EPMINR.GT.0.0.AND. - EPMAXR.GT.0.0)THEN EPMIN=MIN(EPMINR,EPMAXR)/PGAS EPMAX=MAX(EPMINR,EPMAXR)/PGAS ELSE CALL INPMSG(I+1,'Zero range and negative values') CALL INPMSG(I+2,'are not permitted in RANGE. ') OK=.FALSE. ENDIF ELSE CALL INPMSG(I,'Missing or invalid arguments. ') OK=.FALSE. ENDIF ESET=.FALSE. INEXT=I+3 * Listed values of E. ELSEIF(INPCMP(I,'E#LECTRIC-FIELD').NE.0)THEN IF(INPTYP(I+1).EQ.0)THEN CALL INPSTR(I+1,I+1,STRING,NCSTR) DO 200 IGLB=1,NGLB IF(STRING(1:NCSTR).EQ.GLBVAR(IGLB))THEN ISLOT=MATSLT(NINT(GLBVAL(IGLB))) IF(GLBMOD(IGLB).NE.5)THEN CALL INPMSG(I+1,'Not of type Matrix.') OK=.FALSE. ELSEIF(ISLOT.LE.0)THEN CALL INPMSG(I+1,'Matrix inaccessible.') OK=.FALSE. ELSEIF(MLEN(ISLOT).GT.MXLIST)THEN CALL INPMSG(I+1,'More than MXLIST elements.') OK=.FALSE. ELSE NGAS=MLEN(ISLOT) DO 220 J=1,NGAS IF(MVEC(MORG(ISLOT)+J).LE.0)THEN CALL INPMSG(I+1,'Contains values <= 0.') OK=.FALSE. GOTO 210 ELSE EGAS(J)=MVEC(MORG(ISLOT)+J)/PGAS ENDIF 220 CONTINUE ESET=.TRUE. ENDIF GOTO 210 ENDIF 200 CONTINUE CALL INPMSG(I+1,'Not a global variable.') OK=.FALSE. 210 CONTINUE INEXT=I+2 ELSEIF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN NGAS=0 DO 230 J=I+1,NWORD IF(INPTYP(J).NE.1.AND.INPTYP(J).NE.2)THEN INEXT=J GOTO 240 ELSEIF(NGAS+1.GT.MXLIST)THEN CALL INPMSG(J,'Too many values, ignored.') OK=.FALSE. GOTO 230 ENDIF CALL INPCHK(J,2,IFAIL1) IF(IFAIL1.EQ.0)THEN CALL INPRDR(J,EFLDR,0.0) IF(EFLDR.GT.0.0)THEN NGAS=NGAS+1 EGAS(NGAS)=EFLDR/PGAS ELSE CALL INPMSG(J,'Not strictly positive.') OK=.FALSE. ENDIF ELSE CALL INPMSG(J,'Invalid field value.') OK=.FALSE. ENDIF 230 CONTINUE INEXT=NWORD+1 240 CONTINUE ESET=.TRUE. ELSE CALL INPMSG(I,'Invalid field specification.') OK=.FALSE. INEXT=I+2 ENDIF * Plot distribution functions. ELSEIF(INPCMP(I,'PL#OT-DIST#RIBUTION-#FUNCTIONS').NE.0)THEN LF0PLT=.TRUE. ELSEIF(INPCMP(I,'NOPL#OT-DIST#RIBUTION-#FUNCTIONS').NE.0)THEN LF0PLT=.FALSE. * Plot cross sections. ELSEIF(INPCMP(I,'PL#OT-CR#OSS-#SECTIONS').NE.0)THEN LCSPLT=.TRUE. ELSEIF(INPCMP(I,'NOPL#OT-CR#OSS-#SECTIONS').NE.0)THEN LCSPLT=.FALSE. * Keep cross section and distribution functions. ELSEIF(INPCMP(I,'KEEP').NE.0)THEN LGKEEP=.TRUE. ELSEIF(INPCMP(I,'NOKEEP').NE.0)THEN LGKEEP=.FALSE. * Keep cross section and distribution functions. ELSEIF(INPCMP(I,'PRINT').NE.0)THEN LBMCPR=.TRUE. ELSEIF(INPCMP(I,'NOPRINT').NE.0)THEN LBMCPR=.FALSE. * Kind of E/p scale. ELSEIF(INPCMP(I,'LIN#EAR-#E/P-#SCALE')+ - INPCMP(I,'LIN#EAR-#ELECTRIC-#SCALE')+ - INPCMP(I,'LIN#EAR-#ELECTRIC-#FIELD-#SCALE').NE.0)THEN EPLOG=.FALSE. ESET=.FALSE. ELSEIF(INPCMP(I,'LOG#ARITHMIC-#E/P-#SCALE')+ - INPCMP(I,'LOG#ARITHMIC-#ELECTRIC-#SCALE')+ - INPCMP(I,'LOG#ARITHMIC-#ELECTRIC-#FIELD-#SCALE').NE.0)THEN EPLOG=.TRUE. ESET=.FALSE. * Number of points. ELSEIF(INPCMP(I,'N-E#/P')+ - INPCMP(I,'N-E#LECTRIC-#FIELD').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) IF(IFAIL1.NE.0)OK=.FALSE. CALL INPRDI(I+1,NGASR,20) IF(NGASR.LE.0.OR.NGASR.GT.MXLIST)THEN CALL INPMSG(I+1,'Value is out of range. ') OK=.FALSE. ELSE NGAS=NGASR ENDIF ENDIF ESET=.FALSE. INEXT=I+2 * Range of E-B angle. ELSEIF(MAGOK.AND.INPCMP(I,'ANG#LE-RAN#GE').NE.0)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPCHK(I+2,2,IFAIL2) IF(IFAIL1.EQ.0.AND.IFAIL2.EQ.0.AND.NWORD.GE.I+2)THEN CALL INPRDR(I+1,BAMINR,180*BANGMN/PI) CALL INPRDR(I+2,BAMAXR,180*BANGMX/PI) IF(BAMINR.LT.0.OR.BAMINR.GT.90.0.OR. - BAMAXR.LT.0.OR.BAMAXR.GT.90.0)THEN IF(BAMINR.LT.0.OR.BAMINR.GT.90.0) - CALL INPMSG(I+1,'Out of range [0,90].') IF(BAMAXR.LT.0.OR.BAMAXR.GT.90.0) - CALL INPMSG(I+2,'Out of range [0,90].') OK=.FALSE. ELSEIF(BAMINR.NE.BAMAXR)THEN BANGMN=PI*MIN(BAMINR,BAMAXR)/180 BANGMX=PI*MAX(BAMINR,BAMAXR)/180 ELSE CALL INPMSG(I+1,'A zero range is not permitted ') CALL INPMSG(I+2,'for the E-B angular range. ') OK=.FALSE. ENDIF ELSE CALL INPMSG(I,'Missing or invalid arguments. ') OK=.FALSE. ENDIF ASET=.FALSE. INEXT=I+3 ELSEIF(INPCMP(I,'ANG#LE-RAN#GE').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') CALL INPMSG(I+2,'Has been ignored.') OK=.FALSE. INEXT=I+3 ELSEIF(MAGOK.AND.INPCMP(I,'ANG#LES').NE.0)THEN IF(INPTYP(I+1).EQ.0)THEN CALL INPSTR(I+1,I+1,STRING,NCSTR) DO 350 IGLB=1,NGLB IF(STRING(1:NCSTR).EQ.GLBVAR(IGLB))THEN ISLOT=MATSLT(NINT(GLBVAL(IGLB))) IF(GLBMOD(IGLB).NE.5)THEN CALL INPMSG(I+1,'Not of type Matrix.') OK=.FALSE. ELSEIF(ISLOT.LE.0)THEN CALL INPMSG(I+1,'Matrix inaccessible.') OK=.FALSE. ELSEIF(MLEN(ISLOT).GT.MXBANG)THEN CALL INPMSG(I+1,'More than MXBANG elements.') OK=.FALSE. ELSE NBANG=MLEN(ISLOT) DO 370 J=1,NBANG IF(MVEC(MORG(ISLOT)+J).LT.0.OR. - MVEC(MORG(ISLOT)+J).GT.90)THEN CALL INPMSG(I+1,'Out of range [0,90].') OK=.FALSE. GOTO 360 ELSE BANG(J)=PI*MVEC(MORG(ISLOT)+J)/180 ENDIF 370 CONTINUE ASET=.TRUE. ENDIF GOTO 360 ENDIF 350 CONTINUE CALL INPMSG(I+1,'Not a global variable.') OK=.FALSE. 360 CONTINUE INEXT=I+2 ELSEIF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN NBANG=0 DO 380 J=I+1,NWORD IF(INPTYP(J).NE.1.AND.INPTYP(J).NE.2)THEN INEXT=J GOTO 390 ELSEIF(NBANG+1.GT.MXBANG)THEN CALL INPMSG(J,'Too many values, ignored.') OK=.FALSE. GOTO 380 ENDIF CALL INPCHK(J,2,IFAIL1) IF(IFAIL1.EQ.0)THEN CALL INPRDR(J,ANGR,0.0) IF(ANGR.GE.0.0.AND.ANGR.LE.90.0)THEN NBANG=NBANG+1 BANG(NBANG)=PI*ANGR/180 ELSE CALL INPMSG(J,'Out of range [0,90].') OK=.FALSE. ENDIF ELSE CALL INPMSG(J,'Invalid angle value.') OK=.FALSE. ENDIF 380 CONTINUE INEXT=NWORD+1 390 CONTINUE ASET=.TRUE. ELSE CALL INPMSG(I,'Invalid angle specification.') OK=.FALSE. INEXT=I+2 ENDIF ELSEIF(INPCMP(I,'ANG#LE').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') OK=.FALSE. INEXT=I+2 * Number of points. ELSEIF(MAGOK.AND.INPCMP(I,'N-ANG#LES').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) IF(IFAIL1.NE.0)OK=.FALSE. CALL INPRDI(I+1,NBANGR,NBANG) IF(NBANGR.LE.0.OR.NBANGR.GT.MXBANG)THEN CALL INPMSG(I+1,'Value is out of range. ') OK=.FALSE. ELSEIF(NBANGR.GT.1.AND..NOT.MAGOK)THEN CALL INPMSG(I+1,'Not meaningful since B=0. ') OK=.FALSE. ELSE NBANG=NBANGR ENDIF ENDIF ASET=.FALSE. INEXT=I+2 ELSEIF(INPCMP(I,'N-ANG#LES').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') OK=.FALSE. INEXT=I+2 * Range of B field. ELSEIF(MAGOK.AND.INPCMP(I,'B-RAN#GE')+ - INPCMP(I,'MAG#NETIC-F#IELD-RAN#GE')+ - INPCMP(I,'B-F#IELD-RAN#GE').NE.0)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPCHK(I+2,2,IFAIL2) IF(IFAIL1.EQ.0.AND.IFAIL2.EQ.0.AND.NWORD.GE.I+2)THEN CALL INPRDR(I+1,BTMINR,BTABMN/100) CALL INPRDR(I+2,BTMAXR,BTABMX/100) IF(BTMINR.LT.0.OR.BTMAXR.LT.0)THEN IF(BTMINR.LT.0)CALL INPMSG(I+1,'Is not > 0.') IF(BTMAXR.LT.0)CALL INPMSG(I+1,'Is not > 0.') OK=.FALSE. ELSEIF(BTMINR.NE.BTMAXR)THEN BTABMN=100*MIN(BTMINR,BTMAXR) BTABMX=100*MAX(BTMINR,BTMAXR) ELSE CALL INPMSG(I+1,'A zero range is not permitted') CALL INPMSG(I+2,'for the B field range.') OK=.FALSE. ENDIF ELSE CALL INPMSG(I,'Missing or invalid arguments. ') OK=.FALSE. ENDIF INEXT=I+3 ELSEIF(INPCMP(I,'B-RAN#GE')+INPCMP(I,'B-FIELD-RAN#GE').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') CALL INPMSG(I+2,'Has been ignored.') OK=.FALSE. INEXT=I+3 * Listed B fields. ELSEIF(MAGOK.AND.INPCMP(I,'B-FIELD').NE.0)THEN IF(INPTYP(I+1).EQ.0)THEN CALL INPSTR(I+1,I+1,STRING,NCSTR) DO 300 IGLB=1,NGLB IF(STRING(1:NCSTR).EQ.GLBVAR(IGLB))THEN ISLOT=MATSLT(NINT(GLBVAL(IGLB))) IF(GLBMOD(IGLB).NE.5)THEN CALL INPMSG(I+1,'Not of type Matrix.') OK=.FALSE. ELSEIF(ISLOT.LE.0)THEN CALL INPMSG(I+1,'Matrix inaccessible.') OK=.FALSE. ELSEIF(MLEN(ISLOT).GT.MXBTAB)THEN CALL INPMSG(I+1,'More than MXBTAB elements.') OK=.FALSE. ELSE NBTAB=MLEN(ISLOT) DO 320 J=1,NBTAB IF(MVEC(MORG(ISLOT)+J).LE.0)THEN CALL INPMSG(I+1,'Contains values <= 0.') OK=.FALSE. GOTO 310 ELSE BTAB(J)=100*MVEC(MORG(ISLOT)+J) ENDIF 320 CONTINUE BSET=.TRUE. ENDIF GOTO 310 ENDIF 300 CONTINUE CALL INPMSG(I+1,'Not a global variable.') OK=.FALSE. 310 CONTINUE INEXT=I+2 ELSEIF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN NBTAB=0 DO 330 J=I+1,NWORD IF(INPTYP(J).NE.1.AND.INPTYP(J).NE.2)THEN INEXT=J GOTO 340 ELSEIF(NBTAB+1.GT.MXBTAB)THEN CALL INPMSG(J,'Too many values, ignored.') OK=.FALSE. GOTO 330 ENDIF CALL INPCHK(J,2,IFAIL1) IF(IFAIL1.EQ.0)THEN CALL INPRDR(J,BFLDR,0.0) IF(BFLDR.GE.0.0)THEN NBTAB=NBTAB+1 BTAB(NBTAB)=100*BFLDR ELSE CALL INPMSG(J,'Negative values not allowed.') OK=.FALSE. ENDIF ELSE CALL INPMSG(J,'Invalid field value.') OK=.FALSE. ENDIF 330 CONTINUE INEXT=NWORD+1 340 CONTINUE BSET=.TRUE. ELSE CALL INPMSG(I,'Invalid field specification.') OK=.FALSE. INEXT=I+2 ENDIF ELSEIF(INPCMP(I,'B-FIELD').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') OK=.FALSE. INEXT=I+2 * Number of points. ELSEIF(MAGOK.AND.INPCMP(I,'N-B-#FIELD')+ - INPCMP(I,'N-MAG#NETIC-#FIELD').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) IF(IFAIL1.NE.0)OK=.FALSE. CALL INPRDI(I+1,NBTABR,NBTAB) IF(NBTABR.LE.0.OR.NBTABR.GT.MXBTAB)THEN CALL INPMSG(I+1,'Value is out of range. ') OK=.FALSE. ELSEIF(NBTABR.GT.1.AND..NOT.MAGOK)THEN CALL INPMSG(I+1,'Not meaningful since B=0. ') OK=.FALSE. ELSE NBTAB=NBTABR ENDIF ENDIF INEXT=I+2 ELSEIF(INPCMP(I,'N-B-#FIELD')+ - INPCMP(I,'N-MAG#NETIC-#FIELD').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') OK=.FALSE. INEXT=I+2 * Threshold setting. ELSEIF(INPCMP(I,'SST-THRESHOLD').NE.0)THEN IF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,SSTHRR,SSTTHR) IF(IFAIL1.EQ.0.AND.SSTHRR.LE.0)THEN CALL INPMSG(I+1,'Should be > 0.') OK=.FALSE. ELSEIF(IFAIL1.EQ.0)THEN SSTTHR=SSTHRR ENDIF INEXT=I+2 ELSE CALL INPMSG(I,'Takes a numeric argument.') OK=.FALSE. ENDIF * Number of MC collisions. ELSEIF(INPCMP(I,'COLL#ISIONS').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) IF(IFAIL1.NE.0)OK=.FALSE. CALL INPRDI(I+1,NMAXR,5) IF(NMAXR.LE.0)THEN CALL INPMSG(I+1,'Value is out of range. ') OK=.FALSE. ELSE NNMAX=NMAXR ENDIF ENDIF INEXT=I+2 * Mobility. ELSEIF(INPCMP(I,'ION-MOB#ILITY')+ - INPCMP(I,'MOB#ILITY').NE.0)THEN IF(I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPSTR(I+1,I+1,STRING,NCMOB) ENDIF INEXT=I+2 * Other options are not known. ELSE CALL INPMSG(I,'Not a recognised keyword. ') OK=.FALSE. ENDIF 20 CONTINUE *** Dump error messages. CALL INPERR *** Check whether we have to continue or not. IF(JFAIL.EQ.2.AND..NOT.OK)THEN PRINT *,' ###### GASBMC ERROR : Magboltz not called'// - ' because of the above errors.' IFAIL=1 NGAS=0 CALL PROEND RETURN ELSEIF(JFAIL.EQ.3.AND..NOT.OK)THEN PRINT *,' ###### GASBMC ERROR : Program terminated'// - ' because of the above errors.' IFAIL=1 NGAS=0 CALL PROEND CALL QUIT RETURN ENDIF *** Progress printing. CALL PROFLD(1,'Initialisation',-1.0) CALL PROSTA(1,0.0) *** Set the scale of the E/p points. IF(NGAS.GT.1.AND..NOT.ESET)THEN DO 30 I=1,NGAS IF(EPLOG)THEN EGAS(I)=EPMIN*(EPMAX/EPMIN)** - (REAL(I-1)/REAL(MAX(1,NGAS-1))) ELSE EGAS(I)=EPMIN+(EPMAX-EPMIN)* - (REAL(I-1)/REAL(MAX(1,NGAS-1))) ENDIF 30 CONTINUE ELSEIF(.NOT.ESET)THEN IF(EPLOG)THEN EGAS(1)=SQRT(EPMIN*EPMAX) ELSE EGAS(1)=(EPMIN+EPMAX)/2 ENDIF ENDIF *** Compute the E-B angles. IF(NBANG.GT.1.AND..NOT.ASET)THEN DO 40 J=1,NBANG BANG(J)=BANGMN+REAL(J-1)*(BANGMX-BANGMN)/REAL(NBANG-1) 40 CONTINUE ELSEIF(.NOT.ASET)THEN BANG(1)=(BANGMN+BANGMX)/2 ENDIF *** Compute the B field strengths. IF(NBTAB.GT.1.AND..NOT.BSET)THEN DO 50 J=1,NBTAB BTAB(J)=(BTABMN+REAL(J-1)*(BTABMX-BTABMN)/REAL(NBTAB-1)) 50 CONTINUE ELSEIF(.NOT.BSET)THEN BTAB(1)=(BTABMN+BTABMX)/2 ENDIF *** Renormalise the fractions. FRTOT=0.0 DO 60 I=1,MXGNAM IF(FRAMIX(I).LT.0)FRAMIX(I)=0.0 FRTOT=FRTOT+FRAMIX(I) 60 CONTINUE IF(FRTOT.LE.0.0)THEN PRINT *,' !!!!!! GASBMC WARNING : Please have at least'// - ' one gas in your mixture; nothing done.' NGAS=0 IFAIL=1 RETURN ELSE DO 70 I=1,MXGNAM FRAMIX(I)=100*FRAMIX(I)/FRTOT GASFRM(I)=FRAMIX(I) 70 CONTINUE ENDIF *** Name of the mixture. STR=' ' NC=0 * Loop over the gases. DO 80 I=1,MXGNAM * Skip gases that are absent. IF(FRAMIX(I).LE.0)GOTO 80 * Format the percentage. CALL OUTFMT(REAL(FRAMIX(I)),2,OUTSTR,NCOUT,'LEFT') * Hydrogen and Deuterium. IF(I.EQ.21)THEN STR(NC+1:NC+6+NCOUT)='H2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.22)THEN STR(NC+1:NC+6+NCOUT)='D2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Helium 3 and 4. ELSEIF(I.EQ.3)THEN STR(NC+1:NC+18+NCOUT)='isotropic He-4 '//OUTSTR(1:NCOUT)// - '%, ' NC=NC+18+NCOUT ELSEIF(I.EQ.4)THEN STR(NC+1:NC+18+NCOUT)='isotropic He-3 '//OUTSTR(1:NCOUT)// - '%, ' NC=NC+18+NCOUT ELSEIF(I.EQ.45)THEN STR(NC+1:NC+8+NCOUT)='He-4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.44)THEN STR(NC+1:NC+8+NCOUT)='He-3 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Neon. ELSEIF(I.EQ.5)THEN STR(NC+1:NC+16+NCOUT)='isotropic Ne '//OUTSTR(1:NCOUT)// - '%, ' NC=NC+16+NCOUT ELSEIF(I.EQ.46)THEN STR(NC+1:NC+6+NCOUT)='Ne '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Argon. ELSEIF(I.EQ.2)THEN STR(NC+1:NC+16+NCOUT)='isotropic Ar '//OUTSTR(1:NCOUT)// - '%, ' NC=NC+16+NCOUT ELSEIF(I.EQ.47)THEN STR(NC+1:NC+6+NCOUT)='Ar '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Krypton. ELSEIF(I.EQ.6)THEN STR(NC+1:NC+16+NCOUT)='isotropic Kr '//OUTSTR(1:NCOUT)// - '%, ' NC=NC+16+NCOUT ELSEIF(I.EQ.48)THEN STR(NC+1:NC+6+NCOUT)='Kr '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Xenon. ELSEIF(I.EQ.7)THEN STR(NC+1:NC+16+NCOUT)='isotropic Xe '//OUTSTR(1:NCOUT)// - '%, ' NC=NC+16+NCOUT ELSEIF(I.EQ.49)THEN STR(NC+1:NC+6+NCOUT)='Xe '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Methane. ELSEIF(I.EQ.8)THEN STR(NC+1:NC+7+NCOUT)='CH4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * Deuterium methane, silane and germane. ELSEIF(I.EQ.41)THEN STR(NC+1:NC+7+NCOUT)='CD4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.59)THEN STR(NC+1:NC+8+NCOUT)='GeH4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.60)THEN STR(NC+1:NC+8+NCOUT)='SiH4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Ethane. ELSEIF(I.EQ.9)THEN STR(NC+1:NC+8+NCOUT)='C2H6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Ethene. ELSEIF(I.EQ.19)THEN STR(NC+1:NC+8+NCOUT)='C2H4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Acetylene. ELSEIF(I.EQ.20)THEN STR(NC+1:NC+8+NCOUT)='C2H2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Propane. ELSEIF(I.EQ.10)THEN STR(NC+1:NC+8+NCOUT)='C3H8 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Propene. ELSEIF(I.EQ.32)THEN STR(NC+1:NC+9+NCOUT)='C3H6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * n-Butane and Isobutane. ELSEIF(I.EQ.11)THEN STR(NC+1:NC+10+NCOUT)='iC4H10 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT ELSEIF(I.EQ.56)THEN STR(NC+1:NC+10+NCOUT)='nC4H10 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT * neo-Pentane and n-Pentane. ELSEIF(I.EQ.13)THEN STR(NC+1:NC+12+NCOUT)='neoC5H12 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+12+NCOUT ELSEIF(I.EQ.57)THEN STR(NC+1:NC+10+NCOUT)='nC5H12 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT * Nitrogen. ELSEIF(I.EQ.16)THEN STR(NC+1:NC+16+NCOUT)='isotropic N2 '//OUTSTR(1:NCOUT)// - '%, ' NC=NC+16+NCOUT ELSEIF(I.EQ.58)THEN STR(NC+1:NC+6+NCOUT)='N2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Water vapour. ELSEIF(I.EQ.14)THEN STR(NC+1:NC+7+NCOUT)='H2O '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * Carbon monoxide and dioxide. ELSEIF(I.EQ.23)THEN STR(NC+1:NC+6+NCOUT)='CO '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.12)THEN STR(NC+1:NC+7+NCOUT)='CO2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * Methylal. ELSEIF(I.EQ.24)THEN STR(NC+1:NC+10+NCOUT)='C3H8O2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT * Sulphur compounds. ELSEIF(I.EQ.39)THEN STR(NC+1:NC+7+NCOUT)='CS2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.40)THEN STR(NC+1:NC+7+NCOUT)='COS '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.55)THEN STR(NC+1:NC+7+NCOUT)='H2S '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * SF6. ELSEIF(I.EQ.30)THEN STR(NC+1:NC+7+NCOUT)='SF6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * NH3. ELSEIF(I.EQ.31)THEN STR(NC+1:NC+7+NCOUT)='NH3 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * Freons (Freon 14, 23, Zyron 116N5) and related compounds. ELSEIF(I.EQ.1)THEN STR(NC+1:NC+7+NCOUT)='CF4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.29)THEN STR(NC+1:NC+8+NCOUT)='C2F6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.42)THEN STR(NC+1:NC+7+NCOUT)='BF3 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.43)THEN STR(NC+1:NC+16+NCOUT)= - 'C2F4H2/C2HF5 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+16+NCOUT ELSEIF(I.EQ.50)THEN STR(NC+1:NC+8+NCOUT)='CHF3 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.51)THEN STR(NC+1:NC+9+NCOUT)='CF3Br '//OUTSTR(1:NCOUT)//'%, ' NC=NC+9+NCOUT ELSEIF(I.EQ.52)THEN STR(NC+1:NC+8+NCOUT)='C3F8 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Cesium and Mercury. ELSEIF(I.EQ.37)THEN STR(NC+1:NC+6+NCOUT)='Cs '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Cesium and Mercury. ELSEIF(I.EQ.54)THEN STR(NC+1:NC+6+NCOUT)='Hg '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Oxygen and Ozone. ELSEIF(I.EQ.15)THEN STR(NC+1:NC+6+NCOUT)='O2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.53)THEN STR(NC+1:NC+6+NCOUT)='O3 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Fluorine. ELSEIF(I.EQ.38)THEN STR(NC+1:NC+6+NCOUT)='F2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Nitrous and nitric oxide. ELSEIF(I.EQ.17)THEN STR(NC+1:NC+6+NCOUT)='NO '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.18)THEN STR(NC+1:NC+7+NCOUT)='N2O '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * DME. ELSEIF(I.EQ.25)THEN STR(NC+1:NC+7+NCOUT)='DME '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * Alcohols. ELSEIF(I.EQ.34)THEN STR(NC+1:NC+9+NCOUT)='CH3OH '//OUTSTR(1:NCOUT)//'%, ' NC=NC+9+NCOUT ELSEIF(I.EQ.35)THEN STR(NC+1:NC+10+NCOUT)='C2H5OH '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT ELSEIF(I.EQ.36)THEN STR(NC+1:NC+10+NCOUT)='C3H7OH '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT * Reid step, Reid ramp and Maxwell model. ELSEIF(I.EQ.26)THEN STR(NC+1:NC+13+NCOUT)='Reid-step '//OUTSTR(1:NCOUT)//'%, ' NC=NC+13+NCOUT ELSEIF(I.EQ.28)THEN STR(NC+1:NC+13+NCOUT)='Reid-ramp '//OUTSTR(1:NCOUT)//'%, ' NC=NC+13+NCOUT ELSEIF(I.EQ.27)THEN STR(NC+1:NC+11+NCOUT)='Maxwell '//OUTSTR(1:NCOUT)//'%, ' NC=NC+11+NCOUT * Obsolete components. ELSE STR(NC+1:NC+7+NCOUT)='??? '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ENDIF * Next component. 80 CONTINUE * Gas temperature. CALL OUTFMT(TGAS,2,OUTSTR,NCOUT,'LEFT') STR(NC+1:NC+NCOUT+6)='T='//OUTSTR(1:NCOUT)//' K, ' NC=NC+NCOUT+6 * Gas pressure. CALL OUTFMT(PGAS/760.0,2,OUTSTR,NCOUT,'LEFT') STR(NC+1:NC+NCOUT+6)='p='//OUTSTR(1:NCOUT)//' atm' NC=NC+NCOUT+6 * Copy to the gas identifier. IF(NC.GT.LEN(GASID))THEN GASID=STR(1:NC-2)//'...' NC=LEN(GASID) ELSE GASID=STR(1:NC) ENDIF *** Debugging output. IF(LDEBUG)THEN WRITE(LUNOUT,'('' ++++++ GASBMC DEBUG : Mixing the'', - '' following gases:''// - '' CF4 '',F6.3,'' Argon '',F6.3/ - '' Helium 4 '',F6.3,'' Helium 3 '',F6.3/ - '' Neon '',F6.3,'' Krypton '',F6.3/ - '' Xenon '',F6.3,'' CH4 '',F6.3/ - '' C2H6 '',F6.3,'' C3H8 '',F6.3/ - '' iso-C4H10 '',F6.3,'' CO2 '',F6.3/ - '' neo-C5H12 '',F6.3,'' H2O '',F6.3/ - '' Oxygen '',F6.3,'' Nitrogen '',F6.3/ - '' NO '',F6.3,'' N2O '',F6.3/ - '' C2H4 '',F6.3,'' C2H2 '',F6.3/ - '' Hydrogen '',F6.3,'' Deuterium '',F6.3/ - '' CO '',F6.3,'' Methylal '',F6.3/ - '' DME '',F6.3,'' Reid step '',F6.3/ - '' Maxwell '',F6.3,'' Reid ramp '',F6.3/ - '' C2F6 '',F6.3,'' SF6 '',F6.3/ - '' NH3 '',F6.3,'' C3H6 '',F6.3/ - '' cyclo-C3H6 '',F6.3,'' CH3OH '',F6.3/ - '' C2H5OH '',F6.3,'' C3H7OH '',F6.3/ - '' Cs '',F6.3,'' F '',F6.3/ - '' CS2 '',F6.3,'' COS '',F6.3/ - '' CD4 '',F6.3,'' BF3 '',F6.3/ - '' C2F4H2 '',F6.3,'' He 3 aniso '',F6.3/ - '' He 4 aniso '',F6.3,'' Ne aniso '',F6.3/ - '' Ar aniso '',F6.3,'' Kr aniso '',F6.3/ - '' Xe aniso '',F6.3,'' CHF3 '',F6.3/ - '' CF3Br '',F6.3,'' C3F8 '',F6.3/ - '' O3 '',F6.3,'' Mercury '',F6.3/ - '' H2S '',F6.3,'' n-C4H10 '',F6.3/ - '' n-C5H12 '',F6.3,'' N2 '',F6.3/ - '' GeH4 '',F6.3,'' SiH4 '',F6.3)') - (0.01*REAL(FRAMIX(I)),I=1,60) WRITE(LUNOUT,'('' With the following parameters:''// - '' E/p range: '',2F10.3, - '' V/cm.Torr''/ - '' Number of E/p points: '',I6/ - '' Magnetic field range: '',2F10.3,'' T''/ - '' Number of B field points: '',I6/ - '' angle(E,B) range: '',2F10.3, - '' degrees''/ - '' Number of (E,B) points: '',I6/ - '' Pressure of the gas: '',F10.3,'' Torr''/ - '' Temperature of the gas: '',F10.3,'' K'')') - EPMIN,EPMAX,NGAS,BTABMN/100,BTABMX/100,NBTAB, - 180*BANGMN/PI,180*BANGMX/PI,NBANG,PGAS,TGAS WRITE(LUNOUT,'('' Accuracy settings: '')') WRITE(LUNOUT,'('' SST threshold: '',F10.3,'' 1/cm'')') - SSTTHR WRITE(LUNOUT,'('' MC iterations: '',I5)') NNMAX WRITE(LUNOUT,'('' Identifier: '',A)') GASID(1:NC) ENDIF *** Compute the mobilities for the various points. IF(NCMOB.GT.0)THEN CALL PROFLD(1,'Adding mobility',-1.0) CALL PROSTA(1,0.0) * Call editor of specified as @. IF(INDEX(STRING(1:NCMOB),'@').NE.0)THEN NRES=1 CALL ALGEDT(VARLIS,1,IENTRY,USE,NRES) IFAIL1=0 * Usual function translation if not. ELSE CALL ALGPRE(STRING,NCMOB,VARLIS,1,NRES,USE,IENTRY, - IFAIL1) ENDIF * Check return code of translation. IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASBMC WARNING : Ion mobility'// - ' function rejected; no ion mobility in table.' CALL ALGCLR(IENTRY) NCMOB=0 ENDIF * Check number of results returned by the function. IF(NRES.NE.1)THEN PRINT *,' !!!!!! GASBMC WARNING : Number of'// - ' results returned by the mobility function'// - ' is not 1; rejected.' CALL ALGCLR(IENTRY) NCMOB=0 ENDIF * Evaluate. DO 90 I=1,NGAS VAR(1)=EGAS(I) MODVAR(1)=2 CALL ALGEXE(IENTRY,VAR,MODVAR,1,RES,MODRES,1,IFAIL1) MGAS(I)=RES(1) DO 100 J=1,NBANG DO 110 K=1,NBTAB MGAS2(I,J,K)=RES(1) 110 CONTINUE 100 CONTINUE 90 CONTINUE * Clear the mobility entry point - no longer needed. CALL ALGCLR(IENTRY) * Dump algebra error messages. CALL ALGERR ENDIF *** Reset frequencies NEXGAS=0 NIOGAS=0 *** Fill the gas tables, first with a magnetic field. IF(MAGOK)THEN * Header. TAB2D = .TRUE. IF(LDEBUG)PRINT *,' ++++++ GASBMC DEBUG : Preparing a'// - ' 3D table.' * Loop over the B fields. CALL PRORED(3) CALL PROFLD(1,'B-field',REAL(NBTAB)) DO 120 K=1,NBTAB CALL PROSTA(1,REAL(K)) * Loop over the angles. CALL PROFLD(2,'angle(E,B)',REAL(NBANG)) DO 130 J=1,NBANG CALL PROSTA(2,REAL(J)) ** Loop over the electric field. CALL PROFLD(3,'E-field',REAL(NGAS)) DO 140 I=1,NGAS * Progress printing. CALL PROSTA(3,REAL(I)) C print *,' Starting for:' C print *,' E = ',EGAS(I)*PGAS C print *,' B = ',BTAB(K)/100,' T' C print *,' angle = ',180*BANG(J)/PI,' degrees' * Run Magboltz. CALL GASB7(DBLE(EGAS(I)*PGAS),DBLE(BTAB(K)/10), - DBLE(180*BANG(J)/PI),DBLE(TGAS),DBLE(PGAS), - DBLE(SSTTHR),NNMAX,IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! GASBMC WARNING : Running'// - ' Magboltz 7 for E/p=',EGAS(I), - ' angle=',180*BANG(J)/PI,' failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF * Plot distribution function if requested. IF(LF0PLT)CALL F0PLT7(GASID) * Plot cross sections if requested. IF(LCSPLT)CALL GASPCS(GASID) * Keep cross sections and distribution function if requested. IF(LGKEEP)CALL GASSAV * Output the transport results. CALL OUTB7(VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL,SBOL) VGAS2(I,J,K)=VBOL XGAS2(I,J,K)=XBOL YGAS2(I,J,K)=YBOL WGAS2(I,J,K)=WBOL DGAS2(I,J,K)=DBOL OGAS2(I,J,K)=OBOL AGAS2(I,J,K)=ABOL AORIG2(I,J,K)=ABOL BGAS2(I,J,K)=BBOL DO 150 L=1,6 SGAS2(I,J,K,L)=SBOL(L) 150 CONTINUE * Output the frequencies CALL OUTEI7(EXBOL,IOBOL) DO 151 L=1,NEXGAS EXGAS2(I,J,K,L)=EXBOL(L) 151 CONTINUE DO 152 L=1,NIOGAS IOGAS2(I,J,K,L)=IOBOL(L) 152 CONTINUE * Next E field. 140 CONTINUE * Next angle. 130 CONTINUE * Next B field 120 CONTINUE * Transfer the data from the VGAS2 etc to VGAS. IF(NBANG.EQ.1.AND.NBTAB.EQ.1)THEN PRINT *,' ------ GASBMC MESSAGE : The table is'// - ' 1-dimensional even though B/=0.' TAB2D=.FALSE. DO 160 I=1,NGAS VGAS(I)=VGAS2(I,1,1) XGAS(I)=XGAS2(I,1,1) YGAS(I)=YGAS2(I,1,1) DGAS(I)=DGAS2(I,1,1) AGAS(I)=AGAS2(I,1,1) AORIG(I)=AGAS2(I,1,1) BGAS(I)=BGAS2(I,1,1) OGAS(I)=OGAS2(I,1,1) WGAS(I)=WGAS2(I,1,1) DO 170 L=1,6 SGAS(I,L)=SGAS2(I,1,1,L) 170 CONTINUE 160 CONTINUE ENDIF ** If there is no magnetic field. ELSE CALL PRORED(1) CALL PROFLD(1,'Electric field',REAL(NGAS)) * First fill the 2 dimensional arrays as for the B field case. NBANG=1 IF(LDEBUG)PRINT *,' ++++++ GASBMC DEBUG : Preparing a'// - ' 1D table.' * Loop over the electric field. CALL PROFLD(1,'Electric field',REAL(NGAS)) DO 180 I=1,NGAS * Progress printing. CALL PROSTA(1,REAL(I)) * Run Magboltz. C print *,' Starting for:' C print *,' E = ',EGAS(I)*PGAS CALL GASB7(DBLE(EGAS(I)*PGAS),0.0D0,0.0D0,DBLE(TGAS), - DBLE(PGAS),DBLE(SSTTHR),NNMAX,IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! GASBMC WARNING : Running'// - ' Magboltz 7 for E/p=',EGAS(I),' failed;'// - ' no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF * Plot distribution function if requested. IF(LF0PLT)CALL F0PLT7(GASID) * Plot cross sections if requested. IF(LCSPLT)CALL GASPCS(GASID) * Keep cross sections and distribution function if requested. IF(LGKEEP)CALL GASSAV * Output the results. CALL OUTB7(VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL,SBOL) VGAS(I)=VBOL XGAS(I)=XBOL YGAS(I)=YBOL WGAS(I)=WBOL DGAS(I)=DBOL OGAS(I)=OBOL AGAS(I)=ABOL AORIG(I)=ABOL BGAS(I)=BBOL DO 190 L=1,6 SGAS(I,L)=SBOL(L) 190 CONTINUE * Output the frequencies CALL OUTEI7(EXBOL,IOBOL) DO 191 L=1,MXEXG EXGAS(I,L)=EXBOL(L) 191 CONTINUE DO 192 L=1,MXIOG IOGAS(I,L)=IOBOL(L) 192 CONTINUE * Next E field. 180 CONTINUE * Declare the table to be 1-dimensional. TAB2D=.FALSE. ENDIF * End of progress printing. CALL PROEND * Check error flags. IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! GASBMC WARNING : Computing the transport'// - ' properties failed ; no gas tables.' RETURN ENDIF *** Set the GASOK flags. GASOK(1)=.TRUE. IF(NCMOB.GT.0)THEN GASOK(2)=.TRUE. ELSE GASOK(2)=.FALSE. ENDIF GASOK(3)=.TRUE. GASOK(4)=.TRUE. GASOK(6)=.TRUE. IF(MAGOK)THEN GASOK(7)=.TRUE. GASOK(9)=.TRUE. GASOK(10)=.TRUE. ELSE GASOK(7)=.FALSE. GASOK(9)=.FALSE. GASOK(10)=.FALSE. ENDIF GASOK(8)=.TRUE. GASOK(11)=.TRUE. GASOK(15)=.TRUE. GASOK(16)=.TRUE. *** Interpolation flags. IVMETH=2 IMMETH=2 IDMETH=2 IOMETH=2 IAMETH=2 IBMETH=2 IWMETH=2 IEMETH=2 IZMETH=2 *** Extrapolation flags. IF(NGAS.LE.1)THEN IVEXTR=0 IMEXTR=0 IDEXTR=0 IAEXTR=0 IBEXTR=0 IWEXTR=0 IOEXTR=0 IEEXTR=0 IZEXTR=0 JVEXTR=0 JMEXTR=0 JDEXTR=0 JAEXTR=0 JBEXTR=0 JWEXTR=0 JOEXTR=0 JEEXTR=0 JZEXTR=0 ENDIF *** Record CPU time used. CALL TIMLOG('Magboltz gas mixing: ') END +DECK,OUTB7. SUBROUTINE OUTB7(VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL,SBOL) *----------------------------------------------------------------------- * OUTB7 - Extracts the results from Magboltz. * (Last changed on 22/ 9/05.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBOUT. +SEQ,INPT. REAL VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL,SBOL(6) *** Velocity. VBOL=MAX(0.0,REAL(WZ*1D-6)) XBOL=REAL(WX*1D-6) YBOL=REAL(WY*1D-6) *** Lorentz angle. WBOL=REAL(ATAN2(SQRT(WX**2+WY**2),WZ)) *** Diffusion: longitudinal, DBOL=SQRT(2D-6*DIFZZ*TORR/VBOL) * transverse, OBOL=SQRT(2D-6*0.5*(DIFXX+DIFYY)*TORR/VBOL) * tensor. SBOL(1)=2D-6*DIFZZ*TORR/VBOL SBOL(2)=2D-6*DIFXX*TORR/VBOL SBOL(3)=2D-6*DIFYY*TORR/VBOL SBOL(4)=2D-6*DIFXZ*TORR/VBOL SBOL(5)=2D-6*DIFYZ*TORR/VBOL SBOL(6)=2D-6*DIFXY*TORR/VBOL *** Townsend coefficient. IF(ALPHA.GT.0)THEN ABOL=REAL(LOG(ALPHA/TORR)) ELSE ABOL=-30 ENDIF *** Attachment coefficient. IF(ATT.GT.0)THEN BBOL=REAL(LOG(ATT/TORR)) ELSE BBOL=-30 ENDIF END +DECK,GASIDE. SUBROUTINE GASIDE(IEXC,ID,IFAIL) *----------------------------------------------------------------------- * GASIDE - Returns the excitation number for a string. * (Last changed on 2/ 8/10.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,GASDATA. +SEQ,PRINTPLOT. INTEGER IEXC,IFAIL,I,J,K CHARACTER*45 ID *** See whether we already have this one DO 10 I=1,NEXGAS IF(DSCEXG(I).EQ.ID)THEN IEXC=I IFAIL=0 RETURN ENDIF 10 CONTINUE *** Otherwise try and add IF(NEXGAS.LT.MXEXG)THEN NEXGAS=NEXGAS+1 DSCEXG(NEXGAS)=ID PENPRB(NEXGAS)=0 PENRMS(NEXGAS)=0 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASIDE DEBUG :'', - '' Added excitation '',A,''.'')') ID IEXC=NEXGAS DO 140 K=1,MXBTAB DO 130 J=1,MXBANG DO 120 I=1,MXLIST EXGAS2(I,J,K,IEXC)=0 120 CONTINUE 130 CONTINUE 140 CONTINUE DO 150 I=1,MXLIST EXGAS(I,IEXC)=0 150 CONTINUE IFAIL=0 ELSE PRINT *,' !!!!!! GASIDE WARNING : No room to store an'// - ' excitation level; increase MXEXG.' IEXC=0 IFAIL=1 ENDIF END +DECK,GASIDI. SUBROUTINE GASIDI(IION,ID,IFAIL) *----------------------------------------------------------------------- * GASIDI - Returns the ionisation number for a string. * (Last changed on 25/ 6/09.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,GASDATA. +SEQ,PRINTPLOT. INTEGER IION,IFAIL,I,J,K CHARACTER*45 ID *** See whether we already have this one DO 10 I=1,NIOGAS IF(DSCIOG(I).EQ.ID)THEN IION=I IFAIL=0 RETURN ENDIF 10 CONTINUE *** Otherwise try and add IF(NIOGAS.LT.MXIOG)THEN NIOGAS=NIOGAS+1 DSCIOG(NIOGAS)=ID IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASIDI DEBUG :'', - '' Added ionisation '',A,''.'')') ID IION=NIOGAS DO 140 K=1,MXBTAB DO 130 J=1,MXBANG DO 120 I=1,MXLIST IOGAS2(I,J,K,IION)=0 120 CONTINUE 130 CONTINUE 140 CONTINUE DO 150 I=1,MXLIST IOGAS(I,IION)=0 150 CONTINUE IFAIL=0 ELSE PRINT *,' !!!!!! GASIDI WARNING : No room to store an'// - ' ionisation level; increase MXIOG.' IION=0 IFAIL=1 ENDIF END +DECK,GASIDO. SUBROUTINE GASIDO(IEXC,ID,ITYPE,DE,IFAIL) *----------------------------------------------------------------------- * GASIDO - Returns the cross section number for a string composed of * the gas name and the Magboltz description. * (Last changed on 29/ 6/09.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,GASDATA. +SEQ,PRINTPLOT. INTEGER IEXC,IFAIL,ITYPE,I REAL DE CHARACTER*45 ID *** Look to see whether we already have this one DO 10 I=1,NCSGAS IF(DSCCSG(I).EQ.ID)THEN IEXC=I IFAIL=0 RETURN ENDIF 10 CONTINUE *** If not, see whether we've room to add it. IF(NCSGAS.LT.MXCSG)THEN NCSGAS=NCSGAS+1 DSCCSG(NCSGAS)=ID ICSTYP(NCSGAS)=ITYPE ELOSCS(NCSGAS)=DE IEXC=NCSGAS IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASIDO DEBUG :'', - '' Cross section "'',A,''" of type '',I1,'' is given'', - '' reference '',I3,''.'')') ID,ITYPE,IEXC IFAIL=0 ELSE PRINT *,' !!!!!! GASIDO WARNING : Ran out of storage'// - ' for cross section terms.' IEXC=0 IFAIL=1 ENDIF END +DECK,GASEXU. SUBROUTINE GASEXU(ITYPE,IGAS,ISTATE, - XPOS,YPOS,ZPOS,ENERGY,TIME, - ADDNEW,XNEW,YNEW,ZNEW,DELAY,ENEW) *----------------------------------------------------------------------- * GASEXU - User procedure to deal with excitations. * (Last changed on 2/ 8/10.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,SCRIP. +SEQ,NAMES. +SEQ,DIMENSIONS. +SEQ,GASDATA. LOGICAL ADDNEW INTEGER ITYPE,IGAS,ISTATE,IREF,IFAIL1,I,IION REAL XPOS,YPOS,ZPOS,ENERGY,TIME,ELOSS,XNEW,YNEW,ZNEW,DELAY, - RNDUNI,RNDNOR,RNDEXP,ENEW CHARACTER*45 NEWID EXTERNAL RNDUNI,RNDNOR,RNDEXP *** Initial value. ADDNEW=.FALSE. *** Skip inelastic collisions (vibrations, rotations, polyads) IF(DSCRPT(ISTATE)(1:4).NE.' EXC')RETURN *** Identify the cross section. C print *,' ### Excitation: ',NAMEG(IGAS)//DSCRPT(ISTATE) CALL GASTTR(NAMEG(IGAS)//DSCRPT(ISTATE),NEWID,ELOSS) CALL GASIDE(IREF,NEWID,IFAIL1) C print *,' Short name: ',NEWID,', Reference: ',IREF IF(IFAIL1.NE.0.OR.IREF.LE.0.OR.IREF.GT.NEXGAS)THEN PRINT *,' !!!!!! GASEXU WARNING : Lookup for excitation '// - NAMEG(IGAS)//DSCRPT(ISTATE)//' failed; not processed.' RETURN ENDIF *** Decide whether to add electrons. IF(PENPRB(IREF).GE.RNDUNI(1.0))THEN C print *,' Penning rate: ',penprb(iref) ADDNEW=.TRUE. XNEW=RNDNOR(XPOS,PENRMS(IREF)) YNEW=RNDNOR(YPOS,PENRMS(IREF)) ZNEW=RNDNOR(ZPOS,PENRMS(IREF)) DELAY=RNDEXP(PENDT(IREF)) * Identify a suitable component to ionise IION=-1.0 DO 10 I=1,NIOGAS IF(ENIOG(I).LT.ELOSS)THEN IF(IION.GT.0)THEN PRINT *,' !!!!!! GASEXU WARNING : More than one'// - ' ionisation candidate; picking '// - DSCIOG(IION)//' and ignoring '//DSCIOG(I) ELSE ENEW=ELOSS-ENIOG(I) IION=I C print *,' Candidate recipient: ',DSCIOG(I), C - ' Ionisation energy: ',eniog(i), C - ' Excitation energy: ',eloss ENDIF ENDIF 10 CONTINUE ENDIF END +DECK,GASLEX. SUBROUTINE GASLEX(IFAIL) *----------------------------------------------------------------------- * GASLEX - Extracts all excitations and ionisations. * (Last changed on 29/ 6/09.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,CNSTS. +SEQ,INPT. +SEQ,NAMES. +SEQ,RATIO. +SEQ,GASN. +SEQ,PRINTPLOT. CHARACTER*15 NAME CHARACTER*30 SCRPT(226) CHARACTER*80 GASID DOUBLE PRECISION Q(6,2048),QIN(220,2048),E(6),EI(220), - PEQEL(6,2048),PEQIN(220,2048),VIRIAL,EB REAL PGAS,TGAS,GASFRM(MXGNAM),GASSUM INTEGER KIN(220),KEL(6),NIN,I,J,IFAIL,IREF,IFAIL1,IFAIL2, - IFAIL3,IFAIL4,IFAIL5,IFAIL6 *** Retrieve pressure and temperature. CALL GASINF(PGAS,TGAS,GASID,GASFRM) *** Loop over all gases GASSUM=0 DO 10 I=1,MXGNAM IF(GASFRM(I).LE.0)GOTO 10 GASSUM=GASSUM+GASFRM(I) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASLEX DEBUG : Gas '',I3, - '' has fraction '',F10.3)') I,GASFRM(I) * Pressure and temperature. TEMPC=20.0 TORR=760.0 * Set a final energy such that all excitations are present. EFINAL=1000.0 * Density correction factors. AKT=(ABZERO+TEMPC)*BOLTZ * Store the gas mixing data. NGAS=1 FRAC(1)=100.0 NGASN(1)=I * Retrieve the gas data (1 is not a specific cross section). CALL GETGAS(I,Q,QIN,NIN,E,EI,NAME,VIRIAL,EB,PEQEL,PEQIN, - KEL,KIN,SCRPT) * The elastic term is entry 2. CALL GASIDO(IREF,NAME//SCRPT(2),1,REAL(E(2)),IFAIL1) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASLEX DEBUG :'', - '' Elastic: '',A,'' (Eloss = '',E12.5,'' eV)'')') - SCRPT(2),E(2) * The ionisation is at entry 3. CALL GASIDO(IREF,NAME//SCRPT(3),2,REAL(E(3)),IFAIL2) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASLEX DEBUG :'', - '' Ionisation: '',A,'' (Eloss = '',E12.5,'' eV)'')') - SCRPT(3),E(3) * The attachment is at entry 4. CALL GASIDO(IREF,NAME//SCRPT(4),3,REAL(E(4)),IFAIL3) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASLEX DEBUG :'', - '' Attachment: '',A,'' (Eloss = '',E12.5,'' eV)'')') - SCRPT(4),E(4) * The inelastic, super-elastic + excitations are in 6+I, I=1,NIN. DO 20 J=1,NIN IF(SCRPT(6+J)(1:4).NE.' EXC'.AND.EI(J).GT.0)THEN CALL GASIDO(IREF,NAME//SCRPT(6+J),4,REAL(EI(J)),IFAIL4) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASLEX DEBUG :'', - '' Inelastic: '',A,'' (Eloss = '',E12.5,'' eV)'')') - SCRPT(6+J),EI(J) ELSEIF(SCRPT(6+J)(1:4).NE.' EXC')THEN CALL GASIDO(IREF,NAME//SCRPT(6+J),5,REAL(EI(J)),IFAIL5) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASLEX DEBUG :'', - '' Super-elastic: '',A,'' (Eloss = '',E12.5,'' eV)'')') - SCRPT(6+J),EI(J) ELSE CALL GASIDO(IREF,NAME//SCRPT(6+J),6,REAL(EI(J)),IFAIL6) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASLEX DEBUG :'', - '' Excitation: '',A,'' (Eloss = '',E12.5,'' eV)'')') - SCRPT(6+J),EI(J) ENDIF 20 CONTINUE * Check error flags. IF(IFAIL1.NE.0.OR.IFAIL2.NE.0.OR.IFAIL3.NE.0.OR.IFAIL4.NE.0.OR. - IFAIL5.NE.0.OR.IFAIL6.NE.0)THEN PRINT *,' !!!!!! GASLEX WARNING : Error storing a cross'// - ' section term; abandoning.' IFAIL=1 RETURN ENDIF * Next gas 10 CONTINUE *** Check that there is a gas. IF(GASSUM.LE.0)THEN PRINT *,' !!!!!! GASLEX WARNING : Gas composition does'// - ' not contain a single element; table empty.' IFAIL=1 ELSE IFAIL=0 ENDIF END +DECK,OUTEI7. SUBROUTINE OUTEI7(EXBOL,IOBOL) *----------------------------------------------------------------------- * OUTEI7 - Extracts the ionisation/excitation rates from Magboltz. * (Last changed on 25/ 8/09.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,SETP. +SEQ,TTRM. +SEQ,INPT. +SEQ,OUTPT. +SEQ,SCRIP. +SEQ,LARGE. +SEQ,NAMES. +SEQ,DIMENSIONS. +SEQ,PRINTPLOT. REAL EXBOL(MXEXG),IOBOL(MXIOG),FREQ,FRELV,ERRFRE INTEGER NREAL,I,J,IEXC,IION,IFAIL *** Initialise the vectors DO 30 I=1,MXEXG EXBOL(I)=0 30 CONTINUE DO 40 I=1,MXIOG IOBOL(I)=0 40 CONTINUE *** Number of collisions and frequency scaling factor. IF(TTOTS.EQ.0.0D0) THEN NREAL=NMAX TTOTS=ST ELSE NREAL=INT(XID) ENDIF FREQ=REAL(NREAL)/TTOTS *** Loop over the gases and states, selecting DO 10 I=1,NGAS DO 20 J=1,IPLAST IF(IARRY(J).LE.5*I .AND. IARRY(J).GT.5*(I-1))THEN ** Compute the rates. FRELV=FREQ*ICOLN(J)/NREAL IF(ICOLN(J).EQ.0) THEN ERRFRE=0.0 ELSE ERRFRE=100.0/SQRT(REAL(ICOLN(J))) ENDIF ** Select the excitation frequencies IF(DSCRPT(J)(1:4).EQ.' EXC')THEN * Identify and store the rate. CALL GASIDE(IEXC,NAMEG(I)//DSCRPT(J),IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! OUTEI7 WARNING: Excitation'// - ' buffer is full; unable to add '// - NAMEG(I)//DSCRPT(J) ELSE EXBOL(IEXC)=FRELV/TORR ENDIF IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ OUTEI7 DEBUG :'', - '' Gas '',A,'', state '',A,'', exc id '',I3, - '', rate: '',E12.5,'' +/- '',F8.4,'' %'')') - NAMEG(I),DSCRPT(J),IEXC,FRELV,ERRFRE ** Select the ionisation frequencies ELSEIF(DSCRPT(J)(1:4).EQ.' ION')THEN * Identify and store the rate. CALL GASIDI(IION,NAMEG(I)//DSCRPT(J),IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! OUTEI7 WARNING: Ionisation'// - ' buffer is full; unable to add '// - NAMEG(I)//DSCRPT(J) ELSE IOBOL(IION)=FRELV/TORR ENDIF IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ OUTEI7 DEBUG :'', - '' Gas '',A,'', state '',A,'', ion id '',I3, - '', rate: '',E12.5,'' +/- '',F8.4,'' %'')') - NAMEG(I),DSCRPT(J),IION,FRELV,ERRFRE ENDIF ENDIF 20 CONTINUE 10 CONTINUE END +DECK,F0PLT7. SUBROUTINE F0PLT7(GASID) *----------------------------------------------------------------------- * F0PLT7 - Plots the distribution functions. * (Last changed on 2/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MIX. +SEQ,OUTPT. +SEQ,BFLD. +SEQ,SETP. +SEQ,DIMENSIONS. CHARACTER*100 AUX CHARACTER*(*) GASID INTEGER NC,STRLEN EXTERNAL STRLEN *** Plot the function. CALL GRAOPT('LOG-Y') * Plot frame. CALL GRGRP2(EVECT,SPEC,2048, - 'Energy [eV]','Distribution function', - 'Electron energy distribution') * Prepare a label. IF(GASID.NE.' ')THEN AUX(1:5)='Gas: ' AUX(6:)=GASID CALL GRCOMM(4,AUX(1:STRLEN(GASID)+5)) ENDIF * Prepare the E, B and angle labels. CALL OUTFMT(REAL(EMAG),2,AUX,NC,'LEFT') CALL GRCOMM(1,'E = '//AUX(1:NC)//' V/cm') CALL OUTFMT(REAL(BMAG/10),2,AUX,NC,'LEFT') CALL GRCOMM(2,'B = '//AUX(1:NC)//' T') CALL OUTFMT(REAL(BTHETA),2,AUX,NC,'LEFT') CALL GRCOMM(3,'Angle = '//AUX(1:NC)//' degrees') *** Close the plot and register. CALL GRNEXT CALL GRALOG('Magboltz energy distribution plot:') END +DECK,GASPCS. SUBROUTINE GASPCS(GASID) *----------------------------------------------------------------------- * GASPCS - Plots the cross sections. * (Last changed on 2/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MIX. +SEQ,OUTPT. +SEQ,BFLD. +SEQ,SETP. +SEQ,INPT. +SEQ,DIMENSIONS. CHARACTER*100 AUX CHARACTER*(*) GASID DOUBLE PRECISION YAUX(2048),YMIN,YMAX INTEGER NC,STRLEN,I,J EXTERNAL STRLEN *** Determine the range YMIN=-1 YMAX=-1 DO 30 I=1,2048 IF((YMIN.LT.0.OR.YMAX.LT.0).AND.QTOT(I).GT.0)THEN YMIN=QTOT(I) YMAX=QTOT(I) ELSEIF(QTOT(I).GT.0)THEN YMIN=MIN(YMIN,QTOT(I)) YMAX=MAX(YMAX,QTOT(I)) ENDIF IF((YMIN.LT.0.OR.YMAX.LT.0).AND.QEL(I).GT.0)THEN YMIN=QEL(I) YMAX=QEL(I) ELSEIF(QEL(I).GT.0)THEN YMIN=MIN(YMIN,QEL(I)) YMAX=MAX(YMAX,QEL(I)) ENDIF IF((YMIN.LT.0.OR.YMAX.LT.0).AND.QSATT(I).GT.0)THEN YMIN=QSATT(I) YMAX=QSATT(I) ELSEIF(QSATT(I).GT.0)THEN YMIN=MIN(YMIN,QSATT(I)) YMAX=MAX(YMAX,QSATT(I)) ENDIF DO 40 J=1,NGAS IF((YMIN.LT.0.OR.YMAX.LT.0).AND.QION(J,I).GT.0)THEN YMIN=QION(J,I) YMAX=QION(J,I) ELSEIF(QION(J,I).GT.0)THEN YMIN=MIN(YMIN,QION(J,I)) YMAX=MAX(YMAX,QION(J,I)) ENDIF 40 CONTINUE 30 CONTINUE *** Plot frame. CALL GRAOPT('LOG-X,LOG-Y') CALL GRCART(0.9*REAL(EVECT(1)),0.9*REAL(YMIN), - 1.1*REAL(EVECT(2048)),1.1*REAL(YMAX), - 'Energy [eV]', - 'Density corrected inverse mean free path [1/cm]', - 'Cross section terms') * Prepare the gas label. IF(GASID.NE.' ')THEN AUX(1:5)='Gas: ' AUX(6:)=GASID CALL GRCOMM(4,AUX(1:STRLEN(GASID)+5)) ENDIF * Prepare the E, B and angle labels. CALL OUTFMT(REAL(EMAG),2,AUX,NC,'LEFT') CALL GRCOMM(1,'E = '//AUX(1:NC)//' V/cm') CALL OUTFMT(REAL(BMAG/10),2,AUX,NC,'LEFT') CALL GRCOMM(2,'B = '//AUX(1:NC)//' T') CALL OUTFMT(REAL(BTHETA),2,AUX,NC,'LEFT') CALL GRCOMM(3,'Angle = '//AUX(1:NC)//' degrees') *** Add the total cross section. CALL GRATTS('FUNCTION-1','POLYLINE') CALL GRLIN2(2048,EVECT,QTOT) * Add the elastic term. CALL GRATTS('FUNCTION-2','POLYLINE') CALL GRLIN2(2048,EVECT,QEL) * Add the attachment term. CALL GRATTS('FUNCTION-3','POLYLINE') CALL GRLIN2(2048,EVECT,QSATT) * Add the ionisation terms. CALL GRATTS('FUNCTION-4','POLYLINE') DO 10 I=1,NGAS DO 20 J=1,2048 YAUX(J)=QION(I,J) 20 CONTINUE CALL GRLIN2(2048,EVECT,YAUX) 10 CONTINUE *** Close the plot and register. CALL GRNEXT CALL GRALOG('Magboltz cross section plot:') END +DECK,GASSAV. SUBROUTINE GASSAV *----------------------------------------------------------------------- * GASSAV - Saves cross section and energy distribution data. * (Last changed on 22/ 5/09.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,DIMENSIONS. +SEQ,GLOBALS. +SEQ,MIX. +SEQ,OUTPT. +SEQ,INPT. +SEQ,LARGE. +SEQ,PRINTPLOT. REAL CSEMAT(MXLIST),CSTMAT(MXLIST),CSAMAT(MXLIST),CSIMAT(MXLIST), - EMAT(MXLIST),FMAT(MXLIST),SCALE,FSUM,ALOSCH INTEGER NC,JVAR,I,J,K,NSAMP,ISIZ(1),IDIM(1),IFAIL1,IFAIL2,IFAIL3, - IFAIL4,IFAIL5,IFAIL6,NORM,NDATA CHARACTER*20 STR PARAMETER(ALOSCH=2.6867775E19) *** Identify the routine. IF(LIDENT)PRINT *,' /// ROUTINE GASSAV ///' *** Settings. NSAMP=2 *** Check that the total number of samples doesn't exceed MXLIST. IF(2048/NSAMP.GT.MXLIST)THEN PRINT *,' !!!!!! GASSAV WARNING : Number of samples too'// - ' large; reduced.' NSAMP=NINT(0.5+2048.0/REAL(MXLIST)) * and also be sure there is at least 1 sample. ELSEIF(2048/NSAMP.LT.1)THEN PRINT *,' !!!!!! GASSAV WARNING : Number of samples too'// - ' small; increased to have 1 sample.' NSAMP=2048 ENDIF *** Figure out which set of variables is still free. JVAR=0 10 CONTINUE JVAR=JVAR+1 CALL OUTFMT(REAL(JVAR),2,STR,NC,'LEFT') DO 20 I=1,NGLB IF(GLBVAR(I).EQ.'CSE_'//STR(1:NC).OR. - GLBVAR(I).EQ.'CST_'//STR(1:NC).OR. - GLBVAR(I).EQ.'CSA_'//STR(1:NC).OR. - GLBVAR(I).EQ.'CSI_'//STR(1:NC).OR. - GLBVAR(I).EQ.'F_'//STR(1:NC).OR. - GLBVAR(I).EQ.'E_'//STR(1:NC))GOTO 10 20 CONTINUE *** Prepare a sampling vector, initialise the sum of F. FSUM=0 NDATA=0 * Loop over the samples. DO 30 I=0,2047,NSAMP NDATA=NDATA+1 * Initialise. EMAT(NDATA)=0 FMAT(NDATA)=0 CSTMAT(NDATA)=0 CSEMAT(NDATA)=0 CSAMAT(NDATA)=0 CSIMAT(NDATA)=0 NORM=0 * Loop over the sub-samples. DO 40 J=1,NSAMP IF(I+J.GE.2048)GOTO 40 NORM=NORM+1 EMAT(NDATA)=EMAT(NDATA)+EVECT(I+J) C Return the same data as Magboltz (RV 22/5/2009) C FMAT(NDATA)=FMAT(NDATA)+SPEC(I+J)/TCF(I+J) FMAT(NDATA)=FMAT(NDATA)+SPEC(I+J) CSTMAT(NDATA)=CSTMAT(NDATA)+QTOT(I+J) CSEMAT(NDATA)=CSEMAT(NDATA)+QEL(I+J) CSAMAT(NDATA)=CSAMAT(NDATA)+QSATT(I+J) DO 50 K=1,NGAS CSIMAT(NDATA)=CSIMAT(NDATA)+QION(K,I+J) 50 CONTINUE 40 CONTINUE * Normalise by number of samples. IF(NORM.GT.0)THEN EMAT(NDATA)=EMAT(NDATA)/NORM CSTMAT(NDATA)=CSTMAT(NDATA)/(NORM*ALOSCH) CSEMAT(NDATA)=CSEMAT(NDATA)/(NORM*ALOSCH) CSAMAT(NDATA)=CSAMAT(NDATA)/(NORM*ALOSCH) CSIMAT(NDATA)=CSIMAT(NDATA)/(NORM*ALOSCH) ELSE EMAT(NDATA)=0 CSTMAT(NDATA)=0 CSEMAT(NDATA)=0 CSAMAT(NDATA)=0 CSIMAT(NDATA)=0 ENDIF * Keep track of the sum of F. FSUM=FSUM+FMAT(NDATA) 30 CONTINUE *** Normalise the energy distribution function. SCALE=FSUM*(EMAT(2)-EMAT(1)) IF(SCALE.LE.0)THEN PRINT *,' !!!!!! GASSAV WARNING : Probability scaling'// - ' less or equal 0; probabilities not normalised.' SCALE=1 ENDIF DO 70 I=1,NDATA FMAT(I)=FMAT(I)/SCALE 70 CONTINUE *** Save the parameters. ISIZ(1)=NDATA IDIM(1)=MXLIST CALL MATSAV(EMAT,1,IDIM,ISIZ,'E_'//STR(1:NC),IFAIL1) CALL MATSAV(FMAT,1,IDIM,ISIZ,'F_'//STR(1:NC),IFAIL2) CALL MATSAV(CSTMAT,1,IDIM,ISIZ,'CST_'//STR(1:NC),IFAIL4) CALL MATSAV(CSEMAT,1,IDIM,ISIZ,'CSE_'//STR(1:NC),IFAIL3) CALL MATSAV(CSAMAT,1,IDIM,ISIZ,'CSA_'//STR(1:NC),IFAIL5) CALL MATSAV(CSIMAT,1,IDIM,ISIZ,'CSI_'//STR(1:NC),IFAIL6) IF(IFAIL1.NE.0.OR.IFAIL2.NE.0.OR.IFAIL3.NE.0.OR. - IFAIL4.NE.0.OR.IFAIL5.NE.0.OR.IFAIL6.NE.0)THEN PRINT *,' !!!!!! GASSAV WARNING : Error while saving one'// - ' or more matrices.' ELSE WRITE(LUNOUT,'('' ------ GASSAV MESSAGE : Data saved'', - '' under the following names:''/ - 26X,''Energy: '',A/ - 26X,''Distribution function: '',A/ - 26X,''Total cross section: '',A/ - 26X,''Elastic cross section: '',A/ - 26X,''Attachment cross section: '',A/ - 26X,''Ionisation cross section: '',A)') - 'E_'//STR(1:NC),'F_'//STR(1:NC),'CST_'//STR(1:NC), - 'CSE_'//STR(1:NC),'CSA_'//STR(1:NC),'CSI_'//STR(1:NC) ENDIF END +DECK,DRAND48. DOUBLE PRECISION FUNCTION drand48(DUMMY) *----------------------------------------------------------------------- * RNDM2 - Returns double precision random numbers by calling RM48. * (Last changed on 26/10/07.) *----------------------------------------------------------------------- implicit none INTEGER NVEC PARAMETER(NVEC=1000) DOUBLE PRECISION RVEC(NVEC),DUMMY INTEGER IVEC SAVE RVEC,IVEC DATA IVEC/0/ *** Now generate random number between 0 and one. IF(IVEC.EQ.0.OR.IVEC.GE.NVEC)THEN CALL RM48(RVEC,NVEC) IVEC=1 ELSE IVEC=IVEC+1 ENDIF *** Assign result. drand48=RVEC(IVEC) END +PATCH,MAGBOL7. +DECK,GASB7. SUBROUTINE GASB7(EE,BB,BTH,TT,PP,SSTTHR,NNMAX,IFAIL) *----------------------------------------------------------------------- * GASB7 - Interface to Magboltz 7, originally the main program. * Author: Steve Biagi, extensively modified. * (Last changed on 17/ 3/09.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,BFLD. +SEQ,INPT. +SEQ,SETP. +SEQ,OUTPT. +SEQ,MAGBOUT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. INTEGER NRETRY,IELOW,IFAIL,IFAIL1,NNMAX DOUBLE PRECISION EOP,ALPP,ATTP,SSTMIN,TGAS,EE,BB,BTH,TT,PP, - SSTTHR,EFMAX PARAMETER(EFMAX=100000.0) *** Identify the procedure. IF(LIDENT)PRINT *,' /// ROUTINE GASB7 ///' *** Assume this will work. IFAIL=0 *** Set parameters CALL SETB7(EE,BB,BTH,TT,PP,NNMAX,IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASB7 WARNING : Setup phase of Magboltz'// - ' failed at E=',EE,' B=',BB,' angle=',BTH, - '; not computing transport parameters.' IFAIL=1 RETURN ENDIF *** Calculate EFINAL if set to 0. IF(EFINAL.le.0.0D0)THEN * Start at 0.5 eV. If E/p > 15 start at 8.0 eV. EFINAL=0.5D0 EOP=EMAG*(TEMPC+273.15D0)/(TORR*293.15D0) IF(EOP.GT.15.0D0) EFINAL=8.0D0 ESTART=EFINAL/50.0D0 * Keep track of the number of retries NRETRY=0 10 CONTINUE NRETRY=NRETRY+1 CALL MIXER7(IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASB7 WARNING : Gas mixing phase'// - ' of Magboltz failed; not computing transport'// - ' parameters.' IFAIL=1 RETURN ENDIF * Loop to calculate EFINAL IF(BMAG.EQ.0.0D0.OR.BTHETA.EQ.0.0D0.OR. - ABS(BTHETA).EQ.180.0D0)THEN CALL ELIMIT(IELOW) ELSEIF(BTHETA.EQ.90.0D0) THEN CALL ELIMITB(IELOW) ELSE CALL ELIMITC(IELOW) ENDIF IF(IELOW.EQ.1) THEN EFINAL=EFINAL*SQRT(2.0D0) ESTART=EFINAL/50.0D0 IF(EFINAL.GT.EFMAX)THEN EFINAL=EFMAX ESTART=EFINAL/50.0 CALL MIXER7(IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASB7 WARNING : Mixing'// - ' for Efinal = Emax failed; not'// - ' computing transport parameters.' IFAIL=1 RETURN ELSE PRINT *,' ------ GASB7 WARNING : Reached'// - ' maximum parametrised e- energy;'// - ' please check energy distributions.' LF0PLT=.TRUE. ENDIF ELSEIF(NRETRY.LT.50)THEN GO TO 10 ELSE PRINT *,' !!!!!! GASB7 WARNING : Calculation'// - ' of EFINAL did not converge; reduced'// - ' precision.' ENDIF ENDIF ** Otherwise simply mix the gases using the set value. ELSE CALL MIXER7(IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASB7 WARNING : Gas mixing phase'// - ' of Magboltz failed; not computing transport'// - ' parameters.' IFAIL=1 RETURN ENDIF ENDIF *** Start printing. CALL PRNTER *** Monte Carlo loops, again keep track of repetitions NRETRY=0 20 CONTINUE NRETRY=NRETRY+1 * Call the appropriate routine IF(BMAG.EQ.0.0D0)THEN CALL MONTE ELSEIF(BTHETA.EQ.0.0D0.OR.BTHETA.EQ.180.0D0) THEN CALL MONTEA ELSEIF(BTHETA.EQ.90.0D0) THEN CALL MONTEB ELSE CALL MONTEC ENDIF * Check for convergence. IF(SPEC(2048).GT.500.0D0) THEN IF(EFINAL*2.GT.EFMAX)THEN EFINAL=EFMAX ESTART=EFINAL/50.0 CALL MIXER7(IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASB7 WARNING : Mixing'// - ' for Efinal = Emax failed; not'// - ' computing transport parameters.' IFAIL=1 RETURN ELSE PRINT *,' ------ GASB7 WARNING : Reached'// - ' maximum parametrised e- energy;'// - ' please check energy distributions.' LF0PLT=.TRUE. ENDIF ELSEIF(NRETRY.LT.5)THEN EFINAL=EFINAL*2 ESTART=EFINAL/50.0D0 PRINT *,' ------ GASB7 MESSAGE : Energy range is'// - ' insufficient; increasing to ',EFINAL,' eV'// - ' and trying again.' IF(LDEBUG)CALL F0PLT7('Insufficient E range') CALL SETB7I CALL MIXER7(IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASB7 WARNING : Gas mixing'// - ' phase of Magboltz failed; not computing'// - ' transport parameters.' IFAIL=1 RETURN ENDIF GO TO 20 ELSE PRINT *,' !!!!!! GASB7 WARNING : Reached maximum'// - ' number of range increases; reduced precision.' ENDIF ENDIF *** Output from initial MC loops CALL OUTPUT *** If attachment or ionisation is greater than SSTMIN, include spatial * gradients in the solution . TGAS=273.15D0+TEMPC ALPP=ALPHA*760.0D0*TGAS/(TORR*293.15D0) ATTP=ATT*760.0D0*TGAS/(TORR*293.15D0) * Set the value of SSTMIN SSTMIN=SSTTHR * Check whether the threshold is passed C IF(ALPP.GT.SSTMIN.OR.ATTP.GT.SSTMIN)then * Modification at the request of Steve Biagi (RV 6/9/2007). IF(ABS(ALPP-ATTP).GT.SSTMIN)then IF(BMAG.EQ.0.0D0) THEN CALL ALPCALC(IFAIL1) ELSE IF(BTHETA.EQ.0.0D0.OR.BTHETA.EQ.180.0D0) THEN CALL ALPCLCA(IFAIL1) ELSE IF(BTHETA.EQ.90.0D0) THEN CALL ALPCLCB(IFAIL1) ELSE CALL ALPCLCC(IFAIL1) ENDIF IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASB7 WARNING : Failure performing'// - ' high-field calculations.' IFAIL=1 RETURN ENDIF ENDIF * Output after the full calculations CALL OUTPUT2 END +DECK,ANGCUT. SUBROUTINE ANGCUT(PSCT1,ANGC,PSCT2) *----------------------------------------------------------------------- * ANGCUT - Set angle cuts on angular distribution and renormalise * forward scattering probability * (Last changed on 22/ 5/05.) *----------------------------------------------------------------------- implicit none DOUBLE PRECISION ANGC,PSCT1,PSCT2,API,RADS,CNS,THETAC,FAC ANGC=1.0D0 PSCT2=PSCT1 IF(PSCT1.LE.1.0D0) RETURN API=ACOS(-1.0D0) RADS=2.0D0/API CNS=PSCT1-0.5D0 THETAC=ASIN(2.0D0*SQRT(CNS-CNS*CNS)) FAC=(1.0D0-COS(THETAC))/(SIN(THETAC)*SIN(THETAC)) PSCT2=(CNS*FAC)+0.5D0 ANGC=THETAC*RADS END +DECK,MIXER7. SUBROUTINE MIXER7(IFAIL) *----------------------------------------------------------------------- * MIXER7 - Fills arrays of collision frequency * can have a mixture of up to 6 gases * Author: Steve Biagi, with modifications. * (Last changed on 2/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,RATIO. +SEQ,GASN. +SEQ,MIX. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,LARGE. +SEQ,ANIS. +SEQ,FRED. +SEQ,MRATIO. +SEQ,NAMES. +SEQ,SCRIP. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. CHARACTER*15 NAMEn(mxngas) CHARACTER*30 SCRPn(226,mxngas) DOUBLE PRECISION Qn(6,2048,mxngas),En(6,mxngas),EInn(220,mxngas), - QATT(mxngas,2048), - PEQELn(6,2048,mxngas),PEQINn(220,2048,mxngas), - EHALF,AJ,PSCT1,ANGC,PSCT2,BP,F2,ELOW,EHI, - VIRIAL(mxngas),EBn(mxngas),RGASn(mxngas) INTEGER KINn(220,mxngas),KELn(6,mxngas),igas,ilev, - I,J,K,IE,NP,IF,KELSUM,JLOW,JHI,L,IFAIL *** Identify if requested. IF(LIDENT)PRINT *,' /// ROUTINE MIXER7 ///' NISO=0 *** This in principle will work. IFAIL=0 *** Initialise do 100 igas=1,mxngas NINn(igas)=0 NAMEG(igas)='---------------' do 110 j=1,6 KELn(J,igas)=0 En(j,igas)=0 do 115 k=1,2048 Qn(j,k,igas)=0 115 continue 110 continue DO 120 j=1,220 KINn(J,igas)=0 EInn(j,igas)=0 120 continue 100 continue *** Energy vector IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ MIXER7 DEBUG : Mixing'', - '' for Efinal = '',E12.5,'' eV.'')') EFINAL ESTEP=EFINAL/DBLE(NSTEP) EHALF=ESTEP/2.0D0 Evect(1)=EHALF DO 3 I=2,2048 AJ=DBLE(I-1) Evect(I)=EHALF+ESTEP*AJ 3 EROOT(I)=SQRT(Evect(I)) EROOT(1)=SQRT(EHALF) DO 6 I=1,512 6 INDEX(I)=0 *** Call gas cross-sections do 10 igas=1,ngas CALL GETGAS(NGASN(igas),Qn(1,1,igas),QINn(1,1,igas),NINn(igas), - En(1,igas),EInn(1,igas),NAMEn(igas), - VIRIAL(igas),EBn(igas),PEQELn(1,1,igas),PEQINn(1,1,igas), - KELn(1,igas),KINn(1,igas),SCRPn(1,igas)) do ie=1,2048 do ilev=1,6 if (qn(ilev,ie,igas).lt.0.0d0)then print *,' !!!!!! MIXER7 WARNING : Negative elastic'// - ' cross section for gas=',igas,' type=',ilev, - ' energy=',evect(ie),' cs=',qn(ilev,ie,igas), - '; set to 0.' qn(ilev,ie,igas)=0 endif enddo do ilev=1,ninn(igas) if (qinn(ilev,ie,igas).lt.0.0d0)then print *,' !!!!!! MIXER7 WARNING : Negative inelastic'// - ' cross section for gas=',igas,' type=',ilev, - ' energy=',evect(ie),' cs=',qinn(ilev,ie,igas), - '; set to 0.' qinn(ilev,ie,igas)=0 endif enddo enddo 10 continue C --------------------------------------------------------------- C CORRECTION OF NUMBER DENSITY DUE TO VIRIAL COEFFICIENT C CAN BE PROGRAMMED HERE NOT YET IMPLEMENTED. C----------------------------------------------------------------- C----------------------------------------------------------------- C CALCULATION OF COLLISION FREQUENCIES FOR AN ARRAY OF C ELECTRON ENERGIES IN THE RANGE ZERO TO EFINAL C C L=5*N-4 ELASTIC NTH GAS C L=5*N-3 IONISATION NTH GAS C L=5*N-2 ATTACHMENT NTH GAS C L=5*N-1 INELASTIC NTH GAS C L=5*N SUPERELASTIC NTH GAS C--------------------------------------------------------------- DO 700 IE=1,2048 FCION(IE)=0.0D0 FCATT(IE)=0.0D0 *** Initial NP NP=0 *** Loop over the gases do 710 igas=1,ngas NP=NP+1 CF(IE,NP)=Qn(2,IE,igas)*VANn(igas) PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 IF(KELn(2,igas).EQ.1) THEN PSCT1=PEQELn(2,IE,igas) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(IE.eq.1)then RGASN(igas)=1.0D0+En(2,igas)/2.0D0 RGAS(NP)=RGASN(igas) EIN(NP)=0.0D0 IPN(NP)=0 L=1+5*(igas-1) IARRY(NP)=L DSCRPT(NP)=SCRPN(2,igas) NAMEG(igas)=NAMEn(igas) endif IF(EFINAL.ge.En(3,igas))then NP=NP+1 CF(IE,NP)=Qn(3,IE,igas)*VANn(igas) FCION(IE)=FCION(IE)+CF(IE,NP) PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 IF(KELn(3,igas).EQ.1) THEN PSCT1=PEQELn(3,IE,igas) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(IE.EQ.1)then RGAS(NP)=RGASN(igas) EIN(NP)=En(3,igas)/RGASN(igas) WPL(NP)=EBn(igas) IPN(NP)=1 L=2+5*(igas-1) IARRY(NP)=L DSCRPT(NP)=SCRPN(3,igas) endif endif IF(EFINAL.ge.En(4,igas))then NP=NP+1 CF(IE,NP)=Qn(4,IE,igas)*VANn(igas) FCATT(IE)=FCATT(IE)+CF(IE,NP) PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 IF(IE.eq.1)then INDEX(NP)=0 RGAS(NP)=RGASN(igas) EIN(NP)=0.0D0 IPN(NP)=-1 L=3+5*(igas-1) IARRY(NP)=L DSCRPT(NP)=SCRPN(4,igas) endif endif DO 50 J=1,NINN(igas) NP=NP+1 CF(IE,NP)=QINn(J,IE,igas)*VANn(igas) PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 IF(KINn(J,igas).NE.0) THEN PSCT1=PEQINn(J,IE,igas) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(IE.eq.1)then RGAS(NP)=RGASN(igas) EIN(NP)=EInn(J,igas)/RGASN(igas) L=4+5*(igas-1) IF(EInn(J,igas).LT.0.0D0) L=5+5*(igas-1) IPN(NP)=0 IARRY(NP)=L DSCRPT(NP)=SCRPN(6+J,igas) endif 50 CONTINUE 710 continue *** End of loop updates IPLAST=NP ISIZE=1 IF(IPLAST.GE.2) ISIZE=2 IF(IPLAST.GE.4) ISIZE=4 IF(IPLAST.GE.8) ISIZE=8 IF(IPLAST.GE.16) ISIZE=16 IF(IPLAST.GE.32) ISIZE=32 IF(IPLAST.GE.64) ISIZE=64 IF(IPLAST.GE.128) ISIZE=128 IF(IPLAST.GE.256) ISIZE=256 IF(IPLAST.GE.512) ISIZE=512 IF(IPLAST.GE.1024)ISIZE=1024 *** Can increase array size up to 1356 if more complex mixtures used. * 1356 = 6 * 226 ( 6 = max no of gases. 226 = max no of levels ) IF(IPLAST.GT.512)then print *,' ###### MIXER7 ERROR : Too many levels in', - ' calculation. Can increase the array sizes from', - ' 512 up to 1356 maximum.' IFAIL=1 RETURN ENDIF *** Calculation of total collision frequency TCF(IE)=0.0D0 DO 610 IF=1,IPLAST TCF(IE)=TCF(IE)+CF(IE,IF) IF(CF(IE,IF).LT.0.0D0.and.lbmcpr) WRITE(lunout,776) - CF(IE,IF),IE,IF,IARRY(IF),EIN(IF) 776 FORMAT(' WARNING NEGATIVE COLLISION FEQUENCY =',D12.3,' IE =',I6, /' IF =',I3,' IARRY=',I5,' EIN=',F7.4) 610 CONTINUE DO 620 IF=1,IPLAST IF(TCF(IE).EQ.0.0D0) GO TO 615 CF(IE,IF)=CF(IE,IF)/TCF(IE) GO TO 620 615 CF(IE,IF)=0.0D0 620 CONTINUE DO 630 IF=2,IPLAST CF(IE,IF)=CF(IE,IF)+CF(IE,IF-1) 630 CONTINUE FCATT(IE)=FCATT(IE)*EROOT(IE) FCION(IE)=FCION(IE)*EROOT(IE) TCF(IE)=TCF(IE)*EROOT(IE) 700 CONTINUE C if(lbmcpr)WRITE(lunout,841) (INDEX(J),J, J=1,IPLAST) C 841 FORMAT(2X,' INDEX=',I3,' J=',I3) *** Set anisotropic flag if anisotropic scattering data is detected KELSUM=0 do 703 igas=1,ngas DO 701 J=1,6 KELSUM=KELSUM+KELn(J,igas) 701 continue DO 702 J=1,220 KELSUM=KELSUM+KINn(J,igas) 702 continue 703 continue IF(KELSUM.GT.0) NISO=1 C IF(NISO.EQ.1.and.lbmcpr) WRITE(lunout,7765) NISO C7765 FORMAT(3X,' ANISOTROPIC SCATTERING DETECTED NISO=',I5) *** Calculate null collision frequency BP=EMAG*EMAG*CONST1 F2=EMAG*CONST3 ELOW=TMAX*(TMAX*BP-F2*SQRT(0.5D0*EFINAL))/ESTEP-1.0D0 ELOW=MIN(ELOW,SMALL) EHI=TMAX*(TMAX*BP+F2*SQRT(0.5D0*EFINAL))/ESTEP+1.0D0 IF(EHI.GT.10000.) EHI=10000. DO 810 I=1,8 JLOW=2048-256*(9-I)+1+INT(ELOW) JHI=2048-256*(8-I)+INT(EHI) JLOW=MAX(JLOW,1) JHI=MIN(JHI,2048) DO 800 J=JLOW,JHI IF(TCF(J).GE.TCFMAX(I)) TCFMAX(I)=TCF(J) 800 CONTINUE 810 CONTINUE *** Cross section data for integrals in output DO 900 I=1,NSTEP qtot(i)=0 qel(i)=0 do 901 igas=1,ngas * Total and elastic cross sections QTOT(I)=qtot(i)+ANn(igas)*Qn(1,I,igas) QEL(I)=qel(i)+ANn(igas)*Qn(2,I,igas) * Ionisation and attachment for individual gases QION(igas,I)=Qn(3,I,igas)*ANn(igas) QATT(igas,I)=Qn(4,I,igas)*ANn(igas) 901 continue * Totals QREL(I)=0.0D0 QSATT(I)=0.0D0 QSUM(I)=0.0D0 DO 855 igas=1,NGAS QSUM(I)=QSUM(I)+QION(igas,I)+QATT(igas,I) QSATT(I)=QSATT(I)+QATT(igas,I) QREL(I)=QREL(I)+QION(igas,I)-QATT(igas,I) DO 860 J=1,NINN(igas) QSUM(I)=QSUM(I)+QINn(J,I,igas)*ANn(igas) 860 continue 855 continue * 900 CONTINUE END +DECK,GETGAS. SUBROUTINE GETGAS(NGS,Q,QIN,NIN,E,EI,NAME,VIRL,EB, - PEQEL,PEQIN,KEL,KIN,SCRPT) *----------------------------------------------------------------------- * GETGAS - Retrieves gas tables, originally called GASMIX * Author: Steve Biagi, modified. * (Last changed on 16/ 9/05.) *----------------------------------------------------------------------- implicit none CHARACTER*15 NAME CHARACTER*30 SCRPT(226) DOUBLE PRECISION Q(6,2048),QIN(220,2048),E(6),EI(220), - PEQEL(6,2048),PEQIN(220,2048),VIRL,EB INTEGER KIN(220),KEL(6),NGS,NIN *** Take the desired gas IF(NGS.EQ.1)THEN CALL GAS1(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.2)THEN CALL GAS2(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.3)THEN CALL GAS3(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.4)THEN CALL GAS4(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.5)THEN CALL GAS5(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.6)THEN CALL GAS6(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.7)THEN CALL GAS7(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.8)THEN CALL GAS8(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.9)THEN CALL GAS9(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.10)THEN CALL GAS10(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.11)THEN CALL GAS11(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.12)THEN CALL GAS12(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.13)THEN CALL GAS13(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.14)THEN CALL GAS14(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.15)THEN CALL GAS15(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.16)THEN CALL GAS16(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.17)THEN CALL GAS17(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.18)THEN CALL GAS18(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.19)THEN CALL GAS19(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.20)THEN CALL GAS20(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.21)THEN CALL GAS21(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.22)THEN CALL GAS22(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.23)THEN CALL GAS23(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.24)THEN CALL GAS24(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.25)THEN CALL GAS25(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.26)THEN CALL GAS26(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.27)THEN CALL GAS27(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.28)THEN CALL GAS28(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.29)THEN CALL GAS29(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.30)THEN CALL GAS30(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.31)THEN CALL GAS31(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.32)THEN CALL GAS32(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.33)THEN CALL GAS33(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.34)THEN CALL GAS34(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.35)THEN CALL GAS35(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.36)THEN CALL GAS36(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.37)THEN CALL GAS37(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.38)THEN CALL GAS38(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.39)THEN CALL GAS39(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.40)THEN CALL GAS40(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.41)THEN CALL GAS41(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.42)THEN CALL GAS42(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.43)THEN CALL GAS43(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.44)THEN CALL GAS44(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.45)THEN CALL GAS45(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.46)THEN CALL GAS46(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.47)THEN CALL GAS47(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.48)THEN CALL GAS48(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.49)THEN CALL GAS49(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.50)THEN CALL GAS50(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.51)THEN CALL GAS51(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.52)THEN CALL GAS52(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.53)THEN CALL GAS53(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.54)THEN CALL GAS54(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.55)THEN CALL GAS55(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.56)THEN CALL GAS56(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.57)THEN CALL GAS57(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.58)THEN CALL GAS58(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.59)THEN CALL GAS59(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSEIF(NGS.EQ.60)THEN CALL GAS60(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,KEL,KIN, - SCRPT) ELSE PRINT *,' !!!!!! GETGAS WARNING : Received the unknown'// - ' gas identifier ',NGS,'.' ENDIF END +DECK,SETB7. SUBROUTINE SETB7(EE,BB,BTH,TT,PP,NNMAX,IFAIL) *----------------------------------------------------------------------- * SETB7 - Sets parameters for Magboltz 7, originally called SETUP. * Author: Originally from Steve Biagi, extensively modified. * (Last changed on 21/12/05.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,MAGBOUT. +SEQ,INPT. +SEQ,CNSTS. +SEQ,CNSTS1. +SEQ,RATIO. +SEQ,GASN. +SEQ,SETP. +SEQ,THRM. +SEQ,BFLD. +SEQ,MRATIO. +SEQ,TTRM. +SEQ,OUTPT. +SEQ,PRINTPLOT. INTEGER IFAIL,I,J,NSCALE,NNMAX DOUBLE PRECISION EE,BB,BTH,TT,PP,EOVM,TOTFRAC,CORR *** Identify the procedure. IF(LIDENT)PRINT *,' /// ROUTINE SETB7 ///' *** New update of constants 1998 API=ACOS(-1.0D0) EOVM=SQRT(2.0D0*ECHARG/EMASS)*100.0D0 CONST1=AWB/2.0D0*1.0D-19 CONST2=CONST1*1.0D-02 CONST3=SQRT(0.2D0*AWB)*1.0D-09 CONST4=CONST3*ALOSCH*1.0D-15 CONST5=CONST3/2.0D0 *** Debugging output. IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ SETB7 DEBUG : E='',E15.2, - '' V/cm, B='',E15.2,'' T, angle='',F10.3,'' degrees''/26X, - ''T='',F10.3,'' K, p='',F10.3,'' Torr, n='',I10)') - EE,BB,BTH,TT,PP,NNMAX *** Assume things will work. IFAIL=0 *** Number of collisions. NMAX=NNMAX *** Request automatic calculation of EFINAL. EFINAL=0.0 *** Establish the gas mixture. NGAS=0 TOTFRAC=0.0 DO 10 I=1,mxgnam IF(FRAMIX(I).GT.0)THEN * Ensure the limit on gas components is not exceeded. IF(NGAS.GE.mxngas)THEN PRINT *,' !!!!!! SETB7 WARNING : The mixture'// - ' consists of more than MXNGAS components.' PRINT *,' Adjust this'// - ' parameter and recompile the program.' IFAIL=1 RETURN ENDIF * Add a new gas to the list. NGAS=NGAS+1 FRAC(NGAS)=FRAMIX(I) TOTFRAC=TOTFRAC+FRAC(NGAS) NGASN(NGAS)=I IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ SETB7 DEBUG : Gas '', - I3,'' id='',I3,'' frac='',E12.5)') - NGAS,NGASN(NGAS),FRAC(NGAS) ENDIF 10 CONTINUE * Check that there is some gas to be scaled. IF(TOTFRAC.LE.0.OR.NGAS.LE.0)THEN PRINT *,' !!!!!! SETB7 WARNING : No gas present in the'// - ' mixture; setup aborted.' IFAIL=1 RETURN ENDIF *** Temperature and pressure. TEMPC=TT-273.15D0 TORR=PP * Density correction factors. CORR=ABZERO*TORR/(ATMOS*(ABZERO+TEMPC)) AKT=(ABZERO+TEMPC)*BOLTZ * Scale the fractions. DO 20 J=1,NGAS ANn(J)=FRAC(J)*CORR*ALOSCH/TOTFRAC VANn(J)=FRAC(J)*CORR*CONST4*1.0D15/TOTFRAC 20 CONTINUE *** Field values EMAG=EE BMAG=BB BTHETA=BTH *** Set remaining parameters. TMAX=100.0D0 NSCALE=10000000 NMAX=NMAX*NSCALE IF(NMAX.LT.0) THEN PRINT *,' !!!!!! SETB7 WARNING : NMAX is too large and'// - ' has caused overflow; no setup phase performed.' IFAIL=1 RETURN ENDIF NSTEP=2048 *** Initialisations that may need to be redone. CALL SETB7I END +DECK,SETB7I. SUBROUTINE SETB7I *----------------------------------------------------------------------- * SETB7I - Oiginally part of SETUP. * Author: Originally from Steve Biagi, extensively modified. * (Last changed on 21/12/05.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,CNSTS. +SEQ,INPT. +SEQ,SETP. +SEQ,MAGBOUT. +SEQ,TTRM. +SEQ,THRM. +SEQ,OUTPT. +SEQ,BFLD. INTEGER J,K *** Angles. THETA=0.785D0 PHI=0.1D0 *** Zero common blocks of output results WX=0.0D0 WY=0.0D0 WZ=0.0D0 DWX=0.0D0 DWY=0.0D0 DWZ=0.0D0 TTOTS=0.0D0 ALPHA=0.0D0 ATT=0.0D0 ALPER=0.0D0 ATTER=0.0D0 DIFLN=0.0D0 DIFTR=0.0D0 DFLER=0.0D0 DFTER=0.0D0 DIFXX=0.0D0 DIFYY=0.0D0 DIFZZ=0.0D0 DIFYZ=0.0D0 DIFXY=0.0D0 DIFXZ=0.0D0 DXXER=0.0D0 DYYER=0.0D0 DZZER=0.0D0 DYZER=0.0D0 DXYER=0.0D0 DXZER=0.0D0 DO 65 J=1,300 65 TIME(J)=0.0D0 DO 70 K=1,5*mxngas 70 ICOLL(K)=0 DO 80 K=1,512 80 ICOLN(K)=0 DO 100 K=1,2048 100 SPEC(K)=0.0D0 DO 101 K=1,8 101 TCFMAX(K)=0.0D0 *** Can set random number seed to seed value here RSTART=0.666D0 C RANDOM NUMBER SEED FUNCTION (RSTART) *** Final energy ESTART=EFINAL/50.0D0 ITHRM=0 *** Calculate thermal velocity distribution integrals C CON=1.0D-13/SQRT(AMU/(2.0D0*BOLTZJ*(TEMPC+ABZERO))) C N.B. Loaded error function integrals in data array . *** Radians per picosecond WB=AWB*BMAG*1.0D-12 *** Metres per picosecond IF(BMAG.NE.0.0D0)EOVB=EMAG*1.D-9/BMAG END +DECK,PRNTER. SUBROUTINE PRNTER *----------------------------------------------------------------------- * PRNTER - Output routine * (Last changed on 19/ 9/05.) *----------------------------------------------------------------------- IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,INPT. +SEQ,RATIO. +SEQ,SETP. +SEQ,THRM. +SEQ,BFLD. +SEQ,LARGE. +SEQ,NAMES. +SEQ,PRINTPLOT. if(.not.lbmcpr)return WRITE(LUNOUT,1) 1 FORMAT(2(/),10X,'PROGRAM MAGBOLTZ 2 VERSION 7.1 ',/) WRITE(LUNOUT,10) NGAS 10 FORMAT(10X,'MONTE CARLO SOLUTION FOR MIXTURE OF ',I2,' GASES.',/, /5X,'------------------------------------------------------') WRITE(LUNOUT,30) (NAMEG(J),FRAC(J), J=1,NGAS) 30 FORMAT(/,5X,' GASES USED ',5X,' PERCENTAGE USED ',2(/),6(6X,A15, /5X,F9.4,/)) WRITE(LUNOUT,50) TEMPC,TORR 50 FORMAT(/,2X,'GAS TEMPERATURE =',F6.1,' DEGREES CENTIGRADE.',/,2X,' /GAS PRESSURE = ',F7.1,' TORR.') WRITE(LUNOUT,60) EFINAL,NSTEP 60 FORMAT(1(/),2X,'INTEGRATION FROM 0.0 TO ',F8.2,' EV. IN ',I4,' ST /EPS. ') C IF(ITHRM.EQ.0) WRITE(LUNOUT,64) C IF(ITHRM.NE.0) WRITE(LUNOUT,65) C 64 FORMAT(2(/),' THERMAL MOTION OF GAS NOT INCLUDED') C 65 FORMAT(2(/),' THERMAL MOTION OF GAS INCLUDED') 74 WRITE(LUNOUT,90) EMAG,BMAG,BTHETA,WB 90 FORMAT(1(/),' ELECTRIC FIELD =',F12.4,' VOLTS/CM.',/' MAGNETIC F /IELD =',F11.4,' KILOGAUSS.',/,' ANGLE BETWEEN ELECTRIC AND MAGNET /IC FIELD =',F10.3,' DEGREES.',/,' CYCLOTRON FREQ. =',D12.3,' RADI /ANS/PICOSECOND') WRITE(LUNOUT,95) ESTART 95 FORMAT(1(/),' INITIAL ELECTRON ENERGY =',F8.3,' EV.') C WRITE(LUNOUT,96) RSTART C 96 FORMAT(/,' RANDOM NUMBER STARTER (SEED)=',F7.4) WRITE(LUNOUT,100) NMAX 100 FORMAT(1(/),' TOTAL NUMBER OF REAL COLLISIONS =',I11) WRITE(LUNOUT,110) (TCFMAX(L),L=1,8) 110 FORMAT(1(/),' NULL COLLISION FREQUENCY AT 8 EQUALLY SPACED ENERG /Y INTERVALS (*10**12/SEC)',/,2(4(5X,D10.3)/)) WRITE(LUNOUT,111) (TCF(L),L=128,1920,256) 111 FORMAT(' REAL COLLISION FREQUENCY AT 8 EQUALLY SPACED ENERGY INT /ERVALS (*10**12/SEC)',/,2(4(5X,D10.3)/)) END +DECK,SORT. SUBROUTINE SORT(I,R2,IE) *----------------------------------------------------------------------- * SORT - Selects collision type from collision array by binary step * sampling reduces sampling range to within 4 positions in * array. * output = i (position within 4 of correct value) * (Last changed on 28/ 7/05.) *----------------------------------------------------------------------- implicit none +SEQ,LARGE. INTEGER I,IE,ISTEP,INCR,K DOUBLE PRECISION R2 ISTEP=ISIZE INCR=0 DO 1 K=1,12 I=INCR IF(ISTEP.EQ.2) RETURN I=INCR+ISTEP IF(I.LE.IPLAST)THEN IF(CF(IE,I).LT.R2) INCR=INCR+ISTEP ENDIF ISTEP=ISTEP/2 1 CONTINUE END +DECK,MONTE. SUBROUTINE MONTE IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,LARGE. +SEQ,ANIS. +SEQ,MAGBOUT. +SEQ,THRM. +SEQ,OUTPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION XST(100000),YST(100000),ZST(100000),STO(100000) DIMENSION WZST(10),AVEST(10) DIMENSION DFZZST(10),DFYYST(10),DFXXST(10) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C USED WITH MAGNETIC FIELD B =0.0 ELECTRIC FIELD IN Z DIRECTION. C ------------------------------------------------------------------- WX=0.0D0 WY=0.0D0 DWX=0.0D0 DWY=0.0D0 DIFYZ=0.0D0 DIFXY=0.0D0 DIFXZ=0.0D0 DYZER=0.0D0 DXYER=0.0D0 DXZER=0.0D0 X=0.0D0 Y=0.0D0 Z=0.0D0 ST=0.0D0 ST1=0.0D0 ST2=0.0D0 SUME2=0.0D0 SUMXX=0.0D0 SUMYY=0.0D0 SUMZZ=0.0D0 SUMVX=0.0D0 SUMVY=0.0D0 ZOLD=0.0D0 STOLD=0.0D0 ST1OLD=0.0D0 ST2OLD=0.0D0 SZZOLD=0.0D0 SXXOLD=0.0D0 SYYOLD=0.0D0 SVXOLD=0.0D0 SVYOLD=0.0D0 SME2OLD=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 ARAT=EMASS/AMU INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=100000 TDASH=0.0D0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) E=E1+(AP+BP*T)*T IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) C if(lbmcpr)WRITE(lunout,996) C996 FORMAT(/,5X,' WARNING NULL COLLISION TIME INCREASED',/) GO TO 1 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) THEN NNULL=NNULL+1 GO TO 1 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0D0+B/3.0D0) CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 CX1=DCX1*CONST7 CY1=DCY1*CONST7 CZ1=DCZ1*CONST7 X=X+DCX1*A Y=Y+DCY1*A Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 WZ=Z/ST SUMVX=SUMVX+CX1*CX1*T2 SUMVY=SUMVY+CY1*CY1*T2 IF(ID.EQ.0) GO TO 121 KDUM=0 DO 120 JDUM=1,4 ST2=ST2+T NCOLDM=NCOL+KDUM IF(NCOLDM.GT.NCOLM) NCOLDM=NCOLDM-NCOLM SDIF=ST-STO(NCOLDM) SUMXX=SUMXX+((X-XST(NCOLDM))**2)*T/SDIF SUMYY=SUMYY+((Y-YST(NCOLDM))**2)*T/SDIF IF(J1.LT.3) GO TO 120 ST1=ST1+T SUMZZ=SUMZZ+((Z-ZST(NCOLDM)-WZ*SDIF)**2)*T/SDIF 120 KDUM=KDUM+12500 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM) THEN ID=ID+1 XID=DBLE(ID) NCOL=0 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) C FIND LOCATION WITHIN 4 UNITS IN COLLISION ARRAY CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).LE.0) GO TO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IF(E.LT.EI) THEN C if(lbmcpr)WRITE(lunout,994) E,EI,J2 C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001D0 ENDIF S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE C ISOTROPIC SCATTERING R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C if(lbmcpr)WRITE(lunout,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 C /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 130 CONTINUE 133 CONTINUE C ------------------------------------------ IF(J1.EQ.1.and.lbmcpr) WRITE(lunout,201) 201 FORMAT(/,' VEL POS TIME ENERGY COUNT DIFXX / DIFYY DIFZZ',/) WZ=WZ*1.0D+09 AVE=SUME2/ST DIFLN=0.0D0 IF(NISO.EQ.0) THEN DIFXX=5.0D+15*SUMVX/ST DIFYY=5.0D+15*SUMVY/ST DFXXST(J1)=5.0D+15*(SUMVX-SVXOLD)/(ST-STOLD) DFYYST(J1)=5.0D+15*(SUMVY-SVYOLD)/(ST-STOLD) ELSE IF(ST2.NE.0.0D0) THEN DIFYY=5.0D+15*SUMYY/ST2 DIFXX=5.0D+15*SUMXX/ST2 DFXXST(J1)=5.0D+15*(SUMXX-SXXOLD)/(ST2-ST2OLD) DFYYST(J1)=5.0D+15*(SUMYY-SYYOLD)/(ST2-ST2OLD) ELSE DFXXST(J1)=0.0D0 DFYYST(J1)=0.0D0 ENDIF ENDIF IF(ST1.NE.0.0D0) THEN DIFZZ=5.0D+15*SUMZZ/ST1 DFZZST(J1)=5.0D+15*(SUMZZ-SZZOLD)/(ST1-ST1OLD) ELSE DFZZST(J1)=0.0D0 ENDIF WZST(J1)=(Z-ZOLD)/(ST-STOLD)*1.0D+09 AVEST(J1)=(SUME2-SME2OLD)/(ST-STOLD) ZOLD=Z STOLD=ST ST1OLD=ST1 ST2OLD=ST2 SVXOLD=SUMVX SVYOLD=SUMVY SZZOLD=SUMZZ SXXOLD=SUMXX SYYOLD=SUMYY SME2OLD=SUME2 if(lbmcpr)WRITE(lunout,202) WZ,Z,ST,AVE,ID,DIFXX,DIFYY,DIFZZ 202 FORMAT(1X,F8.2,2(1X,D10.3),F9.4,1X,I5,1X,3(2X,F8.1)) C LOOP 210 CONTINUE C CALCULATE ERRORS AND CHECK AVERAGES TWZST=0.0D0 TAVE=0.0D0 T2WZST=0.0D0 T2AVE=0.0D0 TZZST=0.0D0 TYYST=0.0D0 TXXST=0.0D0 T2ZZST=0.0D0 T2YYST=0.0D0 T2XXST=0.0D0 DO 768 K=1,10 TWZST=TWZST+WZST(K) TAVE=TAVE+AVEST(K) T2WZST=T2WZST+WZST(K)*WZST(K) T2AVE=T2AVE+AVEST(K)*AVEST(K) TXXST=TXXST+DFXXST(K) TYYST=TYYST+DFYYST(K) T2YYST=T2YYST+DFYYST(K)*DFYYST(K) T2XXST=T2XXST+DFXXST(K)*DFXXST(K) IF(K.LT.3) GO TO 768 TZZST=TZZST+DFZZST(K) T2ZZST=T2ZZST+DFZZST(K)*DFZZST(K) 768 CONTINUE DWZ=100.0D0*SQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZ DEN=100.0D0*SQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DXXER=100.0D0*SQRT((T2XXST-TXXST*TXXST/10.0D0)/9.0D0)/DIFXX DYYER=100.0D0*SQRT((T2YYST-TYYST*TYYST/10.0D0)/9.0D0)/DIFYY DZZER=100.0D0*SQRT((T2ZZST-TZZST*TZZST/8.0D0)/7.0D0)/DIFZZ DIFLN=DIFZZ DIFTR=(DIFXX+DIFYY)/2.0D0 C CONVERT CM/SEC WZ=WZ*1.0D05 DFLER=DZZER DFTER=(DXXER+DYYER)/2.0D0 C CALCULATE TOWNSEND COEFICIENTS AND ERRORS ANCATT=0.0D0 ANCION=0.0D0 DO 800 I=1,NGAS ANCATT=ANCATT+ICOLL((5*I)-2) 800 ANCION=ANCION+ICOLL((5*I)-3) ATTER=0.0D0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0D0*SQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0D0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0D0*SQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 END +DECK,DLCMIC. SUBROUTINE DLCMIC(X1,Y1,Z1,OPTION,NCOPT,EF,ES,DIRX,DIRY,DIRZ, - IRCS,IHF) *----------------------------------------------------------------------- * DLCMIC - Microscopic MC tracking front-end * NSTATL(IPT): 1=elastic, 2=ionise, 3=attach, 4=excitation, * 5=super-elastic, 6=inelastic * NSTATN(I) : individual level described in DSCRPT(I) * (Last changed on 25/ 5/09.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,MATDATA. +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,LARGE. +SEQ,SCRIP. +SEQ,NAMES. +SEQ,PRINTPLOT. +SEQ,DRIFTLINE. REAL X1,Y1,Z1,EF,ES,DIRX,DIRY,DIRZ,DNORM INTEGER IFAIL,NSTATL(5*MXNGAS),NSTATN(512),I,IPT,IGAS,ITYPE, - IREF,IHF,ISIZ(1),MATSLT,IRCS,ISCS,NCOPT LOGICAL LPLION,LPLEXC,LPLINE,LPLELA,LPLSUP,LPLATT, - lheinrich CHARACTER*(*) OPTION EXTERNAL MATSLT *** Check the energy IF(ES.LT.0)THEN PRINT *,' !!!!!! DLCMIC WARNING : Starting energy is'// - ' negative; abandoned.' NU=0 ISTAT=-3 RETURN ELSEIF(EF.LE.0)THEN PRINT *,' !!!!!! DLCMIC WARNING : Final energy is'// - ' non-positive; abandoned.' NU=0 ISTAT=-3 RETURN ENDIF *** Initialise the gas CALL DLCMII(EF,NSTATL,NSTATN,IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! DLCMIC WARNING : Initialisation failed'// - ' ; no calculation performed.' RETURN ENDIF *** Decode the options: Magboltz print option. LBMCPR=.FALSE. IF(INDEX(OPTION(1:NCOPT),'NOPRINT').NE.0)THEN LBMCPR=.FALSE. ELSEIF(INDEX(OPTION(1:NCOPT),'PRINT').NE.0)THEN LBMCPR=.TRUE. ENDIF * Mark ionisations LPLION=.FALSE. IF(INDEX(OPTION(1:NCOPT),'NOMARK-ION').NE.0)THEN LPLION=.FALSE. ELSEIF(INDEX(OPTION(1:NCOPT),'MARK-ION').NE.0)THEN LPLION=.TRUE. ENDIF * Mark excitations LPLEXC=.FALSE. IF(INDEX(OPTION(1:NCOPT),'NOMARK-EXC').NE.0)THEN LPLEXC=.FALSE. ELSEIF(INDEX(OPTION(1:NCOPT),'MARK-EXC').NE.0)THEN LPLEXC=.TRUE. ENDIF * Mark inelastic LPLINE=.FALSE. IF(INDEX(OPTION(1:NCOPT),'NOMARK-INEL').NE.0)THEN LPLINE=.FALSE. ELSEIF(INDEX(OPTION(1:NCOPT),'MARK-INEL').NE.0)THEN LPLINE=.TRUE. ENDIF * Mark elastic LPLELA=.FALSE. IF(INDEX(OPTION(1:NCOPT),'NOMARK-ELAS').NE.0)THEN LPLELA=.FALSE. ELSEIF(INDEX(OPTION(1:NCOPT),'MARK-ELAS').NE.0)THEN LPLELA=.TRUE. ENDIF * Mark super-elastic LPLSUP=.FALSE. IF(INDEX(OPTION(1:NCOPT),'NOMARK-SUP').NE.0)THEN LPLSUP=.FALSE. ELSEIF(INDEX(OPTION(1:NCOPT),'MARK-SUP').NE.0)THEN LPLSUP=.TRUE. ENDIF * Mark attachment LPLATT=.FALSE. IF(INDEX(OPTION(1:NCOPT),'NOMARK-ATT').NE.0)THEN LPLATT=.FALSE. ELSEIF(INDEX(OPTION(1:NCOPT),'MARK-ATT').NE.0)THEN LPLATT=.TRUE. ENDIF * Heinrich options lheinrich=.FALSE. IF(INDEX(OPTION(1:NCOPT),'NOHEINRICH').NE.0)THEN lheinrich=.FALSE. ELSEIF(INDEX(OPTION(1:NCOPT),'HEINRICH').NE.0)THEN lheinrich=.TRUE. ENDIF *** Book an histogram for the energy distribution, if needed. IF(IHF.LT.0)THEN CALL HISADM('ALLOCATE',IHF,100,0.0,EF,.FALSE.,IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! DLCMIC WARNING : Unable to obtain'// - ' matrix storage; energy not histogrammed.' IHF=0 ENDIF ENDIF *** Normalise the initial vector. IF(DIRX**2+DIRY**2+DIRZ**2.LE.0)THEN PRINT *,' !!!!!! DLCMIC WARNING : Initial direction'// - ' vector has zero norm; no calculation.' RETURN ELSE DNORM=SQRT(DIRX**2+DIRY**2+DIRZ**2) DIRX=DIRX/DNORM DIRY=DIRY/DNORM DIRZ=DIRZ/DNORM ENDIF *** Step. CALL DLCMST(X1,Y1,Z1,EF,ES,DIRX,DIRY,DIRZ,NSTATL,NSTATN,IHF, - LPLION,LPLEXC,LPLINE,LPLELA,LPLSUP,LPLATT,lheinrich) *** Extract the statistics: first initialise the counters. IF(IRCS.GT.0)THEN * Loop over the levels. DO 10 I=1,IPLAST IPT=IARRY(I) IGAS=1+(IPT-1)/5 ITYPE=IPT-5*(IGAS-1) IF(ITYPE.EQ.4.AND.DSCRPT(I)(1:4).NE.' EXC')ITYPE=6 CALL GASIDO(IREF,NAMEG(IGAS)//DSCRPT(I),ITYPE,0.0,IFAIL) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMIC DEBUG :'', - '' Gas '',I3,'', cs type '',I1,'', cs "'',A,''",'', - '' count '',I6,'', ref '',I3)') IGAS,ITYPE,DSCRPT(I), - NSTATN(I),IREF IF(IFAIL.NE.0)PRINT *,' !!!!!! DLCMIC WARNING : Unable'// - ' to store a rate.' 10 CONTINUE *** Store the matrices: elastic. ISIZ(1)=IPLAST CALL MATADM('ALLOCATE',IRCS,1,ISIZ,2,IFAIL) ISCS=MATSLT(IRCS) DO 20 I=1,IPLAST MVEC(MORG(ISCS)+I)=NSTATN(I) 20 CONTINUE ENDIF END SUBROUTINE DLCMII(EF,NSTATL,NSTATN,IFAIL) *----------------------------------------------------------------------- * DLCMII - Initialisation for microscopic MC tracking. * (Last changed on 3/ 4/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,INPT. INTEGER I,IFAIL,NMAX,NSTATL(5*MXNGAS),NSTATN(512) DOUBLE PRECISION E,B,BTH,T,P REAL EF,PGAS,TGAS,FRASUM,GASFRM(MXGNAM) CHARACTER*80 GASID *** Retrieve pressure and temperature. CALL GASINF(PGAS,TGAS,GASID,GASFRM) *** Set the gas mixture. FRASUM=0 DO 10 I=1,MXGNAM FRAMIX(I)=GASFRM(I) FRASUM=FRASUM+FRAMIX(I) 10 CONTINUE IF(FRASUM.LE.0)THEN PRINT *,' !!!!!! DLCMII WARNING : Sum of gas fractions'// - ' less or equal to 0; no calculation.' IFAIL=1 RETURN ENDIF *** Set E, B and angle: dummy values E=1000.0 B=0.0 BTH=0.0 * Set the pressure and temperature. T=TGAS P=PGAS * Number of collisions: dummy value NMAX=2 *** Establish the parameters. CALL SETB7(E,B,BTH,T,P,NMAX,IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! DLCMII WARNING : Setting Magboltz'// - ' parameters failed.' IFAIL=1 RETURN ENDIF * Overrrule the energy limit EFINAL=DBLE(EF) *** Mix the gases CALL MIXER7(IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! DLCMII WARNING : Setting Magboltz'// - ' cross section tables failed.' IFAIL=1 RETURN ENDIF *** Plot the cross sections C call gaspcs('DLCMIC') *** Initial statistics. DO 20 I=1,5*MXNGAS NSTATL(I)=0 20 CONTINUE DO 30 I=1,512 NSTATN(I)=0 30 CONTINUE *** Has worked. IFAIL=0 END SUBROUTINE DLCMST(X1,Y1,Z1,EF,ES,DIRX,DIRY,DIRZ, - NSTATL,NSTATN,IHF, - LPLION,LPLEXC,LPLINE,LPLELA,LPLSUP,LPLATT,lheinrich) *----------------------------------------------------------------------- * DLCMST - Microscopic MC tracking, derived from MONTE * (Last changed on 2/ 8/10.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,DIMENSIONS. +SEQ,INPT. +SEQ,CNSTS. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,LARGE. +SEQ,ANIS. +SEQ,SCRIP. +SEQ,PRINTPLOT. +SEQ,DRIFTLINE. DOUBLE PRECISION X,Y,Z,ST,RDUM,E1,E,EX,EY,EZ, - CONST6,CONST7,CONST9,TDASH,TLIM,T,T2, - DCX1,DCY1,DCZ1,DCX2,DCY2,DCZ2,THETA0,PHI0, - AP,BP,A,F3,F4,F5,F6,F8,F9,R1,R2,R3,R4,R5,R9,R31, - S1,S2,EXTRA,EI,D,Q,ARG1,ARGZ,CSQD,DELTAE,U, - DRAND48,EMAX,XPL(1),YPL(1),ZPL(1), - xold, yold, zold, eold REAL X1,Y1,Z1,ES,EF,XS,YS,ZS,EXS,EYS,EZS,ETOTS,VOLTS, - DIRX,DIRY,DIRZ,XNEW,YNEW,ZNEW,DELAY,ENEW INTEGER INTEM,J1,NCOL,NNULL,I,IE,IPT,ILOC,IGAS,ITYPE, - NSTATL(5*MXNGAS),NSTATN(512),IHF LOGICAL LPLION,LPLEXC,LPLINE,LPLELA,LPLSUP,LPLATT,lheinrich, - ADDNEW EXTERNAL DRAND48 integer ioncount *** Debugging IF(LDEBUG)WRITE(LUNOUT,*) ' ++++++ DLCMST DEBUG : Start: ', - X1,Y1,Z1,', energy start/max: ',ES,EF *** Initialise the steps NU=1 XU(NU)=DBLE(X1) YU(NU)=DBLE(Y1) ZU(NU)=DBLE(Z1) TU(NU)=0 CALL DLCSTA(-1.0,1) IF(ISTAT.NE.0)RETURN *** Heinrich options. if(lheinrich)then open(unit=38,file='heinrich.dump') endif *** Set technique and particle labels IPTYPE=1 QPCHAR=-1.0 IPTECH=4 *** Starting point. X=X1/1.0D2 Y=Y1/1.0D2 Z=Z1/1.0D2 * Starting time. ST=0.0D0 * Starting energy and keeping track of energy E1=DBLE(ES) EMAX=E1 * Various parameters. SMALL=1.0D-20 RDUM=RSTART CONST9=CONST3*0.01D0 INTEM=8 NCOL=0 NNULL=0 * Number of collisions for de-correlation ? TDASH=0.0D0 *** Initial direction cosines DCX1=DBLE(DIRX) DCY1=DBLE(DIRY) DCZ1=DBLE(DIRZ) * Parameters to compute position after step F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) *** Main loop DO 210 J1=1,100000000 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG : Step '', - I3,'', iteration '',I5,'', collision '',I5)') NU,J1,NCOL *** Get the electric and magnetic field XS=REAL(X*100.0) YS=REAL(Y*100.0) ZS=REAL(Z*100.0) CALL EFIELD(XS,YS,ZS,EXS,EYS,EZS,ETOTS,VOLTS,0,ILOC) EX=-DBLE(EXS) EY=-DBLE(EYS) EZ=-DBLE(EZS) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG : At ('', - 3E15.8,''), E = ('',3E15.8,''), loc = '',I5,'', nu = '', - I5)') X,Y,Z,EX,EY,EZ,ILOC,NU * If this is not in the drift medium, stop now. IF(ILOC.NE.0.OR. - XS.LT.DDXMIN.OR.XS.GT.DDXMAX.OR. - YS.LT.DDYMIN.OR.YS.GT.DDYMAX.OR. - ZS.LT.DDZMIN.OR.ZS.GT.DDZMAX)THEN IF(NU.GE.MXLIST)THEN ISTAT=-2 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG :'', - '' Too many steps, istat = -2, e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') EMAX,NU,NCOL * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF IF(ILOC.EQ.-5.OR.ILOC.EQ.-6)THEN CALL DLCFMP(XU(NU),YU(NU),ZU(NU), - X*1.0D2,Y*1.0D2,Z*1.0D2, - T*1.0D-6,ILOC,QPCHAR,IPTECH) ELSE NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 CALL DLCSTA(-1.0,1) ENDIF IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG :'', - '' loc = '',I5,'', istat = '',I5,'', e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') - ILOC,ISTAT,EMAX,NU,NCOL * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF *** Determine free time 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=CONST3*(DCX1*EX+DCY1*EY+DCZ1*EZ)*SQRT(E1) BP=(EX**2+EY**2+EZ**2)*CONST1 E=E1+(AP+BP*T)*T * Keep track of the highest energy EMAX=MAX(E,EMAX) IF(E.GT.EFINAL)THEN IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG :'', - '' Energy '',E15.8,'' eV exceeds e_maximum '',E15.8, - '' eV; abandoned at nu = '',I4,'', ncol = '',I5)') - E,EFINAL,NU,NCOL IF(NU.GE.MXLIST)THEN ISTAT=-2 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG :'', - '' Too many steps, istat = -2, e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') EMAX,NU,NCOL * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 ISTAT=-9 * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF IF(IHF.GT.0)CALL HISENT(IHF,REAL(E),1.0) * Check null collisions IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) IF(LBMCPR)WRITE(LUNOUT,996) 996 FORMAT(/,5X,' WARNING NULL COLLISION TIME INCREASED',/) GO TO 1 ENDIF * Test for real or null collision R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) THEN IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG :'', - '' Null collision.'')') NNULL=NNULL+1 GO TO 1 ENDIF *** Direction cosines and positions at instant before collision T2=T*T TDASH=0.0D0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6+EX*T*CONST5/SQRT(E) DCY2=DCY1*CONST6+EY*T*CONST5/SQRT(E) DCZ2=DCZ1*CONST6+EZ*T*CONST5/SQRT(E) * const7: velocity [m/psec], a: velocity time [m] CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 xold=x yold=y zold=z eold=e1 X=X+DCX1*A+T2*EX*CONST2 Y=Y+DCY1*A+T2*EY*CONST2 Z=Z+DCZ1*A+T2*EZ*CONST2 ST=ST+T *** Add new point IF(NMC*(NCOL/NMC).EQ.NCOL)THEN IF(NU.GE.MXLIST)THEN ISTAT=-2 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG :'', - '' Too many steps, istat = -2, e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') EMAX,NU,NCOL * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 ENDIF *** Determination of real collision type R2=drand48(RDUM) * Find location within 4 units in collision array CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) * Use flat distribution of electron energy between E-EION and 0.0 eV IF(IPN(I).GT.0)THEN R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI ENDIF *** Generate scattering angles, update lab cosines, type of collision. IPT=IARRY(I) IGAS=1+(IPT-1)/5 ITYPE=IPT-5*(IGAS-1) * NSTATL(IPT): 1=elastic, 2=ionise, 3=attach, 4=inelastic, 5=super NSTATL(IPT)=NSTATL(IPT)+1 * NSTATN(I): individual level described in DSCRPT(I) NSTATN(I)=NSTATN(I)+1 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG : Gas '',I3, - '' type '',I1,'' level '',A)') IGAS,ITYPE,DSCRPT(I) * Elastic. XPL(1)=X*1.0D2 YPL(1)=Y*1.0D2 ZPL(1)=Z*1.0D2 IF(ITYPE.EQ.1.AND.LPLELA)THEN CALL GRATTS('ELASTIC','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) * Ionisation. ELSEIF(ITYPE.EQ.2.AND.LPLION)THEN CALL GRATTS('IONISATION','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) * Heinrich update if(lheinrich)ioncount=ioncount+1 * Electron ends due to attachment. ELSEIF(ITYPE.EQ.3)THEN IF(LPLATT)THEN CALL GRATTS('ATTACHMENT','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ENDIF IF(NU.GE.MXLIST)THEN ISTAT=-2 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG :'', - '' Too many steps, istat = -2, e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') EMAX,NU,NCOL * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF IF(ABS(TU(NU)-ST*1.0D-6).GT.1.0D-6)THEN NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 ENDIF ISTAT=-7 * Heinrich options. if(lheinrich)close(unit=38) RETURN * Inelastic and excitation. ELSEIF(ITYPE.EQ.4.AND.(LPLINE.OR.LPLEXC))THEN IF(LPLEXC.AND.DSCRPT(I)(1:4).EQ.' EXC')THEN CALL GRATTS('EXCITATION','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ELSEIF(LPLINE.AND.DSCRPT(I)(1:4).NE.' EXC')THEN CALL GRATTS('INELASTIC','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ENDIF * Super-elastic ELSEIF(ITYPE.EQ.5.AND.LPLSUP)THEN CALL GRATTS('SUPER-ELASTIC','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ENDIF * Call a user procedure to dealing with excitations. CALL GASEXU(ITYPE,IGAS,I, - REAL(X*100),REAL(Y*100),REAL(Z*100), - REAL(E),REAL(ST*1.0D-6), - ADDNEW,XNEW,YNEW,ZNEW,DELAY,ENEW) * Write a Heinrich record if(lheinrich)then write(38,'(1x,I5,2X,i5,8(e20.13,2x),a)') itype,ioncount, - x*100,y*100,z*100,e, - xold*100,yold*100,zold*100,eold,dscrpt(i) endif *** Fix energy loss smaller than incident energy if error occurs IF(E.LT.EI) THEN IF(LBMCPR)WRITE(LUNOUT,994) E,EI,J1 994 FORMAT(2X,' WARNING ENERGY =',F10.5, - ' LESS THAN ENERGY LOSS EI=',F10.5,' AT ITER=',I12, - ' DUE TO BINNING ERROR') IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMST DEBUG : Gas '',I3, - '' type '',I1,'' level '',A)') IGAS,ITYPE,DSCRPT(I) EI=E-0.0001D0 ENDIF * Scatter S2=(S1*S1)/(S1-1.0D0) * Anisotropic scattering to obtain theta IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 * Isotropic scattering ELSE R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) * Obtain phi R4=drand48(RDUM) PHI0=F4*R4 * Work out the new direction F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN IF(LBMCPR)WRITE(LUNOUT,9232) J1,E1 9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT J1 =',I10,' E1=',E12.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 ELSE DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) ENDIF 210 CONTINUE *** End of loop. PRINT *,' !!!!!! DLCMST WARNING : Reached end of loop, should'// - ' not happen; returning ISTAT = -2.' ISTAT=-2 * Heinrich options. if(lheinrich)close(unit=38) END SUBROUTINE DLCMIA(X1,Y1,Z1,OPTION,EF,ES,DIRX,DIRY,DIRZ,IRCS,IHF, - TOFF,NETOT,NITOT,IFAIL) *----------------------------------------------------------------------- * DLCMIA - Microscopic MC tracking front-end * NSTATL(IPT): 1=elastic, 2=ionise, 3=attach, 4=excitation, * 5=super-elastic, 6=inelastic * NSTATN(I) : individual level described in DSCRPT(I) * (Last changed on 15/12/10.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,MATDATA. +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,LARGE. +SEQ,SCRIP. +SEQ,NAMES. +SEQ,PRINTPLOT. +SEQ,SIGNALDATA. +SEQ,DRIFTLINE. REAL X1,Y1,Z1,EF,ES,DIRX,DIRY,DIRZ,DNORM,TOFF INTEGER IFAIL1,IFAIL,NSTATL(5*MXNGAS),NSTATN(512),I,IPT,IGAS, - ITYPE,IREF,IHF,ISIZ(1),MATSLT,IRCS,ISCS,NETOT,NITOT,NEMAX LOGICAL LPLION,LPLEXC,LPLINE,LPLELA,LPLSUP,LPLATT,LELEPL,LIONPL, - lheinrich,LSIGAD CHARACTER*(*) OPTION EXTERNAL MATSLT *** Assume this will fail. IFAIL=1 *** Check the energy IF(ES.LT.0)THEN PRINT *,' !!!!!! DLCMIA WARNING : Starting energy is'// - ' negative; abandoned.' NU=0 ISTAT=-3 RETURN ELSEIF(EF.LE.0)THEN PRINT *,' !!!!!! DLCMIA WARNING : Final energy is'// - ' non-positive; abandoned.' NU=0 ISTAT=-3 RETURN ENDIF *** Initialise the gas CALL DLCMII(EF,NSTATL,NSTATN,IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! DLCMIA WARNING : Initialisation failed'// - ' ; no calculation performed.' RETURN ENDIF *** Decode the options: Magboltz print option. LBMCPR=.FALSE. IF(INDEX(OPTION,'NOPRINT').NE.0)THEN LBMCPR=.FALSE. ELSEIF(INDEX(OPTION,'PRINT').NE.0)THEN LBMCPR=.TRUE. ENDIF * Mark ionisations LPLION=.FALSE. IF(INDEX(OPTION,'NOMARK-ION').NE.0)THEN LPLION=.FALSE. ELSEIF(INDEX(OPTION,'MARK-ION').NE.0)THEN LPLION=.TRUE. ENDIF * Mark excitations LPLEXC=.FALSE. IF(INDEX(OPTION,'NOMARK-EXC').NE.0)THEN LPLEXC=.FALSE. ELSEIF(INDEX(OPTION,'MARK-EXC').NE.0)THEN LPLEXC=.TRUE. ENDIF * Mark inelastic LPLINE=.FALSE. IF(INDEX(OPTION,'NOMARK-INEL').NE.0)THEN LPLINE=.FALSE. ELSEIF(INDEX(OPTION,'MARK-INEL').NE.0)THEN LPLINE=.TRUE. ENDIF * Mark elastic LPLELA=.FALSE. IF(INDEX(OPTION,'NOMARK-ELAS').NE.0)THEN LPLELA=.FALSE. ELSEIF(INDEX(OPTION,'MARK-ELAS').NE.0)THEN LPLELA=.TRUE. ENDIF * Mark super-elastic LPLSUP=.FALSE. IF(INDEX(OPTION,'NOMARK-SUP').NE.0)THEN LPLSUP=.FALSE. ELSEIF(INDEX(OPTION,'MARK-SUP').NE.0)THEN LPLSUP=.TRUE. ENDIF * Mark attachment LPLATT=.FALSE. IF(INDEX(OPTION,'NOMARK-ATT').NE.0)THEN LPLATT=.FALSE. ELSEIF(INDEX(OPTION,'MARK-ATT').NE.0)THEN LPLATT=.TRUE. ENDIF * Heinrich options lheinrich=.FALSE. IF(INDEX(OPTION,'NOHEINRICH').NE.0)THEN lheinrich=.FALSE. ELSEIF(INDEX(OPTION,'HEINRICH').NE.0)THEN lheinrich=.TRUE. ENDIF * Signal LSIGAD=.FALSE. IF(INDEX(OPTION,'NOSIGNAL').NE.0)THEN LSIGAD=.FALSE. ELSEIF(INDEX(OPTION,'SIGNAL').NE.0)THEN LSIGAD=.TRUE. ENDIF *** Electron and ion tracking, avalanche limit LELEPL=.FALSE. LIONPL=.FALSE. NEMAX=0 * Decode the options. IF(INDEX(OPTION,'NOPLOT-ELECTRON').NE.0)THEN LELEPL=.FALSE. ELSEIF(INDEX(OPTION,'PLOT-ELECTRON').NE.0)THEN LELEPL=.TRUE. ENDIF IF(INDEX(OPTION,'NOPLOT-ION').NE.0)THEN LIONPL=.FALSE. ELSEIF(INDEX(OPTION,'PLOT-ION').NE.0)THEN LIONPL=.TRUE. ENDIF IF(INDEX(OPTION,'ABORT-100000').NE.0)THEN NEMAX=100000 ELSEIF(INDEX(OPTION,'ABORT-10000').NE.0)THEN NEMAX=10000 ELSEIF(INDEX(OPTION,'ABORT-1000').NE.0)THEN NEMAX=1000 ELSEIF(INDEX(OPTION,'ABORT-100').NE.0)THEN NEMAX=100 ELSEIF(INDEX(OPTION,'ABORT-10').NE.0)THEN NEMAX=10 ENDIF *** Book an histogram for the energy distribution, if needed. IF(IHF.LT.0)THEN CALL HISADM('ALLOCATE',IHF,100,0.0,EF,.FALSE.,IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! DLCMIA WARNING : Unable to obtain'// - ' matrix storage; energy not histogrammed.' IHF=0 ENDIF ENDIF *** Normalise the initial vector. IF(DIRX**2+DIRY**2+DIRZ**2.LE.0)THEN PRINT *,' !!!!!! DLCMIA WARNING : Initial direction'// - ' vector has zero norm; no calculation.' RETURN ELSE DNORM=SQRT(DIRX**2+DIRY**2+DIRZ**2) DIRX=DIRX/DNORM DIRY=DIRY/DNORM DIRZ=DIRZ/DNORM ENDIF *** Initialise signal calculations if not yet done. IF(LSIGAD.AND..NOT.SIGSET)THEN CALL SIGINI(IFAIL1) IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! DLCMIA WARNING : Initialisation of'// - ' signal calculation failed; no avalanche.' RETURN ENDIF ENDIF *** Step. CALL DLCMSA(X1,Y1,Z1,EF,ES,DIRX,DIRY,DIRZ, - NSTATL,NSTATN,IHF,TOFF,NETOT,NITOT, - LPLION,LPLEXC,LPLINE,LPLELA,LPLSUP,LPLATT, - LELEPL,LIONPL,lheinrich,LSIGAD,NEMAX,IFAIL1) * Check error condition. IF(IFAIL1.NE.0)RETURN *** Extract the statistics: first initialise the counters. IF(IRCS.GT.0)THEN * Loop over the levels. DO 10 I=1,IPLAST IPT=IARRY(I) IGAS=1+(IPT-1)/5 ITYPE=IPT-5*(IGAS-1) IF(ITYPE.EQ.4.AND.DSCRPT(I)(1:4).NE.' EXC')ITYPE=6 CALL GASIDO(IREF,NAMEG(IGAS)//DSCRPT(I),ITYPE,0.0,IFAIL1) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMIA DEBUG :'', - '' Gas '',I3,'', cs type '',I1,'', cs "'',A,''",'', - '' count '',I6,'', ref '',I3)') IGAS,ITYPE,DSCRPT(I), - NSTATN(I),IREF IF(IFAIL1.NE.0)PRINT *,' !!!!!! DLCMIA WARNING : Unable'// - ' to store a rate.' 10 CONTINUE *** Store the matrices: elastic. ISIZ(1)=IPLAST CALL MATADM('ALLOCATE',IRCS,1,ISIZ,2,IFAIL1) ISCS=MATSLT(IRCS) DO 20 I=1,IPLAST MVEC(MORG(ISCS)+I)=NSTATN(I) 20 CONTINUE ENDIF *** Success IFAIL=0 END SUBROUTINE DLCMSA(X1,Y1,Z1,EF,ES,DIRX,DIRY,DIRZ, - NSTATL,NSTATN,IHF,TOFF,NETOT,NITOT, - LPLION,LPLEXC,LPLINE,LPLELA,LPLSUP,LPLATT, - LELEPL,LIONPL,lheinrich,LSIGAD,NEMAX,IFAIL) *----------------------------------------------------------------------- * DLCMSA - Microscopic MC tracking, with avalanche derived from MONTE. * (Last changed on 2/ 8/10.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,MAGBPARM. +SEQ,DIMENSIONS. +SEQ,INPT. +SEQ,CNSTS. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,LARGE. +SEQ,ANIS. +SEQ,SCRIP. +SEQ,PRINTPLOT. +SEQ,DRIFTLINE. +SEQ,MCAMAT. INTEGER NCOLM PARAMETER(NCOLM=1000000) DOUBLE PRECISION X,Y,Z,ST,RDUM,E1,E,EX,EY,EZ, - CONST6,CONST7,CONST9,TDASH,TLIM,T,T2, - DCX1,DCY1,DCZ1,DCX2,DCY2,DCZ2,THETA0,PHI0, - AP,BP,A,F3,F4,F5,F6,F8,F9,R1,R2,R3,R4,R5,R9,R31, - S1,S2,EXTRA,EI,D,Q,ARG1,ARGZ,CSQD,DELTAE,U, - DRAND48,EMAX,XPL(1),YPL(1),ZPL(1),ESEC REAL X1,Y1,Z1,ES,EF,XS,YS,ZS,EXS,EYS,EZS,ETOTS,VOLTS, - DIRX,DIRY,DIRZ,XNEW,YNEW,ZNEW,DELAY,ENEW,TOFF C - ,exs2,eys2,ezs2,etots2 INTEGER INTEM,J1,NCOL,NNULL,I,IE,IPT,ILOC,IGAS,ITYPE,NEMAX, - NSTATL(5*MXNGAS),NSTATN(512),IHF,NETOT,NITOT,IMCA,IFAIL1, - IFAIL LOGICAL LPLION,LPLEXC,LPLINE,LPLELA,LPLSUP,LPLATT,LELEPL,LIONPL, - lheinrich,LSIGAD,ADDNEW EXTERNAL DRAND48 integer ioncount *** By default, failure. IFAIL=1 print *,' Microscopic avalanche' print *,' Position: ',x1,y1,z1 print *,' Energy: at start ',es,' eV, maximal ',ef,' eV' print *,' Velocity vector: ',dirx,diry,dirz *** Initialise the avalanche table. NMCA=1 XLIST(1)=X1/1.0D2 YLIST(1)=Y1/1.0D2 ZLIST(1)=Z1/1.0D2 TLIST(1)=TOFF/1.0D-6 ELIST(1)=ES EMAX=ELIST(1) NETOT=1 NITOT=0 *** Heinrich options. if(lheinrich)then open(unit=38,file='heinrich.ions') endif *** Loop over the table. IMCA=0 100 CONTINUE IMCA=IMCA+1 * Check we are still in the table. IF(IMCA.GT.NMCA)THEN * Release memory. CALL BOOK('RELEASE','MCAMAT','MCA',IFAIL1) * This was a success IFAIL=0 * Heinrich options. if(lheinrich)close(unit=38) * Return RETURN ENDIF *** Starting point. X=XLIST(IMCA) Y=YLIST(IMCA) Z=ZLIST(IMCA) * Starting time. ST=TLIST(IMCA) * Starting energy. E1=DBLE(ELIST(IMCA)) *** Initialise the steps NU=1 XU(NU)=100.0*X YU(NU)=100.0*Y ZU(NU)=100.0*Z TU(NU)=1.0D-6*ST *** Set technique and particle labels IPTYPE=1 QPCHAR=-1.0 IPTECH=4 *** Restart ionisation counter ioncount=0 *** Get the electric and magnetic field for the starting point. XS=REAL(X*100.0) YS=REAL(Y*100.0) ZS=REAL(Z*100.0) CALL EFIELD(XS,YS,ZS,EXS,EYS,EZS,ETOTS,VOLTS,0,ILOC) EX=-DBLE(EXS) EY=-DBLE(EYS) EZ=-DBLE(EZS) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG : At ('', - 3E15.8,''), E = ('',3E15.8,''), loc = '',I5,'', nu = '', - I5)') X,Y,Z,EX,EY,EZ,ILOC,NU * If this is not in the drift medium, stop now. IF(ILOC.EQ.-5.OR.ILOC.EQ.-6)THEN ISTAT=ILOC XELIST(IMCA)=REAL(XU(NU))/100.0 YELIST(IMCA)=REAL(YU(NU))/100.0 ZELIST(IMCA)=REAL(ZU(NU))/100.0 TELIST(IMCA)=REAL(TU(NU))*1.0E6 ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) GOTO 100 ENDIF * Start status checking. CALL DLCSTA(-1.0,1) * Check that we are inside the area, terminate if not. IF(ISTAT.NE.0.OR.ILOC.NE.0)THEN IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG :'', - '' loc = '',I5,'', istat = '',I5,'', e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') - ILOC,ISTAT,EMAX,NU,NCOL * End of drift line processing. XELIST(IMCA)=REAL(XU(NU))/100.0 YELIST(IMCA)=REAL(YU(NU))/100.0 ZELIST(IMCA)=REAL(ZU(NU))/100.0 TELIST(IMCA)=REAL(TU(NU))*1.0E6 ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) GOTO 100 ENDIF *** Various parameters. SMALL=1.0D-20 RDUM=RSTART CONST9=CONST3*0.01D0 NCOL=0 NNULL=0 * Number of collisions for de-correlation ? TDASH=0.0D0 * Parameters to compute position after step INTEM=8 F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) *** Initial direction cosines: first electron is specified IF(IMCA.EQ.1)THEN DCX1=DBLE(DIRX) DCY1=DBLE(DIRY) DCZ1=DBLE(DIRZ) * The secondary electrons are isotropic ELSE THETA0=ACOS(MIN(1.0,MAX(-1.0,1.0-2.0*DRAND48(RDUM)))) PHI0=F4*DRAND48(RDUM) DCX1=COS(PHI0)*SIN(THETA0) DCY1=SIN(PHI0)*SIN(THETA0) DCZ1=COS(THETA0) ENDIF *** Main loop DO 210 J1=1,100000000 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG : Step '', - I3,'', iteration '',I5,'', collision '',I5)') NU,J1,NCOL *** Get the electric and magnetic field (check only). C xs=real(x*100.0) C ys=real(y*100.0) C zs=real(z*100.0) C call efield(xs,ys,zs,exs2,eys2,ezs2,etots2,volts,0,iloc) C if(abs(exs-exs2).gt.1.0e-5*(1+abs(exs)+abs(exs2)).or. C - abs(eys-eys2).gt.1.0e-5*(1+abs(eys)+abs(eys2)).or. C - abs(ezs-ezs2).gt.1.0e-5*(1+abs(ezs)+abs(ezs2)).or. C - abs(etots-etots2).gt.1.0e-5*(1+abs(etots)+abs(etots2)))then C print *,' Step ',j1,' field clash:' C print *,' e = ',exs2,eys2,ezs2,etots2 C print *,' o = ',exs,eys,ezs,etots C endif *** Determine free time 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=CONST3*(DCX1*EX+DCY1*EY+DCZ1*EZ)*SQRT(E1) BP=(EX**2+EY**2+EZ**2)*CONST1 E=E1+(AP+BP*T)*T * Keep track of the highest energy EMAX=MAX(E,EMAX) IF(E.GT.EFINAL)THEN PRINT *,' !!!!!! DLCMSA WARNING : Instantaneous electron'// - ' energy ',E,' eV exceeds E_maximum ',EFINAL,' eV;'// - ' avalanche tracking stopped.' C print *,' E1 = ',E1,', AP = ',AP,', BP = ',BP,', T = ',T * Too many points. IF(NU.GE.MXLIST)THEN ISTAT=-2 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG :'', - '' Too many steps, istat = -2, e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') EMAX,NU,NCOL IF(LELEPL)CALL DLCPLT XELIST(IMCA)=X YELIST(IMCA)=Y ZELIST(IMCA)=Z TELIST(IMCA)=ST ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF * Add the point. NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 * Record the problem. ISTAT=-9 * Plot it. IF(LELEPL)CALL DLCPLT * Record the end point. XELIST(IMCA)=REAL(XU(NU))/100.0 YELIST(IMCA)=REAL(YU(NU))/100.0 ZELIST(IMCA)=REAL(ZU(NU))/100.0 TELIST(IMCA)=REAL(TU(NU))*1.0E6 ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF IF(IHF.GT.0)CALL HISENT(IHF,REAL(E),1.0) * Check null collisions IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) IF(LBMCPR)WRITE(LUNOUT,996) 996 FORMAT(/,5X,' WARNING NULL COLLISION TIME INCREASED',/) GO TO 1 ENDIF * Test for real or null collision R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) THEN IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG :'', - '' Null collision.'')') NNULL=NNULL+1 GO TO 1 ENDIF *** Direction cosines and positions at instant before collision T2=T*T TDASH=0.0D0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6+EX*T*CONST5/SQRT(E) DCY2=DCY1*CONST6+EY*T*CONST5/SQRT(E) DCZ2=DCZ1*CONST6+EZ*T*CONST5/SQRT(E) * const7: velocity [m/psec], a: velocity time [m] CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 X=X+DCX1*A+T2*EX*CONST2 Y=Y+DCY1*A+T2*EY*CONST2 Z=Z+DCZ1*A+T2*EZ*CONST2 ST=ST+T *** Check the location: first compute the E field. XS=REAL(X*100.0) YS=REAL(Y*100.0) ZS=REAL(Z*100.0) CALL EFIELD(XS,YS,ZS,EXS,EYS,EZS,ETOTS,VOLTS,0,ILOC) EX=-DBLE(EXS) EY=-DBLE(EYS) EZ=-DBLE(EZS) IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG : At ('', - 3E15.8,''), E = ('',3E15.8,''), loc = '',I5,'', nu = '', - I5)') X,Y,Z,EX,EY,EZ,ILOC,NU * Then verify status and position wrt box. IF(ILOC.NE.0.OR. - XS.LT.DDXMIN.OR.XS.GT.DDXMAX.OR. - YS.LT.DDYMIN.OR.YS.GT.DDYMAX.OR. - ZS.LT.DDZMIN.OR.ZS.GT.DDZMAX)THEN IF(NU.GE.MXLIST)THEN ISTAT=-2 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG :'', - '' Too many steps, istat = -2, e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') EMAX,NU,NCOL IF(LELEPL)CALL DLCPLT XELIST(IMCA)=X YELIST(IMCA)=Y ZELIST(IMCA)=Z TELIST(IMCA)=ST ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) GOTO 100 ENDIF IF(ILOC.EQ.-5.OR.ILOC.EQ.-6)THEN CALL DLCFMP(XU(NU),YU(NU),ZU(NU), - X*1.0D2,Y*1.0D2,Z*1.0D2, - T*1.0D-6,ILOC,QPCHAR,IPTECH) ISTAT=ILOC ELSE NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 CALL DLCSTA(-1.0,1) ENDIF IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG :'', - '' loc = '',I5,'', istat = '',I5,'', e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') - ILOC,ISTAT,EMAX,NU,NCOL IF(LELEPL)CALL DLCPLT XELIST(IMCA)=REAL(XU(NU))/100.0 YELIST(IMCA)=REAL(YU(NU))/100.0 ZELIST(IMCA)=REAL(ZU(NU))/100.0 TELIST(IMCA)=REAL(TU(NU))*1.0E6 ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) GOTO 100 ENDIF *** Add the new point. IF(NMC*(NCOL/NMC).EQ.NCOL)THEN IF(NU.GE.MXLIST)THEN ISTAT=-2 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG :'', - '' Too many steps, istat = -2, e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') EMAX,NU,NCOL IF(LELEPL)CALL DLCPLT XELIST(IMCA)=X YELIST(IMCA)=Y ZELIST(IMCA)=Z TELIST(IMCA)=ST ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) GOTO 100 ENDIF NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 ENDIF *** Determination of real collision type R2=drand48(RDUM) * Find location within 4 units in collision array CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) * Use flat distribution of electron energy between E-EION and 0.0 eV IF(IPN(I).GT.0)THEN R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI ENDIF *** Generate scattering angles, update lab cosines, type of collision. IPT=IARRY(I) IGAS=1+(IPT-1)/5 ITYPE=IPT-5*(IGAS-1) * NSTATL(IPT): 1=elastic, 2=ionise, 3=attach, 4=inelastic, 5=super NSTATL(IPT)=NSTATL(IPT)+1 * NSTATN(I): individual level described in DSCRPT(I) NSTATN(I)=NSTATN(I)+1 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG : Gas '',I3, - '' type '',I1,'' level '',A)') IGAS,ITYPE,DSCRPT(I) ** Common XPL(1)=X*1.0D2 YPL(1)=Y*1.0D2 ZPL(1)=Z*1.0D2 ** Elastic. IF(ITYPE.EQ.1.AND.LPLELA)THEN CALL GRATTS('ELASTIC','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ** Ionisation. ELSEIF(ITYPE.EQ.2)THEN * Plot if asked. IF(LPLION)THEN CALL GRATTS('IONISATION','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ENDIF * Use OPAL Peterson and Beaty splitting factor. R9=drand48(RDUM) C ESEC=R9*(E-EI) ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI * Ensure the energy is not negative IF(ESEC.LT.0)THEN PRINT *,' !!!!!! DLCMSA WARNING : Secondary'// - ' electron energy ',ESEC,' eV < 0; set'// - ' to "small".' ESEC=SMALL ENDIF * Ensure we do not pass the maximum permitted avalanche size. IF(NMCA+1.GT.NEMAX.AND.NEMAX.GT.0)THEN PRINT *,' !!!!!! DLCMSA WARNING : Avalanche exceeds'// - ' maximum permitted size; avalanche ended.' CALL BOOK('RELEASE','MCAMAT','MCA',IFAIL1) * Heinrich options. if(lheinrich)close(unit=38) RETURN * Ensure there is still space in the table. ELSEIF(NMCA+1.GT.MXMCA)THEN PRINT *,' !!!!!! DLCMSA WARNING : Overflow of'// - ' secondary electron table; avalanche ended.' CALL BOOK('RELEASE','MCAMAT','MCA',IFAIL1) * Heinrich options. if(lheinrich)close(unit=38) RETURN ENDIF * Add the point to the table, NMCA=NMCA+1 * Store position, energy and time XLIST(NMCA)=X YLIST(NMCA)=Y ZLIST(NMCA)=Z TLIST(NMCA)=ST ELIST(NMCA)=ESEC * Increment the electron counter NETOT=NETOT+1 NITOT=NITOT+1 * Write a Heinrich record if(lheinrich)then ioncount=ioncount+1 write(38,'(1x,i5,2x,i5,8(2x,e12.5))') - itype,ioncount, - xlist(imca),ylist(imca),zlist(imca),elist(imca), - xlist(nmca),ylist(nmca),zlist(nmca),elist(nmca) endif ** Electron ends due to attachment. ELSEIF(ITYPE.EQ.3)THEN * Plot position if requested. IF(LPLATT)THEN CALL GRATTS('ATTACHMENT','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ENDIF * See whether we still have room. IF(NU.GE.MXLIST)THEN ISTAT=-2 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ DLCMSA DEBUG :'', - '' Too many steps, istat = -2, e_max = '',E15.8, - '' eV, nu = '',I4,'', ncol = '',I5)') EMAX,NU,NCOL IF(LELEPL)CALL DLCPLT XELIST(IMCA)=X YELIST(IMCA)=Y ZELIST(IMCA)=Z TELIST(IMCA)=ST ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) GOTO 100 ENDIF * Add point if we still have room. NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 ISTAT=-7 * Decrement the electron counter NETOT=NETOT-1 * Plot and take next electron. IF(LELEPL)CALL DLCPLT XELIST(IMCA)=REAL(XU(NU))/100.0 YELIST(IMCA)=REAL(YU(NU))/100.0 ZELIST(IMCA)=REAL(ZU(NU))/100.0 TELIST(IMCA)=REAL(TU(NU))*1.0E6 ISLIST(IMCA)=ISTAT * Add the signal. IF(LSIGAD)CALL SIGADM(0.0, .TRUE., 1.0, IFAIL) GOTO 100 ** Inelastic and excitation. ELSEIF(ITYPE.EQ.4)THEN * Plot excitations. IF(LPLEXC.AND.DSCRPT(I)(1:4).EQ.' EXC')THEN CALL GRATTS('EXCITATION','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) * Plot other inelastic states. ELSEIF(LPLINE.AND.DSCRPT(I)(1:4).NE.' EXC')THEN CALL GRATTS('INELASTIC','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ENDIF * Call a user procedure to dealing with excitations. CALL GASEXU(ITYPE,IGAS,I, - REAL(X*100),REAL(Y*100),REAL(Z*100), - REAL(E),REAL(ST*1.0D-6), - ADDNEW,XNEW,YNEW,ZNEW,DELAY,ENEW) IF(ADDNEW)THEN * Ensure we do not pass the maximum permitted avalanche size. IF(NMCA+1.GT.NEMAX.AND.NEMAX.GT.0)THEN PRINT *,' !!!!!! DLCMSA WARNING : Avalanche'// - ' exceeds maximum permitted size;'// - ' avalanche ended.' CALL BOOK('RELEASE','MCAMAT','MCA',IFAIL1) RETURN * Ensure there is still space in the table. ELSEIF(NMCA+1.GT.MXMCA)THEN PRINT *,' !!!!!! DLCMSA WARNING : Overflow of'// - ' secondary electron table; avalanche ended.' CALL BOOK('RELEASE','MCAMAT','MCA',IFAIL1) RETURN ENDIF * Add the point to the table, NMCA=NMCA+1 * Store position, energy and time XLIST(NMCA)=XNEW/100.0 YLIST(NMCA)=YNEW/100.0 ZLIST(NMCA)=ZNEW/100.0 TLIST(NMCA)=ST+DELAY/1.0D-6 ELIST(NMCA)=ENEW C print *,' Adding an electron at ',xnew,ynew,znew, C - ' with delay ',delay,' energy: ',enew * Increment the electron counter NETOT=NETOT+1 NITOT=NITOT+1 ENDIF * Write a Heinrich record if(lheinrich)then write(38,'(1x,I5,2X,i5,5(2x,e20.13),2x,a)') itype,ioncount, - x*100,y*100,z*100,e,st*1.0d-6,dscrpt(i) endif ** Super-elastic ELSEIF(ITYPE.EQ.5.AND.LPLSUP)THEN CALL GRATTS('SUPER-ELASTIC','POLYMARKER') CALL PLAGPM(1,XPL,YPL,ZPL) ENDIF *** Fix energy loss smaller than incident energy if error occurs IF(E.LT.EI) THEN IF(LBMCPR)WRITE(LUNOUT,994) E,EI,J1 994 FORMAT(2X,' WARNING ENERGY =',F8.3, - ' LESS THAN ENERGY LOSS EI=',F8.3,' AT ITER=',I12, - ' DUE TO BINNING ERROR') EI=E-0.0001D0 ENDIF * Scatter S2=(S1*S1)/(S1-1.0D0) * Anisotropic scattering to obtain theta IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 * Isotropic scattering ELSE R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) * Obtain phi R4=drand48(RDUM) PHI0=F4*R4 * Work out the new direction F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN IF(LBMCPR)WRITE(LUNOUT,9232) J1,E1 9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT J1 =',I10,' E1=',E12.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 ELSE DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) ENDIF 210 CONTINUE *** Should not reach this point. PRINT *,' !!!!!! DLCMSA WARNING : Should not reach end of'// - ' loop - please report.' IFAIL=0 END SUBROUTINE DLCMIR(X1,Y1,Z1,ES,EF,NSTATL,NSTATN) *----------------------------------------------------------------------- * DLCMIR - Microscopic MC tracking, minimal variation on MONTE * (Last changed on 25/ 3/08.) *----------------------------------------------------------------------- IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,LARGE. +SEQ,ANIS. +SEQ,MAGBOUT. +SEQ,THRM. +SEQ,OUTPT. +SEQ,MAGBPARM. +SEQ,DIMENSIONS. +SEQ,PRINTPLOT. +SEQ,DRIFTLINE. REAL QCHARGE DIMENSION XST(100000),YST(100000),ZST(100000),STO(100000) DIMENSION WZST(10),AVEST(10) DIMENSION DFZZST(10),DFYYST(10),DFXXST(10) real X1,Y1,Z1,ES,EF integer ifail,NSTATL(5*MXNGAS),NSTATN(512) *** Initialise the gas call dlcmii(ef,NSTATL,NSTATN,ifail) lbmcpr=.true. *** Initialise the steps NU=1 XU(NU)=X1 YU(NU)=Y1 ZU(NU)=Z1 TU(NU)=0 *** Set technique and particle labels IPTYPE=1 QPCHAR=QCHARGE IPTECH=4 C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C USED WITH MAGNETIC FIELD B =0.0 ELECTRIC FIELD IN Z DIRECTION. C ------------------------------------------------------------------- WX=0.0D0 WY=0.0D0 DWX=0.0D0 DWY=0.0D0 DIFYZ=0.0D0 DIFXY=0.0D0 DIFXZ=0.0D0 DYZER=0.0D0 DXYER=0.0D0 DXZER=0.0D0 X=x1 Y=y1 Z=z1 ST=0.0D0 ST1=0.0D0 ST2=0.0D0 SUME2=0.0D0 SUMXX=0.0D0 SUMYY=0.0D0 SUMZZ=0.0D0 SUMVX=0.0D0 SUMVY=0.0D0 ZOLD=0.0D0 STOLD=0.0D0 ST1OLD=0.0D0 ST2OLD=0.0D0 SZZOLD=0.0D0 SXXOLD=0.0D0 SYYOLD=0.0D0 SVXOLD=0.0D0 SVYOLD=0.0D0 SME2OLD=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 ARAT=EMASS/AMU INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=100000 TDASH=0.0D0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,1 DO 133 J2=1,10000000 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) E=E1+(AP+BP*T)*T IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) if(lbmcpr)WRITE(lunout,996) 996 FORMAT(/,5X,' WARNING NULL COLLISION TIME INCREASED',/) GO TO 1 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) THEN NNULL=NNULL+1 GO TO 1 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0D0+B/3.0D0) CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 CX1=DCX1*CONST7 CY1=DCY1*CONST7 CZ1=DCZ1*CONST7 X=X+DCX1*A Y=Y+DCY1*A Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 WZ=Z/ST SUMVX=SUMVX+CX1*CX1*T2 SUMVY=SUMVY+CY1*CY1*T2 IF(ID.EQ.0) GO TO 121 KDUM=0 DO 120 JDUM=1,4 ST2=ST2+T NCOLDM=NCOL+KDUM IF(NCOLDM.GT.NCOLM) NCOLDM=NCOLDM-NCOLM SDIF=ST-STO(NCOLDM) SUMXX=SUMXX+((X-XST(NCOLDM))**2)*T/SDIF SUMYY=SUMYY+((Y-YST(NCOLDM))**2)*T/SDIF IF(J1.LT.3) GO TO 120 ST1=ST1+T SUMZZ=SUMZZ+((Z-ZST(NCOLDM)-WZ*SDIF)**2)*T/SDIF 120 KDUM=KDUM+12500 121 continue C XST(NCOL)=X C YST(NCOL)=Y C ZST(NCOL)=Z C STO(NCOL)=ST C IF(NCOL.GE.NCOLM) THEN C ID=ID+1 C XID=DBLE(ID) C NCOL=0 C ENDIF *** Add new point IF(Z*1.0D2.GT.1)THEN IF(NU.GE.MXLIST)THEN ISTAT=-2 RETURN ENDIF NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 ISTAT=-1 RETURN ELSEIF(NMC*(NCOL/NMC).EQ.NCOL)THEN IF(NU.GE.MXLIST)THEN ISTAT=-2 RETURN ENDIF NU=NU+1 XU(NU)=X*1.0D2 YU(NU)=Y*1.0D2 ZU(NU)=Z*1.0D2 TU(NU)=ST*1.0D-6 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) C FIND LOCATION WITHIN 4 UNITS IN COLLISION ARRAY CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).LE.0) GO TO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IF(E.LT.EI) THEN if(lbmcpr)WRITE(lunout,994) E,EI,J2 994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001D0 ENDIF S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE C ISOTROPIC SCATTERING R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN if(lbmcpr)WRITE(lunout,9232) ITER,ID,E1 9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 130 CONTINUE 133 CONTINUE C ------------------------------------------ IF(J1.EQ.1.and.lbmcpr) WRITE(lunout,201) 201 FORMAT(/,' VEL POS TIME ENERGY COUNT DIFXX / DIFYY DIFZZ',/) WZ=WZ*1.0D+09 AVE=SUME2/ST DIFLN=0.0D0 IF(NISO.EQ.0) THEN DIFXX=5.0D+15*SUMVX/ST DIFYY=5.0D+15*SUMVY/ST DFXXST(J1)=5.0D+15*(SUMVX-SVXOLD)/(ST-STOLD) DFYYST(J1)=5.0D+15*(SUMVY-SVYOLD)/(ST-STOLD) ELSE IF(ST2.NE.0.0D0) THEN DIFYY=5.0D+15*SUMYY/ST2 DIFXX=5.0D+15*SUMXX/ST2 DFXXST(J1)=5.0D+15*(SUMXX-SXXOLD)/(ST2-ST2OLD) DFYYST(J1)=5.0D+15*(SUMYY-SYYOLD)/(ST2-ST2OLD) ELSE DFXXST(J1)=0.0D0 DFYYST(J1)=0.0D0 ENDIF ENDIF IF(ST1.NE.0.0D0) THEN DIFZZ=5.0D+15*SUMZZ/ST1 DFZZST(J1)=5.0D+15*(SUMZZ-SZZOLD)/(ST1-ST1OLD) ELSE DFZZST(J1)=0.0D0 ENDIF WZST(J1)=(Z-ZOLD)/(ST-STOLD)*1.0D+09 AVEST(J1)=(SUME2-SME2OLD)/(ST-STOLD) ZOLD=Z STOLD=ST ST1OLD=ST1 ST2OLD=ST2 SVXOLD=SUMVX SVYOLD=SUMVY SZZOLD=SUMZZ SXXOLD=SUMXX SYYOLD=SUMYY SME2OLD=SUME2 if(lbmcpr)WRITE(lunout,202) WZ,Z,ST,AVE,ID,DIFXX,DIFYY,DIFZZ 202 FORMAT(1X,F8.2,2(1X,D10.3),F9.4,1X,I5,1X,3(2X,F8.1)) C LOOP 210 CONTINUE C CALCULATE ERRORS AND CHECK AVERAGES TWZST=0.0D0 TAVE=0.0D0 T2WZST=0.0D0 T2AVE=0.0D0 TZZST=0.0D0 TYYST=0.0D0 TXXST=0.0D0 T2ZZST=0.0D0 T2YYST=0.0D0 T2XXST=0.0D0 DO 768 K=1,10 TWZST=TWZST+WZST(K) TAVE=TAVE+AVEST(K) T2WZST=T2WZST+WZST(K)*WZST(K) T2AVE=T2AVE+AVEST(K)*AVEST(K) TXXST=TXXST+DFXXST(K) TYYST=TYYST+DFYYST(K) T2YYST=T2YYST+DFYYST(K)*DFYYST(K) T2XXST=T2XXST+DFXXST(K)*DFXXST(K) IF(K.LT.3) GO TO 768 TZZST=TZZST+DFZZST(K) T2ZZST=T2ZZST+DFZZST(K)*DFZZST(K) 768 CONTINUE DWZ=100.0D0*SQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZ DEN=100.0D0*SQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DXXER=100.0D0*SQRT((T2XXST-TXXST*TXXST/10.0D0)/9.0D0)/DIFXX DYYER=100.0D0*SQRT((T2YYST-TYYST*TYYST/10.0D0)/9.0D0)/DIFYY DZZER=100.0D0*SQRT((T2ZZST-TZZST*TZZST/8.0D0)/7.0D0)/DIFZZ DIFLN=DIFZZ DIFTR=(DIFXX+DIFYY)/2.0D0 C CONVERT CM/SEC WZ=WZ*1.0D05 DFLER=DZZER DFTER=(DXXER+DYYER)/2.0D0 C CALCULATE TOWNSEND COEFICIENTS AND ERRORS ANCATT=0.0D0 ANCION=0.0D0 DO 800 I=1,NGAS ANCATT=ANCATT+ICOLL((5*I)-2) 800 ANCION=ANCION+ICOLL((5*I)-3) ATTER=0.0D0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0D0*SQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0D0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0D0*SQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 END +DECK,OUTPUT. SUBROUTINE OUTPUT IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,MIX. +SEQ,RATIO. +SEQ,MAGBOUT. +SEQ,SETP. +SEQ,BFLD. +SEQ,LARGE. +SEQ,OUTPT. +SEQ,SINT. +SEQ,NAMES. +SEQ,SCRIP. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. if(lbmcpr)WRITE(lunout,15) IF(LBMCPR)WRITE(LUNOUT,15) 15 FORMAT('---------------------------------------------------------- /-------------------') NREAL=NMAX IF(LBMCPR)WRITE(LUNOUT,109) TMAX1,NNULL,NREAL 109 FORMAT(/,2X,'CALCULATED MAX. COLLISION TIME =',F7.2,' PICOSECONDS. /',2(/),2X,'NUMBER OF NULL COLLISIONS =',I11,/,2X,'NUMBER OF REAL C /OLLISIONS =',I11) WMNZ=WZ*1.0D-05 WMNY=WY*1.0D-05 WMNX=WX*1.0D-05 IF(LBMCPR)WRITE(LUNOUT,940) WMNZ,DWZ,WMNY,DWY,WMNX,DWX 940 FORMAT(/,2X,'Z DRIFT VELOCITY =',E11.4,' MICRONS/NANOSECOND +-',F /8.2,'% ',/,2X,'Y DRIFT VELOCITY =',E11.4,' MICRONS/NANOSECOND +-' /,F8.2,'%',/,2X,'X DRIFT VELOCITY =',E11.4,' MICRONS/NANOSECOND +- /',F8.2,'%',/) IF(BMAG.GT.0.0D0.AND.(BTHETA.GT.0.0D0.AND.BTHETA.LT.180.0D0)) /GO TO 800 DTOVMB=DIFTR*EMAG/WZ DTMN=SQRT(2.0D0*DIFTR/WZ)*10000.0D0 DFTER1=SQRT(DFTER**2+DWZ**2) DFTER2=DFTER1/2.0 IF(LBMCPR)WRITE(LUNOUT,954) IF(LBMCPR)WRITE(LUNOUT,950) DIFTR,DFTER,DTOVMB,DFTER1,DTMN,DFTER2 950 FORMAT(/,2X,'TRANSVERSE DIFFUSION =',D11.4,' +-',F8.2,'%',/,10X, /'=',F9.4,' EV. +-',F8.2,'%',/,10X,'=',F9.3,' MICRONS/CENTIMETER**0 /.5 +-',F8.2,'%',/) DLOVMB=DIFLN*EMAG/WZ DLMN=SQRT(2.0D0*DIFLN/WZ)*10000.0D0 DFLER1=SQRT(DFLER**2+DWZ**2) DFLER2=DFLER1/2.0 IF(LBMCPR)WRITE(LUNOUT,992) DIFLN,DFLER,DLOVMB,DFLER1,DLMN,DFLER2 992 FORMAT(/,2X,'LONGITUDINAL DIFFUSION =',D11.4,' +-',F8.1,'%',/,10X, /'=',F9.4,' EV. +-',F8.2,'%',/,10X,'=',F9.3,' MICRONS/CENTIMETER**0 /.5 +-',F8.2,'%',/) GO TO 900 800 IF(LBMCPR)WRITE(LUNOUT,954) 954 FORMAT(/,10X,' DIFFUSION IN CM**2/SEC.',/) IF(LBMCPR)WRITE(LUNOUT,955) DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ 955 FORMAT(/,2X,'DIFFUSION TENSOR :',/,6X,' DIFXX =',D11.4,' DIFYY =', /D11.4,' DIFZZ =',D11.4,/,6X,' DIFYZ =',D11.4,' DIFXY =',D11.4,' DI /FXZ =',D11.4,/) IF(LBMCPR)WRITE(LUNOUT,956) DXXER,DYYER,DZZER,DYZER,DXYER,DXZER 956 FORMAT(/,2X,'ERROR ON DIFFUSION TENSOR :',/,6X,' DIFXX =',F8.2,'% / DIFYY =',F8.2,'% DIFZZ =',F8.2,'%',/,6X,' DIFYZ =',F8.2,'% DIFX /Y =',F8.2,'% DIFXZ =',F8.2,'%',/) IF(BTHETA.EQ.90. .and. lbmcpr)WRITE(LUNOUT,957) - DIFLN,DFLER,DIFTR,DFTER,DIFXX,DXXER 957 FORMAT(/,8X,' LONGITUDINAL DIFFUSION =',D11.4,' +-',F8.2,'%',/,10X /,' TRANSVERSE DIFFUSION =',D11.4,' +-',F8.2,'%',/,2X,'TRANSVERSE D /IFFUSION (PARALLEL TO B-FIELD) DIFXX=',D11.4,' +-',F8.2,'%',/) 900 IF(LBMCPR)WRITE(LUNOUT,333) ALPHA,ALPER,ATT,ATTER 333 FORMAT(2(/),' IONISATION RATE /CM.=',E11.4,' +/-',F6.2,' PERCENT. /',/,' ATTACHMENT RATE /CM.=',E11.4,' +/-',F6.2,' PERCENT.',2(/)) IF(LBMCPR)WRITE(LUNOUT,960) AVE,DEN 960 FORMAT(/,2X,'MEAN ELECTRON ENERGY =',F9.4,' EV. ERROR = +-',F8.2, /'%',/) END +DECK,MONTEA. SUBROUTINE MONTEA IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,BFLD. +SEQ,LARGE. +SEQ,ANIS. +SEQ,MAGBOUT. +SEQ,OUTPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION XST(100000),YST(100000),ZST(100000),STO(100000) DIMENSION WZST(10),AVEST(10) DIMENSION DFZZST(10),DFYYST(10),DFXXST(10) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C USED WITH MAGNETIC FIELD , B , PARALLEL TO ELECTRIC FIELD IN THE C Z DIRECTION. C ------------------------------------------------------------------- WX=0.0D0 WY=0.0D0 DWX=0.0D0 DWY=0.0D0 DIFYZ=0.0D0 DIFXY=0.0D0 DIFXZ=0.0D0 DYZER=0.0D0 DXYER=0.0D0 DXZER=0.0D0 X=0.0D0 Y=0.0D0 Z=0.0D0 ST=0.0D0 ST1=0.0D0 ST2=0.0D0 SUME2=0.0D0 SUMXX=0.0D0 SUMYY=0.0D0 SUMZZ=0.0D0 SUMVX=0.0D0 SUMVY=0.0D0 ZOLD=0.0D0 STOLD=0.0D0 ST1OLD=0.0D0 ST2OLD=0.0D0 SZZOLD=0.0D0 SXXOLD=0.0D0 SYYOLD=0.0D0 SVXOLD=0.0D0 SVYOLD=0.0D0 SME2OLD=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=100000 TDASH=0.0D0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C INITIAL VELOCITY VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) E=E1+(AP+BP*T)*T IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) C IF(LBMCPR)WRITE(LUNOUT,996) C996 FORMAT(/,5X,' WARNING NULL COLLISION TIME INCREASED',/) GO TO 1 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) THEN NNULL=NNULL+1 GO TO 1 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) CONST6=SQRT(E1/E) CX2=CX1*COSWT-CY1*SINWT CY2=CY1*COSWT+CX1*SINWT VTOT=CONST9*SQRT(E) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0D0+B/3.0D0) CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 DX=(CX1*SINWT-CY1*(1.0D0-COSWT))/WB X=X+DX DY=(CY1*SINWT+CX1*(1.0D0-COSWT))/WB Y=Y+DY Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 WZ=Z/ST SUMVX=SUMVX+DX*DX SUMVY=SUMVY+DY*DY IF(ID.EQ.0) GO TO 121 KDUM=0 DO 120 JDUM=1,4 ST2=ST2+T NCOLDM=NCOL+KDUM IF(NCOLDM.GT.NCOLM) NCOLDM=NCOLDM-NCOLM SDIF=ST-STO(NCOLDM) SUMXX=SUMXX+((X-XST(NCOLDM))**2)*T/SDIF SUMYY=SUMYY+((Y-YST(NCOLDM))**2)*T/SDIF IF(J1.LT.3) GO TO 120 ST1=ST1+T SUMZZ=SUMZZ+((Z-ZST(NCOLDM)-WZ*SDIF)**2)*T/SDIF 120 KDUM=KDUM+12500 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM) THEN ID=ID+1 XID=DBLE(ID) NCOL=0 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) C FIND LOCATION WITHIN 4 UNITS IN COLLISION ARRAY CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).LE.0) GO TO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IF(E.LT.EI) THEN C IF(LBMCPR)WRITE(LUNOUT,994) E,EI,J2 C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001D0 ENDIF S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE C ISOTROPIC SCATTERING R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C IF(LBMCPR)WRITE(LUNOUT,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 C /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) C CALCULATE VELOCITY VECTORS AFTER COLLISION 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT 133 CONTINUE C ------------------------------------------ IF(J1.EQ.1.and.LBMCPR)WRITE(LUNOUT,201) 201 FORMAT(/,' VEL POS TIME ENERGY COUNT DIFXX / DIFYY DIFZZ ',/) WZ=WZ*1.0D+09 AVE=SUME2/ST IF(NISO.EQ.0) THEN DIFXX=5.0D+15*SUMVX/ST DIFYY=5.0D+15*SUMVY/ST DFXXST(J1)=5.0D+15*(SUMVX-SVXOLD)/(ST-STOLD) DFYYST(J1)=5.0D+15*(SUMVY-SVYOLD)/(ST-STOLD) ELSE IF(ST2.NE.0.0D0) THEN DIFYY=5.0D+15*SUMYY/ST2 DIFXX=5.0D+15*SUMXX/ST2 DFXXST(J1)=5.0D+15*(SUMXX-SXXOLD)/(ST2-ST2OLD) DFYYST(J1)=5.0D+15*(SUMYY-SYYOLD)/(ST2-ST2OLD) ELSE DFXXST(J1)=0.0D0 DFYYST(J1)=0.0D0 ENDIF ENDIF IF(ST1.NE.0.0D0) THEN DIFZZ=5.0D+15*SUMZZ/ST1 DFZZST(J1)=5.0D+15*(SUMZZ-SZZOLD)/(ST1-ST1OLD) ELSE DFZZST(J1)=0.0D0 ENDIF WZST(J1)=(Z-ZOLD)/(ST-STOLD)*1.0D+09 AVEST(J1)=(SUME2-SME2OLD)/(ST-STOLD) ZOLD=Z STOLD=ST ST1OLD=ST1 ST2OLD=ST2 SVXOLD=SUMVX SVYOLD=SUMVY SZZOLD=SUMZZ SXXOLD=SUMXX SYYOLD=SUMYY SME2OLD=SUME2 IF(LBMCPR)WRITE(LUNOUT,202) WZ,Z,ST,AVE,ID,DIFXX,DIFYY,DIFZZ 202 FORMAT(1X,F8.2,2(1X,D10.3),F9.4,1X,I5,1X,3(2X,F8.1)) C LOOP 210 CONTINUE C CALCULATE ERRORS AND CHECK AVERAGES TWZST=0.0D0 TAVE=0.0D0 T2WZST=0.0D0 T2AVE=0.0D0 TZZST=0.0D0 TYYST=0.0D0 TXXST=0.0D0 T2ZZST=0.0D0 T2YYST=0.0D0 T2XXST=0.0D0 DO 768 K=1,10 TWZST=TWZST+WZST(K) TAVE=TAVE+AVEST(K) T2WZST=T2WZST+WZST(K)*WZST(K) T2AVE=T2AVE+AVEST(K)*AVEST(K) TXXST=TXXST+DFXXST(K) TYYST=TYYST+DFYYST(K) T2XXST=T2XXST+DFXXST(K)*DFXXST(K) T2YYST=T2YYST+DFYYST(K)*DFYYST(K) IF(K.LT.3) GO TO 768 TZZST=TZZST+DFZZST(K) T2ZZST=T2ZZST+DFZZST(K)*DFZZST(K) 768 CONTINUE DWZ=100.0D0*SQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZ DEN=100.0D0*SQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DXXER=100.0D0*SQRT((T2XXST-TXXST*TXXST/10.0D0)/9.0D0)/DIFXX DYYER=100.0D0*SQRT((T2YYST-TYYST*TYYST/10.0D0)/9.0D0)/DIFYY DZZER=100.0D0*SQRT((T2ZZST-TZZST*TZZST/8.0D0)/7.0D0)/DIFZZ DIFLN=DIFZZ DIFTR=(DIFXX+DIFYY)/2.0D0 C CONVERT TO CM/SEC WZ=WZ*1.0D05 DFLER=DZZER DFTER=(DXXER+DYYER)/2.0D0 C CALCULATE TOWNSEND COEFICIENTS AND ERRORS ANCATT=0.0D0 ANCION=0.0D0 DO 800 I=1,NGAS ANCATT=ANCATT+ICOLL((5*I)-2) 800 ANCION=ANCION+ICOLL((5*I)-3) ATTER=0.0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0*SQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0*SQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 END +DECK,MONTEB. SUBROUTINE MONTEB IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,BFLD. +SEQ,LARGE. +SEQ,ANIS. +SEQ,MIX. +SEQ,MAGBOUT. +SEQ,OUTPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION XST(100000),YST(100000),ZST(100000),STO(100000) DIMENSION WZST(10),WYST(10),AVEST(10) DIMENSION DFZZST(10),DFYYST(10),DFXXST(10) DIMENSION DFYZST(10),DFLNST(10),DFTRST(10) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C SUBROUTINE HANDLES MAGNETIC FIELD AND ELECTRIC FIELD C BFIELD ALONG X-AXIS EFIELD ALONG Z-AXIS (90 DEGREES). C ------------------------------------------------------------------- IF(LIDENT)PRINT *,' /// ROUTINE MONTEB ///' WX=0.0D0 DWX=0.0D0 DIFXZ=0.0D0 DIFXY=0.0D0 DXZER=0.0D0 DXYER=0.0D0 X=0.0D0 Y=0.0D0 Z=0.0D0 ST=0.0D0 ST1=0.0D0 ST2=0.0D0 SUMXX=0.0D0 SUMYY=0.0D0 SUMZZ=0.0D0 SUMYZ=0.0D0 SUMLS=0.0D0 SUMTS=0.0D0 SUMVX=0.0D0 ZOLD=0.0D0 YOLD=0.0D0 STOLD=0.0D0 ST1OLD=0.0D0 ST2OLD=0.0D0 SZZOLD=0.0D0 SXXOLD=0.0D0 SYYOLD=0.0D0 SYZOLD=0.0D0 SVXOLD=0.0D0 SLNOLD=0.0D0 STROLD=0.0D0 EBAROLD=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 EF100=EMAG*100.0D0 RDUM=RSTART E1=ESTART INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=100000 TDASH=0.0D0 CONST9=CONST3*0.01D0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C INITIAL VELOCITY VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0D0-COSWT))/WB E=E1+DZ*EF100 C IF(E.LT.0.0.and.LBMCPR)WRITE(LUNOUT,983) C - J2,DZ,E1,COSWT,SINWT,WBT,CY1 C983 FORMAT(2X,' J2=',I12,' DZ=',D12.3,' E1=',D12.3,' COSWT=',D12.3 C /,' SINWT=',D12.3,' WBT=',D12.3,' CY1=',D12.3) IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) C C IF(LBMCPR)WRITE(LUNOUT,996) C996 FORMAT(/,5X,' WARNING NULL COLLISION TIME INCREASED',/) GO TO 1 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) THEN NNULL=NNULL+1 GO TO 1 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 C CALC VELOCITY CX2=CX1 CY2=(CY1-EOVB)*COSWT+CZ1*SINWT+EOVB CZ2=CZ1*COSWT-(CY1-EOVB)*SINWT C CALC DIRECTION COSINE VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT NCOL=NCOL+1 C CALC NEW POSITION X=X+CX1*T Y=Y+EOVB*T+((CY1-EOVB)*SINWT+CZ1*(1.0D0-COSWT))/WB Z=Z+DZ ST=ST+T IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 WZ=Z/ST WY=Y/ST SUMVX=SUMVX+CX1*CX1*T2 IF(ID.EQ.0) GO TO 121 KDUM=0 DO 120 J=1,4 ST2=ST2+T NCOLDM=NCOL+KDUM IF(NCOLDM.GT.NCOLM) NCOLDM=NCOLDM-NCOLM SDIF=ST-STO(NCOLDM) SUMXX=SUMXX+((X-XST(NCOLDM))**2)*T/SDIF IF(J1.LT.3) GO TO 120 ST1=ST1+T SUMZZ=SUMZZ+((Z-ZST(NCOLDM)-WZ*SDIF)**2)*T/SDIF SUMYY=SUMYY+((Y-YST(NCOLDM)-WY*SDIF)**2)*T/SDIF SUMYZ=SUMYZ+(Z-ZST(NCOLDM)-WZ*SDIF)*(Y-YST(NCOLDM)-WY*SDIF)*T/SDIF A2=(WZ*SDIF)**2+(WY*SDIF)**2 B2=(Z-WZ*SDIF-ZST(NCOLDM))**2+(Y-WY*SDIF-YST(NCOLDM))**2 C2=(Z-ZST(NCOLDM))**2+(Y-YST(NCOLDM))**2 DL2=(A2+B2-C2)**2/(4.0D0*A2) DT2=B2-DL2 SUMLS=SUMLS+DL2*T/SDIF SUMTS=SUMTS+DT2*T/SDIF 120 KDUM=KDUM+12500 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM) THEN ID=ID+1 XID=DBLE(ID) NCOL=0 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) C FIND LOCATION WITHIN 4 UNITS IN COLLISION ARRAY CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).LE.0) GO TO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IF(E.LT.EI) THEN C IF(LBMCPR)WRITE(LUNOUT,994) E,EI,J2 C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001D0 ENDIF S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE C ISOTROPIC SCATTERING R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C IF(LBMCPR)WRITE(LUNOUT,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 C /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) C CALCULATE VELOCITY VECTORS AFTER COLLISION 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT 133 CONTINUE C ------------------------------------------ IF(J1.EQ.1 .and. LBMCPR)WRITE(LUNOUT,201) 201 FORMAT(/,' VELZ VELY ENERGY ID DIFXX DIFYY DIFZZ DI /FYZ DIFLNG DIFTRN',/) WZ=WZ*1.0D+09 WY=WY*1.0D+09 IF(ST2.NE.0.0D0) DIFXX=5.0D+15*SUMXX/ST2 IF(ST1.NE.0.0D0) DIFYY=5.0D+15*SUMYY/ST1 IF(ST1.NE.0.0D0) DIFZZ=5.0D+15*SUMZZ/ST1 IF(ST1.NE.0.0D0) DIFYZ=-5.0D+15*SUMYZ/ST1 IF(ST1.NE.0.0D0) DIFLN=5.0D+15*SUMLS/ST1 IF(ST1.NE.0.0D0) DIFTR=5.0D+15*SUMTS/ST1 IF(NISO.EQ.0) DIFXX=5.0D+15*SUMVX/ST EBAR=0.0D0 DO 300 IK=1,2048 * Changed name of ES to EVECT (RV, 20/4/2005) 300 EBAR=EBAR+Evect(IK)*SPEC(IK)/TCF(IK) AVE=EBAR/ST WZST(J1)=(Z-ZOLD)/(ST-STOLD)*1.0D+09 WYST(J1)=(Y-YOLD)/(ST-STOLD)*1.0D+09 AVEST(J1)=(EBAR-EBAROLD)/(ST-STOLD) EBAROLD=EBAR DFZZST(J1)=0.0D0 DFYYST(J1)=0.0D0 DFYZST(J1)=0.0D0 DFLNST(J1)=0.0D0 DFTRST(J1)=0.0D0 IF(J1.GT.2) THEN DFZZST(J1)=5.0D+15*(SUMZZ-SZZOLD)/(ST1-ST1OLD) DFYYST(J1)=5.0D+15*(SUMYY-SYYOLD)/(ST1-ST1OLD) DFYZST(J1)=5.0D+15*(SUMYZ-SYZOLD)/(ST1-ST1OLD) DFLNST(J1)=5.0D+15*(SUMLS-SLNOLD)/(ST1-ST1OLD) DFTRST(J1)=5.0D+15*(SUMTS-STROLD)/(ST1-ST1OLD) ENDIF DFXXST(J1)=5.0D+15*(SUMXX-SXXOLD)/(ST2-ST2OLD) IF(NISO.EQ.0) DFXXST(J1)=5.0D+15*(SUMVX-SVXOLD)/(ST-STOLD) ZOLD=Z YOLD=Y STOLD=ST ST1OLD=ST1 ST2OLD=ST2 SVXOLD=SUMVX SZZOLD=SUMZZ SXXOLD=SUMXX SYYOLD=SUMYY SYZOLD=SUMYZ SLNOLD=SUMLS STROLD=SUMTS IF(LBMCPR)WRITE(LUNOUT,202) WZ,WY,AVE,ID,DIFXX,DIFYY,DIFZZ, /DIFYZ,DIFLN,DIFTR 202 FORMAT(2(F7.2,1X),F7.4,1X,I4,6(F7.1,1X)) C LOOP 210 CONTINUE C CALCULATE ERRORS AND CHECK AVERAGES TWZST=0.0D0 TWYST=0.0D0 TAVE=0.0D0 T2WZST=0.0D0 T2WYST=0.0D0 T2AVE=0.0D0 TZZST=0.0D0 TYYST=0.0D0 TXXST=0.0D0 TYZST=0.0D0 TLNST=0.0D0 TTRST=0.0D0 T2ZZST=0.0D0 T2YYST=0.0D0 T2XXST=0.0D0 T2YZST=0.0D0 T2LNST=0.0D0 T2TRST=0.0D0 DO 768 K=1,10 TWZST=TWZST+WZST(K) TWYST=TWYST+WYST(K) TAVE=TAVE+AVEST(K) T2WZST=T2WZST+WZST(K)*WZST(K) T2WYST=T2WYST+WYST(K)*WYST(K) T2AVE=T2AVE+AVEST(K)*AVEST(K) TXXST=TXXST+DFXXST(K) T2XXST=T2XXST+DFXXST(K)*DFXXST(K) IF(K.LT.3) GO TO 768 TZZST=TZZST+DFZZST(K) TYYST=TYYST+DFYYST(K) TYZST=TYZST+DFYZST(K) TLNST=TLNST+DFLNST(K) TTRST=TTRST+DFTRST(K) T2ZZST=T2ZZST+DFZZST(K)*DFZZST(K) T2YYST=T2YYST+DFYYST(K)*DFYYST(K) T2YZST=T2YZST+DFYZST(K)*DFYZST(K) T2LNST=T2LNST+DFLNST(K)*DFLNST(K) T2TRST=T2TRST+DFTRST(K)*DFTRST(K) 768 CONTINUE DWZ=100.0D0*SQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZ DWY=100.0D0*SQRT((T2WYST-TWYST*TWYST/10.0D0)/9.0D0)/ABS(WY) DEN=100.0D0*SQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DXXER=100.0D0*SQRT((T2XXST-TXXST*TXXST/10.0D0)/9.0D0)/DIFXX DYYER=100.0D0*SQRT((T2YYST-TYYST*TYYST/8.0D0)/7.0D0)/DIFYY DZZER=100.0D0*SQRT((T2ZZST-TZZST*TZZST/8.0D0)/7.0D0)/DIFZZ DYZER=100.0D0*SQRT((T2YZST-TYZST*TYZST/8.0D0)/7.0D0)/ABS(DIFYZ) DFLER=100.0D0*SQRT((T2LNST-TLNST*TLNST/8.0D0)/7.0D0)/DIFLN DFTER=100.0D0*SQRT((T2TRST-TTRST*TTRST/8.0D0)/7.0D0)/DIFTR C CONVERT TO CM/SEC WZ=WZ*1.0D05 WY=WY*1.0D05 C CALCULATE TOWNSEND COEFICIENTS AND ERRORS ANCATT=0.0D0 ANCION=0.0D0 DO 800 I=1,NGAS ANCATT=ANCATT+ICOLL((5*I)-2) 800 ANCION=ANCION+ICOLL((5*I)-3) ATTER=0.0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0D0*SQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0D0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0D0*SQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 END +DECK,MONTEC. SUBROUTINE MONTEC IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,BFLD. +SEQ,LARGE. +SEQ,ANIS. +SEQ,MIX. +SEQ,MAGBOUT. +SEQ,OUTPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION XST(100000),YST(100000),ZST(100000),STO(100000) DIMENSION WZST(10),WYST(10),WXST(10),AVEST(10) DIMENSION DFZZST(10),DFYYST(10),DFXXST(10) DIMENSION DFYZST(10),DFXYST(10),DFXZST(10) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C SUBROUTINE SOLVES MOTION IN COORDINATE SYSTEM WITH BFIELD C ALIGNED ALONG X AXIS AND ELECTRIC FIELD AT AN ANGLE BTHETA IN C THE X-Z PLANE. THE VELOCITY VECTORS AND DIFFUSION ARE THEN C ROTATED INTO THE STANDARD COORDINATE FRAME WITH THE ELECTRIC- C FIELD ALONG Z-AXIS AND THE BFIELD AT AN ANGLE BTHETA TO THE C ELECTRIC FIELD IN THE X-Z PLANE. C ------------------------------------------------------------------- X=0.0D0 Y=0.0D0 Z=0.0D0 C CALC LONG AND TRANS ONLY FOR 90 DEGREES BETWEEN E AND B DIFLN=0.0D0 DIFTR=0.0D0 DFLER=0.0D0 DFTER=0.0D0 DIFXXR=0.0D0 DIFYYR=0.0D0 DIFZZR=0.0D0 DIFYZR=0.0D0 DIFXZR=0.0D0 DIFXYR=0.0D0 ST=0.0D0 ST1=0.0D0 SUMXX=0.0D0 SUMYY=0.0D0 SUMZZ=0.0D0 SUMYZ=0.0D0 SUMXY=0.0D0 SUMXZ=0.0D0 ZROLD=0.0D0 YROLD=0.0D0 XROLD=0.0D0 SZZR=0.0D0 SYYR=0.0D0 SXXR=0.0D0 SXYR=0.0D0 SYZR=0.0D0 SXZR=0.0D0 STOLD=0.0D0 ST1OLD=0.0D0 ST2OLD=0.0D0 SZZOLD=0.0D0 SYYOLD=0.0D0 SXXOLD=0.0D0 SYZOLD=0.0D0 SXYOLD=0.0D0 SXZOLD=0.0D0 EBAROLD=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 API=ACOS(-1.0D0) C CALC ROTATION MATRIX ANGLES RCS=COS((BTHETA-90.0D0)*API/180.0D0) RSN=SIN((BTHETA-90.0D0)*API/180.0D0) C RTHETA=BTHETA*API/180.0D0 EFZ100=EMAG*100.0D0*SIN(RTHETA) EFX100=EMAG*100.0D0*COS(RTHETA) F1=EMAG*CONST2*COS(RTHETA) EOVBR=EOVB*SIN(RTHETA) RDUM=RSTART E1=ESTART INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 NCOLM=100000 TDASH=0.0D0 CONST9=CONST3*0.01D0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C INITIAL VELOCITY VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2.0D0*API DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVBR-CY1)*(1.0D0-COSWT))/WB DX=CX1*T+F1*T*T E=E1+DZ*EFZ100+DX*EFX100 C IF(E.LT.0.0 .and. LBMCPR)WRITE(LUNOUT,983) C - J2,DZ,E1,COSWT,SINWT,WBT,CY1 C983 FORMAT(2X,' J2=',I12,' DZ=',D12.3,' E1=',D12.3,' COSWT=',D12.3 C /,' SINWT=',D12.3,' WBT=',D12.3,' CY1=',D12.3) IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) C IF(LBMCPR)WRITE(LUNOUT,996) C996 FORMAT(/,5X,' WARNING NULL COLLISION TIME INCREASED',/) GO TO 1 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) THEN NNULL=NNULL+1 GO TO 1 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 C CALC VELOCITY CX2=CX1+2.0D0*F1*T CY2=(CY1-EOVBR)*COSWT+CZ1*SINWT+EOVBR CZ2=CZ1*COSWT-(CY1-EOVBR)*SINWT C CALC DIRECTION COSINE VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT NCOL=NCOL+1 C CALC NEW POSITION X=X+DX Y=Y+EOVBR*T+((CY1-EOVBR)*SINWT+CZ1*(1.0D0-COSWT))/WB Z=Z+DZ ST=ST+T IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 WZ=Z/ST WY=Y/ST WX=X/ST IF(J1.LT.3) GO TO 121 KDUM=0 DO 120 J=1,4 NCOLDM=NCOL+KDUM IF(NCOLDM.GT.NCOLM) NCOLDM=NCOLDM-NCOLM ST1=ST1+T SDIF=ST-STO(NCOLDM) SUMZZ=SUMZZ+((Z-ZST(NCOLDM)-WZ*SDIF)**2)*T/SDIF SUMYY=SUMYY+((Y-YST(NCOLDM)-WY*SDIF)**2)*T/SDIF SUMXX=SUMXX+((X-XST(NCOLDM)-WX*SDIF)**2)*T/SDIF SUMYZ=SUMYZ+(Z-ZST(NCOLDM)-WZ*SDIF)*(Y-YST(NCOLDM)-WY*SDIF)*T/SDIF SUMXY=SUMXY+(X-XST(NCOLDM)-WX*SDIF)*(Y-YST(NCOLDM)-WY*SDIF)*T/SDIF SUMXZ=SUMXZ+(X-XST(NCOLDM)-WX*SDIF)*(Z-ZST(NCOLDM)-WZ*SDIF)*T/SDIF 120 KDUM=KDUM+12500 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM) THEN ID=ID+1 XID=DBLE(ID) NCOL=0 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) C FIND LOCATION WITHIN 4 UNITS IN COLLISION ARRAY CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).LE.0) GO TO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IF(E.LT.EI) THEN C IF(LBMCPR)WRITE(LUNOUT,994) E,EI,J2 C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001D0 ENDIF S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE C ISOTROPIC SCATTERING R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C IF(LBMCPR)WRITE(LUNOUT,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 C /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) C CALCULATE VELOCITY VECTORS AFTER COLLISION 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT 133 CONTINUE C ------------------------------------------ IF(J1.EQ.1 .and. LBMCPR)WRITE(LUNOUT,201) 201 FORMAT(/,' VELZ VELY VELX ENERGY ID DIFXX DIFYY DIFZ /Z DIFYZ DIFXZ DIFXY',/) WZ=WZ*1.0D+09 WY=WY*1.0D+09 WX=WX*1.0D+09 C CALCULATE ROTATED VECTORS AND POSITIONS WZR=WZ*RCS-WX*RSN WYR=WY WXR=WZ*RSN+WX*RCS ZR=Z*RCS-X*RSN YR=Y XR=Z*RSN+X*RCS EBAR=0.0D0 DO 300 IK=1,2048 * Changed name of ES to EVECT (RV, 20/4/2005) 300 EBAR=EBAR+Evect(IK)*SPEC(IK)/TCF(IK) AVE=EBAR/ST WZST(J1)=(ZR-ZROLD)/(ST-STOLD)*1.0D+09 WYST(J1)=(YR-YROLD)/(ST-STOLD)*1.0D+09 WXST(J1)=(XR-XROLD)/(ST-STOLD)*1.0D+09 AVEST(J1)=(EBAR-EBAROLD)/(ST-STOLD) EBAROLD=EBAR IF(J1.LT.3) GO TO 100 DIFXX=5.0D+15*SUMXX/ST1 DIFYY=5.0D+15*SUMYY/ST1 DIFZZ=5.0D+15*SUMZZ/ST1 DIFYZ=5.0D+15*SUMYZ/ST1 DIFXZ=5.0D+15*SUMXZ/ST1 DIFXY=5.0D+15*SUMXY/ST1 C CALCULATE ROTATED TENSOR . DIFXXR=DIFXX*RCS*RCS+DIFZZ*RSN*RSN+2.0D0*RCS*RSN*DIFXZ DIFYYR=DIFYY DIFZZR=DIFXX*RSN*RSN+DIFZZ*RCS*RCS-2.0D0*RCS*RSN*DIFXZ DIFXYR=RCS*DIFXY+RSN*DIFYZ DIFYZR=RSN*DIFXY-RCS*DIFYZ DIFXZR=(RCS*RCS-RSN*RSN)*DIFXZ-RSN*RCS*(DIFXX-DIFZZ) SXXR=SUMXX*RCS*RCS+SUMZZ*RSN*RSN+2.0D0*RCS*RSN*SUMXZ SYYR=SUMYY SZZR=SUMXX*RSN*RSN+SUMZZ*RCS*RCS-2.0D0*RCS*RSN*SUMXZ SXYR=RCS*SUMXY+RSN*SUMYZ SYZR=RSN*SUMXY-RCS*SUMYZ SXZR=(RCS*RCS-RSN*RSN)*SUMXZ-RSN*RCS*(SUMXX-SUMZZ) C 100 DFZZST(J1)=0.0D0 DFYYST(J1)=0.0D0 DFXXST(J1)=0.0D0 DFXYST(J1)=0.0D0 DFYZST(J1)=0.0D0 DFXZST(J1)=0.0D0 IF(J1.GT.2) THEN DFZZST(J1)=5.0D+15*(SZZR-SZZOLD)/(ST1-ST1OLD) DFYYST(J1)=5.0D+15*(SYYR-SYYOLD)/(ST1-ST1OLD) DFXXST(J1)=5.0D+15*(SXXR-SXXOLD)/(ST1-ST1OLD) DFXYST(J1)=5.0D+15*(SXYR-SXYOLD)/(ST1-ST1OLD) DFYZST(J1)=5.0D+15*(SYZR-SYZOLD)/(ST1-ST1OLD) DFXZST(J1)=5.0D+15*(SXZR-SXZOLD)/(ST1-ST1OLD) ENDIF ZROLD=ZR YROLD=YR XROLD=XR STOLD=ST ST1OLD=ST1 SZZOLD=SZZR SYYOLD=SYYR SXXOLD=SXXR SXYOLD=SXYR SYZOLD=SYZR SXZOLD=SXZR C OUTPUT ROTATED VECTORS AND TENSOR IF(LBMCPR)WRITE(LUNOUT,202) - WZR,WYR,WXR,AVE,ID,DIFXXR,DIFYYR,DIFZZR,DIFYZR,DIFXZR,DIFXYR 202 FORMAT(3(F7.2,1X),1X,F7.4,I4,6(F7.1)) C LOOP 210 CONTINUE C CALCULATE ERRORS AND CHECK AVERAGES TWZST=0.0D0 TWYST=0.0D0 TWXST=0.0D0 TAVE=0.0D0 T2WZST=0.0D0 T2WYST=0.0D0 T2WXST=0.0D0 T2AVE=0.0D0 TZZST=0.0D0 TYYST=0.0D0 TXXST=0.0D0 TXYST=0.0D0 TYZST=0.0D0 TXZST=0.0D0 T2ZZST=0.0D0 T2YYST=0.0D0 T2XXST=0.0D0 T2XYST=0.0D0 T2YZST=0.0D0 T2XZST=0.0D0 DO 768 K=1,10 TWZST=TWZST+WZST(K) TWYST=TWYST+WYST(K) TWXST=TWXST+WXST(K) TAVE=TAVE+AVEST(K) T2WZST=T2WZST+WZST(K)*WZST(K) T2WYST=T2WYST+WYST(K)*WYST(K) T2WXST=T2WXST+WXST(K)*WXST(K) T2AVE=T2AVE+AVEST(K)*AVEST(K) IF(K.LT.3) GO TO 768 TZZST=TZZST+DFZZST(K) TYYST=TYYST+DFYYST(K) TXXST=TXXST+DFXXST(K) TXYST=TXYST+DFXYST(K) TYZST=TYZST+DFYZST(K) TXZST=TXZST+DFXZST(K) T2ZZST=T2ZZST+DFZZST(K)*DFZZST(K) T2YYST=T2YYST+DFYYST(K)*DFYYST(K) T2XXST=T2XXST+DFXXST(K)*DFXXST(K) T2XYST=T2XYST+DFXYST(K)*DFXYST(K) T2YZST=T2YZST+DFYZST(K)*DFYZST(K) T2XZST=T2XZST+DFXZST(K)*DFXZST(K) 768 CONTINUE DWZ=100.0D0*SQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZR DWY=100.0D0*SQRT((T2WYST-TWYST*TWYST/10.0D0)/9.0D0)/ABS(WYR) DWX=100.0D0*SQRT((T2WXST-TWXST*TWXST/10.0D0)/9.0D0)/ABS(WXR) DEN=100.0D0*SQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DZZER=100.0D0*SQRT((T2ZZST-TZZST*TZZST/8.0D0)/7.0D0)/DIFZZR DYYER=100.0D0*SQRT((T2YYST-TYYST*TYYST/8.0D0)/7.0D0)/DIFYYR DXXER=100.0D0*SQRT((T2XXST-TXXST*TXXST/8.0D0)/7.0D0)/DIFXXR DXYER=100.0D0*SQRT((T2XYST-TXYST*TXYST/8.0D0)/7.0D0)/ABS(DIFXYR) DYZER=100.0D0*SQRT((T2YZST-TYZST*TYZST/8.0D0)/7.0D0)/ABS(DIFYZR) DXZER=100.0D0*SQRT((T2XZST-TXZST*TXZST/8.0D0)/7.0D0)/ABS(DIFXZR) C LOAD ROTATED VALUES INTO ARRAYS WZ=WZR WX=WXR WY=WYR DIFXX=DIFXXR DIFYY=DIFYYR DIFZZ=DIFZZR DIFYZ=DIFYZR DIFXZ=DIFXZR DIFXY=DIFXYR C CONVERT TO CM/SEC. WZ=WZ*1.0D05 WY=WY*1.0D05 WX=WX*1.0D05 C CALCULATE TOWNSEND COEFICIENTS AND ERRORS ANCATT=0.0D0 ANCION=0.0D0 DO 800 I=1,NGAS ANCATT=ANCATT+ICOLL((5*I)-2) 800 ANCION=ANCION+ICOLL((5*I)-3) ATTER=0.0D0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0D0*SQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0D0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0D0*SQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 END +DECK,ELIMIT. SUBROUTINE ELIMIT(IELOW) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,INPT. +SEQ,CNSTS. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,LARGE. +SEQ,ANIS. C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND TESTS TO FIND IF THE UPPER ENERGY C LIMIT FOR THE ELECTRON ENERGY IS EXCEEDED. C IF ENERGY LIMIT IS OK IELOW = 0 C IF ENERGY LIMIT IS EXCEEDED IELOW = 1 C THE TEST IS CARRIED OUT FOR A SAMPLE OF COLLISIONS THAT ARE C SMALLER THAN THE FULL SAMPLE BY A FACTOR OF 1/ISAMP C C USED WITH MAGNETIC FIELD B =0.0 ELECTRIC FIELD IN Z DIRECTION. C ------------------------------------------------------------------- ISAMP=10 SMALL=1.0D-20 RDUM=RSTART E1=ESTART INTEM=8 TDASH=0.0D0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ISAMP C MAIN LOOP DO 210 J1=1,J2M 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) E=E1+(AP+BP*T)*T IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) GO TO 1 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) GO TO 1 C C CALCULATE DIRECTION COSINES AT INSTANT BEFORE COLLISION C IF(IE.EQ.2048) THEN C ELECTRON ENERGY OUT OF RANGE IELOW=1 RETURN ENDIF TDASH=0.0D0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) C FIND LOCATION WITHIN 4 UNITS IN COLLISION ARRAY CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).LE.0) GO TO 666 R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) IF(E.LT.EI) THEN EI=E-0.0001D0 ENDIF S2=(S1*S1)/(S1-1.0D0) IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 210 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) C LOOP 210 CONTINUE IELOW=0 END +DECK,ELIMITB. SUBROUTINE ELIMITB(IELOW) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,INPT. +SEQ,CNSTS. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,BFLD. +SEQ,LARGE. +SEQ,ANIS. C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND TESTS TO FIND IF THE UPPER ENERGY C LIMIT FOR THE ELECTRON ENERGY IS EXCEEDED. C IF ENERGY LIMIT IS OK IELOW = 0 C IF ENERGY LIMIT IS EXCEEDED IELOW = 1 C THE TEST IS CARRIED OUT FOR A SAMPLE OF COLLISIONS THAT ARE C SMALLER THAN THE FULL SAMPLE BY A FACTOR OF 1/ISAMP C C USED WITH MAGNETIC FIELD B AT 90 DEGREES TO ELECTRIC FIELD C ------------------------------------------------------------------- ISAMP=20 SMALL=1.0D-20 EF100=EMAG*100.0D0 RDUM=RSTART E1=ESTART INTEM=8 TDASH=0.0D0 CONST9=CONST3*0.01D0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ISAMP C MAIN LOOP DO 210 J1=1,J2M 1 continue R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0D0-COSWT))/WB E=E1+DZ*EF100 IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) GO TO 1 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) GO TO 1 C C CALCULATE DIRECTION COSINES AT INSTANT BEFORE COLLISION C IF(IE.EQ.2048) THEN C ELECTRON ENERGY OUT OF RANGE IELOW=1 RETURN ENDIF TDASH=0.0D0 CX2=CX1 CY2=(CY1-EOVB)*COSWT+CZ1*SINWT+EOVB CZ2=CZ1*COSWT-(CY1-EOVB)*SINWT VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) C FIND LOCATION WITHIN 4 UNITS IN COLLISION ARRAY CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).LE.0) GO TO 666 R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) IF(E.LT.EI) THEN EI=E-0.0001D0 ENDIF S2=(S1*S1)/(S1-1.0D0) IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT C LOOP 210 CONTINUE IELOW=0 END +DECK,ELIMITC. SUBROUTINE ELIMITC(IELOW) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,INPT. +SEQ,CNSTS. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,BFLD. +SEQ,LARGE. +SEQ,ANIS. C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND TESTS TO FIND IF THE UPPER ENERGY C LIMIT FOR THE ELECTRON ENERGY IS EXCEEDED. C IF ENERGY LIMIT IS OK IELOW = 0 C IF ENERGY LIMIT IS EXCEEDED IELOW = 1 C THE TEST IS CARRIED OUT FOR A SAMPLE OF COLLISIONS THAT ARE C SMALLER THAN THE FULL SAMPLE BY A FACTOR OF 1/ISAMP C C USED WITH MAGNETIC FIELD B AT ANGLES BETWEEN 0 AND 90 DEGREES TO C THE ELECTRIC FIELD. C ------------------------------------------------------------------- ISAMP=20 SMALL=1.0D-20 RTHETA=BTHETA*ACOS(-1.0D0)/180.0D0 EFZ100=EMAG*100.0D0*SIN(RTHETA) EFX100=EMAG*100.0D0*COS(RTHETA) F1=EMAG*CONST2*COS(RTHETA) EOVBR=EOVB*SIN(RTHETA) RDUM=RSTART E1=ESTART INTEM=8 TDASH=0.0D0 CONST9=CONST3*0.01D0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2.0D0*ACOS(-1.0D0) DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ISAMP C MAIN LOOP DO 210 J1=1,J2M 1 R1=drand48(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,INTEM) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVBR-CY1)*(1.0D0-COSWT))/WB DX=CX1*T+F1*T*T E=E1+DZ*EFZ100+DX*EFX100 IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) GO TO 1 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM) GO TO 1 C C CALCULATE DIRECTION COSINES AT INSTANT BEFORE COLLISION C IF(IE.EQ.2048) THEN C ELECTRON ENERGY OUT OF RANGE IELOW=1 RETURN ENDIF TDASH=0.0D0 CX2=CX1+2.0D0*F1*T CY2=(CY1-EOVBR)*COSWT+CZ1*SINWT+EOVBR CZ2=CZ1*COSWT-(CY1-EOVBR)*SINWT VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) C FIND LOCATION WITHIN 4 UNITS IN COLLISION ARRAY CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).LE.0) GO TO 666 R9=drand48(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) IF(E.LT.EI) THEN EI=E-0.0001D0 ENDIF S2=(S1*S1)/(S1-1.0D0) IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT C LOOP 210 CONTINUE IELOW=0 END +DECK,ALPCALC. SUBROUTINE ALPCALC(IFAIL) *----------------------------------------------------------------------- * ALPCALC - Estimate time step and space steps for avalanche * simulation in time of flight and steady state townsend * simulations. Uses estimated gain of 3.0 between planes. * Calls SST and TOF subroutines and updates ALPHA and ATT. * Author: Steve Biagi, minor modifications. * (Last changed on 21/ 9/05.) *----------------------------------------------------------------------- implicit none +SEQ,SETP. +SEQ,SSTOUT. +SEQ,TOFOUT. +SEQ,MAGBOUT. +SEQ,CTCALC. +SEQ,CION. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. INTEGER IMAX,IFAIL DOUBLE PRECISION ZSTEPM,WRZN,FC1,FC2,ALPTEST *** Assume that this will work. IFAIL=0 *** Modify the NMAX parameter if too small. IMAX=NMAX/10000000 IF(IMAX.LT.5) IMAX=5 NMAX=IMAX*10000000 ALPHAST=0.85D0*ABS(ALPHA-ATT) VDST=WZ*1.D-5 TSTEP=LOG(3.0D0)/(ALPHAST*VDST*1.0D5) ZSTEP=LOG(3.0D0)/ALPHAST *** Convert to metres and picoseconds TSTEP=TSTEP*1.0D12 ZSTEP=ZSTEP*0.01D0 TFINAL=7.0D0*TSTEP ITFINAL=7 ZFINAL=8.0D0*ZSTEP IZFINAL=8 ZPLANE1=ZSTEP ZPLANE2=2.0D0*ZSTEP ZPLANE3=3.0D0*ZSTEP ZPLANE4=4.0D0*ZSTEP ZPLANE5=5.0D0*ZSTEP ZPLANE6=6.0D0*ZSTEP ZPLANE7=7.0D0*ZSTEP ZPLANE8=8.0D0*ZSTEP *** Calc sst IF(LBMCPR)WRITE(LUNOUT,11) 11 FORMAT(/,2X,'SOLUTION FOR STEADY STATE TOWNSEND PARAMETERS',/,' - /------------------------------------------------') ZSTEPM=ZSTEP*1.0D6 IF(LBMCPR)WRITE(LUNOUT,12) ZSTEPM 12 FORMAT(1(/),' SPACE STEP BETWEEN SAMPLING PLANES =',D12.5,' MICRON /S.',/) CALL MONTEFD(IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! ALPCALC WARNING: Failure in MONTEFD;'// - ' no further calculations.' RETURN ENDIF CALL SST *** Load new alpha and attachment into common blocks ALPHA=ALPHSST ALPER=ALPHERR ATT=ATTSST ATTER=ATTERR C----------------------------------------------- IF(LBMCPR)WRITE(LUNOUT,18) 18 FORMAT(/,' SST DRIFT VELOCITIES') IF(LBMCPR)WRITE(LUNOUT,19) VDOUT,VDERR,WSOUT,WSERR 19 FORMAT(/,' VD=',F9.1,' +- ',F6.2,' % WS=',F9.1,' +- ',F6.2,' %') IF(LBMCPR)WRITE(LUNOUT,20) 20 FORMAT(/,' SST DIFFUSION') IF(LBMCPR)WRITE(LUNOUT,21) DLOUT,DLERR,DTOUT,DTERR 21 FORMAT(/,' DL=',F9.1,' +- ',F6.1,' % DT=',F9.1,' +- ',F6.2,' %') IF(LBMCPR)WRITE(LUNOUT,22) 22 FORMAT(/,' SST TOWNSEND COEFICIENTS') IF(LBMCPR)WRITE(LUNOUT,23) ALPHSST,ALPHERR,ATTSST,ATTERR 23 FORMAT(/,' ALPHA=',F9.1,' +- ',F6.2,' % ATT=',F9.1,' +- ',F6.2, /' %') *** Calc time of flight and pt IF(LBMCPR)WRITE(LUNOUT,25) 25 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') IF(LBMCPR)WRITE(LUNOUT,26) TSTEP 26 FORMAT(1(/),' TIME STEP BETWEEN SAMPLING PLANES =',D12.5,' PICOSE /CS.',/) CALL MONTEFT(IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! ALPCALC WARNING: Failure in MONTEFT;'// - ' no further calculations.' RETURN ENDIF CALL FRIEDLAND CALL PT CALL TOF IF(LBMCPR)WRITE(LUNOUT,27) RALPHA,RALPER,RATTOF,RATOFER 27 FORMAT(/,' PT IONISATION AND ATTACHMENT RATES *10**12/SEC',/,' ALP /HA=',D10.3,' +- ',F6.2,' % ATT=',D10.3,' +- ',F6.2,' %') IF(LBMCPR)WRITE(LUNOUT,28) 28 FORMAT(/,' TOF DIFFUSION') IF(LBMCPR)WRITE(LUNOUT,29) TOFDL,TOFDLER,TOFDT,TOFDTER 29 FORMAT(/,' DL=',F8.1,' +- ',F6.1,' % DT=',F8.1,' +- ',F6.1, /' %') IF(LBMCPR)WRITE(LUNOUT,30) 30 FORMAT(/,' TOF DRIFT VELOCITY') IF(LBMCPR)WRITE(LUNOUT,31) TOFWR,TOFWRER 31 FORMAT(/,' WR=',F8.2,' +-',F6.1,' %') WRZN=TOFWR*1.0D05 FC1=WRZN/(2.0D0*TOFDL) FC2=((RALPHA-RATTOF)*1.0D12)/TOFDL ALPTEST=FC1-SQRT(FC1**2-FC2) IF(LBMCPR)WRITE(LUNOUT,888) ALPTEST 888 FORMAT(/,'TOWNSEND COEFICIENT (ALPHA-ATT) CALCULATED FROM TOF RESU /LTS:',/,' ALPHA-ATT /CM.=',D11.4) END +DECK,MONTEFT. SUBROUTINE MONTEFT(IFAIL) *----------------------------------------------------------------------- * MONTEFT - Calculates collision events and updates diffusion and * velocity. This routine handles terminations at fixed * drift times. * Author: Steve Biagi, with modifications. * (Last changed on 16/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,LARGE. +SEQ,CION. +SEQ,OUTPT. +SEQ,TTRM. +SEQ,IPT. +SEQ,TPLOUT. +SEQ,ANIS. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DOUBLE PRECISION EPRM(4000000),S,RDUM,E1,T,T2,AP,E, - CONST6,CONST7,CONST9, - ZSTRT,TSSTRT,DCX1,DCY1,DCZ1,DCX2,DCY2,DCZ2, - E100,DCX100,DCY100,DCZ100, - BP,F1,F2,F3,F4,F5,F6,F8,F9,TLIM,TDASH,TSTOP,DRAND48,TTEM, - A,R1,R2,R3,R4,R5,R9,R31,S1,S2,EI,ESEC,PHI0,THETA0,D,Q,U, - CSQD,ARGZ,ARG1,W,ANEION,ANBT,EPRMBAR,E2PRM,EBAR,EERR INTEGER IESPECP(100),I,ID,INTEM,I100,NCOL,NELEC,NEION,NMXADD, - NPONT,NCLUS,J1,IPRINT,JPRINT,ITER,IPLANE,IDUM,IE,IT,IPT,JCT, - IFAIL EXTERNAL DRAND48 logical lab20 *** Identify the procedure if requested. IF(LIDENT)PRINT *,' /// ROUTINE MONTEFT ///' *** This will usually work. IFAIL=0 *** Calculates collision events and updates diffusion and velocity. * this routine handles terminations at fixed drift times. S=0.0D0 ST=0.0D0 X=0.0D0 Y=0.0D0 Z=0.0D0 ZTOT=0.0D0 ZTOTS=0.0D0 TTOT=0.0D0 TTOTS=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 API=ACOS(-1.0D0) DO 25 I=1,300 25 TIME(I)=0.0D0 DO 26 I=1,5*mxngas 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,2048 28 SPEC(I)=0.0D0 DO 33 I=1,100 33 IESPECP(I)=0 DO 34 I=1,8 ETPL(I)=0.0D0 XTPL(I)=0.0D0 YTPL(I)=0.0D0 ZTPL(I)=0.0D0 TTPL(I)=0.0D0 XXTPL(I)=0.0D0 YYTPL(I)=0.0D0 ZZTPL(I)=0.0D0 VZTPL(I)=0.0D0 34 NETPL(I)=0 ID=0 INTEM=8 I100=0 NCOL=0 NNULL=0 NELEC=0 NEION=0 NMXADD=0 NPONT=0 NCLUS=0 J1=1 ZSTRT=0.0D0 TSSTRT=0.0D0 * Initial direction cosines DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2.0D0*API *** Set to maximum possible collision freq. TLIM=TCFMAX(1) DO 35 I=2,INTEM 35 IF(TLIM.LT.TCFMAX(I)) TLIM=TCFMAX(I) JPRINT=NMAX/10 IPRINT=0 ITER=0 IPLANE=0 IPRIM=0 *** Loop for new starting electrons 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN * Check if program will exceed maximum number of iterations * in this cycle if so output current results. IF(ITER.GT.NMAX) THEN IPRIM=IPRIM-1 GO TO 700 ENDIF X=0.0D0 Y=0.0D0 Z=0.0D0 DCZ1=DCZ100 DCX1=DCX100 DCY1=DCY100 E1=E100 NCLUS=NCLUS+1 ST=0.0D0 TSSTRT=0.0D0 ZSTRT=0.0D0 IPLANE=0 ENDIF IF(IPRIM.GT.4000000) THEN IF(LBMCPR)WRITE(LUNOUT,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) PRINT *,' !!!!!! MONTEFT WARNING: Attachment too high;'// - ' unable to compute transport parameters.' GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=INT(E1)+1 IDUM=MIN(IDUM,100) IESPECP(IDUM)=IESPECP(IDUM)+1 *** Start of loop for newly created electrons 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP *** Main loop 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) lab20=.false. 15 continue IF((T+ST).GE.TSTOP .or. lab20) THEN if(.not.lab20)then IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP * Store position and energy at time plane =IPLANE. CALL TPLANE(T,E1,DCX1,DCY1,DCZ1,AP,BP,EMAG,IPLANE) * Check if passed through more than one plane in this step IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 endif IF((T+ST).GE.TFINAL .or. lab20) THEN if(.not.lab20)then ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT TSTOP=TSTEP * No more electrons in cascade try new primary electron IF(NELEC.EQ.(NCLUS+1)) GO TO 544 endif * Take electrons from store (label 20 no longer used, RV 13/5/2005). C 20 continue lab20=.false. X=XS(NPONT) Y=YS(NPONT) Z=ZS(NPONT) ST=TS(NPONT) E1=ES(NPONT) DCX1=DCX(NPONT) DCY1=DCY(NPONT) DCZ1=DCZ(NPONT) IPLANE=IPL(NPONT) NPONT=NPONT-1 ZSTRT=Z TSSTRT=ST GO TO 555 ENDIF ENDIF 913 FORMAT(3X,' AFTER STORE ITER=',I10,' E1=',D12.3,' T=',D12.3,' AP=' - ,D12.3,' BP=',D12.3,' DCZ1=',D12.3) E=E1+(AP+BP*T)*T IF(E.LT.0.0D0) THEN IF(LBMCPR)WRITE(LUNOUT,913)ITER,E,E1,AP,BP,DCZ1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) *** Test for real or null collision R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 *** Calculate direction cosines and positions at instant before * collision also update diffusion and energy calculations. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 X=X+DCX1*A Y=Y+DCY1*A Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 *** Determination of real collision type C R2=RNDM2(RDUM) R2=drand48(RDUM) * Find location within 4 units in collision array CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(E.LT.EI) THEN C IF(LBMCPR)WRITE(LUNOUT,994) E,EI,ITER C994 FORMAT(2X,' WARNING ENERGY =',F8.3, C - ' LESS THAN ENERGY LOSS EI=',F8.3, C - ' AT ITER=',I12,' DUE TO BINNING ERROR') * Fix energy loss smaller than incident energy if a bining error * occurs. EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 * Attachment IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT * Electron captured start new primary IF(NELEC.EQ.(NCLUS+1)) GO TO 544 * Electron captured take next electron from store C GO TO 20 lab20=.true. goto 15 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) * Use OPAL peterson and beaty splitting factor. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI * Store position ,energy, direction cosines and time of generation * of ionisation electron NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN IF(LBMCPR)WRITE(LUNOUT,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) ifail=1 return C STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC * Randomise secondary electron direction R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=ACOS(F3) F6=COS(THETA0) F5=SIN(THETA0) R4=drand48(rdum) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE *** Generate scattering angles and update laboratory cosines after * collision also update energy of electron. 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 S2=(S1*S1)/(S1-1.0D0) * Anisotropic scattering IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE * Isotropic scattering R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C IF(LBMCPR)WRITE(LUNOUT,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =', C - I10,' E1=',E12.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 190 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 190 CONTINUE *** Store direction cosines and energy after n collisions * for later reuse in primary generation I100=I100+1 IF(I100.EQ.200) THEN DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 E100=E1 I100=0 ENDIF IF(IPRINT.GT.JPRINT) GO TO 200 GO TO 1 * Intermediate printout 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 JCT=ID/100000 C IF(J1.EQ.1 .and. LBMCPR)WRITE(LUNOUT,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VEL POS TIME C - COUNT ') C IF(LBMCPR)WRITE(LUNOUT,202) W,ZTOTS,TTOTS,JCT C 202 FORMAT(1X,F8.3,2(1X,D10.3),4X,I6) J1=J1+1 GO TO 1 *** Main loop end 700 XID=DBLE(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DBLE(NEION) ANBT=DBLE(NELEC-IPRIM) ATTOINT=ANEION/ANBT ATTERT=SQRT(ANEION)/ANEION AIOERT=SQRT(ANBT)/ANBT ELSE ANEION=DBLE(NEION) ATTOINT=-1.0 ATTERT=SQRT(ANEION)/ANEION ENDIF JCT=ID/100000 IF(J1.EQ.1) THEN IF(LBMCPR)WRITE(LUNOUT,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS),', - ' DECREASE THE ESTIMATED ALPHA. NCLUS = ',I7, - ' ITER =',I9) ifail=1 return C STOP ENDIF IF(LBMCPR)WRITE(LUNOUT,878) NELEC,NEION,IPRIM 878 FORMAT(/,' TOTAL NO OF ELECTRONS=',I8,/,' TOTAL NO OF NEG. IONS=', - I8,/,' TOTAL NO OF PRIMARIES=',I8) EPRMBAR=0.0D0 E2PRM=0.0D0 IF(IPRIM.EQ.1) RETURN DO 310 I=1,IPRIM E2PRM=E2PRM+EPRM(I)*EPRM(I) 310 EPRMBAR=EPRMBAR+EPRM(I) EBAR=EPRMBAR/IPRIM EERR=SQRT(E2PRM/IPRIM-EBAR**2) IF(LBMCPR)WRITE(LUNOUT,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, - ' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C IF(LBMCPR)WRITE(LUNOUT,835) (IESPECP(J),J=1,100) C835 FORMAT(/,2X,'ENERGY SPECTRUM OF PRIMARY ELECTRONS IN 1 EV. BINS',/ C - ,10(2X,10I5,/)) RETURN 315 IF(ITER.GT.NMAX) THEN IF(LBMCPR)WRITE(LUNOUT,991) - ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =', - I10,/,' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4, - ' NMXADD=',I3) ifail=1 return C STOP ENDIF END +DECK,TPLANE. SUBROUTINE TPLANE(T,E1,DCX1,DCY1,DCZ1,AP,BP,EFLD,IPLANE) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,CNSTS1. +SEQ,CION. +SEQ,OUTPT. +SEQ,TPLOUT. C----------------------------------------------------------------------- C STORES POSITION, TIME AND ENERGY AND SUMS REQUIRED C TO CALCULATE DEVIATIONS AND MEANS AT PLANE =IPLANE C----------------------------------------------------------------------- TIMESP=IPLANE*TSTEP C CALC TIME LEFT TO ARRIVE AT PLANE TIMLFT=TIMESP-ST T2LFT=TIMLFT*TIMLFT A=AP*TIMLFT B=BP*T2LFT EPLANE=E1+A+B CONST6=SQRT(E1/EPLANE) C DCX2=DCX1*CONST6 C DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFLD*TIMLFT*CONST5/SQRT(EPLANE) XPLANE=X+DCX1*TIMLFT*SQRT(E1)*CONST3*0.01D0 YPLANE=Y+DCY1*TIMLFT*SQRT(E1)*CONST3*0.01D0 ZPLANE=Z+DCZ1*TIMLFT*SQRT(E1)*CONST3*0.01D0+T2LFT*EFLD*CONST2 VZPLANE=DCZ2*SQRT(EPLANE)*CONST3*0.01D0 XTPL(IPLANE)=XTPL(IPLANE)+XPLANE YTPL(IPLANE)=YTPL(IPLANE)+YPLANE ZTPL(IPLANE)=ZTPL(IPLANE)+ZPLANE XXTPL(IPLANE)=XXTPL(IPLANE)+XPLANE*XPLANE YYTPL(IPLANE)=YYTPL(IPLANE)+YPLANE*YPLANE ZZTPL(IPLANE)=ZZTPL(IPLANE)+ZPLANE*ZPLANE ETPL(IPLANE)=ETPL(IPLANE)+EPLANE TTPL(IPLANE)=TTPL(IPLANE)+ST+TIMLFT VZTPL(IPLANE)=VZTPL(IPLANE)+VZPLANE NETPL(IPLANE)=NETPL(IPLANE)+1 END +DECK,FRIEDLAND. SUBROUTINE FRIEDLAND *----------------------------------------------------------------------- * FRIEDL - Calculate distribution function using Friedland * technique. Use distribution function to calculate average * energy ionisation rate and attachment rate. * Reference: J. Friedland, Physics of Fluids 20(1461)1977 * Author: Steve Biagi * (Last changed on 23/ 5/05.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,FRED. +SEQ,OUTPT. +SEQ,CNSTS1. +SEQ,TTRM. +SEQ,LARGE. +SEQ,MIX. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DOUBLE PRECISION FR(2048),ALFBAR,ATTBAR,EBAR,FSUM INTEGER I *** Initialise. ALFBAR=0.0D0 ATTBAR=0.0D0 EBAR=0.0D0 FSUM=0.0D0 DO 100 I=1,2048 FR(I)=SPEC(I)/TCF(I) * Changed E to EVECT (RV, 20/4/2005) EBAR=EBAR+Evect(I)*SPEC(I)/TCF(I) ALFBAR=ALFBAR+FCION(I)*SPEC(I)/TCF(I) ATTBAR=ATTBAR+FCATT(I)*SPEC(I)/TCF(I) 100 FSUM=FSUM+FR(I) *** Normalise DO 200 I=1,2048 200 FR(I)=FR(I)/FSUM EBAR=EBAR/TTOTS ALFBAR=ALFBAR/TTOTS ATTBAR=ATTBAR/TTOTS *** Output result. IF(LBMCPR)WRITE(LUNOUT,900) EBAR,ALFBAR,ATTBAR 900 FORMAT(2(/),' ESTIMATE USING FRIEDLAND :',/,' AVERAGE ENERGY =', - F8.3,'EV.',/,' AVERAGE IONISATION =',E11.4,' *10**12/SEC'/ - ' AVERAGE ATTACHMENT =',E11.4,' *10**12/SEC') END +DECK,PT. SUBROUTINE PT IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CION. +SEQ,TPLOUT. +SEQ,PTTOF. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION ANTPL(8) C ------------------------------------------------ C CALCULATES PULSED TOWNSEND COEFFICIENTS C------------------------------------------------- ANTPL(1)=DBLE(NETPL(1)) RI(1)=(LOG(ANTPL(1))-LOG(DBLE(IPRIM)))/TSTEP EPT(1)=ETPL(1)/ANTPL(1) TTEST(1)=TTPL(1)/ANTPL(1) VZPT(1)=1.0D+09*VZTPL(1)/ANTPL(1) DO 10 I=2,ITFINAL IF(NETPL(I).EQ.0) THEN ITFINAL=I-1 GO TO 11 ENDIF ANTPL(I)=DBLE(NETPL(I)) RI(I)=(LOG(ANTPL(I))-LOG(ANTPL(I-1)))/TSTEP EPT(I)=ETPL(I)/ANTPL(I) TTEST(I)=TTPL(I)/ANTPL(I) VZPT(I)=1.0D+09*VZTPL(I)/ANTPL(I) 10 CONTINUE 11 IF(LBMCPR)WRITE(LUNOUT,900) ITFINAL 900 FORMAT(2(/),' PULSED TOWNSEND RESULTS AT',I2,' SEQUENTIAL TIME PLA /NES',/,' PLANE NO. (ION-ATT) FREQ. ENERGY WV NO.OF E /LECTRONS',/) DO 20 IPL=1,ITFINAL IF(LBMCPR)WRITE(LUNOUT,910) - IPL,RI(IPL),EPT(IPL),VZPT(IPL),NETPL(IPL) 910 FORMAT(2X,I2,4X,E15.4,7X,F7.2,4X,F7.2,3X,I8) 20 CONTINUE END +DECK,TOF. SUBROUTINE TOF IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CION. +SEQ,TPLOUT. +SEQ,TOFOUT. +SEQ,PTTOF. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION DLTF(8),DXTF(8),DYTF(8),WR(8),ANTPL(8) C---------------------------------------------------------- C CALCULATES TIME OF FLIGHT COEFFICIENTS C--------------------------------------------- ANTPL(1)=DBLE(NETPL(1)) WR(1)=ZTPL(1)/(ANTPL(1)*TSTEP) DLTF(1)=((ZZTPL(1)/ANTPL(1))-(ZTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DXTF(1)=((XXTPL(1)/ANTPL(1))-(XTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DYTF(1)=((YYTPL(1)/ANTPL(1))-(YTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DO 10 I=2,ITFINAL ANTPL(I)=DBLE(NETPL(I)) WR(I)=((ZTPL(I)/ANTPL(I))-(ZTPL(I-1)/ANTPL(I-1)))/TSTEP DLTF(I)=((ZZTPL(I)/ANTPL(I))-(ZTPL(I)/ANTPL(I))**2-(ZZTPL(I-1)/ANT /PL(I-1))+(ZTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) DXTF(I)=((XXTPL(I)/ANTPL(I))-(XTPL(I)/ANTPL(I))**2-(XXTPL(I-1)/ANT /PL(I-1))+(XTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) DYTF(I)=((YYTPL(I)/ANTPL(I))-(YTPL(I)/ANTPL(I))**2-(YYTPL(I-1)/ANT /PL(I-1))+(YTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) 10 CONTINUE DO 15 I=1,ITFINAL WR(I)=WR(I)*1.0D+09 DLTF(I)=DLTF(I)*1.0D+16 DXTF(I)=DXTF(I)*1.0D+16 DYTF(I)=DYTF(I)*1.0D+16 15 CONTINUE IF(LBMCPR)WRITE(LUNOUT,900) ITFINAL 900 FORMAT(2(/),' TIME OF FLIGHT RESULTS AT',I2,' SEQUENTIAL TIME PLAN /ES',/,' PLANE NO. DL DX DY WR', //) DO 20 IPL=1,ITFINAL IF(LBMCPR)WRITE(LUNOUT,910) - IPL,DLTF(IPL),DXTF(IPL),DYTF(IPL),WR(IPL) 910 FORMAT(3X,I3,4X,3F12.1,4X,F8.2) 20 CONTINUE IF(NETPL(1).GT.NETPL(ITFINAL)) THEN C NET ATTACHMENT TAKE RESULTS FROM PLANE 2 TOFENE=EPT(2) TOFENER=100.0D0*ABS((EPT(2)-EPT(3))/(2.0D0*EPT(2))) TOFWV=VZPT(2) TOFWVER=100.0D0*ABS((VZPT(2)-VZPT(3))/(2.0D0*VZPT(2))) TOFDL=DLTF(2) TOFDLER=100.0D0*ABS((DLTF(2)-DLTF(3))/(2.0D0*DLTF(2))) TDT2=(DXTF(2)+DYTF(2))/2.0D0 TDT3=(DXTF(3)+DYTF(3))/2.0D0 TOFDT=TDT2 TOFDTER=100.0D0*ABS((TDT2-TDT3)/(2.0D0*TDT2)) TOFWR=WR(2) TOFWRER=100.0D0*ABS((WR(2)-WR(3))/(2.0D0*WR(2))) ANST2=DBLE(NETPL(2)) ANST3=DBLE(NETPL(3)) ANST4=ANST3-SQRT(ANST3) ANST5=LOG(ANST2/ANST3) ANST6=LOG(ANST2/ANST4) ANST7=ANST6/ANST5 ANST8=ANST7-1.0D0 IF(ATTOINT.EQ.-1.0) THEN C NO IONISATION RALPHA=0.0D0 RALPER=0.0D0 RATTOF=-RI(2) RATOFER=100.0D0*SQRT(ANST8**2+ATTERT**2) ELSE RALPHA=RI(2)/(1.0D0-ATTOINT) RALPER=100.0D0*SQRT(ANST8**2+AIOERT**2) RATTOF=ATTOINT*RI(2)/(1.0D0-ATTOINT) RATOFER=100.0D0*SQRT(ANST8**2+ATTERT**2) ENDIF ELSE C NET IONISATION TAKE RESULTS FROM PLANE ITFINAL I1=ITFINAL I2=ITFINAL-1 TOFENE=EPT(I1) TOFENER=100.0D0*ABS((EPT(I1)-EPT(I2))/(2.0D0*EPT(I1))) TOFWV=VZPT(I1) TOFWVER=100.0D0*ABS((VZPT(I1)-VZPT(I2))/(2.0D0*VZPT(I1))) TOFDL=DLTF(I1) TOFDLER=100.0D0*ABS((DLTF(I1)-DLTF(I2))/(2.0D0*DLTF(I1))) TDT1=(DXTF(I1)+DYTF(I1))/2.0D0 TDT2=(DXTF(I2)+DYTF(I2))/2.0D0 TOFDT=TDT1 TOFDTER=100.0D0*ABS((TDT1-TDT2)/(2.0D0*TDT1)) TOFWR=WR(I1) TOFWRER=100.0D0*ABS((WR(I1)-WR(I2))/(2.0D0*WR(I1))) ATER=ABS((RI(I1)-RI(I2))/(2.0D0*RI(I1))) RALPHA=RI(I1)/(1.0D0-ATTOINT) RALPER=100.0D0*SQRT(ATER**2+AIOERT**2) RATTOF=ATTOINT*RI(I1)/(1.0D0-ATTOINT) IF(ATTOINT.NE.0.0D0) THEN RATOFER=100.0D0*SQRT(ATER**2+ATTERT**2) ELSE RATOFER=0.0D0 ENDIF ENDIF END +DECK,MONTEFD. SUBROUTINE MONTEFD(IFAIL) *----------------------------------------------------------------------- * MONTEFD - Calculates collision events and updates diffusion and * velocity. this routine handles terminations at fixed * drift distances. * Author: Steve Biagi, with modifications. * (Last changed on 16/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,LARGE. +SEQ,CION. +SEQ,OUTPT. +SEQ,TTRM. +SEQ,IPS. +SEQ,SPLOUT. +SEQ,SPL1. +SEQ,CTCALC. +SEQ,ANIS. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DOUBLE PRECISION EPRM(4000000),DRAND48,S,RDUM,E1,AP,BP,E,EI, - CONST6,CONST7,CONST9,CX1,CY1,CZ1,THETA0,PHI0, - TLIM,TDASH,T,T2,TOLD,TLFT,TTEM,EPOT,TZSTOP,TZSTOP1,ESEC, - F1,F2,F3,F4,F5,F6,F8,F9,R1,R2,R3,R4,R5,R9,R31,S1,S2,A,B, - DCX1,DCY1,DCZ1,DCX100,DCY100,DCZ100,DCX2,DCY2,DCZ2,E100, - ZSTRT,TSSTRT,ARG1,D,Q,U,CSQD,ARGZ,W,ANEION,ANBT,EPRMBAR, - E2PRM,EBAR,EERR INTEGER IESPECP(100),I,ID,INTEM,I100,NCOL,NELEC,NEION,NMXADD, - NPONT,NCLUS,J1,JPRINT,IPRINT,IDUM,ISOL,IE,IT,IPT,IDM1, - ITER,IZPLANE,JCT,IFAIL EXTERNAL DRAND48 logical lab18,lab20 *** Identify the routine if desired. IF(LIDENT)PRINT *,' /// ROUTINE MONTEFD ///' *** This will usually work. IFAIL=0 *** Initialise S=0.0D0 ST=0.0D0 X=0.0D0 Y=0.0D0 Z=0.0D0 ZTOT=0.0D0 ZTOTS=0.0D0 TTOT=0.0D0 TTOTS=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 API=ACOS(-1.0D0) DO 25 I=1,300 25 TIME(I)=0.0D0 DO 26 I=1,5*mxngas 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,2048 28 SPEC(I)=0.0D0 DO 33 I=1,100 33 IESPECP(I)=0 DO 34 I=1,8 ESPL(I)=0.0D0 XSPL(I)=0.0D0 YSPL(I)=0.0D0 ZSPL(I)=0.0D0 TSPL(I)=0.0D0 XXSPL(I)=0.0D0 YYSPL(I)=0.0D0 ZZSPL(I)=0.0D0 VZSPL(I)=0.0D0 TSSUM(I)=0.0D0 TSSUM2(I)=0.0D0 TMSPL(I)=0.0D0 TTMSPL(I)=0.0D0 RSPL(I)=0.0D0 RRSPL(I)=0.0D0 RRSPM(I)=0.0D0 34 NESST(I)=0 NESST(9)=0 ID=0 INTEM=8 I100=0 NCOL=0 NNULL=0 NELEC=0 NEION=0 NMXADD=0 NPONT=0 NCLUS=0 J1=1 ZSTRT=0.0D0 TSSTRT=0.0D0 *** Initial direction cosines DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) DCX100=DCX1 DCY100=DCY1 DCZ100=DCZ1 E100=E1 BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2.0D0*API *** Set to maximum possible collision freq. TLIM=TCFMAX(1) DO 35 I=2,INTEM 35 IF(TLIM.LT.TCFMAX(I)) TLIM=TCFMAX(I) JPRINT=NMAX/10 IPRINT=0 ITER=0 IPRIM=0 *** Loop for new starting electrons 544 IPRIM=IPRIM+1 if(ldebug)print *,' ++++++ MONTEFD DEBUG : New primary: ',IPRIM IZPLANE=0 TZSTOP=1000.0D0 IF(IPRIM.GT.1) THEN *** Check if program will exceed maximum number of iterations in this * cycle , if so output current results. IF(ITER.GT.NMAX) THEN IPRIM=IPRIM-1 GO TO 700 ENDIF X=0.0D0 Y=0.0D0 Z=0.0D0 DCZ1=DCZ100 DCX1=DCX100 DCY1=DCY100 NCLUS=NCLUS+1 E1=E100 ST=0.0D0 ZSTRT=0.0D0 TSSTRT=0.0D0 ENDIF IF(IPRIM.GT.4000000) THEN IF(LBMCPR)WRITE(LUNOUT,944) IPRIM 944 FORMAT(2X,' PROGRAM STOPPED TOO MANY PRIMARIES IPRIM=',I7) IFAIL=1 PRINT *,' !!!!!! MONTEFD WARNING: Attachment too high;'// - ' unable to compute transport parameters.' RETURN C STOP ENDIF EPRM(IPRIM)=E1 IDUM=INT(E1)+1 IDUM=MIN(IDUM,100) IESPECP(IDUM)=IESPECP(IDUM)+1 *** Start of loop for newly created electrons . 555 TDASH=0.0D0 NELEC=NELEC+1 *** Main loop 1 CONTINUE C if(100000*(iter/100000).eq.iter)print *,' Iter = ',iter C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-LOG(R1)/TLIM+TDASH TOLD=TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) lab18=.false. lab20=.false. 15 continue IF((T.GE.TZSTOP.AND.TOLD.LT.TZSTOP) .or. lab18 .or. lab20) THEN if((.not.lab18) .and. (.not.lab20))then TLFT=TZSTOP *** Store position and energy at z plane = IZPLANE. CALL SPLANE(T,E1,DCX1,DCY1,DCZ1,AP,BP,EMAG,TLFT, - IZPLANE) endif * Change IF statement from (IZFINAL+1) to (IZFINAL-1) * for anode termination . IF(IZPLANE.GE.(IZFINAL+1) .or. lab18 .or. lab20) THEN 18 continue lab18=.false. if(.not.lab20)then ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT * No more electrons in cascade return to main. IF(NELEC.EQ.(NCLUS+1)) GO TO 544 endif * Take electrons from store C 20 continue lab20=.false. X=XSS(NPONT) Y=YSS(NPONT) Z=ZSS(NPONT) ST=TSS(NPONT) E1=ESS(NPONT) DCX1=DCXS(NPONT) DCY1=DCYS(NPONT) DCZ1=DCZS(NPONT) IZPLANE=IPLS(NPONT) NPONT=NPONT-1 ZSTRT=Z TSSTRT=ST IF(Z.GT.ZFINAL) THEN * Check if electron has enough energy to go back to final plane EPOT=EMAG*(Z-ZFINAL)*100.0D0 IF(E1.LT.EPOT) THEN NELEC=NELEC+1 ISOL=1 GO TO 18 ENDIF ENDIF CALL TCALC(Z,DCZ1,E1,EMAG,TZSTOP,TZSTOP1,ISOL, - IZPLANE) IF(TZSTOP.EQ.-99.0D0) THEN * Catch runaway electrons at high field NELEC=NELEC+1 ISOL=1 GO TO 18 ENDIF GO TO 555 ENDIF * If two solutions repeat entry for second solution. IF(ISOL.EQ.2) THEN TZSTOP=TZSTOP1 ISOL=1 GO TO 15 ENDIF ENDIF E=E1+(AP+BP*T)*T IF(E.LT.0.0D0) THEN IF(LBMCPR)WRITE(LUNOUT,999) E,E1,AP,BP,T,DCZ1,ITER 999 FORMAT(2X,' WARNING ENERGY LT.0. E=',D12.3,' E1=',D12.3, - ' AP=',D12.3,' BP=',D12.3,' T=',D12.3,/,' DCZ1=',D12.3, - ' ITER=',I10) E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) *** Test for real or null collision R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 *** Calculate direction cosines and positions at instant before * collision also update diffusion and energy calculations. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) A=AP*T B=BP*T2 CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 CZ1=DCZ1*CONST7 X=X+DCX1*A Y=Y+DCY1*A Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 CX1=DCX1*CONST7 CY1=DCY1*CONST7 SPEC(IE)=SPEC(IE)+1.0D0 *** Determination of real collision type R2=drand48(RDUM) * Find location within 4 units in collision array CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(E.LT.EI) THEN *** Fix energy loss smaller than incident energy if a bining error * occurs. C IF(LBMCPR)WRITE(LUNOUT,994) E,EI,ITER C994 FORMAT(3X,' WARNING BINNING ERROR ENERGY =',F8.3,' EI=', C - F8.3,' ITER =',I12) EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 * Attachment IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT IDM1=1+INT(Z/ZSTEP) IF(IDM1.GT.9) IDM1=9 * Next line added to avoid IDM1=0 (RV 6/11/2007). IF(IDM1.LT.1) IDM1=1 * End of modification. NESST(IDM1)=NESST(IDM1)-1 * Electron captured start new primary IF(NELEC.EQ.(NCLUS+1)) GO TO 544 * Electron captured take next electron from store C GO TO 20 lab20=.true. goto 15 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) *** Use OPAL Peterson and Beaty splitting factor. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI *** Store position ,energy, direction cosines and time of generation * of ionisation electron NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN IF(LBMCPR)WRITE(LUNOUT,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED NPONT=',I3,' ITER=',I10) IFAIL=1 RETURN C STOP ENDIF XSS(NPONT)=X YSS(NPONT)=Y ZSS(NPONT)=Z TSS(NPONT)=ST ESS(NPONT)=ESEC * Randomise secondary electron direction R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=ACOS(F3) F6=COS(THETA0) F5=SIN(THETA0) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) DCXS(NPONT)=F9*F5 DCYS(NPONT)=F8*F5 DCZS(NPONT)=F6 IDM1=1+INT(Z/ZSTEP) IF(IDM1.GT.9) IDM1=9 * Next line added to avoid IDM1=0 (RV 23/11/2007). IF(IDM1.LT.1) IDM1=1 * End of modification. IPLS(NPONT)=IDM1 NESST(IPLS(NPONT))=NESST(IPLS(NPONT))+1 *** Generate scattering angles and update laboratory cosines after * collision also update energy of electron. 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 S2=(S1*S1)/(S1-1.0D0) * Anisotropic scattering IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE * Isotropic scattering R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C IF(LBMCPR)WRITE(LUNOUT,9232) ITER,ID,E1 C9232 FORMAT(3X,' WARNING ARGZ= 0.0 AT ITER =',I10,' ID=',I10, C - ' E1=',E12.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 190 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 190 CONTINUE *** Store direction cosines and energy after N collisions * for later reuse in primary generation. I100=I100+1 IF(I100.EQ.200) THEN DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 E100=E1 I100=0 ENDIF IF(Z.GT.ZFINAL) THEN * Check if electron has enough energy to go back to final plane. EPOT=EMAG*(Z-ZFINAL)*100.0D0 IF(E1.LT.EPOT)then C GO TO 18 lab18=.true. goto 15 endif ENDIF * Calculate time tzstop to arrive at next z plane IZPLANE. CALL TCALC(Z,DCZ1,E1,EMAG,TZSTOP,TZSTOP1,ISOL,IZPLANE) * Catch runaway electrons at high field IF(TZSTOP.EQ.-99.0D0)then C GO TO 18 lab18=.true. goto 15 endif IF(IPRINT.GT.JPRINT) GO TO 200 GO TO 1 * Intermediate printout 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 XID=DBLE(ID) JCT=ID/100000 C IF(J1.EQ.1 .and. LBMCPR)WRITE(LUNOUT,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VEL POS TIME C / COUNT') C IF(LBMCPR)WRITE(LUNOUT,202) W,ZTOTS,TTOTS,JCT C 202 FORMAT(1X,F8.3,2(1X,D10.3),1X,I6) J1=J1+1 GO TO 1 *** Main loop end 700 XID=DBLE(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DBLE(NEION) ANBT=DBLE(NELEC-IPRIM) ATTOION=ANEION/ANBT ATTATER=SQRT(ANEION)/ANEION ATTIOER=SQRT(ANBT)/ANBT ELSE ATTOION=-1.0D0 ANEION=DBLE(NEION) ATTATER=SQRT(ANEION)/ANEION ENDIF JCT=ID/10000 IF(J1.EQ.1) THEN IF(LBMCPR)WRITE(LUNOUT,940) NCLUS,ITER,NELEC,NEION 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS),', - ' DECREASE THE ESTIMATED ALPHA. NCLUS=',I7, - ' ITER =',I9,' NELEC=',I9,' NEION =',I6) ENDIF IF(LBMCPR)WRITE(LUNOUT,878) NELEC,NEION,IPRIM 878 FORMAT(/,' TOTAL NO OF ELECTRONS=',I8,/,' TOTAL NO OF NEG. IONS=', /I8,/,' TOTAL NO OF PRIMARIES=',I8) EPRMBAR=0.0D0 E2PRM=0.0D0 IF(IPRIM.EQ.1) RETURN DO 310 I=1,IPRIM E2PRM=E2PRM+EPRM(I)*EPRM(I) 310 EPRMBAR=EPRMBAR+EPRM(I) EBAR=EPRMBAR/IPRIM EERR=SQRT(E2PRM/IPRIM-EBAR**2) IF(LBMCPR)WRITE(LUNOUT,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C IF(LBMCPR)WRITE(LUNOUT,837) (IESPECP(J),J=1,100) C 837 FORMAT(/,2X,'ENERGY SPECTRUM OF PRIMARIES IN 1EV BINS',/,10(2X,10I C /5,/)) RETURN 315 IF(ITER.GT.NMAX) THEN IF(LBMCPR)WRITE(LUNOUT,991) - ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =',I10/ - ' NPONT=',I4,' NELEC=',I8,' IPRIM=',I6,' NMXADD=',I3) IFAIL=1 RETURN C STOP ENDIF END +DECK,SPLANE. SUBROUTINE SPLANE(T,E1,DCX1,DCY1,DCZ1,AP,BP,EFLD,TIMLFT,IZPLANE) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,CNSTS1. +SEQ,OUTPT. +SEQ,CION. +SEQ,SPLOUT. +SEQ,SPL1. C-------------------------------------------------------- C STORES POSITION, TIME AND ENERGY AND SUMS REQUIRED C TO CALCULATE DEVIATIONS AND MEANS AT PLANE =IZPLANE C---------------------------------------------------- IF(IZPLANE.GT.8) RETURN T2LFT=TIMLFT*TIMLFT A=AP*TIMLFT B=BP*T2LFT EPLANE=E1+A+B CONST6=SQRT(E1/EPLANE) C DCX2=DCX1*CONST6 C DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFLD*TIMLFT*CONST5/SQRT(EPLANE) XPLANE=X+DCX1*TIMLFT*SQRT(E1)*CONST3*0.01D0 YPLANE=Y+DCY1*TIMLFT*SQRT(E1)*CONST3*0.01D0 ZPLANE=Z+DCZ1*TIMLFT*SQRT(E1)*CONST3*0.01D0+T2LFT*EFLD*CONST2 VZPLANE=DCZ2*SQRT(EPLANE)*CONST3*0.01D0 WGHT=ABS(1.0D0/VZPLANE) RPLANE=SQRT(XPLANE**2+YPLANE**2) XSPL(IZPLANE)=XSPL(IZPLANE)+XPLANE*WGHT YSPL(IZPLANE)=YSPL(IZPLANE)+YPLANE*WGHT RSPL(IZPLANE)=RSPL(IZPLANE)+RPLANE*WGHT ZSPL(IZPLANE)=ZSPL(IZPLANE)+ZPLANE*WGHT TMSPL(IZPLANE)=TMSPL(IZPLANE)+(ST+TIMLFT)*WGHT TTMSPL(IZPLANE)=TTMSPL(IZPLANE)+(ST+TIMLFT)*(ST+TIMLFT)*WGHT XXSPL(IZPLANE)=XXSPL(IZPLANE)+XPLANE*XPLANE*WGHT YYSPL(IZPLANE)=YYSPL(IZPLANE)+YPLANE*YPLANE*WGHT RRSPM(IZPLANE)=RRSPM(IZPLANE)+RPLANE*RPLANE*WGHT ZZSPL(IZPLANE)=ZZSPL(IZPLANE)+ZPLANE*ZPLANE*WGHT ESPL(IZPLANE)=ESPL(IZPLANE)+EPLANE*WGHT TSPL(IZPLANE)=TSPL(IZPLANE)+WGHT/(ST+TIMLFT) VZSPL(IZPLANE)=VZSPL(IZPLANE)+VZPLANE*WGHT TSSUM(IZPLANE)=TSSUM(IZPLANE)+WGHT TSSUM2(IZPLANE)=TSSUM2(IZPLANE)+WGHT*WGHT END +DECK,TCALC. SUBROUTINE TCALC(Z,DCZ1,E1,EMAG,TZSTOP1,TZSTOP2,ISOL,IZPLANE) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS1. +SEQ,CION. +SEQ,CTCALC. C---------------------------------------------------------------------- C CALCULATE ELAPSED TIME ,TZSTOP1, UNTIL ARRIVAL AT NEXT PLANE ,IZPLANE. C IF TWO POSITIVE SOLUTIONS SET ISOL=2 AND CALCULATE SECOND SOLUTION C TZSTOP2. C----------------------------------------------------------------------- ISOL=1 A=EMAG*CONST2 B=SQRT(E1)*CONST3*0.01D0*DCZ1 B2=B*B IF(Z.LT.ZPLANE1) THEN IZPLANE=1 C1=Z-ZPLANE1 c2=0 ELSE IF(Z.LT.ZPLANE2) THEN IZPLANE=2 C1=Z-ZPLANE2 C2=Z-ZPLANE1 ELSE IF(Z.LT.ZPLANE3) THEN IZPLANE=3 C1=Z-ZPLANE3 C2=Z-ZPLANE2 ELSE IF(Z.LT.ZPLANE4) THEN IZPLANE=4 C1=Z-ZPLANE4 C2=Z-ZPLANE3 ELSE IF(Z.LT.ZPLANE5) THEN IZPLANE=5 C1=Z-ZPLANE5 C2=Z-ZPLANE4 ELSE IF(Z.LT.ZPLANE6) THEN IZPLANE=6 C1=Z-ZPLANE6 C2=Z-ZPLANE5 ELSE IF(Z.LT.ZPLANE7) THEN IZPLANE=7 C1=Z-ZPLANE7 C2=Z-ZPLANE6 ELSE IF(Z.LT.ZPLANE8) THEN IZPLANE=8 C1=Z-ZPLANE8 C2=Z-ZPLANE7 ELSE IZPLANE=9 C1=Z-ZPLANE8-10.0D0*ZSTEP C2=Z-ZPLANE8 ENDIF C CHECK PLANE IN DRIFT DIRECTION ( ONLY ONE TIME SOLUTION POSITIVE) FAC=B2-4.0D0*A*C1 IF(FAC.LT.0.0D0) THEN C PASSED FINAL PLANE (RUNAWAY ELECTRONS) TZSTOP1=-99.0D0 RETURN ENDIF TSTOP1=(-B+SQRT(B2-4.0D0*A*C1))/(2.0D0*A) TSTOP2=(-B-SQRT(B2-4.0D0*A*C1))/(2.0D0*A) IF(TSTOP1.LT.TSTOP2) THEN IF(TSTOP1.GE.0.0D0)THEN TZSTOP1=TSTOP1 ELSE TZSTOP1=TSTOP2 ENDIF IF(IZPLANE.EQ.1) RETURN ELSE IF(TSTOP2.GE.0.0D0) THEN TZSTOP1=TSTOP2 ELSE TZSTOP1=TSTOP1 ENDIF IF(IZPLANE.EQ.1) RETURN ENDIF C CHECK PLANE IN BACKWARD DIRECTION (ONLY IF REAL SOLUTION) FAC=B2-4.0D0*A*C2 IF(FAC.LT.0.0D0) RETURN TSTOP1=(-B+SQRT(FAC))/(2.0D0*A) TSTOP2=(-B-SQRT(FAC))/(2.0D0*A) C SOLUTIONS CAN BE EITHER BOTH POSITIVE OR BOTH NEGATIVE C PICK POSITIVE SOLUTIONS AND ORDER IN TIME SEQUENCE OR C RETURN IF NEGATIVE IF(TSTOP1.LT.0.0D0) RETURN C FOUND BACKWARD SOLUTIONS ISOL=2 IZPLANE=IZPLANE-1 IF(TSTOP1.LT.TSTOP2) THEN TZSTOP1=TSTOP1 TZSTOP2=TSTOP2 ELSE TZSTOP1=TSTOP2 TZSTOP2=TSTOP1 ENDIF END +DECK,SST. SUBROUTINE SST IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CION. +SEQ,SPLOUT. +SEQ,SPL1. +SEQ,CTCALC. +SEQ,SSTOUT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION ESST(8),VDSST(8),WSSST(8),DXSST(8),DYSST(8),WTEMP(8) DIMENSION DRSST(8) DIMENSION ALFNE(8),ALFNJ(8),ALFN(8),ZSST(8),DLSST(8) DIMENSION NEPL(8) C---------------------------------------------------------------------- C CALCULATES STEADY STATE TOWNSEND COEFFICIENTS. C LOADS REULTS AND ERRORS INTO COMMON BLOCKS /SSTOUT/ C ------------------------------------------------------------------- VDOUT=0.0D0 VDERR=0.0D0 WSOUT=0.0D0 WSERR=0.0D0 DLOUT=0.0D0 DLERR=0.0D0 DTOUT=0.0D0 DTERR=0.0D0 ALPHSST=0.0D0 ALPHERR=0.0D0 ATTSST=0.0D0 ATTERR=0.0D0 JPRINT=IZFINAL C CALCULATE NUMBER OF ELECTRONS AT EACH PLANE NEPL(1)=IPRIM+NESST(1) DO 21 K=2,JPRINT NEPL(K)=NEPL(K-1)+NESST(K) 21 CONTINUE C SUBSTITUTE NEPL FOR NEEST DO 22 K=1,JPRINT 22 NESST(K)=NEPL(K) DO 23 I=1,JPRINT IF(NESST(I).EQ.0) THEN JPRINT=I-1 GO TO 24 ENDIF 23 CONTINUE 24 ESST(1)=ESPL(1)/TSSUM(1) ZSST(1)=ZSPL(1)/TSSUM(1) VDSST(1)=VZSPL(1)/TSSUM(1) WTEMP(1)=ZSTEP*TSSUM(1)/TMSPL(1) WSSST(1)=WTEMP(1) DXSST(1)=((XXSPL(1)/TSSUM(1))-(XSPL(1)/TSSUM(1))**2)*WSSST(1)/ /(2.0D0*ZSTEP) DYSST(1)=((YYSPL(1)/TSSUM(1))-(YSPL(1)/TSSUM(1))**2)*WSSST(1)/ /(2.0D0*ZSTEP) DLSST(1)=((TTMSPL(1)/TSSUM(1))-(TMSPL(1)/TSSUM(1))**2)*WSSST(1)**3 //(2.0D0*ZSTEP) IF(NESST(1).EQ.0) GO TO 1 ALFNE(1)=(LOG(DBLE(NESST(1)))-LOG(DBLE(IPRIM)))/ZSTEP 1 ALFNJ(1)=0.0D0 ALFN(1)=0.0D0 DO 10 I=2,JPRINT ESST(I)=ESPL(I)/TSSUM(I) ZSST(I)=ZSPL(I)/TSSUM(I) VDSST(I)=VZSPL(I)/TSSUM(I) WTEMP(I)=ZSTEP*DBLE(I)*TSSUM(I)/TMSPL(I) WSSST(I)=(WTEMP(I)*WTEMP(I-1))/(I*WTEMP(I-1)-(I-1)*WTEMP(I)) DXSST(I)=((XXSPL(I)/TSSUM(I))-(XSPL(I)/TSSUM(I))**2-(XXSPL(I-1)/ /TSSUM(I-1))+(XSPL(I-1)/TSSUM(I-1))**2)*WSSST(I)/(2.0D0*ZSTEP) DYSST(I)=((YYSPL(I)/TSSUM(I))-(YSPL(I)/TSSUM(I))**2-(YYSPL(I-1)/ /TSSUM(I-1))+(YSPL(I-1)/TSSUM(I-1))**2)*WSSST(I)/(2.0D0*ZSTEP) DLSST(I)=((TTMSPL(I)/TSSUM(I))-(TMSPL(I)/TSSUM(I))**2-(TTMSPL(I-1) //TSSUM(I-1))+(TMSPL(I-1)/TSSUM(I-1))**2)*WSSST(I)**3/(2.0D0*ZSTEP) ALFN(I)=(LOG(TSSUM(I))-LOG(TSSUM(I-1)))/ZSTEP ALFNJ(I)=(LOG(TSSUM(I)*VDSST(I))-LOG(TSSUM(I-1)*VDSST(I-1)))/ZST /EP IF(NESST(I).EQ.0.OR.NESST(I-1).EQ.0) GO TO 10 10 ALFNE(I)=(LOG(DBLE(NESST(I)))-LOG(DBLE(NESST(I-1))))/ZSTEP DXFIN=((XXSPL(JPRINT)/TSSUM(JPRINT))-(XSPL(JPRINT)/TSSUM(JPRINT)) /**2)*WSSST(JPRINT)/(JPRINT*2.0D0*ZSTEP) DXFIN=DXFIN*1.0D+16 DYFIN=((YYSPL(JPRINT)/TSSUM(JPRINT))-(YSPL(JPRINT)/TSSUM(JPRINT)) /**2)*WSSST(JPRINT)/(JPRINT*2.0D0*ZSTEP) DYFIN=DYFIN*1.0D+16 DLFIN=((TTMSPL(JPRINT)/TSSUM(JPRINT))-(TMSPL(JPRINT)/TSSUM(JPRINT) /)**2)*WSSST(JPRINT)**3/(JPRINT*2.0D0*ZSTEP) DLFIN=DLFIN*1.0D+16 ALNGTH=ZSTEP*DBLE(JPRINT) ALFIN=LOG(DBLE(NESST(JPRINT))/DBLE(IPRIM))/ALNGTH ALFIN=ALFIN*0.01D0 DO 15 J=1,JPRINT VDSST(J)=VDSST(J)*1.0D+09 WSSST(J)=WSSST(J)*1.0D+09 DXSST(J)=DXSST(J)*1.0D+16 DYSST(J)=DYSST(J)*1.0D+16 DLSST(J)=DLSST(J)*1.0D+16 ALFN(J)=ALFN(J)*0.01D0 ALFNJ(J)=ALFNJ(J)*0.01D0 ALFNE(J)=ALFNE(J)*0.01D0 15 CONTINUE IF(LBMCPR)WRITE(LUNOUT,800) JPRINT 800 FORMAT(2(/),' STEADY STATE TOWNSEND RESULTS FOR',I2,' SEQUENTIAL S /PACE PLANES',2(/),'PLANE NEL VD WS DL DT /EBAR ALFN ALFNJ ALFNE',/) DO 20 IPL=1,JPRINT DRSST(IPL)=(DXSST(IPL)+DYSST(IPL))/2.0 20 IF(LBMCPR)WRITE(LUNOUT,810) - IPL,NESST(IPL),VDSST(IPL),WSSST(IPL),DLSST(IPL),DRSST(IPL), - ESST(IPL),ALFN(IPL),ALFNJ(IPL),ALFNE(IPL) 810 FORMAT(1X,I2,2X,I7,2(1X,F6.1),2F9.1,F6.1,3F8.1) IF(NESST(1).GT.NESST(5)) THEN C NET ATTACHMENT THEREFORE TAKE RESULTS FROM PLANE 2 VDOUT=VDSST(2) VDERR=100.0D0*ABS((VDSST(2)-VDSST(3))/(2.0D0*VDSST(2))) WSOUT=WSSST(2) WSERR=100.0D0*ABS((WSSST(2)-WSSST(3))/(2.0D0*WSSST(2))) DLOUT=DLSST(2) DLERR=100.0D0*ABS((DLSST(2)-DLSST(3))/(2.0D0*DLSST(2))) DTOUT=DRSST(2) DTERR=100.0D0*ABS((DRSST(2)-DRSST(3))/(2.0D0*DRSST(2))) IF(ATTOION.EQ.-1.0D0) THEN C NO IONISATION ALPHSST=0.0 ALPHERR=0.0 ANST2=DBLE(NESST(2)) ANST3=DBLE(NESST(3)) ANST4=ANST3-SQRT(ANST3) ANST5=LOG(ANST2/ANST3) ANST6=LOG(ANST2/ANST4) ANST7=ANST6/ANST5 ANST8=ANST7-1.0D0 ATTSST=-(ALFN(2)+ALFNJ(2)+ALFNE(2))/3.0D0 ATTERR=100.0D0*SQRT(ANST8**2+ATTATER**2) ELSE ANST2=DBLE(NESST(2)) ANST3=DBLE(NESST(3)) ANST4=ANST3-SQRT(ANST3) ANST5=LOG(ANST2/ANST3) ANST6=LOG(ANST2/ANST4) ANST7=ANST6/ANST5 ANST8=ANST7-1.0D0 ATMP=(ALFN(2)+ALFNJ(2)+ALFNE(2))/3.0D0 ALPHSST=ATMP/(1.0D0-ATTOION) ALPHERR=100.0D0*SQRT(ANST8**2+ATTIOER**2) ATTSST=ATTOION*ATMP/(1.0D0-ATTOION) ATTERR=100.0D0*SQRT(ANST8**2+ATTATER**2) ENDIF ELSE C NET IONISATION THEREFORE TAKE RESULTS FROM PLANE 8 VDOUT=VDSST(8) VDERR=100.0D0*ABS((VDSST(8)-VDSST(7))/(2.0D0*VDSST(8))) WSOUT=WSSST(8) WSERR=100.0D0*ABS((WSSST(8)-WSSST(7))/(2.0D0*WSSST(8))) DLOUT=DLFIN DLERR=100.0D0*ABS((DLOUT-DLSST(8))/(2.0D0*DLOUT)) DTOUT=(DXFIN+DYFIN)/2.0D0 DTERR=100.0D0*ABS((DTOUT-DRSST(8))/(2.0D0*DTOUT)) ATMP=(ALFN(8)+ALFNJ(8)+ALFNE(8))/3.0D0 ATMP2=(ALFN(7)+ALFNJ(7)+ALFNE(7))/3.0D0 ATER=ABS((ATMP-ATMP2)/(2.0D0*ATMP)) ALPHSST=ATMP/(1.0D0-ATTOION) ALPHERR=100.0D0*SQRT(ATER**2+ATTIOER**2) ATTSST=ATTOION*ATMP/(1.0D0-ATTOION) IF(ATTOION.NE.0.0D0) THEN ATTERR=100.0D0*SQRT(ATER**2+ATTATER**2) ELSE ATTERR=0.0D0 ENDIF ENDIF END +DECK,OUTPUT2. SUBROUTINE OUTPUT2 *----------------------------------------------------------------------- * OUTPUT2 - Output after refining for high fields. * Author: Steve Biagi, with minor modifications. * (Last changed on 2/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,MIX. +SEQ,RATIO. +SEQ,SETP. +SEQ,LARGE. +SEQ,OUTPT. +SEQ,TTRM. +SEQ,SINT. +SEQ,NAMES. +SEQ,SCRIP. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DOUBLE PRECISION FREQEL(mxngas),FREQSP(mxngas),FREINE(mxngas), - FREATT(mxngas),FREION(mxngas),SPECS(32),SMSPEC,ENER,EPLT, - SPECN,ERRFRE,FREQ,FREIN,FREEL,FRELV INTEGER NINEL,NELA,NREAL,I,J,K,J1,J2 *** Print header. IF(LBMCPR)WRITE(LUNOUT,15) IF(LBMCPR)WRITE(LUNOUT,15) 15 FORMAT('---------------------------------------------------------- /-------------------') IF(LBMCPR)WRITE(LUNOUT,110) SPEC(2048) 110 FORMAT(2(/),' NUMBER OF COLLISIONS IN FINAL ENERGY BIN =',F8.1) NREAL=INT(XID) *** Summing rearranged for adjustable number of gases. NINEL=0 NELA=0 DO 10 I=1,NGAS NINEL=NINEL+ICOLL(5*I-3)+ICOLL(5*I-2)+ICOLL(5*I-1)+ICOLL(5*I) NELA=NELA+ICOLL(5*I-4) 10 CONTINUE IF(TTOTS.EQ.0.0D0) THEN NREAL=NMAX TTOTS=ST ELSE NREAL=INT(XID) ENDIF FREQ=NREAL/TTOTS FREIN=NINEL/TTOTS FREEL=NELA/TTOTS IF(LBMCPR)WRITE(LUNOUT,220) FREQ,FREIN,FREEL 220 FORMAT(/,6X,'TOTAL COLL. FREQ. =',D11.4,' (*10**12)/SEC.',/,2X,'IN /ELASTIC COLL. FREQ. =',D11.4,' (*10**12)/SEC.',/,4X,'ELASTIC COLL. / FREQ. =',D11.4,' (*10**12)/SEC.',/) IF(LBMCPR)WRITE(LUNOUT,15) C ILAST=INT(TMAX1)+1 C IF(ILAST.GT.120) ILAST=120 C IF(LBMCPR)WRITE(LUNOUT,1010) (TIME(I),I=1,ILAST) C1010 FORMAT(/,6X,'DISTRIBUTION OF COLLISION TIMES IN 1 PECOSECOND BINS' C /,2(/),20(1X,6(F10.1,2X)/)) C IF(LBMCPR)WRITE(LUNOUT,15) DO 1020 I=1,NGAS FREQEL(I)=ICOLL((5*I)-4)/TTOTS FREQSP(I)=ICOLL(5*I)/TTOTS FREINE(I)=ICOLL((5*I)-1)/TTOTS FREATT(I)=ICOLL((5*I)-2)/TTOTS FREION(I)=ICOLL((5*I)-3)/TTOTS 1020 CONTINUE C IF(LBMCPR)WRITE(LUNOUT,1050) C - (NAMEG(I),FREQEL(I),FREQSP(I),FREINE(I),FREATT(I),FREION(I), C - I=1,NGAS) C1050 FORMAT(/,5X,'COLLISION FREQUENCIES SORTED ACCORDING TO GAS AND TYP C /E OF COLLISION',/,5X,' IN UNITS OF 10**12/SEC.',2(/),' GASES USED C / ELASTIC SUPERELAS INELASTIC ATTACHMENT IONISATION ',2 C /(/),6(A15,1X,5(D10.3,2X),/)) C IF(LBMCPR)WRITE(LUNOUT,15) IF(LBMCPR)WRITE(LUNOUT,1060) 1060 FORMAT(/,2X,'DETAILED COLLISION FREQUENCIES FOR EACH GAS IN UNITS /OF 10**12/SEC. :',2(/)) DO 1100 J=1,NGAS IF(LBMCPR)WRITE(LUNOUT,1065) NAMEG(J) 1065 FORMAT(3X,A15,/,'------------------',2(/)) * Changed LAST to IPLAST (RV, 20/4/2005) DO 1090 K=1,IPLAST IF(IARRY(K).LE.(5*J).AND.IARRY(K).GT.(5*(J-1))) THEN FRELV=FREQ*ICOLN(K)/NREAL IF(ICOLN(K).EQ.0) THEN ERRFRE=0.0 ELSE ERRFRE=100.0D0*SQRT(DBLE(ICOLN(K)))/DBLE(ICOLN(K)) ENDIF IF(LBMCPR)WRITE(LUNOUT,1070) DSCRPT(K),FRELV,ERRFRE 1070 FORMAT(3X,A30,3X,D11.4,' +-',F8.4,' %') ENDIF 1090 CONTINUE 1100 CONTINUE IF(LBMCPR)WRITE(LUNOUT,15) IF(LBMCPR)WRITE(LUNOUT,301) 301 FORMAT(2(/),10X,' NORMALISED ENERGY DISTRIBUTION') J1=0 J2=0 SPECN=DBLE(NREAL) SMSPEC=0.0D0 DO 350 K=1,2048 SPEC(K)=SPEC(K)/SPECN J1=J1+1 SMSPEC=SMSPEC+SPEC(K) IF(J1.LT.64) GO TO 350 J2=J2+1 SPECS(J2)=SMSPEC SMSPEC=0.0D0 J1=0 350 CONTINUE EPLT=EFINAL/32.0D0 DO 420 I=1,32 ENER=EPLT*(DBLE(I)-0.5D0) IF(LBMCPR)WRITE(LUNOUT,302) ENER,SPECS(I) 302 FORMAT(6X,'E=',F12.3,6X,'SPEC=',D12.5) 420 CONTINUE END +DECK,ALPCLB. SUBROUTINE ALPCLCB(IFAIL) *----------------------------------------------------------------------- * ALPCLCB - Estimate time step for avalanche simulation in time of * flight sim. Uses estimated gain of 3.0 between planes. * Calls TOF and PT subroutines and updates ALPHA and ATT. * Version with B-field along x-axis and efield along z-axis * (90 degrees) * Author: Steve Biagi, with minor modifications * (Last changed on 22/ 9/05.) *----------------------------------------------------------------------- implicit none +SEQ,SETP. +SEQ,TOFOUT. +SEQ,MAGBOUT. +SEQ,CION. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. INTEGER IFAIL,IMAX DOUBLE PRECISION WRZN,FC1,FC2,ALPZZ,ALPATT,RATIO *** Assume that this will work. IFAIL=0 *** Increase NMAX if too small. IMAX=NMAX/10000000 IF(IMAX.LT.5) IMAX=5 NMAX=IMAX*10000000 ALPHAST=0.85D0*ABS(ALPHA-ATT) VDST=WZ*1.D-5 TSTEP=LOG(3.0D0)/(ALPHAST*VDST*1.0D5) TSTEP=TSTEP*1.0D12 TFINAL=7.0D0*TSTEP ITFINAL=7 *** Calc time of flight and pt IF(LBMCPR)WRITE(LUNOUT,25) 25 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') IF(LBMCPR)WRITE(LUNOUT,26) TSTEP 26 FORMAT(1(/),' TIME STEP BETWEEN SAMPLING PLANES =',D12.5,' PICOSE /CS.',/) CALL MONTEFTG(IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! ALPCLCB WARNING : Failure in MONTEFTG;'// - ' no further calculations.' RETURN ENDIF CALL FRIEDLAND CALL PTG CALL TOFG IF(LBMCPR)WRITE(LUNOUT,27) RALPHA,RALPER,RATTOF,RATOFER 27 FORMAT(/,'PT IONISATION AND ATTACHMENT RATES *10**12/SEC',/,'ALPHA /=',D10.3,' +- ',F6.2,' % ATT=',D10.3,' +- ',F6.2,' %') IF(LBMCPR)WRITE(LUNOUT,28) 28 FORMAT(/,'TOF DIFFUSION') IF(LBMCPR)WRITE(LUNOUT,29) - TOFDZZ,TOFDZZER,TOFDXX,TOFDXXER,TOFDYY,TOFDYYER, - TOFDYZ,TOFDYZER 29 FORMAT(/,'DZZ=',F8.1,' +- ',F5.1,' %',/,'DXX=',F8.1,' +- ',F5.1,' /%',/,'DYY=',F8.1,' +- ',F5.1,' %',/,'DYZ=',F8.1,' +- ',F5.1,' %') IF(LBMCPR)WRITE(LUNOUT,30) 30 FORMAT(/,'TOF DRIFT VELOCITY') IF(LBMCPR)WRITE(LUNOUT,31) TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER 31 FORMAT(/,'WRZ=',F8.2,' +-',F6.1,' % WRY=',F8.2,' +-',F6.1,' %') *** Calculate townsend sst coeficients from tof results WRZN=TOFWRZ*1.0D05 FC1=WRZN/(2.0D0*TOFDZZ) FC2=((RALPHA-RATTOF)*1.0D12)/TOFDZZ ALPZZ=FC1-SQRT(FC1**2-FC2) *** Load new alpha and attachment into common blocks ALPATT=ALPHA-ATT RATIO=ALPZZ/ALPATT ALPHA=ALPHA*RATIO ATT=ATT*RATIO IF(LBMCPR)WRITE(LUNOUT,32) ALPHA,ALPER,ATT,ATTER 32 FORMAT(/,'TOWNSEND COEFICIENTS CALCULATED FROM TOF RESULTS:',2(/), /'IONISATION RATE /CM.=',D11.4,' +-',F6.2,' %',/,'ATTACHMENT RATE / /CM.=',D11.4,' +-',F6.2,' %',/) END +DECK,MONTEFTG. SUBROUTINE MONTEFTG(IFAIL) *----------------------------------------------------------------------- * MONTEFTG - Calculates collision events and updates diffusion and * velocity. This routine handles terminations at fixed * drift times. B field at 90 degrees to efield. * Author: Steve Biagi, with modifications. * (Last changed on 16/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,BFLD. +SEQ,LARGE. +SEQ,CION. +SEQ,OUTPT. +SEQ,TTRM. +SEQ,IPT. +SEQ,TPLOUT. +SEQ,ANIS. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DOUBLE PRECISION EPRM(4000000),DRAND48,S,YTOT,YTOTS,RDUM,E1, - CONST9,YSTRT,ZSTRT,TSSTRT,DCX1,DCY1,DCZ1,VTOT,TLIM,TDASH, - TSTOP,T,WBT,COSWT,SINWT,DZ,E,TTEM,T2,DCX2,DCY2,DCZ2, - CX1,CY1,CZ1,CX2,CY2,CZ2,E100,DCX100,DCY100,DCZ100,EI,ESEC, - F3,F4,F5,F6,F8,F9,R1,R2,R3,R4,R5,R9,R31,S1,S2,THETA0,PHI0, - ARG1,D,Q,U,CSQD,ARGZ,W,WY,ANEION,ANBT,EPRMBAR,E2PRM,EBAR, - EERR INTEGER IESPECP(100),I,ID,INTEM,I100,NCOL,NELEC,NEION,NMXADD, - NPONT,NCLUS,J1,IPRINT,JPRINT,ITER,IPLANE,IDUM,IE,IT,IPT, - JCT,IFAIL logical lab20 EXTERNAL DRAND48 *** Identify the routine if desired. IF(LIDENT)PRINT *,' /// ROUTINE MONTEFTG ///' *** This will usually work. IFAIL=0 *** Initial values. S=0.0D0 ST=0.0D0 X=0.0D0 Y=0.0D0 Z=0.0D0 ZTOT=0.0D0 ZTOTS=0.0D0 YTOT=0.0D0 YTOTS=0.0D0 TTOT=0.0D0 TTOTS=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 API=ACOS(-1.0D0) DO 25 I=1,300 25 TIME(I)=0.0D0 DO 26 I=1,5*mxngas 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,2048 28 SPEC(I)=0.0D0 DO 33 I=1,100 33 IESPECP(I)=0 DO 34 I=1,8 ETPL(I)=0.0D0 XTPL(I)=0.0D0 YTPL(I)=0.0D0 ZTPL(I)=0.0D0 TTPL(I)=0.0D0 XXTPL(I)=0.0D0 YYTPL(I)=0.0D0 ZZTPL(I)=0.0D0 YZTPL(I)=0.0D0 VZTPL(I)=0.0D0 VYTPL(I)=0.0D0 34 NETPL(I)=0 ID=0 INTEM=8 I100=0 NCOL=0 NNULL=0 NELEC=0 NEION=0 NMXADD=0 NPONT=0 NCLUS=0 J1=1 ZSTRT=0.0D0 YSTRT=0.0D0 TSSTRT=0.0D0 *** Initial direction cosines DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) *** Initial velocity VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 F4=2.0D0*API *** Set to maximum possible collision freq. TLIM=TCFMAX(1) DO 35 I=2,INTEM 35 IF(TLIM.LT.TCFMAX(I)) TLIM=TCFMAX(I) JPRINT=NMAX/10 IPRINT=0 ITER=0 IPLANE=0 IPRIM=0 *** Loop for new starting electrons 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN *** Check if program will exceed maximum number of iterations * in this cycle if so output current results. IF(ITER.GT.NMAX) THEN IPRIM=IPRIM-1 GO TO 700 ENDIF X=0.0D0 Y=0.0D0 Z=0.0D0 DCZ1=DCZ100 DCX1=DCX100 DCY1=DCY100 E1=E100 VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT NCLUS=NCLUS+1 ST=0.0D0 TSSTRT=0.0D0 ZSTRT=0.0D0 YSTRT=0.0D0 IPLANE=0 ENDIF IF(IPRIM.GT.4000000) THEN IF(LBMCPR)WRITE(LUNOUT,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) PRINT *,' !!!!!! MONTEFTG WARNING: Attachment too high;'// - ' unable to compute transport parameters.' GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=INT(E1)+1 IDUM=MIN(IDUM,100) IESPECP(IDUM)=IESPECP(IDUM)+1 **** Start of loop for newly created electrons 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP *** Main loop 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) lab20=.false. 15 continue IF((T+ST).GE.TSTOP .or. lab20) THEN if(.not.lab20)then IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP * Store position and energy at time plane = IPLANE. CALL TPLANEG(T,E1,CX1,CY1,CZ1,EMAG,IPLANE) * Check if passed through more than one plane in this step IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 endif IF((T+ST).GE.TFINAL .or. lab20) THEN if(.not.lab20)then ZTOT=ZTOT+Z YTOT=YTOT+Y TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT YTOTS=YTOTS+Y-YSTRT TTOTS=TTOTS+ST-TSSTRT TSTOP=TSTEP * No more electrons in cascade try new primary electron IF(NELEC.EQ.(NCLUS+1)) GO TO 544 endif * Take electrons from store C 20 continue lab20=.false. X=XS(NPONT) Y=YS(NPONT) Z=ZS(NPONT) ST=TS(NPONT) E1=ES(NPONT) DCX1=DCX(NPONT) DCY1=DCY(NPONT) DCZ1=DCZ(NPONT) VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT IPLANE=IPL(NPONT) NPONT=NPONT-1 ZSTRT=Z YSTRT=Y TSSTRT=ST GO TO 555 ENDIF ENDIF DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0D0-COSWT))/WB E=E1+DZ*EMAG*100.0D0 913 FORMAT(3X,' AFTER STORE ITER=',I10,' DZ=',D12.3,'E1=',D12.3, - ' COSWT=',D12.3,' SINWT=',D12.3,' WBT=',D12.3,' CY1=',D12.3) IF(E.LT.0.0D0) THEN IF(LBMCPR)WRITE(LUNOUT,913)ITER,DZ,E,COSWT,SINWT,WBT,CY1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) *** Test for real or null collision R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 *** Calculate direction cosines and positions at instant before * collision also update diffusion and energy calculations. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 * Calc velocity CX2=CX1 CY2=(CY1-EOVB)*COSWT+CZ1*SINWT+EOVB CZ2=CZ1*COSWT-(CY1-EOVB)*SINWT * Calc direction cosines VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT NCOL=NCOL+1 * Calc new position X=X+CX1*T Y=Y+EOVB*T+((CY1-EOVB)*SINWT+CZ1*(1.0D0-COSWT))/WB Z=Z+DZ ST=ST+T IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 *** Determination of real collision type R2=drand48(RDUM) * Find location within 4 units in collision array CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(E.LT.EI) THEN C IF(LBMCPR)WRITE(LUNOUT,994) E,EI,ITER C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=', C - F8.3,' AT ITER=',I12,' DUE TO BINNING ERROR') *** Fix energy loss smaller than incident energy if a bining error * occurs. EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 * Attachment IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z YTOT=YTOT+Y TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT YTOTS=YTOTS+Y-YSTRT TTOTS=TTOTS+ST-TSSTRT * Electron captured start new primary IF(NELEC.EQ.(NCLUS+1)) GO TO 544 * Electron captured take next electron from store C GO TO 20 lab20=.true. goto 15 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) * Use OPAL Peterson and Beaty splitting factor. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI * Store position ,energy, direction cosines and time of generation * of ionisation electron NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN IF(LBMCPR)WRITE(LUNOUT,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) IFAIL=1 RETURN C STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC *** Randomise secondary electron direction R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=ACOS(F3) F6=COS(THETA0) F5=SIN(THETA0) R4=drand48(rdum) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE *** Generate scattering angles and update laboratory cosines after * collision also update energy of electron. 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 S2=(S1*S1)/(S1-1.0D0) * Anisotropic scattering IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE * Isotropic scattering R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C IF(LBMCPR)WRITE(LUNOUT,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10, C - ' E1=',E12.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 190 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 190 CONTINUE VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT *** Store direction cosines and energy after N collisions * for later reuse in primary generation I100=I100+1 IF(I100.EQ.200) THEN DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 E100=E1 I100=0 ENDIF IF(IPRINT.GT.JPRINT) GO TO 200 GO TO 1 * Intermediate printout 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 WY=YTOTS/TTOTS WY=WY*1.0D+09 JCT=ID/100000 C IF(J1.EQ.1 .and. LBMCPR)WRITE(LUNOUT,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/, C - ' VELZ POSZ TIME', C - ' VELY COUNT ') C IF(LBMCPR)WRITE(LUNOUT,202) W,ZTOTS,TTOTS,WY,JCT C 202 FORMAT(1X,F8.3,3(1X,D10.3),4X,I6) J1=J1+1 GO TO 1 *** Main loop end 700 XID=DBLE(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DBLE(NEION) ANBT=DBLE(NELEC-IPRIM) ATTOINT=ANEION/ANBT ATTERT=SQRT(ANEION)/ANEION AIOERT=SQRT(ANBT)/ANBT ELSE ANEION=DBLE(NEION) ATTOINT=-1.0D0 ATTERT=SQRT(ANEION)/ANEION ENDIF JCT=ID/100000 IF(J1.EQ.1) THEN IF(LBMCPR)WRITE(LUNOUT,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS),', - ' DECREASE THE ESTIMATED ALPHA. NCLUS = ',I7, - ' ITER =',I9) IFAIL=1 RETURN C STOP ENDIF IF(LBMCPR)WRITE(LUNOUT,878) NELEC,NEION,IPRIM 878 FORMAT(/,' TOTAL NO OF ELECTRONS=',I8/' TOTAL NO OF NEG. IONS=', - I8/' TOTAL NO OF PRIMARIES=',I8) EPRMBAR=0.0D0 E2PRM=0.0D0 IF(IPRIM.EQ.1) RETURN DO 310 I=1,IPRIM E2PRM=E2PRM+EPRM(I)*EPRM(I) 310 EPRMBAR=EPRMBAR+EPRM(I) EBAR=EPRMBAR/IPRIM EERR=SQRT(E2PRM/IPRIM-EBAR**2) IF(LBMCPR)WRITE(LUNOUT,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.'/ - ' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C IF(LBMCPR)WRITE(LUNOUT,835) (IESPECP(J),J=1,100) C835 FORMAT(/,2X,'ENERGY SPECTRUM OF PRIMARY ELECTRONS IN 1 EV. BINS', C - /,10(2X,10I5,/)) RETURN 315 IF(ITER.GT.NMAX) THEN IF(LBMCPR)WRITE(LUNOUT,991) - ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =', - I10/' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4, - ' NMXADD=',I3) IFAIL=1 RETURN C STOP ENDIF END +DECK,TPLANEG. SUBROUTINE TPLANEG(T,E1,CX1,CY1,CZ1,EFLD,IPLANE) *----------------------------------------------------------------------- *----------------------------------------------------------------------- IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,CNSTS1. +SEQ,BFLD. +SEQ,CION. +SEQ,OUTPT. +SEQ,TPLOUT. C----------------------------------------------------------------------- C STORES POSITION, TIME AND ENERGY AND SUMS REQUIRED C TO CALCULATE DEVIATIONS AND MEANS AT PLANE =IPLANE C BFIELD AT 90 DEGREES TO EFIELD C----------------------------------------------------------------------- TIMESP=IPLANE*TSTEP C CALC TIME LEFT TO ARRIVE AT PLANE TIMLFT=TIMESP-ST T2LFT=TIMLFT*TIMLFT WBT=WB*TIMLFT COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0D0-COSWT))/WB CX2=CX1 CY2=(CY1-EOVB)*COSWT+CZ1*SINWT+EOVB CZ2=CZ1*COSWT-(CY1-EOVB)*SINWT VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCZ2=CZ2/VTOT DCY2=CY2/VTOT XPLANE=X+CX1*TIMLFT YPLANE=Y+EOVB*TIMLFT+((CY1-EOVB)*SINWT+CZ1*(1.0D0-COSWT))/WB DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0D0-COSWT))/WB ZPLANE=Z+DZ EPLANE=E1+DZ*EFLD*100.0D0 VZPLANE=DCZ2*SQRT(EPLANE)*CONST3*0.01D0 VYPLANE=DCY2*SQRT(EPLANE)*CONST3*0.01D0 XTPL(IPLANE)=XTPL(IPLANE)+XPLANE YTPL(IPLANE)=YTPL(IPLANE)+YPLANE ZTPL(IPLANE)=ZTPL(IPLANE)+ZPLANE XXTPL(IPLANE)=XXTPL(IPLANE)+XPLANE*XPLANE YYTPL(IPLANE)=YYTPL(IPLANE)+YPLANE*YPLANE ZZTPL(IPLANE)=ZZTPL(IPLANE)+ZPLANE*ZPLANE YZTPL(IPLANE)=YZTPL(IPLANE)+YPLANE*ZPLANE ETPL(IPLANE)=ETPL(IPLANE)+EPLANE TTPL(IPLANE)=TTPL(IPLANE)+ST+TIMLFT VZTPL(IPLANE)=VZTPL(IPLANE)+VZPLANE VYTPL(IPLANE)=VYTPL(IPLANE)+VYPLANE NETPL(IPLANE)=NETPL(IPLANE)+1 END +DECK,PTG. SUBROUTINE PTG IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CION. +SEQ,TPLOUT. +SEQ,PTTOF. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION ANTPL(8) C ------------------------------------------------ C CALCULATES PULSED TOWNSEND COEFFICIENTS C------------------------------------------------- ANTPL(1)=DBLE(NETPL(1)) RI(1)=(LOG(ANTPL(1))-LOG(DBLE(IPRIM)))/TSTEP EPT(1)=ETPL(1)/ANTPL(1) TTEST(1)=TTPL(1)/ANTPL(1) VZPT(1)=1.0D+09*VZTPL(1)/ANTPL(1) VYPT(1)=1.0D+09*VYTPL(1)/ANTPL(1) DO 10 I=2,ITFINAL IF(NETPL(I).EQ.0) THEN ITFINAL=I-1 GO TO 11 ENDIF ANTPL(I)=DBLE(NETPL(I)) RI(I)=(LOG(ANTPL(I))-LOG(ANTPL(I-1)))/TSTEP EPT(I)=ETPL(I)/ANTPL(I) TTEST(I)=TTPL(I)/ANTPL(I) VZPT(I)=1.0D+09*VZTPL(I)/ANTPL(I) VYPT(I)=1.0D+09*VYTPL(I)/ANTPL(I) 10 CONTINUE 11 IF(LBMCPR)WRITE(LUNOUT,900) ITFINAL 900 FORMAT(2(/),' PULSED TOWNSEND RESULTS AT',I2,' SEQUENTIAL TIME PLA /NES',/,'PLANE (ION-ATT)FRQ. ENERGY WVZ WVY NO.OF / ELECTRONS',/) DO 20 IPL=1,ITFINAL IF(LBMCPR)WRITE(LUNOUT,910) - IPL,RI(IPL),EPT(IPL),VZPT(IPL),VYPT(IPL),NETPL(IPL) 910 FORMAT(1X,I2,4X,D12.4,4X,F7.2,4X,F6.1,4X,F6.1,4X,I8) 20 CONTINUE END +DECK,TOFG. SUBROUTINE TOFG IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CION. +SEQ,TPLOUT. +SEQ,TOFOUT. +SEQ,PTTOF. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION DZTF(8),DXTF(8),DYTF(8),DYZTF(8),WRZ(8),WRY(8),ANTPL(8) C---------------------------------------------------------- C CALCULATES TIME OF FLIGHT COEFFICIENTS C--------------------------------------------- ANTPL(1)=DBLE(NETPL(1)) WRZ(1)=ZTPL(1)/(ANTPL(1)*TSTEP) WRY(1)=YTPL(1)/(ANTPL(1)*TSTEP) DZTF(1)=((ZZTPL(1)/ANTPL(1))-(ZTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DXTF(1)=((XXTPL(1)/ANTPL(1))-(XTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DYTF(1)=((YYTPL(1)/ANTPL(1))-(YTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DYZTF(1)=((YZTPL(1)/ANTPL(1))-(YTPL(1)*ZTPL(1)/(ANTPL(1)**2)))/(2 /.0D0*TSTEP) DO 10 I=2,ITFINAL ANTPL(I)=DBLE(NETPL(I)) WRZ(I)=((ZTPL(I)/ANTPL(I))-(ZTPL(I-1)/ANTPL(I-1)))/TSTEP WRY(I)=((YTPL(I)/ANTPL(I))-(YTPL(I-1)/ANTPL(I-1)))/TSTEP DZTF(I)=((ZZTPL(I)/ANTPL(I))-(ZTPL(I)/ANTPL(I))**2-(ZZTPL(I-1)/ANT /PL(I-1))+(ZTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) DXTF(I)=((XXTPL(I)/ANTPL(I))-(XTPL(I)/ANTPL(I))**2-(XXTPL(I-1)/ANT /PL(I-1))+(XTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) DYTF(I)=((YYTPL(I)/ANTPL(I))-(YTPL(I)/ANTPL(I))**2-(YYTPL(I-1)/ANT /PL(I-1))+(YTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) DYZTF(I)=((YZTPL(I)/ANTPL(I))-(YTPL(I)*ZTPL(I)/(ANTPL(I)**2))-(YZT /PL(I-1)/ANTPL(I-1))+(YTPL(I-1)*ZTPL(I-1)/(ANTPL(I-1)**2)))/(2.0D0* /TSTEP) 10 CONTINUE DO 15 I=1,ITFINAL WRZ(I)=WRZ(I)*1.0D+09 WRY(I)=WRY(I)*1.0D+09 DZTF(I)=DZTF(I)*1.0D+16 DXTF(I)=DXTF(I)*1.0D+16 DYTF(I)=DYTF(I)*1.0D+16 DYZTF(I)=DYZTF(I)*1.0D+16 15 CONTINUE IF(LBMCPR)WRITE(LUNOUT,900) ITFINAL 900 FORMAT(2(/),' TIME OF FLIGHT RESULTS AT',I2,' SEQUENTIAL TIME PLAN /ES',/,'PLANE DZZ DXX DYY DYZ WRZ /WRY',/) DO 20 IPL=1,ITFINAL IF(LBMCPR)WRITE(LUNOUT,910) - IPL,DZTF(IPL),DXTF(IPL),DYTF(IPL),DYZTF(IPL), - WRZ(IPL),WRY(IPL) 910 FORMAT(1X,I2,2X,4F9.1,4X,F8.2,4X,F8.2) 20 CONTINUE IF(NETPL(1).GT.NETPL(ITFINAL)) THEN C NET ATTACHMENT TAKE RESULTS FROM PLANE 2 TOFENE=EPT(2) TOFENER=100.0D0*ABS((EPT(2)-EPT(3))/(2.0D0*EPT(2))) TOFWVZ=VZPT(2) TOFWVZER=100.0D0*ABS((VZPT(2)-VZPT(3))/(2.0D0*VZPT(2))) TOFWVY=VYPT(2) TOFWVYER=100.0D0*ABS((VYPT(2)-VYPT(3))/(2.0D0*VYPT(2))) TOFDZZ=DZTF(2) TOFDZZER=100.0D0*ABS((DZTF(2)-DZTF(3))/(2.0D0*DZTF(2))) TOFDXX=DXTF(2) TOFDXXER=100.0D0*ABS((DXTF(2)-DXTF(3))/(2.0D0*DXTF(2))) TOFDYY=DYTF(2) TOFDYYER=100.0D0*ABS((DYTF(2)-DYTF(3))/(2.0D0*DYTF(2))) TOFDYZ=DYZTF(2) TOFDYZER=100.0D0*ABS((DYZTF(2)-DYZTF(3))/(2.0D0*DYZTF(2))) TOFWRZ=WRZ(2) TOFWRY=WRY(2) TOFWRZER=100.0D0*ABS((WRZ(2)-WRZ(3))/(2.0D0*WRZ(2))) TOFWRYER=100.0D0*ABS((WRY(2)-WRY(3))/(2.0D0*WRY(2))) ANST2=DBLE(NETPL(2)) ANST3=DBLE(NETPL(3)) ANST4=ANST3-SQRT(ANST3) ANST5=LOG(ANST2/ANST3) ANST6=LOG(ANST2/ANST4) ANST7=ANST6/ANST5 ANST8=ANST7-1.0D0 IF(ATTOINT.EQ.-1.0D0) THEN C NO IONISATION RALPHA=0.0D0 RALPER=0.0D0 RATTOF=-RI(2) RATOFER=100.0D0*SQRT(ANST8**2+ATTERT**2) ELSE RALPHA=RI(2)/(1.0D0-ATTOINT) RALPER=100.0D0*SQRT(ANST8**2+AIOERT**2) RATTOF=ATTOINT*RI(2)/(1.0D0-ATTOINT) RATOFER=100.0D0*SQRT(ANST8**2+ATTERT**2) ENDIF ELSE C NET IONISATION TAKE RESULTS FROM PLANE ITFINAL I1=ITFINAL I2=ITFINAL-1 TOFENE=EPT(I1) TOFENER=100.0D0*ABS((EPT(I1)-EPT(I2))/(2.0D0*EPT(I1))) TOFWVZ=VZPT(I1) TOFWVZER=100.0D0*ABS((VZPT(I1)-VZPT(I2))/(2.0D0*VZPT(I1))) TOFWVY=VYPT(I1) TOFWVYER=100.0D0*ABS((VYPT(I1)-VYPT(I2))/(2.0D0*VYPT(I1))) TOFDZZ=DZTF(I1) TOFDZZER=100.0D0*ABS((DZTF(I1)-DZTF(I2))/(2.0D0*DZTF(I1))) TOFDXX=DXTF(I1) TOFDXXER=100.0D0*ABS((DXTF(I1)-DXTF(I2))/(2.0D0*DXTF(I1))) TOFDYY=DYTF(I1) TOFDYYER=100.0D0*ABS((DYTF(I1)-DYTF(I2))/(2.0D0*DYTF(I1))) TOFDYZ=DYZTF(I1) TOFDYZER=100.0D0*ABS((DYZTF(I1)-DYZTF(I2))/(2.0D0*DYZTF(I1))) TOFWRZ=WRZ(I1) TOFWRY=WRY(I1) TOFWRZER=100.0D0*ABS((WRZ(I1)-WRZ(I2))/(2.0D0*WRZ(I1))) TOFWRYER=100.0D0*ABS((WRY(I1)-WRY(I2))/(2.0D0*WRY(I1))) ATER=ABS((RI(I1)-RI(I2))/(2.0D0*RI(I1))) RALPHA=RI(I1)/(1.0D0-ATTOINT) RALPER=100.0D0*SQRT(ATER**2+AIOERT**2) RATTOF=ATTOINT*RI(I1)/(1.0D0-ATTOINT) IF(ATTOINT.NE.0.0D0) THEN RATOFER=100.0D0*SQRT(ATER**2+ATTERT**2) ELSE RATOFER=0.0D0 ENDIF ENDIF END +DECK,ALPCLCC. SUBROUTINE ALPCLCC(IFAIL) *----------------------------------------------------------------------- * ALPCLCC - Estimate time step for avalanche simulation in time of * flight sim. uses estimated gain of 3.0 between planes. * Calls TOF and PT subroutines and updates ALPHA and ATT * B-field at any angle BTHETA to E-field. * Author: Steve Biagi, with modifications * (Last changed on 22/ 9/05.) *----------------------------------------------------------------------- implicit none +SEQ,SETP. +SEQ,TOFOUT. +SEQ,MAGBOUT. +SEQ,CION. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. INTEGER IFAIL,IMAX DOUBLE PRECISION WRZN,FC1,FC2,ALPZZ,ALPATT,RATIO *** Assume that this will work. IFAIL=0 *** Increase NMAX if too small. IMAX=NMAX/10000000 IF(IMAX.LT.5) IMAX=5 NMAX=IMAX*10000000 ALPHAST=0.85D0*ABS(ALPHA-ATT) VDST=WZ*1.D-5 TSTEP=LOG(3.0D0)/(ALPHAST*VDST*1.0D5) TSTEP=TSTEP*1.0D12 TFINAL=7.0D0*TSTEP ITFINAL=7 *** Calc time of flight and pt IF(LBMCPR)WRITE(LUNOUT,25) 25 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') IF(LBMCPR)WRITE(LUNOUT,26) TSTEP 26 FORMAT(1(/),' TIME STEP BETWEEN SAMPLING PLANES =',D12.5,' PICOSE /CS.',/) CALL MONTEFTH(IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! ALPCLCC WARNING : Failure in MONTEFTH;'// - ' no further calculations.' RETURN ENDIF CALL FRIEDLAND CALL PTH CALL TOFH IF(LBMCPR)WRITE(LUNOUT,27) RALPHA,RALPER,RATTOF,RATOFER 27 FORMAT(/,'PT IONISATION AND ATTACHMENT RATES *10**12/SEC',/,'ALPHA /=',D10.3,' +- ',F6.2,' % ATT=',D10.3,' +- ',F6.2,' %') IF(LBMCPR)WRITE(LUNOUT,28) 28 FORMAT(/,'TOF DIFFUSION') IF(LBMCPR)WRITE(LUNOUT,29) - TOFDZZ,TOFDZZER,TOFDXX,TOFDXXER,TOFDYY,TOFDYYER, - TOFDYZ,TOFDYZER,TOFDXZ,TOFDXZER,TOFDXY,TOFDXYER 29 FORMAT(/,'DZZ=',F8.1,' +- ',F5.1,' %',/,'DXX=',F8.1,' +- ',F5.1,' /%',/,'DYY=',F8.1,' +- ',F5.1,' %',/,'DYZ=',F8.1,' +- ',F5.1,' %',/ /,'DXZ=',F8.1,' +- ',F5.1,' %',/,'DXY=',F8.1,' +- ',F5.1,' %') IF(LBMCPR)WRITE(LUNOUT,30) 30 FORMAT(/,'TOF DRIFT VELOCITY') IF(LBMCPR)WRITE(LUNOUT,31) - TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER,TOFWRX,TOFWRXER 31 FORMAT(/,'WRZ=',F8.2,' +-',F6.1,' % WRY=',F8.2,' +-',F6.1,' % / WRX=',F8.2,' +-',F6.1,' %') *** Calculate townsend sst coeficients from tof results WRZN=TOFWRZ*1.0D05 FC1=WRZN/(2.0D0*TOFDZZ) FC2=((RALPHA-RATTOF)*1.0D12)/TOFDZZ ALPZZ=FC1-SQRT(FC1**2-FC2) *** Load new alpha and attachment into common blocks ALPATT=ALPHA-ATT RATIO=ALPZZ/ALPATT ALPHA=ALPHA*RATIO ATT=ATT*RATIO IF(LBMCPR)WRITE(LUNOUT,32) ALPHA,ALPER,ATT,ATTER 32 FORMAT(/,'TOWNSEND COEFICIENTS CALCULATED FROM TOF RESULTS:',2(/), /'IONISATION RATE /CM.=',D11.4,' +-',F6.2,' %',/,'ATTACHMENT RATE / /CM.=',D11.4,' +-',F6.2,' %',/) END +DECK,MONTEFTH. SUBROUTINE MONTEFTH(IFAIL) *----------------------------------------------------------------------- * MONTEFTH - Calculates collision events and updates diffusion and * velocity. This routine handles terminations at fixed * drift times. Solves motion in coordinate system with * bfield aligned to x-axis electric field at an angle * btheta in the x-z plane. The results for the velocity * vectors are then rotated into the standard coordinate * frame with the electric field along the z-axis and the * bfield at an angle BTHETA to the electric field in the * x-z plane. * Author: Steve Biagi, with modifications. * (Last changed on 16/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,BFLD. +SEQ,ROTS. +SEQ,LARGE. +SEQ,CION. +SEQ,OUTPT. +SEQ,TTRM. +SEQ,IPT. +SEQ,TPLOUT. +SEQ,ANIS. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DOUBLE PRECISION EPRM(4000000),DRAND48,S,RDUM,E1,E,EI, - XTOT,XTOTS,YTOT,YTOTS,XSTRT,YSTRT,ZSTRT,TSSTRT, - CONST9,ARG1,D,Q,U,CSQD,ARGZ,WX,WY,WZ,WXR,WYR,WZR, - RTHETA,VTOT,TLIM,TDASH,TSTOP,T,T2,WBT,COSWT,SINWT,TTEM, - DCX1,DCY1,DCZ1,CX1,CY1,CZ1,DCX100,DCY100,DCZ100,CX2,CY2,CZ2, - DCX2,DCY2,DCZ2,E100,DX,DZ,ESEC,PHI0,THETA0, - F3,F4,F5,F6,F8,F9,R1,R2,R3,R31,R4,R5,R9,S1,S2, - ANEION,ANBT,EPRMBAR,E2PRM,EBAR,EERR INTEGER IESPECP(100),I,ID,INTEM,I100,NCOL,NELEC,NEION,NMXADD, - NPONT,NCLUS,J1,JPRINT,IPRINT,ITER,IPLANE,IDUM,IE,IT,IPT,JCT, - IFAIL EXTERNAL DRAND48 logical lab20 *** Identify the routine if requested. IF(LIDENT)PRINT *,' /// ROUTINE MONTEFTH ///' *** Assume this will work. IFAIL=0 *** Initialise S=0.0D0 ST=0.0D0 X=0.0D0 Y=0.0D0 Z=0.0D0 ZTOT=0.0D0 ZTOTS=0.0D0 YTOT=0.0D0 YTOTS=0.0D0 XTOT=0.0D0 XTOTS=0.0D0 TTOT=0.0D0 TTOTS=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 DO 25 I=1,300 25 TIME(I)=0.0D0 DO 26 I=1,5*mxngas 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,2048 28 SPEC(I)=0.0D0 DO 33 I=1,100 33 IESPECP(I)=0 DO 34 I=1,8 ETPL(I)=0.0D0 XTPL(I)=0.0D0 YTPL(I)=0.0D0 ZTPL(I)=0.0D0 TTPL(I)=0.0D0 XXTPL(I)=0.0D0 YYTPL(I)=0.0D0 ZZTPL(I)=0.0D0 YZTPL(I)=0.0D0 XZTPL(I)=0.0D0 XYTPL(I)=0.0D0 VZTPL(I)=0.0D0 VYTPL(I)=0.0D0 VXTPL(I)=0.0D0 34 NETPL(I)=0 ID=0 INTEM=8 I100=0 NCOL=0 NNULL=0 NELEC=0 NEION=0 NMXADD=0 NPONT=0 NCLUS=0 J1=1 ZSTRT=0.0D0 YSTRT=0.0D0 XSTRT=0.0D0 TSSTRT=0.0D0 API=ACOS(-1.0D0) *** Calc rotation matrix angles RCS=COS((BTHETA-90.0D0)*API/180.0D0) RSN=SIN((BTHETA-90.0D0)*API/180.0D0) RTHETA=BTHETA*API/180.0D0 EFZ100=EMAG*100.0D0*SIN(RTHETA) EFX100=EMAG*100.0D0*COS(RTHETA) F1=EMAG*CONST2*COS(RTHETA) EOVBR=EOVB*SIN(RTHETA) *** Initial direction cosines DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) *** Initial velocity VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 F4=2.0D0*API *** Set to maximum possible collision freq. TLIM=TCFMAX(1) DO 35 I=2,INTEM 35 IF(TLIM.LT.TCFMAX(I)) TLIM=TCFMAX(I) JPRINT=NMAX/10 IPRINT=0 ITER=0 IPLANE=0 IPRIM=0 *** Loop for new starting electrons 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN *** Check if program will exceed maximum number of iterations * in this cycle if so output current results. IF(ITER.GT.NMAX) THEN IPRIM=IPRIM-1 GO TO 700 ENDIF X=0.0D0 Y=0.0D0 Z=0.0D0 DCZ1=DCZ100 DCX1=DCX100 DCY1=DCY100 E1=E100 VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT NCLUS=NCLUS+1 ST=0.0D0 TSSTRT=0.0D0 ZSTRT=0.0D0 YSTRT=0.0D0 XSTRT=0.0D0 IPLANE=0 ENDIF IF(IPRIM.GT.4000000) THEN IF(LBMCPR)WRITE(LUNOUT,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) PRINT *,' !!!!!! MONTEFTH WARNING: Attachment too high;'// - ' unable to compute transport parameters.' GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=INT(E1)+1 IDUM=MIN(IDUM,100) IESPECP(IDUM)=IESPECP(IDUM)+1 *** Start of loop for newly created electrons 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP *** Main loop 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) lab20=.false. 15 continue IF((T+ST).GE.TSTOP .or. lab20) THEN if(.not.lab20)then IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP * Store position and energy at time plane =IPLANE. CALL TPLANEH(T,E1,CX1,CY1,CZ1,EMAG,IPLANE) * Check if passed through more than one plane in this step IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 endif IF((T+ST).GE.TFINAL .or. lab20) THEN if(.not.lab20)then ZTOT=ZTOT+Z YTOT=YTOT+Y XTOT=XTOT+X TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT YTOTS=YTOTS+Y-YSTRT XTOTS=XTOTS+X-XSTRT TTOTS=TTOTS+ST-TSSTRT TSTOP=TSTEP * No more electrons in cascade try new primary electron IF(NELEC.EQ.(NCLUS+1)) GO TO 544 endif * Take electrons from store C 20 continue lab20=.false. X=XS(NPONT) Y=YS(NPONT) Z=ZS(NPONT) ST=TS(NPONT) E1=ES(NPONT) DCX1=DCX(NPONT) DCY1=DCY(NPONT) DCZ1=DCZ(NPONT) VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT IPLANE=IPL(NPONT) NPONT=NPONT-1 ZSTRT=Z YSTRT=Y XSTRT=X TSSTRT=ST GO TO 555 ENDIF ENDIF DZ=(CZ1*SINWT+(EOVBR-CY1)*(1.0D0-COSWT))/WB DX=CX1*T+F1*T*T E=E1+DZ*EFZ100+DX*EFX100 913 FORMAT(3X,' AFTER STORE ITER=',I10,' DZ=',D12.3,'E1=',D12.3, - ' COSWT=',D12.3,' SINWT=',D12.3,' WBT=',D12.3,' CY1=',D12.3) IF(E.LT.0.0D0) THEN IF(LBMCPR)WRITE(LUNOUT,913)ITER,DZ,E,COSWT,SINWT,WBT,CY1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) *** Test for real or null collision R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 *** Calculate direction cosines and positions at instant before * collision also update diffusion and energy calculations. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 * Calc velocity CX2=CX1+2.0D0*F1*T CY2=(CY1-EOVBR)*COSWT+CZ1*SINWT+EOVBR CZ2=CZ1*COSWT-(CY1-EOVBR)*SINWT * Calc direction cosines VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT NCOL=NCOL+1 * Calc new position X=X+DX Y=Y+EOVBR*T+((CY1-EOVBR)*SINWT+CZ1*(1.0D0-COSWT))/WB Z=Z+DZ ST=ST+T IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 *** Determination of real collision type R2=drand48(RDUM) * Find location within 4 units in collision array CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(E.LT.EI) THEN C IF(LBMCPR)WRITE(LUNOUT,994) E,EI,ITER C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') *** Fix energy loss smaller than incident energy if a bining error * occurs. EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 * Attachment IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z YTOT=YTOT+Y XTOT=XTOT+X TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT YTOTS=YTOTS+Y-YSTRT XTOTS=XTOTS+X-XSTRT TTOTS=TTOTS+ST-TSSTRT * Electron captured start new primary IF(NELEC.EQ.(NCLUS+1)) GO TO 544 * Electron captured take next electron from store C GO TO 20 lab20=.true. goto 15 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) * Use OPAL Peterson and Beaty splitting factor. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI * Store position ,energy, direction cosines and time of generation * of ionisation electron NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN IF(LBMCPR)WRITE(LUNOUT,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) IFAIL=1 RETURN C STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC * Randomise secondary electron direction R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=ACOS(F3) F6=COS(THETA0) F5=SIN(THETA0) R4=drand48(rdum) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE *** Generate scattering angles and update laboratory cosines after * collision also update energy of electron. 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 S2=(S1*S1)/(S1-1.0D0) * Anisotropic scattering IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE * Isotropic scattering R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C IF(LBMCPR)WRITE(LUNOUT,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10, C - ' E1=',E12.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 190 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 190 CONTINUE VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT *** Store direction cosines and energy after N collisions * for later reuse in primary generation I100=I100+1 IF(I100.EQ.200) THEN DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 E100=E1 I100=0 ENDIF IF(IPRINT.GT.JPRINT) GO TO 200 GO TO 1 *** Intermediate printout 200 IPRINT=0 WZ=ZTOTS/TTOTS WZ=WZ*1.0D+09 WY=YTOTS/TTOTS WY=WY*1.0D+09 WX=XTOTS/TTOTS WX=WX*1.0D+09 JCT=ID/100000 C IF(J1.EQ.1 .and. LBMCPR)WRITE(LUNOUT,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VELZ VELY VELX C / TIME COUNT ') *** Rotate intermediate output into lab frame WZR=WZ*RCS-WX*RSN WYR=WY WXR=WZ*RSN+WX*RCS C IF(LBMCPR)WRITE(LUNOUT,202) WZR,WYR,WXR,TTOTS,JCT C 202 FORMAT(3(1X,F8.3),1X,D10.3,4X,I6) J1=J1+1 GO TO 1 *** Main loop end 700 XID=DBLE(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DBLE(NEION) ANBT=DBLE(NELEC-IPRIM) ATTOINT=ANEION/ANBT ATTERT=SQRT(ANEION)/ANEION AIOERT=SQRT(ANBT)/ANBT ELSE ANEION=DBLE(NEION) ATTOINT=-1.0D0 ATTERT=SQRT(ANEION)/ANEION ENDIF JCT=ID/100000 IF(J1.EQ.1) THEN IF(LBMCPR)WRITE(LUNOUT,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS),', - ' DECREASE THE ESTIMATED ALPHA. NCLUS = ',I7, - ' ITER =',I9) IFAIL=1 RETURN C STOP ENDIF IF(LBMCPR)WRITE(LUNOUT,878) NELEC,NEION,IPRIM 878 FORMAT(/,' TOTAL NO OF ELECTRONS=',I8,/,' TOTAL NO OF NEG. IONS=', - I8,/,' TOTAL NO OF PRIMARIES=',I8) EPRMBAR=0.0D0 E2PRM=0.0D0 IF(IPRIM.EQ.1) RETURN DO 310 I=1,IPRIM E2PRM=E2PRM+EPRM(I)*EPRM(I) 310 EPRMBAR=EPRMBAR+EPRM(I) EBAR=EPRMBAR/IPRIM EERR=SQRT(E2PRM/IPRIM-EBAR**2) IF(LBMCPR)WRITE(LUNOUT,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, - ' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C IF(LBMCPR)WRITE(LUNOUT,835) (IESPECP(J),J=1,100) C835 FORMAT(/,2X,'ENERGY SPECTRUM OF PRIMARY ELECTRONS IN 1 EV. BINS'/ C - 10(2X,10I5,/)) RETURN 315 IF(ITER.GT.NMAX) THEN IF(LBMCPR)WRITE(LUNOUT,991) - ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =',I10/ - ' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4,' NMXADD=',I3) IFAIL=1 RETURN C STOP ENDIF END +DECK,TPLANEH. SUBROUTINE TPLANEH(T,E1,CX1,CY1,CZ1,EFLD,IPLANE) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,CNSTS1. +SEQ,BFLD. +SEQ,ROTS. +SEQ,CION. +SEQ,OUTPT. +SEQ,TPLOUT. C----------------------------------------------------------------------- C STORES POSITION, TIME AND ENERGY AND SUMS REQUIRED C TO CALCULATE DEVIATIONS AND MEANS AT PLANE =IPLANE C USED WITH BFIELD AT ANGLE BTHETA TO EMAG C ROTATES STORED POSITIONS INTO LAB FRAME. C----------------------------------------------------------------------- TIMESP=IPLANE*TSTEP C CALC TIME LEFT TO ARRIVE AT PLANE TIMLFT=TIMESP-ST T2LFT=TIMLFT*TIMLFT WBT=WB*TIMLFT COSWT=COS(WBT) SINWT=SIN(WBT) CX2=CX1+2.0D0*F1*TIMLFT CY2=(CY1-EOVBR)*COSWT+CZ1*SINWT+EOVBR CZ2=CZ1*COSWT-(CY1-EOVBR)*SINWT VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCZ2=CZ2/VTOT DCY2=CY2/VTOT DCX2=CX2/VTOT DX=CX1*TIMLFT+F1*TIMLFT*TIMLFT XPLANE=X+DX YPLANE=Y+EOVBR*TIMLFT+((CY1-EOVBR)*SINWT+CZ1*(1.0D0-COSWT))/WB DZ=(CZ1*SINWT+(EOVBR-CY1)*(1.0D0-COSWT))/WB ZPLANE=Z+DZ C ROTATE POSITIONS ZPLANER=ZPLANE*RCS-XPLANE*RSN YPLANER=YPLANE XPLANER=ZPLANE*RSN+XPLANE*RCS EPLANE=E1+DZ*EFZ100+DX*EFX100 VZPLANE=DCZ2*SQRT(EPLANE)*CONST3*0.01D0 VYPLANE=DCY2*SQRT(EPLANE)*CONST3*0.01D0 VXPLANE=DCX2*SQRT(EPLANE)*CONST3*0.01D0 XTPL(IPLANE)=XTPL(IPLANE)+XPLANER YTPL(IPLANE)=YTPL(IPLANE)+YPLANER ZTPL(IPLANE)=ZTPL(IPLANE)+ZPLANER XXTPL(IPLANE)=XXTPL(IPLANE)+XPLANER*XPLANER YYTPL(IPLANE)=YYTPL(IPLANE)+YPLANER*YPLANER ZZTPL(IPLANE)=ZZTPL(IPLANE)+ZPLANER*ZPLANER YZTPL(IPLANE)=YZTPL(IPLANE)+YPLANER*ZPLANER XZTPL(IPLANE)=XZTPL(IPLANE)+XPLANER*ZPLANER XYTPL(IPLANE)=XYTPL(IPLANE)+XPLANER*YPLANER ETPL(IPLANE)=ETPL(IPLANE)+EPLANE TTPL(IPLANE)=TTPL(IPLANE)+ST+TIMLFT C ROTATE VELOCITIES VZPLNER=VZPLANE*RCS-VXPLANE*RSN VYPLNER=VYPLANE VXPLNER=VZPLANE*RSN+VXPLANE*RCS VZTPL(IPLANE)=VZTPL(IPLANE)+VZPLNER VYTPL(IPLANE)=VYTPL(IPLANE)+VYPLNER VXTPL(IPLANE)=VXTPL(IPLANE)+VXPLNER NETPL(IPLANE)=NETPL(IPLANE)+1 END +DECK,PTH. SUBROUTINE PTH IMPLICIT REAL*8 (A-H,O-Z) +SEQ,ROTS. +SEQ,CION. +SEQ,TPLOUT. +SEQ,PTTOF. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION ANTPL(8) C ------------------------------------------------ C CALCULATES PULSED TOWNSEND COEFFICIENTS C------------------------------------------------- ANTPL(1)=DBLE(NETPL(1)) RI(1)=(LOG(ANTPL(1))-LOG(DBLE(IPRIM)))/TSTEP EPT(1)=ETPL(1)/ANTPL(1) TTEST(1)=TTPL(1)/ANTPL(1) VZPT(1)=1.0D+09*VZTPL(1)/ANTPL(1) VYPT(1)=1.0D+09*VYTPL(1)/ANTPL(1) VXPT(1)=1.0D+09*VXTPL(1)/ANTPL(1) DO 10 I=2,ITFINAL IF(NETPL(I).EQ.0) THEN ITFINAL=I-1 GO TO 11 ENDIF ANTPL(I)=DBLE(NETPL(I)) RI(I)=(LOG(ANTPL(I))-LOG(ANTPL(I-1)))/TSTEP EPT(I)=ETPL(I)/ANTPL(I) TTEST(I)=TTPL(I)/ANTPL(I) VZPT(I)=1.0D+09*VZTPL(I)/ANTPL(I) VYPT(I)=1.0D+09*VYTPL(I)/ANTPL(I) VXPT(I)=1.0D+09*VXTPL(I)/ANTPL(I) 10 CONTINUE 11 IF(LBMCPR)WRITE(LUNOUT,900) ITFINAL 900 FORMAT(2(/),' PULSED TOWNSEND RESULTS AT',I2,' SEQUENTIAL TIME PLA /NES',/,'PLANE (ION-ATT)FRQ. ENERGY WVZ WVY W /VX NO.OF ELECTRNS',/) DO 20 IPL=1,ITFINAL IF(LBMCPR)WRITE(LUNOUT,910) - IPL,RI(IPL),EPT(IPL),VZPT(IPL),VYPT(IPL),VXPT(IPL), - NETPL(IPL) 910 FORMAT(1X,I2,4X,D12.4,4X,F7.2,4X,F6.1,4X,F6.1,4X,F6.1,4X,I8) 20 CONTINUE END +DECK,TOFH. SUBROUTINE TOFH IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CION. +SEQ,TPLOUT. +SEQ,TOFOUT. +SEQ,PTTOF. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION DZTF(8),DXTF(8),DYTF(8),DYZTF(8),DXYTF(8),DXZTF(8) DIMENSION WRZ(8),WRY(8),WRX(8),ANTPL(8) C---------------------------------------------------------- C CALCULATES TIME OF FLIGHT COEFFICIENTS C--------------------------------------------- ANTPL(1)=DBLE(NETPL(1)) WRZ(1)=ZTPL(1)/(ANTPL(1)*TSTEP) WRY(1)=YTPL(1)/(ANTPL(1)*TSTEP) WRX(1)=XTPL(1)/(ANTPL(1)*TSTEP) DZTF(1)=((ZZTPL(1)/ANTPL(1))-(ZTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DXTF(1)=((XXTPL(1)/ANTPL(1))-(XTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DYTF(1)=((YYTPL(1)/ANTPL(1))-(YTPL(1)/ANTPL(1))**2)/(2.0D0*TSTEP) DYZTF(1)=((YZTPL(1)/ANTPL(1))-(YTPL(1)*ZTPL(1)/(ANTPL(1)**2)))/(2 /.0D0*TSTEP) DXZTF(1)=((XZTPL(1)/ANTPL(1))-(XTPL(1)*ZTPL(1)/(ANTPL(1)**2)))/(2 /.0D0*TSTEP) DXYTF(1)=((XYTPL(1)/ANTPL(1))-(XTPL(1)*YTPL(1)/(ANTPL(1)**2)))/(2 /.0D0*TSTEP) DO 10 I=2,ITFINAL ANTPL(I)=DBLE(NETPL(I)) WRZ(I)=((ZTPL(I)/ANTPL(I))-(ZTPL(I-1)/ANTPL(I-1)))/TSTEP WRY(I)=((YTPL(I)/ANTPL(I))-(YTPL(I-1)/ANTPL(I-1)))/TSTEP WRX(I)=((XTPL(I)/ANTPL(I))-(XTPL(I-1)/ANTPL(I-1)))/TSTEP DZTF(I)=((ZZTPL(I)/ANTPL(I))-(ZTPL(I)/ANTPL(I))**2-(ZZTPL(I-1)/ANT /PL(I-1))+(ZTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) DXTF(I)=((XXTPL(I)/ANTPL(I))-(XTPL(I)/ANTPL(I))**2-(XXTPL(I-1)/ANT /PL(I-1))+(XTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) DYTF(I)=((YYTPL(I)/ANTPL(I))-(YTPL(I)/ANTPL(I))**2-(YYTPL(I-1)/ANT /PL(I-1))+(YTPL(I-1)/ANTPL(I-1))**2)/(2.0D0*TSTEP) DYZTF(I)=((YZTPL(I)/ANTPL(I))-(YTPL(I)*ZTPL(I)/(ANTPL(I)**2))-(YZT /PL(I-1)/ANTPL(I-1))+(YTPL(I-1)*ZTPL(I-1)/(ANTPL(I-1)**2)))/(2.0D0* /TSTEP) DXZTF(I)=((XZTPL(I)/ANTPL(I))-(XTPL(I)*ZTPL(I)/(ANTPL(I)**2))-(XZT /PL(I-1)/ANTPL(I-1))+(XTPL(I-1)*ZTPL(I-1)/(ANTPL(I-1)**2)))/(2.0D0* /TSTEP) DXYTF(I)=((XYTPL(I)/ANTPL(I))-(XTPL(I)*YTPL(I)/(ANTPL(I)**2))-(XYT /PL(I-1)/ANTPL(I-1))+(XTPL(I-1)*YTPL(I-1)/(ANTPL(I-1)**2)))/(2.0D0* /TSTEP) 10 CONTINUE DO 15 I=1,ITFINAL WRZ(I)=WRZ(I)*1.0D+09 WRY(I)=WRY(I)*1.0D+09 WRX(I)=WRX(I)*1.0D+09 DZTF(I)=DZTF(I)*1.0D+16 DXTF(I)=DXTF(I)*1.0D+16 DYTF(I)=DYTF(I)*1.0D+16 DYZTF(I)=DYZTF(I)*1.0D+16 DXZTF(I)=DXZTF(I)*1.0D+16 DXYTF(I)=DXYTF(I)*1.0D+16 15 CONTINUE IF(LBMCPR)WRITE(LUNOUT,900) ITFINAL 900 FORMAT(2(/),' TIME OF FLIGHT RESULTS AT',I2,' SEQUENTIAL TIME PLAN /ES',/,'PLANE DZZ DXX DYY DYZ DXZ DXY W /RZ WRY WRX',/) DO 20 IPL=1,ITFINAL IF(LBMCPR)WRITE(LUNOUT,910) - IPL,DZTF(IPL),DXTF(IPL),DYTF(IPL),DYZTF(IPL), - DXZTF(IPL),DXYTF(IPL),WRZ(IPL),WRY(IPL),WRX(IPL) 910 FORMAT(1X,I2,2X,6F8.1,3F8.2) 20 CONTINUE IF(NETPL(1).GT.NETPL(ITFINAL)) THEN C NET ATTACHMENT TAKE RESULTS FROM PLANE 2 TOFENE=EPT(2) TOFENER=100.0D0*ABS((EPT(2)-EPT(3))/(2.0D0*EPT(2))) TOFWVZ=VZPT(2) TOFWVZER=100.0D0*ABS((VZPT(2)-VZPT(3))/(2.0D0*VZPT(2))) TOFWVY=VYPT(2) TOFWVYER=100.0D0*ABS((VYPT(2)-VYPT(3))/(2.0D0*VYPT(2))) TOFWVX=VXPT(2) TOFWVXER=100.0D0*ABS((VXPT(2)-VXPT(3))/(2.0D0*VXPT(2))) TOFDZZ=DZTF(2) TOFDZZER=100.0D0*ABS((DZTF(2)-DZTF(3))/(2.0D0*DZTF(2))) TOFDXX=DXTF(2) TOFDXXER=100.0D0*ABS((DXTF(2)-DXTF(3))/(2.0D0*DXTF(2))) TOFDYY=DYTF(2) TOFDYYER=100.0D0*ABS((DYTF(2)-DYTF(3))/(2.0D0*DYTF(2))) TOFDYZ=DYZTF(2) TOFDYZER=100.0D0*ABS((DYZTF(2)-DYZTF(3))/(2.0D0*DYZTF(2))) TOFDXZ=DXZTF(2) TOFDXZER=100.0D0*ABS((DXZTF(2)-DXZTF(3))/(2.0D0*DXZTF(2))) TOFDXY=DXYTF(2) TOFDXYER=100.0D0*ABS((DXYTF(2)-DXYTF(3))/(2.0D0*DXYTF(2))) TOFWRZ=WRZ(2) TOFWRY=WRY(2) TOFWRX=WRX(2) TOFWRZER=100.0D0*ABS((WRZ(2)-WRZ(3))/(2.0D0*WRZ(2))) TOFWRYER=100.0D0*ABS((WRY(2)-WRY(3))/(2.0D0*WRY(2))) TOFWRXER=100.0D0*ABS((WRX(2)-WRX(3))/(2.0D0*WRX(2))) ANST2=DBLE(NETPL(2)) ANST3=DBLE(NETPL(3)) ANST4=ANST3-SQRT(ANST3) ANST5=LOG(ANST2/ANST3) ANST6=LOG(ANST2/ANST4) ANST7=ANST6/ANST5 ANST8=ANST7-1.0D0 IF(ATTOINT.EQ.-1.0D0) THEN C NO IONISATION RALPHA=0.0D0 RALPER=0.0D0 RATTOF=-RI(2) RATOFER=100.0D0*SQRT(ANST8**2+ATTERT**2) ELSE RALPHA=RI(2)/(1.0D0-ATTOINT) RALPER=100.0D0*SQRT(ANST8**2+AIOERT**2) RATTOF=ATTOINT*RI(2)/(1.0D0-ATTOINT) RATOFER=100.0D0*SQRT(ANST8**2+ATTERT**2) ENDIF ELSE C NET IONISATION TAKE RESULTS FROM PLANE ITFINAL I1=ITFINAL I2=ITFINAL-1 TOFENE=EPT(I1) TOFENER=100.0D0*ABS((EPT(I1)-EPT(I2))/(2.0D0*EPT(I1))) TOFWVZ=VZPT(I1) TOFWVZER=100.0D0*ABS((VZPT(I1)-VZPT(I2))/(2.0D0*VZPT(I1))) TOFWVY=VYPT(I1) TOFWVYER=100.0D0*ABS((VYPT(I1)-VYPT(I2))/(2.0D0*VYPT(I1))) TOFWVX=VXPT(I1) TOFWVXER=100.0D0*ABS((VXPT(I1)-VXPT(I2))/(2.0D0*VXPT(I1))) TOFDZZ=DZTF(I1) TOFDZZER=100.0D0*ABS((DZTF(I1)-DZTF(I2))/(2.0D0*DZTF(I1))) TOFDXX=DXTF(I1) TOFDXXER=100.0D0*ABS((DXTF(I1)-DXTF(I2))/(2.0D0*DXTF(I1))) TOFDYY=DYTF(I1) TOFDYYER=100.0D0*ABS((DYTF(I1)-DYTF(I2))/(2.0D0*DYTF(I1))) TOFDYZ=DYZTF(I1) TOFDYZER=100.0D0*ABS((DYZTF(I1)-DYZTF(I2))/(2.0D0*DYZTF(I1))) TOFDXZ=DXZTF(I1) TOFDXZER=100.0D0*ABS((DXZTF(I1)-DXZTF(I2))/(2.0D0*DXZTF(I1))) TOFDXY=DXYTF(I1) TOFDXYER=100.0D0*ABS((DXYTF(I1)-DXYTF(I2))/(2.0D0*DXYTF(I1))) TOFWRZ=WRZ(I1) TOFWRY=WRY(I1) TOFWRX=WRX(I1) TOFWRZER=100.0D0*ABS((WRZ(I1)-WRZ(I2))/(2.0D0*WRZ(I1))) TOFWRYER=100.0D0*ABS((WRY(I1)-WRY(I2))/(2.0D0*WRY(I1))) TOFWRXER=100.0D0*ABS((WRX(I1)-WRX(I2))/(2.0D0*WRX(I1))) ATER=ABS((RI(I1)-RI(I2))/(2.0D0*RI(I1))) RALPHA=RI(I1)/(1.0D0-ATTOINT) RALPER=100.0D0*SQRT(ATER**2+AIOERT**2) RATTOF=ATTOINT*RI(I1)/(1.0D0-ATTOINT) IF(ATTOINT.NE.0.0D0) THEN RATOFER=100.0D0*SQRT(ATER**2+ATTERT**2) ELSE RATOFER=0.0D0 ENDIF ENDIF END +DECK,ALPCLCA. SUBROUTINE ALPCLCA(IFAIL) *----------------------------------------------------------------------- * ALPCLCA - Estimate time step for avalanche simulation in time of * flight sim. Uses estimated gain of 3.0 between planes. * Calls TOF and PT subroutines and updates ALPHA and ATT. * Version with B-field parallel to E-field. *----------------------------------------------------------------------- implicit none +SEQ,SETP. +SEQ,TOFOUT. +SEQ,MAGBOUT. +SEQ,CION. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. INTEGER IMAX,IFAIL DOUBLE PRECISION WRN,FC1,FC2,ALPZZ,ALPATT,RATIO *** Assume that this will work. IFAIL=0 *** Increase NMAX if needed. IMAX=NMAX/10000000 IF(IMAX.LT.5) IMAX=5 NMAX=IMAX*10000000 ALPHAST=0.85D0*ABS(ALPHA-ATT) VDST=WZ*1.D-5 TSTEP=LOG(3.0D0)/(ALPHAST*VDST*1.0D5) TSTEP=TSTEP*1.0D12 TFINAL=7.0D0*TSTEP ITFINAL=7 *** Calc time of flight and pt IF(LBMCPR)WRITE(LUNOUT,25) 25 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') IF(LBMCPR)WRITE(LUNOUT,26) TSTEP 26 FORMAT(1(/),' TIME STEP BETWEEN SAMPLING PLANES =',D12.5,' PICOSE /CS.',/) CALL MONTEFTA(IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! ALPCLCA WARNING : Failure in MONTEFTA;'// - ' no further calculations.' RETURN ENDIF CALL FRIEDLAND CALL PT CALL TOF IF(LBMCPR)WRITE(LUNOUT,27) RALPHA,RALPER,RATTOF,RATOFER 27 FORMAT(/,'PT IONISATION AND ATTACHMENT RATES *10**12/SEC',/,'ALPHA /=',D10.3,' +- ',F6.2,' % ATT=',D10.3,' +- ',F6.2,' %') IF(LBMCPR)WRITE(LUNOUT,28) 28 FORMAT(/,' TOF DIFFUSION') IF(LBMCPR)WRITE(LUNOUT,29) TOFDL,TOFDLER,TOFDT,TOFDTER 29 FORMAT(/,' DL=',F8.1,' +- ',F6.1,' % DT=',F8.1,' +- ',F6.1, /' %') IF(LBMCPR)WRITE(LUNOUT,30) 30 FORMAT(/,' TOF DRIFT VELOCITY') IF(LBMCPR)WRITE(LUNOUT,31) TOFWR,TOFWRER 31 FORMAT(/,' WR=',F8.2,' +- ',F6.2,' %') *** Calculate townsend sst coeficients from tof results WRN=TOFWR*1.0D05 FC1=WRN/(2.0D0*TOFDL) FC2=((RALPHA-RATTOF)*1.0D12)/TOFDL ALPZZ=FC1-SQRT(FC1**2-FC2) *** Load new alpha and attachment into common blocks ALPATT=ALPHA-ATT RATIO=ALPZZ/ALPATT ALPHA=ALPHA*RATIO ATT=ATT*RATIO IF(LBMCPR)WRITE(LUNOUT,32) ALPHA,ALPER,ATT,ATTER 32 FORMAT(/,'TOWNSEND COEFICIENTS CALCULATED FROM TOF RESULTS:',2(/), /'IONISATION RATE /CM.=',D11.4,' +-',F6.2,' %',/,'ATTACHMENT RATE / /CM.=',D11.4,' +-',F6.2,' %',/) END +DECK,MONTEFTA. SUBROUTINE MONTEFTA(IFAIL) *----------------------------------------------------------------------- * MONTEFTA - Calculates collision events and updates diffusion and * velocity. This routine handles terminations at fixed * drift times. Bfield parallel to Efield. * Author: Steve Biagi, with modifications. * (Last changed on 16/ 3/08.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDIM. +SEQ,INPT. +SEQ,CNSTS1. +SEQ,SETP. +SEQ,BFLD. +SEQ,LARGE. +SEQ,CION. +SEQ,OUTPT. +SEQ,TTRM. +SEQ,IPT. +SEQ,TPLOUT. +SEQ,ANIS. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DOUBLE PRECISION EPRM(4000000),DRAND48,S,RDUM,E1,EI,ESEC, - CONST6,CONST7,CONST9,A,DX,DY, - ZSTRT,TSSTRT,DCX1,DCY1,DCZ1,VTOT,CX1,CY1,CZ1,CX2,CY2, - E100,DCX100,DCY100,DCZ100,DCX2,DCY2,DCZ2, - AP,BP,TLIM,TDASH,TSTOP,T,E,TTEM,T2,PHI0,THETA0, - F1,F2,F3,F4,F5,F6,F8,F9,R1,R2,R3,R4,R5,R9,R31,S1,S2, - WBT,COSWT,SINWT,ARG1,D,Q,U,CSQD,ARGZ,W,ANEION,ANBT,EPRMBAR, - E2PRM,EBAR,EERR INTEGER IESPECP(100),I,ID,INTEM,I100,NCOL,NELEC,NEION,NMXADD,IT, - NPONT,NCLUS,J1,IPRINT,JPRINT,ITER,IPLANE,IDUM,IE,IPT,JCT, - IFAIL EXTERNAL DRAND48 logical lab20 *** Identify the routine if requested. IF(LIDENT)PRINT *,' /// ROUTINE MONTEFTA ///' *** Assume this will work. IFAIL=0 *** Initialise. S=0.0D0 ST=0.0D0 X=0.0D0 Y=0.0D0 Z=0.0D0 ZTOT=0.0D0 ZTOTS=0.0D0 TTOT=0.0D0 TTOTS=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 DO 25 I=1,300 25 TIME(I)=0.0D0 DO 26 I=1,5*mxngas 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,2048 28 SPEC(I)=0.0D0 DO 33 I=1,100 33 IESPECP(I)=0 DO 34 I=1,8 ETPL(I)=0.0D0 XTPL(I)=0.0D0 YTPL(I)=0.0D0 ZTPL(I)=0.0D0 TTPL(I)=0.0D0 XXTPL(I)=0.0D0 YYTPL(I)=0.0D0 ZZTPL(I)=0.0D0 VZTPL(I)=0.0D0 34 NETPL(I)=0 ID=0 INTEM=8 I100=0 NCOL=0 NNULL=0 NELEC=0 NEION=0 NMXADD=0 NPONT=0 NCLUS=0 J1=1 ZSTRT=0.0D0 TSSTRT=0.0D0 * Initial direction cosines DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) * Initial velocity VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 API=ACOS(-1.0D0) F4=2.0D0*API * Set to maximum possible collision freq. TLIM=TCFMAX(1) DO 35 I=2,INTEM 35 IF(TLIM.LT.TCFMAX(I)) TLIM=TCFMAX(I) JPRINT=NMAX/10 IPRINT=0 ITER=0 IPLANE=0 IPRIM=0 *** Loop for new starting electrons 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN * Check if program will exceed maximum number of iterations * in this cycle if so output current results. IF(ITER.GT.NMAX) THEN IPRIM=IPRIM-1 GO TO 700 ENDIF X=0.0D0 Y=0.0D0 Z=0.0D0 DCZ1=DCZ100 DCX1=DCX100 DCY1=DCY100 E1=E100 VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT NCLUS=NCLUS+1 ST=0.0D0 TSSTRT=0.0D0 ZSTRT=0.0D0 IPLANE=0 ENDIF IF(IPRIM.GT.4000000) THEN IF(LBMCPR)WRITE(LUNOUT,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) PRINT *,' !!!!!! MONTEFTA WARNING: Attachment too high;'// - ' unable to compute transport parameters.' GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=INT(E1)+1 IDUM=MIN(IDUM,100) IESPECP(IDUM)=IESPECP(IDUM)+1 *** Start of loop for newly created electrons 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP *** Main loop 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) lab20=.false. 15 continue IF((T+ST).GE.TSTOP .or. lab20) THEN if(.not.lab20)then IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP * Store position and energy at time plane = IPLANE. CALL TPLANEA(T,E1,CX1,CY1,DCZ1,AP,BP,EMAG,IPLANE) * Check if passed through more than one plane in this step IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 endif IF((T+ST).GE.TFINAL .or. lab20) THEN if(.not.lab20)then ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT TSTOP=TSTEP * No more electrons in cascade try new primary electron IF(NELEC.EQ.(NCLUS+1)) GO TO 544 endif * Take electrons from store C 20 continue lab20=.false. X=XS(NPONT) Y=YS(NPONT) Z=ZS(NPONT) ST=TS(NPONT) E1=ES(NPONT) DCX1=DCX(NPONT) DCY1=DCY(NPONT) DCZ1=DCZ(NPONT) VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT IPLANE=IPL(NPONT) NPONT=NPONT-1 ZSTRT=Z TSSTRT=ST GO TO 555 ENDIF ENDIF 913 FORMAT(3X,' AFTER STORE ITER=',I10,' E1=',D12.3,' T=',D12.3, - ' AP=',D12.3,' BP=',D12.3,' DCZ1=',D12.3) E=E1+(AP+BP*T)*T IF(E.LT.0.0D0) THEN IF(LBMCPR)WRITE(LUNOUT,913)ITER,E,E1,AP,BP,DCZ1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=MIN(IE,2048) *** Test for real or null collision R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 *** Calculate direction cosines and positions at instant before * collision also update diffusion and energy calculations. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) CONST6=SQRT(E1/E) CX2=CX1*COSWT-CY1*SINWT CY2=CY1*COSWT+CX1*SINWT VTOT=CONST9*SQRT(E) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 DX=(CX1*SINWT-CY1*(1.0D0-COSWT))/WB X=X+DX DY=(CY1*SINWT+CX1*(1.0D0-COSWT))/WB Y=Y+DY Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 *** Determination of real collision type C R2=RNDM2(RDUM) R2=drand48(RDUM) * Find location within 4 units in collision array CALL SORT(I,R2,IE) 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(E.LT.EI) THEN C IF(LBMCPR)WRITE(LUNOUT,994) E,EI,ITER C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY', C - ' LOSS EI=',F8.3,' AT ITER=',I12,' DUE TO BINNING', C - ' ERROR') *** Fix energy loss smaller than incident energy if a bining error * occurs. EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 * Attachment IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT * Electron captured start new primary IF(NELEC.EQ.(NCLUS+1)) GO TO 544 * Electron captured take next electron from store C GO TO 20 lab20=.true. goto 15 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) * Use OPAL Peterson and Beaty splitting factor. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI *** Store position ,energy, direction cosines and time of generation * of ionisation electron NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN IF(LBMCPR)WRITE(LUNOUT,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) IFAIL=1 RETURN C STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC *** Randomise secondary electron direction R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=ACOS(F3) F6=COS(THETA0) F5=SIN(THETA0) R4=drand48(rdum) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE *** Generate scattering angles and update laboratory cosines after * collision also update energy of electron. 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IF(ITER.LT.0)GOTO 315 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 S2=(S1*S1)/(S1-1.0D0) * Anisotropic scattering IF(INDEX(I).NE.0) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE * Isotropic scattering R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=ACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=SIN(PHI0) F9=COS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0D0-F3*SQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.0D0)*(S1-1.0D0)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C IF(LBMCPR)WRITE(LUNOUT,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10, C - ' E1=',E12.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 190 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 190 CONTINUE VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT *** Store direction cosines and energy after N collisions * for later reuse in primary generation I100=I100+1 IF(I100.EQ.200) THEN DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 E100=E1 I100=0 ENDIF IF(IPRINT.GT.JPRINT) GO TO 200 GO TO 1 *** Intermediate printout 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 JCT=ID/100000 C IF(J1.EQ.1 .and. LBMCPR)WRITE(LUNOUT,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VEL POS TIME C / COUNT ') C IF(LBMCPR)WRITE(LUNOUT,202) W,ZTOTS,TTOTS,JCT C 202 FORMAT(1X,F8.3,2(1X,D10.3),4X,I6) J1=J1+1 GO TO 1 *** Main loop end 700 XID=DBLE(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DBLE(NEION) ANBT=DBLE(NELEC-IPRIM) ATTOINT=ANEION/ANBT ATTERT=SQRT(ANEION)/ANEION AIOERT=SQRT(ANBT)/ANBT ELSE ANEION=DBLE(NEION) ATTOINT=-1.0D0 ATTERT=SQRT(ANEION)/ANEION ENDIF JCT=ID/100000 IF(J1.EQ.1) THEN IF(LBMCPR)WRITE(LUNOUT,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS),', - ' DECREASE THE ESTIMATED ALPHA. NCLUS = ',I7, - ' ITER =',I9) IFAIL=1 RETURN C STOP ENDIF IF(LBMCPR)WRITE(LUNOUT,878) NELEC,NEION,IPRIM 878 FORMAT(/,' TOTAL NO OF ELECTRONS=',I8,/,' TOTAL NO OF NEG. IONS=', /I8,/,' TOTAL NO OF PRIMARIES=',I8) EPRMBAR=0.0D0 E2PRM=0.0D0 IF(IPRIM.EQ.1) RETURN DO 310 I=1,IPRIM E2PRM=E2PRM+EPRM(I)*EPRM(I) 310 EPRMBAR=EPRMBAR+EPRM(I) EBAR=EPRMBAR/IPRIM EERR=SQRT(E2PRM/IPRIM-EBAR**2) IF(LBMCPR)WRITE(LUNOUT,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C IF(LBMCPR)WRITE(LUNOUT,835) (IESPECP(J),J=1,100) C835 FORMAT(/,2X,'ENERGY SPECTRUM OF PRIMARY ELECTRONS IN 1 EV. BINS',/ C /,10(2X,10I5,/)) RETURN 315 IF(ITER.GT.NMAX) THEN IF(LBMCPR)WRITE(LUNOUT,991) - ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =',I10/ - ' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4,' NMXADD=',I3) IFAIL=1 RETURN C STOP ENDIF END +DECK,TPLANEA. SUBROUTINE TPLANEA(T,E1,CX1,CY1,DCZ1,AP,BP,EFLD,IPLANE) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,CNSTS1. +SEQ,BFLD. +SEQ,CION. +SEQ,OUTPT. +SEQ,TPLOUT. C----------------------------------------------------------------------- C STORES POSITION, TIME AND ENERGY AND SUMS REQUIRED C TO CALCULATE DEVIATIONS AND MEANS AT PLANE =IPLANE C----------------------------------------------------------------------- TIMESP=IPLANE*TSTEP C CALC TIME LEFT TO ARRIVE AT PLANE TIMLFT=TIMESP-ST T2LFT=TIMLFT*TIMLFT A=AP*TIMLFT B=BP*T2LFT EPLANE=E1+A+B WBT=WB*TIMLFT COSWT=COS(WBT) SINWT=SIN(WBT) CONST6=SQRT(E1/EPLANE) DCZ2=DCZ1*CONST6+EFLD*TIMLFT*CONST5/SQRT(EPLANE) XPLANE=X+(CX1*SINWT-CY1*(1.0D0-COSWT))/WB YPLANE=Y+(CY1*SINWT+CX1*(1.0D0-COSWT))/WB ZPLANE=Z+DCZ1*TIMLFT*SQRT(E1)*CONST3*0.01D0+T2LFT*EFLD*CONST2 VZPLANE=DCZ2*SQRT(EPLANE)*CONST3*0.01D0 XTPL(IPLANE)=XTPL(IPLANE)+XPLANE YTPL(IPLANE)=YTPL(IPLANE)+YPLANE ZTPL(IPLANE)=ZTPL(IPLANE)+ZPLANE XXTPL(IPLANE)=XXTPL(IPLANE)+XPLANE*XPLANE YYTPL(IPLANE)=YYTPL(IPLANE)+YPLANE*YPLANE ZZTPL(IPLANE)=ZZTPL(IPLANE)+ZPLANE*ZPLANE ETPL(IPLANE)=ETPL(IPLANE)+EPLANE TTPL(IPLANE)=TTPL(IPLANE)+ST+TIMLFT VZTPL(IPLANE)=VZTPL(IPLANE)+VZPLANE NETPL(IPLANE)=NETPL(IPLANE)+1 END +DECK,GAS1. SUBROUTINE GAS1(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(72),YXSEC(72),XVIB2(14),YVIB2(14), /XVIB3(14),YVIB3(14),XVIB4(14),YVIB4(14),XVIB5(16),YVIB5(16), /XVIB6(16),YVIB6(16),XEXC(33),YEXC(33),XION(52),YION(52), /XATT(11),YATT(11) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.0,.001,.002,.003,.004,.005,.006,.007,.008,.009, /0.01,.012,.014,.016,.018,0.02,.025,0.03,.035,0.04, /.045,0.05,.055,0.06,.065,0.07,.075,0.08,.085,0.09, /0.10,0.12,0.14,0.17,0.20,0.24,0.30,0.40,0.50,0.60, /0.80,1.00,1.20,1.40,1.70,2.00,3.00,5.00,6.00,7.00, /8.00,9.00,10.0,15.0,20.0,30.0,35.0,50.0,60.0,75.0, /100.,150.,200.,300.,500.,700.,1000.,2000.,4000.,10000., /20000.,100000./ C DATA YXSEC/13.5,9.50,7.80,6.90,6.20,5.80,5.45,5.20,4.85,4.65, /4.40,4.00,3.70,3.50,3.30,3.10,2.60,2.25,1.90,1.65, /1.45,1.27,1.10,0.98,0.87,0.75,0.66,0.55,0.49,0.41, /0.29,0.17,0.14,0.16,0.20,0.30,0.48,0.90,1.40,2.00, /3.70,4.70,5.60,6.00,6.30,6.50,6.80,6.90,7.00,7.20, /7.30,7.50,7.85,9.20,9.20,8.80,8.40,6.72,5.90,5.28, /4.16,2.99,1.92,1.13,0.63,0.42,0.27,0.12,0.06,0.02, /0.01,.002/ C VIBRATION V4 (RESONANCE ONLY) DATA XVIB2/0.0784,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,50.0, /100.,1000.,10000.,100000./ DATA YVIB2/0.0,0.0,0.11,0.93,1.40,1.20,0.80,0.07,.022,.0001, /.00001,.000001,.0000001,.00000001/ C VIBRATION V1 (RESONANCE ONLY) DATA XVIB3/0.1126,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,50.0, /100.,1000.,10000.,100000./ DATA YVIB3/0.0,0.0,.037,0.31,0.47,0.40,0.27,.023,.007,.00003, /.000003,.0000003,.00000003,.000000003/ C VIBRATION V3 (RESONANCE ONLY) DATA XVIB4/0.1589,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,50.0, /100.,1000.,10000.,100000./ DATA YVIB4/0.0,0.0,0.33,2.80,4.20,3.60,2.33,0.20,.067,.0001, /.00001,.000001,.0000001,.00000001/ C VIBRATION HARMONIC 2(V3) DATA XVIB5/0.3178,1.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0, /20.0,50.0,100.0,1000.,10000.,100000./ DATA YVIB5/0.0,.001,0.01,0.04,0.06,0.47,0.70,0.60,0.40,.033, /.011,.0005,.00001,.000001,.0000001,.00000001/ C VIBRATION HARMONIC (3(V3) + ALL OTHER HARMONICS) DATA XVIB6/0.4767,1.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0, /20.0,50.0,100.,1000.,10000.,100000./ DATA YVIB6/0.0,.001,0.08,0.16,0.24,1.84,2.80,2.40,1.60,.128, /.040,.0008,.00008,.000008,.0000008,.00000008/ DATA XION/15.9,16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0, /50.0,60.0,70.0,80.0,90.0,100.,125.,150.,175.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000.,10000.,20000., /40000.,100000./ DATA YION/0.0,.034,.080,.137,.204,.295,.479,.656,.937,1.19, /1.41,1.62,1.83,2.03,2.18,2.38,2.60,2.78,2.98,3.25, /3.41,3.97,4.39,4.76,4.91,5.12,5.31,5.28,5.31,5.10, /4.78,4.59,4.31,4.05,3.83,3.51,3.11,2.83,2.61,2.38, /2.23,1.89,1.64,1.50,1.34,1.15,0.99,0.70,0.44,.256, /.141,.072/ DATA XATT/4.00,4.10,5.00,6.00,7.00,8.00,9.00,10.0,11.0, /12.0,100./ DATA YATT/.0,.00001,.00092,.0066,.0135,.0142,.0051,.0010,.0004, /.00001,.0000001/ C DISOCIATION X-SECTION EXCLUDING DISOCIATIVE IONISATION X-SECTION DATA XEXC/12.5,13.0,14.0,15.0,16.0,18.0,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,100.,120.,140.,160., /180.,200.,250.,300.,400.,500.,600.,1000.,2000.,4000., /10000.,20000.,100000./ DATA YEXC/0.0,.036,.156,.288,0.43,0.67,0.84,1.15,1.32,1.44, /1.53,1.56,1.60,1.62,1.63,1.63,1.62,1.60,1.58,1.55, /1.52,1.48,1.40,1.30,1.12,0.94,0.82,0.54,0.32,0.18, /0.09,0.05,.013/ C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO MARCH 2001 C ALLOWS SUPERELASTIC SCATTERING TO V4 VIBRATIONAL LEVEL C BORN ANGULAR DISTRIBUTION FOR V4 LEVEL C INCLUDED NEW IONISATION X-SECTIONS BY NISHIMURA AND READJUSTED C DISOCIATION X-SECTION TO FIT TOWNSEND MEASUREMENTS. C --------------------------------------------------------------- NAME='CF4 (2001)' FAC1=1.00 FAC2=0.71 NIN=7 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C ANGULAR DISTRIBUTION FOR LEVEL 2 AND 4 KIN(2)=1 KIN(4)=1 C NDATA=72 NVIB2=14 NVIB3=14 NVIB4=14 NVIB5=16 NVIB6=16 NION=52 NATT=11 NEXC=33 E(1)=0.0 E(2)=2.0*EMASS/(88.0046*AMU) E(3)=15.90 E(4)=0.0 E(5)=0.0 E(6)=0.0 C SET OPAL BEATY ENERGY SPLITTING TO EION EOBY=E(3) EIN(1)=-0.0784 EIN(2)=0.0784 EIN(3)=0.1126 EIN(4)=0.1589 EIN(5)=0.3178 EIN(6)=0.4767 EIN(7)=12.5 SCRPT(1)=' ' SCRPT(2)=' ELASTIC CF4 ' SCRPT(3)=' IONISATION ELOSS= 15.90 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V4 ELOSS= -0.0784 ' SCRPT(8)=' VIB V4 ANIS ELOSS= 0.0784 ' SCRPT(9)=' VIB V1 ELOSS= 0.1126 ' SCRPT(10)=' VIB V3 ANIS ELOSS= 0.1589 ' SCRPT(11)=' VIB 2V3 ELOSS= 0.3178 ' SCRPT(12)=' VIB HARMONIC ELOSS= 0.4767 ' SCRPT(13)=' EXC DISOCIATN ELOSS= 12.5 ' APOP=EXP(EIN(1)/AKT) EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC OF VIBRATION V4 C QIN(1,I)=0.0D0 IF(EN.EQ.0.0D0) GO TO 305 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.0768*LOG((EFAC+1.0D0)/(EFAC-1.0D0))/EN QIN(1,I)=QIN(1,I)*APOP/(1.0D0+APOP)*1.D-16 C 305 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.0768*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=((A*EN+B)+QIN(2,I))*1.0/(1.0+APOP)*1.D-16 PEQIN(2,I)=0.5+(QIN(2,I)-FAC1*QIN(2,I))/QIN(2,I) 400 CONTINUE C QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.0224*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(3,I)=((A*EN+B)+QIN(3,I))*1.D-16 500 CONTINUE C QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=1.584*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(4) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.58 XMT=((1.5-FWD/(FWD+BCK))*QIN(4,I)+RAT4*(A*EN+B))*1.0D-16 QIN(4,I)=((A*EN+B)+QIN(4,I))*1.D-16 PEQIN(4,I)=0.5+(QIN(4,I)-XMT)/QIN(4,I) 600 CONTINUE C QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(5,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(6,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS2. SUBROUTINE GAS2(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(44),YXSEC(44),XENI(76),YXENI(76),XIN(26),YXSIN(26), /YXPIN(26),YXDIN(26) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/1.00,1.20,1.50,1.70,2.00,2.50,3.00,4.00,4.90,5.00, /6.00,6.67,7.00,8.00,8.71,9.00,10.0,11.0,12.0,13.0, /13.6,14.0,15.0,16.0,16.5,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,400.,1000.,2000., /4000.,10000.,20000.,100000./ DATA YXSEC/1.3913,1.66,2.05,2.33,2.70,3.43,4.15,5.65,7.26,7.46, /9.32,10.6,11.3,13.1,14.1,14.4,15.4,15.8,15.8,15.4, /15.1,14.8,14.1,13.2,13.0,11.4,10.2,7.80,6.25,4.45, /3.50,2.80,2.20,2.00,1.45,0.90,0.63,0.28,0.18,0.10, /0.05,.0048,0.0018,.00009/ DATA XENI/15.7,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /20.5,21.0,21.5,22.0,22.5,23.0,23.5,24.0,24.5,25.0, /25.5,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,250., /300.,350.,400.,450.,500.,600.,700.,800.,900.,1000., /1200.,1400.,1600.,1800.,2000.,2500.,3000.,3500.,4000.,5000., /6000.,8000.,10000.,14000.,20000.,100000./ DATA YXENI/0.00,.031,.094,.163,.235,.310,.386,.465,.546,.627, /.713,.787,.858,.933,.994,1.06,1.12,1.18,1.24,1.30, /1.35,1.41,1.60,1.80,1.96,2.11,2.24,2.33,2.39,2.49, /2.53,2.60,2.66,2.73,2.77,2.82,2.84,2.85,2.86,2.86, /2.85,2.83,2.81,2.76,2.73,2.68,2.62,2.52,2.39,2.17, /1.98,1.81,1.68,1.55,1.46,1.30,1.16,1.06,.985,.915, /.780,.698,.647,.585,.533,.453,.390,.345,.306,.259, /.223,.175,.147,.112,.0838,.0167/ DATA XIN/11.55,13.0,13.2,13.4,14.0,16.0,20.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,500.,700.,1000.,1400., /2000.,4000.,6000.,10000.,20000.,100000./ DATA YXSIN/0.00,.069,.090,.087,.115,.205,0.22,0.25,0.29,0.34, /0.31,.265,0.24,0.18,0.15,.115,.080,.063,.047,.036, /.028,.016,.0115,.007,.0036,.00072/ DATA YXPIN/0.00,0.00,.012,.036,.072,.205,0.42,0.54,0.53,0.50, /0.46,0.39,0.34,0.26,0.21,.165,0.11,.083,0.06,.046, /.035,.020,.0140,.009,.0042,.0009/ DATA YXDIN/0.00,0.00,0.00,0.00,0.00,.067,0.15,0.29,0.35,0.39, /0.41,0.47,0.47,0.44,0.37,.285,0.19,0.15,0.11,.081, /.061,.035,.0245,.016,.008,.0016/ NAME='Ar (2002 iso.)' C ---------------------------------------------------------------- C MULTI-TERM CROSS-SECTION. C FOR PURE ARGON: C ACCURACY OF DERIVED VELOCITY AND DIFFUSION COEFFICIENTS 0.5% BELOW C 3000VOLTS . BELOW 20000VOLTS ACCURACY 1.0%. IONISATION COEFFICIENT C AND DRIFT VELOCITY ACCURACY BETTER THAN 5% BELOW 1,000,000 VOLTS C MOD 1997 DATA SET : ION OF RAPP ET AL MODIFIED BELOW 19.0 EV IN C ORDER TO GIVE CORRECT WANNIER EXPONENT . C----------------------------------------------------------------- C C PARAMETERS OF PHASE SHIFT ANALYSIS. C APOL=11.08 LMAX=100 AA=-1.459 DD=68.93 FF=-97.0 A1=8.69 API=ACOS(-1.0D0) C ---------------------------------------------------------- NIN=3 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=44 NIDATA=76 NXDATA=26 E(1)=0.0 E(2)=2.0*EMASS/(39.948*AMU) E(3)=15.7 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=11.55 EIN(2)=13.0 EIN(3)=14.0 C OPAL AND BEATY EOBY=10.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ARGON ' SCRPT(3)=' IONISATION ELOSS= 15.7 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC S-LEVELS ELOSS= 11.55 ' SCRPT(8)=' EXC P-LEVELS ELOSS= 13.0 ' SCRPT(9)=' EXC D-LEVELS ELOSS= 14.O ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.1.0D0) GO TO 100 IF(EN.EQ.0.0D0) Q(2,I)=7.79D-16 IF(EN.EQ.0.0D0) GO TO 200 AK=SQRT(EN/ARY) AK2=AK*AK AK3=AK2*AK AK4=AK3*AK AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK2*LOG(AK))-(API*APOL/3.0)*AK2+ /DD*AK3+FF*AK4 AN1=(API/15.0D0)*APOL*AK2-A1*AK3 AN2=API*APOL*AK2/105.0 AN0=ATAN(AN0) AN1=ATAN(AN1) AN2=ATAN(AN2) SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 DO 10 J=2,LMAX-1 SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(ATAN(API*APOL*AK2*SUMI)))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/AK2 GO TO 200 100 CONTINUE DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 200 CONTINUE Q(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NIDATA IF(EN.LE.XENI(J)) GO TO 220 210 CONTINUE J=NIDATA 220 A=(YXENI(J)-YXENI(J-1))/(XENI(J)-XENI(J-1)) B=(XENI(J-1)*YXENI(J)-XENI(J)*YXENI(J-1))/(XENI(J-1)-XENI(J)) Q(3,I)=(A*EN+B)*1.0D-16 230 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 QIN(2,I)=0.0D0 QIN(3,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NXDATA IF(EN.LE.XIN(J)) GO TO 320 310 CONTINUE J=NXDATA 320 A=(YXSIN(J)-YXSIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXSIN(J)-XIN(J)*YXSIN(J-1))/(XIN(J-1)-XIN(J)) QIN(1,I)=(A*EN+B)*1.0D-16 IF(EN.LE.EIN(2)) GO TO 400 A=(YXPIN(J)-YXPIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXPIN(J)-XIN(J)*YXPIN(J-1))/(XIN(J-1)-XIN(J)) QIN(2,I)=(A*EN+B)*1.0D-16 IF(EN.LE.EIN(3)) GO TO 400 A=(YXDIN(J)-YXDIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXDIN(J)-XIN(J)*YXDIN(J-1))/(XIN(J-1)-XIN(J)) QIN(3,I)=(A*EN+B)*1.0D-16 400 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS3. SUBROUTINE GAS3(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(67),YXSEC(67),XION(48),YION(48),XEXC(25),YEXC(25), /XEXS(34),YEXS(34) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.008,0.009,0.01,0.013,0.017,0.020,0.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.18,0.20, /0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.20, /1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.6,16.5,18.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,75.0,80.0,90.0,100.,150.,200., /400.,600.,1000.,2000.,10000.,20000.,100000./ DATA YXSEC/4.90,5.18,5.19,5.21,5.26,5.31,5.35,5.41,5.46,5.54, /5.62,5.68,5.74,5.79,5.83,5.86,5.94,6.04,6.12,6.16, /6.27,6.35,6.49,6.59,6.66,6.73,6.77,6.82,6.85,6.91, /6.96,6.98,6.99,6.96,6.89,6.62,6.31,6.00,5.68,5.35, /5.03,4.72,4.44,4.15,3.83,3.25,2.99,2.58,2.00,1.60, /1.06,0.77,0.57,0.46,0.40,0.37,0.30,0.26,.132,.081, /.024,.012,.0048,.0014,.00008,.00002,.0000012/ C DATA XION/24.587,25.0,25.5,26.0,26.5,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0, /100.,120.,150.,175.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,4000.,5000.,6000.,8000.,10000.,20000.,100000./ DATA YION/0.0,.0051,.0111,.0172,.0232,.029,.042,.054,.066,.091, /.112,.133,.153,.169,.207,.239,.267,.286,.316,.339, /.361,.367,.364,.354,.342,.316,.293,.253,.221,.197, /.177,.163,.148,.138,.119,.103,.095,.086,.078,.065, /.055,.044,.036,.032,.025,.021,.0117,.0040/ C TRIPLET EXCITATION DATA XEXC/19.82,20.0,20.2,20.5,20.6,20.8,21.0,21.3,22.0,25.0, /30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,150.,200., /400.,1000.,10000.,20000.,100000./ DATA YEXC/0.00,.047,.053,.035,.029,.043,.042,.041,.046,.075, /.071,.054,.038,.026,.017,.013,.0094,.0075,.0022,.00094, /.00012,.000008,.000000008,.000000001,.0000000003/ C SINGLET EXCITATION DATA XEXS/20.61,20.9,21.0,21.5,22.0,22.5,25.0,28.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,150.,200., /300.,400.,500.,600.,800.,1000.,1500.,2000.,3000.,4000., /6000.,10000.,20000.,100000./ DATA YEXS/0.00,.025,.022,.0265,.0315,.036,.065,.082,.092,.115, /.133,.148,.155,.175,.177,.178,.178,.177,.163,.148, /.121,.099,.086,.075,.061,.051,.038,.030,.022,.017, /.013,.0088,.0052,.0018/ NAME='He4 (1997)' C -------------------------------------------------------------------- C HELIUM 4 BEST KNOWN GAS USED AS STANDARD ACCURACY BETTER THAN 0.2% C AT ALL FIELDS. C UPDATED 1992 TO INCLUDE 20KEV RANGE ALSO ELASTIC ANISOTROPIC C INCLUDED AS OPTION C -------------------------------------------------------------------- NIN=2 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=67 NION=48 NEXC=25 NEXS=34 E(1)=0.0 E(2)=2.0*EMASS/(4.00260*AMU) E(3)=24.587 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.8 EIN(1)=19.82 EIN(2)=20.61 SCRPT(1)=' ' SCRPT(2)=' ELASTIC HELIUM 4 ' SCRPT(3)=' IONISATION ELOSS= 24.587 ' SCRPT(4)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC TRIPLET ELOSS= 19.82 ' SCRPT(8)=' EXC SINGLET ELOSS= 20.61 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(1,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 700 DO 610 J=2,NEXS IF(EN.LE.XEXS(J)) GO TO 620 610 CONTINUE J=NEXS 620 A=(YEXS(J)-YEXS(J-1))/(XEXS(J)-XEXS(J-1)) B=(XEXS(J-1)*YEXS(J)-XEXS(J)*YEXS(J-1))/(XEXS(J-1)-XEXS(J)) QIN(2,I)=(A*EN+B)*1.D-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS4. SUBROUTINE GAS4(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(66),YXSEC(66),XION(47),YION(47),XEXC(17),YEXC(17), /XEXS(29),YEXS(29) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.008,0.009,0.01,0.013,0.017,0.020,0.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.18,0.20, /0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.20, /1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.6,16.5,18.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,75.0,80.0,90.0,100.,150.,200., /400.,600.,1000.,2000.,10000.,20000./ DATA YXSEC/4.90,5.18,5.19,5.21,5.26,5.31,5.35,5.41,5.46,5.54, /5.62,5.68,5.74,5.79,5.83,5.86,5.94,6.04,6.12,6.16, /6.27,6.35,6.49,6.59,6.66,6.73,6.77,6.82,6.85,6.91, /6.96,6.98,6.99,6.96,6.89,6.62,6.31,6.00,5.68,5.35, /5.03,4.72,4.44,4.15,3.83,3.25,2.99,2.58,1.95,1.51, /0.98,0.70,0.50,0.40,0.34,0.31,0.25,0.21,.104,.063, /.020,.010,.0035,.0010,.00008,.00002/ C DATA XION/24.59,25.0,25.5,26.0,26.5,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0, /100.,120.,150.,175.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,4000.,5000.,6000.,8000.,10000.,20000./ DATA YION/0.0,.0051,.0111,.0172,.0232,.029,.042,.054,.066,.091, /.112,.133,.153,.169,.207,.239,.267,.286,.316,.339, /.361,.367,.364,.354,.342,.316,.293,.253,.221,.197, /.177,.163,.148,.138,.119,.103,.095,.086,.078,.065, /.055,.044,.036,.032,.025,.021,.0117/ C TRIPLET EXCITATION DATA XEXC/19.82,20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.,150.,200.,400.,1000.,10000.,20000./ DATA YEXC/0.00,0.03,.075,.071,.054,.038,.026,.017,.013,.0094, /.0075,.0022,.00094,.00012,.000008,.000000008,.000000001/ C SINGLET EXCITATION DATA XEXS/20.6,22.0,25.0,28.0,30.0,35.0,40.0,45.0,50.0,60.0, /70.0,80.0,90.0,100.,150.,200.,300.,400.,500.,600., /800.,1000.,1500.,2000.,3000.,4000.,6000.,10000.,20000./ DATA YEXS/0.00,0.04,.065,.082,.092,.115,.133,.148,.155,.175, /.177,.178,.178,.177,.163,.148,.121,.099,.086,.075, /.061,.051,.038,.030,.022,.017,.013,.0088,.0052/ NAME='He3 (1992)' C -------------------------------------------------------------------- C HELIUM 3 BEST KNOWN GAS USED AS STANDARD ACCURACY BETTER THAN 0.2% C AT ALL FIELDS. C UPDATED 1992 TO INCLUDE 20KEV RANGE ALSO ELASTIC ANISOTROPIC C INCLUDED AS OPTION C -------------------------------------------------------------------- NIN=2 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=66 NION=47 NEXC=17 NEXS=29 E(1)=0.0 E(2)=2.0*EMASS/(3.01600*AMU) E(3)=24.59 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.8 EIN(1)=19.82 EIN(2)=20.6 SCRPT(1)=' ' SCRPT(2)=' ELASTIC HELIUM 3 ' SCRPT(3)=' IONISATION ELOSS= 24.59 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC TRIPLET ELOSS= 19.82 ' SCRPT(8)=' EXC SINGLET ELOSS= 20.6 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(1,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 700 DO 610 J=2,NEXS IF(EN.LE.XEXS(J)) GO TO 620 610 CONTINUE J=NEXS 620 A=(YEXS(J)-YEXS(J-1))/(XEXS(J)-XEXS(J-1)) B=(XEXS(J-1)*YEXS(J)-XEXS(J)*YEXS(J-1))/(XEXS(J-1)-XEXS(J)) QIN(2,I)=(A*EN+B)*1.D-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS5. SUBROUTINE GAS5(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(43),YXSEC(43),XION(68),YION(68),XEL(51),YEL(51) DIMENSION X1(48),Y1(48),X2(57),Y2(57),X3(48),Y3(48),X4(49),Y4(49) DIMENSION X5(48),Y5(48),X6(45),Y6(45),X7(45),Y7(45),X8(45),Y8(45) DIMENSION X9(45),Y9(45) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/1.00,1.20,1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00, /7.00,8.00,8.71,9.00,10.0,11.0,13.6,15.0,16.5,19.6, /20.0,30.0,40.0,50.0,60.0,70.0,77.0,100.,130.,150., /170.,200.,300.,400.,600.,800.,1000.,2000.,4000.,10000., /20000.,40000.,100000./ DATA YXSEC/1.6178,1.69,1.75,1.79,1.82,1.86,1.91,1.98,2.07,2.14, /2.21,2.29,2.35,2.37,2.44,2.51,2.66,2.71,2.76,2.83, /2.84,2.84,2.78,2.58,2.30,2.12,2.03,1.53,1.21,1.03, /0.90,.756,0.48,0.31,0.17,0.11,.077,.025,.007,.0016, /.0005,.00014,.00003/ C ELASTIC TOTAL DATA XEL/1.00,1.20,1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00, /8.00,10.0,12.0,14.0,16.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,90.0,100.,125.,150.,200.,250., /300.,350.,400.,500.,600.,700.,800.,900.,1000.,1200., /1500.,2000.,2500.,3000.,4000.,5000.,6000.,10000.,20000.,40000., /100000./ DATA YEL/1.5667,1.68,1.82,1.94,2.01,2.16,2.30,2.55,2.80,2.98, /3.23,3.39,3.54,3.63,3.67,3.68,3.70,3.63,3.54,3.31, /3.12,2.93,2.75,2.56,2.42,2.26,1.98,1.76,1.41,1.26, /1.10,1.02,.921,.806,.703,.643,.577,.539,.486,.434, /.366,.292,.233,.195,.168,.131,.107,.073,.040,.023, /.011/ C IONISATION DATA XION/21.56,22.0,22.5,23.0,23.5,24.0,24.5,25.0,25.5,26.0, /27.0,28.0,29.0,30.0,32.0,34.0,36.0,40.0,45.0,50.0, /55.0,60.0,65.0,70.0,75.0,80.0,90.0,100.,110.,120., /140.,150.,175.,200.,250.,300.,350.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,3500.,4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000., /10000.,12000.,14000.,16000.,18000.,20000.,50000.,100000./ DATA YION/0.00,.0032,.0076,.0121,.0172,.022,.027,.032,.037,.042, /.054,.066,.078,.091,.116,.141,.166,.215,.266,.322, /.372,.416,.458,.495,.527,.557,.604,.643,.679,.699, /.730,.744,.754,.752,.730,.692,.657,.617,.560,.507, /.463,.425,.394,.368,.317,.287,.260,.236,.219,.186, /.160,.142,.127,.116,.108,.099,.0929,.0819,.0734,.0672, /.0618,.0536,.0471,.0423,.0387,.0355,.0174,.0104/ C EXCITATION C 1S5 DATA X1/16.618,16.70,16.80,16.9,17.0,17.1,17.2,17.3,17.4,17.6, /17.8,18.0,18.2,18.3,18.4,18.5,18.6,18.7,18.8,19.0, /19.5,20.0,21.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /44.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150.,200., /250.,500.,1000.,2000.,5000.,10000.,20000.,100000./ DATA Y1/0.0,.0009,.0022,.0042,.0072,.0054,.0046,.0050,.0053,.0060, /.0065,.0070,.0074,.0080,.0104,.0130,.0108,.0085,.0082,.0083, /.0086,.0087,.0086,.0083,.0073,.0070,.0067,.0062,.0045,.0031, /.0024,.0016,.0010,.0006,.0004,.00028,.0002,.00011,.00006,.00002, /1.1D-5,1.3D-6,1.5D-7,1.7D-8,9.6D-10,1.1D-10,1.4D-11,1.7D-13/ C 1S4 DATA X2/16.670,16.70,16.80,16.9,17.0,17.2, /17.5,18.0,18.2,18.4,18.5,18.6,18.7,18.8,19.0, /19.5,20.0,21.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /44.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150.,200., /250.,300.,400.,500.,600.,700.,800.,900.,1000.,1200., /1500.,2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /40000.,100000./ DATA Y2/0.,.00004,.0021,.0030,.0060,.0040, /.0053,.0057,.0058,.0070,.0100,.0080,.0060,.0058,.0057, /.0057,.0059,.0057,.0062,.0069,.0074,.0076,.0078,.0081,.0084, /.0086,.0086,.0083,.0080,.0078,.0075,.0073,.0069,.0062,.0052, /.0047,.0041,.0034,.0029,.0026,.0023,.0021,.0019,.0018,.0015, /.0012,.0010,.0009,.0007,.00059,.00050,.00043,.00034,.00028,.00016, /.000092,.000047/ C 1S3 DATA X3/16.715,16.80,16.9,17.0,17.1,17.2,17.3,17.4,17.5,17.6, /17.8,18.0,18.2,18.3,18.4,18.5,18.6,18.7,18.8,19.0, /19.5,20.0,21.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /44.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150.,200., /250.,500.,1000.,2000.,5000.,10000.,20000.,100000./ DATA Y3/0.,.0003,.0009,.0016,.0011,.0009,.0010,.0011,.0011,.0011, /.0012,.0013,.0014,.0015,.0022,.0029,.0022,.0017,.0015,.0016, /.0016,.0017,.0017,.0016,.0015,.0015,.0015,.0014,.0010,.00079, /.00065,.0005,.00033,.00023,.00017,.00013,.0001,6.5D-5,4.D-5,2.D-5, /1.1D-5,2.0D-6,3.6D-7,6.4D-8,6.7D-9,1.2D-9,2.4D-10,7.0D-12/ C 1S2 DATA X4/16.847,17.0,17.1,17.5,18.0,18.5,19.0, /19.5,20.0,21.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /44.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150.,200., /250.,300.,400.,500.,600.,700.,800.,900.,1000.,1200., /1500.,2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /40000.,100000./ DATA Y4/0.,.0090,.0170,.0175,.0182,.0194,.0205, /.0215,.0225,.0245,.0266,.0310,.0430,.0580,.0700,.0870,.0960, /.1000,.1030,.1040,.1030,.1000,.0973,.0934,.0862,.0770,.0655, /.0571,.0509,.0420,.0360,.0316,.0282,.0256,.0235,.0217,.0189, /.0159,.0127,.0110,.0092,.0073,.0061,.0053,.0042,.0035,.0020, /.0011,.00059/ C SUM OF 2P(10-2) = 2P10+2P9+2P8+2P7+2P6+2P5+2P4+2P3+2P2 DATA X5/18.381,18.5,18.6,18.7,18.8,19.0,19.5,20.0,21.0,22.0, /24.0,26.0,28.0,30.0,35.0,40.0,44.0,50.0,60.0,70.0, /80.0,90.0,100.,120.,150.,200.,250.,300.,400.,500., /600.,700.,800.,900.,1000.,1200.,1500.,2000.,2400.,3000., /4000.,5000.,6000.,8000.,10000.,20000.,40000.,100000./ DATA Y5/0.,.0005,.0050,.0210,.0110,.0098,.0118,.0140,.0191,.0225, /.0256,.0263,.0258,.0249,.0219,.0191,.0172,.0149,.0121,.0101, /.0087,.0076,.0067,.0055,.0043,.0031,.0025,.0020,.0015,.0012, /.00098,.00084,.00073,.00065,.00058,.00048,.00039,.00029,.00024, /.00019,.00014,.00012,.00010,.00007,.00006,.00003,.000016,.000007/ C 2P1 DATA X6/18.965,19.2,20.0,20.5,21.0,22.0,23.0,24.0,26.0,28.0, /30.0,35.0,40.0,44.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2400.,3000.,4000.,5000.,6000., /8000.,10000.,20000.,40000.,100000./ DATA Y6/0.,.0014,.0023,.0029,.0035,.0048,.0062,.0075,.0105,.0135, /.0158,.0195,.0211,.0213,.0209,.0195,.0179,.0163,.0150,.0138, /.0118,.0097,.0074,.0060,.0051,.0038,.0031,.0026,.0022,.0019, /.0017,.0015,.0013,.0010,.0008,.00065,.00052,.00039,.00031,.00026, /.00020,.00016,.00008,.00004,.00002/ C SUM 2S5 + 2S4 + 2S3 + 2S2 DATA X7/19.663,20.5,21.0,21.5,22.0,23.0,24.0,25.0,26.0,28.0, /30.0,35.0,40.0,44.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2400.,3000.,4000.,5000.,6000., /8000.,10000.,20000.,40000.,100000./ DATA Y7/0.,.0021,.0031,.0040,.0047,.0058,.0067,.0074,.0079,.0087, /.0093,.0102,.0109,.0112,.0116,.0119,.0120,.0120,.0118,.0117, /.0112,.0105,.0094,.0084,.0077,.0065,.0057,.0051,.0046,.0042, /.0039,.0036,.0032,.0027,.0022,.0019,.0016,.0013,.0011,.00092, /.00073,.00061,.00035,.00020,.000104/ C SUM HIGHER LEVELS 3D + 3S DATA X8/20.033,20.5,21.0,21.5,22.0,23.0,24.0,25.0,26.0,28.0, /30.0,35.0,40.0,44.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2400.,3000.,4000.,5000.,6000., /8000.,10000.,20000.,40000.,100000./ DATA Y8/0.,.0008,.0015,.0022,.0028,.0040,.0051,.0060,.0068,.0081, /.0090,.0101,.0104,.0104,.0101,.0095,.0089,.0084,.0079,.0074, /.0067,.0058,.0048,.0041,.0035,.0029,.0024,.0021,.0018,.0016, /.0015,.0014,.0012,.00096,.00075,.00064,.00053,.0004,.00034,.00029, /.00022,.00018,.00010,.000057,.000028/ C SUM 3P (3P1 T0 3P10) DATA X9/20.200,20.5,21.0,21.5,22.0,23.0,24.0,25.0,26.0,28.0, /30.0,35.0,40.0,44.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2400.,3000.,4000.,5000.,6000., /8000.,10000.,20000.,40000.,100000./ DATA Y9/0.,.0004,.0013,.0021,.0028,.0039,.0047,.0054,.0058,.0065, /.0068,.0070,.0068,.0066,.0062,.0055,.0050,.0045,.0041,.0037, /.0032,.0026,.0020,.0016,.0014,.00103,.00083,.00070,.00060,.00052, /.00047,.00042,.00035,.00028,.00021,.00018,.00014,.00011,.000086, /.000072,.000054,.000043,.000022,.000012,.0000055/ C --------------------------------------------------------------------- C NAME='Ne (2003 iso.)' C --------------------------------------------------------------------- C UPDATE OF 2002 FILE USES MORE DETAILED EXCITATION X-SECTIONS FOR USE C IN PENNING CALCULATIONS. C SHAPE 0F EXCITATION FUNCTIONS CLOSE TO THRESHOLD GUIDED BY C ZEMAN AND BARTSCHAT J.PHYS. B 30(1997)4609 C ALL X-SECTIONS CONSISTENT WITH PUBLISHED ELECTRON SCATTERING DATA UP C TO 2003 C FIT TO RATE COEFICIENTS OF : C TACHIBANA AN PHELPS : PHYS REV.A36(1987)999 C TACHIBANA AND HARIMA J.PHYS.B 17(1984)879 C GOOD FIT TO DRIFT DIFFUSION DATA OF ROBERTSON AND ALSO DATA OF C LUCAS AND SAELEE . CLOSE FIT TO TOWNSEND DATA OF CHANIN AND RORK C --------------------------------------------------------------------- NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NEL=51 NDATA=43 NION=68 NEXC1=48 NEXC2=57 NEXC3=48 NEXC4=49 NEXC5=48 NEXC6=45 NEXC7=45 NEXC8=45 NEXC9=45 E(1)=0.0 E(2)=2.0*EMASS/(20.179*AMU) E(3)=21.56 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=24.2 EIN(1)=16.618 EIN(2)=16.670 EIN(3)=16.715 EIN(4)=16.857 EIN(5)=18.381 EIN(6)=18.965 EIN(7)=19.663 EIN(8)=20.033 EIN(9)=20.200 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ISOTROPIC NEON ' SCRPT(3)=' IONISATION ELOSS= 21.56 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC 1S5 ELOSS= 16.618 ' SCRPT(8)=' EXC 1S4 ELOSS= 16.670 ' SCRPT(9)=' EXC 1S3 ELOSS= 16.715 ' SCRPT(10)=' EXC 1S2 ELOSS= 16.857 ' SCRPT(11)=' EXCSUM 2P10-2 ELOSS= 18.381 ' SCRPT(12)=' EXC 2P1 ) ELOSS= 18.965 ' SCRPT(13)=' EXC SUM 2S ELOSS= 19.663 ' SCRPT(14)=' EXC 3D+3S ELOSS= 20.033 ' SCRPT(15)=' EXC 3P ELOSS= 20.200 ' C PARAMETERS OF PHASE SHIFT ANALYSIS APOL=2.672 LMAX=100 AA=0.2135 DD=3.86 FF=-2.656 A1=1.846 B1=3.29 A2=-0.037 API=ACOS(-1.0D0) C EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.1.0D0) GO TO 100 IF(EN.EQ.0.0D0) QELA=0.161D-16 IF(EN.EQ.0.0D0) QMOM=0.161D-16 IF(EN.EQ.0.0D0) GO TO 200 AK=SQRT(EN/ARY) AK2=AK*AK AK3=AK2*AK AK4=AK3*AK AK5=AK4*AK AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK2*LOG(AK))-(API*APOL/3.0)*AK2+ /DD*AK3+FF*AK4 AN1=((API/15.0)*APOL*AK2-A1*AK3)/(1.0+B1*AK2) AN2=API*APOL*AK2/105.0-A2*AK5 ANHIGH=AN2 SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 SIGEL=(SIN(AN0))**2+3.0*(SIN(AN1))**2 DO 10 J=2,LMAX-1 ANLOW=ANHIGH ANHIGH=API*APOL*AK2/((2.*J+5.0)*(2.*J+3.0)*(2.*J+1.0)) SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(API*APOL*AK2*SUMI))**2 SIGEL=SIGEL+(2.0*J+1.0)*(SIN(ANLOW))**2 10 CONTINUE QELA=SIGEL*4.0*PIR2/AK2 QMOM=SUM*4.0*PIR2/AK2 GO TO 200 100 CONTINUE DO 110 J=2,NEL IF(EN.LE.XEL(J)) GO TO 120 110 CONTINUE J=NEL 120 A=(YEL(J)-YEL(J-1))/(XEL(J)-XEL(J-1)) B=(XEL(J-1)*YEL(J)-XEL(J)*YEL(J-1))/(XEL(J-1)-XEL(J)) QELA=(A*EN+B)*1.0D-16 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.0D-16 200 CONTINUE C PEQEL(2,I)=0.5+(QELA-QMOM)/QELA PEQEL(2,I)=0.0 Q(2,I)=QMOM Q(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 230 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 360 DO 340 J=2,NEXC1 IF(EN.LE.X1(J)) GO TO 350 340 CONTINUE J=NEXC1 350 A=(Y1(J)-Y1(J-1))/(X1(J)-X1(J-1)) B=(X1(J-1)*Y1(J)-X1(J)*Y1(J-1))/(X1(J-1)-X1(J)) QIN(1,I)=(A*EN+B)*1.0D-16 360 CONTINUE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 430 DO 410 J=2,NEXC2 IF(EN.LE.X2(J)) GO TO 420 410 CONTINUE J=NEXC2 420 A=(Y2(J)-Y2(J-1))/(X2(J)-X2(J-1)) B=(X2(J-1)*Y2(J)-X2(J)*Y2(J-1))/(X2(J-1)-X2(J)) QIN(2,I)=(A*EN+B)*1.0D-16 430 CONTINUE C QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 460 DO 440 J=2,NEXC3 IF(EN.LE.X3(J)) GO TO 450 440 CONTINUE J=NEXC3 450 A=(Y3(J)-Y3(J-1))/(X3(J)-X3(J-1)) B=(X3(J-1)*Y3(J)-X3(J)*Y3(J-1))/(X3(J-1)-X3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 460 CONTINUE C QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 530 DO 510 J=2,NEXC4 IF(EN.LE.X4(J)) GO TO 520 510 CONTINUE J=NEXC4 520 A=(Y4(J)-Y4(J-1))/(X4(J)-X4(J-1)) B=(X4(J-1)*Y4(J)-X4(J)*Y4(J-1))/(X4(J-1)-X4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 530 CONTINUE QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 560 DO 540 J=2,NEXC5 IF(EN.LE.X5(J)) GO TO 550 540 CONTINUE J=NEXC5 550 A=(Y5(J)-Y5(J-1))/(X5(J)-X5(J-1)) B=(X5(J-1)*Y5(J)-X5(J)*Y5(J-1))/(X5(J-1)-X5(J)) QIN(5,I)=(A*EN+B)*1.0D-16 560 CONTINUE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 630 DO 610 J=2,NEXC6 IF(EN.LE.X6(J)) GO TO 620 610 CONTINUE J=NEXC6 620 A=(Y6(J)-Y6(J-1))/(X6(J)-X6(J-1)) B=(X6(J-1)*Y6(J)-X6(J)*Y6(J-1))/(X6(J-1)-X6(J)) QIN(6,I)=(A*EN+B)*1.0D-16 630 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 660 DO 640 J=2,NEXC7 IF(EN.LE.X7(J)) GO TO 650 640 CONTINUE J=NEXC7 650 A=(Y7(J)-Y7(J-1))/(X7(J)-X7(J-1)) B=(X7(J-1)*Y7(J)-X7(J)*Y7(J-1))/(X7(J-1)-X7(J)) QIN(7,I)=(A*EN+B)*1.0D-16 660 CONTINUE C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 730 DO 710 J=2,NEXC8 IF(EN.LE.X8(J)) GO TO 720 710 CONTINUE J=NEXC8 720 A=(Y8(J)-Y8(J-1))/(X8(J)-X8(J-1)) B=(X8(J-1)*Y8(J)-X8(J)*Y8(J-1))/(X8(J-1)-X8(J)) QIN(8,I)=(A*EN+B)*1.0D-16 730 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 760 DO 740 J=2,NEXC1 IF(EN.LE.X9(J)) GO TO 750 740 CONTINUE J=NEXC9 750 A=(Y9(J)-Y9(J-1))/(X9(J)-X9(J-1)) B=(X9(J-1)*Y9(J)-X9(J)*Y9(J-1))/(X9(J-1)-X9(J)) QIN(9,I)=(A*EN+B)*1.0D-16 760 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+QIN(5,I)+ /QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTING TIME IF(EFINAL.LT.EIN(9)) NIN=8 IF(EFINAL.LT.EIN(8)) NIN=7 IF(EFINAL.LT.EIN(7)) NIN=6 IF(EFINAL.LT.EIN(6)) NIN=5 IF(EFINAL.LT.EIN(5)) NIN=4 IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 END +DECK,GAS6. SUBROUTINE GAS6(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(83),YXSEC(83),XION(71),YION(71), /XEXC1(95),YEXC1(95),XEXC2(76),YEXC2(76), /XEXC3(71),YEXC3(71),XEXC4(63),YEXC4(63),XELA(93),YELA(93) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/1.D-6,.001,.003,.005,.007,0.01,.015,0.02,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.52,0.54,0.56,0.60, /0.70,0.80,0.90,1.00,1.20,1.40,1.70,2.00,2.50,3.00, /3.30,3.60,4.00,4.40,4.80,5.20,5.60,6.00,6.50,7.00, /7.50,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /20.0,30.0,40.0,50.0,60.0,75.0,100.,150.,200.,300., /400.,500.,700.,1000.,1500.,2000.,3000.,4000.,6000.,8000., /10000.,20000.,100000./ DATA YXSEC/37.4,33.1,30.0,27.9,26.2,24.2,21.6,19.5,16.3,13.9, /12.1,10.6,9.30,8.35,7.38,6.65,5.45,4.40,3.25,2.45, /1.55,0.92,0.52,0.26,.145,.103,.100,.104,.110,.133, /.235,.375,.535,0.74,1.26,1.74,2.55,3.40,4.75,6.35, /7.32,8.28,9.51,10.7,11.9,13.2,14.2,15.2,16.2,17.2, /17.9,18.4,18.7,18.1,17.2,16.0,14.8,13.6,12.5,11.4, /8.18,4.08,2.47,1.71,1.43,1.35,1.30,0.90,0.80,0.64, /0.54,0.45,0.40,0.30,0.21,0.16,0.12,0.09,.065,.052, /.044,.025,.005/ C ELASTIC DATA XELA/1.D-6,.001,.003,.005,.007,0.01,.015,0.02,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.55,0.60,0.65,0.70, /0.72,0.74,0.76,0.80,0.85,0.90,0.95,1.00,1.10,1.20, /1.30,1.40,1.50,1.75,2.00,2.25,2.50,3.00,3.50,4.00, /5.00,6.00,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0, /15.0,16.0,18.0,20.0,22.5,25.0,27.5,30.0,35.0,40.0, /45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150.,175., /200.,250.,300.,400.,500.,600.,700.,800.,1000.,2000., /4000.,6000.,10000./ DATA YELA/37.4,34.6,31.8,29.9,28.4,26.6,24.1,22.2,19.1,16.8, /14.9,13.4,12.1,11.0,10.0,9.15,7.71,6.56,5.21,4.38, /3.22,2.31,1.75,1.30,1.04,0.83,0.65,0.57,0.50,0.46, /0.45,0.44,0.45,0.46,0.48,0.53,0.60,0.67,0.85,1.07, /1.32,1.54,1.84,2.23,3.02,3.83,4.68,6.36,8.24,10.1, /14.1,18.5,22.0,25.0,26.2,27.2,27.6,27.5,26.8,26.3, /24.9,23.7,22.3,21.0,19.3,17.3,15.8,14.9,13.2,11.5, /10.7,9.68,8.80,8.00,7.15,6.35,5.69,4.98,4.30,3.97, /3.73,3.43,3.06,2.71,2.45,2.33,2.15,1.99,1.81,1.36, /.974,.738,0.55/ C IONISATION DATA XION/13.996,14.5,15.0,15.5,16.0,16.5,17.0,17.5,18.0,18.5, /19.0,19.5,20.0,21.0,22.0,23.0,24.0,26.0,28.0,30.0, /32.0,34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,65.0, /70.0,80.0,90.0,100.,120.,140.,160.,180.,200.,250., /300.,400.,500.,600.,700.,800.,900.,1000.,1200.,1400., /1600.,1800.,2000.,2500.,3000.,3500.,4000.,4500.,5000.,5500., /6000.,7000.,8000.,9000.,10000.,12000.,14000.,16000.,18000.,20000., /100000./ DATA YION/0.00,.078,.160,.255,.358,.465,.576,.684,.799,.906, /1.01,1.12,1.22,1.41,1.58,1.76,1.93,2.24,2.52,2.77, /2.96,3.13,3.26,3.39,3.49,3.67,3.84,3.97,4.09,4.17, /4.21,4.26,4.23,4.20,4.08,3.91,3.75,3.61,3.46,3.13, /2.87,2.46,2.16,1.94,1.76,1.60,1.49,1.39,1.20,1.07, /.975,.895,.818,.699,.606,.534,.480,.435,.405,.373, /.348,.307,.277,.251,.230,.199,.176,.157,.145,.132, /.039/ C EXCITATION TO FIRST 4 S STATES DATA XEXC1/9.915,9.92,9.93,9.94,9.95,9.96,9.98,10.0,10.02,10.04, /10.06,10.08,10.09,10.1,10.11,10.12,10.13,10.14,10.15,10.16, /10.17,10.18,10.19,10.2,10.25,10.3,10.4,10.5,10.6,10.7, /10.8,10.9,11.0,11.3,11.6,11.8,12.0,12.5,13.0,13.5, /14.0,14.5,15.0,15.5,16.0,17.0,18.0,19.0,20.0,22.0, /24.0,27.0,30.0,33.0,36.0,40.0,44.0,50.0,54.0,60.0, /70.0,80.0,90.0,100.,120.,140.,170.,200.,240.,280., /320.,360.,400.,450.,500.,600.,700.,800.,1000.,1400., /2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000.,40000., /100000.,200000.,400000.,1000000.,1500000./ DATA YEXC1/0.00, /.00033,.00103,.00173,.00242,.00310,.00445,.00578,.00709,.00856, /.0105,.0127,.0152,.0217,.0372,.0640,.0937,.108,.0971,.0697, /.0443,.0300,.0250,.0244,.0287,.0333,.0422,.0507,.0593,.0697, /.081,.092,.103,.132,.158,.173,.188,.219,.244,.265, /.282,.296,.308,.318,.326,.338,.347,.353,.357,.361, /.361,.357,.351,.343,.335,.324,.314,.299,.289,.276, /.256,.239,.225,.212,.190,.173,.153,.138,.122,.110, /.0998,.0918,.0850,.0780,.0722,.0630,.0561,.0506,.0426,.0327, /.0246,.0212,.0177,.0140,.0116,.0100,.0079,.0066,.0037,.0021, /.00109,.00072,.00054,.00046,.00046/ C EXCITATION TO NEXT GROUP OF P STATES DATA XEXC2/11.304,11.35,11.4,11.45,11.5,11.6,11.7,11.8,11.9,12.0, /12.1,12.2,12.3,12.4,12.5,12.6,12.7,12.8,12.9,13.0, /13.5,14.0,14.5,15.0,15.5,16.0,17.0,18.0,19.0,20.0, /22.0,24.0,27.0,30.0,33.0,36.0,40.0,44.0,50.0,54.0, /60.0,70.0,80.0,90.0,100.,120.,140.,170.,200.,240., /280.,320.,360.,400.,450.,500.,600.,700.,800.,1000., /1400.,2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /40000.,100000.,200000.,400000.,1000000.,1500000./ DATA YEXC2/0.0, /.00073,.00151,.0026,.0059,.0141,.0225,.0304,.0381,.0454, /.0523,.0589,.0653,.0713,.0771,.0826,.0878,.0928,.0976,.102, /.122,.137,.150,.159,.166,.171,.177,.180,.179,.177, /.170,.161,.147,.134,.122,.112,.101,.0911,.0797,.0735, /.0659,.0563,.0492,.0439,.0397,.0335,.0291,.0245,.0214,.0183, /.0161,.0145,.0132,.0121,.0110,.0101,.0087,.0077,.0069,.0058, /.00443,.00332,.00286,.00238,.00188,.00156,.00135,.00106,.00088, /.00050,.00029,.000146,.000097,.000073,.000063,.000063/ C EXCITATION TO GROUP OF S P AND D STATES ABOVE 12 EV DATA XEXC3/11.998,12.05,12.1,12.2,12.3,12.4,12.5,12.6,12.7,12.8, /12.9,13.0,13.2,13.4,13.6,13.8,14.0,14.5,15.0,15.5, /16.0,17.0,18.0,19.0,20.0,22.0,24.0,27.0,30.0,33.0, /36.0,40.0,44.0,50.0,54.0,60.0,70.0,80.0,90.0,100., /120.,140.,170.,200.,240.,280.,320.,360.,400.,450., /500.,600.,700.,800.,1000.,1400.,2000.,2400.,3000.,4000., /5000.,6000.,8000.,10000.,20000.,40000.,100000.,200000.,400000., /1000000.,1500000./ DATA YEXC3/0.0, /.0014,.0027,.0170,.0308,.0441,.0570,.0696,.0818,.0937, /.105,.116,.138,.158,.177,.195,.212,.250,.282,.308, /.331,.365,.388,.403,.412,.416,.411,.394,.373,.352, /.331,.307,.285,.257,.242,.222,.195,.175,.159,.146, /.126,.111,.0955,.0841,.0729,.0647,.0583,.0532,.0490,.0448, /.0412,.0358,.0317,.0285,.0239,.0183,.0137,.0118,.00986,.00779, /.00648,.00558,.00440,.00365,.00207,.00119,.00061,.00040,.00030, /.00026,.00026/ C EXCIATION OF ALL STATES ABOVE 12.75 EV DATA XEXC4/12.75,12.8,12.9,13.0,13.2,13.4,13.6,13.8,14.0,14.5, /15.0,15.5,16.0,17.0,18.0,19.0,20.0,22.0,24.0,27.0, /30.0,33.0,36.0,40.0,44.0,50.0,54.0,60.0,70.0,80.0, /90.0,100.,120.,140.,170.,200.,240.,280.,320.,360., /400.,450.,500.,600.,700.,800.,1000.,1400.,2000.,2400., /3000.,4000.,5000.,6000.,8000.,10000.,20000.,40000.,100000., /200000.,400000.,1000000.,1500000./ DATA YEXC4/0.0, /.00005,.000455,.00124,.00388,.00780,.0129,.0189,.0259,.0465, /.0705,.097,.125,.184,.243,.300,.354,.453,.536,.637, /.712,.768,.809,.846,.868,.884,.887,.883,.864,.838, /.809,.780,.725,.676,.612,.560,.503,.458,.420,.389, /.362,.334,.311,.273,.244,.221,.187,.145,.110,.0948, /.0793,.0628,.0524,.0451,.0356,.0296,.0168,.00965,.00495, /.00329,.00248,.0021,.0021/ C NAME='Kr (2001)' C C -------------------------------------------------------------------- C DATA ON KRYPTON NOT AS GOOD AS ARGON . FIT TO HUNTERS DRIFT VELOCITY C AND DIFFUSION OF KOZUMI .TOWNSEND COEFFICIENT C OF KRUITOFF,HEYLEN AND BHATTACHYRA CONSISENT SO AVERAGED AND GOOD C AGREEMENT OBTAINED WITH CALCULATED VALUES. C -------------------------------------------------------------------- C NIN=4 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=83 NION=71 NEXC1=95 NEXC2=76 NEXC3=71 NEXC4=63 E(1)=0.0 E(2)=2.0*EMASS/(83.80*AMU) E(3)=13.996 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=9.60 EIN(1)=9.915 EIN(2)=11.304 EIN(3)=11.998 EIN(4)=12.75 SCRPT(1)=' ' SCRPT(2)=' ELASTIC KRYPTON ' SCRPT(3)=' IONISATION ELOSS= 13.996 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC S-LEVELS ELOSS= 9.915 ' SCRPT(8)=' EXC P-LEVELS ELOSS= 11.304 ' SCRPT(9)=' EXC D+P-LVLS ELOSS= 11.998 ' SCRPT(10)=' EXC LVLS .GT. EL0SS= 12.75 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0D0) Q(2,I)=37.8D-16 IF(EN.EQ.0.0D0) GO TO 200 DO 110 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 110 CONTINUE J=NDATA C USE LOG INTERPOLATION 160 Y1=LOG(YXSEC(J-1)) Y2=LOG(YXSEC(J)) X1=LOG(XEN(J-1)) X2=LOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=EXP((A*LOG(EN)+B))*1.0D-16 200 CONTINUE Q(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 230 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C EXCITATION TO FIRST FOUR 5S-LEVELS QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 370 DO 350 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 360 350 CONTINUE J=NEXC1 360 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(1,I)=(A*EN+B)*1.0D-16 370 CONTINUE C EXCITATION TO 5P-LEVELS QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 470 DO 450 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 460 450 CONTINUE J=NEXC2 460 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(2,I)=(A*EN+B)*1.0D-16 470 CONTINUE C EXCITATION TO 5D + 4D + 5P' LEVELS (UP TO 12.5 EV) QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 570 DO 550 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 560 550 CONTINUE J=NEXC3 560 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 570 CONTINUE C EXCITATION TO ALL LEVELS ABOVE 12.75 EV. QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 670 DO 650 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 660 650 CONTINUE J=NEXC4 660 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 670 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 END +DECK,GAS7. SUBROUTINE GAS7(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(116),YXSEC(116),XION(77),YION(77) DIMENSION XEXC1(98),YEXC1(98),XEXC2(76),YEXC2(76),XEXC3(67) DIMENSION YEXC3(67),XEXC4(62),YEXC4(62) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C DATA XEN/0.00,.001,.005,.007,0.01,.015,0.02,.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.10,0.12,0.14,0.17,0.20,0.25, /0.27,0.30,0.32,0.35,0.37,0.40,0.42,0.44,0.46,0.48, /0.50,0.51,0.52,0.53,0.54,0.55,0.56,0.57,0.58,0.59, /0.60,0.61,0.62,0.63,0.64,0.65,0.66,0.67,0.68,0.69, /0.70,.715,0.73,0.75,0.77,0.80,0.83,0.85,0.87,0.90, /1.00,1.08,1.14,1.20,1.30,1.40,1.50,1.70,2.00,2.50, /3.00,3.50,4.00,4.50,5.00,5.50,6.00,6.50,7.00,8.00, /9.00,10.0,12.0,15.0,18.0,20.0,25.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,125.,150.,200.,250.,300., /400.,500.,600.,700.,800.,1000.,1500.,2000.,3000.,4000., /5000.,6000.,8000.,10000.,20000.,200000./ DATA YXSEC/131.,115.,97.0,91.1,83.9,74.6,67.3,61.2,56.1,47.9, /41.4,36.2,31.8,28.2,22.5,18.1,14.8,11.1,8.36,5.33, /4.47,3.43,2.88,2.22,1.86,1.43,1.20,1.01,.844,.708, /.596,.548,.504,.465,.430,.399,.372,.348,.328,.310, /.296,.285,.276,.270,.266,.265,.266,.270,.276,.287, /.306,.341,.377,.427,.479,.562,.651,.713,.778,.880, /1.26,1.62,1.92,2.25,2.85,3.51,4.22,5.73,7.97,11.8, /15.8,20.4,24.4,28.0,30.7,31.5,32.3,31.6,31.0,27.5, /22.8,18.5,14.0,9.71,7.73,6.72,5.35,4.43,3.42,2.81, /2.42,2.17,2.00,1.89,1.80,1.73,1.65,1.34,1.15,1.05, /0.95,0.86,0.75,0.69,0.63,0.56,0.37,0.29,0.21,0.16, /0.13,0.12,.087,.073,.037,.006/ C DATA XION/12.13,12.5,13.0,13.5,14.0,14.5,15.0,15.5,16.0,16.5, /17.0,18.0,19.0,20.0,21.0,22.0,23.0,24.0,26.0,28.0, /30.0,32.0,34.0,36.0,40.0,45.0,50.0,55.0,60.0,65.0, /70.0,80.0,90.0,100.,110.,120.,130.,140.,150.,160., /180.,200.,250.,300.,350.,400.,450.,500.,550.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,3500.,4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000., /10000.,12000.,14000.,16000.,18000.,20000.,200000./ DATA YION/0.00,.090,.236,.394,.559,.730,.906,1.09,1.27,1.42, /1.58,1.85,2.11,2.35,2.56,2.82,3.02,3.21,3.49,3.71, /3.93,4.15,4.30,4.42,4.60,4.82,4.96,5.08,5.19,5.24, /5.28,5.32,5.41,5.53,5.61,5.59,5.53,5.41,5.31,5.16, /4.91,4.71,4.29,3.96,3.66,3.40,3.19,3.01,2.81,2.67, /2.44,2.22,2.05,1.92,1.68,1.48,1.37,1.23,1.14,.974, /.842,.742,.668,.607,.560,.519,.485,.426,.385,.349, /.321,.275,.244,.220,.202,.188,.0155/ DATA XEXC1/8.315,8.35,8.40,8.45,8.50,8.55,8.60,8.65,8.70,8.75, /8.80,8.85,8.90,8.95,9.00,9.05,9.10,9.15,9.20,9.25, /9.30,9.35,9.40,9.45,9.50,9.55,9.60,9.65,9.70,9.75, /9.80,9.90,10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0, /15.0,16.0,18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,90.0,100.,120.,140.,160., /180.,200.,240.,280.,320.,360.,400.,450.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,2000.,2400.,2800., /3200.,3600.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000., /15000.,20000.,30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC1/0.00,.0116,.024,.027,.026,.029,.0346,.040,.0458,.0516, /.0584,.0670,.079,.093,.106,.115,.116,.112,.108,.106, /.107,.115,.125,.144,.206,.240,.214,.168,.146,.144, /.147,.156,.164,.178,.192,.206,.232,.288,.336,.387, /.425,.459,.512,.552,.581,.602,.616,.624,.629,.634, /.629,.590,.571,.538,.509,.480,.456,.413,.374,.350, /.326,.307,.269,.245,.221,.206,.192,.173,.158,.139, /.125,.110,.101,.0917,.080,.0706,.063,.053,.046,.040, /.0360,.033,.0302,.0274,.025,.0216,.019,.017,.015,.013, /.0101,.0082,.006,.005,.0035,.003,.0025,.0017/ DATA XEXC2/9.447,9.45,9.50,9.55,9.60,9.65,9.70,9.75,9.80,9.90, /10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0,15.0,16.0, /18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,120.,140.,160.,180.,200., /240.,280.,320.,360.,400.,450.,500.,600.,700.,800., /900.,1000.,1200.,1400.,1600.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000.,15000.,20000., /30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC2/0.00,.0035,.0108,.0158,.0157,.015,.0176,.027,.037,.063, /.0884,.134,.177,.214,.277,.392,.461,.504,.530,.544, /.557,.555,.547,.538,.526,.515,.503,.475,.450,.408, /.374,.346,.323,.302,.284,.255,.232,.214,.199,.185, /.164,.148,.134,.124,.114,.106,.097,.0851,.0756,.0684, /.0624,.0575,.0499,.0442,.0397,.0332,.0287,.0252,.0227,.0206, /.0189,.0172,.0157,.0135,.0119,.0107,.0097,.00884,.00632,.00499, /.00359,.00286,.00210,.00171,.00146,.00097/ DATA XEXC3/9.917,10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0,15.0, /16.0,18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /50.0,60.0,70.0,80.0,90.0,100.,120.,140.,160.,180., /200.,240.,280.,320.,360.,400.,450.,500.,600.,700., /800.,900.,1000.,1200.,1400.,1600.,2000.,2400.,2800.,3200., /3600.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000.,15000., /20000.,30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC3/0.00,.000005,.0389,.118,.190,.315,.615,.810,.939,1.03, /1.08,1.14,1.17,1.17,1.16,1.15,1.13,1.11,1.07,1.02, /.930,.858,.800,.745,.701,.661,.596,.544,.501,.466, /.435,.386,.348,.318,.292,.271,.249,.230,.202,.180, /.162,.149,.137,.119,.106,.0947,.0792,.0684,.0604,.0541, /.0492,.0451,.0410,.0375,.0324,.0284,.0254,.0231,.0212,.0152, /.0120,.00861,.00686,.00504,.00409,.00351,.00233/ DATA XEXC4/11.70,12.0,13.0,14.0,15.0,16.0,18.0,20.0,22.0,24.0, /26.0,28.0,30.0,35.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.,120.,140.,160.,180.,200.,240.,280.,320.,360., /400.,450.,500.,600.,700.,800.,900.,1000.,1200.,1400., /1600.,2000.,2400.,2800.,3200.,3600.,4000.,4500.,5000.,6000., /7000.,8000.,9000.,10000.,15000.,20000.,30000.,40000.,60000.,8E4, /100000.,200000./ DATA YEXC4/0.00,.00194,.0299,.0776,.134,.194,.308,.410,.494,.564, /.622,.668,.705,.767,.801,.820,.807,.784,.756,.727, /.698,.645,.598,.558,.523,.492,.442,.400,.367,.340, /.316,.291,.271,.237,.212,.192,.176,.162,.141,.125, /.112,.0946,.0818,.0722,.0648,.0589,.0540,.0492,.0450,.0388, /.0342,.0306,.0277,.0254,.0182,.0144,.0104,.00828,.00608,.00494, /.00424,.00281/ C NAME='Xe (2003)' C C -------------------------------------------------------------------- C DATA ON XENON NOT AS GOOD AS ARGON . USED MOMENTUM TRANSFER C X-SECTION FROM SCHMIDT. AND FIT TO TOWNSEND COEFFICIENT OF C JACQUES ET AL J.PHYS D 19 (1986) 1731-1739 AND KRUITHOF TO OBTAIN C INELASTIC X-SECTIONS. C -------------------------------------------------------------------- C C NIN=4 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=116 NION=77 NEXC1=98 NEXC2=76 NEXC3=67 NEXC4=62 E(1)=0.0 E(2)=2.0*EMASS/(131.30*AMU) E(3)=12.13 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=8.70 EIN(1)=8.315 EIN(2)=9.447 EIN(3)=9.917 EIN(4)=11.70 SCRPT(1)=' ' SCRPT(2)=' ELASTIC XENON ' SCRPT(3)=' IONISATION ELOSS= 12.13 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC ELOSS= 8.315 ' SCRPT(8)=' EXC ELOSS= 9.447 ' SCRPT(9)=' EXC ELOSS= 9.917 ' SCRPT(10)=' EXC ELOSS= 11.70 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.LE.XEN(2)) THEN Q(2,I)=122.D-16 GO TO 200 ENDIF DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 200 CONTINUE Q(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 230 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 370 DO 350 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 360 350 CONTINUE J=NEXC1 360 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(1,I)=(A*EN+B)*1.0D-16 370 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 470 DO 450 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 460 450 CONTINUE J=NEXC2 460 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(2,I)=(A*EN+B)*1.0D-16 470 CONTINUE QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 570 DO 550 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 560 550 CONTINUE J=NEXC3 560 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 570 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 670 DO 650 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 660 650 CONTINUE J=NEXC4 660 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 670 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) 900 CONTINUE IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 END +DECK,GAS8. SUBROUTINE GAS8(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(73),YXSEC(73),XVIB1(24),YVIB1(24),XVIB2(22),YVIB2(22 /),XION(82),YION(82),XATT(14),YATT(14),XDIS1(32),YDIS1(32), /XDIS2(32),YDIS2(32),XDIS3(32),YDIS3(32),XDIS4(32),YDIS4(32), /YELAT(73),XVIB3(19),YVIB3(19),XVIB4(19),YVIB4(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.0001,.001,.004,.007,0.01,.012,.014,.017,0.02, /.025,0.03,.035,0.04,0.05,0.06,0.07,0.08,0.09,0.10, /0.12,0.14,0.17,0.20,0.24,0.28,0.32,0.36,0.40,0.45, /0.50,0.60,0.70,0.80,1.00,1.20,1.40,1.70,2.00,2.50, /3.00,3.50,4.00,5.00,6.00,7.00,8.00,9.00,10.0,12.0, /15.0,20.0,30.0,40.0,50.0,60.0,80.0,100.,150.,200., /300.,400.,500.,600.,800.,1000.,2000.,4000.,6000.,8000., /10000.,20000.,100000./ C ELASTIC MOMENTUM TRANSFER X-SECTION DATA YXSEC/26.7,25.4,22.7,18.9,16.6,14.9,14.0,13.1,12.1,11.1, /9.80,8.71,7.78,6.98,5.68,4.70,3.85,3.31,2.75,2.32, /1.72,1.23,0.78,.500,.330,.315,.340,.375,.430,.500, /.600,.810,1.05,1.29,1.80,2.15,2.55,3.25,4.05,5.80, /7.90,10.1,11.7,14.5,16.3,17.2,17.6,17.6,17.0,15.0, /13.0,8.50,4.70,3.40,2.50,2.10,1.55,1.20,0.66,0.44, /0.25,0.16,0.12,0.09,0.06,.045,.016,.006,.003,.002, /.001,.00025,.000015/ C ELASTIC TOTAL X-SECTION DATA YELAT/26.7,25.6,23.3,19.9,17.9,16.4,15.5,14.8,13.8,12.9, /11.6,10.6,9.67,8.89,7.60,6.57,5.60,4.90,4.20,3.70, /2.80,2.20,1.62,1.23,0.95,0.82,0.75,0.72,0.71,0.73, /0.77,0.95,1.10,1.28,1.72,2.25,3.00,4.00,5.00,7.32, /8.81,11.0,13.3,17.6,21.2,23.2,24.0,23.8,23.1,21.4, /19.7,15.6,11.2,8.55,7.20,6.09,4.74,3.89,2.55,2.00, /1.35,1.05,0.78,0.65,0.50,0.42,0.23,0.14,0.10,0.08, /.064,.030,.007/ DATA XVIB1/.1625,0.20,0.30,0.40,0.50,0.60,0.80,1.00,2.00,3.00, /5.00,6.00,7.00,8.00,9.00,10.0,12.5,15.0,20.0,50.0, /100.0,1000.,10000.,100000./ DATA YVIB1/0.00,.0001,.056,.067,.072,.075,.078,.079,.119,.152, /0.50,0.70,0.80,0.75,0.65,0.55,0.39,0.33,0.19,.077, /.044,0.004,.0004,.00004/ DATA XVIB2/.3743,0.40,0.50,0.60,0.80,1.00,2.00,3.00,5.00,6.00, /7.00,8.00,9.00,10.0,12.5,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB2/0.00,.006,.011,.012,.013,.014,.033,.090,0.50,0.70, /0.80,0.75,0.65,0.50,0.25,0.19,0.10,0.04,0.02,0.01, /.001,.0001/ DATA XVIB3/.544,1.00,2.00,3.00,5.00,6.00,7.00,8.00,9.00,10.0, /12.5,15.0,17.5,20.0,50.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,.001,.005,.027,.095,.125,.135,.135,.110,.080, /.055,.037,.028,.020,.008,.003,.0003,.00003,.000003/ DATA XVIB4/.736,1.00,2.00,3.00,5.00,6.00,7.00,8.00,9.00,10.0, /12.5,15.0,17.5,20.0,50.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,.0008,.004,.024,.080,.105,.115,.115,.095,.070, /.045,.027,.018,.010,.007,.003,.0003,.00003,.000003/ DATA XION/12.99,13.5,14.0,14.5,15.0,15.5,16.0,16.5,17.0,17.5, /18.0,18.5,19.0,19.5,21.0,21.5,22.0,22.5,23.0,23.5, /24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000., /1500.,2000.,3000.,4000.,5000.,7000.,10000.,12000.,15000.,20000., /40000.,100000./ DATA YION/0.00,.034,.074,0.13,.198,.278,.361,.445,.530,.610, /.706,.793,.880,.977,1.24,1.34,1.42,1.50,1.57,1.65, /1.72,1.97,2.20,2.38,2.54,2.68,2.79,2.91,3.02,3.21, /3.36,3.47,3.56,3.62,3.66,3.68,3.69,3.70,3.69,3.68, /3.66,3.63,3.62,3.59,3.55,3.52,3.48,3.45,3.41,3.38, /3.33,3.25,3.11,3.01,2.72,2.49,2.27,2.09,1.94,1.83, /1.72,1.63,1.54,1.47,1.40,1.34,1.28,1.24,1.20,1.18, /0.82,0.66,0.47,0.37,0.31,.235,.175,.151,.127,0.10, /.058,.028/ DATA XATT/7.00,7.50,8.00,8.50,9.00,9.50,10.0,10.5,11.0,11.5, /12.0,12.5,13.0,13.5/ DATA YATT/0.00,0.005,0.12,0.51,0.75,0.85,0.96,0.91,0.72,0.49, /0.27,0.13,0.06,0.00/ DATA XDIS1/9.00,10.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,100000./ DATA YDIS1/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.28, /0.24,0.18,0.14,.098,.075,.055,.040,.029,.022,.018, /.009,.0018/ DATA XDIS2/10.0,11.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,100000./ DATA YDIS2/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.28, /0.24,0.18,0.14,.098,.075,.055,.040,.029,.022,.018, /.009,.0018/ DATA XDIS3/11.0,12.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,100000./ DATA YDIS3/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.28, /0.24,0.18,0.14,.098,.075,.055,.040,.029,.022,.018, /.009,.0018/ DATA XDIS4/11.8,12.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,100000./ DATA YDIS4/0.00,.045,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.28, /0.24,0.18,0.14,.098,.075,.055,.040,.029,.022,.018, /.009,.0018/ NAME='CH4 (2004)' NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C USE ANISOTROPIC SCATTERING FOR ELASTIC AND COPY (OFFSET) TO IONISATION KEL(2)=1 KEL(3)=1 C USE ANISOTROPIC SCATTERING FOR LEVEL 2 AND 3 KIN(2)=1 KIN(3)=1 C RAT=0.8 NDATA=73 NVIB1=24 NVIB2=22 NVIB3=19 NVIB4=19 NION=82 NATT=14 NDIS1=32 NDIS2=32 NDIS3=32 NDIS4=32 E(1)=0.0 E(2)=2.0*EMASS/(16.0426*AMU) E(3)=12.99 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=7.3 IOFF=INT(0.5+E(3)/ESTEP) EIN(1)=-0.1625 EIN(2)=0.1625 EIN(3)=0.3743 EIN(4)=0.544 EIN(5)=0.736 EIN(6)=9.0 EIN(7)=10.0 EIN(8)=11.0 EIN(9)=11.8 SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) METHANE ' SCRPT(3)=' IONISATION ELOSS= 12.99 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V2+V4 ELOSS= -0.1625 ' SCRPT(8)=' VIB V2+V4 ELOSS= 0.1625 ' SCRPT(9)=' VIB V1+V3 ELOSS= 0.3743 ' SCRPT(10)=' VIB HAR ELOSS= 0.544 ' SCRPT(11)=' VIB HAR ELOSS= 0.736 ' SCRPT(12)=' EXC DISOCIATN ELOSS= 9.0 ' SCRPT(13)=' EXC DISOCIATN ELOSS= 10.0 ' SCRPT(14)=' EXC DISOCIATN ELOSS= 11.0 ' SCRPT(15)=' EXC DISOCIATN ELOSS= 11.8 ' APOP=EXP(EIN(1)/AKT) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP C USE LOG INTERPOLATION FOR ELASTIC IF(EN.LE.XEN(2)) THEN QELA=26.7D-16 QMOM=26.7D-16 GO TO 30 ENDIF DO 3 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 4 3 CONTINUE J=NDATA 4 YXJ=LOG(YELAT(J)) YXJ1=LOG(YELAT(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=EXP(A*LOG(EN)+B)*1.D-16 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=EXP(A*LOG(EN)+B)*1.D-16 30 CONTINUE PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC DISTRIBUTION SAME AS ELASTIC AT ENERGY OFFSET BY C IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 200 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(14)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C V4 + V2 SUPERELASTIC QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.091*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)+(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C V4 + V2 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.091*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(2) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C RATIO OF MT TO TOTAL X-SECT FOR RESONANCE PART =RAT XMT=((1.5-FWD/(FWD+BCK))*QIN(2,I)+RAT*(A*EN+B))*1.D-16 QIN(2,I)=((A*EN+B)+QIN(2,I))*1.D-16 PEQIN(2,I)=0.5+(QIN(2,I)-XMT)/QIN(2,I) QIN(2,I)=QIN(2,I)/(1.0+APOP) 400 CONTINUE C V1 + V3 QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.082*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(3) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C RATIO OF MT TO TOTAL X-SECT FOR RESONANCE PART =RAT XMT=((1.5-FWD/(FWD+BCK))*QIN(3,I)+RAT*(A*EN+B))*1.D-16 QIN(3,I)=((A*EN+B)+QIN(3,I))*1.D-16 PEQIN(3,I)=0.5+(QIN(3,I)-XMT)/QIN(3,I) 500 CONTINUE C VIBRATION HARMONICS 1 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.D-16 600 CONTINUE C VIBRATION HARMONICS 2 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=(A*EN+B)*1.D-16 700 CONTINUE C DISOCIATIVE EXCITATION QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 850 DO 810 J=2,NDIS1 IF(EN.LE.XDIS1(J)) GO TO 820 810 CONTINUE J=NDIS1 820 A=(YDIS1(J)-YDIS1(J-1))/(XDIS1(J)-XDIS1(J-1)) B=(XDIS1(J-1)*YDIS1(J)-XDIS1(J)*YDIS1(J-1))/(XDIS1(J-1)-XDIS1(J)) QIN(6,I)=(A*EN+B)*1.D-16 850 CONTINUE C DISOCIATIVE EXCITATION QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 900 DO 860 J=2,NDIS2 IF(EN.LE.XDIS2(J)) GO TO 870 860 CONTINUE J=NDIS2 870 A=(YDIS2(J)-YDIS2(J-1))/(XDIS2(J)-XDIS2(J-1)) B=(XDIS2(J-1)*YDIS2(J)-XDIS2(J)*YDIS2(J-1))/(XDIS2(J-1)-XDIS2(J)) QIN(7,I)=(A*EN+B)*1.D-16 900 CONTINUE C DISOCIATIVE EXCITATION QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 950 DO 910 J=2,NDIS3 IF(EN.LE.XDIS3(J)) GO TO 920 910 CONTINUE J=NDIS3 920 A=(YDIS3(J)-YDIS3(J-1))/(XDIS3(J)-XDIS3(J-1)) B=(XDIS3(J-1)*YDIS3(J)-XDIS3(J)*YDIS3(J-1))/(XDIS3(J-1)-XDIS3(J)) QIN(8,I)=(A*EN+B)*1.D-16 950 CONTINUE C DISOCIATIVE EXCITATION QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 990 DO 960 J=2,NDIS4 IF(EN.LE.XDIS4(J)) GO TO 970 960 CONTINUE J=NDIS4 970 A=(YDIS4(J)-YDIS4(J-1))/(XDIS4(J)-XDIS4(J-1)) B=(XDIS4(J-1)*YDIS4(J)-XDIS4(J)*YDIS4(J-1))/(XDIS4(J-1)-XDIS4(J)) QIN(9,I)=(A*EN+B)*1.D-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) C 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS9. SUBROUTINE GAS9(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(55),YXSEC(55),XATT(16),YATT(16),XION(50),YION(50), /XVIB1(28),YVIB1(28),XVIB2(28),YVIB2(28),XVIB3(28),YVIB3(28), /XVIB4(25),YVIB4(25),XVIB5(19),YVIB5(19), /XEXC(25),YEXC(25),XEXC1(23),YEXC1(23),XEXC2(19),YEXC2(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.001,.002,.003,.004,.005,.007,0.01,.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.24,0.30,0.40,0.50,0.60, /0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,15.0,20.0,30.0,40.0,70.0,100.,140.,200., /1000.,2000.,10000.,20000.,100000./ DATA YXSEC/40.0,34.0,31.0,29.0,28.0,27.0,25.0,22.5,20.0,16.0, /12.0,7.25,4.70,3.25,2.40,1.80,1.40,1.15,1.10,1.10, /1.10,1.10,1.20,1.55,1.90,3.00,4.10,6.00,7.30,7.90, /8.30,8.80,9.60,10.6,12.6,15.8,19.8,22.2,23.0,21.5, /19.0,16.2,10.9,7.00,4.90,3.76,2.15,1.41,1.00,0.70, /0.14,0.07,.012,.006,.0012/ DATA XVIB1/.117,0.13,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,0.06,0.09,.115,0.12,0.12,0.11,0.09,.078,.055, /0.04,0.04,0.06,0.11,0.16,0.21,0.27,0.37,0.37,0.30, /0.21,0.11,0.06,.036,0.01,.001,.0001,.00001/ DATA XVIB2/.148,0.16,0.17,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,.057,0.10,0.14,0.15,0.16,0.16,0.14,0.12,0.09, /0.07,0.07,0.09,0.15,0.22,0.29,0.38,0.48,0.48,0.40, /0.28,0.16,0.09,0.06,.016,.0016,.00016,.000016/ DATA XVIB3/.182,0.19,0.20,0.23,0.25,0.30,0.35,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.11,0.13,0.27,0.33,0.37,0.38,0.37,0.32,0.23, /0.16,0.16,0.19,0.35,0.52,0.68,0.88,1.15,1.15,0.95, /0.65,0.37,0.20,0.12,0.03,.003,.0003,.00003/ DATA XVIB4/.366,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.20,0.32,0.34,0.36,0.37,0.37,0.34,0.30,0.36, /0.53,0.78,1.02,1.35,1.48,1.25,0.95,0.55,0.23,0.13, /0.08,.016,.0016,.00016,.000016/ DATA XVIB5/.548,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.001,0.01,.016,.035,0.06,0.09,0.12,0.13,0.11, /0.08,.045,0.02,0.01,.007,.0016,.00016,.000016,.0000016/ DATA XION/11.52,12.0,12.5,13.0,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,25.0,30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0, /90.0,100.,125.,150.,175.,200.,250.,300.,350.,400., /450.,500.,600.,700.,800.,900.,1000.,1250.,1500.,1750., /2000.,2500.,3000.,4000.,6000.,8000.,12000.,20000.,40000.,100000./ DATA YION/0.00,.014,0.06,.135,.345,0.63,0.94,1.28,1.62,1.95, /2.24,3.48,4.45,4.94,5.41,5.84,6.04,6.67,6.93,6.86, /6.84,6.89,6.53,6.32,5.98,5.68,5.01,4.60,4.18,3.86, /3.47,3.33,3.03,2.71,2.38,2.25,2.03,1.75,1.52,1.37, /1.22,1.08,0.90,0.72,0.53,0.42,0.30,0.20,0.11,.045/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ DATA XEXC/8.20,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.00,0.40,0.70,0.80,0.90,1.00,1.05,1.20,1.35,1.45, /1.50,1.50,1.50,1.40,1.30,1.20,1.00,0.90,0.70,0.50, /0.25,0.13,0.05,.025,.005/ DATA XEXC1/10.3,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,0.15,0.30,0.55,0.85,1.15,1.35,1.45, /1.50,1.50,1.50,1.40,1.30,1.20,1.00,0.90,0.70,0.50, /0.25,0.13,0.05,.025,.005/ DATA XEXC2/17.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.25,0.55,0.70, /0.75,0.70,0.67,0.64,0.58,0.50,0.40,0.32,0.23,0.15, /0.08,.045,0.02,0.01,.002/ NAME='C2H6 (1999)' C --------------------------------------------------------------------- C UPDATED TO DEC 1994 . INCLUDES LATEST ELECTRON SCATTERING RESULTS C GIVES BETTER FIT THAN PREVIOUS DATA SET C 1999 MOD USES VIBRATION AT 35.8 MV AND ALSO SUPER ELASTICS. C ALSO MOD TO ELASTIC AT LOW ENERGY BELOW 20 MV C --------------------------------------------------------------------- NIN=11 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=55 NION=50 NATT=16 NVIB1=28 NVIB2=28 NVIB3=28 NVIB4=25 NVIB5=19 NEXC=25 NEXC1=23 NEXC2=19 E(1)=0.0 E(2)=2.0*EMASS/(30.06964*AMU) E(3)=11.52 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=11.52 EIN(1)=-0.0358 EIN(2)=0.0358 EIN(3)=-0.117 EIN(4)=0.117 EIN(5)=0.148 EIN(6)=0.182 EIN(7)=0.366 EIN(8)=0.548 EIN(9)=8.2 EIN(10)=10.3 EIN(11)=17.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ETHANE ' SCRPT(3)=' IONISATION ELOSS= 11.52 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= -0.0358 ' SCRPT(8)=' VIB ELOSS= 0.0358 ' SCRPT(9)=' VIB ELOSS= -0.117 ' SCRPT(10)=' VIB ELOSS= 0.117 ' SCRPT(11)=' VIB ELOSS= 0.148 ' SCRPT(12)=' VIB ELOSS= 0.182 ' SCRPT(13)=' VIB ELOSS= 0.366 ' SCRPT(14)=' VIB ELOSS= 0.548 ' SCRPT(15)=' EXC ELOSS= 8.2 ' SCRPT(16)=' EXC ELOSS= 10.3 ' SCRPT(17)=' EXC ELOSS= 17.0 ' APOP=EXP(EIN(1)/AKT) POPVH=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GE.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C SUPER V TORSION QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 1300 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.003*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 C 1300 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 1301 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.003*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)*1.0/(1.0+APOP)*1.D-16 1301 CONTINUE C SUPERELASTIC VIB1 C QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EIN(4)).LE.XVIB1(J)) GO TO 302 301 CONTINUE J=NVIB1 302 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.D-16/EN QIN(3,I)=QIN(3,I)*POPVH/(1.0+POPVH) 305 CONTINUE C QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(4,I)=(A*EN+B)*1.D-16 QIN(4,I)=QIN(4,I)/(1.0+POPVH) 400 CONTINUE QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(6,I)=(A*EN+B)*1.D-16 600 CONTINUE QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(7,I)=(A*EN+B)*1.D-16 700 CONTINUE QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 720 710 CONTINUE J=NVIB5 720 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(8,I)=(A*EN+B)*1.D-16 800 CONTINUE QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(9,I)=(A*EN+B)*1.D-16 900 CONTINUE QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 990 DO 910 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 920 910 CONTINUE J=NEXC1 920 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(10,I)=(A*EN+B)*1.D-16 990 CONTINUE QIN(11,I)=0.0D0 IF(EN.LE.EIN(11)) GO TO 1990 DO 1910 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 1920 1910 CONTINUE J=NEXC2 1920 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(11,I)=(A*EN+B)*1.D-16 1990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS10. SUBROUTINE GAS10(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(59),YXSEC(59),XION(46),YION(46),XATT(16),YATT(16), /XVIB1(28),YVIB1(28),XVIB2(28),YVIB2(28),XVIB3(25),YVIB3(25), /XVIB4(19),YVIB4(19),XEXC1(25),YEXC1(25),XEXC2(23),YEXC2(23), /XEXC3(19),YEXC3(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.001,0.002,0.003,0.004,0.005,0.007,0.01,0.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.24,0.30,0.40,0.50, /0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00,7.50, /8.50,10.0,15.0,20.0,30.0,40.0,70.0,100.,140.,200., /250.,300.,500.,1000.,1500.,3000.,6000.,10000.,20000.,100000./ DATA YXSEC/55.0,55.0,46.0,40.0,36.0,32.0,27.5,22.5,19.5,16.5, /14.2,12.5,11.2,9.80,8.20,6.70,5.30,3.80,3.00,2.65, /2.60,2.60,2.90,3.40,4.30,6.10,8.40,10.0,11.2, /12.0,12.5,13.0,13.7,15.5,17.7,22.0,25.4,27.7,30.0, /26.0,23.1,16.7,13.0,9.00,6.80,4.00,2.88,1.70,1.05, /0.75,0.62,0.35,.155,0.10,.045,0.02,.012,.005,.001/ DATA XION/10.95,12.0,13.0,14.0,15.0,17.5,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.21,0.47,0.76,1.14,2.30,3.31,5.21,6.47,7.37, /8.00,8.54,9.22,9.79,10.1,10.2,10.2,10.2,9.90,9.36, /8.84,8.35,7.80,6.84,6.25,5.78,5.26,4.93,4.33,3.99, /3.67,3.27,3.05,2.64,2.27,2.06,1.88,1.62,1.39,0.92, /0.69,0.51,0.36,.195,.105,.066/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.90,1.48,2.23,3.78,5.94,8.91,13.9,19.8,16.6, /13.1,8.37,4.72,1.76,0.67,0.00/ DATA XVIB1/.108,.125,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,0.16,0.31,0.42,0.43,0.43,0.39,0.33,0.29,0.24, /0.19,0.19,0.23,0.37,0.55,0.72,0.93,1.22,1.22,1.00, /0.69,0.39,0.21,0.13,0.03,.003,.0003,.00003/ DATA XVIB2/.173,0.18,0.19,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.10,0.21,0.29,0.38,0.41,0.43,0.41,0.38,0.32, /0.26,0.24,0.25,0.37,0.55,0.72,0.93,1.22,1.22,1.00, /0.69,0.39,0.21,0.13,0.03,.003,.0003,.00003/ DATA XVIB3/.363,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.33,0.44,0.49,0.52,0.52,0.49,0.46,0.44,0.48, /0.70,1.00,1.30,1.68,1.85,1.60,1.18,0.68,0.30,0.17, /0.10,0.02,.002,.0002,.00002/ DATA XVIB4/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,.001,0.01,.020,.050,.094,0.12,0.16,0.18,0.15, /.114,.066,.028,.016,.010,.002,.0002,.00002,.000002/ DATA XEXC1/7.70,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,1.00,1.45,1.55,1.60,1.65,1.65,1.65,1.65,1.65, /1.70,1.70,1.65,1.55,1.30,1.20,1.00,0.94,0.80,0.52, /0.25,0.13,0.05,.026,.005/ DATA XEXC2/10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.15,0.31,0.58,0.89,1.20,1.40,1.52, /1.65,1.70,1.65,1.55,1.30,1.20,1.00,0.94,0.80,0.52, /0.25,0.13,0.05,.026,.005/ DATA XEXC3/17.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.33,0.72,1.00, /1.40,1.65,1.65,1.55,1.30,1.20,1.00,0.94,0.80,0.52, /0.25,0.13,0.05,.026,.005/ C NAME='C3H8 (1999)' C --------------------------------------------------------------------- NIN=8 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=59 NION=46 NATT=16 NVIB1=28 NVIB2=28 NVIB3=25 NVIB4=19 NEXC1=25 NEXC2=23 NEXC3=19 E(1)=0.0 E(2)=2.0*EMASS/(44.09652*AMU) E(3)=10.95 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.95 EIN(1)=-0.108 EIN(2)=0.108 EIN(3)=0.173 EIN(4)=0.363 EIN(5)=0.519 EIN(6)=7.7 EIN(7)=10.0 EIN(8)=17.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC PROPANE ' SCRPT(3)=' IONISATION ELOSS=10.95 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= -0.108 ' SCRPT(8)=' VIB ELOSS= 0.108 ' SCRPT(9)=' VIB ELOSS= 0.173 ' SCRPT(10)=' VIB ELOSS= 0.363 ' SCRPT(11)=' VIB ELOSS= 0.519 ' SCRPT(12)=' EXC ELOSS= 7.70 ' SCRPT(13)=' EXC ELOSS= 10.0 ' SCRPT(14)=' EXC ELOSS= 17.0 ' APOP=EXP(EIN(1)/AKT) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 1100 DO 1010 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 1020 1010 CONTINUE J=NVIB1 1020 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP) 1100 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.D-16 QIN(2,I)=QIN(2,I)/(1.0+APOP) 400 CONTINUE QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.D-16 500 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.D-16 600 CONTINUE QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=(A*EN+B)*1.D-16 700 CONTINUE QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 720 710 CONTINUE J=NEXC1 720 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(6,I)=(A*EN+B)*1.D-16 800 CONTINUE QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 820 810 CONTINUE J=NEXC2 820 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(7,I)=(A*EN+B)*1.D-16 900 CONTINUE QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 920 910 CONTINUE J=NEXC3 920 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(8,I)=(A*EN+B)*1.D-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS11. SUBROUTINE GAS11(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(62),YXSEC(62),XION(46),YION(46),XATT(16),YATT(16), /XVIB1(34),YVIB1(34),XVIB2(28),YVIB2(28),XVIB3(28),YVIB3(28), /XVIB4(25),YVIB4(25),XVIB5(19),YVIB5(19),XEXC1(25),YEXC1(25), /XEXC2(23),YEXC2(23),XEXC3(19),YEXC3(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.001,0.002,0.003,0.004,0.005,0.007,0.01,0.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.23,0.26,0.30,0.35,0.40, /0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0,70.0,100., /140.,200.,250.,300.,500.,1000.,1500.,3000.,6000.,10000., /20000.,100000./ DATA YXSEC/65.0,65.0,64.0,63.0,62.0,61.0,59.0,54.0,44.0,35.0, /27.5,23.0,19.0,16.5,15.0,14.0,13.0,12.5,11.5,11.0, /10.0,9.50,8.00,5.50,3.50,3.60,4.80,7.50,9.60,11.5, /13.0,14.0,15.0,16.0,17.0,19.0,21.5,26.0,30.0,33.0, /35.0,35.0,33.0,30.0,21.5,17.0,11.5,8.80,5.20,3.75, /2.21,1.36,0.98,0.81,0.46,0.20,0.13,0.06,.026,.016, /.0065,.0013/ DATA XION/10.67,11.2,12.7,13.7,14.7,17.2,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.27,0.61,0.99,1.48,3.00,4.30,6.77,8.41,9.58, /10.4,11.1,12.0,12.7,13.1,13.3,13.3,13.3,12.9,12.2, /11.5,10.9,10.1,8.89,8.12,7.51,6.84,6.41,5.63,5.19, /4.77,4.25,3.97,3.43,2.95,2.68,2.44,2.11,1.81,1.20, /0.90,0.66,0.47,.254,.136,.086/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,1.15,1.92,2.90,4.90,7.72,11.6,18.1,25.7,21.6, /17.0,10.9,6.14,2.30,0.87,0.00/ DATA XVIB1/.052,.055,.060,.065,.070,.075,0.08,0.10,0.12,0.14, /0.20,0.25,0.30,0.40,0.50,0.70,1.00,1.50,2.00,3.00, /4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0, /100.,1000.,10000.,100000./ DATA YVIB1/0.00,.014,.021,.024,.026,.027,.028,.028,.027,.025, /.021,.018,.016,.014,.012,.009,.008,.012,.015,.024, /.036,.047,.060,.079,.079,.065,.045,.025,.014,.008, /.002,.0002,.00002,.00002/ DATA XVIB2/.108,.125,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.27,0.52,0.71,0.73,0.73,0.66,0.56,0.49,0.41, /0.32,0.32,0.39,0.63,0.93,1.22,1.57,2.06,2.06,1.69, /1.17,0.66,0.35,0.22,0.05,.005,.0005,.00005/ DATA XVIB3/.173,0.18,0.19,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.13,0.27,0.38,0.49,0.53,0.56,0.53,0.49,0.42, /0.34,0.31,0.33,0.48,0.72,0.94,1.21,1.59,1.59,1.30, /0.90,0.51,0.27,0.17,0.04,.004,.0004,.00004/ DATA XVIB4/.363,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.47,0.63,0.70,0.74,0.74,0.70,0.66,0.63,0.69, /1.00,1.43,1.86,2.40,2.65,2.29,1.69,0.97,0.43,0.24, /0.14,0.03,.003,.0003,.00003/ DATA XVIB5/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.001,0.01,.033,.085,0.16,0.20,0.27,0.30,0.25, /.193,.112,.047,.027,.017,.003,.0003,.00003,.000003/ DATA XEXC1/7.40,8.70,9.70,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,1.30,1.89,2.02,2.08,2.15,2.15,2.15,2.15,2.15, /2.21,2.21,2.15,2.02,1.69,1.56,1.30,1.22,1.04,0.68, /0.33,0.17,0.06,.034,.007/ DATA XEXC2/9.70,10.7,11.7,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.19,0.40,0.75,1.16,1.56,1.82,1.98, /2.15,2.21,2.15,2.02,1.69,1.56,1.30,1.22,1.04,0.68, /0.32,0.17,0.06,.034,.006/ DATA XEXC3/17.0,20.0,25.0,30.0,40.0,60.0,80.0,100.,150.,200., /300.,400.,600.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.43,0.94,1.30,1.82,2.15,2.15,2.02,1.69,1.56, /1.30,1.22,1.04,0.68,0.33,0.17,0.07,.034,.006/ C-------------------------------------------------------- NAME='iC4H10 (1999)' C --------------------------------------------------------------------- NIN=10 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=62 NION=46 NATT=16 NVIB1=34 NVIB2=28 NVIB3=28 NVIB4=25 NVIB5=19 NEXC1=25 NEXC2=23 NEXC3=19 E(1)=0.0 E(2)=2.0*EMASS/(58.1234*AMU) E(3)=10.67 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.67 EIN(1)=-0.052 EIN(2)=0.052 EIN(3)=-0.108 EIN(4)=0.108 EIN(5)=0.173 EIN(6)=0.363 EIN(7)=0.519 EIN(8)=7.4 EIN(9)=9.70 EIN(10)=17.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ISOBUTANE ' SCRPT(3)=' IONISATION ELOSS= 10.67 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= -0.052 ' SCRPT(8)=' VIB ELOSS= 0.052 ' SCRPT(9)=' VIB ELOSS= -0.108 ' SCRPT(10)=' VIB ELOSS= 0.108 ' SCRPT(11)=' VIB ELOSS= 0.173 ' SCRPT(12)=' VIB ELOSS= 0.363 ' SCRPT(13)=' VIB ELOSS= 0.519 ' SCRPT(14)=' EXC ELOSS= 7.4 ' SCRPT(15)=' EXC ELOSS= 9.70 ' SCRPT(16)=' EXC ELOSS= 17.0 ' APOP=EXP(EIN(1)/AKT) HPOP=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC VIB QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 302 301 CONTINUE J=NVIB1 302 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN QIN(1,I)=APOP*QIN(1,I)/(1.0+APOP) C 305 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 4000 DO 4100 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 4200 4100 CONTINUE J=NVIB1 4200 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.D-16/(1.0+APOP) 4000 CONTINUE QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 1100 DO 307 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 308 307 CONTINUE J=NVIB2 308 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.D-16/EN QIN(3,I)=HPOP*QIN(3,I)/(1.0+HPOP) 1100 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B)*1.D-16/(1.0+HPOP) 400 CONTINUE QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(6,I)=(A*EN+B)*1.D-16 600 CONTINUE QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 700 CONTINUE QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 720 710 CONTINUE J=NEXC1 720 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 800 CONTINUE QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 820 810 CONTINUE J=NEXC2 820 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 900 CONTINUE QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 920 910 CONTINUE J=NEXC3 920 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(10,I)=(A*EN+B)*1.D-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS12. SUBROUTINE GAS12(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220),PJ(220) DIMENSION XEN(65),YMOM(65),XV2(21),YV2(21),X2V2(23),Y2V2(23), /XV1(30),YV1(30),X3V2(15),Y3V2(15),XV3(15),YV3(15), /XVPD3(20),YVPD3(20),XV130(17),YV130(17),XVPD4(18),YVPD4(18), /XVPD5(15),YVPD5(15),XVPD6(15),YVPD6(15),XVPD7(15),YVPD7(15), /XVPD8(15),YVPD8(15),XVPD9(15),YVPD9(15),XVPDH(13),YVPDH(13), /XEXC1(40),YEXC1(40),XEXC2(40),YEXC2(40),XEXC3(38),YEXC3(38), /XEXC4(38),YEXC4(38),XEXC5(38),YEXC5(38),XEXC6(38),YEXC6(38), /XATT(29),YATT(29),XION(68),YION(68),YEL(65),YVBMOM(65),YVBEL(65) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC +ROTATIONAL DATA XEN/1.D-6,.001,.002,.004,.007,.010,.014,.020,.030,.040, /0.05,0.06,0.08,0.10,.125,.150,.175,0.20,0.25,0.30, /0.35,0.40,0.50,0.60,0.70,0.85,1.00,1.25,1.50,1.70, /1.90,2.10,2.30,2.50,2.80,3.00,3.30,3.60,3.80,4.00, /4.50,5.00,5.50,6.00,7.00,8.00,10.0,12.0,15.0,17.0, /20.0,25.0,30.0,50.0,75.0,100.,200.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ C GROUND STATE AND BEND MODE ELASTIC + ROTATION. MOMENTUM TRANSFER C AT 293.15 KELVIN DATA YMOM/148.,148.,146.,141.,134.,128.,119.,109.,95.0,85.0, /76.5,69.5,59.0,52.5,47.5,41.0,36.0,30.0,22.0,16.2, /12.8,10.6,8.20,6.45,5.35,4.30,3.90,3.65,3.60,3.65, /3.75,3.85,4.00,4.20,4.60,4.90,5.30,5.80,6.00,6.00, /5.50,5.10,5.00,5.20,6.10,7.30,8.80,10.0,11.0,11.0, /10.8,10.2,9.50,6.50,4.25,3.15,1.16,0.42,0.23,0.12, /.046,.021,.0081,.0040,.001/ C GROUND STATE AND BEND MODE ELASTIC + ROTATION AT 293.15 KELVIN DATA YEL/148.,148.,146.,141.,135.,129.,120.,110.,96.0,86.0, /77.5,70.5,60.0,53.5,48.5,42.0,37.0,31.5,24.8,20.4, /17.4,15.5,13.0,10.7,9.20,7.50,6.30,5.30,4.65,4.46, /4.45,4.45,4.60,4.75,5.10,5.55,6.80,7.90,8.50,7.80, /6.25,6.15,6.60,7.05,8.10,9.50,11.5,13.1,13.3,13.7, /13.8,14.0,13.7,10.4,8.25,7.00,4.55,2.85,2.10,1.40, /0.80,0.44,0.20,.105,.018/ C ELASTIC FOR BEND MODE VIBRATIONS. MOMENTUM TRANSFER DATA YVBMOM/148.,148.,146.,141.,134.,128.,119.,109.,95.0,85.0, /76.5,69.5,59.0,53.5,50.0,46.5,45.5,45.0,43.0,37.0, /28.5,22.5,16.0,11.5,8.95,6.80,5.80,5.05,4.80,4.65, /4.65,4.70,4.80,5.00,5.35,5.65,6.00,6.20,6.20,6.10, /5.50,5.10,5.00,5.20,6.10,7.30,8.80,10.0,11.0,11.0, /10.8,10.2,9.50,6.50,4.25,3.15,1.16,0.42,0.23,0.12, /.046,.021,.0081,.0040,.001/ C ELASTIC FOR BEND MODE VIBRATIONS. DATA YVBEL/165.,165.,163.,158.,152.,146.,137.,127.,113.,103., /94.5,87.5,77.0,70.5,65.5,59.0,52.5,47.0,43.3,37.0, /28.5,24.0,19.0,16.2,14.2,12.5,11.4,9.50,8.10,7.66, /7.65,7.75,7.90,8.80,9.10,9.55,10.8,11.9,12.0,10.8, /9.25,8.15,7.60,7.55,8.10,9.50,11.5,13.1,13.3,13.7, /13.8,14.0,13.7,10.4,8.25,7.00,4.55,2.85,2.10,1.40, /0.80,0.44,0.20,.105,.018/ C C V(010) BEND MODE ( ANALYTICAL DIPOLE FUNCTION AT THRESHOLD) DATA XV2/.08275,2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00, /8.00,10.0,15.0,20.0,30.0,50.0,70.0,100.,1000.,10000., /100000./ DATA YV2/0.00,0.00,0.24,0.48,1.29,1.70,1.70,1.17,0.74,0.42, /0.01,0.08,0.05,0.08,0.12,0.07,.001,.0001,.00001,.000001, /.0000001/ C V(020) BEND MODE HARMONIC RESONANCE DATA X2V2/.15937,0.18,0.50,1.00,2.00,3.00,3.50,3.80,4.00,4.50, /5.00,6.00,8.00,10.0,15.0,20.0,30.0,50.0,70.0,100., /1000.,10000.,100000./ DATA Y2V2/0.00,0.02,0.01,.003,.025,0.09,0.31,0.44,0.56,0.49, /0.35,0.17,0.08,0.10,0.02,.008,.015,.008,.001,.0001, /.00001,.000001,.0000001/ C V(100) SYMMETRIC STRETCH DATA XV1/.17211,0.18,0.20,0.23,0.25,0.30,0.40,0.50,0.60,1.00, /2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00,8.00, /10.0,15.0,20.0,30.0,50.0,70.0,100.,1000.,10000.,100000./ DATA YV1/0.00,.475,.790,0.91,0.91,0.82,0.58,0.43,0.34,0.32, /0.38,0.66,0.89,1.27,1.32,1.04,0.53,0.18,.084,.075, /.077,.030,.009,.030,.008,.001,.0001,.00001,.000001,.0000001/ C V(030) + V(110) DATA X3V2/.251,2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA Y3V2/0.00,0.00,0.01,0.17,0.36,0.58,0.58,0.36,0.17,0.01, /.001,.0001,.00001,.000001,.0000001/ C V(001) ASYMMETRIC STRETCH (ANALYTICAL DIPOLE FUNCTION AT THRESHOLD) DATA XV3/.29126,2.00,3.00,3.50,3.80,4.00,4.50,5.00,6.00,8.00, /10.0,100.,1000.,10000.,100000./ DATA YV3/0.00,0.00,.002,.005,.010,.005,.002,.001,.001,.001, /.001,.0001,.00001,.000001,.0000001/ C V(040) + V(120) + V(200) POLYAD 3 DATA XVPD3/.335,0.35,0.50,0.80,2.00,2.50,3.00,3.50,3.80,4.00, /4.50,5.00,6.00,10.0,20.0,40.0,100.,1000.,10000.,100000./ DATA YVPD3/0.00,0.09,.035,0.02,0.02,0.02,0.21,0.43,0.70,0.70, /0.43,0.21,0.05,.020,0.01,.005,.0001,.00001,.000001,.0000001/ C V(130) + V(210) DATA XV130/0.422,2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00, /10.0,20.0,40.0,100.,1000.,10000.,100000./ DATA YV130/0.00,0.00,.005,0.10,0.22,0.35,0.35,0.22,0.10,.025, /.005,.002,.001,.0001,.00001,.000001,.0000001/ C POLYAD 4 DATA XVPD4/0.505,0.55,0.65,1.00,2.00,2.50,3.00,3.50,3.80,4.00, /4.50,5.00,6.00,10.0,100.,1000.,10000.,100000./ DATA YVPD4/0.00,.0017,.0005,.0001,.0001,.005,0.12,0.24,0.40,0.40, /0.24,0.13,0.01,.001,.0001,.00001,.000001,.0000001/ C POLYAD 5 DATA XVPD5/0.685,2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVPD5/0.00,0.00,.003,0.07,0.14,0.24,0.24,0.14,0.08,.006, /.001,.0001,.00001,.000001,.0000001/ C POLYAD 6 DATA XVPD6/0.825,2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVPD6/0.00,0.00,.001,0.05,0.10,0.16,0.16,0.10,0.05,.004, /.001,.0001,.00001,.000001,.0000001/ C POLYAD 7 DATA XVPD7/0.995,2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVPD7/0.00,0.00,.001,0.03,0.06,0.10,0.10,0.06,0.03,.003, /.001,.0001,.00001,.000001,.0000001/ C POLYAD 8 DATA XVPD8/1.160,2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVPD8/0.00,0.00,.001,0.03,0.06,0.10,0.10,0.06,0.03,.003, /.001,.0001,.00001,.000001,.0000001/ C POLYAD 9 DATA XVPD9/1.320,2.00,2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVPD9/0.00,0.00,.001,0.03,0.06,0.10,0.10,0.06,0.03,.003, /.001,.0001,.00001,.000001,.0000001/ C SUM HIGHER POLYADS DATA XVPDH/2.50,3.00,3.50,3.80,4.00,4.50,5.00,6.00,10.0,100., /1000.,10000.,100000./ DATA YVPDH/0.00,0.01,0.36,0.58,0.58,0.36,0.16,.045,.001,.0001, /.00001,.000001,.0000001/ C DATA FROM RAP AND BRIGLIA WITH CORRECTED ONSET DATA XATT/3.85,4.00,4.20,4.40,4.60,4.80,5.00,5.20,5.40,6.30, /6.60,6.90,7.20,7.40,7.60,7.80,8.00,8.20,8.40,8.60, /8.80,9.00,9.20,9.50,9.80,10.0,100.,1000.,100000./ DATA YATT/.0,.0005,.0014,.0014,.001,.0006,.0003,.0001,.0001,.0001, /.0001,.0002,.0008,.0018,.0027,.0036,.0042,.0041,.0034,.0020, /.0012,.0004,.0003,.0002,.0001,.0001,.00001,.000001,.0000001/ C DATA XEXC1/7.90,9.00,10.0,11.0,12.0,13.0,14.0,16.0,18.0,20.0, /25.0,30.0,35.0,40.0,50.0,60.0,80.0,100.,120.,150., /200.,250.,300.,400.,500.,600.,750.,1000.,1500.,2000., /2500.,3000.,4000.,6000.,8000.,10000.,20000.,40000.,60000.,100000./ DATA YEXC1/0.00,.007,.030,.069,.078,.069,.063,.060,.058,.057, /.053,.051,.049,.047,.046,.043,.038,.034,.031,.027, /.022,.019,.016,.013,.0110,.0095,.0079,.0062,.0044,.0034, /.0028,.0024,.0018,.0013,.00098,.00080,.00042,.00023,.00016,.00009/ C DATA XEXC2/8.90,9.50,10.0,11.0,12.0,13.0,14.0,16.0,18.0,20.0, /25.0,30.0,35.0,40.0,50.0,60.0,80.0,100.,120.,150., /200.,250.,300.,400.,500.,600.,750.,1000.,1500.,2000., /2500.,3000.,4000.,6000.,8000.,10000.,20000.,40000.,60000.,100000./ DATA YEXC2/0.00,.004,.009,.040,.065,.062,.060,.058,.057,.056, /.055,.054,.052,.050,.048,.046,.041,.037,.034,.029, /.024,.021,.018,.015,.0123,.0106,.0089,.0070,.0050,.0039, /.0032,.0027,.0021,.0015,.00116,.00095,.00046,.00027,.00019,.00012/ C DATA XEXC3/10.5,12.0,13.0,14.0,15.0,17.0,20.0,25.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,100.,120.,150.,200.,250., /300.,400.,500.,600.,750.,1000.,1500.,2000.,2500.,3000., /4000.,6000.,8000.,10000.,20000.,40000.,60000.,100000./ DATA YEXC3/0.00,0.56,0.43,0.34,0.31,0.30,0.30,0.31,0.32,0.33, /0.34,0.35,0.36,0.36,0.35,0.34,0.32,0.29,0.26,0.23, /.206,.171,.147,.129,.109,.088,.063,.049,.041,.035, /.027,.019,.0142,.0114,.0058,.0029,.0020,.0011/ C DATA XEXC4/12.2,13.0,14.0,15.0,16.0,17.0,20.0,25.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,100.,120.,150.,200.,250., /300.,400.,500.,600.,750.,1000.,1500.,2000.,2500.,3000., /4000.,6000.,8000.,10000.,20000.,40000.,60000.,100000./ DATA YEXC4/0.00,0.23,0.31,0.34,0.38,0.40,0.46,0.54,0.60,0.63, /0.65,0.67,0.68,0.67,0.66,0.63,0.60,0.54,0.47,0.41, /0.37,0.30,0.26,0.23,.186,.147,.104,.081,.066,.057, /.043,.030,.023,.0180,.0093,.0047,.0031,.00182/ C DATA XEXC5/13.2,14.0,15.0,16.0,17.0,18.0,20.0,25.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,100.,120.,150.,200.,250., /300.,400.,500.,600.,750.,1000.,1500.,2000.,2500.,3000., /4000.,6000.,8000.,10000.,20000.,40000.,60000.,100000./ DATA YEXC5/0.00,0.37,0.48,0.61,0.69,0.76,0.89,1.11,1.24,1.33, /1.39,1.45,1.48,1.49,1.48,1.45,1.37,1.27,1.11,1.00, /0.91,0.76,0.66,0.58,0.49,0.40,0.30,0.24,0.21,0.17, /0.13,.099,.077,.064,.036,.021,.014,.0094/ C DATA XEXC6/15.0,16.0,17.0,18.0,19.0,20.0,21.0,25.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,100.,120.,150.,200.,250., /300.,400.,500.,600.,750.,1000.,1500.,2000.,2500.,3000., /4000.,6000.,8000.,10000.,20000.,40000.,60000.,100000./ DATA YEXC6/0.0,.0005,.003,.006,.009,.013,.016,.025,.031,.034, /.037,.038,.039,.039,.038,.037,.035,.032,.028,.025, /.022,.019,.016,.014,.012,.010,.007,.006,.0049,.0043, /.0034,.0025,.0020,.0018,.00098,.0006,.0004,.00027/ C C DATA FROM RAPP, LINDSAY AND RIEKE ALSO BB THEORY DATA XION/13.773,14.5,15.0,15.5,16.0,16.5,17.0,17.5,18.0,18.5, /19.0,19.5,21.0,21.5,22.0,22.5,23.0,23.5,24.0,26.0, /28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0,50.0,55.0, /60.0,65.0,70.0,75.0,80.0,85.0,90.0,100.,110.,130., /140.,160.,180.,200.,250.,300.,400.,500.,600.,700., /800.,900.,1000.,1400.,2000.,3000.,4000.,5000.,6000.,7000., /8000.,10000.,14000.,20000.,30000.,40000.,60000.,100000./ DATA YION/0.00,.055,.097,.135,.174,.215,.255,.293,.333,.373, /.427,.452,.577,.623,.676,.727,.777,.828,.880,1.12, /1.34,1.51,1.65,1.78,1.89,1.99,2.11,2.37,2.59,2.76, /2.93,3.07,3.18,3.27,3.35,3.41,3.46,3.52,3.55,3.55, /3.52,3.44,3.36,3.26,3.02,2.81,2.42,2.10,1.86,1.69, /1.54,1.42,1.32,1.03,.795,.575,.454,.376,.322,.282, /.252,.208,.158,.115,.082,.063,.046,.032/ C --------------------------------------------------------------------- C --------------------------------------------------------------------- C NAME='CO2 (2004 iso.)' C --------------------------------------------------------------------- C---------------------------------------------------------------------- C TEMPERATURE DEPENDENCE OF VIBRATIONAL SCATTERING NOW INCLUDED USING C EXTRA ELASTIC X-SECTION FOR ELASTIC SCATTERING FROM VIBRATIONAL BEND C MODES.. CF: FERCH ET AL PHYS REV. A40 (1989) 5407 C REPRODUCES DRIFT DIFFUSION DATA OF: C ELFORD AND HADDAD AUST.J.PHYS. 33 (1980) 517 C HASEGAWA ET AL J.PHYS. D 29(1996) 2664 C NAKAMURA AUST.J.PHYS. 48 (1995) 357 C ZHAO ET AL NUCL.INSTR.METH. A340(1994) 485 C---------------------------------------------------------------------- C ISOTROPIC SCATTERING ONLY IN THIS VERSION C IMPROVED EXCITATION X-SECTIONS ALLOW EASIER CALCULATION OF PENNING C EFFECTS IN ARGON KRYPTON OR XENON MIXTURES. C --------------------------------------------------------------------- NIN=85 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NEL=65 NV2=21 N2V2=23 NV1=30 N3V2=15 NV3=15 NPD3=20 NV130=17 NPD4=18 NPD5=15 NPD6=15 NPD7=15 NPD8=15 NPD9=15 NPDH=13 NATT=29 NEXC1=40 NEXC2=40 NEXC3=38 NEXC4=38 NEXC5=38 NEXC6=38 NION=68 E(1)=0.0 E(2)=2.0*EMASS/(44.0095*AMU) E(3)=13.773 E(4)=3.85 E(5)=0.0 E(6)=0.0 C OPAL AND BEATY IONISATION ENERGY SPLITTING EOBY=13.773 C DIPOLE TRANSITION STRENGTH FOR VIBRATIONS V010 AND V001 AMPV2=0.1703 AMPV3=0.3922 C----------------------------------------------------------------------- C B0 IS ROTATIONAL CONSTANT C QBQA IS QUADRUPOLE MOMENT B0=4.838D-5 A0=0.5291772083D-8 QBQA=3.24 QBK=1.67552*(QBQA*A0)**2 C----------------------------------------------------------------------- C CALC FRACTIONAL POPULATION DENSITY OF ROTATIONAL STATES PJ(1)=1.0 DO 3 L=2,31 J=(2*L)-2 3 PJ(L)=(2*J+1)*EXP(-J*(J+1)*B0/AKT) SUM=0.0 DO 4 L=1,31 4 SUM=SUM+PJ(L) DO 5 L=1,31 5 PJ(L)=PJ(L)/SUM C---------------------------------------------------------------------- C CALC ROTATIONAL TRANSITION ENERGIES DO 7 K=1,59,2 EIN(K)=B0*(4*K+2) 7 EIN(K+1)=-EIN(K) EIN(61) = -0.08275 EIN(62) = 0.08275 EIN(63) = -0.15937 EIN(64) = 0.15937 EIN(65) = -0.17211 EIN(66) = 0.17211 EIN(67) = -0.251 EIN(68) = 0.251 EIN(69) = -0.29126 EIN(70) = 0.29126 EIN(71) = 0.335 EIN(72) = 0.422 EIN(73) = 0.505 EIN(74) = 0.685 EIN(75) = 0.825 EIN(76) = 0.995 EIN(77) = 1.160 EIN(78) = 1.320 EIN(79) = 2.500 EIN(80) = 7.90 EIN(81) = 8.90 EIN(82) = 10.5 EIN(83) = 12.2 EIN(84) = 13.2 EIN(85) = 15.0 C--------------------------------------------------- C DEGENERACY OF VIBRATIONAL STATES DEGV1=1.0 DEGV2=2.0 DEGV3=1.0 DEG2V2=3.0 C 3V2 === SUM (3V2 + V12) = 4+2 DEG3V2=6.0 C---------------------------------------------------- C CALC POPULATION OF VIBRATIONAL STATES SUM=0.0 APOPV2=DEGV2*EXP(EIN(61)/AKT) APOP2V2=DEG2V2*EXP(EIN(63)/AKT) APOPV1=DEGV1*EXP(EIN(65)/AKT) APOP3V2=DEG3V2*EXP(EIN(67)/AKT) APOPV3=DEGV3*EXP(EIN(69)/AKT) SUM=1.0+APOPV2+APOP2V2+APOPV1+APOP3V2+APOPV3 APOPGS=1.0/SUM APOPV2=APOPV2/SUM APOP2V2=APOP2V2/SUM APOPV1=APOPV1/SUM APOP3V2=APOP3V2/SUM APOPV3=APOPV3/SUM APBEND=APOPV2+APOP2V2+APOP3V2 C C RENORMALISE VIBRATIONAL GROUND STATE POPULATION IN ORDER TO ACCOUNT C FOR EXCITATION FROM VIBRATIONALLY EXCITED STATES APOPGS=1.0 C BEND MODE AND EFFECTIVE GROUND STATE POPULATION AT 293.15 KELVIN AEXT20=7.51373753D-2 AGST20=1.0-AEXT20 C------------------------------------------------------ SCRPT(1)=' ' SCRPT(2)=' ELASTIC ISOTROPIC CO2 ' SCRPT(3)=' IONISATION ELOSS= 13.773 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 0-2 ELOSS= 0.00029' SCRPT(8)=' ROT 2-0 ELOSS= -0.00029' SCRPT(9)=' ROT 2-4 ELOSS= 0.00068' SCRPT(10)=' ROT 4-2 ELOSS= -0.00068' SCRPT(11)=' ROT 4-6 ELOSS= 0.00106' SCRPT(12)=' ROT 6-4 ELOSS= -0.00106' SCRPT(13)=' ROT 6-8 ELOSS= 0.00145' SCRPT(14)=' ROT 8-6 ELOSS= -0.00145' SCRPT(15)=' ROT 8-10 ELOSS= 0.00184' SCRPT(16)=' ROT 10-8 ELOSS= -0.00184' SCRPT(17)=' ROT 10-12 ELOSS= 0.00223' SCRPT(18)=' ROT 12-10 ELOSS= -0.00223' SCRPT(19)=' ROT 12-14 ELOSS= 0.00261' SCRPT(20)=' ROT 14-12 ELOSS= -0.00261' SCRPT(21)=' ROT 14-16 ELOSS= 0.00300' SCRPT(22)=' ROT 16-14 ELOSS= -0.00300' SCRPT(23)=' ROT 16-18 ELOSS= 0.00339' SCRPT(24)=' ROT 18-16 ELOSS= -0.00339' SCRPT(25)=' ROT 18-20 ELOSS= 0.00377' SCRPT(26)=' ROT 20-18 ELOSS= -0.00377' SCRPT(27)=' ROT 20-22 ELOSS= 0.00416' SCRPT(28)=' ROT 22-20 ELOSS= -0.00416' SCRPT(29)=' ROT 22-24 ELOSS= 0.00455' SCRPT(30)=' ROT 24-22 ELOSS= -0.00455' SCRPT(31)=' ROT 24-26 ELOSS= 0.00493' SCRPT(32)=' ROT 26-24 ELOSS= -0.00493' SCRPT(33)=' ROT 26-28 ELOSS= 0.00532' SCRPT(34)=' ROT 28-26 ELOSS= -0.00532' SCRPT(35)=' ROT 28-30 ELOSS= 0.00571' SCRPT(36)=' ROT 30-28 ELOSS= -0.00571' SCRPT(37)=' ROT 30-32 ELOSS= 0.00610' SCRPT(38)=' ROT 32-30 ELOSS= -0.00610' SCRPT(39)=' ROT 32-34 ELOSS= 0.00648' SCRPT(40)=' ROT 34-32 ELOSS= -0.00648' SCRPT(41)=' ROT 34-36 ELOSS= 0.00687' SCRPT(42)=' ROT 36-34 ELOSS= -0.00687' SCRPT(43)=' ROT 36-38 ELOSS= 0.00726' SCRPT(44)=' ROT 38-36 ELOSS= -0.00726' SCRPT(45)=' ROT 38-40 ELOSS= 0.00764' SCRPT(46)=' ROT 40-38 ELOSS= -0.00764' SCRPT(47)=' ROT 40-42 ELOSS= 0.00803' SCRPT(48)=' ROT 42-40 ELOSS= -0.00803' SCRPT(49)=' ROT 42-44 ELOSS= 0.00842' SCRPT(50)=' ROT 44-42 ELOSS= -0.00842' SCRPT(51)=' ROT 44-46 ELOSS= 0.00881' SCRPT(52)=' ROT 46-44 ELOSS= -0.00881' SCRPT(53)=' ROT 46-48 ELOSS= 0.00919' SCRPT(54)=' ROT 48-46 ELOSS= -0.00919' SCRPT(55)=' ROT 48-50 ELOSS= 0.00958' SCRPT(56)=' ROT 50-48 ELOSS= -0.00958' SCRPT(57)=' ROT 50-52 ELOSS= 0.00997' SCRPT(58)=' ROT 52-50 ELOSS= -0.00997' SCRPT(59)=' ROT 52-54 ELOSS= 0.01035' SCRPT(60)=' ROT 54-52 ELOSS= -0.01035' SCRPT(61)=' ROT 54-56 ELOSS= 0.01074' SCRPT(62)=' ROT 56-54 ELOSS= -0.01074' SCRPT(63)=' ROT 56-58 ELOSS= 0.01113' SCRPT(64)=' ROT 58-56 ELOSS= -0.01113' SCRPT(65)=' ROT 58-60 ELOSS= 0.01151' SCRPT(66)=' ROT 60-58 ELOSS= -0.01151' SCRPT(67)=' V (010) ELOSS= -0.08275' SCRPT(68)=' V (010) ELOSS= 0.08275' SCRPT(69)=' V (020) ELOSS= -0.15937' SCRPT(70)=' V (020) ELOSS= 0.15937' SCRPT(71)=' V (100) ELOSS= -0.17211' SCRPT(72)=' V (100) ELOSS= 0.17211' SCRPT(73)=' V (030)+(110) ELOSS= -0.251 ' SCRPT(74)=' V (030)+(110) ELOSS= 0.251 ' SCRPT(75)=' V (001) ELOSS= -0.29126' SCRPT(76)=' V (001) ELOSS= 0.29126' SCRPT(77)=' V POLYAD 3 ELOSS= 0.335 ' SCRPT(78)=' V (130)+(210) ELOSS= 0.422 ' SCRPT(79)=' V POLYAD 4 ELOSS= 0.505 ' SCRPT(80)=' V POLYAD 5 ELOSS= 0.685 ' SCRPT(81)=' V POLYAD 6 ELOSS= 0.825 ' SCRPT(82)=' V POLYAD 7 ELOSS= 0.995 ' SCRPT(83)=' V POLYAD 8 ELOSS= 1.160 ' SCRPT(84)=' V POLYAD 9 ELOSS= 1.320 ' SCRPT(85)=' V POLYAD SUM ELOSS= 2.500 ' SCRPT(86)=' EXC ELOSS= 7.900 ' SCRPT(87)=' EXC ELOSS= 8.900 ' SCRPT(88)=' EXC ELOSS= 10.500 ' SCRPT(89)=' EXC ELOSS= 12.200 ' SCRPT(90)=' EXC ELOSS= 13.200 ' SCRPT(91)=' EXC ELOSS= 15.000 ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP C ELASTIC USE LOG INTERPOLATION IF(EN.LE.XEN(1)) THEN QMOM=YMOM(1)*1.D-16 QELA=YEL(1)*1.D-16 QBMOM=QMOM QBELA=QELA GO TO 20 ENDIF DO 10 J=2,NEL IF(EN.LE.XEN(J)) GO TO 15 10 CONTINUE J=NEL 15 YXJ=LOG(YMOM(J)) YXJ1=LOG(YMOM(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=EXP(A*LOG(EN)+B)*1.D-16 YXJ=LOG(YEL(J)) YXJ1=LOG(YEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=EXP(A*LOG(EN)+B)*1.D-16 YXJ=LOG(YVBMOM(J)) YXJ1=LOG(YVBMOM(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QBMOM=EXP(A*LOG(EN)+B)*1.D-16 YXJ=LOG(YVBEL(J)) YXJ1=LOG(YVBEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QBELA=EXP(A*LOG(EN)+B)*1.D-16 20 CONTINUE C CALC CHANGE IN ELASTIC CROSS SECTION DUE TO CHANGE IN ELASTIC C SCATTERING FROM BEND MODES ( CHANGE RELATIVE TO X-SECTION AT 293.15K) C BEND MODE POPULATION AT 293.15K == AEXT20,GROUND STATE POP. == AGST20 C QMOM=(1.0-APBEND)*(QMOM-AEXT20*QBMOM)/AGST20+APBEND*QBMOM QELA=(1.0-APBEND)*(QELA-AEXT20*QBELA)/AGST20+APBEND*QBELA C ISOTROPIC Q(2,I)=QMOM PEQEL(2,I)=0.5D0 C C ANISOTROPIC C Q(2,I)=QELA C PEQEL(2,I)=0.5+(QELA-QMOM)/QELA C C IONISATION Q(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 40 DO 25 J=2,NION IF(EN.LE.XION(J)) GO TO 30 25 CONTINUE J=NION 30 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=1.0D-16*(A*EN+B) C ATTACHMENT 40 Q(4,I)=0.0D0 IF(EN.LE.E(4)) GO TO 50 DO 45 J=2,NATT IF(EN.LE.XATT(J)) GO TO 46 45 CONTINUE J=NATT 46 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=1.0D-16*(A*EN+B) C 50 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C ---------------------------------------------------------------------- C QUADRUPOLE BORN ROTATIONAL STATES (GERJUOY AND STEIN) C ---------------------------------------------------------------------- C SUPERELASTIC ROTATION DO 51 K=2,60,2 AJ=DBLE(K) L=(K/2)+1 51 QIN(K,I)=PJ(L)*QBK*SQRT(1.0-EIN(K)/EN)*AJ*(AJ-1.0)/((2.0*AJ+1.0)* /(2.0*AJ-1.0)) C ROTATION DO 52 K=1,59,2 QIN(K,I)=0.0D0 IF(EN.LE.EIN(K)) GO TO 52 AJ=DBLE(K-1) L=(K+1)/2 QIN(K,I)=PJ(L)*QBK*SQRT(1.0-EIN(K)/EN)*(AJ+2.0)*(AJ+1.0)/((2.0*AJ /+3.0)*(2.0*AJ+1.0)) 52 CONTINUE C BORN (1/E) FALL OFF IN ROTATONAL X-SEC ABOVE 6.0 EV IF(EN.LT.6.0) GO TO 80 DO 70 K=1,60 70 QIN(K,I)=QIN(K,I)*6.0/EN 80 CONTINUE C C SUPERELASTIC V2 BEND MODE QIN(61,I)=0.0D0 IF(EN.LE.0.0) GO TO 150 EFAC=SQRT(1.0-(EIN(61)/EN)) QIN(61,I)=AMPV2*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 110 J=2,NV2 IF((EN+EIN(62)).LE.XV2(J)) GOTO 120 110 CONTINUE J=NV2 120 A=(YV2(J)-YV2(J-1))/(XV2(J)-XV2(J-1)) B=(XV2(J-1)*YV2(J)-XV2(J)*YV2(J-1))/(XV2(J-1)-XV2(J)) QIN(61,I)=QIN(61,I)+(EN+EIN(62))*(A*(EN+EIN(62))+B)/EN QIN(61,I)=QIN(61,I)*APOPV2/DEGV2*1.D-16 C V2 BEND MODE 150 QIN(62,I)=0.0D0 IF(EN.LE.EIN(62)) GO TO 200 EFAC=SQRT(1.0-(EIN(62)/EN)) QIN(62,I)=AMPV2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 160 J=2,NV2 IF(EN.LE.XV2(J)) GO TO 170 160 CONTINUE J=NV2 170 A=(YV2(J)-YV2(J-1))/(XV2(J)-XV2(J-1)) B=(XV2(J-1)*YV2(J)-XV2(J)*YV2(J-1))/(XV2(J-1)-XV2(J)) QIN(62,I)=QIN(62,I)+(A*EN+B) QIN(62,I)=QIN(62,I)*APOPGS*1.D-16 C C SUPERELASTIC 2V2 BEND MODE HARMONIC 200 CONTINUE QIN(63,I)=0.0D0 IF(EN.LE.0.0) GO TO 250 DO 210 J=2,N2V2 IF((EN+EIN(64)).LE.X2V2(J)) GOTO 220 210 CONTINUE J=N2V2 220 A=(Y2V2(J)-Y2V2(J-1))/(X2V2(J)-X2V2(J-1)) B=(X2V2(J-1)*Y2V2(J)-X2V2(J)*Y2V2(J-1))/(X2V2(J-1)-X2V2(J)) QIN(63,I)=(EN+EIN(64))*(A*(EN+EIN(64))+B)/EN QIN(63,I)=QIN(63,I)*APOP2V2/DEG2V2*1.D-16 C 2V2 BEND MODE HARMONIC 250 CONTINUE QIN(64,I)=0.0D0 IF(EN.LE.EIN(64)) GO TO 300 DO 260 J=2,N2V2 IF(EN.LE.X2V2(J)) GOTO 270 260 CONTINUE J=N2V2 270 A=(Y2V2(J)-Y2V2(J-1))/(X2V2(J)-X2V2(J-1)) B=(X2V2(J-1)*Y2V2(J)-X2V2(J)*Y2V2(J-1))/(X2V2(J-1)-X2V2(J)) QIN(64,I)=(A*EN+B)*APOPGS*1.D-16 C C SUPERELASTIC V1 SYMMETRIC STRETCH 300 CONTINUE QIN(65,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 DO 310 J=2,NV1 IF((EN+EIN(66)).LE.XV1(J)) GOTO 320 310 CONTINUE J=NV1 320 A=(YV1(J)-YV1(J-1))/(XV1(J)-XV1(J-1)) B=(XV1(J-1)*YV1(J)-XV1(J)*YV1(J-1))/(XV1(J-1)-XV1(J)) QIN(65,I)=(EN+EIN(66))*(A*(EN+EIN(66))+B)/EN QIN(65,I)=QIN(65,I)*APOPV1/DEGV1*1.D-16 C V1 SYMMETRIC STRETCH 350 CONTINUE QIN(66,I)=0.0D0 IF(EN.LE.EIN(66)) GO TO 400 DO 360 J=2,NV1 IF(EN.LE.XV1(J)) GOTO 370 360 CONTINUE J=NV1 370 A=(YV1(J)-YV1(J-1))/(XV1(J)-XV1(J-1)) B=(XV1(J-1)*YV1(J)-XV1(J)*YV1(J-1))/(XV1(J-1)-XV1(J)) QIN(66,I)=(A*EN+B)*APOPGS*1.D-16 C C SUPERELASTIC 3V2 + V12 400 CONTINUE QIN(67,I)=0.0D0 IF(EN.LE.0.0) GO TO 450 DO 410 J=2,N3V2 IF((EN+EIN(68)).LE.X3V2(J)) GOTO 420 410 CONTINUE J=N3V2 420 A=(Y3V2(J)-Y3V2(J-1))/(X3V2(J)-X3V2(J-1)) B=(X3V2(J-1)*Y3V2(J)-X3V2(J)*Y3V2(J-1))/(X3V2(J-1)-X3V2(J)) QIN(67,I)=(EN+EIN(68))*(A*(EN+EIN(68))+B)/EN QIN(67,I)=QIN(67,I)*APOP3V2/DEG3V2*1.D-16 C 3V2 + V12 450 CONTINUE QIN(68,I)=0.0D0 IF(EN.LE.EIN(68)) GO TO 500 DO 460 J=2,N3V2 IF(EN.LE.X3V2(J)) GOTO 470 460 CONTINUE J=N3V2 470 A=(Y3V2(J)-Y3V2(J-1))/(X3V2(J)-X3V2(J-1)) B=(X3V2(J-1)*Y3V2(J)-X3V2(J)*Y3V2(J-1))/(X3V2(J-1)-X3V2(J)) QIN(68,I)=(A*EN+B)*APOPGS*1.D-16 C C SUPERELASTIC V3 ASYMMETRIC STRETCH 500 QIN(69,I)=0.0D0 IF(EN.LE.0.0) GO TO 550 EFAC=SQRT(1.0-(EIN(69)/EN)) QIN(69,I)=AMPV3*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 510 J=2,NV3 IF((EN+EIN(70)).LE.XV3(J)) GOTO 520 510 CONTINUE J=NV3 520 A=(YV3(J)-YV3(J-1))/(XV3(J)-XV3(J-1)) B=(XV3(J-1)*YV3(J)-XV3(J)*YV3(J-1))/(XV3(J-1)-XV3(J)) QIN(69,I)=QIN(69,I)+(EN+EIN(70))*(A*(EN+EIN(70))+B)/EN QIN(69,I)=QIN(69,I)*APOPV3/DEGV3*1.D-16 C V3 ASYMMETRIC STRETCH 550 QIN(70,I)=0.0D0 IF(EN.LE.EIN(70)) GO TO 600 EFAC=SQRT(1.0-(EIN(70)/EN)) QIN(70,I)=AMPV3*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 560 J=2,NV3 IF(EN.LE.XV3(J)) GO TO 570 560 CONTINUE J=NV3 570 A=(YV3(J)-YV3(J-1))/(XV3(J)-XV3(J-1)) B=(XV3(J-1)*YV3(J)-XV3(J)*YV3(J-1))/(XV3(J-1)-XV3(J)) QIN(70,I)=QIN(70,I)+(A*EN+B) QIN(70,I)=QIN(70,I)*APOPGS*1.D-16 C C 4V2 + 2V1 + V12V2 POLYAD 3 600 CONTINUE QIN(71,I)=0.0D0 IF(EN.LE.EIN(71)) GO TO 650 DO 610 J=2,NPD3 IF(EN.LE.XVPD3(J)) GOTO 620 610 CONTINUE J=NPD3 620 A=(YVPD3(J)-YVPD3(J-1))/(XVPD3(J)-XVPD3(J-1)) B=(XVPD3(J-1)*YVPD3(J)-XVPD3(J)*YVPD3(J-1))/(XVPD3(J-1)-XVPD3(J)) QIN(71,I)=(A*EN+B)*1.D-16 C C 3V2V1 + 2V1V2 650 CONTINUE QIN(72,I)=0.0D0 IF(EN.LE.EIN(72)) GO TO 700 DO 660 J=2,NV130 IF(EN.LE.XV130(J)) GOTO 670 660 CONTINUE J=NV130 670 A=(YV130(J)-YV130(J-1))/(XV130(J)-XV130(J-1)) B=(XV130(J-1)*YV130(J)-XV130(J)*YV130(J-1))/(XV130(J-1)-XV130(J)) QIN(72,I)=(A*EN+B)*1.D-16 C C POLYAD 4 700 CONTINUE QIN(73,I)=0.0D0 IF(EN.LE.EIN(73)) GO TO 750 DO 710 J=2,NPD4 IF(EN.LE.XVPD4(J)) GOTO 720 710 CONTINUE J=NPD4 720 A=(YVPD4(J)-YVPD4(J-1))/(XVPD4(J)-XVPD4(J-1)) B=(XVPD4(J-1)*YVPD4(J)-XVPD4(J)*YVPD4(J-1))/(XVPD4(J-1)-XVPD4(J)) QIN(73,I)=(A*EN+B)*1.D-16 C C PLOYAD 5 750 CONTINUE QIN(74,I)=0.0D0 IF(EN.LE.EIN(74)) GO TO 800 DO 760 J=2,NPD5 IF(EN.LE.XVPD5(J)) GOTO 770 760 CONTINUE J=NPD5 770 A=(YVPD5(J)-YVPD5(J-1))/(XVPD5(J)-XVPD5(J-1)) B=(XVPD5(J-1)*YVPD5(J)-XVPD5(J)*YVPD5(J-1))/(XVPD5(J-1)-XVPD5(J)) QIN(74,I)=(A*EN+B)*1.D-16 C C POLYAD 6 800 CONTINUE QIN(75,I)=0.0D0 IF(EN.LE.EIN(75)) GO TO 850 DO 810 J=2,NPD6 IF(EN.LE.XVPD6(J)) GOTO 820 810 CONTINUE J=NPD6 820 A=(YVPD6(J)-YVPD6(J-1))/(XVPD6(J)-XVPD6(J-1)) B=(XVPD6(J-1)*YVPD6(J)-XVPD6(J)*YVPD6(J-1))/(XVPD6(J-1)-XVPD6(J)) QIN(75,I)=(A*EN+B)*1.D-16 C C POLYAD 7 850 CONTINUE QIN(76,I)=0.0D0 IF(EN.LE.EIN(76)) GO TO 900 DO 860 J=2,NPD7 IF(EN.LE.XVPD7(J)) GOTO 870 860 CONTINUE J=NPD7 870 A=(YVPD7(J)-YVPD7(J-1))/(XVPD7(J)-XVPD7(J-1)) B=(XVPD7(J-1)*YVPD7(J)-XVPD7(J)*YVPD7(J-1))/(XVPD7(J-1)-XVPD7(J)) QIN(76,I)=(A*EN+B)*1.D-16 C C POLYAD 8 900 CONTINUE QIN(77,I)=0.0D0 IF(EN.LE.EIN(77)) GO TO 950 DO 910 J=2,NPD8 IF(EN.LE.XVPD8(J)) GOTO 920 910 CONTINUE J=NPD8 920 A=(YVPD8(J)-YVPD8(J-1))/(XVPD8(J)-XVPD8(J-1)) B=(XVPD8(J-1)*YVPD8(J)-XVPD8(J)*YVPD8(J-1))/(XVPD8(J-1)-XVPD8(J)) QIN(77,I)=(A*EN+B)*1.D-16 C C POLYAD 9 950 CONTINUE QIN(78,I)=0.0D0 IF(EN.LE.EIN(78)) GO TO 1000 DO 960 J=2,NPD9 IF(EN.LE.XVPD9(J)) GOTO 970 960 CONTINUE J=NPD9 970 A=(YVPD9(J)-YVPD9(J-1))/(XVPD9(J)-XVPD9(J-1)) B=(XVPD9(J-1)*YVPD9(J)-XVPD9(J)*YVPD9(J-1))/(XVPD9(J-1)-XVPD9(J)) QIN(78,I)=(A*EN+B)*1.D-16 C C SUM OF HIGHER POLYADS 1000 CONTINUE QIN(79,I)=0.0D0 IF(EN.LE.EIN(79)) GO TO 1050 DO 1010 J=2,NPDH IF(EN.LE.XVPDH(J)) GOTO 1020 1010 CONTINUE J=NPDH 1020 A=(YVPDH(J)-YVPDH(J-1))/(XVPDH(J)-XVPDH(J-1)) B=(XVPDH(J-1)*YVPDH(J)-XVPDH(J)*YVPDH(J-1))/(XVPDH(J-1)-XVPDH(J)) QIN(79,I)=(A*EN+B)*1.D-16 C 1050 CONTINUE QIN(80,I)=0.0D0 IF(EN.LE.EIN(80)) GO TO 1100 DO 1060 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 1070 1060 CONTINUE J=NEXC1 1070 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(80,I)=(A*EN+B)*1.D-16 1100 CONTINUE QIN(81,I)=0.0D0 IF(EN.LE.EIN(81)) GO TO 1150 DO 1110 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 1120 1110 CONTINUE J=NEXC2 1120 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(81,I)=(A*EN+B)*1.D-16 C 1150 CONTINUE QIN(82,I)=0.0D0 IF(EN.LE.EIN(82)) GO TO 1200 DO 1160 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 1170 1160 CONTINUE J=NEXC3 1170 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(82,I)=(A*EN+B)*1.D-16 C 1200 CONTINUE QIN(83,I)=0.0D0 IF(EN.LE.EIN(83)) GO TO 1250 DO 1210 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GOTO 1220 1210 CONTINUE J=NEXC4 1220 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(83,I)=(A*EN+B)*1.D-16 C 1250 CONTINUE QIN(84,I)=0.0D0 IF(EN.LE.EIN(84)) GO TO 1300 DO 1260 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GOTO 1270 1260 CONTINUE J=NEXC5 1270 A=(YEXC5(J)-YEXC5(J-1))/(XEXC5(J)-XEXC5(J-1)) B=(XEXC5(J-1)*YEXC5(J)-XEXC5(J)*YEXC5(J-1))/(XEXC5(J-1)-XEXC5(J)) QIN(84,I)=(A*EN+B)*1.D-16 C 1300 CONTINUE QIN(85,I)=0.0D0 IF(EN.LE.EIN(85)) GO TO 1400 DO 1310 J=2,NEXC6 IF(EN.LE.XEXC6(J)) GOTO 1320 1310 CONTINUE J=NEXC6 1320 A=(YEXC6(J)-YEXC6(J-1))/(XEXC6(J)-XEXC6(J-1)) B=(XEXC6(J-1)*YEXC6(J)-XEXC6(J)*YEXC6(J-1))/(XEXC6(J-1)-XEXC6(J)) QIN(85,I)=(A*EN+B)*1.D-16 C 1400 CONTINUE C SUM ROTATION SUMR=0.0 DO 1450 K=1,60 SUMR=SUMR+QIN(K,I) 1450 CONTINUE C SUM VIBRATION SUMV=0.0 DO 1455 K=61,79 SUMV=SUMV+QIN(K,I) 1455 CONTINUE C SUM EXCITATION SUME=0.0 DO 1460 K=80,85 SUME=SUME+QIN(K,I) 1460 CONTINUE C GET CORRECT ELASTIC X-SECTION Q(2,I)=Q(2,I)-SUMR C Q(1,I) TOTAL USED FOR INFORMATION ONLY Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+SUMR+SUMV+SUME 9000 CONTINUE C C SAVE ON COMPUTING TIME C DO 2000 K=1,15 J=86-K IF(EFINAL.LE.EIN(J)) NIN=J-1 2000 CONTINUE C END +DECK,GAS13. SUBROUTINE GAS13(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(62),YXSEC(62),XION(46),YION(46),XATT(16),YATT(16), /XVIB1(34),YVIB1(34),XVIB2(28),YVIB2(28),XVIB3(28),YVIB3(28), /XVIB4(25),YVIB4(25),XVIB5(19),YVIB5(19),XEXC1(25),YEXC1(25), /XEXC2(23),YEXC2(23),XEXC3(19),YEXC3(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.001,.002,.003,.004,.005,.007,0.01,0.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.23,0.26,0.30,0.35,0.40, /0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0,70.0,100., /140.,200.,250.,300.,500.,1000.,1500.,3000.,6000.,10000., /20000.,100000./ DATA YXSEC/94.0,93.5,93.0,92.5,92.0,91.5,91.0,90.0,88.0,85.0, /74.0,63.0,53.0,45.0,39.0,33.5,29.0,25.0,21.0,17.0, /13.5,10.8,6.50,4.50,3.60,3.30,3.40,4.20,6.00,7.80, /12.5,16.7,21.8,25.0,27.5,30.0,34.0,37.0,40.0,43.0, /44.0,44.0,42.0,39.0,28.0,22.0,15.0,11.5,6.80,4.90, /2.90,1.78,1.28,1.06,0.60,0.26,0.17,0.08,.034,.021, /.0085,.0017/ DATA XION/10.35,11.0,12.5,13.5,14.5,17.0,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.33,0.75,1.22,1.82,3.69,5.29,8.33,10.3,11.8, /12.8,13.7,14.8,15.6,16.1,16.4,16.4,16.4,15.9,15.0, /14.1,13.4,12.4,10.9,9.99,9.24,8.41,7.88,6.92,6.38, /5.87,5.23,4.88,4.22,3.63,3.30,3.00,2.60,2.23,1.48, /1.11,0.81,0.58,0.31,.167,.106/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,1.41,2.36,3.57,6.03,9.50,14.3,22.3,31.6,26.6, /20.9,13.4,7.55,2.83,1.07,0.00/ DATA XVIB1/.052,.055,.060,.065,.070,.075,0.08,0.10,0.12,0.14, /0.20,0.25,0.30,0.40,0.50,0.70,1.00,1.50,2.00,3.00, /4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0, /100.,1000.,10000.,100000./ DATA YVIB1/0.00,.017,.026,.030,.032,.033,.034,.034,.033,.031, /.026,.022,.020,.017,.015,.011,.010,.015,.018,.030, /.044,.058,.074,.097,.097,.080,.055,.031,.017,.010, /.003,.0003,.00003,.00003/ DATA XVIB2/.108,.125,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.33,0.64,0.87,0.90,0.90,0.81,0.69,0.60,0.50, /0.39,0.39,0.48,0.77,1.14,1.50,1.93,2.53,2.53,2.08, /1.44,0.81,0.43,0.27,0.06,.006,.0006,.00006/ DATA XVIB3/.173,0.18,0.19,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.16,0.33,0.47,0.60,0.65,0.69,0.65,0.60,0.52, /0.42,0.38,0.41,0.59,0.89,1.16,1.49,1.96,1.96,1.60, /1.11,0.63,0.33,0.21,0.05,.005,.0005,.00005/ DATA XVIB4/.363,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.58,0.77,0.86,0.91,0.91,0.86,0.81,0.77,0.85, /1.23,1.76,2.29,2.95,3.26,2.82,2.08,1.19,0.53,0.30, /0.17,0.04,.004,.0004,.00004/ DATA XVIB5/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.001,0.01,.041,.105,0.20,0.25,0.33,0.37,0.31, /.237,.138,.058,.033,.021,.004,.0004,.00004,.000004/ DATA XEXC1/7.20,8.50,9.50,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,1.60,2.32,2.48,2.56,2.64,2.64,2.64,2.64,2.64, /2.72,2.72,2.64,2.48,2.08,1.92,1.60,1.50,1.28,0.84, /0.41,0.21,0.07,.042,.009/ DATA XEXC2/9.50,10.5,11.5,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.23,0.49,0.92,1.43,1.92,2.24,2.44, /2.65,2.72,2.65,2.48,2.08,1.92,1.60,1.50,1.28,0.84, /0.39,0.21,0.07,.042,.007/ DATA XEXC3/17.0,20.0,25.0,30.0,40.0,60.0,80.0,100.,150.,200., /300.,400.,600.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.53,1.16,1.60,2.24,2.64,2.64,2.48,2.08,1.92, /1.60,1.50,1.28,0.84,0.41,0.21,0.09,.042,.007/ C ---------------------------------------------------------------------- C NO DIFFUSION EXPERIMENTAL DATA AVAILABLE,USED INELASTICS FROM SCALING C ISOBUTANE INELASTIC X-SECT. ELASTIC DETERMINED FROM DRIFT VELOCITY. C HENCE DIFFUSION ACCURATE TO ONLY 10% , DRIFT VELOCITY TO 3% BELOW C 10KV/CM. C MODIFICATION OF NEO-PENTANE (1995) TO INCLUDE SUPERELASTIC SCATTERING C FIT TO DRIFT VELOCITY OF FLORIANO GEE AND FREEMAN C ---------------------------------------------------------------------- NAME='neoC5H12 (2003)' C NIN=11 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=62 NION=46 NATT=16 NVIB1=34 NVIB2=28 NVIB3=28 NVIB4=25 NVIB5=19 NEXC1=25 NEXC2=23 NEXC3=19 E(1)=0.0 E(2)=2.0*EMASS/(72.1503*AMU) E(3)=10.35 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.35 EIN(1)=-.052 EIN(2)=0.052 EIN(3)=-.108 EIN(4)=0.108 EIN(5)=-.173 EIN(6)=0.173 EIN(7)=0.363 EIN(8)=0.519 EIN(9)=7.2 EIN(10)=9.50 EIN(11)=17.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC NEO-PENTANE ' SCRPT(3)=' IONISATION ELOSS= 10.35 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= -0.052 ' SCRPT(8)=' VIB ELOSS= 0.052 ' SCRPT(9)=' VIB ELOSS= -0.108 ' SCRPT(10)=' VIB ELOSS= 0.108 ' SCRPT(11)=' VIB ELOSS= -0.173 ' SCRPT(12)=' VIB ELOSS= 0.173 ' SCRPT(13)=' VIB ELOSS= 0.363 ' SCRPT(14)=' VIB ELOSS= 0.519 ' SCRPT(15)=' EXC ELOSS= 7.20 ' SCRPT(16)=' EXC ELOSS= 9.50 ' SCRPT(17)=' EXC ELOSS= 17.0 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(3)/AKT) APOP3=EXP(EIN(5)/AKT) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 21 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 21 CONTINUE Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 30 DO 22 J=2,NION IF(EN.LE.XION(J)) GO TO 23 22 CONTINUE J=NION 23 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 30 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 40 IF(EN.GT.XATT(NATT)) GO TO 40 DO 31 J=2,NATT IF(EN.LE.XATT(J)) GO TO 32 31 CONTINUE J=NATT 32 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 40 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC VIB1 QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 150 DO 110 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 120 110 CONTINUE J=NVIB1 120 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C VIB1 150 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 200 DO 160 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 170 160 CONTINUE J=NVIB1 170 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)/(1.0+APOP1)*1.D-16 200 CONTINUE C C SUPERELASTIC VIB2 QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 250 DO 210 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 220 210 CONTINUE J=NVIB2 220 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C VIB2 250 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 300 DO 260 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 270 260 CONTINUE J=NVIB2 270 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B)/(1.0+APOP2)*1.D-16 300 CONTINUE C C SUPERELASTIC VIB3 QIN(5,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 DO 310 J=2,NVIB3 IF((EN+EIN(6)).LE.XVIB3(J)) GO TO 320 310 CONTINUE J=NVIB3 320 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(5,I)=QIN(5,I)*APOP3/(1.0+APOP3)*1.D-16 C VIB3 350 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 400 DO 360 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 370 360 CONTINUE J=NVIB3 370 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(6,I)=(A*EN+B)/(1.0+APOP3)*1.D-16 400 CONTINUE C VIB4 QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 500 DO 410 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 420 410 CONTINUE J=NVIB4 420 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(7,I)=(A*EN+B)*1.D-16 500 CONTINUE C VIB5 QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 600 DO 510 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 520 510 CONTINUE J=NVIB5 520 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(8,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC1 QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(9,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC2 QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(10,I)=(A*EN+B)*1.D-16 800 CONTINUE C EXC3 QIN(11,I)=0.0D0 IF(EN.LE.EIN(11)) GO TO 900 DO 810 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 820 810 CONTINUE J=NEXC3 820 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(11,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 END +DECK,GAS14. SUBROUTINE GAS14(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION ELEV(100),AJL(100),PJ(100) DIMENSION SALPHA(105),EROT(105),AJIN(210),IMAP(210) DIMENSION XEL(24),YEL(24),XVIB1(26),YVIB1(26),XVIB2(27),YVIB2(27), /XION(46),YION(46),XATT(20),YATT(20),XEXC(9),YEXC(9),XEXC1(17), /YEXC1(17),XEXC2(15),YEXC2(15) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ENERGY LEVELS OF WATER ( UP TO J=9) IN MILLIVOLTS DATA ELEV/0.0,2.950,4.604,5.253,8.690,9.856,11.800,16.726,16.882, /16.956,17.640,21.946,25.578,26.304,35.363,35.387,27.531,27.876, /34.157,37.240,39.152,47.426,47.590,60.518,60.521,40.338,40.496, /49.526,51.603,55.360,62.484,63.085,75.645,75.673,92.005,92.006, /55.383,55.452,67.312,68.552,74.734,80.463,82.022,93.822,93.953, /110.172,110.176,129.571,129.571,72.685,72.714,87.311,87.98,97.006, /101.26,104.44,115.03,115.46,131.38,131.40,150.79,150.79,172.94, /172.94,92.252,92.264,109.46,109.80,121.87,124.74,130.20,139.20, /140.32,155.62,155.71,175.02,175.02,197.22,197.22,221.81,221.81, /114.09,114.09,133.79,133.95,149.02,150.79,159.06,166.25,168.65, /182.87,183.16,202.25,202.27,224.48,224.48,249.18,249.18,275.92, /275.92/ C J VALUE OF WATER LEVELS DATA AJL/0.0,1.0,1.0,1.0,2.0,2.0,2.0,2.0,2.0, /3.0,3.0,3.0,3.0,3.0,3.0,3.0,4.0,4.0, /4.0,4.0,4.0,4.0,4.0,4.0,4.0,5.0,5.0, /5.0,5.0,5.0,5.0,5.0,5.0,5.0,5.0,5.0, /6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0, /6.0,6.0,6.0,6.0,7.0,7.0,7.0,7.0,7.0, /7.0,7.0,7.0,7.0,7.0,7.0,7.0,7.0,7.0, /7.0,8.0,8.0,8.0,8.0,8.0,8.0,8.0,8.0, /8.0,8.0,8.0,8.0,8.0,8.0,8.0,8.0,8.0, /9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0, /9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0,9.0, /9.0/ C TRANSITION AMPLITUDES FOR 210 TRANSITIONS DATA SALPHA/1.50,1.259,1.092,1.088,1.101,2.074,2.543,2.166,2.066, /2.181, /3.655,3.446,2.037,4.224,1.899,4.218,5.660,1.841,4.140,1.850, /.8333,1.036,1.083,1.297,1.850,2.025,2.085,1.566,2.494,2.881, /1.709,2.965,1.778,1.860,1.000,1.500,2.157,3.007,3.977,4.984, /5.970,6.980,7.990,1.500,1.667,1.971,2.445,3.131,3.970,4.940, /2.395,2.319,2.322,2.449,2.800,3.290,3.393,3.270,3.153,3.090, /3.100,4.397,4.267,4.120,4.000,5.400,5.250,5.120,1.244,2.336, /3.390,4.397,5.400,6.400,.9225,2.165,3.251,4.265,5.250,.6050, /1.840,3.068,4.090,.3804,1.402,2.750,.2494,1.090,0.197,.7557, /1.744,2.837,3.918,4.965,5.960,6.980,7.990,.3003,.8347,1.641, /2.681,3.710,4.820,5.900,1.550/ C TRANSITION J(INITIAL) VALUES FOR 210 TRANSITIONS DATA AJIN/1.0,1.0,2.0,2.0,3.0,3.0,4.0,4.0,5.0,5.0, /2.0,2.0,3.0,3.0,4.0,4.0,5.0,5.0,3.0,3.0, /4.0,4.0,5.0,5.0,4.0,4.0,5.0,5.0,5.0,5.0, /6.0,6.0,7.0,7.0,6.0,6.0,7.0,7.0,7.0,7.0, /2.0,2.0,3.0,3.0,4.0,4.0,3.0,3.0,4.0,4.0, /5.0,5.0,6.0,6.0,4.0,4.0,5.0,5.0,6.0,6.0, /5.0,5.0,6.0,6.0,6.0,6.0,6.0,6.0,0.0,1.0, /1.0,2.0,2.0,3.0,3.0,4.0,4.0,5.0,5.0,6.0, /6.0,7.0,7.0,8.0,8.0,9.0,1.0,2.0,2.0,3.0, /3.0,4.0,4.0,5.0,5.0,6.0,6.0,7.0,7.0,8.0, /2.0,3.0,3.0,4.0,4.0,5.0,5.0,6.0,6.0,7.0, /7.0,8.0,3.0,4.0,4.0,5.0,5.0,6.0,6.0,7.0, /7.0,8.0,4.0,5.0,5.0,6.0,6.0,7.0,7.0,8.0, /5.0,6.0,6.0,7.0,7.0,8.0,1.0,2.0,2.0,3.0, /3.0,4.0,4.0,5.0,5.0,6.0,6.0,7.0,2.0,3.0, /3.0,4.0,4.0,5.0,5.0,6.0,6.0,7.0,3.0,4.0, /4.0,5.0,5.0,6.0,6.0,7.0,4.0,5.0,5.0,6.0, /6.0,7.0,5.0,6.0,6.0,7.0,6.0,7.0,1.0,2.0, /2.0,3.0,3.0,4.0,4.0,5.0,5.0,6.0,6.0,7.0, /7.0,8.0,8.0,9.0,2.0,3.0,3.0,4.0,4.0,5.0, /5.0,6.0,6.0,7.0,7.0,8.0,8.0,9.0,6.0,7.0/ C TRANSITION ENERGIES FOR 210 TRANSITIONS IN MILIVOLTS DATA EROT/2.303,5.082,9.083,12.93,16.33,3.110,4.809,8.439,12.59, /4.538, /4.994,7.724,6.626,5.834,9.188,7.423,7.433,11.93,9.695,14.63, /6.869,9.785,13.09,7.938,10.19,13.16,16.35,9.364,10.88,13.36, /11.11,11.91,13.10,17.54,4.604,6.906,8.950,10.92,12.97,15.11, /17.33,19.58,21.84,11.47,13.78,15.75,17.45,19.03,20.67,22.49, /18.48,21.12,23.33,25.10,26.52,27.74,25.13,28.05,30.74,33.00, /34.76,31.48,34.50,37.43,40.16,37.56,40.61,43.62,12.28,18.66, /25.16,31.49,37.57,43.36,16.45,22.01,28.25,34.53,40.62,21.51, /25.84,31.47,37.58,27.48,30.42,35.00,34.24,35.89,41.55,4.086, /7.100,9.891,12.46,14.89,17.23,19.54,21.82,4.769,8.579,12.29, /15.71,18.76,21.48,23.99,16.54/ C MAP OF TRANSITION NO TO LEVEL POPULATION DATA IMAP/2,4,7,9,14,16,23,25,34,36,5,7,12,14,21,23,32,34,10,12, /19,21,30,32,17,19,28,30,26,28,39,41,54,56,37,39,52,54,50,52, /6,8,13,15,22,24,11,13,20,22,31,33,44,46,18,20,29,31,42,44, /27,29,40,42,38,40,66,68,1,3,2,6,5,11,10,18,17,27,26,38, /37,51,50,66,65,83,4,8,7,13,12,20,19,29,28,40,39,53,52,68, /9,15,14,22,21,31,30,42,41,55,54,70,16,24,23,33,32,44,43,57, /56,72,25,35,34,46,45,59,58,74,36,48,47,61,60,76,3,9,8,16, /15,25,24,36,35,49,48,64,6,14,13,23,22,34,33,47,46,62,11,21, /20,32,31,45,44,60,18,30,29,43,42,58,27,41,40,56,38,54,3,5, /6,10,11,17,18,26,27,37,38,50,51,65,66,82,8,12,13,19,20,28, /29,39,40,52,53,67,68,84,42,54/ C ELASTIC MOMENTUM TRANSFER ( NO ROTATION ) DATA XEL/.0001,.001,0.01,0.02,0.10,0.20,0.40,1.00,2.00,4.00, /6.00,8.00,10.0,12.0,16.0,20.0,30.0,60.0,100.,200., /500.0,1000.0,10000.,100000./ DATA YEL/384000.,37900.,3590.,1747.,179.,56.5,13.1,1.72,.707,1.21, /2.22,3.23,4.34,4.34,4.24,3.74,3.03,1.89,1.23,.575, /.200,.065,.006,.0006/ C VIBRATION DATA XVIB1/.198,.214,.216,.218,.219,0.23,0.25,0.28,0.32,0.35, /0.40,0.50,0.60,0.80,1.00,1.60,2.50,4.00,7.00,10.0, /15.0,20.0,100.0,1000.0,10000.,100000./ DATA YVIB1/0.00,.001,0.01,0.10,1.00,1.39,1.62,1.74,1.82,1.78, /1.58,1.20,0.74,0.47,0.35,0.24,0.17,0.15,0.18,0.17, /0.15,0.12,0.03,0.003,.0003,.00003/ DATA XVIB2/.453,.463,.470,.473,0.48,0.49,0.55,0.64,0.70,0.75, /0.80,0.90,1.00,1.40,2.00,2.50,4.00,6.00,8.00,10.0, /15.0,20.0,40.0,100.0,1000.0,10000.,100000./ DATA YVIB2/0.00,0.01,0.10,1.00,3.14,3.51,3.72,3.26,2.81,2.17, /1.00,0.68,0.53,0.36,0.31,0.31,0.36,0.47,0.50,0.39, /0.19,0.12,0.10,0.03,0.003,.0003,.00003/ DATA XION/12.61,13.5,14.0,15.0,16.0,17.0,18.0,20.0,22.5,25.0, /30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0,100., /110.,125.,150.,175.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000.,1200.,1500.,2000.,3000.,4000.,7000., /10000.,14000.,20000.,40000.,60000.,100000./ DATA YION/0.00,.036,.066,.120,.178,.256,.333,.465,.648,.825, /1.11,1.35,1.55,1.72,1.84,2.02,2.12,2.21,2.24,2.26, /2.26,2.23,2.15,2.08,2.01,1.82,1.65,1.42,1.21,1.06, /.933,.848,.777,.708,.620,.523,.417,.300,.236,.147, /.108,.080,.059,.032,.022,.0135/ DATA XATT/4.50,5.50,5.75,6.00,6.25,6.40,6.60,7.00,7.50,8.00, /8.50,9.00,9.50,10.0,11.0,13.0,14.0,1000.,10000.,100000./ DATA YATT/0.00,.0008,.003,.019,.060,.064,.060,.035,.011,.010, /.011,.0085,.006,.003,.0058,.001,.0001,.00001,.000001,.0000001/ DATA XEXC/4.20,4.50,5.00,6.00,10.0,100.,1000.0,10000.,100000./ DATA YEXC/0.00,.032,.064,.080,.064,0.004,0.0004,.00004,.000004/ DATA XEXC1/7.40,7.60,8.25,9.10,10.0,12.0,15.0,20.0,30.0,40.0, /50.0,80.0,100.0,200.0,1000.,10000.,100000./ DATA YEXC1/0.00,.027,.158,.264,.394,.607,0.87,1.11,1.24,1.16, /1.09,0.87,0.80,0.51,0.16,.0158,.00158/ DATA XEXC2/13.1,14.1,15.0,17.0,19.0,21.0,25.0,35.0,50.0,70.0, /100.0,200.0,1000.0,10000.,100000./ DATA YEXC2/0.00,.016,.067,0.17,0.22,0.29,0.36,0.50,0.66,0.69, /0.66,0.49,0.16,.016,.0016/ NAME='H2O (2004)' C -------------------------------------------------------------------- C EXPERIMENTAL DATA NOT ACCURATE IN WATER VAPOUR. ELECTRON SCATTERING C DATA USED IN ANALYSIS REPRODUCES DRIFT VELOCITY AND DIFFUSION C COEFFICIENTS TO AN ACCURACY OF 2%. C --------------------------------------------------------------------- NIN=215 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN KIN(J)=0 2 IF(J.LE.210) KIN(J)=1 NEL=24 NVIB1=26 NVIB2=27 NION=46 NATT=20 NEXC=9 NEXC1=17 NEXC2=15 E(1)=0.0 E(2)=2.0*EMASS/(18.01528*AMU) E(3)=12.61 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=12.61 C----------------------------------------------------------------- C DBA IS DIPOLE MOMENT C DRAT IS RATIO OF MOMENTUM TRANSFER TO TOTAL X-SECTION FOR DIPOLE C ----------------------------------------------------------------- GPARA=1.0 GORTHO=3.0 DBA=0.728 DRAT=0.07 A0=0.5291772083D-8 RY=13.60569172 DBK=8.37758*RY*(DBA*A0)**2 C------------------------------------------------------------------ C CALCULATE POPULATION DENSITIES OF ROTATIONAL LEVELS DO 3 J=1,99,2 3 PJ(J)=GPARA*(2.0*AJL(J)+1.0)*EXP(-ELEV(J)*1.D-3/AKT) DO 4 J=2,100,2 4 PJ(J)=GORTHO*(2.0*AJL(J)+1.0)*EXP(-ELEV(J)*1.D-3/AKT) SUM=0.0 DO 5 J=1,100 5 SUM=SUM+PJ(J) DO 6 J=1,100 6 PJ(J)=PJ(J)/SUM DO 7 J=1,105 EIN(2*J-1)=EROT(J)*1.D-3 7 EIN(2*J)=-EROT(J)*1.D-3 C EIN(211)=0.198 EIN(212)=0.453 EIN(213)=4.20 EIN(214)=7.40 EIN(215)=13.1 SCRPT(1)=' ' SCRPT(2)=' ELASTIC WATER ' SCRPT(3)=' IONISATION ELOSS= 12.61 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 101--110 ELOSS= 0.002303' SCRPT(8)=' ROT 110--101 ELOSS=-0.002303' SCRPT(9)=' ROT 211--220 ELOSS= 0.005082' SCRPT(10)=' ROT 220--211 ELOSS=-0.005082' SCRPT(11)=' ROT 321--330 ELOSS= 0.009083' SCRPT(12)=' ROT 330--321 ELOSS=-0.009083' SCRPT(13)=' ROT 431--440 ELOSS= 0.01293 ' SCRPT(14)=' ROT 440--431 ELOSS=-0.01293 ' SCRPT(15)=' ROT 541--550 ELOSS= 0.01633 ' SCRPT(16)=' ROT 550--541 ELOSS=-0.01633 ' SCRPT(17)=' ROT 202--211 ELOSS= 0.00311 ' SCRPT(18)=' ROT 211--202 ELOSS=-0.00311 ' SCRPT(19)=' ROT 312--321 ELOSS= 0.004809' SCRPT(20)=' ROT 321--312 ELOSS=-0.004809' SCRPT(21)=' ROT 422--431 ELOSS= 0.008439' SCRPT(22)=' ROT 431--422 ELOSS=-0.008439' SCRPT(23)=' ROT 532--541 ELOSS= 0.01259 ' SCRPT(24)=' ROT 541--532 ELOSS=-0.01259 ' SCRPT(25)=' ROT 303--312 ELOSS= 0.004538' SCRPT(26)=' ROT 312--303 ELOSS=-0.004538' SCRPT(27)=' ROT 413--422 ELOSS= 0.004994' SCRPT(28)=' ROT 422--413 ELOSS=-0.004994' SCRPT(29)=' ROT 523--532 ELOSS= 0.007724' SCRPT(30)=' ROT 532--523 ELOSS=-0.007724' SCRPT(31)=' ROT 404--413 ELOSS= 0.006626' SCRPT(32)=' ROT 413--404 ELOSS=-0.006626' SCRPT(33)=' ROT 514--523 ELOSS= 0.005834' SCRPT(34)=' ROT 523--514 ELOSS=-0.005834' SCRPT(35)=' ROT 505--514 ELOSS= 0.009188' SCRPT(36)=' ROT 514--505 ELOSS=-0.009188' SCRPT(37)=' ROT 615--624 ELOSS= 0.007423' SCRPT(38)=' ROT 624--615 ELOSS=-0.007423' SCRPT(39)=' ROT 725--734 ELOSS= 0.007433' SCRPT(40)=' ROT 734--725 ELOSS=-0.007433' SCRPT(41)=' ROT 606--615 ELOSS= 0.01193 ' SCRPT(42)=' ROT 615--606 ELOSS=-0.01193 ' SCRPT(43)=' ROT 716--725 ELOSS= 0.009695' SCRPT(44)=' ROT 725--716 ELOSS=-0.009695' SCRPT(45)=' ROT 707--716 ELOSS= 0.01463 ' SCRPT(46)=' ROT 716--707 ELOSS=-0.01463 ' SCRPT(47)=' ROT 212--221 ELOSS= 0.006869' SCRPT(48)=' ROT 221--212 ELOSS=-0.006869' SCRPT(49)=' ROT 322--331 ELOSS= 0.009785' SCRPT(50)=' ROT 331--322 ELOSS=-0.009785' SCRPT(51)=' ROT 432--441 ELOSS= 0.01309 ' SCRPT(52)=' ROT 441--432 ELOSS=-0.01309 ' SCRPT(53)=' ROT 313--322 ELOSS= 0.007938' SCRPT(54)=' ROT 322--313 ELOSS=-0.007938' SCRPT(55)=' ROT 423--432 ELOSS= 0.01019 ' SCRPT(56)=' ROT 432--423 ELOSS=-0.01019 ' SCRPT(57)=' ROT 533--542 ELOSS= 0.01316 ' SCRPT(58)=' ROT 542--533 ELOSS=-0.01316 ' SCRPT(59)=' ROT 643--652 ELOSS= 0.01635 ' SCRPT(60)=' ROT 652--643 ELOSS=-0.01635 ' SCRPT(61)=' ROT 414--423 ELOSS= 0.009364' SCRPT(62)=' ROT 423--414 ELOSS=-0.009364' SCRPT(63)=' ROT 524--533 ELOSS= 0.01088 ' SCRPT(64)=' ROT 533--524 ELOSS=-0.01088 ' SCRPT(65)=' ROT 634--643 ELOSS= 0.01336 ' SCRPT(66)=' ROT 643--634 ELOSS=-0.01336 ' SCRPT(67)=' ROT 515--524 ELOSS= 0.01111 ' SCRPT(68)=' ROT 524--515 ELOSS=-0.01111 ' SCRPT(69)=' ROT 625--634 ELOSS= 0.01191 ' SCRPT(70)=' ROT 634--625 ELOSS=-0.01191 ' SCRPT(71)=' ROT 616--625 ELOSS= 0.01310 ' SCRPT(72)=' ROT 625--616 ELOSS=-0.01310 ' SCRPT(73)=' ROT 818--827 ELOSS= 0.01754 ' SCRPT(74)=' ROT 827--818 ELOSS=-0.01754 ' SCRPT(75)=' ROT 000--111 ELOSS= 0.004604' SCRPT(76)=' ROT 111--000 ELOSS=-0.004604' SCRPT(77)=' ROT 101--212 ELOSS= 0.006906' SCRPT(78)=' ROT 212--101 ELOSS=-0.006906' SCRPT(79)=' ROT 202--313 ELOSS= 0.008950' SCRPT(80)=' ROT 313--202 ELOSS=-0.008950' SCRPT(81)=' ROT 303--414 ELOSS= 0.01092 ' SCRPT(82)=' ROT 414--303 ELOSS=-0.01092 ' SCRPT(83)=' ROT 404--515 ELOSS= 0.01297 ' SCRPT(84)=' ROT 515--404 ELOSS=-0.01297 ' SCRPT(85)=' ROT 505--616 ELOSS= 0.01511 ' SCRPT(86)=' ROT 616--505 ELOSS=-0.01511 ' SCRPT(87)=' ROT 606--717 ELOSS= 0.01733 ' SCRPT(88)=' ROT 717--606 ELOSS=-0.01733 ' SCRPT(89)=' ROT 707--818 ELOSS= 0.01958 ' SCRPT(90)=' ROT 818--707 ELOSS=-0.01958 ' SCRPT(91)=' ROT 808--919 ELOSS= 0.02184 ' SCRPT(92)=' ROT 919--808 ELOSS=-0.02184 ' SCRPT(93)=' ROT 110--221 ELOSS= 0.01147 ' SCRPT(94)=' ROT 221--110 ELOSS=-0.01147 ' SCRPT(95)=' ROT 211--322 ELOSS= 0.01378 ' SCRPT(96)=' ROT 322--211 ELOSS=-0.01378 ' SCRPT(97)=' ROT 312--423 ELOSS= 0.01575 ' SCRPT(98)=' ROT 423--312 ELOSS=-0.01575 ' SCRPT(99)=' ROT 413--524 ELOSS= 0.01745 ' SCRPT(100)=' ROT 524--413 ELOSS=-0.01745 ' SCRPT(101)=' ROT 514--625 ELOSS= 0.01903 ' SCRPT(102)=' ROT 625--514 ELOSS=-0.01903 ' SCRPT(103)=' ROT 615--726 ELOSS= 0.02067 ' SCRPT(104)=' ROT 726--615 ELOSS=-0.02067 ' SCRPT(105)=' ROT 716--827 ELOSS= 0.02249 ' SCRPT(106)=' ROT 827--716 ELOSS=-0.02249 ' SCRPT(107)=' ROT 220--331 ELOSS= 0.01848 ' SCRPT(108)=' ROT 331--220 ELOSS=-0.01848 ' SCRPT(109)=' ROT 321--432 ELOSS= 0.02112 ' SCRPT(110)=' ROT 432--321 ELOSS=-0.02112 ' SCRPT(111)=' ROT 422--533 ELOSS= 0.02333 ' SCRPT(112)=' ROT 533--422 ELOSS=-0.02333 ' SCRPT(113)=' ROT 523--634 ELOSS= 0.02510 ' SCRPT(114)=' ROT 634--523 ELOSS=-0.02510 ' SCRPT(115)=' ROT 624--735 ELOSS= 0.02652 ' SCRPT(116)=' ROT 735--624 ELOSS=-0.02652 ' SCRPT(117)=' ROT 725--836 ELOSS= 0.02774 ' SCRPT(118)=' ROT 836--725 ELOSS=-0.02774 ' SCRPT(119)=' ROT 330--441 ELOSS= 0.02513 ' SCRPT(120)=' ROT 441--330 ELOSS=-0.02513 ' SCRPT(121)=' ROT 431--542 ELOSS= 0.02805 ' SCRPT(122)=' ROT 542--431 ELOSS=-0.02805 ' SCRPT(123)=' ROT 532--643 ELOSS= 0.03074 ' SCRPT(124)=' ROT 643--532 ELOSS=-0.03074 ' SCRPT(125)=' ROT 633--744 ELOSS= 0.03300 ' SCRPT(126)=' ROT 744--633 ELOSS=-0.03300 ' SCRPT(127)=' ROT 734--845 ELOSS= 0.03476 ' SCRPT(128)=' ROT 845--734 ELOSS=-0.03476 ' SCRPT(129)=' ROT 440--551 ELOSS= 0.03148 ' SCRPT(130)=' ROT 551--440 ELOSS=-0.03148 ' SCRPT(131)=' ROT 541--652 ELOSS= 0.03450 ' SCRPT(132)=' ROT 652--541 ELOSS=-0.03450 ' SCRPT(133)=' ROT 642--753 ELOSS= 0.03743 ' SCRPT(134)=' ROT 753--642 ELOSS=-0.03743 ' SCRPT(135)=' ROT 743--854 ELOSS= 0.04016 ' SCRPT(136)=' ROT 854--743 ELOSS=-0.04016 ' SCRPT(137)=' ROT 550--661 ELOSS= 0.03757 ' SCRPT(138)=' ROT 661--550 ELOSS=-0.03757 ' SCRPT(139)=' ROT 651--762 ELOSS= 0.04061 ' SCRPT(140)=' ROT 762--651 ELOSS=-0.04061 ' SCRPT(141)=' ROT 752--863 ELOSS= 0.04361 ' SCRPT(142)=' ROT 863--752 ELOSS=-0.04361 ' SCRPT(143)=' ROT 111--220 ELOSS= 0.01228 ' SCRPT(144)=' ROT 220--111 ELOSS=-0.01228 ' SCRPT(145)=' ROT 221--330 ELOSS= 0.01866 ' SCRPT(146)=' ROT 330--221 ELOSS=-0.01866 ' SCRPT(147)=' ROT 331--440 ELOSS= 0.02516 ' SCRPT(148)=' ROT 440--331 ELOSS=-0.02516 ' SCRPT(149)=' ROT 441--550 ELOSS= 0.03149 ' SCRPT(150)=' ROT 550--441 ELOSS=-0.03149 ' SCRPT(151)=' ROT 551--660 ELOSS= 0.03757 ' SCRPT(152)=' ROT 660--551 ELOSS=-0.03757 ' SCRPT(153)=' ROT 661--770 ELOSS= 0.04336 ' SCRPT(154)=' ROT 770--661 ELOSS=-0.04336 ' SCRPT(155)=' ROT 212--321 ELOSS= 0.01645 ' SCRPT(156)=' ROT 321--212 ELOSS=-0.01645 ' SCRPT(157)=' ROT 322--431 ELOSS= 0.02201 ' SCRPT(158)=' ROT 431--322 ELOSS=-0.02201 ' SCRPT(159)=' ROT 432--541 ELOSS= 0.02825 ' SCRPT(160)=' ROT 541--432 ELOSS=-0.02825 ' SCRPT(161)=' ROT 542--651 ELOSS= 0.03453 ' SCRPT(162)=' ROT 651--542 ELOSS=-0.03453 ' SCRPT(163)=' ROT 652--761 ELOSS= 0.04062 ' SCRPT(164)=' ROT 761--652 ELOSS=-0.04062 ' SCRPT(165)=' ROT 313--422 ELOSS= 0.02151 ' SCRPT(166)=' ROT 422--313 ELOSS=-0.02151 ' SCRPT(167)=' ROT 423--532 ELOSS= 0.02584 ' SCRPT(168)=' ROT 532--423 ELOSS=-0.02584 ' SCRPT(169)=' ROT 533--642 ELOSS= 0.03147 ' SCRPT(170)=' ROT 642--533 ELOSS=-0.03147 ' SCRPT(171)=' ROT 643--752 ELOSS= 0.03758 ' SCRPT(172)=' ROT 752--643 ELOSS=-0.03758 ' SCRPT(173)=' ROT 414--523 ELOSS= 0.02748 ' SCRPT(174)=' ROT 523--414 ELOSS=-0.02748 ' SCRPT(175)=' ROT 524--633 ELOSS= 0.03042 ' SCRPT(176)=' ROT 633--524 ELOSS=-0.03042 ' SCRPT(177)=' ROT 634--743 ELOSS= 0.03500 ' SCRPT(178)=' ROT 743--634 ELOSS=-0.03500 ' SCRPT(179)=' ROT 515--624 ELOSS= 0.03424 ' SCRPT(180)=' ROT 624--515 ELOSS=-0.03424 ' SCRPT(181)=' ROT 625--734 ELOSS= 0.03589 ' SCRPT(182)=' ROT 734--625 ELOSS=-0.03589 ' SCRPT(183)=' ROT 616--725 ELOSS= 0.04155 ' SCRPT(184)=' ROT 725--616 ELOSS=-0.04155 ' SCRPT(185)=' ROT 111--202 ELOSS= 0.004086' SCRPT(186)=' ROT 202--111 ELOSS=-0.004086' SCRPT(187)=' ROT 212--303 ELOSS= 0.007100' SCRPT(188)=' ROT 303--212 ELOSS=-0.007100' SCRPT(189)=' ROT 313--404 ELOSS= 0.009891' SCRPT(190)=' ROT 404--313 ELOSS=-0.009891' SCRPT(191)=' ROT 414--505 ELOSS= 0.01246 ' SCRPT(192)=' ROT 505--414 ELOSS=-0.01246 ' SCRPT(193)=' ROT 515--606 ELOSS= 0.01489 ' SCRPT(194)=' ROT 606--515 ELOSS=-0.01489 ' SCRPT(195)=' ROT 616--707 ELOSS= 0.01723 ' SCRPT(196)=' ROT 707--616 ELOSS=-0.01723 ' SCRPT(197)=' ROT 717--808 ELOSS= 0.01954 ' SCRPT(198)=' ROT 808--717 ELOSS=-0.01954 ' SCRPT(199)=' ROT 818--909 ELOSS= 0.02182 ' SCRPT(200)=' ROT 909--818 ELOSS=-0.02182 ' SCRPT(201)=' ROT 221--312 ELOSS= 0.004769' SCRPT(202)=' ROT 312--221 ELOSS=-0.004769' SCRPT(203)=' ROT 322--413 ELOSS= 0.008579' SCRPT(204)=' ROT 413--322 ELOSS=-0.008579' SCRPT(205)=' ROT 423--514 ELOSS= 0.01229 ' SCRPT(206)=' ROT 514--423 ELOSS=-0.01229 ' SCRPT(207)=' ROT 524--615 ELOSS= 0.01571 ' SCRPT(208)=' ROT 615--524 ELOSS=-0.01571 ' SCRPT(209)=' ROT 625--716 ELOSS= 0.01876 ' SCRPT(210)=' ROT 716--625 ELOSS=-0.01876 ' SCRPT(211)=' ROT 726--817 ELOSS= 0.02148 ' SCRPT(212)=' ROT 817--726 ELOSS=-0.02148 ' SCRPT(213)=' ROT 827--918 ELOSS= 0.02399 ' SCRPT(214)=' ROT 918--827 ELOSS=-0.02399 ' SCRPT(215)=' ROT 634--725 ELOSS= 0.01654 ' SCRPT(216)=' ROT 725--634 ELOSS=-0.01654 ' SCRPT(217)=' VIB V2 ELOSS= 0.198 ' SCRPT(218)=' VIB V1+V3 ELOSS= 0.453 ' SCRPT(219)=' EXC ELOSS= 4.20 ' SCRPT(220)=' EXC ELOSS= 7.40 ' SCRPT(221)=' EXC ELOSS= 13.1 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.LE.XEL(1)) THEN Q(2,I)=YEL(1)*1.D-16 GO TO 25 ENDIF DO 10 J=2,NEL IF(EN.LE.XEL(J)) GO TO 20 10 CONTINUE J=NEL 20 Y1=LOG(YEL(J)) Y2=LOG(YEL(J-1)) X1=LOG(XEL(J)) X2=LOG(XEL(J-1)) A=(Y1-Y2)/(X1-X2) B=(X2*Y1-X1*Y2)/(X2-X1) Q(2,I)=EXP(A*LOG(EN)+B)*1.0D-16 C 25 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GO TO 40 30 CONTINUE J=NION 40 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 50 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 55 DO 51 J=2,NATT IF(EN.LE.XATT(J)) GO TO 52 51 CONTINUE J=NATT 52 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 C 55 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C ---------------------------------------------------------------- C DIPOLE BORN ROTATIONAL STATES C---------------------------------------------------------------- ENRT=SQRT(EN) C C SUPER ELASTIC ROTATIONAL COLLISIONS DO 100 L=2,210,2 AL=AJIN(L) L2=L/2 QIN(L,I)=DBK*SALPHA(L2)*PJ(IMAP(L))*LOG((ENRT+SQRT(EN-EIN(L)))/ /(SQRT(EN-EIN(L))-ENRT))/((2.0*AL+1.0)*EN) 100 PEQIN(L,I)=0.5+(QIN(L,I)-DRAT*QIN(L,I))/QIN(L,I) C C ROTATIONAL COLLISIONS DO 150 L=1,209,2 QIN(L,I)=0.0D0 PEQIN(L,I)=0.5D0 IF(EN.LE.EIN(L)) GO TO 150 AL=AJIN(L) L2=(L+1)/2 QIN(L,I)=DBK*SALPHA(L2)*PJ(IMAP(L))*LOG((ENRT+SQRT(EN-EIN(L)))/ /(ENRT-SQRT(EN-EIN(L))))/((2.0*AL+1.0)*EN) PEQIN(L,I)=0.5+(QIN(L,I)-DRAT*QIN(L,I))/QIN(L,I) 150 CONTINUE C C VIBRATION QIN(211,I)=0.0D0 IF(EN.LE.EIN(211)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(211,I)=(A*EN+B)*1.D-16 400 CONTINUE C QIN(212,I)=0.0D0 IF(EN.LE.EIN(212)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(212,I)=(A*EN+B)*1.D-16 500 CONTINUE C QIN(213,I)=0.0D0 IF(EN.LE.EIN(213)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(213,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(214,I)=0.0D0 IF(EN.LE.EIN(214)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(214,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(215,I)=0.0D0 IF(EN.LE.EIN(215)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(215,I)=(A*EN+B)*1.D-16 800 CONTINUE SUM=0.0 DO 850 K=1,210 SUM=SUM+QIN(K,I) 850 CONTINUE C--------------------------------------------------------------------- C SUM OF ELASTIC (MT), ROT (MT) AND INELASTIC Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(211,I)+QIN(212,I)+QIN(213,I)+ /QIN(214,I)+QIN(215,I)+SUM*DRAT C 900 CONTINUE C SAVE COMPUTE TIME DO 1000 K=1,5 J=216-K IF(EFINAL.LE.EIN(J)) NIN=J-1 1000 CONTINUE C END +DECK,GAS15. SUBROUTINE GAS15(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(48),YXSEC(48),XVIB1(64),YVIB1(64),YVIB2(64),YVIB3(64 /),YVIB4(64),XION(60),YION(60),X3ATT(30),Y3ATT(30),XATT(33),YATT(33 /),XEXC1(21),YEXC1(21),XEXC2(15),YEXC2(15),XEXC3(18),YEXC3(18), /XEXC4(13),YEXC4(13),XEXC5(25),YEXC5(25),XEXC6(22),YEXC6(22), /XROT(53),YROT(53) DIMENSION PJ(30) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC + ROTATIONAL MOMENTUM TRANSFER DATA XEN/0.00,.001,.003,.005,.007,.0085,0.01,.015,0.02,0.03, /0.04,0.06,0.08,0.10,0.12,0.15,0.20,0.30,0.40,0.50, /0.60,0.80,1.00,1.20,1.50,2.00,2.50,3.00,4.00,5.00, /6.00,8.00,10.0,12.0,15.0,20.0,25.0,30.0,40.0,50.0, /60.0,80.0,100.,200.,300.,500.,1000.,100000./ DATA YXSEC/0.35,0.35,0.40,0.50,0.58,0.64,0.70,0.87,0.99,1.25, /1.50,1.85,2.65,3.85,4.80,5.60,5.70,5.80,5.90,5.95, /6.00,6.80,7.40,7.80,7.70,6.80,6.55,6.30,6.10,6.00, /5.90,5.85,5.80,5.70,5.60,5.45,5.10,4.70,3.75,3.12, /2.67,2.07,1.71,0.93,0.67,0.33,0.10,.001/ C VIB V1 DATA XVIB1/.193,0.20,0.21,0.23,0.32,0.33,0.35,0.44,0.45,0.47, /0.56,0.57,0.59,0.68,0.69,0.71,0.79,0.80,0.82,0.90, /0.91,0.93,1.02,1.03,1.05,1.13,1.14,1.16,1.23,1.24, /1.26,1.34,1.35,1.37,1.44,1.45,1.47,1.54,1.55,1.57, /1.63,1.65,1.67,4.00,5.00,6.00,7.00,8.00,8.50,9.00, /9.50,10.0,11.0,12.0,13.0,14.0,15.0,17.0,20.0,45.0, /100.,1000.,10000.,100000./ DATA YVIB1/0.00,0.11,0.11,0.00,0.00,0.94,0.00,0.00,1.10,0.00, /0.00,1.40,0.00,0.00,1.30,0.00,0.00,1.00,0.00,0.00, /0.60,0.00,0.00,.285,0.00,0.00,.113,0.00,0.00,.048, /0.00,0.00,.017,0.00,0.00,.0055,0.00,0.00,.0019,0.00, /0.00,.0006,0.00,.001,.042,.100,.176,.231,.245,.247, /.245,.234,.186,.143,.102,.071,.040,.020,.010,.001, /0.00,0.00,0.00,0.00/ C VIB 2V1 DATA YVIB2/0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00, /0.00,0.14,0.00,0.00,.415,0.00,0.00,.535,0.00,0.00, /.465,0.00,0.00,.315,0.00,0.00,0.20,0.00,0.00,.095, /0.00,0.00,0.04,0.00,0.00,.018,0.00,0.00,.008,0.00, /0.00,.003,0.00,.001,.028,.040,.073,.094,.105,.110, /.109,.109,.093,.073,.051,.028,.013,.008,.005,.001, /0.00,0.00,0.00,0.00/ C VIB 3V1 DATA YVIB3/0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00, /0.00,0.00,0.00,0.00,.0037,0.00,0.00,.0215,0.0,0.0, /0.09,0.00,0.00,0.12,0.00,0.00,.115,0.00,0.00,.095, /0.00,0.00,.055,0.00,0.00,.030,0.00,0.00,.0165,0.00, /0.00,.008,0.00,0.00,0.00,.012,.036,.059,.067,.075, /.072,.068,.056,.048,.030,.017,.009,.002,.001,0.00, /0.00,0.00,0.00,0.00/ C VIB 4V1 DATA YVIB4/0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00, /0.00,0.00,0.00,0.00,0.00,0.00,0.00,.0015,0.00,0.0, /.0055,0.00,0.0,.0095,0.00,0.0,.0165,0.00,0.0,.0315, /0.00,0.00,.0335,0.0,0.00,.0285,0.00,0.0,.0215,0.00, /0.00,.0165,0.00,0.0,0.00,.001,.027,.035,.038,.041, /.043,.046,.031,.025,.018,.009,.001,0.00,0.00,0.00, /0.00,0.00,0.00,0.00/ C IONISATION DATA XION/12.072,12.5,13.0,13.5,14.0,14.5,15.0,15.5,16.0,16.5, /17.0,17.5,18.0,18.5,19.0,19.5,20.0,20.5,21.0,21.5, /22.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,40.0,45.0, /50.0,55.0,60.0,70.0,80.0,90.0,100.,110.,120.,130., /140.,150.,160.,180.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000.,2000.,4000.,6000.,10000.,20000.,100000./ DATA YION/0.00,.0105,.023,.041,.054,.069,.085,.098,.114,.136, /.158,.180,.203,.229,.253,.279,.307,.333,.360,.387, /.416,.535,.654,.770,.897,1.03,1.15,1.27,1.47,1.70, /1.88,2.03,2.17,2.38,2.52,2.62,2.67,2.71,2.72,2.72, /2.71,2.69,2.67,2.62,2.53,2.36,2.18,1.88,1.67,1.49, /1.35,1.23,1.13,1.06,0.60,0.34,0.24,.155,.084,.020/ C THREE BODY ATTACHMENT DATA X3ATT/0.035,0.04,.045,0.05,.055,.056,.058,0.06,.065,0.07, /.075,0.08,.081,.085,0.09,.095,0.10,.101,.105,0.11, /.115,0.20,0.30,0.40,0.50,0.80,1.00,2.00,1000.,100000./ DATA Y3ATT/0.00,.00063,.00137,.00281,.00562,.00624,.00781,.01062, /.0206,.0375, /.0718,.137,.140,.0718,.0312,.0562,.112,.122,.0624,.0125, /0.016,.024,.017,.013,.010,.004,.002,.0001,.0000001,0.0/ C DISSOCIATIVE ATTACHMENT DATA XATT/4.20,4.40,4.60,4.80,5.00,5.20,5.40,5.60,5.80,6.00, /6.20,6.30,6.40,6.50,6.60,6.70,6.80,7.00,7.20,7.40, /7.60,7.80,8.00,8.20,8.40,8.60,8.80,9.00,9.40,10.0, /12.0,100.,100000./ DATA YATT/0.00,.00026,.00070,.00132,.00220,.00360,.00536,.00747, /.00958,.0114, /.0131,.0136,.0140,.0141,.0140,.0137,.0134,.0120,.0106,.00897, /.00738,.00571,.00448,.00334,.00237,.00167,.00123,.00088,.00053, /.00028,.0001,.000001,.000000001/ C EXCITATION TO A1 DELTA G DATA XEXC1/.977,.982,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,30.0,40.0,50.0,60.0,80.0,100.,1000.,100000./ DATA YEXC1/0.00,.001,.0165,.037,.055,.068,.075,.0782,.079,.0773, /.075,.0575,.0435,.026,.0182,.0137,.0108,.0073,.0054,.0001,.000001/ C EXCITATION TO B1 SIGMA G+ DATA XEXC2/1.627,1.64,2.00,3.00,4.00,5.00,6.00,8.00,10.0,15.0, /20.0,40.0,100.,1000.,100000./ DATA YEXC2/0.00,.001,.003,.010,.015,.018,.020,.020,.016,.014, /.013,.005,.002,.0002,.00002/ C EXCITATION SUM OF C1 SIGMA U- AND C3 DELTA U DATA XEXC3/4.50,4.80,5.00,5.50,6.00,6.50,7.00,7.50,8.00,9.00, /10.0,12.0,15.0,20.0,50.0,100.,1000.,100000./ DATA YEXC3/0.00,.003,.009,.030,.065,.085,.095,.100,.100,.085, /.070,.045,.020,.010,.005,.002,.001,.00001/ C EXCITATION TO A3 SIGMA U+ (MOLECULAR DISSOCIATION) DATA XEXC4/6.10,7.00,7.80,9.00,10.0,12.0,15.0,17.0,20.0,45.0, /100.,1000.,100000./ DATA YEXC4/0.00,.150,.250,.232,.210,.165,.105,.065,.048,.019, /.0096,.001,.00001/ C EXCITATION TO B3 SIGMA U- (MOLECULAR DISSOCIATION) DATA XEXC5/8.40,9.00,10.0,12.0,15.0,18.0,20.0,22.0,25.0,30.0, /40.0,50.0,60.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,10000.,100000./ DATA YEXC5/0.00,.129,.329,.772,1.15,1.31,1.34,1.35,1.34,1.27, /1.11,1.00,0.90,0.74,0.64,0.45,0.35,0.24,0.19,0.15, /0.13,.102,.086,.013,.0011/ C EXCITATION TO HIGHER STATES SUMMED CROSS SECTION DATA XEXC6/9.30,10.0,12.0,15.0,18.0,20.0,25.0,30.0,35.0,40.0, /50.0,60.0,80.0,100.,150.,200.,300.,400.,500.,600., /1000.,100000./ DATA YEXC6/0.00,.014,.079,.133,.162,.171,.176,.173,.166,.155, /.138,.123,.102,.084,.055,.041,.025,.019,.014,.012, /.0055,.000055/ C LAWTON AND PHELPS RESONANT ROTATION DATA XROT/.020,.021,.025,0.07,0.08,0.10,0.20,0.21,0.22,0.32, /0.33,0.35,0.44,0.45,0.47,0.56,0.57,0.59,0.68,0.69, /0.71,0.79,0.80,0.81,0.90,0.91,0.93,1.02,1.03,1.05, /1.13,1.14,1.16,1.23,1.24,1.26,1.34,1.35,1.37,1.44, /1.45,1.47,1.54,1.55,1.57,1.64,1.65,1.67,10.,100., /1000.,10000.,100000./ DATA YROT/.00,.0001,.0001,.0001,.0054,.0001,.0001,.0216,.0001, /.0001, /.0384,.0001,.0001,.054,.0001,.0001,.067,.0001,.0001,0.08, /.0001,.0001,.093,.0001,.0001,.084,.0001,.0001,.072,.0001, /.0001,.047,.0001,.0001,.060,.0001,.0001,.036,.0001,.0001, /.024,.0001,.0001,.012,.0001,.0001,.0048,.0001,.000001,.0000001, /.00000001,.00000001,.00000000001/ C ---------------------------------------------------------------------- C X-SECTIONS DERIVED FROM LAWTON AND PHELPS : J.CHEM.PHYS. 69(1978)1055 C VIBRATIONAL X-SECTION ADJUSTED TO FIT ARGON MIXTURE DATA OF: C JEON AND NAKAMURA J.APPL.PHYS D 31(1998) 2145-2150 C ELASTIC X-SECTION DERIVED FROM FIT TO PURE OXYGEN DATA OF: C JEON AND NAKAMURA (AS ABOVE) AT HIGH FIELD , C AND THE DATA AT LOW FIELD OF : C CROMPTON AND ELFORD AUST. J. PHYS. 26(1973)771-782 C REID AND CROMPTON AUST. J. PHYS. 33(1980)215-216 C N.B THE 3-BODY ATTACHMENT X-SECTION IS INCLUDED IN THE SUBROUTINE. C THE FIT TO THE DRIFT VELOCITY AND DIFFUSION MEASURED BY THE ABOVE C REFERENCES IS WITHIN THE EXPERIMENTAL ERRORS . C----------------------------------------------------------------------- C 2004 : INCLUDED FULL SET OF POPULATED ROTATIONAL LEVELS AND C TRANSITIONS FOR LINEAR ROTOR USING EFFECTIVE QUADRUPOLE C MOMENT OF - 0.26 ea0**2 and B0=0.1783mev. C LESS THAN 1% CHANGE ON TRANSPORT COEFICIENTS WITH RESPECT TO C 2003 ANALYSIS USING SINGLE LUMPED EFFECTIVE ROTATIONAL LEVEL C ---------------------------------------------------------------------- C NAME='O2 (2004)' C NIN=40 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NROT=53 NDATA=48 NVIB1=64 NVIB2=64 NVIB3=64 NVIB4=64 NION=60 NATT=33 N3ATT=30 NEXC1=21 NEXC2=15 NEXC3=18 NEXC4=13 NEXC5=25 NEXC6=22 E(1)=0.0 E(2)=2.0*EMASS/(31.9988*AMU) E(3)=12.072 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=17.4 C-------------------------------------------------------- B0=0.0001783 A0=0.5291772083D-8 QBQA=0.26 QBK=1.67552*(QBQA*A0)**2 C-------------------------------------------------------- C CALC FRACTIONAL POPULATION DENSITY OF ROTATIONAL STATES PJ(1)=3.0 DO 3 L=2,15 J=(2*L)-1 3 PJ(L)=(2*J+1)*EXP(-(J*(J+1)-2)*B0/AKT) SUM=0.0 DO 5 L=1,15 5 SUM=SUM+PJ(L) DO 6 L=1,15 6 PJ(L)=PJ(L)/SUM C--------------------------------------------------------- C CALCULATE ROTATIONAL TRANSITION ENERGIES DO 7 K=1,27,2 EIN(K)=B0*(4*K+6) 7 EIN(K+1)=-EIN(K) C EIN(29)=-0.020 EIN(30)=0.020 EIN(31)=0.193 EIN(32)=0.386 EIN(33)=0.579 EIN(34)=0.772 EIN(35)=0.977 EIN(36)=1.627 EIN(37)=4.50 EIN(38)=6.10 EIN(39)=8.40 EIN(40)=9.30 SCRPT(1)=' ' SCRPT(2)=' ELASTIC OXYGEN ' SCRPT(3)=' IONISATION ELOSS= 12.072 ' SCRPT(4)=' ATTACHMENT 2+3 BODY ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 1-3 ELOSS= 0.001783' SCRPT(8)=' ROT 3-1 ELOSS=-0.001783' SCRPT(9)=' ROT 3-5 ELOSS= 0.003209' SCRPT(10)=' ROT 5-3 ELOSS=-0.003209' SCRPT(11)=' ROT 5-7 ELOSS= 0.004636' SCRPT(12)=' ROT 7-5 ELOSS=-0.004636' SCRPT(13)=' ROT 7-9 ELOSS= 0.006062' SCRPT(14)=' ROT 9-7 ELOSS=-0.006062' SCRPT(15)=' ROT 9-11 ELOSS= 0.007489' SCRPT(16)=' ROT 11-9 ELOSS=-0.007489' SCRPT(17)=' ROT 11-13 ELOSS= 0.008915' SCRPT(18)=' ROT 13-11 ELOSS=-0.008915' SCRPT(19)=' ROT 13-15 ELOSS= 0.01034 ' SCRPT(20)=' ROT 15-13 ELOSS=-0.01034 ' SCRPT(21)=' ROT 15-17 ELOSS= 0.01177 ' SCRPT(22)=' ROT 17-15 ELOSS=-0.01177 ' SCRPT(23)=' ROT 17-19 ELOSS= 0.01319 ' SCRPT(24)=' ROT 19-17 ELOSS=-0.01319 ' SCRPT(25)=' ROT 19-21 ELOSS= 0.01462 ' SCRPT(26)=' ROT 21-19 ELOSS=-0.01462 ' SCRPT(27)=' ROT 21-23 ELOSS= 0.01605 ' SCRPT(28)=' ROT 23-21 ELOSS=-0.01605 ' SCRPT(29)=' ROT 23-25 ELOSS= 0.01747 ' SCRPT(30)=' ROT 25-23 ELOSS=-0.01747 ' SCRPT(31)=' ROT 25-27 ELOSS= 0.01890 ' SCRPT(32)=' ROT 27-25 ELOSS=-0.01890 ' SCRPT(33)=' ROT 27-29 ELOSS= 0.02033 ' SCRPT(34)=' ROT 29-27 ELOSS=-0.02033 ' SCRPT(35)=' ROT RESONANCE ELOSS= -0.020 ' SCRPT(36)=' ROT RESONANCE ELOSS= 0.020 ' SCRPT(37)=' VIB V1 ELOSS= 0.193 ' SCRPT(38)=' VIB 2V1 ELOSS= 0.386 ' SCRPT(39)=' VIB 3V1 ELOSS= 0.579 ' SCRPT(40)=' VIB 4V1 ELOSS= 0.772 ' SCRPT(41)=' EXC A1(DEL)G ELOSS= 0.977 ' SCRPT(42)=' EXC B1(SIG)G ELOSS= 1.627 ' SCRPT(43)=' EXC C1+C3 ELOSS= 4.50 ' SCRPT(44)=' EXC A3 DISOC ELOSS= 6.10 ' SCRPT(45)=' EXC B3 DISOC ELOSS= 8.40 ' SCRPT(46)=' EXC ELOSS= 9.30 ' C CALCULATE DENSITY CORRECTION FOR THREE BODY ATTACHMENT CROSS-SECTION FAC=273.15D0*TORR/((TEMPC+273.15D0)*760.0D0) C APOP1=EXP(EIN(29)/AKT) EN=-ESTEP/2.0D0 DO 9900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GO TO 40 30 CONTINUE J=NION 40 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 50 SINGLE=0.0D0 IF(EN.LT.XATT(1)) GO TO 80 IF(EN.GT.XATT(NATT)) GO TO 80 DO 60 J=2,NATT IF(EN.LE.XATT(J)) GO TO 70 60 CONTINUE J=NATT 70 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) SINGLE=(A*EN+B)*1.D-16 C 80 THREEB=0.0D0 IF(EN.LT.X3ATT(1)) GO TO 100 IF(EN.GT.X3ATT(N3ATT)) GO TO 100 DO 90 J=2,N3ATT IF(EN.LE.X3ATT(J)) GO TO 95 90 CONTINUE J=N3ATT 95 A=(Y3ATT(J)-Y3ATT(J-1))/(X3ATT(J)-X3ATT(J-1)) B=(X3ATT(J-1)*Y3ATT(J)-X3ATT(J)*Y3ATT(J-1))/(X3ATT(J-1)-X3ATT(J)) THREEB=FAC*(A*EN+B)*1.D-16 100 Q(4,I)=SINGLE+THREEB Q(5,I)=0.0D0 Q(6,I)=0.0D0 C------------------------------------------------------------ C QUADRUPOLE BORN ROTATIONAL STATES C------------------------------------------------------------- C SUPERELASTIC ROTATION DO 200 K=2,28,2 AJ=DBLE(K+1) L=1+(K/2) 200 QIN(K,I)=PJ(L)*QBK*SQRT(1.0-EIN(K)/EN)*AJ*(AJ-1.0)/((2.0*AJ+1.0)* /(2.0*AJ-1.0)) C ROTATION DO 250 K=1,27,2 QIN(K,I)=0.0D0 IF(EN.LE.EIN(K)) GO TO 250 AJ=DBLE(K) L=(K+1)/2 QIN(K,I)=PJ(L)*QBK*SQRT(1.0-EIN(K)/EN)*(AJ+2.0)*(AJ+1.0)/((2.0*AJ /+3.0)*(2.0*AJ+1.0)) 250 CONTINUE C MOD : USE BORN 1/E FALL OFF OF ROTATIONAL X-SECTION ABOVE 6.0 EV IF(EN.LT.6.0) GO TO 300 DO 270 K=1,28 270 QIN(K,I)=QIN(K,I)*6.0/EN C C SUPERELASTIC RESONANT ROTATION 300 QIN(29,I)=0.0D0 IF(EN.EQ.0.0) GO TO 350 DO 330 J=2,NROT IF((EN+EIN(30)).LE.XROT(J)) GO TO 340 330 CONTINUE J=NROT 340 A=(YROT(J)-YROT(J-1))/(XROT(J)-XROT(J-1)) B=(XROT(J-1)*YROT(J)-XROT(J)*YROT(J-1))/(XROT(J-1)-XROT(J)) QIN(29,I)=(A*(EN+EIN(30))+B)*(EN+EIN(30))/EN QIN(29,I)=QIN(29,I)*APOP1/(1.0+APOP1)*1.D-16 350 CONTINUE C C RESONANT ROTATION QIN(30,I)=0.0D0 IF(EN.LE.EIN(30)) GO TO 400 DO 360 J=2,NROT IF(EN.LE.XROT(J)) GO TO 370 360 CONTINUE J=NROT 370 A=(YROT(J)-YROT(J-1))/(XROT(J)-XROT(J-1)) B=(XROT(J-1)*YROT(J)-XROT(J)*YROT(J-1))/(XROT(J-1)-XROT(J)) QIN(30,I)=(A*EN+B)/(1.0+APOP1)*1.D-16 400 CONTINUE C VIB V1 QIN(31,I)=0.0D0 IF(EN.LE.EIN(31)) GO TO 500 DO 410 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 420 410 CONTINUE J=NVIB1 420 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(31,I)=(A*EN+B)*1.D-16 500 CONTINUE C VIB 2V1 QIN(32,I)=0.0D0 IF(EN.LE.EIN(32)) GO TO 600 DO 510 J=2,NVIB2 IF(EN.LE.XVIB1(J)) GO TO 520 510 CONTINUE J=NVIB2 520 A=(YVIB2(J)-YVIB2(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB2(J)-XVIB1(J)*YVIB2(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(32,I)=(A*EN+B)*1.D-16 600 CONTINUE C VIB 3V1 QIN(33,I)=0.0D0 IF(EN.LE.EIN(33)) GO TO 700 DO 610 J=2,NVIB3 IF(EN.LE.XVIB1(J)) GO TO 620 610 CONTINUE J=NVIB3 620 A=(YVIB3(J)-YVIB3(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB3(J)-XVIB1(J)*YVIB3(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(33,I)=(A*EN+B)*1.D-16 700 CONTINUE C VIB 4V1 QIN(34,I)=0.0D0 IF(EN.LE.EIN(34)) GO TO 800 DO 710 J=2,NVIB4 IF(EN.LE.XVIB1(J)) GO TO 720 710 CONTINUE J=NVIB4 720 A=(YVIB4(J)-YVIB4(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB4(J)-XVIB1(J)*YVIB4(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(34,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(35,I)=0.0D0 IF(EN.LE.EIN(35)) GO TO 900 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 820 810 CONTINUE J=NEXC1 820 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(35,I)=(A*EN+B)*1.D-16 900 CONTINUE C QIN(36,I)=0.0D0 IF(EN.LE.EIN(36)) GO TO 1000 DO 910 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 920 910 CONTINUE J=NEXC2 920 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(36,I)=(A*EN+B)*1.D-16 1000 CONTINUE C QIN(37,I)=0.0D0 IF(EN.LE.EIN(37)) GO TO 1100 DO 1010 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 1020 1010 CONTINUE J=NEXC3 1020 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(37,I)=(A*EN+B)*1.D-16 1100 CONTINUE C QIN(38,I)=0.0D0 IF(EN.LE.EIN(38)) GO TO 1200 DO 1110 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 1120 1110 CONTINUE J=NEXC4 1120 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(38,I)=(A*EN+B)*1.D-16 1200 CONTINUE C QIN(39,I)=0.0D0 IF(EN.LE.EIN(39)) GO TO 1300 DO 1210 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GO TO 1220 1210 CONTINUE J=NEXC5 1220 A=(YEXC5(J)-YEXC5(J-1))/(XEXC5(J)-XEXC5(J-1)) B=(XEXC5(J-1)*YEXC5(J)-XEXC5(J)*YEXC5(J-1))/(XEXC5(J-1)-XEXC5(J)) QIN(39,I)=(A*EN+B)*1.D-16 1300 CONTINUE C QIN(40,I)=0.0D0 IF(EN.LE.EIN(40)) GO TO 1400 DO 1310 J=2,NEXC6 IF(EN.LE.XEXC6(J)) GO TO 1320 1310 CONTINUE J=NEXC6 1320 A=(YEXC6(J)-YEXC6(J-1))/(XEXC6(J)-XEXC6(J-1)) B=(XEXC6(J-1)*YEXC6(J)-XEXC6(J)*YEXC6(J-1))/(XEXC6(J-1)-XEXC6(J)) QIN(40,I)=(A*EN+B)*1.D-16 1400 CONTINUE SUMROT=0.0D0 DO 1500 K=1,30 1500 SUMROT=SUMROT+QIN(K,I) C------------------------------------------------------------------- C GET CORRECT ELASTIC Q(2,I)=Q(2,I)-SUMROT C------------------------------------------------------------------- C TOTAL X-SECTION Q(1,I) USED FOR INFORMATION ONLY Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(31,I)+QIN(32,I)+QIN(33,I)+ /QIN(34,I)+QIN(35,I)+QIN(36,I)+QIN(37,I)+QIN(38,I)+QIN(39,I)+ /QIN(40,I)+SUMROT 9900 CONTINUE C SAVE COMPUTE TIME DO 9990 K=1,10 J=41-K IF(EFINAL.LE.EIN(J)) NIN=J-1 9990 CONTINUE C END +DECK,GAS16. SUBROUTINE GAS16(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220),PJ(220) DIMENSION XMOM(65),YMOM(65),XELA(59),YELA(59),XVIB1(50),YVIB1(50), /XVIB2(24),YVIB2(24),XVIB3(20),YVIB3(20),XVIB4(18),YVIB4(18), /XVIB5(18),YVIB5(18),XVIB6(15),YVIB6(15),XVIB7(17),YVIB7(17), /XVIB8(15),YVIB8(15), /XTRP1(25),YTRP1(25),XTRP3(23),YTRP3(23),XTRP5(26),YTRP5(26), /XTRP7(29),YTRP7(29),XTRP8(19),YTRP8(19), /XSNG2(29),YSNG2(29),XSNG5(26),YSNG5(26),XION(43),YION(43) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XELA/0.00,.010,.015,0.02,0.03,0.04,0.05,0.07,0.10,0.12, /0.15,0.17,0.20,0.25,0.30,0.35,0.40,0.50,0.70,1.00, /1.20,1.30,1.50,1.70,1.90,2.10,2.20,2.50,2.80,3.00, /3.30,3.60,4.00,4.50,5.00,6.00,7.00,8.00,10.0,12.0, /15.0,17.0,20.0,25.0,30.0,50.0,75.0,100.,150.,200., /300.,500.,700.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YELA/1.10,1.92,2.23,2.49,2.95,3.35,3.78,4.48,5.26,5.72, /6.33,6.62,7.11,7.70,8.22,8.62,8.96,9.24,9.52,9.74, /10.26,10.91,11.99,13.78,16.98,17.62,18.94,19.11,22.7,18.74, /16.88,15.59,14.08,12.90,12.74,12.53,12.43,13.01,13.23,13.23, /12.80,12.56,12.10,11.41,10.67,8.30,6.66,5.38,4.18,3.50, /2.70,1.831,1.455,1.03,0.58,0.28,0.10,.052,.008/ DATA XMOM/0.00,.001,.002,.003,.005,.007,.0085,.010,.015,0.02, /0.03,0.04,0.05,0.07,0.10,0.12,0.15,0.17,0.20,0.25, /0.30,0.35,0.40,0.50,0.70,1.00,1.20,1.30,1.50,1.70, /1.90,2.10,2.20,2.50,2.80,3.00,3.30,3.60,4.00,4.50, /5.00,6.00,7.00,8.00,10.0,12.0,15.0,17.0,20.0,25.0, /30.0,50.0,75.0,100.,150.,200.,300.,500.,700.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YMOM/1.10,1.36,1.49,1.62,1.81,2.00,2.10,2.19,2.55,2.85, /3.38,3.82,4.30,5.08,5.92,6.42,7.08,7.38,7.88,8.48, /8.98,9.36,9.67,9.87,9.97,9.96,10.34,10.92,11.87,13.47, /16.41,16.85,18.02,17.92,21.0,17.20,15.3,13.96,12.42,11.19, /10.86,10.36,10.0,10.2,9.90,9.50,8.70,8.26,7.60,6.70, /5.90,3.80,2.56,1.80,1.13,0.80,0.48,0.23,.143,.077, /.038,.019,.008,.004,.001/ DATA XVIB1/0.29,0.30,0.33,0.40,0.75,0.90,1.00,1.10,1.16,1.20, /1.22,1.40,1.50,1.60,1.65,1.70,1.80,1.90,2.00,2.10, /2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,3.60,4.00,5.00,15.0,18.0, /20.0,22.0,23.0,25.0,29.0,32.0,50.0,80.0,1000.,100000./ DATA YVIB1/.00,.001,.0017,.0025,.0037,.0055,.0065,.009,.011,.0125, /.0135,.070,.100,.150,.270,.315,.540,1.485,4.80,2.565, /1.20,4.50,2.76,1.59,3.15,1.545,0.60,1.35,.525,0.870, /1.17,0.855,0.66,0.60,.585,0.57,.055,.035,.035,0.04, /.065,.085,.085,0.06,0.03,.015,.012,0.00,0.00,0.00/ DATA XVIB2/0.59,1.70,1.80,1.90,2.00,2.10,2.20,2.30,2.40,2.50, /2.60,2.70,2.75,2.80,2.90,3.00,3.10,3.20,3.30,3.40, /3.50,3.60,1000.,100000./ DATA YVIB2/0.00,0.00,.015,0.63,1.935,3.30,1.47,0.54,2.115,3.00, /0.54,1.05,1.725,1.275,0.33,0.90,0.645,0.375,0.345,0.30, /0.213,0.00,0.00,0.00/ DATA XVIB3/0.88,1.90,2.00,2.10,2.20,2.30,2.40,2.50,2.60,2.70, /2.75,2.80,2.90,3.00,3.10,3.20,3.30,3.40,1000.,100000./ DATA YVIB3/0.00,0.00,0.96,2.055,2.70,1.695,0.075,0.96,1.47,0.45, /0.96,0.54,0.855,0.405,0.282,0.291,0.0615,0.00,0.00,0.00/ DATA XVIB4/1.17,2.00,2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.75, /2.80,2.90,3.00,3.10,3.20,3.30,1000.,100000./ DATA YVIB4/0.0,0.0,.2025,1.515,2.385,1.440,.555,.0825,1.2,1.095, /0.675,0.03,0.33,0.315,0.06,0.00,0.00,0.00/ DATA XVIB5/1.47,2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80, /2.90,3.00,3.10,3.20,3.30,3.40,1000.,100000./ DATA YVIB5/0.00,0.00,.825,1.23,1.53,1.44,0.345,.0225,.345,0.54, /0.66,.2175,.105,.315,.1035,0.00,0.00,0.00/ DATA XVIB6/1.76,2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90, /3.00,3.10,3.20,1000.,100000./ DATA YVIB6/0.00,0.00,.0063,1.125,1.74,1.38,0.78,0.45,.315,.246, /0.48,.1635,0.00,0.00,0.00/ DATA XVIB7/2.06,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,1000.,100000./ DATA YVIB7/0.00,0.00,.0126,0.39,0.66,0.96,.795,0.60,0.18,.0063, /.192,.204,.078,.0189,0.00,0.00,0.00/ DATA XVIB8/2.35,2.50,2.60,2.70,2.75,2.80,2.90,3.00,3.10,3.20, /3.30,3.40,3.50,1000.,100000./ DATA YVIB8/0.00,0.00,.0189,0.36,0.36,0.33,.345,.264,.0375,.0063, /.1545,.0252,0.00,0.00,0.00/ DATA XTRP1/6.17,7.00,7.80,8.50,9.00,10.0,11.0,12.0,13.0,14.0, /16.0,17.0,18.0,20.0,22.0,24.0,26.0,30.0,34.0,40.0, /50.0,70.0,150.,1000.,100000./ DATA YTRP1/0.00,.0033,.0085,.0213,.0307,.0468,.059,.069,.075,.082, /.089,.089,.084,.072,.061,.052,.045,.034,.029,.023, /.019,.004,0.00,0.00,0.00/ DATA XTRP3/7.35,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /17.0,18.0,20.0,22.0,26.0,30.0,34.0,40.0,50.0,70.0, /150.0,1000.,100000./ DATA YTRP3/.0,.0543,.1434,.2312,.2975,.343,.373,.387,.397,.399, /.383,.354,.289,.227,.165,.131,.106,.0777,.0469,.0168, /0.00,0.00,0.00/ DATA XTRP5/7.80,8.10,8.50,8.70,9.00,10.0,11.0,12.0,13.0,14.0, /16.0,17.0,18.0,20.0,22.0,24.0,26.0,30.0,34.0,40.0, /50.0,70.0,150.0,500.0,1000.,100000./ DATA YTRP5/0.0,.0015,.0097,.018,.029,.073,.115,.148,.180,.208, /.205,.178,.152,.122,.105,.091,.081,.066,.057,.047, /.041,.021,.007,0.00,0.00,0.00/ DATA XSNG2/8.55,9.00,12.0,14.0,15.0,16.0,17.0,18.0,19.0,20.0, /24.0,26.0,30.0,40.0,50.0,70.0,100.,150.,200.,250., /300.,500.,700.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YSNG2/.0,.0141,.163,.2276,.2412,.2481,.2483,.238,.2268,.2150, /.1860,.1734,.1527,.1160,.0900,.0642,.0425,.0268,.0201,.0161, /.0134,.0082,.0060,.0042,.0020,.0010,.0004,.0002,.00004/ DATA XTRP7/11.03,11.5,12.0,12.5,13.0,13.5,13.8,14.0,14.2,14.5, /15.0,16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,36.0,40.0,50.0,70.0,100.0,150.0,1000.,100000./ DATA YTRP7/.0,.0405,.093,.1965,.435,.735,.93,.975,.96,.945, /.825,.645,.525,.450,.405,.375,.315,.2655,.225,.2085, /.1665,.117,.0945,.0585,.0225,.0023,0.00,0.00,0.00/ DATA XTRP8/11.87,11.92,12.7,17.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,32.0,40.0,50.0,70.0,100.,150.0,1000.,100000./ DATA YTRP8/.0,.0496,.0041,.0346,.0436,.0448,.0405,.0338,.0289, /.0241,.0193,.0172,.0122,.010,.007,.005,0.00,0.00,0.00/ DATA XSNG5/13.0,14.0,15.0,16.0,17.0,18.0,20.0,22.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,250.,300.,500.,700., /1000.,2000.,4000.,10000.,20000.,100000./ DATA YSNG5/0.0,.081,0.19,0.25,0.42,0.52,0.75,0.96,1.19,1.48, /1.65,1.76,1.68,1.58,1.33,1.16,1.05,0.96,0.74,0.64, /0.53,0.28,0.14,0.06,0.03,.006/ DATA XION/15.6,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /21.0,22.0,23.0,24.0,25.0,26.0,30.0,34.0,38.0,45.0, /50.0,60.0,75.0,100.,125.,150.,200.,250.,300.,400., /500.,700.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,40000.,100000./ DATA YION/0.00,.021,.047,.071,.099,.129,.164,.199,.230,.270, /.344,.418,.492,.565,.640,.714,1.03,1.27,1.49,1.78, /1.94,2.18,2.39,2.52,2.52,2.45,2.27,2.08,1.92,1.66, /1.45,1.16,0.91,.654,.521,.375,.295,.209,.164,.135, /.073,.040,.017/ NAME='N2 (04 Phelps)' C -------------------------------------------------------------- C NITROGEN FROM PITCHFORD AND PHELPS . JILA REPORT NO.26 (1985) C MULTI TERM CROSS SECTIONS WITH MODIFICATION CF:PHELPS PRIVATE C COMMUNICATION . REDUCED 11.03 ENERGY LOSS X-SECTION BY 0.6666 C IN CODE. C ACCURACY ABOUT 1% AT ALL FIELDS. C COMBINED SOME CLOSE LEVELS IN ORDER TO SAVE COMPUTING TIME C 2004: INCLUDED FULL TREATMENT OF ROTATIONAL STATES C ISOTROPIC ELASTIC SCATTERING C -------------------------------------------------------------- NIN=71 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NELA=59 NMOM=65 NVIB1=50 NVIB2=24 NVIB3=20 NVIB4=18 NVIB5=18 NVIB6=15 NVIB7=17 NVIB8=15 NTRP1=25 NTRP3=23 NTRP5=26 NTRP7=29 NTRP8=19 NSNG2=29 NSNG5=26 NION=43 E(1)=0.0 E(2)=2.0*EMASS/(27.7940*AMU) E(3)=15.60 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=13.0 C CALC FRACTIONAL POPULATION DENSITY FOR ROTATIONAL STATES B0=2.4668D-4 A0=0.5291772083D-8 QBQA=1.06 QBK=1.67552*(QBQA*A0)**2 DO 3 K=1,29,2 3 PJ(K)=3*(2*K+1)*EXP(-K*(K+1)*B0/AKT) DO 4 K=2,28,2 4 PJ(K)=6*(2*K+1)*EXP(-K*(K+1)*B0/AKT) SUM=6.0 DO 5 K=1,29 5 SUM=SUM+PJ(K) FROT0=6.0/SUM DO 6 K=1,29 6 PJ(K)=PJ(K)/SUM C CALC ROTATIONAL TRANSITION ENERGIES DO 7 K=1,28 J=K-1 EIN(K+28)=B0*(4*J+6) 7 EIN(K)=-EIN(K+28) EIN(57)=0.290 EIN(58)=0.590 EIN(59)=0.880 EIN(60)=1.17 EIN(61)=1.47 EIN(62)=1.76 EIN(63)=2.06 EIN(64)=2.35 EIN(65)=6.17 EIN(66)=7.35 EIN(67)=7.80 EIN(68)=8.55 EIN(69)=11.03 EIN(70)=11.87 EIN(71)=13.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ISOTROPIC NITROGEN ' SCRPT(3)=' IONISATION ELOSS= 15.60 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 2-0 ELOSS= -0.00148' SCRPT(8)=' ROT 3-1 ELOSS= -0.00247' SCRPT(9)=' ROT 4-2 ELOSS= -0.00345' SCRPT(10)=' ROT 5-3 ELOSS= -0.00444' SCRPT(11)=' ROT 6-4 ELOSS= -0.00543' SCRPT(12)=' ROT 7-5 ELOSS= -0.00641' SCRPT(13)=' ROT 8-6 ELOSS= -0.00740' SCRPT(14)=' ROT 9-7 ELOSS= -0.00839' SCRPT(15)=' ROT 10-8 ELOSS= -0.00937' SCRPT(16)=' ROT 11-9 ELOSS= -0.0104 ' SCRPT(17)=' ROT 12-10 ELOSS= -0.0113 ' SCRPT(18)=' ROT 13-11 ELOSS= -0.0123 ' SCRPT(19)=' ROT 14-12 ELOSS= -0.0133 ' SCRPT(20)=' ROT 15-13 ELOSS= -0.0143 ' SCRPT(21)=' ROT 16-14 ELOSS= -0.0153 ' SCRPT(22)=' ROT 17-15 ELOSS= -0.0163 ' SCRPT(23)=' ROT 18-16 ELOSS= -0.0173 ' SCRPT(24)=' ROT 19-17 ELOSS= -0.0183 ' SCRPT(25)=' ROT 20-18 ELOSS= -0.0192 ' SCRPT(26)=' ROT 21-19 ELOSS= -0.0202 ' SCRPT(27)=' ROT 22-20 ELOSS= -0.0212 ' SCRPT(28)=' ROT 23-21 ELOSS= -0.0222 ' SCRPT(29)=' ROT 24-22 ELOSS= -0.0232 ' SCRPT(30)=' ROT 25-23 ELOSS= -0.0242 ' SCRPT(31)=' ROT 26-24 ELOSS= -0.0252 ' SCRPT(32)=' ROT 27-25 ELOSS= -0.0261 ' SCRPT(33)=' ROT 28-26 ELOSS= -0.0271 ' SCRPT(34)=' ROT 29-27 ELOSS= -0.0281 ' SCRPT(35)=' ROT 0-2 ELOSS= 0.00148' SCRPT(36)=' ROT 1-3 ELOSS= 0.00247' SCRPT(37)=' ROT 2-4 ELOSS= 0.00345' SCRPT(38)=' ROT 3-5 ELOSS= 0.00444' SCRPT(39)=' ROT 4-6 ELOSS= 0.00543' SCRPT(40)=' ROT 5-7 ELOSS= 0.00641' SCRPT(41)=' ROT 6-8 ELOSS= 0.00740' SCRPT(42)=' ROT 7-9 ELOSS= 0.00839' SCRPT(43)=' ROT 8-10 ELOSS= 0.00937' SCRPT(44)=' ROT 9-11 ELOSS= 0.0104 ' SCRPT(45)=' ROT 10-12 ELOSS= 0.0113 ' SCRPT(46)=' ROT 11-13 ELOSS= 0.0123 ' SCRPT(47)=' ROT 12-14 ELOSS= 0.0133 ' SCRPT(48)=' ROT 13-15 ELOSS= 0.0143 ' SCRPT(49)=' ROT 14-16 ELOSS= 0.0153 ' SCRPT(50)=' ROT 15-17 ELOSS= 0.0163 ' SCRPT(51)=' ROT 16-18 ELOSS= 0.0173 ' SCRPT(52)=' ROT 17-19 ELOSS= 0.0183 ' SCRPT(53)=' ROT 18-20 ELOSS= 0.0192 ' SCRPT(54)=' ROT 19-21 ELOSS= 0.0202 ' SCRPT(55)=' ROT 20-22 ELOSS= 0.0212 ' SCRPT(56)=' ROT 21-23 ELOSS= 0.0222 ' SCRPT(57)=' ROT 22-24 ELOSS= 0.0232 ' SCRPT(58)=' ROT 23-25 ELOSS= 0.0242 ' SCRPT(59)=' ROT 24-26 ELOSS= 0.0252 ' SCRPT(60)=' ROT 25-27 ELOSS= 0.0261 ' SCRPT(61)=' ROT 26-28 ELOSS= 0.0271 ' SCRPT(62)=' ROT 27-29 ELOSS= 0.0281 ' SCRPT(63)=' VIB V1 ELOSS= 0.290 ' SCRPT(64)=' VIB 2V1 ELOSS= 0.590 ' SCRPT(65)=' VIB 3V1 ELOSS= 0.880 ' SCRPT(66)=' VIB 4V1 ELOSS= 1.17 ' SCRPT(67)=' VIB 5V1 ELOSS= 1.47 ' SCRPT(68)=' VIB 6V1 ELOSS= 1.76 ' SCRPT(69)=' VIB 7V1 ELOSS= 2.06 ' SCRPT(70)=' VIB 8V1 ELOSS= 2.35 ' SCRPT(71)=' EXC TRPLT1 ELOSS= 6.17 ' SCRPT(72)=' EXC TRPLT3 ELOSS= 7.35 ' SCRPT(73)=' EXC TRPLT5 ELOSS= 7.80 ' SCRPT(74)=' EXC SNGLT2 ELOSS= 8.55 ' SCRPT(75)=' EXC TRPLT7 ELOSS= 11.03 ' SCRPT(76)=' EXC TRPLT8 ELOSS= 11.87 ' SCRPT(77)=' EXC SNGLT5 ELOSS= 13.0 ' C EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP C C ELASTIC (+ROTATIONAL) DO 10 J=2,NELA IF(EN.LE.XELA(J)) GO TO 15 10 CONTINUE J=NELA 15 A=(YELA(J)-YELA(J-1))/(XELA(J)-XELA(J-1)) B=(XELA(J-1)*YELA(J)-XELA(J)*YELA(J-1))/(XELA(J-1)-XELA(J)) QELA=(A*EN+B)*1.0D-16 C C MOMENTUM TRANSFER DO 20 J=2,NMOM IF(EN.LE.XMOM(J)) GO TO 25 20 CONTINUE J=NMOM 25 A=(YMOM(J)-YMOM(J-1))/(XMOM(J)-XMOM(J-1)) B=(XMOM(J-1)*YMOM(J)-XMOM(J)*YMOM(J-1))/(XMOM(J-1)-XMOM(J)) QMOM=(A*EN+B)*1.0D-16 C C PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QMOM C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GO TO 40 30 CONTINUE J=NION 40 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 50 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C--------------------------------------------------------------------- C QUADRUPOLE BORN ROTATIONAL STATES ( GERJUOY AND STEIN) C--------------------------------------------------------------------- C SUPERELASTIC ROTATION DO 51 K=1,28 AJ=DBLE(K+1) 51 QIN(K,I)=PJ(K+1)*QBK*SQRT(1.0-EIN(K)/EN)*AJ*(AJ-1.0)/((2.0*AJ+1.0 /)*(2.0*AJ-1.0)) DO 52 K=29,56 52 QIN(K,I)=0.0D0 C INELASTIC ROTATION C ROT 0-2 IF(EN.LE.EIN(29)) GO TO 60 QIN(29,I)=FROT0*QBK*SQRT(1.0-EIN(29)/EN)*2.0/3.0 C ROT 1-3 AND HIGHER DO 53 K=30,56 AJ=DBLE(K-29) IF(EN.LE.EIN(K)) GO TO 60 53 QIN(K,I)=PJ(K-29)*QBK*SQRT(1.0-EIN(K)/EN)*(AJ+2.0)*(AJ+1.0)/((2.0 /*AJ+3.0)*(2.0*AJ+1.0)) C BORN (1/E) FALL OFF IN ROTATIONAL X-SECS ABOVE 6.0 EV 60 IF(EN.LT.6.0) GO TO 80 DO 70 K=1,56 70 QIN(K,I)=QIN(K,I)*6.0/EN 80 CONTINUE C--------------------------------------------------------------------- C VIBRATIONAL AND EXCITATION X-SECTIONS C--------------------------------------------------------------------- QIN(57,I)=0.0D0 IF(EN.LE.EIN(57)) GO TO 110 DO 90 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 100 90 CONTINUE J=NVIB1 100 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(57,I)=(A*EN+B)*1.D-16 110 CONTINUE C QIN(58,I)=0.0D0 IF(EN.LE.EIN(58)) GO TO 140 DO 120 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 130 120 CONTINUE J=NVIB2 130 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(58,I)=(A*EN+B)*1.D-16 140 CONTINUE C QIN(59,I)=0.0D0 IF(EN.LE.EIN(59)) GO TO 170 DO 150 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 160 150 CONTINUE J=NVIB3 160 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(59,I)=(A*EN+B)*1.D-16 170 CONTINUE C QIN(60,I)=0.0D0 IF(EN.LE.EIN(60)) GO TO 200 DO 180 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 190 180 CONTINUE J=NVIB4 190 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(60,I)=(A*EN+B)*1.D-16 200 CONTINUE C QIN(61,I)=0.0D0 IF(EN.LE.EIN(61)) GO TO 230 DO 210 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 220 210 CONTINUE J=NVIB5 220 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(61,I)=(A*EN+B)*1.D-16 230 CONTINUE C QIN(62,I)=0.0D0 IF(EN.LE.EIN(62)) GO TO 260 DO 240 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 250 240 CONTINUE J=NVIB6 250 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(62,I)=(A*EN+B)*1.D-16 260 CONTINUE C QIN(63,I)=0.0D0 IF(EN.LE.EIN(63)) GO TO 330 DO 310 J=2,NVIB7 IF(EN.LE.XVIB7(J)) GO TO 320 310 CONTINUE J=NVIB7 320 A=(YVIB7(J)-YVIB7(J-1))/(XVIB7(J)-XVIB7(J-1)) B=(XVIB7(J-1)*YVIB7(J)-XVIB7(J)*YVIB7(J-1))/(XVIB7(J-1)-XVIB7(J)) QIN(63,I)=(A*EN+B)*1.D-16 330 CONTINUE C QIN(64,I)=0.0D0 IF(EN.LE.EIN(64)) GO TO 360 DO 340 J=2,NVIB8 IF(EN.LE.XVIB8(J)) GO TO 350 340 CONTINUE J=NVIB8 350 A=(YVIB8(J)-YVIB8(J-1))/(XVIB8(J)-XVIB8(J-1)) B=(XVIB8(J-1)*YVIB8(J)-XVIB8(J)*YVIB8(J-1))/(XVIB8(J-1)-XVIB8(J)) QIN(64,I)=(A*EN+B)*1.D-16 360 CONTINUE C QIN(65,I)=0.0D0 IF(EN.LE.EIN(65)) GO TO 450 DO 430 J=2,NTRP1 IF(EN.LE.XTRP1(J)) GO TO 440 430 CONTINUE J=NTRP1 440 A=(YTRP1(J)-YTRP1(J-1))/(XTRP1(J)-XTRP1(J-1)) B=(XTRP1(J-1)*YTRP1(J)-XTRP1(J)*YTRP1(J-1))/(XTRP1(J-1)-XTRP1(J)) QIN(65,I)=(A*EN+B)*1.D-16 450 CONTINUE C QIN(66,I)=0.0D0 IF(EN.LE.EIN(66)) GO TO 510 DO 490 J=2,NTRP3 IF(EN.LE.XTRP3(J)) GO TO 500 490 CONTINUE J=NTRP3 500 A=(YTRP3(J)-YTRP3(J-1))/(XTRP3(J)-XTRP3(J-1)) B=(XTRP3(J-1)*YTRP3(J)-XTRP3(J)*YTRP3(J-1))/(XTRP3(J-1)-XTRP3(J)) QIN(66,I)=(A*EN+B)*1.D-16 510 CONTINUE C QIN(67,I)=0.0D0 IF(EN.LE.EIN(67)) GO TO 570 DO 550 J=2,NTRP5 IF(EN.LE.XTRP5(J)) GO TO 560 550 CONTINUE J=NTRP5 560 A=(YTRP5(J)-YTRP5(J-1))/(XTRP5(J)-XTRP5(J-1)) B=(XTRP5(J-1)*YTRP5(J)-XTRP5(J)*YTRP5(J-1))/(XTRP5(J-1)-XTRP5(J)) QIN(67,I)=(A*EN+B)*1.D-16 570 CONTINUE C QIN(68,I)=0.0D0 IF(EN.LE.EIN(68)) GO TO 660 DO 640 J=2,NSNG2 IF(EN.LE.XSNG2(J)) GO TO 650 640 CONTINUE J=NSNG2 650 A=(YSNG2(J)-YSNG2(J-1))/(XSNG2(J)-XSNG2(J-1)) B=(XSNG2(J-1)*YSNG2(J)-XSNG2(J)*YSNG2(J-1))/(XSNG2(J-1)-XSNG2(J)) QIN(68,I)=(A*EN+B)*1.D-16 660 CONTINUE C QIN(69,I)=0.0D0 IF(EN.LE.EIN(69)) GO TO 720 DO 700 J=2,NTRP7 IF(EN.LE.XTRP7(J)) GO TO 710 700 CONTINUE J=NTRP7 710 A=(YTRP7(J)-YTRP7(J-1))/(XTRP7(J)-XTRP7(J-1)) B=(XTRP7(J-1)*YTRP7(J)-XTRP7(J)*YTRP7(J-1))/(XTRP7(J-1)-XTRP7(J)) QIN(69,I)=0.6666*(A*EN+B)*1.D-16 720 CONTINUE C QIN(70,I)=0.0D0 IF(EN.LE.EIN(70)) GO TO 750 DO 730 J=2,NTRP8 IF(EN.LE.XTRP8(J)) GO TO 740 730 CONTINUE J=NTRP8 740 A=(YTRP8(J)-YTRP8(J-1))/(XTRP8(J)-XTRP8(J-1)) B=(XTRP8(J-1)*YTRP8(J)-XTRP8(J)*YTRP8(J-1))/(XTRP8(J-1)-XTRP8(J)) QIN(70,I)=(A*EN+B)*1.D-16 750 CONTINUE C QIN(71,I)=0.0D0 IF(EN.LE.EIN(71)) GO TO 810 DO 790 J=2,NSNG5 IF(EN.LE.XSNG5(J)) GO TO 800 790 CONTINUE J=NSNG5 800 A=(YSNG5(J)-YSNG5(J-1))/(XSNG5(J)-XSNG5(J-1)) B=(XSNG5(J-1)*YSNG5(J)-XSNG5(J)*YSNG5(J-1))/(XSNG5(J-1)-XSNG5(J)) QIN(71,I)=(A*EN+B)*1.D-16 810 CONTINUE C C SUM=0.0D0 DO 898 K=1,56 SUM=SUM+QIN(K,I) 898 CONTINUE C GET CORRECT ELASTIC XSECTION BY SUBTRACTION OF ROTATION Q(2,I)=Q(2,I)-SUM SUM1=0.0D0 DO 899 K=57,71 SUM1=SUM1+QIN(K,I) 899 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+SUM+SUM1 900 CONTINUE C SAVE COMPUTE TIME DO 1000 K=1,71 J=72-K IF(EFINAL.LE.EIN(J)) NIN=J-1 1000 CONTINUE C END +DECK,GAS17. SUBROUTINE GAS17(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(58),YXSEC(58),XION(48),YION(48),XATT(23),YATT(23), /XROT1(18),YROT1(18),XVIB1(24),YVIB1(24),XVIB2(23),YVIB2(23), /XEXC1(32),YEXC1(32), /XAT3(18),YAT3(18) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.005,.007,0.01,.012,.015,0.02,0.03,0.04,0.05, /0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.20,0.30,0.40, /0.50,0.60,0.70,0.80,0.90,1.00,1.20,1.50,2.00,3.00, /4.00,5.00,6.00,7.00,8.00,9.00,10.0,12.0,15.0,20.0, /30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150., /200.,300.,400.,500.,1000.,2000.,10000.,100000./ DATA YXSEC/32.0,30.8,29.8,27.8,25.5,22.1,20.0,15.7,13.3,11.2, /10.0,9.25,8.63,8.34,8.24,8.00,6.73,6.00,6.00,6.14, /6.50,6.88,7.70,8.25,8.95,9.78,10.6,13.3,13.6,12.8, /10.2,9.78,8.45,7.10,6.10,5.20,4.75,4.10,2.85,1.85, /1.12,0.82,0.59,0.49,0.39,0.32,0.28,0.24,0.18,0.14, /0.09,0.05,.035,.025,0.01,.004,.0005,.0001/ DATA XION/9.2644,9.50,10.0,10.5,11.0,11.5,12.0,12.5,13.0,13.5, /14.0,15.0,16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0, /28.0,32.0,36.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0, /100.,120.,140.,160.,200.,300.,400.,500.,600.,700., /800.,900.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YION/0.00,.011,.018,.031,.047,.064,.093,.131,.184,.244, /.305,.418,.503,.585,.663,.736,.813,.959,1.11,1.26, /1.40,1.65,1.87,2.08,2.30,2.48,2.74,2.91,3.04,3.11, /3.14,3.14,3.10,3.04,2.86,2.45,2.11,1.86,1.67,1.51, /1.39,1.27,1.21,0.80,0.45,0.23,0.14,.035/ DATA XATT/6.50,6.80,7.00,7.20,7.40,7.60,7.80,8.00,8.60,8.80, /9.00,9.20,9.40,9.60,9.80,10.0,10.4,10.6,10.8,11.0, /11.5,13.0,14.0/ DATA YATT/0.00,0.02,0.08,0.33,0.71,0.96,1.08,1.11,1.11,1.09, /1.04,0.95,0.83,0.65,0.51,0.38,0.18,0.11,0.08,0.06, /0.04,0.03,0.00/ DATA XAT3/0.01,.012,.015,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.12,0.15,0.20,0.30,1.00,10.0/ DATA YAT3/0.00,.085,0.24,0.14,0.07,.041,.029,.023,.019,.017, /.015,.014,.013,.012,.010,.0085,.0035,0.00/ DATA XROT1/.100,0.12,0.15,0.20,0.30,0.40,0.50,0.60,0.70,0.80, /0.90,1.00,1.20,1.50,2.00,10.0,100.,100000./ DATA YROT1/0.00,.037,.037,.033,.026,.018,.014,.011,.009,.006, /.005,.004,.003,.002,.001,.0001,.00001,.000001/ DATA XVIB1/.2326,0.24,0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90, /1.00,1.20,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00, /10.0,20.0,100.,100000./ DATA YVIB1/0.00,0.05,0.08,0.10,0.08,0.06,0.05,0.04,.032,.027, /.023,.018,.012,.008,.004,.002,.0015,.0012,.001,.0008, /.0005,.0001,.00002,.000001/ DATA XVIB2/0.60,0.63,0.70,0.80,0.90,1.00,1.20,1.50,2.00,3.00, /4.00,5.00,6.00,7.00,8.00,10.0,15.0,20.0,40.0,60.0, /100.,1000.,100000./ DATA YVIB2/0.00,0.60,0.90,0.90,0.85,0.80,0.70,0.50,0.31,0.16, /0.11,.075,.055,.042,.035,.025,.012,.008,.002,.001, /.0005,.00005,.000005/ DATA XEXC1/6.10,6.50,7.00,7.50,8.00,8.50,9.00,10.0,12.0,15.0, /20.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,120., /150.,200.,300.,400.,500.,1000.,2000.,4000.,10000.,20000., /40000.,100000./ DATA YEXC1/0.00,0.01,0.02,.085,0.20,0.55,0.70,1.00,1.65,2.21, /3.30,3.50,3.30,3.00,2.65,2.26,2.16,2.00,1.80,1.60, /1.40,1.03,0.85,0.65,0.52,0.25,0.13,0.06,.025,.012, /.0065,.0025/ NAME='NO (1995)' C --------------------------------------------------------------------- C CALCULATE CORRECTION FACTOR FOR 3BODY ATTACHMENT CROSS-SECTION FAC=273.15*TORR/((TEMPC+273.15)*760.0) C--------------------------------------------- C IF(LBMCPR)WRITE(LUNOUT,100) C 100 FORMAT(1H1) C IF(LBMCPR)WRITE(LUNOUT,100) FAC C 101 FORMAT(' 3BODY ATTACHMENT INCLUDED DENSITY SCALING FACTOR =',F7.4) NIN=4 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=58 NION=48 NATT=23 NAT3=18 NROT1=18 NVIB1=24 NVIB2=23 NEXC1=32 E(1)=0.0 E(2)=2.0*EMASS/(30.00614*AMU) E(3)=9.2644 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=13.6 EIN(1)=0.100 EIN(2)=0.2326 EIN(3)=0.600 EIN(4)=6.10 SCRPT(1)=' ' SCRPT(2)=' ELASTIC NITRIC OXIDE ' SCRPT(3)=' IONISATION ELOSS= 9.2644 ' SCRPT(4)=' ATTACHMENT 2+3 BODY ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT ELOSS= 0.100 ' SCRPT(8)=' VIB V1 ELOSS= 0.2326 ' SCRPT(9)=' VIB SUM ELOSS= 0.600 ' SCRPT(10)=' EXC ELOSS= 6.10 ' EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 Q(4,I)=0.0D0 SINGLE=0.0D0 IF(EN.LT.XATT(1)) GO TO 250 IF(EN.GT.XATT(NATT)) GO TO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) SINGLE=(A*EN+B)*1.D-18 250 THREEB=0.0D0 IF(EN.LT.XAT3(1)) GO TO 300 IF(EN.GT.XAT3(NAT3)) GO TO 300 DO 260 J=2,NAT3 IF(EN.LE.XAT3(J)) GO TO 270 260 CONTINUE J=NAT3 270 A=(YAT3(J)-YAT3(J-1))/(XAT3(J)-XAT3(J-1)) B=(XAT3(J-1)*YAT3(J)-XAT3(J)*YAT3(J-1))/(XAT3(J-1)-XAT3(J)) THREEB=FAC*(A*EN+B)*1.D-16 Q(4,I)=SINGLE+THREEB 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NROT1 IF(EN.LE.XROT1(J)) GO TO 320 310 CONTINUE J=NROT1 320 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(1,I)=(A*EN+B)*1.D-16 400 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 500 DO 410 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 420 410 CONTINUE J=NVIB1 420 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.D-16 500 CONTINUE QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 600 DO 510 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 520 510 CONTINUE J=NVIB2 520 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.D-16 600 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(4,I)=(A*EN+B)*1.D-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS18. SUBROUTINE GAS18(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220),PJ(60) DIMENSION XEN(69),YXSEC(69),XION(47),YION(47),XATT(51),YATT(51), /XEXC1(28),YEXC1(28),XEXC2(24),YEXC2(24),XEXC3(25),YEXC3(25), /XVIBH(19),YVIBH(19),XVIBR(19),YVIBR(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC +ROTATION MOMENTUM TRANSFER DATA XEN/0.00,0.001,.0034,0.01,.012,.014,.017,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17, /0.20,0.25,0.30,0.35,0.40,0.50,0.60,0.70,0.80,1.00, /1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60,3.00,4.00, /5.00,6.00,7.00,8.00,9.00,10.0,12.0,14.0,17.0,20.0, /25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,140., /200.,250.,300.,400.,500.,700.,1000.,10000.,100000./ DATA YXSEC/180.,150.,105.,54.5,48.5,43.5,39.0,35.2,30.5,27.3, /22.6,19.8,17.5,15.5,13.4,12.1,10.8,8.90,7.55,6.10, /5.20,4.20,3.70,3.35,3.20,3.10,3.15,3.25,3.35,3.65, /4.30,5.00,6.30,8.70,10.2,11.5,12.0,11.5,10.2,8.90, /8.60,9.00,9.50,10.2,10.7,11.1,11.4,11.1,10.0,8.81, /7.31,6.44,5.21,4.40,3.81,3.41,2.88,2.65,2.33,1.59, /1.14,0.88,0.73,0.50,0.38,0.25,0.16,0.016,0.0016/ C IONISATION DATA XION/12.886,14.0,14.5,15.0,16.0,17.0,18.0,20.0,21.0,22.5, /25.0,30.0,35.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0, /90.0,100.,110.,120.,140.,160.,200.,250.,300.,350., /400.,450.,500.,600.,700.,800.,900.,1000.,1500.,2000., /3000.,4000.,6000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.065,.135,.175,.255,.330,.414,.602,0.72,0.877, /1.16,1.61,2.03,2.34,2.61,2.82,3.02,3.18,3.46,3.63, /3.71,3.76,3.77,3.76,3.73,3.63,3.44,3.17,2.94,2.72, /2.51,2.36,2.22,1.95,1.77,1.62,1.49,1.42,1.05,0.83, /0.60,0.48,0.34,.218,.119,.065,.028/ C ATACHMENT DATA XATT/0.20,0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.10,1.20,1.30,1.40,1.50,1.60,1.70,1.80,1.90,2.00, /2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,3.60,3.70,3.80,3.90,4.00, /4.30,5.00,6.00,7.00,8.00,9.00,10.0,11.0,12.0,14.0, /16.0/ DATA YATT/0.00,0.01,0.02,0.25,0.90,1.12,1.16,1.23,1.35,1.45, /1.52,1.61,1.70,1.76,2.05,2.29,2.92,3.59,4.48,5.35, /6.02,6.58,6.58,6.18,5.45,4.60,3.72,2.75,2.00,1.48, /1.07,0.75,0.48,0.36,0.27,0.22,0.17,0.15,0.13,0.10, /0.08,0.08,0.09,0.12,0.23,0.34,0.57,0.69,0.46,0.15, /0.00/ C VIBRATIONS DATA XVIBH/.073,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,3.40,3.60,3.80,4.00,10.0,100000./ DATA YVIBH/0.00,.022,.062,.144,.291,.500,.735,.927,1.00,.927, /.735,.500,.291,.144,.062,.022,.007,.000001,.000000001/ DATA XVIBR/.073,5.20,5.60,6.00,6.40,6.80,7.20,7.60,8.00,8.40, /8.80,9.20,9.60,10.0,10.4,10.8,11.2,15.0,100000./ DATA YVIBR/0.00,.006,0.02,.065,.174,.375,.644,.896,1.00,.896, /.644,.375,.174,.065,0.02,.006,.001,.000001,.000000001/ C EXCITATIONS DATA XEXC1/4.06,4.50,5.00,6.00,7.00,8.00,9.00,10.0,12.0,14.0, /17.0,20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.,140.,200.,300.,500.,1000.,10000.,100000./ DATA YEXC1/0.00,0.55,0.83,0.93,0.93,0.84,0.78,0.69,0.60,0.50, /0.42,0.34,0.26,0.21,0.15,0.12,0.10,0.08,0.07,0.06, /0.05,.034,.022,.014,.008,.004,.0004,.00004/ DATA XEXC2/8.50,9.00,10.0,12.0,14.0,17.0,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,140.,200.,300.,400.,500., /700.,1000.,10000.,100000./ DATA YEXC2/0.00,.016,.048,0.12,0.22,0.34,0.47,0.62,0.73,0.81, /0.75,0.64,0.57,0.48,0.36,0.26,0.17,0.12,.083,.067, /.046,.034,.003,.0003/ DATA XEXC3/9.60,10.0,12.0,14.0,17.0,20.0,25.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,140.,200.,250.,300.,400., /500.,700.,1000.,10000.,100000./ DATA YEXC3/0.00,.036,0.26,0.76,1.44,2.23,3.20,3.87,4.40,4.40, /3.81,3.41,2.88,2.65,2.33,1.59,1.14,0.88,0.76,0.56, /0.44,0.33,0.25,.025,.0025/ NAME='N2O (2004)' C ---------------------------------------------------------------------- C DRIFT DIFFUSION AND TOWNSEND EXP DATA: C PACK VOSHALL AND PHELPS PHYS.REV. 127 (1962) 2084 C YOSHIDA SASAKI ET AL J.PHYS.D 32 (1999) 862 C C UPDATE OF HAYASHI X-SECTIONS INCLUDING NEW X-SECTION MEASUREMENTS BY: C KITAJIMA SAKAMOTO GULLEY BUCKMAN ET AL J.PHYS.B 33(2000) 1687 C AKTHER ET AL J.PHYS.B 35(2002) L481 C --------------------------------------------------------------------- C MOD OF 2003 DATA TO INCLUDE DIPOLE ROTATIONAL TRANSITIONS. C USED LINEAR UNSYMMETRIC ROTOR MODEL. C USED ANISOTROPIC ANGULAR BORN DIPOLE ROTATIONAL SCATTERING C --------------------------------------------------------------------- C SCALEAT = SCALE FACTOR TO ALLOW FOR DEATTACHMENT COLLISIONS C SET SCALE =0.0 FOR COMPLETE DEATTACHMENT C SET SCALE =1.0 FOR NO DEATTACHMENT C --------------------------------------------------------------------- SCALEAT=1.0 C AMPV2=0.06 AMPV1=0.24 AMPV3=0.12 AMPV3=0.18 ARESV2=2.65 ARESV1=2.55 ARESV3=0.30 ARES2V1=0.95 ARESVR=0.62 NIN=131 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN KIN(J)=0 2 IF(J.LE.120) KIN(J)=1 NDATA=69 NION=47 NATT=51 NVIBH=19 NVIBR=19 NEXC1=28 NEXC2=24 NEXC3=25 E(1)=0.0 E(2)=2.0*EMASS/(44.01288*AMU) E(3)=12.886 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=12.886 C B0 IS ROTATIONAL CONSTANT AND DBA IS DIPOLE MOMENT C DRAT IS RATIO OF MOMENTUM TRANSFER TO TOTAL X-SECTION FOR DIPOLE C -------------------------------------------------------------------- B0=5.185D-5 DBA=0.06326 DRAT=0.25 A0=0.5291772083D-8 RY=13.60569172 DBK=8.37758*RY*(DBA*A0)**2 C -------------------------------------------------------------- C CALCULATE ROTATIONAL STATE POPULATION AT TEMPERATURE AKT DO 3 K=1,60 3 PJ(K)=(2*K+1)*EXP(-K*(K+1)*B0/AKT) SUM=1.0D0 DO 4 K=1,60 4 SUM=SUM+PJ(K) FROT0=1.0D0/SUM DO 5 K=1,60 5 PJ(K)=PJ(K)/SUM C CALCULATE ROTATIONAL TRANSITION ENERGIES DO 6 K=1,60 J=K-1 EIN(K+60)=B0*2*(J+1) 6 EIN(K)=-EIN(K+60) EIN(121)=-0.073 EIN(122)=0.073 EIN(123)=-0.15932 EIN(124)=0.15932 EIN(125)=0.27717 EIN(126)=0.318 EIN(127)=0.477 EIN(128)=0.636 EIN(129)=4.06 EIN(130)=8.50 EIN(131)=9.60 APOPV2=EXP(EIN(121)/AKT) APOPV1=EXP(EIN(123)/AKT) C IF(LBMCPR)WRITE(LUNOUT,99) FROT0,(PJ(J),J=1,60) C 99 FORMAT(2X,'POP OF STATES=',/,10(2X,D10.3)) C IF(LBMCPR)WRITE(LUNOUT,98) (EIN(J),J=1,140) C 98 FORMAT(2X,'TRANS ENERGY=',/,10(2X,D10.3)) SCRPT(1)=' ' SCRPT(2)=' ELASTIC NITROUS OXIDE ' SCRPT(3)=' IONISATION ELOSS= 12.886 ' SCRPT(4)=' ATTACHMENT (NO DEATTACHMENT) ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 1-0 ELOSS= -0.00010' SCRPT(8)=' ROT 2-1 ELOSS= -0.00021' SCRPT(9)=' ROT 3-2 ELOSS= -0.00031' SCRPT(10)=' ROT 4-3 ELOSS= -0.00041' SCRPT(11)=' ROT 5-4 ELOSS= -0.00052' SCRPT(12)=' ROT 6-5 ELOSS= -0.00062' SCRPT(13)=' ROT 7-6 ELOSS= -0.00073' SCRPT(14)=' ROT 8-7 ELOSS= -0.00083' SCRPT(15)=' ROT 9-8 ELOSS= -0.00093' SCRPT(16)=' ROT 10-9 ELOSS= -0.00104' SCRPT(17)=' ROT 11-10 ELOSS= -0.00114' SCRPT(18)=' ROT 12-11 ELOSS= -0.00124' SCRPT(19)=' ROT 13-12 ELOSS= -0.00135' SCRPT(20)=' ROT 14-13 ELOSS= -0.00145' SCRPT(21)=' ROT 15-14 ELOSS= -0.00156' SCRPT(22)=' ROT 16-15 ELOSS= -0.00166' SCRPT(23)=' ROT 17-16 ELOSS= -0.00176' SCRPT(24)=' ROT 18-17 ELOSS= -0.00187' SCRPT(25)=' ROT 19-18 ELOSS= -0.00197' SCRPT(26)=' ROT 20-19 ELOSS= -0.00207' SCRPT(27)=' ROT 21-20 ELOSS= -0.00218' SCRPT(28)=' ROT 22-21 ELOSS= -0.00228' SCRPT(29)=' ROT 23-22 ELOSS= -0.00239' SCRPT(30)=' ROT 24-23 ELOSS= -0.00249' SCRPT(31)=' ROT 25-24 ELOSS= -0.00259' SCRPT(32)=' ROT 26-25 ELOSS= -0.00270' SCRPT(33)=' ROT 27-26 ELOSS= -0.00280' SCRPT(34)=' ROT 28-27 ELOSS= -0.00290' SCRPT(35)=' ROT 29-28 ELOSS= -0.00301' SCRPT(36)=' ROT 30-29 ELOSS= -0.00311' SCRPT(37)=' ROT 31-30 ELOSS= -0.00321' SCRPT(38)=' ROT 32-31 ELOSS= -0.00332' SCRPT(39)=' ROT 33-32 ELOSS= -0.00342' SCRPT(40)=' ROT 34-33 ELOSS= -0.00353' SCRPT(41)=' ROT 35-34 ELOSS= -0.00363' SCRPT(42)=' ROT 36-35 ELOSS= -0.00373' SCRPT(43)=' ROT 37-36 ELOSS= -0.00384' SCRPT(44)=' ROT 38-37 ELOSS= -0.00394' SCRPT(45)=' ROT 39-38 ELOSS= -0.00404' SCRPT(46)=' ROT 40-39 ELOSS= -0.00415' SCRPT(47)=' ROT 41-40 ELOSS= -0.00425' SCRPT(48)=' ROT 42-41 ELOSS= -0.00436' SCRPT(49)=' ROT 43-42 ELOSS= -0.00446' SCRPT(50)=' ROT 44-43 ELOSS= -0.00456' SCRPT(51)=' ROT 45-44 ELOSS= -0.00467' SCRPT(52)=' ROT 46-45 ELOSS= -0.00477' SCRPT(53)=' ROT 47-46 ELOSS= -0.00487' SCRPT(54)=' ROT 48-47 ELOSS= -0.00498' SCRPT(55)=' ROT 49-48 ELOSS= -0.00508' SCRPT(56)=' ROT 50-49 ELOSS= -0.00519' SCRPT(57)=' ROT 51-50 ELOSS= -0.00529' SCRPT(58)=' ROT 52-51 ELOSS= -0.00539' SCRPT(59)=' ROT 53-52 ELOSS= -0.00550' SCRPT(60)=' ROT 54-53 ELOSS= -0.00560' SCRPT(61)=' ROT 55-54 ELOSS= -0.00570' SCRPT(62)=' ROT 56-55 ELOSS= -0.00581' SCRPT(63)=' ROT 57-56 ELOSS= -0.00591' SCRPT(64)=' ROT 58-57 ELOSS= -0.00601' SCRPT(65)=' ROT 59-58 ELOSS= -0.00612' SCRPT(66)=' ROT 60-59 ELOSS= -0.00622' SCRPT(67)=' ROT 0-1 ELOSS= 0.00010' SCRPT(68)=' ROT 1-2 ELOSS= 0.00021' SCRPT(69)=' ROT 2-3 ELOSS= 0.00031' SCRPT(70)=' ROT 3-4 ELOSS= 0.00041' SCRPT(71)=' ROT 4-5 ELOSS= 0.00052' SCRPT(72)=' ROT 5-6 ELOSS= 0.00062' SCRPT(73)=' ROT 6-7 ELOSS= 0.00073' SCRPT(74)=' ROT 7-8 ELOSS= 0.00083' SCRPT(75)=' ROT 8-9 ELOSS= 0.00093' SCRPT(76)=' ROT 9-10 ELOSS= 0.00104' SCRPT(77)=' ROT 10-11 ELOSS= 0.00114' SCRPT(78)=' ROT 11-12 ELOSS= 0.00124' SCRPT(79)=' ROT 12-13 ELOSS= 0.00135' SCRPT(80)=' ROT 13-14 ELOSS= 0.00145' SCRPT(81)=' ROT 14-15 ELOSS= 0.00156' SCRPT(82)=' ROT 15-16 ELOSS= 0.00166' SCRPT(83)=' ROT 16-17 ELOSS= 0.00176' SCRPT(84)=' ROT 17-18 ELOSS= 0.00187' SCRPT(85)=' ROT 18-19 ELOSS= 0.00197' SCRPT(86)=' ROT 19-20 ELOSS= 0.00207' SCRPT(87)=' ROT 20-21 ELOSS= 0.00218' SCRPT(88)=' ROT 21-22 ELOSS= 0.00228' SCRPT(89)=' ROT 22-23 ELOSS= 0.00239' SCRPT(90)=' ROT 23-24 ELOSS= 0.00249' SCRPT(91)=' ROT 24-25 ELOSS= 0.00259' SCRPT(92)=' ROT 25-26 ELOSS= 0.00270' SCRPT(93)=' ROT 26-27 ELOSS= 0.00280' SCRPT(94)=' ROT 27-28 ELOSS= 0.00290' SCRPT(95)=' ROT 28-29 ELOSS= 0.00301' SCRPT(96)=' ROT 29-30 ELOSS= 0.00311' SCRPT(97)=' ROT 30-31 ELOSS= 0.00321' SCRPT(98)=' ROT 31-32 ELOSS= 0.00332' SCRPT(99)=' ROT 32-33 ELOSS= 0.00342' SCRPT(100)=' ROT 33-34 ELOSS= 0.00353' SCRPT(101)=' ROT 34-35 ELOSS= 0.00363' SCRPT(102)=' ROT 35-36 ELOSS= 0.00373' SCRPT(103)=' ROT 36-37 ELOSS= 0.00384' SCRPT(104)=' ROT 37-38 ELOSS= 0.00394' SCRPT(105)=' ROT 38-39 ELOSS= 0.00404' SCRPT(106)=' ROT 39-40 ELOSS= 0.00415' SCRPT(107)=' ROT 40-41 ELOSS= 0.00425' SCRPT(108)=' ROT 41-42 ELOSS= 0.00436' SCRPT(109)=' ROT 42-43 ELOSS= 0.00446' SCRPT(110)=' ROT 43-44 ELOSS= 0.00456' SCRPT(111)=' ROT 44-45 ELOSS= 0.00467' SCRPT(112)=' ROT 45-46 ELOSS= 0.00477' SCRPT(113)=' ROT 46-47 ELOSS= 0.00487' SCRPT(114)=' ROT 47-48 ELOSS= 0.00498' SCRPT(115)=' ROT 48-49 ELOSS= 0.00508' SCRPT(116)=' ROT 49-50 ELOSS= 0.00519' SCRPT(117)=' ROT 50-51 ELOSS= 0.00529' SCRPT(118)=' ROT 51-52 ELOSS= 0.00539' SCRPT(119)=' ROT 52-53 ELOSS= 0.00550' SCRPT(120)=' ROT 53-54 ELOSS= 0.00560' SCRPT(121)=' ROT 54-55 ELOSS= 0.00570' SCRPT(122)=' ROT 55-56 ELOSS= 0.00581' SCRPT(123)=' ROT 56-57 ELOSS= 0.00591' SCRPT(124)=' ROT 57-58 ELOSS= 0.00601' SCRPT(125)=' ROT 58-59 ELOSS= 0.00612' SCRPT(126)=' ROT 59-60 ELOSS= 0.00622' SCRPT(127)=' VIB V2 ELOSS= -0.073 ' SCRPT(128)=' VIB V2 ELOSS= 0.073 ' SCRPT(129)=' VIB V1 ELOSS= -0.159 ' SCRPT(130)=' VIB V1 ELOSS= 0.159 ' SCRPT(131)=' VIB V3 ELOSS= 0.277 ' SCRPT(132)=' VIB 2V1 ELOSS= 0.318 ' SCRPT(133)=' VIB 3V1 ELOSS= 0.477 ' SCRPT(134)=' VIB HIGH ELOSS= 0.636 ' SCRPT(135)=' EXC ELOSS= 4.06 ' SCRPT(136)=' EXC ELOSS= 8.50 ' SCRPT(137)=' EXC ELOSS= 9.60 ' EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GO TO 40 30 CONTINUE J=NION 40 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 50 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 60 IF(EN.GT.XATT(NATT)) GO TO 60 DO 51 J=2,NATT IF(EN.LE.XATT(J)) GO TO 52 51 CONTINUE J=NATT 52 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-18*SCALEAT C 60 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C---------------------------------------------------------------------- C DIPOLE BORN ROTATIONAL STATES C--------------------------------------------------------------------- ENRT=SQRT(EN) C SUPERELASTIC COLLISIONS DO 100 L=1,60 AL=DBLE(L) QIN(L,I)=PJ(L)*DBK*LOG((ENRT+SQRT(EN-EIN(L)))/(SQRT(EN-EIN(L))- /ENRT))*AL/((2.0*AL+1.0)*EN) 100 PEQIN(L,I)=0.5+(QIN(L,I)-DRAT*QIN(L,I))/QIN(L,I) C ROT 0-1 QIN(61,I)=0.0D0 IF(EN.LE.EIN(61)) GO TO 200 QIN(61,I)=FROT0*DBK*LOG((ENRT+SQRT(EN-EIN(61)))/(ENRT-SQRT(EN- /EIN(61))))/EN PEQIN(61,I)=0.5+(QIN(61,I)-DRAT*QIN(61,I))/QIN(61,I) C ROT 1-2 AND HIGHER DO 160 L=62,120 QIN(L,I)=0.0D0 IF(EN.LE.EIN(L)) GO TO 200 AL=DBLE(L-61) QIN(L,I)=PJ(L-61)*DBK*LOG((ENRT+SQRT(EN-EIN(L)))/(ENRT-SQRT(EN- /EIN(L))))*(AL+1.0)/((2.0*AL+1.0)*EN) 160 PEQIN(L,I)=0.5+(QIN(L,I)-DRAT*QIN(L,I))/QIN(L,I) C C SUPERELASTIC V2 BEND MODE 200 QIN(121,I)=0.0D0 IF(EN.LE.0.0) GO TO 325 EFAC=SQRT(1.0-(EIN(121)/EN)) QIN(121,I)=AMPV2*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIBH IF((EN+EIN(122)).LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(121,I)=QIN(121,I)+ARESV2*(EN+EIN(122))*(A*(EN+EIN(122))+B)/EN C FACTOR 0.5 FROM LEVEL DEGENERACY QIN(121,I)=0.5*QIN(121,I)*APOPV2/(1.0+APOPV2)*1.D-16 C V2 BEND MODE 325 CONTINUE QIN(122,I)=0.0D0 IF(EN.LE.EIN(122)) GO TO 350 EFAC=SQRT(1.0-(EIN(122)/EN)) QIN(122,I)=AMPV2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 330 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 340 330 CONTINUE J=NVIBH 340 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(122,I)=QIN(122,I)+ARESV2*(A*EN+B) QIN(122,I)=QIN(122,I)*1.0/(1.0+APOPV2)*1.D-16 350 CONTINUE C SUPERELASTIC V1 SYMMETRIC STRETCH QIN(123,I)=0.0D0 IF(EN.LE.0.0) GO TO 375 EFAC=SQRT(1.0-(EIN(123)/EN)) QIN(123,I)=AMPV1*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 360 J=2,NVIBH IF((EN+EIN(124)).LE.XVIBH(J)) GO TO 370 360 CONTINUE J=NVIBH 370 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(123,I)=QIN(123,I)+ARESV1*(EN+EIN(124))*(A*(EN+EIN(124))+B)/EN DO 371 J=2,NVIBR IF((EN+EIN(124)).LE.XVIBR(J)) GO TO 372 371 CONTINUE J=NVIBR 372 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(123,I)=QIN(123,I)+ARESVR*(EN+EIN(124))*(A*(EN+EIN(124))+B)/EN QIN(123,I)=QIN(123,I)*APOPV1/(1.0+APOPV1)*1.D-16 C V1 SYMMETRIC STRETCH 375 CONTINUE QIN(124,I)=0.0D0 IF(EN.LE.EIN(124)) GO TO 400 EFAC=SQRT(1.0-(EIN(124)/EN)) QIN(124,I)=AMPV1*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 380 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 390 380 CONTINUE J=NVIBH 390 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(124,I)=QIN(124,I)+ARESV1*(A*EN+B) DO 391 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 392 391 CONTINUE J=NVIBR 392 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(124,I)=QIN(124,I)+ARESVR*(A*EN+B) QIN(124,I)=QIN(124,I)*1.0/(1.0+APOPV1)*1.D-16 400 CONTINUE C V3 ASYMMETRIC STRETCH QIN(125,I)=0.0D0 IF(EN.LE.EIN(125)) GO TO 450 EFAC=SQRT(1.0-(EIN(125)/EN)) QIN(125,I)=AMPV3*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(125,I)=QIN(125,I)+ARESV3*(A*EN+B) QIN(125,I)=QIN(125,I)*1.D-16 C 2V1 SYMMETRIC STRETCH HARMONICS 450 CONTINUE QIN(126,I)=0.0D0 IF(EN.LE.EIN(126)) GO TO 500 DO 460 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 470 460 CONTINUE J=NVIBH 470 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(126,I)=ARES2V1*(A*EN+B)*1.D-16 C 3V1 SYMMETRIC STRETCH HARMONICS 500 CONTINUE QIN(127,I)=0.0D0 IF(EN.LE.EIN(127)) GO TO 550 QIN(127,I)=QIN(126,I)*0.6 C SUM OF HIGHER VIBRATIONAL HARMONICS 550 CONTINUE QIN(128,I)=0.0D0 IF(EN.LE.EIN(128)) GO TO 600 QIN(128,I)=QIN(127,I)*0.9 600 CONTINUE QIN(129,I)=0.0D0 IF(EN.LE.EIN(129)) GO TO 650 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(129,I)=(A*EN+B)*1.D-16 650 CONTINUE QIN(130,I)=0.0D0 IF(EN.LE.EIN(130)) GO TO 700 DO 660 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 670 660 CONTINUE J=NEXC2 670 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(130,I)=(A*EN+B)*1.D-16 700 CONTINUE QIN(131,I)=0.0D0 IF(EN.LE.EIN(131)) GO TO 750 DO 710 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 720 710 CONTINUE J=NEXC3 720 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(131,I)=(A*EN+B)*1.D-16 750 CONTINUE SUMROT=0.0D0 DO 800 L=1,120 800 SUMROT=SUMROT+QIN(L,I) C GET ELASTIC MOMENTUM TRANSFER Q(2,I)=Q(2,I)-SUMROT*DRAT C Q(1,I) USED ONLY FOR INFORMATION Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(121,I)+QIN(122,I)+QIN(123,I)+ /QIN(124,I)+QIN(125,I)+QIN(126,I)+QIN(127,I)+QIN(128,I)+QIN(129,I)+ /QIN(130,I)+QIN(131,I)+SUMROT*DRAT 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(131)) NIN=130 IF(EFINAL.LE.EIN(130)) NIN=129 IF(EFINAL.LE.EIN(129)) NIN=128 IF(EFINAL.LE.EIN(128)) NIN=127 IF(EFINAL.LE.EIN(127)) NIN=126 IF(EFINAL.LE.EIN(126)) NIN=125 IF(EFINAL.LE.EIN(125)) NIN=124 IF(EFINAL.LE.EIN(124)) NIN=123 END +DECK,GAS19. SUBROUTINE GAS19(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(50),YXSEC(50),XVIB1(31),YVIB1(31),XVIB2(31), /YVIB2(31),XVIB3(18),YVIB3(18),XVIB4(31),YVIB4(31),XVIB5(21), /YVIB5(21),XEXC1(17),YEXC1(17),XEXC2(24),YEXC2(24),XEXC3(23), /YEXC3(23),XION(57),YION(57),XATT(16),YATT(16) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.01,.014,0.02,.025,0.03,0.04,0.05,0.06,0.07, /0.08,0.09,0.10,0.12,0.14,0.17,0.20,0.25,0.30,0.40, /0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,10.0,14.0,20.0,30.0,40.0,50.0,70.0,100., /140.,200.,300.,400.,600.,800.,1000.,2000.,10000.,100000./ DATA YXSEC/8.40,8.40,7.80,7.20,6.60,6.00,4.90,3.90,3.00,2.70, /2.60,2.60,2.70,3.00,3.35,3.85,4.40,5.35,6.20,8.00, /9.60,11.0,13.0,14.5,16.0,17.0,17.0,16.5,16.5,17.5, /19.5,19.5,17.5,12.5,8.00,5.00,3.60,2.70,1.90,1.25, /0.85,0.58,0.37,0.27,0.17,0.12,0.10,.047,.008,.00006/ DATA XVIB1/.117,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB1/0.0,.001,.025,.044,.088,.094,.088,.063,.044,.029, /.014,.013,.038,.088,.125,.163,.212,.288,.312,.288, /.262,.125,0.10,.075,0.05,.025,0.01,.004,.0004,.000012, /.0000012/ DATA XVIB2/.166,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB2/0.00,.001,.138,0.47,2.36,3.30,2.91,2.04,1.35,0.76, /0.48,0.34,0.20,0.21,0.26,0.33,0.46,0.54,0.56,0.50, /0.41,0.23,0.18,0.14,0.10,.056,.024,0.01,.0012,.00004, /.000004/ DATA XVIB3/.333,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,10.0,100.0,1000.,10000.,100000./ DATA YVIB3/0.00,.001,.094,0.11,0.51,0.94,0.85,0.56,0.33,0.19, /.094,0.05,.025,.0012,.00012,.000012,.0000012,.00000012/ DATA XVIB4/.375,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB4/0.00,.001,.033,.056,0.34,0.54,0.50,0.40,0.29,0.20, /0.16,0.14,0.14,0.18,0.30,0.50,0.63,0.65,0.58,0.48, /0.36,0.20,0.15,0.13,0.09,0.05,.021,.009,.0011,.00004, /.000004/ DATA XVIB5/0.75,1.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB5/0.00,.0001,.001,.017,.030,0.05,0.06,.065,.058,.048, /.036,.020,.015,.012,.009,.005,.0021,.0009,.00011,.000004, /.0000004/ DATA XEXC1/3.70,3.77,4.00,4.50,5.00,6.00,7.00,8.00,9.00,10.0, /14.0,20.0,30.0,100.,1000.,10000.,100000./ DATA YEXC1/0.00,0.01,0.05,0.24,0.45,0.54,0.54,0.48,0.41,0.31, /0.12,.041,.010,.001,.0001,.00001,.000001/ DATA XEXC2/4.85,4.90,5.00,5.50,6.00,7.00,8.00,9.00,10.0,14.0, /20.0,30.0,40.0,50.0,70.0,100.,140.,200.,300.,500., /700.,1000.,10000.,100000./ DATA YEXC2/0.00,.009,.019,.056,0.23,0.56,0.80,1.08,1.30,2.17, /3.09,3.88,4.00,3.76,3.38,3.01,2.40,1.79,1.18,0.66, /0.48,0.35,0.035,.0035/ DATA XEXC3/7.10,7.15,8.00,8.50,9.00,10.0,14.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,100.,140.,200.,300.,500.,700., /1000.,10000.,100000./ DATA YEXC3/0.00,0.01,0.08,0.14,0.25,0.41,0.82,1.07,1.10,1.12, /1.00,0.94,0.80,0.72,0.49,0.35,0.25,0.17,0.10,0.07, /0.05,.005,.0005/ DATA XION/10.5,10.55,11.0,11.5,12.0,12.5,13.0,13.5,14.0,14.5, /15.0,16.0,17.0,18.0,19.0,21.0,22.0,24.0,26.0,28.0, /30.0,32.0,34.0,36.0,38.0,40.0,45.0,50.0,60.0,70.0, /80.0,90.0,100.,120.,140.,150.,175.,200.,250.,300., /350.,400.,450.,500.,600.,700.,800.,900.,1000.,1250., /1500.,1750.,2000.,2500.,3000.,10000.,100000./ DATA YION/0.00,.011,.045,.087,.134,.193,.263,.345,.431,.533, /.641,.861,1.06,1.27,1.49,1.90,2.09,2.44,2.95,3.25, /3.52,3.76,3.98,4.18,4.35,4.50,4.80,5.07,5.47,5.69, /5.80,5.83,5.79,5.66,5.42,5.20,4.80,4.58,3.92,3.56, /3.18,2.87,2.64,2.45,2.19,1.96,1.75,1.63,1.52,1.28, /1.11,1.03,.908,.767,.678,0.26,.045/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ NAME='C2H4 (1999)' C --------------------------------------------------------------------- C 1999 INCLUDED VIBRATIONAL RESONACE SHAPE FROM WALKER ET AL C REF J.CHEM.PHYS. 69(1978) 5532 C NOW FITS ARGON-ETHENE MIXTURE DATA OF JEAN-MARIE ET AL. C AND SCHMIDTS DATA IN PURE ETHENE C --------------------------------------------------------------------- NIN=10 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=50 NVIB1=31 NVIB2=31 NVIB3=18 NVIB4=31 NVIB5=21 NEXC1=17 NEXC2=24 NEXC3=23 NION=57 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(28.05376*AMU) E(3)=10.5 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.5 EIN(1)=-0.117 EIN(2)=0.117 EIN(3)=-0.166 EIN(4)=0.166 EIN(5)=0.333 EIN(6)=0.375 EIN(7)=0.750 EIN(8)=3.70 EIN(9)=4.85 EIN(10)=7.10 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ETHENE ' SCRPT(3)=' IONISATION ELOSS= 10.5 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V7 ELOSS= -0.117 ' SCRPT(8)=' VIB V7 ELOSS= 0.117 ' SCRPT(9)=' VIB V2+V3 ELOSS= -0.166 ' SCRPT(10)=' VIB V2+V3 ELOSS= 0.166 ' SCRPT(11)=' VIB 2V3+2V2 ELOSS= 0.333 ' SCRPT(12)=' VIB V1 ELOSS= 0.375 ' SCRPT(13)=' VIB 2V1 ELOSS= 0.750 ' SCRPT(14)=' EXC ELOSS= 3.70 ' SCRPT(15)=' EXC ELOSS= 4.85 ' SCRPT(16)=' EXC ELOSS= 7.10 ' AMP1=0.091 AMP2=0.091 AMP3=0.10 APOP=EXP(EIN(1)/AKT) APOPH=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 C 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C V7 SUPERELASTIC QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V7 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=QIN(2,I)+(A*EN+B) QIN(2,I)=QIN(2,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 4150 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 4120 4110 CONTINUE J=NVIB2 4120 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V2 + V3 (SUM OF VIBRATIONS AT 166 AND 201 MV) QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 450 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3+2V2 (HARMONICS) QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 460 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 470 460 CONTINUE J=NVIB3 470 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 550 EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP3*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 600 DO 560 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 570 560 CONTINUE J=NVIB5 570 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 899 DO 810 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 820 810 CONTINUE J=NEXC3 820 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(10,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS20. SUBROUTINE GAS20(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(58),YXSEC(58),XVIB1(37),YVIB1(37),XVIB2(27), /YVIB2(27),XVIB3(27),YVIB3(27),XEXC1(28),YEXC1(28),XEXC2(17), /YEXC2(17),XEXC3(32),YEXC3(32),XION(42),YION(42), /XATT(16),YATT(16) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08,0.09, /0.10,0.12,0.14,0.17,0.20,0.25,0.30,0.40,0.50,0.60, /0.80,1.00,1.20,1.40,1.70,2.00,2.50,3.00,4.00,5.00, /6.00,7.00,8.00,9.00,10.0,12.0,14.0,17.0,20.0,30.0, /40.0,50.0,60.0,70.0,80.0,90.0,100.,120.,140.,170., /200.,300.,400.,600.,800.,1000.,10000.,100000./ DATA YXSEC/10.5,10.3,9.85,9.60,9.50,9.45,9.45,9.55,9.75,9.95, /10.1,10.2,10.3,10.4,10.5,10.8,11.2,12.3,13.4,14.5, /16.7,18.5,20.3,22.0,24.5,27.0,27.0,23.0,18.0,17.0, /16.5,16.0,15.0,14.0,13.0,11.0,10.0,7.80,6.60,4.10, /2.95,2.30,1.85,1.55,1.30,1.15,1.00,0.85,0.72,0.57, /0.48,0.31,0.22,0.14,0.10,0.07,.007,.0007/ C V5 DATA XVIB1/.0904,.092,.095,0.10,0.11,0.12,0.14,0.17,0.20,0.25, /0.30,0.40,0.50,0.60,0.80,1.00,1.20,1.40,1.70,2.00, /2.50,3.00,4.00,5.00,6.00,7.00,8.00,10.0,12.0,14.0, /20.0,30.0,50.0,100.,1000.,10000.,100000./ DATA YVIB1/0.0,1.32,2.15,2.95,3.75,4.15,4.50,4.50,4.35,4.05, /3.70,3.20,2.90,2.60,2.30,2.05,1.80,1.70,1.70,1.85, /2.00,1.65,1.10,0.80,0.60,0.50,0.40,0.28,0.24,0.21, /.155,.110,.070,.038,.0038,.00038,.000038/ C 2V5 DATA XVIB2/0.18,0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.20,1.40,1.70,2.00,2.50,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.01,.015,0.02,.023,.026,0.03,.035,0.04,0.05, /0.07,0.11,0.26,0.64,1.27,1.00,0.35,0.15,0.08,0.04, /.025,.015,.011,.001,.0001,.00001,.000001/ C V3 DATA XVIB3/.408,.412,0.43,0.45,0.50,0.60,0.70,0.80,0.90,1.00, /1.20,1.40,1.70,2.00,2.50,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,.018,0.15,0.22,0.35,0.49,0.56,0.57,0.57,0.56, /0.52,0.51,0.54,0.77,1.01,0.86,0.31,0.20,0.17,.156, /.141,.129,.119,.018,.0018,.00018,.000018/ C DATA XEXC1/1.95,1.97,2.00,2.20,2.50,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,12.0,14.0,20.0,25.0,30.0,40.0,50.0, /70.0,100.,140.,200.,400.,1000.,10000.,100000./ DATA YEXC1/0.00,.009,0.09,0.50,0.80,0.89,0.85,0.74,0.61,0.52, /0.45,0.40,0.36,0.30,0.26,0.18,0.14,0.12,0.09,.072, /.055,.036,.027,.018,.009,.004,.0004,.00004/ C DATA XEXC2/4.90,5.00,6.00,7.00,8.00,9.00,10.0,12.0,14.0,17.0, /20.0,25.0,30.0,100.,1000.,10000.,100000./ DATA YEXC2/0.00,0.01,0.10,0.19,0.29,0.33,0.35,0.34,0.28,0.17, /.095,0.03,.008,.001,.0001,.00001,.000001/ C DATA XEXC3/7.90,8.00,8.20,8.50,8.80,9.00,10.0,12.0,14.0,17.0, /20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100., /120.,140.,170.,200.,250.,300.,400.,600.,800.,1000., /10000.,100000./ DATA YEXC3/0.00,0.01,0.17,0.35,0.75,1.25,1.95,2.50,2.60,2.80, /2.85,2.85,2.80,2.65,2.35,2.00,1.75,1.55,1.40,1.25, /1.00,0.90,0.74,0.61,0.48,0.40,0.30,0.20,0.15,.125, /.013,.0013/ C DATA XION/11.42,11.5,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100., /120.,140.,170.,200.,250.,300.,400.,500.,600.,700., /800.,900.,1000.,1500.,2000.,4000.,6000.,8000.,10000.,20000., /40000.,100000./ DATA YION/0.00,.019,.095,.280,.484,.725,.931,1.13,1.31,1.47, /1.63,2.66,3.32,4.05,4.41,4.61,4.70,4.73,4.72,4.67, /4.50,4.32,4.00,3.73,3.33,2.99,2.49,2.13,1.86,1.64, /1.47,1.30,1.23,.908,.720,.405,.287,.223,.184,.100, /.054,.023/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ NAME='C2H2 (2002)' C --------------------------------------------------------------------- C FIT TO DRIFT VELOCITY AND TRANSVERSE DIFFUSION IN PURE GAS : C DUNCAN AND WALKER J.CHEM.SOC (LONDON) 68 (1972) 1800 C ARGON MIXTURE DATA ( DRIFT VELOCITY ONLY) : C CHRISTOPHOROU ET AL NUCL.INST.METH. 163(1979)141 C TOWNSEND COEFICIENT : HEYLEN C --------------------------------------------------------------------- NIN=7 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=58 NVIB1=37 NVIB2=27 NVIB3=27 NEXC1=28 NEXC2=17 NEXC3=32 NION=42 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(26.03788*AMU) E(3)=11.42 C CORRECT ENERGY E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.0 EIN(1)=-.0904 EIN(2)=0.0904 EIN(3)=0.180 EIN(4)=0.408 EIN(5)=1.95 EIN(6)=4.90 EIN(7)=7.90 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ACETYLENE ' SCRPT(3)=' IONISATION ELOSS= 11.42 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V5 ELOSS= -0.0904 ' SCRPT(8)=' VIB V5 ELOSS= 0.0904 ' SCRPT(9)=' VIB 2V5 ELOSS= 0.180 ' SCRPT(10)=' VIB V3 ELOSS= 0.408 ' SCRPT(11)=' EXC ELOSS= 1.95 ' SCRPT(12)=' EXC ELOSS= 4.90 ' SCRPT(13)=' EXC ELOSS= 7.90 ' EN=-ESTEP/2.0D0 APOPV5=EXP(EIN(1)/AKT) DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC V5 QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 330 DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN C FACTOR 0.5 FROM DENSITY OF STATES QIN(1,I)=0.5*QIN(1,I)*APOPV5/(1.0+APOPV5) 330 CONTINUE C V5 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 370 DO 350 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 360 350 CONTINUE J=NVIB1 360 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.D-16 QIN(2,I)=QIN(2,I)/(1.0+APOPV5) 370 CONTINUE C 2V5 QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.D-16 430 CONTINUE C V3 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 470 DO 450 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 460 450 CONTINUE J=NVIB3 460 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.D-16 470 CONTINUE C QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 530 DO 510 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 520 510 CONTINUE J=NEXC1 520 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(5,I)=(A*EN+B)*1.D-16 530 CONTINUE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 570 DO 550 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 560 550 CONTINUE J=NEXC2 560 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(6,I)=(A*EN+B)*1.D-16 570 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 630 DO 610 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 620 610 CONTINUE J=NEXC3 620 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(7,I)=(A*EN+B)*1.D-16 630 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LT.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS21. SUBROUTINE GAS21(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(57),YXSEC(57),XROT0(57),YROT0(57),XROT1(47),YROT1(47 /),XROT2(32),YROT2(32),XROT3(32),YROT3(32),XVIB1(40),YVIB1(40), /XVIB2(39),YVIB2(39),XVIB3(16),YVIB3(16),XVIB4(15),YVIB4(15), /XEXC1(20),YEXC1(20),XEXC2(23),YEXC2(23),XATT(18),YATT(18), /XION(72),YION(72),PJ(5) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C -------------------------------------------------------------- C ELASTIC MT DATA XEN/0.00,.001,.003,.005,.007,0.01,0.02,0.03,0.04,.046, /0.05,0.06,0.07,0.08,0.09,0.10,0.13,0.15,0.20,0.30, /0.40,0.50,0.60,0.70,0.90,1.00,1.10,1.40,1.50,1.60, /1.80,2.00,2.50,3.00,4.00,5.00,6.00,8.00,10.0,15.0, /20.0,30.0,40.0,50.0,60.0,80.0,100.,150.,200.,300., /400.,500.,600.,800.,1000.,10000.,100000./ DATA YXSEC/7.20,7.25,7.35,7.45,7.56,7.72,8.14,8.56,8.98,9.10, /9.27,9.53,9.79,10.04,10.25,10.47,11.08,11.43,12.06,13.00, /13.71,14.45,15.19,15.64,16.14,16.47,16.84,18.10,18.42,18.59, /18.15,17.90,17.30,16.40,13.80,11.80,9.800,7.20,5.10,2.80, /1.80,0.95,0.64,0.45,0.34,0.22,0.15,0.07,.043,.022, /.014,.010,.006,.004,.002,.0002,.00002/ C----------------------------------------------------------------------- C ROTATION J=0-2 DATA XROT0/.0439,.046,.047,.048,.049,.050,.051,.054,.055, /.060, /.065,.070,.080,.090,0.10,0.11,0.12,0.13,0.14,0.15, /0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.55,0.60,0.65, /0.70,0.80,0.90,1.00,1.10,1.20,1.35,1.50,1.75,2.00, /2.50,3.00,3.50,4.00,4.50,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YROT0/0.00,.0206,.0276,.0286,.0297,.0308,.0310,.0330,.0340, /.0394, /.0452,.0507,.0614,.0680,.0740,.0790,.0835,.088,.0925,.0970, /.115,.132,.152,.175,.200,.228,.260,.291,.323,.359, /.394,.469,.555,.636,.716,.796,.916,1.036,1.203,1.370, /1.585,1.704,1.755,1.758,1.732,1.689,1.579,1.462,1.350,1.248, /1.156,0.730,0.44,0.05,.0015,.0005,.00015/ C----------------------------------------------------------------------- C ROTATION J=1-3 DATA XROT1/0.0727,.075,.080,.085,.090,.095,0.10,0.11,0.12,0.13, /0.15,0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.56,0.60, /0.66,0.70,0.80,0.90,1.01,1.20,1.40,1.60,1.80,2.00, /2.50,3.00,3.50,4.00,4.50,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YROT1/0.00,.0085,.0149,.0203,.0238,.0266,.0282,.0351,.0403, /.0449,.0520,.0604,.0719,.0870,.1029,.1191,.1361,.1543,.1773,.1944, /.2212,.2396,.2839,.3328,.3842,.489,.569,.658,.743,.818, /.952,1.020,1.046,1.050,1.036,1.011,.946,.876,.809,.748, /.694,.440,.265,0.03,0.001,.0001,.00001/ C----------------------------------------------------------------------- C ROTATION J=2-4 (ALSO USE THESE VALUES FOR 4-6 TRANSITION) DATA XROT2/0.1008,0.15,0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.60, /0.70,0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00, /4.50,5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000., /10000.,100000./ DATA YROT2/0.00,.0249,.0367,.0475,.0577,.0694,.0834,.1003,.1192, /.145,.178,.216,.256,.299,.436,.543,.600,.649,.670,.672, /.662,.646,.627,.605,.561,.517,.444,0.17,.017,.0007, /.00007,.000007/ C----------------------------------------------------------------------- C ROTATION J=3-5 (ALSO USE THESE VALUES FOR 5-7 TRANSITION) DATA XROT3/0.1280,0.15,0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.60, /0.70,0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00, /4.50,5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000., /10000.,100000./ DATA YROT3/0.00,.019,.033,.043,.050,.058,.066,.075,.085,.104, /.128,.154,.185,.214,.334,.565,.700,.750,.825,.828, /.818,.797,.774,.747,.692,.640,.548,0.18,0.02,.0007, /.00007,.000007/ C----------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=0 ROTATIONALLY ELASTIC DATA XVIB1/0.516,0.56,0.58,0.60,0.65,0.75,0.85,0.95,1.00,1.05, /1.10,1.15,1.20,1.30,1.40,1.60,1.80,2.20,2.40,2.60, /3.00,3.50,4.00,4.50,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,12.0,13.0,14.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,.0007,.0025,.0063,.0070,.0103,.0164,.0269,.0331, /.0386,.0435,.0483,.0525,.0626,.0707,.0926,.1166,.1556,.1635,.1719, /.1916,.2008,.1860,.1630,.1460,.1160,.0876,.0637,.0506,.0376, /.0292,.0215,.0180,.0170,.0150,.0092,.0018,.00006,.000006,.0000007/ C----------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=2 ROTATIONALLY INELASTIC DATA XVIB2/0.558,.575,0.60,0.65,0.75,0.85,0.95,1.00,1.05,1.10, /1.15,1.20,1.30,1.40,1.60,1.80,2.20,2.40,2.60,3.00, /3.50,4.00,4.50,5.00,6.00,7.00,8.00,9.00,10.0,11.0, /12.0,13.0,14.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,.0002,.0016,.0027,.0056,.0107,.0197,.0255,.0305, /.0356,.0408,.0459,.0579,.0671,.0954,.1279,.1829,.1963,.2141,.2494, /.2672,.2540,.2270,.2040,.1640,.1224,.0879,.0684,.0498,.0388, /.0285,.0200,.0150,.0100,.0062,.0012,.00004,.000004,.0000004/ C----------------------------------------------------------------------- C VIBRATION V=0-2 DATA XVIB3/1.023,1.34,1.50,2.00,3.00,4.00,5.00,6.00,8.00,10.0, /15.0,20.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,.001,.002,.014,.035,.037,.035,.029,.021,.014, /.002,.001,.0003,.00001,.000001,.0000001/ C----------------------------------------------------------------------- C VIBRATION V=0-3 DATA XVIB4/1.480,1.95,2.00,3.00,4.00,5.00,6.00,8.00,10.0,15.0, /20.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,.001,.0012,.0036,.0037,.0035,.0027,.0019,.0012, /.0002,.0001,.00003,.000001,.0000001,.00000001/ C----------------------------------------------------------------------- C EXCITATION TO TRIPLET STATES (DISSOCIATION) DATA XEXC1/8.85,8.92,9.34,10.0,11.0,12.0,15.0,20.0,25.0,30.0, /40.0,50.0,60.0,80.0,100.,150.,200.,1000.,10000.,100000./ DATA YEXC1/0.00,0.01,0.05,0.10,0.23,0.42,0.64,0.57,0.35,0.23, /0.10,.051,.031,.013,.006,.0015,.0006,.0001,.00002,.000004/ C EXCITATION TO SINGLET STATES DATA XEXC2/12.0,12.13,13.4,15.0,17.0,20.0,25.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,400.,500.,600.,800., /1000.,10000.,100000./ DATA YEXC2/0.00,0.10,0.10,0.27,0.44,0.64,0.95,1.12,1.19,1.23, /1.26,1.17,1.10,0.88,0.78,0.64,0.55,0.47,0.42,0.34, /0.27,0.06,.015/ C----------------------------------------------------------------------- DATA XATT/7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /17.0,18.0,30.0,60.0,100.,1000.,10000.,100000./ DATA YATT/0.00,.000032,.00009,.000128,.000118,.000075,.000052, /.00021,.000087,.000085,.00009,.0001,.00005,.00002,.00001, /.000001,.0000001,.00000001/ C----------------------------------------------------------------------- DATA XION/15.427,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /20.5,21.0,21.5,22.0,22.5,23.0,23.5,24.0,24.5,25.0, /25.5,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000., /10000.,100000./ DATA YION/0.00,.0299,.0607,.0924,.123,.156,.187,.220,.249,.280, /.310,.336,.362,.390,.413,.439,.461,.484,.505,.524, /.544,.563,.632,.688,.736,.776,.812,.840,.866,.913, /.941,.959,.968,.971,.971,.970,.964,.958,.948,.934, /.924,.916,.903,.891,.878,.864,.853,.844,.830,.821, /.813,.790,.752,.715,.636,.573,.518,.476,.438,.406, /.378,.354,.334,.315,.298,.283,.271,.260,.250,.240, /.060,.015/ C---------------------------------------------------------------------- NAME='H2 (2001)' C -------------------------------------------------------------------- C CALCULATE FRACTIONAL POPULATION DENSITY FOR ROTATIONAL STATES B0=0.00753936 DO 111 K=1,5,2 111 PJ(K)=3*(2*K+1)*EXP(-K*(K+1)*B0/AKT) DO 112 K=2,4,2 112 PJ(K)=(2*K+1)*EXP(-K*(K+1)*B0/AKT) SUM=1.0 DO 113 K=1,5 113 SUM=SUM+PJ(K) FROT0=1.0/SUM FROT1=PJ(1)/SUM FROT2=PJ(2)/SUM FROT3=PJ(3)/SUM FROT4=PJ(4)/SUM FROT5=PJ(5)/SUM C IF(LBMCPR)WRITE(LUNOUT,88) FROT0,FROT1,FROT2,FROT3,FROT4,FROT5 C 88 FORMAT(3X,' FROT0=',F9.6,' FROT1=',F9.6,' FROT2=',F9.6,' FROT3=', C /F9.6,' FROT4=',F9.6,' FROT5=',F9.6) C----------------------------------------------------------------------- NIN=14 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=57 NROT0=57 NROT1=47 NROT2=32 NROT3=32 NVIB1=40 NVIB2=39 NVIB3=16 NVIB4=15 NEXC1=20 NEXC2=23 NION=72 NATT=18 E(1)=0.0 E(2)=2.0*EMASS/(2.015650*AMU) E(3)=15.427 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=8.30 EIN(1)=-.0439 EIN(2)=-.0727 EIN(3)=-.1008 EIN(4)=-.128 EIN(5)=0.0439 EIN(6)=0.0727 EIN(7)=0.1008 EIN(8)=0.128 EIN(9)=0.516 EIN(10)=0.558 EIN(11)=1.023 EIN(12)=1.480 EIN(13)=8.85 EIN(14)=12.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC HYDROGEN ' SCRPT(3)=' IONISATION ELOSS= 15.427 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 2-0 ELOSS= -0.0439 ' SCRPT(8)=' ROT 3-1 ELOSS= -0.0727 ' SCRPT(9)=' ROT 4-2 ELOSS= -0.1008 ' SCRPT(10)=' ROT 5-3 ELOSS= -0.128 ' SCRPT(11)=' ROT 0-2 ELOSS= 0.0439 ' SCRPT(12)=' ROT 1-3 ELOSS= 0.0727 ' SCRPT(13)=' ROT 2-4 + 4-6 ELOSS= 0.1008 ' SCRPT(14)=' ROT 3-5 + 5-7 ELOSS= 0.128 ' SCRPT(15)=' VIB V1 DJ=0 ELOSS= 0.516 ' SCRPT(16)=' VIB V1 DJ=2 ELOSS= 0.558 ' SCRPT(17)=' VIB 2V1 ELOSS= 1.023 ' SCRPT(18)=' VIB 3V1 ELOSS= 1.480 ' SCRPT(19)=' EXC TRPLT ELOSS= 8.85 ' SCRPT(20)=' EXC SNGLT ELOSS= 12.0 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 CONTINUE C Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 CONTINUE Q(5,I)=0.0D0 Q(6,I)=0.0D0 C--------------------------------------------------------------------- C SUPERELASTIC 2-0 QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 1100 DO 1010 J=2,NROT0 IF((EN+EIN(5)).LE.XROT0(J)) GO TO 1020 1010 CONTINUE J=NROT0 1020 A=(YROT0(J)-YROT0(J-1))/(XROT0(J)-XROT0(J-1)) B=(XROT0(J-1)*YROT0(J)-XROT0(J)*YROT0(J-1))/(XROT0(J-1)-XROT0(J)) QIN(1,I)=FROT2*0.2*(EN+EIN(5))*(A*(EN+EIN(5))+B)*1.D-16/EN 1100 CONTINUE C SUPERELASTIC 3-1 QIN(2,I)=0.0D0 IF(EN.LE.0.0) GO TO 1200 DO 1110 J=2,NROT1 IF((EN+EIN(6)).LE.XROT1(J)) GO TO 1120 1110 CONTINUE J=NROT1 1120 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(2,I)=FROT3*(3.0/7.0)*(EN+EIN(6))*(A*(EN+EIN(6))+B)*1.D-16/EN 1200 CONTINUE C SUPERELASTIC 4-2 QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 1250 DO 1210 J=2,NROT2 IF((EN+EIN(7)).LE.XROT2(J)) GO TO 1220 1210 CONTINUE J=NROT2 1220 A=(YROT2(J)-YROT2(J-1))/(XROT2(J)-XROT2(J-1)) B=(XROT2(J-1)*YROT2(J)-XROT2(J)*YROT2(J-1))/(XROT2(J-1)-XROT2(J)) QIN(3,I)=FROT4*(5.0/9.0)*(EN+EIN(7))*(A*(EN+EIN(7))+B)*1.D-16/EN 1250 CONTINUE C SUPERELASTIC 5-3 QIN(4,I)=0.0D0 IF(EN.LE.0.0) GO TO 1290 DO 1260 J=2,NROT3 IF((EN+EIN(8)).LE.XROT3(J)) GO TO 1270 1260 CONTINUE J=NROT3 1270 A=(YROT3(J)-YROT3(J-1))/(XROT3(J)-XROT3(J-1)) B=(XROT3(J-1)*YROT3(J)-XROT3(J)*YROT3(J-1))/(XROT3(J-1)-XROT3(J)) QIN(4,I)=FROT5*(7.0/11.)*(EN+EIN(8))*(A*(EN+EIN(8))+B)*1.D-16/EN 1290 CONTINUE C ROTATION 0-2 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 1400 DO 1310 J=2,NROT0 IF(EN.LE.XROT0(J)) GO TO 1320 1310 CONTINUE J=NROT0 1320 A=(YROT0(J)-YROT0(J-1))/(XROT0(J)-XROT0(J-1)) B=(XROT0(J-1)*YROT0(J)-XROT0(J)*YROT0(J-1))/(XROT0(J-1)-XROT0(J)) QIN(5,I)=(A*EN+B)*1.D-16*FROT0 1400 CONTINUE C ROTATION 1-3 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 1401 DO 1311 J=2,NROT1 IF(EN.LE.XROT1(J)) GO TO 1321 1311 CONTINUE J=NROT1 1321 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(6,I)=(A*EN+B)*1.D-16*FROT1 1401 CONTINUE C ROTATION 2-4 +4-6 QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 1402 DO 1312 J=2,NROT2 IF(EN.LE.XROT2(J)) GO TO 1322 1312 CONTINUE J=NROT2 1322 A=(YROT2(J)-YROT2(J-1))/(XROT2(J)-XROT2(J-1)) B=(XROT2(J-1)*YROT2(J)-XROT2(J)*YROT2(J-1))/(XROT2(J-1)-XROT2(J)) QIN(7,I)=(A*EN+B)*1.D-16*(FROT2+FROT4) 1402 CONTINUE C ROTATION 3-5 +5-7 QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 1403 DO 1313 J=2,NROT3 IF(EN.LE.XROT3(J)) GO TO 1323 1313 CONTINUE J=NROT3 1323 A=(YROT3(J)-YROT3(J-1))/(XROT3(J)-XROT3(J-1)) B=(XROT3(J-1)*YROT3(J)-XROT3(J)*YROT3(J-1))/(XROT3(J-1)-XROT3(J)) QIN(8,I)=(A*EN+B)*1.D-16*(FROT3+FROT5) 1403 CONTINUE C----------------------------------------------------------------------- QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(9,I)=(A*EN+B)*1.D-16 400 CONTINUE C QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(10,I)=(A*EN+B)*1.D-16 500 CONTINUE C QIN(11,I)=0.0D0 IF(EN.LE.EIN(11)) GO TO 501 DO 411 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 421 411 CONTINUE J=NVIB3 421 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(11,I)=(A*EN+B)*1.D-16 501 CONTINUE C QIN(12,I)=0.0D0 IF(EN.LE.EIN(12)) GO TO 502 DO 412 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 422 412 CONTINUE J=NVIB4 422 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(12,I)=(A*EN+B)*1.D-16 502 CONTINUE C----------------------------------------------------------------------- QIN(13,I)=0.0D0 IF(EN.LE.EIN(13)) GO TO 600 DO 510 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 520 510 CONTINUE J=NEXC1 520 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(13,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(14,I)=0.0D0 IF(EN.LE.EIN(14)) GO TO 700 DO 610 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 620 610 CONTINUE J=NEXC2 620 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(14,I)=(A*EN+B)*1.D-16 700 CONTINUE C--------------------------------------------------------------------- Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I)+ /QIN(12,I)+QIN(13,I)+QIN(14,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(14)) NIN=13 IF(EFINAL.LE.EIN(13)) NIN=12 IF(EFINAL.LE.EIN(12)) NIN=11 IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS22. SUBROUTINE GAS22(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(53),YXSEC(53),XROT0(40),YROT0(40),XROT1(42),YROT1(42 /),XROT2(31),YROT2(31),XROT3(31),YROT3(31),XROT4(31),YROT4(31), /XROT5(30),YROT5(30),XVIB1(35),YVIB1(35),XVIB2(35),YVIB2(35), /XVIB3(16),YVIB3(16),XVIB4(16),YVIB4(16),XEXC1(20),YEXC1(20), /XEXC2(23),YEXC2(23),XATT(18),YATT(18),XION(72),YION(72),PJ(7) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.01,0.02,0.03,0.04,.046,0.05,0.06,0.07,0.08, /0.09,0.10,0.13,0.15,0.20,0.30,0.40,0.50,0.60,0.70, /0.90,1.00,1.10,1.40,1.50,1.60,1.80,2.00,2.50,3.00, /4.00,5.00,6.00,8.00,10.0,15.0,20.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,400.,500.,600.,800., /1000.,10000.,100000./ DATA YXSEC/6.36,7.26,7.95,8.45,8.91,9.05,9.22,9.50,9.79,10.04, /10.24,10.44,10.93,11.33,11.93,12.92,13.82,14.61,15.51,16.20, /16.9,17.2,17.3,17.7,17.7,17.8,17.7,17.5,16.8,16.1, /14.2,13.5,13.2,12.3,11.2,7.30,4.30,1.60,0.77,0.50, /0.35,0.22,0.15,0.07,.043,.022,.014,.010,.006,.004, /.002,.0002,.00002/ C----------------------------------------------------------------------- C ROTATION J=0-2 DATA XROT0/.0226,.025,0.03,0.04,0.05,0.06,0.07,0.08,0.10,0.15, /0.20,0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.20,1.50,2.00,2.50,3.00,3.50,4.00,4.50,5.00,6.00, /7.00,8.00,9.00,10.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YROT0/0.00,.024,.042,.061,.067,.073,.078,.082,.091,.110, /.129,.144,.170,.215,.264,.323,.394,.469,.555,.636, /.796,1.036,1.370,1.585,1.704,1.755,1.758,1.732,1.689,1.579, /1.462,1.350,1.248,1.156,0.730,0.44,0.05,.0015,.00015,.000015/ C----------------------------------------------------------------------- C ROTATION J=1-3 DATA XROT1/.0377,0.04,0.05,0.06,0.07,0.08,0.10,0.15,0.20,0.25, /0.30,0.40,0.50,0.56,0.60,0.66,0.70,0.80,0.90,1.01, /1.20,1.40,1.60,1.80,2.00,2.50,3.00,3.50,4.00,4.50, /5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YROT1/0.00,0.01,.026,.032,.036,.040,.046,.058,.071,.082, /.094,.122,.152,.165,.178,.200,.214,.252,.292,.334, /.420,.510,.610,.700,.786,.937,1.01,1.05,1.05,1.04, /1.01,.946,.876,.809,.748,.694,.440,.265,0.03,.001,.0001,.00001/ C----------------------------------------------------------------------- C ROTATION J=2-4 DATA XROT2/.0528,0.07,0.10,0.15,0.20,0.30,0.40,0.50,0.60,0.70, /0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00,4.50, /5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000.,10000.,100000./ DATA YROT2/0.00,.022,.034,.046,.055,.075,.099,.115,.132,.162, /.193,.227,.266,.463,.619,.719,.774,.799,.802,.790, /.771,.748,.721,.669,.617,.529,0.20,0.02,.0007,.00007,.000007/ C----------------------------------------------------------------------- C ROTATION J=3-5 DATA XROT3/.0679,0.10,0.15,0.20,0.25,0.30,0.40,0.50,0.60,0.70, /0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00,4.50, /5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000.,10000.,100000./ DATA YROT3/0.00,0.02,0.04,0.05,0.06,0.07,.095,.110,.129,.160, /.194,.233,.271,.478,.637,.742,.799,.825,.828,.818, /.797,.774,.747,.692,.640,.548,0.18,0.02,.0007,.00007,.000007/ C----------------------------------------------------------------------- C ROTATION J=4-6 DATA XROT4/.0830,0.10,0.15,0.20,0.25,0.30,0.40,0.50,0.60,0.70, /0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00,4.50, /5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000.,10000.,100000./ DATA YROT4/0.00,.012,0.03,.038,.045,.053,.071,.083,.097,.120, /.146,.175,0.20,0.36,0.48,0.56,0.60,0.62,0.62,0.61, /0.60,0.58,0.56,0.52,0.48,0.41,0.13,.015,.0005,.00005,.000005/ C----------------------------------------------------------------------- C ROTATION J=5-7 DATA XROT5/.0981,0.15,0.20,0.25,0.30,0.40,0.50,0.60,0.70,0.80, /0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00,4.50,5.00, /5.50,6.00,7.00,8.00,10.0,20.0,100.,1000.,10000.,100000./ DATA YROT5/0.00,.015,.028,.034,0.04,.053,.062,.073,0.09,0.11, /0.13,0.15,0.27,0.36,0.42,0.45,0.46,0.46,0.46,0.45, /0.44,0.42,0.39,0.36,0.31,0.10,0.01,.0004,.00004,.000004/ C---------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=0 ROTATIONALLY ELASTIC DATA XVIB1/0.371,0.50,0.60,0.65,0.75,0.85,1.00,1.15,1.25,1.50, /1.75,2.00,2.20,2.40,2.60,3.00,3.50,4.00,4.50,5.00, /6.00,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0, /20.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,.0045,.009,.011,.016,.020,.028,.037,.042,.064, /.084,.100,.110,.120,.128,.135,.140,.140,.135,.122, /.100,.077,.060,.046,.035,.027,.021,.017,.015,.013, /.0085,.0017,.00005,.000005,.0000005/ C----------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=2 ROTATIONALLY INELASTIC DATA XVIB2/0.391,0.50,0.60,0.65,0.75,0.85,1.00,1.15,1.25,1.50, /1.75,2.00,2.20,2.40,2.60,3.00,3.50,4.00,4.50,5.00, /6.00,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0, /20.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,.0025,.0055,.008,.012,.017,.026,.035,.040,.064, /.088,.115,.135,.150,.160,.176,.188,.188,.185,.172, /.142,.110,.082,.062,.045,.035,.026,.019,.014,.011, /.0074,.0015,.00004,.000004,.0000004/ C----------------------------------------------------------------------- C VIBRATION V=0-2 DATA XVIB3/0.735,1.00,1.50,2.00,3.00,4.00,5.00,6.00,8.00,10.0, /15.0,20.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,.0005,.003,.007,.017,.018,.017,.015,.011,.007, /.001,.0005,.00015,.000005,.0000005,.00000005/ C----------------------------------------------------------------------- C VIBRATION V=0-3 DATA XVIB4/1.085,1.35,1.50,2.00,3.00,4.00,5.00,6.00,8.00,10.0, /15.0,20.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,.00015,.0003,.0008,.0016,.0016,.0015,.0012,.001, /.0015,.0005,.0001,.000025,.0000008,.00000008,.000000008/ C----------------------------------------------------------------------- C EXCITATION TO TRIPLET STATES (DISSOCIATION) DATA XEXC1/8.85,8.92,9.34,10.0,11.0,12.0,15.0,20.0,25.0,30.0, /40.0,50.0,60.0,80.0,100.,150.,200.,1000.,10000.,100000./ DATA YEXC1/0.00,.008,0.04,0.08,.184,.336,0.51,0.46,0.28,0.18, /0.08,.041,.025,.010,.005,.0012,.0005,.00008,.000008,.0000008/ C EXCITATION TO SINGLET STATES DATA XEXC2/12.0,12.13,13.4,15.0,17.0,20.0,25.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,400.,500.,600.,800., /1000.,10000.,100000./ DATA YEXC2/0.00,0.09,0.09,0.24,0.40,0.58,0.86,1.01,1.07,1.11, /1.13,1.05,0.99,0.79,0.70,0.58,0.50,0.42,0.38,0.31, /0.24,.024,.0024/ C----------------------------------------------------------------------- DATA XATT/7.40,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /17.0,18.0,30.0,60.0,100.,1000.,10000.,100000./ DATA YATT/0.00,.000005,.000012,.000026,.000027,.00003,.000035, /.00010,.00008,.00009,.00010,.00011,.00006,.00001,.000001, /.0000001,.00000001,.000000001/ C----------------------------------------------------------------------- DATA XION/15.427,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /20.5,21.0,21.5,22.0,22.5,23.0,23.5,24.0,24.5,25.0, /25.5,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000., /10000.,100000./ DATA YION/0.00,.034,.069,.104,.138,.173,.207,.239,.272,.300, /.328,.355,.383,.406,.429,.454,.475,.498,.518,.537, /.556,.575,.641,.699,.744,.786,.821,.851,.876,.931, /.950,.968,.977,.981,.981,.980,.974,.968,.958,.948, /.939,.925,.913,.907,.889,.877,.866,.853,.839,.827, /.813,.792,.754,.716,.638,.576,.523,.482,.446,.414, /.387,.366,.344,.326,.310,.295,.282,.271,.257,.247, /.0247,.00247/ C---------------------------------------------------------------------- NAME='D2 (1998)' C -------------------------------------------------------------------- C CALCULATE FRACTIONAL POPULATION DENSITY FOR ROTATIONAL STATES B0=0.00377272 DO 111 K=1,7,2 111 PJ(K)=3*(2*K+1)*EXP(-K*(K+1)*B0/AKT) DO 112 K=2,6,2 112 PJ(K)=6*(2*K+1)*EXP(-K*(K+1)*B0/AKT) SUM=6.0 DO 113 K=1,7 113 SUM=SUM+PJ(K) FROT0=6.0/SUM FROT1=PJ(1)/SUM FROT2=PJ(2)/SUM FROT3=PJ(3)/SUM FROT4=PJ(4)/SUM FROT5=PJ(5)/SUM FROT6=PJ(6)/SUM FROT7=PJ(7)/SUM C IF(LBMCPR)WRITE(LUNOUT,88) C - FROT0,FROT1,FROT2,FROT3,FROT4,FROT5,FROT6,FROT7 C 88 FORMAT(2X,' FROT0=',F9.5,' FROT1=',F9.5,' FROT2=',F9.5,' FROT3=', C /F9.5,' FROT4=',F9.5,' FROT5=',F9.5,' FROT6=',F9.5,' FROT7=',F9.5) C----------------------------------------------------------------------- NIN=15 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=53 NROT0=40 NROT1=42 NROT2=31 NROT3=31 NROT4=31 NROT5=30 NVIB1=35 NVIB2=35 NVIB3=16 NVIB4=16 NEXC1=20 NEXC2=23 NION=72 NATT=18 E(1)=0.0 E(2)=2.0*EMASS/(4.028204*AMU) E(3)=15.427 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=8.30 EIN(1)=-.0226 EIN(2)=-.0377 EIN(3)=-.0528 EIN(4)=0.0226 EIN(5)=0.0377 EIN(6)=0.0528 EIN(7)=0.0679 EIN(8)=0.0830 EIN(9)=0.0981 EIN(10)=0.371 EIN(11)=0.391 EIN(12)=0.735 EIN(13)=1.085 EIN(14)=8.85 EIN(15)=12.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC DEUTERIUM ' SCRPT(3)=' IONISATION ELOSS= 15.427 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 2-0 ELOSS= -0.0226 ' SCRPT(8)=' ROT 3-1 ELOSS= -0.0377 ' SCRPT(9)=' ROT 4-2 ELOSS= -0.0528 ' SCRPT(10)=' ROT 0-2 ELOSS= 0.0226 ' SCRPT(11)=' ROT 1-3 ELOSS= 0.0377 ' SCRPT(12)=' ROT 2-4 ELOSS= 0.0528 ' SCRPT(13)=' ROT 3-5 ELOSS= 0.0679 ' SCRPT(14)=' ROT 4-6 + 6-8 ELOSS= 0.0830 ' SCRPT(15)=' ROT 5-7 + 7-9 ELOSS= 0.0981 ' SCRPT(16)=' VIB V1 DJ=0 ELOSS= 0.371 ' SCRPT(17)=' VIB V1 DJ=2 ELOSS= 0.391 ' SCRPT(18)=' VIB 2V1 ELOSS= 0.735 ' SCRPT(19)=' VIB 3V1 ELOSS= 1.085 ' SCRPT(20)=' EXC TRPLT ELOSS= 8.85 ' SCRPT(21)=' EXC SNGLT ELOSS= 12.0 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 CONTINUE C Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 CONTINUE Q(5,I)=0.0D0 Q(6,I)=0.0D0 C--------------------------------------------------------------------- C SUPERELASTIC 2-0 QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 1100 DO 1010 J=2,NROT0 IF((EN+EIN(4)).LE.XROT0(J)) GO TO 1020 1010 CONTINUE J=NROT0 1020 A=(YROT0(J)-YROT0(J-1))/(XROT0(J)-XROT0(J-1)) B=(XROT0(J-1)*YROT0(J)-XROT0(J)*YROT0(J-1))/(XROT0(J-1)-XROT0(J)) QIN(1,I)=FROT2*0.2*(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.D-16/EN 1100 CONTINUE C SUPERELASTIC 3-1 QIN(2,I)=0.0D0 IF(EN.LE.0.0) GO TO 1101 DO 1011 J=2,NROT1 IF((EN+EIN(5)).LE.XROT1(J)) GO TO 1021 1011 CONTINUE J=NROT1 1021 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(2,I)=FROT3*(3.0/7.0)*(EN+EIN(5))*(A*(EN+EIN(5))+B)*1.D-16/EN 1101 CONTINUE C SUPERELASTIC 4-2 QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 1102 DO 1012 J=2,NROT2 IF((EN+EIN(6)).LE.XROT2(J)) GO TO 1022 1012 CONTINUE J=NROT2 1022 A=(YROT2(J)-YROT2(J-1))/(XROT2(J)-XROT2(J-1)) B=(XROT2(J-1)*YROT2(J)-XROT2(J)*YROT2(J-1))/(XROT2(J-1)-XROT2(J)) QIN(3,I)=FROT4*(5.0/9.0)*(EN+EIN(6))*(A*(EN+EIN(6))+B)*1.D-16/EN 1102 CONTINUE C ROTATION 0-2 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 1400 DO 1310 J=2,NROT0 IF(EN.LE.XROT0(J)) GO TO 1320 1310 CONTINUE J=NROT0 1320 A=(YROT0(J)-YROT0(J-1))/(XROT0(J)-XROT0(J-1)) B=(XROT0(J-1)*YROT0(J)-XROT0(J)*YROT0(J-1))/(XROT0(J-1)-XROT0(J)) QIN(4,I)=(A*EN+B)*1.D-16*FROT0 1400 CONTINUE C ROTATION 1-3 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 1401 DO 1311 J=2,NROT1 IF(EN.LE.XROT1(J)) GO TO 1321 1311 CONTINUE J=NROT1 1321 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(5,I)=(A*EN+B)*1.D-16*FROT1 1401 CONTINUE C ROTATION 2-4 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 1402 DO 1312 J=2,NROT2 IF(EN.LE.XROT2(J)) GO TO 1322 1312 CONTINUE J=NROT2 1322 A=(YROT2(J)-YROT2(J-1))/(XROT2(J)-XROT2(J-1)) B=(XROT2(J-1)*YROT2(J)-XROT2(J)*YROT2(J-1))/(XROT2(J-1)-XROT2(J)) QIN(6,I)=(A*EN+B)*1.D-16*FROT2 1402 CONTINUE C ROTATION 3-5 QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 1403 DO 1313 J=2,NROT3 IF(EN.LE.XROT3(J)) GO TO 1323 1313 CONTINUE J=NROT3 1323 A=(YROT3(J)-YROT3(J-1))/(XROT3(J)-XROT3(J-1)) B=(XROT3(J-1)*YROT3(J)-XROT3(J)*YROT3(J-1))/(XROT3(J-1)-XROT3(J)) QIN(7,I)=(A*EN+B)*1.D-16*FROT3 1403 CONTINUE C ROTATION 4-6 + 6-8 QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 1404 DO 1314 J=2,NROT4 IF(EN.LE.XROT4(J)) GO TO 1324 1314 CONTINUE J=NROT4 1324 A=(YROT4(J)-YROT4(J-1))/(XROT4(J)-XROT4(J-1)) B=(XROT4(J-1)*YROT4(J)-XROT4(J)*YROT4(J-1))/(XROT4(J-1)-XROT4(J)) QIN(8,I)=(A*EN+B)*1.D-16*(FROT4+FROT6) 1404 CONTINUE C ROTATION 5-7 + 7-9 QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 1405 DO 1315 J=2,NROT5 IF(EN.LE.XROT5(J)) GO TO 1325 1315 CONTINUE J=NROT5 1325 A=(YROT5(J)-YROT5(J-1))/(XROT5(J)-XROT5(J-1)) B=(XROT5(J-1)*YROT5(J)-XROT5(J)*YROT5(J-1))/(XROT5(J-1)-XROT5(J)) QIN(9,I)=(A*EN+B)*1.D-16*(FROT5+FROT7) 1405 CONTINUE C----------------------------------------------------------------------- QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(10,I)=(A*EN+B)*1.D-16 400 CONTINUE C QIN(11,I)=0.0D0 IF(EN.LE.EIN(11)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(11,I)=(A*EN+B)*1.D-16 500 CONTINUE C QIN(12,I)=0.0D0 IF(EN.LE.EIN(12)) GO TO 501 DO 411 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 421 411 CONTINUE J=NVIB3 421 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(12,I)=(A*EN+B)*1.D-16 501 CONTINUE C QIN(13,I)=0.0D0 IF(EN.LE.EIN(13)) GO TO 502 DO 412 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 422 412 CONTINUE J=NVIB4 422 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(13,I)=(A*EN+B)*1.D-16 502 CONTINUE C----------------------------------------------------------------------- QIN(14,I)=0.0D0 IF(EN.LE.EIN(14)) GO TO 600 DO 510 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 520 510 CONTINUE J=NEXC1 520 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(14,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(15,I)=0.0D0 IF(EN.LE.EIN(15)) GO TO 700 DO 610 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 620 610 CONTINUE J=NEXC2 620 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(15,I)=(A*EN+B)*1.D-16 700 CONTINUE C--------------------------------------------------------------------- C NB. ROTATIONAL AND VIBRATIONAL STATES INCLUDED IN Q(2,I) C ------------------------------------------------------------------- Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(14,I)+QIN(15,I) C GET CORRECT ELASTIC XSECTION IF(EN.LT.200.) THEN Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I)-QIN(3,I)-QIN(4,I)-QIN(5,I)-QIN(6,I /)-QIN(7,I)-QIN(8,I)-QIN(9,I)-QIN(10,I)-QIN(11,I)-QIN(12,I)-QIN(13, /I) ENDIF 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(15)) NIN=14 IF(EFINAL.LE.EIN(14)) NIN=13 IF(EFINAL.LE.EIN(13)) NIN=12 IF(EFINAL.LE.EIN(12)) NIN=11 IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS23. SUBROUTINE GAS23(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220),PJ(40) DIMENSION XEN(53),YEN(53),XVIB1(52),YVIB1(52),XVIB2(27),YVIB2(27), /XVIB3(24),YVIB3(24),XVIB4(23),YVIB4(23),XVIB5(20),YVIB5(20), /XVIB6(19),YVIB6(19),XION(90),YION(90),XATT(52),YATT(52), /XEXC(30),YEXC(30),XEXC1(26),YEXC1(26),XEXC2(24),YEXC2(24), /XEXC3(22),YEXC3(22),XEXC4(21),YEXC4(21),XEXC5(19),YEXC5(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/0.00,.001,.002,.003,.005,.007,.0085,0.01,.015,0.02, /0.03,0.04,0.05,0.07,0.10,0.12,0.14,0.16,0.18,0.20, /0.25,0.30,0.40,0.50,0.60,0.80,1.00,1.20,1.40,1.60, /1.80,2.00,2.50,3.00,4.00,5.00,6.00,7.00,8.00,10.0, /12.0,15.0,17.0,20.0,25.0,30.0,50.0,75.0,100.,200., /1000.,10000.,100000./ DATA YEN/0.51,0.90,1.08,1.24,1.50,1.72,1.85,2.00,2.42,2.77, /3.38,3.90,4.35,5.10,6.00,6.50,7.10,7.75,8.10,8.50, /10.7,12.4,14.7,15.6,16.1,16.4,17.5,22.4,30.1,36.2, /37.4,37.2,20.3,16.4,12.1,11.2,10.7,10.2,9.81,8.83, /8.48,8.38,8.08,7.58,6.59,5.79,3.59,2.29,1.70,1.00, /0.15,.015,.0015/ C DATA XVIB1/.266,.270,0.28,0.30,0.32,0.35,0.40,0.45,0.50,0.60, /0.70,0.80,0.85,0.90,0.95,1.00,1.05,1.10,1.22,1.31, /1.41,1.51,1.65,1.74,1.82,1.90,1.98,2.09,2.17,2.28, /2.32,2.40,2.51,2.69,2.87,3.07,3.29,3.53,3.82,4.00, /5.00,6.00,8.00,10.0,12.0,15.0,20.0,30.0,100.,1000., /10000.,100000./ DATA YVIB1/0.00,.045,.081,.117,.131,.153,.165,.168,.167,.155, /.135,.118,.112,.115,.120,.130,.196,.320,0.77,1.31, /2.30,3.44,3.23,3.80,4.20,3.74,3.34,3.64,3.18,2.67, /2.74,2.39,2.00,1.57,1.17,0.83,0.55,0.35,0.18,.051, /.043,.037,.030,.025,.022,.018,.014,.010,.0037,.00037, /.000037,.0000037/ DATA XVIB2/.528,1.10,1.20,1.30,1.40,1.50,1.60,1.70,1.80,1.90, /2.00,2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.80,2.90, /3.00,3.20,10.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,.027,.055,.135,.495,1.11,1.66,1.43,1.22,1.66, /1.43,1.14,1.15,0.91,0.67,0.67,0.44,0.39,0.22,0.22, /0.11,.055,.005,.0005,.00005,.000005,.0000006/ DATA XVIB3/.787,1.40,1.50,1.60,1.70,1.80,1.90,2.00,2.10,2.20, /2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,3.20,10.0, /100.,1000.,10000.,100000./ DATA YVIB3/0.00,.055,0.28,0.77,1.08,0.83,0.49,0.72,0.83,0.44, /0.39,0.44,0.22,0.25,0.17,0.11,0.12,.055,.022,.0022, /.00022,.000022,.0000022,.00000022/ DATA XVIB4/1.043,1.40,1.50,1.60,1.70,1.80,1.90,2.00,2.10,2.20, /2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,10.0,100., /1000.,10000.,100000./ DATA YVIB4/0.00,.013,0.11,0.25,0.61,0.77,0.61,0.20,0.32,0.41, /0.22,0.12,0.20,.045,.045,.012,.0032,.0027,.0003,.00003, /.000003,.0000003,.00000003/ DATA XVIB5/1.295,1.60,1.70,1.80,1.90,2.00,2.10,2.20,2.30,2.40, /2.50,2.60,2.70,2.80,3.00,10.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.055,0.29,0.32,0.54,0.32,0.11,.049,0.20,.072, /.045,.045,.009,.004,.002,.0002,.00002,.000002,.0000002,.00000002/ DATA XVIB6/1.544,1.70,1.80,1.90,2.00,2.10,2.20,2.30,2.40,2.50, /2.60,2.70,2.80,3.00,10.0,100.,1000.,10000.,100000./ DATA YVIB6/0.00,.049,0.13,0.22,0.61,0.61,0.45,0.34,0.20,0.14, /0.13,.042,.014,.0045,.0005,.00005,.000005,.0000005,.00000005/ C DATA XION/14.013,14.5,15.0,15.5,16.0,16.5,17.0,17.5,18.0,18.5, /19.0,19.5,20.0,20.5,21.0,21.5,22.0,22.5,23.0,23.5, /24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000., /1100.,1200.,1300.,1400.,1500.,1600.,1800.,2000.,2500.,3000., /4000.,6000.,8000.,10000.,15000.,20000.,30000.,40000.,60000., /100000./ DATA YION/0.00,.0273,.051,.077,.106,.139,.177,.214,.254,.297, /.340,.386,.428,.472,.516,.560,.601,.643,.684,.724, /.766,.933,1.09,1.24,1.38,1.50,1.60,1.70,1.79,1.97, /2.12,2.24,2.34,2.43,2.50,2.53,2.59,2.60,2.63,2.64, /2.65,2.66,2.66,2.65,2.64,2.63,2.62,2.60,2.59,2.58, /2.57,2.52,2.45,2.37,2.16,1.99,1.85,1.72,1.59,1.50, /1.43,1.35,1.27,1.21,1.15,1.11,1.06,1.03,.994,.959, /.864,.810,.762,.721,.683,.650,.592,.545,.456,.392, /.309,.219,.172,.141,.099,.077,.054,.042,.029, /.019/ DATA XATT/9.00,9.20,9.30,9.35,9.40,9.45,9.60,9.65,9.70,9.75, /9.80,9.85,9.90,10.0,10.1,10.2,10.3,10.4,10.5,10.6, /10.7,10.8,10.9,11.0,11.1,11.2,11.3,11.4,11.5,11.6, /11.7,11.8,11.9,12.0,12.1,12.2,12.3,12.4,12.5,12.6, /12.8,13.0,19.0,25.0,30.0,35.0,40.0,60.0,100.,1000., /10000.,100000./ DATA YATT/0.00,.00009,.00018,.00026,.00034,.00073,.0011,.0017, /.0018,.0019,.0020,.0020,.0020,.0020,.0020,.0019,.0018,.0017,.0015, /.0014,.0012,.0011,.0010,.00088,.00077,.00065,.00055,.00047,.00040, /.00033,.00028,.00024,.00019,.00017,.00014,.00011,.00010,.00009, /.00008,.00007,.00006,.00006,.00006,.00006,.0001,.0001,.0001,.0001, /.0001,.0001,.0000001,.00000001/ C EXCITATION A3 PI DATA XEXC/6.04,6.20,6.40,6.60,7.00,7.15,8.00,9.00,10.0,11.0, /12.0,13.0,14.0,15.0,17.0,20.0,22.0,24.0,27.0,30.0, /35.0,40.0,50.0,60.0,70.0,80.0,100.,1000.,10000.,100000./ DATA YEXC/0.00,2.04,2.09,2.04,0.55,0.29,0.53,0.94,1.06,1.08, /1.02,0.92,0.81,0.71,0.55,0.39,0.34,0.29,.245,0.22, /0.21,0.20,0.18,0.17,0.15,0.14,.127,.028,.0028,.00028/ C EXCITATION A3 SIGMA DATA XEXC1/6.82,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0, /17.0,20.0,22.0,24.0,27.0,30.0,35.0,40.0,50.0,60.0, /70.0,80.0,100.0,1000.,10000.,100000./ DATA YEXC1/0.00,.013,0.07,0.34,0.46,0.50,0.49,0.46,0.42,0.38, /0.32,0.25,0.21,0.18,0.15,.118,.084,.056,.031,.018, /.0118,.007,.003,.00014,.000014,.0000014/ C EXCITATION A1 PI DATA XEXC2/8.07,9.00,10.0,11.0,12.0,13.0,14.0,15.0,17.0,20.0, /22.0,24.0,27.0,30.0,35.0,40.0,50.0,60.0,70.0,80.0, /100.,1000.,10000.,100000./ DATA YEXC2/0.00,.108,0.18,0.24,0.27,0.29,0.32,0.35,0.38,0.39, /0.40,0.42,0.42,0.41,0.40,0.39,0.38,0.36,0.35,0.34, /0.31,.084,.0084,.00084/ C EXCITATION B3 SIGMA DATA XEXC3/10.39,11.0,12.0,13.0,14.0,15.0,17.0,20.0,22.0,24.0, /27.0,30.0,35.0,40.0,50.0,60.0,70.0,80.0,100.,1000., /10000.,100000./ DATA YEXC3/0.00,.025,.035,.055,.066,.074,.077,.060,.042,.028, /.018,.015,.0137,.0127,.0118,.0118,.0108,.0108,.0099,.0014, /.00014,.000014/ C EXCITATION C1 SIGMA +E1 PI DATA XEXC4/11.3,12.0,13.0,14.0,15.0,17.0,20.0,22.0,24.0,27.0, /30.0,35.0,40.0,50.0,60.0,70.0,80.0,100.,1000.,10000., /100000./ DATA YEXC4/0.00,.056,.087,0.12,0.14,.175,0.22,0.24,0.25,0.27, /0.28,0.28,0.28,0.27,0.25,.245,0.24,0.22,.063,.0063, /.00063/ C EXCITATION SUM OF HIGHER LEVELS DATA XEXC5/13.5,14.0,15.0,17.0,20.0,22.0,24.0,27.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,100.,1000.,10000.,100000./ DATA YEXC5/0.00,0.07,0.14,0.29,0.39,0.42,0.45,0.48,0.49,0.50, /0.52,0.52,0.50,0.49,0.48,0.46,0.13,.013,.0013/ C ------------------------------------------------------------------- C FIT TO DATA OF : C HADDAD AND MILLOY AUST J. PHYS 36(1983)473 C PETROVIC AND CROMPTON AUST J. PHYS 42(1989)609 C NAKAMURA J.PHYS D 20(1987) 933 C SAELEE AND LUCAS J.PHYS D 10(1977) 343 C AND LOW TEMPERTURE PACK AND PHELPS DATA C REPLACES 1998 ROUTINE C USES ANISTROPIC ANGULAR DISTRIBUTION FOR DIPOLE ROTATIONAL STATES C ------------------------------------------------------------------- C NAME='CO (2003)' C NIN=64 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN KIN(J)=0 2 IF(J.LE.52) KIN(J)=1 NDATA=53 NVIB1=52 NVIB2=27 NVIB3=24 NVIB4=23 NVIB5=20 NVIB6=19 NION=90 NATT=52 NEXC=30 NEXC1=26 NEXC2=24 NEXC3=22 NEXC4=21 NEXC5=19 E(1)=0.0 E(2)=2.0*EMASS/(28.0104*AMU) E(3)=14.013 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=14.013 C B0 IS ROTATIONAL CONSTANT AND DBA IS DIPOLE MOMENT C DRAT IS RATIO OF MOMENTUM TRANSFER TO TOTAL X-SECTION FOR DIPOLE C ------------------------------------------------------ B0=2.384D-4 DBA=0.0432 DRAT=0.25 AVIB=1.0 C ------------------------------------------------------- A0=0.5291772083D-8 RY=13.60569172 DBK=8.37758*RY*(DBA*A0)**2 C CALCULATE ROTATIONAL STATE POPULATION AT TEMPERATURE DO 3 K=1,26 3 PJ(K)=(2*K+1)*EXP(-K*(K+1)*B0/AKT) SUM=1.0 DO 4 K=1,26 4 SUM=SUM+PJ(K) FROT0=1.0D0/SUM DO 5 K=1,26 5 PJ(K)=PJ(K)/SUM C CALC ROTATIONAL TRANSITION ENERGIES DO 6 K=1,26 J=K-1 EIN(K+26)=B0*2*(J+1) 6 EIN(K)=-EIN(K+26) EIN(53)=0.266 EIN(54)=0.528 EIN(55)=0.787 EIN(56)=1.043 EIN(57)=1.295 EIN(58)=1.544 EIN(59)=6.04 EIN(60)=6.82 EIN(61)=8.07 EIN(62)=10.39 EIN(63)=11.3 EIN(64)=13.5 C IF(LBMCPR)WRITE(LUNOUT,99) FROT0,(PJ(J),J=1,30) C 99 FORMAT(2X,'POP OF STATES=',/,11(2X,D10.3)) C IF(LBMCPR)WRITE(LUNOUT,98) (EIN(J),J=1,64) C 98 FORMAT(2X,'TRANS ENERGY=',/,10(2X,D10.3)) SCRPT(1)=' ' SCRPT(2)=' ELASTIC CARBON MONOXIDE' SCRPT(3)=' IONISATION ELOSS= 14.013 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 1-0 ELOSS= -0.00048' SCRPT(8)=' ROT 2-1 ELOSS= -0.00095' SCRPT(9)=' ROT 3-2 ELOSS= -0.00143' SCRPT(10)=' ROT 4-3 ELOSS= -0.00191' SCRPT(11)=' ROT 5-4 ELOSS= -0.00238' SCRPT(12)=' ROT 6-5 ELOSS= -0.00286' SCRPT(13)=' ROT 7-6 ELOSS= -0.00334' SCRPT(14)=' ROT 8-7 ELOSS= -0.00381' SCRPT(15)=' ROT 9-8 ELOSS= -0.00429' SCRPT(16)=' ROT 10-9 ELOSS= -0.00477' SCRPT(17)=' ROT 11-10 ELOSS= -0.00524' SCRPT(18)=' ROT 12-11 ELOSS= -0.00572' SCRPT(19)=' ROT 13-12 ELOSS= -0.00620' SCRPT(20)=' ROT 14-13 ELOSS= -0.00668' SCRPT(21)=' ROT 15-14 ELOSS= -0.00715' SCRPT(22)=' ROT 16-15 ELOSS= -0.00763' SCRPT(23)=' ROT 17-16 ELOSS= -0.00811' SCRPT(24)=' ROT 18-17 ELOSS= -0.00858' SCRPT(25)=' ROT 19-18 ELOSS= -0.00906' SCRPT(26)=' ROT 20-19 ELOSS= -0.00954' SCRPT(27)=' ROT 21-20 ELOSS= -0.0100 ' SCRPT(28)=' ROT 22-21 ELOSS= -0.0105 ' SCRPT(29)=' ROT 23-22 ELOSS= -0.0110 ' SCRPT(30)=' ROT 24-23 ELOSS= -0.0114 ' SCRPT(31)=' ROT 25-24 ELOSS= -0.0119 ' SCRPT(32)=' ROT 26-25 ELOSS= -0.0124 ' SCRPT(33)=' ROT 0-1 ELOSS= 0.00048' SCRPT(34)=' ROT 1-2 ELOSS= 0.00095' SCRPT(35)=' ROT 2-3 ELOSS= 0.00143' SCRPT(36)=' ROT 3-4 ELOSS= 0.00191' SCRPT(37)=' ROT 4-5 ELOSS= 0.00238' SCRPT(38)=' ROT 5-6 ELOSS= 0.00286' SCRPT(39)=' ROT 6-7 ELOSS= 0.00334' SCRPT(40)=' ROT 7-8 ELOSS= 0.00381' SCRPT(41)=' ROT 8-9 ELOSS= 0.00429' SCRPT(42)=' ROT 9-10 ELOSS= 0.00477' SCRPT(43)=' ROT 10-11 ELOSS= 0.00524' SCRPT(44)=' ROT 11-12 ELOSS= 0.00572' SCRPT(45)=' ROT 12-13 ELOSS= 0.00620' SCRPT(46)=' ROT 13-14 ELOSS= 0.00668' SCRPT(47)=' ROT 14-15 ELOSS= 0.00715' SCRPT(48)=' ROT 15-16 ELOSS= 0.00763' SCRPT(49)=' ROT 16-17 ELOSS= 0.00811' SCRPT(50)=' ROT 17-18 ELOSS= 0.00858' SCRPT(51)=' ROT 18-19 ELOSS= 0.00906' SCRPT(52)=' ROT 19-20 ELOSS= 0.00954' SCRPT(53)=' ROT 20-21 ELOSS= 0.0100 ' SCRPT(54)=' ROT 21-22 ELOSS= 0.0105 ' SCRPT(55)=' ROT 22-23 ELOSS= 0.0110 ' SCRPT(56)=' ROT 23-24 ELOSS= 0.0114 ' SCRPT(57)=' ROT 24-25 ELOSS= 0.0119 ' SCRPT(58)=' ROT 25-26 ELOSS= 0.0124 ' SCRPT(59)=' VIB V1 ELOSS= 0.266 ' SCRPT(60)=' VIB 2V1 ELOSS= 0.528 ' SCRPT(61)=' VIB 3V1 ELOSS= 0.787 ' SCRPT(62)=' VIB 4V1 ELOSS= 1.043 ' SCRPT(63)=' VIB 5V1 ELOSS= 1.295 ' SCRPT(64)=' VIB 6V1 ELOSS= 1.544 ' SCRPT(65)=' EXC A3 PI ELOSS= 6.04 ' SCRPT(66)=' EXC A3 SIGMA ELOSS= 6.82 ' SCRPT(67)=' EXC A1 PI ELOSS= 8.07 ' SCRPT(68)=' EXC B3 SIGMA ELOSS= 10.39 ' SCRPT(69)=' EXC C1 + E1 ELOSS= 11.3 ' SCRPT(70)=' EXC ELOSS= 13.5 ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YEN(J)-YEN(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEN(J)-XEN(J)*YEN(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GO TO 40 30 CONTINUE J=NION 40 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 50 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 55 IF(EN.GT.XATT(NATT)) GO TO 55 DO 51 J=2,NATT IF(EN.LE.XATT(J)) GO TO 52 51 CONTINUE J=NATT 52 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 C 55 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C---------------------------------------------------------------------- C DIPOLE BORN ROTATIONAL STATES C---------------------------------------------------------------------- ENRT=SQRT(EN) C SUPER ELASTIC ROTATIONAL COLLISIONS DO 150 L=1,26 AL=DBLE(L) QIN(L,I)=PJ(L)*DBK*LOG((ENRT+SQRT(EN-EIN(L)))/(SQRT(EN-EIN(L))- /ENRT))*AL/((2.0*AL+1.0)*EN) 150 PEQIN(L,I)=0.5+(QIN(L,I)-DRAT*QIN(L,I))/QIN(L,I) DO 155 L=27,52 155 QIN(L,I)=0.0D0 C ROT 0-1 IF(EN.LE.EIN(27)) GO TO 200 QIN(27,I)=FROT0*DBK*LOG((ENRT+SQRT(EN-EIN(27)))/(ENRT-SQRT(EN- /EIN(27))))/EN PEQIN(27,I)=0.5+(QIN(27,I)-DRAT*QIN(27,I))/QIN(27,I) C ROT 1-2 AND HIGHER DO 160 L=28,52 IF(EN.LE.EIN(L)) GO TO 200 AL=DBLE(L-27) QIN(L,I)=PJ(L-27)*DBK*LOG((ENRT+SQRT(EN-EIN(L)))/(ENRT-SQRT(EN- /EIN(L))))*(AL+1.0)/((2.0*AL+1.0)*EN) 160 PEQIN(L,I)=0.5+(QIN(L,I)-DRAT*QIN(L,I))/QIN(L,I) C 200 CONTINUE C QIN(53,I)=0.0D0 IF(EN.LE.EIN(53)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(53,I)=(A*EN+B)*1.D-16*AVIB 400 CONTINUE C QIN(54,I)=0.0D0 IF(EN.LE.EIN(54)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(54,I)=(A*EN+B)*1.D-16 500 CONTINUE C QIN(55,I)=0.0D0 IF(EN.LE.EIN(55)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(55,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(56,I)=0.0D0 IF(EN.LE.EIN(56)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(56,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(57,I)=0.0D0 IF(EN.LE.EIN(57)) GO TO 800 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 720 710 CONTINUE J=NVIB5 720 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(57,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(58,I)=0.0D0 IF(EN.LE.EIN(58)) GO TO 900 DO 810 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 820 810 CONTINUE J=NVIB6 820 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(58,I)=(A*EN+B)*1.D-16 900 CONTINUE C QIN(59,I)=0.0D0 IF(EN.LE.EIN(59)) GO TO 1000 DO 910 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 920 910 CONTINUE J=NEXC 920 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(59,I)=(A*EN+B)*1.D-16 1000 CONTINUE C QIN(60,I)=0.0D0 IF(EN.LE.EIN(60)) GO TO 1100 DO 1010 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 1020 1010 CONTINUE J=NEXC1 1020 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(60,I)=(A*EN+B)*1.D-16 1100 CONTINUE C QIN(61,I)=0.0D0 IF(EN.LE.EIN(61)) GO TO 1200 DO 1110 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 1120 1110 CONTINUE J=NEXC2 1120 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(61,I)=(A*EN+B)*1.D-16 1200 CONTINUE C QIN(62,I)=0.0D0 IF(EN.LE.EIN(62)) GO TO 1300 DO 1210 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 1220 1210 CONTINUE J=NEXC3 1220 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(62,I)=(A*EN+B)*1.D-16 1300 CONTINUE C QIN(63,I)=0.0D0 IF(EN.LE.EIN(63)) GO TO 1400 DO 1310 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 1320 1310 CONTINUE J=NEXC4 1320 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(63,I)=(A*EN+B)*1.D-16 1400 CONTINUE C QIN(64,I)=0.0D0 IF(EN.LE.EIN(64)) GO TO 1500 DO 1410 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GO TO 1420 1410 CONTINUE J=NEXC5 1420 A=(YEXC5(J)-YEXC5(J-1))/(XEXC5(J)-XEXC5(J-1)) B=(XEXC5(J-1)*YEXC5(J)-XEXC5(J)*YEXC5(J-1))/(XEXC5(J-1)-XEXC5(J)) QIN(64,I)=(A*EN+B)*1.D-16 1500 CONTINUE C SUM=0.0D0 DO 2000 K=1,64 SUM=SUM+QIN(K,I) 2000 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+SUM 9000 CONTINUE C SAVE COMPUTE TIME DO 9900 K=1,64 J=65-K IF(EFINAL.LE.EIN(J)) NIN=J-1 9900 CONTINUE C END +DECK,GAS24. SUBROUTINE GAS24(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(33),YXSEC(33),XVIB1(29),YVIB1(29),XVIB2(29),YVIB2(29 /),XVIB3(28),YVIB3(28),XION(25),YION(25),XEXC(26),YEXC(26), /XEXC1(31),YEXC1(31) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.001,0.003,0.007,0.01,0.014,0.02,0.03,0.05,0.07, /0.10,0.14,0.20,0.30,0.40,0.60,0.80,1.00,1.40,2.00, /3.00,5.00,6.00,8.00,10.0,14.0,20.0,40.0,70.0,100., /140.,200.,1000./ DATA YXSEC/165.,145.,135.,122.,108.,98.0,92.0,83.0,71.0,62.0, /50.0,43.0,36.0,28.5,24.0,15.8,11.5,9.30,8.50,9.20, /12.5,22.0,26.0,38.0,40.0,30.0,20.0,10.0,6.00,4.00, /2.80,2.00,0.40/ DATA XVIB1/0.00,0.12,0.121,0.13,0.14,0.17,0.22,0.26,0.36,0.46, /0.56,0.66,0.76,0.96,1.36,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,14.0,20.0,40.0,100.,1000./ DATA YVIB1/0.00,0.00,.052,0.42,0.75,1.03,1.21,1.26,1.14,0.98, /0.84,0.74,0.66,0.58,0.49,0.56,0.77,1.23,1.75,2.27, /2.36,2.27,1.92,1.40,0.59,0.28,0.07,0.02,0.00/ DATA XVIB2/0.00,0.16,0.161,0.17,0.18,0.21,0.26,0.30,0.40,0.50, /0.60,0.70,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,14.0,20.0,40.0,100.,1000./ DATA YVIB2/0.00,0.00,.052,0.42,0.75,1.03,1.21,1.26,1.14,0.98, /0.84,0.74,0.66,0.58,0.49,0.56,0.77,1.23,1.75,2.27, /2.36,2.27,1.92,1.40,0.59,0.28,0.07,0.02,0.00/ DATA XVIB3/0.00,0.36,0.362,0.38,0.40,0.42,0.47,0.51,0.55,0.60, /0.70,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,14.0,20.0,40.0,100.,1000./ DATA YVIB3/0.00,0.00,.053,.105,0.21,0.28,0.42,0.53,0.61,0.66, /0.75,0.75,0.73,0.66,0.72,0.88,1.28,1.75,2.10,2.36, /2.36,1.92,1.40,0.54,0.23,0.07,0.02,0.00/ DATA XION/10.0,10.8,13.3,18.3,19.3,20.3,23.3,28.3,33.3,38.3, /43.3,48.3,53.3,58.3,68.3,78.3,88.3,98.3,120.,140., /200.,300.,500.,700.,1000./ DATA YION/0.00,.251,2.28,5.93,6.84,7.52,9.01,11.1,12.6,13.6, /14.5,15.0,15.2,15.6,16.0,16.1,16.0,15.7,15.2,14.6, /12.5,9.67,6.74,5.04,4.01/ DATA XEXC/6.30,6.70,7.30,7.80,8.30,8.80,9.30,10.3,11.3,13.3, /15.3,19.3,24.3,29.3,39.3,49.3,59.3,69.3,79.3,100., /150.,200.,300.,400.,600.,1000./ DATA YEXC/0.00,0.35,0.65,1.00,1.31,1.55,1.75,2.16,2.45,3.02, /3.49,4.08,4.43,4.51,4.31,3.90,3.55,3.23,2.94,2.47, /1.78,1.40,0.98,0.73,0.47,0.33/ DATA XEXC1/8.30,8.50,9.10,9.60,10.1,10.6,11.1,12.1,13.1,14.1, /15.1,17.1,19.1,21.1,25.1,29.1,34.1,39.1,44.1,49.1, /59.1,69.1,79.1,100.,150.,200.,300.,400.,500.,600.,1000./ DATA YEXC1/0.00,0.12,0.26,0.38,0.47,0.58,0.70,1.06,1.60,2.36, /3.29,4.81,5.94,6.53,7.16,7.24,7.06,6.61,6.10,5.54, /4.61,3.96,3.47,2.80,2.04,1.67,1.22,0.96,0.79,0.67,0.49/ C C NO EXPERIMENTAL DATA ON TRANSVERSE DIFFUSION AVAILABLE SO TWO C DATA SETS CREATED WITH EXPECTED MAXIMUM AND MINIMUM DIFFUSION C HOT IS THE MORE DIFFUSING GAS. C NAME='Methylal (hot)' C NIN=5 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=33 NVIB1=29 NVIB2=29 NVIB3=28 NION=25 NEXC=26 NEXC1=31 E(1)=0.0 E(2)=2.0*EMASS/(76.09532*AMU) E(3)=10.0 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.12 EIN(2)=0.16 EIN(3)=0.36 EIN(4)=6.3 EIN(5)=8.3 EOBY=10.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC METHYLAL ' SCRPT(3)=' IONISATION ELOSS= 10.0 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= 0.12 ' SCRPT(8)=' VIB ELOSS= 0.16 ' SCRPT(9)=' VIB ELOSS= 0.36 ' SCRPT(10)=' EXC ELOSS= 6.3 ' SCRPT(11)=' EXC ELOSS= 8.3 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP C DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(A*EN+B)*1.D-16 400 CONTINUE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(2,I)=(A*EN+B)*1.D-16 430 CONTINUE C QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 460 DO 440 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 450 440 CONTINUE J=NVIB3 450 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(3,I)=(A*EN+B)*1.D-16 460 CONTINUE C QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(4,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(5,I)=(A*EN+B)*1.D-16 700 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+QIN(5,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS25. SUBROUTINE GAS25(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(54),YXSEC(54),XION(29),YION(29),XATT(16),YATT(16), /XVIB3(19),YVIB3(19),XVIB4(28),YVIB4(28),XVIB5(25),YVIB5(25), /XVIB6(19),YVIB6(19),XEXC(27),YEXC(27),XEXC1(35),YEXC1(35) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.004,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.11,0.12,0.13,0.14,0.16,0.18,0.20,0.24, /0.30,0.40,0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00, /5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0, /70.0,100.,140.,200.,250.,300.,500.,1000.,1500.,3000., /6000.,10000.,20000.,100000./ DATA YXSEC/235.,235.,235.,233.,225.,215.,205.,190.,175.,160., /140.,125.,110.,95.0,80.0,74.0,62.0,51.0,43.0,34.0, /25.0,20.0,18.0,16.5,15.7,15.0,14.5,15.0,17.5,20.0, /22.0,23.5,24.0,24.5,24.0,22.0,15.0,11.5,8.00,6.20, /3.50,2.60,1.50,0.95,0.70,0.55,0.30,0.14,0.09,0.04, /0.02,.012,.005,.001/ DATA XION/10.04,10.9,13.4,18.4,19.4,20.4,23.4,28.4,33.4,38.4, /43.4,48.4,53.4,58.4,68.4,78.4,88.4,98.4,120.,140., /200.,300.,500.,700.,1000.,2000.,4000.,10000.,100000./ DATA YION/0.00,0.12,1.12,2.92,3.37,3.70,4.44,5.48,6.17,6.68, /7.13,7.41,7.52,7.66,7.84,7.89,7.84,7.75,7.53,7.20, /6.17,4.76,3.30,2.45,1.95,1.15,0.70,0.36,.06/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ C V2 AND V3 DIPOLE PARTS GIVEN ANALYTICALLY C NB V3 TABLE CONTAINS ONLY RESONANCE PART OF X-SECT. DATA XVIB3/.137,1.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,14.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.01,0.45,0.75,1.00,1.15,1.20,1.15,1.00,0.90, /0.80,0.50,0.35,0.21,0.16,0.05,.005,.0005,.00005/ DATA XVIB4/.180,0.19,0.20,0.23,0.25,0.30,0.35,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.17,0.22,0.30,0.32,0.34,0.34,0.32,0.31,0.25, /0.21,0.19,0.19,0.32,0.47,0.61,0.79,1.03,1.03,0.85, /0.58,0.33,0.18,0.11,0.03,.003,.0003,.00003/ DATA XVIB5/.349,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,0.35,0.43,0.47,0.48,0.48,0.46,0.43,0.43,0.47, /0.69,1.00,1.30,1.75,1.90,1.60,1.20,0.72,0.30,0.17, /0.10,0.02,.002,.0002,.00002/ DATA XVIB6/.529,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB6/0.00,.001,0.01,.016,.035,0.06,0.09,0.12,0.13,0.11, /0.08,.045,0.02,0.01,.007,.0016,.00016,.000016,.0000016/ DATA XEXC/7.70,8.50,9.00,9.50,10.5,11.5,13.0,15.0,20.0,25.0, /30.0,40.0,50.0,60.0,70.0,80.0,100.,150.,200.,300., /400.,600.,1000.,2000.,4000.,10000.,100000./ DATA YEXC/0.00,0.11,0.38,0.71,1.26,1.76,2.03,2.36,2.80,3.03, /3.08,3.19,3.25,3.25,3.20,3.10,2.81,1.93,1.49,1.10, /0.88,0.66,0.44,0.28,.160,.083,.0150/ DATA XEXC1/8.50,8.70,9.30,9.85,10.3,10.8,11.3,12.3,13.3,14.3, /15.3,17.3,20.0,22.0,25.0,30.0,35.0,40.0,45.0,50.0, /60.0,70.0,80.0,100.,150.,200.,300.,400.,500.,600., /1000.,2000.,4000.,10000.,100000./ DATA YEXC1/0.00,0.077,0.16,0.23,0.29,0.34,0.42,0.64,0.97,1.43, /1.99,2.91,3.79,4.07,4.73,5.50,5.94,6.16,6.44,6.60, /6.82,6.82,6.77,6.44,4.79,3.91,2.86,2.20,1.87,1.65, /1.16,0.68,0.40,0.20,.038/ NAME='DME (1998)' C --------------------------------------------------------------------- C UPDATES DME97 WITH MONTE CARLO SIMULATION OF STEADY STATE TOWNSEND C VALUE FOR ALPHA. C UPDATES DME94 WITH CORRECT VIBRATIONAL ANALYSIS FROM SVERDLOV. C UPDATES DME92 WITH BETTER FIT TO FANO AND EV/ION PAIR C --------------------------------------------------------------------- AVIB1=0.06 AVIB2=0.35 NIN=8 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=54 NVIB3=19 NVIB4=28 NVIB5=25 NVIB6=19 NION=29 NATT=16 NEXC=27 NEXC1=35 E(1)=0.0 E(2)=2.0*EMASS/(46.06904*AMU) E(3)=10.04 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.04 EIN(1)=-0.051 EIN(2)=0.051 EIN(3)=0.137 EIN(4)=0.180 EIN(5)=0.349 EIN(6)=0.529 EIN(7)=7.70 EIN(8)=8.5 SCRPT(1)=' ' SCRPT(2)=' ELASTIC DME ' SCRPT(3)=' IONISATION ELOSS= 10.04 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= -0.051 ' SCRPT(8)=' VIB ELOSS= 0.051 ' SCRPT(9)=' VIB ELOSS= 0.137 ' SCRPT(10)=' VIB ELOSS= 0.180 ' SCRPT(11)=' VIB ELOSS= 0.349 ' SCRPT(12)=' VIB ELOSS= 0.529 ' SCRPT(13)=' EXC ELOSS= 7.70 ' SCRPT(14)=' EXC ELOSS= 8.50 ' APOP=EXP(EIN(1)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC OF VIBRATION C QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 390 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AVIB1*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 C 390 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AVIB1*LOG((1.0+EFAC)/(1.0-EFAC))/(EN*(1.0+APOP))*1.D-16 400 CONTINUE QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 430 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(3,I)=(A*EN+B) EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=(QIN(3,I)+AVIB2*LOG((1.0+EFAC)/(1.0-EFAC))/EN)*1.D-16 430 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 500 DO 440 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 450 440 CONTINUE J=NVIB4 450 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(4,I)=(A*EN+B)*1.D-16 500 CONTINUE QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 600 DO 540 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 550 540 CONTINUE J=NVIB5 550 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(5,I)=(A*EN+B)*1.D-16 600 CONTINUE QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 700 DO 640 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 650 640 CONTINUE J=NVIB6 650 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(6,I)=(A*EN+B)*1.D-16 700 CONTINUE QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 800 DO 710 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 720 710 CONTINUE J=NEXC 720 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 800 CONTINUE QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 899 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 820 810 CONTINUE J=NEXC1 820 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 899 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS26. SUBROUTINE GAS26(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO DECEMBER 1994 C --------------------------------------------------------------- NAME='Reid step anis.' C NIN=1 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C ANISOTROPIC SCATTERING FOR LEVEL 1 KIN(1)=1 C E(1)=0.0 E(2)=2.0*EMASS/(4.0*AMU) E(3)=15.90 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.90 EIN(1)=0.2 SCRPT(1)=' ' SCRPT(2)=' ELASTIC REID STEP(ANIS)' SCRPT(3)=' IONISATION ELOSS= 15.90 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC (ANIS) ELOSS= 0.20 ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP PEQEL(2,I)=0.0D0 PEQIN(1,I)=0.0D0 EN=EN+ESTEP Q(2,I)=1.0D-16 Q(3,I)=0.0D0 Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 400 QIN(1,I)=10.0D-16 PEQIN(1,I)=0.5+(QIN(1,I)-0.7*QIN(1,I))/QIN(1,I) 400 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+0.7*QIN(1,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS27. SUBROUTINE GAS27(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ---------------------------------------------------------------- C MAXWELL MODEL DECEMBER 1994 C --------------------------------------------------------------- NAME='Maxwell (1994)' C NIN=0 DO 1 J=1,6 1 KEL(J)=0 C DO 2 J=1,NIN C 2 KIN(J)=0 SIGC=6.0D-16 E(1)=0.0 E(2)=2.0*EMASS/(4.0*AMU) E(3)=99. E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=99. SCRPT(1)=' ' SCRPT(2)=' ELASTIC MAXWELL ' SCRPT(3)=' ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) THEN Q(2,I)=100000.D-16 GO TO 10 ENDIF Q(2,I)=SIGC/SQRT(EN) 10 Q(3,I)=0.0D0 Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C Q(1,I)=Q(2,I) 9000 CONTINUE END +DECK,GAS28. SUBROUTINE GAS28(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO DECEMBER 1994 C --------------------------------------------------------------- NAME='Reid ramp S=10' C NIN=1 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 E(1)=0.0 E(2)=2.0*EMASS/(4.0*AMU) E(3)=15.90 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.9 EIN(1)=0.2 SCRPT(1)=' ' SCRPT(2)=' ELASTIC REID RAMP ' SCRPT(3)=' ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC ELOSS= 0.2 ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP Q(2,I)=6.0D-16 Q(3,I)=0.0D0 Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 400 QIN(1,I)=(EN-EIN(1))*10.0D-16 400 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS29. SUBROUTINE GAS29(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XENM(56),YXMOM(56),XENT(56),YXTOT(56), /XVIB2(22),YVIB2(22),XVIB3(22),YVIB3(22),XVIB4(22),YVIB4(22), /XVIB5(22),YVIB5(22),XVIB6(22),YVIB6(22), /XDISS(27),YDISS(27),XATT(26),YATT(26),XION(48),YION(48) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XENM/0.0,0.001,0.002,0.004,0.007,0.01,.015,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.0,200.,400.,1000.,10000.,100000./ C ELASTIC MOMENTUM TRANSFER DATA YXMOM/29.0,26.0,24.0,20.0,16.0,12.9,9.60,7.65,6.40,5.55, /4.25,3.40,2.80,2.40,2.00,1.90,2.00,2.50,3.15,4.20, /5.25,6.10,6.80,7.40,7.80,8.20,8.80,9.30,9.60,9.80, /10.0,10.4,10.7,11.0,11.2,11.4,11.5,11.6,11.8,12.0, /12.5,14.5,14.5,13.2,11.5,10.0,9.20,8.50,7.66,6.66, /5.86,3.00,1.50,0.60,0.06,.0006/ DATA XENT/0.0,0.001,0.002,0.004,0.007,0.01,.015,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.0,200.,400.,1000.,10000.,100000./ C ELASTIC TOTAL DATA YXTOT/29.0,26.0,24.0,20.0,16.0,12.9,9.60,7.65,6.40,5.55, /4.25,3.40,2.80,2.40,2.00,1.90,2.00,2.50,3.15,4.20, /5.25,6.10,6.80,7.40,7.80,8.20,8.80,9.30,9.60,9.80, /11.3,12.5,13.5,14.5,15.5,16.5,17.5,18.5,19.5,20.0, /20.7,23.5,23.5,21.5,19.5,18.5,17.5,17.0,16.0,15.0, /14.5,11.5,9.00,7.00,0.70,0.07/ C VIBRATION V11 (RESONANCE ONLY) DATA XVIB2/0.065,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB2/0.0,0.0,.028,.063,.196,.182,0.14,.126,.182,0.21, /0.21,.175,.063,.028,.014,.007,.0014,.000007,.0000007,.00000007, /.000000007,.0000000007/ C VIBRATION V2 (RESONANCE ONLY) DATA XVIB3/0.1001,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB3/0.0,0.0,.175,.343,1.08,1.04,0.77,0.70,1.02,1.15, /1.13,.959,0.35,.154,.063,.028,.014,.000003,.0000003,.00000003, /.000000003,.0000000003/ C VIBRATION V1 (RESONANCE ONLY) DATA XVIB4/0.1523,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB4/0.0,0.0,.378,.756,2.34,2.24,1.68,1.51,2.23,2.52, /2.49,2.10,0.77,.336,0.14,0.07,.035,.00007,.000007,.0000007, /.00000007,.000000007/ C VIBRATION HARMONIC 2(V1) DATA XVIB5/0.35,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB5/0.0,0.0,.135,0.27,0.84,.795,0.60,0.54,.795,0.90, /.885,0.75,0.27,0.12,.045,0.03,.015,.00015,.000015,.0000015, /.00000015,.000000015/ C VIBRATION HARMONIC (3(V1) + ALL OTHER HARMONICS) DATA XVIB6/0.500,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB6/0.0,0.0,0.54,1.08,3.35,3.20,2.40,2.16,3.18,3.60, /3.56,3.00,1.09,0.48,.195,.105,.045,.00015,.000015,.0000015, /.00000015,.000000015/ C DISOCIATION X-SECTION DATA XDISS/11.8,12.0,13.0,14.0,15.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,300.,400.,500., /600.,800.,1000.,2000.,4000.,10000.,100000./ DATA YDISS/0.00,.007,.072,0.40,0.75,1.33,1.61,1.88,2.00,2.25, /2.40,2.50,2.60,2.60,2.60,2.55,2.50,2.40,2.30,2.20, /2.00,1.75,1.48,0.80,0.46,0.21,0.021/ DATA XION/14.48,17.0,18.0,19.0,21.0,23.0,25.0,27.0,29.0,31.0, /33.0,35.0,37.0,39.0,41.0,43.0,45.0,47.0,49.0,51.0, /61.0,71.0,81.0,91.0,101.,126.,151.,176.,201.,251., /301.,351.,401.,451.,501.,601.,701.,801.,901.,1001., /1251.,1501.,1751.,2001.,2501.,3001.,10000.,100000./ DATA YION/0.00,.0889,.211,.375,.782,1.18,1.59,2.11,2.49,2.81, /3.16,3.49,3.86,4.17,4.54,4.85,5.14,5.52,5.77,6.19, /6.82,7.57,7.84,8.17,8.39,8.77,8.75,8.76,8.57,8.17, /7.41,7.13,6.55,6.21,5.89,5.17,4.72,4.40,3.96,3.77, /3.19,2.79,2.44,2.28,1.88,1.67,0.60,0.09/ DATA XATT/2.00,2.25,2.50,2.75,3.00,3.25,3.50,3.75,4.00,4.25, /4.50,4.75,5.00,5.25,5.50,5.75,6.00,6.25,6.50,6.75, /7.00,8.00,10.0,20.0,100.0,100000./ DATA YATT/.0,.0075,.020,.038,.053,.069,.083,.086,.083,.074, /.060,.046,.035,.025,.017,.010,.0068,.004,.0016,.0007, /.0003,.0002,.0001,.00001,.000001,.0000001/ C --------------------------------------------------------------------- C NEW ANALYSIS UPDATED TO NOVEMBER 1999. C ALLOWS SUPERELASTIC SCATTERING TO ALL VIBRATIONAL LEVELS c EXCLUDING VIBRATION HARMONICS. C BORN ANGULAR DISTRIBUTION FOR V1(0.1001) AND V2(0.1523) LEVELS. C -------------------------------------------------------------------- NAME='C2F6 (1999)' C NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C ANISOTROPIC SCATTERING FROM LEVEL 5 AND 6 KIN(5)=1 KIN(6)=1 C NDATA=56 NETOT=56 NVIB2=22 NVIB3=22 NVIB4=22 NVIB5=22 NVIB6=22 NDISS=27 NATT=26 NION=48 E(1)=0.0 E(2)=2.0*EMASS/(138.0118*AMU) E(3)=14.48 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=14.48 EIN(1)=-0.065 EIN(2)=-0.1001 EIN(3)=-0.1523 EIN(4)=0.065 EIN(5)=0.1001 EIN(6)=0.1523 EIN(7)=0.35 EIN(8)=0.500 EIN(9)=11.8 SCRPT(1)=' ' SCRPT(2)=' ELASTIC C2F6 ' SCRPT(3)=' IONISATION ELOSS= 14.48 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V11 ELOSS= -0.065 ' SCRPT(8)=' VIB V2 ELOSS= -0.1001 ' SCRPT(9)=' VIB V1 ELOSS= -0.1523 ' SCRPT(10)=' VIB V11 ELOSS= 0.065 ' SCRPT(11)=' VIB V2 ELOSS= 0.1001 ' SCRPT(12)=' VIB V1 ELOSS= 0.1523 ' SCRPT(13)=' VIB 2V1 ELOSS= 0.35 ' SCRPT(14)=' VIB ELOSS= 0.50 ' SCRPT(15)=' EXC DISOCN ELOSS= 11.8 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(2)/AKT) APOP3=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XENM(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXMOM(J)-YXMOM(J-1))/(XENM(J)-XENM(J-1)) B=(XENM(J-1)*YXMOM(J)-XENM(J)*YXMOM(J-1))/(XENM(J-1)-XENM(J)) XMOMT=(A*EN+B)*1.0D-16 DO 50 J=2,NETOT IF(EN.LE.XENT(J)) GO TO 60 50 CONTINUE J=NETOT 60 A=(YXTOT(J)-YXTOT(J-1))/(XENT(J)-XENT(J-1)) B=(XENT(J-1)*YXTOT(J)-XENT(J)*YXTOT(J-1))/(XENT(J-1)-XENT(J)) XTOT=(A*EN+B)*1.0D-16 IF(KEL(2).EQ.1) Q(2,I)=XTOT IF(KEL(2).EQ.1) PEQEL(2,I)=0.5+(XTOT-XMOMT)/XTOT IF(KEL(2).EQ.0) Q(2,I)=XMOMT C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 250 IF(EN.GT.XATT(NATT)) GO TO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 250 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTICS QIN(1,I)=0.0D0 QIN(2,I)=0.0D0 QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V11 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.0363*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 260 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 270 260 CONTINUE J=NVIB2 270 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C SUPERELASTIC OF VIBRATION V2 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.4230*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 280 J=2,NVIB3 IF((EN+EIN(5)).LE.XVIB3(J)) GO TO 290 280 CONTINUE J=NVIB3 290 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(2,I)=QIN(2,I)+(EN+EIN(5))*(A*(EN+EIN(5))+B)/EN QIN(2,I)=QIN(2,I)*APOP2/(1.0+APOP2)*1.D-16 C SUPERELASTIC OF VIBRATION V1 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=1.5000*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 300 J=2,NVIB4 IF((EN+EIN(6)).LE.XVIB4(J))GO TO 301 300 CONTINUE J=NVIB4 301 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(3,I)=QIN(3,I)*APOP3/(1.0+APOP3)*1.D-16 C 305 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0363*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=((A*EN+B)+QIN(4,I))*1.0/(1.0+APOP1)*1.D-16 400 CONTINUE C QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.4230*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(5) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM.T /TOT X-SECT FOR RESONANCE PART = RAT3 RAT3=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(5,I)+RAT3*(A*EN+B))*1.0D-16 XMT=XMT/(1.0+APOP2) QIN(5,I)=((A*EN+B)+QIN(5,I))*1.0/(1.0+APOP2)*1.D-16 PEQIN(5,I)=0.5+(QIN(5,I)-XMT)/QIN(5,I) 500 CONTINUE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=1.500*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(6,I)+RAT4*(A*EN+B))*1.0D-16 XMT=XMT/(1.0+APOP3) QIN(6,I)=((A*EN+B)+QIN(6,I))*1.0/(1.0+APOP3)*1.D-16 PEQIN(6,I)=0.5+(QIN(6,I)-XMT)/QIN(6,I) 600 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(8,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NDISS IF(EN.LE.XDISS(J)) GO TO 820 810 CONTINUE J=NDISS 820 A=(YDISS(J)-YDISS(J-1))/(XDISS(J)-XDISS(J-1)) B=(XDISS(J-1)*YDISS(J)-XDISS(J)*YDISS(J-1))/(XDISS(J-1)-XDISS(J)) QIN(9,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS30. SUBROUTINE GAS30(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ---------------------------------------------------------------- C SF6 FILE FROM ITOH ET AL J.PHYS.D. 26 (1993) 1975-1979 C --------------------------------------------------------------- NAME='SF6 (93 Itoh)' C NIN=2 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 E(1)=0.0 E(2)=2.0D0*EMASS/(146.05642*AMU) E(3)=15.8 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.8 EIN(1)=0.095 EIN(2)=9.80 SCRPT(1)=' ' SCRPT(2)=' ELASTIC SF6 ' SCRPT(3)=' IONISATION ELOSS= 15.8 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= 0.095 ' SCRPT(8)=' EXC ELOSS= 9.80 ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0D0) THEN BTA=-5.0 GO TO 3 ENDIF BTA=LOG10(EN) 3 BTA2=BTA*BTA BTA3=BTA2*BTA EN2=EN*EN EN3=EN2*EN Q(2,I)=0.0D0 IF(EN.EQ.0.0) THEN Q(2,I)=20.0 GO TO 10 ENDIF IF(EN.LE.0.255) THEN Q(2,I)=10.0**(1.055-1.033*BTA-0.1632*BTA2+0.0126*BTA3) GO TO 10 ENDIF IF(EN.LE.0.92) THEN Q(2,I)=10.0**(1.041-0.189*BTA+2.091*BTA2+1.348*BTA3) GO TO 10 ENDIF IF(EN.LE.1.90) THEN Q(2,I)=10.0**(1.037-0.3741*BTA+1.193*BTA2+0.5179*BTA3) GO TO 10 ENDIF IF(EN.LE.6.20) THEN Q(2,I)=1.917+6.463*EN-1.027*EN2+0.05562*EN3 GO TO 10 ENDIF IF(EN.LE.28.2) THEN Q(2,I)=12.53+0.7762*EN-0.0457*EN2+0.0006344*EN3 GO TO 10 ENDIF IF(EN.LE.51.0) THEN Q(2,I)=20.44-0.3373*EN+0.002436*EN2-0.000006189*EN3 GO TO 10 ENDIF IF(EN.LE.80.0) THEN Q(2,I)=29.09-0.7115*EN+0.007397*EN2-0.00002485*EN3 GO TO 10 ENDIF IF(EN.LE.188.0) THEN Q(2,I)=10.51*EXP(-0.00558*EN) GO TO 10 ENDIF IF(EN.LE.364.0) THEN Q(2,I)=1289.0*EN**(-1.118) GO TO 10 ENDIF Q(2,I)=4.881*EXP(-0.002807*EN) 10 Q(2,I)=Q(2,I)*1.D-16 Q(3,I)=0.0D0 IF(EN.LE.15.8) GO TO 20 IF(EN.LE.38.9) THEN Q(3,I)=4.715-0.693*EN+0.0306*EN2-0.0003508*EN3 GO TO 20 ENDIF IF(EN.LE.122.0) THEN Q(3,I)=6.986-EXP(2.07-0.0145*EN-0.00014*EN2) GO TO 20 ENDIF IF(EN.LE.201.0) THEN Q(3,I)=4.364+0.0323*EN-0.00009987*EN2 GO TO 20 ENDIF Q(3,I)=EXP(2.151-0.00115*EN) 20 Q(3,I)=Q(3,I)*1.D-16 Q(4,I)=0.0D0 QA1=0.0D0 IF(EN.EQ.0.0) THEN QA1=4000.0 GO TO 30 ENDIF IF(EN.GT.25.0) THEN QA5=0.0D0 GO TO 70 ENDIF IF(EN.LE.0.14) THEN QA1=436.0*(0.0617*SQRT(1.0/EN)*EXP(-1.0*(EN/0.0045)**2)+ /EXP(-EN/0.0559)) GO TO 30 ENDIF IF(EN.LE.0.9746) THEN QA1=EXP(6.477-20.91*EN+1.183*EN2) ENDIF 30 Q(4,I)=QA1*1.D-16 QA2=0.0D0 IF(EN.LE.0.312) THEN QA2=2.85*EN+5.419*EN2+30.49*EN3 GO TO 40 ENDIF IF(EN.LE.0.425) THEN QA2=468.0*EN3-624.3*EN2+268.1*EN-34.75 GO TO 40 ENDIF IF(EN.LE.1.05) THEN QA2=8.751-22.15*EN+19.08*EN2-5.592*EN3 GO TO 40 ENDIF QA2=EXP(8.054-10.42*EN) 40 Q(4,I)=Q(4,I)+QA2*1.D-16 QA3=0.0D0 IF(EN.LT.2.19) GO TO 50 IF(EN.LE.2.90) THEN QA3=-0.1069+0.08552*EN-0.01676*EN2 GO TO 50 ENDIF IF(EN.LT.3.32) GO TO 50 IF(EN.LE.4.27) THEN QA3=-0.2016+0.2133*EN-0.07421*EN2+0.00851*EN3 GO TO 50 ENDIF IF(EN.LE.5.59) THEN QA3=0.7777-0.6913*EN+0.1856*EN2-0.0153*EN3 GO TO 50 ENDIF IF(EN.LE.7.95) THEN QA3=0.9885-0.3216*EN+0.03252*EN2-0.0009533*EN3 GO TO 50 ENDIF IF(EN.LE.9.73) THEN QA3=-0.3504+0.08087*EN-0.0045*EN2 GO TO 50 ENDIF IF(EN.LE.11.1) THEN QA3=1.397-0.2724*EN+0.01335*EN2 GO TO 50 ENDIF IF(EN.LE.11.8) THEN QA3=-3.30+0.5801*EN-0.02533*EN2 GO TO 50 ENDIF QA3=EXP(10.91-1.264*EN) 50 Q(4,I)=Q(4,I)+QA3*1.D-16 QA4=0.0D0 IF(EN.LT.3.92) GO TO 60 IF(EN.LE.8.25) THEN QA4=EXP(-466.8+296.4*EN-71.09*EN2+7.573*EN3-0.3033*EN*EN3) ENDIF 60 Q(4,I)=Q(4,I)+QA4*1.D-16 QA5=0.0D0 IF(EN.LE.1.50) GO TO 70 IF(EN.LE.3.27) THEN QA5=EXP(2.932*EN3-22.91*EN2+56.52*EN-53.37) GO TO 70 ENDIF IF(EN.LE.7.45) THEN QA5=EXP(0.5554*EN3-9.613*EN2+52.832*EN-100.3) GO TO 70 ENDIF IF(EN.LE.10.6) THEN QA5=EXP(0.1216*EN2-1.035*EN-9.723) GO TO 70 ENDIF IF(EN.LE.11.7) THEN QA5=EXP(-1.114*EN2+25.12*EN-148.0)-0.00012 GO TO 70 ENDIF QA5=EXP(-0.9386*EN2+21.0*EN-123.9) 70 Q(4,I)=Q(4,I)+QA5*1.D-16 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C VIBRATIONAL SUM QIN(1,I)=0.0D0 IF(EN.LE.EIN(1).OR.EN.GT.50.0) GO TO 400 IF(EN.LE.0.247) THEN QIN(1,I)=(14.06+4.425/EN-0.5472/EN2)*1.D-16 GO TO 400 ENDIF IF(EN.LE.0.505) THEN QIN(1,I)=(EXP(11.19*EN3-13.91*EN2+4.663*EN+2.664))*1.D-16 GO TO 400 ENDIF IF(EN.LE.1.03) THEN QIN(1,I)=(EXP(0.3166*EN2-1.341*EN+3.509))*1.D-16 GO TO 400 ENDIF QIN(1,I)=(22.0*10.0**(-0.2645*EN))*1.D-16 C EXCITATION 400 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 500 IF(EN.LE.26.66) THEN QIN(2,I)=(4.811*BTA-4.769)*1.D-16 GO TO 500 ENDIF IF(EN.LE.29.3) THEN QIN(2,I)=(3.643-0.204*EN+0.005477*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.56.6) THEN QIN(2,I)=(0.01382*EN**(1.522))*1.D-16 GO TO 500 ENDIF IF(EN.LE.65.2) THEN QIN(2,I)=(-25.26+0.9902*EN-0.007593*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.100.0) THEN QIN(2,I)=(2.197+0.1479*EN-0.001123*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.250.0) THEN QIN(2,I)=(17.11*EXP(-0.0109*EN))*1.D-16 GO TO 500 ENDIF QIN(2,I)=(6566000.0*EN**(-2.821))*1.D-16 500 CONTINUE IF(QIN(2,I).LE.0.0) QIN(2,I)=0.0 C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS31. SUBROUTINE GAS31(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEL(25),YEL(25),XVIBH(19),YVIBH(19),XION(47),YION(47), /XATT(30),YATT(30),XEXC1(18),YEXC1(18) DIMENSION ELEV(120),AKL(120),AJL(120),PJ(120) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C J VALUES OF FIRST 120 LEVELS DATA AJL/0.0,1.0,1.0,2.0,2.0,2.0,3.0,3.0,3.0,3.0, /4.0,4.0,4.0,4.0,4.0,5.0,5.0,5.0,5.0,5.0, /5.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,7.0,7.0, /7.0,7.0,7.0,7.0,7.0,7.0,8.0,8.0,8.0,8.0, /8.0,8.0,8.0,8.0,8.0,9.0,9.0,9.0,9.0,9.0, /9.0,9.0,9.0,9.0,9.0,10.,10.,10.,10.,10., /10.,10.,10.,10.,10.,10.,11.,11.,11.,11., /11.,11.,11.,11.,11.,11.,11.,11.,12.,12., /12.,12.,12.,12.,12.,12.,12.,12.,12.,12., /12.,13.,13.,13.,13.,13.,13.,13.,13.,13., /13.,13.,13.,13.,13.,14.,14.,14.,14.,14., /14.,14.,14.,14.,14.,14.,14.,14.,14.,14./ C K VALUES OF FIRST 120 LEVELS DATA AKL/0.0,0.0,1.0,0.0,1.0,2.0,0.0,1.0,2.0,3.0, /0.0,1.0,2.0,3.0,4.0,0.0,1.0,2.0,3.0,4.0, /5.0,0.0,1.0,2.0,3.0,4.0,5.0,6.0,0.0,1.0, /2.0,3.0,4.0,5.0,6.0,7.0,0.0,1.0,2.0,3.0, /4.0,5.0,6.0,7.0,8.0,0.0,1.0,2.0,3.0,4.0, /5.0,6.0,7.0,8.0,9.0,0.0,1.0,2.0,3.0,4.0, /5.0,6.0,7.0,8.0,9.0,10.,0.0,1.0,2.0,3.0, /4.0,5.0,6.0,7.0,8.0,9.0,10.,11.,0.0,1.0, /2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.,11., /12.,0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0, /9.0,10.,11.,12.,13.,0.0,1.0,2.0,3.0,4.0, /5.0,6.0,7.0,8.0,9.0,10.,11.,12.,13.,14./ C (ELASTIC + ROTATIONAL) MOMENTUM TRANSFER DATA XEL/.0001,.001,0.01,0.03,0.10,0.40,1.00,1.50,2.00,2.75, /3.50,5.00,7.50,10.0,12.0,15.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YEL/156000.,15600.,1560.,520.,125.,19.5,5.20,3.25,3.00,2.80, /3.20,4.50,6.00,7.00,7.00,6.80,6.50,5.50,2.90,1.55, /0.70,0.15,.075,.007,.0007/ C RESONACE SHAPE FUNCTION FOR VIBRATIONS DATA XVIBH/0.00,2.00,3.00,4.00,5.00,6.00,7.00,7.30,7.60,8.00, /9.00,10.0,12.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIBH/0.00,0.00,0.01,0.06,0.16,0.39,0.59,0.60,0.59,0.42, /0.31,0.16,0.06,0.01,.005,.001,.0001,.00001,.000001/ C IONISATION DATA XION/10.16,11.6,12.5,14.0,16.0,18.0,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,55.0,60.0,65.0,70.0,80.0,90.0,100., /120.,140.,160.,180.,200.,240.,280.,320.,360.,400., /440.,500.,550.,600.,650.,700.,750.,800.,900.,1000., /2000.,4000.,6000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.067,0.16,0.29,0.46,0.63,0.80,1.25,1.65,2.02, /2.38,2.62,2.78,2.87,2.94,2.99,3.02,3.05,3.04,3.01, /2.91,2.80,2.70,2.60,2.50,2.30,2.13,1.98,1.85,1.74, /1.64,1.50,1.42,1.34,1.27,1.21,1.16,1.12,1.05,0.99, /0.53,0.30,0.21,0.14,.074,.040,.017/ C ATTACHMENT DATA XATT/4.60,4.75,5.00,5.25,5.50,5.65,5.75,6.00,6.25,6.50, /6.75,7.00,7.50,8.00,8.50,9.00,9.50,10.0,10.5,11.0, /11.5,12.0,12.5,13.0,14.0,16.0,100.,1000.,10000.,100000./ DATA YATT/0.00,0.15,0.63,2.04,3.33,3.66,3.60,2.82,1.65,0.84, /0.36,0.12,.048,.048,.048,.081,.276,0.48,0.54,0.48, /0.36,.213,.114,0.06,0.03,.003,.0003,.00003,.000003,.0000003/ C USED SINGLE LUMPED EXCITATION LEVEL AT 7 EV DATA XEXC1/7.00,7.50,8.00,9.00,10.0,12.0,15.0,20.0,30.0,40.0, /50.0,80.0,100.0,200.,500.0,1000.,10000.,100000./ DATA YEXC1/0.00,0.24,0.48,0.96,1.32,1.80,2.28,2.85,3.10,3.25, /3.35,3.20,3.00,2.40,1.35,0.72,.072,.0072/ C NAME='NH3 (2004)' C -------------------------------------------------------------------- C EXPERIMENTAL DATA NOT ACCURATE IN AMMONIA GAS. LACK OF GOOD QUALITY C TRANSVERSE DIFFUSION MEASUREMENTS. ELECTRON SCATTERING DATA IS C USED IN THE ANALYSIS AND REPRODUCES DRIFT VELOCITY AND DIFFUSION C COEFFICIENTS TO AN ACCURACY OF 3%. C ATTACHMENT X-SEC FROM SHARP ET AL. C USED SYMMETRIC TOP ROTATOR MODEL FOR ROTATIONAL EXCITATIONS C THE FIRST 120 ROTATIONAL STATES ARE USED IN THE ANALYSIS THEN GROUPED C INTO TRANSITIONS OF EQUAL ENERGY GIVING A TOTAL OF 28 ROTATIONAL C TRANSITIONS. C DIPOLE ANGULAR DISTRIBUTION USED FOR ROTATIONAL EXCITATIONS. C --------------------------------------------------------------------- NIN=34 DO 1 J=1,6 1 KEL(J)=0 C SET ANGULAR DISTRIBUTION FLAG FOR ROTATIONAL LEVELS DO 2 J=1,NIN KIN(J)=0 2 IF(J.LE.28) KIN(J)=1 NDATA=25 NVIBH=19 NION=47 NATT=30 NEXC1=18 E(1)=0.0 E(2)=2.0*EMASS/(17.03056*AMU) E(3)=10.16 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.8 C---------------------------------------------------------------------- C AR AND BR ARE ROTATIONAL CONSTANTS FOR SYMMETRIC TOP ROTOR C ENERGY OF LEVEL (JK) = BR*J*(J+1) + (AR-BR)*K*K C DBA IS DIPOLE MOMENT C DRAT IS MOMENTUM TRANSFER TO TOTAL X-SECTION RATIO FOR DIPOLE ROTOR C AR=0.0000287 BR=0.0000453 RY=13.60569172 A0=0.5291772083D-8 C CONVERT TO EV AR=AR*2.0*RY BR=BR*2.0*RY DBA=0.5787 DRAT=0.08 DBK=8.37758*RY*(DBA*A0)**2 C --------------------------------------------------------------------- C CALCULATE ROTATIONAL STATE POPULATION PJ(LEVEL) AT TEMPERATURE AKT L=1 ELEV(1)=0.0 DO 6 J=1,14 DO 6 K=1,(J+1) L=L+1 AJ=DBLE(J) AK=DBLE(K) AK=AK-1.0 6 ELEV(L)=BR*AJ*(AJ+1.0)+(AR-BR)*AK*AK PJ(1)=2.0 DO 7 L=2,120 DEG=2.0 IF(AKL(L).EQ.1..OR.AKL(L).EQ.2..OR.AKL(L).EQ.4..OR.AKL(L).EQ.5..OR /.AKL(L).EQ.7..OR.AKL(L).EQ.8..OR.AKL(L).EQ.10..OR.AKL(L).EQ.11..OR /.AKL(L).EQ.13..OR.AKL(L).EQ.14.) DEG=1.0 7 PJ(L)=DEG*(2.0*AJL(L)+1.0)*EXP(-ELEV(L)/AKT) SUM=0.0 DO 8 L=1,120 8 SUM=SUM+PJ(L) DO 9 L=1,120 9 PJ(L)=PJ(L)/SUM C ---------------------------------------------------------------------- EIN(1)=ELEV(1)-ELEV(2) EIN(2)=-EIN(1) EIN(3)=ELEV(2)-ELEV(4) EIN(4)=-EIN(3) EIN(5)=ELEV(4)-ELEV(7) EIN(6)=-EIN(5) EIN(7)=ELEV(7)-ELEV(11) EIN(8)=-EIN(7) EIN(9)=ELEV(11)-ELEV(16) EIN(10)=-EIN(9) EIN(11)=ELEV(16)-ELEV(22) EIN(12)=-EIN(11) EIN(13)=ELEV(22)-ELEV(29) EIN(14)=-EIN(13) EIN(15)=ELEV(29)-ELEV(37) EIN(16)=-EIN(15) EIN(17)=ELEV(37)-ELEV(46) EIN(18)=-EIN(17) EIN(19)=ELEV(46)-ELEV(56) EIN(20)=-EIN(19) EIN(21)=ELEV(56)-ELEV(67) EIN(22)=-EIN(21) EIN(23)=ELEV(67)-ELEV(79) EIN(24)=-EIN(23) EIN(25)=ELEV(79)-ELEV(92) EIN(26)=-EIN(25) EIN(27)=ELEV(92)-ELEV(106) EIN(28)=-EIN(27) EIN(29)=-0.1178 EIN(30)=0.1178 EIN(31)=0.2013 EIN(32)=0.4137 EIN(33)=0.8274 EIN(34)=7.00 SCRPT(1)=' ' SCRPT(2)=' ELASTIC NH3 ' SCRPT(3)=' IONISATION ELOSS= 10.16 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 1K-- 0K ELOSS= -0.00247' SCRPT(8)=' ROT 0K-- 1K ELOSS= 0.00247' SCRPT(9)=' ROT 2K-- 1K ELOSS= -0.00493' SCRPT(10)=' ROT 1K-- 2K ELOSS= 0.00493' SCRPT(11)=' ROT 3K-- 2K ELOSS= -0.00740' SCRPT(12)=' ROT 2K-- 3K ELOSS= 0.00740' SCRPT(13)=' ROT 4K-- 3K ELOSS= -0.00986' SCRPT(14)=' ROT 3K-- 4K ELOSS= 0.00986' SCRPT(15)=' ROT 5K-- 4K ELOSS= -0.0123 ' SCRPT(16)=' ROT 4K-- 5K ELOSS= 0.0123 ' SCRPT(17)=' ROT 6K-- 5K ELOSS= -0.0148 ' SCRPT(18)=' ROT 5K-- 6K ELOSS= 0.0148 ' SCRPT(19)=' ROT 7K-- 6K ELOSS= -0.0173 ' SCRPT(20)=' ROT 6K-- 7K ELOSS= 0.0173 ' SCRPT(21)=' ROT 8K-- 7K ELOSS= -0.0197 ' SCRPT(22)=' ROT 7K-- 8K ELOSS= 0.0197 ' SCRPT(23)=' ROT 9K-- 8K ELOSS= -0.0222 ' SCRPT(24)=' ROT 8K-- 9K ELOSS= 0.0222 ' SCRPT(25)=' ROT 10K-- 9K ELOSS= -0.0247 ' SCRPT(26)=' ROT 9K--10K ELOSS= 0.0247 ' SCRPT(27)=' ROT 11K--10K ELOSS= -0.0271 ' SCRPT(28)=' ROT 10K--11K ELOSS= 0.0271 ' SCRPT(29)=' ROT 12K--11K ELOSS= -0.0296 ' SCRPT(30)=' ROT 11K--12K ELOSS= 0.0296 ' SCRPT(31)=' ROT 13K--12K ELOSS= -0.0320 ' SCRPT(32)=' ROT 12K--13K ELOSS= 0.0320 ' SCRPT(33)=' ROT 14K--13K ELOSS= -0.0345 ' SCRPT(34)=' ROT 13K--14K ELOSS= 0.0345 ' SCRPT(35)=' VIB V2 ELOSS= -0.1178 ' SCRPT(36)=' VIB V2 ELOSS= 0.1178 ' SCRPT(37)=' VIB V4 ELOSS= 0.2013 ' SCRPT(38)=' VIB V1 + V3 ELOSS= 0.4137 ' SCRPT(39)=' VIB HAR ELOSS= 0.8274 ' SCRPT(40)=' EXC ELOSS= 7.00 ' EN=-ESTEP/2.0D0 APOPV2=EXP(EIN(29)/AKT) DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0D0 IF(EN.LE.XEL(1)) THEN Q(2,I)=YEL(1)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEL(J)) GO TO 20 10 CONTINUE J=NDATA C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC 20 YXJ=LOG(YEL(J)) YXJ1=LOG(YEL(J-1)) XNJ=LOG(XEL(J)) XNJ1=LOG(XEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 40 DO 31 J=2,NION IF(EN.LE.XION(J)) GO TO 32 31 CONTINUE J=NION 32 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 40 CONTINUE C Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 50 DO 41 J=2,NATT IF(EN.LE.XATT(J)) GO TO 42 41 CONTINUE J=NATT 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-18 50 CONTINUE Q(5,I)=0.0D0 Q(6,I)=0.0D0 C---------------------------------------------------------------------- C DIPOLE BORN ROTATIONAL TRANSITIONS C SUMMED TRANSITIONS OF EQUAL ENERGY C---------------------------------------------------------------------- ENRT=SQRT(EN) C ROTATIONAL COLLISIONS (JK) C 10-->00 AJ=1.0 AJG=1.0 AJG2=AJG*AJG QIN(1,I)=DBK*LOG((ENRT+SQRT(EN-EIN(1)))/(SQRT(EN-EIN(1))-ENRT)) /*PJ(2)*AJG2/(AJG*(2.0*AJ+1.0)*EN) PEQIN(1,I)=0.5+(QIN(1,I)-DRAT*QIN(1,I))/QIN(1,I) C 00-->10 AJ=0.0 AJG=1.0 AJG2=AJG*AJG QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 60 QIN(2,I)=DBK*LOG((ENRT+SQRT(EN-EIN(2)))/(ENRT-SQRT(EN-EIN(2)))) /*PJ(1)*AJG2/(AJG*(2.0*AJ+1.0)*EN) PEQIN(2,I)=0.5+(QIN(2,I)-DRAT*QIN(2,I))/QIN(2,I) C 20-->10 + 21-->11 60 AJ=2.0 AJG=2.0 AJG2=AJG*AJG QIN(3,I)=DBK*LOG((ENRT+SQRT(EN-EIN(3)))/(SQRT(EN-EIN(3))-ENRT)) /*(PJ(4)*AJG2+PJ(5)*(AJG2-1.0))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(3,I)=0.5+(QIN(3,I)-DRAT*QIN(3,I))/QIN(3,I) C 10-->20 + 11-->21 AJ=1.0 AJG=2.0 AJG2=AJG*AJG QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 61 QIN(4,I)=DBK*LOG((ENRT+SQRT(EN-EIN(4)))/(ENRT-SQRT(EN-EIN(4)))) /*(PJ(2)*AJG2+PJ(3)*(AJG2-1.0))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(4,I)=0.5+(QIN(4,I)-DRAT*QIN(4,I))/QIN(4,I) C 30-->20 + 31-->21 + 32-->22 61 AJ=3.0 AJG=3.0 AJG2=AJG*AJG QIN(5,I)=DBK*LOG((ENRT+SQRT(EN-EIN(5)))/(SQRT(EN-EIN(5))-ENRT)) /*(PJ(7)*AJG2+PJ(8)*(AJG2-1.0)+PJ(9)*(AJG2-4.0))/(AJG*(2.0*AJ+1.0)* /EN) PEQIN(5,I)=0.5+(QIN(5,I)-DRAT*QIN(5,I))/QIN(5,I) C 20-->30 + 21-->31 + 22-->32 AJ=2.0 AJG=3.0 AJG2=AJG*AJG QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 62 QIN(6,I)=DBK*LOG((ENRT+SQRT(EN-EIN(6)))/(ENRT-SQRT(EN-EIN(6)))) /*(PJ(4)*AJG2+PJ(5)*(AJG2-1.0)+PJ(6)*(AJG2-4.0))/(AJG*(2.0*AJ+1.0)* /EN) PEQIN(6,I)=0.5+(QIN(6,I)-DRAT*QIN(6,I))/QIN(6,I) C 40-->30 + 41-->31 + 42-->32 + 43-->33 62 AJ=4.0 AJG=4.0 AJG2=AJG*AJG QIN(7,I)=DBK*LOG((ENRT+SQRT(EN-EIN(7)))/(SQRT(EN-EIN(7))-ENRT)) /*(PJ(11)*AJG2+PJ(12)*(AJG2-1.0)+PJ(13)*(AJG2-4.0)+PJ(14)*(AJG2-9.0 /))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(7,I)=0.5+(QIN(7,I)-DRAT*QIN(7,I))/QIN(7,I) C 30-->40 + 31-->41 + 32-->42 + 33-->43 AJ=3.0 AJG=4.0 AJG2=AJG*AJG QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 63 QIN(8,I)=DBK*LOG((ENRT+SQRT(EN-EIN(8)))/(ENRT-SQRT(EN-EIN(8)))) /*(PJ(7)*AJG2+PJ(8)*(AJG2-1.0)+PJ(9)*(AJG2-4.0)+PJ(10)*(AJG2-9.0))/ /(AJG*(2.0*AJ+1.0)*EN) PEQIN(8,I)=0.5+(QIN(8,I)-DRAT*QIN(8,I))/QIN(8,I) C 50-->40 + 51-->41 + 52-->42 + 53-->43 + 54-->44 63 AJ=5.0 AJG=5.0 AJG2=AJG*AJG QIN(9,I)=DBK*LOG((ENRT+SQRT(EN-EIN(9)))/(SQRT(EN-EIN(9))-ENRT)) /*(PJ(16)*AJG2+PJ(17)*(AJG2-1.0)+PJ(18)*(AJG2-4.0)+PJ(19)*(AJG2-9.0 /)+PJ(20)*(AJG2-16.0))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(9,I)=0.5+(QIN(9,I)-DRAT*QIN(9,I))/QIN(9,I) C 40-->50 + 41-->51 + 42-->52 + 43-->53 + 44-->54 AJ=4.0 AJG=5.0 AJG2=AJG*AJG QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 64 QIN(10,I)=DBK*LOG((ENRT+SQRT(EN-EIN(10)))/(ENRT-SQRT(EN-EIN(10) /)))*(PJ(11)*AJG2+PJ(12)*(AJG2-1.0)+PJ(13)*(AJG2-4.0)+PJ(14)*(AJG2- /9.0)+PJ(15)*(AJG2-16.0))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(10,I)=0.5+(QIN(10,I)-DRAT*QIN(10,I))/QIN(10,I) C 60-->50 + 61-->51 + 62-->52 + 63-->53 + 64-->54 + 65-->55 64 AJ=6.0 AJG=6.0 AJG2=AJG*AJG QIN(11,I)=DBK*LOG((ENRT+SQRT(EN-EIN(11)))/(SQRT(EN-EIN(11))- /ENRT))*(PJ(22)*AJG2+PJ(23)*(AJG2-1.0)+PJ(24)*(AJG2-4.0)+PJ(25)* /(AJG2-9.0)+PJ(26)*(AJG2-16.0)+PJ(27)*(AJG2-25.0))/(AJG*(2.0*AJ+ /1.0)*EN) PEQIN(11,I)=0.5+(QIN(11,I)-DRAT*QIN(11,I))/QIN(11,I) C 50-->60 + 51-->61 + 52-->62 + 53-->63 + 54-->64 + 55-->65 AJ=5.0 AJG=6.0 AJG2=AJG*AJG QIN(12,I)=0.0D0 IF(EN.LE.EIN(12)) GO TO 65 QIN(12,I)=DBK*LOG((ENRT+SQRT(EN-EIN(12)))/(ENRT-SQRT(EN-EIN(12) /)))*(PJ(16)*AJG2+PJ(17)*(AJG2-1.0)+PJ(18)*(AJG2-4.0)+PJ(19)*(AJG2- /9.0)+PJ(20)*(AJG2-16.0)+PJ(21)*(AJG2-25.0))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(12,I)=0.5+(QIN(12,I)-DRAT*QIN(12,I))/QIN(12,I) C 70-->60 + 71-->61 + 72-->62 + 73-->63 + 74-->64 + 75-->65 + 76-->66 65 AJ=7.0 AJG=7.0 AJG2=AJG*AJG QIN(13,I)=DBK*LOG((ENRT+SQRT(EN-EIN(13)))/(SQRT(EN-EIN(13))- /ENRT))*(PJ(29)*AJG2+PJ(30)*(AJG2-1.0)+PJ(31)*(AJG2-4.0)+PJ(32)* /(AJG2-9.0)+PJ(33)*(AJG2-16.)+PJ(34)*(AJG2-25.)+PJ(35)*(AJG2-36.))/ /(AJG*(2.0*AJ+1.0)*EN) PEQIN(13,I)=0.5+(QIN(13,I)-DRAT*QIN(13,I))/QIN(13,I) C 60-->70 + 61-->71 + 62-->72 + 63-->73 + 64-->74 + 65-->75 + 66-->76 AJ=6.0 AJG=7.0 AJG2=AJG*AJG QIN(14,I)=0.0D0 IF(EN.LE.EIN(14)) GO TO 66 QIN(14,I)=DBK*LOG((ENRT+SQRT(EN-EIN(14)))/(ENRT-SQRT(EN-EIN(14) /)))*(PJ(22)*AJG2+PJ(23)*(AJG2-1.0)+PJ(24)*(AJG2-4.0)+PJ(25)*(AJG2- /9.0)+PJ(26)*(AJG2-16.0)+PJ(27)*(AJG2-25.0)+PJ(28)*(AJG2-36.))/ /(AJG*(2.0*AJ+1.0)*EN) PEQIN(14,I)=0.5+(QIN(14,I)-DRAT*QIN(14,I))/QIN(14,I) C 80-->70 +81-->71 +82-->72 +87-->73 +84-->74 +85-->75 +86-->76 +87-->77 66 AJ=8.0 AJG=8.0 AJG2=AJG*AJG QIN(15,I)=DBK*LOG((ENRT+SQRT(EN-EIN(15)))/(SQRT(EN-EIN(15))- /ENRT))*(PJ(37)*AJG2+PJ(38)*(AJG2-1.0)+PJ(39)*(AJG2-4.0)+PJ(40)* /(AJG2-9.0)+PJ(41)*(AJG2-16.)+PJ(42)*(AJG2-25.)+PJ(43)*(AJG2-36.)+ /PJ(44)*(AJG2-49.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(15,I)=0.5+(QIN(15,I)-DRAT*QIN(15,I))/QIN(15,I) C 70-->80 +71-->81 +72-->82 +73-->83 +74-->84 +75-->85 +76-->86 +77-->87 AJ=7.0 AJG=8.0 AJG2=AJG*AJG QIN(16,I)=0.0D0 IF(EN.LE.EIN(16)) GO TO 67 QIN(16,I)=DBK*LOG((ENRT+SQRT(EN-EIN(16)))/(ENRT-SQRT(EN-EIN(16) /)))*(PJ(29)*AJG2+PJ(30)*(AJG2-1.0)+PJ(31)*(AJG2-4.0)+PJ(32)*(AJG2- /9.0)+PJ(33)*(AJG2-16.0)+PJ(34)*(AJG2-25.0)+PJ(35)*(AJG2-36.)+ /PJ(36)*(AJG2-49.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(16,I)=0.5+(QIN(16,I)-DRAT*QIN(16,I))/QIN(16,I) C 90-->80 +91-->81 +92-->82 +97-->83 +94-->84 +95-->85 +96-->86 +97-->87 C +98-->88 67 AJ=9.0 AJG=9.0 AJG2=AJG*AJG QIN(17,I)=DBK*LOG((ENRT+SQRT(EN-EIN(17)))/(SQRT(EN-EIN(17))- /ENRT))*(PJ(46)*AJG2+PJ(47)*(AJG2-1.0)+PJ(48)*(AJG2-4.0)+PJ(49)* /(AJG2-9.0)+PJ(50)*(AJG2-16.)+PJ(51)*(AJG2-25.)+PJ(52)*(AJG2-36.)+ /PJ(53)*(AJG2-49.)+PJ(54)*(AJG2-64.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(17,I)=0.5+(QIN(17,I)-DRAT*QIN(17,I))/QIN(17,I) C 80-->90 +81-->91 +82-->92 +83-->93 +84-->94 +85-->95 +86-->96 +87-->97 C +88-->98 AJ=8.0 AJG=9.0 AJG2=AJG*AJG QIN(18,I)=0.0D0 IF(EN.LE.EIN(18)) GO TO 68 QIN(18,I)=DBK*LOG((ENRT+SQRT(EN-EIN(18)))/(ENRT-SQRT(EN-EIN(18) /)))*(PJ(37)*AJG2+PJ(38)*(AJG2-1.0)+PJ(39)*(AJG2-4.0)+PJ(40)*(AJG2- /9.0)+PJ(41)*(AJG2-16.0)+PJ(42)*(AJG2-25.0)+PJ(43)*(AJG2-36.)+ /PJ(44)*(AJG2-49.)+PJ(45)*(AJG2-64.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(18,I)=0.5+(QIN(18,I)-DRAT*QIN(18,I))/QIN(18,I) C 10 0-->90 + 10 1-->91 +10 2-->92 + 10 3 -->93 + 10 4-->94 + 10 5-->95 C + 10 6-->96 + 10 7-->97 + 10 8 -->98 + 10 9-->99 68 AJ=10.0 AJG=10.0 AJG2=AJG*AJG QIN(19,I)=DBK*LOG((ENRT+SQRT(EN-EIN(19)))/(SQRT(EN-EIN(19))- /ENRT))*(PJ(56)*AJG2+PJ(57)*(AJG2-1.0)+PJ(58)*(AJG2-4.0)+PJ(59)* /(AJG2-9.0)+PJ(60)*(AJG2-16.)+PJ(61)*(AJG2-25.)+PJ(62)*(AJG2-36.)+ /PJ(63)*(AJG2-49.)+PJ(64)*(AJG2-64.)+PJ(65)*(AJG2-81.))/(AJG*(2.0* /AJ+1.0)*EN) PEQIN(19,I)=0.5+(QIN(19,I)-DRAT*QIN(19,I))/QIN(19,I) C 90-->10 0 + 91-->10 1 + 92-->10 2 + 93-->10 3 + 94-->10 4 + 95-->10 5 C + 96-->10 6 + 97-->10 7 + 98-->10 8 + 99-->10 9 AJ=9.0 AJG=10.0 AJG2=AJG*AJG QIN(20,I)=0.0D0 IF(EN.LE.EIN(20)) GO TO 69 QIN(20,I)=DBK*LOG((ENRT+SQRT(EN-EIN(20)))/(ENRT-SQRT(EN-EIN(20) /)))*(PJ(46)*AJG2+PJ(47)*(AJG2-1.0)+PJ(48)*(AJG2-4.0)+PJ(49)*(AJG2- /9.0)+PJ(50)*(AJG2-16.0)+PJ(51)*(AJG2-25.0)+PJ(52)*(AJG2-36.)+ /PJ(53)*(AJG2-49.)+PJ(54)*(AJG2-64.)+PJ(55)*(AJG2-81.))/(AJG*(2.0* /AJ+1.0)*EN) PEQIN(20,I)=0.5+(QIN(20,I)-DRAT*QIN(20,I))/QIN(20,I) C 110-->100 +111-->101 +112-->102 +113-->103 +114-->104 +115-->105 C +116-->106 +117-->107 +118-->108 +119-->109 +1110-->1010 69 AJ=11.0 AJG=11.0 AJG2=AJG*AJG QIN(21,I)=DBK*LOG((ENRT+SQRT(EN-EIN(21)))/(SQRT(EN-EIN(21))- /ENRT))*(PJ(67)*AJG2+PJ(68)*(AJG2-1.0)+PJ(69)*(AJG2-4.0)+PJ(70)* /(AJG2-9.0)+PJ(71)*(AJG2-16.)+PJ(72)*(AJG2-25.)+PJ(73)*(AJG2-36.)+ /PJ(74)*(AJG2-49.)+PJ(75)*(AJG2-64.)+PJ(76)*(AJG2-81.)+PJ(77)*(AJG2 /-100.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(21,I)=0.5+(QIN(21,I)-DRAT*QIN(21,I))/QIN(21,I) C 100-->110 +101-->111 +102-->112 +103-->113 +104-->114 +105-->115 C +106-->116 +107-->117 +108-->118 +109-->119 +1010-->1110 AJ=10.0 AJG=11.0 AJG2=AJG*AJG QIN(22,I)=0.0D0 IF(EN.LE.EIN(22)) GO TO 70 QIN(22,I)=DBK*LOG((ENRT+SQRT(EN-EIN(22)))/(ENRT-SQRT(EN-EIN(22) /)))*(PJ(56)*AJG2+PJ(57)*(AJG2-1.0)+PJ(58)*(AJG2-4.0)+PJ(59)*(AJG2- /9.0)+PJ(60)*(AJG2-16.0)+PJ(61)*(AJG2-25.0)+PJ(62)*(AJG2-36.)+ /PJ(63)*(AJG2-49.)+PJ(64)*(AJG2-64.)+PJ(65)*(AJG2-81.)+PJ(66)*(AJG2 /-100.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(22,I)=0.5+(QIN(22,I)-DRAT*QIN(22,I))/QIN(22,I) C 120-->110 +121-->111 +122-->112 +123-->113 +124-->114 +125-->115 C +126-->116 +127-->117 +128-->118 +129-->119 +1210-->1110 +1211-->1111 70 AJ=12.0 AJG=12.0 AJG2=AJG*AJG QIN(23,I)=DBK*LOG((ENRT+SQRT(EN-EIN(23)))/(SQRT(EN-EIN(23))- /ENRT))*(PJ(79)*AJG2+PJ(80)*(AJG2-1.0)+PJ(81)*(AJG2-4.0)+PJ(82)* /(AJG2-9.0)+PJ(83)*(AJG2-16.)+PJ(84)*(AJG2-25.)+PJ(85)*(AJG2-36.)+ /PJ(86)*(AJG2-49.)+PJ(87)*(AJG2-64.)+PJ(88)*(AJG2-81.)+PJ(89)*(AJG2 /-100.)+PJ(90)*(AJG2-121.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(23,I)=0.5+(QIN(23,I)-DRAT*QIN(23,I))/QIN(23,I) C 110-->120 +111-->121 +112-->122 +113-->123 +114-->124 +115-->125 C +116-->126 +117-->127 +118-->128 +119-->129 +1110-->1210 +1111-->1211 AJ=11.0 AJG=12.0 AJG2=AJG*AJG QIN(24,I)=0.0D0 IF(EN.LE.EIN(24)) GO TO 71 QIN(24,I)=DBK*LOG((ENRT+SQRT(EN-EIN(24)))/(ENRT-SQRT(EN-EIN(24) /)))*(PJ(67)*AJG2+PJ(68)*(AJG2-1.0)+PJ(69)*(AJG2-4.0)+PJ(70)*(AJG2- /9.0)+PJ(71)*(AJG2-16.0)+PJ(72)*(AJG2-25.0)+PJ(73)*(AJG2-36.)+ /PJ(74)*(AJG2-49.)+PJ(75)*(AJG2-64.)+PJ(76)*(AJG2-81.)+PJ(77)*(AJG2 /-100.)+PJ(78)*(AJG2-121.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(24,I)=0.5+(QIN(24,I)-DRAT*QIN(24,I))/QIN(24,I) C 130-->120 +131-->121 +132-->122 +133-->123 +134-->124 +135-->125 C +136-->126 +137-->127 +138-->128 +139-->129 +1310-->1210 +1311-->1211 C +1312-->1212 71 AJ=13.0 AJG=13.0 AJG2=AJG*AJG QIN(25,I)=DBK*LOG((ENRT+SQRT(EN-EIN(25)))/(SQRT(EN-EIN(25))- /ENRT))*(PJ(92)*AJG2+PJ(93)*(AJG2-1.0)+PJ(94)*(AJG2-4.0)+PJ(95)* /(AJG2-9.0)+PJ(96)*(AJG2-16.)+PJ(97)*(AJG2-25.)+PJ(98)*(AJG2-36.)+ /PJ(99)*(AJG2-49.)+PJ(100)*(AJG2-64.)+PJ(101)*(AJG2-81.)+PJ(102)* /(AJG2-100.)+PJ(103)*(AJG2-121.)+PJ(104)*(AJG2-144.))/(AJG* /(2.0*AJ+1.0)*EN) PEQIN(25,I)=0.5+(QIN(25,I)-DRAT*QIN(25,I))/QIN(25,I) C 120-->130 +121-->131 +122-->132 +123-->133 +124-->134 +125-->135 C +126-->136 +127-->137 +128-->138 +129-->139 +1210-->1310 +1211-->1311 C +1212-->1312 AJ=12.0 AJG=13.0 AJG2=AJG*AJG QIN(26,I)=0.0D0 IF(EN.LE.EIN(26)) GO TO 72 QIN(26,I)=DBK*LOG((ENRT+SQRT(EN-EIN(26)))/(ENRT-SQRT(EN-EIN(26) /)))*(PJ(79)*AJG2+PJ(80)*(AJG2-1.0)+PJ(81)*(AJG2-4.0)+PJ(82)*(AJG2- /9.0)+PJ(83)*(AJG2-16.0)+PJ(84)*(AJG2-25.0)+PJ(85)*(AJG2-36.)+ /PJ(86)*(AJG2-49.)+PJ(87)*(AJG2-64.)+PJ(88)*(AJG2-81.)+PJ(89)*(AJG2 /-100.)+PJ(90)*(AJG2-121.)+PJ(91)*(AJG2-144.))/ /(AJG*(2.0*AJ+1.0)*EN) PEQIN(26,I)=0.5+(QIN(26,I)-DRAT*QIN(26,I))/QIN(26,I) C 140-->130 +141-->131 +142-->132 +143-->133 +144-->134 +145-->135 C +146-->136 +147-->137 +148-->138 +149-->139 +1410-->1310 +1411-->1311 C +1412-->1312 +1413-->1313 72 AJ=14.0 AJG=14.0 AJG2=AJG*AJG QIN(27,I)=DBK*LOG((ENRT+SQRT(EN-EIN(27)))/(SQRT(EN-EIN(27))- /ENRT))*(PJ(106)*AJG2+PJ(107)*(AJG2-1.0)+PJ(108)*(AJG2-4.0)+ /PJ(109)*(AJG2-9.0)+PJ(110)*(AJG2-16.)+PJ(111)*(AJG2-25.)+PJ(112)* /(AJG2-36.)+PJ(113)*(AJG2-49.)+PJ(114)*(AJG2-64.)+PJ(115)* /(AJG2-81.)+PJ(116)*(AJG2-100.)+PJ(117)*(AJG2-121.)+PJ(118)*(AJG2- /144.)+PJ(119)*(AJG2-169.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(27,I)=0.5+(QIN(27,I)-DRAT*QIN(27,I))/QIN(27,I) C 130-->140 +131-->141 +132-->142 +133-->143 +134-->144 +135-->145 C +136-->146 +137-->147 +138-->148 +139-->149 +1310-->1410 +1311-->1411 C +1312-->1412 +1313-->1413 AJ=13.0 AJG=14.0 AJG2=AJG*AJG QIN(28,I)=0.0D0 IF(EN.LE.EIN(28)) GO TO 200 QIN(28,I)=DBK*LOG((ENRT+SQRT(EN-EIN(28)))/(ENRT-SQRT(EN-EIN(28) /)))*(PJ(92)*AJG2+PJ(93)*(AJG2-1.0)+PJ(94)*(AJG2-4.0)+PJ(95)*(AJG2- /9.0)+PJ(96)*(AJG2-16.0)+PJ(97)*(AJG2-25.0)+PJ(98)*(AJG2-36.)+ /PJ(99)*(AJG2-49.)+PJ(100)*(AJG2-64.)+PJ(101)*(AJG2-81.)+PJ(102)* /(AJG2-100.)+PJ(103)*(AJG2-121.)+PJ(104)*(AJG2-144.)+PJ(105)* /(AJG2-169.))/(AJG*(2.0*AJ+1.0)*EN) PEQIN(28,I)=0.5+(QIN(28,I)-DRAT*QIN(28,I))/QIN(28,I) C C SUPERELASTIC V2 C 200 QIN(29,I)=0.0D0 IF(EN.LE.0.0) GO TO 250 EFAC=SQRT(1.0-(EIN(29)/EN)) QIN(29,I)=0.195*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EIN(30)).LE.XVIBH(J)) GO TO 230 220 CONTINUE J=NVIBH 230 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(29,I)=QIN(29,I)+0.25*(EN+EIN(30))*(A*(EN+EIN(30))+B)/EN QIN(29,I)=QIN(29,I)*APOPV2/(1.0+APOPV2)*1.D-16 C V2 250 QIN(30,I)=0.0D0 IF(EN.LE.EIN(30)) GO TO 300 EFAC=SQRT(1.0-(EIN(30)/EN)) QIN(30,I)=0.195*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(30,I)=QIN(30,I)+0.25*(A*EN+B) QIN(30,I)=QIN(30,I)/(1.0+APOPV2)*1.D-16 C V4 300 QIN(31,I)=0.0D0 IF(EN.LE.EIN(31)) GO TO 400 EFAC=SQRT(1.0-(EIN(31)/EN)) QIN(31,I)=0.182*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(31,I)=(QIN(31,I)+0.52*(A*EN+B))*1.D-16 400 CONTINUE C V1+V3 QIN(32,I)=0.0D0 IF(EN.LE.EIN(32)) GO TO 500 EFAC=SQRT(1.0-(EIN(32)/EN)) QIN(32,I)=0.182*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(32,I)=(QIN(32,I)+1.10*(A*EN+B))*1.D-16 500 CONTINUE C HARMONICS (2V1,2V1+V4,3V1, ETC ) QIN(33,I)=0.0D0 IF(EN.LE.EIN(33)) GO TO 600 DO 510 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 520 510 CONTINUE J=NVIBH 520 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(33,I)=0.165*(A*EN+B)*1.D-16 600 CONTINUE C QIN(34,I)=0.0D0 IF(EN.LE.EIN(34)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(34,I)=(A*EN+B)*1.D-16 700 CONTINUE SUM=0.0D0 DO 750 K=1,28 750 SUM=SUM+QIN(K,I) C--------------------------------------------------------------------- C SUBTRACT ROTATIONAL MT XSEC TO GET CORRECT ELASTIC MT XSEC. C Q(2,I)=Q(2,I)-SUM*DRAT C----------------------------------------------------- C TOTAL XSEC (USED ONLY FOR INFORMATION) Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(29,I)+QIN(30,I)+ /QIN(31,I)+QIN(32,I)+QIN(33,I)+QIN(34,I)+SUM*DRAT 900 CONTINUE C SAVE COMPUTE TIME DO 1000 K=1,6 J=35-K IF(EFINAL.LE.EIN(J)) NIN=J-1 1000 CONTINUE C END +DECK,GAS32. SUBROUTINE GAS32(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(49),YXSEC(49),XVIB1(31),YVIB1(31),XVIB2(31), /YVIB2(31),XVIB3(18),YVIB3(18),XVIB4(31),YVIB4(31),XVIB5(21), /YVIB5(21),XEXC1(17),YEXC1(17),XEXC2(23),YEXC2(23),XEXC3(20), /YEXC3(20),XION(46),YION(46),XATT(16),YATT(16) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.01,.014,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.11,0.12,0.14,0.16,0.18,0.20,0.25,0.30, /0.40,0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00, /6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0,70.0, /100.,140.,200.,250.,300.,500.,1000.,1500.,10000.,100000./ DATA YXSEC/54.0,51.0,50.0,49.0,45.0,42.0,39.0,34.0,28.5,22.0, /15.5,9.40,6.80,4.80,4.40,4.80,6.10,8.80,15.5,19.5, /22.0,22.5,23.0,23.5,24.0,24.0,24.5,24.0,25.0,27.0, /28.0,30.0,27.0,22.0,15.4,12.0,8.31,6.28,3.69, /2.66,1.57,0.97,0.70,0.57,0.32,.143,.092,.011,.001/ DATA XVIB1/.114,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB1/0.0,.001,0.04,0.07,0.14,0.15,0.14,0.10,0.08,0.08, /0.08,0.08,0.08,0.20,0.28,0.36,0.48,0.64,0.70,0.64, /0.59,0.30,0.22,0.17,0.11,0.06,.022,.008,.0008,.00003, /.000003/ DATA XVIB2/.161,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB2/0.00,.001,0.22,0.75,3.77,5.28,4.65,3.26,2.16,1.21, /0.77,0.54,0.38,0.42,0.60,0.80,1.11,1.30,1.35,1.20, /1.00,0.56,0.44,0.33,0.24,0.14,0.06,.024,.003,.0001, /.00001/ DATA XVIB3/.322,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,10.0,100.0,1000.,10000.,100000./ DATA YVIB3/0.00,.001,0.15,0.17,0.82,1.50,1.36,0.90,0.52,0.30, /0.15,0.08,0.04,.002,.0002,.00002,.000002,.0000002/ DATA XVIB4/.360,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB4/0.00,.001,.052,.090,0.54,0.86,0.80,0.64,0.46,0.45, /0.45,0.45,0.50,0.60,1.00,1.40,1.80,1.85,1.70,1.50, /1.20,0.65,0.48,0.42,0.28,0.16,0.06,0.03,.004,.0001, /.00001/ DATA XVIB5/0.72,1.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB5/0.00,.0001,.008,0.05,0.10,0.16,0.20,0.21,0.18,0.15, /0.12,0.06,0.05,0.04,0.03,.015,.007,.003,.0004,.00001, /.000001/ DATA XEXC1/4.18,4.50,5.00,6.00,7.00,8.00,9.00,10.0,12.0,14.0, /16.0,20.0,30.0,100.,1000.,10000.,100000./ DATA YEXC1/0.00,0.11,0.21,0.42,0.84,0.80,0.67,0.61,0.45,0.34, /0.27,0.25,0.20,0.06,.006,.0006,.00006/ DATA XEXC2/7.30,7.50,8.00,8.50,9.00,10.0,11.0,14.0,20.0,25.0, /30.0,40.0,60.0,80.0,100.,150.,200.,400.,1000.,2000., /10000.,20000.,100000./ DATA YEXC2/0.00,.026,0.21,0.36,0.65,1.11,1.70,2.38,2.74,2.81, /2.86,2.81,2.69,2.55,2.38,2.14,1.87,1.46,0.82,0.41, /0.09,.044,.009/ DATA XEXC3/9.00,10.0,11.0,14.0,16.0,20.0,25.0,30.0,40.0,60.0, /80.0,100.,150.,200.,400.,1000.,2000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.43,1.11,2.04,2.30,2.64,2.81,2.86,2.81,2.69, /2.55,2.38,2.14,1.87,1.46,0.82,0.41,0.09,.044,.009/ DATA XION/9.73,11.0,12.0,13.0,14.0,16.5,19.0,24.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.19,0.43,0.70,1.05,2.12,3.06,4.81,5.97,6.80, /7.38,7.88,8.51,9.04,9.32,9.42,9.42,9.42,9.14,8.64, /8.16,7.71,7.20,6.31,5.77,5.34,4.86,4.55,4.00,3.68, /3.39,3.02,2.82,2.44,2.10,1.90,1.74,1.50,1.28,0.85, /0.64,0.47,0.33,0.18,.097,.061/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ NAME='C3H6 (1999)' C --------------------------------------------------------------------- C 1999 INCLUDED VIBRATIONAL RESONACE SHAPE FROM ALLEN AND ALSO USED C SIMILAR RESONANCE SHAPE IN ETHENE FROM WALKER ET AL .: C REF J.CHEM.PHYS. 69(1978) 5532 (ETHENE RESONANCE MOVED TO 2.1 EV) C FIT TO SCHMIDTS ,GEE+FREEMAN AND BOWMAN+GORDON DATA IN PURE PROPENE C NO GOOD DATA AT HIGH FIELD THEREFORE X-SECTIONS ABOVE 3 EV ARE C DERIVED FROM SYSTEMATICS IN THE HYDROCARBONS. C --------------------------------------------------------------------- NIN=12 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=49 NVIB1=31 NVIB2=31 NVIB3=18 NVIB4=31 NVIB5=21 NEXC1=17 NEXC2=23 NEXC3=20 NION=46 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(42.08064*AMU) E(3)=9.73 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=9.73 EIN(1)=-0.0716 EIN(2)=0.0716 EIN(3)=-0.114 EIN(4)=0.114 EIN(5)=-0.161 EIN(6)=0.161 EIN(7)=0.322 EIN(8)=0.360 EIN(9)=0.720 EIN(10)=4.18 EIN(11)=7.30 EIN(12)=9.00 SCRPT(1)=' ' SCRPT(2)=' ELASTIC PROPENE ' SCRPT(3)=' IONISATION ELOSS= 9.73 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V20 ELOSS= -0.0716 ' SCRPT(8)=' VIB V20 ELOSS= 0.0716 ' SCRPT(9)=' VIB V13 ELOSS= -0.114 ' SCRPT(10)=' VIB V13 ELOSS= 0.114 ' SCRPT(11)=' VIB ELOSS= -0.161 ' SCRPT(12)=' VIB ELOSS= 0.161 ' SCRPT(13)=' VIB HAR ELOSS= 0.322 ' SCRPT(14)=' VIB ELOSS= 0.360 ' SCRPT(15)=' VIB HAR ELOSS= 0.720 ' SCRPT(16)=' EXC ELOSS= 4.18 ' SCRPT(17)=' EXC ELOSS= 7.30 ' SCRPT(18)=' EXC ELOSS= 9.00 ' AMP=0.070 AMP1=0.15 AMP2=0.15 AMP3=0.198 APOPL=EXP(EIN(1)/AKT) APOP=EXP(EIN(3)/AKT) APOPH=EXP(EIN(5)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 C 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C SUPERELASTIC QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 3050 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOPL/(1.0+APOPL)*1.D-16 3050 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 3060 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOPL)*1.D-16 3060 CONTINUE C C V7 SUPERELASTIC QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP1*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EIN(4)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V7 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP1*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QIN(5,I)=0.0D0 IF(EN.LE.0.0) GO TO 4150 EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=AMP2*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EIN(6)).LE.XVIB2(J)) GO TO 4120 4110 CONTINUE J=NVIB2 4120 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(5,I)=QIN(5,I)+(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(5,I)=QIN(5,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V2 + V3 (SUM OF VIBRATIONS AT 166 AND 201 MV) QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 450 EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(6,I)=QIN(6,I)+(A*EN+B) QIN(6,I)=QIN(6,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3+2V2 (HARMONICS) QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 500 DO 460 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 470 460 CONTINUE J=NVIB3 470 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(7,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 550 EFAC=SQRT(1.0-(EIN(8)/EN)) QIN(8,I)=AMP3*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(8,I)=(QIN(8,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 600 DO 560 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 570 560 CONTINUE J=NVIB5 570 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(9,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(10,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(11,I)=0.0D0 IF(EN.LE.EIN(11)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(11,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(12,I)=0.0D0 IF(EN.LE.EIN(12)) GO TO 899 DO 810 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 820 810 CONTINUE J=NEXC3 820 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(12,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I)+ /QIN(12,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(12)) NIN=11 IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS33. SUBROUTINE GAS33(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(49),YXSEC(49),XVIB1(32),YVIB1(32),XVIB2(31), /YVIB2(31),XVIB3(15),YVIB3(15),XVIB4(28),YVIB4(28),XVIB5(21), /YVIB5(21),XEXC1(23),YEXC1(23),XEXC2(20),YEXC2(20), /XION(46),YION(46),XATT(16),YATT(16) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.01,.014,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.11,0.12,0.14,0.16,0.18,0.20,0.25,0.30, /0.40,0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00, /6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0,70.0, /100.,140.,200.,250.,300.,500.,1000.,1500.,10000.,100000./ DATA YXSEC/13.0,11.0,10.5,9.80,7.80,5.60,4.20,2.90,2.10,2.00, /2.20,2.65,3.25,3.90,5.65,7.30,9.15,10.8,14.2,16.8, /20.0,21.5,22.0,22.5,22.7,22.8,22.9,23.0,23.5,25.5, /27.0,29.0,27.0,22.0,15.4,12.0,8.31,6.28,3.69, /2.66,1.57,0.97,0.70,0.57,0.32,.143,.092,.011,.001/ DATA XVIB1/.107,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /3.00,4.00,4.50,5.00,5.50,6.00,6.50,7.00,8.00,9.00, /10.0,11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000., /10000.,100000./ DATA YVIB1/0.0,.001,.022,.040,.080,.080,.080,.085,.085,.085, /0.13,0.22,0.70,1.10,1.25,1.15,0.75,0.60,0.71,0.77, /0.71,0.64,0.31,0.25,0.18,0.12,0.06,.025,0.01,.001, /.00003,.000003/ DATA XVIB2/.178,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB2/0.00,.001,0.15,0.25,0.40,0.45,0.47,0.50,0.52,0.55, /0.57,0.60,0.62,0.66,0.74,0.90,1.14,1.33,1.38,1.23, /1.01,0.56,0.44,0.34,0.25,0.14,.059,.025,.003,.0001, /.00001/ DATA XVIB3/.295,1.00,3.00,4.00,4.50,5.00,5.50,6.00,6.50,7.00, /10.0,100.0,1000.,10000.,100000./ DATA YVIB3/0.00,.001,0.01,0.01,0.05,0.10,0.15,0.10,0.05,0.01, /.001,.0001,.00001,.000001,.0000001/ DATA XVIB4/.374,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,3.00, /4.00,5.00,6.00,7.00,8.00,9.00,10.0,11.0,15.0,20.0, /25.0,30.0,50.0,100.,200.,1000.,10000.,100000./ DATA YVIB4/0.00,.001,.029,.049,0.30,0.44,0.47,0.50,0.55,0.70, /0.75,1.15,1.40,1.70,1.80,1.70,1.50,1.40,0.90,0.66, /0.57,0.40,0.22,0.92,0.04,.004,.0004,.00004/ DATA XVIB5/.748,1.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB5/0.00,.0001,.002,.030,.052,.088,0.11,0.12,0.10,.084, /.065,.035,.025,.020,.016,.009,.004,.0014,.0002,.000005, /.0000005/ DATA XEXC1/7.30,7.50,8.00,8.50,9.00,10.0,11.0,14.0,20.0,25.0, /30.0,40.0,60.0,80.0,100.,150.,200.,400.,1000.,2000., /10000.,20000.,100000./ DATA YEXC1/0.00,.026,0.21,0.36,0.65,1.11,1.70,2.38,2.74,2.81, /2.86,2.81,2.69,2.55,2.38,2.14,1.87,1.46,0.82,0.41, /0.09,.044,.009/ DATA XEXC2/9.00,10.0,11.0,14.0,16.0,20.0,25.0,30.0,40.0,60.0, /80.0,100.,150.,200.,400.,1000.,2000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.43,1.11,2.04,2.30,2.64,2.81,2.86,2.81,2.69, /2.55,2.38,2.14,1.87,1.46,0.82,0.41,0.09,.044,.009/ DATA XION/9.86,11.0,12.0,13.0,14.0,16.5,19.0,24.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.19,0.43,0.70,1.05,2.12,3.06,4.81,5.97,6.80, /7.38,7.88,8.51,9.04,9.32,9.42,9.42,9.42,9.14,8.64, /8.16,7.71,7.20,6.31,5.77,5.34,4.86,4.55,4.00,3.68, /3.39,3.02,2.82,2.44,2.10,1.90,1.74,1.50,1.28,0.85, /0.64,0.47,0.33,0.18,.097,.061/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ NAME='cyclo-C3H6 (99)' C --------------------------------------------------------------------- C 1999 INCLUDED VIBRATIONAL RESONACE SHAPES FROM ALLEN (ERHARDT AND C MORGAN) AND ASLO BOESTEN AND TANAKA XIX ICPEAC C FIT TO SCHMIDTS ,GEE+FREEMAN AND BOWMAN+GORDON DATA IN C PURE CYCLO - PROPANE AND SCHMIDT IN HELIUM/CYCLOPROPANE. C NO GOOD DATA AT HIGH FIELD THEREFORE X-SECTIONS ABOVE 1 EV ARE C DERIVED FROM SYSTEMATICS IN THE HYDROCARBONS AND ABOVE REFS. C --------------------------------------------------------------------- NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=49 NVIB1=32 NVIB2=31 NVIB3=15 NVIB4=28 NVIB5=21 NEXC1=23 NEXC2=20 NION=46 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(42.08064*AMU) E(3)=9.86 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=9.86 EIN(1)=-0.107 EIN(2)=0.107 EIN(3)=-0.178 EIN(4)=0.178 EIN(5)=0.295 EIN(6)=0.374 EIN(7)=0.748 EIN(8)=7.30 EIN(9)=9.00 SCRPT(1)=' ' SCRPT(2)=' ELASTIC CYCLO PROPANE ' SCRPT(3)=' IONISATION ELOSS= 9.86 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V11 ELOSS= -0.107 ' SCRPT(8)=' VIB V11 ELOSS= 0.107 ' SCRPT(9)=' VIB ELOSS= -0.178 ' SCRPT(10)=' VIB ELOSS= 0.178 ' SCRPT(11)=' VIB 2V3 ELOSS= 0.295 ' SCRPT(12)=' VIB ELOSS= 0.374 ' SCRPT(13)=' VIB HAR ELOSS= 0.748 ' SCRPT(14)=' EXC ELOSS= 7.30 ' SCRPT(15)=' EXC ELOSS= 9.00 ' AMP1=0.120 AMP2=0.090 AMP3=0.109 APOP=EXP(EIN(1)/AKT) APOPH=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 C 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C V7 SUPERELASTIC QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V11 + V3 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=QIN(2,I)+(A*EN+B) QIN(2,I)=QIN(2,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 4150 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 4120 4110 CONTINUE J=NVIB2 4120 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V9 + V2 (SUM OF VIBRATIONS AT 179 AND 183 MV) QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 450 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3 (HARMONICS) QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 460 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 470 460 CONTINUE J=NVIB3 470 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 + V8 + V12 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 550 EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP3*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 600 DO 560 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 570 560 CONTINUE J=NVIB5 570 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 850 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 820 810 CONTINUE J=NEXC1 820 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 850 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 899 DO 860 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 870 860 CONTINUE J=NEXC2 870 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS34. SUBROUTINE GAS34(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(24),YXSEC(24),XVIBH(18),YVIBH(18),XION(47),YION(47), /XATT(17),YATT(17),XEXC(25),YEXC(25),XEXC1(23),YEXC1(23), /XEXC2(19),YEXC2(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.001,0.01,0.10,0.40,1.00,1.50,2.00,3.00, /4.00,5.00,7.50,10.0,12.0,15.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YXSEC/2060.,2060.,1750.,175.,42.5,16.5,13.5,12.5,13.5, /15.0,16.0,20.0,19.0,18.0,15.0,11.5,8.60,3.60,2.05, /0.80,0.20,0.10,.008,.0008/ DATA XVIBH/0.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,12.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIBH/0.00,0.00,.025,0.45,0.60,0.80,0.95,1.00,0.95,0.80, /0.60,0.45,0.30,0.18,0.02,.001,.0001,.00001/ DATA XION/10.85,11.5,12.0,12.5,13.5,14.5,15.5,16.5,17.5,18.5, /20.0,25.0,30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0, /90.0,100.,125.,150.,175.,200.,250.,300.,350.,400., /450.,500.,600.,700.,800.,900.,1000.,1250.,1500.,1750., /2000.,4000.,6000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.015,0.06,0.13,0.33,0.60,0.89,1.21,1.53,1.84, /2.12,3.29,4.20,4.67,5.11,5.52,5.70,6.30,6.54,6.48, /6.46,6.51,6.17,5.97,5.65,5.36,4.73,4.34,3.95,3.65, /3.28,3.15,2.86,2.56,2.25,2.12,1.92,1.65,1.44,1.29, /1.15,0.68,0.50,0.34,.189,.104,.043/ DATA XATT/5.00,5.50,6.00,7.00,7.50,8.00,8.50,9.00,9.50,10.0, /10.4,11.0,12.0,13.0,14.0,15.0,20.0/ DATA YATT/0.00,.145,0.44,0.38,0.32,0.24,0.26,0.36,0.66,1.24, /2.00,1.08,0.30,0.20,0.16,0.12,0.00/ DATA XEXC/7.50,8.00,9.00,10.0,11.0,14.0,17.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.00,0.21,0.46,0.53,0.60,0.67,0.69,0.79,0.90,0.96, /1.00,1.00,1.00,0.93,0.87,0.80,0.66,0.60,0.47,0.33, /0.17,0.09,.033,.017,.004/ DATA XEXC1/9.80,10.5,11.5,13.5,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,0.11,0.23,0.42,0.64,0.87,1.02,1.10, /1.15,1.15,1.15,1.07,1.00,0.93,0.78,0.70,0.54,0.40, /0.20,0.10,0.04,0.02,.004/ DATA XEXC2/17.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.24,0.52,0.66, /0.71,0.66,0.63,0.60,0.55,0.47,0.38,0.30,0.22,0.14, /.076,.043,.019,.009,.0019/ C NAME='CH3OH (1999)' C -------------------------------------------------------------------- C X-SECTIONS FROM SCALING ETHANOL X-SECTIONS AND ALSO FROM C TOTAL ELECTRON SCATTERING FROM GDANSK. C --------------------------------------------------------------------- NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=24 NVIBH=18 NION=47 NATT=17 NEXC=25 NEXC1=23 NEXC2=19 E(1)=0.0 E(2)=2.0*EMASS/(32.04186*AMU) E(3)=10.85 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.85 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.1281 EIN(4)=0.1281 EIN(5)=0.1668 EIN(6)=0.3527 EIN(7)=7.50 EIN(8)=9.80 EIN(9)=17.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC METHANOL ' SCRPT(3)=' IONISATION ELOSS= 10.85 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT ELOSS= -0.025 ' SCRPT(8)=' ROT ELOSS= 0.025 ' SCRPT(9)=' VIB V8 ELOSS= -0.1281 ' SCRPT(10)=' VIB V8 ELOSS= 0.1281 ' SCRPT(11)=' VIB V6 ELOSS= 0.1668 ' SCRPT(12)=' VIB V3 ELOSS= 0.3527 ' SCRPT(13)=' EXC ELOSS= 7.50 ' SCRPT(14)=' EXC ELOSS= 9.80 ' SCRPT(15)=' EXC ELOSS= 17.0 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0D0 C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 40 DO 31 J=2,NION IF(EN.LE.XION(J)) GO TO 32 31 CONTINUE J=NION 32 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 40 CONTINUE C Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 50 IF(EN.GE.XATT(NATT)) GO TO 50 DO 41 J=2,NATT IF(EN.LE.XATT(J)) GO TO 42 41 CONTINUE J=NATT 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 50 CONTINUE Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 150 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 250 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.40*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EIN(4)).LE.XVIBH(J)) GO TO 230 220 CONTINUE J=NVIBH 230 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.40*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.44*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(5,I)=(QIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.84*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C--------------------------------------------------------------------- C SUBTRACT ROTATIONAL XSEC TO GET CORRECT ELASTIC XSEC. Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I) C IF(Q(2,I).LE.0.0 .and. LBMCPR)WRITE(LUNOUT,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',D12.3,' I=',I5) C TOTAL Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+ /QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS35. SUBROUTINE GAS35(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(24),YXSEC(24),XVIBH(18),YVIBH(18),XION(48),YION(48), /XATT(17),YATT(17),XEXC(25),YEXC(25),XEXC1(23),YEXC1(23), /XEXC2(19),YEXC2(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.001,0.01,0.10,0.40,1.00,1.50,2.00,3.00, /4.00,5.00,7.50,10.0,12.0,15.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YXSEC/2060.,2060.,1750.,175.,42.5,16.5,13.5,12.5,13.5, /18.0,21.0,27.0,26.5,25.0,21.0,16.0,12.0,5.00,2.90, /1.05,0.35,0.16,.012,.001/ DATA XVIBH/0.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,12.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIBH/0.00,0.00,.025,0.25,0.66,0.88,1.05,1.10,1.05,0.88, /0.66,0.50,0.33,0.19,.022,.0011,.00011,.000011/ DATA XION/10.48,11.0,12.0,12.5,13.0,14.0,15.0,17.0,20.0,25.0, /30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0,100., /125.,150.,175.,200.,250.,300.,350.,400.,450.,500., /600.,700.,800.,900.,1000.,1250.,1500.,1750.,2000.,2500., /3000.,5000.,7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.11,0.32,0.45,0.59,0.91,1.32,2.21,3.12,5.01, /6.22,7.09,7.69,8.21,8.87,9.41,9.71,9.81,9.81,9.81, /9.52,9.00,8.50,8.03,7.50,6.58,6.01,5.56,5.06,4.74, /4.16,3.84,3.53,3.14,2.93,2.54,2.18,1.98,1.81,1.56, /1.34,0.88,0.66,0.49,0.35,.188,.101,.063/ DATA XATT/5.00,5.50,6.00,7.00,7.50,8.00,8.50,9.00,9.50,10.0, /10.4,11.0,12.0,13.0,14.0,15.0,20.0/ DATA YATT/0.00,.145,0.44,0.38,0.32,0.24,0.26,0.36,0.66,1.24, /2.00,1.08,0.30,0.20,0.16,0.12,0.00/ DATA XEXC/7.20,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.00,0.81,1.18,1.27,1.31,1.35,1.35,1.35,1.35,1.35, /1.39,1.39,1.35,1.27,1.06,0.98,0.82,0.77,0.65,0.42, /0.20,0.10,.041,.021,.004/ DATA XEXC1/9.50,10.5,11.5,13.5,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,0.14,0.30,0.56,0.86,1.15,1.35,1.46, /1.59,1.64,1.59,1.49,1.25,1.15,0.96,0.90,0.77,0.50, /0.24,0.12,.048,.025,.005/ DATA XEXC2/16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.32,0.69,0.96, /1.35,1.59,1.59,1.49,1.25,1.15,0.96,0.90,0.77,0.50, /0.24,0.12,.048,.025,.005/ C NAME='C2H5OH (1999)' C -------------------------------------------------------------------- C VIBRATION EXCITATION AND IONISATION FROM SCALING PROPANE X-SECTIONS C EXPERIMENTAL DATA FROM CHRISTOPHOROU AND FROMMHOLD ALSO MIXTURE c DATA WITH ARGON FROM COLLI AND LEONARDIS C --------------------------------------------------------------------- NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=24 NVIBH=18 NION=48 NATT=17 NEXC=25 NEXC1=23 NEXC2=19 E(1)=0.0 E(2)=2.0*EMASS/(46.06904*AMU) E(3)=10.48 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.48 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.109 EIN(4)=0.109 EIN(5)=0.1668 EIN(6)=0.3527 EIN(7)=7.20 EIN(8)=9.50 EIN(9)=16.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ETHANOL ' SCRPT(3)=' IONISATION ELOSS= 10.48 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT ELOSS= -0.025 ' SCRPT(8)=' ROT ELOSS= 0.025 ' SCRPT(9)=' VIB V8 ELOSS= -0.109 ' SCRPT(10)=' VIB V8 ELOSS= 0.109 ' SCRPT(11)=' VIB V6 ELOSS= 0.1668 ' SCRPT(12)=' VIB V3 ELOSS= 0.3527 ' SCRPT(13)=' EXC ELOSS= 7.20 ' SCRPT(14)=' EXC ELOSS= 9.50 ' SCRPT(15)=' EXC ELOSS= 16.0 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0D0 C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 40 DO 31 J=2,NION IF(EN.LE.XION(J)) GO TO 32 31 CONTINUE J=NION 32 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 40 CONTINUE C Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 50 IF(EN.GE.XATT(NATT)) GO TO 50 DO 41 J=2,NATT IF(EN.LE.XATT(J)) GO TO 42 41 CONTINUE J=NATT 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 50 CONTINUE Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 150 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 250 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.403*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EIN(4)).LE.XVIBH(J)) GO TO 230 220 CONTINUE J=NVIBH 230 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.403*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.423*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(5,I)=(QIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.84*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C--------------------------------------------------------------------- C SUBTRACT ROTATIONAL XSEC TO GET CORRECT ELASTIC XSEC. Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I) C IF(Q(2,I).LE.0.0 .and. LBMCPR)WRITE(LUNOUT,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',D12.3,' I=',I5) C TOTAL Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+ /QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS36. SUBROUTINE GAS36(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(24),YXSEC(24),XVIBH(18),YVIBH(18),XION(46),YION(46), /XATT(17),YATT(17),XEXC(25),YEXC(25),XEXC1(23),YEXC1(23), /XEXC2(19),YEXC2(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.001,0.01,0.10,0.40,1.00,1.50,2.00,3.00, /4.00,5.00,7.50,10.0,12.0,15.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YXSEC/2160.,2160.,1840.,184.,44.5,17.0,14.0,13.0,14.0, /21.0,26.0,33.5,33.5,31.5,26.5,20.5,15.5,6.50,3.70, /1.30,0.45,0.21,.015,.0012/ DATA XVIBH/0.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,12.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIBH/0.00,0.00,.034,0.34,0.89,1.19,1.42,1.48,1.42,1.19, /0.89,0.68,0.45,0.25,.030,.0015,.00015,.000015/ DATA XION/10.18,10.7,12.0,13.0,14.0,16.5,19.5,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.26,0.59,0.96,1.43,2.91,4.17,6.57,8.16,9.30, /10.1,10.8,11.6,12.3,12.7,12.9,12.9,12.9,12.5,11.8, /11.2,10.6,9.80,8.63,7.88,7.29,6.64,6.22,5.46,5.04, /4.63,4.12,3.85,3.33,2.86,2.60,2.37,2.05,1.76,1.16, /0.87,0.64,0.46,0.25,0.11,.083/ DATA XATT/5.00,5.50,6.00,7.00,7.50,8.00,8.50,9.00,9.50,10.0, /10.4,11.0,12.0,13.0,14.0,15.0,20.0/ DATA YATT/0.00,.145,0.44,0.38,0.32,0.24,0.26,0.36,0.66,1.24, /2.00,1.08,0.30,0.20,0.16,0.12,0.00/ DATA XEXC/7.00,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.00,1.07,1.57,1.69,1.74,1.80,1.80,1.80,1.80,1.80, /1.85,1.85,1.80,1.69,1.41,1.30,1.09,1.02,0.86,0.56, /0.27,0.13,.055,.028,.005/ DATA XEXC1/9.00,10.0,11.0,13.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,0.19,0.40,0.75,1.14,1.53,1.80,1.94, /2.11,2.18,2.11,1.98,1.66,1.53,1.28,1.20,1.02,0.67, /0.32,0.16,.064,.033,.007/ DATA XEXC2/16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.42,0.92,1.28, /1.80,2.11,2.11,1.98,1.66,1.53,1.28,1.20,1.02,0.67, /0.32,0.16,.064,.033,.007/ C NAME='2-propanol 1999' C -------------------------------------------------------------------- C X-SECTIONS FROM SCALING ETHANOL X-SECTIONS AT LOW ENERGY AND C FITS TO DRIFT VELOCITY OF CHRISTOPHOROU AND CHRISTODOULIDES. C --------------------------------------------------------------------- NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=24 NVIBH=18 NION=46 NATT=17 NEXC=25 NEXC1=23 NEXC2=19 E(1)=0.0 E(2)=2.0*EMASS/(60.09592*AMU) E(3)=10.18 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.18 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.109 EIN(4)=0.109 EIN(5)=0.1668 EIN(6)=0.3527 EIN(7)=7.00 EIN(8)=9.00 EIN(9)=16.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC PROPANOL ' SCRPT(3)=' IONISATION ELOSS= 10.18 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT ELOSS= -0.025 ' SCRPT(8)=' ROT ELOSS= 0.025 ' SCRPT(9)=' VIB V8 ELOSS= -0.109 ' SCRPT(10)=' VIB V8 ELOSS= 0.109 ' SCRPT(11)=' VIB V6 ELOSS= 0.1668 ' SCRPT(12)=' VIB V3 ELOSS= 0.3527 ' SCRPT(13)=' EXC ELOSS= 7.00 ' SCRPT(14)=' EXC ELOSS= 9.00 ' SCRPT(15)=' EXC ELOSS= 16.0 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0D0 C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 40 DO 31 J=2,NION IF(EN.LE.XION(J)) GO TO 32 31 CONTINUE J=NION 32 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 40 CONTINUE C Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 50 IF(EN.GE.XATT(NATT)) GO TO 50 DO 41 J=2,NATT IF(EN.LE.XATT(J)) GO TO 42 41 CONTINUE J=NATT 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 50 CONTINUE Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 150 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 250 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.443*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EIN(4)).LE.XVIBH(J)) GO TO 230 220 CONTINUE J=NVIBH 230 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.443*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.465*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(5,I)=(QIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.92*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C--------------------------------------------------------------------- C SUBTRACT ROTATIONAL XSEC TO GET CORRECT ELASTIC XSEC. Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I) C IF(Q(2,I).LE.0.0 .and. LBMCPR)WRITE(LUNOUT,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',D12.3,' I=',I5) C TOTAL Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+ /QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS37. SUBROUTINE GAS37(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(67),YXSEC(67),XATT(3),YATT(3),XION(27),YION(27), /XEXC1(27),YEXC1(27),XEXC2(25),YEXC2(25),XEXC3(22),YEXC3(22), /XEXC4(20),YEXC4(20),XEXC5(18),YEXC5(18) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.00005,.0001,.00015,.0002,.0003,.0004,.0005,.0006, /.0007, /.0008,.0009,.001,.00125,.0015,.0017,.00185,.002,.0025,.003, /.004,.005,.0056,.006,.007,.008,.009,0.01,.0125,.013, /.015,0.02,.025,0.03,0.04,0.05,0.06,0.07,0.08,0.09, /0.10,0.20,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.20,1.40,1.50,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /4.00,10.0,1000.,2000.,10000.,20000.,100000./ DATA YXSEC/1190.,1188.,1005.,916.,851.,760.,708.,667.,639.,624., /609.,639.,696.,1149.,4745.,10930.,10930.,7038.,2782.,2130., /2354.,4620.,6849.,6300.,4016.,2848.,2520.,2876.,4365.,4745., /4515.,2876.,1775.,1430.,1039.,851.,790.,710.,670.,630., /600.,415.,340.,290.,260.,230.,210.,195.,180.,170., /135.,100.,80.0,65.0,58.5,52.5,47.6,44.4,43.1,41.2, /36.0,26.0,0.14,0.07,.012,.006,.0012/ DATA XION/3.8926,5.00,6.00,7.00,8.00,10.0,12.0,14.0,15.0,17.0, /20.0,25.0,30.0,40.0,50.0,60.0,80.0,100.,200.,300., /400.,500.,600.,700.,1000.,10000.,100000./ DATA YION/0.00,2.70,4.80,6.00,7.20,8.00,8.20,9.80,10.0,9.30, /8.40,9.90,10.2,9.92,9.82,9.58,9.08,8.79,7.40,6.25, /5.44,5.02,4.88,4.80,4.50,0.45,.045/ DATA XATT/10.0,100.0,100000./ DATA YATT/0.00,0.0000001,0.0000000001/ C P1/2 DATA XEXC1/1.3859,1.40,1.45,1.50,1.60,1.70,1.90,2.00,2.20,2.50, /3.00,3.50,4.00,5.00,6.00,7.00,8.00,10.0,15.0,20.0, /40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC1/0.00,1.47,15.4,23.7,17.8,17.1,14.2,12.7,12.0,11.2, /12.2,12.7,13.0,13.8,14.3,15.1,15.1,14.7,13.8,13.3, /8.32,6.24,4.94,4.16,0.42,.042,.0042/ C P3/2 DATA XEXC2/1.4546,1.50,1.60,1.70,1.90,2.00,2.20,2.50,3.00,3.50, /4.00,5.00,6.00,7.00,8.00,10.0,15.0,20.0,40.0,60.0, /80.0,100.,1000.,10000.,100000./ DATA YEXC2/0.00,23.7,34.6,32.3,26.9,24.2,21.5,19.5,20.5,21.5, /22.0,23.3,24.2,25.5,25.5,24.9,23.3,22.4,14.1,10.6, /8.36,7.04,0.70,0.07,.007/ C D3/2 + D5/2 DATA XEXC3/1.7977,1.90,2.00,2.20,2.50,3.00,3.50,4.00,5.00,6.00, /7.00,8.00,10.0,15.0,20.0,40.0,60.0,80.0,100.,1000., /10000.,100000./ DATA YEXC3/0.00,7.50,14.7,19.8,20.3,21.8,23.2,23.5,24.9,25.8, /27.3,27.3,26.6,24.9,24.0,15.0,11.3,8.93,7.52,0.75, /.075,.0075/ C S1/2 DATA XEXC4/2.2981,2.40,2.50,3.00,3.50,4.00,5.00,6.00,7.00,8.00, /10.0,15.0,20.0,40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC4/0.00,3.40,4.90,6.40,7.30,7.50,7.95,8.25,8.70,8.70, /8.47,7.95,7.65,4.80,3.60,2.85,2.40,0.24,.024,.0024/ C SUM OF HIGHER LEVELS DATA XEXC5/2.6986,3.00,3.50,4.00,5.00,6.00,7.00,8.00,10.0,15.0, /20.0,40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC5/0.00,1.90,3.30,4.40,4.66,4.84,5.10,5.10,4.97,4.66, /4.49,2.82,2.11,1.67,1.41,.141,.0141,.00141/ NAME='Cs (2001)' C --------------------------------------------------------------------- C --------------------------------------------------------------------- NIN=5 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=67 NION=27 NATT=3 NEXC1=27 NEXC2=25 NEXC3=22 NEXC4=20 NEXC5=18 E(1)=0.0 E(2)=2.0*EMASS/(132.90545*AMU) E(3)=3.8926 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=3.8926 EIN(1)=1.3859 EIN(2)=1.4546 EIN(3)=1.7977 EIN(4)=2.2981 EIN(5)=2.6986 SCRPT(1)=' ' SCRPT(2)=' ELASTIC CESIUM ' SCRPT(3)=' IONISATION ELOSS= 3.8926 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC P1/2 ELOSS= 1.3859 ' SCRPT(8)=' EXC P3/2 ELOSS= 1.4546 ' SCRPT(9)=' EXC D3/2+5/2 ELOSS= 1.7977 ' SCRPT(10)=' EXC S1/2 ELOSS= 2.2981 ' SCRPT(11)=' EXC HIGHER ELOSS= 2.6986 ' EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GE.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 320 310 CONTINUE J=NEXC1 320 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(1,I)=(A*EN+B)*1.D-16 400 CONTINUE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 500 DO 410 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 420 410 CONTINUE J=NEXC2 420 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(2,I)=(A*EN+B)*1.D-16 500 CONTINUE C QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 600 DO 510 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 520 510 CONTINUE J=NEXC3 520 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 700 DO 610 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 620 610 CONTINUE J=NEXC4 620 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 800 DO 710 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GO TO 720 710 CONTINUE J=NEXC5 720 A=(YEXC5(J)-YEXC5(J-1))/(XEXC5(J)-XEXC5(J-1)) B=(XEXC5(J-1)*YEXC5(J)-XEXC5(J)*YEXC5(J-1))/(XEXC5(J-1)-XEXC5(J)) QIN(5,I)=(A*EN+B)*1.D-16 800 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS38. SUBROUTINE GAS38(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(29),YXSEC(29),XATT(65),YATT(65),XION(24),YION(24), /XVIB1(55),YVIB1(55),XVIB2(54),YVIB2(54),XVIB3(32),YVIB3(32), /XVIB4(24),YVIB4(24),XEXC1(18),YEXC1(18),XEXC2(17),YEXC2(17), /XEXC3(18),YEXC3(18),XEXC4(17),YEXC4(17) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,0.01,.028,.109,.282,.471,.681,1.01,1.25,1.45, /1.49,1.53,1.56,1.62,2.16,2.57,3.58,6.19,9.89,16.3, /24.5,39.3,71.0,120.,218.,379.,953.,10000.,100000./ DATA YXSEC/10.3,10.3,10.2,10.3,10.5,11.1,12.7,16.6,21.6,32.6, /35.6,36.2,36.2,35.4,24.3,19.9,16.2,12.2,10.1,8.13, /6.24,4.19,2.52,1.44,.684,.301,.082,.009,.001/ DATA XVIB1/.1108,0.20,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.10,1.20,1.30,1.40,1.50,1.60,1.70,1.80,1.90,2.00, /2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,3.60,3.70,3.80,3.90,4.00, /4.10,4.20,4.30,4.40,4.50,4.60,4.70,4.80,4.90,5.00, /10.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,0.64,0.85,0.86,0.77,0.63,0.50,0.39,0.30,0.23, /0.18,0.14,0.12,.095,.079,.066,.057,.049,.043,.038, /.033,.030,.027,.024,.022,.020,.018,.017,.015,.014, /.013,.012,.011,.0105,.010,.0094,.0089,.0084,.0078,.0074, /.0071,.0067,.0063,.0060,.0057,.0054,.0052,.0050,.0048,.0046, /.0025,.00030,.00003,.000003,.0000003/ DATA XVIB2/.2188,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.10, /1.20,1.30,1.40,1.50,1.60,1.70,1.80,1.90,2.00,2.10, /2.20,2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,3.10, /3.20,3.30,3.40,3.50,3.60,3.70,3.80,3.90,4.00,4.10, /4.20,4.30,4.40,4.50,4.60,4.70,4.80,4.90,5.00,10.0, /100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.82,0.99,0.97,0.85,0.70,0.55,0.43,0.33,0.26, /0.21,0.16,0.13,0.11,.093,.080,.069,.060,.053,.047, /.042,.037,.034,.031,.028,.026,.024,.022,.020,.019, /.017,.016,.015,.014,.013,.012,.011,.011,.010,.010, /.0094,.0089,.0084,.0081,.0077,.0073,.0070,.0067,.0064,.0035, /.0004,.00004,.000004,.0000004/ DATA XVIB3/.3237,0.40,0.50,0.60,0.70,0.80,1.00,1.20,1.40,1.60, /1.80,2.00,2.20,2.40,2.60,2.80,3.00,3.20,3.40,3.60, /3.80,4.00,4.20,4.40,4.60,4.80,5.00,10.0,100.,1000., /10000.,100000./ DATA YVIB3/0.00,0.52,0.63,0.61,0.53,0.43,0.27,0.16,0.10,.069, /.050,.039,.031,.025,.021,.017,.015,.013,.011,.010, /.0088,.0079,.0071,.0064,.0058,.0053,.0048,.003,.0003,.00003, /.000003,.0000003/ DATA XVIB4/.4205,0.50,0.60,0.70,0.80,0.90,1.00,1.20,1.40,1.60, /1.80,2.00,2.20,2.50,3.00,3.50,4.00,4.50,4.90,10.0, /100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.18,0.21,0.21,0.18,0.15,0.11,.060,.034,.023, /.016,.013,.010,.0078,.0052,.0038,.0028,.0022,.0018,.001, /.0001,.00001,.000001,.0000001/ DATA XION/15.69,16.54,16.56,16.83,17.4,18.2,19.6,21.8,25.5,28.6, /35.4,42.5,52.1,66.6,94.0,118.,176.,269.,381.,507., /720.,937.,10000.,100000./ DATA YION/0.0,.0103,.015,.0255,.0413,.066,.106,.172,.302,.436, /.628,.783,.934,1.066,1.18,1.22,1.18,1.04,.865,.721, /.572,.473,0.05,0.005/ DATA XATT/0.00,0.01,0.02,0.03,0.04,0.05,0.07,0.10,0.15,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,3.60,3.80,4.00,4.20,4.40,4.60,4.80, /5.00,5.20,5.40,5.60,5.80,6.00,6.20,6.40,6.60,6.80, /7.00,7.20,7.40,7.60,7.80,8.00,8.20,8.40,8.60,8.80, /10.0,100.,1000.,10000.,100000./ DATA YATT/80.0,44.4,24.7,13.7,8.20,7.40,7.10,6.50,5.45,4.80, /4.25,3.65,3.10,2.65,2.25,1.92,1.34,0.94,.655,.455, /.320,.153,.075,.036,.022,.014,.012,.011,.010,.0097, /.0093,.0082,.0069,.0056,.0046,.0039,.0035,.0036,.0038,.0042, /.0046,.0052,.0057,.0063,.0068,.0069,.0070,.0069,.0064,.0058, /.0052,.0049,.0040,.0035,.0030,.0025,.0021,.0017,.0014,.0012, /.0004,.00004,.000004,.0000004,.00000004/ DATA XEXC1/3.16,4.00,4.20,4.60,5.60,6.00,7.00,8.00,10.0,15.0, /20.0,27.0,34.0,40.0,100.,1000.,10000.,100000./ DATA YEXC1/0.0,.065,0.10,.145,0.20,0.22,0.23,0.22,0.20,0.14, /.107,.080,.060,.048,.024,.003,.0003,.00003/ DATA XEXC2/4.34,5.00,6.00,7.00,8.00,10.0,14.7,20.0,25.0,40.0, /54.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC2/0.00,0.04,0.06,.074,.080,.074,.060,.047,.040,.025, /.020,.017,.013,.010,.001,.0001,.00001/ DATA XEXC3/11.57,11.73,12.62,14.0,17.0,18.7,21.6,25.8,31.1,39.5, /51.9,78.4,142.,235.,396.,959.,10000.,100000./ DATA YEXC3/0.00,.0102,.0301,.0791,.232,.301,.373,.445,.502,.524, /.510,.477,.373,.282,.204,.119,.012,.0012/ DATA XEXC4/13.08,19.25,20.4,23.8,28.6,34.6,43.0,53.4,68.2,90.6, /121.,180.,284.,427.,970.,10000.,100000./ DATA YEXC4/.0,.0104,.0144,.025,.0396,.0552,.0666,.0722,.074,.0734, /.0693,.0588,.0442,.033,.0176,.0018,.00018/ NAME='F2 (Morgan)' C --------------------------------------------------------------------- C COPIED FROM W.L.MORGAN C --------------------------------------------------------------------- NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=29 NION=24 NATT=65 NVIB1=55 NVIB2=54 NVIB3=32 NVIB4=24 NEXC1=18 NEXC2=17 NEXC3=18 NEXC4=17 E(1)=0.0 E(2)=2.0*EMASS/(38.00000*AMU) E(3)=15.69 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.69 EIN(1)=-0.1108 EIN(2)=0.1108 EIN(3)=0.2188 EIN(4)=0.3237 EIN(5)=0.4205 EIN(6)=3.16 EIN(7)=4.34 EIN(8)=11.57 EIN(9)=13.08 SCRPT(1)=' ' SCRPT(2)=' ELASTIC FLOURINE ' SCRPT(3)=' IONISATION ELOSS= 15.69 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V1 ELOSS= -0.1108 ' SCRPT(8)=' VIB V1 ELOSS= 0.1108 ' SCRPT(9)=' VIB 2V1 ELOSS= 0.2188 ' SCRPT(10)=' VIB 3V1 ELOSS= 0.3237 ' SCRPT(11)=' VIB 4V1 ELOSS= 0.4205 ' SCRPT(12)=' EXC ELOSS= 3.16 ' SCRPT(13)=' EXC ELOSS= 4.34 ' SCRPT(14)=' EXC ELOSS= 11.57 ' SCRPT(15)=' EXC ELOSS= 13.08 ' APOP=EXP(EIN(1)/AKT) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 Q(4,I)=0.0D0 IF(EN.GE.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC V1 QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 302 301 CONTINUE J=NVIB1 302 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP) 305 CONTINUE C V1 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.D-16 QIN(2,I)=QIN(2,I)/(1.0+APOP) 400 CONTINUE C 2V1 QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.D-16 500 CONTINUE C 3V1 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.D-16 600 CONTINUE C 4V1 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 720 710 CONTINUE J=NEXC1 720 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(6,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 820 810 CONTINUE J=NEXC2 820 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(7,I)=(A*EN+B)*1.D-16 900 CONTINUE C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 920 910 CONTINUE J=NEXC3 920 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(8,I)=(A*EN+B)*1.D-16 990 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 1990 DO 1910 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 1920 1910 CONTINUE J=NEXC4 1920 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(9,I)=(A*EN+B)*1.D-16 1990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS39. SUBROUTINE GAS39(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(30),YXSEC(30),XVIB1(39),YVIB1(39), /XVIB2(34),YVIB2(34),XEXC(18),YEXC(18),XION(69),YION(69), /XATT(30),YATT(30),XAT1(9),YAT1(9) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC DATA XEN/0.00,0.01,0.02,0.04,0.07,0.10,0.15,0.20,0.30,0.50, /0.80,1.00,1.20,1.50,1.80,2.20,3.00,3.50,5.00,8.00, /10.0,12.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YXSEC/99.0,90.0,80.0,58.0,45.0,36.5,28.5,23.0,16.0,9.82, /7.62,8.61,11.6,14.3,20.0,23.8,27.6,28.1,26.4,28.1, /29.2,29.2,26.4,17.1,9.90,6.50,2.70,0.27,.027,.0027/ C VIBRATION V2 (010) BENDING DATA XVIB1/.0490,0.05,.055,0.06,0.07,0.08,0.09,0.10,0.12,0.14, /0.17,0.20,0.25,0.30,0.35,0.40,0.50,0.60,0.80,1.00, /1.20,1.40,1.70,2.00,2.50,3.00,3.50,4.00,5.00,6.00, /8.00,10.0,15.0,20.0,40.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,2.40,10.0,18.5,21.0,22.0,21.0,19.5,14.0,10.0, /7.00,5.00,3.20,2.10,1.50,1.20,0.90,0.78,0.60,0.50, /0.43,0.39,0.33,0.29,0.25,0.22,0.25,0.32,0.40,0.45, /0.20,0.10,.075,.052,.032,.013,.0013,.00013,.000013/ C VIBRATION V1 (100) SYMMETRIC STRETCH DATA XVIB2/.0810,0.09,0.10,0.11,0.12,0.13,0.15,0.17,0.20,0.25, /0.30,0.35,0.40,0.50,0.60,0.80,1.00,1.20,1.40,1.70, /2.00,2.50,3.00,3.50,4.00,5.00,6.00,8.00,10.0,20.0, /100.,1000.,10000.,100000./ DATA YVIB2/0.00,2.50,6.00,7.50,8.00,7.50,5.80,4.20,2.50,1.50, /1.05,0.74,0.58,0.40,0.29,0.16,0.12,0.10,0.10,.125, /.165,0.27,0.43,0.51,0.49,0.20,0.12,0.07,.057,.033, /.008,.0008,.00008,.000008/ C VIBRATION V3 (001) ASYMMETRIC STRETCH : USED DIPOLE EXCITATION FUNC. C C IONISATION DATA XION/10.07,10.5,11.0,11.5,12.0,12.5,13.0,13.5,14.0,14.5, /15.0,15.5,16.0,16.5,17.0,18.0,19.0,20.0,21.0,22.0, /23.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0, /45.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0,90.0,100., /120.,140.,160.,180.,200.,220.,240.,250.,300.,350., /400.,450.,500.,550.,600.,650.,700.,800.,900.,1000., /1500.,2000.,2500.,3000.,5000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.192,.421,.652,.880,1.10,1.32,1.53,1.72,1.92, /2.20,2.48,2.74,3.03,3.31,3.84,4.34,4.83,5.28,5.69, /6.06,6.40,6.99,7.48,7.90,8.26,8.58,8.84,9.05,9.23, /9.53,9.69,9.75,9.74,9.68,9.59,9.47,9.34,9.06,8.76, /8.17,7.63,7.14,6.71,6.33,5.99,5.69,5.55,4.96,4.48, /4.10,3.79,3.52,3.29,3.09,2.92,2.76,2.50,2.29,2.12, /1.56,1.28,1.10,0.94,0.66,0.42,0.24,.134,.069/ C ATTACHMENT CS2 - (PROBABLY 3 BODY MORMALISED AT 40 TORR) DATA XAT1/.0001,.001,0.01,.017,.025,0.03,.035,0.04,10.0/ DATA YAT1/35.0,35.0,28.0,20.0,10.0,5.00,1.50,.00001,.0000001/ C DISOCIATIVE ATTACHMENT UNITS OF 10**-19 DATA XATT/2.41,2.50,2.60,2.70,2.80,3.00,3.20,3.35,3.60,3.70, /3.80,4.00,4.20,4.40,5.40,5.50,5.75,6.00,6.25,6.50, /6.75,7.00,7.50,7.75,8.00,8.25,8.50,10.0,100.,100000./ DATA YATT/0.00,0.01,0.02,0.04,0.08,0.40,2.00,3.70,3.00,3.10, /2.70,1.50,0.40,0.01,0.01,0.10,0.50,1.45,1.80,0.90, /0.30,0.20,0.30,0.90,0.50,0.10,0.01,0.01,.001,.0001/ C EXCITATION DATA XEXC/6.20,7.00,8.00,9.00,10.0,11.0,12.0,14.0,17.0,20.0, /30.0,40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC/0.00,0.60,1.50,3.30,5.20,7.00,8.00,8.80,9.20,8.90, /8.00,7.40,6.30,5.50,5.00,0.50,0.05,.005/ C ---------------------------------------------------------------- C LACK OF ELECTRON DRIFT DATA . C USED SOHNS ELECTRON SCATTERING DATA AND UNPUBLISHED DATA BY ALLEN. C THE ATTACHMENT IS PROBABLY 3 BODY EXCEPT FOR THE DISOCIATIVE C ATTACHMENT. C THE 3-BODY X-SECTION CORRESPONDS TO 40 TORR PRESSURE C --------------------------------------------------------------- NAME='CS2 (2001)' C NIN=6 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=30 NVIB1=39 NVIB2=34 NION=69 NATT=30 NAT1=9 NEXC=18 E(1)=0.0 E(2)=2.0*EMASS/(76.1427*AMU) E(3)=10.07 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.07 EIN(1)=-0.049 EIN(2)=0.049 EIN(3)=-0.081 EIN(4)=0.081 EIN(5)=0.190 EIN(6)=6.20 SCRPT(1)=' ' SCRPT(2)=' ELASTIC CS2 ' SCRPT(3)=' IONISATION ELOSS= 10.07 ' SCRPT(4)=' ATTACHMENT (ASSUMED 2 BODY) ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V2 ELOSS= -0.049 ' SCRPT(8)=' VIB V2 ELOSS= 0.049 ' SCRPT(9)=' VIB V1 ELOSS= -0.081 ' SCRPT(10)=' VIB V1 ELOSS= 0.081 ' SCRPT(11)=' VIB V3 ELOSS= 0.190 ' SCRPT(12)=' EXC ELOSS= 6.20 ' APOPV2=EXP(EIN(1)/AKT) APOPV1=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XAT1(1)) GO TO 250 IF(EN.GT.XAT1(NAT1)) GO TO 250 DO 210 J=2,NAT1 IF(EN.LE.XAT1(J)) GO TO 220 210 CONTINUE J=NAT1 220 A=(YAT1(J)-YAT1(J-1))/(XAT1(J)-XAT1(J-1)) B=(XAT1(J-1)*YAT1(J)-XAT1(J)*YAT1(J-1))/(XAT1(J-1)-XAT1(J)) Q(4,I)=(A*EN+B)*1.D-16*1.3 250 CONTINUE IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 260 J=2,NATT IF(EN.LE.XATT(J)) GO TO 270 260 CONTINUE J=NATT 270 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=Q(4,I)+(A*EN+B)*1.D-19 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC V2 BENDING MODE C QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 340 DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN QIN(1,I)=QIN(1,I)*APOPV2/(1.0+APOPV2) 340 CONTINUE C C VIBRATION V2 BENDING MODE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 DO 350 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 360 350 CONTINUE J=NVIB1 360 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.D-16 QIN(2,I)=QIN(2,I)/(1.0+APOPV2) 400 CONTINUE C C SUPERELASTIC OF V1 SYMMETRIC STRETCH VIBRATION C QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 440 DO 410 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.D-16/EN QIN(3,I)=QIN(3,I)*APOPV1/(1.0+APOPV1) 440 CONTINUE C C VIBRATION V3 SYMMETRIC STRETCH QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 500 DO 450 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 460 450 CONTINUE J=NVIB2 460 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B)*1.D-16 QIN(4,I)=QIN(4,I)/(1.0+APOPV1) 500 CONTINUE C C VIBRATION V3 ASYMMETRIC STRETCH QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 600 EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.710*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(5,I)=QIN(5,I)*1.D-16 600 CONTINUE C C EXCITATION (DISOCIATION) QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(6,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 END +DECK,GAS40. SUBROUTINE GAS40(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(34),YXSEC(34),XVIB1(40),YVIB1(40), /XVIB2(39),YVIB2(39),XVIB3(31),YVIB3(31), /XVIB4(14),YVIB4(14),XVIB5(22),YVIB5(22),XVIB6(22),YVIB6(22), /XEXC(17),YEXC(17),XION(70),YION(70),XATT(20),YATT(20) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC DATA XEN/1.D-6,.001,0.01,0.10,0.15,0.20,0.30,0.40,0.50,0.60, /0.70,0.80,1.00,1.20,1.50,1.70,2.00,2.50,3.00,4.00, /5.00,7.00,10.0,15.0,20.0,30.0,40.0,60.0,80.0,100., /200.,1000.,10000.,100000./ DATA YXSEC/1.9D3,1.9D3,190.,19.0,11.5,9.00,7.20,7.40,7.70,8.00, /8.40,8.80,10.0,10.7,10.0,9.50,9.00,10.0,11.5,14.5, /15.0,15.5,16.0,14.5,13.0,9.00,6.50,4.00,2.60,2.00, /1.00,0.20,0.02,.002/ C VIBRATION V2 (010) BENDING DATA XVIB1/.064,0.07,0.08,0.09,0.10,0.12,0.14,0.17,0.20,0.24, /0.28,0.32,0.36,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.10,1.15,1.20,1.30,1.50,1.70,2.00,2.50,3.00, /4.00,5.00,6.00,7.00,8.00,10.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,2.75,4.20,4.80,4.80,4.50,3.50,2.60,2.10,1.60, /1.35,1.15,1.05,1.00,1.00,1.05,1.15,1.40,1.85,2.30, /2.80,3.40,3.80,3.80,3.30,2.20,1.30,0.80,0.35,0.25, /0.21,.165,0.14,.125,0.11,0.09,.013,.0013,.00013,.000013/ C VIBRATION V1 (100) SYMMETRIC STRETCH DATA XVIB2/.107,0.11,0.12,0.13,0.14,0.15,0.16,0.18,0.20,0.22, /0.25,0.30,0.35,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.10,1.15,1.20,1.30,1.50,2.00,2.50,3.00,3.50,4.00, /4.50,5.00,6.00,8.00,10.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.30,0.56,0.68,0.75,0.78,0.81,0.81,0.75,0.64, /0.58,0.50,0.47,0.46,0.46,0.50,0.55,0.70,0.90,1.15, /1.40,1.50,1.50,1.30,0.90,0.50,0.40,0.40,0.68,0.84, /0.65,0.48,0.30,0.24,0.21,.021,.0021,.00021,.000021/ C VIBRATION HARMONIC 2V2 (020) BENDING DATA XVIB3/.128,0.13,0.14,0.15,0.16,0.18,0.20,0.22,0.25,0.30, /0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.10,1.15,1.20, /1.30,1.50,1.70,2.00,3.00,5.00,10.0,100.,1000.,10000., /100000./ DATA YVIB3/0.00,1.07,2.40,3.00,3.35,3.70,3.75,3.50,2.75,1.95, /1.35,1.20,1.30,1.50,1.90,2.40,2.80,3.50,3.90,3.90, /3.60,2.50,1.50,0.90,0.20,.035,0.01,.001,.0001,.00001, /.000001/ C VIBRATION V3 (001) ASYMMETRIC STRETCH ( RESONANCE PART ONLY) DATA XVIB4/.256,0.70,0.80,0.90,1.00,1.10,1.15,1.20,1.30,1.50, /1.70,2.00,10.0,100000./ DATA YVIB4/0.00,0.02,0.60,1.50,2.60,3.00,3.50,3.50,3.00,1.80, /0.90,0.08,0.001,.000002/ C VIBRATION SUM OF HARMONICS NV1 DATA XVIB5/0.38,0.70,0.80,0.90,1.00,1.10,1.15,1.20,1.30,1.50, /1.70,2.00,3.00,3.50,4.00,4.50,5.00,6.00,10.0,100., /1000.,100000./ DATA YVIB5/0.00,.001,0.04,0.12,0.20,0.26,0.30,0.30,0.26,0.20, /0.12,0.02,0.05,0.10,0.15,0.10,0.05,0.02,0.01,.001, /.0001,.0000001/ C VIBRATION SUM OF HIGHER HARMONICS (0.512) DATA XVIB6/.512,0.70,0.80,0.90,1.00,1.10,1.15,1.20,1.30,1.50, /1.70,2.00,3.00,3.50,4.00,4.50,5.00,6.00,10.0,100., /1000.,100000./ DATA YVIB6/0.00,.001,0.03,0.08,0.13,0.17,0.20,0.20,0.17,0.13, /0.08,0.02,0.03,0.07,0.10,0.07,0.03,0.02,0.01,.001, /.0001,.0000001/ C IONISATION DATA XION/11.19,11.5,12.0,12.5,13.0,13.5,14.0,14.5,15.0,15.5, /16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0,21.0, /22.0,23.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0, /40.0,45.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0,90.0, /100.,110.,120.,140.,160.,180.,200.,250.,300.,350., /400.,450.,500.,550.,600.,650.,700.,750.,800.,900., /1000.,1500.,2000.,2500.,3000.,5000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.105,.279,.455,.630,.802,0.97,1.13,1.29,1.44, /1.58,1.72,1.85,1.99,2.14,2.28,2.43,2.58,2.73,3.01, /3.27,3.52,3.75,4.16,4.51,4.81,5.09,5.33,5.53,5.71, /5.85,6.14,6.33,6.44,6.50,6.53,6.52,6.50,6.46,6.34, /6.20,6.05,5.90,5.59,5.29,5.02,4.78,4.26,3.84,3.51, /3.23,2.99,2.79,2.62,2.47,2.34,2.22,2.11,2.01,1.85, /1.71,1.26,1.03,0.88,0.76,0.54,0.34,0.20,.108,.055/ DATA XATT/0.94,1.00,1.10,1.20,1.25,1.30,1.40,1.50,1.60,1.70, /1.80,1.90,2.00,2.10,2.20,2.30,2.40,2.50,10.0,100000./ DATA YATT/0.00,0.03,.182,.272,.290,.282,.263,.219,.151,.106, /.069,.042,.026,.015,.011,.005,.002,.001,.001,.0000001/ C EXCITATION DATA XEXC/7.00,8.00,9.00,10.0,11.0,12.0,14.0,17.0,20.0,30.0, /40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC/0.0,0.60,1.40,2.80,4.00,5.00,5.75,6.10,6.00,5.40, /5.00,4.20,3.70,3.35,0.65,.065,.0065/ C ---------------------------------------------------------------- C LACK OF ELECTRON DRIFT DATA. C USED SOHNS ELECTRON SCATTERING DATA . C POSSIBLE 3-BODY ATTACHMENT NOT YET INCLUDED . C 3-BODY ATTACHMENT IS SMALLER THAN CARBON DISULPHIDE BUT MAY BE C SIGNIFICANT.. C --------------------------------------------------------------- NAME='COS (2001)' C NIN=10 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=34 NVIB1=40 NVIB2=39 NVIB3=31 NVIB4=14 NVIB5=22 NVIB6=22 NION=70 NATT=20 NEXC=17 E(1)=0.0 E(2)=2.0*EMASS/(60.0761*AMU) E(3)=11.19 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=11.19 EIN(1)=-0.064 EIN(2)=0.064 EIN(3)=-0.107 EIN(4)=0.107 EIN(5)=-0.128 EIN(6)=0.128 EIN(7)=0.256 EIN(8)=0.380 EIN(9)=0.512 EIN(10)=7.00 SCRPT(1)=' ' SCRPT(2)=' ELASTIC COS ' SCRPT(3)=' IONISATION ELOSS= 11.19 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V2 ELOSS= -0.064 ' SCRPT(8)=' VIB V2 ELOSS= 0.064 ' SCRPT(9)=' VIB V1 ELOSS= -0.107 ' SCRPT(10)=' VIB V1 ELOSS= 0.107 ' SCRPT(11)=' VIB 2V2 ELOSS= -0.128 ' SCRPT(12)=' VIB 2V2 ELOSS= 0.128 ' SCRPT(13)=' VIB V3 ELOSS= 0.256 ' SCRPT(14)=' VIB NV1 ELOSS= 0.380 ' SCRPT(15)=' VIB ELOSS= 0.512 ' SCRPT(16)=' EXC ELOSS= 7.00 ' APOPV2=EXP(EIN(1)/AKT) APOPV1=EXP(EIN(3)/AKT) APOP2V2=EXP(EIN(5)/AKT) EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) Q(2,I)=1900.D-16 IF(EN.EQ.0.0) GO TO 30 DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA C USE LOG INTERPOLATION 20 Y1=LOG(YXSEC(J-1)) Y2=LOG(YXSEC(J)) X1=LOG(XEN(J-1)) X2=LOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=EXP((A*LOG(EN)+B))*1.0D-16 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC V2 BENDING MODE C QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 340 DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOPV2/(1.0+APOPV2)*1.D-16 340 CONTINUE C C VIBRATION V2 BENDING MODE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 DO 350 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 360 350 CONTINUE J=NVIB1 360 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B) QIN(2,I)=QIN(2,I)/(1.0+APOPV2)*1.D-16 400 CONTINUE C C SUPERELASTIC OF VIBRATION V1 SYMMETRIC STRETCH C QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 440 DO 410 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOPV1/(1.0+APOPV1)*1.D-16 440 CONTINUE C C VIBRATION V1 SYMMETRIC STRETCH C QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 500 DO 450 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 460 450 CONTINUE J=NVIB2 460 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOPV1)*1.D-16 500 CONTINUE C C SUPERELASTIC VIBRATION HARMONIC 2V2 BENDING MODE C QIN(5,I)=0.0D0 IF(EN.EQ.0.0) GO TO 540 DO 510 J=2,NVIB3 IF((EN+EIN(6)).LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(5,I)=QIN(5,I)*APOP2V2/(1.0+APOP2V2)*1.D-16 540 CONTINUE C C VIBRATION HARMONIC 2V2 BENDING MODE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 550 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 560 550 CONTINUE J=NVIB3 560 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(6,I)=(A*EN+B) QIN(6,I)=QIN(6,I)/(1.0+APOP2V2)*1.D-16 600 CONTINUE C C VIBRATION V3 ASYMMETRIC STRETCH C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=SQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.639*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(7,I)=(QIN(7,I)+(A*EN+B))*1.D-16 700 CONTINUE C C SUM OF HARMONICS NV1 C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 740 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 720 710 CONTINUE J=NVIB5 720 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(8,I)=(A*EN+B)*1.D-16 740 CONTINUE C C SUM OF HIGHER HARMONICS (0.512) C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 800 DO 750 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 760 750 CONTINUE J=NVIB6 760 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C C EXCITATION (DISOCIATION) C QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(10,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 END +DECK,GAS41. SUBROUTINE GAS41(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. +SEQ,MAGBPARM. +SEQ,PRINTPLOT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(73),YXSEC(73),XVIB1(24),YVIB1(24),XVIB2(22),YVIB2(22 /),XION(82),YION(82),XATT(14),YATT(14),XDIS1(32),YDIS1(32), /XDIS2(32),YDIS2(32),XDIS3(32),YDIS3(32),XDIS4(32),YDIS4(32), /YELAT(73),XVIB3(19),YVIB3(19),XVIB4(19),YVIB4(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.0001,.001,.004,.007,0.01,.012,.014,.017,0.02, /.025,0.03,.035,0.04,0.05,0.06,0.07,0.08,0.09,0.10, /0.12,0.14,0.17,0.20,0.24,0.28,0.32,0.36,0.40,0.45, /0.50,0.60,0.70,0.80,1.00,1.20,1.40,1.70,2.00,2.50, /3.00,3.50,4.00,5.00,6.00,7.00,8.00,9.00,10.0,12.0, /15.0,20.0,30.0,40.0,50.0,60.0,80.0,100.,150.,200., /300.,400.,500.,600.,800.,1000.,2000.,4000.,6000.,8000., /10000.,20000.,100000./ C ELASTIC MOMENTUM TRANSFER X-SECTION DATA YXSEC/26.7,25.4,22.7,18.9,16.6,14.9,14.0,13.1,12.1,11.1, /9.80,8.71,7.78,6.98,5.68,4.70,3.85,3.31,2.75,2.32, /1.72,1.23,0.78,.500,.330,.315,.340,.375,.430,.500, /.600,.810,1.05,1.29,1.80,2.15,2.55,3.25,4.05,5.80, /7.90,10.1,11.7,14.5,16.3,17.2,17.6,17.6,17.0,15.0, /13.0,8.50,4.70,3.40,2.50,2.10,1.55,1.20,0.66,0.44, /0.25,0.16,0.12,0.09,0.06,.045,.016,.006,.003,.002, /.001,.00025,.000015/ C ELASTIC TOTAL X-SECTION DATA YELAT/26.7,25.6,23.3,19.9,17.9,16.4,15.5,14.8,13.8,12.9, /11.6,10.6,9.67,8.89,7.60,6.57,5.60,4.90,4.20,3.70, /2.80,2.20,1.62,1.23,0.95,0.82,0.75,0.72,0.71,0.73, /0.77,0.95,1.10,1.28,1.72,2.25,3.00,4.00,5.00,7.32, /8.81,11.0,13.3,17.6,21.2,23.2,24.0,23.8,23.1,21.4, /19.7,15.6,11.2,8.55,7.20,6.09,4.74,3.89,2.55,2.00, /1.35,1.05,0.78,0.65,0.50,0.42,0.23,0.14,0.10,0.08, /.064,.030,.007/ DATA XVIB1/.1234,0.20,0.30,0.40,0.50,0.60,0.80,1.00,2.00,3.00, /5.00,6.00,7.00,8.00,9.00,10.0,12.5,15.0,20.0,50.0, /100.0,1000.,10000.,100000./ DATA YVIB1/0.00,.0001,.048,.054,.057,.059,.069,.079,.119,.152, /0.50,0.70,0.80,0.75,0.65,0.55,0.39,0.33,0.19,.077, /.044,0.004,.0004,.00004/ DATA XVIB2/.275,0.40,0.50,0.60,0.80,1.00,2.00,3.00,5.00,6.00, /7.00,8.00,9.00,10.0,12.5,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB2/0.00,.006,.009,.010,.011,.013,.033,.090,0.50,0.70, /0.80,0.75,0.65,0.50,0.25,0.19,0.10,0.04,0.02,0.01, /.001,.0001/ DATA XVIB3/.405,1.00,2.00,3.00,5.00,6.00,7.00,8.00,9.00,10.0, /12.5,15.0,17.5,20.0,50.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,.001,.005,.027,.095,.125,.135,.135,.110,.080, /.055,.037,.028,.020,.008,.003,.0003,.00003,.000003/ DATA XVIB4/.545,1.00,2.00,3.00,5.00,6.00,7.00,8.00,9.00,10.0, /12.5,15.0,17.5,20.0,50.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,.0008,.004,.024,.080,.105,.115,.115,.095,.070, /.045,.027,.018,.010,.007,.003,.0003,.00003,.000003/ DATA XION/12.99,13.5,14.0,14.5,15.0,15.5,16.0,16.5,17.0,17.5, /18.0,18.5,19.0,19.5,21.0,21.5,22.0,22.5,23.0,23.5, /24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000., /1500.,2000.,3000.,4000.,5000.,7000.,10000.,12000.,15000.,20000., /40000.,100000./ DATA YION/0.00,.034,.074,0.13,.198,.278,.361,.445,.530,.610, /.706,.793,.880,.977,1.24,1.34,1.42,1.50,1.57,1.65, /1.72,1.97,2.20,2.38,2.54,2.68,2.79,2.91,3.02,3.21, /3.36,3.47,3.56,3.62,3.66,3.68,3.69,3.70,3.69,3.68, /3.66,3.63,3.62,3.59,3.55,3.52,3.48,3.45,3.41,3.38, /3.33,3.25,3.11,3.01,2.72,2.49,2.27,2.09,1.94,1.83, /1.72,1.63,1.54,1.47,1.40,1.34,1.28,1.24,1.20,1.18, /0.82,0.66,0.47,0.37,0.31,.235,.175,.151,.127,0.10, /.058,.028/ DATA XATT/7.00,7.50,8.00,8.50,9.00,9.50,10.0,10.5,11.0,11.5, /12.0,12.5,13.0,13.5/ DATA YATT/0.00,0.005,0.12,0.51,0.75,0.85,0.96,0.91,0.72,0.49, /0.27,0.13,0.06,0.00/ DATA XDIS1/9.00,10.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,100000./ DATA YDIS1/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.28, /0.24,0.18,0.14,.098,.075,.055,.040,.029,.022,.018, /.009,.0018/ DATA XDIS2/10.0,11.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,100000./ DATA YDIS2/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.28, /0.24,0.18,0.14,.098,.075,.055,.040,.029,.022,.018, /.009,.0018/ DATA XDIS3/11.0,12.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,100000./ DATA YDIS3/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.28, /0.24,0.18,0.14,.098,.075,.055,.040,.029,.022,.018, /.009,.0018/ DATA XDIS4/11.8,12.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,100000./ DATA YDIS4/0.00,.045,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.28, /0.24,0.18,0.14,.098,.075,.055,.040,.029,.022,.018, /.009,.0018/ C --------------------------------------------------------------------- C SCALED VIBRATIONAL X-SECTIONS FROM METHANE (CH4) TO GIVE FIT TO DRIFT C VELOCITY AND TRANSVERSE DIFFUSION IN DEUTERATED METHANE. C NO MIXTURE DATA AVAILABLE. C REFS: DRIFT VELOCITY: C COTTRELL AND WALKER TRANS.FARADAY.SOC. 61 (1585) 1965 C TRANSVERSE DIFFUSION: C MILLICAN AND WALKER J.PHYS.D 20 (193) 1987 C --------------------------------------------------------------------- NAME='CD4 (2004)' C AVIB1=0.059 AVIB2=0.050 NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C USE ANISOTROPIC SCATTERING FOR ELASTIC AND COPY (OFFSET) TO IONISATION KEL(2)=1 KEL(3)=1 C USE ANISOTROPIC SCATTERING FOR LEVEL 2 AND 3 KIN(2)=1 KIN(3)=1 C RAT=0.8 NDATA=73 NVIB1=24 NVIB2=22 NVIB3=19 NVIB4=19 NION=82 NATT=14 NDIS1=32 NDIS2=32 NDIS3=32 NDIS4=32 E(1)=0.0 E(2)=2.0*EMASS/(20.0671*AMU) E(3)=12.99 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=7.3 IOFF=INT(0.5+E(3)/ESTEP) EIN(1)=-0.1234 EIN(2)=0.1234 EIN(3)=0.275 EIN(4)=0.405 EIN(5)=0.545 EIN(6)=9.0 EIN(7)=10.0 EIN(8)=11.0 EIN(9)=11.8 SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) CD4 ' SCRPT(3)=' IONISATION ELOSS= 12.99 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V2+V4 ELOSS= -0.1234 ' SCRPT(8)=' VIB V2+V4 ELOSS= 0.1234 ' SCRPT(9)=' VIB V1+V3 ELOSS= 0.275 ' SCRPT(10)=' VIB HAR ELOSS= 0.405 ' SCRPT(11)=' VIB HAR ELOSS= 0.545 ' SCRPT(12)=' EXC DISOCIATN ELOSS= 9.0 ' SCRPT(13)=' EXC DISOCIATN ELOSS= 10.0 ' SCRPT(14)=' EXC DISOCIATN ELOSS= 11.0 ' SCRPT(15)=' EXC DISOCIATN ELOSS= 11.8 ' APOP=EXP(EIN(1)/AKT) C IF(LBMCPR)WRITE(LUNOUT,99) APOP C 99 FORMAT(3X,'APOP=',D12.3) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP C USE LOG INTERPOLATION FOR ELASTIC IF(EN.LE.XEN(2)) THEN QELA=26.7D-16 QMOM=26.7D-16 GO TO 30 ENDIF DO 3 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 4 3 CONTINUE J=NDATA 4 YXJ=LOG(YELAT(J)) YXJ1=LOG(YELAT(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=EXP(A*LOG(EN)+B)*1.D-16 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=EXP(A*LOG(EN)+B)*1.D-16 30 CONTINUE PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC DISTRIBUTION SAME AS ELASTIC AT ENERGY OFFSET BY C IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 200 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(14)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C V4 + V2 SUPERELASTIC QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AVIB1*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)+(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C V4 + V2 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AVIB1*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(2) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C RATIO OF MT TO TOTAL X-SECT FOR RESONANCE PART =RAT XMT=((1.5-FWD/(FWD+BCK))*QIN(2,I)+RAT*(A*EN+B))*1.D-16 QIN(2,I)=((A*EN+B)+QIN(2,I))*1.D-16 PEQIN(2,I)=0.5+(QIN(2,I)-XMT)/QIN(2,I) QIN(2,I)=QIN(2,I)/(1.0+APOP) 400 CONTINUE C V1 + V3 QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AVIB2*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(3) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C RATIO OF MT TO TOTAL X-SECT FOR RESONANCE PART =RAT XMT=((1.5-FWD/(FWD+BCK))*QIN(3,I)+RAT*(A*EN+B))*1.D-16 QIN(3,I)=((A*EN+B)+QIN(3,I))*1.D-16 PEQIN(3,I)=0.5+(QIN(3,I)-XMT)/QIN(3,I) 500 CONTINUE C VIBRATION HARMONICS 1 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.D-16 600 CONTINUE C VIBRATION HARMONICS 2 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=(A*EN+B)*1.D-16 700 CONTINUE C DISOCIATIVE EXCITATION QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 850 DO 810 J=2,NDIS1 IF(EN.LE.XDIS1(J)) GO TO 820 810 CONTINUE J=NDIS1 820 A=(YDIS1(J)-YDIS1(J-1))/(XDIS1(J)-XDIS1(J-1)) B=(XDIS1(J-1)*YDIS1(J)-XDIS1(J)*YDIS1(J-1))/(XDIS1(J-1)-XDIS1(J)) QIN(6,I)=(A*EN+B)*1.D-16 850 CONTINUE C DISOCIATIVE EXCITATION QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 900 DO 860 J=2,NDIS2 IF(EN.LE.XDIS2(J)) GO TO 870 860 CONTINUE J=NDIS2 870 A=(YDIS2(J)-YDIS2(J-1))/(XDIS2(J)-XDIS2(J-1)) B=(XDIS2(J-1)*YDIS2(J)-XDIS2(J)*YDIS2(J-1))/(XDIS2(J-1)-XDIS2(J)) QIN(7,I)=(A*EN+B)*1.D-16 900 CONTINUE C DISOCIATIVE EXCITATION QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 950 DO 910 J=2,NDIS3 IF(EN.LE.XDIS3(J)) GO TO 920 910 CONTINUE J=NDIS3 920 A=(YDIS3(J)-YDIS3(J-1))/(XDIS3(J)-XDIS3(J-1)) B=(XDIS3(J-1)*YDIS3(J)-XDIS3(J)*YDIS3(J-1))/(XDIS3(J-1)-XDIS3(J)) QIN(8,I)=(A*EN+B)*1.D-16 950 CONTINUE C DISOCIATIVE EXCITATION QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 990 DO 960 J=2,NDIS4 IF(EN.LE.XDIS4(J)) GO TO 970 960 CONTINUE J=NDIS4 970 A=(YDIS4(J)-YDIS4(J-1))/(XDIS4(J)-XDIS4(J-1)) B=(XDIS4(J-1)*YDIS4(J)-XDIS4(J)*YDIS4(J-1))/(XDIS4(J-1)-XDIS4(J)) QIN(9,I)=(A*EN+B)*1.D-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) C 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 C END +DECK,GAS42. SUBROUTINE GAS42(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(62),YXSEC(62),XVIBH(15),YVIBH(15), /XVIB1(15),YVIB1(15),XVIB3(15),YVIB3(15),XEXC(34),YEXC(34), /XION(71),YION(71),XATT(33),YATT(33) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C DATA XEN/0.0,.001,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.12,0.14,0.16,0.18,0.20,0.24,0.30,0.35, /0.40,0.50,0.60,0.70,0.80,1.00,1.50,2.00,2.50,3.00, /3.50,4.00,5.00,6.00,7.00,8.00,10.0,12.0,14.0,17.0, /20.0,24.0,28.0,32.0,36.0,40.0,45.0,50.0,60.0,75.0, /100.,150.,200.,300.,500.,700.,1000.,2000.,4000.,10000., /20000.,100000./ C DATA YXSEC/100.,80.0,50.3,43.0,39.0,35.5,33.0,31.0,29.4,27.8, /26.8,25.5,23.5,21.0,18.5,16.0,14.0,10.5,7.20,5.65, /4.25,3.15,2.70,2.70,3.30,4.30,6.20,7.80,9.30,10.4, /11.1,11.3,11.3,10.9,10.5,10.0,9.00,8.50,8.00,7.50, /7.20,6.80,6.50,6.40,6.30,6.20,6.00,5.75,5.05,4.50, /3.75,2.70,1.75,1.00,0.57,0.38,0.24,0.11,0.05,0.02, /0.01,.002/ C C VIBRATION V1 DATA XVIB1/0.110,1.00,1.50,2.00,2.50,3.00,3.50,4.00,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVIB1/0.0,.00001,0.20,0.48,0.72,0.80,0.72,0.48,0.32,0.12, /.0016,.001,.0001,.00001,.000001/ C VIBRATION V3 DATA XVIB3/0.180,1.00,1.50,2.00,2.50,3.00,3.50,4.00,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVIB3/0.0,.00001,0.40,0.96,1.44,1.60,1.44,0.96,0.64,0.24, /.0032,.001,.0001,.00001,.000001/ C VIBRATION HARMONIC (2V1+2V3 AND HIGHER HARMONICS) DATA XVIBH/0.360,1.00,1.50,2.00,2.50,3.00,3.50,4.00,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVIBH/0.0,.00001,0.21,0.54,0.78,0.90,0.78,0.54,0.36,0.18, /.0024,.001,.0001,.00001,.000001/ C DATA XION/15.56,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0,20.5, /21.0,22.0,23.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0, /38.0,40.0,45.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0, /85.0,90.0,95.0,100.,105.,110.,115.,120.,125.,130., /135.,140.,150.,160.,170.,180.,200.,220.,250.,300., /350.,400.,450.,500.,600.,700.,800.,900.,1000.,1200., /1400.,2000.,2500.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /100000./ DATA YION/0.0,0.045,.064,.079,.130,.183,.236,.295,.356,.419, /.493,.645,0.80,0.96,1.26,1.54,1.80,2.03,2.25,2.45, /2.63,2.79,3.15,3.48,3.76,3.99,4.19,4.35,4.48,4.58, /4.67,4.74,4.80,4.84,4.88,4.90,4.92,4.93,4.93,4.93, /4.93,4.92,4.89,4.86,4.81,4.76,4.66,4.54,4.37,4.08, /3.83,3.59,3.38,3.20,2.88,2.62,2.41,2.23,2.07,1.85, /1.66,1.37,1.15,1.02,0.82,0.67,0.58,0.45,0.36,0.21, /.06/ C ATTACHMENT DATA XATT/10.0,10.4,10.5,10.6,10.7,10.8,10.9,11.0,11.1,11.2, /11.3,11.4,11.5,11.6,11.7,11.8,11.9,12.0,12.1,12.2, /12.3,12.4,12.5,12.6,12.7,12.8,12.9,13.0,20.0,100., /1000.,10000.,100000./ DATA YATT/0.00,.0015,.0032,.0046,.0063,.0084,.010,.014,.017,.020, /.022,.024,.025,.025,.023,.021,.018,.015,.012,.0097, /.0069,.0048,.0033,.0022,.0015,.00092,.00061,.00024,.0002,.0001, /.00001,.000001,.0000001/ C DISOCIATION X-SECTION EXCLUDING DISOCIATIVE IONISATION X-SECTION DATA XEXC/10.0,10.1,10.6,11.1,11.6,12.1,12.6,13.1,13.6,14.1, /14.6,15.1,16.2,17.2,18.2,20.2,22.2,24.2,27.2,30.3, /40.0,50.0,100.,200.,300.,400.,500.,600.,1000.,2000., /4000.,10000.,20000.,100000./ DATA YEXC/0.00,0.01,0.11,0.21,0.39,0.58,0.65,0.73,0.82,0.89, /0.97,1.03,1.15,1.24,1.33,1.49,1.61,1.68,1.78,1.82, /1.81,1.83,1.88,1.88,1.70,1.40,1.10,0.88,0.49,0.22, /0.11,0.05,0.03,.008/ C ---------------------------------------------------------------- C --------------------------------------------------------------- NAME='BF3 (2001)' C NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C ANISOTROPIC SCATTERING FOR LEVELS 6 AND 7 KIN(6)=1 KIN(7)=1 C NDATA=62 NVIB1=15 NVIB3=15 NVIBH=15 NION=71 NATT=33 NEXC=34 E(1)=0.0 E(2)=2.0*EMASS/(67.8062*AMU) E(3)=15.56 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.56 EIN(1)=-0.0596 EIN(2)=-0.086 EIN(3)=-0.110 EIN(4)=0.0596 EIN(5)=0.086 EIN(6)=0.110 EIN(7)=0.180 EIN(8)=0.360 EIN(9)=10.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC BF3 ' SCRPT(3)=' IONISATION ELOSS= 15.56 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V4 ELOSS= -0.0596 ' SCRPT(8)=' VIB V2 ELOSS= -0.086 ' SCRPT(9)=' VIB V1 ELOSS= -0.110 ' SCRPT(10)=' VIB V4 ELOSS= 0.0596 ' SCRPT(11)=' VIB V2 ELOSS= 0.086 ' SCRPT(12)=' VIB V1 (ANIS) ELOSS= 0.110 ' SCRPT(13)=' VIB V3 (ANIS) ELOSS= 0.180 ' SCRPT(14)=' VIB HAR ELOSS= 0.360 ' SCRPT(15)=' EXC ELOSS= 10.0 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(2)/AKT) APOP3=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC OF VIBRATION V4 C QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 305 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.018*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 305 CONTINUE C C SUPERELASTIC OF VIBRATION V2 QIN(2,I)=0.0D0 IF(EN.EQ.0.0) GO TO 400 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.045*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(2,I)=QIN(2,I)*APOP2/(1.0+APOP2)*1.D-16 400 CONTINUE C SUPERELASTIC OF VIBRATION V1 QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 500 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.37*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(3,I)=QIN(3,I)*APOP3/(1.0+APOP3)*1.D-16 500 CONTINUE C V4 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.018*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=QIN(4,I)*1.0/(1.0+APOP1)*1.D-16 600 CONTINUE C V2 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.045*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(5,I)=QIN(5,I)*1.0/(1.0+APOP2)*1.D-16 700 CONTINUE C V1 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 720 710 CONTINUE J=NVIB1 720 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.37*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.58 XMT=((1.5-FWD/(FWD+BCK))*QIN(6,I)+RAT4*(A*EN+B))*1.D-16 QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 PEQIN(6,I)=0.5+(QIN(6,I)-XMT)/QIN(6,I) QIN(6,I)=QIN(6,I)*1.0/(1.0+APOP3) 800 CONTINUE C V3 QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 820 810 CONTINUE J=NVIB3 820 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=SQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.74*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(7) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.58 XMT=((1.5-FWD/(FWD+BCK))*QIN(7,I)+RAT4*(A*EN+B))*1.D-16 QIN(7,I)=(QIN(7,I)+(A*EN+B))*1.D-16 PEQIN(7,I)=0.5+(QIN(7,I)-XMT)/QIN(7,I) 900 CONTINUE C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 1000 DO 910 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 920 910 CONTINUE J=NVIBH 920 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(8,I)=(A*EN+B)*1.D-16 1000 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 1100 DO 1010 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 1020 1010 CONTINUE J=NEXC 1020 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(9,I)=(A*EN+B)*1.D-16 1100 CONTINUE C C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS43. SUBROUTINE GAS43(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) *----------------------------------------------------------------------- * GAS43 - C2F4H2 cross sections. * Author: Steve Biagi, with 1 correction from Steve Biagi. * (Last changed on 11/12/07.) *----------------------------------------------------------------------- IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XENM(30),YXMOM(30),XENT(30),YXTOT(30), /XVIB2(22),YVIB2(22),XVIB3(22),YVIB3(22),XVIB4(22),YVIB4(22), /XVIB5(22),YVIB5(22),XVIB6(22),YVIB6(22), /XDISS(27),YDISS(27),XATT(26),YATT(26),XION(48),YION(48) *** Next line corrected (RV 11/12/07). C CHARACTER*15 SCRPT(226) CHARACTER*30 SCRPT(226) *** End of correction. CHARACTER*15 NAME DATA XENM/1.D-6,0.001,0.01,0.10,1.00,1.50,2.00,3.00,4.00,5.00, /6.00,7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,200.,400.,1000.,10000.,100000./ C ELASTIC MOMENTUM TRANSFER DATA YXMOM/2500.,2500.,1700.,170.,17.0,12.0,10.0,8.60,8.20,8.80, /9.80,10.7,11.4,12.0,12.5,14.5,14.5,13.2,11.5,10.0, /9.20,8.50,7.66,6.66,5.86,3.00,1.50,0.60,0.06,.006/ C ELASTIC DATA XENT/1.D-6,0.001,0.01,0.10,1.00,1.50,2.00,3.00,4.00,5.00, /6.00,7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,200.,400.,1000.,10000.,100000./ C ELASTIC TOTAL DATA YXTOT/2500.,2500.,1700.,170.,17.0,13.0,13.5,14.5,15.5,16.5, /17.5,18.5,19.5,20.0,20.7,23.5,23.5,21.5,19.5,18.5, /17.5,17.0,16.0,15.0,14.5,11.5,9.00,7.00,0.70,0.07/ C VIBRATION V11 (RESONANCE ONLY) DATA XVIB2/0.065,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB2/0.0,0.0,.028,.063,.196,.182,0.14,.126,.182,0.21, /0.21,.175,.063,.028,.014,.007,.0014,.000007,.0000007,.00000007, /.000000007,.0000000007/ C VIBRATION V2 (RESONANCE ONLY) DATA XVIB3/0.1001,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB3/0.0,0.0,.175,.343,1.08,1.04,0.77,0.70,1.02,1.15, /1.13,.959,0.35,.154,.063,.028,.014,.000003,.0000003,.00000003, /.000000003,.0000000003/ C VIBRATION V1 (RESONANCE ONLY) DATA XVIB4/0.1523,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB4/0.0,0.0,.378,.756,2.34,2.24,1.68,1.51,2.23,2.52, /2.49,2.10,0.77,.336,0.14,0.07,.035,.00007,.000007,.0000007, /.00000007,.000000007/ C VIBRATION HARMONIC 2(V1) DATA XVIB5/0.35,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB5/0.0,0.0,.135,0.27,0.84,.795,0.60,0.54,.795,0.90, /.885,0.75,0.27,0.12,.045,0.03,.015,.00015,.000015,.0000015, /.00000015,.000000015/ C VIBRATION HARMONIC (3(V1) + ALL OTHER HARMONICS) DATA XVIB6/0.500,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB6/0.0,0.0,0.54,1.08,3.35,3.20,2.40,2.16,3.18,3.60, /3.56,3.00,1.09,0.48,.195,.105,.045,.00015,.000015,.0000015, /.00000015,.000000015/ C DISOCIATION X-SECTION DATA XDISS/11.8,12.0,13.0,14.0,15.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,300.,400.,500., /600.,800.,1000.,2000.,4000.,10000.,100000./ DATA YDISS/0.00,.007,.072,0.40,0.75,1.33,1.61,1.88,2.00,2.25, /2.40,2.50,2.60,2.60,2.60,2.55,2.50,2.40,2.30,2.20, /2.00,1.75,1.48,0.80,0.46,0.21,0.021/ DATA XION/14.48,17.0,18.0,19.0,21.0,23.0,25.0,27.0,29.0,31.0, /33.0,35.0,37.0,39.0,41.0,43.0,45.0,47.0,49.0,51.0, /61.0,71.0,81.0,91.0,101.,126.,151.,176.,201.,251., /301.,351.,401.,451.,501.,601.,701.,801.,901.,1001., /1251.,1501.,1751.,2001.,2501.,3001.,10000.,100000./ DATA YION/0.00,.0889,.211,.375,.782,1.18,1.59,2.11,2.49,2.81, /3.16,3.49,3.86,4.17,4.54,4.85,5.14,5.52,5.77,6.19, /6.82,7.57,7.84,8.17,8.39,8.77,8.75,8.76,8.57,8.17, /7.41,7.13,6.55,6.21,5.89,5.17,4.72,4.40,3.96,3.77, /3.19,2.79,2.44,2.28,1.88,1.67,0.60,0.09/ DATA XATT/2.00,2.25,2.50,2.75,3.00,3.25,3.50,3.75,4.00,4.25, /4.50,4.75,5.00,5.25,5.50,5.75,6.00,6.25,6.50,6.75, /7.00,8.00,10.0,20.0,100.0,100000./ DATA YATT/.0,.0075,.020,.038,.053,.069,.083,.086,.083,.074, /.060,.046,.035,.025,.017,.010,.0068,.004,.0016,.0007, /.0003,.0002,.0001,.00001,.000001,.0000001/ C --------------------------------------------------------------------- C DATA SET USES C2F6 FOR ALL XSECS EXCEPT LOW ENERGY ELASTIC WHICH C IS DOMINATED BY DIPOLE SCATTERING BELOW 1 EV ENRGY . c ABOVE 1EV SMOOTH JOIN TO C2F6 ELASTIC IS USED . C THE LARGEST ERRORS IN SWARM PARAMETERS PROBABLY WILL BE FOR THE C ATTACHMENT WHICH MAY BE VERY SENSITIVE TO DETAILED MOLECULAR C STRUCTURE. C -------------------------------------------------------------------- NAME='C2HF5/C2H2F4' C NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C ANISOTROPIC SCATTERING FOR LEVELS 5 AND 6 KIN(5)=1 KIN(6)=1 C NDATA=30 NETOT=30 NVIB2=22 NVIB3=22 NVIB4=22 NVIB5=22 NVIB6=22 NDISS=27 NATT=26 C RENORMALISE ATTACHMENT X-SECTION ATTNRM=0.05 NION=48 E(1)=0.0 E(2)=2.0*EMASS/(120.*AMU) E(3)=14.48 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=14.48 EIN(1)=-0.065 EIN(2)=-0.1001 EIN(3)=-0.1523 EIN(4)=0.065 EIN(5)=0.1001 EIN(6)=0.1523 EIN(7)=0.35 EIN(8)=0.500 EIN(9)=11.8 SCRPT(1)=' ' SCRPT(2)=' ELASTIC C2HF5/C2H2F4 ' SCRPT(3)=' IONISATION ELOSS= 14.48 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V11 ELOSS= -0.065 ' SCRPT(8)=' VIB V2 ELOSS= -0.1001 ' SCRPT(9)=' VIB V1 ELOSS= -0.1523 ' SCRPT(10)=' VIB V11 ELOSS= 0.065 ' SCRPT(11)=' VIB V2 (ANIS) ELOSS= 0.1001 ' SCRPT(12)=' VIB V1 (ANIS) ELOSS= 0.1523 ' SCRPT(13)=' VIB ELOSS= 0.35 ' SCRPT(14)=' VIB ELOSS= 0.50 ' SCRPT(15)=' EXC DISOCN ELOSS= 11.8 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(2)/AKT) APOP3=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) XMOMT=2500.D-16 IF(EN.EQ.0.0) GO TO 30 DO 10 J=2,NDATA IF(EN.LE.XENM(J)) GO TO 20 10 CONTINUE J=NDATA C USE LOG INTERPOLATION 20 Y1=LOG(YXMOM(J-1)) Y2=LOG(YXMOM(J)) X1=LOG(XENM(J-1)) X2=LOG(XENM(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) XMOMT=EXP((A*LOG(EN)+B))*1.0D-16 30 IF(EN.EQ.0.0) XTOT=2500.D-16 IF(EN.EQ.0.0) GO TO 70 DO 50 J=2,NETOT IF(EN.LE.XENT(J)) GO TO 60 50 CONTINUE J=NETOT 60 Y1=LOG(YXTOT(J-1)) Y2=LOG(YXTOT(J)) X1=LOG(XENT(J-1)) X2=LOG(XENT(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) XTOT=EXP((A*LOG(EN)+B))*1.0D-16 70 CONTINUE Q(2,I)=XTOT PEQEL(2,I)=0.5+(XTOT-XMOMT)/XTOT IF(KEL(2).EQ.0) Q(2,I)=XMOMT IF(KEL(2).EQ.0) PEQEL(2,I)=0.5D0 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 250 IF(EN.GT.XATT(NATT)) GO TO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16*ATTNRM 250 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTICS QIN(1,I)=0.0D0 QIN(2,I)=0.0D0 QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V11 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.0363*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 260 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 270 260 CONTINUE J=NVIB2 270 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C SUPERELASTIC OF VIBRATION V2 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.4230*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 280 J=2,NVIB3 IF((EN+EIN(5)).LE.XVIB3(J)) GO TO 290 280 CONTINUE J=NVIB3 290 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(2,I)=QIN(2,I)+(EN+EIN(5))*(A*(EN+EIN(5))+B)/EN QIN(2,I)=QIN(2,I)*APOP2/(1.0+APOP2)*1.D-16 C SUPERELASTIC OF VIBRATION V1 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=1.5000*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 300 J=2,NVIB4 IF((EN+EIN(6)).LE.XVIB4(J))GO TO 301 300 CONTINUE J=NVIB4 301 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(3,I)=QIN(3,I)*APOP3/(1.0+APOP3)*1.D-16 C 305 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0363*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=((A*EN+B)+QIN(4,I))*1.0/(1.0+APOP1)*1.D-16 400 CONTINUE C QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.4230*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(5) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM.T /TOT X-SECT FOR RESONANCE PART = RAT3 RAT3=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(5,I)+RAT3*(A*EN+B))*1.0D-16 XMT=XMT/(1.0+APOP2) QIN(5,I)=((A*EN+B)+QIN(5,I))*1.0/(1.0+APOP2)*1.D-16 PEQIN(5,I)=0.5+(QIN(5,I)-XMT)/QIN(5,I) 500 CONTINUE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=1.500*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(6,I)+RAT4*(A*EN+B))*1.0D-16 XMT=XMT/(1.0+APOP3) QIN(6,I)=((A*EN+B)+QIN(6,I))*1.0/(1.0+APOP3)*1.D-16 PEQIN(6,I)=0.5+(QIN(6,I)-XMT)/QIN(6,I) 600 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(8,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NDISS IF(EN.LE.XDISS(J)) GO TO 820 810 CONTINUE J=NDISS 820 A=(YDISS(J)-YDISS(J-1))/(XDISS(J)-XDISS(J-1)) B=(XDISS(J-1)*YDISS(J)-XDISS(J)*YDISS(J-1))/(XDISS(J-1)-XDISS(J)) QIN(9,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS44. SUBROUTINE GAS44(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(67),YXSEC(67),XION(48),YION(48),XEXC(25),YEXC(25), /XEXS(34),YEXS(34),XEL(69),YEL(69) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/0.00,0.008,0.009,0.01,0.013,0.017,0.020,0.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.18,0.20, /0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.20, /1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.6,16.5,18.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,75.0,80.0,90.0,100.,150.,200., /400.,600.,1000.,2000.,10000.,20000.,100000./ DATA YXSEC/4.90,5.18,5.19,5.21,5.26,5.31,5.35,5.41,5.46,5.54, /5.62,5.68,5.74,5.79,5.83,5.86,5.94,6.04,6.12,6.16, /6.27,6.35,6.49,6.59,6.66,6.73,6.77,6.82,6.85,6.91, /6.96,6.98,6.99,6.96,6.89,6.62,6.31,6.00,5.68,5.35, /5.03,4.72,4.44,4.15,3.83,3.25,2.99,2.58,2.00,1.60, /1.06,0.77,0.57,0.46,0.40,0.37,0.30,0.26,.132,.081, /.024,.012,.0048,.0014,.00008,.00002,.0000012/ C ELASTIC TOTAL DATA XEL/0.00,0.05,0.10,0.20,0.30,0.40,0.50,0.60,0.80,1.00, /1.22,1.50,1.70,2.00,2.40,2.50,3.00,3.40,4.00,4.40, /5.00,5.40,6.00,6.40,7.00,7.40,8.00,8.40,9.00,9.40, /10.0,10.4,11.4,12.0,12.4,13.4,14.0,14.4,15.4,16.0, /16.4,17.4,18.0,20.0,25.0,30.0,40.0,50.0,60.0,70.0, /80.0,90.0,100.,125.,150.,200.,250.,300.,400.,500., /600.,800.,1000.,1500.,2000.,4000.,10000.,20000.,100000./ DATA YEL/4.90,5.48,5.67,5.86,5.98,6.03,6.08,6.09,6.11,6.12, /6.10,6.08,6.07,6.03,5.95,5.93,5.82,5.73,5.60,5.51, /5.38,5.29,5.15,5.07,4.94,4.86,4.75,4.68,4.57,4.49, /4.39,4.32,4.15,4.06,4.00,3.85,3.76,3.71,3.58,3.51, /3.46,3.34,3.26,3.00,2.52,2.15,1.63,1.29,1.06,.884, /.734,.653,.572,.445,.351,.239,.181,.152,.107,.080, /.065,.040,.030,.020,.015,.0073,.0033,.0015,.0004/ C IONISATION DATA XION/24.587,25.0,25.5,26.0,26.5,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0, /100.,120.,150.,175.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,4000.,5000.,6000.,8000.,10000.,20000.,100000./ DATA YION/0.0,.0052,.0113,.0175,.0236,.030,.043,.055,.066,.089, /.111,.132,.150,.166,.203,.235,.260,.281,.312,.335, /.364,.369,.364,.354,.342,.315,.287,.249,.215,.191, /.173,.159,.145,.133,.117,.103,.093,.086,.080,.065, /.055,.045,.036,.031,.025,.020,.0117,.0040/ C TRIPLET EXCITATION DATA XEXC/19.82,20.0,20.2,20.5,20.6,20.8,21.0,21.3,22.0,25.0, /30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,150.,200., /400.,1000.,10000.,20000.,100000./ DATA YEXC/0.00,.047,.053,.035,.029,.043,.042,.041,.046,.075, /.071,.054,.038,.026,.017,.013,.0094,.0075,.0022,.00094, /.00012,.000008,.000000008,.000000001,.0000000003/ C SINGLET EXCITATION DATA XEXS/20.61,20.9,21.0,21.5,22.0,22.5,25.0,28.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,150.,200., /300.,400.,500.,600.,800.,1000.,1500.,2000.,3000.,4000., /6000.,10000.,20000.,100000./ DATA YEXS/0.00,.025,.022,.0265,.0315,.036,.065,.082,.092,.115, /.133,.148,.155,.175,.177,.178,.178,.177,.163,.148, /.121,.099,.086,.075,.061,.051,.038,.030,.022,.017, /.013,.0088,.0052,.0018/ NAME='He3 (2002)' C -------------------------------------------------------------------- C HELIUM 4 BEST KNOWN GAS USED AS STANDARD ACCURACY BETTER THAN 0.2% C AT ALL FIELDS ONLY DIFFERENCE FROM HE3 IS ATOMIC MASS. C UPDATED 1997 DATA FILE TO INCLUDE ANISOTROPIC ELASTIC SCATTTERING C -------------------------------------------------------------------- NIN=2 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C ANISOTROPIC ELASTIC SCATTERING COPY (OFFSET) TO IONISATION KEL(2)=1 KEL(3)=1 C NEL=69 NDATA=67 NION=48 NEXC=25 NEXS=34 E(1)=0.0 E(2)=2.0*EMASS/(3.01600*AMU) E(3)=24.587 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.8 IOFF=INT(0.5+E(3)/ESTEP) EIN(1)=19.82 EIN(2)=20.61 SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) HELIUM 3 ' SCRPT(3)=' IONISATION ELOSS= 24.587 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC TRPLT ELOSS= 19.82 ' SCRPT(8)=' EXC SNGLT ELOSS= 20.61 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NEL IF(EN.LE.XEL(J)) GO TO 20 10 CONTINUE J=NEL 20 A=(YEL(J)-YEL(J-1))/(XEL(J)-XEL(J-1)) B=(XEL(J-1)*YEL(J)-XEL(J)*YEL(J-1))/(XEL(J-1)-XEL(J)) QELA=(A*EN+B)*1.0D-16 DO 50 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 60 50 CONTINUE J=NDATA 60 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.0D-16 PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LE.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGIES C ANISOTROPIC ANGULAR DISTRIBUTION SAME AS ELASTIC AT ENERGY OFFSET BY C IONISATION ENERGY IF(EN.LE.2.0*E(3)) GO TO 200 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C 200 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(1,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 700 DO 610 J=2,NEXS IF(EN.LE.XEXS(J)) GO TO 620 610 CONTINUE J=NEXS 620 A=(YEXS(J)-YEXS(J-1))/(XEXS(J)-XEXS(J-1)) B=(XEXS(J-1)*YEXS(J)-XEXS(J)*YEXS(J-1))/(XEXS(J-1)-XEXS(J)) QIN(2,I)=(A*EN+B)*1.D-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS45. SUBROUTINE GAS45(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(67),YXSEC(67),XION(48),YION(48),XEXC(25),YEXC(25), /XEXS(34),YEXS(34),XEL(69),YEL(69) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/0.00,0.008,0.009,0.01,0.013,0.017,0.020,0.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.18,0.20, /0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.20, /1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.6,16.5,18.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,75.0,80.0,90.0,100.,150.,200., /400.,600.,1000.,2000.,10000.,20000.,100000./ DATA YXSEC/4.90,5.18,5.19,5.21,5.26,5.31,5.35,5.41,5.46,5.54, /5.62,5.68,5.74,5.79,5.83,5.86,5.94,6.04,6.12,6.16, /6.27,6.35,6.49,6.59,6.66,6.73,6.77,6.82,6.85,6.91, /6.96,6.98,6.99,6.96,6.89,6.62,6.31,6.00,5.68,5.35, /5.03,4.72,4.44,4.15,3.83,3.25,2.99,2.58,2.00,1.60, /1.06,0.77,0.57,0.46,0.40,0.37,0.30,0.26,.132,.081, /.024,.012,.0048,.0014,.00008,.00002,.0000012/ C ELASTIC TOTAL DATA XEL/0.00,0.05,0.10,0.20,0.30,0.40,0.50,0.60,0.80,1.00, /1.22,1.50,1.70,2.00,2.40,2.50,3.00,3.40,4.00,4.40, /5.00,5.40,6.00,6.40,7.00,7.40,8.00,8.40,9.00,9.40, /10.0,10.4,11.4,12.0,12.4,13.4,14.0,14.4,15.4,16.0, /16.4,17.4,18.0,20.0,25.0,30.0,40.0,50.0,60.0,70.0, /80.0,90.0,100.,125.,150.,200.,250.,300.,400.,500., /600.,800.,1000.,1500.,2000.,4000.,10000.,20000.,100000./ DATA YEL/4.90,5.48,5.67,5.86,5.98,6.03,6.08,6.09,6.11,6.12, /6.10,6.08,6.07,6.03,5.95,5.93,5.82,5.73,5.60,5.51, /5.38,5.29,5.15,5.07,4.94,4.86,4.75,4.68,4.57,4.49, /4.39,4.32,4.15,4.06,4.00,3.85,3.76,3.71,3.58,3.51, /3.46,3.34,3.26,3.00,2.52,2.15,1.63,1.29,1.06,.884, /.734,.653,.572,.445,.351,.239,.181,.152,.107,.080, /.065,.040,.030,.020,.015,.0073,.0033,.0015,.0004/ C IONISATION DATA XION/24.587,25.0,25.5,26.0,26.5,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0, /100.,120.,150.,175.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,4000.,5000.,6000.,8000.,10000.,20000.,100000./ DATA YION/0.0,.0052,.0113,.0175,.0236,.030,.043,.055,.066,.089, /.111,.132,.150,.166,.203,.235,.260,.281,.312,.335, /.364,.369,.364,.354,.342,.315,.287,.249,.215,.191, /.173,.159,.145,.133,.117,.103,.093,.086,.080,.065, /.055,.045,.036,.031,.025,.020,.0117,.0040/ C TRIPLET EXCITATION DATA XEXC/19.82,20.0,20.2,20.5,20.6,20.8,21.0,21.3,22.0,25.0, /30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,150.,200., /400.,1000.,10000.,20000.,100000./ DATA YEXC/0.00,.047,.053,.035,.029,.043,.042,.041,.046,.075, /.071,.054,.038,.026,.017,.013,.0094,.0075,.0022,.00094, /.00012,.000008,.000000008,.000000001,.0000000003/ C SINGLET EXCITATION DATA XEXS/20.61,20.9,21.0,21.5,22.0,22.5,25.0,28.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,150.,200., /300.,400.,500.,600.,800.,1000.,1500.,2000.,3000.,4000., /6000.,10000.,20000.,100000./ DATA YEXS/0.00,.025,.022,.0265,.0315,.036,.065,.082,.092,.115, /.133,.148,.155,.175,.177,.178,.178,.177,.163,.148, /.121,.099,.086,.075,.061,.051,.038,.030,.022,.017, /.013,.0088,.0052,.0018/ NAME='He4 (2002)' C -------------------------------------------------------------------- C HELIUM 4 BEST KNOWN GAS USED AS STANDARD ACCURACY BETTER THAN 0.2% C AT ALL FIELDS. C UPDATED 1997 DATA FILE TO INCLUDE ANISOTROPIC ELASTIC SCATTTERING C -------------------------------------------------------------------- NIN=2 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C USE ANISOTROPIC ELASTIC SCATTERING AND COPY (OFFSET) TO IONISATION KEL(2)=1 KEL(3)=1 C NEL=69 NDATA=67 NION=48 NEXC=25 NEXS=34 E(1)=0.0 E(2)=2.0*EMASS/(4.00260*AMU) E(3)=24.587 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=15.8 IOFF=INT(0.5+E(3)/ESTEP) EIN(1)=19.82 EIN(2)=20.61 SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) HELIUM 4 ' SCRPT(3)=' IONISATION ELOSS= 24.587 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC TRPLT ELOSS= 19.82 ' SCRPT(8)=' EXC SNGLT ELOSS= 20.61 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NEL IF(EN.LE.XEL(J)) GO TO 20 10 CONTINUE J=NEL 20 A=(YEL(J)-YEL(J-1))/(XEL(J)-XEL(J-1)) B=(XEL(J-1)*YEL(J)-XEL(J)*YEL(J-1))/(XEL(J-1)-XEL(J)) QELA=(A*EN+B)*1.0D-16 DO 50 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 60 50 CONTINUE J=NDATA 60 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.0D-16 PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LE.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISTRIBUTION SAME AS ELASTIC AT ENERGY OFFSET BY C IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 200 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C 200 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(1,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 700 DO 610 J=2,NEXS IF(EN.LE.XEXS(J)) GO TO 620 610 CONTINUE J=NEXS 620 A=(YEXS(J)-YEXS(J-1))/(XEXS(J)-XEXS(J-1)) B=(XEXS(J-1)*YEXS(J)-XEXS(J)*YEXS(J-1))/(XEXS(J-1)-XEXS(J)) QIN(2,I)=(A*EN+B)*1.D-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS46. SUBROUTINE GAS46(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(43),YXSEC(43),XION(68),YION(68),XEL(51),YEL(51) DIMENSION X1(48),Y1(48),X2(57),Y2(57),X3(48),Y3(48),X4(49),Y4(49) DIMENSION X5(48),Y5(48),X6(45),Y6(45),X7(45),Y7(45),X8(45),Y8(45) DIMENSION X9(45),Y9(45) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/1.00,1.20,1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00, /7.00,8.00,8.71,9.00,10.0,11.0,13.6,15.0,16.5,19.6, /20.0,30.0,40.0,50.0,60.0,70.0,77.0,100.,130.,150., /170.,200.,300.,400.,600.,800.,1000.,2000.,4000.,10000., /20000.,40000.,100000./ DATA YXSEC/1.6178,1.69,1.75,1.79,1.82,1.86,1.91,1.98,2.07,2.14, /2.21,2.29,2.35,2.37,2.44,2.51,2.66,2.71,2.76,2.83, /2.84,2.84,2.78,2.58,2.30,2.12,2.03,1.53,1.21,1.03, /0.90,.756,0.48,0.31,0.17,0.11,.077,.025,.007,.0016, /.0005,.00014,.00003/ C ELASTIC TOTAL DATA XEL/1.00,1.20,1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00, /8.00,10.0,12.0,14.0,16.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,90.0,100.,125.,150.,200.,250., /300.,350.,400.,500.,600.,700.,800.,900.,1000.,1200., /1500.,2000.,2500.,3000.,4000.,5000.,6000.,10000.,20000.,40000., /100000./ DATA YEL/1.5667,1.68,1.82,1.94,2.01,2.16,2.30,2.55,2.80,2.98, /3.23,3.39,3.54,3.63,3.67,3.68,3.70,3.63,3.54,3.31, /3.12,2.93,2.75,2.56,2.42,2.26,1.98,1.76,1.41,1.26, /1.10,1.02,.921,.806,.703,.643,.577,.539,.486,.434, /.366,.292,.233,.195,.168,.131,.107,.073,.040,.023, /.011/ C IONISATION DATA XION/21.56,22.0,22.5,23.0,23.5,24.0,24.5,25.0,25.5,26.0, /27.0,28.0,29.0,30.0,32.0,34.0,36.0,40.0,45.0,50.0, /55.0,60.0,65.0,70.0,75.0,80.0,90.0,100.,110.,120., /140.,150.,175.,200.,250.,300.,350.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,3500.,4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000., /10000.,12000.,14000.,16000.,18000.,20000.,50000.,100000./ DATA YION/0.00,.0032,.0076,.0121,.0172,.022,.027,.032,.037,.042, /.054,.066,.078,.091,.116,.141,.166,.215,.266,.322, /.372,.416,.458,.495,.527,.557,.604,.643,.679,.699, /.730,.744,.754,.752,.730,.692,.657,.617,.560,.507, /.463,.425,.394,.368,.317,.287,.260,.236,.219,.186, /.160,.142,.127,.116,.108,.099,.0929,.0819,.0734,.0672, /.0618,.0536,.0471,.0423,.0387,.0355,.0174,.0104/ C EXCITATION C 1S5 DATA X1/16.618,16.70,16.80,16.9,17.0,17.1,17.2,17.3,17.4,17.6, /17.8,18.0,18.2,18.3,18.4,18.5,18.6,18.7,18.8,19.0, /19.5,20.0,21.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /44.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150.,200., /250.,500.,1000.,2000.,5000.,10000.,20000.,100000./ DATA Y1/0.0,.0009,.0022,.0042,.0072,.0054,.0046,.0050,.0053,.0060, /.0065,.0070,.0074,.0080,.0104,.0130,.0108,.0085,.0082,.0083, /.0086,.0087,.0086,.0083,.0073,.0070,.0067,.0062,.0045,.0031, /.0024,.0016,.0010,.0006,.0004,.00028,.0002,.00011,.00006,.00002, /1.1D-5,1.3D-6,1.5D-7,1.7D-8,9.6D-10,1.1D-10,1.4D-11,1.7D-13/ C 1S4 DATA X2/16.670,16.70,16.80,16.9,17.0,17.2, /17.5,18.0,18.2,18.4,18.5,18.6,18.7,18.8,19.0, /19.5,20.0,21.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /44.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150.,200., /250.,300.,400.,500.,600.,700.,800.,900.,1000.,1200., /1500.,2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /40000.,100000./ DATA Y2/0.,.00004,.0021,.0030,.0060,.0040, /.0053,.0057,.0058,.0070,.0100,.0080,.0060,.0058,.0057, /.0057,.0059,.0057,.0062,.0069,.0074,.0076,.0078,.0081,.0084, /.0086,.0086,.0083,.0080,.0078,.0075,.0073,.0069,.0062,.0052, /.0047,.0041,.0034,.0029,.0026,.0023,.0021,.0019,.0018,.0015, /.0012,.0010,.0009,.0007,.00059,.00050,.00043,.00034,.00028,.00016, /.000092,.000047/ C 1S3 DATA X3/16.715,16.80,16.9,17.0,17.1,17.2,17.3,17.4,17.5,17.6, /17.8,18.0,18.2,18.3,18.4,18.5,18.6,18.7,18.8,19.0, /19.5,20.0,21.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /44.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150.,200., /250.,500.,1000.,2000.,5000.,10000.,20000.,100000./ DATA Y3/0.,.0003,.0009,.0016,.0011,.0009,.0010,.0011,.0011,.0011, /.0012,.0013,.0014,.0015,.0022,.0029,.0022,.0017,.0015,.0016, /.0016,.0017,.0017,.0016,.0015,.0015,.0015,.0014,.0010,.00079, /.00065,.0005,.00033,.00023,.00017,.00013,.0001,6.5D-5,4.D-5,2.D-5, /1.1D-5,2.0D-6,3.6D-7,6.4D-8,6.7D-9,1.2D-9,2.4D-10,7.0D-12/ C 1S2 DATA X4/16.847,17.0,17.1,17.5,18.0,18.5,19.0, /19.5,20.0,21.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /44.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150.,200., /250.,300.,400.,500.,600.,700.,800.,900.,1000.,1200., /1500.,2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /40000.,100000./ DATA Y4/0.,.0090,.0170,.0175,.0182,.0194,.0205, /.0215,.0225,.0245,.0266,.0310,.0430,.0580,.0700,.0870,.0960, /.1000,.1030,.1040,.1030,.1000,.0973,.0934,.0862,.0770,.0655, /.0571,.0509,.0420,.0360,.0316,.0282,.0256,.0235,.0217,.0189, /.0159,.0127,.0110,.0092,.0073,.0061,.0053,.0042,.0035,.0020, /.0011,.00059/ C SUM OF 2P(10-2) = 2P10+2P9+2P8+2P7+2P6+2P5+2P4+2P3+2P2 DATA X5/18.381,18.5,18.6,18.7,18.8,19.0,19.5,20.0,21.0,22.0, /24.0,26.0,28.0,30.0,35.0,40.0,44.0,50.0,60.0,70.0, /80.0,90.0,100.,120.,150.,200.,250.,300.,400.,500., /600.,700.,800.,900.,1000.,1200.,1500.,2000.,2400.,3000., /4000.,5000.,6000.,8000.,10000.,20000.,40000.,100000./ DATA Y5/0.,.0005,.0050,.0210,.0110,.0098,.0118,.0140,.0191,.0225, /.0256,.0263,.0258,.0249,.0219,.0191,.0172,.0149,.0121,.0101, /.0087,.0076,.0067,.0055,.0043,.0031,.0025,.0020,.0015,.0012, /.00098,.00084,.00073,.00065,.00058,.00048,.00039,.00029,.00024, /.00019,.00014,.00012,.00010,.00007,.00006,.00003,.000016,.000007/ C 2P1 DATA X6/18.965,19.2,20.0,20.5,21.0,22.0,23.0,24.0,26.0,28.0, /30.0,35.0,40.0,44.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2400.,3000.,4000.,5000.,6000., /8000.,10000.,20000.,40000.,100000./ DATA Y6/0.,.0014,.0023,.0029,.0035,.0048,.0062,.0075,.0105,.0135, /.0158,.0195,.0211,.0213,.0209,.0195,.0179,.0163,.0150,.0138, /.0118,.0097,.0074,.0060,.0051,.0038,.0031,.0026,.0022,.0019, /.0017,.0015,.0013,.0010,.0008,.00065,.00052,.00039,.00031,.00026, /.00020,.00016,.00008,.00004,.00002/ C SUM 2S5 + 2S4 + 2S3 + 2S2 DATA X7/19.663,20.5,21.0,21.5,22.0,23.0,24.0,25.0,26.0,28.0, /30.0,35.0,40.0,44.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2400.,3000.,4000.,5000.,6000., /8000.,10000.,20000.,40000.,100000./ DATA Y7/0.,.0021,.0031,.0040,.0047,.0058,.0067,.0074,.0079,.0087, /.0093,.0102,.0109,.0112,.0116,.0119,.0120,.0120,.0118,.0117, /.0112,.0105,.0094,.0084,.0077,.0065,.0057,.0051,.0046,.0042, /.0039,.0036,.0032,.0027,.0022,.0019,.0016,.0013,.0011,.00092, /.00073,.00061,.00035,.00020,.000104/ C SUM HIGHER LEVELS 3D + 3S DATA X8/20.033,20.5,21.0,21.5,22.0,23.0,24.0,25.0,26.0,28.0, /30.0,35.0,40.0,44.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2400.,3000.,4000.,5000.,6000., /8000.,10000.,20000.,40000.,100000./ DATA Y8/0.,.0008,.0015,.0022,.0028,.0040,.0051,.0060,.0068,.0081, /.0090,.0101,.0104,.0104,.0101,.0095,.0089,.0084,.0079,.0074, /.0067,.0058,.0048,.0041,.0035,.0029,.0024,.0021,.0018,.0016, /.0015,.0014,.0012,.00096,.00075,.00064,.00053,.0004,.00034,.00029, /.00022,.00018,.00010,.000057,.000028/ C SUM 3P (3P1 T0 3P10) DATA X9/20.200,20.5,21.0,21.5,22.0,23.0,24.0,25.0,26.0,28.0, /30.0,35.0,40.0,44.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2400.,3000.,4000.,5000.,6000., /8000.,10000.,20000.,40000.,100000./ DATA Y9/0.,.0004,.0013,.0021,.0028,.0039,.0047,.0054,.0058,.0065, /.0068,.0070,.0068,.0066,.0062,.0055,.0050,.0045,.0041,.0037, /.0032,.0026,.0020,.0016,.0014,.00103,.00083,.00070,.00060,.00052, /.00047,.00042,.00035,.00028,.00021,.00018,.00014,.00011,.000086, /.000072,.000054,.000043,.000022,.000012,.0000055/ C --------------------------------------------------------------------- C NAME='Ne (2003 anis.)' C --------------------------------------------------------------------- C UPDATE OF 2002 FILE USES MORE DETAILED EXCITATION X-SECTIONS FOR USE C IN PENNING CALCULATIONS. C SHAPE 0F EXCITATION FUNCTIONS CLOSE TO THRESHOLD GUIDED BY C ZEMAN AND BARTSCHAT J.PHYS. B 30(1997)4609 C ALL X-SECTIONS CONSISTENT WITH PUBLISHED ELECTRON SCATTERING DATA UP C TO 2003 C FIT TO RATE COEFICIENTS OF : C TACHIBANA AN PHELPS : PHYS REV.A36(1987)999 C TACHIBANA AND HARIMA J.PHYS.B 17(1984)879 C GOOD FIT TO DRIFT DIFFUSION DATA OF ROBERTSON AND ALSO DATA OF C LUCAS AND SAELEE . CLOSE FIT TO TOWNSEND DATA OF CHANIN AND RORK C --------------------------------------------------------------------- NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C USE ANISOTROPIC ELASTIC SCATTERING AND COPY (OFFSET) TO IONISATION KEL(2)=1 KEL(3)=1 C NEL=51 NDATA=43 NION=68 NEXC1=48 NEXC2=57 NEXC3=48 NEXC4=49 NEXC5=48 NEXC6=45 NEXC7=45 NEXC8=45 NEXC9=45 E(1)=0.0 E(2)=2.0*EMASS/(20.179*AMU) E(3)=21.56 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=24.2 IOFF=INT(0.5+E(3)/ESTEP) EIN(1)=16.618 EIN(2)=16.670 EIN(3)=16.715 EIN(4)=16.857 EIN(5)=18.381 EIN(6)=18.965 EIN(7)=19.663 EIN(8)=20.033 EIN(9)=20.200 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC NEON ' SCRPT(3)=' IONISATION ELOSS= 21.56 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC 1S5 ELOSS= 16.618 ' SCRPT(8)=' EXC 1S4 ELOSS= 16.670 ' SCRPT(9)=' EXC 1S3 ELOSS= 16.715 ' SCRPT(10)=' EXC 1S2 ELOSS= 16.857 ' SCRPT(11)=' EXCSUM 2P10-2 ELOSS= 18.381 ' SCRPT(12)=' EXC 2P1 ) ELOSS= 18.965 ' SCRPT(13)=' EXC SUM 2S ELOSS= 19.663 ' SCRPT(14)=' EXC 3D+3S ELOSS= 20.033 ' SCRPT(15)=' EXC 3P ELOSS= 20.200 ' C PARAMETERS OF PHASE SHIFT ANALYSIS APOL=2.672 LMAX=100 AA=0.2135 DD=3.86 FF=-2.656 A1=1.846 B1=3.29 A2=-0.037 API=ACOS(-1.0D0) C EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.1.0) GO TO 100 IF(EN.EQ.0.0) QELA=0.161D-16 IF(EN.EQ.0.0) QMOM=0.161D-16 IF(EN.EQ.0.0) GO TO 200 AK=SQRT(EN/ARY) AK2=AK*AK AK3=AK2*AK AK4=AK3*AK AK5=AK4*AK AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK2*LOG(AK))-(API*APOL/3.0)*AK2+ /DD*AK3+FF*AK4 AN1=((API/15.0)*APOL*AK2-A1*AK3)/(1.0+B1*AK2) AN2=API*APOL*AK2/105.0-A2*AK5 ANHIGH=AN2 SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 SIGEL=(SIN(AN0))**2+3.0*(SIN(AN1))**2 DO 10 J=2,LMAX-1 ANLOW=ANHIGH ANHIGH=API*APOL*AK2/((2.*J+5.0)*(2.*J+3.0)*(2.*J+1.0)) SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(API*APOL*AK2*SUMI))**2 SIGEL=SIGEL+(2.0*J+1.0)*(SIN(ANLOW))**2 10 CONTINUE QELA=SIGEL*4.0*PIR2/AK2 QMOM=SUM*4.0*PIR2/AK2 GO TO 200 100 CONTINUE DO 110 J=2,NEL IF(EN.LE.XEL(J)) GO TO 120 110 CONTINUE J=NEL 120 A=(YEL(J)-YEL(J-1))/(XEL(J)-XEL(J-1)) B=(XEL(J-1)*YEL(J)-XEL(J)*YEL(J-1))/(XEL(J-1)-XEL(J)) QELA=(A*EN+B)*1.0D-16 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.0D-16 200 CONTINUE PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISTRIBUTION SAME AS ELASTIC AT ENERGY OFF SET BY C THE IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 230 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C 230 Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 360 DO 340 J=2,NEXC1 IF(EN.LE.X1(J)) GO TO 350 340 CONTINUE J=NEXC1 350 A=(Y1(J)-Y1(J-1))/(X1(J)-X1(J-1)) B=(X1(J-1)*Y1(J)-X1(J)*Y1(J-1))/(X1(J-1)-X1(J)) QIN(1,I)=(A*EN+B)*1.0D-16 360 CONTINUE C QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 430 DO 410 J=2,NEXC2 IF(EN.LE.X2(J)) GO TO 420 410 CONTINUE J=NEXC2 420 A=(Y2(J)-Y2(J-1))/(X2(J)-X2(J-1)) B=(X2(J-1)*Y2(J)-X2(J)*Y2(J-1))/(X2(J-1)-X2(J)) QIN(2,I)=(A*EN+B)*1.0D-16 430 CONTINUE C QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 460 DO 440 J=2,NEXC3 IF(EN.LE.X3(J)) GO TO 450 440 CONTINUE J=NEXC3 450 A=(Y3(J)-Y3(J-1))/(X3(J)-X3(J-1)) B=(X3(J-1)*Y3(J)-X3(J)*Y3(J-1))/(X3(J-1)-X3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 460 CONTINUE C QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 530 DO 510 J=2,NEXC4 IF(EN.LE.X4(J)) GO TO 520 510 CONTINUE J=NEXC4 520 A=(Y4(J)-Y4(J-1))/(X4(J)-X4(J-1)) B=(X4(J-1)*Y4(J)-X4(J)*Y4(J-1))/(X4(J-1)-X4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 530 CONTINUE QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 560 DO 540 J=2,NEXC5 IF(EN.LE.X5(J)) GO TO 550 540 CONTINUE J=NEXC5 550 A=(Y5(J)-Y5(J-1))/(X5(J)-X5(J-1)) B=(X5(J-1)*Y5(J)-X5(J)*Y5(J-1))/(X5(J-1)-X5(J)) QIN(5,I)=(A*EN+B)*1.0D-16 560 CONTINUE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 630 DO 610 J=2,NEXC6 IF(EN.LE.X6(J)) GO TO 620 610 CONTINUE J=NEXC6 620 A=(Y6(J)-Y6(J-1))/(X6(J)-X6(J-1)) B=(X6(J-1)*Y6(J)-X6(J)*Y6(J-1))/(X6(J-1)-X6(J)) QIN(6,I)=(A*EN+B)*1.0D-16 630 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 660 DO 640 J=2,NEXC7 IF(EN.LE.X7(J)) GO TO 650 640 CONTINUE J=NEXC7 650 A=(Y7(J)-Y7(J-1))/(X7(J)-X7(J-1)) B=(X7(J-1)*Y7(J)-X7(J)*Y7(J-1))/(X7(J-1)-X7(J)) QIN(7,I)=(A*EN+B)*1.0D-16 660 CONTINUE C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 730 DO 710 J=2,NEXC8 IF(EN.LE.X8(J)) GO TO 720 710 CONTINUE J=NEXC8 720 A=(Y8(J)-Y8(J-1))/(X8(J)-X8(J-1)) B=(X8(J-1)*Y8(J)-X8(J)*Y8(J-1))/(X8(J-1)-X8(J)) QIN(8,I)=(A*EN+B)*1.0D-16 730 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 760 DO 740 J=2,NEXC1 IF(EN.LE.X9(J)) GO TO 750 740 CONTINUE J=NEXC9 750 A=(Y9(J)-Y9(J-1))/(X9(J)-X9(J-1)) B=(X9(J-1)*Y9(J)-X9(J)*Y9(J-1))/(X9(J-1)-X9(J)) QIN(9,I)=(A*EN+B)*1.0D-16 760 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+QIN(5,I)+ /QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTING TIME IF(EFINAL.LT.EIN(9)) NIN=8 IF(EFINAL.LT.EIN(8)) NIN=7 IF(EFINAL.LT.EIN(7)) NIN=6 IF(EFINAL.LT.EIN(6)) NIN=5 IF(EFINAL.LT.EIN(5)) NIN=4 IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 END +DECK,GAS47. SUBROUTINE GAS47(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(44),YXSEC(44),XENI(76),YXENI(76),XIN(26),YXSIN(26),Y /XPIN(26),YXDIN(26),XEL(44),YEL(44) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/1.00,1.20,1.50,1.70,2.00,2.50,3.00,4.00,4.90,5.00, /6.00,6.67,7.00,8.00,8.71,9.00,10.0,11.0,12.0,13.0, /13.6,14.0,15.0,16.0,16.5,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,400.,1000.,2000., /4000.,10000.,20000.,100000./ DATA YXSEC/1.3913,1.66,2.05,2.33,2.70,3.43,4.15,5.65,7.26,7.46, /9.32,10.6,11.3,13.1,14.1,14.4,15.4,15.8,15.8,15.4, /15.1,14.8,14.1,13.2,13.0,11.4,10.2,7.80,6.25,4.45, /3.50,2.80,2.20,2.00,1.45,0.90,0.63,0.28,0.18,0.10, /0.05,.0048,0.0018,.00009/ C ELASTIC DATA XEL/1.00,1.50,2.00,3.00,4.00,5.00,6.00,8.00,10.0,12.0, /14.0,16.0,18.0,20.0,25.0,30.0,40.0,50.0,60.0,70.0, /80.0,90.0,100.,125.,150.,200.,250.,300.,350.,400., /500.,600.,700.,800.,1000.,1500.,2000.,3000.,4000.,5000., /6000.,10000.,20000.,100000./ DATA YEL/1.4945,2.25,3.20,5.10,7.20,8.95,11.1,15.8,20.3,23.2, /23.5,22.3,19.5,17.8,13.9,11.4,8.44,6.84,6.12,5.56, /5.09,4.72,4.42,3.81,3.41,2.94,2.61,2.44,2.29,2.07, /1.90,1.74,1.61,1.59,1.28,0.95,.767,.518,.448,.356, /.305,0.18,0.09,0.02/ DATA XENI/15.7,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /20.5,21.0,21.5,22.0,22.5,23.0,23.5,24.0,24.5,25.0, /25.5,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,250., /300.,350.,400.,450.,500.,600.,700.,800.,900.,1000., /1200.,1400.,1600.,1800.,2000.,2500.,3000.,3500.,4000.,5000., /6000.,8000.,10000.,14000.,20000.,100000./ DATA YXENI/0.00,.031,.094,.163,.235,.310,.386,.465,.546,.627, /.713,.787,.858,.933,.994,1.06,1.12,1.18,1.24,1.30, /1.35,1.41,1.60,1.80,1.96,2.11,2.24,2.33,2.39,2.49, /2.53,2.60,2.66,2.73,2.77,2.82,2.84,2.85,2.86,2.86, /2.85,2.83,2.81,2.76,2.73,2.68,2.62,2.52,2.39,2.17, /1.98,1.81,1.68,1.55,1.46,1.30,1.16,1.06,.985,.915, /.780,.698,.647,.585,.533,.453,.390,.345,.306,.259, /.223,.175,.147,.112,.0838,.0167/ DATA XIN/11.55,13.0,13.2,13.4,14.0,16.0,20.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,500.,700.,1000.,1400., /2000.,4000.,6000.,10000.,20000.,100000./ DATA YXSIN/0.00,.069,.090,.087,.115,.205,0.22,0.25,0.29,0.34, /0.31,.265,0.24,0.18,0.15,.115,.080,.063,.047,.036, /.028,.016,.0115,.007,.0036,.00072/ DATA YXPIN/0.00,0.00,.012,.036,.072,.205,0.42,0.54,0.53,0.50, /0.46,0.39,0.34,0.26,0.21,.165,0.11,.083,0.06,.046, /.035,.020,.0140,.009,.0042,.0009/ DATA YXDIN/0.00,0.00,0.00,0.00,0.00,.067,0.15,0.29,0.35,0.39, /0.41,0.47,0.47,0.44,0.37,.285,0.19,0.15,0.11,.081, /.061,.035,.0245,.016,.008,.0016/ NAME='Ar (2002 anis.)' C ---------------------------------------------------------------- C MULTI-TERM CROSS-SECTION. C FOR PURE ARGON: C ACCURACY OF DERIVED VELOCITY AND DIFFUSION COEFFICIENTS 0.5% BELOW C 3000VOLTS . BELOW 20000VOLTS ACCURACY 1.0%. IONISATION COEFFICIENT C AND DRIFT VELOCITY ACCURACY BETTER THAN 5% BELOW 1,000,000 VOLTS C ANISOTROPIC ELASTIC SCATTERING VERSION C C----------------------------------------------------------------- C C PARAMETERS OF PHASE SHIFT ANALYSIS. C APOL=11.08 LMAX=100 AA=-1.459 DD=68.93 FF=-97.0 A1=8.69 API=ACOS(-1.0D0) C NIN=3 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C USE ANISOTROPIC ELASTIC SCATTERING AND COPY (OFFSET) TO IONISATION KEL(2)=1 KEL(3)=1 C NEL=44 NDATA=44 NIDATA=76 NXDATA=26 E(1)=0.0 E(2)=2.0*EMASS/(39.948*AMU) E(3)=15.7 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.0 IOFF=INT(0.5+E(3)/ESTEP) EIN(1)=11.55 EIN(2)=13.0 EIN(3)=14.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) ARGON ' SCRPT(3)=' IONISATION ELOSS= 15.7 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC S-LEVELS ELOSS= 11.55 ' SCRPT(8)=' EXC P-LEVELS ELOSS= 13.0 ' SCRPT(9)=' EXC D-LEVELS ELOSS= 14.0 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.1.0) GO TO 100 IF(EN.EQ.0.0) QELA=7.491D-16 IF(EN.EQ.0.0) QMOM=7.491D-16 IF(EN.EQ.0.0) GO TO 200 AK=SQRT(EN/ARY) AK2=AK*AK AK3=AK2*AK AK4=AK3*AK AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK2*LOG(AK))-(API*APOL/3.0)*AK2+ /DD*AK3+FF*AK4 AN1=(API/15.0)*APOL*AK2-A1*AK3 AN2=API*APOL*AK2/105.0 AN0=ATAN(AN0) AN1=ATAN(AN1) AN2=ATAN(AN2) ANHIGH=AN2 SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 SIGEL=(SIN(AN0))**2+3.0*(SIN(AN1))**2 DO 10 J=2,LMAX-1 ANLOW=ANHIGH SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(ATAN(API*APOL*AK2*SUMI)))**2 ANHIGH=ATAN(API*APOL*AK2/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0))) SIGEL=SIGEL+(2.0*J+1.0)*(SIN(ANLOW))**2 10 CONTINUE QELA=SIGEL*4.0*PIR2/AK2 QMOM=SUM*4.0*PIR2/AK2 GO TO 200 100 CONTINUE DO 110 J=2,NEL IF(EN.LE.XEL(J)) GO TO 120 110 CONTINUE J=NEL 120 A=(YEL(J)-YEL(J-1))/(XEL(J)-XEL(J-1)) B=(XEL(J-1)*YEL(J)-XEL(J)*YEL(J-1))/(XEL(J-1)-XEL(J)) QELA=(A*EN+B)*1.0D-16 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.0D-16 200 CONTINUE PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NIDATA IF(EN.LE.XENI(J)) GO TO 220 210 CONTINUE J=NIDATA 220 A=(YXENI(J)-YXENI(J-1))/(XENI(J)-XENI(J-1)) B=(XENI(J-1)*YXENI(J)-XENI(J)*YXENI(J-1))/(XENI(J-1)-XENI(J)) Q(3,I)=(A*EN+B)*1.0D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISTRIBUTION SAME AS ELASTIC AT ENERGY OFFSET BY C IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 230 PEQEL(3,I)=PEQEL(2,(I-IOFF)) 230 Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 QIN(2,I)=0.0D0 QIN(3,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NXDATA IF(EN.LE.XIN(J)) GO TO 320 310 CONTINUE J=NXDATA 320 A=(YXSIN(J)-YXSIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXSIN(J)-XIN(J)*YXSIN(J-1))/(XIN(J-1)-XIN(J)) QIN(1,I)=(A*EN+B)*1.0D-16 IF(EN.LE.EIN(2)) GO TO 400 A=(YXPIN(J)-YXPIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXPIN(J)-XIN(J)*YXPIN(J-1))/(XIN(J-1)-XIN(J)) QIN(2,I)=(A*EN+B)*1.0D-16 IF(EN.LE.EIN(3)) GO TO 400 A=(YXDIN(J)-YXDIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXDIN(J)-XIN(J)*YXDIN(J-1))/(XIN(J-1)-XIN(J)) QIN(3,I)=(A*EN+B)*1.0D-16 400 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C END +DECK,GAS48. SUBROUTINE GAS48(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(83),YXSEC(83),XION(71),YION(71), /XEXC1(95),YEXC1(95),XEXC2(76),YEXC2(76), /XEXC3(71),YEXC3(71),XEXC4(63),YEXC4(63),XEL(95),YEL(95) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/1.D-6,.001,.003,.005,.007,0.01,.015,0.02,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.52,0.54,0.56,0.60, /0.70,0.80,0.90,1.00,1.20,1.40,1.70,2.00,2.50,3.00, /3.30,3.60,4.00,4.40,4.80,5.20,5.60,6.00,6.50,7.00, /7.50,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /20.0,30.0,40.0,50.0,60.0,75.0,100.,150.,200.,300., /400.,500.,700.,1000.,1500.,2000.,3000.,4000.,6000.,8000., /10000.,20000.,100000./ DATA YXSEC/37.4,33.1,30.0,27.9,26.2,24.2,21.6,19.5,16.3,13.9, /12.1,10.6,9.30,8.35,7.38,6.65,5.45,4.40,3.25,2.45, /1.55,0.92,0.52,0.26,.145,.103,.100,.104,.110,.133, /.235,.375,.535,0.74,1.26,1.74,2.55,3.40,4.75,6.35, /7.32,8.28,9.51,10.7,11.9,13.2,14.2,15.2,16.2,17.2, /17.9,18.4,18.7,18.1,17.2,16.0,14.8,13.6,12.5,11.4, /8.18,4.08,2.47,1.71,1.43,1.35,1.30,0.90,0.80,0.64, /0.54,0.45,0.40,0.30,0.21,0.16,0.12,0.09,.065,.052, /.044,.025,.005/ C ELASTIC DATA XEL/1.D-6,.001,.003,.005,.007,0.01,.015,0.02,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.55,0.60,0.65,0.70, /0.72,0.74,0.76,0.80,0.85,0.90,0.95,1.00,1.10,1.20, /1.30,1.40,1.50,1.75,2.00,2.25,2.50,3.00,3.50,4.00, /5.00,6.00,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0, /15.0,16.0,18.0,20.0,22.5,25.0,27.5,30.0,35.0,40.0, /45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150.,175., /200.,250.,300.,400.,500.,600.,700.,800.,1000.,2000., /4000.,6000.,10000.,20000.,100000./ DATA YEL/37.4,34.6,31.8,29.9,28.4,26.6,24.1,22.2,19.1,16.8, /14.9,13.4,12.1,11.0,10.0,9.15,7.71,6.56,5.21,4.38, /3.22,2.31,1.75,1.30,1.04,0.83,0.65,0.57,0.50,0.46, /0.45,0.44,0.45,0.46,0.48,0.53,0.60,0.67,0.85,1.07, /1.32,1.54,1.84,2.23,3.02,3.83,4.68,6.36,8.24,10.1, /14.1,18.5,22.0,25.0,26.2,27.2,27.6,27.5,26.8,26.3, /24.9,23.7,22.3,21.0,19.3,17.3,15.8,14.9,13.2,11.5, /10.7,9.68,8.80,8.00,7.15,6.35,5.69,4.98,4.30,3.97, /3.73,3.43,3.06,2.71,2.45,2.33,2.15,1.99,1.81,1.36, /.974,.738,0.55,0.32,0.10/ C IONISATION DATA XION/13.996,14.5,15.0,15.5,16.0,16.5,17.0,17.5,18.0,18.5, /19.0,19.5,20.0,21.0,22.0,23.0,24.0,26.0,28.0,30.0, /32.0,34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,65.0, /70.0,80.0,90.0,100.,120.,140.,160.,180.,200.,250., /300.,400.,500.,600.,700.,800.,900.,1000.,1200.,1400., /1600.,1800.,2000.,2500.,3000.,3500.,4000.,4500.,5000.,5500., /6000.,7000.,8000.,9000.,10000.,12000.,14000.,16000.,18000.,20000., /100000./ DATA YION/0.00,.078,.160,.255,.358,.465,.576,.684,.799,.906, /1.01,1.12,1.22,1.41,1.58,1.76,1.93,2.24,2.52,2.77, /2.96,3.13,3.26,3.39,3.49,3.67,3.84,3.97,4.09,4.17, /4.21,4.26,4.23,4.20,4.08,3.91,3.75,3.61,3.46,3.13, /2.87,2.46,2.16,1.94,1.76,1.60,1.49,1.39,1.20,1.07, /.975,.895,.818,.699,.606,.534,.480,.435,.405,.373, /.348,.307,.277,.251,.230,.199,.176,.157,.145,.132, /.039/ C EXCITATION TO FIRST 4 S STATES DATA XEXC1/9.915,9.92,9.93,9.94,9.95,9.96,9.98,10.0,10.02,10.04, /10.06,10.08,10.09,10.1,10.11,10.12,10.13,10.14,10.15,10.16, /10.17,10.18,10.19,10.2,10.25,10.3,10.4,10.5,10.6,10.7, /10.8,10.9,11.0,11.3,11.6,11.8,12.0,12.5,13.0,13.5, /14.0,14.5,15.0,15.5,16.0,17.0,18.0,19.0,20.0,22.0, /24.0,27.0,30.0,33.0,36.0,40.0,44.0,50.0,54.0,60.0, /70.0,80.0,90.0,100.,120.,140.,170.,200.,240.,280., /320.,360.,400.,450.,500.,600.,700.,800.,1000.,1400., /2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000.,40000., /100000.,200000.,400000.,1000000.,1500000./ DATA YEXC1/0.00, /.00033,.00103,.00173,.00242,.00310,.00445,.00578,.00709,.00856, /.0105,.0127,.0152,.0217,.0372,.0640,.0937,.108,.0971,.0697, /.0443,.0300,.0250,.0244,.0287,.0333,.0422,.0507,.0593,.0697, /.081,.092,.103,.132,.158,.173,.188,.219,.244,.265, /.282,.296,.308,.318,.326,.338,.347,.353,.357,.361, /.361,.357,.351,.343,.335,.324,.314,.299,.289,.276, /.256,.239,.225,.212,.190,.173,.153,.138,.122,.110, /.0998,.0918,.0850,.0780,.0722,.0630,.0561,.0506,.0426,.0327, /.0246,.0212,.0177,.0140,.0116,.0100,.0079,.0066,.0037,.0021, /.00109,.00072,.00054,.00046,.00046/ C EXCITATION TO NEXT GROUP OF P STATES DATA XEXC2/11.304,11.35,11.4,11.45,11.5,11.6,11.7,11.8,11.9,12.0, /12.1,12.2,12.3,12.4,12.5,12.6,12.7,12.8,12.9,13.0, /13.5,14.0,14.5,15.0,15.5,16.0,17.0,18.0,19.0,20.0, /22.0,24.0,27.0,30.0,33.0,36.0,40.0,44.0,50.0,54.0, /60.0,70.0,80.0,90.0,100.,120.,140.,170.,200.,240., /280.,320.,360.,400.,450.,500.,600.,700.,800.,1000., /1400.,2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /40000.,100000.,200000.,400000.,1000000.,1500000./ DATA YEXC2/0.0, /.00073,.00151,.0026,.0059,.0141,.0225,.0304,.0381,.0454, /.0523,.0589,.0653,.0713,.0771,.0826,.0878,.0928,.0976,.102, /.122,.137,.150,.159,.166,.171,.177,.180,.179,.177, /.170,.161,.147,.134,.122,.112,.101,.0911,.0797,.0735, /.0659,.0563,.0492,.0439,.0397,.0335,.0291,.0245,.0214,.0183, /.0161,.0145,.0132,.0121,.0110,.0101,.0087,.0077,.0069,.0058, /.00443,.00332,.00286,.00238,.00188,.00156,.00135,.00106,.00088, /.00050,.00029,.000146,.000097,.000073,.000063,.000063/ C EXCITATION TO GROUP OF S P AND D STATES ABOVE 12 EV DATA XEXC3/11.998,12.05,12.1,12.2,12.3,12.4,12.5,12.6,12.7,12.8, /12.9,13.0,13.2,13.4,13.6,13.8,14.0,14.5,15.0,15.5, /16.0,17.0,18.0,19.0,20.0,22.0,24.0,27.0,30.0,33.0, /36.0,40.0,44.0,50.0,54.0,60.0,70.0,80.0,90.0,100., /120.,140.,170.,200.,240.,280.,320.,360.,400.,450., /500.,600.,700.,800.,1000.,1400.,2000.,2400.,3000.,4000., /5000.,6000.,8000.,10000.,20000.,40000.,100000.,200000.,400000., /1000000.,1500000./ DATA YEXC3/0.0, /.0014,.0027,.0170,.0308,.0441,.0570,.0696,.0818,.0937, /.105,.116,.138,.158,.177,.195,.212,.250,.282,.308, /.331,.365,.388,.403,.412,.416,.411,.394,.373,.352, /.331,.307,.285,.257,.242,.222,.195,.175,.159,.146, /.126,.111,.0955,.0841,.0729,.0647,.0583,.0532,.0490,.0448, /.0412,.0358,.0317,.0285,.0239,.0183,.0137,.0118,.00986,.00779, /.00648,.00558,.00440,.00365,.00207,.00119,.00061,.00040,.00030, /.00026,.00026/ C EXCIATION OF ALL STATES ABOVE 12.75 EV DATA XEXC4/12.75,12.8,12.9,13.0,13.2,13.4,13.6,13.8,14.0,14.5, /15.0,15.5,16.0,17.0,18.0,19.0,20.0,22.0,24.0,27.0, /30.0,33.0,36.0,40.0,44.0,50.0,54.0,60.0,70.0,80.0, /90.0,100.,120.,140.,170.,200.,240.,280.,320.,360., /400.,450.,500.,600.,700.,800.,1000.,1400.,2000.,2400., /3000.,4000.,5000.,6000.,8000.,10000.,20000.,40000.,100000., /200000.,400000.,1000000.,1500000./ DATA YEXC4/0.0, /.00005,.000455,.00124,.00388,.00780,.0129,.0189,.0259,.0465, /.0705,.097,.125,.184,.243,.300,.354,.453,.536,.637, /.712,.768,.809,.846,.868,.884,.887,.883,.864,.838, /.809,.780,.725,.676,.612,.560,.503,.458,.420,.389, /.362,.334,.311,.273,.244,.221,.187,.145,.110,.0948, /.0793,.0628,.0524,.0451,.0356,.0296,.0168,.00965,.00495, /.00329,.00248,.0021,.0021/ C NAME='Kr (2002)' C C -------------------------------------------------------------------- C DATA ON KRYPTON NOT AS GOOD AS ARGON . FIT TO HUNTERS DRIFT VELOCITY C AND DIFFUSION OF KOZUMI .TOWNSEND COEFFICIENT C OF KRUITOFF,HEYLEN AND BHATTACHYRA CONSISENT SO AVERAGED AND GOOD C AGREEMENT OBTAINED WITH CALCULATED VALUES. C -------------------------------------------------------------------- C NIN=4 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C USE ANISOTROPIC ELASTIC SCATTERING AND COPY (OFFSET) TO IONISATION KEL(2)=1 KEL(3)=1 C NEL=95 NDATA=83 NION=71 NEXC1=95 NEXC2=76 NEXC3=71 NEXC4=63 E(1)=0.0 E(2)=2.0*EMASS/(83.80*AMU) E(3)=13.996 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=9.6 IOFF=INT(0.5+E(3)/ESTEP) EIN(1)=9.915 EIN(2)=11.304 EIN(3)=11.998 EIN(4)=12.75 SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) KRYPTON ' SCRPT(3)=' IONISATION ELOSS= 13.996 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC S-LEVELS ELOSS= 9.915 ' SCRPT(8)=' EXC P-LEVELS ELOSS= 11.304 ' SCRPT(9)=' EXC D+P-LVLS ELOSS= 11.998 ' SCRPT(10)=' EXC HIGHER ELOSS= 12.75 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) QELA=37.8D-16 IF(EN.EQ.0.0) QMOM=37.8D-16 IF(EN.EQ.0.0) GO TO 200 DO 110 J=2,NEL IF(EN.LE.XEL(J)) GO TO 120 110 CONTINUE J=NEL C USE LOG INTERPOLATION 120 Y1=LOG(YEL(J-1)) Y2=LOG(YEL(J)) X1=LOG(XEL(J-1)) X2=LOG(XEL(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) QELA=EXP((A*LOG(EN)+B))*1.0D-16 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA C USE LOG INTERPOLATION 160 Y1=LOG(YXSEC(J-1)) Y2=LOG(YXSEC(J)) X1=LOG(XEN(J-1)) X2=LOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) QMOM=EXP((A*LOG(EN)+B))*1.0D-16 200 CONTINUE PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC DISTRIBUTION SAME AS ELASTIC AT ENERGY OFFSET BY C IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 230 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C 230 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C EXCITATION TO FIRST FOUR 5S-LEVELS QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 370 DO 350 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 360 350 CONTINUE J=NEXC1 360 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(1,I)=(A*EN+B)*1.0D-16 370 CONTINUE C EXCITATION TO 5P-LEVELS QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 470 DO 450 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 460 450 CONTINUE J=NEXC2 460 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(2,I)=(A*EN+B)*1.0D-16 470 CONTINUE C EXCITATION TO 5D + 4D + 5P' LEVELS (UP TO 12.5 EV) QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 570 DO 550 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 560 550 CONTINUE J=NEXC3 560 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 570 CONTINUE C EXCITATION TO ALL LEVELS ABOVE 12.75 EV. QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 670 DO 650 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 660 650 CONTINUE J=NEXC4 660 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 670 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 END +DECK,GAS49. SUBROUTINE GAS49(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(116),YXSEC(116),XION(77),YION(77) DIMENSION XEXC1(98),YEXC1(98),XEXC2(76),YEXC2(76),XEXC3(67) DIMENSION YEXC3(67),XEXC4(62),YEXC4(62),XEL(108),YEL(108) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/0.00,.001,.005,.007,0.01,.015,0.02,.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.10,0.12,0.14,0.17,0.20,0.25, /0.27,0.30,0.32,0.35,0.37,0.40,0.42,0.44,0.46,0.48, /0.50,0.51,0.52,0.53,0.54,0.55,0.56,0.57,0.58,0.59, /0.60,0.61,0.62,0.63,0.64,0.65,0.66,0.67,0.68,0.69, /0.70,.715,0.73,0.75,0.77,0.80,0.83,0.85,0.87,0.90, /1.00,1.08,1.14,1.20,1.30,1.40,1.50,1.70,2.00,2.50, /3.00,3.50,4.00,4.50,5.00,5.50,6.00,6.50,7.00,8.00, /9.00,10.0,12.0,15.0,18.0,20.0,25.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,125.,150.,200.,250.,300., /400.,500.,600.,700.,800.,1000.,1500.,2000.,3000.,4000., /5000.,6000.,8000.,10000.,20000.,200000./ DATA YXSEC/131.,115.,97.0,91.1,83.9,74.6,67.3,61.2,56.1,47.9, /41.4,36.2,31.8,28.2,22.5,18.1,14.8,11.1,8.36,5.33, /4.47,3.43,2.88,2.22,1.86,1.43,1.20,1.01,.844,.708, /.596,.548,.504,.465,.430,.399,.372,.348,.328,.310, /.296,.285,.276,.270,.266,.265,.266,.270,.276,.287, /.306,.341,.377,.427,.479,.562,.651,.713,.778,.880, /1.26,1.62,1.92,2.25,2.85,3.51,4.22,5.73,7.97,11.8, /15.8,20.4,24.4,28.0,30.7,31.5,32.3,31.6,31.0,27.5, /22.8,18.5,14.0,9.71,7.73,6.72,5.35,4.43,3.42,2.81, /2.42,2.17,2.00,1.89,1.80,1.73,1.65,1.34,1.15,1.05, /0.95,0.86,0.75,0.69,0.63,0.56,0.37,0.29,0.21,0.16, /0.13,0.12,.087,.073,.037,.006/ C ELASTIC TOTAL DATA XEL/0.00,.001,.005,.007,0.01,.015,0.02,.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.10,0.12,0.14,0.17,0.20,0.25, /0.27,0.30,0.32,0.35,0.37,0.40,0.42,0.44,0.46,0.48, /0.50,0.51,0.52,0.53,0.54,0.55,0.56,0.57,0.58,0.59, /0.60,0.61,0.62,0.63,0.64,0.65,0.66,0.67,0.68,0.69, /0.70,0.75,0.80,0.85,0.90,1.00,1.20,1.50,1.75,2.00, /2.50,2.75,3.00,3.75,4.00,4.50,5.00,5.50,6.00,6.50, /7.00,8.00,9.00,10.0,12.0,15.0,18.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150.,200., /250.,300.,400.,500.,600.,700.,800.,1000.,1500.,2000., /3000.,4000.,5000.,6000.,8000.,10000.,20000.,200000./ DATA YEL/131.,117.,101.,95.4,88.8,80.1,73.3,67.5,62.6,54.7, /48.4,43.2,38.8,35.2,29.4,24.7,21.2,17.1,14.0,10.3, /9.10,7.75,6.94,5.95,5.40,4.50,4.25,3.95,3.65,3.45, /3.20,3.11,3.00,2.90,2.79,2.69,2.59,2.48,2.37,2.25, /2.14,2.02,1.92,1.80,1.69,1.58,1.48,1.40,1.32,1.28, /1.26,1.24,1.30,1.45,1.50,1.87,2.80,4.76,6.68,8.85, /13.7,16.3,18.7,24.5,29.0,32.7,36.8,39.3,41.7,41.7, /41.8,41.8,40.9,39.9,37.3,34.1,32.2,30.6,21.9,13.9, /8.24,6.60,5.73,5.40,5.33,5.18,5.00,4.70,4.65,4.62, /4.49,4.28,4.02,3.68,3.49,3.23,2.98,2.73,2.19,1.87, /1.51,1.28,1.15,1.03,0.86,0.76,0.46,0.11/ C IONISATION DATA XION/12.13,12.5,13.0,13.5,14.0,14.5,15.0,15.5,16.0,16.5, /17.0,18.0,19.0,20.0,21.0,22.0,23.0,24.0,26.0,28.0, /30.0,32.0,34.0,36.0,40.0,45.0,50.0,55.0,60.0,65.0, /70.0,80.0,90.0,100.,110.,120.,130.,140.,150.,160., /180.,200.,250.,300.,350.,400.,450.,500.,550.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,3500.,4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000., /10000.,12000.,14000.,16000.,18000.,20000.,200000./ DATA YION/0.00,.090,.236,.394,.559,.730,.906,1.09,1.27,1.42, /1.58,1.85,2.11,2.35,2.56,2.82,3.02,3.21,3.49,3.71, /3.93,4.15,4.30,4.42,4.60,4.82,4.96,5.08,5.19,5.24, /5.28,5.32,5.41,5.53,5.61,5.59,5.53,5.41,5.31,5.16, /4.91,4.71,4.29,3.96,3.66,3.40,3.19,3.01,2.81,2.67, /2.44,2.22,2.05,1.92,1.68,1.48,1.37,1.23,1.14,.974, /.842,.742,.668,.607,.560,.519,.485,.426,.385,.349, /.321,.275,.244,.220,.202,.188,.0155/ C EXCITATION DATA XEXC1/8.315,8.35,8.40,8.45,8.50,8.55,8.60,8.65,8.70,8.75, /8.80,8.85,8.90,8.95,9.00,9.05,9.10,9.15,9.20,9.25, /9.30,9.35,9.40,9.45,9.50,9.55,9.60,9.65,9.70,9.75, /9.80,9.90,10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0, /15.0,16.0,18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,90.0,100.,120.,140.,160., /180.,200.,240.,280.,320.,360.,400.,450.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,2000.,2400.,2800., /3200.,3600.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000., /15000.,20000.,30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC1/0.00,.0116,.024,.027,.026,.029,.0346,.040,.0458,.0516, /.0584,.0670,.079,.093,.106,.115,.116,.112,.108,.106, /.107,.115,.125,.144,.206,.240,.214,.168,.146,.144, /.147,.156,.164,.178,.192,.206,.232,.288,.336,.387, /.425,.459,.512,.552,.581,.602,.616,.624,.629,.634, /.629,.590,.571,.538,.509,.480,.456,.413,.374,.350, /.326,.307,.269,.245,.221,.206,.192,.173,.158,.139, /.125,.110,.101,.0917,.080,.0706,.063,.053,.046,.040, /.0360,.033,.0302,.0274,.025,.0216,.019,.017,.015,.013, /.0101,.0082,.006,.005,.0035,.003,.0025,.0017/ DATA XEXC2/9.447,9.45,9.50,9.55,9.60,9.65,9.70,9.75,9.80,9.90, /10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0,15.0,16.0, /18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,120.,140.,160.,180.,200., /240.,280.,320.,360.,400.,450.,500.,600.,700.,800., /900.,1000.,1200.,1400.,1600.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000.,15000.,20000., /30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC2/0.00,.0035,.0108,.0158,.0157,.015,.0176,.027,.037,.063, /.0884,.134,.177,.214,.277,.392,.461,.504,.530,.544, /.557,.555,.547,.538,.526,.515,.503,.475,.450,.408, /.374,.346,.323,.302,.284,.255,.232,.214,.199,.185, /.164,.148,.134,.124,.114,.106,.097,.0851,.0756,.0684, /.0624,.0575,.0499,.0442,.0397,.0332,.0287,.0252,.0227,.0206, /.0189,.0172,.0157,.0135,.0119,.0107,.0097,.00884,.00632,.00499, /.00359,.00286,.00210,.00171,.00146,.00097/ DATA XEXC3/9.917,10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0,15.0, /16.0,18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /50.0,60.0,70.0,80.0,90.0,100.,120.,140.,160.,180., /200.,240.,280.,320.,360.,400.,450.,500.,600.,700., /800.,900.,1000.,1200.,1400.,1600.,2000.,2400.,2800.,3200., /3600.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000.,15000., /20000.,30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC3/0.00,.000005,.0389,.118,.190,.315,.615,.810,.939,1.03, /1.08,1.14,1.17,1.17,1.16,1.15,1.13,1.11,1.07,1.02, /.930,.858,.800,.745,.701,.661,.596,.544,.501,.466, /.435,.386,.348,.318,.292,.271,.249,.230,.202,.180, /.162,.149,.137,.119,.106,.0947,.0792,.0684,.0605,.0541, /.0492,.0451,.0410,.0375,.0324,.0284,.0254,.0231,.0212,.0152, /.0120,.00861,.00686,.00504,.00409,.00351,.00233/ DATA XEXC4/11.70,12.0,13.0,14.0,15.0,16.0,18.0,20.0,22.0,24.0, /26.0,28.0,30.0,35.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.,120.,140.,160.,180.,200.,240.,280.,320.,360., /400.,450.,500.,600.,700.,800.,900.,1000.,1200.,1400., /1600.,2000.,2400.,2800.,3200.,3600.,4000.,4500.,5000.,6000., /7000.,8000.,9000.,10000.,15000.,20000.,30000.,40000.,60000.,8E4, /100000.,200000./ DATA YEXC4/0.00,.00194,.0299,.0776,.134,.194,.308,.410,.494,.564, /.622,.668,.705,.767,.801,.820,.807,.784,.756,.727, /.698,.645,.598,.558,.523,.492,.442,.400,.367,.340, /.316,.291,.271,.237,.212,.192,.176,.162,.141,.125, /.112,.0946,.0818,.0722,.0648,.0589,.0540,.0492,.0450,.0388, /.0342,.0306,.0277,.0254,.0182,.0144,.0104,.00828,.00608,.00494, /.00424,.00281/ C NAME='Xe (2003 anis.)' C C -------------------------------------------------------------------- C DATA ON XENON NOT AS GOOD AS ARGON . USED MOMENTUM TRANSFER C X-SECTION FROM SCHMIDT. AND FIT TO TOWNSEND COEFFICIENT OF C JACQUES ET AL J.PHYS D 19 (1986) 1731-1739 AND KRUITHOF TO OBTAIN C INELASTIC X-SECTIONS. C -------------------------------------------------------------------- C C NIN=4 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C USE ANISOTROPIC ELASTIC SCATTERING AND COPY (OFFSET) TO IONISATION KEL(2)=1 C NDATA=116 NEL=108 NION=77 NEXC1=98 NEXC2=76 NEXC3=67 NEXC4=62 E(1)=0.0 E(2)=2.0*EMASS/(131.30*AMU) E(3)=12.13 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=8.7 IOFF=INT(0.5+E(3)/ESTEP) EIN(1)=8.315 EIN(2)=9.447 EIN(3)=9.917 EIN(4)=11.70 SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) XENON ' SCRPT(3)=' IONISATION ELOSS= 12.13 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC ELOSS= 8.315 ' SCRPT(8)=' EXC ELOSS= 9.447 ' SCRPT(9)=' EXC ELOSS= 9.917 ' SCRPT(10)=' EXC ELOSS= 11.70 ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.LE.XEN(2)) THEN QELA=122.D-16 QMOM=122.D-16 GO TO 200 ENDIF DO 110 J=2,NEL IF(EN.LE.XEL(J)) GO TO 120 110 CONTINUE J=NEL 120 YXJ=LOG(YEL(J)) YXJ1=LOG(YEL(J-1)) XNJ=LOG(XEL(J)) XNJ1=LOG(XEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=EXP(A*LOG(EN)+B)*1.D-16 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=EXP(A*LOG(EN)+B)*1.D-16 200 CONTINUE PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISTRIBUTION SAME AS ELASTIC AT ENERGY OFF SET BY C IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 230 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C 230 Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C QIN(1,I)=0.0D0 IF(EN.LE.EIN(1)) GO TO 370 DO 350 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 360 350 CONTINUE J=NEXC1 360 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(1,I)=(A*EN+B)*1.0D-16 370 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 470 DO 450 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 460 450 CONTINUE J=NEXC2 460 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(2,I)=(A*EN+B)*1.0D-16 470 CONTINUE QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 570 DO 550 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 560 550 CONTINUE J=NEXC3 560 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 570 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 670 DO 650 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 660 650 CONTINUE J=NEXC4 660 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 670 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) 900 CONTINUE IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 END +DECK,GAS50. SUBROUTINE GAS50(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(32),YXSEC(32),XVIB3(14),YVIB3(14),XVIB4(16), /YVIB4(16),XVIB6(16),YVIB6(16),XEXC(33),YEXC(33),XION(52),YION(52), /XATT(13),YATT(13) CHARACTER*15 NAME CHARACTER*30 SCRPT(226) DATA XEN/1.D-6,.001,0.01,0.10,1.00,1.50,2.00,3.00,4.00,5.00, /7.00,9.00,10.0,15.0,20.0,30.0,35.0,50.0,60.0,75.0, /100.,150.,200.,300.,500.,700.,1000.,2000.,4000.,10000., /20000.,100000./ DATA YXSEC/1.63D4,1.63D4,1630.,163.,16.3,11.5,10.5,9.50,9.50,10.0, /11.0,11.0,10.8,10.5,10.0,9.50,8.40,6.50,5.50,4.60, /3.54,2.55,1.63,0.96,0.54,0.36,0.23,0.10,0.05,0.02, /0.01,.002/ C VIBRATION V5 + V2 + V4 (RESONANCE ONLY) DATA XVIB3/0.1429,4.00,4.70,5.70,6.70,7.70,9.50,15.0,20.0,50.0, /100.,1000.,10000.,100000./ DATA YVIB3/0.0,0.0,.109,.952,1.43,1.22,0.79,.068,.023,.0001, /.00001,.000001,.0000001,.00000001/ C VIBRATION HARMONIC 2(V5) DATA XVIB4/0.2858,1.00,3.00,3.70,4.70,5.70,6.70,7.70,9.50,15.0, /20.0,50.0,100.0,1000.,10000.,100000./ DATA YVIB4/0.0,.001,.005,0.02,0.03,0.23,0.35,0.30,0.20,.016, /.006,.0003,.00001,.000001,.0000001,.00000001/ C VIBRATION HARMONIC (3(V5) + ALL OTHER HARMONICS) DATA XVIB6/0.4287,1.00,3.00,3.70,4.70,5.70,6.70,7.70,9.50,15.0, /20.0,50.0,100.,1000.,10000.,100000./ DATA YVIB6/0.0,.001,0.04,0.08,0.12,0.92,1.40,1.20,0.80,.064, /.020,.0004,.00004,.000004,.0000004,.00000004/ DATA XION/13.86,14.0,15.0,16.0,17.0,18.0,20.0,22.0,24.0,26.0, /28.0,30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,60.0,70.0,80.0,90.0,100.,125.,150.,175.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000.,10000.,20000., /40000.,100000./ DATA YION/0.0,.031,.072,.123,.184,.266,.431,.590,.843,1.07, /1.27,1.46,1.65,1.83,1.96,2.14,2.34,2.50,2.68,2.93, /3.07,3.57,3.95,4.28,4.42,4.61,4.78,4.75,4.78,4.59, /4.30,4.13,3.88,3.65,3.45,3.16,2.80,2.55,2.35,2.14, /2.01,1.70,1.48,1.35,1.21,1.04,0.89,0.63,0.40,.230, /.127,.065/ DATA XATT/1.00,2.50,4.00,6.00,7.00,8.00,9.00,10.0,11.0,12.0, /14.0,100.,10000./ DATA YATT/0.00,0.04,0.17,0.17,0.07,0.07,0.56,2.26,1.30,0.67, /0.01,.0001,.000001/ C DISOCIATION X-SECTION EXCLUDING DISOCIATIVE IONISATION X-SECTION DATA XEXC/10.7,11.0,12.0,13.0,14.0,16.0,18.0,23.0,28.0,33.0, /38.0,43.0,48.0,60.0,70.0,80.0,100.,120.,140.,160., /180.,200.,250.,300.,400.,500.,600.,1000.,2000.,4000., /10000.,20000.,100000./ DATA YEXC/0.0,0.05,0.21,0.37,0.57,0.87,1.10,1.42,1.52,1.57, /1.60,1.63,1.62,1.61,1.60,1.60,1.59,1.57,1.55,1.52, /1.49,1.45,1.37,1.27,1.10,0.92,0.80,0.53,0.31,0.18, /0.09,0.05,.013/ C ---------------------------------------------------------------- C DATA ON DRIFT VELOCITY AND TOWNSEND IN PURE GAS C : P.REV. E 60 (1999) 4990 C ALSO CLARK ET AL IN ABOVE REF. C ARGON MIXTURE DATA IN : CHEM. PHYS.LETT. 304(1999) 303 C C --------------------------------------------------------------- C NAME='CHF3 (2001)' C NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=32 NVIB3=14 NVIB4=16 NVIB6=16 NION=52 NATT=13 NEXC=33 E(1)=0.0 E(2)=2.0*EMASS/(70.0138*AMU) E(3)=13.86 E(4)=0.0 E(5)=0.0 E(6)=0.0 C SET OPAL AND BEATY ENERGY SPLITTING TO EION EOBY=E(3) EIN(1)=-0.035 EIN(2)=0.035 EIN(3)=-0.063 EIN(4)=0.063 EIN(5)=0.1429 EIN(6)=0.2858 EIN(7)=0.3764 EIN(8)=0.4287 EIN(9)=10.7 APOPR=EXP(EIN(1)/AKT) APOPV=EXP(EIN(3)/AKT) SCRPT(1)=' ' SCRPT(2)=' ELASTIC CHF3 ' SCRPT(3)=' IONISATION ELOSS= 13.86 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT ELOSS= -0.035 ' SCRPT(8)=' ROT ELOSS= 0.035 ' SCRPT(9)=' VIB63 ELOSS= -0.063 ' SCRPT(10)=' VIB63 ELOSS= 0.063 ' SCRPT(11)=' VIB524 ELOSS= 0.1429 ' SCRPT(12)=' VIB1 ELOSS= 0.2858 ' SCRPT(13)=' VIB HAR ELOSS= 0.3764 ' SCRPT(14)=' VIB HAR ELOSS= 0.4287 ' SCRPT(15)=' EXC (DISOCTN) ELOSS= 10.7 ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) Q(2,I)=16300.D-16 IF(EN.EQ.0.0) GO TO 30 DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA C USE LOG INTERPOLATION 20 Y1=LOG(YXSEC(J-1)) Y2=LOG(YXSEC(J)) X1=LOG(XEN(J-1)) X2=LOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=EXP((A*LOG(EN)+B))*1.0D-16 C 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC EFFECTIVE ROTATION C QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 305 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.100*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOPR/(1.0+APOPR)*1.D-16 C C EFFECTIVE ROTATION 305 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 350 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.100*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)*1.0/(1.0+APOPR)*1.D-16 350 CONTINUE C C SUPERELASTIC OF VIBRATION V6 + V3 C QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 365 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.152*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(3,I)=QIN(3,I)*APOPV/(1.0+APOPV)*1.D-16 C C VIB V6 + V3 365 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.152*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=QIN(4,I)*1.0/(1.0+APOPV)*1.D-16 400 CONTINUE C C V5 + V2 + V4 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.748*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(5,I)=((A*EN+B)+QIN(5,I))*1.D-16 500 CONTINUE C 2V5 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(6,I)=(A*EN+B)*1.D-16 600 CONTINUE C V1 QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 EFAC=SQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.421*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(7,I)=QIN(7,I)*1.D-16 700 CONTINUE C HIGHER HARMONICS QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(8,I)=(A*EN+B)*1.D-16 800 CONTINUE C EXCITATION (DISOCIATION) QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(9,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS51. SUBROUTINE GAS51(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEL(30),YEL(30),XVIBH(16),YVIBH(16), /XEXC(31),YEXC(31),XION(40),YION(40) CHARACTER*15 NAME CHARACTER*30 SCRPT(226) DATA XEL/1.D-6,.001,0.01,0.10,0.40,0.60,0.80,1.00,1.40,2.00, /3.00,5.00,7.50,10.0,14.0,20.0,30.0,50.0,75.0,100., /150.,200.,400.,700.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YEL/2800.,2800.,280.,28.0,7.00,5.50,5.00,5.00,6.00,7.00, /9.00,11.5,15.5,18.0,18.0,17.0,14.0,10.0,8.00,6.00, /4.00,3.00,1.45,0.90,0.65,0.30,0.15,0.05,0.02,.004/ C VIBRATION HARMONIC 2(V3) DATA XVIBH/0.30,1.00,3.00,3.70,4.70,5.70,6.70,7.70,9.50,15.0, /20.0,50.0,100.0,1000.,10000.,100000./ DATA YVIBH/0.00,.005,.025,0.10,0.25,1.15,1.75,1.50,1.00,.080, /.030,.0015,.00005,.000005,.0000005,.00000005/ DATA XION/11.40,12.0,13.0,14.0,16.0,18.0,20.0,22.0,24.0,26.0, /30.0,34.0,38.0,42.0,46.0,50.0,60.0,70.0,80.0,90.0, /100.,125.,150.,175.,200.,250.,300.,400.,500.,600., /800.,1000.,1500.,2000.,2500.,3000.,5000.,10000.,20000.,100000./ DATA YION/0.00,0.04,0.13,0.25,0.40,0.66,1.00,1.30,1.70,2.05, /2.45,2.85,3.30,3.80,4.30,4.60,5.35,5.90,6.40,6.60, /6.80,7.00,7.05,7.00,6.90,6.45,6.20,5.50,4.75,4.20, /3.55,3.05,2.25,1.85,1.60,1.35,0.95,0.60,0.35,0.10/ C DISOCIATION X-SECTION EXCLUDING DISOCIATIVE IONISATION X-SECTION DATA XEXC/8.70,9.00,10.0,11.0,12.0,14.0,16.0,21.0,26.0,31.0, /36.0,40.0,50.0,70.0,100.,120.,140.,160.,180.,200., /250.,300.,400.,500.,600.,1000.,2000.,4000.,10000.,20000., /100000./ DATA YEXC/0.0,0.07,0.32,0.56,0.85,1.35,1.65,2.15,2.30,2.35, /2.40,2.45,2.45,2.43,2.41,2.39,2.35,2.30,2.25,2.20, /2.05,1.90,1.65,1.40,1.20,0.80,0.46,0.27,0.14,0.07, /.020/ C ---------------------------------------------------------------- C SCALED X-SECTIONS FROM SYSTEMATICS AND USED ATTACHMENT X-SECTION C FROM ALAJAJIAN ET AL : J.PHYS B21(1988) 4021 C AND NORMALISED TO MCCORKLE (1987) AND SPYROU ET AL C --------------------------------------------------------------- C NAME='CF3Br (2002)' C NIN=7 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NEL=30 NVIBH=16 NION=40 NEXC=31 E(1)=0.0 E(2)=2.0*EMASS/(148.90991*AMU) E(3)=11.40 E(4)=0.0 E(5)=0.0 E(6)=0.0 C SET OPAL AND BEATY ENERGY SPLITTING TO EION EOBY=E(3) EIN(1)=-0.050 EIN(2)=0.050 EIN(3)=-0.1345 EIN(4)=0.1345 EIN(5)=0.1499 EIN(6)=0.30 EIN(7)=8.7 APOPV1=EXP(EIN(1)/AKT) APOPV2=EXP(EIN(3)/AKT) SCRPT(1)=' ' SCRPT(2)=' ELASTIC CF3BR ' SCRPT(3)=' IONISATION ELOSS= 11.40 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB1 ELOSS= -0.050 ' SCRPT(8)=' VIB1 ELOSS= 0.050 ' SCRPT(9)=' VIB2 ELOSS= -0.1345 ' SCRPT(10)=' VIB2 ELOSS= 0.1345 ' SCRPT(11)=' VIB3 ELOSS= 0.1499 ' SCRPT(12)=' VIB HAR ELOSS= 0.30 ' SCRPT(13)=' EXC ELOSS= 8.7 ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) Q(2,I)=2800.D-16 IF(EN.EQ.0.0) GO TO 30 DO 10 J=2,NEL IF(EN.LE.XEL(J)) GO TO 20 10 CONTINUE J=NEL C USE LOG INTERPOLATION 20 Y1=LOG(YEL(J-1)) Y2=LOG(YEL(J)) X1=LOG(XEL(J-1)) X2=LOG(XEL(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=EXP((A*LOG(EN)+B))*1.0D-16 C 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 100 DO 40 J=2,NION IF(EN.LE.XION(J)) GO TO 50 40 CONTINUE J=NION 50 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 100 Q(4,I)=0.0D0 IF(EN.EQ.0.0.OR.EN.GT.2.0) GO TO 200 C FUNCTIONAL FORM OF ATTACHMENT FROM J.PHYS.B 21(1988) 4021 AT1=0.0353/SQRT(EN) AT2=EXP(-EN*EN/9.D-6) AT3=EXP(-EN/0.0588) Q(4,I)=(AT1*AT2+AT3)*27.4D-16 200 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC VIBRATION V1 C QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 250 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.100*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOPV1/(1.0+APOPV1)*1.D-16 C C VIBRATION V1 C 250 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 300 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.100*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)*1.0/(1.0+APOPV1)*1.D-16 300 CONTINUE C C SUPERELASTIC OF VIBRATION V2 C QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 350 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.110*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(3,I)=QIN(3,I)*APOPV2/(1.0+APOPV2)*1.D-16 C C VIBRATION V2 350 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.110*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=QIN(4,I)*1.0/(1.0+APOPV2)*1.D-16 400 CONTINUE C C VIBRATION V3 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.750*LOG((1.0+EFAC)/(1.0-EFAC))/EN*1.D-16 500 CONTINUE C C VIBRATION HARMONIC 2V3 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 520 510 CONTINUE J=NVIBH 520 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(6,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 620 610 CONTINUE J=NEXC 620 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS52. SUBROUTINE GAS52(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XENM(56),YXMOM(56),XENT(56),YXTOT(56), /XVIB2(22),YVIB2(22),XVIB3(22),YVIB3(22),XVIB4(22),YVIB4(22), /XVIB5(22),YVIB5(22),XVIB6(22),YVIB6(22),YATT1(23), /XDISS(27),YDISS(27),XATT(23),YATT(23),XION(50),YION(50) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XENM/0.0,0.001,0.002,0.004,0.007,0.01,.015,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.0,200.,400.,1000.,10000.,100000./ C ELASTIC MOMENTUM TRANSFER DATA YXMOM/56.0,52.0,49.0,42.0,35.0,28.0,21.0,16.5,13.5,11.5, /9.20,7.40,6.10,5.20,4.20,3.90,4.00,4.40,5.20,6.40, /7.60,8.50,9.60,10.2,10.8,11.3,12.0,12.5,12.9,13.1, /13.2,13.6,14.0,14.5,15.5,16.5,17.5,18.5,19.5,20.5, /21.5,25.0,25.5,23.5,20.5,16.8,14.0,12.2,10.7,9.60, /8.50,4.50,2.20,0.85,.085,.0085/ DATA XENT/0.0,0.001,0.002,0.004,0.007,0.01,.015,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.0,200.,400.,1000.,10000.,100000./ C ELASTIC TOTAL ( NO GOOD DATA AVAILABLE) DATA YXTOT/56*0.0/ C VIBRATION V1 (RESONANCE ONLY) DATA XVIB2/0.065,1.00,1.90,2.30,3.10,3.70,4.50,5.50,6.50,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB2/0.0,.0000001,.050,.113,.353,.328,.252,.227,.328,.378, /.378,.315,.113,.050,.025,.013,.0025,.000013,.0000013,.00000013, /.000000013,.0000000013/ C VIBRATION V2 (RESONANCE ONLY) DATA XVIB3/0.100,1.00,1.90,2.30,3.10,3.70,4.50,5.50,6.50,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB3/0.0,.0000001,.315,.617,1.94,1.87,1.39,1.26,1.84,2.07, /2.03,1.73,0.63,.277,.113,.050,.025,.000005,.0000005,.00000005, /.000000005,.0000000005/ C VIBRATION V3 (RESONANCE ONLY) DATA XVIB4/0.155,1.00,1.90,2.30,3.10,3.70,4.50,5.50,6.50,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB4/0.0,.0000001,.680,1.36,4.21,4.03,3.02,2.72,4.01,4.54, /4.48,3.78,1.39,.605,.252,.126,.063,.00013,.000013,.0000013, /.00000013,.000000013/ C VIBRATION HARMONIC 2(V3) DATA XVIB5/0.35,1.00,1.90,2.30,3.10,3.70,4.50,5.50,6.50,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB5/0.0,.0000001,.243,.486,1.51,1.43,1.08,.972,1.43,1.62, /1.59,1.35,.486,.216,.081,.054,.027,.00027,.000027,.0000027, /.00000027,.000000027/ C VIBRATION HARMONIC (3(V3) + ALL OTHER HARMONICS) DATA XVIB6/0.500,1.00,1.90,2.30,3.10,3.70,4.50,5.50,6.50,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB6/0.0,.0000001,.826,1.65,5.12,4.90,3.65,3.30,4.85,5.50, /5.45,4.60,1.65,.735,.300,.160,.070,.00023,.000023,.0000023, /.00000023,.000000023/ C DISOCIATION X-SECTION DATA XDISS/11.0,12.0,13.0,14.0,15.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,300.,400.,500., /600.,800.,1000.,2000.,4000.,10000.,100000./ DATA YDISS/0.00,.005,.070,0.22,0.75,1.70,2.25,2.90,3.15,3.35, /3.45,3.50,3.60,3.60,3.60,3.55,3.50,3.35,3.25,3.08, /2.80,2.45,2.05,1.12,0.65,0.30,0.030/ C ION NISHIMURA ET AL DATA XION/13.38,16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0, /50.0,60.0,70.0,80.0,90.0,100.,125.,150.,175.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1250.,1500.,1750.,2000.,2500.,3000.,10000.,20000.,100000./ DATA YION/0.00,.129,.316,.562,.815,1.13,1.81,2.31,3.08,3.58, /4.10,4.57,5.12,5.58,5.88,6.54,7.01,7.43,7.85,8.31, /8.99,10.4,11.3,11.9,12.5,12.8,13.3,13.4,13.2,12.8, /12.1,11.2,10.5,9.80,9.31,8.61,7.80,6.99,6.41,5.82, /5.48,4.64,4.05,3.62,3.31,2.78,2.44,0.88,0.48,0.13/ C ATTACHMENT DATA XATT/0.70,0.80,1.00,1.50,1.70,2.00,2.30,2.50,2.70,3.00, /3.50,4.00,4.50,5.00,5.50,6.00,6.50,7.00,8.00,10.0, /20.0,100.0,100000./ C PRESSURE DEPENDENT ATTACHMENT X-SEC DATA YATT/.000,.003,.006,.028,.049,.092,.097,.073,.035,.026, /.021,.017,.015,.012,.008,.006,.005,.005,.005,.004, /.002,.00005,.0000005/ C DISOCIATIVE ATTACHMENT DATA YATT1/0.00,0.00,0.00,.002,.010,.026,.066,.099,.127,.103, /.055,.025,.009,.004,.004,.004,.003,.003,.002,.001, /.001,.00005,.0000005/ C --------------------------------------------------------------------- C APPROXIMATE PRESSURE DEPENDENCE OF ATTACHMENT IS INCLUDED C ALLOWS SUPERELASTIC SCATTERING TO ALL VIBRATIONAL LEVELS C EXCLUDING VIBRATION HARMONICS. C BORN ANGULAR DISTRIBUTION FOR V2(0.100) AND V3(0.155) LEVELS. C -------------------------------------------------------------------- C NAME='C3F8 (2002)' C NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C ANISOTROPIC SCATTERING FOR LEVELS 5 AND 6 KIN(5)=1 KIN(6)=1 C NDATA=56 NETOT=56 NVIB2=22 NVIB3=22 NVIB4=22 NVIB5=22 NVIB6=22 NDISS=27 NATT=23 NION=50 E(1)=0.0 E(2)=2.0*EMASS/(188.0193*AMU) E(3)=13.38 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=13.38 EIN(1)=-0.065 EIN(2)=-0.100 EIN(3)=-0.155 EIN(4)=0.065 EIN(5)=0.100 EIN(6)=0.155 EIN(7)=0.35 EIN(8)=0.500 EIN(9)=11.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC C3F8 ' SCRPT(3)=' IONISATION ELOSS= 13.38 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V1 ELOSS= -0.065 ' SCRPT(8)=' VIB V2 ELOSS= -0.100 ' SCRPT(9)=' VIB V3 ELOSS= -0.155 ' SCRPT(10)=' VIB V1 ELOSS= 0.065 ' SCRPT(11)=' VIB V2 ELOSS= 0.100 ' SCRPT(12)=' VIB V3 ELOSS= 0.155 ' SCRPT(13)=' VIB 2V3 ELOSS= 0.35 ' SCRPT(14)=' VIB ELOSS= 0.50 ' SCRPT(15)=' EXC DISOCN ELOSS= 11.0 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(2)/AKT) APOP3=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XENM(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXMOM(J)-YXMOM(J-1))/(XENM(J)-XENM(J-1)) B=(XENM(J-1)*YXMOM(J)-XENM(J)*YXMOM(J-1))/(XENM(J-1)-XENM(J)) XMOMT=(A*EN+B)*1.0D-16 DO 50 J=2,NETOT IF(EN.LE.XENT(J)) GO TO 60 50 CONTINUE J=NETOT 60 A=(YXTOT(J)-YXTOT(J-1))/(XENT(J)-XENT(J-1)) B=(XENT(J-1)*YXTOT(J)-XENT(J)*YXTOT(J-1))/(XENT(J-1)-XENT(J)) XTOT=(A*EN+B)*1.0D-16 Q(2,I)=XTOT PEQEL(2,I)=0.5+(XTOT-XMOMT)/XTOT IF(KEL(2).EQ.0) Q(2,I)=XMOMT IF(KEL(2).EQ.0) PEQEL(2,I)=0.5D0 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 250 IF(EN.GT.XATT(NATT)) GO TO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) A1=(YATT1(J)-YATT1(J-1))/(XATT(J)-XATT(J-1)) B1=(XATT(J-1)*YATT1(J)-XATT(J)*YATT1(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=((A*EN+B)+(A1*EN+B1)*TORR/2280.0)*1.D-16 250 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTICS QIN(1,I)=0.0D0 QIN(2,I)=0.0D0 QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V1 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.070*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 260 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 270 260 CONTINUE J=NVIB2 270 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C SUPERELASTIC OF VIBRATION V2 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.850*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 280 J=2,NVIB3 IF((EN+EIN(5)).LE.XVIB3(J)) GO TO 290 280 CONTINUE J=NVIB3 290 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(2,I)=QIN(2,I)+(EN+EIN(5))*(A*(EN+EIN(5))+B)/EN QIN(2,I)=QIN(2,I)*APOP2/(1.0+APOP2)*1.D-16 C SUPERELASTIC OF VIBRATION V3 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=1.600*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 300 J=2,NVIB4 IF((EN+EIN(6)).LE.XVIB4(J))GO TO 301 300 CONTINUE J=NVIB4 301 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(3,I)=QIN(3,I)*APOP3/(1.0+APOP3)*1.D-16 C 305 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.070*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=((A*EN+B)+QIN(4,I))*1.0/(1.0+APOP1)*1.D-16 400 CONTINUE C QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.850*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(5) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM.T /TOT X-SECT FOR RESONANCE PART = RAT3 RAT3=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(5,I)+RAT3*(A*EN+B))*1.0D-16 XMT=XMT/(1.0+APOP2) QIN(5,I)=((A*EN+B)+QIN(5,I))*1.0/(1.0+APOP2)*1.D-16 PEQIN(5,I)=0.5+(QIN(5,I)-XMT)/QIN(5,I) 500 CONTINUE C QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=1.600*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(6,I)+RAT4*(A*EN+B))*1.0D-16 XMT=XMT/(1.0+APOP3) QIN(6,I)=((A*EN+B)+QIN(6,I))*1.0/(1.0+APOP3)*1.D-16 PEQIN(6,I)=0.5+(QIN(6,I)-XMT)/QIN(6,I) 600 CONTINUE C QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(8,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NDISS IF(EN.LE.XDISS(J)) GO TO 820 810 CONTINUE J=NDISS 820 A=(YDISS(J)-YDISS(J-1))/(XDISS(J)-XDISS(J-1)) B=(XDISS(J-1)*YDISS(J)-XDISS(J)*YDISS(J-1))/(XDISS(J-1)-XDISS(J)) QIN(9,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS53. SUBROUTINE GAS53(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(30),YXSEC(30),XION(104),YION(104), /XVIB1(18),YVIB1(18),XVIB2(18),YVIB2(18),XVIB3(16),YVIB3(16), /XVIB4(16),YVIB4(16),XVIB5(16),YVIB5(16), /XEXC1(15),YEXC1(15),XEXC2(14),YEXC2(14),XEXC3(15),YEXC3(15), /XATT(25),YAT1(25),YAT2(25) CHARACTER*15 NAME CHARACTER*30 SCRPT(226) DATA XEN/1.D-6,.001,0.01,0.10,0.20,0.40,0.70,1.00,2.00,3.00, /4.00,5.00,6.00,7.00,8.00,10.0,15.0,20.0,30.0,50.0, /100.,200.,300.,600.,1000.,2000.,3000.,6000.,10000.,100000./ DATA YXSEC/3000.,1500.,150.,19.0,14.0,12.0,12.0,12.0,12.0,12.0, /12.0,12.0,12.0,12.0,12.0,12.0,11.5,11.0,10.0,7.40, /4.70,1.99,1.16,0.41,.185,.058,.028,.0081,.0031,.0003/ C VIBRATION V2 BEND MODE C RESONANCE ONLY , DIPOLE ANALYTICAL DATA XVIB1/.0869,0.50,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,12.0,15.0,100.,1000.,100000./ DATA YVIB1/0.00,.0005,.001,.005,.010,0.12,.265,0.24,0.13,0.07, /0.03,0.02,0.01,.001,.0001,.00001,.000001,.0000001/ C VIBRATION SUM OF V1 AND V3 STRETCH MODES C RESONANCE ONLY , DIPOLE ANALYTICAL DATA XVIB2/.1292,0.50,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,12.0,14.0,100.,1000.,100000./ DATA YVIB2/0.00,0.01,0.015,0.02,0.05,0.43,0.83,0.74,0.56,0.44, /0.25,0.14,0.05,0.01,.001,.0001,.00001,.000001/ C VIBRATION HARMONIC (V12 AND V23 ) DATA XVIB3/0.2161,1.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,12.0,20.0,100.,1000.,100000./ DATA YVIB3/0.00,.001,0.01,.077,.165,.140,.068,.034,.022,.020, /.020,.010,.005,.001,.0001,.000001/ C VIBRATION HARMONIC (V13 2V1 AND 2V3) DATA XVIB4/0.2660,1.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,12.0,20.0,100.,1000.,100000./ DATA YVIB4/0.00,.003,0.04,.140,.278,.271,.238,.210,.140,.075, /.029,.010,.005,.001,.0001,.000001/ C VIBRATION HARMONIC ( SUM OF HIGHER HARMONICS ) DATA XVIB5/0.38,1.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,12.0,20.0,100.,1000.,100000./ DATA YVIB5/0.00,.001,0.02,.070,.139,.135,.119,.105,.070,.038, /.014,.005,.002,.001,.0001,.000001/ DATA XION/12.75,13.0,13.5,14.0,14.5,15.0,15.5,16.0,16.5,17.0, /17.5,18.0,18.5,19.0,19.5,20.0,20.5,21.0,21.5,22.0, /22.5,23.0,23.5,24.0,26.0,28.0,30.0,32.0,34.0,36.0, /38.0,40.0,45.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0, /85.0,90.0,95.0,100.,105.,110.,115.,120.,125.,130., /135.,140.,145.,150.,160.,170.,180.,190.,200.,210., /220.,230.,240.,250.,300.,350.,400.,450.,500.,550., /600.,650.,700.,750.,800.,850.,900.,950.,1000.,1100., /1250.,1500.,1750.,2000.,2250.,2500.,2750.,3000.,3250.,3500., /3750.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000.,15000., /20000.,30000.,50000.,100000./ DATA YION/0.00,.011,.035,.059,.083,.118,.162,.216,.270,.324, /.378,.431,.484,.535,.586,.636,.685,.732,.779,.824, /.869,.921,.975,1.03,1.25,1.46,1.66,1.84,2.01,2.17, /2.31,2.44,2.72,2.95,3.14,3.30,3.42,3.52,3.60,3.66, /3.71,3.74,3.77,3.78,3.79,3.80,3.80,3.79,3.78,3.77, /3.76,3.74,3.72,3.70,3.66,3.61,3.56,3.51,3.46,3.41, /3.35,3.30,3.25,3.20,2.97,2.76,2.57,2.41,2.27,2.14, /2.03,1.93,1.84,1.76,1.68,1.62,1.55,1.50,1.44,1.35, /1.23,1.07,.950,.856,.780,.717,.664,.619,.580,.546, /.516,.489,.443,.406,.348,.305,.272,.246,.225,.158, /.123,.086,.054,.029/ C DISOCIATIVE ATTACHMENT : O3 + E- = O2 + O- DATA XATT/0.00,0.20,0.40,0.60,0.80,1.00,1.20,1.40,1.60,1.80, /2.00,2.40,2.60,3.00,3.50,4.00,5.00,6.00,7.00,7.50, /8.00,9.00,10.0,20.0,100000./ DATA YAT1/0.00,.032,.070,0.14,0.22,0.29,0.36,0.37,0.36,0.26, /0.21,0.12,0.10,0.09,0.08,0.06,0.02,0.02,0.05,0.07, /0.05,0.01,.005,.001,.00000001/ C DISOCIATIVE ATTACHMENT : O3 + E- = O + O2- DATA YAT2/0.00,0.00,0.00,0.01,0.08,0.13,0.17,0.15,0.11,.055, /.025,.006,.005,.002,.002,.0015,.001,.002,.003,.003, /.0025,.001,.0005,.0001,.00000001/ C CHAPPUIS BAND DATA XEXC1/1.50,2.00,3.00,4.00,5.00,6.00,8.00,10.0,12.0,14.0, /20.0,40.0,100.,1000.,100000./ DATA YEXC1/0.00,0.01,0.04,0.12,0.12,0.10,0.08,0.06,0.05,0.04, /0.02,0.01,.004,.0004,.000004/ C HARTLEY BAND DATA XEXC2/4.85,6.00,7.00,8.00,9.00,10.0,12.0,14.0,16.0,20.0, /40.0,100.,1000.,100000./ DATA YEXC2/0.00,0.26,0.63,0.75,0.68,0.65,0.58,0.47,0.37,0.27, /0.13,0.05,.005,.000005/ C SUM OF OTHER STATES HIGHER THAN 9.0 EV DATA XEXC3/9.00,10.0,12.0,14.0,16.0,18.0,20.0,40.0,100.,150., /200.,400.,1000.,10000.,100000./ DATA YEXC3/0.00,0.52,1.50,1.50,1.40,1.40,1.20,1.00,0.80,0.70, /0.60,0.30,0.12,.012,.0012/ C --------------------------------------------------------------------- C OZONE C USED BEB (THEORETICAL VALUES) FOR IONIZATION X-SECTION C VIB.RESONANCES: ALLAN ET AL J. PHYS. B 29(1996)4727 C ATTACHMENT: RANGWALA ET AL J. PHYS. B 32(1999)3795 C EXCITATION: ALLEN ET AL J.CHEM.PHYS.105(1996)5665 C ELASTIC : SHYN AND SWEENEY PHYS REV 47A (1993)2919 C GULLEY ET AL J. PHYS. B 31 (1998)5197 C PABLOS ET AL J. PHYS. B 35 (2002)865 C GOOD FIT TO EXPERIMENTAL ATTACHMENT RATE MEASUREMENTS : C STELMAN,MORUZZI AND PHELPS J.CHEM.PHYS 56(1972)4183 C N.B. ATTACHMENT RATE MEASUREMENTS OF PHELPS NEED TO BE CORRECTED C FOR DETACHMENT COLLISIONS . CORRECTION FACTOR TAKEN FROM C KLOPOVSKII ET AL PLASMA PHYSICS REPORTS 23(1997) 165-171 C --------------------------------------------------------------------- C NAME='O3 (2002)' C NIN=11 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=30 NVIB1=18 NVIB2=18 NVIB3=16 NVIB4=16 NVIB5=16 NION=104 NATT=25 NEXC1=15 NEXC2=14 NEXC3=15 E(1)=0.0 E(2)=2.0*EMASS/(47.9982*AMU) E(3)=12.75 E(4)=0.0 E(5)=0.0 E(6)=0.0 C SET OPAL AND BEATY ENERGY SPLITTING TO EION EOBY=E(3) EIN(1)=-0.005 EIN(2)=0.005 EIN(3)=-0.0869 EIN(4)=0.0869 EIN(5)=0.1292 EIN(6)=0.2161 EIN(7)=0.2660 EIN(8)=0.380 EIN(9)=1.50 EIN(10)=4.85 EIN(11)=9.00 APOPR=EXP(EIN(1)/AKT) APOPV=EXP(EIN(3)/AKT) SCRPT(1)=' ' SCRPT(2)=' ELASTIC OZONE ' SCRPT(3)=' IONISATION ELOSS= 12.75 ' SCRPT(4)=' DISOCIATIVE ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT ELOSS= -0.005 ' SCRPT(8)=' ROT ELOSS= 0.005 ' SCRPT(9)=' VIB2 BEND ELOSS= -0.0869 ' SCRPT(10)=' VIB2 BEND ELOSS= 0.0869 ' SCRPT(11)=' VIB3+VIB1 ELOSS= 0.1292 ' SCRPT(12)=' V12+V23 ELOSS= 0.2161 ' SCRPT(13)=' V13+2V1+2V3 ELOSS= 0.2660 ' SCRPT(14)=' SUM HIGH VIB ELOSS= 0.380 ' SCRPT(15)=' EXC CHAPPUIS ELOSS= 1.50 ' SCRPT(16)=' EXC HARTLEY ELOSS= 4.85 ' SCRPT(17)=' EXC ELOSS= 9.00 ' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) Q(2,I)=3000.D-16 IF(EN.EQ.0.0) GO TO 30 DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA C USE LOG INTERPOLATION 20 Y1=LOG(YXSEC(J-1)) Y2=LOG(YXSEC(J)) X1=LOG(XEN(J-1)) X2=LOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=EXP((A*LOG(EN)+B))*1.0D-16 C 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C SUM OF DISOCIATIVE ATTACHMENTS TO O- AND O2- 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A1=(YAT1(J)-YAT1(J-1))/(XATT(J)-XATT(J-1)) B1=(XATT(J-1)*YAT1(J)-XATT(J)*YAT1(J-1))/(XATT(J-1)-XATT(J)) A2=(YAT2(J)-YAT2(J-1))/(XATT(J)-XATT(J-1)) B2=(XATT(J-1)*YAT2(J)-XATT(J)*YAT2(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=((A1+A2)*EN+B1+B2)*1.D-16 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC EFFECTIVE ROTATION C QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 305 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.450*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOPR/(1.0+APOPR)*1.D-16 C C EFFECTIVE ROTATION 305 CONTINUE QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 350 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.450*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)*1.0/(1.0+APOPR)*1.D-16 350 CONTINUE C C SUPERELASTIC VIBRATION V2 (BEND MODE) C QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 365 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.0133*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(3,I)=QIN(3,I)*APOPV/(1.0+APOPV)*1.D-16 C C VIBRATION V2 (BEND MODE) 365 CONTINUE QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 DO 370 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 380 370 CONTINUE J=NVIB1 380 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0133*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=(A*EN+B)+QIN(4,I) QIN(4,I)=QIN(4,I)*1.0/(1.0+APOPV)*1.D-16 400 CONTINUE C C V1 + V3 ( STRETCH MODES ) QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.090*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(5,I)=((A*EN+B)+QIN(5,I))*1.D-16 500 CONTINUE C C V12 +V23 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(6,I)=(A*EN+B)*1.D-16 600 CONTINUE C C V13+2V1+2V3 QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(7,I)=(A*EN+B)*1.D-16 700 CONTINUE C C HIGHER HARMONICS QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 720 710 CONTINUE J=NVIB5 720 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(8,I)=(A*EN+B)*1.D-16 800 CONTINUE C C EXCITATION CHAPPUIS BAND QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 820 810 CONTINUE J=NEXC1 820 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(9,I)=(A*EN+B)*1.D-16 900 CONTINUE C C EXCITATION HARTLEY BAND QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 1000 DO 910 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 920 910 CONTINUE J=NEXC2 920 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(10,I)=(A*EN+B)*1.D-16 1000 CONTINUE C C EXCITATION QIN(11,I)=0.0D0 IF(EN.LE.EIN(11)) GO TO 1100 DO 1010 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 1020 1010 CONTINUE J=NEXC3 1020 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(11,I)=(A*EN+B)*1.D-16 1100 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 END +DECK,GAS54. SUBROUTINE GAS54(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,MAGBDIM. +SEQ,RATIO. +SEQ,GASN. +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(79),YXSEC(79),XION(52),YION(52) DIMENSION XDIM(10),YDIM(10) DIMENSION XEXC3(28),YEXC3(28),XEXC4(32),YEXC4(32),XEXC5(20) DIMENSION YEXC5(20),XEXC6(24),YEXC6(24),YEXC7(12),XEXC7(12) DIMENSION YEXC8(12),XEXC8(12),XEL(57),YEL(57) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER ENGLAND+ELFORD 1991 (MOD 2003 EL+MC) DATA XEN/0.00,.005,0.01,.015,0.02,0.03,0.04,0.05,0.06,0.07, /0.08,0.09,0.10,0.12,0.13,0.14,0.15,0.16,0.17,0.18, /0.19,0.20,0.21,0.22,0.23,0.24,0.26,0.28,0.30,0.32, /0.34,0.36,0.38,0.39,0.40,0.41,0.42,0.43,0.44,0.46, /0.48,0.50,0.55,0.60,0.65,0.70,0.75,0.80,0.90,1.00, /1.20,1.40,1.60,1.80,2.00,2.50,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,12.0,15.0,25.0,35.0,50.0,100., /150.,300.,400.,500.,1000.,2000.,4000.,10000.,100000./ DATA YXSEC/13.7,13.8,13.9,14.2,15.0,16.5,18.0,20.5,23.0,26.5, /30.0,34.0,39.4,54.9,62.9,71.0,78.9,86.5,94.2,102., /109.,115.,121.,127.,133.,139.,149.,159.,168.,177., /186.,195.,204.,208.,211.,214.,217.,219.,220.,219., /215.,209.,190.,174.,161.,151.,143.,136.,123.,113., /95.5,82.0,70.0,60.5,51.5,37.0,29.0,20.0,14.7,10.8, /8.17,5.63,4.29,3.37,3.00,2.95,4.00,4.40,3.60,1.35, /0.95,0.79,.826,.752,0.57,0.28,0.14,.056,.0056/ C ELASTIC TOTAL ELFORD AND MCEARCHAN THEORY DATA XEL/0.00,.001,.002,.004,.007,0.01,0.02,0.03,0.04,0.05, /0.06,0.07,0.08,0.09,0.10,0.15,0.20,0.25,0.30,0.35, /0.40,0.45,0.50,0.55,0.60,0.70,0.80,0.90,1.00,1.20, /1.40,1.60,1.80,2.00,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,12.0,15.0,25.0,35.0,50.0,100.,150.,300., /400.,500.,1000.,2000.,4000.,10000.,100000./ DATA YEL/12.33,17.4,17.9,19.2,21.2,20.4,23.5,26.0,28.2,30.4, /32.5,34.7,37.0,39.4,42.0,58.1,81.7,113.,147.,176., /194.,203.,205.,205.,203.,195.,185.,173.,162.,142., /126.,113.,102.,93.1,63.5,46.5,35.3,27.8,22.2,19.4, /16.5,14.3,12.5,11.0,9.60,9.00,9.00,8.80,7.50,4.90, /3.90,3.40,2.30,1.40,0.90,0.50,0.12/ C IONISATION DATA XION/10.4375,15.0,17.5,20.0,25.0,30.0,35.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,90.0,100.,125., /150.,175.,200.,250.,300.,350.,400.,450.,500.,550., /600.,650.,700.,800.,900.,1000.,1500.,2000.,2500.,3000., /3500.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000.,11000., /20000.,50000.,100000./ DATA YION/0.00,1.13,2.47,2.68,3.79,4.50,5.09,5.44,5.75, /5.95,6.09,6.22,6.27,6.37,6.38,6.42,6.37,6.27,5.92, /5.72,5.44,5.17,4.77,4.34,4.01,3.87,3.46,3.24,3.13, /3.07,2.80,2.70,2.37,2.20,2.12,1.62,1.31,1.11,.976, /.859,.763,.691,.612,.513,.431,.373,.332,.300,.274, /.150,.060,.030/ C DIMER X-SECTION (ENGLAND AND ELFORD AJP 44(1991)647-675) DATA XDIM/.040,.045,0.09,0.17,0.40,4.00,40.0,400.,4000.,100000./ DATA YDIM/0.00,8.30,8.30,1.25,0.83,.083,.008,.0008,.00008,.000003/ C EXCITATION DATA XEXC3/4.667,4.70,4.80,4.90,5.00,5.10,5.20,5.30,5.40,5.50, /5.60,5.70,5.80,5.90,6.00,6.25,6.50,7.00,7.25,7.50, /10.0,12.0,15.0,20.0,30.0,100.,1000.,100000./ DATA YEXC3/0.00,0.10,0.60,0.25,0.30,0.40,0.55,0.68,0.85,0.95, /0.95,0.90,0.85,0.75,0.70,0.65,0.60,0.50,0.48,0.45, /0.15,0.09,.044,.019,.005,.00015,.000005,.0000000001/ DATA XEXC4/4.887,4.90,5.00,5.10,5.20,5.30,5.40,5.50,5.60,5.70, /5.80,5.90,6.00,6.25,6.50,7.00,7.25,7.50,10.0,12.0, /15.0,20.0,30.0,60.0,100.,150.,200.,400.,1000.,2000., /10000.,100000./ DATA YEXC4/0.00,0.20,1.20,2.50,1.50,1.40,1.60,2.00,2.40,2.50, /2.45,2.30,2.15,1.95,1.75,1.55,1.50,1.45,0.80,0.60, /0.39,0.34,0.27,0.19,0.13,.085,0.06,0.03,.012,.006, /.0012,.00012/ DATA XEXC5/5.461,5.50,5.60,5.70,5.80,5.90,6.00,6.25,6.50,7.00, /7.25,7.50,10.0,15.0,20.0,30.0,40.0,100.,1000.,100000./ DATA YEXC5/0.00,0.80,2.00,3.20,3.50,3.65,3.60,3.45,3.25,2.60, /2.45,2.30,0.90,0.23,0.10,.028,.012,.0009,.000001,.00000001/ DATA XEXC6/6.704,7.00,7.50,8.00,9.00,10.0,11.0,12.5,15.0,20.0, /25.0,35.0,40.0,50.0,60.0,100.,150.,200.,400.,1000., /2000.,5000.,10000.,100000./ DATA YEXC6/0.00,0.08,0.20,0.50,1.50,2.05,2.50,3.05,3.55,4.25, /4.55,4.50,4.40,4.15,3.75,3.00,2.45,2.10,1.25,0.65, /0.34,0.14,0.07,.007/ DATA XEXC7/7.926,9.00,10.0,20.0,40.0,60.0,100.,200.,1000.,2000., /10000.,100000./ DATA YEXC7/0.00,0.25,0.15,0.14,0.13,0.11,0.07,0.04,.008,.004, /.0008,.00008/ DATA XEXC8/8.60,10.0,11.0,20.0,40.0,60.0,100.,200.,1000.,2000., /10000.,100000./ DATA YEXC8/0.00,0.75,0.45,0.42,0.39,0.32,0.21,0.12,.024,.012, /.0024,.00024/ C ------------------------------------------------------------------- NAME='Hg2 (2003)' C------------------------------------------------------------------- C -------------------------------------------------------------------- C ISOTROPIC SCATTERING VERSION OF MERCURY WITH DIMERS USES AMALGAM OF C ELFORD AND MCEARCHAN 2003 AND C ENGLAND AND ELFORD 1993 C CONTAINS POSSIBLE EXTENSION TO ANISOTROPIC SCATTERING USING THE C THEORETICAL ELASTIC X-SECTION OF ELFORD AND MCEARCHAN. C C DIMER FRACTION IN GAS FOR NITROGEN AND HELIUM MIXTURES AND PURE C MERCURY SHOWN AS PARAMETER EANDE (BELOW) FOR GENERAL PURPOSE USE C HAVE SET EANDE TO NITROGEN MIXTURE VALUE. C FOR LARGE FRACTIONS OF MERCURY AT LOW FIELDS USE BOLTZMAN SOLUTION C SINCE BACKGROUND GAS MOVEMENT (KT TERM) IS IMPORTANT . C USE MONTE CARLO (KT=0 BACKGROUND GAS STATIONARY) FOR MOST OTHER CASES C -------------------------------------------------------------------- C C FIND FRACTION OF GAS FOR DIMER NORMALISATION C GFRAC=0.0 DO 11 IDGS=1,mxngas IF(NGASN(IDGS).EQ.55) THEN GFRAC=FRAC(IDGS) ENDIF 11 CONTINUE GFRAC=GFRAC/100.0 C------------------------------------------------------------- C DIMER NORMALISATION C PURE MERCURY EANDE=0.00221 C N2-HG MIX EANDE=0.00162 C HE-HG MIX EANDE=0.00067 EANDE=0.00221 DNORM=GFRAC*(573.0/(273.15+TEMPC))*TORR/760.0 DNORM=DNORM*EANDE C--------------------------------------------------------------- NIN=8 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=79 NEL=57 NION=52 NDIM=10 NEXC3=28 NEXC4=32 NEXC5=20 NEXC6=24 NEXC7=12 NEXC8=12 E(1)=0.0 E(2)=2.0*EMASS/(200.59*AMU) E(3)=10.4375 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.4375 EIN(1)=-0.040 EIN(2)=0.040 EIN(3)=4.667 EIN(4)=4.887 EIN(5)=5.461 EIN(6)=6.704 EIN(7)=7.926 EIN(8)=8.60 SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ISOT) MERCURY ' SCRPT(3)=' IONISATION ELOSS= 10.4375 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC DIMER SUP ELOSS= -0.040 ' SCRPT(8)=' EXC DIMER ELOSS= 0.040 ' SCRPT(9)=' EXC 3P0 ELOSS= 4.667 ' SCRPT(10)=' EXC 3P1 ELOSS= 4.887 ' SCRPT(11)=' EXC 3P2 ELOSS= 5.461 ' SCRPT(12)=' EXC 1P1 ELOSS= 6.704 ' SCRPT(13)=' EXC 1S0 ELOSS= 7.926 ' SCRPT(14)=' EXC HIGH ELOSS= 8.60 ' APOPDM=EXP(EIN(1)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP C USE LOG INTERPOLATION FOR ELASTIC AND MT X-SECTIONS IF(EN.LE.XEL(2)) THEN QELA=YEL(1)*1.D-16 GO TO 125 ENDIF DO 110 J=2,NEL IF(EN.LE.XEL(J)) GO TO 120 110 CONTINUE J=NEL 120 YXJ=LOG(YEL(J)) YXJ1=LOG(YEL(J-1)) XNJ=LOG(XEL(J)) XNJ1=LOG(XEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=EXP(A*LOG(EN)+B)*1.D-16 125 IF(EN.LE.XEN(2)) THEN QMOM=YXSEC(1)*1.D-16 GO TO 200 ENDIF DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=EXP(A*LOG(EN)+B)*1.D-16 200 CONTINUE C------------------------------------------------------------------ C ANISOTROPIC VERSION DECOMMENT 2 LINES BELOW AND COMMENT NEXT TWO C ALSO CHANGE SCRIPT DESCRIPTOR : SCRPT(2) AND SET KEL(2)=1 C PEQEL(2,I)=0.5+(QELA-QMOM)/QELA C Q(2,I)=QELA C-------------------------------------------------------------- PEQEL(2,I)=0.0D0 Q(2,I)=QMOM C-------------------------------------------------------------- C IONISATION Q(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 230 CONTINUE Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C DIMER SUPERELASTIC QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 300 DO 250 J=2,NDIM IF((EN+EIN(2)).LE.XDIM(J)) GO TO 270 250 CONTINUE J=NDIM 270 A=(YDIM(J)-YDIM(J-1))/(XDIM(J)-XDIM(J-1)) B=(XDIM(J-1)*YDIM(J)-XDIM(J)*YDIM(J-1))/(XDIM(J-1)-XDIM(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN QIN(1,I)=QIN(1,I)*APOPDM/(1.0+APOPDM) QIN(1,I)=QIN(1,I)*DNORM 300 CONTINUE C DIMER QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 340 DO 310 J=2,NDIM IF(EN.LE.XDIM(J)) GO TO 320 310 CONTINUE J=NDIM 320 A=(YDIM(J)-YDIM(J-1))/(XDIM(J)-XDIM(J-1)) B=(XDIM(J-1)*YDIM(J)-XDIM(J)*YDIM(J-1))/(XDIM(J-1)-XDIM(J)) QIN(2,I)=(A*EN+B)*1.D-16 QIN(2,I)=QIN(2,I)/(1.0+APOPDM) QIN(2,I)=QIN(2,I)*DNORM 340 CONTINUE C EXC 3P0 QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 370 DO 350 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 360 350 CONTINUE J=NEXC3 360 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 370 CONTINUE C EXC 3P1 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 470 DO 450 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 460 450 CONTINUE J=NEXC4 460 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 470 CONTINUE C EXC 3P2 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 570 DO 550 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GO TO 560 550 CONTINUE J=NEXC5 560 A=(YEXC5(J)-YEXC5(J-1))/(XEXC5(J)-XEXC5(J-1)) B=(XEXC5(J-1)*YEXC5(J)-XEXC5(J)*YEXC5(J-1))/(XEXC5(J-1)-XEXC5(J)) QIN(5,I)=(A*EN+B)*1.0D-16 570 CONTINUE C EXC 1P1 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 670 DO 650 J=2,NEXC6 IF(EN.LE.XEXC6(J)) GO TO 660 650 CONTINUE J=NEXC6 660 A=(YEXC6(J)-YEXC6(J-1))/(XEXC6(J)-XEXC6(J-1)) B=(XEXC6(J-1)*YEXC6(J)-XEXC6(J)*YEXC6(J-1))/(XEXC6(J-1)-XEXC6(J)) QIN(6,I)=(A*EN+B)*1.0D-16 670 CONTINUE C EXC 1S0 QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 770 DO 750 J=2,NEXC7 IF(EN.LE.XEXC7(J)) GO TO 760 750 CONTINUE J=NEXC7 760 A=(YEXC7(J)-YEXC7(J-1))/(XEXC7(J)-XEXC7(J-1)) B=(XEXC7(J-1)*YEXC7(J)-XEXC7(J)*YEXC7(J-1))/(XEXC7(J-1)-XEXC7(J)) QIN(7,I)=(A*EN+B)*1.0D-16 770 CONTINUE C EXC SUM HIGHER LEVELS QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 870 DO 850 J=2,NEXC8 IF(EN.LE.XEXC8(J)) GO TO 860 850 CONTINUE J=NEXC8 860 A=(YEXC8(J)-YEXC8(J-1))/(XEXC8(J)-XEXC8(J-1)) B=(XEXC8(J-1)*YEXC8(J)-XEXC8(J)*YEXC8(J-1))/(XEXC8(J-1)-XEXC8(J)) QIN(8,I)=(A*EN+B)*1.0D-16 870 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+QIN(5,I)+ /QIN(6,I)+QIN(7,I)+QIN(8,I) 900 CONTINUE IF(EFINAL.LT.EIN(8)) NIN=7 IF(EFINAL.LT.EIN(7)) NIN=6 IF(EFINAL.LT.EIN(6)) NIN=5 IF(EFINAL.LT.EIN(5)) NIN=4 IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 END +DECK,GAS55. SUBROUTINE GAS55(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEL(25),YEL(25),XVIB1(16),YVIB1(16),XVIB2(16),YVIB2(16), /XVIB3(15),YVIB3(15),XVIB4(15),YVIB4(15),XEXC(18),YEXC(18), /XION(66),YION(66),XATT(26),YATT(26) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC + EFFECTIVE ROTATION DATA XEL/0.00,.001,0.01,0.10,0.40,0.60,0.80,1.00,1.20,1.50, /1.75,2.00,2.30,3.00,5.00,7.00,10.0,15.0,20.0,30.0, /50.0,100.,1000.,10000.,100000./ DATA YEL/1900.,1900.,1600.,160.,40.0,23.5,13.0,8.10,7.50,9.00, /15.0,18.9,21.0,17.0,21.8,21.8,12.8,8.30,5.20,3.30, /1.75,0.75,0.07,.007,.0007/ C VIBRATION DATA XVIB1/.1466,0.80,1.00,1.50,2.00,2.30,2.70,3.00,5.00,7.00, /10.0,20.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,.0001,0.02,0.22,0.55,0.60,0.60,0.56,0.33,0.20, /0.10,.05,.001,.0001,.00001,.000001/ DATA XVIB2/.3242,0.80,1.00,1.50,2.00,2.30,2.70,3.00,5.00,7.00, /10.0,20.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,.0001,0.10,1.20,2.30,2.15,1.50,1.20,0.30,0.10, /0.05,.025,.001,.0001,.00001,.000001/ DATA XVIB3/.4708,0.90,1.00,1.50,2.00,2.30,2.70,3.00,5.00,7.00, /10.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,.001,.006,0.24,0.42,0.50,0.42,0.25,0.05,0.01, /.001,.0001,.00001,.000001,.0000001/ DATA XVIB4/.6484,0.90,1.00,1.50,2.00,2.30,2.70,3.00,5.00,7.00, /10.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,.001,0.01,1.15,1.40,1.45,1.40,0.80,0.16,0.03, /.001,.0001,.00001,.000001,.0000001/ DATA XION/10.48,11.0,11.5,12.0,12.5,13.0,13.5,14.0,14.5,15.0, /16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0,28.0,30.0, /32.0,34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,65.0, /70.0,80.0,90.0,100.,110.,120.,130.,150.,170.,200., /250.,300.,350.,400.,450.,500.,550.,600.,650.,700., /750.,800.,900.,1000.,1200.,1500.,2000.,3000.,4000.,7000., /10000.,14000.,20000.,40000.,60000.,100000./ DATA YION/0.00,.088,.175,.262,.349,.435,.518,.621,.724,.825, /1.02,1.22,1.42,1.62,1.79,2.11,2.38,2.62,2.82,3.01, /3.17,3.30,3.42,3.52,3.61,3.77,3.88,3.94,3.98,3.99, /3.99,3.95,3.88,3.80,3.71,3.61,3.52,3.33,3.16,2.93, /2.61,2.36,2.15,1.98,1.83,1.71,1.60,1.51,1.42,1.35, /1.28,1.22,1.12,1.04,.903,.758,.603,.433,.341,.212, /.155,.116,.085,.046,.032,.020/ DATA XATT/1.50,1.75,2.00,2.25,2.50,2.75,3.00,3.25,4.75,5.00, /5.25,5.50,5.65,6.00,6.25,6.50,7.00,7.50,8.00,8.50, /9.00,9.50,10.0,10.5,11.0,11.5/ DATA YATT/0.00,.0023,.0088,.019,.018,.012,.003,.0001,.0001,.0007, /.005,.010,.010,.0048,.0012,.0001,.0001,.0018,.0024,.0018, /.0018,.003,.0033,.001,.0001,.0000001/ DATA XEXC/7.85,8.00,9.00,10.0,12.0,15.0,20.0,25.0,30.0,40.0, /60.0,100.,150.,200.,300.,1000.,10000.,100000./ DATA YEXC/0.00,0.40,2.00,3.00,3.80,4.20,4.60,4.60,4.20,3.80, /2.90,2.30,1.70,1.40,1.15,0.55,.055,.0055/ C------------------------------------------------------------------ NAME='H2S (2003)' C -------------------------------------------------------------------- C NO DRIFT VELOCITY AVAILABLE IN PURE H2S USED DATA OF MIXTURE IN C2H4 C FROM HURST ET AL. AND DIFFUSION FROM MILLICAN AND WALKER. C ELASTIC AND VIBRATION XSECTIONS FROM ELECTRON SCATTERING BY : C GULLEY ET AL AND ROHR . ATTACHMENT FROM AZRIA ET AL. C IONISATION : BEB X-SECTIONS OF KIM C NB. DT OF MILLICAN AND WALKER AFFECTED BY ATTACHMENT ABOVE 40 TD. C --------------------------------------------------------------------- NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NEL=25 NVIB1=16 NVIB2=16 NVIB3=15 NVIB4=15 NION=66 NATT=26 NEXC=18 AMP1=0.1875 AMP2=0.1725 AMPVIB1=0.075 AMPVIB2=0.375 E(1)=0.0 E(2)=2.0*EMASS/(34.08088*AMU) E(3)=10.48 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.48 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.075 EIN(4)=0.075 EIN(5)=0.1466 EIN(6)=0.3242 EIN(7)=0.4708 EIN(8)=0.6484 EIN(9)=7.85 SCRPT(1)=' ' SCRPT(2)=' ELASTIC H2S ' SCRPT(3)=' IONISATION ELOSS= 10.48 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT R1 ELOSS= -0.025 ' SCRPT(8)=' ROT R1 ELOSS= 0.025 ' SCRPT(9)=' ROT R2 EL0SS= -0.075 ' SCRPT(10)=' ROT R2 ELOSS= 0.075 ' SCRPT(11)=' VIB V2 ELOSS= 0.1466 ' SCRPT(12)=' VIB V13 ELOSS= 0.3242 ' SCRPT(13)=' (V13+V2)+HIGH ELOSS= 0.4708 ' SCRPT(14)=' 2V13+HIGH ELOSS= 0.6484 ' SCRPT(15)=' EXC ELOSS= 7.85 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0D0 IF(EN.LE.XEL(2)) THEN Q(2,I)=YEL(2)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NEL IF(EN.LE.XEL(J)) GO TO 20 10 CONTINUE J=NEL 20 Y1=LOG(YEL(J)) Y2=LOG(YEL(J-1)) X1=LOG(XEL(J)) X2=LOG(XEL(J-1)) A=(Y1-Y2)/(X1-X2) B=(X2*Y1-X1*Y2)/(X2-X1) Q(2,I)=EXP(A*LOG(EN)+B)*1.0D-16 C 30 Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 200 CONTINUE C Q(4,I)=0.0D0 IF(EN.LT.XATT(1).OR.EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 CONTINUE Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 1300 EFAC=SQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 1300 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 1400 EFAC=SQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC ROT2 C 1400 QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 1500 EFAC=SQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*LOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C ROT2 1500 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 1600 EFAC=SQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*LOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C VIB V2 1600 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=SQRT(1.0-(EIN(5)/EN)) QIN(5,I)=AMPVIB1*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(5,I)=(QIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB V13 COMPOSITE QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=SQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMPVIB2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C VIB V2+V13 AND HIGHER SERIES QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C VIB 2V13 AND HIGHER SERIES QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C SINGLE EFFECTIVE EXCITATION LEVEL QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 720 710 CONTINUE J=NEXC 720 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C--------------------------------------------------------------------- C GET ELASTIC FROM ELASTIC + ROTATION X-SECTION Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I)-QIN(3,I)-QIN(4,I) C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(7,I)+QIN(8,I)+ /QIN(9,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 C END +DECK,GAS56. SUBROUTINE GAS56(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(57),YXSEC(57),XION(46),YION(46),XATT(16),YATT(16), /XVIB1(34),YVIB1(34),XVIB2(28),YVIB2(28),XVIB3(28),YVIB3(28), /XVIB4(25),YVIB4(25),XVIB5(19),YVIB5(19),XEXC1(25),YEXC1(25), /XEXC2(23),YEXC2(23),XEXC3(19),YEXC3(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.001,.002,.004,.007,0.01,.015,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17, /0.20,0.25,0.30,0.35,0.40,0.50,0.60,0.80,1.00,1.50, /2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0, /20.0,30.0,40.0,70.0,100.,140.,200.,250.,300.,500., /1000.,1500.,3000.,6000.,10000.,20000.,100000./ DATA YXSEC/60.0,59.0,56.0,54.0,51.0,45.0,35.0,27.5,22.5,19.0, /14.0,10.7,9.40,7.80,6.90,6.00,5.50,5.30,5.55,6.55, /8.05,11.5,13.5,14.5,15.5,16.5,17.5,18.5,19.5,21.0, /22.5,25.0,29.0,31.0,34.0,36.0,36.0,34.0,31.0,21.5, /17.0,11.5,8.80,5.20,3.75,2.21,1.36,0.98,0.81,0.46, /0.20,0.13,0.06,.026,.016,.0065,.0013/ DATA XION/10.67,11.2,12.7,13.7,14.7,17.2,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.27,0.61,0.99,1.48,3.00,4.30,6.77,8.41,9.58, /10.4,11.1,12.0,12.7,13.1,13.3,13.3,13.3,12.9,12.2, /11.5,10.9,10.1,8.89,8.12,7.51,6.84,6.41,5.63,5.19, /4.77,4.25,3.97,3.43,2.95,2.68,2.44,2.11,1.81,1.20, /0.90,0.66,0.47,.254,.136,.086/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,1.15,1.92,2.90,4.90,7.72,11.6,18.1,25.7,21.6, /17.0,10.9,6.14,2.30,0.87,0.00/ DATA XVIB1/.052,.055,.060,.065,.070,.075,0.08,0.10,0.12,0.14, /0.20,0.25,0.30,0.40,0.50,0.70,1.00,1.50,2.00,3.00, /4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0, /100.,1000.,10000.,100000./ DATA YVIB1/0.00,.014,.021,.024,.026,.027,.028,.028,.027,.025, /.021,.018,.016,.014,.012,.009,.008,.012,.015,.024, /.036,.047,.060,.079,.079,.065,.045,.025,.014,.008, /.002,.0002,.00002,.00002/ DATA XVIB2/.108,.125,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.27,0.52,0.71,0.73,0.73,0.66,0.56,0.49,0.41, /0.32,0.32,0.39,0.63,0.93,1.22,1.57,2.06,2.06,1.69, /1.17,0.66,0.35,0.22,0.05,.005,.0005,.00005/ DATA XVIB3/.173,0.18,0.19,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.13,0.27,0.38,0.49,0.53,0.56,0.53,0.49,0.42, /0.34,0.31,0.33,0.48,0.72,0.94,1.21,1.59,1.59,1.30, /0.90,0.51,0.27,0.17,0.04,.004,.0004,.00004/ DATA XVIB4/.363,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.47,0.63,0.70,0.74,0.74,0.70,0.66,0.63,0.69, /1.00,1.43,1.86,2.40,2.65,2.29,1.69,0.97,0.43,0.24, /0.14,0.03,.003,.0003,.00003/ DATA XVIB5/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.001,0.01,.033,.085,0.16,0.20,0.27,0.30,0.25, /.193,.112,.047,.027,.017,.003,.0003,.00003,.000003/ DATA XEXC1/7.40,8.70,9.70,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,1.30,1.89,2.02,2.08,2.15,2.15,2.15,2.15,2.15, /2.21,2.21,2.15,2.02,1.69,1.56,1.30,1.22,1.04,0.68, /0.33,0.17,0.06,.034,.007/ DATA XEXC2/9.70,10.7,11.7,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.19,0.40,0.75,1.16,1.56,1.82,1.98, /2.15,2.21,2.15,2.02,1.69,1.56,1.30,1.22,1.04,0.68, /0.32,0.17,0.06,.034,.006/ DATA XEXC3/17.0,20.0,25.0,30.0,40.0,60.0,80.0,100.,150.,200., /300.,400.,600.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.43,0.94,1.30,1.82,2.15,2.15,2.02,1.69,1.56, /1.30,1.22,1.04,0.68,0.33,0.17,0.07,.034,.006/ C-------------------------------------------------------- NAME='n-C4H10 (2003)' C --------------------------------------------------------------------- C NO EXPERIMENTAL DATA AVAILABLE ON DIFFUSION . DRIFT VELOCITY DATA C FROM FLORIANO,GEE AND FREEMAN USED. C ANALYSIS : FIXED INELASTIC X-SECTIONS TO ISOBUTANE VALUES AND VARIED C ELASTIC X-SECTION TO OBTAIN FIT TO DRIFT VELOCITY. C NO USEFUL ELECTRON SCATTERING DATA AVAILABLE. C ---------------------------------------------------------------------- NIN=10 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=57 NION=46 NATT=16 NVIB1=34 NVIB2=28 NVIB3=28 NVIB4=25 NVIB5=19 NEXC1=25 NEXC2=23 NEXC3=19 E(1)=0.0 E(2)=2.0*EMASS/(58.1234*AMU) E(3)=10.67 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.67 EIN(1)=-0.052 EIN(2)=0.052 EIN(3)=-0.108 EIN(4)=0.108 EIN(5)=0.173 EIN(6)=0.363 EIN(7)=0.519 EIN(8)=7.4 EIN(9)=9.70 EIN(10)=17.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC N-BUTANE ' SCRPT(3)=' IONISATION ELOSS= 10.67 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= -0.052 ' SCRPT(8)=' VIB ELOSS= 0.052 ' SCRPT(9)=' VIB ELOSS= -0.108 ' SCRPT(10)=' VIB ELOSS= 0.108 ' SCRPT(11)=' VIB ELOSS= 0.173 ' SCRPT(12)=' VIB ELOSS= 0.363 ' SCRPT(13)=' VIB ELOSS= 0.519 ' SCRPT(14)=' EXC ELOSS= 7.4 ' SCRPT(15)=' EXC ELOSS= 9.70 ' SCRPT(16)=' EXC ELOSS= 17.0 ' APOP=EXP(EIN(1)/AKT) HPOP=EXP(EIN(3)/AKT) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC VIB QIN(1,I)=0.0D0 IF(EN.EQ.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 302 301 CONTINUE J=NVIB1 302 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN QIN(1,I)=APOP*QIN(1,I)/(1.0+APOP) C 305 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 4000 DO 4100 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 4200 4100 CONTINUE J=NVIB1 4200 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.D-16/(1.0+APOP) 4000 CONTINUE QIN(3,I)=0.0D0 IF(EN.EQ.0.0) GO TO 1100 DO 307 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 308 307 CONTINUE J=NVIB2 308 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.D-16/EN QIN(3,I)=HPOP*QIN(3,I)/(1.0+HPOP) 1100 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B)*1.D-16/(1.0+HPOP) 400 CONTINUE QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(6,I)=(A*EN+B)*1.D-16 600 CONTINUE QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 700 CONTINUE QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 720 710 CONTINUE J=NEXC1 720 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 800 CONTINUE QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 820 810 CONTINUE J=NEXC2 820 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 900 CONTINUE QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 920 910 CONTINUE J=NEXC3 920 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(10,I)=(A*EN+B)*1.D-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 END +DECK,GAS57. SUBROUTINE GAS57(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XEN(61),YXSEC(61),XION(46),YION(46),XATT(16),YATT(16), /XVIB1(34),YVIB1(34),XVIB2(28),YVIB2(28),XVIB3(28),YVIB3(28), /XVIB4(25),YVIB4(25),XVIB5(19),YVIB5(19),XEXC1(25),YEXC1(25), /XEXC2(23),YEXC2(23),XEXC3(19),YEXC3(19) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XEN/0.00,.001,.002,.003,.004,.005,.007,0.01,.015,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.14,0.16,0.18,0.20,0.23,0.26,0.30,0.35,0.40,0.50, /0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,15.0,20.0,30.0,40.0,70.0,100.,140., /200.,250.,300.,500.,1000.,1500.,3000.,6000.,10000.,20000., /100000./ DATA YXSEC/77.0,75.0,70.0,66.0,62.0,57.0,51.0,45.0,37.0,31.0, /24.0,18.5,15.5,13.0,11.0,9.45,8.25,7.35,6.75,6.75, /8.20,10.6,13.7,17.2,20.5,23.0,25.0,26.5,27.0,28.0, /29.0,30.0,31.0,32.5,34.0,36.0,38.0,40.0,43.0,44.0, /44.0,42.0,39.0,28.0,22.0,15.0,11.5,6.80,4.90,2.90, /1.78,1.28,1.06,0.60,0.26,0.17,0.08,.034,.021,.0085, /.0017/ DATA XION/10.35,11.0,12.5,13.5,14.5,17.0,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.33,0.75,1.22,1.82,3.69,5.29,8.33,10.3,11.8, /12.8,13.7,14.8,15.6,16.1,16.4,16.4,16.4,15.9,15.0, /14.1,13.4,12.4,10.9,9.99,9.24,8.41,7.88,6.92,6.38, /5.87,5.23,4.88,4.22,3.63,3.30,3.00,2.60,2.23,1.48, /1.11,0.81,0.58,0.31,.167,.106/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,1.41,2.36,3.57,6.03,9.50,14.3,22.3,31.6,26.6, /20.9,13.4,7.55,2.83,1.07,0.00/ DATA XVIB1/.052,.055,.060,.065,.070,.075,0.08,0.10,0.12,0.14, /0.20,0.25,0.30,0.40,0.50,0.70,1.00,1.50,2.00,3.00, /4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0, /100.,1000.,10000.,100000./ DATA YVIB1/0.00,.017,.026,.030,.032,.033,.034,.034,.033,.031, /.026,.022,.020,.017,.015,.011,.010,.015,.018,.030, /.044,.058,.074,.097,.097,.080,.055,.031,.017,.010, /.003,.0003,.00003,.00003/ DATA XVIB2/.108,.125,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.33,0.64,0.87,0.90,0.90,0.81,0.69,0.60,0.50, /0.39,0.39,0.48,0.77,1.14,1.50,1.93,2.53,2.53,2.08, /1.44,0.81,0.43,0.27,0.06,.006,.0006,.00006/ DATA XVIB3/.173,0.18,0.19,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.16,0.33,0.47,0.60,0.65,0.69,0.65,0.60,0.52, /0.42,0.38,0.41,0.59,0.89,1.16,1.49,1.96,1.96,1.60, /1.11,0.63,0.33,0.21,0.05,.005,.0005,.00005/ DATA XVIB4/.363,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.58,0.77,0.86,0.91,0.91,0.86,0.81,0.77,0.85, /1.23,1.76,2.29,2.95,3.26,2.82,2.08,1.19,0.53,0.30, /0.17,0.04,.004,.0004,.00004/ DATA XVIB5/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.001,0.01,.041,.105,0.20,0.25,0.33,0.37,0.31, /.237,.138,.058,.033,.021,.004,.0004,.00004,.000004/ DATA XEXC1/7.20,8.50,9.50,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,1.60,2.32,2.48,2.56,2.64,2.64,2.64,2.64,2.64, /2.72,2.72,2.64,2.48,2.08,1.92,1.60,1.50,1.28,0.84, /0.41,0.21,0.07,.042,.009/ DATA XEXC2/9.50,10.5,11.5,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.23,0.49,0.92,1.43,1.92,2.24,2.44, /2.65,2.72,2.65,2.48,2.08,1.92,1.60,1.50,1.28,0.84, /0.39,0.21,0.07,.042,.007/ DATA XEXC3/17.0,20.0,25.0,30.0,40.0,60.0,80.0,100.,150.,200., /300.,400.,600.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.53,1.16,1.60,2.24,2.64,2.64,2.48,2.08,1.92, /1.60,1.50,1.28,0.84,0.41,0.21,0.09,.042,.007/ C ---------------------------------------------------------------------- C NO DIFFUSION EXPERIMENTAL DATA AVAILABLE,USED INELASTICS FROM SCALING C ISOBUTANE INELASTIC X-SECT. ELASTIC DETERMINED FROM DRIFT VELOCITY. C HENCE DIFFUSION ACCURATE TO ONLY 10% , DRIFT VELOCITY TO 3% BELOW C 10KV/CM. C MODIFICATION OF NEO-PENTANE (1995) TO INCLUDE SUPERELASTIC SCATTERING C FIT TO DRIFT VELOCITY OF FLORIANO GEE AND FREEMAN C ---------------------------------------------------------------------- C NAME='n-C5H12 (2003)' C NIN=11 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NDATA=61 NION=46 NATT=16 NVIB1=34 NVIB2=28 NVIB3=28 NVIB4=25 NVIB5=19 NEXC1=25 NEXC2=23 NEXC3=19 E(1)=0.0 E(2)=2.0*EMASS/(72.1503*AMU) E(3)=10.35 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=10.35 EIN(1)=-.052 EIN(2)=0.052 EIN(3)=-.108 EIN(4)=0.108 EIN(5)=-.173 EIN(6)=0.173 EIN(7)=0.363 EIN(8)=0.519 EIN(9)=7.2 EIN(10)=9.50 EIN(11)=17.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC N-PENTANE ' SCRPT(3)=' IONISATION ELOSS= 10.35 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB ELOSS= -0.052 ' SCRPT(8)=' VIB ELOSS= 0.052 ' SCRPT(9)=' VIB ELOSS= -0.108 ' SCRPT(10)=' VIB ELOSS= 0.108 ' SCRPT(11)=' VIB ELOSS= -0.173 ' SCRPT(12)=' VIB ELOSS= 0.173 ' SCRPT(13)=' VIB ELOSS= 0.363 ' SCRPT(14)=' VIB ELOSS= 0.519 ' SCRPT(15)=' EXC ELOSS= 7.20 ' SCRPT(16)=' EXC ELOSS= 9.50 ' SCRPT(17)=' EXC ELOSS= 17.0 ' APOP1=EXP(EIN(1)/AKT) APOP2=EXP(EIN(3)/AKT) APOP3=EXP(EIN(5)/AKT) EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 21 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 YXJ=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 21 CONTINUE Q(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 30 DO 22 J=2,NION IF(EN.LE.XION(J)) GO TO 23 22 CONTINUE J=NION 23 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 30 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 40 IF(EN.GT.XATT(NATT)) GO TO 40 DO 31 J=2,NATT IF(EN.LE.XATT(J)) GO TO 32 31 CONTINUE J=NATT 32 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 40 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C SUPERELASTIC VIB1 QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 150 DO 110 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 120 110 CONTINUE J=NVIB1 120 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C VIB1 150 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 200 DO 160 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 170 160 CONTINUE J=NVIB1 170 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)/(1.0+APOP1)*1.D-16 200 CONTINUE C C SUPERELASTIC VIB2 QIN(3,I)=0.0D0 IF(EN.LE.0.0) GO TO 250 DO 210 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 220 210 CONTINUE J=NVIB2 220 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C VIB2 250 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 300 DO 260 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 270 260 CONTINUE J=NVIB2 270 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B)/(1.0+APOP2)*1.D-16 300 CONTINUE C C SUPERELASTIC VIB3 QIN(5,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 DO 310 J=2,NVIB3 IF((EN+EIN(6)).LE.XVIB3(J)) GO TO 320 310 CONTINUE J=NVIB3 320 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(5,I)=QIN(5,I)*APOP3/(1.0+APOP3)*1.D-16 C VIB3 350 QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 400 DO 360 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 370 360 CONTINUE J=NVIB3 370 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(6,I)=(A*EN+B)/(1.0+APOP3)*1.D-16 400 CONTINUE C VIB4 QIN(7,I)=0.0D0 IF(EN.LE.EIN(7)) GO TO 500 DO 410 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 420 410 CONTINUE J=NVIB4 420 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(7,I)=(A*EN+B)*1.D-16 500 CONTINUE C VIB5 QIN(8,I)=0.0D0 IF(EN.LE.EIN(8)) GO TO 600 DO 510 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 520 510 CONTINUE J=NVIB5 520 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(8,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC1 QIN(9,I)=0.0D0 IF(EN.LE.EIN(9)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(9,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC2 QIN(10,I)=0.0D0 IF(EN.LE.EIN(10)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(10,I)=(A*EN+B)*1.D-16 800 CONTINUE C EXC3 QIN(11,I)=0.0D0 IF(EN.LE.EIN(11)) GO TO 900 DO 810 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 820 810 CONTINUE J=NEXC3 820 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(11,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 END +DECK,GAS58. SUBROUTINE GAS58(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220),PJ(220) DIMENSION XMOM(65),YMOM(65),XELA(59),YELA(59),XVIB1(50),YVIB1(50), /XVIB2(24),YVIB2(24),XVIB3(20),YVIB3(20),XVIB4(18),YVIB4(18), /XVIB5(18),YVIB5(18),XVIB6(15),YVIB6(15),XVIB7(17),YVIB7(17), /XVIB8(15),YVIB8(15), /XTRP1(25),YTRP1(25),XTRP3(23),YTRP3(23),XTRP5(26),YTRP5(26), /XTRP7(29),YTRP7(29),XTRP8(19),YTRP8(19), /XSNG2(29),YSNG2(29),XSNG5(26),YSNG5(26),XION(43),YION(43) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XELA/0.00,.010,.015,0.02,0.03,0.04,0.05,0.07,0.10,0.12, /0.15,0.17,0.20,0.25,0.30,0.35,0.40,0.50,0.70,1.00, /1.20,1.30,1.50,1.70,1.90,2.10,2.20,2.50,2.80,3.00, /3.30,3.60,4.00,4.50,5.00,6.00,7.00,8.00,10.0,12.0, /15.0,17.0,20.0,25.0,30.0,50.0,75.0,100.,150.,200., /300.,500.,700.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YELA/1.10,1.92,2.23,2.49,2.95,3.35,3.78,4.48,5.26,5.72, /6.33,6.62,7.11,7.70,8.22,8.62,8.96,9.24,9.52,9.74, /10.26,10.91,11.99,13.78,16.98,17.62,18.94,19.11,22.7,18.74, /16.88,15.59,14.08,12.90,12.74,12.53,12.43,13.01,13.23,13.23, /12.80,12.56,12.10,11.41,10.67,8.30,6.66,5.38,4.18,3.50, /2.70,1.831,1.455,1.03,0.58,0.28,0.10,.052,.008/ DATA XMOM/0.00,.001,.002,.003,.005,.007,.0085,.010,.015,0.02, /0.03,0.04,0.05,0.07,0.10,0.12,0.15,0.17,0.20,0.25, /0.30,0.35,0.40,0.50,0.70,1.00,1.20,1.30,1.50,1.70, /1.90,2.10,2.20,2.50,2.80,3.00,3.30,3.60,4.00,4.50, /5.00,6.00,7.00,8.00,10.0,12.0,15.0,17.0,20.0,25.0, /30.0,50.0,75.0,100.,150.,200.,300.,500.,700.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YMOM/1.10,1.36,1.49,1.62,1.81,2.00,2.10,2.19,2.55,2.85, /3.38,3.82,4.30,5.08,5.92,6.42,7.08,7.38,7.88,8.48, /8.98,9.36,9.67,9.87,9.97,9.96,10.34,10.92,11.87,13.47, /16.41,16.85,18.02,17.92,21.0,17.20,15.3,13.96,12.42,11.19, /10.86,10.36,10.0,10.2,9.90,9.50,8.70,8.26,7.60,6.70, /5.90,3.80,2.56,1.80,1.13,0.80,0.48,0.23,.143,.077, /.038,.019,.008,.004,.001/ DATA XVIB1/0.29,0.30,0.33,0.40,0.75,0.90,1.00,1.10,1.16,1.20, /1.22,1.40,1.50,1.60,1.65,1.70,1.80,1.90,2.00,2.10, /2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,3.60,4.00,5.00,15.0,18.0, /20.0,22.0,23.0,25.0,29.0,32.0,50.0,80.0,1000.,100000./ DATA YVIB1/.00,.001,.0017,.0025,.0037,.0055,.0065,.009,.011,.0125, /.0135,.070,.100,.150,.270,.315,.540,1.485,4.80,2.565, /1.20,4.50,2.76,1.59,3.15,1.545,0.60,1.35,.525,0.870, /1.17,0.855,0.66,0.60,.585,0.57,.055,.035,.035,0.04, /.065,.085,.085,0.06,0.03,.015,.012,0.00,0.00,0.00/ DATA XVIB2/0.59,1.70,1.80,1.90,2.00,2.10,2.20,2.30,2.40,2.50, /2.60,2.70,2.75,2.80,2.90,3.00,3.10,3.20,3.30,3.40, /3.50,3.60,1000.,100000./ DATA YVIB2/0.00,0.00,.015,0.63,1.935,3.30,1.47,0.54,2.115,3.00, /0.54,1.05,1.725,1.275,0.33,0.90,0.645,0.375,0.345,0.30, /0.213,0.00,0.00,0.00/ DATA XVIB3/0.88,1.90,2.00,2.10,2.20,2.30,2.40,2.50,2.60,2.70, /2.75,2.80,2.90,3.00,3.10,3.20,3.30,3.40,1000.,100000./ DATA YVIB3/0.00,0.00,0.96,2.055,2.70,1.695,0.075,0.96,1.47,0.45, /0.96,0.54,0.855,0.405,0.282,0.291,0.0615,0.00,0.00,0.00/ DATA XVIB4/1.17,2.00,2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.75, /2.80,2.90,3.00,3.10,3.20,3.30,1000.,100000./ DATA YVIB4/0.0,0.0,.2025,1.515,2.385,1.440,.555,.0825,1.2,1.095, /0.675,0.03,0.33,0.315,0.06,0.00,0.00,0.00/ DATA XVIB5/1.47,2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80, /2.90,3.00,3.10,3.20,3.30,3.40,1000.,100000./ DATA YVIB5/0.00,0.00,.825,1.23,1.53,1.44,0.345,.0225,.345,0.54, /0.66,.2175,.105,.315,.1035,0.00,0.00,0.00/ DATA XVIB6/1.76,2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90, /3.00,3.10,3.20,1000.,100000./ DATA YVIB6/0.00,0.00,.0063,1.125,1.74,1.38,0.78,0.45,.315,.246, /0.48,.1635,0.00,0.00,0.00/ DATA XVIB7/2.06,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,1000.,100000./ DATA YVIB7/0.00,0.00,.0126,0.39,0.66,0.96,.795,0.60,0.18,.0063, /.192,.204,.078,.0189,0.00,0.00,0.00/ DATA XVIB8/2.35,2.50,2.60,2.70,2.75,2.80,2.90,3.00,3.10,3.20, /3.30,3.40,3.50,1000.,100000./ DATA YVIB8/0.00,0.00,.0189,0.36,0.36,0.33,.345,.264,.0375,.0063, /.1545,.0252,0.00,0.00,0.00/ DATA XTRP1/6.17,7.00,7.80,8.50,9.00,10.0,11.0,12.0,13.0,14.0, /16.0,17.0,18.0,20.0,22.0,24.0,26.0,30.0,34.0,40.0, /50.0,70.0,150.,1000.,100000./ DATA YTRP1/0.00,.0033,.0085,.0213,.0307,.0468,.059,.069,.075,.082, /.089,.089,.084,.072,.061,.052,.045,.034,.029,.023, /.019,.004,0.00,0.00,0.00/ DATA XTRP3/7.35,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /17.0,18.0,20.0,22.0,26.0,30.0,34.0,40.0,50.0,70.0, /150.0,1000.,100000./ DATA YTRP3/.0,.0543,.1434,.2312,.2975,.343,.373,.387,.397,.399, /.383,.354,.289,.227,.165,.131,.106,.0777,.0469,.0168, /0.00,0.00,0.00/ DATA XTRP5/7.80,8.10,8.50,8.70,9.00,10.0,11.0,12.0,13.0,14.0, /16.0,17.0,18.0,20.0,22.0,24.0,26.0,30.0,34.0,40.0, /50.0,70.0,150.0,500.0,1000.,100000./ DATA YTRP5/0.0,.0015,.0097,.018,.029,.073,.115,.148,.180,.208, /.205,.178,.152,.122,.105,.091,.081,.066,.057,.047, /.041,.021,.007,0.00,0.00,0.00/ DATA XSNG2/8.55,9.00,12.0,14.0,15.0,16.0,17.0,18.0,19.0,20.0, /24.0,26.0,30.0,40.0,50.0,70.0,100.,150.,200.,250., /300.,500.,700.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YSNG2/.0,.0141,.163,.2276,.2412,.2481,.2483,.238,.2268,.2150, /.1860,.1734,.1527,.1160,.0900,.0642,.0425,.0268,.0201,.0161, /.0134,.0082,.0060,.0042,.0020,.0010,.0004,.0002,.00004/ DATA XTRP7/11.03,11.5,12.0,12.5,13.0,13.5,13.8,14.0,14.2,14.5, /15.0,16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,36.0,40.0,50.0,70.0,100.0,150.0,1000.,100000./ DATA YTRP7/.0,.0405,.093,.1965,.435,.735,.93,.975,.96,.945, /.825,.645,.525,.450,.405,.375,.315,.2655,.225,.2085, /.1665,.117,.0945,.0585,.0225,.0023,0.00,0.00,0.00/ DATA XTRP8/11.87,11.92,12.7,17.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,32.0,40.0,50.0,70.0,100.,150.0,1000.,100000./ DATA YTRP8/.0,.0496,.0041,.0346,.0436,.0448,.0405,.0338,.0289, /.0241,.0193,.0172,.0122,.010,.007,.005,0.00,0.00,0.00/ DATA XSNG5/13.0,14.0,15.0,16.0,17.0,18.0,20.0,22.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,250.,300.,500.,700., /1000.,2000.,4000.,10000.,20000.,100000./ DATA YSNG5/0.0,.081,0.19,0.25,0.42,0.52,0.75,0.96,1.19,1.48, /1.65,1.76,1.68,1.58,1.33,1.16,1.05,0.96,0.74,0.64, /0.53,0.28,0.14,0.06,0.03,.006/ DATA XION/15.6,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /21.0,22.0,23.0,24.0,25.0,26.0,30.0,34.0,38.0,45.0, /50.0,60.0,75.0,100.,125.,150.,200.,250.,300.,400., /500.,700.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000., /20000.,40000.,100000./ DATA YION/0.00,.021,.047,.071,.099,.129,.164,.199,.230,.270, /.344,.418,.492,.565,.640,.714,1.03,1.27,1.49,1.78, /1.94,2.18,2.39,2.52,2.52,2.45,2.27,2.08,1.92,1.66, /1.45,1.16,0.91,.654,.521,.375,.295,.209,.164,.135, /.073,.040,.017/ C NAME='N2 (2004 anis.)' C -------------------------------------------------------------- C NITROGEN FROM PITCHFORD AND PHELPS . JILA REPORT NO.26 (1985) C MULTI TERM CROSS SECTIONS WITH MODIFICATION CF:PHELPS PRIVATE C COMMUNICATION . REDUCED 11.03 ENERGY LOSS X-SECTION BY 0.6666 C IN CODE. C ACCURACY ABOUT 1% AT ALL FIELDS. C COMBINED SOME CLOSE LEVELS IN ORDER TO SAVE COMPUTING TIME C 2004: INCLUDED FULL TREATMENT OF ROTATIONAL STATES C ANISOTROPIC ELASTIC SCATTERING C -------------------------------------------------------------- NIN=71 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C USE ANISTROPIC ELASTIC SCATTERING AND COPY (OFFSET) TO IONISATION KEL(2)=1 KEL(3)=1 C NELA=59 NMOM=65 NVIB1=50 NVIB2=24 NVIB3=20 NVIB4=18 NVIB5=18 NVIB6=15 NVIB7=17 NVIB8=15 NTRP1=25 NTRP3=23 NTRP5=26 NTRP7=29 NTRP8=19 NSNG2=29 NSNG5=26 NION=43 E(1)=0.0 E(2)=2.0*EMASS/(27.7940*AMU) E(3)=15.60 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=13.0 IOFF=INT(0.5+E(3)/ESTEP) C CALC FRACTIONAL POPULATION DENSITY FOR ROTATIONAL STATES B0=2.4668D-4 A0=0.5291772083 QBQA=1.06 QBK=1.67552*(QBQA*A0)**2*1.D-16 DO 3 K=1,29,2 3 PJ(K)=3*(2*K+1)*EXP(-K*(K+1)*B0/AKT) DO 4 K=2,28,2 4 PJ(K)=6*(2*K+1)*EXP(-K*(K+1)*B0/AKT) SUM=6.0D0 DO 5 K=1,29 5 SUM=SUM+PJ(K) FROT0=6.0D0/SUM DO 6 K=1,29 6 PJ(K)=PJ(K)/SUM C CALC ROTATIONAL TRANSITION ENERGIES DO 7 K=1,28 J=K-1 EIN(K+28)=B0*(4*J+6) 7 EIN(K)=-EIN(K+28) EIN(57)=0.290 EIN(58)=0.590 EIN(59)=0.880 EIN(60)=1.17 EIN(61)=1.47 EIN(62)=1.76 EIN(63)=2.06 EIN(64)=2.35 EIN(65)=6.17 EIN(66)=7.35 EIN(67)=7.80 EIN(68)=8.55 EIN(69)=11.03 EIN(70)=11.87 EIN(71)=13.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC NITROGEN' SCRPT(3)=' IONISATION ELOSS= 15.60 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 2-0 ELOSS= -0.00148' SCRPT(8)=' ROT 3-1 ELOSS= -0.00247' SCRPT(9)=' ROT 4-2 ELOSS= -0.00345' SCRPT(10)=' ROT 5-3 ELOSS= -0.00444' SCRPT(11)=' ROT 6-4 ELOSS= -0.00543' SCRPT(12)=' ROT 7-5 ELOSS= -0.00641' SCRPT(13)=' ROT 8-6 ELOSS= -0.00740' SCRPT(14)=' ROT 9-7 ELOSS= -0.00839' SCRPT(15)=' ROT 10-8 ELOSS= -0.00937' SCRPT(16)=' ROT 11-9 ELOSS= -0.0104 ' SCRPT(17)=' ROT 12-10 ELOSS= -0.0113 ' SCRPT(18)=' ROT 13-11 ELOSS= -0.0123 ' SCRPT(19)=' ROT 14-12 ELOSS= -0.0133 ' SCRPT(20)=' ROT 15-13 ELOSS= -0.0143 ' SCRPT(21)=' ROT 16-14 ELOSS= -0.0153 ' SCRPT(22)=' ROT 17-15 ELOSS= -0.0163 ' SCRPT(23)=' ROT 18-16 ELOSS= -0.0173 ' SCRPT(24)=' ROT 19-17 ELOSS= -0.0183 ' SCRPT(25)=' ROT 20-18 ELOSS= -0.0192 ' SCRPT(26)=' ROT 21-19 ELOSS= -0.0202 ' SCRPT(27)=' ROT 22-20 ELOSS= -0.0212 ' SCRPT(28)=' ROT 23-21 ELOSS= -0.0222 ' SCRPT(29)=' ROT 24-22 ELOSS= -0.0232 ' SCRPT(30)=' ROT 25-23 ELOSS= -0.0242 ' SCRPT(31)=' ROT 26-24 ELOSS= -0.0252 ' SCRPT(32)=' ROT 27-25 ELOSS= -0.0261 ' SCRPT(33)=' ROT 28-26 ELOSS= -0.0271 ' SCRPT(34)=' ROT 29-27 ELOSS= -0.0281 ' SCRPT(35)=' ROT 0-2 ELOSS= 0.00148' SCRPT(36)=' ROT 1-3 ELOSS= 0.00247' SCRPT(37)=' ROT 2-4 ELOSS= 0.00345' SCRPT(38)=' ROT 3-5 ELOSS= 0.00444' SCRPT(39)=' ROT 4-6 ELOSS= 0.00543' SCRPT(40)=' ROT 5-7 ELOSS= 0.00641' SCRPT(41)=' ROT 6-8 ELOSS= 0.00740' SCRPT(42)=' ROT 7-9 ELOSS= 0.00839' SCRPT(43)=' ROT 8-10 ELOSS= 0.00937' SCRPT(44)=' ROT 9-11 ELOSS= 0.0104 ' SCRPT(45)=' ROT 10-12 ELOSS= 0.0113 ' SCRPT(46)=' ROT 11-13 ELOSS= 0.0123 ' SCRPT(47)=' ROT 12-14 ELOSS= 0.0133 ' SCRPT(48)=' ROT 13-15 ELOSS= 0.0143 ' SCRPT(49)=' ROT 14-16 ELOSS= 0.0153 ' SCRPT(50)=' ROT 15-17 ELOSS= 0.0163 ' SCRPT(51)=' ROT 16-18 ELOSS= 0.0173 ' SCRPT(52)=' ROT 17-19 ELOSS= 0.0183 ' SCRPT(53)=' ROT 18-20 ELOSS= 0.0192 ' SCRPT(54)=' ROT 19-21 ELOSS= 0.0202 ' SCRPT(55)=' ROT 20-22 ELOSS= 0.0212 ' SCRPT(56)=' ROT 21-23 ELOSS= 0.0222 ' SCRPT(57)=' ROT 22-24 ELOSS= 0.0232 ' SCRPT(58)=' ROT 23-25 ELOSS= 0.0242 ' SCRPT(59)=' ROT 24-26 ELOSS= 0.0252 ' SCRPT(60)=' ROT 25-27 ELOSS= 0.0261 ' SCRPT(61)=' ROT 26-28 ELOSS= 0.0271 ' SCRPT(62)=' ROT 27-29 ELOSS= 0.0281 ' SCRPT(63)=' VIB V1 ELOSS= 0.290 ' SCRPT(64)=' VIB 2V1 ELOSS= 0.590 ' SCRPT(65)=' VIB 3V1 ELOSS= 0.880 ' SCRPT(66)=' VIB 4V1 ELOSS= 1.17 ' SCRPT(67)=' VIB 5V1 ELOSS= 1.47 ' SCRPT(68)=' VIB 6V1 ELOSS= 1.76 ' SCRPT(69)=' VIB 7V1 ELOSS= 2.06 ' SCRPT(70)=' VIB 8V1 ELOSS= 2.35 ' SCRPT(71)=' EXC TRPLT1 ELOSS= 6.17 ' SCRPT(72)=' EXC TRPLT3 ELOSS= 7.35 ' SCRPT(73)=' EXC TRPLT5 ELOSS= 7.80 ' SCRPT(74)=' EXC SNGLT2 ELOSS= 8.55 ' SCRPT(75)=' EXC TRPLT7 ELOSS= 11.03 ' SCRPT(76)=' EXC TRPLT8 ELOSS= 11.87 ' SCRPT(77)=' EXC SNGLT5 ELOSS= 13.0 ' C EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP C C ELASTIC (+ROTATIONAL) DO 10 J=2,NELA IF(EN.LE.XELA(J)) GO TO 15 10 CONTINUE J=NELA 15 A=(YELA(J)-YELA(J-1))/(XELA(J)-XELA(J-1)) B=(XELA(J-1)*YELA(J)-XELA(J)*YELA(J-1))/(XELA(J-1)-XELA(J)) QELA=(A*EN+B)*1.0D-16 C C MOMENTUM TRANSFER DO 20 J=2,NMOM IF(EN.LE.XMOM(J)) GO TO 25 20 CONTINUE J=NMOM 25 A=(YMOM(J)-YMOM(J-1))/(XMOM(J)-XMOM(J-1)) B=(XMOM(J-1)*YMOM(J)-XMOM(J)*YMOM(J-1))/(XMOM(J-1)-XMOM(J)) QMOM=(A*EN+B)*1.0D-16 C PEQEL(2,I)=0.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LT.E(3)) GO TO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GO TO 40 30 CONTINUE J=NION 40 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON FOR C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISTRIBUTION SAME AS ELASTIC AT ENERGY OFFSET BY C IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 50 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C 50 Q(4,I)=0.0D0 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C--------------------------------------------------------------------- C QUADRUPOLE BORN ROTATIONAL STATES ( GERJUOY AND STEIN) C--------------------------------------------------------------------- C SUPERELASTIC ROTATION DO 51 K=1,28 AJ=DBLE(K+1) 51 QIN(K,I)=PJ(K+1)*QBK*SQRT(1.0-EIN(K)/EN)*AJ*(AJ-1.0)/((2.0*AJ+1.0 /)*(2.0*AJ-1.0)) C DO 52 K=29,56 52 QIN(K,I)=0.0D0 C INELASTIC ROTATION C ROT 0-2 IF(EN.LE.EIN(29)) GO TO 60 QIN(29,I)=FROT0*QBK*SQRT(1.0-EIN(29)/EN)*2.0/3.0 C ROT 1-3 AND HIGHER DO 53 K=30,56 AJ=DBLE(K-29) IF(EN.LE.EIN(K)) GO TO 60 53 QIN(K,I)=PJ(K-29)*QBK*SQRT(1.0-EIN(K)/EN)*(AJ+2.0)*(AJ+1.0)/((2.0 /*AJ+3.0)*(2.0*AJ+1.0)) C BORN (1/E) FALL OFF IN ROTATIONAL X-SECS ABOVE 6.0 EV 60 IF(EN.LT.6.0) GO TO 80 DO 70 K=1,56 70 QIN(K,I)=QIN(K,I)*6.0/EN C C--------------------------------------------------------------------- 80 CONTINUE C--------------------------------------------------------------------- QIN(57,I)=0.0D0 IF(EN.LE.EIN(57)) GO TO 110 DO 90 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 100 90 CONTINUE J=NVIB1 100 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(57,I)=(A*EN+B)*1.D-16 110 CONTINUE C QIN(58,I)=0.0D0 IF(EN.LE.EIN(58)) GO TO 140 DO 120 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 130 120 CONTINUE J=NVIB2 130 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(58,I)=(A*EN+B)*1.D-16 140 CONTINUE C QIN(59,I)=0.0D0 IF(EN.LE.EIN(59)) GO TO 170 DO 150 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 160 150 CONTINUE J=NVIB3 160 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(59,I)=(A*EN+B)*1.D-16 170 CONTINUE C QIN(60,I)=0.0D0 IF(EN.LE.EIN(60)) GO TO 200 DO 180 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 190 180 CONTINUE J=NVIB4 190 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(60,I)=(A*EN+B)*1.D-16 200 CONTINUE C QIN(61,I)=0.0D0 IF(EN.LE.EIN(61)) GO TO 230 DO 210 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 220 210 CONTINUE J=NVIB5 220 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(61,I)=(A*EN+B)*1.D-16 230 CONTINUE C QIN(62,I)=0.0D0 IF(EN.LE.EIN(62)) GO TO 260 DO 240 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 250 240 CONTINUE J=NVIB6 250 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(62,I)=(A*EN+B)*1.D-16 260 CONTINUE C QIN(63,I)=0.0D0 IF(EN.LE.EIN(63)) GO TO 330 DO 310 J=2,NVIB7 IF(EN.LE.XVIB7(J)) GO TO 320 310 CONTINUE J=NVIB7 320 A=(YVIB7(J)-YVIB7(J-1))/(XVIB7(J)-XVIB7(J-1)) B=(XVIB7(J-1)*YVIB7(J)-XVIB7(J)*YVIB7(J-1))/(XVIB7(J-1)-XVIB7(J)) QIN(63,I)=(A*EN+B)*1.D-16 330 CONTINUE C QIN(64,I)=0.0D0 IF(EN.LE.EIN(64)) GO TO 360 DO 340 J=2,NVIB8 IF(EN.LE.XVIB8(J)) GO TO 350 340 CONTINUE J=NVIB8 350 A=(YVIB8(J)-YVIB8(J-1))/(XVIB8(J)-XVIB8(J-1)) B=(XVIB8(J-1)*YVIB8(J)-XVIB8(J)*YVIB8(J-1))/(XVIB8(J-1)-XVIB8(J)) QIN(64,I)=(A*EN+B)*1.D-16 360 CONTINUE C QIN(65,I)=0.0D0 IF(EN.LE.EIN(65)) GO TO 450 DO 430 J=2,NTRP1 IF(EN.LE.XTRP1(J)) GO TO 440 430 CONTINUE J=NTRP1 440 A=(YTRP1(J)-YTRP1(J-1))/(XTRP1(J)-XTRP1(J-1)) B=(XTRP1(J-1)*YTRP1(J)-XTRP1(J)*YTRP1(J-1))/(XTRP1(J-1)-XTRP1(J)) QIN(65,I)=(A*EN+B)*1.D-16 450 CONTINUE C QIN(66,I)=0.0D0 IF(EN.LE.EIN(66)) GO TO 510 DO 490 J=2,NTRP3 IF(EN.LE.XTRP3(J)) GO TO 500 490 CONTINUE J=NTRP3 500 A=(YTRP3(J)-YTRP3(J-1))/(XTRP3(J)-XTRP3(J-1)) B=(XTRP3(J-1)*YTRP3(J)-XTRP3(J)*YTRP3(J-1))/(XTRP3(J-1)-XTRP3(J)) QIN(66,I)=(A*EN+B)*1.D-16 510 CONTINUE C QIN(67,I)=0.0D0 IF(EN.LE.EIN(67)) GO TO 570 DO 550 J=2,NTRP5 IF(EN.LE.XTRP5(J)) GO TO 560 550 CONTINUE J=NTRP5 560 A=(YTRP5(J)-YTRP5(J-1))/(XTRP5(J)-XTRP5(J-1)) B=(XTRP5(J-1)*YTRP5(J)-XTRP5(J)*YTRP5(J-1))/(XTRP5(J-1)-XTRP5(J)) QIN(67,I)=(A*EN+B)*1.D-16 570 CONTINUE C QIN(68,I)=0.0D0 IF(EN.LE.EIN(68)) GO TO 660 DO 640 J=2,NSNG2 IF(EN.LE.XSNG2(J)) GO TO 650 640 CONTINUE J=NSNG2 650 A=(YSNG2(J)-YSNG2(J-1))/(XSNG2(J)-XSNG2(J-1)) B=(XSNG2(J-1)*YSNG2(J)-XSNG2(J)*YSNG2(J-1))/(XSNG2(J-1)-XSNG2(J)) QIN(68,I)=(A*EN+B)*1.D-16 660 CONTINUE C QIN(69,I)=0.0D0 IF(EN.LE.EIN(69)) GO TO 720 DO 700 J=2,NTRP7 IF(EN.LE.XTRP7(J)) GO TO 710 700 CONTINUE J=NTRP7 710 A=(YTRP7(J)-YTRP7(J-1))/(XTRP7(J)-XTRP7(J-1)) B=(XTRP7(J-1)*YTRP7(J)-XTRP7(J)*YTRP7(J-1))/(XTRP7(J-1)-XTRP7(J)) QIN(69,I)=0.6666*(A*EN+B)*1.D-16 720 CONTINUE C QIN(70,I)=0.0D0 IF(EN.LE.EIN(70)) GO TO 750 DO 730 J=2,NTRP8 IF(EN.LE.XTRP8(J)) GO TO 740 730 CONTINUE J=NTRP8 740 A=(YTRP8(J)-YTRP8(J-1))/(XTRP8(J)-XTRP8(J-1)) B=(XTRP8(J-1)*YTRP8(J)-XTRP8(J)*YTRP8(J-1))/(XTRP8(J-1)-XTRP8(J)) QIN(70,I)=(A*EN+B)*1.D-16 750 CONTINUE C QIN(71,I)=0.0D0 IF(EN.LE.EIN(71)) GO TO 810 DO 790 J=2,NSNG5 IF(EN.LE.XSNG5(J)) GO TO 800 790 CONTINUE J=NSNG5 800 A=(YSNG5(J)-YSNG5(J-1))/(XSNG5(J)-XSNG5(J-1)) B=(XSNG5(J-1)*YSNG5(J)-XSNG5(J)*YSNG5(J-1))/(XSNG5(J-1)-XSNG5(J)) QIN(71,I)=(A*EN+B)*1.D-16 810 CONTINUE C C SUM=0.0D0 DO 898 K=1,56 SUM=SUM+QIN(K,I) 898 CONTINUE C GET CORRECT ELASTIC XSECTION BY SUBTRACTION OF ROTATION Q(2,I)=Q(2,I)-SUM SUM1=0.0D0 DO 899 K=57,71 SUM1=SUM1+QIN(K,I) 899 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+SUM+SUM1 900 CONTINUE C SAVE COMPUTE TIME DO 1000 K=1,71 J=72-K IF(EFINAL.LE.EIN(J)) NIN=J-1 1000 CONTINUE C END +DECK,GAS59. SUBROUTINE GAS59(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XELM(69),YELM(69),XVIBR(21),YVIBR(21), /XION(106),YION(106),XATT(10),YATT(10),XDIS1(28),YDIS1(28), /XEL(11),YEL(11) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XELM/0.00,.001,0.01,.012,.014,.017,0.02,.025,0.03,.035, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17, /0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80, /1.00,1.20,1.40,1.70,2.00,2.50,3.00,3.50,4.00,5.00, /6.00,7.00,8.00,9.00,10.0,12.0,15.0,20.0,30.0,40.0, /50.0,60.0,80.0,100.,150.,200.,300.,400.,500.,600., /800.,1000.,2000.,4000.,6000.,8000.,10000.,20000.,100000./ C ELASTIC MOMENTUM TRANSFER X-SECTION DATA YELM/106.,106.,106.,105.,104.,102.,100.,95.0,90.0,86.0, /83.0,76.5,70.5,65.5,60.5,55.5,51.0,43.0,32.5,20.5, /13.0,6.00,4.00,3.20,3.20,3.30,3.60,4.30,5.00,6.50, /9.50,12.5,16.5,21.0,26.0,28.5,30.0,30.5,30.0,28.5, /26.5,24.5,22.5,20.5,18.5,16.0,13.0,8.50,4.70,3.40, /2.50,2.10,1.55,1.20,0.85,0.65,0.55,0.40,0.35,0.30, /0.25,0.20,0.11,0.07,0.04,0.03,.025,.013,.002/ C ELASTIC X-SECTION (ONLY KNOWN IN LIMITED RANGE) DATA XEL/1.00,2.00,2.50,3.00,5.00,7.50,10.0,15.0,20.0,60.0, /100./ DATA YEL/11.5,28.5,33.0,40.5,51.5,48.0,41.0,30.5,24.0,8.00, /6.40/ C VIBRATION RESONANCE SHAPE FUNCTION C GAUSSIAN SHAPE FUNCTION AT 2.5 EV RESONANCE FWHM = 1.6 EV C PLUS A HIGH ENERGY TAIL DATA XVIBR/0.35,0.70,1.00,1.30,1.60,1.90,2.20,2.50,3.00,3.50, /4.00,4.50,5.00,5.50,6.00,6.50,10.0,100.,1000.,10000., /100000./ DATA YVIBR/0.00,0.16,0.47,1.14,2.25,3.65,4.90,5.40,4.90,3.65, /2.25,1.14,0.47,0.16,0.04,0.02,.001,.0001,.00001,.000001, /.0000001/ C USE BEB VALUES FOR IONISATION DATA XION/11.33,11.5,12.0,12.5,13.0,13.5,14.0,14.5,15.0,15.5, /16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0,20.5, /21.0,21.5,22.0,22.5,23.0,23.5,24.0,26.0,28.0,30.0, /32.0,34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,65.0, /70.0,75.0,80.0,85.0,90.0,95.0,100.,105.,110.,115., /120.,125.,130.,135.,140.,145.,150.,160.,170.,180., /190.,200.,210.,220.,230.,240.,250.,300.,350.,400., /450.,500.,550.,600.,650.,700.,750.,800.,850.,900., /950.,1000.,1100.,1200.,1300.,1400.,1500.,1600.,1700.,1800., /1900.,2000.,2200.,2400.,2700.,3000.,4000.,5000.,6000.,8000., /10000.,15000.,20000.,40000.,70000.,100000./ DATA YION/0.00,.050,.202,.359,.518,.676,.832,.986,1.14,1.28, /1.42,1.56,1.69,1.82,1.94,2.06,2.17,2.28,2.38,2.49, /2.60,2.70,2.80,2.90,2.99,3.08,3.16,3.47,3.74,3.96, /4.16,4.32,4.46,4.58,4.68,4.88,5.04,5.15,5.22,5.26, /5.27,5.27,5.26,5.24,5.20,5.16,5.12,5.08,5.03,4.98, /4.92,4.87,4.82,4.76,4.71,4.66,4.60,4.50,4.40,4.31, /4.21,4.12,4.04,3.95,3.87,3.80,3.72,3.39,3.12,2.88, /2.69,2.52,2.37,2.23,2.12,2.01,1.92,1.84,1.76,1.69, /1.62,1.56,1.46,1.37,1.29,1.22,1.15,1.10,1.05,1.00, /.960,.922,.854,.797,.724,.665,.524,.435,.372,.291, /.240,.169,.131,.071,.043,.031/ C ATTACHMENT X-SECTION ( NO DATA) DATA XATT/7.00,7.50,8.00,8.50,9.00,9.50,10.0,10.5,11.0,11.5/ DATA YATT/10*0.0/ C EXCITATION AND DISSOCIATION DATA XDIS1/7.50,8.50,10.0,12.5,15.0,20.0,25.0,30.0,40.0,60.0, /80.0,100.,150.,200.,300.,400.,500.,750.,1000.,1500., /2000.,3000.,4000.,6000.,8000.,10000.,20000.,100000./ DATA YDIS1/0.00,1.80,4.50,5.70,6.50,7.00,7.25,7.25,7.00,6.50, /6.00,5.50,4.80,4.00,3.00,2.50,2.00,1.40,1.00,0.80, /0.60,0.40,0.30,0.20,0.18,0.16,0.08,0.02/ C C ****************************************************************** C ISOTROPIC FIT TO DRIFT DIFFUSION DATA IN ARGON / GEH4 MIXTURES OF C SOEJIMA AND NAKAMURA J VAC SCI TECHNOL A 11 (1993) 1161-1164 C OTHER ELECTRON SCATTERING REFERENCES : C DILLON ET AL J.PHYS B 26(1993)3147 C KARWASZ J.PHYS B 28(1995)1301 C MOZEJKO ET AL J.PHYS.B 29(1996)L571 C IONISATION X-SECTION FROM BEB THEORY OF KIM ET AL NIST WEB PAGE C C C COMBINED EXCITATION AND DISSOCIATION X-SECTION FROM CONSISTENT C SUM OF ELASTIC, VIBRATION ,IONISATION AND EXCITATION/DISSOCIATION C TO GIVE EXPERIMENTAL VALUES OF THE TOTAL X-SECTION. C C ANALYSIS SUMMARY : DRIFT AND DIFFUSION DATA CONSTRAIN VIBRATIONAL C X-SECTION BUT ARE ONLY SENSITIVE TO THE ELASTIC X-SECTION BELOW C 0.2EV . VALUES OF THE ELASTIC X-SECTION ABOVE 1 EV ARE CONSTRAINED C BY THE ELECTRON SCATTERING MEASUREMENTS OF DILLON ET AL. C THE ELASTIC X-SECTION IN THE RAMSAUER DIP REGION BETWEEN 0.2 AND C 1.0 EV IS NOT CONSTRAINED BY THE DATA AND ONLY MEASUREMENTS OF DRIFT C AND DIFFUSION IN PURE GERMANE WILL ALLOW A COMPLETE ANALYSIS C C -------------------------------------------------------------------- C********************************************************************** NAME='Germane (2005)' C********************************************************************** NIN=6 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C NDATA=69 NVIBR=21 NION=106 NATT=10 NDIS1=28 E(1)=0.0 E(2)=2.0*EMASS/(76.6418*AMU) E(3)=11.33 E(4)=0.0 E(5)=0.0 E(6)=0.0 C OPAL AND BEATY ENERGY SPLITTING FACTOR EOBY=E(3) EIN(1)=-0.1016 EIN(2)=0.1016 EIN(3)=0.2611 EIN(4)=0.35 EIN(5)=0.50 EIN(6)=7.5 SCRPT(1)=' ' SCRPT(2)=' ELASTIC GERMANE ' SCRPT(3)=' IONISATION ELOSS= 11.33 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V2+V4 ELOSS= -0.1016 ' SCRPT(8)=' VIB V2+V4 ELOSS= 0.1016 ' SCRPT(9)=' VIB V1+V3 ELOSS= 0.2611 ' SCRPT(10)=' VIB HAR ELOSS= 0.350 ' SCRPT(11)=' VIB HAR ELOSS= 0.500 ' SCRPT(12)=' EXC+DISSOC ELOSS= 7.5 ' APOP=DEXP(EIN(1)/AKT) C EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP C USE LOG INTERPOLATION FOR ELASTIC IF(EN.LE.XELM(2)) THEN QMOM=YELM(2)*1.D-16 GO TO 30 ENDIF DO 3 J=2,NDATA IF(EN.LE.XELM(J)) GO TO 4 3 CONTINUE J=NDATA 4 XNJ=DLOG(XELM(J)) XNJ1=DLOG(XELM(J-1)) YXJ=DLOG(YELM(J)) YXJ1=DLOG(YELM(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=DEXP(A*DLOG(EN)+B)*1.D-16 30 CONTINUE PEQEL(2,I)=0.5D0 Q(2,I)=QMOM C C IONISATION C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C C ATTACHMENT C 200 Q(4,I)=0.0D0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(10)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 C 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C V4 + V2 SUPERELASTIC QIN(1,I)=0.0D0 IF(EN.LE.0.0) GO TO 350 IF((EN+EIN(2)).LE.XVIBR(1)) GO TO 330 DO 310 J=2,NVIBR IF((EN+EIN(2)).LE.XVIBR(J)) GO TO 320 310 CONTINUE J=NVIBR 320 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(1,I)=1.50*((EN+EIN(2))*(A*(EN+EIN(2))+B)/EN) 330 CONTINUE EFAC=DSQRT(1.0-(EIN(1)/EN)) QDIPOL=0.825*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)+QDIPOL QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V4 + V2 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 IF(EN.LE.XVIBR(1)) GO TO 380 DO 360 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 370 360 CONTINUE J=NVIBR 370 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(2,I)=1.50*(A*EN+B) 380 CONTINUE EFAC=DSQRT(1.0-(EIN(2)/EN)) QDIPOL=0.825*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)+QDIPOL QIN(2,I)=QIN(2,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C V1 + V3 QIN(3,I)=0.0D0 IF(EN.LE.EIN(3)) GO TO 500 IF(EN.LE.XVIBR(1)) GO TO 430 DO 410 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 420 410 CONTINUE J=NVIBR 420 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(3,I)=0.84*(A*EN+B) 430 CONTINUE EFAC=DSQRT(1.0-(EIN(3)/EN)) QDIPOL=0.530*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(3,I)=(QDIPOL+QIN(3,I))*1.D-16 500 CONTINUE C C VIBRATION HARMONICS 1 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 520 510 CONTINUE J=NVIBR 520 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(4,I)=0.113*(A*EN+B)*1.D-16 600 CONTINUE C C VIBRATION HARMONICS 2 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 620 610 CONTINUE J=NVIBR 620 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(5,I)=0.074*(A*EN+B)*1.D-16 700 CONTINUE C C EXCITATION + DISSOCIATION QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 850 DO 810 J=2,NDIS1 IF(EN.LE.XDIS1(J)) GO TO 820 810 CONTINUE J=NDIS1 820 A=(YDIS1(J)-YDIS1(J-1))/(XDIS1(J)-XDIS1(J-1)) B=(XDIS1(J-1)*YDIS1(J)-XDIS1(J)*YDIS1(J-1))/(XDIS1(J-1)-XDIS1(J)) QIN(6,I)=(A*EN+B)*1.D-16 850 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I) C 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 C RETURN END +DECK,GAS60. SUBROUTINE GAS60(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) DIMENSION XELM(48),YELM(48),XVIBR(21),YVIBR(21), /XION(106),YION(106),XATT(10),YATT(10),XDIS1(28),YDIS1(28), /XEL(12),YEL(12) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER X-SECTION DATA XELM/0.00,.001,.004,0.01,.014,0.02,0.03,0.04,0.05,0.06, /0.07,0.08,0.10,0.12,0.14,0.17,0.20,0.30,0.40,0.50, /0.60,0.70,0.80,1.00,1.20,1.40,1.80,2.15,2.65,3.00, /4.00,5.00,7.50,10.0,15.0,20.0,40.0,70.0,100.,150., /200.,400.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YELM/50.0,50.0,48.5,47.0,44.5,41.5,36.0,29.0,24.0,18.0, /14.5,11.5,7.50,4.80,2.65,1.60,1.20,0.95,0.95,1.05, /1.20,1.50,2.00,4.60,10.0,19.5,29.5,31.5,31.5,28.5, /24.5,25.5,23.0,16.0,11.5,9.50,5.00,3.00,1.50,0.90, /0.63,0.28,0.18,0.10,0.05,.0048,.0018,.00009/ C ELASTIC X-SECTION (ONLY KNOWN IN LIMITED RANGE) DATA XEL/1.80,2.15,2.65,3.00,4.00,5.00,7.50,10.0,15.0,20.0, /40.0,100./ DATA YEL/30.0,32.0,35.0,36.5,40.0,44.5,47.0,40.0,29.0,21.0, /15.0,5.00/ C VIBRATION RESONANCE SHAPE FUNCTION C GAUSSIAN SHAPE FUNCTION AT 2.35 EV RESONANCE FWHM = 1.5 EV C PLUS A HIGH ENERGY TAIL DATA XVIBR/0.35,0.73,1.00,1.27,1.54,1.81,2.08,2.35,2.80,3.25, /3.70,4.15,4.60,5.05,5.50,5.95,10.0,100.,1000.,10000., /100000./ DATA YVIBR/0.00,0.16,0.47,1.14,2.25,3.65,4.90,5.40,4.90,3.65, /2.25,1.14,0.47,0.16,0.08,0.06,0.05,.005,.0001,.00001, /.000001/ C USE BEB VALUES FOR IONISATION DATA XION/11.65,12.0,12.5,13.0,13.5,14.0,14.5,15.0,15.5,16.0, /16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0,20.5,21.0, /21.5,22.0,22.5,23.0,23.5,24.0,26.0,28.0,30.0,32.0, /34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,65.0,70.0, /75.0,80.0,85.0,90.0,95.0,100.,105.,110.,115.,120., /125.,130.,135.,140.,145.,150.,160.,170.,180.,190., /200.,210.,220.,230.,240.,250.,300.,350.,400.,450., /500.,550.,600.,650.,700.,750.,800.,850.,900.,950., /1000.,1100.,1200.,1300.,1400.,1500.,1600.,1700.,1800.,1900., /2000.,2200.,2400.,2700.,3000.,4000.,5000.,6000.,8000.,10000., /14000.,20000.,30000.,40000.,60000.,100000./ DATA YION/0.00,.112,.276,.444,.613,.780,.945,1.11,1.26,1.42, /1.56,1.70,1.84,1.97,2.10,2.22,2.34,2.45,2.57,2.68, /2.79,2.90,3.00,3.10,3.20,3.29,3.62,3.90,4.14,4.34, /4.51,4.65,4.78,4.88,5.06,5.17,5.23,5.25,5.24,5.21, /5.17,5.12,5.06,5.00,4.93,4.87,4.80,4.73,4.66,4.59, /4.52,4.45,4.39,4.32,4.26,4.20,4.08,3.96,3.86,3.75, /3.66,3.56,3.48,3.39,3.31,3.24,2.90,2.64,2.42,2.24, /2.08,1.94,1.83,1.73,1.64,1.56,1.48,1.42,1.36,1.30, /1.25,1.16,1.09,1.02,.963,.912,.866,.825,.788,.754, /.724,.670,.623,.566,.518,.407,.337,.288,.225,.185, /.138,.101,.070,.054,.038,.024/ C ATTACHMENT X-SECTION ( NB *10**19 ) DATA XATT/7.00,7.50,8.00,8.50,9.00,9.50,10.0,10.5,11.0,11.5/ DATA YATT/0.00,5.00,10.0,16.0,10.0,5.00,1.00,0.10,0.01,.001/ C EXCITATION AND DISSOCIATION DATA XDIS1/8.00,9.00,10.0,12.0,15.0,20.0,25.0,30.0,40.0,60.0, /80.0,100.,150.,200.,300.,400.,500.,750.,1000.,1500., /2000.,3000.,4000.,6000.,8000.,10000.,20000.,100000./ DATA YDIS1/0.00,2.00,3.80,5.10,5.90,6.60,6.80,6.80,6.80,6.60, /6.00,5.50,4.80,4.00,3.00,2.50,2.00,1.40,1.00,0.80, /0.60,0.40,0.30,0.20,0.18,0.16,0.08,0.02/ C C ********************************************************************* C FIT TO SILANE: C DRIFT VELOCITY : C W.J.POLLOCK TRANS FARADAY SOC. 64(1968)2919 C TRANSVERSE DIFF : C MILLICAN AND WALKER J.PHYS.D 20(1987)193 C TOWNSEND COEFICIENTS : C SHIMOZUMA AND TAGASHIRA J.PHYS.D 19(1986)L179 C ----------------------------------------------------------- C FIT TO MIXTURE DATA : C ARGON/SILANE: DL AND VD C KURACHI AND NAKAMURA J.PHYS.D 21(1988)602 C ARGON/KRYPTON: DL AND VD C KURACHI AND NAKAMURA IEEE TRANS PLASMA SCI. 19(1991)262 C C*********************************************************************** NAME='Silane (2005)' C*********************************************************************** NIN=6 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C C USE ANISOTROPIC SCATTERING FROM LEVEL 2 AND 3 (V24 AND V13) KIN(2)=1 KIN(3)=1 C RAT=1.0 NDATA=48 NVIBR=21 NION=106 NATT=10 NDIS1=28 E(1)=0.0 E(2)=2.0*EMASS/(32.1173*AMU) E(3)=11.65 E(4)=0.0 E(5)=0.0 E(6)=0.0 C OPAL AND BEATY ENERGY SPLITTING FACTOR EOBY=E(3) EIN(1)=-0.1128 EIN(2)=0.1128 EIN(3)=0.2707 EIN(4)=0.35 EIN(5)=0.50 EIN(6)=8.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC SILANE ' SCRPT(3)=' IONISATION ELOSS= 11.65 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V2+V4 ELOSS= -0.1128 ' SCRPT(8)=' VIB V2+V4 ELOSS= 0.1128 ' SCRPT(9)=' VIB V1+V3 ELOSS= 0.2707 ' SCRPT(10)=' VIB HAR ELOSS= 0.350 ' SCRPT(11)=' VIB HAR ELOSS= 0.500 ' SCRPT(12)=' EXC+DISSOC ELOSS= 8.0 ' APOP=DEXP(EIN(1)/AKT) C EN=-ESTEP/2.0D0 DO 1000 I=1,NSTEP EN=EN+ESTEP C USE LOG INTERPOLATION FOR ELASTIC IF(EN.LE.XELM(2)) THEN QMOM=YELM(2)*1.D-16 GO TO 30 ENDIF DO 3 J=2,NDATA IF(EN.LE.XELM(J)) GO TO 4 3 CONTINUE J=NDATA 4 XNJ=DLOG(XELM(J)) XNJ1=DLOG(XELM(J-1)) YXJ=DLOG(YELM(J)) YXJ1=DLOG(YELM(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=DEXP(A*DLOG(EN)+B)*1.D-16 30 CONTINUE PEQEL(2,I)=0.5D0 Q(2,I)=QMOM C C IONISATION C Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C C ATTACHMENT C 200 Q(4,I)=0.0D0 IF(EN.LE.XATT(1)) GO TO 300 IF(EN.GT.XATT(10)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 C 300 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C C V4 + V2 SUPERELASTIC QIN(1,I)=0.0D0 QRES=0.0D0 IF(EN.LE.0.0) GO TO 350 IF((EN+EIN(2)).LE.XVIBR(1)) GO TO 330 DO 310 J=2,NVIBR IF((EN+EIN(2)).LE.XVIBR(J)) GO TO 320 310 CONTINUE J=NVIBR 320 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QRES=1.40*((EN+EIN(2))*(A*(EN+EIN(2))+B)/EN) 330 CONTINUE EFAC=DSQRT(1.0-(EIN(1)/EN)) QDIPOL=0.660*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=(QRES+QDIPOL)*1.D-16 QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP) 350 CONTINUE C C V4 + V2 QIN(2,I)=0.0D0 QRES=0.0D0 IF(EN.LE.EIN(2)) GO TO 400 IF(EN.LE.XVIBR(1)) GO TO 380 DO 360 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 370 360 CONTINUE J=NVIBR 370 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QRES=1.40*(A*EN+B) 380 CONTINUE EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.660*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(2) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C RATIO OF MT TO TOTAL X-SECT FOR RESONANCE PART = RAT XMT=((1.5-FWD/(FWD+BCK))*QIN(2,I)+RAT*QRES)*1.D-16 QIN(2,I)=(QIN(2,I)+QRES)*1.D-16 PEQIN(2,I)=0.5+(QIN(2,I)-XMT)/QIN(2,I) QIN(2,I)=QIN(2,I)/(1.0+APOP) 400 CONTINUE C C V1 + V3 QIN(3,I)=0.0D0 QRES=0.0D0 IF(EN.LE.EIN(3)) GO TO 500 IF(EN.LE.XVIBR(1)) GO TO 430 DO 410 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 420 410 CONTINUE J=NVIBR 420 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QRES=0.65*(A*EN+B) 430 CONTINUE EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.418*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(3) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C RATIO OF MT TO TOTAL X-SECT FOR RESONANCE PART = RAT XMT=((1.5-FWD/(FWD+BCK))*QIN(3,I)+RAT*QRES)*1.D-16 QIN(3,I)=(QIN(3,I)+QRES)*1.D-16 PEQIN(3,I)=0.5+(QIN(3,I)-XMT)/QIN(3,I) 500 CONTINUE C C VIBRATION HARMONICS 1 QIN(4,I)=0.0D0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 520 510 CONTINUE J=NVIBR 520 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(4,I)=0.134*(A*EN+B)*1.D-16 600 CONTINUE C C VIBRATION HARMONICS 2 QIN(5,I)=0.0D0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIBR IF(EN.LE.XVIBR(J)) GO TO 620 610 CONTINUE J=NVIBR 620 A=(YVIBR(J)-YVIBR(J-1))/(XVIBR(J)-XVIBR(J-1)) B=(XVIBR(J-1)*YVIBR(J)-XVIBR(J)*YVIBR(J-1))/(XVIBR(J-1)-XVIBR(J)) QIN(5,I)=0.094*(A*EN+B)*1.D-16 700 CONTINUE C C EXCITATION + DISSOCIATION QIN(6,I)=0.0D0 IF(EN.LE.EIN(6)) GO TO 850 DO 810 J=2,NDIS1 IF(EN.LE.XDIS1(J)) GO TO 820 810 CONTINUE J=NDIS1 820 A=(YDIS1(J)-YDIS1(J-1))/(XDIS1(J)-XDIS1(J-1)) B=(XDIS1(J-1)*YDIS1(J)-XDIS1(J)*YDIS1(J-1))/(XDIS1(J-1)-XDIS1(J)) QIN(6,I)=(A*EN+B)*1.D-16 850 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I) C 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 C RETURN END +DECK,GAS61. SUBROUTINE GAS61(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) +SEQ,CNSTS. +SEQ,INPT. DIMENSION PEQEL(6,2048),PEQIN(220,2048),KIN(220),KEL(6) DIMENSION Q(6,2048),QIN(220,2048),E(6),EIN(220) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME NAME='Dummy' C --------------------------------------------------------------------- C DUMMY ROUTINE C --------------------------------------------------------------------- NIN=0 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 E(1)=0.0 E(2)=0.0 E(3)=0.0 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=0.0 SCRPT(1)=' ' SCRPT(2)=' ELASTIC DUMMY ' SCRPT(3)=' IONISATION ELOSS= ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' EN=-ESTEP/2.0D0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0D0 Q(3,I)=0.0D0 Q(4,I)=0.0D0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME END *** End of magboltz-7.car ***