C PROGRAM MAGBOLTZ 2 VERSION 8.97 SEPTEMBER 2011 C -------------------------------------------------------------------- C COPYRIGHT 2011 STEPHEN FRANCIS BIAGI C---------------------------------------------------------------------- C VERSION 8.97 UPDATE FOR KRYPTON WITH 51 LEVELS C---------------------------------------------------------------------- C VERSION 8.96 UPDATE FOR ARGON WITH SMALL INCREASE IN EXCITATION C X-SECTIONS IN RESONANCE REGION FOR S-LEVELS C AND COMPENSATING INCREASE IN ELASTIC MOMENTUM TRANSFER C X-SECTION AT THE MAXIMUM (11 EV) C ---------------------------------------------------------------------- C VERSION 8.95 NEW GAS(44) TRIMETHYL AMINE TMA USED AS LIGHT EMITTER IN C WIRE CHAMBERS AND DOPANT IN PENNING DOPANT IN XENON C --------------------------------------------------------------------- C VERSION 8.94 UPDATED XENON IONISATION X-SECTION (FROM OZKAN SAHIN) C---------------------------------------------------------------------- C VERSION 8.93 UPDATED XENON IONISATION X-SECTION C---------------------------------------------------------------------- C VERSION 8.92 INCLUDED HYDROGEN UPDATE WITH 106 LEVELS C---------------------------------------------------------------------- C VERSION 8.91 INCLUDED C2H2F4 UPDATE C---------------------------------------------------------------------- C VERSION 8.9 INCLUDED NEON UPDATE WITH 45 LEVELS C---------------------------------------------------------------------- C VERSION 8.8 INCLUDED HELIUM UPDATE WITH 49 LEVELS C REMOVED CONTROL ON PENNING IN PURE GASES WHICH NOW ALLOWS C CALCULATION OF HORNBECK-MOLNAR IONISATION AS A PSEUDO-PENNING EFFECT C---------------------------------------------------------------------- C VERSION 8.7 INCLUDED XENON UPDATE WITH 50 LEVELS C---------------------------------------------------------------------- C VERSION 8.6 INCLUDED ARGON UPDATE WITH 44 LEVELS C--------------------------------------------------------------------- C VERSION 8.5 CORRECTION FOR MISSING LINE IN SUBROUTINE MONTEA WHICH C CAUSED ERRORS IN VERSIONS 8.4,8.3 AND 8.2 WHEN A MAGNETIC C FIELD WAS INCLUDED PARALLEL TO THE E FIELD C----------------------------------------------------------------------- C VERSION 8.4 INCLUDED ISOBUTANE UPDATE C---------------------------------------------------------------- C VERSION 8.3 INCLUDED NITROGEN UPDATE C --------------------------------------------------------------------- C VERSION 8.2 INTRODUCED ALTERNATIVE FORMALISM FOR ANGULAR DISTRIBUTION C REF: PHYS.REV.65E 037402 OKHRIMOVSKYY ET AL. C INTRODUCED CONTROL FOR ANGULAR DISTRIBUTION GIVING C CHOICE OF TWO DIFFERENT ANISOTROPIC SCAT. FORMALISMS. C INCREASED DECORRELATION TO 200000 COLLISIONS C INCLUDED PENNING TRANSFER EFFICIENCY C INCREASED ENERGY SEGEMENTATION FROM 2000 TO 4000 STEPS 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 VERSION 7.2 CHANGED RANDOM NUMBER GENERATOR FROM drand48 TO RM48.F C ALL INTEGERS MADE INTEGER*8 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 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) = 30/CM AT NTP. C WHERE ABS= MAGNITUDE , ALPHA=GAIN COEFICIENT AND ATT=ATTACHMENT. C ( FOR SMALLER VALUES OF ABS(ALPHA-ATT) < 30/CM , THE CHANGE OF THE C GAIN OR ATTACHMENT IS TYPICALLY LESS THAN 3% FOR THE SOLUTION WITHOUT C SPATIAL GRADIENTS ). C----------------------------------------------------------------------- C -------------------------------------------------------------------- C THE INPUT CONTROL FLAG IPEN WHEN SET TO 1 ALLOWS SOME PENNING CALCS: C C ESTIMATES OF THE PENNING EFFECT AT HIGH FIELD CAN BE OBTAINED BY C EDITING THE ARRAY PENFRA(3,220) IN THE GAS DATA BASE SUBROUTINES. C THE PROGRAM CAN THEN BE RECOMPILED AND RUN. THE OUTPUT THEN CONTAINS C INFORMATION ON THE PENNING FRACTION USED IN THE CALCULATION. 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 THE FIRST ENTRY PENFRA(1,N) IS THE FRACTION OF THE EXCITED STATE N C THAT WILL TRANSFER TO IONISE THE LOWER IONISATION LEVELS IN THE GAS C MIXTURE. C THE SECOND ENTRY ,PENFRA(2,N) IS THE DELOCALISATION LENGTH OF THE C TRANSFER I.E. THE AVERAGE DISTANCE THAT THE EXCITED GAS WILL TRAVEL C BEFORE THE TRANSFER ( OR IN CASE OF PHOTON EMISSION AND CAPTURE) C THE AVERAGE DISTANCE TRAVELLED BY THE PHOTON) C THE THIRD ENTRY , PENFRA(3,N) IS THE DECAY TIME OF THE EXCITED STATE C IN THE MIXTURE. C NB DELOCALISATION DISTANCE IS IN MICRONS AND DECAY TIME IN PICOSECS. C THERE IS NO AUTOMATIC METHOD FOR CHOOSING THE PENNING FRACTION BUT C YOU WILL FIND THAT THE ARRAY PENFRA(1,220) FOR HELIUM HAS BEEN SET TO C 1.0 (100%) THIS IS THE ONLY CORRECT CHOICE FOR THIS GAS WITH ANY OTHER C GAS MIXED IN. SIMILARLY THE NEON PENNING FRACTION SHOULD BE BETWEEN C 0.3 AND 0.7 (30 TO 70 %) . ARGON WHEN MIXED WITH HYDROCARBONS OTHER C THAN METHANE GIVES PENNING FRACTIONS OF 0 TO 30%. C IF DIFFICULTY OCCURS CONTACT THE AUTHOR. C 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: 3I10,F10.5 : NGAS,NMAX,IPEN,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 IPEN = 0 PENNING EFFECTS NOT INCLUDED C = 1 PENNING EFFECTS INCLUDED (SEE INSTRUCTIONS ABOVE) 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 : EFIELD,BMAG,BTHETA C EFIELD : 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 (2008) 5* C GAS2 : ARGON (2011) 5* C GAS3 : HELIUM 4 (2010) 5* C GAS4 : HELIUM 3 (2010) 5* C GAS5 : NEON (2010) 5* C GAS6 : KRYPTON (2011) 4* C GAS7 : XENON (2011) 4* C GAS8 : METHANE (2008) 5* C GAS9 : ETHANE (1999) 5* C GAS10 : PROPANE (1999) 4* C GAS11 : ISOBUTANE (2009) 4* C GAS12 : CO2 (2007) 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 (2008) 5* 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 (2010) 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 : C2H2F4 (2010) UPDATE WITH DE URQUIJO MIXTURE DATA 3* C GAS44 : TMA N-(CH3)3 (2011) 3* C GAS45 : C GAS46 : C GAS47 : C GAS48 : C GAS49 : 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 GAS61-80 :DUMMY ROUTINES C------------------------------------------------------------------ C PROGRAM MAGBOLTZ 2 IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/CTOWNS/ALPHA,ATT 1 CALL SETUP(LAST) IF(LAST.EQ.1) GO TO 99 IF(EFINAL.GT.0.0D0) GO TO 3 C CALCULATE EFINAL (START AT 0.5 EV. IF E/P GT 15 START AT 8.0 EV.) EFINAL=0.5D0 EOP=EFIELD*(TEMPC+273.15D0)/(TORR*293.15D0) IF(EOP.GT.15.0D0) EFINAL=8.0D0 ESTART=EFINAL/50.0D0 2 CALL MIXER C LOOP TO CALCULATE EFINAL IF(BMAG.EQ.0.0D0.OR.BTHETA.EQ.0.0D0.OR.DABS(BTHETA).EQ.180.0D0) /THEN CALL ELIMIT(IELOW) GO TO 10 ENDIF IF(BTHETA.EQ.90.0D0) THEN CALL ELIMITB(IELOW) GO TO 10 ELSE CALL ELIMITC(IELOW) ENDIF 10 IF(IELOW.EQ.1) THEN EFINAL=EFINAL*DSQRT(2.0D0) ESTART=EFINAL/50.0D0 GO TO 2 ENDIF GO TO 4 3 CALL MIXER 4 CONTINUE CALL PRNTER IF(BMAG.EQ.0.0D0) CALL MONTE IF(BMAG.NE.0.0D0) THEN IF(BTHETA.EQ.0.0D0.OR.BTHETA.EQ.180.0D0) THEN CALL MONTEA ELSE IF(BTHETA.EQ.90.0D0) THEN CALL MONTEB ELSE CALL MONTEC ENDIF ENDIF C IF(SPEC(4000).GT.500.0D0) THEN C WRITE(6,50) C 50 FORMAT(' WARNING COMPUTATION STOPPED INCREASE ELECTRON ENERGY INT C /EGRATION RANGE ') C STOP C ENDIF CALL OUTPUT C IF ATTACHMENT OR IONISATION RATE IS GREATER THAN SSTMIN THEN INCLUDE C 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) C******************* SSTMIN=30.0D0 C SSTMIN=60.0D0 C***************** IF(DABS(ALPP-ATTP).GT.SSTMIN) GO TO 5 IF(ALPP.GT.SSTMIN.OR.ATTP.GT.SSTMIN) GO TO 5 CALL OUTPUT2 GO TO 1 5 IF(BMAG.EQ.0.0D0) THEN CALL ALPCALC ELSE IF(BTHETA.EQ.0.0D0.OR.BTHETA.EQ.180.0D0) THEN CALL ALPCLCA ELSE IF(BTHETA.EQ.90.0D0) THEN CALL ALPCLCB ELSE CALL ALPCLCC ENDIF CALL OUTPUT2 GO TO 1 99 STOP END SUBROUTINE ANGCUT(PSCT1,ANGC,PSCT2) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) C -------------------------------------------------------------- C SET ANGLE CUTS ON ANGULAR DISTRIBUTION AND RENORMALISE FORWARD C SCATTERING PROBABILITY C --------------------------------------------------------------- ANGC=1.0D0 PSCT2=PSCT1 IF(PSCT1.LE.1.0D0) RETURN API=DACOS(-1.0D0) RADS=2.0D0/API CNS=PSCT1-0.5D0 THETAC=DASIN(2.0D0*DSQRT(CNS-CNS*CNS)) FAC=(1.0D0-DCOS(THETAC))/(DSIN(THETAC)*DSIN(THETAC)) PSCT2=(CNS*FAC)+0.5D0 ANGC=THETAC*RADS RETURN END SUBROUTINE MIXER IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/RATIO/AN1,AN2,AN3,AN4,AN5,AN6,AN,FRAC(6) COMMON/GASN/NGASN(6) COMMON/MIX1/QELM(4000),QSUM(4000),QION(6,4000),QIN1(220,4000), /QIN2(220,4000),QIN3(220,4000),QIN4(220,4000),QIN5(220,4000), /QIN6(220,4000),QSATT(4000) COMMON/MIX2/E(4000),EROOT(4000),QTOT(4000),QREL(4000), /QINEL(4000),QEL(4000) COMMON/MIX3/NIN1,NIN2,NIN3,NIN4,NIN5,NIN6,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) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),IPLAST,ISIZE,PENFRA(3,512) COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO COMMON/FRED/FCION(4000),FCATT(4000) COMMON/MRATIO/VAN1,VAN2,VAN3,VAN4,VAN5,VAN6,VAN COMMON/NAMES/NAMEG(6) COMMON/SCRIP/DSCRPT(512) CHARACTER*15 NAMEG,NAME1,NAME2,NAME3,NAME4,NAME5,NAME6 CHARACTER*30 DSCRPT,SCRP1(226),SCRP2(226),SCRP3(226),SCRP4(226), /SCRP5(226),SCRP6(226) DIMENSION Q1(6,4000),Q2(6,4000),Q3(6,4000),Q4(6,4000), /Q5(6,4000),Q6(6,4000) DIMENSION E1(6),E2(6),E3(6),E4(6),E5(6),E6(6),EI1(220),EI2(220), /EI3(220),EI4(220),EI5(220),EI6(220) DIMENSION QQROT(4000),QDROT(4000),QATT(6,4000),EION(6) DIMENSION PEQEL1(6,4000),PEQEL2(6,4000),PEQEL3(6,4000), /PEQEL4(6,4000),PEQEL5(6,4000),PEQEL6(6,4000) DIMENSION PEQIN1(220,4000),PEQIN2(220,4000),PEQIN3(220,4000), /PEQIN4(220,4000),PEQIN5(220,4000),PEQIN6(220,4000) DIMENSION PENFRA1(3,220),PENFRA2(3,220),PENFRA3(3,220), /PENFRA4(3,220),PENFRA5(3,220),PENFRA6(3,220) DIMENSION KIN1(220),KIN2(220),KIN3(220),KIN4(220),KIN5(220), /KIN6(220) DIMENSION KEL1(6),KEL2(6),KEL3(6),KEL4(6),KEL5(6),KEL6(6) C C --------------------------------------------------------------------- C C SUBROUTINE MIXER FILLS ARRAYS OF COLLISION FREQUENCY C CAN HAVE A MIXTURE OF UP TO 6 GASES C C C --------------------------------------------------------------------- C NISO=0 NIN1=0 NIN2=0 NIN3=0 NIN4=0 NIN5=0 NIN6=0 N4000=4000 NONE=1 DO 2 J=1,6 NAMEG(J)='---------------' KEL1(J)=0 KEL2(J)=0 KEL3(J)=0 KEL4(J)=0 KEL5(J)=0 KEL6(J)=0 DO 1 I=1,4000 Q1(J,I)=0.0D0 Q2(J,I)=0.0D0 Q3(J,I)=0.0D0 Q4(J,I)=0.0D0 Q5(J,I)=0.0D0 Q6(J,I)=0.0D0 1 CONTINUE E1(J)=0.0D0 E2(J)=0.0D0 E3(J)=0.0D0 E4(J)=0.0D0 E5(J)=0.0D0 2 E6(J)=0.0D0 ESTEP=EFINAL/DFLOAT(NSTEP) EHALF=ESTEP/2.0D0 E(1)=EHALF DO 3 I=2,4000 AJ=DFLOAT(I-1) E(I)=EHALF+ESTEP*AJ 3 EROOT(I)=DSQRT(E(I)) EROOT(1)=DSQRT(EHALF) DO 4 I=1,220 KIN1(I)=0 KIN2(I)=0 KIN3(I)=0 KIN4(I)=0 KIN5(I)=0 4 KIN6(I)=0 DO 6 I=1,512 6 INDEX(I)=0 C C CALL GAS CROSS-SECTIONS CALL GASMIX(NGASN(1),Q1,QIN1,NIN1,E1,EI1,NAME1,VIRIAL1,EB1, /PEQEL1,PEQIN1,PENFRA1,KEL1,KIN1,SCRP1) IF(NGAS.EQ.1) GO TO 10 CALL GASMIX(NGASN(2),Q2,QIN2,NIN2,E2,EI2,NAME2,VIRIAL2,EB2, /PEQEL2,PEQIN2,PENFRA2,KEL2,KIN2,SCRP2) IF(NGAS.EQ.2) GO TO 10 CALL GASMIX(NGASN(3),Q3,QIN3,NIN3,E3,EI3,NAME3,VIRIAL3,EB3, /PEQEL3,PEQIN3,PENFRA3,KEL3,KIN3,SCRP3) IF(NGAS.EQ.3) GO TO 10 CALL GASMIX(NGASN(4),Q4,QIN4,NIN4,E4,EI4,NAME4,VIRIAL4,EB4, /PEQEL4,PEQIN4,PENFRA4,KEL4,KIN4,SCRP4) IF(NGAS.EQ.4) GO TO 10 CALL GASMIX(NGASN(5),Q5,QIN5,NIN5,E5,EI5,NAME5,VIRIAL5,EB5, /PEQEL5,PEQIN5,PENFRA5,KEL5,KIN5,SCRP5) IF(NGAS.EQ.5) GO TO 10 CALL GASMIX(NGASN(6),Q6,QIN6,NIN6,E6,EI6,NAME6,VIRIAL6,EB6, /PEQEL6,PEQIN6,PENFRA6,KEL6,KIN6,SCRP6) 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,4000 FCION(IE)=0.0D0 FCATT(IE)=0.0D0 NP=1 CF(IE,NP)=Q1(2,IE)*VAN1 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL1(2).EQ.1) THEN PSCT1=PEQEL1(2,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL1(2).EQ.2) THEN PSCT(IE,NP)=PEQEL1(2,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 12 RGAS1=1.0D0+E1(2)/2.0D0 RGAS(NP)=RGAS1 EIN(NP)=0.0D0 IPN(NP)=0 L=1 IARRY(NP)=L DSCRPT(NP)=SCRP1(2) NAMEG(1)=NAME1 PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 12 IF(EFINAL.LT.E1(3)) GO TO 30 NP=NP+1 CF(IE,NP)=Q1(3,IE)*VAN1 FCION(IE)=FCION(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL1(3).EQ.1) THEN PSCT1=PEQEL1(3,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL1(3).EQ.2) THEN PSCT(IE,NP)=PEQEL1(3,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 30 RGAS(NP)=RGAS1 EIN(NP)=E1(3)/RGAS1 WPL(NP)=EB1 IPN(NP)=1 L=2 IARRY(NP)=L DSCRPT(NP)=SCRP1(3) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 30 IF(EFINAL.LT.E1(4)) GO TO 40 NP=NP+1 CF(IE,NP)=Q1(4,IE)*VAN1 FCATT(IE)=FCATT(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 IF(IE.GT.1) GO TO 40 INDEX(NP)=0 RGAS(NP)=RGAS1 EIN(NP)=0.0D0 IPN(NP)=-1 L=3 IARRY(NP)=L DSCRPT(NP)=SCRP1(4) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 40 IF(NIN1.EQ.0) GO TO 60 DO 50 J=1,NIN1 NP=NP+1 CF(IE,NP)=QIN1(J,IE)*VAN1 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KIN1(J).EQ.1) THEN PSCT1=PEQIN1(J,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KIN1(J).EQ.2) THEN PSCT(IE,NP)=PEQIN1(J,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 50 RGAS(NP)=RGAS1 EIN(NP)=EI1(J)/RGAS1 L=4 IF(EI1(J).LT.0.0D0) L=5 IPN(NP)=0 IARRY(NP)=L DSCRPT(NP)=SCRP1(6+J) PENFRA(1,NP)=PENFRA1(1,J) PENFRA(2,NP)=PENFRA1(2,J)*1.D-16/DSQRT(3.0D0) PENFRA(3,NP)=PENFRA1(3,J) 50 CONTINUE C 60 IF(NGAS.EQ.1) GO TO 600 NP=NP+1 CF(IE,NP)=Q2(2,IE)*VAN2 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL2(2).EQ.1) THEN PSCT1=PEQEL2(2,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL2(2).EQ.2) THEN PSCT(IE,NP)=PEQEL2(2,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 62 RGAS2=1.0D0+E2(2)/2.0D0 RGAS(NP)=RGAS2 EIN(NP)=0.0D0 IPN(NP)=0 L=6 IARRY(NP)=L DSCRPT(NP)=SCRP2(2) NAMEG(2)=NAME2 PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 62 IF(EFINAL.LT.E2(3)) GO TO 130 NP=NP+1 CF(IE,NP)=Q2(3,IE)*VAN2 FCION(IE)=FCION(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL2(3).EQ.1) THEN PSCT1=PEQEL2(3,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL2(3).EQ.2) THEN PSCT(IE,NP)=PEQEL2(3,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 130 RGAS(NP)=RGAS2 EIN(NP)=E2(3)/RGAS2 WPL(NP)=EB2 IPN(NP)=1 L=7 IARRY(NP)=L DSCRPT(NP)=SCRP2(3) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 130 IF(EFINAL.LT.E2(4)) GO TO 140 NP=NP+1 CF(IE,NP)=Q2(4,IE)*VAN2 FCATT(IE)=FCATT(IE)+CF(IE,NP) IF(IE.GT.1) GO TO 140 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 RGAS(NP)=RGAS2 EIN(NP)=0.0D0 IPN(NP)=-1 L=8 IARRY(NP)=L DSCRPT(NP)=SCRP2(4) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 140 IF(NIN2.EQ.0) GO TO 160 DO 150 J=1,NIN2 NP=NP+1 CF(IE,NP)=QIN2(J,IE)*VAN2 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KIN2(J).EQ.1) THEN PSCT1=PEQIN2(J,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 IF(KIN2(J).EQ.2) THEN PSCT(IE,NP)=PEQIN2(J,IE) INDEX(NP)=2 ENDIF C ENDIF IF(IE.GT.1) GO TO 150 RGAS(NP)=RGAS2 EIN(NP)=EI2(J)/RGAS2 L=9 IF(EI2(J).LT.0.0D0) L=10 IPN(NP)=0 IARRY(NP)=L DSCRPT(NP)=SCRP2(6+J) PENFRA(1,NP)=PENFRA2(1,J) PENFRA(2,NP)=PENFRA2(2,J)*1.D-6/DSQRT(3.0D0) PENFRA(3,NP)=PENFRA2(3,J) 150 CONTINUE C 160 IF(NGAS.EQ.2) GO TO 600 NP=NP+1 CF(IE,NP)=Q3(2,IE)*VAN3 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL3(2).EQ.1) THEN PSCT1=PEQEL3(2,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL3(2).EQ.2) THEN PSCT(IE,NP)=PEQEL3(2,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 162 RGAS3=1.0D0+E3(2)/2.0D0 RGAS(NP)=RGAS3 EIN(NP)=0.0D0 IPN(NP)=0 L=11 IARRY(NP)=L DSCRPT(NP)=SCRP3(2) NAMEG(3)=NAME3 PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 162 IF(EFINAL.LT.E3(3)) GO TO 230 NP=NP+1 CF(IE,NP)=Q3(3,IE)*VAN3 FCION(IE)=FCION(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL3(3).EQ.1) THEN PSCT1=PEQEL3(3,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL3(3).EQ.2) THEN PSCT(IE,NP)=PEQEL3(3,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 230 RGAS(NP)=RGAS3 EIN(NP)=E3(3)/RGAS3 WPL(NP)=EB3 IPN(NP)=1 L=12 IARRY(NP)=L DSCRPT(NP)=SCRP3(3) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 230 IF(EFINAL.LT.E3(4)) GO TO 240 NP=NP+1 CF(IE,NP)=Q3(4,IE)*VAN3 FCATT(IE)=FCATT(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 IF(IE.GT.1) GO TO 240 INDEX(NP)=0 RGAS(NP)=RGAS3 EIN(NP)=0.0D0 IPN(NP)=-1 L=13 IARRY(NP)=L DSCRPT(NP)=SCRP3(4) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 240 IF(NIN3.EQ.0) GO TO 260 DO 250 J=1,NIN3 NP=NP+1 CF(IE,NP)=QIN3(J,IE)*VAN3 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KIN3(J).EQ.1) THEN PSCT1=PEQIN3(J,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KIN3(J).EQ.2) THEN PSCT(IE,NP)=PEQIN3(J,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 250 RGAS(NP)=RGAS3 EIN(NP)=EI3(J)/RGAS3 L=14 IF(EI3(J).LT.0.0D0) L=15 IPN(NP)=0 IARRY(NP)=L DSCRPT(NP)=SCRP3(6+J) PENFRA(1,NP)=PENFRA3(1,J) PENFRA(2,NP)=PENFRA3(2,J)*1.D-6/DSQRT(3.0D0) PENFRA(3,NP)=PENFRA3(3,J) 250 CONTINUE C 260 IF(NGAS.EQ.3) GO TO 600 NP=NP+1 CF(IE,NP)=Q4(2,IE)*VAN4 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL4(2).EQ.1) THEN PSCT1=PEQEL4(2,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL4(2).EQ.2) THEN PSCT(IE,NP)=PEQEL4(2,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 262 RGAS4=1.0D0+E4(2)/2.0D0 RGAS(NP)=RGAS4 EIN(NP)=0.0D0 IPN(NP)=0 L=16 IARRY(NP)=L DSCRPT(NP)=SCRP4(2) NAMEG(4)=NAME4 PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 262 IF(EFINAL.LT.E4(3)) GO TO 330 NP=NP+1 CF(IE,NP)=Q4(3,IE)*VAN4 FCION(IE)=FCION(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL4(3).EQ.1) THEN PSCT1=PEQEL4(3,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL4(3).EQ.2) THEN PSCT(IE,NP)=PEQEL4(3,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 330 RGAS(NP)=RGAS4 EIN(NP)=E4(3)/RGAS4 WPL(NP)=EB4 IPN(NP)=1 L=17 IARRY(NP)=L DSCRPT(NP)=SCRP4(3) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 330 IF(EFINAL.LT.E4(4)) GO TO 340 NP=NP+1 CF(IE,NP)=Q4(4,IE)*VAN4 FCATT(IE)=FCATT(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 IF(IE.GT.1) GO TO 340 INDEX(NP)=0 RGAS(NP)=RGAS4 EIN(NP)=0.0D0 IPN(NP)=-1 L=18 IARRY(NP)=L DSCRPT(NP)=SCRP4(4) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 340 IF(NIN4.EQ.0) GO TO 360 DO 350 J=1,NIN4 NP=NP+1 CF(IE,NP)=QIN4(J,IE)*VAN4 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KIN4(J).EQ.1) THEN PSCT1=PEQIN4(J,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KIN4(J).EQ.2) THEN PSCT(IE,NP)=PEQIN4(J,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 350 RGAS(NP)=RGAS4 EIN(NP)=EI4(J)/RGAS4 L=19 IF(EI4(J).LT.0.0D0) L=20 IPN(NP)=0 IARRY(NP)=L DSCRPT(NP)=SCRP4(6+J) PENFRA(1,NP)=PENFRA4(1,J) PENFRA(2,NP)=PENFRA4(2,J)*1.D-6/DSQRT(3.0D0) PENFRA(3,NP)=PENFRA4(3,J) 350 CONTINUE C 360 IF(NGAS.EQ.4) GO TO 600 NP=NP+1 CF(IE,NP)=Q5(2,IE)*VAN5 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL5(2).EQ.1) THEN PSCT1=PEQEL5(2,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL5(2).EQ.2) THEN PSCT(IE,NP)=PEQEL5(2,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 362 RGAS5=1.0D0+E5(2)/2.0D0 RGAS(NP)=RGAS5 EIN(NP)=0.0D0 IPN(NP)=0 L=21 IARRY(NP)=L DSCRPT(NP)=SCRP5(2) NAMEG(5)=NAME5 PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 362 IF(EFINAL.LT.E5(3)) GO TO 430 NP=NP+1 CF(IE,NP)=Q5(3,IE)*VAN5 FCION(IE)=FCION(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL5(3).EQ.1) THEN PSCT1=PEQEL5(3,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL5(3).EQ.2) THEN PSCT(IE,NP)=PEQEL5(3,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 430 RGAS(NP)=RGAS5 EIN(NP)=E5(3)/RGAS5 WPL(NP)=EB5 IPN(NP)=1 L=22 IARRY(NP)=L DSCRPT(NP)=SCRP5(3) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 430 IF(EFINAL.LT.E5(4)) GO TO 440 NP=NP+1 CF(IE,NP)=Q5(4,IE)*VAN5 FCATT(IE)=FCATT(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 IF(IE.GT.1) GO TO 440 INDEX(NP)=0 RGAS(NP)=RGAS5 EIN(NP)=0.0D0 IPN(NP)=-1 L=23 IARRY(NP)=L DSCRPT(NP)=SCRP5(4) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 440 IF(NIN5.EQ.0) GO TO 460 DO 450 J=1,NIN5 NP=NP+1 CF(IE,NP)=QIN5(J,IE)*VAN5 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KIN5(J).EQ.1) THEN PSCT1=PEQIN5(J,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KIN5(J).EQ.2) THEN PSCT(IE,NP)=PEQIN5(J,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 450 RGAS(NP)=RGAS5 EIN(NP)=EI5(J)/RGAS5 L=24 IF(EI5(J).LT.0.0D0) L=25 IPN(NP)=0 IARRY(NP)=L DSCRPT(NP)=SCRP5(6+J) PENFRA(1,NP)=PENFRA5(1,J) PENFRA(2,NP)=PENFRA5(2,J)*1.D-6/DSQRT(3.0D0) PENFRA(3,NP)=PENFRA5(3,J) 450 CONTINUE C 460 IF(NGAS.EQ.5) GO TO 600 NP=NP+1 CF(IE,NP)=Q6(2,IE)*VAN6 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL6(2).EQ.1) THEN PSCT1=PEQEL6(2,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL6(2).EQ.2) THEN PSCT(IE,NP)=PEQEL6(2,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 462 RGAS6=1.0D0+E6(2)/2.0D0 RGAS(NP)=RGAS6 EIN(NP)=0.0D0 IPN(NP)=0 L=26 IARRY(NP)=L DSCRPT(NP)=SCRP6(2) NAMEG(6)=NAME6 PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 462 IF(EFINAL.LT.E6(3)) GO TO 530 NP=NP+1 CF(IE,NP)=Q6(3,IE)*VAN6 FCION(IE)=FCION(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KEL6(3).EQ.1) THEN PSCT1=PEQEL6(3,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL6(3).EQ.2) THEN PSCT(IE,NP)=PEQEL6(3,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 530 RGAS(NP)=RGAS6 EIN(NP)=E6(3)/RGAS6 WPL(NP)=EB6 IPN(NP)=1 L=27 IARRY(NP)=L DSCRPT(NP)=SCRP6(3) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 530 IF(EFINAL.LT.E6(4)) GO TO 540 NP=NP+1 CF(IE,NP)=Q6(4,IE)*VAN6 FCATT(IE)=FCATT(IE)+CF(IE,NP) PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 IF(IE.GT.1) GO TO 540 INDEX(NP)=0 RGAS(NP)=RGAS6 EIN(NP)=0.0D0 IPN(NP)=-1 L=28 IARRY(NP)=L DSCRPT(NP)=SCRP6(4) PENFRA(1,NP)=0.0 PENFRA(2,NP)=0.0 PENFRA(3,NP)=0.0 540 IF(NIN6.EQ.0) GO TO 560 DO 550 J=1,NIN6 NP=NP+1 CF(IE,NP)=QIN6(J,IE)*VAN6 PSCT(IE,NP)=0.5D0 ANGCT(IE,NP)=1.0D0 INDEX(NP)=0 C IF(KIN6(J).EQ.1) THEN PSCT1=PEQIN6(J,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KIN6(J).EQ.2) THEN PSCT(IE,NP)=PEQIN6(J,IE) INDEX(NP)=2 ENDIF C IF(IE.GT.1) GO TO 550 RGAS(NP)=RGAS6 EIN(NP)=EI6(J)/RGAS6 L=29 IF(EI6(J).LT.0.0D0) L=30 IPN(NP)=0 IARRY(NP)=L DSCRPT(NP)=SCRP6(6+J) PENFRA(1,NP)=PENFRA6(1,J) PENFRA(2,NP)=PENFRA6(2,J)*1.D-6/DSQRT(3.0D0) PENFRA(3,NP)=PENFRA6(3,J) 550 CONTINUE 560 CONTINUE C 600 CONTINUE 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 C ---------------------------------------------------------------- C CAN INCREASE ARRAY SIZE UP TO 1356 IF MORE COMPLEX MIXTURES USED. C 1356 = 6 * 226 ( 6 = MAX NO OF GASES. 226 = MAX NO OF LEVELS ) C ------------------------------------------------------------------ IF(IPLAST.GT.512) WRITE(6,992) 992 FORMAT(/,/,6X,'WARNING TOO MANY LEVELS IN CALCULATION. CAN INCREAS /E THE ARRAY SIZES FROM 512 UP TO 1356 MAXIMUM',/) IF(IPLAST.GT.512) STOP C -------------------------------------------------------------------- C CALCULATION OF TOTAL COLLISION FREQUENCY C --------------------------------------------------------------------- TCF(IE)=0.0D0 DO 610 IF=1,IPLAST TCF(IE)=TCF(IE)+CF(IE,IF) IF(CF(IE,IF).LT.0.0D0) WRITE(6,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 WRITE(6,841) (INDEX(J),J, J=1,IPLAST) C 841 FORMAT(2X,' INDEX=',I3,' J=',I3) C SET ANISOTROPIC FLAG IF ANISOTROPIC SCATTERING DATA IS DETECTED KELSUM=0 DO 701 J=1,6 701 KELSUM=KELSUM+KEL1(J)+KEL2(J)+KEL3(J)+KEL4(J)+KEL5(J)+KEL6(J) DO 702 J=1,220 702 KELSUM=KELSUM+KIN1(J)+KIN2(J)+KIN3(J)+KIN4(J)+KIN5(J)+KIN6(J) IF(KELSUM.GT.0) NISO=1 C IF(NISO.EQ.1) WRITE(6,7765) NISO C7765 FORMAT(3X,' ANISOTROPIC SCATTERING DETECTED NISO=',I5) C ------------------------------------------------------------------- C CALCULATE NULL COLLISION FREQUENCY C ------------------------------------------------------------------- BP=EFIELD*EFIELD*CONST1 F2=EFIELD*CONST3 ELOW=TMAX*(TMAX*BP-F2*DSQRT(0.5D0*EFINAL))/ESTEP-1.0D0 ELOW=DMIN1(ELOW,SMALL) EHI=TMAX*(TMAX*BP+F2*DSQRT(0.5D0*EFINAL))/ESTEP+1.0D0 IF(EHI.GT.10000.D0) EHI=10000.D0 DO 810 I=1,8 JLOW=4000-500*(9-I)+1+DINT(ELOW) JHI=4000-500*(8-I)+DINT(EHI) JLOW=DMAX0(JLOW,NONE) JHI=DMIN0(JHI,N4000) DO 800 J=JLOW,JHI IF(TCF(J).GE.TCFMAX(I)) TCFMAX(I)=TCF(J) 800 CONTINUE 810 CONTINUE C ------------------------------------------------------------------- C CROSS SECTION DATA FOR INTEGRALS IN OUTPUT C --------------------------------------------------------------------- DO 900 I=1,NSTEP QTOT(I)=AN1*Q1(1,I)+AN2*Q2(1,I)+AN3*Q3(1,I)+AN4*Q4(1,I)+ /AN5*Q5(1,I)+AN6*Q6(1,I) QEL(I)=AN1*Q1(2,I)+AN2*Q2(2,I)+AN3*Q3(2,I)+AN4*Q4(2,I)+ /AN5*Q5(2,I)+AN6*Q6(2,I) C QION(1,I)=Q1(3,I)*AN1 QION(2,I)=Q2(3,I)*AN2 QION(3,I)=Q3(3,I)*AN3 QION(4,I)=Q4(3,I)*AN4 QION(5,I)=Q5(3,I)*AN5 QION(6,I)=Q6(3,I)*AN6 QATT(1,I)=Q1(4,I)*AN1 QATT(2,I)=Q2(4,I)*AN2 QATT(3,I)=Q3(4,I)*AN3 QATT(4,I)=Q4(4,I)*AN4 QATT(5,I)=Q5(4,I)*AN5 QATT(6,I)=Q6(4,I)*AN6 C 850 QREL(I)=0.0D0 QSATT(I)=0.0D0 QSUM(I)=0.0D0 DO 855 J=1,NGAS QSUM(I)=QSUM(I)+QION(J,I)+QATT(J,I) QSATT(I)=QSATT(I)+QATT(J,I) 855 QREL(I)=QREL(I)+QION(J,I)-QATT(J,I) C IF(NIN1.EQ.0) GO TO 865 DO 860 J=1,NIN1 860 QSUM(I)=QSUM(I)+QIN1(J,I)*AN1 865 IF(NIN2.EQ.0) GO TO 875 DO 870 J=1,NIN2 870 QSUM(I)=QSUM(I)+QIN2(J,I)*AN2 875 IF(NIN3.EQ.0) GO TO 885 DO 880 J=1,NIN3 880 QSUM(I)=QSUM(I)+QIN3(J,I)*AN3 885 IF(NIN4.EQ.0) GO TO 895 DO 890 J=1,NIN4 890 QSUM(I)=QSUM(I)+QIN4(J,I)*AN4 895 IF(NIN5.EQ.0) GO TO 898 DO 896 J=1,NIN5 896 QSUM(I)=QSUM(I)+QIN5(J,I)*AN5 898 IF(NIN6.EQ.0) GO TO 900 DO 899 J=1,NIN6 899 QSUM(I)=QSUM(I)+QIN6(J,I)*AN6 C 900 CONTINUE C RETURN END SUBROUTINE GASMIX(NGS,Q,QIN,NIN,E,EI,NAME,VIRL,EB, /PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) CHARACTER*15 NAME CHARACTER*30 SCRPT(226) DIMENSION Q(6,4000),QIN(220,4000),E(6),EI(220),KIN(220) DIMENSION PEQEL(6,4000),PEQIN(220,4000),KEL(6),PENFRA(3,220) C GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, /21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40, /41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60, /61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80) NGS 1 CALL GAS1(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 2 CALL GAS2(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 3 CALL GAS3(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 4 CALL GAS4(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 5 CALL GAS5(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 6 CALL GAS6(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 7 CALL GAS7(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 8 CALL GAS8(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 9 CALL GAS9(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 10 CALL GAS10(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 11 CALL GAS11(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 12 CALL GAS12(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 13 CALL GAS13(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 14 CALL GAS14(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 15 CALL GAS15(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 16 CALL GAS16(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 17 CALL GAS17(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 18 CALL GAS18(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 19 CALL GAS19(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 20 CALL GAS20(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 21 CALL GAS21(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 22 CALL GAS22(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 23 CALL GAS23(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 24 CALL GAS24(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 25 CALL GAS25(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 26 CALL GAS26(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 27 CALL GAS27(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 28 CALL GAS28(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 29 CALL GAS29(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 30 CALL GAS30(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 31 CALL GAS31(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 32 CALL GAS32(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 33 CALL GAS33(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 34 CALL GAS34(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 35 CALL GAS35(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 36 CALL GAS36(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 37 CALL GAS37(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 38 CALL GAS38(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 39 CALL GAS39(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 40 CALL GAS40(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 41 CALL GAS41(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 42 CALL GAS42(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 43 CALL GAS43(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 44 CALL GAS44(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 45 CALL GAS45(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 46 CALL GAS46(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 47 CALL GAS47(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 48 CALL GAS48(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 49 CALL GAS49(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 50 CALL GAS50(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 51 CALL GAS51(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 52 CALL GAS52(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 53 CALL GAS53(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 54 CALL GAS54(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 55 CALL GAS55(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 56 CALL GAS56(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 57 CALL GAS57(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 58 CALL GAS58(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 59 CALL GAS59(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 60 CALL GAS60(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 61 CALL GAS61(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 62 CALL GAS62(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 63 CALL GAS63(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 64 CALL GAS64(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 65 CALL GAS65(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 66 CALL GAS66(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 67 CALL GAS67(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 68 CALL GAS68(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 69 CALL GAS69(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 70 CALL GAS70(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 71 CALL GAS71(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 72 CALL GAS72(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 73 CALL GAS73(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 74 CALL GAS74(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 75 CALL GAS75(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 76 CALL GAS76(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 77 CALL GAS77(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 78 CALL GAS78(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 79 CALL GAS79(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN 80 CALL GAS80(Q,QIN,NIN,E,EI,NAME,VIRL,EB,PEQEL,PEQIN,PENFRA,KEL,KIN, /SCRPT) RETURN END SUBROUTINE SETUP(LAST) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/RATIO/AN1,AN2,AN3,AN4,AN5,AN6,AN,FRAC(6) COMMON/GASN/NGASN(6) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/VEL/WX,WY,WZ COMMON/VELERR/DWX,DWY,DWZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/DIFVEL/DIFLN,DIFTR COMMON/DIFERL/DFLER,DFTER COMMON/DIFLAB/DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ COMMON/DIFERB/DXXER,DYYER,DZZER,DYZER,DXYER,DXZER COMMON/THRM/ERFINT(25),CON,ITHRM COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/MRATIO/VAN1,VAN2,VAN3,VAN4,VAN5,VAN6,VAN COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) C INTEGRALS OF ERROR FUNCTION C DATA ERFINT/.112462916,.222702589,.328626759,.428392355, C /.520499878,.603856091,.677801194,.742100965,.796908212,.842700793, C /.880205070,.910313978,.934007945,.952285120,.966105146,.976348383, C /.983790459,.989090502,.992790429,.995322265,.997020533,.998137154, C /.998856823,.999311486,.999593048/ C C NEW UPDATE OF CONSTANTS 2008 C DO 1 K=1,25 1 ERFINT(K)=0.0D0 API=DACOS(-1.0D0) ARY=13.60569193 PIR2=8.7973553523D-17 ECHARG=1.602176487D-19 EMASS=9.10938215D-31 AMU=1.660538782D-27 BOLTZ=8.617343D-5 BOLTZJ=1.3806504D-23 AWB=1.758820150D10 ALOSCH=2.6867774D19 EOVM=DSQRT(2.0D0*ECHARG/EMASS)*100.0D0 ABZERO=273.15D0 ATMOS=760.0D0 CONST1=AWB/2.0D0*1.0D-19 CONST2=CONST1*1.0D-02 CONST3=DSQRT(0.2D0*AWB)*1.0D-09 CONST4=CONST3*ALOSCH*1.0D-15 CONST5=CONST3/2.0D0 C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% C FIX ELASTIC ANGULAR DISTRIBUTIONS TO OKHRIMVOSKKY TYPE NANISO=2 C FIX ELASTIC ANGULAR DISTRIBUTIONS TO CAPITELLI LONGO TYPE C NANISO=1 C FIX ELASTIC ANGULAR DISTRIBUTIONS TO ISOTROPIC SCATTERING C NANISO=0 C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% C -------------------------------------------- C C READ IN OUTPUT CONTROL AND INTEGRATION DATA C READ(5,2) NGAS,NMAX,IPEN,EFINAL 2 FORMAT(3I10,F10.5) IF(NGAS.EQ.0) GO TO 99 C C GAS IDENTIFIERS C READ(5,3) NGASN(1),NGASN(2),NGASN(3),NGASN(4),NGASN(5),NGASN(6) 3 FORMAT(6I5) C C GAS PARAMETERS C READ(5,4) FRAC(1),FRAC(2),FRAC(3),FRAC(4),FRAC(5),FRAC(6),TEMPC, /TORR 4 FORMAT(8F10.4) C C FIELD VALUES C READ(5,5) EFIELD,BMAG,BTHETA 5 FORMAT(3F10.3) C CHECK INPUT C IF(NGAS.EQ.1.AND.IPEN.EQ.1) THEN C WRITE(6,992) C 992 FORMAT(' PROGRAM STOPPED IT IS NOT POSSIBLE TO HAVE PENNING TRANSF C /ERS IN PURE GASES.',/,' ONLY MIXTURES ALLOWED WITH IPEN=1') C STOP C ENDIF TOTFRAC=0.0D0 IF(NGAS.EQ.0.OR.NGAS.GT.6) GO TO 999 DO 10 J=1,NGAS IF(NGASN(J).EQ.0.OR.FRAC(J).EQ.0.0D0) GO TO 999 10 TOTFRAC=TOTFRAC+FRAC(J) IF(DABS(TOTFRAC-100.0D0).GT.1.D-6) GO TO 999 LAST=0 TMAX=100.0D0 NSCALE=10000000 NMAX=NMAX*NSCALE IF(NMAX.LT.0) THEN WRITE(6,91) 91 FORMAT(2(/),' ERROR IN INPUT : NMAX TOO LARGE OVERFLOWED THE ALLO /WED INTEGER RANGE OF THE COMPUTER OR COMPILER') LAST=1 RETURN ENDIF NSTEP=4000 THETA=0.785D0 PHI=0.1D0 C 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,30 70 ICOLL(K)=0 DO 80 K=1,512 80 ICOLN(K)=0 DO 100 K=1,4000 100 SPEC(K)=0.0D0 DO 101 K=1,8 101 TCFMAX(K)=0.0D0 C --------------------------------------------- C CAN SET RANDOM NUMBER SEED TO SEED VALUE HERE C RSTART=0.666D0 C RANDOM NUMBER SEED FUNCTION (RSTART) C----------------------------------------------- ESTART=EFINAL/50.0D0 ITHRM=0 CORR=ABZERO*TORR/(ATMOS*(ABZERO+TEMPC)*100.0D0) AKT=(ABZERO+TEMPC)*BOLTZ AN1=FRAC(1)*CORR*ALOSCH AN2=FRAC(2)*CORR*ALOSCH AN3=FRAC(3)*CORR*ALOSCH AN4=FRAC(4)*CORR*ALOSCH AN5=FRAC(5)*CORR*ALOSCH AN6=FRAC(6)*CORR*ALOSCH AN=100.0D0*CORR*ALOSCH VAN1=FRAC(1)*CORR*CONST4*1.0D15 VAN2=FRAC(2)*CORR*CONST4*1.0D15 VAN3=FRAC(3)*CORR*CONST4*1.0D15 VAN4=FRAC(4)*CORR*CONST4*1.0D15 VAN5=FRAC(5)*CORR*CONST4*1.0D15 VAN6=FRAC(6)*CORR*CONST4*1.0D15 VAN=100.0D0*CORR*CONST4*1.0D15 C CALCULATE THERMAL VELOCITY DISTRIBUTION INTEGRALS C CON=1.0D-13/DSQRT(AMU/(2.0D0*BOLTZJ*(TEMPC+ABZERO))) C N.B. LOADED ERROR FUNCTION INTEGRALS IN DATA ARRAY . C C RADIANS PER PICOSECOND WB=AWB*BMAG*1.0D-12 C METRES PER PICOSECOND IF(BMAG.EQ.0.0D0) RETURN EOVB=EFIELD*1.D-9/BMAG RETURN 999 WRITE(6,87) NGAS,(J,NGASN(J),FRAC(J),J=1,6) 87 FORMAT(3(/),4X,' ERROR IN GAS INPUT : NGAS=',I5,6(/,2X,' N=',I3,' /NGAS=',I5,' FRAC=',F8.3)) 99 LAST=1 RETURN END SUBROUTINE PRNTER IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/RATIO/AN1,AN2,AN3,AN4,AN5,AN6,AN,FRAC(6) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/THRM/ERFINT(25),CON,ITHRM COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),IPLAST,ISIZE,PENFRA(3,512) COMMON/NAMES/NAMEG(6) CHARACTER*15 NAMEG WRITE(6,1) 1 FORMAT(2(/),10X,'PROGRAM MAGBOLTZ 2 VERSION 8.97',/) WRITE(6,10) NGAS 10 FORMAT(10X,'MONTE CARLO SOLUTION FOR MIXTURE OF ',I2,' GASES.',/, /5X,'------------------------------------------------------') WRITE(6,30) (NAMEG(J),FRAC(J), J=1,NGAS) 30 FORMAT(/,5X,' GASES USED ',5X,' PERCENTAGE USED ',2(/),6(6X,A15, /5X,F9.4,/)) WRITE(6,50) TEMPC,TORR 50 FORMAT(/,2X,'GAS TEMPERATURE =',F6.1,' DEGREES CENTIGRADE.',/,2X,' /GAS PRESSURE = ',F7.1,' TORR.') WRITE(6,51) EFINAL,NSTEP 51 FORMAT(1(/),2X,'INTEGRATION FROM 0.0 TO ',F8.2,' EV. IN ',I4,' ST /EPS. ') IF(IPEN.EQ.0) WRITE(6,52) IF(IPEN.EQ.1) WRITE(6,53) 52 FORMAT(/,' PENNING EFFECTS NOT INCLUDED') 53 FORMAT(/,' PENNING EFFECTS INCLUDED') IF(NANISO.EQ.0) WRITE(6,61) IF(NANISO.EQ.1) WRITE(6,62) IF(NANISO.EQ.2) WRITE(6,63) IF(NANISO.LT.0.OR.NANISO.GT.2) THEN WRITE(6,64) STOP ENDIF 61 FORMAT(/,' ISOTROPIC SCATTERING X-SECTIONS USED') 62 FORMAT(/,' ANISOTROPIC SCATTERING TYPE 1 (CAPITELLI/LONGO) USED IF / AVAILABLE') 63 FORMAT(/,' ANISOTROPIC SCATTERING TYPE 2 (OKHRIMOVSKYY) USED IF AV /AILABLE') 64 FORMAT(/,' INPUT ERROR FOR ISOTROPY CONTROL,PROGRAM STOPPED') C IF(ITHRM.EQ.0) WRITE(6,65) C IF(ITHRM.NE.0) WRITE(6,66) C 65 FORMAT(2(/),' THERMAL MOTION OF GAS NOT INCLUDED') C 66 FORMAT(2(/),' THERMAL MOTION OF GAS INCLUDED') 74 WRITE(6,90) EFIELD,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(6,95) ESTART 95 FORMAT(1(/),' INITIAL ELECTRON ENERGY =',F8.3,' EV.') C WRITE(6,96) RSTART C 96 FORMAT(/,' RANDOM NUMBER STARTER (SEED)=',F7.4) WRITE(6,100) NMAX 100 FORMAT(1(/),' TOTAL NUMBER OF REAL COLLISIONS =',I11) WRITE(6,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(6,111) (TCF(L),L=250,3750,500) 111 FORMAT(' REAL COLLISION FREQUENCY AT 8 EQUALLY SPACED ENERGY INT /ERVALS (*10**12/SEC)',/,2(4(5X,D10.3)/)) RETURN END SUBROUTINE SORT(I,R2,IE) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) C C SELECTS COLLISION TYPE FROM COLLISION ARRAY BY BINARY STEP SAMPLING C REDUCES SAMPLING RANGE TO WITHIN 4 POSITIONS IN ARRAY C OUTPUT = I ( POSITION WITHIN 4 OF CORRECT VALUE) C ISTEP=ISIZE INCR=0 DO 1 K=1,12 I=INCR IF(ISTEP.EQ.2) RETURN I=INCR+ISTEP IF(I.GT.LAST) GO TO 2 IF(CF(IE,I).LT.R2) THEN INCR=INCR+ISTEP ENDIF 2 ISTEP=ISTEP/2 1 CONTINUE RETURN END SUBROUTINE MONTE IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO COMMON/VEL/WX,WY,WZ COMMON/VELERR/DWX,DWY,DWZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/DIFVEL/DIFLN,DIFTR COMMON/DIFERL/DFLER,DFTER COMMON/DIFLAB/DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ COMMON/DIFERB/DXXER,DYYER,DZZER,DYZER,DXYER,DXZER COMMON/THRM/ERFINT(25),CON,ITHRM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) DIMENSION XST(200000),YST(200000),ZST(200000),STO(200000) 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 N4000=4000 N300=300 INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 IEXTRA=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=200000 TDASH=0.0D0 C C INITIAL DIRECTION COSINES C DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*DACOS(-1.0D0) DELTAE=EFINAL/DFLOAT(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M 1 R1=drand48(RDUM) I=DINT(E1/DELTAE)+1 I=DMIN0(I,INTEM) TLIM=TCFMAX(I) T=-DLOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) E=E1+(AP+BP*T)*T IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+DLOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) C WRITE(6,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=DSQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0D0+B/3.0D0) CONST7=CONST9*DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) 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+25000 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM) THEN ID=ID+1 XID=DFLOAT(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 WRITE(6,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 C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I), OF TRANSFER TO C IONISATION OF THE OTHER GASES IN MIXTURE IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).NE.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 C ADD EXTRA IONISATION COLLISION IEXTRA=IEXTRA+1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) R3=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN R3=drand48(RDUM) EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,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) WRITE(6,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 WRITE(6,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 IF LAST ENERGY BIN IS HIGH INCREASE INTEGRATION ENERGY RANGE IF(SPEC(4000).GT.(150.0D0*DFLOAT(J1))) THEN WRITE(6,50) 50 FORMAT(' WARNING ENERGY OUT OF RANGE,INCREASE ELECTRON ENERGY INT /EGRATION RANGE ') STOP ENDIF 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*DSQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZ DEN=100.0D0*DSQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DXXER=100.0D0*DSQRT((T2XXST-TXXST*TXXST/10.0D0)/9.0D0)/DIFXX DYYER=100.0D0*DSQRT((T2YYST-TYYST*TYYST/10.0D0)/9.0D0)/DIFYY DZZER=100.0D0*DSQRT((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) ANCION=ANCION+IEXTRA ATTER=0.0D0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0D0*DSQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0D0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0D0*DSQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 RETURN END SUBROUTINE OUTPUT IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/MIX2/E(4000),EROOT(4000),QTOT(4000),QREL(4000),QINEL(4000), /QEL(4000) COMMON/MIX1/QELM(4000),QSUM(4000),QION(6,4000),QIN1(220,4000), /QIN2(220,4000),QIN3(220,4000),QIN4(220,4000),QIN5(220,4000), /QIN6(220,4000),QSATT(4000) COMMON/RATIO/AN1,AN2,AN3,AN4,AN5,AN6,AN,FRAC(6) COMMON/DIFVEL/DIFLN,DIFTR COMMON/DIFERL/DFLER,DFTER COMMON/DIFLAB/DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ COMMON/DIFERB/DXXER,DYYER,DZZER,DYZER,DXYER,DXZER COMMON/VEL/WX,WY,WZ COMMON/VELERR/DWX,DWY,DWZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/SINT/SIMF(4000) COMMON/NAMES/NAMEG(6) COMMON/SCRIP/DSCRPT(512) CHARACTER*30 DSCRPT CHARACTER*15 NAMEG WRITE(6,15) WRITE(6,15) 15 FORMAT('---------------------------------------------------------- /-------------------') NREAL=NMAX WRITE(6,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 WRITE(6,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*EFIELD/WZ DTMN=DSQRT(2.0D0*DIFTR/WZ)*10000.0D0 DFTER1=DSQRT(DFTER**2+DWZ**2) DFTER2=DFTER1/2.0 WRITE(6,954) WRITE(6,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*EFIELD/WZ DLMN=DSQRT(2.0D0*DIFLN/WZ)*10000.0D0 DFLER1=DSQRT(DFLER**2+DWZ**2) DFLER2=DFLER1/2.0 WRITE(6,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 WRITE(6,954) 954 FORMAT(/,10X,' DIFFUSION IN CM**2/SEC.',/) WRITE(6,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,/) WRITE(6,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.) WRITE(6,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 WRITE(6,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(/)) WRITE(6,960) AVE,DEN 960 FORMAT(/,2X,'MEAN ELECTRON ENERGY =',F9.4,' EV. ERROR = +-',F8.2, /'%',/) RETURN END SUBROUTINE MONTEA IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO COMMON/DIFVEL/DIFLN,DIFTR COMMON/DIFERL/DFLER,DFTER COMMON/DIFLAB/DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ COMMON/DIFERB/DXXER,DYYER,DZZER,DYZER,DXYER,DXZER COMMON/VEL/WX,WY,WZ COMMON/VELERR/DWX,DWY,DWZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) DIMENSION XST(200000),YST(200000),ZST(200000),STO(200000) 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 N4000=4000 N300=300 INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 IEXTRA=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=200000 TDASH=0.0D0 C C INITIAL DIRECTION COSINES C DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C INITIAL VELOCITY VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*DACOS(-1.0D0) DELTAE=EFINAL/DFLOAT(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M 1 R1=drand48(RDUM) I=DINT(E1/DELTAE)+1 I=DMIN0(I,INTEM) TLIM=TCFMAX(I) T=-DLOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) E=E1+(AP+BP*T)*T IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+DLOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) C WRITE(6,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=DCOS(WBT) SINWT=DSIN(WBT) CONST6=DSQRT(E1/E) CX2=CX1*COSWT-CY1*SINWT CY2=CY1*COSWT+CX1*SINWT VTOT=CONST9*DSQRT(E) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0D0+B/3.0D0) CONST7=CONST9*DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) 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+25000 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM) THEN ID=ID+1 XID=DFLOAT(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 WRITE(6,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 C IF EXCITATION THEN ADD PROBABLITY,PENFRAC(1,I),OF TRANSFER TO GIVE C IONISATION OF THE OTHER GASES IN THE MIXTURE. IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).NE.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 C ADD EXTRA IONISATION COLLISION IEXTRA=IEXTRA+1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) VTOT=CONST9*DSQRT(E1) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,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) WRITE(6,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 WRITE(6,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*DSQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZ DEN=100.0D0*DSQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DXXER=100.0D0*DSQRT((T2XXST-TXXST*TXXST/10.0D0)/9.0D0)/DIFXX DYYER=100.0D0*DSQRT((T2YYST-TYYST*TYYST/10.0D0)/9.0D0)/DIFYY DZZER=100.0D0*DSQRT((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) ANCION=ANCION+IEXTRA ATTER=0.0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0*DSQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0*DSQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 RETURN END SUBROUTINE MONTEB IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO COMMON/MIX2/ES(4000),EROOT(4000),QTOT(4000),QREL(4000),QINEL(4000) /,QEL(4000) COMMON/DIFLAB/DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ COMMON/DIFERB/DXXER,DYYER,DZZER,DYZER,DXYER,DXZER COMMON/DIFVEL/DIFLN,DIFTR COMMON/DIFERL/DFLER,DFTER COMMON/VEL/WX,WY,WZ COMMON/VELERR/DWX,DWY,DWZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) DIMENSION XST(200000),YST(200000),ZST(200000),STO(200000) 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 ------------------------------------------------------------------- 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=EFIELD*100.0D0 RDUM=RSTART E1=ESTART N4000=4000 N300=300 INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 IEXTRA=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=200000 TDASH=0.0D0 CONST9=CONST3*0.01D0 C C INITIAL DIRECTION COSINES C DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C INITIAL VELOCITY VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2.0D0*DACOS(-1.0D0) DELTAE=EFINAL/DFLOAT(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M 1 R1=drand48(RDUM) I=DINT(E1/DELTAE)+1 I=DMIN0(I,INTEM) TLIM=TCFMAX(I) T=-DLOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=DCOS(WBT) SINWT=DSIN(WBT) DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0D0-COSWT))/WB E=E1+DZ*EF100 C IF(E.LT.0.0) WRITE(6,983) 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=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+DLOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) C C WRITE(6,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=DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) 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+25000 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM) THEN ID=ID+1 XID=DFLOAT(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 WRITE(6,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 C IF EXCITATION THEN ADD PROBABILITY,PENFRAC(1,I), OF TRANSFER TO GIVE C IONISATION OF THE OTHER GASES IN THE MIXTURE IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).NE.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 C ADD EXTRA IONISATION COLLISION IEXTRA=IEXTRA+1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) VTOT=CONST9*DSQRT(E1) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,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) WRITE(6,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,4000 300 EBAR=EBAR+ES(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 WRITE(6,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*DSQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZ DWY=100.0D0*DSQRT((T2WYST-TWYST*TWYST/10.0D0)/9.0D0)/DABS(WY) DEN=100.0D0*DSQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DXXER=100.0D0*DSQRT((T2XXST-TXXST*TXXST/10.0D0)/9.0D0)/DIFXX DYYER=100.0D0*DSQRT((T2YYST-TYYST*TYYST/8.0D0)/7.0D0)/DIFYY DZZER=100.0D0*DSQRT((T2ZZST-TZZST*TZZST/8.0D0)/7.0D0)/DIFZZ DYZER=100.0D0*DSQRT((T2YZST-TYZST*TYZST/8.0D0)/7.0D0)/DABS(DIFYZ) DFLER=100.0D0*DSQRT((T2LNST-TLNST*TLNST/8.0D0)/7.0D0)/DIFLN DFTER=100.0D0*DSQRT((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) ANCION=ANCION+IEXTRA ATTER=0.0D0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0D0*DSQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0D0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0D0*DSQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 RETURN END SUBROUTINE MONTEC IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO COMMON/MIX2/ES(4000),EROOT(4000),QTOT(4000),QREL(4000),QINEL(4000) /,QEL(4000) COMMON/DIFLAB/DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ COMMON/DIFERB/DXXER,DYYER,DZZER,DYZER,DXYER,DXZER COMMON/DIFVEL/DIFLN,DIFTR COMMON/DIFERL/DFLER,DFTER COMMON/VEL/WX,WY,WZ COMMON/VELERR/DWX,DWY,DWZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) DIMENSION XST(200000),YST(200000),ZST(200000),STO(200000) 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=DACOS(-1.0D0) C CALC ROTATION MATRIX ANGLES RCS=DCOS((BTHETA-90.0D0)*API/180.0D0) RSN=DSIN((BTHETA-90.0D0)*API/180.0D0) C RTHETA=BTHETA*API/180.0D0 EFZ100=EFIELD*100.0D0*DSIN(RTHETA) EFX100=EFIELD*100.0D0*DCOS(RTHETA) F1=EFIELD*CONST2*DCOS(RTHETA) EOVBR=EOVB*DSIN(RTHETA) RDUM=RSTART E1=ESTART N4000=4000 N300=300 INTEM=8 ITMAX=10 ID=0 NCOL=0 NNULL=0 IEXTRA=0 NCOLM=200000 TDASH=0.0D0 CONST9=CONST3*0.01D0 C C INITIAL DIRECTION COSINES C DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C INITIAL VELOCITY VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2.0D0*API DELTAE=EFINAL/DFLOAT(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M 1 R1=drand48(RDUM) I=DINT(E1/DELTAE)+1 I=DMIN0(I,INTEM) TLIM=TCFMAX(I) T=-DLOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=DCOS(WBT) SINWT=DSIN(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) WRITE(6,983) 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=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+DLOG(R1)/TLIM TCFMAX(I)=1.05D0*TCFMAX(I) C WRITE(6,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=DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) 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+25000 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM) THEN ID=ID+1 XID=DFLOAT(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 WRITE(6,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 C IF EXCITATION THEN ADD PROBABILITY, PENFRA(1,I), OF TRANSFER TO GIVE C IONISATION OF THE OTHER GASES IN THE MIXTURE IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).NE.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 C ADD EXTRA IONISATION COLLISION IEXTRA=IEXTRA+1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) VTOT=CONST9*DSQRT(E1) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,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) WRITE(6,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,4000 300 EBAR=EBAR+ES(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 WRITE(6,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*DSQRT((T2WZST-TWZST*TWZST/10.0D0)/9.0D0)/WZR DWY=100.0D0*DSQRT((T2WYST-TWYST*TWYST/10.0D0)/9.0D0)/DABS(WYR) DWX=100.0D0*DSQRT((T2WXST-TWXST*TWXST/10.0D0)/9.0D0)/DABS(WXR) DEN=100.0D0*DSQRT((T2AVE-TAVE*TAVE/10.0D0)/9.0D0)/AVE DZZER=100.0D0*DSQRT((T2ZZST-TZZST*TZZST/8.0D0)/7.0D0)/DIFZZR DYYER=100.0D0*DSQRT((T2YYST-TYYST*TYYST/8.0D0)/7.0D0)/DIFYYR DXXER=100.0D0*DSQRT((T2XXST-TXXST*TXXST/8.0D0)/7.0D0)/DIFXXR DXYER=100.0D0*DSQRT((T2XYST-TXYST*TXYST/8.0D0)/7.0D0)/DABS(DIFXYR) DYZER=100.0D0*DSQRT((T2YZST-TYZST*TYZST/8.0D0)/7.0D0)/DABS(DIFYZR) DXZER=100.0D0*DSQRT((T2XZST-TXZST*TXZST/8.0D0)/7.0D0)/DABS(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) ANCION=ANCION+IEXTRA ATTER=0.0D0 IF(ANCATT.EQ.0.0D0) GO TO 810 ATTER=100.0D0*DSQRT(ANCATT)/ANCATT 810 ATT=ANCATT/(ST*WZ)*1.0D12 ALPER=0.0D0 IF(ANCION.EQ.0.0D0) GO TO 820 ALPER=100.0D0*DSQRT(ANCION)/ANCION 820 ALPHA=ANCION/(ST*WZ)*1.0D12 RETURN END SUBROUTINE ELIMIT(IELOW) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO 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 N4000=4000 INTEM=8 TDASH=0.0D0 C C INITIAL DIRECTION COSINES C DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*DACOS(-1.0D0) DELTAE=EFINAL/DFLOAT(INTEM) J2M=NMAX/ISAMP C MAIN LOOP DO 210 J1=1,J2M 1 R1=drand48(RDUM) I=DINT(E1/DELTAE)+1 I=DMIN0(I,INTEM) TLIM=TCFMAX(I) T=-DLOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) E=E1+(AP+BP*T)*T IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+DLOG(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.4000) THEN C ELECTRON ENERGY OUT OF RANGE IELOW=1 RETURN ENDIF TDASH=0.0D0 CONST6=DSQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(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) R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) ARGZ=DSQRT(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 RETURN END SUBROUTINE ELIMITB(IELOW) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO 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=EFIELD*100.0D0 RDUM=RSTART E1=ESTART N4000=4000 INTEM=8 TDASH=0.0D0 CONST9=CONST3*0.01D0 C C INITIAL DIRECTION COSINES C DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2.0D0*DACOS(-1.0D0) DELTAE=EFINAL/DFLOAT(INTEM) J2M=NMAX/ISAMP C MAIN LOOP DO 210 J1=1,J2M 1 R1=drand48(RDUM) I=DINT(E1/DELTAE)+1 I=DMIN0(I,INTEM) TLIM=TCFMAX(I) T=-DLOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=DCOS(WBT) SINWT=DSIN(WBT) DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0D0-COSWT))/WB E=E1+DZ*EF100 IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+DLOG(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.4000) 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=DSQRT(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) R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) VTOT=CONST9*DSQRT(E1) ARGZ=DSQRT(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 RETURN END SUBROUTINE ELIMITC(IELOW) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO 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*DACOS(-1.0D0)/180.0D0 EFZ100=EFIELD*100.0D0*DSIN(RTHETA) EFX100=EFIELD*100.0D0*DCOS(RTHETA) F1=EFIELD*CONST2*DCOS(RTHETA) EOVBR=EOVB*DSIN(RTHETA) RDUM=RSTART E1=ESTART N4000=4000 INTEM=8 TDASH=0.0D0 CONST9=CONST3*0.01D0 C C INITIAL DIRECTION COSINES C DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2.0D0*DACOS(-1.0D0) DELTAE=EFINAL/DFLOAT(INTEM) J2M=NMAX/ISAMP C MAIN LOOP DO 210 J1=1,J2M 1 R1=drand48(RDUM) I=DINT(E1/DELTAE)+1 I=DMIN0(I,INTEM) TLIM=TCFMAX(I) T=-DLOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=DCOS(WBT) SINWT=DSIN(WBT) DZ=(CZ1*SINWT+(EOVBR-CY1)*(1.0D0-COSWT))/WB DX=CX1*T+F1*T*T E=E1+DZ*EFZ100+DX*EFX100 IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) IF(TCF(IE).GT.TLIM) THEN TDASH=TDASH+DLOG(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.4000) 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=DSQRT(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) R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) VTOT=CONST9*DSQRT(E1) ARGZ=DSQRT(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 RETURN END SUBROUTINE ALPCALC IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/SSTOUT/VDOUT,VDERR,WSOUT,WSERR,DLOUT,DLERR,DTOUT,DTERR, /ALPHSST,ALPHERR,ATTSST,ATTERR COMMON/TOFOUT/RALPHA,RALPER,TOFENE,TOFENER,TOFWV,TOFWVER, /TOFDL,TOFDLER,TOFDT,TOFDTER,TOFWR,TOFWRER,RATTOF,RATOFER COMMON/VEL/WX,WY,WZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, /ZPLANE7,ZPLANE8,IZFINAL COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM C --------------------------------------------------------------------- C ESTIMATE TIME STEP AND SPACE STEPS FOR AVALANCHE SIMULATION IN C TIME OF FLIGHT AND STEADY STATE TOWNSEND SIMULATIONS. C USES ESTIMATED GAIN OF 3.0 BETWEEN PLANES. C CALLS SST AND TOF SUBROUTINES AND UPDATES ALPHA AND ATT C ------------------------------------------------------------------ IMAX=NMAX/10000000 IF(IMAX.LT.5) IMAX=5 NMAX=IMAX*10000000 ALPHAST=0.85D0*DABS(ALPHA-ATT) VDST=WZ*1.D-5 TSTEP=DLOG(3.0D0)/(ALPHAST*VDST*1.0D5) ZSTEP=DLOG(3.0D0)/ALPHAST C 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 C CALC SST WRITE(6,11) 11 FORMAT(/,2X,'SOLUTION FOR STEADY STATE TOWNSEND PARAMETERS',/,' - /------------------------------------------------') ZSTEPM=ZSTEP*1.0D6 WRITE(6,12) ZSTEPM 12 FORMAT(1(/),' SPACE STEP BETWEEN SAMPLING PLANES =',D12.5,' MICRON /S.',/) CALL MONTEFD CALL SST C-------------------------------------------------------- C LOAD NEW ALPHA AND ATTACHMENT INTO COMMON BLOCKS C----------------------------------------------- ALPHA=ALPHSST ALPER=ALPHERR ATT=ATTSST ATTER=ATTERR C----------------------------------------------- WRITE(6,18) 18 FORMAT(/,' SST DRIFT VELOCITIES') WRITE(6,19) VDOUT,VDERR,WSOUT,WSERR 19 FORMAT(/,' VD=',F9.1,' +- ',F6.2,' % WS=',F9.1,' +- ',F6.2,' %') WRITE(6,20) 20 FORMAT(/,' SST DIFFUSION') WRITE(6,21) DLOUT,DLERR,DTOUT,DTERR 21 FORMAT(/,' DL=',F9.1,' +- ',F6.1,' % DT=',F9.1,' +- ',F6.2,' %') WRITE(6,22) 22 FORMAT(/,' SST TOWNSEND COEFICIENTS') WRITE(6,23) ALPHSST,ALPHERR,ATTSST,ATTERR 23 FORMAT(/,' ALPHA=',F9.1,' +- ',F6.2,' % ATT=',F9.1,' +- ',F6.2, /' %') C CALC TIME OF FLIGHT AND PT WRITE(6,25) 25 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') WRITE(6,26) TSTEP 26 FORMAT(1(/),' TIME STEP BETWEEN SAMPLING PLANES =',D12.5,' PICOSE /CS.',/) CALL MONTEFT CALL FRIEDLAND CALL PT CALL TOF WRITE(6,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,' %') WRITE(6,28) 28 FORMAT(/,' TOF DIFFUSION') WRITE(6,29) TOFDL,TOFDLER,TOFDT,TOFDTER 29 FORMAT(/,' DL=',F8.1,' +- ',F6.1,' % DT=',F8.1,' +- ',F6.1, /' %') WRITE(6,30) 30 FORMAT(/,' TOF DRIFT VELOCITY') WRITE(6,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-DSQRT(FC1**2-FC2) WRITE(6,888) ALPTEST 888 FORMAT(/,'TOWNSEND COEFICIENT (ALPHA-ATT) CALCULATED FROM TOF RESU /LTS:',/,' ALPHA-ATT /CM.=',D11.4) RETURN END SUBROUTINE MONTEFT IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),IPLAST,ISIZE,PENFRA(3,512) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/IPT/XS(200),YS(200),ZS(200),TS(200),ES(200), /DCX(200),DCY(200),DCZ(200),IPL(200) COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),ATTOINT,ATTERT,AIOERT COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO DIMENSION EPRM(4000000),IESPECP(100) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C THIS ROUTINE HANDLES TERMINATIONS AT FIXED DRIFT TIMES. C ------------------------------------------------------------------- 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=DACOS(-1.0D0) DO 25 I=1,300 25 TIME(I)=0.0D0 DO 26 I=1,30 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,4000 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 N4000=4000 N300=300 N100=100 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 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*API C 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 C LOOP FOR NEW STARTING ELECTRONS 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN C CHECK IF PROGRAM WILL EXCEED MAXIMUM NUMBER OF ITERATIONS C 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 WRITE(6,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=DINT(E1)+1 IDUM=DMIN0(IDUM,N100) IESPECP(IDUM)=IESPECP(IDUM)+1 C START OF LOOP FOR NEWLY CREATED ELECTRONS 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP C MAIN LOOP 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) 15 IF((T+ST).GE.TSTOP) THEN IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP C STORE POSITION AND ENERGY AT TIME PLANE =IPLANE. CALL TPLANE(T,E1,DCX1,DCY1,DCZ1,AP,BP,EFIELD,IPLANE) C CHECK IF PASSED THROUGH MORE THAN ONE PLANE IN THIS STEP IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 IF((T+ST).GE.TFINAL) THEN ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT TSTOP=TSTEP C NO MORE ELECTRONS IN CASCADE TRY NEW PRIMARY ELECTRON IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C TAKE ELECTRONS FROM STORE 20 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 WRITE(6,913)ITER,E,E1,AP,BP,DCZ1 E=0.001D0 ENDIF IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 CONST6=DSQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(E) CONST7=CONST9*DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- C R2=RNDM2(RDUM) 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(E.LT.EI) THEN C WRITE(6,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') C 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 C ATTACHMENT IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=DINT(T+1.0D0) IT=DMIN0(IT,N300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT C ELECTRON CAPTURED START NEW PRIMARY IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C ELECTRON CAPTURED TAKE NEXT ELECTRON FROM STORE GO TO 20 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) C USE OPAL PETERSON AND BEATY SPLITTING FACTOR. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI C STORE POSITION ,ENERGY, DIRECTION COSINES AND TIME OF GENERATION C OF IONISATION ELECTRON NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=DACOS(F3) F6=DCOS(THETA0) F5=DSIN(THETA0) R4=drand48(rdum) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I), OF TRANSFER TO GIVE C IONISATION OF THE OTHER GASES IN THE MIXTURE. IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).NE.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 NCLUS=NCLUS+1 NPONT=NPONT+1 IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER STOP ENDIF C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XS(NPONT)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YS(NPONT)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZS(NPONT)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN C POSSIBLE PENNING TRANSFER TIME 667 TPEN=ST IF(PENFRA(3,I).EQ.0.0) GO TO 668 RAN=drand48(RDUM) TPEN=ST-DLOG(RAN)*PENFRA(3,I) 668 TS(NPONT)=TPEN ES(NPONT)=1.0 DCX(NPONT)=DCX1 DCY(NPONT)=DCY1 DCZ(NPONT)=DCZ1 C FIND LAST TIME PLANE BEFORE TPEN TSTOP1=0.0 IPLANE1=0 DO 669 KDUM=1,ITFINAL TSTOP1=TSTEP+TSTOP1 IF(TPEN.LT.TSTOP1) GO TO 670 IPLANE1=IPLANE1+1 669 CONTINUE C PENNING TRANSFER OCCURS AFTER FINAL TIME PLANE CLEAR ENTRY NPONT=NPONT-1 NCLUS=NCLUS-1 GO TO 5 670 IPL(NPONT)=IPLANE1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,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 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 C STORE DIRECTION COSINES AND ENERGY AFTER N COLLISIONS C 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 C INTERMEDIATE PRINTOUT 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 JCT=ID/100000 C IF(J1.EQ.1) WRITE(6,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VEL POS TIME C / COUNT ') C WRITE(6,202) W,ZTOTS,TTOTS,JCT C 202 FORMAT(1X,F8.3,2(1X,D10.3),4X,I6) J1=J1+1 GO TO 1 C MAIN LOOP END 700 XID=DFLOAT(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DFLOAT(NEION) ANBT=DFLOAT(NELEC-IPRIM) ATTOINT=ANEION/ANBT ATTERT=DSQRT(ANEION)/ANEION AIOERT=DSQRT(ANBT)/ANBT ELSE ANEION=DFLOAT(NEION) ATTOINT=-1.0 ATTERT=DSQRT(ANEION)/ANEION ENDIF JCT=ID/100000 IF(J1.EQ.1) THEN WRITE(6,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS), DECREASE THE /ESTIMATED ALPHA. NCLUS = ',I7,' ITER =',I9) STOP ENDIF WRITE(6,878) NELEC,NEION,IPRIM 878 FORMAT(/,' TOTAL NO OF ELECTRONS=',I10,/,' TOTAL NO OF NEG. IONS=' /,I10,/,' TOTAL NO OF PRIMARIES=',I10) 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=DSQRT(E2PRM/IPRIM-EBAR**2) WRITE(6,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C WRITE(6,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 WRITE(6,991) ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =',I10,/, /' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4,' NMXADD=',I3) STOP ENDIF RETURN END SUBROUTINE TPLANE(T,E1,DCX1,DCY1,DCZ1,AP,BP,EFLD,IPLANE) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),ATTOINT,ATTERT,AIOERT 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=DSQRT(E1/EPLANE) C DCX2=DCX1*CONST6 C DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFLD*TIMLFT*CONST5/DSQRT(EPLANE) XPLANE=X+DCX1*TIMLFT*DSQRT(E1)*CONST3*0.01D0 YPLANE=Y+DCY1*TIMLFT*DSQRT(E1)*CONST3*0.01D0 ZPLANE=Z+DCZ1*TIMLFT*DSQRT(E1)*CONST3*0.01D0+T2LFT*EFLD*CONST2 VZPLANE=DCZ2*DSQRT(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 RETURN END SUBROUTINE FRIEDLAND IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/FRED/FCION(4000),FCATT(4000) COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/MIX2/E(4000),EROOT(4000),QTOT(4000),QREL(4000),QINEL(4000), /QEL(4000) DIMENSION FR(4000) C ------------------------------------------------------- C CALCULATE DISTRIBUTION FUNCTION USING FRIEDLAND TECHNIQUE C CF: J.FRIEDLAND PHYSICS OF FLUIDS 20(1461)1977 C USE DITRIBUTION FUNCTION TO CALCULATE AVERAGE ENERGY C IONISATION RATE AND ATTACHMENT RATE. C----------------------------------------------------- ALFBAR=0.0D0 ATTBAR=0.0D0 EBAR=0.0D0 FSUM=0.0D0 DO 100 I=1,4000 FR(I)=SPEC(I)/TCF(I) EBAR=EBAR+E(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) DO 200 I=1,4000 200 FR(I)=FR(I)/FSUM EBAR=EBAR/TTOTS ALFBAR=ALFBAR/TTOTS ATTBAR=ATTBAR/TTOTS WRITE(6,900) EBAR,ALFBAR,ATTBAR 900 FORMAT(2(/),' ESTIMATE USING FRIEDLAND :',/,' AVERAGE ENERGY =',F8 /.3,'EV.',/,' AVERAGE IONISATION =',E11.4,' *10**12/SEC',/,' AVERAG /E ATTACHMENT =',E11.4,' *10**12/SEC') RETURN END SUBROUTINE PT IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),ATTOINT,ATTERT,AIOERT COMMON/PTTOF/RI(8),EPT(8),VZPT(8),TTEST(8) DIMENSION ANTPL(8) C ------------------------------------------------ C CALCULATES PULSED TOWNSEND COEFFICIENTS C------------------------------------------------- ANTPL(1)=DFLOAT(NETPL(1)) RI(1)=(DLOG(ANTPL(1))-DLOG(DFLOAT(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)=DFLOAT(NETPL(I)) RI(I)=(DLOG(ANTPL(I))-DLOG(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 WRITE(6,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 WRITE(6,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 RETURN END SUBROUTINE TOF IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),ATTOINT,ATTERT,AIOERT COMMON/TOFOUT/RALPHA,RALPER,TOFENE,TOFENER,TOFWV,TOFWVER, /TOFDL,TOFDLER,TOFDT,TOFDTER,TOFWR,TOFWRER,RATTOF,RATOFER COMMON/PTTOF/RI(8),EPT(8),VZPT(8),TTEST(8) DIMENSION DLTF(8),DXTF(8),DYTF(8),WR(8),ANTPL(8) C---------------------------------------------------------- C CALCULATES TIME OF FLIGHT COEFFICIENTS C--------------------------------------------- ANTPL(1)=DFLOAT(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)=DFLOAT(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 WRITE(6,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 WRITE(6,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*DABS((EPT(2)-EPT(3))/(2.0D0*EPT(2))) TOFWV=VZPT(2) TOFWVER=100.0D0*DABS((VZPT(2)-VZPT(3))/(2.0D0*VZPT(2))) TOFDL=DLTF(2) TOFDLER=100.0D0*DABS((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*DABS((TDT2-TDT3)/(2.0D0*TDT2)) TOFWR=WR(2) TOFWRER=100.0D0*DABS((WR(2)-WR(3))/(2.0D0*WR(2))) ANST2=DFLOAT(NETPL(2)) ANST3=DFLOAT(NETPL(3)) ANST4=ANST3-DSQRT(ANST3) ANST5=DLOG(ANST2/ANST3) ANST6=DLOG(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*DSQRT(ANST8**2+ATTERT**2) ELSE RALPHA=RI(2)/(1.0D0-ATTOINT) RALPER=100.0D0*DSQRT(ANST8**2+AIOERT**2) RATTOF=ATTOINT*RI(2)/(1.0D0-ATTOINT) RATOFER=100.0D0*DSQRT(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*DABS((EPT(I1)-EPT(I2))/(2.0D0*EPT(I1))) TOFWV=VZPT(I1) TOFWVER=100.0D0*DABS((VZPT(I1)-VZPT(I2))/(2.0D0*VZPT(I1))) TOFDL=DLTF(I1) TOFDLER=100.0D0*DABS((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*DABS((TDT1-TDT2)/(2.0D0*TDT1)) TOFWR=WR(I1) TOFWRER=100.0D0*DABS((WR(I1)-WR(I2))/(2.0D0*WR(I1))) ATER=DABS((RI(I1)-RI(I2))/(2.0D0*RI(I1))) RALPHA=RI(I1)/(1.0D0-ATTOINT) RALPER=100.0D0*DSQRT(ATER**2+AIOERT**2) RATTOF=ATTOINT*RI(I1)/(1.0D0-ATTOINT) IF(ATTOINT.NE.0.0D0) THEN RATOFER=100.0D0*DSQRT(ATER**2+ATTERT**2) ELSE RATOFER=0.0D0 ENDIF ENDIF RETURN END SUBROUTINE MONTEFD IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/IPS/XSS(200),YSS(200),ZSS(200),TSS(200),ESS(200), /DCXS(200),DCYS(200),DCZS(200),IPLS(200) 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) COMMON/SPL1/TMSPL(8),TTMSPL(8),RSPL(8),RRSPL(8),RRSPM(8) COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, /ZPLANE7,ZPLANE8,IZFINAL COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO DIMENSION EPRM(4000000),IESPECP(100) C---------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C THIS ROUTINE HANDLES TERMINATIONS AT FIXED DRIFT DISTANCES. C ------------------------------------------------------------------- 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=DACOS(-1.0D0) DO 25 I=1,300 25 TIME(I)=0.0D0 DO 26 I=1,30 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,4000 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 N4000=4000 N300=300 N100=100 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 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) DCX100=DCX1 DCY100=DCY1 DCZ100=DCZ1 E100=E1 BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*API C 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 C LOOP FOR NEW STARTING ELECTRONS 544 IPRIM=IPRIM+1 IZPLANE=0 TZSTOP=1000.0D0 IF(IPRIM.GT.1) THEN C CHECK IF PROGRAM WILL EXCEED MAXIMUM NUMBER OF ITERATIONS IN THIS C 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 WRITE(6,944) IPRIM 944 FORMAT(2X,' PROGRAM STOPPED TOO MANY PRIMARIES IPRIM=',I7) STOP ENDIF EPRM(IPRIM)=E1 IDUM=DINT(E1)+1 IDUM=DMIN0(IDUM,N100) IESPECP(IDUM)=IESPECP(IDUM)+1 C START OF LOOP FOR NEWLY CREATED ELECTRONS . 555 TDASH=0.0D0 NELEC=NELEC+1 C MAIN LOOP 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TOLD=TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) 15 IF(T.GE.TZSTOP.AND.TOLD.LT.TZSTOP) THEN TLFT=TZSTOP C STORE POSITION AND ENERGY AT Z PLANE = IZPLANE. C IF(IZPLANE.EQ.0) WRITE(6,8876) IZPLANE C8876 FORMAT(' IZPLANE=',I5) CALL SPLANE(T,E1,DCX1,DCY1,DCZ1,AP,BP,EFIELD,TLFT,IZPLANE) C******************************************************************** C C CHANGE IF STATEMENT FROM (IZFINAL+1) TO (IZFINAL-1) C FOR ANODE TERMINATION . C********************************************************************* IF(IZPLANE.GE.(IZFINAL+1)) THEN 18 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT C NO MORE ELECTRONS IN CASCADE RETURN TO MAIN. IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C TAKE ELECTRONS FROM STORE 20 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 C CHECK IF ELECTRON HAS ENOUGH ENERGY TO GO BACK TO FINAL PLANE EPOT=EFIELD*(Z-ZFINAL)*100.0D0 IF(E1.LT.EPOT) THEN NELEC=NELEC+1 ISOL=1 GO TO 18 ENDIF ENDIF CALL TCALC(Z,DCZ1,E1,EFIELD,TZSTOP,TZSTOP1,ISOL,IZPLANE) IF(TZSTOP.EQ.-99.0D0) THEN C CATCH RUNAWAY ELECTRONS AT HIGH FIELD NELEC=NELEC+1 ISOL=1 GO TO 18 ENDIF GO TO 555 ENDIF C 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 WRITE(6,999) E,E1,AP,BP,T,DCZ1,ITER 999 FORMAT(2X,' WARNING ENERGY LT.0. E=',D12.3,' E1=',D12.3,' AP=',D1 /2.3,' BP=',D12.3,' T=',D12.3,/,' DCZ1=',D12.3,' ITER=',I10) E=0.001D0 ENDIF IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 CONST6=DSQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(E) A=AP*T B=BP*T2 CONST7=CONST9*DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) TIME(IT)=TIME(IT)+1.0D0 CX1=DCX1*CONST7 CY1=DCY1*CONST7 SPEC(IE)=SPEC(IE)+1.0D0 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(E.LT.EI) THEN C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF A BINING ERROR OCCURS. C WRITE(6,994) E,EI,ITER C994 FORMAT(3X,' WARNING BINNING ERROR ENERGY =',F8.3,' EI=',F8.3,' ITE C /R =',I12) EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 C ATTACHMENT IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=DINT(T+1.0D0) IT=DMIN0(IT,N300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT IDM1=1+DINT(Z/ZSTEP) IF(IDM1.LT.1) IDM1=1 IF(IDM1.GT.9) IDM1=9 NESST(IDM1)=NESST(IDM1)-1 C ELECTRON CAPTURED START NEW PRIMARY IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C ELECTRON CAPTURED TAKE NEXT ELECTRON FROM STORE GO TO 20 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) C USE OPAL PETERSON AND BEATY SPLITTING FACTOR. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) C RESCALE ESEC BY WPL(I)*(ESEC/(WPL(I))**0.9524 ESEC=WPL(I)*(ESEC/WPL(I))**0.9524 EI=ESEC+EI C STORE POSITION ,ENERGY, DIRECTION COSINES AND TIME OF GENERATION C OF IONISATION ELECTRON NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED NPONT=',I3,' ITER=',I10) STOP ENDIF XSS(NPONT)=X YSS(NPONT)=Y ZSS(NPONT)=Z TSS(NPONT)=ST ESS(NPONT)=ESEC C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=DACOS(F3) F6=DCOS(THETA0) F5=DSIN(THETA0) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) DCXS(NPONT)=F9*F5 DCYS(NPONT)=F8*F5 DCZS(NPONT)=F6 IDM1=1+DINT(Z/ZSTEP) IF(IDM1.LT.1) IDM1=1 IF(IDM1.GT.9) IDM1=9 IPLS(NPONT)=IDM1 NESST(IPLS(NPONT))=NESST(IPLS(NPONT))+1 C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 C IF EXCITATION THEN ADD PROBABILITY,PENFRA(1,I), OF TRANSFER TO GIVE C IONISATION OF THE OTHER GASES IN THE MIXTURE. IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).NE.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 NCLUS=NCLUS+1 NPONT=NPONT+1 IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER STOP ENDIF C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XSS(NPONT)=X YSS(NPONT)=Y ZSS(NPONT)=Z IF(ZSS(NPONT).GT.ZFINAL.OR.ZSS(NPONT).LT.0.0) GO TO 669 GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XSS(NPONT)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YSS(NPONT)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZSS(NPONT)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN IF(ZSS(NPONT).LT.0.0) GO TO 669 IF(ZSS(NPONT).GT.ZFINAL.OR.ZSS(NPONT).LT.0.0) GO TO 669 667 TPEN=ST IF(PENFRA(3,I).EQ.0.) GO TO 668 RAN=drand48(RDUM) TPEN=ST-DLOG(RAN)*PENFRA(3,I) 668 TSS(NPONT)=TPEN ESS(NPONT)=1.0 DCXS(NPONT)=DCX1 DCYS(NPONT)=DCY1 DCZS(NPONT)=DCZ1 C FIND LAST PLANE BEFORE ZSS(NPONT) IDM1=1+DINT(ZSS(NPONT)/ZSTEP) IF(IDM1.LT.1) IDM1=1 IF(IDM1.GT.9) IDM1=9 IPLS(NPONT)=IDM1 NESST(IPLS(NPONT))=NESST(IPLS(NPONT))+1 GO TO 5 C PENNING TRANSFER OCCURS BEFORE FIRST SPACE PLANE CLEAR ENTRY 669 NPONT=NPONT-1 NCLUS=NCLUS-1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,9232) ITER,ID,E1 C9232 FORMAT(3X,' WARNING ARGZ= 0.0 AT ITER =',I10,' ID=',I10,' E1=',E C /12.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 C STORE DIRECTION COSINES AND ENERGY AFTER N COLLISIONS C 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 C CHECK IF ELECTRON HAS ENOUGH ENERGY TO GO BACK TO FINAL PLANE. EPOT=EFIELD*(Z-ZFINAL)*100.0D0 IF(E1.LT.EPOT) GO TO 18 ENDIF C CALCULATE TIME TZSTOP TO ARRIVE AT NEXT Z PLANE IZPLANE. CALL TCALC(Z,DCZ1,E1,EFIELD,TZSTOP,TZSTOP1,ISOL,IZPLANE) C CATCH RUNAWAY ELECTRONS AT HIGH FIELD IF(TZSTOP.EQ.-99.0D0) GO TO 18 IF(IPRINT.GT.JPRINT) GO TO 200 GO TO 1 C INTERMEDIATE PRINTOUT 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 XID=DFLOAT(ID) JCT=ID/100000 C IF(J1.EQ.1) WRITE(6,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VEL POS TIME C / COUNT') C WRITE(6,202) W,ZTOTS,TTOTS,JCT C 202 FORMAT(1X,F8.3,2(1X,D10.3),1X,I6) J1=J1+1 GO TO 1 C MAIN LOOP END 700 XID=DFLOAT(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DFLOAT(NEION) ANBT=DFLOAT(NELEC-IPRIM) ATTOION=ANEION/ANBT ATTATER=DSQRT(ANEION)/ANEION ATTIOER=DSQRT(ANBT)/ANBT ELSE ATTOION=-1.0D0 ANEION=DFLOAT(NEION) ATTATER=DSQRT(ANEION)/ANEION ENDIF JCT=ID/10000 IF(J1.EQ.1) THEN WRITE(6,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 WRITE(6,878) NELEC,NEION,IPRIM 878 FORMAT(/,' TOTAL NO OF ELECTRONS=',I10,/,' TOTAL NO OF NEG. IONS=' /,I10,/,' TOTAL NO OF PRIMARIES=',I10) 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=DSQRT(E2PRM/IPRIM-EBAR**2) WRITE(6,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C WRITE(6,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 WRITE(6,991) ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =',I10,/, /' NPONT=',I4,' NELEC=',I8,' IPRIM=',I6,' NMXADD=',I3) STOP ENDIF RETURN END SUBROUTINE SPLANE(T,E1,DCX1,DCY1,DCZ1,AP,BP,EFLD,TIMLFT,IZPLANE) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM 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) COMMON/SPL1/TMSPL(8),TTMSPL(8),RSPL(8),RRSPL(8),RRSPM(8) 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=DSQRT(E1/EPLANE) C DCX2=DCX1*CONST6 C DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFLD*TIMLFT*CONST5/DSQRT(EPLANE) XPLANE=X+DCX1*TIMLFT*DSQRT(E1)*CONST3*0.01D0 YPLANE=Y+DCY1*TIMLFT*DSQRT(E1)*CONST3*0.01D0 ZPLANE=Z+DCZ1*TIMLFT*DSQRT(E1)*CONST3*0.01D0+T2LFT*EFLD*CONST2 VZPLANE=DCZ2*DSQRT(EPLANE)*CONST3*0.01D0 WGHT=DABS(1.0D0/VZPLANE) RPLANE=DSQRT(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 RETURN END SUBROUTINE TCALC(Z,DCZ1,E1,EFIELD,TZSTOP1,TZSTOP2,ISOL,IZPLANE) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, /ZPLANE7,ZPLANE8,IZFINAL 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=EFIELD*CONST2 B=DSQRT(E1)*CONST3*0.01D0*DCZ1 B2=B*B IF(Z.LT.ZPLANE1) THEN IZPLANE=1 C1=Z-ZPLANE1 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+DSQRT(B2-4.0D0*A*C1))/(2.0D0*A) TSTOP2=(-B-DSQRT(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+DSQRT(FAC))/(2.0D0*A) TSTOP2=(-B-DSQRT(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 RETURN END SUBROUTINE SST IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM 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) COMMON/SPL1/TMSPL(8),TTMSPL(8),RSPL(8),RRSPL(8),RRSPM(8) COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, /ZPLANE7,ZPLANE8,IZFINAL COMMON/SSTOUT/VDOUT,VDERR,WSOUT,WSERR,DLOUT,DLERR,DTOUT,DTERR, /ALPHSST,ALPHERR,ATTSST,ATTERR 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 DRSS1(8),DRSS2(8),DRSS3(8),ALFEX1(8),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)=(DLOG(DFLOAT(NESST(1)))-DLOG(DFLOAT(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*DFLOAT(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)=(DLOG(TSSUM(I))-DLOG(TSSUM(I-1)))/ZSTEP ALFNJ(I)=(DLOG(TSSUM(I)*VDSST(I))-DLOG(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)=(DLOG(DFLOAT(NESST(I)))-DLOG(DFLOAT(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*DFLOAT(JPRINT) ALFIN=DLOG(DFLOAT(NESST(JPRINT))/DFLOAT(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 WRITE(6,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 WRITE(6,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*DABS((VDSST(2)-VDSST(3))/(2.0D0*VDSST(2))) WSOUT=WSSST(2) WSERR=100.0D0*DABS((WSSST(2)-WSSST(3))/(2.0D0*WSSST(2))) DLOUT=DLSST(2) DLERR=100.0D0*DABS((DLSST(2)-DLSST(3))/(2.0D0*DLSST(2))) DTOUT=DRSST(2) DTERR=100.0D0*DABS((DRSST(2)-DRSST(3))/(2.0D0*DRSST(2))) IF(ATTOION.EQ.-1.0D0) THEN C NO IONISATION ALPHSST=0.0 ALPHERR=0.0 ANST2=DFLOAT(NESST(2)) ANST3=DFLOAT(NESST(3)) ANST4=ANST3-DSQRT(ANST3) ANST5=DLOG(ANST2/ANST3) ANST6=DLOG(ANST2/ANST4) ANST7=ANST6/ANST5 ANST8=ANST7-1.0D0 ATTSST=-(ALFN(2)+ALFNJ(2)+ALFNE(2))/3.0D0 ATTERR=100.0D0*DSQRT(ANST8**2+ATTATER**2) ELSE ANST2=DFLOAT(NESST(2)) ANST3=DFLOAT(NESST(3)) ANST4=ANST3-DSQRT(ANST3) ANST5=DLOG(ANST2/ANST3) ANST6=DLOG(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*DSQRT(ANST8**2+ATTIOER**2) ATTSST=ATTOION*ATMP/(1.0D0-ATTOION) ATTERR=100.0D0*DSQRT(ANST8**2+ATTATER**2) ENDIF ELSE C NET IONISATION THEREFORE TAKE RESULTS FROM PLANE 8 VDOUT=VDSST(8) VDERR=100.0D0*DABS((VDSST(8)-VDSST(7))/(2.0D0*VDSST(8))) WSOUT=WSSST(8) WSERR=100.0D0*DABS((WSSST(8)-WSSST(7))/(2.0D0*WSSST(8))) DLOUT=DLFIN DLERR=100.0D0*DABS((DLOUT-DLSST(8))/(2.0D0*DLOUT)) DTOUT=(DXFIN+DYFIN)/2.0D0 DTERR=100.0D0*DABS((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=DABS((ATMP-ATMP2)/(2.0D0*ATMP)) ALPHSST=ATMP/(1.0D0-ATTOION) ALPHERR=100.0D0*DSQRT(ATER**2+ATTIOER**2) ATTSST=ATTOION*ATMP/(1.0D0-ATTOION) IF(ATTOION.NE.0.0D0) THEN ATTERR=100.0D0*DSQRT(ATER**2+ATTATER**2) ELSE ATTERR=0.0D0 ENDIF ENDIF RETURN END SUBROUTINE OUTPUT2 IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/MIX2/E(4000),EROOT(4000),QTOT(4000),QREL(4000),QINEL(4000), /QEL(4000) COMMON/MIX1/QELM(4000),QSUM(4000),QION(6,4000),QIN1(220,4000), /QIN2(220,4000),QIN3(220,4000),QIN4(220,4000),QIN5(220,4000), /QIN6(220,4000),QSATT(4000) COMMON/RATIO/AN1,AN2,AN3,AN4,AN5,AN6,AN,FRAC(6) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),LAST,ISIZE,PENFRA(3,512) COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/SINT/SIMF(4000) COMMON/NAMES/NAMEG(6) COMMON/SCRIP/DSCRPT(512) CHARACTER*30 DSCRPT CHARACTER*15 NAMEG DIMENSION FREQEL(6),FREQSP(6),FREINE(6),FREATT(6),FREION(6) DIMENSION SPECS(40) WRITE(6,15) WRITE(6,15) 15 FORMAT('---------------------------------------------------------- /-------------------') WRITE(6,110) SPEC(4000) 110 FORMAT(2(/),' NUMBER OF COLLISIONS IN FINAL ENERGY BIN =',F8.1) NINEL=ICOLL(2)+ICOLL(3)+ICOLL(4)+ICOLL(5)+ICOLL(7)+ICOLL(8)+ICOLL( /9)+ICOLL(10)+ICOLL(12)+ICOLL(13)+ICOLL(14)+ICOLL(15)+ICOLL(17)+ICO /LL(18)+ICOLL(19)+ICOLL(20)+ICOLL(22)+ICOLL(23)+ICOLL(24)+ICOLL(25) /+ICOLL(27)+ICOLL(28)+ICOLL(29)+ICOLL(30) NELA=ICOLL(1)+ICOLL(6)+ICOLL(11)+ICOLL(16)+ICOLL(21)+ICOLL(26) NTOTAL=NELA+NINEL IF(TTOTS.EQ.0.0D0) THEN NREAL=NTOTAL TTOTS=ST ELSE NREAL=NTOTAL ENDIF FREQ=NREAL/TTOTS FREIN=NINEL/TTOTS FREEL=NELA/TTOTS WRITE(6,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.',/) WRITE(6,15) C ILAST=DINT(TMAX1)+1 C IF(ILAST.GT.120) ILAST=120 C WRITE(6,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 WRITE(6,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 WRITE(6,1050) (NAMEG(I),FREQEL(I),FREQSP(I),FREINE(I),FREATT(I), C /FREION(I),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 WRITE(6,15) WRITE(6,1060) 1060 FORMAT(/,2X,'DETAILED COLLISION FREQUENCIES FOR EACH GAS IN UNITS /OF 10**12/SEC. :',2(/)) DO 1100 J=1,NGAS WRITE(6,1065) NAMEG(J) 1065 FORMAT(3X,A15,/,'------------------',2(/)) DO 1090 K=1,LAST IF(IARRY(K).LE.(5*J).AND.IARRY(K).GT.(5*(J-1))) THEN FRELV=FREQ*ICOLN(K)/DFLOAT(NREAL) IF(ICOLN(K).EQ.0) THEN ERRFRE=0.0 ELSE ERRFRE=100.0D0*DSQRT(DFLOAT(ICOLN(K)))/DFLOAT(ICOLN(K)) ENDIF WRITE(6,1070) DSCRPT(K),FRELV,ERRFRE 1070 FORMAT(3X,A30,3X,D11.4,' +-',F8.4,' %') ENDIF 1090 CONTINUE 1100 CONTINUE WRITE(6,15) WRITE(6,301) 301 FORMAT(2(/),10X,' NORMALISED ENERGY DISTRIBUTION') J1=0 J2=0 SPECN=DFLOAT(NREAL) SMSPEC=0.0D0 DO 350 K=1,4000 SPEC(K)=SPEC(K)/SPECN J1=J1+1 SMSPEC=SMSPEC+SPEC(K) IF(J1.LT.100) GO TO 350 J2=J2+1 SPECS(J2)=SMSPEC SMSPEC=0.0D0 J1=0 350 CONTINUE EPLT=EFINAL/40.0D0 DO 420 I=1,40 ENER=EPLT*(DFLOAT(I)-0.5D0) WRITE(6,302) ENER,SPECS(I) 302 FORMAT(6X,'E=',F7.3,6X,'SPEC=',D10.3) 420 CONTINUE RETURN END SUBROUTINE ALPCLCB IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/TOFGOUT/RALPHA,RALPER,TOFENE,TOFENER,TOFWVZ,TOFWVZER, /TOFWVY,TOFWVYER,TOFDZZ,TOFDZZER,TOFDXX,TOFDXXER,TOFDYY,TOFDYYER, /TOFDYZ,TOFDYZER,TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER,RATTOF,RATOFER COMMON/VEL/WX,WY,WZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM C ---------------------------------------------------------------------- C ESTIMATE TIME STEP FOR AVALANCHE SIMULATION IN TIME OF FLIGHT SIM. C USES ESTIMATED GAIN OF 3.0 BETWEEN PLANES. C CALLS TOF AND PT SUBROUTINES AND UPDATES ALPHA AND ATT C VERSION WITH BFIELD ALONG X-AXIS AND EFIELD ALONG Z-AXIS (90 DEGREES) C ---------------------------------------------------------------------- IMAX=NMAX/10000000 IF(IMAX.LT.5) IMAX=5 NMAX=IMAX*10000000 ALPHAST=0.85D0*DABS(ALPHA-ATT) VDST=WZ*1.D-5 TSTEP=DLOG(3.0D0)/(ALPHAST*VDST*1.0D5) TSTEP=TSTEP*1.0D12 TFINAL=7.0D0*TSTEP ITFINAL=7 C CALC TIME OF FLIGHT AND PT WRITE(6,25) 25 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') WRITE(6,26) TSTEP 26 FORMAT(1(/),' TIME STEP BETWEEN SAMPLING PLANES =',D12.5,' PICOSE /CS.',/) CALL MONTEFTG CALL FRIEDLAND CALL PTG CALL TOFG WRITE(6,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,' %') WRITE(6,28) 28 FORMAT(/,'TOF DIFFUSION') WRITE(6,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,' %') WRITE(6,30) 30 FORMAT(/,'TOF DRIFT VELOCITY') WRITE(6,31) TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER 31 FORMAT(/,'WRZ=',F8.2,' +-',F6.1,' % WRY=',F8.2,' +-',F6.1,' %') C CALCULATE TOWNSEND SST COEFICIENTS FROM TOF RESULTS WRZN=TOFWRZ*1.0D05 FC1=WRZN/(2.0D0*TOFDZZ) FC2=((RALPHA-RATTOF)*1.0D12)/TOFDZZ ALPZZ=FC1-DSQRT(FC1**2-FC2) C---- ------------------------------------------------- C LOAD NEW ALPHA AND ATTACHMENT INTO COMMON BLOCKS C---- ------------------------------------------- ALPATT=ALPHA-ATT RATIO=ALPZZ/ALPATT ALPHA=ALPHA*RATIO ATT=ATT*RATIO WRITE(6,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,' %',/) C --- ------------------------------------------- RETURN END SUBROUTINE MONTEFTG IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),IPLAST,ISIZE,PENFRA(3,512) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/IPT/XS(200),YS(200),ZS(200),TS(200),ES(200), /DCX(200),DCY(200),DCZ(200),IPL(200) COMMON/TPLOUTG/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),YZTPL(8),VZTPL(8),VYTPL(8),NETPL(8),ATTOINT, /ATTERT,AIOERT COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO DIMENSION EPRM(4000000),IESPECP(100) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C THIS ROUTINE HANDLES TERMINATIONS AT FIXED DRIFT TIMES. C B FIELD AT 90 DEGREES TO EFIELD C ------------------------------------------------------------------- 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=DACOS(-1.0D0) DO 25 I=1,300 25 TIME(I)=0.0D0 DO 26 I=1,30 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,4000 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 N4000=4000 N300=300 N100=100 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 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C INITIAL VELOCITY VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 F4=2.0D0*API C 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 C LOOP FOR NEW STARTING ELECTRONS 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN C CHECK IF PROGRAM WILL EXCEED MAXIMUM NUMBER OF ITERATIONS C 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*DSQRT(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 WRITE(6,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=DINT(E1)+1 IDUM=DMIN0(IDUM,N100) IESPECP(IDUM)=IESPECP(IDUM)+1 C START OF LOOP FOR NEWLY CREATED ELECTRONS 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP C MAIN LOOP 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=DCOS(WBT) SINWT=DSIN(WBT) 15 IF((T+ST).GE.TSTOP) THEN IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP C STORE POSITION AND ENERGY AT TIME PLANE =IPLANE. CALL TPLANEG(T,E1,CX1,CY1,CZ1,EFIELD,IPLANE) C CHECK IF PASSED THROUGH MORE THAN ONE PLANE IN THIS STEP IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 IF((T+ST).GE.TFINAL) THEN ZTOT=ZTOT+Z YTOT=YTOT+Y TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT YTOTS=YTOTS+Y-YSTRT TTOTS=TTOTS+ST-TSSTRT TSTOP=TSTEP C NO MORE ELECTRONS IN CASCADE TRY NEW PRIMARY ELECTRON IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C TAKE ELECTRONS FROM STORE 20 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*DSQRT(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*EFIELD*100.0D0 913 FORMAT(3X,' AFTER STORE ITER=',I10,' DZ=',D12.3,'E1=',D12.3,' COSW /T=',D12.3,' SINWT=',D12.3,' WBT=',D12.3,' CY1=',D12.3) IF(E.LT.0.0D0) THEN WRITE(6,913)ITER,DZ,E,COSWT,SINWT,WBT,CY1 E=0.001D0 ENDIF IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. 137 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 COSINES VTOT=DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 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(E.LT.EI) THEN C WRITE(6,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') C 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 C ATTACHMENT IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=DINT(T+1.0D0) IT=DMIN0(IT,N300) 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 C ELECTRON CAPTURED START NEW PRIMARY IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C ELECTRON CAPTURED TAKE NEXT ELECTRON FROM STORE GO TO 20 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) C USE OPAL PETERSON AND BEATY SPLITTING FACTOR. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI C STORE POSITION ,ENERGY, DIRECTION COSINES AND TIME OF GENERATION C OF IONISATION ELECTRON NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=DACOS(F3) F6=DCOS(THETA0) F5=DSIN(THETA0) R4=drand48(rdum) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I),OF TRANSFER TO GIVE C IONISATION OF THE OTHER GASES IN THE MIXTURE IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).EQ.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 NCLUS=NCLUS+1 NPONT=NPONT+1 IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER STOP ENDIF C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XS(NPONT)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YS(NPONT)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZS(NPONT)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN C POSSIBLE PENNING TRANSFER TIME 667 TPEN=ST IF(PENFRA(3,I).EQ.0.0) GO TO 668 RAN=drand48(RDUM) TPEN=ST-DLOG(RAN)*PENFRA(3,I) 668 TS(NPONT)=TPEN ES(NPONT)=1.0 DCX(NPONT)=DCX1 DCY(NPONT)=DCY1 DCZ(NPONT)=DCZ1 C FIND LAST TIME PLANE BEFORE TPEN TSTOP1=0.0 IPLANE1=0 DO 669 KDUM=1,ITFINAL TSTOP1=TSTEP+TSTOP1 IF(TPEN.LT.TSTOP1) GO TO 670 IPLANE1=IPLANE1+1 669 CONTINUE C PENNING TRANSFER OCCURS AFTER FINAL TIME PLANE CLEAR ENTRY NPONT=NPONT-1 NCLUS=NCLUS-1 GO TO 5 670 IPL(NPONT)=IPLANE1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,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 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*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT C STORE DIRECTION COSINES AND ENERGY AFTER N COLLISIONS C 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 C 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) WRITE(6,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VELZ POSZ TIME C / VELY COUNT ') C WRITE(6,202) W,ZTOTS,TTOTS,WY,JCT C 202 FORMAT(1X,F8.3,3(1X,D10.3),4X,I6) J1=J1+1 GO TO 1 C MAIN LOOP END 700 XID=DFLOAT(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DFLOAT(NEION) ANBT=DFLOAT(NELEC-IPRIM) ATTOINT=ANEION/ANBT ATTERT=DSQRT(ANEION)/ANEION AIOERT=DSQRT(ANBT)/ANBT ELSE ANEION=DFLOAT(NEION) ATTOINT=-1.0D0 ATTERT=DSQRT(ANEION)/ANEION ENDIF JCT=ID/100000 IF(J1.EQ.1) THEN WRITE(6,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS), DECREASE THE /ESTIMATED ALPHA. NCLUS = ',I7,' ITER =',I9) STOP ENDIF WRITE(6,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=DSQRT(E2PRM/IPRIM-EBAR**2) WRITE(6,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C WRITE(6,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 WRITE(6,991) ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =',I10,/, /' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4,' NMXADD=',I3) STOP ENDIF RETURN END SUBROUTINE TPLANEG(T,E1,CX1,CY1,CZ1,EFLD,IPLANE) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TPLOUTG/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),YZTPL(8),VZTPL(8),VYTPL(8),NETPL(8),ATTOINT, /ATTERT,AIOERT 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=DCOS(WBT) SINWT=DSIN(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=DSQRT(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*DSQRT(EPLANE)*CONST3*0.01D0 VYPLANE=DCY2*DSQRT(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 RETURN END SUBROUTINE PTG IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUTG/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),YZTPL(8),VZTPL(8),VYTPL(8),NETPL(8),ATTOINT, /ATTERT,AIOERT COMMON/PTTOFG/RI(8),EPT(8),VZPT(8),VYPT(8),TTEST(8) DIMENSION ANTPL(8) C ------------------------------------------------ C CALCULATES PULSED TOWNSEND COEFFICIENTS C------------------------------------------------- ANTPL(1)=DFLOAT(NETPL(1)) RI(1)=(DLOG(ANTPL(1))-DLOG(DFLOAT(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)=DFLOAT(NETPL(I)) RI(I)=(DLOG(ANTPL(I))-DLOG(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 WRITE(6,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 WRITE(6,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 RETURN END SUBROUTINE TOFG IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUTG/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),YZTPL(8),VZTPL(8),VYTPL(8),NETPL(8),ATTOINT, /ATTERT,AIOERT COMMON/TOFGOUT/RALPHA,RALPER,TOFENE,TOFENER,TOFWVZ,TOFWVZER, /TOFWVY,TOFWVYER,TOFDZZ,TOFDZZER,TOFDXX,TOFDXXER,TOFDYY,TOFDYYER, /TOFDYZ,TOFDYZER,TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER,RATTOF,RATOFER COMMON/PTTOFG/RI(8),EPT(8),VZPT(8),VYPT(8),TTEST(8) 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)=DFLOAT(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)=DFLOAT(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 WRITE(6,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 WRITE(6,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*DABS((EPT(2)-EPT(3))/(2.0D0*EPT(2))) TOFWVZ=VZPT(2) TOFWVZER=100.0D0*DABS((VZPT(2)-VZPT(3))/(2.0D0*VZPT(2))) TOFWVY=VYPT(2) TOFWVYER=100.0D0*DABS((VYPT(2)-VYPT(3))/(2.0D0*VYPT(2))) TOFDZZ=DZTF(2) TOFDZZER=100.0D0*DABS((DZTF(2)-DZTF(3))/(2.0D0*DZTF(2))) TOFDXX=DXTF(2) TOFDXXER=100.0D0*DABS((DXTF(2)-DXTF(3))/(2.0D0*DXTF(2))) TOFDYY=DYTF(2) TOFDYYER=100.0D0*DABS((DYTF(2)-DYTF(3))/(2.0D0*DYTF(2))) TOFDYZ=DYZTF(2) TOFDYZER=100.0D0*DABS((DYZTF(2)-DYZTF(3))/(2.0D0*DYZTF(2))) TOFWRZ=WRZ(2) TOFWRY=WRY(2) TOFWRZER=100.0D0*DABS((WRZ(2)-WRZ(3))/(2.0D0*WRZ(2))) TOFWRYER=100.0D0*DABS((WRY(2)-WRY(3))/(2.0D0*WRY(2))) ANST2=DFLOAT(NETPL(2)) ANST3=DFLOAT(NETPL(3)) ANST4=ANST3-DSQRT(ANST3) ANST5=DLOG(ANST2/ANST3) ANST6=DLOG(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*DSQRT(ANST8**2+ATTERT**2) ELSE RALPHA=RI(2)/(1.0D0-ATTOINT) RALPER=100.0D0*DSQRT(ANST8**2+AIOERT**2) RATTOF=ATTOINT*RI(2)/(1.0D0-ATTOINT) RATOFER=100.0D0*DSQRT(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*DABS((EPT(I1)-EPT(I2))/(2.0D0*EPT(I1))) TOFWVZ=VZPT(I1) TOFWVZER=100.0D0*DABS((VZPT(I1)-VZPT(I2))/(2.0D0*VZPT(I1))) TOFWVY=VYPT(I1) TOFWVYER=100.0D0*DABS((VYPT(I1)-VYPT(I2))/(2.0D0*VYPT(I1))) TOFDZZ=DZTF(I1) TOFDZZER=100.0D0*DABS((DZTF(I1)-DZTF(I2))/(2.0D0*DZTF(I1))) TOFDXX=DXTF(I1) TOFDXXER=100.0D0*DABS((DXTF(I1)-DXTF(I2))/(2.0D0*DXTF(I1))) TOFDYY=DYTF(I1) TOFDYYER=100.0D0*DABS((DYTF(I1)-DYTF(I2))/(2.0D0*DYTF(I1))) TOFDYZ=DYZTF(I1) TOFDYZER=100.0D0*DABS((DYZTF(I1)-DYZTF(I2))/(2.0D0*DYZTF(I1))) TOFWRZ=WRZ(I1) TOFWRY=WRY(I1) TOFWRZER=100.0D0*DABS((WRZ(I1)-WRZ(I2))/(2.0D0*WRZ(I1))) TOFWRYER=100.0D0*DABS((WRY(I1)-WRY(I2))/(2.0D0*WRY(I1))) ATER=DABS((RI(I1)-RI(I2))/(2.0D0*RI(I1))) RALPHA=RI(I1)/(1.0D0-ATTOINT) RALPER=100.0D0*DSQRT(ATER**2+AIOERT**2) RATTOF=ATTOINT*RI(I1)/(1.0D0-ATTOINT) IF(ATTOINT.NE.0.0D0) THEN RATOFER=100.0D0*DSQRT(ATER**2+ATTERT**2) ELSE RATOFER=0.0D0 ENDIF ENDIF RETURN END SUBROUTINE ALPCLCC IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/TOFHOUT/RALPHA,RALPER,TOFENE,TOFENER,TOFWVZ,TOFWVZER, /TOFWVY,TOFWVYER,TOFWVX,TOFWVXER,TOFDZZ,TOFDZZER,TOFDXX,TOFDXXER, /TOFDYY,TOFDYYER,TOFDYZ,TOFDYZER,TOFDXY,TOFDXYER,TOFDXZ,TOFDXZER, /TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER,TOFWRX,TOFWRXER,RATTOF,RATOFER COMMON/VEL/WX,WY,WZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM C ---------------------------------------------------------------------- C ESTIMATE TIME STEP FOR AVALANCHE SIMULATION IN TIME OF FLIGHT SIM. C USES ESTIMATED GAIN OF 3.0 BETWEEN PLANES. C CALLS TOF AND PT SUBROUTINES AND UPDATES ALPHA AND ATT C BFIELD AT ANY ANGLE BTHETA TO EFIELD C ---------------------------------------------------------------------- IMAX=NMAX/10000000 IF(IMAX.LT.5) IMAX=5 NMAX=IMAX*10000000 ALPHAST=0.85D0*DABS(ALPHA-ATT) VDST=WZ*1.D-5 TSTEP=DLOG(3.0D0)/(ALPHAST*VDST*1.0D5) TSTEP=TSTEP*1.0D12 TFINAL=7.0D0*TSTEP ITFINAL=7 C CALC TIME OF FLIGHT AND PT WRITE(6,25) 25 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') WRITE(6,26) TSTEP 26 FORMAT(1(/),' TIME STEP BETWEEN SAMPLING PLANES =',D12.5,' PICOSE /CS.',/) CALL MONTEFTH CALL FRIEDLAND CALL PTH CALL TOFH WRITE(6,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,' %') WRITE(6,28) 28 FORMAT(/,'TOF DIFFUSION') WRITE(6,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,' %') WRITE(6,30) 30 FORMAT(/,'TOF DRIFT VELOCITY') WRITE(6,31) TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER,TOFWRX,TOFWRXER 31 FORMAT(/,'WRZ=',F8.2,' +-',F6.1,' % WRY=',F8.2,' +-',F6.1,' % / WRX=',F8.2,' +-',F6.1,' %') C CALCULATE TOWNSEND SST COEFICIENTS FROM TOF RESULTS WRZN=TOFWRZ*1.0D05 FC1=WRZN/(2.0D0*TOFDZZ) FC2=((RALPHA-RATTOF)*1.0D12)/TOFDZZ ALPZZ=FC1-DSQRT(FC1**2-FC2) C----------------------------------------------------- C LOAD NEW ALPHA AND ATTACHMENT INTO COMMON BLOCKS C----------------------------------------------- ALPATT=ALPHA-ATT RATIO=ALPZZ/ALPATT ALPHA=ALPHA*RATIO ATT=ATT*RATIO WRITE(6,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,' %',/) C----------------------------------------------- RETURN END SUBROUTINE MONTEFTH IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/ROTS/RCS,RSN,EFZ100,EFX100,F1,EOVBR COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),IPLAST,ISIZE,PENFRA(3,512) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/IPT/XS(200),YS(200),ZS(200),TS(200),ES(200), /DCX(200),DCY(200),DCZ(200),IPL(200) COMMON/TPLOUTH/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),NETPL(8),ATTOINT,ATTERT,AIOERT COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO DIMENSION EPRM(4000000),IESPECP(100) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C THIS ROUTINE HANDLES TERMINATIONS AT FIXED DRIFT TIMES. C SOLVES MOTION IN COORDINATE SYSTEM WITH BFIELD ALIGNED TO X-AXIS C ELECTRIC FIELD AT AN ANGLE BTHETA IN THE X-Z PLANE. C THE RESULTS FOR THE VELOCITY VECTORS ARE THEN C ROTATED INTO THE STANDARD COORDINATE FRAME WITH THE ELECTRIC FIELD C ALONG THE Z-AXIS AND THE BFIELD AT AN ANGLE BTHETA TO THE ELECTRIC C FIELD IN THE X-Z PLANE C ------------------------------------------------------------------- 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,30 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,4000 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 N4000=4000 N300=300 N100=100 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=DACOS(-1.0D0) C CALC ROTATION MATRIX ANGLES RCS=DCOS((BTHETA-90.0D0)*API/180.0D0) RSN=DSIN((BTHETA-90.0D0)*API/180.0D0) C RTHETA=BTHETA*API/180.0D0 EFZ100=EFIELD*100.0D0*DSIN(RTHETA) EFX100=EFIELD*100.0D0*DCOS(RTHETA) F1=EFIELD*CONST2*DCOS(RTHETA) EOVBR=EOVB*DSIN(RTHETA) C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C INITIAL VELOCITY VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 F4=2.0D0*API C 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 C LOOP FOR NEW STARTING ELECTRONS 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN C CHECK IF PROGRAM WILL EXCEED MAXIMUM NUMBER OF ITERATIONS C 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*DSQRT(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 WRITE(6,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=DINT(E1)+1 IDUM=DMIN0(IDUM,N100) IESPECP(IDUM)=IESPECP(IDUM)+1 C START OF LOOP FOR NEWLY CREATED ELECTRONS 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP C MAIN LOOP 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=DCOS(WBT) SINWT=DSIN(WBT) 15 IF((T+ST).GE.TSTOP) THEN IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP C STORE POSITION AND ENERGY AT TIME PLANE =IPLANE. CALL TPLANEH(T,E1,CX1,CY1,CZ1,EFIELD,IPLANE) C CHECK IF PASSED THROUGH MORE THAN ONE PLANE IN THIS STEP IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 IF((T+ST).GE.TFINAL) 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 C NO MORE ELECTRONS IN CASCADE TRY NEW PRIMARY ELECTRON IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C TAKE ELECTRONS FROM STORE 20 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*DSQRT(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,' COSW /T=',D12.3,' SINWT=',D12.3,' WBT=',D12.3,' CY1=',D12.3) IF(E.LT.0.0D0) THEN WRITE(6,913)ITER,DZ,E,COSWT,SINWT,WBT,CY1 E=0.001D0 ENDIF IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. 137 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 COSINES VTOT=DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 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(E.LT.EI) THEN C WRITE(6,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') C 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 C ATTACHMENT IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=DINT(T+1.0D0) IT=DMIN0(IT,N300) 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 C ELECTRON CAPTURED START NEW PRIMARY IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C ELECTRON CAPTURED TAKE NEXT ELECTRON FROM STORE GO TO 20 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) C USE OPAL PETERSON AND BEATY SPLITTING FACTOR. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI C STORE POSITION ,ENERGY, DIRECTION COSINES AND TIME OF GENERATION C OF IONISATION ELECTRON NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=DACOS(F3) F6=DCOS(THETA0) F5=DSIN(THETA0) R4=drand48(rdum) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I),OF TRANSFER TO GIVE C IONISATION OF THE OTHER GASES IN THE MIXTURE IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).NE.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 NCLUS=NCLUS+1 NPONT=NPONT+1 IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER STOP ENDIF C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XS(NPONT)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YS(NPONT)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZS(NPONT)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN C ENTER POSSIBLE PENNING TRANSFER TIME 667 TPEN=ST IF(PENFRA(3,I).EQ.0.0) GO TO 668 RAN=drand48(RDUM) TPEN=ST-DLOG(RAN)*PENFRA(3,I) 668 TS(NPONT)=TPEN ES(NPONT)=1.0 DCX(NPONT)=DCX1 DCY(NPONT)=DCY1 DCZ(NPONT)=DCZ1 C FIND LAST TIME PLANE BEFORE TPEN TSTOP1=0.0 IPLANE1=0 DO 669 KDUM=1,ITFINAL TSTOP1=TSTEP+TSTOP1 IF(TPEN.LT.TSTOP1) GO TO 670 IPLANE1=IPLANE1+1 669 CONTINUE C PENNING TRANSFER OCCURS AFTER FINAL TIME PLANE. CLEAR ENTRY NPONT=NPONT-1 NCLUS=NCLUS-1 GO TO 5 670 IPL(NPONT)=IPLANE1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,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 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*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT C STORE DIRECTION COSINES AND ENERGY AFTER N COLLISIONS C 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 C 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) WRITE(6,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VELZ VELY VELX C / TIME COUNT ') C ROTATE INTERMEDIATE OUTPUT INTO LAB FRAME WZR=WZ*RCS-WX*RSN WYR=WY WXR=WZ*RSN+WX*RCS C WRITE(6,202) WZR,WYR,WXR,TTOTS,JCT C 202 FORMAT(3(1X,F8.3),1X,D10.3,4X,I6) J1=J1+1 GO TO 1 C MAIN LOOP END 700 XID=DFLOAT(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DFLOAT(NEION) ANBT=DFLOAT(NELEC-IPRIM) ATTOINT=ANEION/ANBT ATTERT=DSQRT(ANEION)/ANEION AIOERT=DSQRT(ANBT)/ANBT ELSE ANEION=DFLOAT(NEION) ATTOINT=-1.0D0 ATTERT=DSQRT(ANEION)/ANEION ENDIF JCT=ID/100000 IF(J1.EQ.1) THEN WRITE(6,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS), DECREASE THE /ESTIMATED ALPHA. NCLUS = ',I7,' ITER =',I9) STOP ENDIF WRITE(6,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=DSQRT(E2PRM/IPRIM-EBAR**2) WRITE(6,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C WRITE(6,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 WRITE(6,991) ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =',I10,/, /' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4,' NMXADD=',I3) STOP ENDIF RETURN END SUBROUTINE TPLANEH(T,E1,CX1,CY1,CZ1,EFLD,IPLANE) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/ROTS/RCS,RSN,EFZ100,EFX100,F1,EOVBR COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TPLOUTH/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),NETPL(8),ATTOINT,ATTERT,AIOERT 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 EFIELD 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=DCOS(WBT) SINWT=DSIN(WBT) CX2=CX1+2.0D0*F1*TIMLFT CY2=(CY1-EOVBR)*COSWT+CZ1*SINWT+EOVBR CZ2=CZ1*COSWT-(CY1-EOVBR)*SINWT VTOT=DSQRT(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*DSQRT(EPLANE)*CONST3*0.01D0 VYPLANE=DCY2*DSQRT(EPLANE)*CONST3*0.01D0 VXPLANE=DCX2*DSQRT(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 RETURN END SUBROUTINE PTH IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/ROTS/RCS,RSN,EFZ100,EFX100,F1,EOVBR COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUTH/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),NETPL(8),ATTOINT,ATTERT,AIOERT COMMON/PTTOFH/RI(8),EPT(8),VZPT(8),VYPT(8),VXPT(8),TTEST(8) DIMENSION ANTPL(8) C ------------------------------------------------ C CALCULATES PULSED TOWNSEND COEFFICIENTS C------------------------------------------------- ANTPL(1)=DFLOAT(NETPL(1)) RI(1)=(DLOG(ANTPL(1))-DLOG(DFLOAT(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)=DFLOAT(NETPL(I)) RI(I)=(DLOG(ANTPL(I))-DLOG(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 WRITE(6,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 WRITE(6,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 RETURN END SUBROUTINE TOFH IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUTH/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),NETPL(8),ATTOINT,ATTERT,AIOERT COMMON/TOFHOUT/RALPHA,RALPER,TOFENE,TOFENER,TOFWVZ,TOFWVZER, /TOFWVY,TOFWVYER,TOFWVX,TOFWVXER,TOFDZZ,TOFDZZER,TOFDXX,TOFDXXER, /TOFDYY,TOFDYYER,TOFDYZ,TOFDYZER,TOFDXY,TOFDXYER,TOFDXZ,TOFDXZER, /TOFWRZ,TOFWRZER,TOFWRY,TOFWRYER,TOFWRX,TOFWRXER,RATTOF,RATOFER COMMON/PTTOFH/RI(8),EPT(8),VZPT(8),VYPT(8),VXPT(8),TTEST(8) 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)=DFLOAT(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)=DFLOAT(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 WRITE(6,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 WRITE(6,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*DABS((EPT(2)-EPT(3))/(2.0D0*EPT(2))) TOFWVZ=VZPT(2) TOFWVZER=100.0D0*DABS((VZPT(2)-VZPT(3))/(2.0D0*VZPT(2))) TOFWVY=VYPT(2) TOFWVYER=100.0D0*DABS((VYPT(2)-VYPT(3))/(2.0D0*VYPT(2))) TOFWVX=VXPT(2) TOFWVXER=100.0D0*DABS((VXPT(2)-VXPT(3))/(2.0D0*VXPT(2))) TOFDZZ=DZTF(2) TOFDZZER=100.0D0*DABS((DZTF(2)-DZTF(3))/(2.0D0*DZTF(2))) TOFDXX=DXTF(2) TOFDXXER=100.0D0*DABS((DXTF(2)-DXTF(3))/(2.0D0*DXTF(2))) TOFDYY=DYTF(2) TOFDYYER=100.0D0*DABS((DYTF(2)-DYTF(3))/(2.0D0*DYTF(2))) TOFDYZ=DYZTF(2) TOFDYZER=100.0D0*DABS((DYZTF(2)-DYZTF(3))/(2.0D0*DYZTF(2))) TOFDXZ=DXZTF(2) TOFDXZER=100.0D0*DABS((DXZTF(2)-DXZTF(3))/(2.0D0*DXZTF(2))) TOFDXY=DXYTF(2) TOFDXYER=100.0D0*DABS((DXYTF(2)-DXYTF(3))/(2.0D0*DXYTF(2))) TOFWRZ=WRZ(2) TOFWRY=WRY(2) TOFWRX=WRX(2) TOFWRZER=100.0D0*DABS((WRZ(2)-WRZ(3))/(2.0D0*WRZ(2))) TOFWRYER=100.0D0*DABS((WRY(2)-WRY(3))/(2.0D0*WRY(2))) TOFWRXER=100.0D0*DABS((WRX(2)-WRX(3))/(2.0D0*WRX(2))) ANST2=DFLOAT(NETPL(2)) ANST3=DFLOAT(NETPL(3)) ANST4=ANST3-DSQRT(ANST3) ANST5=DLOG(ANST2/ANST3) ANST6=DLOG(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*DSQRT(ANST8**2+ATTERT**2) ELSE RALPHA=RI(2)/(1.0D0-ATTOINT) RALPER=100.0D0*DSQRT(ANST8**2+AIOERT**2) RATTOF=ATTOINT*RI(2)/(1.0D0-ATTOINT) RATOFER=100.0D0*DSQRT(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*DABS((EPT(I1)-EPT(I2))/(2.0D0*EPT(I1))) TOFWVZ=VZPT(I1) TOFWVZER=100.0D0*DABS((VZPT(I1)-VZPT(I2))/(2.0D0*VZPT(I1))) TOFWVY=VYPT(I1) TOFWVYER=100.0D0*DABS((VYPT(I1)-VYPT(I2))/(2.0D0*VYPT(I1))) TOFWVX=VXPT(I1) TOFWVXER=100.0D0*DABS((VXPT(I1)-VXPT(I2))/(2.0D0*VXPT(I1))) TOFDZZ=DZTF(I1) TOFDZZER=100.0D0*DABS((DZTF(I1)-DZTF(I2))/(2.0D0*DZTF(I1))) TOFDXX=DXTF(I1) TOFDXXER=100.0D0*DABS((DXTF(I1)-DXTF(I2))/(2.0D0*DXTF(I1))) TOFDYY=DYTF(I1) TOFDYYER=100.0D0*DABS((DYTF(I1)-DYTF(I2))/(2.0D0*DYTF(I1))) TOFDYZ=DYZTF(I1) TOFDYZER=100.0D0*DABS((DYZTF(I1)-DYZTF(I2))/(2.0D0*DYZTF(I1))) TOFDXZ=DXZTF(I1) TOFDXZER=100.0D0*DABS((DXZTF(I1)-DXZTF(I2))/(2.0D0*DXZTF(I1))) TOFDXY=DXYTF(I1) TOFDXYER=100.0D0*DABS((DXYTF(I1)-DXYTF(I2))/(2.0D0*DXYTF(I1))) TOFWRZ=WRZ(I1) TOFWRY=WRY(I1) TOFWRX=WRX(I1) TOFWRZER=100.0D0*DABS((WRZ(I1)-WRZ(I2))/(2.0D0*WRZ(I1))) TOFWRYER=100.0D0*DABS((WRY(I1)-WRY(I2))/(2.0D0*WRY(I1))) TOFWRXER=100.0D0*DABS((WRX(I1)-WRX(I2))/(2.0D0*WRX(I1))) ATER=DABS((RI(I1)-RI(I2))/(2.0D0*RI(I1))) RALPHA=RI(I1)/(1.0D0-ATTOINT) RALPER=100.0D0*DSQRT(ATER**2+AIOERT**2) RATTOF=ATTOINT*RI(I1)/(1.0D0-ATTOINT) IF(ATTOINT.NE.0.0D0) THEN RATOFER=100.0D0*DSQRT(ATER**2+ATTERT**2) ELSE RATOFER=0.0D0 ENDIF ENDIF RETURN END SUBROUTINE ALPCLCA IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/TOFOUT/RALPHA,RALPER,TOFENE,TOFENER,TOFWV,TOFWVER, /TOFDL,TOFDLER,TOFDT,TOFDTER,TOFWR,TOFWRER,RATTOF,RATOFER COMMON/VEL/WX,WY,WZ COMMON/CTOWNS/ALPHA,ATT COMMON/CTWNER/ALPER,ATTER COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM C --------------------------------------------------------------------- C ESTIMATE TIME STEP FOR AVALANCHE SIMULATION IN TIME OF FLIGHT SIM. C USES ESTIMATED GAIN OF 3.0 BETWEEN PLANES. C CALLS TOF AND PT SUBROUTINES AND UPDATES ALPHA AND ATT C VERSION WITH BFIELD PARALLEL TO EFIELD C ------------------------------------------------------------------ IMAX=NMAX/10000000 IF(IMAX.LT.5) IMAX=5 NMAX=IMAX*10000000 ALPHAST=0.85D0*DABS(ALPHA-ATT) VDST=WZ*1.D-5 TSTEP=DLOG(3.0D0)/(ALPHAST*VDST*1.0D5) TSTEP=TSTEP*1.0D12 TFINAL=7.0D0*TSTEP ITFINAL=7 C CALC TIME OF FLIGHT AND PT WRITE(6,25) 25 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') WRITE(6,26) TSTEP 26 FORMAT(1(/),' TIME STEP BETWEEN SAMPLING PLANES =',D12.5,' PICOSE /CS.',/) CALL MONTEFTA CALL FRIEDLAND CALL PT CALL TOF WRITE(6,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,' %') WRITE(6,28) 28 FORMAT(/,' TOF DIFFUSION') WRITE(6,29) TOFDL,TOFDLER,TOFDT,TOFDTER 29 FORMAT(/,' DL=',F8.1,' +- ',F6.1,' % DT=',F8.1,' +- ',F6.1, /' %') WRITE(6,30) 30 FORMAT(/,' TOF DRIFT VELOCITY') WRITE(6,31) TOFWR,TOFWRER 31 FORMAT(/,' WR=',F8.2,' +- ',F6.2,' %') C CALCULATE TOWNSEND SST COEFICIENTS FROM TOF RESULTS WRN=TOFWR*1.0D05 FC1=WRN/(2.0D0*TOFDL) FC2=((RALPHA-RATTOF)*1.0D12)/TOFDL ALPZZ=FC1-DSQRT(FC1**2-FC2) C--------------------------------------------------- C LOAD NEW ALPHA AND ATTACHMENT INTO COMMON BLOCKS C----------------------------------------------- ALPATT=ALPHA-ATT RATIO=ALPZZ/ALPATT ALPHA=ALPHA*RATIO ATT=ATT*RATIO WRITE(6,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,' %',/) C----------------------------------------------- RETURN END SUBROUTINE MONTEFTA IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(8),RSTART, /EFIELD,NMAX COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(4000,512),EIN(512),TCF(4000),IARRY(512),RGAS(512), /IPN(512),WPL(512),IPLAST,ISIZE,PENFRA(3,512) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/IPT/XS(200),YS(200),ZS(200),TS(200),ES(200), /DCX(200),DCY(200),DCZ(200),IPL(200) COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),ATTOINT,ATTERT,AIOERT COMMON/ANIS/PSCT(4000,512),ANGCT(4000,512),INDEX(512),NISO DIMENSION EPRM(4000000),IESPECP(100) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C THIS ROUTINE HANDLES TERMINATIONS AT FIXED DRIFT TIMES. C BFIELD PARALLEL TO EFIELD C ------------------------------------------------------------------- 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,30 26 ICOLL(I)=0 DO 27 I=1,512 27 ICOLN(I)=0 DO 28 I=1,4000 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 N4000=4000 N300=300 N100=100 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 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) C INITIAL VELOCITY VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 API=DACOS(-1.0D0) F4=2.0D0*API C 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 C LOOP FOR NEW STARTING ELECTRONS 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN C CHECK IF PROGRAM WILL EXCEED MAXIMUM NUMBER OF ITERATIONS C 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*DSQRT(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 WRITE(6,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=DINT(E1)+1 IDUM=DMIN0(IDUM,N100) IESPECP(IDUM)=IESPECP(IDUM)+1 C START OF LOOP FOR NEWLY CREATED ELECTRONS 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP C MAIN LOOP 1 CONTINUE C IF(ITER.GT.NMAX) GO TO 315 R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) 15 IF((T+ST).GE.TSTOP) THEN IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP C STORE POSITION AND ENERGY AT TIME PLANE =IPLANE. CALL TPLANEA(T,E1,CX1,CY1,DCZ1,AP,BP,EFIELD,IPLANE) C CHECK IF PASSED THROUGH MORE THAN ONE PLANE IN THIS STEP IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 IF((T+ST).GE.TFINAL) THEN ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT TSTOP=TSTEP C NO MORE ELECTRONS IN CASCADE TRY NEW PRIMARY ELECTRON IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C TAKE ELECTRONS FROM STORE 20 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*DSQRT(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 WRITE(6,913)ITER,E,E1,AP,BP,DCZ1 E=0.001D0 ENDIF IE=DINT(E/ESTEP)+1 IE=DMIN0(IE,N4000) C C TEST FOR REAL OR NULL COLLISION C R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 WBT=WB*T COSWT=DCOS(WBT) SINWT=DSIN(WBT) CONST6=DSQRT(E1/E) CX2=CX1*COSWT-CY1*SINWT CY2=CY1*COSWT+CX1*SINWT VTOT=CONST9*DSQRT(E) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(E) CONST7=CONST9*DSQRT(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=DINT(T+1.0D0) IT=DMIN0(IT,N300) TIME(IT)=TIME(IT)+1.0D0 SPEC(IE)=SPEC(IE)+1.0D0 C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- C R2=RNDM2(RDUM) 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(E.LT.EI) THEN C WRITE(6,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') C 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 C ATTACHMENT IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=DINT(T+1.0D0) IT=DMIN0(IT,N300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT C ELECTRON CAPTURED START NEW PRIMARY IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C ELECTRON CAPTURED TAKE NEXT ELECTRON FROM STORE GO TO 20 ENDIF R9=drand48(RDUM) C ESEC=R9*(E-EI) C USE OPAL PETERSON AND BEATY SPLITTING FACTOR. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI C STORE POSITION ,ENERGY, DIRECTION COSINES AND TIME OF GENERATION C OF IONISATION ELECTRON NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=DACOS(F3) F6=DCOS(THETA0) F5=DSIN(THETA0) R4=drand48(rdum) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ID=ID+1 ITER=ITER+1 IPRINT=IPRINT+1 ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I),OF TRANSFER TO GIVE C IONISATION OF THE OTHER GASES IN THE MIXTURE IF(IPEN.EQ.0) GO TO 5 IF(PENFRA(1,I).NE.0.0) THEN RAN=drand48(RDUM) IF(RAN.GT.PENFRA(1,I)) GO TO 5 NCLUS=NCLUS+1 NPONT=NPONT+1 IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER STOP ENDIF C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XS(NPONT)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YS(NPONT)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZS(NPONT)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN C ENTER POSSIBLE PENNING TRANSFER TIME 667 TPEN=ST IF(PENFRA(3,I).EQ.0.0) GO TO 668 RAN=drand48(RDUM) TPEN=ST-DLOG(RAN)*PENFRA(3,I) 668 TS(NPONT)=TPEN ES(NPONT)=1.0 DCX(NPONT)=DCX1 DCY(NPONT)=DCY1 DCZ(NPONT)=DCZ1 C FIND LAST TIME PLANE BEFORE TPEN TSTOP1=0.0 IPLANE1=0 DO 669 KDUM=1,ITFINAL TSTOP1=TSTEP+TSTOP1 IF(TPEN.LT.TSTOP1) GO TO 670 IPLANE1=IPLANE1+1 669 CONTINUE C PENNING TRANSFER OCCURS AFTER FINAL TIME PLANE. CLEAR ENTRY NPONT=NPONT-1 NCLUS=NCLUS-1 GO TO 5 670 IPL(NPONT)=IPLANE1 ENDIF 5 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPIC SCATTERING R3=drand48(RDUM) IF(INDEX(I).EQ.1) THEN R31=drand48(RDUM) F3=1.0D0-R3*ANGCT(IE,I) IF(R31.GT.PSCT(IE,I)) F3=-F3 ELSE IF(INDEX(I).EQ.2) THEN EPSI=PSCT(IE,I) F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3))) ELSE C ISOTROPIC SCATTERING F3=1.0D0-2.0D0*R3 ENDIF THETA0=DACOS(F3) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) IF(E.LT.EI) EI=0.0D0 ARG1=1.0D0-S1*EI/E ARG1=DMAX1(ARG1,SMALL) D=1.0D0-F3*DSQRT(ARG1) E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2) E1=DMAX1(E1,SMALL) Q=DSQRT((E/E1)*ARG1)/S1 Q=DMIN1(Q,1.0D0) THETA=DASIN(Q*DSIN(THETA0)) F6=DCOS(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=DSIN(THETA) DCZ2=DMIN1(DCZ2,1.0D0) ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0D0) THEN C WRITE(6,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 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*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT C STORE DIRECTION COSINES AND ENERGY AFTER N COLLISIONS C 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 C INTERMEDIATE PRINTOUT 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 JCT=ID/100000 C IF(J1.EQ.1) WRITE(6,201) C 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VEL POS TIME C / COUNT ') C WRITE(6,202) W,ZTOTS,TTOTS,JCT C 202 FORMAT(1X,F8.3,2(1X,D10.3),4X,I6) J1=J1+1 GO TO 1 C MAIN LOOP END 700 XID=DFLOAT(ID) IF(NELEC.GT.IPRIM) THEN ANEION=DFLOAT(NEION) ANBT=DFLOAT(NELEC-IPRIM) ATTOINT=ANEION/ANBT ATTERT=DSQRT(ANEION)/ANEION AIOERT=DSQRT(ANBT)/ANBT ELSE ANEION=DFLOAT(NEION) ATTOINT=-1.0D0 ATTERT=DSQRT(ANEION)/ANEION ENDIF JCT=ID/100000 IF(J1.EQ.1) THEN WRITE(6,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS), DECREASE THE /ESTIMATED ALPHA. NCLUS = ',I7,' ITER =',I9) STOP ENDIF WRITE(6,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=DSQRT(E2PRM/IPRIM-EBAR**2) WRITE(6,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY ELECTRON =',F10.3,' EV.') C WRITE(6,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 WRITE(6,991) ITER,NMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' NMAX =',I10,/, /' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4,' NMXADD=',I3) STOP ENDIF RETURN END SUBROUTINE TPLANEA(T,E1,CX1,CY1,DCZ1,AP,BP,EFLD,IPLANE) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(30),SPEC(4000),TMAX1, /AVE,DEN,XID,X,Y,Z,ST,NNULL,ICOLN(512) COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),ATTOINT,ATTERT,AIOERT 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=DCOS(WBT) SINWT=DSIN(WBT) CONST6=DSQRT(E1/EPLANE) DCZ2=DCZ1*CONST6+EFLD*TIMLFT*CONST5/DSQRT(EPLANE) XPLANE=X+(CX1*SINWT-CY1*(1.0D0-COSWT))/WB YPLANE=Y+(CY1*SINWT+CX1*(1.0D0-COSWT))/WB ZPLANE=Z+DCZ1*TIMLFT*DSQRT(E1)*CONST3*0.01D0+T2LFT*EFLD*CONST2 VZPLANE=DCZ2*DSQRT(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 RETURN END DOUBLE PRECISION FUNCTION DMAX0(IA,IB) INTEGER *8 IA,IB IF(IA.LT.IB) THEN DMAX0=IB ELSE DMAX0=IA ENDIF RETURN END DOUBLE PRECISION FUNCTION DMIN0(IA,IB) INTEGER*8 IA,IB,IONE IONE=1 IF(IA.GT.IB) THEN DMIN0=IB ELSE IF(IA.LT.IONE) THEN DMIN0=IONE ELSE DMIN0=IA ENDIF RETURN END DOUBLE PRECISION FUNCTION drand48(DUMMY) *----------------------------------------------------------------------- * RNDM2 - Returns double precision random numbers by calling RM48. * (Last changed on 5/ 2/00.) *----------------------------------------------------------------------- implicit none INTEGER NVEC PARAMETER(NVEC=1000) DOUBLE PRECISION RVEC(NVEC),DUMMY INTEGER IVEC DATA IVEC/0/ SAVE RVEC,IVEC *** 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 CCCCCCCC * * $Id: rm48.F,v 1.2 1996/12/12 16:32:06 cernlib Exp $ * * $Log: rm48.F,v $ * Revision 1.2 1996/12/12 16:32:06 cernlib * Variables ONE and ZERO added to SAVE statement, courtesy R.Veenhof * * Revision 1.1.1.1 1996/04/01 15:02:55 mclareni * Mathlib gen * * *#include "gen/pilot.h" SUBROUTINE RM48(RVEC,LENV) C Double-precision version of C Universal random number generator proposed by Marsaglia and Zaman C in report FSU-SCRI-87-50 C based on RANMAR, modified by F. James, to generate vectors C of pseudorandom numbers RVEC of length LENV, where the numbers C in RVEC are numbers with at least 48-bit mantissas. C Input and output entry points: RM48IN, RM48UT. C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C!!! Calling sequences for RM48: ++ C!!! CALL RM48 (RVEC, LEN) returns a vector RVEC of LEN ++ C!!! 64-bit random floating point numbers between ++ C!!! zero and one. ++ C!!! CALL RM48IN(I1,N1,N2) initializes the generator from one ++ C!!! 64-bit integer I1, and number counts N1,N2 ++ C!!! (for initializing, set N1=N2=0, but to restart ++ C!!! a previously generated sequence, use values ++ C!!! output by RM48UT) ++ C!!! CALL RM48UT(I1,N1,N2) outputs the value of the original ++ C!!! seed and the two number counts, to be used ++ C!!! for restarting by initializing to I1 and ++ C!!! skipping N2*100000000+N1 numbers. ++ C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C for 32-bit machines, use IMPLICIT DOUBLE PRECISION IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION RVEC(*) COMMON/R48ST1/U(97),C,I97,J97 PARAMETER (MODCNS=1000000000) SAVE CD, CM, TWOM24, NTOT, NTOT2, IJKL,TWOM49, ONE, ZERO DATA NTOT,NTOT2,IJKL/-1,0,0/ C IF (NTOT .GE. 0) GO TO 50 C C Default initialization. User has called RM48 without RM48IN. IJKL = 54217137 NTOT = 0 NTOT2 = 0 KALLED = 0 GO TO 1 C ENTRY RM48IN(IJKLIN, NTOTIN,NTOT2N) C Initializing routine for RM48, may be called before C generating pseudorandom numbers with RM48. The input C values should be in the ranges: 0<=IJKLIN<=900 OOO OOO C 0<=NTOTIN<=999 999 999 C 0<=NTOT2N<<999 999 999! C To get the standard values in Marsaglia's paper, IJKLIN=54217137 C NTOTIN,NTOT2N=0 IJKL = IJKLIN NTOT = MAX(NTOTIN,0) NTOT2= MAX(NTOT2N,0) KALLED = 1 C always come here to initialize 1 CONTINUE IJ = IJKL/30082 KL = IJKL - 30082*IJ I = MOD(IJ/177, 177) + 2 J = MOD(IJ, 177) + 2 K = MOD(KL/169, 178) + 1 L = MOD(KL, 169) WRITE(6,'(A,I10,2X,2I10)') ' RM48 INITIALIZED:',IJKL,NTOT,NTOT2 CCC PRINT '(A,4I10)', ' I,J,K,L= ',I,J,K,L ONE = 1. HALF = 0.5 ZERO = 0. DO 2 II= 1, 97 S = 0. T = HALF DO 3 JJ= 1, 48 M = MOD(MOD(I*J,179)*K, 179) I = J J = K K = M L = MOD(53*L+1, 169) IF (MOD(L*M,64) .GE. 32) S = S+T 3 T = HALF*T 2 U(II) = S TWOM49 = T TWOM24 = ONE DO 4 I24= 1, 24 4 TWOM24 = HALF*TWOM24 C = 362436.*TWOM24 CD = 7654321.*TWOM24 CM = 16777213.*TWOM24 I97 = 97 J97 = 33 C Complete initialization by skipping C (NTOT2*MODCNS + NTOT) random numbers DO 45 LOOP2= 1, NTOT2+1 NOW = MODCNS IF (LOOP2 .EQ. NTOT2+1) NOW=NTOT IF (NOW .GT. 0) THEN WRITE(6,'(A,I15)') ' RM48IN SKIPPING OVER ',NOW DO 40 IDUM = 1, NTOT UNI = U(I97)-U(J97) IF (UNI .LT. ZERO) UNI=UNI+ONE U(I97) = UNI I97 = I97-1 IF (I97 .EQ. 0) I97=97 J97 = J97-1 IF (J97 .EQ. 0) J97=97 C = C - CD IF (C .LT. ZERO) C=C+CM 40 CONTINUE ENDIF 45 CONTINUE IF (KALLED .EQ. 1) RETURN C C Normal entry to generate LENV random numbers 50 CONTINUE DO 100 IVEC= 1, LENV UNI = U(I97)-U(J97) IF (UNI .LT. ZERO) UNI=UNI+ONE U(I97) = UNI I97 = I97-1 IF (I97 .EQ. 0) I97=97 J97 = J97-1 IF (J97 .EQ. 0) J97=97 C = C - CD IF (C .LT. ZERO) C=C+CM UNI = UNI-C IF (UNI .LT. ZERO) UNI=UNI+ONE RVEC(IVEC) = UNI C Replace exact zeros by 2**-49 IF (UNI .EQ. ZERO) THEN RVEC(IVEC) = TWOM49 ENDIF 100 CONTINUE NTOT = NTOT + LENV IF (NTOT .GE. MODCNS) THEN NTOT2 = NTOT2 + 1 NTOT = NTOT - MODCNS ENDIF RETURN C Entry to output current status ENTRY RM48UT(IJKLUT,NTOTUT,NTOT2T) IJKLUT = IJKL NTOTUT = NTOT NTOT2T = NTOT2 RETURN END SUBROUTINE GAS1(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(132),YELM(132),YELT(132),YEPS(132), /XVBV4(17),YVBV4(17),XVBV1(17),YVBV1(17),XVBV3(17),YVBV3(17), /XVIB5(18),YVIB5(18),XVIB6(18),YVIB6(18), /XEXC(31),YEXC(31),XION(52),YION(52),YINC(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,12.0,15.0,20.0,25.0,30.0,40.0,50.0, /60.0,80.0,100.,125.,150.,200.,250.,300.,400.,500., /600.,700.,800.,1000.,1250.,1500.,1750.,2000.,2500.,3000., /3500.,4000.,5000.,6000.,7000.,8000.,9000.,10000.,1.25D4,1.50D4, /1.75D4,2.0D4,2.5D4,3.0D4,3.5D4,4.0D4,4.5D4,5.0D4,6.0D4,7.0D4, /8.0D4,9.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5,2.5D5,3.0D5,3.5D5, /4.0D5,4.5D5,5.0D5,6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.25D6,1.5D6, /1.75D6,2.0D6,2.5D6,3.0D6,3.5D6,4.0D6,4.5D6,5.0D6,6.0D6,7.0D6, /8.0D6,1.0D7/ C ELASTIC MOMENTUM TRANSFER X-SECTION DATA YELM/12.5,8.70,7.00,5.95,5.20,4.70,4.30,3.95,3.65,3.40, /3.20,2.85,2.58,2.37,2.19,2.04,1.77,1.57,1.41,1.30, /1.20,1.12,1.05,0.99,0.93,0.88,0.84,0.80,0.76,0.72, /0.65,0.48,0.35,0.29,0.29,0.34,0.47,0.87,1.35,1.85, /2.95,4.00,4.75,5.15,5.45,5.65,5.80,6.00,6.10,6.30, /6.50,6.80,7.20,8.30,9.50,10.1,9.60,8.80,7.85,6.72, /5.90,5.06,4.16,3.57,2.99,1.92,1.53,1.20,0.88,0.66, /.525,0.43,0.37,0.30,.228,.169,.131,.104,.0711,.0519, /.0397,.0314,.0212,.0153,.0117,.00918,.00743,.00615,.00412,.00297, /2.25D-3,1.77D-3,1.18D-3,8.51D-4,6.45D-4,5.08D-4,4.12D-4,3.41D-4, /2.47D-4,1.88D-4, /1.49D-4,1.21D-4,1.01D-4,6.88D-5,5.05D-5,3.90D-5,3.13D-5,2.17D-5, /1.62D-5,1.27D-5, /1.03D-5,8.56D-6,7.27D-6,5.49D-6,4.34D-6,3.54D-6,2.96D-6,2.52D-6, /1.81D-6,1.36D-6, /1.07D-6,8.68D-7,6.08D-7,4.53D-7,3.51D-7,2.82D-7,2.31D-7,1.93D-7, /1.42D-7,1.08D-7, /8.59D-8,5.79D-8/ C ELASTIC X-SECTION ASSUMED ISOTROPIC BELOW 0.6 EV DATA YELT/12.5,8.70,7.00,5.95,5.20,4.70,4.30,3.95,3.65,3.40, /3.20,2.85,2.58,2.37,2.19,2.04,1.77,1.57,1.41,1.30, /1.20,1.12,1.05,0.99,0.93,0.88,0.84,0.80,0.76,0.72, /0.65,0.48,0.35,0.29,0.29,0.34,0.47,0.87,1.35,1.85, /3.77,4.89,5.66,6.43,7.43,8.34,10.6,12.5,11.6,11.0, /11.0,11.7,12.9,14.5,16.8,17.6,18.1,17.2,15.9,14.9, /14.3,13.0,11.7,10.5,9.65,8.10,6.83,6.02,5.02,4.36, /3.83,3.40,3.08,2.65,2.17,1.89,1.55,1.40,1.19,1.11, /.921,.822,.696,.568,.492,.435,.390,.353,.286,.241, /.209,.185,.150,.127,.111,.0984,.0888,.0810,.0694,.0611, /.0522,.050,.0461,.0391,.0344,.0311,.0287,.0253,.0230,.0214, /.0202,.0193,.0186,.0176,.0169,.0164,.0160,.0157,.0152,.0148, /.0146,.0145,.0143,.0142,.0141,.0141,.0140,.0140,.0140,.0139, /.0139,.0139/ C EPSILON FOR ELASTIC ANGULAR DISTRIBUTION DATA YEPS/40*0.0, /.31944,.26899,.23839,.29336,.38730,.46203,.62112,.69396,.64495, /.59170, /.57021,.58174,.60860,.59206,.60014,.59037,.63994,.66049,.67963, /.72329, /.76015,.78141,.81052,.82334,.84708,.89820,.90642,.92120,.93462, /.94699, /.95392,.95883,.96167,.96468,.96812,.97439,.97626,.980014,.984995, /.989075, /.990155,.991558,.993652,.994554,.995333,.995972,.996446,.996814, /.997470,.997904, /.998217,.998451,.998772,.998984,.999141,.999251,.999339,.999410, /.999514,.999589, /.999647,.999688,.999722,.999783,.999824,.999853,.999874,.999904, /.999923,.999936, /.999946,.999954,.999960,.999969,.999975,.999979,.999982,.999985, /.999989,.999992, /.999993,.999995,.999996,.999997,.999998,.999998,.999999,.999999, /.999999,.999999, /.999999,.999999/ C VIBRATION V4 (RESONANCE ONLY) DATA XVBV4/0.0783,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0, /50.0,100.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YVBV4/0.0,0.0,0.05,0.35,1.06,1.40,1.26,0.97,0.07,.022, /1.D-4,1.D-5,1.D-6,1.D-7,1.D-8,1.D-9,1.D-9/ C VIBRATION V1 (RESONANCE ONLY) DATA XVBV1/0.1126,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0, /50.0,100.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YVBV1/0.0,0.0,.016,.118,0.36,0.47,0.42,0.33,.023,.007, /3.D-5,3.D-6,3.D-7,3.D-8,3.D-9,3.D-10,3.D-10/ C VIBRATION V3 (RESONANCE ONLY) DATA XVBV3/0.1588,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0, /50.0,100.,1000.,1.D4,1.D5,1.D6,1.D7/ DATA YVBV3/0.0,0.0,0.15,1.05,3.19,4.20,3.78,2.90,0.20,.067, /1.D-4,1.D-5,1D-6,1.D-7,1.D-8,1.D-9,1.D-9/ C VIBRATION HARMONIC 2(V3) DATA XVIB5/0.3176,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.,1.D4,1.D5,1.D6,1.D7/ DATA YVIB5/0.0,.001,0.01,.031,0.23,0.67,0.87,0.79,0.60,.042, /.014,.0006,1.D-5,1.D-6,1.D-7,1.D-8,1.D-9,1.D-9/ C VIBRATION HARMONIC (3(V3) + ALL OTHER HARMONICS) DATA XVIB6/0.4764,1.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0, /20.0,50.0,100.,1000.,1.D4,1.D5,1.D6,1.D7/ DATA YVIB6/0.0,.001,0.05,0.13,0.88,2.66,3.50,3.15,2.43,.168, /.043,.001,1.D-4,1.D-5,1.D-6,1.D-7,1.D-8,1.D-8/ C 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.,4000.,5000.,6000., /8000.,10000./ C GROSS IONISATION 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.21,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,.784,.652,.561, /.439,.363/ C COUNTING IONISATION DATA YINC/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.73,4.86,5.04,5.21,5.15,5.08,4.95, /4.64,4.45,4.18,3.91,3.70,3.39,3.00,2.73,2.52,2.30, /2.15,1.82,1.58,1.45,1.29,1.11,.955,.757,.629,.541, /.424,.350/ C ATTACHMENT 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 DISSOCIATION X-SECTION EXCLUDING DISSOCIATIVE IONISATION X-SECTION DATA XEXC/12.56,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./ DATA YEXC/0.0,.030,.080,.180,0.31,0.54,0.74,1.03,1.18,1.28, /1.35,1.38,1.41,1.43,1.44,1.44,1.43,1.41,1.40,1.36, /1.34,1.30,1.24,1.14,0.99,0.83,0.72,0.47,0.28,0.16, /.076/ C ---------------------------------------------------------------------- C NEW ANALYSIS UPDATED TO MARCH 2008 C ALLOWS SUPERELASTIC SCATTERING TO V2,V4,V1 AND V3 VIBRATIONAL LEVELS C BORN ANGULAR DISTRIBUTION FOR V4 AND V3 VIBRATIONAL LEVELS C INCLUDED NEW IONISATION X-SECTIONS BY NISHIMURA AND READJUSTED C DISSOCIATION X-SECTION TO FIT TOWNSEND MEASUREMENTS. C ELASTIC X-SECTION BELOW 0.6 EV ASSUMED ISOTROPIC SINCE NO ACCURATE C DATA EXIST ON ELASTIC SCATTERING AT THE RAMSAUER MINIMUM. C THE ELASTIC X-SECTION BETWEEN 0.0 AND 0.6 EV IS NOT SENSITIVE C ENOUGH TO DRIFT AND DIFFUSION TO ACCURATELY PREDICT THE C POSITION OF THE RAMSAUER MINIMUM. THE ABSOLUTE VALUE OF THE ELASTIC C X-SECTION BELOW THE RAMSAUER MINIMUM ( LESS THAN 0.18 EV) SEEMS TO C BE LOWER THAN PREDICTIONS BY MANN AND LINDER OR FIELD ET AL. C THE TEMPERATURE DEPENDENCE OF THE LOW FIELD MOBILITY CF GEE AND C FREEMAN WHICH IS REPRODUCED BY THIS X-SECTION SET SEEMS ALSO TO C EXCLUDE HIGHER ELASTIC X-SECTIONS IN THE REGION BETWEEN 0.02 AND C 0.1 EV. C THE DATA BASE NOW FITS NAKAMURAS DRIFT VELOCITY IN CF4 AND CF4 ARGON C MIXTURES TO WITHIN EXPERIMENTAL ERRORS . NAKAMURAS DATA IS MUCH MORE C ACCURATE THAN HUNTERS DATA SO WE REJECT HUNTERS DATA IN THE NEW C ANALYSIS. C THE TOWNSEND IONISATION AND ATTACHMENT RATES AGREE WELL WITH THE C PUBLISHED DATA . C --------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME=' CF4 ISOT 2008' ELSE NAME=' CF4 ANISO 2008' ENDIF C-------------------------------------------------------------------- C BORN BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 AM2=7.20 C=93.0 C BORN BETHE FOR EXCITATION AM2EXC=1.6 CEXC=20.7 C NIN=11 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN 2 KIN(J)=0 C ASSUME CAPITELLI LONGO TYPE OF ANGULAR DISTRIBUTION FOR VIBRATIONAL C LEVELS V4 V3 2V3 AND THE SUM OF HIGHER HARMONICS KIN(4)=1 KIN(8)=1 KIN(9)=1 KIN(10)=1 C ANGULAR DISTRIBUTION FOR DISSOCIATIVE EXCITATION CAN BE EITHER C CAPITELLI LONGO OR OKHRIMOVSKKY TYPES KIN(11)=NANISO C RATIO OF MOMENTUM TRANSFER TO TOTAL X-SEC FOR RESONANCE C PART OF VIBRATIONAL X-SECTIONS RAT=0.75 C NDATA=132 NVBV4=17 NVBV1=17 NVBV3=17 NVIB5=18 NVIB6=18 NION=52 NATT=11 NEXC=31 C E(1)=0.0 E(2)=2.0*EMASS/(88.0043*AMU) E(3)=15.90 C EXCITATION X-SECTION AT 1.2 MEV E(4)=0.0047D-16 C IONISING X-SECTION AT 1.2 MEV E(5)=0.0211D-16 C OPAL AND BEATY IONISATION ENERGY SPLITTING AT 1.2 MEV E(6)=19.5 C OPAL BEATY IONISATION ENERGY SPLITTING AT LOW ENERGY EOBY=E(3) C EIN(1)=-0.0539 EIN(2)=0.0539 EIN(3)=-0.0783 EIN(4)=0.0783 EIN(5)=-0.1126 EIN(6)=0.1126 EIN(7)=-0.1588 EIN(8)=0.1588 EIN(9)=0.3176 EIN(10)=0.4764 EIN(11)=12.56 C OFFSET ENERGY FOR IONISATION ELECTRON ANGULAR DISTRIBUTION IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) C OFFSET ENERGY FOR DISSOCIATION ANGULAR DISTRIBUTION IOFF11=IFIX(SNGL(0.5+EIN(11)/ESTEP)) C*********************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C ONLY DISSOCIATION X-SECTION (LEVEL 11) HAS ENOUGH ENERGY TO GIVE C POSSIBLE PENNING TRANSFER DO 7 K=1,11 DO 7 L=1,3 7 PENFRA(L,K)=0.0 C PENNING TRANSFER FRACTION FOR LEVEL 11 PENFRA(1,11)=0.0 C PENNING TRANSFER DISTANCE IN MICRONS PENFRA(2,11)=1.0 C PENNING TRANSFER TIME IN PICOSECONDS PENFRA(3,11)=1.0 IF(IPEN.EQ.0) GO TO 8 IF(PENFRA(1,11).EQ.0.0) GO TO 8 WRITE(6,999) NAME,EIN(11),PENFRA(1,11),PENFRA(2,11),PENFRA(3,11) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY = ',F5.3,' ABS.LENGTH = ',F7.2,' DECAY TIME = ',F7.1,/) 8 CONTINUE C*********************************************************************** SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC CF4 ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC ISOTROPIC CF4 ' ENDIF SCRPT(3)=' IONISATION ELOSS= 15.90 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V2 ELOSS= -0.0539 ' SCRPT(8)=' VIB V2 ELOSS= 0.0539 ' SCRPT(9)=' VIB V4 ELOSS= -0.0783 ' SCRPT(10)=' VIB V4 ANIS ELOSS= 0.0783 ' SCRPT(11)=' VIB V1 ELOSS= -0.1126 ' SCRPT(12)=' VIB V1 ELOSS= 0.1126 ' SCRPT(13)=' VIB V3 ELOSS= -0.1588 ' SCRPT(14)=' VIB V3 ANIS ELOSS= 0.1588 ' SCRPT(15)=' VIB 2V3 ELOSS= 0.3176 ' SCRPT(16)=' VIB HARMONIC ELOSS= 0.4764 ' SCRPT(17)=' EXC DISOCIATN ELOSS= 12.56 ' C VIBRATIONAL DEGENERACY DEGV4=3.0 DEGV3=3.0 DEGV2=2.0 DEGV1=1.0 C CALC VIB LEVEL POPULATIONS APOPV2=DEGV2*DEXP(EIN(1)/AKT) APOPV4=DEGV4*DEXP(EIN(3)/AKT) APOPV1=DEGV1*DEXP(EIN(5)/AKT) APOPV3=DEGV3*DEXP(EIN(7)/AKT) APOPGS=1.0 APOPSUM=APOPGS+APOPV2+APOPV4+APOPV1+APOPV3 APOPGS=1.0/APOPSUM APOPV2=APOPV2/APOPSUM APOPV4=APOPV4/APOPSUM APOPV1=APOPV1/APOPSUM APOPV3=APOPV3/APOPSUM C RENORMALISE GROUND STATE TO ALLOW FOR EXCITATION X-SEC FROM C EXCITED VIBRATIONAL STATES (EXACT APPROX IF THE HOT TRANSITIONS HAVE C EQUAL X-SEC TO THE GROUND STATE TRANSITIONS) C APOPGS=1.0 C EN=-ESTEP/2.0 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=(YELM(J)-YELM(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YELM(J)-XEN(J)*YELM(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.D-16 A=(YELT(J)-YELT(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YELT(J)-XEN(J)*YELT(J-1))/(XEN(J-1)-XEN(J)) QELA=(A*EN+B)*1.D-16 A=(YEPS(J)-YEPS(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEPS(J)-XEN(J)*YEPS(J-1))/(XEN(J-1)-XEN(J)) PQ2=(A*EN+B) PQ1=0.5+(QELA-QMOM)/QELA IF(NANISO.EQ.0) PEQEL(2,I)=0.5 IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) Q(2,I)=QMOM C GROSS IONISATION Q(3,I)=0.0 PEQEL(3,I)=0.5 IF(NANISO.EQ.2) PEQEL(3,I)=0.0 IF(EN.LE.E(3)) GO TO 200 IF(EN.GT.XION(NION)) GO TO 123 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 GO TO 124 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 123 GAMMA=(EMASS2+2.0D0*EN)/EMASS2 BETA=DSQRT(1.0D0-1.0D0/(GAMMA*GAMMA)) BETA2=BETA*BETA X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2)/0.965 124 CONTINUE C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON AT C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISTRIBUTION SAME AS ELASTIC ANGULAR DISTRIBUTION C AT AN ENERGY OFFSET BY THE 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.0 IF(EN.LE.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 C COUNTING IONISATION 250 Q(5,I)=0.0 PEQEL(5,I)=0.5 IF(NANISO.EQ.2) PEQEL(5,I)=0.0 IF(EN.LE.E(3)) GO TO 300 IF(EN.GT.XION(NION)) GO TO 280 DO 260 J=2,NION IF(EN.LE.XION(J)) GO TO 270 260 CONTINUE J=NION 270 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.D-16 GO TO 290 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 280 Q(5,I)=CONST*(AM2*X1+C*X2) 290 CONTINUE C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON AT C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISTRIBUTION SAME AS ELASTIC ANGULAR DISTRIBUTION C AT AN ENERGY OFFSET BY THE IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 295 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 295 CONTINUE C 300 Q(6,I)=0.0 C SCALE FACTOR FOR VIBRATIONAL DIPOLE V3 ABOVE 0.4EV VDSC=1.0 IF(EN.GT.0.4) THEN EPR=EN IF(EN.GT.5.0) EPR=5.0 VDSC=(14.4-EPR)/14.0 ENDIF C C SUPERELASTIC OF VIBRATION V2 ISOTROPIC C QIN(1,I)=0.0 PEQIN(1,I)=0.5 IF(EN.LE.0.0) GO TO 350 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.007*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOPV2*1.D-16/DEGV2 350 CONTINUE C VIBRATION V2 ISOTROPIC QIN(2,I)=0.0 PEQIN(2,I)=0.5 IF(EN.LE.EIN(2)) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.007*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)*APOPGS*1.D-16 400 CONTINUE C C SUPERELASTIC OF VIBRATION V4 ISOTROPIC C QIN(3,I)=0.0 PEQIN(3,I)=0.5 IF(EN.LE.0.0) GO TO 450 DO 410 J=2,NVBV4 IF((EN-EIN(3)).LE.XVBV4(J)) GO TO 420 410 CONTINUE J=NVBV4 420 A=(YVBV4(J)-YVBV4(J-1))/(XVBV4(J)-XVBV4(J-1)) B=(XVBV4(J-1)*YVBV4(J)-XVBV4(J)*YVBV4(J-1))/(XVBV4(J-1)-XVBV4(J)) EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.0500*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(3,I)=QIN(3,I)+(EN-EIN(3))*(A*(EN-EIN(3))+B)/EN QIN(3,I)=QIN(3,I)*APOPV4*1.D-16/DEGV4 450 CONTINUE C VIBRATION V4 ANISOTROPIC QIN(4,I)=0.0 PEQIN(4,I)=0.5 IF(EN.LE.EIN(4)) GO TO 500 DO 460 J=2,NVBV4 IF(EN.LE.XVBV4(J)) GO TO 470 460 CONTINUE J=NVBV4 470 A=(YVBV4(J)-YVBV4(J-1))/(XVBV4(J)-XVBV4(J-1)) B=(XVBV4(J-1)*YVBV4(J)-XVBV4(J)*YVBV4(J-1))/(XVBV4(J-1)-XVBV4(J)) EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0500*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(4) 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(4,I)+RAT*(A*EN+B))*APOPGS*1.D-16 QIN(4,I)=((A*EN+B)+QIN(4,I))*APOPGS*1.D-16 PEQIN(4,I)=0.5+(QIN(4,I)-XMT)/QIN(4,I) 500 CONTINUE C SUPERELASTIC OF VIBRATION V1 ISOTROPIC QIN(5,I)=0.0 PEQIN(5,I)=0.5 IF(EN.LE.0.0) GO TO 550 DO 510 J=2,NVBV1 IF((EN-EIN(5)).LE.XVBV1(J)) GO TO 520 510 CONTINUE J=NVBV1 520 A=(YVBV1(J)-YVBV1(J-1))/(XVBV1(J)-XVBV1(J-1)) B=(XVBV1(J-1)*YVBV1(J)-XVBV1(J)*YVBV1(J-1))/(XVBV1(J-1)-XVBV1(J)) EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.0224*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(5,I)=QIN(5,I)+(EN-EIN(5))*(A*(EN-EIN(5))+B)/EN QIN(5,I)=QIN(5,I)*APOPV1*1.D-16/DEGV1 550 CONTINUE C VIBRATION V1 ISOTROPIC QIN(6,I)=0.0 PEQIN(6,I)=0.5 IF(EN.LE.EIN(6)) GO TO 600 DO 560 J=2,NVBV1 IF(EN.LE.XVBV1(J)) GO TO 570 560 CONTINUE J=NVBV1 570 A=(YVBV1(J)-YVBV1(J-1))/(XVBV1(J)-XVBV1(J-1)) B=(XVBV1(J-1)*YVBV1(J)-XVBV1(J)*YVBV1(J-1))/(XVBV1(J-1)-XVBV1(J)) EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.0224*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(6,I)=((A*EN+B)+QIN(6,I))*APOPGS*1.D-16 600 CONTINUE C SUPERELASTIC OF VIBRATION V3 ISOTROPIC QIN(7,I)=0.0 PEQIN(7,I)=0.5 IF(EN.LE.0.0) GO TO 650 DO 610 J=2,NVBV3 IF((EN-EIN(7)).LE.XVBV3(J)) GO TO 620 610 CONTINUE J=NVBV3 620 A=(YVBV3(J)-YVBV3(J-1))/(XVBV3(J)-XVBV3(J-1)) B=(XVBV3(J-1)*YVBV3(J)-XVBV3(J)*YVBV3(J-1))/(XVBV3(J-1)-XVBV3(J)) EFAC=DSQRT(1.0-(EIN(7)/EN)) QIN(7,I)=VDSC*1.610*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(7,I)=QIN(7,I)+(EN-EIN(7))*(A*(EN-EIN(7))+B)/EN QIN(7,I)=QIN(7,I)*APOPV3*1.D-16/DEGV3 650 CONTINUE C VIBRATION V3 ANISOTROPIC QIN(8,I)=0.0 PEQIN(8,I)=0.5 IF(EN.LE.EIN(8)) GO TO 700 DO 660 J=2,NVBV3 IF(EN.LE.XVBV3(J)) GO TO 670 660 CONTINUE J=NVBV3 670 A=(YVBV3(J)-YVBV3(J-1))/(XVBV3(J)-XVBV3(J-1)) B=(XVBV3(J-1)*YVBV3(J)-XVBV3(J)*YVBV3(J-1))/(XVBV3(J-1)-XVBV3(J)) EFAC=DSQRT(1.0-(EIN(8)/EN)) QIN(8,I)=VDSC*1.610*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(8) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT XMT=((1.5-FWD/(FWD+BCK))*QIN(8,I)+RAT*(A*EN+B))*APOPGS*1.D-16 QIN(8,I)=((A*EN+B)+QIN(8,I))*APOPGS*1.D-16 PEQIN(8,I)=0.5+(QIN(8,I)-XMT)/QIN(8,I) 700 CONTINUE C VIBRATION HARMONIC 2V3 QIN(9,I)=0.0 PEQIN(9,I)=0.5 IF(EN.LE.EIN(9)) 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(9,I)=(A*EN+B)*APOPGS*1.D-16 PEQIN(9,I)=0.5+(1.0-RAT) 800 CONTINUE C VIBRATION HARMONIC 3V3 QIN(10,I)=0.0 PEQIN(10,I)=0.5 IF(EN.LE.EIN(10)) 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(10,I)=(A*EN+B)*APOPGS*1.D-16 PEQIN(10,I)=0.5+(1.0-RAT) 900 CONTINUE C QIN(11,I)=0.0 PEQIN(11,I)=0.5 IF(NANISO.EQ.2) PEQIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 950 IF(EN.GT.XEXC(NEXC)) GO TO 930 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(11,I)=(A*EN+B)*1.D-16 GO TO 940 C USE BORN BETHE X-SECTION ABOVE XEXC(NEXC) EV 930 QIN(11,I)=CONST*(AM2EXC*X1+CEXC*X2) C ANGULAR DISTRIBUTION COPIED FROM THE ELASTIC OFFSET BY TWICE THE C LEVEL ENERGY 940 IF(EN.LE.(2.0*EIN(11))) GO TO 950 PEQIN(11,I)=PEQEL(2,(I-IOFF11)) 950 CONTINUE C Q(1,I)=Q(2,I)+Q(5,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 RETURN END SUBROUTINE GAS2(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(60),YSEC(60),YEL(60),XEPS(160),YEPS(160), /XENI(75),YENI(75),YENC(75), /X1S5(71),Y1S5(71),YEPS1(71),X1S4(113),Y1S4(113),YEPS2(113), /X1S3(70),Y1S3(70),YEPS3(70),X1S2(119),Y1S2(119),YEPS4(119), /X2P10(54),Y2P10(54),YEP2P10(54),X2P9(17),Y2P9(17),YEP2P9(17), /X2P8(15),Y2P8(15),YEP2P8(15),X2P7(17),Y2P7(17),YEP2P7(17), /X2P6(16),Y2P6(16),YEP2P6(16),X2P5(17),Y2P5(17),YEP2P5(17), /X2P4(17),Y2P4(17),YEP2P4(17),X2P3(17),Y2P3(17),YEP2P3(17), /X2P2(16),Y2P2(16),YEP2P2(16),X2P1(17),Y2P1(17),YEP2P1(17), /X3D6(19),Y3D6(19),YEP3D6(19),X3D5(72),Y3D5(72),YEP3D5(72), /X3D4P(20),Y3D4P(20),YEP3D4P(20),X3D4(23),Y3D4(23),YEP3D4(23), /X3D3(20),Y3D3(20),YEP3D3(20),X3D1PP(19),Y3D1PP(19),YEP3D1PP(19), /X3D1P(16),Y3D1P(16),YEP3D1P(16), /X3S1PPPP(21),Y3S1PPPP(21),YEP3S1PPPP(21), /X3S1PPP(16),Y3S1PPP(16),YEP3S1PPP(16), /X3S1PP(21),Y3S1PP(21),YEP3S1PP(21),X2S5(19),Y2S5(19),YEP2S5(19), /X2S3(19),Y2S3(19),YEP2S3(19), /IOFFN(44) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ENERGY DATA XEN/1.00,1.20,1.50,1.70,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.0,14.0,15.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.,40000.,1.D5,1.5D5,2.D5,4.D5,6.D5,1.D6,1.5D6,2.D6/ C ELASTIC MOMENTUM TRANSFER DATA YSEC/1.3913,1.66,2.05,2.33,2.70,3.43,4.20,5.70,7.60,9.60, /11.5,13.1,14.7,16.2,16.8,16.6,15.9,15.1,14.2,13.3, /11.5,10.0,7.75,6.25,4.45,3.50,2.80,2.25,2.00,1.70, /1.50,1.22,1.00,0.78,0.64,0.55,0.48,0.43,.355,0.30, /0.26,0.22,0.16,.095,.063,.033,.021,.0146,.0108,.0047, /.00145,4.3D-4,8.6D-5,4.3D-5,2.7D-5,8.9D-6,4.8D-6,2.2D-6,1.18D-6, /7.6D-7/ C ELASTIC DATA YEL/1.4945,1.80,2.25,2.63,3.20,4.15,5.10,7.05,8.90,11.1, /13.4,15.8,18.1,20.3,21.9,23.0,23.4,23.5,23.2,22.2, /19.4,17.0,13.3,11.0,8.44,7.16,6.28,5.78,5.25,4.89, /4.50,3.95,3.51,3.03,2.70,2.48,2.30,2.10,1.90,1.72, /1.58,1.47,1.27,0.98,.818,.620,.510,.434,.380,.250, /.138,.076,.036,.027,.023,.0156,.0127,.0101,.0087,.0078/ C EPSILON FOR ELASTIC ANGULAR DISTRIBUTION DATA XEPS/.0,.0001,.0002,.0003,.0004,.0006,.0008,.001,.0012,.0014, /.0017,.002,.0025,.003,.004,.005,.006,.008,.010,.012, /.014,.017,.020,.025,.030,.035,.040,.045,.050,.055, /.060,.065,.070,.075,.080,.085,.090,.095,.100,.110, /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.25,0.26,0.27,0.28,0.29,0.30,0.31, /0.32,0.33,0.34,0.35,0.36,0.37,0.38,0.39,0.40,0.41, /0.42,0.43,0.44,0.45,0.46,0.47,0.48,0.49,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.65,0.67,0.70,0.75,0.80,0.85,0.90,0.95, /1.00,1.20,1.50,1.70,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.0,14.0,15.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.,40000.,1.D5,1.5D5,2.D5,4.D5,6.D5,1.D6,1.5D6,2.D6/ DATA YEPS/1.0,.013,.0186,.023,.0266,.0327,.0381,.0428,.0470,.0508, /.0567,.0616,.0696,.0766,.0897,.1012,.1121,.1319,.1499,.1668, /.1827,.2053,.2273,.2605,.2929,.3230,.3531,.3813,.4091,.4358, /.4621,.4881,.5134,.5377,.5616,.5846,.6068,.6284,.6495,.6892, /.7255,.7586,.7882,.8141,.8363,.8548,.8696,.8805,.8877,.8911, /.8907,.8860,.8769,.8631,.8441,.8198,.7896,.7535,.7118,.6647, /.6128,.5566,.4981,.4380,.3778,.3182,.2600,.2043,.1523,.1030, /.0586,.018,-.019,-.0521,-.0812,-.107,-.1293,-.1487,-.1654,-.1796, /-.191,-.2014,-.208,-.2137,-.2179,-.2205,-.222,-.222,-.2213,-.2194, /-.2165,-.213,-.2035,-.192,-.171,-.1296,-.0836,-.0358,.0124,.0589, /.1034,.1164,.1329,.1701,.2318,.2568,.2610,.2826,.2170,.2011, /.2108,.2530,.2774,.2975,.3410,.4033,.4594,.5068,.5446,.5604, /.5680,.5734,.5800,.5970,.6434,.6848,.7284,.7814,.7887,.8171, /.8287,.8478,.8656,.8848,.8982,.9078,.9157,.9180,.9283,.9351, /.9403,.9478,.9591,.9714,.9790,.9871,.9907,.9928,.9942,.9965, /.99827,.99917,.99969,.999807,.999863,.999939,.999961,.999979, /.999987,.999991/ C IONISATION ( VALUES ABOVE 20KEV GENERATED BY BORN BETHE IN SUB) DATA XENI/15.75961,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./ C GROSS IONISATION DATA YENI/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.97,1.80,1.67,1.54,1.44,1.28,1.15,1.04,.971,.898, /.768,.688,.638,.576,.526,.446,.384,.340,.302,.255, /.220,.172,.144,.110,.0825/ C COUNTING IONISATION DATA YENC/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.52,2.56,2.58,2.62,2.63,2.67,2.68,2.68,2.69,2.69, /2.68,2.66,2.64,2.59,2.56,2.52,2.46,2.37,2.24,2.04, /1.85,1.69,1.57,1.45,1.35,1.21,1.08,.981,.912,.843, /.721,.646,.599,.540,.494,.419,.361,.319,.283,.239, /.206,.162,.136,.104,.0775/ C 1S5 METASTABLE SCALE BY 1/E**3 ABOVE 100 EV DATA X1S5/11.548,11.60,11.63,11.64,11.66,11.70,11.75,11.80,11.82, /11.83, /11.84,11.86,11.88,11.90,11.93,12.00,12.10,12.20,12.30,12.40, /12.50,12.60,12.70,12.80,12.83,12.86,12.90,12.91,12.93,12.96, /13.00,13.03,13.05,13.08,13.10,13.12,13.15,13.18,13.20,13.26, /13.28,13.29,13.35,13.40,13.45,13.47,13.50,13.60,13.70,13.80, /14.0,14.5,15.0,16.0,17.0,18.0,20.0,22.0,24.0,26.0, /28.0,30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0, /100./ C UNITS 10-18 CM**2 DATA Y1S5/0.00,0.70,1.22,1.22,1.01,0.88,0.83,0.90,1.13,1.69, /2.27,1.64,1.13,1.04,0.99,1.10,1.31,1.64,2.05,2.47, /2.86,3.20,3.40,3.40,3.33,3.19,2.77,3.28,2.56,2.27, /2.27,3.89,5.20,3.89,2.72,2.14,1.75,1.96,1.69,1.53, /2.03,1.76,1.94,2.09,2.18,2.52,2.36,2.56,2.80,3.10, /3.85,4.40,4.94,5.58,6.16,6.44,6.20,4.90,3.80,3.20, /2.50,2.00,1.15,0.80,0.52,0.37,0.24,.135,.088,.060, /.042/ DATA YEPS1/71*0.0/ C 1S4 RESONANCE RADIATION 106.66 NM WAVELENGTH DATA X1S4/11.624,11.65,11.66,11.67,11.68,11.69,11.70,11.74,11.75, /11.77, /11.79,11.82,11.84,11.87,11.88,11.90,11.95,12.00,12.05,12.10, /12.20,12.30,12.40,12.50,12.60,12.70,12.80,12.85,12.90,12.905, /12.91,12.93,12.97,13.00,13.03,13.05,13.06,13.07,13.09,13.10, /13.15,13.18,13.20,13.21,13.23,13.26,13.30,13.35,13.40,13.45, /13.47,13.49,13.60,13.70,13.80,14.0,15.0,16.0,17.0,18.0, /19.0,20.0,24.0,27.0,30.0,40.0,50.0,60.0,80.0,100., /140.,200.,250.,300.,400.,500.,600.,800.,1000.,1200., /1500.,2000.,2500.,3000.,4000.,5000.,6000.,8000.,1.0D4,1.2D4, /1.4D4,1.7D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,7.0D4,1.0D5,1.5D5, /2.0D5,3.0D5,4.0D5,6.0D5,8.0D5,1.0D6,1.3D6,1.7D6,2.0D6,3.0D6, /4.0D6,7.0D6,1.0D7/ C UNITS 10**-18 CM**2 DATA Y1S4/0.00,0.90,1.48,1.57,1.57,1.55,1.48,1.10,1.05,1.14, /1.22,1.30,1.42,0.90,0.81,.742,.761,.788,0.86,0.92, /1.12,1.55,1.64,1.91,2.16,2.32,2.38,2.34,2.12,2.02, /2.29,2.00,1.87,1.93,2.38,3.28,3.49,3.20,2.21,2.05, /1.76,2.27,2.11,2.36,2.11,1.98,1.89,1.82,1.87,1.94, /2.16,2.07,2.23,2.40,2.55,2.90,5.02,6.23,6.86,7.43, /8.00,8.05,8.05,8.00,7.80,7.30,6.80,6.30,5.60,5.00, /4.30,3.60,3.30,3.00,2.50,2.15,1.90,1.55,1.32,1.16, /0.97,0.78,0.66,0.58,0.47,0.39,0.34,.270,.225,.193, /.170,.145,.127,.106,.0917,.0731,.0616,.0480,.0375,.0291, /.0249,.0207,.0187,.0170,.0163,.0160,.0159,.0160,.0162,.0167, /.0172,.0184,.0192/ DATA YEPS2/113*0.0/ C 1S3 METASTABLE SCALE BY 1/E**3 ABOVE 100 EV DATA X1S3/11.723,11.75,11.76,11.78,11.79,11.80,11.84,11.86,11.90, /11.95, /12.00,12.10,12.20,12.30,12.40,12.50,12.60,12.70,12.80,12.85, /12.90,12.91,12.92,12.94,12.98,12.99,13.00,13.01,13.04,13.05, /13.06,13.08,13.10,13.15,13.18,13.20,13.21,13.23,13.25,13.27, /13.30,13.35,13.40,13.45,13.47,13.49,13.60,13.70,13.80,14.0, /14.5,15.0,16.0,17.0,18.0,20.0,22.0,24.0,26.0,28.0, /30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0,100./ C UNITS 10**-18 CM**2 DATA Y1S3/0.00,.176,0.38,0.45,0.45,0.43,0.23,0.23,.176,.155, /.155,.171,.211,.259,.317,.389,.454,.509,.542,.535, /.479,.373,.567,.486,.437,.639,.518,.461,.518,.752, /.979,.873,.706,.535,.535,.826,1.12,.891,.720,.616, /.461,.236,.243,.252,.445,.356,.405,.454,.486,0.56, /0.80,0.99,1.12,1.23,1.29,1.24,0.98,0.76,0.64,0.50, /0.40,0.23,0.16,.104,.074,.048,.027,.0176,.0120,.0084/ DATA YEPS3/70*0.0/ C 1S2 RESONANCE RADIATION 104.82 NM WAVELENGTH DATA X1S2/11.828,11.85,11.86,11.88,11.90,11.93,11.96,12.00,12.05, /12.10, /12.20,12.30,12.40,12.50,12.60,12.70,12.80,12.85,12.90,12.91, /12.93,12.95,13.00,13.02,13.06,13.10,13.13,13.15,13.17,13.20, /13.21,13.23,13.25,13.27,13.30,13.35,13.40,13.45,13.46,13.48, /13.50,13.60,13.70,13.80,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0,50.0,60.0, /80.0,100.,120.,140.,170.,200.,250.,300.,350.,400., /450.,500.,600.,800.,1000.,1200.,1400.,1700.,2000.,2500., /3000.,3500.,4000.,5000.,6000.,8000.,1.0D4,1.2D4,1.4D4,1.7D4, /2.0D4,2.5D4,3.0D4,3.5D4,4.0D4,5.0D4,6.0D4,8.0D4,1.0D5,1.2D5, /1.4D5,1.7D5,2.0D5,2.5D5,3.0D5,3.5D5,4.0D5,5.0D5,6.0D5,8.0D5, /1.0D6,1.2D6,1.4D6,1.7D6,2.0D6,4.0D6,6.0D6,8.0D6,1.0D7/ C UNITS 10**-18 CM**2 DATA Y1S2/0.00,1.55,1.94,1.76,1.58,1.37,1.24,1.19,1.19,1.21, /1.30,1.44,1.64,1.91,2.25,2.52,2.75,2.83,2.86,3.46, /3.04,2.95,2.93,3.08,4.18,3.29,3.17,3.02,2.99,3.60, /4.21,3.78,3.53,3.17,3.02,2.74,2.92,3.29,3.40,3.24, /3.33,3.71,3.94,4.20,4.80,7.20,9.43,11.7,14.0,16.0, /17.2,18.8,19.8,20.6,21.3,22.0,23.6,24.7,25.5,25.3, /24.0,22.3,20.7,19.3,17.5,16.0,14.0,12.5,11.3,10.3, /9.54,8.87,7.79,6.31,5.34,4.65,4.13,3.55,3.12,2.61, /2.25,1.99,1.79,1.49,1.28,1.01,.841,.724,.637,.544, /.476,.397,.343,.304,.274,.230,.201,.163,.140,.125, /.113,.101,.0931,.0837,.0775,.0732,.0701,.0661,.0636,.0611, /.0600,.0597,.0597,.0600,.0606,.0645,.0676,.0700,.0719/ DATA YEPS4/119*0.0/ C 2P10 J=1 SCALED BY 1/E**2 ABOVE 100 EV DATA X2P10/12.907,12.912,12.922,12.934,12.949,12.966,13.00,13.012, /13.035,13.042, /13.053,13.064,13.068,13.075,13.089,13.107,13.141,13.154,13.162, /13.170, /13.180,13.190,13.202,13.214,13.220,13.234,13.239,13.265,13.271, /13.276, /13.300,13.400,13.445,13.458,13.467,13.480,13.50,13.60,14.0,15.0, /16.0,18.0,19.0,20.0,21.0,22.0,25.0,30.0,35.0,40.0, /50.0,60.0,80.0,100./ DATA Y2P10/0.00,0.76,0.40,0.57,0.53,0.61,0.95,1.40,1.78,1.88, /1.74,1.18,0.70,0.34,0.13,0.21,0.39,0.70,1.01,1.07, /1.33,1.17,1.43,0.70,0.36,0.14,0.11,0.11,0.25,0.18, /0.19,0.21,0.22,0.34,0.51,0.34,0.32,0.31,0.39,0.77, /1.13,1.82,2.03,2.16,2.20,2.17,1.89,1.20,0.81,0.58, /0.33,0.21,0.11,.065/ DATA YEP2P10/54*0.0/ C 2P9 J=3 SCALED BY 1/E**2 ABOVE 100 EV DATA X2P9/13.076,14.0,15.0,16.0,18.0,19.0,20.0,21.0,22.0,25.0, /30.0,35.0,40.0,50.0,60.0,80.0,100./ DATA Y2P9/0.00,0.55,1.23,1.90,2.75,2.94,3.00,2.98,2.92,2.55, /1.73,1.19,0.85,0.50,0.32,0.17,0.11/ DATA YEP2P9/17*0.0/ C 2P8 J=2 SCALED BY 1/E ABOVE 100 EV DATA X2P8/13.095,14.0,15.0,16.0,18.0,20.0,22.0,25.0,30.0,35.0, /40.0,50.0,60.0,80.0,100./ DATA Y2P8/0.00,0.38,0.85,1.25,1.85,2.10,2.30,2.35,2.40,2.36, /2.20,1.80,1.50,1.13,0.90/ DATA YEP2P8/15*0.0/ C 2P7 J=1 SCALED BY 1/E**2 ABOVE 100 EV DATA X2P7/13.153,14.0,15.0,16.0,18.0,19.0,20.0,21.0,22.0,25.0, /30.0,35.0,40.0,50.0,60.0,80.0,100./ DATA Y2P7/0.00,0.20,0.56,0.92,1.56,1.74,1.81,1.81,1.76,1.60, /1.25,1.00,0.84,0.61,0.44,0.27,0.19/ DATA YEP2P7/17*0.0/ C 2P6 J=2 SCALED BY 1/E ABOVE 100 EV DATA X2P6/13.172,14.0,15.0,16.0,18.0,19.0,20.0,22.0,25.0,30.0, /35.0,40.0,50.0,60.0,80.0,100./ DATA Y2P6/0.00,0.36,0.81,1.24,1.84,2.04,2.10,2.20,2.18,1.95, /1.80,1.65,1.42,1.27,1.04,0.87/ DATA YEP2P6/16*0.0/ C 2P5 J=0 SCALED BY 1/E ABOVE 100 EV DATA X2P5/13.273,14.0,15.0,16.0,18.0,19.0,20.0,21.0,22.0,25.0, /30.0,35.0,40.0,50.0,60.0,80.0,100./ DATA Y2P5/0.00,0.09,0.28,0.47,0.83,0.97,1.08,1.16,1.20,1.26, /1.25,1.23,1.20,1.08,0.96,0.75,0.60/ DATA YEP2P5/17*0.0/ C 2P4 J=1 SCALED BY 1/E**2 ABOVE 100 EV DATA X2P4/13.283,14.0,15.0,16.0,18.0,19.0,20.0,21.0,22.0,25.0, /30.0,35.0,40.0,50.0,60.0,80.0,100./ DATA Y2P4/0.00,0.18,0.55,0.90,1.53,1.71,1.77,1.77,1.72,1.57, /1.23,0.98,0.82,0.60,0.43,0.26,0.18/ DATA YEP2P4/17*0.0/ C 2P3 J=2 SCALED BY 1/E ABOVE 100 EV DATA X2P3/13.302,14.0,15.0,16.0,18.0,19.0,20.0,21.0,22.0,25.0, /30.0,35.0,40.0,50.0,60.0,80.0,100./ DATA Y2P3/0.00,.155,0.39,0.62,1.11,1.34,1.51,1.62,1.70,1.82, /1.85,1.76,1.62,1.33,1.10,0.82,0.66/ DATA YEP2P3/17*0.0/ C 2P2 J=1 SCALED BY 1/E**2 ABOVE 100 EV DATA X2P2/13.328,14.0,15.0,16.0,18.0,19.0,20.0,22.0,25.0,30.0, /35.0,40.0,50.0,60.0,80.0,100./ DATA Y2P2/0.00,0.20,0.46,0.60,0.74,0.77,.785,0.78,0.73,0.62, /0.53,0.44,0.33,0.25,0.15,0.10/ DATA YEP2P2/16*0.0/ C 2P1 J=0 SCALED BY 1/E ABOVE 100 EV DATA X2P1/13.480,14.0,15.0,16.0,18.0,19.0,20.0,21.0,22.0,25.0, /30.0,35.0,40.0,50.0,60.0,80.0,100./ DATA Y2P1/0.00,0.29,0.94,1.58,2.75,3.22,3.60,3.85,4.00,4.20, /4.15,4.10,4.00,3.60,3.20,2.50,2.00/ DATA YEP2P1/17*0.0/ C 3D6 J=0 SCALED BY 1/E**3 ABOVE 100 EV DATA X3D6/13.845,14.0,15.0,16.0,17.0,18.0,19.0,20.0,22.0,25.0, /30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0,100./ DATA Y3D6/0.00,0.11,0.64,0.92,1.05,1.10,1.10,1.07,0.97,0.79, /0.56,0.39,0.28,0.21,0.16,.099,.065,.045,.024/ DATA YEP3D6/19*0.0/ C 3D5 J=1 DIPOLE ALLOWED BEF SCALING DATA X3D5/13.864,14.0,15.0,16.0,17.0,18.0,19.0,20.0,22.0,25.0, /30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0,100.,120., /140.,170.,200.,250.,300.,400.,500.,600.,700.,800., /1000.,1200.,1400.,1700.,2000.,2500.,3000.,3500.,4000.,5000., /6000.,8000.,1.0D4,1.2D4,1.4D4,1.7D4,2.0D4,2.5D4,3.0D4,4.0D4, /5.0D4,6.0D4,8.0D4,1.0D5,1.2D5,1.4D5,1.7D5,2.0D5,2.5D5,3.0D5, /4.0D5,5.0D5,6.0D5,8.0D5,1.0D6,1.4D6,2.0D6,3.0D6,4.0D6,6.0D6, /8.0D6,1.0D7/ DATA Y3D5/0.00,0.40,3.00,4.50,5.25,5.50,5.50,5.35,4.90,4.00, /2.80,2.05,1.50,1.15,0.98,0.65,0.46,0.35,0.19,0.14, /.115,.095,.077,.065,.055,.043,.036,.032,.028,.026, /.022,.019,.017,.015,.0128,.0107,.0093,.0082,.0074,.0061, /.0053,.0042,.0035,.0030,.0026,.0023,.0020,.00165,.00143,.00114, /9.6D-4,8.4D-4,6.8D-4,5.8D-4,5.2D-4,4.7D-4,4.2D-4,3.9D-4,3.5D-4, /3.2D-4, /2.9D-4,2.8D-4,2.7D-4,2.6D-4,2.5D-4,2.5D-4,2.5D-4,2.6D-4,2.7D-4, /2.8D-4, /2.9D-4,3.0D-4/ DATA YEP3D5/72*0.0/ C 3D4' J=4 SCALED BY 1/E**3 ABOVE 100 EV DATA X3D4P/13.979,15.0,16.0,17.0,18.0,19.0,20.0,22.0,25.0,30.0, /35.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0,90.0,100./ DATA Y3D4P/0.00,2.16,3.31,3.88,4.11,4.14,4.04,3.68,3.03,2.12, /1.50,1.09,.813,.619,.482,.381,.251,.173,.125,.092/ DATA YEP3D4P/20*0.0/ C 3D4 J=3 SCALED BY 1/E**2 ABOVE 100 EV DATA X3D4/14.013,15.0,16.0,17.0,18.0,19.0,20.0,21.0,22.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./ DATA Y3D4/0.00,0.63,1.05,1.31,1.48,1.57,1.62,1.63,1.62,1.52, /1.28,1.06,0.88,0.73,0.62,0.53,0.46,0.40,0.35,0.31, /0.28,.225,.186/ DATA YEP3D4/23*0.0/ C 3D3 J=2 SCALE BY 1/E**3 ABOVE 100 EV DATA X3D3/13.903,14.0,15.0,16.0,17.0,18.0,19.0,20.0,22.0,25.0, /30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0,100./ DATA Y3D3/0.00,0.15,1.60,3.00,3.70,4.30,4.50,4.40,4.20,3.60, /2.63,1.86,1.35,1.00,0.76,0.47,0.31,0.21,0.15,.114/ DATA YEP3D3/20*0.0/ C 3D1'' J=2 (ALSO 2S5 J=1 ) SCALE BY 1/E**2 ABOVE 100 EV DATA X3D1PP/14.063,15.0,16.0,17.0,18.0,19.0,20.0,22.0,25.0,30.0, /35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0,100./ DATA Y3D1PP/0.00,0.60,1.10,1.50,1.70,1.80,1.85,1.85,1.65,1.35, /1.00,0.73,0.57,0.45,0.32,0.23,0.18,.145,.120/ DATA YEP3D1PP/19*0.0/ C 3D1' J=3 SCALE BY 1/E ABOVE 100 EV DATA X3D1P/14.099,15.0,16.0,18.0,19.0,20.0,21.0,22.0,25.0,30.0, /35.0,40.0,50.0,60.0,80.0,100./ DATA Y3D1P/0.00,0.08,0.18,0.33,0.40,0.45,0.48,0.50,0.54,0.55, /0.52,0.48,0.40,0.33,0.24,0.20/ DATA YEP3D1P/16*0.0/ C 3S1'''' J=2 SCALE BY 1/E**3 ABOVE 100 EV DATA X3S1PPPP/14.214,15.0,16.0,17.0,18.0,19.0,20.0,22.0,24.0,27.0, /30.0,35.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0,90.0, /100./ DATA Y3S1PPPP/0.00,0.80,1.65,2.10,2.30,2.35,2.32,2.15,1.89,1.54, /1.25,0.89,0.65,0.48,0.37,0.29,0.23,0.15,.103,.074, /.055/ DATA YEP3S1PPPP/21*0.0/ C 3S1''' J=3 SCALE BY 1/E ABOVE 100 EV DATA X3S1PPP/14.236,15.0,16.0,18.0,19.0,20.0,21.0,22.0,25.0,30.0, /35.0,40.0,50.0,60.0,80.0,100./ DATA Y3S1PPP/0.00,0.12,0.27,0.50,0.60,0.68,0.72,0.75,0.81,0.82, /0.78,0.72,0.60,0.52,0.36,0.30/ DATA YEP3S1PPP/16*0.0/ C 3S1'' J=2 SCALE BY 1/E**3 ABOVE 100 EV DATA X3S1PP/14.234,15.0,16.0,17.0,18.0,19.0,20.0,21.0,22.0,25.0, /30.0,35.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0,90.0, /100./ DATA Y3S1PP/0.00,0.55,1.06,1.31,1.42,1.44,1.42,1.37,1.31,1.09, /0.77,0.55,0.40,0.30,0.23,0.18,0.14,.0918,.0635,.0456, /.0339/ DATA YEP3S1PP/21*0.0/ C 2S5 J=2 SCALE BY 1/E**2 ABOVE 100 EV DATA X2S5/14.068,15.0,16.0,17.0,18.0,19.0,20.0,22.0,25.0,30.0, /35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0,100./ DATA Y2S5/0.00,0.60,1.10,1.50,1.70,1.80,1.85,1.85,1.65,1.35, /1.00,0.73,0.57,0.45,0.32,0.23,0.18,.145,.120/ DATA YEP2S5/19*0.0/ C 2S3 J=0 SCALE BY 1/E**2 ABOVE 100 EV DATA X2S3/14.241,15.0,16.0,17.0,18.0,19.0,20.0,22.0,25.0,30.0, /35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0,100./ DATA Y2S3/0.00,0.12,0.22,0.30,0.34,0.36,0.37,0.37,0.33,0.27, /0.20,.146,.114,.090,.064,.046,.036,.029,.024/ DATA YEP2S3/19*0.0/ C---------------------------------------------------------------------- C NANISO=0 IF(NANISO.EQ.0) THEN NAME='ARGON ISOT 2011' ELSE NAME='ARGON ANIS 2011' ENDIF 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 2007:INCREASED DATA BASE UPPER ENERGY TO 2MEV C 2007:INCLUDED NEW ANISTROPIC SCATTERING FUNCTION C 2007:INCLUDED POSSIBLE PENNING TRANSFER FRACTION C 2009:SPLIT EXCITATION X-SECTION INTO 44 LEVELS AND MODIFIED C ELASTIC X-SECTION. C 2011:INCREASED SCALING FACTOR FOR S LEVELS AT THRESHOLD FROM C 0.5 TO 0.81 x (BARTSCHAT AND ZATSARINNY BSR MODEL) C EXCITATION RATE STILL WITHIN 1 SIGMA OF TACHIBANAS MEASURED C RATES FOR THE 1S LEVELS C AND SMALL INCREASE IN MOMENTUM TRANSFER X-SECTION AT THE C PEAK( 11 EV) TO FIT DRIFT VELOCITY. 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=DACOS(-1.0D0) A0=0.52917720859D-8 RY=13.60569193 CONST=1.873884D-20 EMASS2=1021997.804 BBCONST=16.0*API*A0*A0*RY*RY/EMASS2 CONST=1.873884D-20 AM2=3.593 C=39.70 C NIN=44 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN 2 KIN(J)=NANISO C NDATA=60 NEPSI=160 NIDATA=75 N1S5=71 N1S4=113 N1S3=70 N1S2=119 N2P10=54 N2P9=17 N2P8=15 N2P7=17 N2P6=16 N2P5=17 N2P4=17 N2P3=17 N2P2=16 N2P1=17 N3D6=19 N3D5=72 N3D3=20 N3D4P=20 N3D4=23 N3D1PP=19 N2S5=19 N3D1P=16 N3S1PPPP=21 N3S1PP=21 N3S1PPP=16 N2S3=19 E(1)=0.0 E(2)=2.0*EMASS/(39.948*AMU) E(3)=15.75961 C EXCITATION X-SECTION AT 1.5MEV E(4)=0.18D-18 C IONISING X-SECTION AT 1.5MEV E(5)=0.9204D-18 C EOBY FOR MINIMUM IONISING PARTICLE E(6)=15.0 C EOBY AT LOW ENERGY EOBY=10.0 IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) EIN(1)=11.548 EIN(2)=11.624 EIN(3)=11.723 EIN(4)=11.828 EIN(5)=12.907 EIN(6)=13.076 EIN(7)=13.095 EIN(8)=13.153 EIN(9)=13.172 EIN(10)=13.273 EIN(11)=13.283 EIN(12)=13.302 EIN(13)=13.328 EIN(14)=13.480 EIN(15)=13.845 EIN(16)=13.864 EIN(17)=13.903 EIN(18)=13.979 EIN(19)=14.013 EIN(20)=14.063 EIN(21)=14.068 EIN(22)=14.090 EIN(23)=14.099 EIN(24)=14.153 EIN(25)=14.214 EIN(26)=14.234 EIN(27)=14.236 EIN(28)=14.241 EIN(29)=14.255 EIN(30)=14.304 EIN(31)=14.711 EIN(32)=14.848 EIN(33)=14.859 EIN(34)=15.004 EIN(35)=15.022 EIN(36)=15.118 EIN(37)=15.186 EIN(38)=15.190 EIN(39)=15.308 EIN(40)=15.351 EIN(41)=15.360 EIN(42)=15.366 EIN(43)=15.374 EIN(44)=15.660 C********************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C USE TRANSFER FRACTION IN RANGE BETWEEN 0.0 AND 0.2 FOR MOST MIXTURES DO 50 NL=1,NIN PENFRA(1,NL)=0.0 C PENNING TRANSFER DISTANCE MICRONS PENFRA(2,NL)=1.0 C PENNING TRANSFER TIME PICOSECONDS 50 PENFRA(3,NL)=1.0 C********************************************************************** IF(IPEN.EQ.0) GO TO 4 DO 3 KDUM=1,NIN IF(PENFRA(1,KDUM).EQ.0.0) GO TO 3 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 3 CONTINUE 4 DO 5 NL=1,NIN 5 IOFFN(NL)=IFIX(SNGL(0.5+EIN(NL)/ESTEP)) SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) ARGON ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC (ISO) ARGON ' ENDIF SCRPT(3)=' IONISATION ELOSS= 15.75961' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EXC 1S5 J=2 M ELVL= 11.548' SCRPT(8)=' EXC 1S4 J=1 R ELVL= 11.624' SCRPT(9)=' EXC 1S3 J=0 M ELVL= 11.723' SCRPT(10)=' EXC 1S2 J=1 R ELVL= 11.828' SCRPT(11)=' EXC 2P10 J=1 ELVL= 12.907' SCRPT(12)=' EXC 2P9 J=3 ELVL= 13.076' SCRPT(13)=' EXC 2P8 J=2 ELVL= 13.095' SCRPT(14)=' EXC 2P7 J=1 ELVL= 13.153' SCRPT(15)=' EXC 2P6 J=2 ELVL= 13.172' SCRPT(16)=' EXC 2P5 J=0 ELVL= 13.273' SCRPT(17)=' EXC 2P4 J=1 ELVL= 13.283' SCRPT(18)=' EXC 2P3 J=2 ELVL= 13.302' SCRPT(19)=' EXC 2P2 J=1 ELVL= 13.328' SCRPT(20)=' EXC 2P1 J=0 ELVL= 13.480' SCRPT(21)=' EXC 3D6 J=0 ELVL= 13.845' SCRPT(22)=' EXC 3D5 J=1 R ELVL= 13.864' SCRPT(23)=' EXC 3D3 J=2 ELVL= 13.903' SCRPT(24)=' EXC 3D4! J=4 ELVL= 13.979' SCRPT(25)=' EXC 3D4 J=3 ELVL= 14.013' SCRPT(26)=' EXC 3D1!! J=2 ELVL= 14.063' SCRPT(27)=' EXC 2S5 J=2 ELVL= 14.068' SCRPT(28)=' EXC 2S4 J=1 R ELVL= 14.090' SCRPT(29)=' EXC 3D1! J=3 ELVL= 14.099' SCRPT(30)=' EXC 3D2 J=1 R ELVL= 14.153' SCRPT(31)=' EXC 3S1!!!!J=2 ELVL= 14.214' SCRPT(32)=' EXC 3S1!! J=2 ELVL= 14.234' SCRPT(33)=' EXC 3S1!!! J=3 ELVL= 14.236' SCRPT(34)=' EXC 2S3 J=0 ELVL= 14.241' SCRPT(35)=' EXC 2S2 J=1 R ELVL= 14.255' SCRPT(36)=' EXC 3S1! J=1 R ELVL= 14.304' SCRPT(37)=' EXC 4D5 J=1 R ELVL= 14.711' SCRPT(38)=' EXC 3S4 J=1 R ELVL= 14.848' SCRPT(39)=' EXC 4D2 J=1 R ELVL= 14.859' SCRPT(40)=' EXC 4S1! J=1 R ELVL= 15.004' SCRPT(41)=' EXC 3S2 J=1 R ELVL= 15.022' SCRPT(42)=' EXC 5D5 J=1 R ELVL= 15.118' SCRPT(43)=' EXC 4S4 J=1 R ELVL= 15.186' SCRPT(44)=' EXC 5D2 J=1 R ELVL= 15.190' SCRPT(45)=' EXC 6D5 J=1 R ELVL= 15.308' SCRPT(46)=' EXC 5S1! J=1 R ELVL= 15.351' SCRPT(47)=' EXC 4S2 J=1 R ELVL= 15.360' SCRPT(48)=' EXC 5S4 J=1 R ELVL= 15.366' SCRPT(49)=' EXC 6D2 J=1 R ELVL= 15.374' SCRPT(50)=' EXC HIGH J=1 R ELVL= 15.660' EN=-ESTEP/2.0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.EIN(1)) THEN GAMMA=(EMASS2+2.0D0*EN)/EMASS2 GAMMA2=GAMMA*GAMMA BETA=DSQRT(1.0D0-1.0D0/(GAMMA*GAMMA)) BETA2=BETA*BETA ENDIF 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=DSQRT(EN/ARY) AK2=AK*AK AK3=AK2*AK AK4=AK3*AK AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK2*DLOG(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=DATAN(AN0) AN1=DATAN(AN1) AN2=DATAN(AN2) ANHIGH=AN2 SUM=(DSIN(AN0-AN1))**2 SUM=SUM+2.0*(DSIN(AN1-AN2))**2 SIGEL=(DSIN(AN0))**2+3.0*(DSIN(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)*(DSIN(DATAN(API*APOL*AK2*SUMI)))**2 ANHIGH=DATAN(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)*(DSIN(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,NDATA IF(EN.LE.XEN(J)) GO TO 120 110 CONTINUE J=NDATA 120 A=(YEL(J)-YEL(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEL(J)-XEN(J)*YEL(J-1))/(XEN(J-1)-XEN(J)) QELA=(A*EN+B)*1.0D-16 A=(YSEC(J)-YSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YSEC(J)-XEN(J)*YSEC(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.0D-16 200 CONTINUE PQ1=0.5+(QELA-QMOM)/QELA DO 201 J=2,NEPSI IF(EN.LE.XEPS(J)) GO TO 202 201 CONTINUE J=NEPSI 202 A=(YEPS(J)-YEPS(J-1))/(XEPS(J)-XEPS(J-1)) B=(XEPS(J-1)*YEPS(J)-XEPS(J)*YEPS(J-1))/(XEPS(J-1)-XEPS(J)) PQ2=A*EN+B IF(NANISO.EQ.0) PEQEL(2,I)=0.5 IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) Q(2,I)=QMOM C GROSS IONISATION Q(3,I)=0.0 PEQEL(3,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 230 IF(EN.GT.XENI(75)) GO TO 221 DO 210 J=2,NIDATA IF(EN.LE.XENI(J)) GO TO 220 210 CONTINUE J=NIDATA 220 A=(YENI(J)-YENI(J-1))/(XENI(J)-XENI(J-1)) B=(XENI(J-1)*YENI(J)-XENI(J)*YENI(J-1))/(XENI(J-1)-XENI(J)) Q(3,I)=(A*EN+B)*1.0D-16 GO TO 222 C USE BORN-BETHE X-SECTION ABOVE XENI(75) EV 221 X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2)/0.939 222 CONTINUE 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.0 C COUNTING IONISATION Q(5,I)=0.0 PEQEL(5,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(5,I)=0.0D0 IF(EN.LE.E(3)) GO TO 250 IF(EN.GT.XENI(75)) GO TO 241 DO 231 J=2,NIDATA IF(EN.LE.XENI(J)) GO TO 240 231 CONTINUE J=NIDATA 240 A=(YENC(J)-YENC(J-1))/(XENI(J)-XENI(J-1)) B=(XENI(J-1)*YENC(J)-XENI(J)*YENC(J-1))/(XENI(J-1)-XENI(J)) Q(5,I)=(A*EN+B)*1.0D-16 GO TO 242 C USE BORN-BETHE X-SECTION ABOVE XENI(75) EV 241 Q(5,I)=CONST*(AM2*X1+C*X2) 242 CONTINUE 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 250 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 250 CONTINUE Q(6,I)=0.0 C DO 251 NL=1,NIN QIN(NL,I)=0.0 PEQIN(NL,I)=0.5D0 IF(NANISO.EQ.2) THEN PEQIN(NL,I)=0.0D0 ENDIF 251 CONTINUE C 1S5 IF(EN.LE.EIN(1)) GO TO 413 IF(EN.GT.X1S5(N1S5)) GO TO 3111 DO 310 J=2,N1S5 IF(EN.LE.X1S5(J)) GO TO 311 310 CONTINUE J=N1S5 311 A=(Y1S5(J)-Y1S5(J-1))/(X1S5(J)-X1S5(J-1)) B=(X1S5(J-1)*Y1S5(J)-X1S5(J)*Y1S5(J-1))/(X1S5(J-1)-X1S5(J)) QIN(1,I)=(A*EN+B)*1.0D-18 GO TO 3112 C IF ENERGY GT X1S5(N1S5) EV SCALE BY 1/E**3 3111 QIN(1,I)=Y1S5(N1S5)*(X1S5(N1S5)/EN)**3*1.0D-18 3112 IF(EN.LE.(2.0*EIN(1))) GO TO 312 PEQIN(1,I)=PEQEL(2,(I-IOFFN(1))) C 1S4 312 IF(EN.LE.EIN(2)) GO TO 413 DO 313 J=2,N1S4 IF(EN.LE.X1S4(J)) GO TO 314 313 CONTINUE J=N1S4 314 A=(Y1S4(J)-Y1S4(J-1))/(X1S4(J)-X1S4(J-1)) B=(X1S4(J-1)*Y1S4(J)-X1S4(J)*Y1S4(J-1))/(X1S4(J-1)-X1S4(J)) QIN(2,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(2))) GO TO 315 PEQIN(2,I)=PEQEL(2,(I-IOFFN(2))) C 1S3 315 IF(EN.LE.EIN(3)) GO TO 413 IF(EN.GT.X1S3(N1S3)) GO TO 3171 DO 316 J=2,N1S3 IF(EN.LE.X1S3(J)) GO TO 317 316 CONTINUE J=N1S3 317 A=(Y1S3(J)-Y1S3(J-1))/(X1S3(J)-X1S3(J-1)) B=(X1S3(J-1)*Y1S3(J)-X1S3(J)*Y1S3(J-1))/(X1S3(J-1)-X1S3(J)) QIN(3,I)=(A*EN+B)*1.0D-18 GO TO 3172 C IF ENERGY GT X1S3(N1S3) EV SCALE BY 1/E**3 3171 QIN(3,I)=Y1S3(N1S3)*(X1S3(N1S3)/EN)**3*1.D-18 3172 IF(EN.LE.(2.0*EIN(3))) GO TO 318 PEQIN(3,I)=PEQEL(2,(I-IOFFN(3))) C 1S2 318 IF(EN.LE.EIN(4)) GO TO 413 DO 319 J=2,N1S2 IF(EN.LE.X1S2(J)) GO TO 320 319 CONTINUE J=N1S2 320 A=(Y1S2(J)-Y1S2(J-1))/(X1S2(J)-X1S2(J-1)) B=(X1S2(J-1)*Y1S2(J)-X1S2(J)*Y1S2(J-1))/(X1S2(J-1)-X1S2(J)) QIN(4,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(4))) GO TO 321 PEQIN(4,I)=PEQEL(2,(I-IOFFN(4))) C C P STATES C C 2P10 321 IF(EN.LE.EIN(5)) GO TO 413 IF(EN.GT.X2P10(N2P10)) GO TO 3231 DO 322 J=2,N2P10 IF(EN.LE.X2P10(J)) GO TO 323 322 CONTINUE J=N2P10 323 A=(Y2P10(J)-Y2P10(J-1))/(X2P10(J)-X2P10(J-1)) B=(X2P10(J-1)*Y2P10(J)-X2P10(J)*Y2P10(J-1))/(X2P10(J-1)-X2P10(J)) QIN(5,I)=(A*EN+B)*1.D-18 GO TO 3232 C IF ENERGY GT X2P10(N2P10) EV SCALE BY 1/E**2 3231 QIN(5,I)=Y2P10(N2P10)*(X2P10(N2P10)/EN)**2*1.0D-18 3232 IF(EN.LE.(2.0*EIN(5))) GO TO 324 PEQIN(5,I)=PEQEL(2,(I-IOFFN(5))) C 2P9 324 IF(EN.LE.EIN(6)) GO TO 413 IF(EN.GT.X2P9(N2P9)) GO TO 3261 DO 325 J=2,N2P9 IF(EN.LE.X2P9(J)) GO TO 326 325 CONTINUE J=N2P9 326 A=(Y2P9(J)-Y2P9(J-1))/(X2P9(J)-X2P9(J-1)) B=(X2P9(J-1)*Y2P9(J)-X2P9(J)*Y2P9(J-1))/(X2P9(J-1)-X2P9(J)) QIN(6,I)=(A*EN+B)*1.D-18 GO TO 3262 C IF ENERGY GT X2P9(N2P9) EV SCALE BY 1/E**2 3261 QIN(6,I)=Y2P9(N2P9)*(X2P9(N2P9)/EN)**2*1.0D-18 3262 IF(EN.LE.(2.0*EIN(6))) GO TO 327 PEQIN(6,I)=PEQEL(2,(I-IOFFN(6))) C 2P8 327 IF(EN.LE.EIN(7)) GO TO 413 IF(EN.GT.X2P8(N2P8)) GO TO 3291 DO 328 J=2,N2P8 IF(EN.LE.X2P8(J)) GO TO 329 328 CONTINUE J=N2P8 329 A=(Y2P8(J)-Y2P8(J-1))/(X2P8(J)-X2P8(J-1)) B=(X2P8(J-1)*Y2P8(J)-X2P8(J)*Y2P8(J-1))/(X2P8(J-1)-X2P8(J)) QIN(7,I)=(A*EN+B)*1.D-18 GO TO 3292 C IF ENERGY GT X2P8(N2P8) EV SCALE BY 1/E 3291 QIN(7,I)=Y2P8(N2P8)*(X2P8(N2P8)/EN)*1.0D-18 3292 IF(EN.LE.(2.0*EIN(7))) GO TO 330 PEQIN(7,I)=PEQEL(2,(I-IOFFN(7))) C 2P7 330 IF(EN.LE.EIN(8)) GO TO 413 IF(EN.GT.X2P7(N2P7)) GO TO 3321 DO 331 J=2,N2P7 IF(EN.LE.X2P7(J)) GO TO 332 331 CONTINUE J=N2P7 332 A=(Y2P7(J)-Y2P7(J-1))/(X2P7(J)-X2P7(J-1)) B=(X2P7(J-1)*Y2P7(J)-X2P7(J)*Y2P7(J-1))/(X2P7(J-1)-X2P7(J)) QIN(8,I)=(A*EN+B)*1.D-18 GO TO 3322 C IF ENERGY GT X2P7(N2P7) EV SCALE BY 1/E**2 3321 QIN(8,I)=Y2P7(N2P7)*(X2P7(N2P7)/EN)**2*1.0D-18 3322 IF(EN.LE.(2.0*EIN(8))) GO TO 333 PEQIN(8,I)=PEQEL(2,(I-IOFFN(8))) C 2P6 333 IF(EN.LE.EIN(9)) GO TO 413 IF(EN.GT.X2P6(N2P6)) GO TO 3351 DO 334 J=2,N2P6 IF(EN.LE.X2P6(J)) GO TO 335 334 CONTINUE J=N2P6 335 A=(Y2P6(J)-Y2P6(J-1))/(X2P6(J)-X2P6(J-1)) B=(X2P6(J-1)*Y2P6(J)-X2P6(J)*Y2P6(J-1))/(X2P6(J-1)-X2P6(J)) QIN(9,I)=(A*EN+B)*1.D-18 GO TO 3352 C IF ENERGY GT X2P6(N2P6) EV SCALE BY 1/E 3351 QIN(9,I)=Y2P6(N2P6)*(X2P6(N2P6)/EN)*1.0D-18 3352 IF(EN.LE.(2.0*EIN(9))) GO TO 336 PEQIN(9,I)=PEQEL(2,(I-IOFFN(9))) C 2P5 336 IF(EN.LE.EIN(10)) GO TO 413 IF(EN.GT.X2P5(N2P5)) GO TO 3381 DO 337 J=2,N2P5 IF(EN.LE.X2P5(J)) GO TO 338 337 CONTINUE J=N2P5 338 A=(Y2P5(J)-Y2P5(J-1))/(X2P5(J)-X2P5(J-1)) B=(X2P5(J-1)*Y2P5(J)-X2P5(J)*Y2P5(J-1))/(X2P5(J-1)-X2P5(J)) QIN(10,I)=(A*EN+B)*1.D-18 GO TO 3382 C IF ENERGY GT X2P5(N2P5) EV SCALE BY 1/E 3381 QIN(10,I)=Y2P5(N2P5)*(X2P5(N2P5)/EN)*1.0D-18 3382 IF(EN.LE.(2.0*EIN(10))) GO TO 339 PEQIN(10,I)=PEQEL(2,(I-IOFFN(10))) C 2P4 339 IF(EN.LE.EIN(11)) GO TO 413 IF(EN.GT.X2P4(N2P4)) GO TO 3411 DO 340 J=2,N2P4 IF(EN.LE.X2P4(J)) GO TO 341 340 CONTINUE J=N2P4 341 A=(Y2P4(J)-Y2P4(J-1))/(X2P4(J)-X2P4(J-1)) B=(X2P4(J-1)*Y2P4(J)-X2P4(J)*Y2P4(J-1))/(X2P4(J-1)-X2P4(J)) QIN(11,I)=(A*EN+B)*1.D-18 GO TO 3412 C IF ENERGY GT X2P4(N2P4) EV SCALE BY 1/E**2 3411 QIN(11,I)=Y2P4(N2P4)*(X2P4(N2P4)/EN)**2*1.0D-18 3412 IF(EN.LE.(2.0*EIN(11))) GO TO 342 PEQIN(11,I)=PEQEL(2,(I-IOFFN(11))) C 2P3 342 IF(EN.LE.EIN(12)) GO TO 413 IF(EN.GT.X2P3(N2P3)) GO TO 3441 DO 343 J=2,N2P3 IF(EN.LE.X2P3(J)) GO TO 344 343 CONTINUE J=N2P3 344 A=(Y2P3(J)-Y2P3(J-1))/(X2P3(J)-X2P3(J-1)) B=(X2P3(J-1)*Y2P3(J)-X2P3(J)*Y2P3(J-1))/(X2P3(J-1)-X2P3(J)) QIN(12,I)=(A*EN+B)*1.D-18 GO TO 3442 C IF ENERGY GT X2P3(N2P3) EV SCALE BY 1/E 3441 QIN(12,I)=Y2P3(N2P3)*(X2P3(N2P3)/EN)*1.0D-18 3442 IF(EN.LE.(2.0*EIN(12))) GO TO 345 PEQIN(12,I)=PEQEL(2,(I-IOFFN(12))) C 2P2 345 IF(EN.LE.EIN(13)) GO TO 413 IF(EN.GT.X2P2(N2P2)) GO TO 3471 DO 346 J=2,N2P2 IF(EN.LE.X2P2(J)) GO TO 347 346 CONTINUE J=N2P2 347 A=(Y2P2(J)-Y2P2(J-1))/(X2P2(J)-X2P2(J-1)) B=(X2P2(J-1)*Y2P2(J)-X2P2(J)*Y2P2(J-1))/(X2P2(J-1)-X2P2(J)) QIN(13,I)=(A*EN+B)*1.D-18 GO TO 3472 C IF ENERGY GT X2P2(N2P2) EV SCALE BY 1/E**2 3471 QIN(13,I)=Y2P2(N2P2)*(X2P2(N2P2)/EN)**2*1.0D-18 3472 IF(EN.LE.(2.0*EIN(13))) GO TO 348 PEQIN(13,I)=PEQEL(2,(I-IOFFN(13))) C 2P1 348 IF(EN.LE.EIN(14)) GO TO 413 IF(EN.GT.X2P1(N2P1)) GO TO 3501 DO 349 J=2,N2P1 IF(EN.LE.X2P1(J)) GO TO 350 349 CONTINUE J=N2P1 350 A=(Y2P1(J)-Y2P1(J-1))/(X2P1(J)-X2P1(J-1)) B=(X2P1(J-1)*Y2P1(J)-X2P1(J)*Y2P1(J-1))/(X2P1(J-1)-X2P1(J)) QIN(14,I)=(A*EN+B)*1.D-18 GO TO 3502 C IF ENERGY GT X2P1(N2P1) EV SCALE BY 1/E 3501 QIN(14,I)=Y2P1(N2P1)*(X2P1(N2P1)/EN)*1.0D-18 3502 IF(EN.LE.(2.0*EIN(14))) GO TO 351 PEQIN(14,I)=PEQEL(2,(I-IOFFN(14))) C 3D6 351 IF(EN.LE.EIN(15)) GO TO 413 IF(EN.GT.X3D6(N3D6)) GO TO 3531 DO 352 J=2,N3D6 IF(EN.LE.X3D6(J)) GO TO 353 352 CONTINUE J=N3D6 353 A=(Y3D6(J)-Y3D6(J-1))/(X3D6(J)-X3D6(J-1)) B=(X3D6(J-1)*Y3D6(J)-X3D6(J)*Y3D6(J-1))/(X3D6(J-1)-X3D6(J)) QIN(15,I)=(A*EN+B)*1.D-18 GO TO 3532 C IF ENERGY GT X3D6(N3D6) EV SCALE BY 1/E**3 3531 QIN(15,I)=Y3D6(N3D6)*(X3D6(N3D6)/EN)**3*1.0D-18 3532 IF(EN.LE.(2.0*EIN(15))) GO TO 354 PEQIN(15,I)=PEQEL(2,(I-IOFFN(15))) C 3D5 354 IF(EN.LE.EIN(16)) GO TO 413 DO 355 J=2,N3D5 IF(EN.LE.X3D5(J)) GO TO 356 355 CONTINUE J=N3D5 356 A=(Y3D5(J)-Y3D5(J-1))/(X3D5(J)-X3D5(J-1)) B=(X3D5(J-1)*Y3D5(J)-X3D5(J)*Y3D5(J-1))/(X3D5(J-1)-X3D5(J)) QIN(16,I)=(A*EN+B)*1.D-18 IF(EN.LE.(2.0*EIN(16))) GO TO 357 PEQIN(16,I)=PEQEL(2,(I-IOFFN(16))) C 3D3 357 IF(EN.LE.EIN(17)) GO TO 413 IF(EN.GT.X3D3(N3D3)) GO TO 3591 DO 358 J=2,N3D3 IF(EN.LE.X3D3(J)) GO TO 359 358 CONTINUE J=N3D3 359 A=(Y3D3(J)-Y3D3(J-1))/(X3D3(J)-X3D3(J-1)) B=(X3D3(J-1)*Y3D3(J)-X3D3(J)*Y3D3(J-1))/(X3D3(J-1)-X3D3(J)) QIN(17,I)=(A*EN+B)*1.D-18 GO TO 3592 C IF ENERGY GT X3D3(N3D3) EV SCALE BY 1/E**3 3591 QIN(17,I)=Y3D3(N3D3)*(X3D3(N3D3)/EN)**3*1.0D-18 3592 IF(EN.LE.(2.0*EIN(17))) GO TO 360 PEQIN(17,I)=PEQEL(2,(I-IOFFN(17))) C 3D4' 360 IF(EN.LE.EIN(18)) GO TO 413 IF(EN.GT.X3D4P(N3D4P)) GO TO 3621 DO 361 J=2,N3D4P IF(EN.LE.X3D4P(J)) GO TO 362 361 CONTINUE J=N3D4P 362 A=(Y3D4P(J)-Y3D4P(J-1))/(X3D4P(J)-X3D4P(J-1)) B=(X3D4P(J-1)*Y3D4P(J)-X3D4P(J)*Y3D4P(J-1))/(X3D4P(J-1)-X3D4P(J)) QIN(18,I)=(A*EN+B)*1.D-18 GO TO 3622 C IF ENERGY GT X3D4P(N3D4P) EV SCALE BY 1/E**3 3621 QIN(18,I)=Y3D4P(N3D4P)*(X3D4P(N3D4P)/EN)**3*1.0D-18 3622 IF(EN.LE.(2.0*EIN(18))) GO TO 363 PEQIN(18,I)=PEQEL(2,(I-IOFFN(18))) C 3D4 363 IF(EN.LE.EIN(19)) GO TO 413 IF(EN.GT.X3D4(N3D4)) GO TO 3651 DO 364 J=2,N3D4 IF(EN.LE.X3D4(J)) GO TO 365 364 CONTINUE J=N3D4 365 A=(Y3D4(J)-Y3D4(J-1))/(X3D4(J)-X3D4(J-1)) B=(X3D4(J-1)*Y3D4(J)-X3D4(J)*Y3D4(J-1))/(X3D4(J-1)-X3D4(J)) QIN(19,I)=(A*EN+B)*1.D-18 GO TO 3652 C IF ENERGY GT X3D4(N3D4) EV SCALE BY 1/E**2 3651 QIN(19,I)=Y3D4(N3D4)*(X3D4(N3D4)/EN)**2*1.0D-18 3652 IF(EN.LE.(2.0*EIN(19))) GO TO 366 PEQIN(19,I)=PEQEL(2,(I-IOFFN(19))) C 3D1'' 366 IF(EN.LE.EIN(20)) GO TO 413 IF(EN.GT.X3D1PP(N3D1PP)) GO TO 3681 DO 367 J=2,N3D1PP IF(EN.LE.X3D1PP(J)) GO TO 368 367 CONTINUE J=N3D1PP 368 A=(Y3D1PP(J)-Y3D1PP(J-1))/(X3D1PP(J)-X3D1PP(J-1)) B=(X3D1PP(J-1)*Y3D1PP(J)-X3D1PP(J)*Y3D1PP(J-1))/(X3D1PP(J-1)- /X3D1PP(J)) QIN(20,I)=(A*EN+B)*1.D-18 GO TO 3682 C IF EN GT X3D1PP(N3D1PP) EV SCALE BY 1/E**2 3681 QIN(20,I)=Y3D1PP(N3D1PP)*(X3D1PP(N3D1PP)/EN)**2*1.0D-18 3682 IF(EN.LE.(2.0*EIN(20))) GO TO 369 PEQIN(20,I)=PEQEL(2,(I-IOFFN(20))) C 2S5 369 IF(EN.LE.EIN(21)) GO TO 413 IF(EN.GT.X2S5(N2S5)) GO TO 3711 DO 370 J=2,N2S5 IF(EN.LE.X2S5(J)) GO TO 371 370 CONTINUE J=N2S5 371 A=(Y2S5(J)-Y2S5(J-1))/(X2S5(J)-X2S5(J-1)) B=(X2S5(J-1)*Y2S5(J)-X2S5(J)*Y2S5(J-1))/(X2S5(J-1)-X2S5(J)) QIN(21,I)=(A*EN+B)*1.D-18 GO TO 3712 C IF EN GT X2S5(N2S5) EV SCALE BY 1/E**2 3711 QIN(21,I)=Y2S5(N2S5)*(X2S5(N2S5)/EN)**2*1.0D-18 3712 IF(EN.LE.(2.0*EIN(21))) GO TO 372 PEQIN(21,I)=PEQEL(2,(I-IOFFN(21))) C 2S4 F=0.0257 372 IF(EN.LE.EIN(22)) GO TO 413 QIN(22,I)=0.0257/(EIN(22)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(22)))-BETA2)*BBCONST*(1.0-(4.0*EIN(22)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(22))) GO TO 375 PEQIN(22,I)=PEQEL(2,(I-IOFFN(22))) C 3D1' 375 IF(EN.LE.EIN(23)) GO TO 413 IF(EN.GT.X3D1P(N3D1P)) GO TO 3771 DO 376 J=2,N3D1P IF(EN.LE.X3D1P(J)) GO TO 377 376 CONTINUE J=N3D1P 377 A=(Y3D1P(J)-Y3D1P(J-1))/(X3D1P(J)-X3D1P(J-1)) B=(X3D1P(J-1)*Y3D1P(J)-X3D1P(J)*Y3D1P(J-1))/(X3D1P(J-1)-X3D1P(J)) QIN(23,I)=(A*EN+B)*1.D-18 GO TO 3772 C IF EN GT X3D1P(N3D1P) EV SCALE BY 1/E 3771 QIN(23,I)=Y3D1P(N3D1P)*(X3D1P(N3D1P)/EN)*1.0D-18 3772 IF(EN.LE.(2.0*EIN(23))) GO TO 378 PEQIN(23,I)=PEQEL(2,(I-IOFFN(23))) C 3D2 F=0.074 378 IF(EN.LE.EIN(24)) GO TO 413 QIN(24,I)=0.0740/(EIN(24)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(24)))-BETA2)*BBCONST*(1.0-(4.0*EIN(24)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(24))) GO TO 381 PEQIN(24,I)=PEQEL(2,(I-IOFFN(24))) C 3S1'''' 381 IF(EN.LE.EIN(25)) GO TO 413 IF(EN.GT.X3S1PPPP(N3S1PPPP)) GO TO 3831 DO 382 J=2,N3S1PPPP IF(EN.LE.X3S1PPPP(J)) GO TO 383 382 CONTINUE J=N3S1PPPP 383 A=(Y3S1PPPP(J)-Y3S1PPPP(J-1))/(X3S1PPPP(J)-X3S1PPPP(J-1)) B=(X3S1PPPP(J-1)*Y3S1PPPP(J)-X3S1PPPP(J)*Y3S1PPPP(J-1))/ /(X3S1PPPP(J-1)-X3S1PPPP(J)) QIN(25,I)=(A*EN+B)*1.D-18 GO TO 3832 C IF EN GT X3S1PPPP(N3S1PPPP) EV SCALE BY 1/E**3 3831 QIN(25,I)=Y3S1PPPP(N3S1PPPP)*(X3S1PPPP(N3S1PPPP)/EN)**3*1.0D-18 3832 IF(EN.LE.(2.0*EIN(25))) GO TO 384 PEQIN(25,I)=PEQEL(2,(I-IOFFN(25))) C 3S1'' 384 IF(EN.LE.EIN(26)) GO TO 413 IF(EN.GT.X3S1PP(N3S1PP)) GO TO 3861 DO 385 J=2,N3S1PP IF(EN.LE.X3S1PP(J)) GO TO 386 385 CONTINUE J=N3S1PP 386 A=(Y3S1PP(J)-Y3S1PP(J-1))/(X3S1PP(J)-X3S1PP(J-1)) B=(X3S1PP(J-1)*Y3S1PP(J)-X3S1PP(J)*Y3S1PP(J-1))/(X3S1PP(J-1)- /X3S1PP(J)) QIN(26,I)=(A*EN+B)*1.D-18 GO TO 3862 C IF EN GT X3S1PP(N3S1PP) EV SCALE BY 1/E**3 3861 QIN(26,I)=Y3S1PP(N3S1PP)*(X3S1PP(N3S1PP)/EN)**3*1.0D-18 3862 IF(EN.LE.(2.0*EIN(26))) GO TO 387 PEQIN(26,I)=PEQEL(2,(I-IOFFN(26))) C 3S1''' 387 IF(EN.LE.EIN(27)) GO TO 413 IF(EN.GT.X3S1PPP(N3S1PPP)) GO TO 3891 DO 388 J=2,N3S1PPP IF(EN.LE.X3S1PPP(J)) GO TO 389 388 CONTINUE J=N3S1PPP 389 A=(Y3S1PPP(J)-Y3S1PPP(J-1))/(X3S1PPP(J)-X3S1PPP(J-1)) B=(X3S1PPP(J-1)*Y3S1PPP(J)-X3S1PPP(J)*Y3S1PPP(J-1))/ /(X3S1PPP(J-1)-X3S1PPP(J)) QIN(27,I)=(A*EN+B)*1.D-18 GO TO 3892 C IF EN GT X3S1PPP(N3S1PPP) EV SCALE BY 1/E 3891 QIN(27,I)=Y3S1PPP(N3S1PPP)*(X3S1PPP(N3S1PPP)/EN)*1.0D-18 3892 IF(EN.LE.(2.0*EIN(27))) GO TO 390 PEQIN(27,I)=PEQEL(2,(I-IOFFN(27))) C 2S3 390 IF(EN.LE.EIN(28)) GO TO 413 IF(EN.GT.X2S3(N2S3)) GO TO 3921 DO 391 J=2,N2S3 IF(EN.LE.X2S3(J)) GO TO 392 391 CONTINUE J=N2S3 392 A=(Y2S3(J)-Y2S3(J-1))/(X2S3(J)-X2S3(J-1)) B=(X2S3(J-1)*Y2S3(J)-X2S3(J)*Y2S3(J-1))/(X2S3(J-1)-X2S3(J)) QIN(28,I)=(A*EN+B)*1.D-18 GO TO 3922 C IF EN GT X2S3(N2S3) EV SCALE BY 1/E**2 3921 QIN(29,I)=Y2S3(N2S3)*(X2S3(N2S3)/EN)**2*1.0D-18 3922 IF(EN.LE.(2.0*EIN(28))) GO TO 393 PEQIN(28,I)=PEQEL(2,(I-IOFFN(28))) C 2S2 F=0.011 393 IF(EN.LE.EIN(29)) GO TO 413 QIN(29,I)=0.0110/(EIN(29)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(29)))-BETA2)*BBCONST*(1.0-(4.0*EIN(29)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(29))) GO TO 396 PEQIN(29,I)=PEQEL(2,(I-IOFFN(29))) C 3S1' F=0.092 396 IF(EN.LE.EIN(30)) GO TO 413 QIN(30,I)=0.0920/(EIN(30)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(30)))-BETA2)*BBCONST*(1.0-(4.0*EIN(30)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(30))) GO TO 399 PEQIN(30,I)=PEQEL(2,(I-IOFFN(30))) C 4D5 F=0.0019 399 IF(EN.LE.EIN(31)) GO TO 413 QIN(31,I)=0.0019/(EIN(31)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(31)))-BETA2)*BBCONST*(1.0-(4.0*EIN(31)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(31))) GO TO 400 PEQIN(31,I)=PEQEL(2,(I-IOFFN(31))) C 3S4 F=0.0144 400 IF(EN.LE.EIN(32)) GO TO 413 QIN(32,I)=0.0144/(EIN(32)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(32)))-BETA2)*BBCONST*(1.0-(4.0*EIN(32)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(32))) GO TO 401 PEQIN(32,I)=PEQEL(2,(I-IOFFN(32))) C 4D2 F=0.0484 401 IF(EN.LE.EIN(33)) GO TO 413 QIN(33,I)=0.0484/(EIN(33)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(33)))-BETA2)*BBCONST*(1.0-(4.0*EIN(33)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(33))) GO TO 402 PEQIN(33,I)=PEQEL(2,(I-IOFFN(33))) C 4S1' F=0.0209 402 IF(EN.LE.EIN(34)) GO TO 413 QIN(34,I)=0.0209/(EIN(34)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(34)))-BETA2)*BBCONST*(1.0-(4.0*EIN(34)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(34))) GO TO 403 PEQIN(34,I)=PEQEL(2,(I-IOFFN(34))) C 3S2 F=0.0220 403 IF(EN.LE.EIN(35)) GO TO 413 QIN(35,I)=0.0220/(EIN(35)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(35)))-BETA2)*BBCONST*(1.0-(4.0*EIN(35)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(35))) GO TO 404 PEQIN(35,I)=PEQEL(2,(I-IOFFN(35))) C 5D5 F=0.0041 404 IF(EN.LE.EIN(36)) GO TO 413 QIN(36,I)=0.0041/(EIN(36)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(36)))-BETA2)*BBCONST*(1.0-(4.0*EIN(36)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(36))) GO TO 405 PEQIN(36,I)=PEQEL(2,(I-IOFFN(36))) C 4S4 F=0.0426 405 IF(EN.LE.EIN(37)) GO TO 413 QIN(37,I)=0.0426/(EIN(37)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(37)))-BETA2)*BBCONST*(1.0-(4.0*EIN(37)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(37))) GO TO 406 PEQIN(37,I)=PEQEL(2,(I-IOFFN(37))) C 5D2 F=0.0426 406 IF(EN.LE.EIN(38)) GO TO 413 QIN(38,I)=0.0426/(EIN(38)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(38)))-BETA2)*BBCONST*(1.0-(4.0*EIN(38)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(38))) GO TO 407 PEQIN(38,I)=PEQEL(2,(I-IOFFN(38))) C 6D5 F=0.00075 407 IF(EN.LE.EIN(39)) GO TO 413 QIN(39,I)=.00075/(EIN(39)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(39)))-BETA2)*BBCONST*(1.0-(4.0*EIN(39)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(39))) GO TO 408 PEQIN(39,I)=PEQEL(2,(I-IOFFN(39))) C 5S1' F=0.00051 408 IF(EN.LE.EIN(40)) GO TO 413 QIN(40,I)=.00051/(EIN(40)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(40)))-BETA2)*BBCONST*(1.0-(4.0*EIN(40)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(40))) GO TO 409 PEQIN(40,I)=PEQEL(2,(I-IOFFN(40))) C 4S2 F=0.00074 409 IF(EN.LE.EIN(41)) GO TO 413 QIN(41,I)=.00074/(EIN(41)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(41)))-BETA2)*BBCONST*(1.0-(4.0*EIN(41)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(41))) GO TO 410 PEQIN(41,I)=PEQEL(2,(I-IOFFN(41))) C 5S4 F=0.0130 410 IF(EN.LE.EIN(42)) GO TO 413 QIN(42,I)=0.0130/(EIN(42)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(42)))-BETA2)*BBCONST*(1.0-(4.0*EIN(42)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(42))) GO TO 411 PEQIN(42,I)=PEQEL(2,(I-IOFFN(42))) C 6D2 F=0.0290 411 IF(EN.LE.EIN(43)) GO TO 413 QIN(43,I)=0.0290/(EIN(43)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(43)))-BETA2)*BBCONST*(1.0-(4.0*EIN(43)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(43))) GO TO 412 PEQIN(43,I)=PEQEL(2,(I-IOFFN(43))) C SUM HIGHER J=1 STATES F=0.1359 412 IF(EN.LE.EIN(44)) GO TO 413 QIN(44,I)=0.1359/(EIN(44)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(44)))-BETA2)*BBCONST*(1.0-(4.0*EIN(44)/(EMASS2*BETA2))) IF(EN.LE.(2.0*EIN(44))) GO TO 413 PEQIN(44,I)=PEQEL(2,(I-IOFFN(44))) 413 CONTINUE C Q1SSUM=QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) QPSSUM=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) QDSSUM=QIN(17,I)+QIN(18,I)+QIN(19,I)+QIN(20,I)+QIN(21,I)+QIN(22,I) /+QIN(23,I)+QIN(24,I)+QIN(25,I)+QIN(26,I)+QIN(27,I)+QIN(28,I)+ /QIN(29,I)+QIN(30,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)+ /QIN(41,I)+QIN(42,I)+QIN(43,I)+QIN(44,I)+QIN(15,I)+QIN(16,I) TOTSUM=Q1SSUM+QPSSUM+QDSSUM C WRITE(6,997) EN,QIN(1,I),QIN(2,I),QIN(3,I),QIN(4,I),Q1SSUM,QPSSUM, C /QDSSUM,TOTSUM C 997 FORMAT(' EN =',D12.5,' Q1S5 =',D12.3,' Q1S4 =',D12.3,' Q1S3 =', C /D12.3,' Q1S2 =',D12.3,/,'S1 =',D12.3,' P2=',D12.3,' D3 =',D12.3, C /' QTOT=',D12.3) C TOTAL X-SECTION Q(1,I)=QELA+Q(5,I)+Q1SSUM+QPSSUM+QDSSUM 900 CONTINUE C SAVE COMPUTE TIME DO 910 K=1,NIN IF(EFINAL.LE.EIN(K)) THEN NIN=K-1 GO TO 911 ENDIF 910 CONTINUE 911 CONTINUE C RETURN END SUBROUTINE GAS3(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(100),YEM(100),YEL(100),YEPS(100), /XION(90),YION(90),YINC(90), /X23S(139),Y23S(139),X21S(128),Y21S(128),X23P(128),Y23P(128), /X21P(125),Y21P(125),X33S(106),Y33S(106),X31S(87),Y31S(87), /X33P(91),Y33P(91),X33D(108),Y33D(108),X31D(94),Y31D(94), /X31P(114),Y31P(114),X43S(59),Y43S(59),X41S(55),Y41S(55), /X43P(76),Y43P(76),X43D(65),Y43D(65),X41D(53),Y41D(53), /X43F(40),Y43F(40),X41F(57),Y41F(57),X41P(96),Y41P(96), /IOFFN(49) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC DATA XEN/0.00,.008,.009,0.01,.013,.017,.020,.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,14.0,16.0,18.0,20.0,25.0,30.0, /35.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., /3000.,4000.,6000.,8000.,10000.,1.25D4,1.5D4,2.0D4,2.5D4,3.0D4, /4.0D4,6.0D4,8.0D4,1.0D5,1.25D5,1.50D5,2.0D5,2.5D5,3.0D5,4.0D5, /6.0D5,8.0D5,1.0D6,1.5D6,2.0D6,3.0D6,4.0D6,6.0D6,8.0D6,1.0D7/ C ELASTIC MOMENTUM TRANSFER DATA YEM/4.89,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.45,4.20,3.68,3.28,2.95,2.64,2.05,1.63, /1.33,1.09,.785,.590,.465,.375,.309,.262,.179,.132, /.0807,.0549,.0400,.0242,.0164,.0119,.00716,.00482,.00234,.0014, /.000676,4.03D-4,1.93D-4,1.15D-4,7.65D-5,5.10D-5,3.66D-5,2.17D-5, /1.45D-5,1.04D-5, /6.18D-6,2.99D-6,1.71D-6,1.21D-6,8.26D-7,6.05D-7,3.73D-7,2.58D-7, /1.92D-7,1.22D-7, /6.48D-8,4.17D-8,2.96D-8,1.58D-8,1.01D-8,5.24D-9,3.25D-9,1.63D-9, /9.89D-10,6.67D-10/ C ELASTIC TOTAL DATA YEL/4.89,5.19,5.20,5.21,5.26,5.29,5.33,5.37,5.41,5.47, /5.53,5.58,5.62,5.66,5.69,5.70,5.76,5.83,5.88,5.90, /5.96,6.01,6.08,6.12,6.14,6.16,6.16,6.17,6.16,6.16, /6.14,6.11,6.09,6.01,5.90,5.60,5.36,5.10,4.91,4.70, /4.51,4.32,4.21,4.10,3.75,3.49,3.27,3.03,2.54,2.14, /1.83,1.61,1.27,1.06,.884,.746,.652,.580,.460,.355, /.244,.194,.150,.117,.087,.071,.052,.041,.028,.022, /.014,.0108,.00722,.00544,.00437,.00352,.00295,.00224,.00182, /.00154, /.00118,.000830,.000654,.000550,.000466,.000411,.000342,.000301, /.000274,.000241, /.000209,.000195,.000186,.000177,.000172,.000169,.000167,.000166, /.000166,.000166/ C ANGULAR DISTRIBUTION PARAMETER EPSILON DATA YEPS/0.0,.00289,.00288,0.0,0.0,-.00562,-.00565,-.01118, /-.01386,-.01920, /-.02440,-.02688,-.03202,-.03445,-.03689,-.04209,-.04686,-.05400, /-.06119,-.06604, /-.07792,-.08474,-.10094,-.11490,-.12663,-.13826,-.14789,-.15724, /-.16707,-.18142, /-.19873,-.21165,-.21951,-.23447,-.24855,-.26918,-.26215,-.26104, /-.23265,-.20568, /-.17192,-.13835,-.08539,-.03657,0.02800,0.09011,0.14616,0.19164, /0.28459,0.34854, /0.39645,0.46261,0.53723,0.61037,0.64478,0.67011,0.70021,0.72258, /0.78150,0.79668, /0.83079,0.86696,0.87845,0.91682,0.92737,0.93870,0.95363,0.96280, /0.97662,.983705, /.988614,.991805,.994606,.995963,.996795,.997452,.997887,.998428, /.998754,.998956, /.999239,.9995075,.9996596,.9997208,.9997819,.9998234,.9998743, /.9999042,.9999236,.9999469, /.9999692,.9999796,.9999853,.9999922,.9999951,.9999975,.9999985, /.9999993,.9999996,.9999997/ C IONISATION (VALUES ABOVE 20KEV GENERATED BY BORN-BETHE IN SUB) DATA XION/24.58739,25.0,25.5,26.0,26.5,27.0,27.5,28.0,28.5,29.0, /29.5,30.0,30.5,31.0,31.5,32.0,32.5,33.0,33.5,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., /225.,250.,275.,300.,350.,400.,450.,500.,550.,600., /650.,700.,750.,800.,850.,900.,950.,1000.,1200.,1400., /1600.,1800.,2000.,2500.,3000.,3500.,4000.,4500.,5000.,5500., /6000.,7000.,8000.,9000.,1.0D4,1.2D4,1.4D4,1.6D4,1.8D4,2.0D4/ C GROSS IONISATION DATA YION/.0,.0041,.0101,.0166,.0233,.0299,.036,.0419,.0477,.0539, /.0600,.0655,.0714,.0773,.0827,.0884,.0940,.0994,.105,.110, /.130,.148,.165,.201,.234,.259,.280,.295,.310,.322, /.333,.341,.349,.356,.360,.362,.364,.365,.366,.366, /.367,.366,.365,.364,.362,.359,.355,.351,.346,.341, /.327,.314,.303,.291,.269,.248,.229,.212,.201,.190, ..179,.171,.162,.154,.148,.142,.137,.128,.115,.102, /.0922,.0845,.0781,.0645,.0551,.0501,.0440,.0409,.0363,.0333, /.0312,.0275,.0249,.0223,.0194,.0164,.0147,.0130,.0119,.0108/ C COUNTING IONISATION DATA YINC/.0,.0041,.0101,.0166,.0233,.0299,.036,.0419,.0477,.0539, /.0600,.0655,.0714,.0773,.0827,.0884,.0940,.0994,.105,.110, /.130,.148,.165,.201,.234,.259,.280,.295,.310,.322, /.333,.341,.349,.356,.360,.362,.364,.365,.366,.366, /.366,.365,.364,.363,.361,.358,.354,.350,.345,.340, /.326,.313,.302,.290,.268,.247,.228,.211,.200,.189, /.178,.170,.161,.153,.147,.141,.136,.127,.114,.101, /.0917,.0841,.0777,.0642,.0548,.0498,.0438,.0407,.0361,.0331, /.0310,.0274,.0248,.0222,.0193,.0163,.0146,.0129,.0118,.0107/ C ALL EXCITATIONS IN UNITS OF 10**-18 C 2 3S J=1 METASTABLE DATA X23S/19.81961,19.83,19.85,19.88,19.9,19.95,20.0,20.05,20.1, /20.15, /20.2,20.25,20.3,20.35,20.4,20.45,20.50,20.55,20.6,20.63, /20.66,20.7,20.75,20.8,20.85,20.90,20.94,20.97,21.0,21.05, /21.1,21.15,21.2,21.25,21.3,21.4,21.5,22.0,22.2,22.25, /22.3,22.35,22.4,22.42,22.44,22.46,22.48,22.5,22.52,22.55, /22.6,22.62,22.64,22.66,22.68,22.7,22.71,22.72,22.75,22.8, /22.85,22.88,22.9,22.95,22.97,23.0,23.05,23.1,23.3,23.4, /23.5,23.6,23.8,24.0,24.5,25.0,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,220., /240.,260.,280.,300.,340.,380.,420.,460.,500.,550., /600.,650.,700.,750.,800.,850.,900.,950.,1000.,1100., /1200.,1300.,1400.,1500.,1600.,1700.,1800.,1900.,2000./ DATA Y23S/0.00,.780,1.16,1.64,1.98,2.81,3.53,4.13,4.61,4.96, /5.20,5.35,5.41,5.36,5.21,4.95,4.63,4.23,3.66,3.16, /3.04,3.13,3.41,3.77,4.14,4.44,4.54,4.43,4.27,3.96, /3.69,3.48,3.32,3.21,3.15,3.08,3.06,3.09,3.08,3.04, /2.97,2.84,2.25,1.58,1.83,4.91,4.45,4.13,3.95,3.79, /3.60,3.51,3.07,2.45,2.61,2.67,2.36,2.97,3.01,2.96, /2.87,2.61,3.04,2.75,3.16,3.06,2.90,2.79,2.81,2.86, /2.75,2.80,2.71,2.65,2.58,2.48,2.39,2.30,2.19,2.09, /1.98,1.84,1.73,1.53,1.36,1.22,1.09,.985,.892,.812, /.742,.680,.555,.461,.389,.332,.287,.250,.220,.194, /.154,.125,.103,.0861,.0726,.0617,.0529,.0397,.0305,.0239, /.0191,.0154,.0126,.0105,.00740,.00542,.00407,.00314,.00247,.00187, /.00145,.00115,9.23D-4,7.53D-4,6.22D-4,5.20D-4,4.39D-4,3.74D-4, /3.21D-4,2.42D-4, /1.86D-4,1.47D-4,1.18D-4,9.57D-5,7.89D-5,6.58D-5,5.54D-5,4.71D-5, /4.04D-5/ C 2 1S J=0 METASTABLE DATA X21S/20.61577,20.62,20.63,20.65,20.67,20.69,20.72,20.75, /20.80,20.85, /20.90,20.96,20.98,21.0,21.05,21.1,21.15,21.2,21.22,21.25, /21.3,21.4,21.5,21.6,21.7,21.8,21.9,22.0,22.1,22.2, /22.25,22.3,22.35,22.4,22.42,22.44,22.46,22.48,22.5,22.55, /22.59,22.6,22.61,22.62,22.63,22.64,22.65,22.68,22.7,22.71, /22.72,22.73,22.75,22.78,22.8,22.85,22.87,22.88,22.89,22.9, /22.91,22.92,22.93,22.94,22.95,22.96,22.97,22.98,22.99,23.0, /23.01,23.05,23.1,23.2,23.3,23.4,23.5,23.6,23.8,24.0, /24.2,24.4,24.7,25.0,26.0,28.0,30.0,32.0,35.0,40.0, /45.0,50.0,55.0,60.0,65.0,70.0,80.0,90.0,100.,110., /120.,140.,170.,200.,240.,280.,320.,360.,400.,450., /500.,550.,600.,650.,700.,800.,900.,1000.,1100.,1200., /1400.,1600.,1800.,2000.,2200.,2400.,2700.,3000./ DATA Y21S/0.00,.406,.477,.664,.820,.946,1.10,1.24,1.47,1.72, /2.03,2.52,2.40,2.39,2.39,2.42,2.46,2.53,2.55,2.53, /2.52,2.53,2.57,2.59,2.62,2.64,2.65,2.65,2.65,2.62, /2.59,2.53,2.42,2.14,1.86,2.17,3.35,3.01,2.79,2.34, /1.80,1.88,2.53,3.37,3.64,3.55,3.42,3.23,2.95,2.45, /1.84,2.32,2.49,2.60,2.62,2.57,2.40,2.57,2.59,2.32, /1.73,2.55,2.36,2.35,2.32,2.23,2.50,2.64,2.61,1.86, /2.28,2.53,2.35,2.39,2.44,2.51,2.48,2.45,2.44,2.49, /2.57,2.63,2.56,2.54,2.53,2.51,2.45,2.35,2.21,2.05, /1.88,1.75,1.65,1.56,1.48,1.41,1.30,1.21,1.14,1.08, /1.03,.948,.850,.771,.686,.617,.560,.512,.471,.428, /.392,.361,.335,.312,.292,.259,.233,.211,.193,.178, /.154,.136,.121,.109,.0997,.0916,.0817,.0737/ C 2 3P J=2,1,0 DATA X23P/20.96409,20.97,21.0,21.05,21.1,21.15,21.2,21.25,21.3, /21.35, /21.4,21.5,21.6,21.7,21.8,21.9,22.0,22.1,22.2,22.3, /22.4,22.45,22.5,22.55,22.6,22.61,22.62,22.63,22.64,22.65, /22.66,22.67,22.68,22.69,22.7,22.71,22.72,22.73,22.75,22.77, /22.8,22.85,22.88,22.9,22.91,22.92,22.93,22.96,22.97,22.99, /23.0,23.04,23.06,23.07,23.08,23.1,23.2,23.3,23.4,23.5, /23.6,23.7,23.8,23.9,24.0,24.2,24.4,24.6,25.0,26.0, /27.0,28.0,29.0,30.0,32.0,34.0,36.0,38.0,40.0,42.0, /44.0,46.0,48.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., /170.,180.,190.,200.,220.,240.,260.,280.,300.,340., /380.,420.,460.,500.,550.,600.,700.,800.,900.,1000., /1200.,1400.,1600.,1800.,2000.,2300.,2600.,3000./ DATA Y23P/0.00,.0936,.241,.442,.611,.761,.912,1.03,1.10,1.17, /1.23,1.32,1.40,1.47,1.54,1.60,1.66,1.73,1.80,1.87, /1.94,2.05,2.07,2.09,2.22,2.48,2.68,2.60,2.27,1.78, /1.45,1.43,1.52,1.59,1.60,1.45,1.47,1.70,1.83,1.91, /1.95,1.93,2.32,1.98,1.72,2.23,2.09,2.12,2.07,2.17, /1.82,2.18,1.80,1.82,1.94,1.94,1.90,1.88,1.89,2.00, /2.16,2.21,2.14,2.08,2.09,2.03,2.16,2.26,2.29,2.41, /2.47,2.48,2.47,2.43,2.30,2.15,2.00,1.84,1.69,1.55, /1.43,1.31,1.21,1.11,.907,.748,.622,.522,.441,.375, /.322,.277,.241,.210,.162,.127,.101,.0812,.0663,.0547, /.0455,.0382,.0324,.0277,.0206,.0156,.0121,.00961,.00772,.00518, /.00363,.00264,.00197,.00151,.00118,8.48D-4,5.21D-4,3.42D-4, /2.37D-4,1.70D-4, /9.65D-5,5.99D-5,3.96D-5,2.76D-5,2.00D-5,1.30D-5,8.94D-6,5.78D-6/ C 2 1P RESONANCE RADIATION J=1 58.434 NM OSC STRENGTH F=0.27608 DATA X21P/21.21802,21.23,21.25,21.3,21.4,21.5,21.6,21.7,21.8,21.9, /22.0,22.1,22.2,22.3,22.35,22.4,22.42,22.44,22.46,22.48, /22.5,22.55,22.57,22.59,22.6,22.61,22.62,22.63,22.64,22.65, /22.66,22.68,22.7,22.71,22.72,22.73,22.75,22.8,22.85,22.87, /22.88,22.9,22.91,22.94,22.96,22.97,22.98,22.99,23.0,23.01, /23.05,23.1,23.2,23.3,23.4,23.5,23.6,23.7,23.8,23.9, /24.0,24.2,24.4,24.6,24.8,25.0,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,33.0,34.0,35.0,36.0,37.0,38.0,39.0, /40.0,42.0,44.0,46.0,48.0,50.0,52.0,54.0,56.0,58.0, /60.0,64.0,68.0,72.0,76.0,80.0,85.0,90.0,95.0,100., /110.,120.,130.,140.,160.,180.,200.,240.,280.,320., /360.,400.,450.,500.,550.,600.,650.,700.,800.,900., /1000.,1100.,1200.,1300.,1400./ DATA Y21P/0.00,.0519,.0884,.163,.290,.397,.493,.582,.666,.748, /.831,.914,.994,1.06,1.09,1.10,1.10,1.36,1.46,1.35, /1.32,1.30,1.28,1.19,1.07,.943,.922,.941,.872,.751, /.737,.959,1.13,1.17,.920,1.03,1.12,1.23,1.35,1.27, /1.18,1.22,1.03,1.14,1.12,1.38,1.29,1.25,1.38,1.24, /1.12,1.13,1.11,1.12,1.16,1.30,1.41,1.44,1.41,1.37, /1.39,1.42,1.52,1.70,1.80,1.89,2.16,2.42,2.69,2.96, /3.24,3.53,3.82,4.12,4.42,4.71,5.00,5.29,5.57,5.85, /6.12,6.63,7.10,7.53,7.93,8.28,8.61,8.90,9.16,9.39, /9.60,9.95,10.2,10.4,10.6,10.7,10.7,10.8,10.8,10.7, /10.6,10.4,10.2,10.0,9.57,9.13,8.71,7.96,7.33,6.79, /6.32,5.92,5.50,5.13,4.82,4.54,4.30,4.08,3.72,3.41, /3.16,2.95,2.76,2.60,2.46/ C 3 3S J=1 DATA X33S/22.71847,22.72,22.73,22.74,22.75,22.78,22.8,22.83,22.85, /22.86, /22.87,22.88,22.89,22.9,22.91,22.912,22.914,22.916,22.92,22.94, /22.96,22.98,23.0,23.02,23.05,23.1,23.2,23.25,23.3,23.35, /23.4,23.44,23.48,23.52,23.57,23.59,23.62,23.65,23.7,23.75, /23.82,23.89,23.93,24.0,24.4,25.0,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,54.0,58.0,62.0,66.0,70.0,75.0,80.0,85.0, /90.0,95.0,100.,110.,120.,130.,140.,150.,160.,170., /180.,200.,220.,240.,260.,280.,300.,340.,380.,420., /460.,500.,550.,600.,650.,700.,750.,800.,850.,900., /950.,1000.,1100.,1200.,1300.,1400./ DATA Y33S/0.00,.800,1.15,1.03,.985,.854,.812,.752,.644,.503, /.277,1.79,1.17,1.06,1.32,1.51,1.57,1.37,.896,.848, /.907,.816,.838,.656,.872,.859,.890,.900,.860,.750, /.620,.810,.770,.960,.870,.870,.730,.710,.710,.730, /.770,.690,.760,.742,.725,.694,.665,.635,.605,.577, /.550,.524,.499,.452,.409,.370,.336,.305,.278,.253, /.231,.212,.178,.151,.130,.112,.0968,.0817,.0696,.0597, /.0516,.0449,.0393,.0306,.0242,.0195,.0160,.0132,.0111,.00938, /.00800,.00596,.00456,.00356,.00284,.00230,.00188,.00131,9.53D-4, /7.13D-4, /5.47D-4,4.29D-4,3.25D-4,2.52D-4,1.99D-4,1.60D-4,1.31D-4,1.08D-4, /9.02D-5,7.62D-5, /6.49D-5,5.58D-5,4.20D-5,3.25D-5,2.56D-5,2.06D-5/ C 3 1S J=0 DATA X31S/22.92032,22.96,22.985,23.02,23.05,23.07,23.1,23.15,23.2, /23.25, /23.3,23.33,23.36,23.39,23.41,23.45,23.48,23.51,23.54,23.56, /23.59,23.62,23.65,23.68,23.73,23.82,23.88,23.94,24.0,25.0, /26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,44.0,48.0, /52.0,56.0,60.0,65.0,70.0,75.0,80.0,90.0,100.,110., /120.,130.,140.,160.,180.,200.,220.,240.,260.,280., /300.,340.,380.,420.,460.,500.,550.,600.,650.,700., /750.,800.,900.,1000.,1100.,1200.,1300.,1400.,1500.,1600., /1800.,2000.,2400.,2800.,3200.,3600.,4000./ DATA Y31S/0.00,.535,.457,.587,.490,.490,.478,.491,.506,.512, /.501,.470,.418,.374,.351,.371,.520,.681,.520,.467, /.496,.410,.442,.429,.416,.455,.377,.444,.422,.426, /.428,.429,.425,.419,.412,.402,.396,.387,.370,.354, /.338,.324,.311,.296,.283,.271,.260,.242,.226,.213, /.203,.193,.185,.172,.161,.152,.144,.137,.131,.125, /.120,.111,.103,.0957,.0894,.0839,.0778,.0725,.0678,.0636, /.0599,.0566,.0509,.0462,.0423,.0389,.0361,.0336,.0315,.0296, /.0264,.0238,.0199,.0171,.0150,.0133,.0120/ C 3 3P J=2,1,0 DATA X33P/23.00707,23.02,23.03,23.04,23.05,23.06,23.07,23.08,23.1, /23.2, /23.3,23.4,23.5,23.55,23.6,23.65,23.7,23.8,23.9,24.0, /24.1,24.2,24.3,24.4,24.6,24.8,25.0,26.0,27.0,28.0, /30.0,32.0,34.0,36.0,38.0,40.0,44.0,48.0,52.0,56.0, /60.0,64.0,68.0,72.0,76.0,80.0,85.0,90.0,95.0,100., /110.,120.,130.,140.,150.,160.,170.,180.,200.,220., /240.,260.,280.,300.,340.,380.,420.,460.,500.,550., /600.,650.,700.,750.,800.,850.,900.,950.,1000.,1100., /1200.,1300.,1400.,1600.,1800.,2000.,2200.,2400.,2600.,2800., /3000./ DATA Y33P/0.00,.387,.410,.179,.148,.335,.381,.282,.280,.309, /.332,.359,.411,.416,.405,.448,.438,.467,.485,.493, /.500,.515,.517,.513,.503,.508,.512,.516,.515,.524, /.544,.539,.523,.500,.474,.446,.392,.342,.297,.259, /.226,.197,.173,.152,.134,.118,.102,.0878,.0762,.0665, /.0512,.0401,.0318,.0255,.0208,.0171,.0142,.0119,.00854,.00632, /.00479,.00371,.00292,.00234,.00157,.00109,7.93D-4,5.92D-4,4.53D-4, /3.34D-4, /2.53D-4,1.96D-4,1.55D-4,1.24D-4,1.01D-4,8.37D-5,6.99D-5,5.89D-5, /5.02D-5,3.72D-5, /2.83D-5,2.21D-5,1.75D-5,1.16D-5,8.05D-6,5.82D-6,4.34D-6,3.32D-6, /2.60D-6,2.07D-6, /1.68D-6/ C 3 3D J=3,2,1 DATA X33D/23.07365,23.1,23.15,23.2,23.25,23.3,23.35,23.4,23.45, /23.5, /23.55,23.6,23.66,23.7,23.75,23.8,23.85,23.9,23.95,24.0, /24.05,24.1,24.15,24.2,24.25,24.3,24.35,24.4,24.45,24.5, /24.55,24.6,24.65,24.7,24.8,24.9,25.0,26.0,27.0,28.0, /29.0,30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,52.0,54.0,56.0,58.0,60.0,64.0,68.0,72.0, /76.0,80.0,85.0,90.0,95.0,100.,110.,120.,130.,140., /150.,160.,180.,200.,220.,240.,260.,280.,300.,320., /340.,360.,380.,400.,440.,480.,520.,560.,600.,650., /700.,750.,800.,850.,900.,1000.,1100.,1200.,1300.,1400., /1600.,1800.,2000.,2200.,2400.,2600.,2800.,3000./ DATA Y33D/0.00,.00956,.0236,.0401,.0602,.0861,.120,.166,.222,.229, /.238,.197,.123,.118,.110,.112,.104,.110,.099,.0985, /.113,.107,.109,.114,.118,.119,.118,.116,.113,.105, /.112,.116,.118,.119,.120,.120,.119,.115,.118,.121, /.121,.120,.113,.105,.0958,.0867,.0780,.0701,.0628,.0563, /.0505,.0453,.0407,.0366,.0330,.0298,.0269,.0221,.0183,.0152, /.0127,.0107,.00868,.00712,.00588,.00490,.00347,.00252,.00188, /.00142, /.00110,8.64D-4,5.56D-4,3.76D-4,2.64D-4,1.92D-4,1.44D-4,1.10D-4, /8.60D-5,6.84D-5, /5.53D-5,4.53D-5,3.76D-5,3.15D-5,2.28D-5,1.70D-5,1.30D-5,1.02D-5, /8.12D-6,6.25D-6, /4.92D-6,3.94D-6,3.21D-6,2.64D-6,2.21D-6,1.58D-6,1.17D-6,8.95D-7, /6.98D-7,5.55D-7, /3.67D-7,2.56D-7,1.85D-7,1.38D-7,1.06D-7,8.32D-8,6.64D-8,5.38D-8/ C 3 1D J=2 DATA X31D/23.07407,23.08,23.1,23.15,23.2,23.25,23.3,23.35,23.4, /23.45, /23.5,23.55,23.6,23.66,23.7,23.75,23.8,23.85,23.9,23.95, /24.0,24.05,24.1,24.15,24.2,24.25,24.3,24.35,24.4,24.45, /24.5,24.6,24.7,24.8,25.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,54.0,58.0, /62.0,66.0,70.0,75.0,80.0,90.0,100.,110.,120.,140., /160.,180.,200.,220.,240.,260.,280.,300.,320.,340., /370.,400.,440.,480.,520.,560.,600.,650.,700.,800., /900.,1000.,1100.,1200.,1300.,1400.,1600.,1800.,2000.,2200., /2400.,2600.,2800.,3000./ DATA Y31D/0.00,.097,.0973,.110,.126,.148,.175,.200,.221,.237, /.235,.198,.185,.192,.168,.181,.189,.172,.193,.184, /.190,.209,.206,.211,.214,.215,.212,.206,.199,.191, /.174,.177,.179,.180,.181,.180,.180,.188,.198,.209, /.217,.224,.229,.232,.234,.235,.234,.233,.228,.222, /.215,.207,.199,.190,.180,.163,.148,.135,.124,.105, /.0913,.0803,.0715,.0643,.0584,.0534,.0492,.0456,.0424,.0397, /.0361,.0332,.0299,.0272,.0249,.0230,.0213,.0196,.0181,.0156, /.0138,.0124,.0112,.0102,.00938,.00868,.00756,.00669,.00600,.00544, /.00497,.00458,.00425,.00396/ C 3 1P RESONANCE RADIATION J=1 53.703 NM OSC STRENGTH F=0.07342 DATA X31P/23.08702,23.1,23.15,23.2,23.25,23.3,23.35,23.4,23.45, /23.5, /23.54,23.56,23.60,23.64,23.68,23.7,23.75,23.80,23.88,23.9, /23.95,24.0,24.05,24.1,24.15,24.2,24.3,24.4,24.5,24.6, /24.7,24.8,25.0,25.2,25.4,25.6,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,52.0,54.0,56.0,58.0,60.0,65.0,70.0,75.0, /80.0,85.0,90.0,95.0,100.,110.,120.,130.,140.,160., /180.,200.,220.,240.,260.,280.,300.,340.,380.,420., /460.,500.,550.,600.,650.,700.,750.,800.,900.,1000., /1100.,1200.,1300.,1400.,1600.,1800.,2000.,2200.,2400.,2600., /2800.,3000.,3400.,3800.,4200.,4600.,5000.,5500.,6000.,6500., /7000.,8000.,9000.,10000./ DATA Y31P/0.00,.114,.129,.137,.137,.134,.131,.130,.128,.129, /.117,.127,.122,.163,.146,.150,.191,.180,.226,.224, /.218,.230,.245,.253,.265,.274,.294,.308,.330,.360, /.373,.382,.397,.409,.418,.423,.434,.469,.516,.577, /.648,.723,.808,.941,1.07,1.20,1.32,1.43,1.54,1.64, /1.74,1.82,1.90,1.97,2.04,2.10,2.15,2.27,2.35,2.42, /2.47,2.50,2.52,2.53,2.53,2.52,2.50,2.47,2.42,2.33, /2.24,2.14,2.06,1.97,1.90,1.82,1.76,1.64,1.53,1.44, /1.36,1.29,1.21,1.15,1.08,1.03,.982,.938,.862,.799, /.745,.699,.658,.623,.563,.514,.474,.440,.411,.386, /.364,.344,.312,.285,.263,.244,.228,.211,.197,.184, /.173,.155,.140,.128/ C 4 3S J=1 DATA X43S/23.59396,23.62,23.65,23.7,23.8,23.9,24.0,25.0,26.0,27.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,52.0,54.0,56.0,58.0,60.0,64.0,68.0,72.0, /76.0,80.0,85.0,90.0,95.0,100.,110.,120.,130.,140., /150.,160.,180.,200.,220.,240.,260.,280.,300.,320., /340.,360.,380.,400.,440.,480.,520.,560.,600./ DATA Y43S/0.0,.314,.304,.292,.276,.266,.260,.243,.238,.234, /.227,.212,.195,.178,.162,.147,.133,.121,.110,.100, /.0911,.0832,.0761,.0697,.0640,.0589,.0543,.0464,.0399,.0346, /.0301,.0264,.0225,.0194,.0168,.0147,.0113,.00894,.00718,.00585, /.00483,.00403,.00289,.00214,.00164,.00127,.00101,8.17D-4,6.69D-4, /5.55D-4, /4.66D-4,3.94D-4,3.37D-4,2.90D-4,2.19D-4,1.70D-4,1.34D-4,1.08D-4, /8.81D-5/ C 4 1S J=0 DATA X41S/23.67357,23.7,23.8,23.9,24.0,25.0,26.0,27.0,28.0,29.0, /30.0,32.0,34.0,36.0,38.0,40.0,44.0,48.0,52.0,56.0, /60.0,65.0,70.0,75.0,80.0,90.0,100.,110.,120.,130., /140.,160.,180.,200.,250.,300.,350.,400.,450.,500., /600.,700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000., /2200.,2400.,2600.,2800.,3000./ DATA Y41S/0.0,.109,.110,.111,.112,.121,.128,.133,.138,.141, /.143,.146,.148,.147,.146,.144,.139,.134,.129,.123, /.118,.113,.108,.103,.0990,.0922,.0868,.0823,.0786,.0753, /.0725,.0677,.0636,.0601,.0527,.0469,.0422,.0382,.0349,.0322, /.0277,.0243,.0216,.0195,.0177,.0150,.0130,.0114,.0102,.00925, /.00845,.00777,.00719,.00669,.00626/ C 4 3P J=2,1,0 DATA X43P/23.70789,23.75,23.8,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0, /54.0,58.0,62.0,66.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,170.,180.,190., /200.,220.,240.,260.,280.,300.,320.,340.,360.,380., /400.,440.,480.,520.,560.,600.,650.,700.,750.,800., /850.,900.,950.,1000.,1100.,1200.,1300.,1400.,1600.,1800., /2000.,2200.,2400.,2600.,2800.,3000./ DATA Y43P/0.0,.085,.110,.118,.152,.177,.194,.205,.211,.215, /.215,.209,.200,.189,.178,.167,.156,.146,.136,.127, /.110,.0962,.0840,.0736,.0647,.0553,.0475,.0410,.0356,.0310, /.0271,.0210,.0165,.0132,.0106,.00865,.00713,.00593,.00498,.00421, /.00359,.00266,.00202,.00156,.00123,9.88D-4,8.03D-4,6.60D-4, /5.49D-4,4.61D-4, /3.90D-4,2.87D-4,2.17D-4,1.67D-4,1.32D-4,1.06D-4,8.18D-5,6.46D-5, /5.18D-5,4.22D-5, /3.48D-5,2.90D-5,2.45D-5,2.08D-5,1.54D-5,1.17D-5,9.13D-6,7.25D-6, /4.78D-6,3.32D-6, /2.39D-6,1.78D-6,1.36D-6,1.07D-6,8.50D-7,6.88D-7/ C 4 3D J=3,2,1 DATA X43D/23.73609,23.8,23.9,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0, /54.0,58.0,62.0,66.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,220., /240.,260.,280.,300.,340.,380.,420.,460.,500.,550., /600.,650.,700.,750.,800.,850.,900.,950.,1000.,1100., /1200.,1300.,1400.,1500.,1600./ DATA Y43D/.0,.0288,.0363,.0407,.0575,.0646,.0681,.0692,.069,.0675, /.0629,.0573,.0516,.0461,.0411,.0365,.0325,.0290,.0258,.0231, /.0186,.0151,.0123,.0102,.00847,.00681,.00554,.00455,.00378,.00316, /.00267,.00194,.00145,.00111,8.61D-4,6.81D-4,5.47D-4,3.66D-4, /2.55D-4,1.84D-4, /1.37D-4,1.04D-4,8.08D-5,6.39D-5,4.18D-5,2.87D-5,2.05D-5,1.51D-5, /1.14D-5,8.32D-6, /6.24D-6,4.79D-6,3.75D-6,3.00D-6,2.43D-6,1.99D-6,1.65D-6,1.39D-6, /1.18D-6,8.66D-7, /6.55D-7,5.08D-7,4.01D-7,3.22D-7,2.63D-7/ C 4 1D J=2 DATA X41D/23.73633,23.8,24.0,25.0,26.0,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,44.0,48.0,52.0,56.0,60.0,64.0, /68.0,72.0,76.0,80.0,85.0,90.0,95.0,100.,110.,120., /130.,140.,160.,180.,200.,220.,240.,260.,300.,340., /380.,420.,460.,500.,550.,600.,650.,700.,800.,900., /1000.,1100.,1200./ DATA Y41D/0.0,.0791,.0799,.0846,.0902,.0959,.102,.107,.112,.120, /.127,.131,.134,.136,.136,.134,.131,.126,.121,.116, /.112,.107,.102,.0978,.0927,.0880,.0836,.0796,.0724,.0663, /.0610,.0564,.0489,.0430,.0384,.0346,.0314,.0288,.0246,.0215, /.0190,.0171,.0155,.0142,.0128,.0117,.0107,.00990,.00860,.00760, /.00681,.00616,.00563/ C 4 3F J=3,4,2 DATA X43F/23.73701,23.8,23.9,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /31.0,32.0,33.0,34.0,35.0,36.0,37.0,38.0,39.0,40.0, /42.0,44.0,46.0,48.0,50.0,54.0,58.0,62.0,66.0,70.0, /75.0,80.0,85.0,90.0,95.0,100.,110.,120.,130.,140./ DATA Y43F/0.0,.0357,.0318,.0289,.0161,.0117,.00922,.00760,.00642, /.00550, /.00478,.00418,.00369,.00327,.00291,.00261,.00234,.00211,.00191, /.00173, /.00144,.00121,.00102,8.68D-4,7.44D-4,5.57D-4,4.25D-4,3.30D-4, /2.61D-4,2.09D-4, /1.61D-4,1.26D-4,9.98D-5,8.03D-5,6.53D-5,5.36D-5,3.72D-5,2.66D-5, /1.96D-5,1.47D-5/ C 4 1F J=3 DATA X41F/23.73701,23.8,24.0,25.0,26.0,27.0,28.0,29.0,30.0,31.0, /32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0, /54.0,58.0,62.0,66.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,220., /240.,260.,280.,300.,340.,380.,420.,460.,500.,550., /600.,650.,700.,750.,800.,900.,1000./ DATA Y41F/0.0,.0175,.0172,.0160,.0149,.0139,.0130,.0122,.0114, /.0108, /.0102,.00909,.00819,.00742,.00677,.00619,.00569,.00525,.00487, /.00452, /.00393,.00346,.00307,.00274,.00246,.00217,.00193,.00173,.00156, /.00142, /.00129,.00108,9.24D-4,7.99D-4,6.99D-4,6.17D-4,5.50D-4,4.47D-4, /3.73D-4,3.19D-4, /2.77D-4,2.45D-4,2.19D-4,1.99D-4,1.67D-4,1.45D-4,1.28D-4,1.15D-4, /1.04D-4,9.39D-5, /8.55D-5,7.86D-5,7.27D-5,6.78D-5,6.35D-5,5.63D-5,5.07D-5/ C 4 1P RESONANCE RADIATION J=1 52.222 NM OSC STRENGTH F=0.02986 DATA X41P/23.74207,23.8,23.9,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /31.0,32.0,33.0,34.0,35.0,36.0,37.0,38.0,39.0,40.0, /42.0,44.0,46.0,48.0,50.0,52.0,54.0,56.0,58.0,60.0, /64.0,68.0,72.0,76.0,80.0,85.0,90.0,95.0,100.,110., /120.,130.,140.,150.,160.,180.,200.,220.,240.,260., /280.,300.,320.,340.,360.,380.,400.,440.,480.,520., /560.,600.,640.,680.,720.,760.,800.,850.,900.,950., /1000.,1100.,1200.,1300.,1400.,1600.,1800.,2000.,2200.,2400., /2600.,2800.,3000.,3400.,3800.,4200.,4600.,5000.,5500.,6000., /6500.,7000.,7500.,8000.,9000.,10000./ DATA Y41P/0.00,.0147,.0242,.0334,.107,.158,.196,.227,.255,.281, /.307,.333,.360,.387,.414,.442,.470,.498,.526,.553, /.606,.657,.704,.748,.789,.826,.860,.891,.919,.944, /.986,1.02,1.05,1.06,1.08,1.09,1.10,1.10,1.10,1.09, /1.07,1.05,1.03,1.01,.985,.939,.896,.855,.817,.783, /.751,.722,.695,.670,.646,.625,.605,.569,.537,.509, /.484,.461,.441,.423,.406,.390,.376,.360,.345,.332, /.320,.298,.279,.263,.248,.224,.205,.189,.175,.163, /.153,.145,.137,.124,.113,.104,.0969,.0905,.0837,.0779, /.0729,.0686,.0648,.0614,.0556,.0510/ C 5 1P RESONANCE RADIATION J=1 51.562 NM F=0.01504 C 6 1P RESONANCE RADIATION J=1 51.210 NM F=0.00863 C 7 1P RESONANCE RADIATION J=1 51.000 NM F=0.00540 C 8 1P RESONANCE RADIATION J=1 50.865 NM F=0.00362 C 9 1P RESONANCE RADIATION J=1 50.772 NM F=0.00253 C 10 1P RESONANCE RADIATION J=1 50.706 NM F=0.00184 C 11 1P RESONANCE RADIATION J=1 50.657 NM F=0.00138 C 12 1P RESONANCE RADIATION J=1 50.620 NM F=0.00106 C SUM HIGHER 1P LEVELS RESONANCE RADIATION J=1 F=0.00440 C TOTAL SUM OSCILLATOR STRENGTH = 0.42326 C -------------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME='HE4 (ISOT) 2010' ELSE NAME='HE4 (ANIS) 2010' ENDIF C -------------------------------------------------------------------- C HELIUM 4 BEST KNOWN GAS USED AS STANDARD ACCURACY BETTER THAN 0.2% C AT ALL FIELDS. C 2002: UPDATED 1997 DATA TO INCLUDE ANISOTROPIC ELASTIC SCATTTERING C 2007: INCREASED DATA FILE UP TO 10 MEV C 2007: NEW ANISTROPIC SCATTERING FUNCTION INTRODUCED C 2007: PENNING FRACTION INTRODUCED C 2010: SPLIT EXCITATION INTO 49 LEVELS. C USED MAINLY THE FOLLOWING THEORETICAL EXCITATION X-SECTIONS: C AT RESONANCE ENERGIES USED RMPS CALCULATIONS OF C BARTSCHAT J.PHYS B31(1998)L469 C AT HIGHER ENERGIES USED RALCHENKO AT.DATA NUCL DATA TABLES 94(2008)603 C AT HIGHEST ENERGIES FOR RESONANCE DIPOLE TRANSITIONS USED BEF SCALING C -------------------------------------------------------------------- C C BORN-BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 API=DACOS(-1.0D0) A0=0.52917720859D-8 RY=13.60569193 BBCONST=16.0*API*A0*A0*RY*RY/EMASS2 C AM2=0.489 C=5.50 C NIN=49 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN 2 KIN(J)=NANISO NDATA=100 NION=90 N23S=139 N21S=128 N23P=128 N21P=125 N33S=106 N31S=87 N33P=91 N33D=108 N31D=94 N31P=114 N43S=59 N41S=55 N43P=76 N43D=65 N41D=53 N43F=40 N41F=57 N41P=96 E(1)=0.0 E(2)=2.0*EMASS/(4.00260*AMU) E(3)=24.58739 C ENTER EXCITATION X-SECTION AT 1.4MEV E(4)=0.5841D-19 C ENTER IONISING X-SECTION AT 1.4MEV E(5)=0.1271D-18 C ENTER EOBY FOR MINIMUM IONISING PARTICLE E(6)=10.5 C EOBY AT LOW ENERGY EOBY=15.8 IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) EIN(1)=19.81961 EIN(2)=20.61577 EIN(3)=20.96409 EIN(4)=21.21802 EIN(5)=22.71847 EIN(6)=22.92032 EIN(7)=23.00707 EIN(8)=23.07365 EIN(9)=23.07407 EIN(10)=23.08702 EIN(11)=23.59396 EIN(12)=23.67357 EIN(13)=23.70789 EIN(14)=23.73609 EIN(15)=23.73633 EIN(16)=23.73701 EIN(17)=23.73701 EIN(18)=23.74207 EIN(19)=23.97197 EIN(20)=24.01121 EIN(21)=24.02822 EIN(22)=24.04266 EIN(23)=24.04280 EIN(24)=24.04315 EIN(25)=24.04315 EIN(26)=24.04580 EIN(27)=24.16900 EIN(28)=24.19116 EIN(29)=24.20081 EIN(30)=24.20916 EIN(31)=24.20925 EIN(32)=24.21100 EIN(33)=24.28456 EIN(34)=24.29828 EIN(35)=24.30429 EIN(36)=24.30954 EIN(37)=24.30960 EIN(38)=24.31071 EIN(39)=24.35810 EIN(40)=24.36718 EIN(41)=24.37116 EIN(42)=24.37468 EIN(43)=24.37472 EIN(44)=24.37547 EIN(45)=24.41989 EIN(46)=24.45168 EIN(47)=24.47518 EIN(48)=24.49308 EIN(49)=24.50708 C*********************************************************************** C ENTER PENNING FRACTION FOR EACH LEVEL C PENNING FRACTION BETWEEN 0.9 AND 1.0 FOR ALL MIXTURES DO 50 NL=1,NIN PENFRA(1,NL)=1.00 C PENNING TRANSFER DISTANCE MICRONS PENFRA(2,NL)=1.0 C PENNING TRANSFER TIME PICOSECONDS 50 PENFRA(3,NL)=1.0 C HORNBECK MOLNAR MOD C IF PURE GAS SET TO : 0 FOR FIRST 6 LEVELS 0.25 FOR OTHER LEVELS C PENFRA(1,1)=0.0 C PENFRA(1,2)=0.0 C PENFRA(1,3)=0.0 C PENFRA(1,4)=0.0 C PENFRA(1,5)=0.0 C PENFRA(1,6)=0.0 C*********************************************************************** IF(IPEN.EQ.0) GO TO 4 DO 3 KDUM=1,NIN IF(PENFRA(1,KDUM).EQ.0.0) GO TO 3 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 3 CONTINUE 4 DO 5 NL=1,NIN 5 IOFFN(NL)=IFIX(SNGL(0.5+EIN(NL)/ESTEP)) SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC HELIUM 4 ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC ISOTROPIC HELIUM 4 ' ENDIF SCRPT(3)=' IONISATION ELOSS= 24.58739' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EX 23S J=1 M ELVL=19.81961' SCRPT(8)=' EX 21S J=0 M ELVL=20.61577' SCRPT(9)=' EX 23P J=2,1,0 ELVL=20.96409' SCRPT(10)=' EX 21P J=1 R ELVL=21.21802' SCRPT(11)=' EX 33S J=1 ELVL=22.71847' SCRPT(12)=' EX 31S J=0 ELVL=22.92032' SCRPT(13)=' EX 33P J=2,1,0 ELVL=23.00707' SCRPT(14)=' EX 33D J=3,2,1 ELVL=23.07365' SCRPT(15)=' EX 31D J=2 ELVL=23.07407' SCRPT(16)=' EX 31P J=1 R ELVL=23.08702' SCRPT(17)=' EX 43S J=1 ELVL=23.59396' SCRPT(18)=' EX 41S J=0 ELVL=23.67357' SCRPT(19)=' EX 43P J=2,1,0 ELVL=23.70789' SCRPT(20)=' EX 43D J=3,2,1 ELVL=23.73609' SCRPT(21)=' EX 41D J=2 ELVL=23.73633' SCRPT(22)=' EX 43F J=3,4,2 ELVL=23.73701' SCRPT(23)=' EX 41F J=3 ELVL=23.73701' SCRPT(24)=' EX 41P J=1 R ELVL=23.74207' SCRPT(25)=' EX 53S J=1 ELVL=23.97197' SCRPT(26)=' EX 51S J=0 ELVL=24.01121' SCRPT(27)=' EX 53P J=2,1,0 ELVL=24.02822' SCRPT(28)=' EX 53D J=3,2,1 ELVL=24.04266' SCRPT(29)=' EX 51D J=2 ELVL=24.04280' SCRPT(30)=' EX 53F J=3,4,2 ELVL=24.04315' SCRPT(31)=' EX 513 J=3 ELVL=24.04315' SCRPT(32)=' EX 51P J=1 R ELVL=24.04580' SCRPT(33)=' EX 63S J=1 ELVL=24.16900' SCRPT(34)=' EX 61S J=0 ELVL=24.19116' SCRPT(35)=' EX 63P J=2,1,0 ELVL=24.20081' SCRPT(36)=' EX 63D J=3,2,1 ELVL=24.20916' SCRPT(37)=' EX 61D J=2 ELVL=24.20925' SCRPT(38)=' EX 61P J=1 R ELVL=24.21100' SCRPT(39)=' EX 73S J=1 ELVL=24.28456' SCRPT(40)=' EX 71S J=0 ELVL=24.29828' SCRPT(41)=' EX 73P J=2,1,0 ELVL=24.30429' SCRPT(42)=' EX 73D J=3,2,1 ELVL=24.30954' SCRPT(43)=' EX 71D J=2 ELVL=24.30960' SCRPT(44)=' EX 71P J=1 R ELVL=24.31071' SCRPT(45)=' EX N3S SUM HIGH ELVL=24.35810' SCRPT(46)=' EX N1S SUM HIGH ELVL=24.36718' SCRPT(47)=' EX N3P SUM HIGH ELVL=24.37116' SCRPT(48)=' EX N3D SUM HIGH ELVL=24.37468' SCRPT(49)=' EX N1D SUM HIGH ELVL=24.37472' SCRPT(50)=' EX 81P J=1 R ELVL=24.37547' SCRPT(51)=' EX 91P J=1 R ELVL=24.41989' SCRPT(52)=' EX 101P J=1 R ELVL=24.45168' SCRPT(53)=' EX 111P J=1 R ELVL=24.47518' SCRPT(54)=' EX 121P J=1 R ELVL=24.49308' SCRPT(55)=' EX N1P SUM HI R ELVL=24.50708' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.EIN(1)) THEN GAMMA1=(EMASS2+2.0D0*EN)/EMASS2 GAMMA2=GAMMA1*GAMMA1 BETA=DSQRT(1.0D0-1.0D0/GAMMA2) BETA2=BETA*BETA ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YEL(J)-YEL(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEL(J)-XEN(J)*YEL(J-1))/(XEN(J-1)-XEN(J)) QELA=(A*EN+B)*1.0D-16 C A=(YEM(J)-YEM(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEM(J)-XEN(J)*YEM(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.0D-16 PQ1=0.5+(QELA-QMOM)/QELA C A=(YEPS(J)-YEPS(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEPS(J)-XEN(J)*YEPS(J-1))/(XEN(J-1)-XEN(J)) PQ2=A*EN+B C IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) THEN Q(2,I)=QMOM PEQEL(2,I)=0.5 ENDIF C GROSS IONISATION Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 200 IF(EN.GT.XION(NION)) GO TO 121 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 GO TO 122 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 121 AX2=1.0D0/BETA2 AX1=AX2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*AX1+C*AX2)/0.995 122 CONTINUE 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 ATTACHMENT 200 Q(4,I)=0.0D0 C COUNTING IONISATION Q(5,I)=0.0D0 PEQEL(5,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(5,I)=0.0D0 IF(EN.LE.E(3)) GO TO 250 IF(EN.GT.XION(NION)) GO TO 241 DO 230 J=2,NION IF(EN.LE.XION(J)) GO TO 240 230 CONTINUE J=NION 240 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.0D-16 GO TO 242 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 241 Q(5,I)=CONST*(AM2*AX1+C*AX2) 242 CONTINUE IF(EN.LE.(2.0D0*E(3))) GO TO 250 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 250 Q(6,I)=0.0D0 C DO 251 NL=1,NIN QIN(NL,I)=0.0D0 PEQIN(NL,I)=0.5D0 IF(NANISO.EQ.2) THEN PEQIN(NL,I)=0.0D0 ENDIF 251 CONTINUE C C 2 3S IF(EN.LE.EIN(1)) GO TO 2000 IF(EN.GT.X23S(N23S)) GO TO 311 DO 300 J=2,N23S IF(EN.LE.X23S(J)) GO TO 310 300 CONTINUE J=N23S 310 A=(Y23S(J)-Y23S(J-1))/(X23S(J)-X23S(J-1)) B=(X23S(J-1)*Y23S(J)-X23S(J)*Y23S(J-1))/(X23S(J-1)-X23S(J)) QIN(1,I)=(A*EN+B)*1.D-18 GO TO 312 C IF ENERGY GT X23S(N23S) EV SCALE BY 1/E**3 311 QIN(1,I)=Y23S(N23S)*(X23S(N23S)/EN)**3*1.D-18 312 IF(EN.LE.(2.0*EIN(1))) GO TO 320 PEQIN(1,I)=PEQEL(2,(I-IOFFN(1))) C C 2 1S 320 IF(EN.LE.EIN(2)) GO TO 2000 IF(EN.GT.X21S(N21S)) GO TO 341 DO 330 J=2,N21S IF(EN.LE.X21S(J)) GO TO 340 330 CONTINUE J=N21S 340 A=(Y21S(J)-Y21S(J-1))/(X21S(J)-X21S(J-1)) B=(X21S(J-1)*Y21S(J)-X21S(J)*Y21S(J-1))/(X21S(J-1)-X21S(J)) QIN(2,I)=(A*EN+B)*1.D-18 GO TO 342 C IF ENERGY GT X21S(N21S) EV SCALE BY 1/E 341 QIN(2,I)=Y21S(N21S)*(X21S(N21S)/EN)*1.D-18 342 IF(EN.LE.(2.0*EIN(2))) GO TO 350 PEQIN(2,I)=PEQEL(2,(I-IOFFN(2))) C C 2 3P 350 IF(EN.LE.EIN(3)) GO TO 2000 IF(EN.GT.X23P(N23P)) GO TO 371 DO 360 J=2,N23P IF(EN.LE.X23P(J)) GO TO 370 360 CONTINUE J=N23P 370 A=(Y23P(J)-Y23P(J-1))/(X23P(J)-X23P(J-1)) B=(X23P(J-1)*Y23P(J)-X23P(J)*Y23P(J-1))/(X23P(J-1)-X23P(J)) QIN(3,I)=(A*EN+B)*1.D-18 GO TO 372 C IF ENERGY GT X23P(N23P) EV SCALE BY 1/E**3 371 QIN(3,I)=Y23P(N23P)*(X23P(N23P)/EN)**3*1.D-18 372 IF(EN.LE.(2.0*EIN(3))) GO TO 380 PEQIN(3,I)=PEQEL(2,(I-IOFFN(3))) C C 2 1P OSC STRENGTH F=0.27608 380 IF(EN.LE.EIN(4)) GO TO 2000 IF(EN.GT.X21P(N21P)) GO TO 401 DO 390 J=2,N21P IF(EN.LE.X21P(J)) GO TO 400 390 CONTINUE J=N21P 400 A=(Y21P(J)-Y21P(J-1))/(X21P(J)-X21P(J-1)) B=(X21P(J-1)*Y21P(J)-X21P(J)*Y21P(J-1))/(X21P(J-1)-X21P(J)) QIN(4,I)=(A*EN+B)*1.D-18 GO TO 402 C IF ENERGY GT X21P(N21P) EV THEN USE BEF SCALING 401 QIN(4,I)=0.27608/(EIN(4)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(4)))-BETA2)*BBCONST*EN/(EN+EIN(4)+E(3)) 402 IF(EN.LE.(2.0*EIN(4))) GO TO 410 PEQIN(4,I)=PEQEL(2,(I-IOFFN(4))) C C 3 3S 410 IF(EN.LE.EIN(5)) GO TO 2000 IF(EN.GT.X33S(N33S)) GO TO 431 DO 420 J=2,N33S IF(EN.LE.X33S(J)) GO TO 430 420 CONTINUE J=N33S 430 A=(Y33S(J)-Y33S(J-1))/(X33S(J)-X33S(J-1)) B=(X33S(J-1)*Y33S(J)-X33S(J)*Y33S(J-1))/(X33S(J-1)-X33S(J)) QIN(5,I)=(A*EN+B)*1.D-18 GO TO 432 C IF ENERGY GT X33S(N33S) EV SCALE BY 1/E**3 431 QIN(5,I)=Y33S(N33S)*(X33S(N33S)/EN)**3*1.D-18 432 IF(EN.LE.(2.0*EIN(5))) GO TO 440 PEQIN(5,I)=PEQEL(2,(I-IOFFN(5))) C C 3 1S 440 IF(EN.LE.EIN(6)) GO TO 2000 IF(EN.GT.X31S(N31S)) GO TO 461 DO 450 J=2,N31S IF(EN.LE.X31S(J)) GO TO 460 450 CONTINUE J=N31S 460 A=(Y31S(J)-Y31S(J-1))/(X31S(J)-X31S(J-1)) B=(X31S(J-1)*Y31S(J)-X31S(J)*Y31S(J-1))/(X31S(J-1)-X31S(J)) QIN(6,I)=(A*EN+B)*1.D-18 GO TO 462 C IF ENERGY GT X31S(N31S) EV SCALE BY 1/E 461 QIN(6,I)=Y31S(N31S)*(X31S(N31S)/EN)*1.D-18 462 IF(EN.LE.(2.0*EIN(6))) GO TO 470 PEQIN(6,I)=PEQEL(2,(I-IOFFN(6))) C C 3 3P 470 IF(EN.LE.EIN(7)) GO TO 2000 IF(EN.GT.X33P(N33P)) GO TO 491 DO 480 J=2,N33P IF(EN.LE.X33P(J)) GO TO 490 480 CONTINUE J=N33P 490 A=(Y33P(J)-Y33P(J-1))/(X33P(J)-X33P(J-1)) B=(X33P(J-1)*Y33P(J)-X33P(J)*Y33P(J-1))/(X33P(J-1)-X33P(J)) QIN(7,I)=(A*EN+B)*1.D-18 GO TO 492 C IF ENERGY GT X33P(N33P) EV SCALE BY 1/E**3 491 QIN(7,I)=Y33P(N33P)*(X33P(N33P)/EN)*1.D-18 492 IF(EN.LE.(2.0*EIN(7))) GO TO 500 PEQIN(7,I)=PEQEL(2,(I-IOFFN(7))) C C 3 3D 500 IF(EN.LE.EIN(8)) GO TO 2000 IF(EN.GT.X33D(N33D)) GO TO 521 DO 510 J=2,N33D IF(EN.LE.X33D(J)) GO TO 520 510 CONTINUE J=N33D 520 A=(Y33D(J)-Y33D(J-1))/(X33D(J)-X33D(J-1)) B=(X33D(J-1)*Y33D(J)-X33D(J)*Y33D(J-1))/(X33D(J-1)-X33D(J)) QIN(8,I)=(A*EN+B)*1.D-18 GO TO 522 C IF ENERGY GT X33D(N33D) EV SCALE BY 1/E**3 521 QIN(8,I)=Y33D(N33D)*(X33D(N33D)/EN)*1.D-18 522 IF(EN.LE.(2.0*EIN(8))) GO TO 530 PEQIN(8,I)=PEQEL(2,(I-IOFFN(8))) C C 3 1D 530 IF(EN.LE.EIN(9)) GO TO 2000 IF(EN.GT.X31D(N31D)) GO TO 551 DO 540 J=2,N31D IF(EN.LE.X31D(J)) GO TO 550 540 CONTINUE J=N31D 550 A=(Y31D(J)-Y31D(J-1))/(X31D(J)-X31D(J-1)) B=(X31D(J-1)*Y31D(J)-X31D(J)*Y31D(J-1))/(X31D(J-1)-X31D(J)) QIN(9,I)=(A*EN+B)*1.D-18 GO TO 552 C IF ENERGY GT X31D(N31D) EV SCALE BY 1/E 551 QIN(9,I)=Y31D(N31D)*(X31D(N31D)/EN)*1.D-18 552 IF(EN.LE.(2.0*EIN(9))) GO TO 560 PEQIN(9,I)=PEQEL(2,(I-IOFFN(9))) C C 3 1P OSC STRENGTH F=0.07342 560 IF(EN.LE.EIN(10)) GO TO 2000 IF(EN.GT.X31P(N31P)) GO TO 581 DO 570 J=2,N31P IF(EN.LE.X31P(J)) GO TO 580 570 CONTINUE J=N31P 580 A=(Y31P(J)-Y31P(J-1))/(X31P(J)-X31P(J-1)) B=(X31P(J-1)*Y31P(J)-X31P(J)*Y31P(J-1))/(X31P(J-1)-X31P(J)) QIN(10,I)=(A*EN+B)*1.D-18 GO TO 582 C IF ENERGY GT X31P(N31P) EV THEN USE BEF SCALING 581 QIN(10,I)=0.07342/(EIN(10)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(10)))-BETA2)*BBCONST*EN/(EN+EIN(10)+E(3)) 582 IF(EN.LE.(2.0*EIN(10))) GO TO 590 PEQIN(10,I)=PEQEL(2,(I-IOFFN(10))) C C 4 3S 590 IF(EN.LE.EIN(11)) GO TO 2000 IF(EN.GT.X43S(N43S)) GO TO 611 DO 600 J=2,N43S IF(EN.LE.X43S(J)) GO TO 610 600 CONTINUE J=N43S 610 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(11,I)=(A*EN+B)*1.D-18 GO TO 612 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 611 QIN(11,I)=Y43S(N43S)*(X43S(N43S)/EN)**3*1.D-18 612 IF(EN.LE.(2.0*EIN(11))) GO TO 620 PEQIN(11,I)=PEQEL(2,(I-IOFFN(11))) C C 4 1S 620 IF(EN.LE.EIN(12)) GO TO 2000 IF(EN.GT.X41S(N41S)) GO TO 641 DO 630 J=2,N41S IF(EN.LE.X41S(J)) GO TO 640 630 CONTINUE J=N41S 640 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(12,I)=(A*EN+B)*1.D-18 GO TO 642 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 641 QIN(12,I)=Y41S(N41S)*(X41S(N41S)/EN)*1.D-18 642 IF(EN.LE.(2.0*EIN(12))) GO TO 650 PEQIN(12,I)=PEQEL(2,(I-IOFFN(12))) C C 4 3P 650 IF(EN.LE.EIN(13)) GO TO 2000 IF(EN.GT.X43P(N43P)) GO TO 671 DO 660 J=2,N43P IF(EN.LE.X43P(J)) GO TO 670 660 CONTINUE J=N43P 670 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(13,I)=(A*EN+B)*1.D-18 GO TO 672 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 671 QIN(13,I)=Y43P(N43P)*(X43P(N43P)/EN)**3*1.D-18 672 IF(EN.LE.(2.0*EIN(13))) GO TO 680 PEQIN(13,I)=PEQEL(2,(I-IOFFN(13))) C C 4 3D 680 IF(EN.LE.EIN(14)) GO TO 2000 IF(EN.GT.X43D(N43D)) GO TO 701 DO 690 J=2,N43D IF(EN.LE.X43D(J)) GO TO 700 690 CONTINUE J=N43P 700 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(14,I)=(A*EN+B)*1.D-18 GO TO 702 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 701 QIN(14,I)=Y43D(N43D)*(X43D(N43D)/EN)**3*1.D-18 702 IF(EN.LE.(2.0*EIN(14))) GO TO 710 PEQIN(14,I)=PEQEL(2,(I-IOFFN(14))) C C 4 1D 710 IF(EN.LE.EIN(15)) GO TO 2000 IF(EN.GT.X41D(N41D)) GO TO 731 DO 720 J=2,N41D IF(EN.LE.X41D(J)) GO TO 730 720 CONTINUE J=N41D 730 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(15,I)=(A*EN+B)*1.D-18 GO TO 732 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 731 QIN(15,I)=Y41D(N41D)*(X41D(N41D)/EN)*1.D-18 732 IF(EN.LE.(2.0*EIN(15))) GO TO 740 PEQIN(15,I)=PEQEL(2,(I-IOFFN(15))) C C 4 3F 740 IF(EN.LE.EIN(16)) GO TO 2000 IF(EN.GT.X43F(N43F)) GO TO 761 DO 750 J=2,N43F IF(EN.LE.X43F(J)) GO TO 760 750 CONTINUE J=N43F 760 A=(Y43F(J)-Y43F(J-1))/(X43F(J)-X43F(J-1)) B=(X43F(J-1)*Y43F(J)-X43F(J)*Y43F(J-1))/(X43F(J-1)-X43F(J)) QIN(16,I)=(A*EN+B)*1.D-18 GO TO 762 C IF ENERGY GT X43F(N43F) EV SCALE BY 1/E**4 761 QIN(16,I)=Y43F(N43F)*(X43F(N43F)/EN)**4*1.D-18 762 IF(EN.LE.(2.0*EIN(16))) GO TO 770 PEQIN(16,I)=PEQEL(2,(I-IOFFN(16))) C C 4 1F 770 IF(EN.LE.EIN(17)) GO TO 2000 IF(EN.GT.X41F(N41F)) GO TO 791 DO 780 J=2,N41F IF(EN.LE.X41F(J)) GO TO 790 780 CONTINUE J=N41F 790 A=(Y41F(J)-Y41F(J-1))/(X41F(J)-X41F(J-1)) B=(X41F(J-1)*Y41F(J)-X41F(J)*Y41F(J-1))/(X41F(J-1)-X41F(J)) QIN(17,I)=(A*EN+B)*1.D-18 GO TO 792 C IF ENERGY GT X41F(N41F) EV SCALE BY 1/E 791 QIN(17,I)=Y41F(N41F)*(X41F(N41F)/EN)*1.D-18 792 IF(EN.LE.(2.0*EIN(17))) GO TO 800 PEQIN(17,I)=PEQEL(2,(I-IOFFN(17))) C C 4 1P OSC STRENGTH F=0.02986 800 IF(EN.LE.EIN(18)) GO TO 2000 IF(EN.GT.X41P(N41P)) GO TO 821 DO 810 J=2,N41P IF(EN.LE.X41P(J)) GO TO 820 810 CONTINUE J=N41P 820 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(18,I)=(A*EN+B)*1.D-18 GO TO 822 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 821 QIN(18,I)=0.02986/(EIN(18)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(18)))-BETA2)*BBCONST*EN/(EN+EIN(18)+E(3)) 822 IF(EN.LE.(2.0*EIN(18))) GO TO 830 PEQIN(18,I)=PEQEL(2,(I-IOFFN(18))) C C 5 3S SCALED FROM 4 3S 830 IF(EN.LE.EIN(19)) GO TO 2000 ER=EIN(19)/EIN(11) ENP=EN/ER IF(ENP.GT.X43S(N43S)) GO TO 851 DO 840 J=2,N43S IF(ENP.LE.X43S(J)) GO TO 850 840 CONTINUE J=N43S 850 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(19,I)=0.512*(A*ENP+B)*1.D-18 GO TO 852 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 851 QIN(19,I)=0.512*Y43S(N43S)*(X43S(N43S)/ENP)**3*1.D-18 852 IF(EN.LE.(2.0*EIN(19))) GO TO 860 PEQIN(19,I)=PEQEL(2,(I-IOFFN(19))) C C 5 1S SCALED FROM 4 1S 860 IF(EN.LE.EIN(20)) GO TO 2000 ER=EIN(20)/EIN(12) ENP=EN/ER IF(ENP.GT.X41S(N41S)) GO TO 881 DO 870 J=2,N41S IF(ENP.LE.X41S(J)) GO TO 880 870 CONTINUE J=N41S 880 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(20,I)=0.512*(A*ENP+B)*1.D-18 GO TO 882 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 881 QIN(20,I)=0.512*Y41S(N41S)*(X41S(N41S)/ENP)*1.D-18 882 IF(EN.LE.(2.0*EIN(20))) GO TO 890 PEQIN(20,I)=PEQEL(2,(I-IOFFN(20))) C C 5 3P SCALED FROM 4 3P 890 IF(EN.LE.EIN(21)) GO TO 2000 ER=EIN(21)/EIN(13) ENP=EN/ER IF(ENP.GT.X43P(N43P)) GO TO 911 DO 900 J=2,N43P IF(ENP.LE.X43P(J)) GO TO 910 900 CONTINUE J=N43P 910 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(21,I)=0.512*(A*ENP+B)*1.D-18 GO TO 912 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 911 QIN(21,I)=0.512*Y43P(N43P)*(X43P(N43P)/ENP)**3*1.D-18 912 IF(EN.LE.(2.0*EIN(21))) GO TO 920 PEQIN(21,I)=PEQEL(2,(I-IOFFN(21))) C C 5 3D SCALED FROM 4 3D 920 IF(EN.LE.EIN(22)) GO TO 2000 ER=EIN(22)/EIN(14) ENP=EN/ER IF(ENP.GT.X43D(N43D)) GO TO 941 DO 930 J=2,N43D IF(ENP.LE.X43D(J)) GO TO 940 930 CONTINUE J=N43P 940 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(22,I)=0.512*(A*ENP+B)*1.D-18 GO TO 942 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 941 QIN(22,I)=0.512*Y43D(N43D)*(X43D(N43D)/ENP)**3*1.D-18 942 IF(EN.LE.(2.0*EIN(22))) GO TO 950 PEQIN(22,I)=PEQEL(2,(I-IOFFN(22))) C C 5 1D SCALED FROM 4 1D 950 IF(EN.LE.EIN(23)) GO TO 2000 ER=EIN(23)/EIN(15) ENP=EN/ER IF(ENP.GT.X41D(N41D)) GO TO 971 DO 960 J=2,N41D IF(ENP.LE.X41D(J)) GO TO 970 960 CONTINUE J=N41D 970 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(23,I)=0.512*(A*ENP+B)*1.D-18 GO TO 972 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 971 QIN(23,I)=0.512*Y41D(N41D)*(X41D(N41D)/ENP)*1.D-18 972 IF(EN.LE.(2.0*EIN(23))) GO TO 980 PEQIN(23,I)=PEQEL(2,(I-IOFFN(23))) C C 5 3F SCALED FROM 4 3F 980 IF(EN.LE.EIN(24)) GO TO 2000 ER=EIN(24)/EIN(16) ENP=EN/ER IF(ENP.GT.X43F(N43F)) GO TO 1001 DO 990 J=2,N43F IF(ENP.LE.X43F(J)) GO TO 1000 990 CONTINUE J=N43F 1000 A=(Y43F(J)-Y43F(J-1))/(X43F(J)-X43F(J-1)) B=(X43F(J-1)*Y43F(J)-X43F(J)*Y43F(J-1))/(X43F(J-1)-X43F(J)) QIN(24,I)=0.512*(A*ENP+B)*1.D-18 GO TO 1002 C IF ENERGY GT X43F(N43F) EV SCALE BY 1/E**4 1001 QIN(24,I)=0.512*Y43F(N43F)*(X43F(N43F)/ENP)**4*1.D-18 1002 IF(EN.LE.(2.0*EIN(24))) GO TO 1010 PEQIN(24,I)=PEQEL(2,(I-IOFFN(24))) C C 5 1F SCALED FROM 4 1F 1010 IF(EN.LE.EIN(25)) GO TO 2000 ER=EIN(25)/EIN(17) ENP=EN/ER IF(ENP.GT.X41F(N41F)) GO TO 1031 DO 1020 J=2,N41F IF(ENP.LE.X41F(J)) GO TO 1030 1020 CONTINUE J=N41F 1030 A=(Y41F(J)-Y41F(J-1))/(X41F(J)-X41F(J-1)) B=(X41F(J-1)*Y41F(J)-X41F(J)*Y41F(J-1))/(X41F(J-1)-X41F(J)) QIN(25,I)=0.512*(A*ENP+B)*1.D-18 GO TO 1032 C IF ENERGY GT X41F(N41F) EV SCALE BY 1/E 1031 QIN(25,I)=0.512*Y41F(N41F)*(X41F(N41F)/ENP)*1.D-18 1032 IF(EN.LE.(2.0*EIN(25))) GO TO 1040 PEQIN(25,I)=PEQEL(2,(I-IOFFN(25))) C C 5 1P SCALED FROM 4 1P OSC STRENGTH F=0.01504 1040 IF(EN.LE.EIN(26)) GO TO 2000 ER=EIN(26)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1061 DO 1050 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1060 1050 CONTINUE J=N41P 1060 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(26,I)=0.01504/0.02986*(A*ENP+B)*1.D-18 GO TO 1062 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1061 QIN(26,I)=0.01504/(EIN(26)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(26)))-BETA2)*BBCONST*EN/(EN+EIN(26)+E(3)) 1062 IF(EN.LE.(2.0*EIN(26))) GO TO 1070 PEQIN(26,I)=PEQEL(2,(I-IOFFN(26))) C C 6 3S SCALED FROM 4 3S 1070 IF(EN.LE.EIN(27)) GO TO 2000 ER=EIN(27)/EIN(11) ENP=EN/ER IF(ENP.GT.X43S(N43S)) GO TO 1091 DO 1080 J=2,N43S IF(ENP.LE.X43S(J)) GO TO 1090 1080 CONTINUE J=N43S 1090 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(27,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1092 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 1091 QIN(27,I)=0.296*Y43S(N43S)*(X43S(N43S)/ENP)**3*1.D-18 1092 IF(EN.LE.(2.0*EIN(27))) GO TO 1100 PEQIN(27,I)=PEQEL(2,(I-IOFFN(27))) C C 6 1S SCALED FROM 4 1S 1100 IF(EN.LE.EIN(28)) GO TO 2000 ER=EIN(28)/EIN(12) ENP=EN/ER IF(ENP.GT.X41S(N41S)) GO TO 1121 DO 1110 J=2,N41S IF(ENP.LE.X41S(J)) GO TO 1120 1110 CONTINUE J=N41S 1120 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(28,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1122 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 1121 QIN(28,I)=0.296*Y41S(N41S)*(X41S(N41S)/ENP)*1.D-18 1122 IF(EN.LE.(2.0*EIN(28))) GO TO 1130 PEQIN(28,I)=PEQEL(2,(I-IOFFN(28))) C C 6 3P SCALED FROM 4 3P 1130 IF(EN.LE.EIN(29)) GO TO 2000 ER=EIN(29)/EIN(13) ENP=EN/ER IF(ENP.GT.X43P(N43P)) GO TO 1151 DO 1140 J=2,N43P IF(ENP.LE.X43P(J)) GO TO 1150 1140 CONTINUE J=N43P 1150 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(29,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1152 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 1151 QIN(29,I)=0.296*Y43P(N43P)*(X43P(N43P)/ENP)**3*1.D-18 1152 IF(EN.LE.(2.0*EIN(29))) GO TO 1160 PEQIN(29,I)=PEQEL(2,(I-IOFFN(29))) C C 6 3D SCALED FROM 4 3D 1160 IF(EN.LE.EIN(30)) GO TO 2000 ER=EIN(30)/EIN(14) ENP=EN/ER IF(ENP.GT.X43D(N43D)) GO TO 1181 DO 1170 J=2,N43D IF(ENP.LE.X43D(J)) GO TO 1180 1170 CONTINUE J=N43P 1180 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(30,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1182 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 1181 QIN(30,I)=0.296*Y43D(N43D)*(X43D(N43D)/ENP)**3*1.D-18 1182 IF(EN.LE.(2.0*EIN(30))) GO TO 1190 PEQIN(30,I)=PEQEL(2,(I-IOFFN(30))) C C 6 1D SCALED FROM 4 1D 1190 IF(EN.LE.EIN(31)) GO TO 2000 ER=EIN(31)/EIN(15) ENP=EN/ER IF(ENP.GT.X41D(N41D)) GO TO 1211 DO 1200 J=2,N41D IF(ENP.LE.X41D(J)) GO TO 1210 1200 CONTINUE J=N41D 1210 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(31,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1212 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 1211 QIN(31,I)=0.296*Y41D(N41D)*(X41D(N41D)/ENP)*1.D-18 1212 IF(EN.LE.(2.0*EIN(31))) GO TO 1220 PEQIN(31,I)=PEQEL(2,(I-IOFFN(31))) C C 6 1P SCALED FROM 4 1P OSC STRENGTH F=0.00863 1220 IF(EN.LE.EIN(32)) GO TO 2000 ER=EIN(32)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1241 DO 1230 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1240 1230 CONTINUE J=N41P 1240 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(32,I)=0.00863/0.02986*(A*ENP+B)*1.D-18 GO TO 1242 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1241 QIN(32,I)=0.00863/(EIN(32)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(32)))-BETA2)*BBCONST*EN/(EN+EIN(32)+E(3)) 1242 IF(EN.LE.(2.0*EIN(32))) GO TO 1250 PEQIN(32,I)=PEQEL(2,(I-IOFFN(32))) C C 7 3S SCALED FROM 4 3S 1250 IF(EN.LE.EIN(33)) GO TO 2000 ER=EIN(33)/EIN(11) ENP=EN/ER IF(ENP.GT.X43S(N43S)) GO TO 1271 DO 1260 J=2,N43S IF(ENP.LE.X43S(J)) GO TO 1270 1260 CONTINUE J=N43S 1270 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(33,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1272 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 1271 QIN(33,I)=0.187*Y43S(N43S)*(X43S(N43S)/ENP)**3*1.D-18 1272 IF(EN.LE.(2.0*EIN(33))) GO TO 1280 PEQIN(33,I)=PEQEL(2,(I-IOFFN(33))) C C 7 1S SCALED FROM 4 1S 1280 IF(EN.LE.EIN(34)) GO TO 2000 ER=EIN(34)/EIN(12) ENP=EN/ER IF(ENP.GT.X41S(N41S)) GO TO 1301 DO 1290 J=2,N41S IF(ENP.LE.X41S(J)) GO TO 1300 1290 CONTINUE J=N41S 1300 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(34,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1302 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 1301 QIN(34,I)=0.187*Y41S(N41S)*(X41S(N41S)/ENP)*1.D-18 1302 IF(EN.LE.(2.0*EIN(34))) GO TO 1310 PEQIN(34,I)=PEQEL(2,(I-IOFFN(34))) C C 7 3P SCALED FROM 4 3P 1310 IF(EN.LE.EIN(35)) GO TO 2000 ER=EIN(35)/EIN(13) ENP=EN/ER IF(ENP.GT.X43P(N43P)) GO TO 1331 DO 1320 J=2,N43P IF(ENP.LE.X43P(J)) GO TO 1330 1320 CONTINUE J=N43P 1330 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(35,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1332 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 1331 QIN(35,I)=0.187*Y43P(N43P)*(X43P(N43P)/ENP)**3*1.D-18 1332 IF(EN.LE.(2.0*EIN(35))) GO TO 1340 PEQIN(35,I)=PEQEL(2,(I-IOFFN(35))) C C 7 3D SCALED FROM 4 3D 1340 IF(EN.LE.EIN(36)) GO TO 2000 ER=EIN(36)/EIN(14) ENP=EN/ER IF(ENP.GT.X43D(N43D)) GO TO 1361 DO 1350 J=2,N43D IF(ENP.LE.X43D(J)) GO TO 1360 1350 CONTINUE J=N43P 1360 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(36,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1362 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 1361 QIN(36,I)=0.187*Y43D(N43D)*(X43D(N43D)/ENP)**3*1.D-18 1362 IF(EN.LE.(2.0*EIN(36))) GO TO 1370 PEQIN(36,I)=PEQEL(2,(I-IOFFN(36))) C C 7 1D SCALED FROM 4 1D 1370 IF(EN.LE.EIN(37)) GO TO 2000 ER=EIN(37)/EIN(15) ENP=EN/ER IF(ENP.GT.X41D(N41D)) GO TO 1391 DO 1380 J=2,N41D IF(ENP.LE.X41D(J)) GO TO 1390 1380 CONTINUE J=N41D 1390 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(37,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1392 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 1391 QIN(37,I)=0.187*Y41D(N41D)*(X41D(N41D)/ENP)*1.D-18 1392 IF(EN.LE.(2.0*EIN(37))) GO TO 1400 PEQIN(37,I)=PEQEL(2,(I-IOFFN(37))) C C 7 1P SCALED FROM 4 1P OSC STRENGTH F=0.00540 1400 IF(EN.LE.EIN(38)) GO TO 2000 ER=EIN(38)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1421 DO 1410 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1420 1410 CONTINUE J=N41P 1420 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(38,I)=0.00540/0.02986*(A*ENP+B)*1.D-18 GO TO 1422 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1421 QIN(38,I)=0.00540/(EIN(38)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(38)))-BETA2)*BBCONST*EN/(EN+EIN(38)+E(3)) 1422 IF(EN.LE.(2.0*EIN(38))) GO TO 1430 PEQIN(38,I)=PEQEL(2,(I-IOFFN(38))) C C SUM 3S LEVELS FROM 8 3S HIGHER AND SCALED FROM 4 3S 1430 IF(EN.LE.EIN(39)) GO TO 2000 ER=EIN(39)/EIN(11) ENP=EN/ER IF(ENP.GT.X43S(N43S)) GO TO 1451 DO 1440 J=2,N43S IF(ENP.LE.X43S(J)) GO TO 1450 1440 CONTINUE J=N43S 1450 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(39,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1452 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 1451 QIN(39,I)=0.553*Y43S(N43S)*(X43S(N43S)/ENP)**3*1.D-18 1452 IF(EN.LE.(2.0*EIN(39))) GO TO 1460 PEQIN(39,I)=PEQEL(2,(I-IOFFN(39))) C C SUM 1S LEVELS FROM 8 1S HIGHER AND SCALED FROM 4 1S 1460 IF(EN.LE.EIN(40)) GO TO 2000 ER=EIN(40)/EIN(12) ENP=EN/ER IF(ENP.GT.X41S(N41S)) GO TO 1481 DO 1470 J=2,N41S IF(ENP.LE.X41S(J)) GO TO 1480 1470 CONTINUE J=N41S 1480 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(40,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1482 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 1481 QIN(40,I)=0.553*Y41S(N41S)*(X41S(N41S)/ENP)*1.D-18 1482 IF(EN.LE.(2.0*EIN(40))) GO TO 1490 PEQIN(40,I)=PEQEL(2,(I-IOFFN(40))) C C SUM 3P LEVELS FROM 8 3P HIGHER AND SCALED FROM 4 3P 1490 IF(EN.LE.EIN(41)) GO TO 2000 ER=EIN(41)/EIN(13) ENP=EN/ER IF(ENP.GT.X43P(N43P)) GO TO 1511 DO 1500 J=2,N43P IF(ENP.LE.X43P(J)) GO TO 1510 1500 CONTINUE J=N43P 1510 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(41,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1512 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 1511 QIN(41,I)=0.553*Y43P(N43P)*(X43P(N43P)/ENP)**3*1.D-18 1512 IF(EN.LE.(2.0*EIN(41))) GO TO 1520 PEQIN(41,I)=PEQEL(2,(I-IOFFN(41))) C C SUM 3D LEVELS FROM 8 3D HIGHER AND SCALED FROM 4 3D 1520 IF(EN.LE.EIN(42)) GO TO 2000 ER=EIN(42)/EIN(14) ENP=EN/ER IF(ENP.GT.X43D(N43D)) GO TO 1541 DO 1530 J=2,N43D IF(ENP.LE.X43D(J)) GO TO 1540 1530 CONTINUE J=N43P 1540 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(42,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1542 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 1541 QIN(42,I)=0.553*Y43D(N43D)*(X43D(N43D)/ENP)**3*1.D-18 1542 IF(EN.LE.(2.0*EIN(42))) GO TO 1550 PEQIN(42,I)=PEQEL(2,(I-IOFFN(42))) C C SUM 1D LEVELS FROM 8 1D HIGHER AND SCALED FROM 4 1D 1550 IF(EN.LE.EIN(43)) GO TO 2000 ER=EIN(43)/EIN(15) ENP=EN/ER IF(ENP.GT.X41D(N41D)) GO TO 1571 DO 1560 J=2,N41D IF(ENP.LE.X41D(J)) GO TO 1570 1560 CONTINUE J=N41D 1570 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(43,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1572 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 1571 QIN(43,I)=0.553*Y41D(N41D)*(X41D(N41D)/ENP)*1.D-18 1572 IF(EN.LE.(2.0*EIN(43))) GO TO 1580 PEQIN(43,I)=PEQEL(2,(I-IOFFN(43))) C C 8 1P SCALED FROM 4 1P OSC STRENGTH F=0.00362 1580 IF(EN.LE.EIN(44)) GO TO 2000 ER=EIN(44)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1601 DO 1590 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1600 1590 CONTINUE J=N41P 1600 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(44,I)=0.00362/0.02986*(A*ENP+B)*1.D-18 GO TO 1602 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1601 QIN(44,I)=0.00362/(EIN(44)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(44)))-BETA2)*BBCONST*EN/(EN+EIN(44)+E(3)) 1602 IF(EN.LE.(2.0*EIN(44))) GO TO 1610 PEQIN(44,I)=PEQEL(2,(I-IOFFN(44))) C C 9 1P SCALED FROM 4 1P OSC STRENGTH F=0.00253 1610 IF(EN.LE.EIN(45)) GO TO 2000 ER=EIN(45)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1631 DO 1620 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1630 1620 CONTINUE J=N41P 1630 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(45,I)=0.00253/0.02986*(A*ENP+B)*1.D-18 GO TO 1632 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1631 QIN(45,I)=0.00253/(EIN(45)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(45)))-BETA2)*BBCONST*EN/(EN+EIN(45)+E(3)) 1632 IF(EN.LE.(2.0*EIN(45))) GO TO 1640 PEQIN(45,I)=PEQEL(2,(I-IOFFN(45))) C C 10 1P SCALED FROM 4 1P OSC STRENGTH F=0.00184 1640 IF(EN.LE.EIN(46)) GO TO 2000 ER=EIN(46)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1661 DO 1650 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1660 1650 CONTINUE J=N41P 1660 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(46,I)=0.00184/0.02986*(A*ENP+B)*1.D-18 GO TO 1662 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1661 QIN(46,I)=0.00184/(EIN(46)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(46)))-BETA2)*BBCONST*EN/(EN+EIN(46)+E(3)) 1662 IF(EN.LE.(2.0*EIN(46))) GO TO 1670 PEQIN(46,I)=PEQEL(2,(I-IOFFN(46))) C C 11 1P SCALED FROM 4 1P OSC STRENGTH F=0.00138 1670 IF(EN.LE.EIN(47)) GO TO 2000 ER=EIN(47)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1691 DO 1680 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1690 1680 CONTINUE J=N41P 1690 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(47,I)=0.00138/0.02986*(A*ENP+B)*1.D-18 GO TO 1692 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1691 QIN(47,I)=0.00138/(EIN(47)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(47)))-BETA2)*BBCONST*EN/(EN+EIN(47)+E(3)) 1692 IF(EN.LE.(2.0*EIN(47))) GO TO 1700 PEQIN(47,I)=PEQEL(2,(I-IOFFN(47))) C C 12 1P SCALED FROM 4 1P OSC STRENGTH F=0.00106 1700 IF(EN.LE.EIN(48)) GO TO 2000 ER=EIN(48)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1721 DO 1710 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1720 1710 CONTINUE J=N41P 1720 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(48,I)=0.00106/0.02986*(A*ENP+B)*1.D-18 GO TO 1722 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1721 QIN(48,I)=0.00106/(EIN(48)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(48)))-BETA2)*BBCONST*EN/(EN+EIN(48)+E(3)) 1722 IF(EN.LE.(2.0*EIN(48))) GO TO 1730 PEQIN(48,I)=PEQEL(2,(I-IOFFN(48))) C C SUM HIGHER 1P LEVELS OSC STRENGTH F=0.00440 1730 IF(EN.LE.EIN(49)) GO TO 2000 ER=EIN(49)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1751 DO 1740 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1750 1740 CONTINUE J=N41P 1750 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(49,I)=0.00440/0.02986*(A*ENP+B)*1.D-18 GO TO 1752 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1751 QIN(49,I)=0.00440/(EIN(49)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(49)))-BETA2)*BBCONST*EN/(EN+EIN(49)+E(3)) 1752 IF(EN.LE.(2.0*EIN(49))) GO TO 1760 PEQIN(49,I)=PEQEL(2,(I-IOFFN(49))) 1760 CONTINUE C 2000 CONTINUE C QMET=QIN(1,I)+QIN(2,I) QDIP=QIN(4,I)+QIN(10,I)+QIN(18,I)+QIN(26,I)+QIN(32,I)+QIN(38,I)+ /QIN(44,I)+QIN(45,I)+QIN(46,I)+QIN(47,I)+QIN(48,I)+QIN(49,I) QTRP=QIN(1,I)+QIN(3,I)+QIN(5,I)+QIN(7,I)+QIN(8,I)+QIN(11,I)+ /QIN(13,I)+QIN(14,I)+QIN(16,I)+QIN(19,I)+QIN(21,I)+QIN(22,I)+ /QIN(24,I)+QIN(27,I)+QIN(29,I)+QIN(30,I)+QIN(33,I)+QIN(35,I)+ /QIN(36,I)+QIN(39,I)+QIN(41,I)+QIN(42,I) QSNG=QIN(2,I)+QIN(4,I)+QIN(6,I)+QIN(9,I)+QIN(10,I)+QIN(12,I)+ /QIN(15,I)+QIN(17,I)+QIN(18,I)+QIN(20,I)+QIN(23,I)+QIN(25,I)+ /QIN(26,I)+QIN(28,I)+QIN(31,I)+QIN(32,I)+QIN(34,I)+QIN(37,I)+ /QIN(38,I)+QIN(40,I)+QIN(43,I)+QIN(44,I)+QIN(45,I)+QIN(46,I)+ /QIN(47,I)+QIN(48,I)+QIN(49,I) QINEL=QSNG+QTRP+Q(5,I) Q(1,I)=QELA+QINEL C EXAMINE X-SECTION DATA C WRITE(6,986) EN,QIN(4,I),QIN(10,I),QIN(18,I),QIN(26,I),QIN(32,I), C /QIN(38,I),QIN(44,I),QIN(45,I),QIN(46,I),QIN(47,I),QIN(48,I), C /QIN(49,I) C 986 FORMAT(' EN=',D11.5,' 21P=',D11.3,' 31P=',D11.3,' 41P=',D11.3,' 51 C /P=',D11.3,' 61P=',D11.3,' 71P=',D11.3,/,8X,' 81P=',D11.3,' 91P=',D C /11.3,' 101P=',D11.3,' 111P=',D11.3,' 121P=',D11.3,' HIP=',D11.3) C WRITE(6,987) EN,QMET,QDIP,QSNG,QTRP,QINEL,Q(1,I) C 987 FORMAT(' EN=',D12.5,' QMET=',D11.3,' QDIP=',D11.3,' QSNG=',D11.3, C /'QTRP=',D11.3,' QINL=',D11.4,' QTOT=',D11.4) 9000 CONTINUE C SAVE COMPUTE TIME DO 9001 K=1,NIN IF(EFINAL.LE.EIN(K)) THEN NIN=K-1 GO TO 9011 ENDIF 9001 CONTINUE 9011 CONTINUE RETURN END SUBROUTINE GAS4(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(100),YEM(100),YEL(100),YEPS(100), /XION(90),YION(90),YINC(90), /X23S(139),Y23S(139),X21S(128),Y21S(128),X23P(128),Y23P(128), /X21P(125),Y21P(125),X33S(106),Y33S(106),X31S(87),Y31S(87), /X33P(91),Y33P(91),X33D(108),Y33D(108),X31D(94),Y31D(94), /X31P(114),Y31P(114),X43S(59),Y43S(59),X41S(55),Y41S(55), /X43P(76),Y43P(76),X43D(65),Y43D(65),X41D(53),Y41D(53), /X43F(40),Y43F(40),X41F(57),Y41F(57),X41P(96),Y41P(96), /IOFFN(49) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC DATA XEN/0.00,.008,.009,0.01,.013,.017,.020,.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,14.0,16.0,18.0,20.0,25.0,30.0, /35.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., /3000.,4000.,6000.,8000.,10000.,1.25D4,1.5D4,2.0D4,2.5D4,3.0D4, /4.0D4,6.0D4,8.0D4,1.0D5,1.25D5,1.50D5,2.0D5,2.5D5,3.0D5,4.0D5, /6.0D5,8.0D5,1.0D6,1.5D6,2.0D6,3.0D6,4.0D6,6.0D6,8.0D6,1.0D7/ C ELASTIC MOMENTUM TRANSFER DATA YEM/4.89,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.45,4.20,3.68,3.28,2.95,2.64,2.05,1.63, /1.33,1.09,.785,.590,.465,.375,.309,.262,.179,.132, /.0807,.0549,.0400,.0242,.0164,.0119,.00716,.00482,.00234,.0014, /.000676,4.03D-4,1.93D-4,1.15D-4,7.65D-5,5.10D-5,3.66D-5,2.17D-5, /1.45D-5,1.04D-5, /6.18D-6,2.99D-6,1.71D-6,1.21D-6,8.26D-7,6.05D-7,3.73D-7,2.58D-7, /1.92D-7,1.22D-7, /6.48D-8,4.17D-8,2.96D-8,1.58D-8,1.01D-8,5.24D-9,3.25D-9,1.63D-9, /9.89D-10,6.67D-10/ C ELASTIC TOTAL DATA YEL/4.89,5.19,5.20,5.21,5.26,5.29,5.33,5.37,5.41,5.47, /5.53,5.58,5.62,5.66,5.69,5.70,5.76,5.83,5.88,5.90, /5.96,6.01,6.08,6.12,6.14,6.16,6.16,6.17,6.16,6.16, /6.14,6.11,6.09,6.01,5.90,5.60,5.36,5.10,4.91,4.70, /4.51,4.32,4.21,4.10,3.75,3.49,3.27,3.03,2.54,2.14, /1.83,1.61,1.27,1.06,.884,.746,.652,.580,.460,.355, /.244,.194,.150,.117,.087,.071,.052,.041,.028,.022, /.014,.0108,.00722,.00544,.00437,.00352,.00295,.00224,.00182, /.00154, /.00118,.000830,.000654,.000550,.000466,.000411,.000342,.000301, /.000274,.000241, /.000209,.000195,.000186,.000177,.000172,.000169,.000167,.000166, /.000166,.000166/ C ANGULAR DISTRIBUTION PARAMETER EPSILON DATA YEPS/0.0,.00289,.00288,0.0,0.0,-.00562,-.00565,-.01118, /-.01386,-.01920, /-.02440,-.02688,-.03202,-.03445,-.03689,-.04209,-.04686,-.05400, /-.06119,-.06604, /-.07792,-.08474,-.10094,-.11490,-.12663,-.13826,-.14789,-.15724, /-.16707,-.18142, /-.19873,-.21165,-.21951,-.23447,-.24855,-.26918,-.26215,-.26104, /-.23265,-.20568, /-.17192,-.13835,-.08539,-.03657,0.02800,0.09011,0.14616,0.19164, /0.28459,0.34854, /0.39645,0.46261,0.53723,0.61037,0.64478,0.67011,0.70021,0.72258, /0.78150,0.79668, /0.83079,0.86696,0.87845,0.91682,0.92737,0.93870,0.95363,0.96280, /0.97662,.983705, /.988614,.991805,.994606,.995963,.996795,.997452,.997887,.998428, /.998754,.998956, /.999239,.9995075,.9996596,.9997208,.9997819,.9998234,.9998743, /.9999042,.9999236,.9999469, /.9999692,.9999796,.9999853,.9999922,.9999951,.9999975,.9999985, /.9999993,.9999996,.9999997/ C IONISATION (VALUES ABOVE 20KEV GENERATED BY BORN-BETHE IN SUB) DATA XION/24.58739,25.0,25.5,26.0,26.5,27.0,27.5,28.0,28.5,29.0, /29.5,30.0,30.5,31.0,31.5,32.0,32.5,33.0,33.5,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., /225.,250.,275.,300.,350.,400.,450.,500.,550.,600., /650.,700.,750.,800.,850.,900.,950.,1000.,1200.,1400., /1600.,1800.,2000.,2500.,3000.,3500.,4000.,4500.,5000.,5500., /6000.,7000.,8000.,9000.,1.0D4,1.2D4,1.4D4,1.6D4,1.8D4,2.0D4/ C GROSS IONISATION DATA YION/.0,.0041,.0101,.0166,.0233,.0299,.036,.0419,.0477,.0539, /.0600,.0655,.0714,.0773,.0827,.0884,.0940,.0994,.105,.110, /.130,.148,.165,.201,.234,.259,.280,.295,.310,.322, /.333,.341,.349,.356,.360,.362,.364,.365,.366,.366, /.367,.366,.365,.364,.362,.359,.355,.351,.346,.341, /.327,.314,.303,.291,.269,.248,.229,.212,.201,.190, ..179,.171,.162,.154,.148,.142,.137,.128,.115,.102, /.0922,.0845,.0781,.0645,.0551,.0501,.0440,.0409,.0363,.0333, /.0312,.0275,.0249,.0223,.0194,.0164,.0147,.0130,.0119,.0108/ C COUNTING IONISATION DATA YINC/.0,.0041,.0101,.0166,.0233,.0299,.036,.0419,.0477,.0539, /.0600,.0655,.0714,.0773,.0827,.0884,.0940,.0994,.105,.110, /.130,.148,.165,.201,.234,.259,.280,.295,.310,.322, /.333,.341,.349,.356,.360,.362,.364,.365,.366,.366, /.366,.365,.364,.363,.361,.358,.354,.350,.345,.340, /.326,.313,.302,.290,.268,.247,.228,.211,.200,.189, /.178,.170,.161,.153,.147,.141,.136,.127,.114,.101, /.0917,.0841,.0777,.0642,.0548,.0498,.0438,.0407,.0361,.0331, /.0310,.0274,.0248,.0222,.0193,.0163,.0146,.0129,.0118,.0107/ C ALL EXCITATIONS IN UNITS OF 10**-18 C 2 3S J=1 METASTABLE DATA X23S/19.81961,19.83,19.85,19.88,19.9,19.95,20.0,20.05,20.1, /20.15, /20.2,20.25,20.3,20.35,20.4,20.45,20.50,20.55,20.6,20.63, /20.66,20.7,20.75,20.8,20.85,20.90,20.94,20.97,21.0,21.05, /21.1,21.15,21.2,21.25,21.3,21.4,21.5,22.0,22.2,22.25, /22.3,22.35,22.4,22.42,22.44,22.46,22.48,22.5,22.52,22.55, /22.6,22.62,22.64,22.66,22.68,22.7,22.71,22.72,22.75,22.8, /22.85,22.88,22.9,22.95,22.97,23.0,23.05,23.1,23.3,23.4, /23.5,23.6,23.8,24.0,24.5,25.0,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,220., /240.,260.,280.,300.,340.,380.,420.,460.,500.,550., /600.,650.,700.,750.,800.,850.,900.,950.,1000.,1100., /1200.,1300.,1400.,1500.,1600.,1700.,1800.,1900.,2000./ DATA Y23S/0.00,.780,1.16,1.64,1.98,2.81,3.53,4.13,4.61,4.96, /5.20,5.35,5.41,5.36,5.21,4.95,4.63,4.23,3.66,3.16, /3.04,3.13,3.41,3.77,4.14,4.44,4.54,4.43,4.27,3.96, /3.69,3.48,3.32,3.21,3.15,3.08,3.06,3.09,3.08,3.04, /2.97,2.84,2.25,1.58,1.83,4.91,4.45,4.13,3.95,3.79, /3.60,3.51,3.07,2.45,2.61,2.67,2.36,2.97,3.01,2.96, /2.87,2.61,3.04,2.75,3.16,3.06,2.90,2.79,2.81,2.86, /2.75,2.80,2.71,2.65,2.58,2.48,2.39,2.30,2.19,2.09, /1.98,1.84,1.73,1.53,1.36,1.22,1.09,.985,.892,.812, /.742,.680,.555,.461,.389,.332,.287,.250,.220,.194, /.154,.125,.103,.0861,.0726,.0617,.0529,.0397,.0305,.0239, /.0191,.0154,.0126,.0105,.00740,.00542,.00407,.00314,.00247,.00187, /.00145,.00115,9.23D-4,7.53D-4,6.22D-4,5.20D-4,4.39D-4,3.74D-4, /3.21D-4,2.42D-4, /1.86D-4,1.47D-4,1.18D-4,9.57D-5,7.89D-5,6.58D-5,5.54D-5,4.71D-5, /4.04D-5/ C 2 1S J=0 METASTABLE DATA X21S/20.61577,20.62,20.63,20.65,20.67,20.69,20.72,20.75, /20.80,20.85, /20.90,20.96,20.98,21.0,21.05,21.1,21.15,21.2,21.22,21.25, /21.3,21.4,21.5,21.6,21.7,21.8,21.9,22.0,22.1,22.2, /22.25,22.3,22.35,22.4,22.42,22.44,22.46,22.48,22.5,22.55, /22.59,22.6,22.61,22.62,22.63,22.64,22.65,22.68,22.7,22.71, /22.72,22.73,22.75,22.78,22.8,22.85,22.87,22.88,22.89,22.9, /22.91,22.92,22.93,22.94,22.95,22.96,22.97,22.98,22.99,23.0, /23.01,23.05,23.1,23.2,23.3,23.4,23.5,23.6,23.8,24.0, /24.2,24.4,24.7,25.0,26.0,28.0,30.0,32.0,35.0,40.0, /45.0,50.0,55.0,60.0,65.0,70.0,80.0,90.0,100.,110., /120.,140.,170.,200.,240.,280.,320.,360.,400.,450., /500.,550.,600.,650.,700.,800.,900.,1000.,1100.,1200., /1400.,1600.,1800.,2000.,2200.,2400.,2700.,3000./ DATA Y21S/0.00,.406,.477,.664,.820,.946,1.10,1.24,1.47,1.72, /2.03,2.52,2.40,2.39,2.39,2.42,2.46,2.53,2.55,2.53, /2.52,2.53,2.57,2.59,2.62,2.64,2.65,2.65,2.65,2.62, /2.59,2.53,2.42,2.14,1.86,2.17,3.35,3.01,2.79,2.34, /1.80,1.88,2.53,3.37,3.64,3.55,3.42,3.23,2.95,2.45, /1.84,2.32,2.49,2.60,2.62,2.57,2.40,2.57,2.59,2.32, /1.73,2.55,2.36,2.35,2.32,2.23,2.50,2.64,2.61,1.86, /2.28,2.53,2.35,2.39,2.44,2.51,2.48,2.45,2.44,2.49, /2.57,2.63,2.56,2.54,2.53,2.51,2.45,2.35,2.21,2.05, /1.88,1.75,1.65,1.56,1.48,1.41,1.30,1.21,1.14,1.08, /1.03,.948,.850,.771,.686,.617,.560,.512,.471,.428, /.392,.361,.335,.312,.292,.259,.233,.211,.193,.178, /.154,.136,.121,.109,.0997,.0916,.0817,.0737/ C 2 3P J=2,1,0 DATA X23P/20.96409,20.97,21.0,21.05,21.1,21.15,21.2,21.25,21.3, /21.35, /21.4,21.5,21.6,21.7,21.8,21.9,22.0,22.1,22.2,22.3, /22.4,22.45,22.5,22.55,22.6,22.61,22.62,22.63,22.64,22.65, /22.66,22.67,22.68,22.69,22.7,22.71,22.72,22.73,22.75,22.77, /22.8,22.85,22.88,22.9,22.91,22.92,22.93,22.96,22.97,22.99, /23.0,23.04,23.06,23.07,23.08,23.1,23.2,23.3,23.4,23.5, /23.6,23.7,23.8,23.9,24.0,24.2,24.4,24.6,25.0,26.0, /27.0,28.0,29.0,30.0,32.0,34.0,36.0,38.0,40.0,42.0, /44.0,46.0,48.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., /170.,180.,190.,200.,220.,240.,260.,280.,300.,340., /380.,420.,460.,500.,550.,600.,700.,800.,900.,1000., /1200.,1400.,1600.,1800.,2000.,2300.,2600.,3000./ DATA Y23P/0.00,.0936,.241,.442,.611,.761,.912,1.03,1.10,1.17, /1.23,1.32,1.40,1.47,1.54,1.60,1.66,1.73,1.80,1.87, /1.94,2.05,2.07,2.09,2.22,2.48,2.68,2.60,2.27,1.78, /1.45,1.43,1.52,1.59,1.60,1.45,1.47,1.70,1.83,1.91, /1.95,1.93,2.32,1.98,1.72,2.23,2.09,2.12,2.07,2.17, /1.82,2.18,1.80,1.82,1.94,1.94,1.90,1.88,1.89,2.00, /2.16,2.21,2.14,2.08,2.09,2.03,2.16,2.26,2.29,2.41, /2.47,2.48,2.47,2.43,2.30,2.15,2.00,1.84,1.69,1.55, /1.43,1.31,1.21,1.11,.907,.748,.622,.522,.441,.375, /.322,.277,.241,.210,.162,.127,.101,.0812,.0663,.0547, /.0455,.0382,.0324,.0277,.0206,.0156,.0121,.00961,.00772,.00518, /.00363,.00264,.00197,.00151,.00118,8.48D-4,5.21D-4,3.42D-4, /2.37D-4,1.70D-4, /9.65D-5,5.99D-5,3.96D-5,2.76D-5,2.00D-5,1.30D-5,8.94D-6,5.78D-6/ C 2 1P RESONANCE RADIATION J=1 58.434 NM OSC STRENGTH F=0.27608 DATA X21P/21.21802,21.23,21.25,21.3,21.4,21.5,21.6,21.7,21.8,21.9, /22.0,22.1,22.2,22.3,22.35,22.4,22.42,22.44,22.46,22.48, /22.5,22.55,22.57,22.59,22.6,22.61,22.62,22.63,22.64,22.65, /22.66,22.68,22.7,22.71,22.72,22.73,22.75,22.8,22.85,22.87, /22.88,22.9,22.91,22.94,22.96,22.97,22.98,22.99,23.0,23.01, /23.05,23.1,23.2,23.3,23.4,23.5,23.6,23.7,23.8,23.9, /24.0,24.2,24.4,24.6,24.8,25.0,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,33.0,34.0,35.0,36.0,37.0,38.0,39.0, /40.0,42.0,44.0,46.0,48.0,50.0,52.0,54.0,56.0,58.0, /60.0,64.0,68.0,72.0,76.0,80.0,85.0,90.0,95.0,100., /110.,120.,130.,140.,160.,180.,200.,240.,280.,320., /360.,400.,450.,500.,550.,600.,650.,700.,800.,900., /1000.,1100.,1200.,1300.,1400./ DATA Y21P/0.00,.0519,.0884,.163,.290,.397,.493,.582,.666,.748, /.831,.914,.994,1.06,1.09,1.10,1.10,1.36,1.46,1.35, /1.32,1.30,1.28,1.19,1.07,.943,.922,.941,.872,.751, /.737,.959,1.13,1.17,.920,1.03,1.12,1.23,1.35,1.27, /1.18,1.22,1.03,1.14,1.12,1.38,1.29,1.25,1.38,1.24, /1.12,1.13,1.11,1.12,1.16,1.30,1.41,1.44,1.41,1.37, /1.39,1.42,1.52,1.70,1.80,1.89,2.16,2.42,2.69,2.96, /3.24,3.53,3.82,4.12,4.42,4.71,5.00,5.29,5.57,5.85, /6.12,6.63,7.10,7.53,7.93,8.28,8.61,8.90,9.16,9.39, /9.60,9.95,10.2,10.4,10.6,10.7,10.7,10.8,10.8,10.7, /10.6,10.4,10.2,10.0,9.57,9.13,8.71,7.96,7.33,6.79, /6.32,5.92,5.50,5.13,4.82,4.54,4.30,4.08,3.72,3.41, /3.16,2.95,2.76,2.60,2.46/ C 3 3S J=1 DATA X33S/22.71847,22.72,22.73,22.74,22.75,22.78,22.8,22.83,22.85, /22.86, /22.87,22.88,22.89,22.9,22.91,22.912,22.914,22.916,22.92,22.94, /22.96,22.98,23.0,23.02,23.05,23.1,23.2,23.25,23.3,23.35, /23.4,23.44,23.48,23.52,23.57,23.59,23.62,23.65,23.7,23.75, /23.82,23.89,23.93,24.0,24.4,25.0,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,54.0,58.0,62.0,66.0,70.0,75.0,80.0,85.0, /90.0,95.0,100.,110.,120.,130.,140.,150.,160.,170., /180.,200.,220.,240.,260.,280.,300.,340.,380.,420., /460.,500.,550.,600.,650.,700.,750.,800.,850.,900., /950.,1000.,1100.,1200.,1300.,1400./ DATA Y33S/0.00,.800,1.15,1.03,.985,.854,.812,.752,.644,.503, /.277,1.79,1.17,1.06,1.32,1.51,1.57,1.37,.896,.848, /.907,.816,.838,.656,.872,.859,.890,.900,.860,.750, /.620,.810,.770,.960,.870,.870,.730,.710,.710,.730, /.770,.690,.760,.742,.725,.694,.665,.635,.605,.577, /.550,.524,.499,.452,.409,.370,.336,.305,.278,.253, /.231,.212,.178,.151,.130,.112,.0968,.0817,.0696,.0597, /.0516,.0449,.0393,.0306,.0242,.0195,.0160,.0132,.0111,.00938, /.00800,.00596,.00456,.00356,.00284,.00230,.00188,.00131,9.53D-4, /7.13D-4, /5.47D-4,4.29D-4,3.25D-4,2.52D-4,1.99D-4,1.60D-4,1.31D-4,1.08D-4, /9.02D-5,7.62D-5, /6.49D-5,5.58D-5,4.20D-5,3.25D-5,2.56D-5,2.06D-5/ C 3 1S J=0 DATA X31S/22.92032,22.96,22.985,23.02,23.05,23.07,23.1,23.15,23.2, /23.25, /23.3,23.33,23.36,23.39,23.41,23.45,23.48,23.51,23.54,23.56, /23.59,23.62,23.65,23.68,23.73,23.82,23.88,23.94,24.0,25.0, /26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,44.0,48.0, /52.0,56.0,60.0,65.0,70.0,75.0,80.0,90.0,100.,110., /120.,130.,140.,160.,180.,200.,220.,240.,260.,280., /300.,340.,380.,420.,460.,500.,550.,600.,650.,700., /750.,800.,900.,1000.,1100.,1200.,1300.,1400.,1500.,1600., /1800.,2000.,2400.,2800.,3200.,3600.,4000./ DATA Y31S/0.00,.535,.457,.587,.490,.490,.478,.491,.506,.512, /.501,.470,.418,.374,.351,.371,.520,.681,.520,.467, /.496,.410,.442,.429,.416,.455,.377,.444,.422,.426, /.428,.429,.425,.419,.412,.402,.396,.387,.370,.354, /.338,.324,.311,.296,.283,.271,.260,.242,.226,.213, /.203,.193,.185,.172,.161,.152,.144,.137,.131,.125, /.120,.111,.103,.0957,.0894,.0839,.0778,.0725,.0678,.0636, /.0599,.0566,.0509,.0462,.0423,.0389,.0361,.0336,.0315,.0296, /.0264,.0238,.0199,.0171,.0150,.0133,.0120/ C 3 3P J=2,1,0 DATA X33P/23.00707,23.02,23.03,23.04,23.05,23.06,23.07,23.08,23.1, /23.2, /23.3,23.4,23.5,23.55,23.6,23.65,23.7,23.8,23.9,24.0, /24.1,24.2,24.3,24.4,24.6,24.8,25.0,26.0,27.0,28.0, /30.0,32.0,34.0,36.0,38.0,40.0,44.0,48.0,52.0,56.0, /60.0,64.0,68.0,72.0,76.0,80.0,85.0,90.0,95.0,100., /110.,120.,130.,140.,150.,160.,170.,180.,200.,220., /240.,260.,280.,300.,340.,380.,420.,460.,500.,550., /600.,650.,700.,750.,800.,850.,900.,950.,1000.,1100., /1200.,1300.,1400.,1600.,1800.,2000.,2200.,2400.,2600.,2800., /3000./ DATA Y33P/0.00,.387,.410,.179,.148,.335,.381,.282,.280,.309, /.332,.359,.411,.416,.405,.448,.438,.467,.485,.493, /.500,.515,.517,.513,.503,.508,.512,.516,.515,.524, /.544,.539,.523,.500,.474,.446,.392,.342,.297,.259, /.226,.197,.173,.152,.134,.118,.102,.0878,.0762,.0665, /.0512,.0401,.0318,.0255,.0208,.0171,.0142,.0119,.00854,.00632, /.00479,.00371,.00292,.00234,.00157,.00109,7.93D-4,5.92D-4,4.53D-4, /3.34D-4, /2.53D-4,1.96D-4,1.55D-4,1.24D-4,1.01D-4,8.37D-5,6.99D-5,5.89D-5, /5.02D-5,3.72D-5, /2.83D-5,2.21D-5,1.75D-5,1.16D-5,8.05D-6,5.82D-6,4.34D-6,3.32D-6, /2.60D-6,2.07D-6, /1.68D-6/ C 3 3D J=3,2,1 DATA X33D/23.07365,23.1,23.15,23.2,23.25,23.3,23.35,23.4,23.45, /23.5, /23.55,23.6,23.66,23.7,23.75,23.8,23.85,23.9,23.95,24.0, /24.05,24.1,24.15,24.2,24.25,24.3,24.35,24.4,24.45,24.5, /24.55,24.6,24.65,24.7,24.8,24.9,25.0,26.0,27.0,28.0, /29.0,30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,52.0,54.0,56.0,58.0,60.0,64.0,68.0,72.0, /76.0,80.0,85.0,90.0,95.0,100.,110.,120.,130.,140., /150.,160.,180.,200.,220.,240.,260.,280.,300.,320., /340.,360.,380.,400.,440.,480.,520.,560.,600.,650., /700.,750.,800.,850.,900.,1000.,1100.,1200.,1300.,1400., /1600.,1800.,2000.,2200.,2400.,2600.,2800.,3000./ DATA Y33D/0.00,.00956,.0236,.0401,.0602,.0861,.120,.166,.222,.229, /.238,.197,.123,.118,.110,.112,.104,.110,.099,.0985, /.113,.107,.109,.114,.118,.119,.118,.116,.113,.105, /.112,.116,.118,.119,.120,.120,.119,.115,.118,.121, /.121,.120,.113,.105,.0958,.0867,.0780,.0701,.0628,.0563, /.0505,.0453,.0407,.0366,.0330,.0298,.0269,.0221,.0183,.0152, /.0127,.0107,.00868,.00712,.00588,.00490,.00347,.00252,.00188, /.00142, /.00110,8.64D-4,5.56D-4,3.76D-4,2.64D-4,1.92D-4,1.44D-4,1.10D-4, /8.60D-5,6.84D-5, /5.53D-5,4.53D-5,3.76D-5,3.15D-5,2.28D-5,1.70D-5,1.30D-5,1.02D-5, /8.12D-6,6.25D-6, /4.92D-6,3.94D-6,3.21D-6,2.64D-6,2.21D-6,1.58D-6,1.17D-6,8.95D-7, /6.98D-7,5.55D-7, /3.67D-7,2.56D-7,1.85D-7,1.38D-7,1.06D-7,8.32D-8,6.64D-8,5.38D-8/ C 3 1D J=2 DATA X31D/23.07407,23.08,23.1,23.15,23.2,23.25,23.3,23.35,23.4, /23.45, /23.5,23.55,23.6,23.66,23.7,23.75,23.8,23.85,23.9,23.95, /24.0,24.05,24.1,24.15,24.2,24.25,24.3,24.35,24.4,24.45, /24.5,24.6,24.7,24.8,25.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,54.0,58.0, /62.0,66.0,70.0,75.0,80.0,90.0,100.,110.,120.,140., /160.,180.,200.,220.,240.,260.,280.,300.,320.,340., /370.,400.,440.,480.,520.,560.,600.,650.,700.,800., /900.,1000.,1100.,1200.,1300.,1400.,1600.,1800.,2000.,2200., /2400.,2600.,2800.,3000./ DATA Y31D/0.00,.097,.0973,.110,.126,.148,.175,.200,.221,.237, /.235,.198,.185,.192,.168,.181,.189,.172,.193,.184, /.190,.209,.206,.211,.214,.215,.212,.206,.199,.191, /.174,.177,.179,.180,.181,.180,.180,.188,.198,.209, /.217,.224,.229,.232,.234,.235,.234,.233,.228,.222, /.215,.207,.199,.190,.180,.163,.148,.135,.124,.105, /.0913,.0803,.0715,.0643,.0584,.0534,.0492,.0456,.0424,.0397, /.0361,.0332,.0299,.0272,.0249,.0230,.0213,.0196,.0181,.0156, /.0138,.0124,.0112,.0102,.00938,.00868,.00756,.00669,.00600,.00544, /.00497,.00458,.00425,.00396/ C 3 1P RESONANCE RADIATION J=1 53.703 NM OSC STRENGTH F=0.07342 DATA X31P/23.08702,23.1,23.15,23.2,23.25,23.3,23.35,23.4,23.45, /23.5, /23.54,23.56,23.60,23.64,23.68,23.7,23.75,23.80,23.88,23.9, /23.95,24.0,24.05,24.1,24.15,24.2,24.3,24.4,24.5,24.6, /24.7,24.8,25.0,25.2,25.4,25.6,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,52.0,54.0,56.0,58.0,60.0,65.0,70.0,75.0, /80.0,85.0,90.0,95.0,100.,110.,120.,130.,140.,160., /180.,200.,220.,240.,260.,280.,300.,340.,380.,420., /460.,500.,550.,600.,650.,700.,750.,800.,900.,1000., /1100.,1200.,1300.,1400.,1600.,1800.,2000.,2200.,2400.,2600., /2800.,3000.,3400.,3800.,4200.,4600.,5000.,5500.,6000.,6500., /7000.,8000.,9000.,10000./ DATA Y31P/0.00,.114,.129,.137,.137,.134,.131,.130,.128,.129, /.117,.127,.122,.163,.146,.150,.191,.180,.226,.224, /.218,.230,.245,.253,.265,.274,.294,.308,.330,.360, /.373,.382,.397,.409,.418,.423,.434,.469,.516,.577, /.648,.723,.808,.941,1.07,1.20,1.32,1.43,1.54,1.64, /1.74,1.82,1.90,1.97,2.04,2.10,2.15,2.27,2.35,2.42, /2.47,2.50,2.52,2.53,2.53,2.52,2.50,2.47,2.42,2.33, /2.24,2.14,2.06,1.97,1.90,1.82,1.76,1.64,1.53,1.44, /1.36,1.29,1.21,1.15,1.08,1.03,.982,.938,.862,.799, /.745,.699,.658,.623,.563,.514,.474,.440,.411,.386, /.364,.344,.312,.285,.263,.244,.228,.211,.197,.184, /.173,.155,.140,.128/ C 4 3S J=1 DATA X43S/23.59396,23.62,23.65,23.7,23.8,23.9,24.0,25.0,26.0,27.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,52.0,54.0,56.0,58.0,60.0,64.0,68.0,72.0, /76.0,80.0,85.0,90.0,95.0,100.,110.,120.,130.,140., /150.,160.,180.,200.,220.,240.,260.,280.,300.,320., /340.,360.,380.,400.,440.,480.,520.,560.,600./ DATA Y43S/0.0,.314,.304,.292,.276,.266,.260,.243,.238,.234, /.227,.212,.195,.178,.162,.147,.133,.121,.110,.100, /.0911,.0832,.0761,.0697,.0640,.0589,.0543,.0464,.0399,.0346, /.0301,.0264,.0225,.0194,.0168,.0147,.0113,.00894,.00718,.00585, /.00483,.00403,.00289,.00214,.00164,.00127,.00101,8.17D-4,6.69D-4, /5.55D-4, /4.66D-4,3.94D-4,3.37D-4,2.90D-4,2.19D-4,1.70D-4,1.34D-4,1.08D-4, /8.81D-5/ C 4 1S J=0 DATA X41S/23.67357,23.7,23.8,23.9,24.0,25.0,26.0,27.0,28.0,29.0, /30.0,32.0,34.0,36.0,38.0,40.0,44.0,48.0,52.0,56.0, /60.0,65.0,70.0,75.0,80.0,90.0,100.,110.,120.,130., /140.,160.,180.,200.,250.,300.,350.,400.,450.,500., /600.,700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000., /2200.,2400.,2600.,2800.,3000./ DATA Y41S/0.0,.109,.110,.111,.112,.121,.128,.133,.138,.141, /.143,.146,.148,.147,.146,.144,.139,.134,.129,.123, /.118,.113,.108,.103,.0990,.0922,.0868,.0823,.0786,.0753, /.0725,.0677,.0636,.0601,.0527,.0469,.0422,.0382,.0349,.0322, /.0277,.0243,.0216,.0195,.0177,.0150,.0130,.0114,.0102,.00925, /.00845,.00777,.00719,.00669,.00626/ C 4 3P J=2,1,0 DATA X43P/23.70789,23.75,23.8,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0, /54.0,58.0,62.0,66.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,170.,180.,190., /200.,220.,240.,260.,280.,300.,320.,340.,360.,380., /400.,440.,480.,520.,560.,600.,650.,700.,750.,800., /850.,900.,950.,1000.,1100.,1200.,1300.,1400.,1600.,1800., /2000.,2200.,2400.,2600.,2800.,3000./ DATA Y43P/0.0,.085,.110,.118,.152,.177,.194,.205,.211,.215, /.215,.209,.200,.189,.178,.167,.156,.146,.136,.127, /.110,.0962,.0840,.0736,.0647,.0553,.0475,.0410,.0356,.0310, /.0271,.0210,.0165,.0132,.0106,.00865,.00713,.00593,.00498,.00421, /.00359,.00266,.00202,.00156,.00123,9.88D-4,8.03D-4,6.60D-4, /5.49D-4,4.61D-4, /3.90D-4,2.87D-4,2.17D-4,1.67D-4,1.32D-4,1.06D-4,8.18D-5,6.46D-5, /5.18D-5,4.22D-5, /3.48D-5,2.90D-5,2.45D-5,2.08D-5,1.54D-5,1.17D-5,9.13D-6,7.25D-6, /4.78D-6,3.32D-6, /2.39D-6,1.78D-6,1.36D-6,1.07D-6,8.50D-7,6.88D-7/ C 4 3D J=3,2,1 DATA X43D/23.73609,23.8,23.9,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0, /54.0,58.0,62.0,66.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,220., /240.,260.,280.,300.,340.,380.,420.,460.,500.,550., /600.,650.,700.,750.,800.,850.,900.,950.,1000.,1100., /1200.,1300.,1400.,1500.,1600./ DATA Y43D/.0,.0288,.0363,.0407,.0575,.0646,.0681,.0692,.069,.0675, /.0629,.0573,.0516,.0461,.0411,.0365,.0325,.0290,.0258,.0231, /.0186,.0151,.0123,.0102,.00847,.00681,.00554,.00455,.00378,.00316, /.00267,.00194,.00145,.00111,8.61D-4,6.81D-4,5.47D-4,3.66D-4, /2.55D-4,1.84D-4, /1.37D-4,1.04D-4,8.08D-5,6.39D-5,4.18D-5,2.87D-5,2.05D-5,1.51D-5, /1.14D-5,8.32D-6, /6.24D-6,4.79D-6,3.75D-6,3.00D-6,2.43D-6,1.99D-6,1.65D-6,1.39D-6, /1.18D-6,8.66D-7, /6.55D-7,5.08D-7,4.01D-7,3.22D-7,2.63D-7/ C 4 1D J=2 DATA X41D/23.73633,23.8,24.0,25.0,26.0,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,44.0,48.0,52.0,56.0,60.0,64.0, /68.0,72.0,76.0,80.0,85.0,90.0,95.0,100.,110.,120., /130.,140.,160.,180.,200.,220.,240.,260.,300.,340., /380.,420.,460.,500.,550.,600.,650.,700.,800.,900., /1000.,1100.,1200./ DATA Y41D/0.0,.0791,.0799,.0846,.0902,.0959,.102,.107,.112,.120, /.127,.131,.134,.136,.136,.134,.131,.126,.121,.116, /.112,.107,.102,.0978,.0927,.0880,.0836,.0796,.0724,.0663, /.0610,.0564,.0489,.0430,.0384,.0346,.0314,.0288,.0246,.0215, /.0190,.0171,.0155,.0142,.0128,.0117,.0107,.00990,.00860,.00760, /.00681,.00616,.00563/ C 4 3F J=3,4,2 DATA X43F/23.73701,23.8,23.9,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /31.0,32.0,33.0,34.0,35.0,36.0,37.0,38.0,39.0,40.0, /42.0,44.0,46.0,48.0,50.0,54.0,58.0,62.0,66.0,70.0, /75.0,80.0,85.0,90.0,95.0,100.,110.,120.,130.,140./ DATA Y43F/0.0,.0357,.0318,.0289,.0161,.0117,.00922,.00760,.00642, /.00550, /.00478,.00418,.00369,.00327,.00291,.00261,.00234,.00211,.00191, /.00173, /.00144,.00121,.00102,8.68D-4,7.44D-4,5.57D-4,4.25D-4,3.30D-4, /2.61D-4,2.09D-4, /1.61D-4,1.26D-4,9.98D-5,8.03D-5,6.53D-5,5.36D-5,3.72D-5,2.66D-5, /1.96D-5,1.47D-5/ C 4 1F J=3 DATA X41F/23.73701,23.8,24.0,25.0,26.0,27.0,28.0,29.0,30.0,31.0, /32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0, /54.0,58.0,62.0,66.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,220., /240.,260.,280.,300.,340.,380.,420.,460.,500.,550., /600.,650.,700.,750.,800.,900.,1000./ DATA Y41F/0.0,.0175,.0172,.0160,.0149,.0139,.0130,.0122,.0114, /.0108, /.0102,.00909,.00819,.00742,.00677,.00619,.00569,.00525,.00487, /.00452, /.00393,.00346,.00307,.00274,.00246,.00217,.00193,.00173,.00156, /.00142, /.00129,.00108,9.24D-4,7.99D-4,6.99D-4,6.17D-4,5.50D-4,4.47D-4, /3.73D-4,3.19D-4, /2.77D-4,2.45D-4,2.19D-4,1.99D-4,1.67D-4,1.45D-4,1.28D-4,1.15D-4, /1.04D-4,9.39D-5, /8.55D-5,7.86D-5,78.27D-5,6.78D-5,6.35D-5,5.63D-5,5.07D-5/ C 4 1P RESONANCE RADIATION J=1 52.222 NM OSC STRENGTH F=0.02986 DATA X41P/23.74207,23.8,23.9,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /31.0,32.0,33.0,34.0,35.0,36.0,37.0,38.0,39.0,40.0, /42.0,44.0,46.0,48.0,50.0,52.0,54.0,56.0,58.0,60.0, /64.0,68.0,72.0,76.0,80.0,85.0,90.0,95.0,100.,110., /120.,130.,140.,150.,160.,180.,200.,220.,240.,260., /280.,300.,320.,340.,360.,380.,400.,440.,480.,520., /560.,600.,640.,680.,720.,760.,800.,850.,900.,950., /1000.,1100.,1200.,1300.,1400.,1600.,1800.,2000.,2200.,2400., /2600.,2800.,3000.,3400.,3800.,4200.,4600.,5000.,5500.,6000., /6500.,7000.,7500.,8000.,9000.,10000./ DATA Y41P/0.00,.0147,.0242,.0334,.107,.158,.196,.227,.255,.281, /.307,.333,.360,.387,.414,.442,.470,.498,.526,.553, /.606,.657,.704,.748,.789,.826,.860,.891,.919,.944, /.986,1.02,1.05,1.06,1.08,1.09,1.10,1.10,1.10,1.09, /1.07,1.05,1.03,1.01,.985,.939,.896,.855,.817,.783, /.751,.722,.695,.670,.646,.625,.605,.569,.537,.509, /.484,.461,.441,.423,.406,.390,.376,.360,.345,.332, /.320,.298,.279,.263,.248,.224,.205,.189,.175,.163, /.153,.145,.137,.124,.113,.104,.0969,.0905,.0837,.0779, /.0729,.0686,.0648,.0614,.0556,.0510/ C 5 1P RESONANCE RADIATION J=1 51.562 NM F=0.01504 C 6 1P RESONANCE RADIATION J=1 51.210 NM F=0.00863 C 7 1P RESONANCE RADIATION J=1 51.000 NM F=0.00540 C 8 1P RESONANCE RADIATION J=1 50.865 NM F=0.00362 C 9 1P RESONANCE RADIATION J=1 50.772 NM F=0.00253 C 10 1P RESONANCE RADIATION J=1 50.706 NM F=0.00184 C 11 1P RESONANCE RADIATION J=1 50.657 NM F=0.00138 C 12 1P RESONANCE RADIATION J=1 50.620 NM F=0.00106 C SUM HIGHER 1P LEVELS RESONANCE RADIATION J=1 F=0.00440 C TOTAL SUM OSCILLATOR STRENGTH = 0.42326 C -------------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME='HE3 (ISOT) 2010' ELSE NAME='HE3 (ANIS) 2010' ENDIF C -------------------------------------------------------------------- C HELIUM 3 USES SAME X-SECTIONS AS HE 4 WITH CORRECT ATOMIC MASS C HELIUM 4 BEST KNOWN GAS USED AS STANDARD ACCURACY BETTER THAN 0.2% C AT ALL FIELDS. C 2002: UPDATED 1997 DATA TO INCLUDE ANISOTROPIC ELASTIC SCATTTERING C 2007: INCREASED DATA FILE UP TO 10 MEV C 2007: NEW ANISTROPIC SCATTERING FUNCTION INTRODUCED C 2007: PENNING FRACTION INTRODUCED C 2010: SPLIT EXCITATION INTO 49 LEVELS. C USED MAINLY THE FOLLOWING THEORETICAL EXCITATION X-SECTIONS: C AT RESONANCE ENERGIES USED RMPS CALCULATIONS OF C BARTSCHAT J.PHYS B31(1998)L469 C AT HIGHER ENERGIES USED RALCHENKO AT.DATA NUCL DATA TABLES 94(2008)603 C AT HIGHEST ENERGIES FOR RESONANCE DIPOLE TRANSITIONS USED BEF SCALING C -------------------------------------------------------------------- C C BORN-BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 API=DACOS(-1.0D0) A0=0.52917720859D-8 RY=13.60569193 BBCONST=16.0*API*A0*A0*RY*RY/EMASS2 C AM2=0.489 C=5.50 C NIN=49 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN 2 KIN(J)=NANISO NDATA=100 NION=90 N23S=139 N21S=128 N23P=128 N21P=125 N33S=106 N31S=87 N33P=91 N33D=108 N31D=94 N31P=114 N43S=59 N41S=55 N43P=76 N43D=65 N41D=53 N43F=40 N41F=57 N41P=96 E(1)=0.0 E(2)=2.0*EMASS/(3.01600*AMU) E(3)=24.58739 C ENTER EXCITATION X-SECTION AT 1.4MEV E(4)=0.5841D-19 C ENTER IONISING X-SECTION AT 1.4MEV E(5)=0.1271D-18 C ENTER EOBY FOR MINIMUM IONISING PARTICLE E(6)=10.5 C EOBY AT LOW ENERGY EOBY=15.8 IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) EIN(1)=19.81961 EIN(2)=20.61577 EIN(3)=20.96409 EIN(4)=21.21802 EIN(5)=22.71847 EIN(6)=22.92032 EIN(7)=23.00707 EIN(8)=23.07365 EIN(9)=23.07407 EIN(10)=23.08702 EIN(11)=23.59396 EIN(12)=23.67357 EIN(13)=23.70789 EIN(14)=23.73609 EIN(15)=23.73633 EIN(16)=23.73701 EIN(17)=23.73701 EIN(18)=23.74207 EIN(19)=23.97197 EIN(20)=24.01121 EIN(21)=24.02822 EIN(22)=24.04266 EIN(23)=24.04280 EIN(24)=24.04315 EIN(25)=24.04315 EIN(26)=24.04580 EIN(27)=24.16900 EIN(28)=24.19116 EIN(29)=24.20081 EIN(30)=24.20916 EIN(31)=24.20925 EIN(32)=24.21100 EIN(33)=24.28456 EIN(34)=24.29828 EIN(35)=24.30429 EIN(36)=24.30954 EIN(37)=24.30960 EIN(38)=24.31071 EIN(39)=24.35810 EIN(40)=24.36718 EIN(41)=24.37116 EIN(42)=24.37468 EIN(43)=24.37472 EIN(44)=24.37547 EIN(45)=24.41989 EIN(46)=24.45168 EIN(47)=24.47518 EIN(48)=24.49308 EIN(49)=24.50708 C*********************************************************************** C ENTER PENNING FRACTION FOR EACH LEVEL C PENNING FRACTION BETWEEN 0.9 AND 1.0 FOR ALL MIXTURES DO 50 NL=1,NIN PENFRA(1,NL)=1.00 C PENNING TRANSFER DISTANCE MICRONS PENFRA(2,NL)=1.0 C PENNING TRANSFER TIME PICOSECONDS 50 PENFRA(3,NL)=1.0 C HORNBECK MOLNAR MOD C IF PURE GAS SET TO : 0 FOR FIRST 6 LEVELS 0.25 FOR OTHER LEVELS C PENFRA(1,1)=0.0 C PENFRA(1,2)=0.0 C PENFRA(1,3)=0.0 C PENFRA(1,4)=0.0 C PENFRA(1,5)=0.0 C PENFRA(1,6)=0.0 C*********************************************************************** IF(IPEN.EQ.0) GO TO 4 DO 3 KDUM=1,NIN IF(PENFRA(1,KDUM).EQ.0.0) GO TO 3 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 3 CONTINUE 4 DO 5 NL=1,NIN 5 IOFFN(NL)=IFIX(SNGL(0.5+EIN(NL)/ESTEP)) SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC HELIUM 3 ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC ISOTROPIC HELIUM 3 ' ENDIF SCRPT(3)=' IONISATION ELOSS= 24.58739' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EX 23S J=1 M ELVL=19.81961' SCRPT(8)=' EX 21S J=0 M ELVL=20.61577' SCRPT(9)=' EX 23P J=2,1,0 ELVL=20.96409' SCRPT(10)=' EX 21P J=1 R ELVL=21.21802' SCRPT(11)=' EX 33S J=1 ELVL=22.71847' SCRPT(12)=' EX 31S J=0 ELVL=22.92032' SCRPT(13)=' EX 33P J=2,1,0 ELVL=23.00707' SCRPT(14)=' EX 33D J=3,2,1 ELVL=23.07365' SCRPT(15)=' EX 31D J=2 ELVL=23.07407' SCRPT(16)=' EX 31P J=1 R ELVL=23.08702' SCRPT(17)=' EX 43S J=1 ELVL=23.59396' SCRPT(18)=' EX 41S J=0 ELVL=23.67357' SCRPT(19)=' EX 43P J=2,1,0 ELVL=23.70789' SCRPT(20)=' EX 43D J=3,2,1 ELVL=23.73609' SCRPT(21)=' EX 41D J=2 ELVL=23.73633' SCRPT(22)=' EX 43F J=3,4,2 ELVL=23.73701' SCRPT(23)=' EX 41F J=3 ELVL=23.73701' SCRPT(24)=' EX 41P J=1 R ELVL=23.74207' SCRPT(25)=' EX 53S J=1 ELVL=23.97197' SCRPT(26)=' EX 51S J=0 ELVL=24.01121' SCRPT(27)=' EX 53P J=2,1,0 ELVL=24.02822' SCRPT(28)=' EX 53D J=3,2,1 ELVL=24.04266' SCRPT(29)=' EX 51D J=2 ELVL=24.04280' SCRPT(30)=' EX 53F J=3,4,2 ELVL=24.04315' SCRPT(31)=' EX 513 J=3 ELVL=24.04315' SCRPT(32)=' EX 51P J=1 R ELVL=24.04580' SCRPT(33)=' EX 63S J=1 ELVL=24.16900' SCRPT(34)=' EX 61S J=0 ELVL=24.19116' SCRPT(35)=' EX 63P J=2,1,0 ELVL=24.20081' SCRPT(36)=' EX 63D J=3,2,1 ELVL=24.20916' SCRPT(37)=' EX 61D J=2 ELVL=24.20925' SCRPT(38)=' EX 61P J=1 R ELVL=24.21100' SCRPT(39)=' EX 73S J=1 ELVL=24.28456' SCRPT(40)=' EX 71S J=0 ELVL=24.29828' SCRPT(41)=' EX 73P J=2,1,0 ELVL=24.30429' SCRPT(42)=' EX 73D J=3,2,1 ELVL=24.30954' SCRPT(43)=' EX 71D J=2 ELVL=24.30960' SCRPT(44)=' EX 71P J=1 R ELVL=24.31071' SCRPT(45)=' EX N3S SUM HIGH ELVL=24.35810' SCRPT(46)=' EX N1S SUM HIGH ELVL=24.36718' SCRPT(47)=' EX N3P SUM HIGH ELVL=24.37116' SCRPT(48)=' EX N3D SUM HIGH ELVL=24.37468' SCRPT(49)=' EX N1D SUM HIGH ELVL=24.37472' SCRPT(50)=' EX 81P J=1 R ELVL=24.37547' SCRPT(51)=' EX 91P J=1 R ELVL=24.41989' SCRPT(52)=' EX 101P J=1 R ELVL=24.45168' SCRPT(53)=' EX 111P J=1 R ELVL=24.47518' SCRPT(54)=' EX 121P J=1 R ELVL=24.49308' SCRPT(55)=' EX N1P SUM HI R ELVL=24.50708' EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.EIN(1)) THEN GAMMA1=(EMASS2+2.0D0*EN)/EMASS2 GAMMA2=GAMMA1*GAMMA1 BETA=DSQRT(1.0D0-1.0D0/GAMMA2) BETA2=BETA*BETA ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YEL(J)-YEL(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEL(J)-XEN(J)*YEL(J-1))/(XEN(J-1)-XEN(J)) QELA=(A*EN+B)*1.0D-16 C A=(YEM(J)-YEM(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEM(J)-XEN(J)*YEM(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.0D-16 PQ1=0.5+(QELA-QMOM)/QELA C A=(YEPS(J)-YEPS(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEPS(J)-XEN(J)*YEPS(J-1))/(XEN(J-1)-XEN(J)) PQ2=A*EN+B C IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) THEN Q(2,I)=QMOM PEQEL(2,I)=0.5 ENDIF C GROSS IONISATION Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 200 IF(EN.GT.XION(NION)) GO TO 121 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 GO TO 122 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 121 AX2=1.0D0/BETA2 AX1=AX2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*AX1+C*AX2)/0.995 122 CONTINUE 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 ATTACHMENT 200 Q(4,I)=0.0D0 C COUNTING IONISATION Q(5,I)=0.0D0 PEQEL(5,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(5,I)=0.0D0 IF(EN.LE.E(3)) GO TO 250 IF(EN.GT.XION(NION)) GO TO 241 DO 230 J=2,NION IF(EN.LE.XION(J)) GO TO 240 230 CONTINUE J=NION 240 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.0D-16 GO TO 242 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 241 Q(5,I)=CONST*(AM2*AX1+C*AX2) 242 CONTINUE IF(EN.LE.(2.0D0*E(3))) GO TO 250 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 250 Q(6,I)=0.0D0 C DO 251 NL=1,NIN QIN(NL,I)=0.0D0 PEQIN(NL,I)=0.5D0 IF(NANISO.EQ.2) THEN PEQIN(NL,I)=0.0D0 ENDIF 251 CONTINUE C C 2 3S IF(EN.LE.EIN(1)) GO TO 2000 IF(EN.GT.X23S(N23S)) GO TO 311 DO 300 J=2,N23S IF(EN.LE.X23S(J)) GO TO 310 300 CONTINUE J=N23S 310 A=(Y23S(J)-Y23S(J-1))/(X23S(J)-X23S(J-1)) B=(X23S(J-1)*Y23S(J)-X23S(J)*Y23S(J-1))/(X23S(J-1)-X23S(J)) QIN(1,I)=(A*EN+B)*1.D-18 GO TO 312 C IF ENERGY GT X23S(N23S) EV SCALE BY 1/E**3 311 QIN(1,I)=Y23S(N23S)*(X23S(N23S)/EN)**3*1.D-18 312 IF(EN.LE.(2.0*EIN(1))) GO TO 320 PEQIN(1,I)=PEQEL(2,(I-IOFFN(1))) C C 2 1S 320 IF(EN.LE.EIN(2)) GO TO 2000 IF(EN.GT.X21S(N21S)) GO TO 341 DO 330 J=2,N21S IF(EN.LE.X21S(J)) GO TO 340 330 CONTINUE J=N21S 340 A=(Y21S(J)-Y21S(J-1))/(X21S(J)-X21S(J-1)) B=(X21S(J-1)*Y21S(J)-X21S(J)*Y21S(J-1))/(X21S(J-1)-X21S(J)) QIN(2,I)=(A*EN+B)*1.D-18 GO TO 342 C IF ENERGY GT X21S(N21S) EV SCALE BY 1/E 341 QIN(2,I)=Y21S(N21S)*(X21S(N21S)/EN)*1.D-18 342 IF(EN.LE.(2.0*EIN(2))) GO TO 350 PEQIN(2,I)=PEQEL(2,(I-IOFFN(2))) C C 2 3P 350 IF(EN.LE.EIN(3)) GO TO 2000 IF(EN.GT.X23P(N23P)) GO TO 371 DO 360 J=2,N23P IF(EN.LE.X23P(J)) GO TO 370 360 CONTINUE J=N23P 370 A=(Y23P(J)-Y23P(J-1))/(X23P(J)-X23P(J-1)) B=(X23P(J-1)*Y23P(J)-X23P(J)*Y23P(J-1))/(X23P(J-1)-X23P(J)) QIN(3,I)=(A*EN+B)*1.D-18 GO TO 372 C IF ENERGY GT X23P(N23P) EV SCALE BY 1/E**3 371 QIN(3,I)=Y23P(N23P)*(X23P(N23P)/EN)**3*1.D-18 372 IF(EN.LE.(2.0*EIN(3))) GO TO 380 PEQIN(3,I)=PEQEL(2,(I-IOFFN(3))) C C 2 1P OSC STRENGTH F=0.27608 380 IF(EN.LE.EIN(4)) GO TO 2000 IF(EN.GT.X21P(N21P)) GO TO 401 DO 390 J=2,N21P IF(EN.LE.X21P(J)) GO TO 400 390 CONTINUE J=N21P 400 A=(Y21P(J)-Y21P(J-1))/(X21P(J)-X21P(J-1)) B=(X21P(J-1)*Y21P(J)-X21P(J)*Y21P(J-1))/(X21P(J-1)-X21P(J)) QIN(4,I)=(A*EN+B)*1.D-18 GO TO 402 C IF ENERGY GT X21P(N21P) EV THEN USE BEF SCALING 401 QIN(4,I)=0.27608/(EIN(4)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(4)))-BETA2)*BBCONST*EN/(EN+EIN(4)+E(3)) 402 IF(EN.LE.(2.0*EIN(4))) GO TO 410 PEQIN(4,I)=PEQEL(2,(I-IOFFN(4))) C C 3 3S 410 IF(EN.LE.EIN(5)) GO TO 2000 IF(EN.GT.X33S(N33S)) GO TO 431 DO 420 J=2,N33S IF(EN.LE.X33S(J)) GO TO 430 420 CONTINUE J=N33S 430 A=(Y33S(J)-Y33S(J-1))/(X33S(J)-X33S(J-1)) B=(X33S(J-1)*Y33S(J)-X33S(J)*Y33S(J-1))/(X33S(J-1)-X33S(J)) QIN(5,I)=(A*EN+B)*1.D-18 GO TO 432 C IF ENERGY GT X33S(N33S) EV SCALE BY 1/E**3 431 QIN(5,I)=Y33S(N33S)*(X33S(N33S)/EN)**3*1.D-18 432 IF(EN.LE.(2.0*EIN(5))) GO TO 440 PEQIN(5,I)=PEQEL(2,(I-IOFFN(5))) C C 3 1S 440 IF(EN.LE.EIN(6)) GO TO 2000 IF(EN.GT.X31S(N31S)) GO TO 461 DO 450 J=2,N31S IF(EN.LE.X31S(J)) GO TO 460 450 CONTINUE J=N31S 460 A=(Y31S(J)-Y31S(J-1))/(X31S(J)-X31S(J-1)) B=(X31S(J-1)*Y31S(J)-X31S(J)*Y31S(J-1))/(X31S(J-1)-X31S(J)) QIN(6,I)=(A*EN+B)*1.D-18 GO TO 462 C IF ENERGY GT X31S(N31S) EV SCALE BY 1/E 461 QIN(6,I)=Y31S(N31S)*(X31S(N31S)/EN)*1.D-18 462 IF(EN.LE.(2.0*EIN(6))) GO TO 470 PEQIN(6,I)=PEQEL(2,(I-IOFFN(6))) C C 3 3P 470 IF(EN.LE.EIN(7)) GO TO 2000 IF(EN.GT.X33P(N33P)) GO TO 491 DO 480 J=2,N33P IF(EN.LE.X33P(J)) GO TO 490 480 CONTINUE J=N33P 490 A=(Y33P(J)-Y33P(J-1))/(X33P(J)-X33P(J-1)) B=(X33P(J-1)*Y33P(J)-X33P(J)*Y33P(J-1))/(X33P(J-1)-X33P(J)) QIN(7,I)=(A*EN+B)*1.D-18 GO TO 492 C IF ENERGY GT X33P(N33P) EV SCALE BY 1/E**3 491 QIN(7,I)=Y33P(N33P)*(X33P(N33P)/EN)*1.D-18 492 IF(EN.LE.(2.0*EIN(7))) GO TO 500 PEQIN(7,I)=PEQEL(2,(I-IOFFN(7))) C C 3 3D 500 IF(EN.LE.EIN(8)) GO TO 2000 IF(EN.GT.X33D(N33D)) GO TO 521 DO 510 J=2,N33D IF(EN.LE.X33D(J)) GO TO 520 510 CONTINUE J=N33D 520 A=(Y33D(J)-Y33D(J-1))/(X33D(J)-X33D(J-1)) B=(X33D(J-1)*Y33D(J)-X33D(J)*Y33D(J-1))/(X33D(J-1)-X33D(J)) QIN(8,I)=(A*EN+B)*1.D-18 GO TO 522 C IF ENERGY GT X33D(N33D) EV SCALE BY 1/E**3 521 QIN(8,I)=Y33D(N33D)*(X33D(N33D)/EN)*1.D-18 522 IF(EN.LE.(2.0*EIN(8))) GO TO 530 PEQIN(8,I)=PEQEL(2,(I-IOFFN(8))) C C 3 1D 530 IF(EN.LE.EIN(9)) GO TO 2000 IF(EN.GT.X31D(N31D)) GO TO 551 DO 540 J=2,N31D IF(EN.LE.X31D(J)) GO TO 550 540 CONTINUE J=N31D 550 A=(Y31D(J)-Y31D(J-1))/(X31D(J)-X31D(J-1)) B=(X31D(J-1)*Y31D(J)-X31D(J)*Y31D(J-1))/(X31D(J-1)-X31D(J)) QIN(9,I)=(A*EN+B)*1.D-18 GO TO 552 C IF ENERGY GT X31D(N31D) EV SCALE BY 1/E 551 QIN(9,I)=Y31D(N31D)*(X31D(N31D)/EN)*1.D-18 552 IF(EN.LE.(2.0*EIN(9))) GO TO 560 PEQIN(9,I)=PEQEL(2,(I-IOFFN(9))) C C 3 1P OSC STRENGTH F=0.07342 560 IF(EN.LE.EIN(10)) GO TO 2000 IF(EN.GT.X31P(N31P)) GO TO 581 DO 570 J=2,N31P IF(EN.LE.X31P(J)) GO TO 580 570 CONTINUE J=N31P 580 A=(Y31P(J)-Y31P(J-1))/(X31P(J)-X31P(J-1)) B=(X31P(J-1)*Y31P(J)-X31P(J)*Y31P(J-1))/(X31P(J-1)-X31P(J)) QIN(10,I)=(A*EN+B)*1.D-18 GO TO 582 C IF ENERGY GT X31P(N31P) EV THEN USE BEF SCALING 581 QIN(10,I)=0.07342/(EIN(10)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(10)))-BETA2)*BBCONST*EN/(EN+EIN(10)+E(3)) 582 IF(EN.LE.(2.0*EIN(10))) GO TO 590 PEQIN(10,I)=PEQEL(2,(I-IOFFN(10))) C C 4 3S 590 IF(EN.LE.EIN(11)) GO TO 2000 IF(EN.GT.X43S(N43S)) GO TO 611 DO 600 J=2,N43S IF(EN.LE.X43S(J)) GO TO 610 600 CONTINUE J=N43S 610 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(11,I)=(A*EN+B)*1.D-18 GO TO 612 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 611 QIN(11,I)=Y43S(N43S)*(X43S(N43S)/EN)**3*1.D-18 612 IF(EN.LE.(2.0*EIN(11))) GO TO 620 PEQIN(11,I)=PEQEL(2,(I-IOFFN(11))) C C 4 1S 620 IF(EN.LE.EIN(12)) GO TO 2000 IF(EN.GT.X41S(N41S)) GO TO 641 DO 630 J=2,N41S IF(EN.LE.X41S(J)) GO TO 640 630 CONTINUE J=N41S 640 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(12,I)=(A*EN+B)*1.D-18 GO TO 642 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 641 QIN(12,I)=Y41S(N41S)*(X41S(N41S)/EN)*1.D-18 642 IF(EN.LE.(2.0*EIN(12))) GO TO 650 PEQIN(12,I)=PEQEL(2,(I-IOFFN(12))) C C 4 3P 650 IF(EN.LE.EIN(13)) GO TO 2000 IF(EN.GT.X43P(N43P)) GO TO 671 DO 660 J=2,N43P IF(EN.LE.X43P(J)) GO TO 670 660 CONTINUE J=N43P 670 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(13,I)=(A*EN+B)*1.D-18 GO TO 672 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 671 QIN(13,I)=Y43P(N43P)*(X43P(N43P)/EN)**3*1.D-18 672 IF(EN.LE.(2.0*EIN(13))) GO TO 680 PEQIN(13,I)=PEQEL(2,(I-IOFFN(13))) C C 4 3D 680 IF(EN.LE.EIN(14)) GO TO 2000 IF(EN.GT.X43D(N43D)) GO TO 701 DO 690 J=2,N43D IF(EN.LE.X43D(J)) GO TO 700 690 CONTINUE J=N43P 700 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(14,I)=(A*EN+B)*1.D-18 GO TO 702 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 701 QIN(14,I)=Y43D(N43D)*(X43D(N43D)/EN)**3*1.D-18 702 IF(EN.LE.(2.0*EIN(14))) GO TO 710 PEQIN(14,I)=PEQEL(2,(I-IOFFN(14))) C C 4 1D 710 IF(EN.LE.EIN(15)) GO TO 2000 IF(EN.GT.X41D(N41D)) GO TO 731 DO 720 J=2,N41D IF(EN.LE.X41D(J)) GO TO 730 720 CONTINUE J=N41D 730 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(15,I)=(A*EN+B)*1.D-18 GO TO 732 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 731 QIN(15,I)=Y41D(N41D)*(X41D(N41D)/EN)*1.D-18 732 IF(EN.LE.(2.0*EIN(15))) GO TO 740 PEQIN(15,I)=PEQEL(2,(I-IOFFN(15))) C C 4 3F 740 IF(EN.LE.EIN(16)) GO TO 2000 IF(EN.GT.X43F(N43F)) GO TO 761 DO 750 J=2,N43F IF(EN.LE.X43F(J)) GO TO 760 750 CONTINUE J=N43F 760 A=(Y43F(J)-Y43F(J-1))/(X43F(J)-X43F(J-1)) B=(X43F(J-1)*Y43F(J)-X43F(J)*Y43F(J-1))/(X43F(J-1)-X43F(J)) QIN(16,I)=(A*EN+B)*1.D-18 GO TO 762 C IF ENERGY GT X43F(N43F) EV SCALE BY 1/E**4 761 QIN(16,I)=Y43F(N43F)*(X43F(N43F)/EN)**4*1.D-18 762 IF(EN.LE.(2.0*EIN(16))) GO TO 770 PEQIN(16,I)=PEQEL(2,(I-IOFFN(16))) C C 4 1F 770 IF(EN.LE.EIN(17)) GO TO 2000 IF(EN.GT.X41F(N41F)) GO TO 791 DO 780 J=2,N41F IF(EN.LE.X41F(J)) GO TO 790 780 CONTINUE J=N41F 790 A=(Y41F(J)-Y41F(J-1))/(X41F(J)-X41F(J-1)) B=(X41F(J-1)*Y41F(J)-X41F(J)*Y41F(J-1))/(X41F(J-1)-X41F(J)) QIN(17,I)=(A*EN+B)*1.D-18 GO TO 792 C IF ENERGY GT X41F(N41F) EV SCALE BY 1/E 791 QIN(17,I)=Y41F(N41F)*(X41F(N41F)/EN)*1.D-18 792 IF(EN.LE.(2.0*EIN(17))) GO TO 800 PEQIN(17,I)=PEQEL(2,(I-IOFFN(17))) C C 4 1P OSC STRENGTH F=0.02986 800 IF(EN.LE.EIN(18)) GO TO 2000 IF(EN.GT.X41P(N41P)) GO TO 821 DO 810 J=2,N41P IF(EN.LE.X41P(J)) GO TO 820 810 CONTINUE J=N41P 820 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(18,I)=(A*EN+B)*1.D-18 GO TO 822 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 821 QIN(18,I)=0.02986/(EIN(18)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(18)))-BETA2)*BBCONST*EN/(EN+EIN(18)+E(3)) 822 IF(EN.LE.(2.0*EIN(18))) GO TO 830 PEQIN(18,I)=PEQEL(2,(I-IOFFN(18))) C C 5 3S SCALED FROM 4 3S 830 IF(EN.LE.EIN(19)) GO TO 2000 ER=EIN(19)/EIN(11) ENP=EN/ER IF(ENP.GT.X43S(N43S)) GO TO 851 DO 840 J=2,N43S IF(ENP.LE.X43S(J)) GO TO 850 840 CONTINUE J=N43S 850 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(19,I)=0.512*(A*ENP+B)*1.D-18 GO TO 852 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 851 QIN(19,I)=0.512*Y43S(N43S)*(X43S(N43S)/ENP)**3*1.D-18 852 IF(EN.LE.(2.0*EIN(19))) GO TO 860 PEQIN(19,I)=PEQEL(2,(I-IOFFN(19))) C C 5 1S SCALED FROM 4 1S 860 IF(EN.LE.EIN(20)) GO TO 2000 ER=EIN(20)/EIN(12) ENP=EN/ER IF(ENP.GT.X41S(N41S)) GO TO 881 DO 870 J=2,N41S IF(ENP.LE.X41S(J)) GO TO 880 870 CONTINUE J=N41S 880 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(20,I)=0.512*(A*ENP+B)*1.D-18 GO TO 882 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 881 QIN(20,I)=0.512*Y41S(N41S)*(X41S(N41S)/ENP)*1.D-18 882 IF(EN.LE.(2.0*EIN(20))) GO TO 890 PEQIN(20,I)=PEQEL(2,(I-IOFFN(20))) C C 5 3P SCALED FROM 4 3P 890 IF(EN.LE.EIN(21)) GO TO 2000 ER=EIN(21)/EIN(13) ENP=EN/ER IF(ENP.GT.X43P(N43P)) GO TO 911 DO 900 J=2,N43P IF(ENP.LE.X43P(J)) GO TO 910 900 CONTINUE J=N43P 910 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(21,I)=0.512*(A*ENP+B)*1.D-18 GO TO 912 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 911 QIN(21,I)=0.512*Y43P(N43P)*(X43P(N43P)/ENP)**3*1.D-18 912 IF(EN.LE.(2.0*EIN(21))) GO TO 920 PEQIN(21,I)=PEQEL(2,(I-IOFFN(21))) C C 5 3D SCALED FROM 4 3D 920 IF(EN.LE.EIN(22)) GO TO 2000 ER=EIN(22)/EIN(14) ENP=EN/ER IF(ENP.GT.X43D(N43D)) GO TO 941 DO 930 J=2,N43D IF(ENP.LE.X43D(J)) GO TO 940 930 CONTINUE J=N43P 940 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(22,I)=0.512*(A*ENP+B)*1.D-18 GO TO 942 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 941 QIN(22,I)=0.512*Y43D(N43D)*(X43D(N43D)/ENP)**3*1.D-18 942 IF(EN.LE.(2.0*EIN(22))) GO TO 950 PEQIN(22,I)=PEQEL(2,(I-IOFFN(22))) C C 5 1D SCALED FROM 4 1D 950 IF(EN.LE.EIN(23)) GO TO 2000 ER=EIN(23)/EIN(15) ENP=EN/ER IF(ENP.GT.X41D(N41D)) GO TO 971 DO 960 J=2,N41D IF(ENP.LE.X41D(J)) GO TO 970 960 CONTINUE J=N41D 970 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(23,I)=0.512*(A*ENP+B)*1.D-18 GO TO 972 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 971 QIN(23,I)=0.512*Y41D(N41D)*(X41D(N41D)/ENP)*1.D-18 972 IF(EN.LE.(2.0*EIN(23))) GO TO 980 PEQIN(23,I)=PEQEL(2,(I-IOFFN(23))) C C 5 3F SCALED FROM 4 3F 980 IF(EN.LE.EIN(24)) GO TO 2000 ER=EIN(24)/EIN(16) ENP=EN/ER IF(ENP.GT.X43F(N43F)) GO TO 1001 DO 990 J=2,N43F IF(ENP.LE.X43F(J)) GO TO 1000 990 CONTINUE J=N43F 1000 A=(Y43F(J)-Y43F(J-1))/(X43F(J)-X43F(J-1)) B=(X43F(J-1)*Y43F(J)-X43F(J)*Y43F(J-1))/(X43F(J-1)-X43F(J)) QIN(24,I)=0.512*(A*ENP+B)*1.D-18 GO TO 1002 C IF ENERGY GT X43F(N43F) EV SCALE BY 1/E**4 1001 QIN(24,I)=0.512*Y43F(N43F)*(X43F(N43F)/ENP)**4*1.D-18 1002 IF(EN.LE.(2.0*EIN(24))) GO TO 1010 PEQIN(24,I)=PEQEL(2,(I-IOFFN(24))) C C 5 1F SCALED FROM 4 1F 1010 IF(EN.LE.EIN(25)) GO TO 2000 ER=EIN(25)/EIN(17) ENP=EN/ER IF(ENP.GT.X41F(N41F)) GO TO 1031 DO 1020 J=2,N41F IF(ENP.LE.X41F(J)) GO TO 1030 1020 CONTINUE J=N41F 1030 A=(Y41F(J)-Y41F(J-1))/(X41F(J)-X41F(J-1)) B=(X41F(J-1)*Y41F(J)-X41F(J)*Y41F(J-1))/(X41F(J-1)-X41F(J)) QIN(25,I)=0.512*(A*ENP+B)*1.D-18 GO TO 1032 C IF ENERGY GT X41F(N41F) EV SCALE BY 1/E 1031 QIN(25,I)=0.512*Y41F(N41F)*(X41F(N41F)/ENP)*1.D-18 1032 IF(EN.LE.(2.0*EIN(25))) GO TO 1040 PEQIN(25,I)=PEQEL(2,(I-IOFFN(25))) C C 5 1P SCALED FROM 4 1P OSC STRENGTH F=0.01504 1040 IF(EN.LE.EIN(26)) GO TO 2000 ER=EIN(26)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1061 DO 1050 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1060 1050 CONTINUE J=N41P 1060 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(26,I)=0.01504/0.02986*(A*ENP+B)*1.D-18 GO TO 1062 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1061 QIN(26,I)=0.01504/(EIN(26)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(26)))-BETA2)*BBCONST*EN/(EN+EIN(26)+E(3)) 1062 IF(EN.LE.(2.0*EIN(26))) GO TO 1070 PEQIN(26,I)=PEQEL(2,(I-IOFFN(26))) C C 6 3S SCALED FROM 4 3S 1070 IF(EN.LE.EIN(27)) GO TO 2000 ER=EIN(27)/EIN(11) ENP=EN/ER IF(ENP.GT.X43S(N43S)) GO TO 1091 DO 1080 J=2,N43S IF(ENP.LE.X43S(J)) GO TO 1090 1080 CONTINUE J=N43S 1090 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(27,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1092 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 1091 QIN(27,I)=0.296*Y43S(N43S)*(X43S(N43S)/ENP)**3*1.D-18 1092 IF(EN.LE.(2.0*EIN(27))) GO TO 1100 PEQIN(27,I)=PEQEL(2,(I-IOFFN(27))) C C 6 1S SCALED FROM 4 1S 1100 IF(EN.LE.EIN(28)) GO TO 2000 ER=EIN(28)/EIN(12) ENP=EN/ER IF(ENP.GT.X41S(N41S)) GO TO 1121 DO 1110 J=2,N41S IF(ENP.LE.X41S(J)) GO TO 1120 1110 CONTINUE J=N41S 1120 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(28,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1122 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 1121 QIN(28,I)=0.296*Y41S(N41S)*(X41S(N41S)/ENP)*1.D-18 1122 IF(EN.LE.(2.0*EIN(28))) GO TO 1130 PEQIN(28,I)=PEQEL(2,(I-IOFFN(28))) C C 6 3P SCALED FROM 4 3P 1130 IF(EN.LE.EIN(29)) GO TO 2000 ER=EIN(29)/EIN(13) ENP=EN/ER IF(ENP.GT.X43P(N43P)) GO TO 1151 DO 1140 J=2,N43P IF(ENP.LE.X43P(J)) GO TO 1150 1140 CONTINUE J=N43P 1150 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(29,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1152 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 1151 QIN(29,I)=0.296*Y43P(N43P)*(X43P(N43P)/ENP)**3*1.D-18 1152 IF(EN.LE.(2.0*EIN(29))) GO TO 1160 PEQIN(29,I)=PEQEL(2,(I-IOFFN(29))) C C 6 3D SCALED FROM 4 3D 1160 IF(EN.LE.EIN(30)) GO TO 2000 ER=EIN(30)/EIN(14) ENP=EN/ER IF(ENP.GT.X43D(N43D)) GO TO 1181 DO 1170 J=2,N43D IF(ENP.LE.X43D(J)) GO TO 1180 1170 CONTINUE J=N43P 1180 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(30,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1182 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 1181 QIN(30,I)=0.296*Y43D(N43D)*(X43D(N43D)/ENP)**3*1.D-18 1182 IF(EN.LE.(2.0*EIN(30))) GO TO 1190 PEQIN(30,I)=PEQEL(2,(I-IOFFN(30))) C C 6 1D SCALED FROM 4 1D 1190 IF(EN.LE.EIN(31)) GO TO 2000 ER=EIN(31)/EIN(15) ENP=EN/ER IF(ENP.GT.X41D(N41D)) GO TO 1211 DO 1200 J=2,N41D IF(ENP.LE.X41D(J)) GO TO 1210 1200 CONTINUE J=N41D 1210 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(31,I)=0.296*(A*ENP+B)*1.D-18 GO TO 1212 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 1211 QIN(31,I)=0.296*Y41D(N41D)*(X41D(N41D)/ENP)*1.D-18 1212 IF(EN.LE.(2.0*EIN(31))) GO TO 1220 PEQIN(31,I)=PEQEL(2,(I-IOFFN(31))) C C 6 1P SCALED FROM 4 1P OSC STRENGTH F=0.00863 1220 IF(EN.LE.EIN(32)) GO TO 2000 ER=EIN(32)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1241 DO 1230 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1240 1230 CONTINUE J=N41P 1240 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(32,I)=0.00863/0.02986*(A*ENP+B)*1.D-18 GO TO 1242 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1241 QIN(32,I)=0.00863/(EIN(32)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(32)))-BETA2)*BBCONST*EN/(EN+EIN(32)+E(3)) 1242 IF(EN.LE.(2.0*EIN(32))) GO TO 1250 PEQIN(32,I)=PEQEL(2,(I-IOFFN(32))) C C 7 3S SCALED FROM 4 3S 1250 IF(EN.LE.EIN(33)) GO TO 2000 ER=EIN(33)/EIN(11) ENP=EN/ER IF(ENP.GT.X43S(N43S)) GO TO 1271 DO 1260 J=2,N43S IF(ENP.LE.X43S(J)) GO TO 1270 1260 CONTINUE J=N43S 1270 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(33,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1272 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 1271 QIN(33,I)=0.187*Y43S(N43S)*(X43S(N43S)/ENP)**3*1.D-18 1272 IF(EN.LE.(2.0*EIN(33))) GO TO 1280 PEQIN(33,I)=PEQEL(2,(I-IOFFN(33))) C C 7 1S SCALED FROM 4 1S 1280 IF(EN.LE.EIN(34)) GO TO 2000 ER=EIN(34)/EIN(12) ENP=EN/ER IF(ENP.GT.X41S(N41S)) GO TO 1301 DO 1290 J=2,N41S IF(ENP.LE.X41S(J)) GO TO 1300 1290 CONTINUE J=N41S 1300 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(34,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1302 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 1301 QIN(34,I)=0.187*Y41S(N41S)*(X41S(N41S)/ENP)*1.D-18 1302 IF(EN.LE.(2.0*EIN(34))) GO TO 1310 PEQIN(34,I)=PEQEL(2,(I-IOFFN(34))) C C 7 3P SCALED FROM 4 3P 1310 IF(EN.LE.EIN(35)) GO TO 2000 ER=EIN(35)/EIN(13) ENP=EN/ER IF(ENP.GT.X43P(N43P)) GO TO 1331 DO 1320 J=2,N43P IF(ENP.LE.X43P(J)) GO TO 1330 1320 CONTINUE J=N43P 1330 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(35,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1332 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 1331 QIN(35,I)=0.187*Y43P(N43P)*(X43P(N43P)/ENP)**3*1.D-18 1332 IF(EN.LE.(2.0*EIN(35))) GO TO 1340 PEQIN(35,I)=PEQEL(2,(I-IOFFN(35))) C C 7 3D SCALED FROM 4 3D 1340 IF(EN.LE.EIN(36)) GO TO 2000 ER=EIN(36)/EIN(14) ENP=EN/ER IF(ENP.GT.X43D(N43D)) GO TO 1361 DO 1350 J=2,N43D IF(ENP.LE.X43D(J)) GO TO 1360 1350 CONTINUE J=N43P 1360 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(36,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1362 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 1361 QIN(36,I)=0.187*Y43D(N43D)*(X43D(N43D)/ENP)**3*1.D-18 1362 IF(EN.LE.(2.0*EIN(36))) GO TO 1370 PEQIN(36,I)=PEQEL(2,(I-IOFFN(36))) C C 7 1D SCALED FROM 4 1D 1370 IF(EN.LE.EIN(37)) GO TO 2000 ER=EIN(37)/EIN(15) ENP=EN/ER IF(ENP.GT.X41D(N41D)) GO TO 1391 DO 1380 J=2,N41D IF(ENP.LE.X41D(J)) GO TO 1390 1380 CONTINUE J=N41D 1390 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(37,I)=0.187*(A*ENP+B)*1.D-18 GO TO 1392 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 1391 QIN(37,I)=0.187*Y41D(N41D)*(X41D(N41D)/ENP)*1.D-18 1392 IF(EN.LE.(2.0*EIN(37))) GO TO 1400 PEQIN(37,I)=PEQEL(2,(I-IOFFN(37))) C C 7 1P SCALED FROM 4 1P OSC STRENGTH F=0.00540 1400 IF(EN.LE.EIN(38)) GO TO 2000 ER=EIN(38)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1421 DO 1410 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1420 1410 CONTINUE J=N41P 1420 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(38,I)=0.00540/0.02986*(A*ENP+B)*1.D-18 GO TO 1422 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1421 QIN(38,I)=0.00540/(EIN(38)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(38)))-BETA2)*BBCONST*EN/(EN+EIN(38)+E(3)) 1422 IF(EN.LE.(2.0*EIN(38))) GO TO 1430 PEQIN(38,I)=PEQEL(2,(I-IOFFN(38))) C C SUM 3S LEVELS FROM 8 3S HIGHER AND SCALED FROM 4 3S 1430 IF(EN.LE.EIN(39)) GO TO 2000 ER=EIN(39)/EIN(11) ENP=EN/ER IF(ENP.GT.X43S(N43S)) GO TO 1451 DO 1440 J=2,N43S IF(ENP.LE.X43S(J)) GO TO 1450 1440 CONTINUE J=N43S 1450 A=(Y43S(J)-Y43S(J-1))/(X43S(J)-X43S(J-1)) B=(X43S(J-1)*Y43S(J)-X43S(J)*Y43S(J-1))/(X43S(J-1)-X43S(J)) QIN(39,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1452 C IF ENERGY GT X43S(N43S) EV SCALE BY 1/E**3 1451 QIN(39,I)=0.553*Y43S(N43S)*(X43S(N43S)/ENP)**3*1.D-18 1452 IF(EN.LE.(2.0*EIN(39))) GO TO 1460 PEQIN(39,I)=PEQEL(2,(I-IOFFN(39))) C C SUM 1S LEVELS FROM 8 1S HIGHER AND SCALED FROM 4 1S 1460 IF(EN.LE.EIN(40)) GO TO 2000 ER=EIN(40)/EIN(12) ENP=EN/ER IF(ENP.GT.X41S(N41S)) GO TO 1481 DO 1470 J=2,N41S IF(ENP.LE.X41S(J)) GO TO 1480 1470 CONTINUE J=N41S 1480 A=(Y41S(J)-Y41S(J-1))/(X41S(J)-X41S(J-1)) B=(X41S(J-1)*Y41S(J)-X41S(J)*Y41S(J-1))/(X41S(J-1)-X41S(J)) QIN(40,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1482 C IF ENERGY GT X41S(N41S) EV SCALE BY 1/E 1481 QIN(40,I)=0.553*Y41S(N41S)*(X41S(N41S)/ENP)*1.D-18 1482 IF(EN.LE.(2.0*EIN(40))) GO TO 1490 PEQIN(40,I)=PEQEL(2,(I-IOFFN(40))) C C SUM 3P LEVELS FROM 8 3P HIGHER AND SCALED FROM 4 3P 1490 IF(EN.LE.EIN(41)) GO TO 2000 ER=EIN(41)/EIN(13) ENP=EN/ER IF(ENP.GT.X43P(N43P)) GO TO 1511 DO 1500 J=2,N43P IF(ENP.LE.X43P(J)) GO TO 1510 1500 CONTINUE J=N43P 1510 A=(Y43P(J)-Y43P(J-1))/(X43P(J)-X43P(J-1)) B=(X43P(J-1)*Y43P(J)-X43P(J)*Y43P(J-1))/(X43P(J-1)-X43P(J)) QIN(41,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1512 C IF ENERGY GT X43P(N43P) EV SCALE BY 1/E**3 1511 QIN(41,I)=0.553*Y43P(N43P)*(X43P(N43P)/ENP)**3*1.D-18 1512 IF(EN.LE.(2.0*EIN(41))) GO TO 1520 PEQIN(41,I)=PEQEL(2,(I-IOFFN(41))) C C SUM 3D LEVELS FROM 8 3D HIGHER AND SCALED FROM 4 3D 1520 IF(EN.LE.EIN(42)) GO TO 2000 ER=EIN(42)/EIN(14) ENP=EN/ER IF(ENP.GT.X43D(N43D)) GO TO 1541 DO 1530 J=2,N43D IF(ENP.LE.X43D(J)) GO TO 1540 1530 CONTINUE J=N43P 1540 A=(Y43D(J)-Y43D(J-1))/(X43D(J)-X43D(J-1)) B=(X43D(J-1)*Y43D(J)-X43D(J)*Y43D(J-1))/(X43D(J-1)-X43D(J)) QIN(42,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1542 C IF ENERGY GT X43D(N43D) EV SCALE BY 1/E**3 1541 QIN(42,I)=0.553*Y43D(N43D)*(X43D(N43D)/ENP)**3*1.D-18 1542 IF(EN.LE.(2.0*EIN(42))) GO TO 1550 PEQIN(42,I)=PEQEL(2,(I-IOFFN(42))) C C SUM 1D LEVELS FROM 8 1D HIGHER AND SCALED FROM 4 1D 1550 IF(EN.LE.EIN(43)) GO TO 2000 ER=EIN(43)/EIN(15) ENP=EN/ER IF(ENP.GT.X41D(N41D)) GO TO 1571 DO 1560 J=2,N41D IF(ENP.LE.X41D(J)) GO TO 1570 1560 CONTINUE J=N41D 1570 A=(Y41D(J)-Y41D(J-1))/(X41D(J)-X41D(J-1)) B=(X41D(J-1)*Y41D(J)-X41D(J)*Y41D(J-1))/(X41D(J-1)-X41D(J)) QIN(43,I)=0.553*(A*ENP+B)*1.D-18 GO TO 1572 C IF ENERGY GT X41D(N41D) EV SCALE BY 1/E 1571 QIN(43,I)=0.553*Y41D(N41D)*(X41D(N41D)/ENP)*1.D-18 1572 IF(EN.LE.(2.0*EIN(43))) GO TO 1580 PEQIN(43,I)=PEQEL(2,(I-IOFFN(43))) C C 8 1P SCALED FROM 4 1P OSC STRENGTH F=0.00362 1580 IF(EN.LE.EIN(44)) GO TO 2000 ER=EIN(44)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1601 DO 1590 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1600 1590 CONTINUE J=N41P 1600 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(44,I)=0.00362/0.02986*(A*ENP+B)*1.D-18 GO TO 1602 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1601 QIN(44,I)=0.00362/(EIN(44)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(44)))-BETA2)*BBCONST*EN/(EN+EIN(44)+E(3)) 1602 IF(EN.LE.(2.0*EIN(44))) GO TO 1610 PEQIN(44,I)=PEQEL(2,(I-IOFFN(44))) C C 9 1P SCALED FROM 4 1P OSC STRENGTH F=0.00253 1610 IF(EN.LE.EIN(45)) GO TO 2000 ER=EIN(45)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1631 DO 1620 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1630 1620 CONTINUE J=N41P 1630 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(45,I)=0.00253/0.02986*(A*ENP+B)*1.D-18 GO TO 1632 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1631 QIN(45,I)=0.00253/(EIN(45)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(45)))-BETA2)*BBCONST*EN/(EN+EIN(45)+E(3)) 1632 IF(EN.LE.(2.0*EIN(45))) GO TO 1640 PEQIN(45,I)=PEQEL(2,(I-IOFFN(45))) C C 10 1P SCALED FROM 4 1P OSC STRENGTH F=0.00184 1640 IF(EN.LE.EIN(46)) GO TO 2000 ER=EIN(46)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1661 DO 1650 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1660 1650 CONTINUE J=N41P 1660 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(46,I)=0.00184/0.02986*(A*ENP+B)*1.D-18 GO TO 1662 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1661 QIN(46,I)=0.00184/(EIN(46)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(46)))-BETA2)*BBCONST*EN/(EN+EIN(46)+E(3)) 1662 IF(EN.LE.(2.0*EIN(46))) GO TO 1670 PEQIN(46,I)=PEQEL(2,(I-IOFFN(46))) C C 11 1P SCALED FROM 4 1P OSC STRENGTH F=0.00138 1670 IF(EN.LE.EIN(47)) GO TO 2000 ER=EIN(47)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1691 DO 1680 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1690 1680 CONTINUE J=N41P 1690 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(47,I)=0.00138/0.02986*(A*ENP+B)*1.D-18 GO TO 1692 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1691 QIN(47,I)=0.00138/(EIN(47)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(47)))-BETA2)*BBCONST*EN/(EN+EIN(47)+E(3)) 1692 IF(EN.LE.(2.0*EIN(47))) GO TO 1700 PEQIN(47,I)=PEQEL(2,(I-IOFFN(47))) C C 12 1P SCALED FROM 4 1P OSC STRENGTH F=0.00106 1700 IF(EN.LE.EIN(48)) GO TO 2000 ER=EIN(48)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1721 DO 1710 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1720 1710 CONTINUE J=N41P 1720 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(48,I)=0.00106/0.02986*(A*ENP+B)*1.D-18 GO TO 1722 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1721 QIN(48,I)=0.00106/(EIN(48)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(48)))-BETA2)*BBCONST*EN/(EN+EIN(48)+E(3)) 1722 IF(EN.LE.(2.0*EIN(48))) GO TO 1730 PEQIN(48,I)=PEQEL(2,(I-IOFFN(48))) C C SUM HIGHER 1P LEVELS OSC STRENGTH F=0.00440 1730 IF(EN.LE.EIN(49)) GO TO 2000 ER=EIN(49)/EIN(18) ENP=EN/ER IF(ENP.GT.X41P(N41P)) GO TO 1751 DO 1740 J=2,N41P IF(ENP.LE.X41P(J)) GO TO 1750 1740 CONTINUE J=N41P 1750 A=(Y41P(J)-Y41P(J-1))/(X41P(J)-X41P(J-1)) B=(X41P(J-1)*Y41P(J)-X41P(J)*Y41P(J-1))/(X41P(J-1)-X41P(J)) QIN(49,I)=0.00440/0.02986*(A*ENP+B)*1.D-18 GO TO 1752 C IF ENERGY GT X41P(N41P) EV USE BEF SCALING 1751 QIN(49,I)=0.00440/(EIN(49)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(49)))-BETA2)*BBCONST*EN/(EN+EIN(49)+E(3)) 1752 IF(EN.LE.(2.0*EIN(49))) GO TO 1760 PEQIN(49,I)=PEQEL(2,(I-IOFFN(49))) 1760 CONTINUE C 2000 CONTINUE C QMET=QIN(1,I)+QIN(2,I) QDIP=QIN(4,I)+QIN(10,I)+QIN(18,I)+QIN(26,I)+QIN(32,I)+QIN(38,I)+ /QIN(44,I)+QIN(45,I)+QIN(46,I)+QIN(47,I)+QIN(48,I)+QIN(49,I) QTRP=QIN(1,I)+QIN(3,I)+QIN(5,I)+QIN(7,I)+QIN(8,I)+QIN(11,I)+ /QIN(13,I)+QIN(14,I)+QIN(16,I)+QIN(19,I)+QIN(21,I)+QIN(22,I)+ /QIN(24,I)+QIN(27,I)+QIN(29,I)+QIN(30,I)+QIN(33,I)+QIN(35,I)+ /QIN(36,I)+QIN(39,I)+QIN(41,I)+QIN(42,I) QSNG=QIN(2,I)+QIN(4,I)+QIN(6,I)+QIN(9,I)+QIN(10,I)+QIN(12,I)+ /QIN(15,I)+QIN(17,I)+QIN(18,I)+QIN(20,I)+QIN(23,I)+QIN(25,I)+ /QIN(26,I)+QIN(28,I)+QIN(31,I)+QIN(32,I)+QIN(34,I)+QIN(37,I)+ /QIN(38,I)+QIN(40,I)+QIN(43,I)+QIN(44,I)+QIN(45,I)+QIN(46,I)+ /QIN(47,I)+QIN(48,I)+QIN(49,I) QINEL=QSNG+QTRP+Q(5,I) Q(1,I)=QELA+QINEL C EXAMINE X-SECTION DATA C WRITE(6,986) EN,QIN(4,I),QIN(10,I),QIN(18,I),QIN(26,I),QIN(32,I), C /QIN(38,I),QIN(44,I),QIN(45,I),QIN(46,I),QIN(47,I),QIN(48,I), C /QIN(49,I) C 986 FORMAT(' EN=',D11.5,' 21P=',D11.3,' 31P=',D11.3,' 41P=',D11.3,' 51 C /P=',D11.3,' 61P=',D11.3,' 71P=',D11.3,/,8X,' 81P=',D11.3,' 91P=',D C /11.3,' 101P=',D11.3,' 111P=',D11.3,' 121P=',D11.3,' HIP=',D11.3) C WRITE(6,987) EN,QMET,QDIP,QSNG,QTRP,QINEL,Q(1,I) C 987 FORMAT(' EN=',D12.5,' QMET=',D11.3,' QDIP=',D11.3,' QSNG=',D11.3, C /'QTRP=',D11.3,' QINL=',D11.4,' QTOT=',D11.4) 9000 CONTINUE C SAVE COMPUTE TIME DO 9001 K=1,NIN IF(EFINAL.LE.EIN(K)) THEN NIN=K-1 GO TO 9011 ENDIF 9001 CONTINUE 9011 CONTINUE RETURN END SUBROUTINE GAS5(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(87),YXSEC(87),XEL(84),YEL(84),XEPS(158),YEPS(158), /XION(74),YION(74),YINC(74), /X1S5(111),Y1S5(111),X1S4(137),Y1S4(137),X1S3(117),Y1S3(117), /X1S2(119),Y1S2(119),X2P10(73),Y2P10(73),X2P9(70),Y2P9(70), /X2P8(72),Y2P8(72),X2P7(65),Y2P7(65),X2P6(59),Y2P6(59), /X2P5(63),Y2P5(63),X2P4(66),Y2P4(66),X2P3(62),Y2P3(62), /X2P2(62),Y2P2(62),X2P1(59),Y2P1(59),X2S5(19),Y2S5(19), /X2S3(19),Y2S3(19),X3D6(12),Y3D6(12),X3D4P(12),Y3D4P(12), /X3D4(12),Y3D4(12),X3D3(12),Y3D3(12),X3D1PP(12),Y3D1PP(12), /X3D1P(12),Y3D1P(12),X3S1PPPP(12),Y3S1PPPP(12), /X3S1PPP(12),Y3S1PPP(12),X3S1PP(12),Y3S1PP(12), /X3P106(16),Y3P106(16),X3P52(16),Y3P52(16),X3P1(16),Y3P1(16), /IOFFN(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.,250.,300.,350.,400.,500.,600.,700.,800., /900.,1000.,1500.,2000.,2500.,3000.,3500.,4000.,5000.,6000., /7000.,8000.,9000.,1.0D4,1.5D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4, /6.0D4,7.0D4,8.0D4,9.0D4,1.0D5,1.25D5,1.50D5,1.75D5,2.0D5,2.5D5, /3.0D5,4.0D5,5.0D5,6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.25D6,1.50D6, /1.75D6,2.0D6,3.0D6,4.0D6,6.0D6,8.0D6,1.0D7/ 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,.585,.474,.385,.321,.234,.180,.143,.117, /.0977,.0830,.0435,.0271,.0187,.0137,.0105,.00833,.00565,.00410, /.00312,.00246,.0020,.00166,.0008,.000478,.00032,.000231,.000138, /9.28D-5, /6.72D-5,5.12D-5,4.05D-5,3.30D-5,2.75D-5,1.88D-5,1.38D-5,1.06D-5, /8.54D-6,5.9D-6, /4.43D-6,2.81D-6,1.99D-6,1.50D-6,1.19D-6,9.71D-7,8.12D-7,6.91D-7, /4.95D-7,3.74D-7, /2.94D-7,2.38D-7,1.24D-7,7.74D-8,3.89D-8,2.36D-8,1.59D-8/ 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.,7000.,8000.,9000., /1.0D4,1.5D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5,2.5D5,3.0D5,4.0D5,5.0D5, /6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.25D6,1.5D6,1.75D6,2.0D6,3.0D6, /4.0D6,6.0D6,8.0D6,1.0D7/ 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.69,3.61,3.50,3.27, /3.09,2.90,2.72,2.54,2.40,2.25,1.96,1.74,1.39,1.21, /1.06,.997,.893,.799,.693,.640,.565,.545,.483,.433, /.359,.284,.223,.191,.156,.125,.109,.096,.0850,.0770, /.0710,.0500,.0389,.0317,.0269,.0208,.0172,.0147,.0129,.0116, /.0106,.00977,.00829,.00731,.00661,.00608,.00636,.00488,.00430, /.00396, /.00374,.00358,.00347,.00339,.00333,.00322,.00315,.00310,.00307, /.00301,.00298,.00296,.00296,.00295/ C ANGULAR DISTRIBUTION PARAMETER EPSILON DATA XEPS/0.0,.0001,.0002,.0003,.0004,.0005,.0006,.0008,.001, /.0012, /.0014,.0016,.0018,.0020,.0024,.0028,.0032,.0036,.0040,.0045, /.0050,.0055,.0060,.0070,.0080,.0090,.0100,.0120,.0140,.0160, /.0180,.0200,.0240,.0280,.0320,.0360,.0400,.0450,.0500,.0550, /0.060,0.070,0.080,0.090,0.100,0.120,0.140,0.160,0.180,0.200, /0.24,0.28,0.32,0.36,0.40,0.45,0.50,0.55,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,8.71,9.00,10.0,11.0,12.0,13.6, /14.0,15.0,16.0,16.5,18.0,19.6,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,77.0,80.0,90.0,100.,125.,130.,150., /170.,200.,250.,300.,350.,400.,500.,600.,700.,800., /900.,1000.,1200.,1500.,2000.,2500.,3000.,3500.,4000.,5000., /6000.,7000.,8000.,9000.,1.0D4,1.5D4,2.0D4,2.5D4,3.0D4,4.0D4, /5.0D4,6.0D4,7.0D4,8.0D4,9.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5, /2.5D5,3.0D5,4.0D5,5.0D5,6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.25D6, /1.5D6,1.75D6,2.0D6,3.0D6,4.0D6,6.0D6,8.0D6,1.0D7/ DATA YEPS/0.0,-.02100,-.02805,-.03494,-.03914,-.04259,-.04678, /-.05337,-.05831,-.06325, /-.06804,-.07208,-.07522,-.07761,-.08388,-.09015,-.09478,-.09866, /-.10254,-.10730, /-.11177,-.11579,-.11891,-.12531,-.13154,-.13659,-.14163,-.14918, /-.15613,-.16248, /-.16779,-.17310,-.18075,-.18722,-.19324,-.19778,-.20202,-.20656, /-.21006,-.21313, /-.21604,-.22041,-.22362,-.22580,-.22725,-.22929,-.22929,-.22856, /-.22711,-.22478, /-.21852,-.21196,-.20422,-.19734,-.18766,-.17649,-.16544,-.15332, /-.14133,-.11787, /-.09463,-.07058,-.04888,-.00900,0.05765,0.11566,0.14122,0.20654, /0.25109,0.32789, /.37941,.40815,.41670,.42042,.41243,.41099,.40593,.39969,.39828, /.38331, /.38303,.37506,.36827,.36259,.35193,.34064,.33744,.31351,.27839, /.22252, /.24457,.30446,.32377,.31932,.33189,.39491,.45872,.50382,.52062, /.56896, /.60358,.62484,.69036,.72708,.78414,.80724,.85978,.88320,.90677, /.91667, /.93247,.93647,.94508,.96121,.97204,.97651,.98092,.98344,.98703, /.98954, /.99172,.99311,.99405,.99480,.99543,.99713,.99791,.998626,.998640, /.999047, /.999212,.999350,.999449,.999525,.999584,.999629,.999711,.999765, /.999805,.999832, /.999895,.999898,.999929,.999947,.999959,.999967,.999972,.9999769, /.9999803,.9999858, /.9999893,.9999917,.9999933,.9999966,.9999980,.9999990,.9999994, /.9999996/ C IONISATION (VALUES ABOVE 20KEV GENERATED BY BORN-BETHE IN SUB) DATA XION/21.56454,22.0,22.5,23.0,23.5,24.0,24.5,25.0,25.5,26.0, /26.5,27.0,27.5,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.,130.,140.,150.,160.,170.,180.,190.,200., /225.,250.,275.,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./ C GROSS IONISATION DATA YION/0.00,.0031,.0085,.0139,.0192,.0248,.0306,.0362,.0417, /.0474, /.0540,.0602,.0664,.0726,.0847,.0971,.122,.147,.170,.217, /.269,.322,.372,.414,.454,.490,.521,.549,.598,.635, /.667,.690,.707,.721,.735,.746,.747,.748,.746,.745, /.737,.723,.703,.682,.648,.607,.549,.501,.457,.420, /.387,.363,.320,.287,.261,.239,.222,.186,.163,.143, /.130,.117,.108,.100,.0937,.0826,.0742,.0678,.0623,.0540, /.0475,.0426,.0389,.0357/ C COUNTING IONISATION DATA YINC/0.00,.0031,.0085,.0139,.0192,.0248,.0306,.0362,.0417, /.0474, /.0540,.0602,.0664,.0726,.0847,.0971,.122,.147,.170,.217, /.269,.322,.372,.414,.454,.490,.521,.548,.595,.630, /.657,.678,.692,.703,.714,.721,.721,.720,.717,.715, /.705,.690,.670,.650,.616,.577,.522,.476,.435,.400, /.369,.345,.305,.273,.248,.228,.211,.177,.155,.136, /.124,.111,.103,.0951,.0891,.0786,.0706,.0645,.0592,.0513, /.0451,.0406,.0370,.0340/ C C 1S5 METASTABLE J=2 UNITS 10**-18 DATA X1S5/16.61907,16.625,16.63,16.64,16.65,16.66,16.67,16.68, /16.69,16.70, /16.71,16.73,16.75,16.79,16.80,16.81,16.82,16.84,16.85,16.86, /16.87,16.88,16.89,16.90,16.91,16.92,16.93,16.94,16.95,16.96, /16.97,16.98,16.99,17.00,17.02,17.04,17.06,17.08,17.10,17.20, /17.30,17.40,17.50,17.60,17.70,17.80,17.90,18.00,18.10,18.20, /18.30,18.40,18.41,18.43,18.45,18.47,18.50,18.53,18.55,18.56, /18.57,18.58,18.59,18.60,18.61,18.62,18.625,18.63,18.64,18.65, /18.66,18.67,18.68,18.69,18.70,18.71,18.72,18.73,18.75,18.78, /18.80,18.90,18.96,18.97,18.98,18.99,19.00,19.05,19.10,19.20, /19.50,19.58,19.60,19.61,19.63,19.65,19.70,19.80,19.90,20.00, /21.0,22.0,23.0,24.0,26.0,28.0,30.0,35.0,40.0,45.0, /50.0/ DATA Y1S5/0.0,.114,.142,.190,.228,.256,.275,.304,.342,.399, /.446,.532,.598,.646,.665,.674,.693,.750,.788,.845, /.902,1.09,1.27,1.47,1.59,1.65,1.65,1.59,1.52,1.44, /1.35,1.28,1.20,1.16,1.03,.988,.931,.893,.864,.807, /.807,.826,.864,.912,.978,1.03,1.11,1.19,1.26,1.34, /1.40,1.42,1.30,1.21,1.15,1.12,1.07,1.02,1.24,1.55, /2.13,2.02,1.64,1.23,1.12,1.56,1.70,1.55,1.10,1.28, /1.58,1.72,1.65,1.42,1.25,1.10,.988,.959,.883,.827, /.817,.836,.779,.931,1.21,1.14,1.02,1.01,1.04,1.08, /1.15,1.07,1.01,1.33,1.27,1.23,1.21,1.17,1.14,1.03, /1.04,1.04,1.03,1.02,.998,.959,.902,.760,.608,.475, /.361/ C 1S4 RESONANCE LEVEL J=1 F=0.0118 UNITS 10**-18 74.3724 NM. DATA X1S4/16.67083,16.675,16.68,16.69,16.70,16.71,16.72,16.73, /16.74,16.75, /16.76,16.77,16.78,16.79,16.80,16.81,16.82,16.83,16.84,16.85, /16.86,16.87,16.88,16.89,16.90,16.91,16.92,16.93,16.94,16.95, /16.96,16.97,16.98,16.99,17.00,17.02,17.04,17.06,17.08,17.10, /17.20,17.30,17.40,17.50,17.60,17.70,17.80,17.90,18.00,18.10, /18.20,18.30,18.40,18.41,18.42,18.43,18.44,18.45,18.47,18.50, /18.52,18.525,18.53,18.54,18.55,18.56,18.57,18.58,18.59,18.60, /18.61,18.62,18.63,18.64,18.65,18.66,18.67,18.68,18.69,18.70, /18.71,18.72,18.73,18.74,18.75,18.76,18.78,18.80,18.90,18.94, /18.96,18.98,18.99,19.00,19.05,19.10,19.20,19.30,19.40,19.50, /19.7,19.9,20.0,21.0,22.0,23.0,24.0,25.0,26.0,27.0, /28.0,30.0,32.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0, /90.0,100.,120.,140.,170.,200.,250.,300.,350.,400., /450.,500.,600.,700.,800.,900.,1000./ DATA Y1S4/0.,.082,.109,.149,.192,.239,.295,.364,.439,.510, /.572,.623,.665,.697,.728,.762,.798,.845,.900,.959, /1.04,1.13,1.21,1.23,1.23,1.18,1.11,1.04,.978,.918, /.852,.824,.784,.750,.722,.674,.646,.608,.598,.580, /.541,.541,.551,.570,.598,.627,.665,.712,.760,.807, /.855,.893,.893,.855,.836,.807,.798,.798,.779,.760, /.760,.874,.770,.788,.836,.978,1.26,1.29,.978,.760, /.788,1.08,.864,.770,.940,1.19,1.41,1.33,1.16,1.04, /.959,.931,.827,.779,.732,.693,.646,.617,.589,.560, /.570,.817,.712,.684,.693,.712,.741,.760,.779,.798, /.817,.808,.770,.810,.850,.890,.920,.940,.960,.990, /1.00,1.02,1.04,1.05,1.06,1.06,1.05,1.04,1.02,.990, /.950,.880,.800,.730,.670,.600,.530,.460,.410,.370, /.338,.310,.270,.239,.217,.198,.184/ C 1S3 METASTABLE LEVEL J=0 UNITS 10**-18 DATA X1S3/16.71538,16.72,16.73,16.74,16.75,16.76,16.77,16.78, /16.79,16.80, /16.81,16.82,16.83,16.84,16.85,16.86,16.87,16.88,16.89,16.90, /16.91,16.92,16.93,16.94,16.95,16.96,16.97,16.98,17.00,17.02, /17.04,17.06,17.08,17.10,17.12,17.14,17.16,17.18,17.20,17.22, /17.26,17.34,17.40,17.45,17.50,17.60,17.70,17.80,17.90,18.00, /18.10,18.20,18.30,18.40,18.41,18.43,18.45,18.47,18.50,18.52, /18.525,18.53,18.54,18.55,18.56,18.57,18.58,18.59,18.60,18.61, /18.62,18.63,18.64,18.65,18.66,18.67,18.68,18.69,18.70,18.71, /18.72,18.73,18.74,18.75,18.76,18.78,18.80,18.82,18.84,18.86, /18.88,18.90,18.92,18.94,18.95,18.96,18.97,18.98,18.99,19.00, /19.05,19.10,19.20,19.30,19.40,19.50,19.60,19.65,19.70,19.80, /19.9,20.0,25.0,30.0,35.0,40.0,50.0/ DATA Y1S3/0.,.025,.038,.046,.054,.063,.078,.095,.117,.144, /.175,.205,.238,.274,.311,.350,.387,.415,.420,.408, /.387,.361,.341,.319,.298,.284,.268,.251,.229,.201, /.197,.186,.176,.170,.165,.161,.159,.157,.155,.153, /.152,.152,.154,.157,.161,.168,.178,.190,.203,.217, /.231,.243,.256,.255,.244,.229,.226,.225,.218,.210, /.335,.220,.218,.226,.253,.343,.427,.315,.230,.235, /.325,.260,.223,.247,.376,.537,.524,.457,.402,.365, /.328,.299,.274,.251,.229,.201,.179,.166,.158,.154, /.150,.146,.141,.130,.126,.134,.214,.249,.199,.189, /.188,.194,.204,.212,.218,.223,.226,.219,.213,.232, /.228,.221,.210,.175,.145,.125,.085/ C 1S2 RESONANCE LEVEL J=1 F=0.159 UNITS 10**-18 73.5901 NM. DATA X1S2/16.84805,16.86,16.87,16.88,16.89,16.90,16.91,16.92, /16.93,16.94, /16.95,16.96,16.98,17.00,17.05,17.10,17.20,17.30,17.40,17.50, /17.60,17.70,17.80,17.90,18.00,18.10,18.20,18.30,18.40,18.42, /18.44,18.46,18.49,18.51,18.53,18.54,18.55,18.56,18.57,18.58, /18.59,18.60,18.61,18.62,18.63,18.64,18.65,18.66,18.67,18.68, /18.69,18.70,18.71,18.72,18.73,18.74,18.76,18.78,18.80,18.85, /18.90,18.92,18.94,18.95,18.96,18.97,18.98,19.00,19.05,19.10, /19.20,19.30,19.40,19.50,19.60,19.70,19.80,19.90,20.00,20.50, /21.0,21.5,22.0,23.0,24.0,25.0,26.0,27.0,28.0,29.0, /30.0,31.0,32.0,33.0,34.0,35.0,36.0,37.0,38.0,39.0, /40.0,41.0,42.0,43.0,45.0,50.0,60.0,70.0,80.0,100., /120.,150.,180.,200.,240.,280.,320.,360.,400./ DATA Y1S2/0.,.230,.513,.864,1.23,1.59,1.83,2.00,2.10,2.16, /2.18,2.15,2.12,2.04,1.86,1.73,1.57,1.49,1.46,1.45, /1.46,1.50,1.54,1.60,1.67,1.75,1.82,1.89,1.99,2.01, /2.03,2.05,2.06,2.11,2.05,1.97,2.06,2.15,2.14,2.01, /1.96,2.02,2.00,1.98,1.94,2.03,2.25,2.37,2.30,2.21, /2.13,2.09,2.04,2.01,1.99,1.95,1.91,1.88,1.88,1.91, /2.01,2.11,2.27,2.29,1.96,1.86,1.93,1.96,1.99,2.01, /2.06,2.10,2.15,2.18,2.25,2.29,2.28,2.32,2.36,2.56, /2.66,2.80,3.07,3.63,4.22,4.88,5.45,6.00,6.57,7.07, /7.52,7.90,8.28,8.60,8.87,9.10,9.30,9.48,9.63,9.76, /9.87,9.96,10.0,10.1,10.2,10.3,10.4,10.3,10.0,9.45, /9.00,8.00,7.20,6.80,6.10,5.50,5.05,4.73,4.45/ C 2P10 J=1 UNITS 10**-18 SCALE 1/E**2 ABOVE 100 EV DATA X2P10/18.38162,18.39,18.40,18.42,18.43,18.44,18.46,18.47, /18.48,18.49, /18.50,18.509,18.51,18.52,18.53,18.54,18.55,18.56,18.57,18.58, /18.59,18.60,18.61,18.62,18.63,18.64,18.65,18.66,18.67,18.68, /18.69,18.70,18.71,18.72,18.74,18.80,18.90,18.92,18.95,18.96, /18.97,19.00,19.10,19.20,19.30,19.40,19.50,19.56,19.57,19.58, /19.59,19.60,19.70,19.80,19.90,20.0,21.0,22.0,23.0,24.0, /25.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,50.0, /60.0,75.0,100./ DATA Y2P10/0.00,.060,.091,.201,.261,.287,.310,.328,.354,.389, /.440,.589,.394,.574,.716,.960,1.23,1.03,.440,.229, /.481,1.16,.777,.606,.863,1.03,1.08,.690,.346,.191, /.117,.085,.081,.074,.068,.062,.064,.095,.597,.580, /.278,.164,.143,.138,.136,.135,.136,.147,.163,.201, /.142,.135,.123,.120,.142,.153,.200,.237,.275,.294, /.309,.318,.328,.332,.328,.323,.313,.304,.285,.200, /.140,.090,.049/ C 2P9 J=3 UNITS 10**-18 SCALE 1/E**2 ABOVE 100 EV DATA X2P9/18.55511,18.56,18.57,18.58,18.59,18.60,18.61,18.62, /18.63,18.64, /18.65,18.66,18.67,18.68,18.69,18.70,18.71,18.72,18.73,18.74, /18.75,18.77,18.80,18.82,18.85,18.88,18.90,18.92,18.94,18.96, /18.97,18.98,18.99,19.00,19.10,19.20,19.30,19.40,19.50,19.55, /19.59,19.60,19.70,19.80,19.90,20.00,20.10,20.20,20.30,20.40, /20.6,20.8,21.0,22.0,24.0,26.0,28.0,30.0,32.0,34.0, /38.0,42.0,46.0,50.0,55.0,60.0,70.0,80.0,90.0,100./ DATA Y2P9/0.0,.093,.157,.233,.183,.114,.092,.132,.102,.116, /.164,.322,.472,.392,.286,.218,.175,.148,.133,.123, /.119,.116,.120,.124,.131,.139,.147,.163,.193,.300, /.320,.180,.128,.131,.135,.142,.151,.159,.171,.179, /.213,.143,.178,.195,.215,.205,.222,.242,.257,.268, /.286,.307,.328,.418,.465,.503,.513,.503,.484,.456, /.404,.332,.285,.256,.204,.171,.128,.097,.078,.062/ C 2P8 J=2 UNITS 10**-18 SCALE BY 1/E ABOVE 60 EV DATA X2P8/18.57583,18.58,18.59,18.60,18.61,18.62,18.63,18.64, /18.65,18.66, /18.67,18.68,18.69,18.70,18.71,18.72,18.74,18.76,18.78,18.80, /18.82,18.84,18.86,18.88,18.90,18.92,18.94,18.96,18.98,19.00, /19.05,19.10,19.20,19.30,19.40,19.50,19.58,19.60,19.62,19.65, /19.68,19.70,19.80,19.90,20.00,20.10,20.20,20.40,20.60,20.80, /21.0,22.0,23.0,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0, /55.0,60.0/ DATA Y2P8/0.0,.142,.198,.206,.250,.193,.158,.172,.403,.506, /.467,.420,.381,.353,.326,.308,.275,.249,.229,.214, /.201,.195,.192,.192,.194,.200,.215,.271,.206,.177, /.177,.179,.185,.192,.200,.207,.205,.243,.228,.224, /.228,.192,.218,.239,.260,.272,.289,.315,.339,.364, /.385,.437,.475,.513,.537,.546,.551,.551,.546,.532, /.513,.494,.475,.456,.437,.423,.408,.394,.385,.370, /.337,.313/ C 2P7 J=1 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 60 EV DATA X2P7/18.61270,18.62,18.63,18.64,18.65,18.66,18.67,18.68, /18.69,18.70, /18.71,18.72,18.74,18.76,18.80,18.85,18.90,18.92,18.93,18.94, /18.95,18.96,18.97,18.98,18.99,19.00,19.05,19.10,19.20,19.30, /19.50,19.60,19.68,18.70,19.80,19.90,20.00,20.10,20.20,20.30, /20.4,20.6,20.8,21.0,21.5,22.0,23.0,24.0,25.0,26.0, /27.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,54.0,60.0/ DATA Y2P7/0.0,.123,.127,.095,.145,.153,.126,.104,.091,.085, /.080,.077,.072,.067,.061,.060,.066,.071,.076,.082, /.096,.118,.112,.074,.066,.067,.070,.075,.084,.088, /.099,.101,.115,.101,.114,.122,.126,.117,.124,.134, /.141,.154,.164,.177,.198,.215,.232,.244,.252,.252, /.250,.248,.243,.233,.218,.201,.184,.169,.156,.144, /.134,.124,.117,.103,.081/ C 2P6 J=2 UNITS 10**-18 SCALE BY 1/E ABOVE 60 EV DATA X2P6/18.63679,18.64,18.65,18.66,18.67,18.68,18.69,18.70, /18.71,18.72, /18.74,18.76,18.78,18.80,18.82,18.84,18.86,18.90,18.94,18.96, /19.00,19.05,19.10,19.20,19.30,19.40,19.50,19.60,19.70,19.80, /19.90,20.00,20.10,20.20,20.30,20.40,20.60,20.80,21.00,21.50, /22.0,23.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,52.0,54.0,60.0/ DATA Y2P6/0.0,.113,.103,.135,.310,.442,.466,.449,.441,.436, /.434,.432,.427,.419,.410,.401,.391,.376,.368,.374, /.333,.319,.317,.321,.330,.339,.349,.388,.369,.362, /.388,.404,.423,.437,.447,.466,.489,.513,.532,.556, /.579,.603,.622,.646,.656,.656,.646,.632,.617,.603, /.589,.575,.561,.546,.532,.518,.503,.489,.475/ C 2P5 J=1 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 60 EV DATA X2P5/18.69336,18.70,18.71,18.72,18.73,18.74,18.75,18.76, /18.78,18.80, /18.82,18.84,18.86,18.88,18.90,18.92,18.94,18.96,18.98,19.00, /19.05,19.10,19.20,19.30,19.40,19.50,19.60,19.67,19.70,19.80, /19.9,20.0,20.1,20.2,20.3,20.4,20.5,20.6,20.8,21.0, /21.5,22.0,23.0,24.0,25.0,26.0,27.0,28.0,29.0,30.0, /32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0, /52.0,54.0,60.0/ DATA Y2P5/0.0,.029,.045,.054,.061,.066,.067,.069,.068,.067, /.066,.066,.067,.068,.071,.074,.081,.095,.078,.079, /.087,.096,.112,.125,.134,.142,.156,.161,.146,.163, /.174,.175,.168,.168,.174,.182,.192,.201,.219,.233, /.237,.239,.242,.242,.239,.235,.229,.228,.228,.228, /.224,.211,.204,.196,.187,.181,.173,.166,.159,.151, /.144,.138,.117/ C 2P4 J=2 UNITS 10**-18 SCALE BY 1/E ABOVE 60 EV DATA X2P4/18.70407,18.71,18.72,18.73,18.74,18.75,18.76,18.77, /18.78,18.79, /18.80,18.82,18.84,18.86,18.88,18.90,18.92,18.94,18.96,18.98, /19.00,19.02,19.10,19.20,19.30,19.40,19.50,19.58,19.60,19.68, /19.70,19.80,19.90,20.00,20.10,20.20,20.30,20.40,20.60,20.80, /21.0,21.5,22.0,22.5,23.0,24.0,25.0,26.0,27.0,28.0, /29.0,30.0,31.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0, /46.0,48.0,50.0,52.0,54.0,60.0/ DATA Y2P4/0.0,.140,.180,.208,.229,.247,.263,.278,.291,.302, /.313,.318,.332,.333,.332,.330,.329,.336,.371,.313, /.287,.275,.263,.264,.270,.278,.289,.312,.291,.293, /.326,.310,.326,.343,.363,.380,.404,.419,.447,.476, /.504,.532,.551,.570,.580,.599,.608,.614,.612,.605, /.594,.580,.564,.546,.513,.485,.461,.440,.423,.408, /.395,.384,.374,.366,.358,.323/ C 2P3 J=0 UNITS 10**-18 SCALE BY 1/E ABOVE 60 EV DATA X2P3/18.71138,18.72,18.73,18.74,18.75,18.76,18.77,18.78, /18.79,18.80, /18.82,18.84,18.86,18.88,18.90,18.92,18.94,18.95,18.96,18.97, /18.98,19.00,19.10,19.20,19.30,19.40,19.50,19.60,19.70,19.80, /19.9,20.0,20.1,20.2,20.3,20.4,20.6,20.8,21.0,21.5, /22.0,23.0,24.0,25.0,26.0,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0,52.0, /54.0,60.0/ DATA Y2P3/0.0,.028,.037,.046,.054,.062,.068,.073,.078,.082, /.087,.090,.092,.095,.098,.104,.124,.139,.142,.083, /.064,.068,.065,.066,.069,.072,.076,.078,.086,.087, /.097,.095,.101,.110,.116,.119,.125,.133,.139,.143, /.149,.152,.153,.151,.150,.149,.146,.142,.137,.127, /.120,.112,.107,.104,.100,.097,.094,.091,.088,.085, /.081,.072/ C 2P2 J=1 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 60 EV DATA X2P2/18.72638,18.73,18.74,18.75,18.76,18.77,18.78,18.79, /18.80,18.82, /18.84,18.86,18.88,18.90,18.92,18.94,18.95,18.96,18.97,18.98, /19.00,19.10,19.20,19.30,19.40,19.50,19.58,19.60,19.70,19.80, /19.9,20.0,20.1,20.2,20.3,20.4,20.6,20.8,21.0,21.5, /22.0,23.0,24.0,25.0,26.0,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0,50.0,52.0, /54.0,60.0/ DATA Y2P2/0.0,.006,.025,.046,.063,.078,.090,.099,.109,.122, /.128,.131,.133,.137,.134,.143,.154,.179,.163,.137, /.125,.128,.140,.150,.159,.166,.183,.163,.187,.187, /.198,.201,.204,.203,.204,.207,.209,.211,.215,.223, /.228,.233,.238,.238,.235,.226,.219,.214,.207,.192, /.178,.163,.150,.140,.129,.122,.115,.108,.103,.096, /.090,.078/ C 2P1 J=0 UNITS 10**-18 SCALE BY 1/E ABOVE 100 EV DATA X2P1/18.96595,18.97,18.98,18.99,19.00,19.01,19.02,19.03, /19.04,19.06, /19.08,19.10,19.15,19.20,19.30,19.40,19.50,19.57,19.58,19.60, /19.66,19.70,19.80,19.90,20.00,20.10,20.20,20.30,20.40,20.60, /20.8,21.0,21.5,22.0,23.0,24.0,25.0,26.0,27.0,28.0, /29.0,30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0, /48.0,50.0,52.0,54.0,60.0,70.0,80.0,90.0,100./ DATA Y2P1/0.0,.134,.170,.194,.206,.216,.223,.230,.235,.243, /.250,.256,.269,.280,.303,.327,.345,.279,.437,.411, /.342,.352,.371,.394,.418,.442,.461,.480,.499,.541, /.580,.618,.722,.826,.969,1.17,1.35,1.48,1.60,1.73, /1.81,1.90,1.97,1.98,1.99,1.99,1.98,1.97,1.97,1.96, /1.95,1.94,1.92,1.90,1.86,1.75,1.61,1.48,1.38/ C C 2S5 J=2 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X2S5/19.66403,19.8,19.9,20.0,20.5,21.0,22.0,23.0,24.0,25.0, /26.0,27.0,28.0,30.0,32.0,36.0,40.0,44.0,50.0/ DATA Y2S5/0.0,.0217,.0374,.0526,.121,.178,.263,.319,.355,.376, /.387,.390,.388,.375,.355,.309,.266,.229,.184/ C 2S4 J=1 RESONANCE LEVEL USE BEF SCALING F=0.0128 62.9743 NM C C 2S3 J=0 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X2S3/19.76060,19.8,19.9,20.0,20.5,21.0,22.0,23.0,24.0,25.0, /26.0,27.0,28.0,30.0,32.0,36.0,40.0,44.0,50.0/ DATA Y2S3/0.0,.0088,.0245,.0376,.0870,.122,.168,.195,.209,.215, /.216,.214,.209,.196,.181,.151,.126,.105,.081/ C 2S2 J=1 RESONANCE LEVEL USE BEF SCALING F=0.0166 62.6827 NM C C 3D6 J=0 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3D6/20.02464,22.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3D6/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3D5 J=1 RESONANCE LEVEL USE BEF SCALING F=0.0048 61.9106 NM C C 3D4! J=4 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3D4P/20.03465,22.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3D4P/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3D4 J=3 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3D4/20.03487,22.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3D4/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3D3 J=2 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3D3/20.03675,22.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3D3/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3D2 J=1 RESONANCE LEVEL USE BEF SCALING F=0.0146 61.8676 NM C C 3D1!! J=2 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3D1PP/20.04820,22.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3D1PP/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3D1! J=3 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3D1P/20.04842,22.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3D1P/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3S1!!!! J=2 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3S1PPPP/20.13611,22.,24.,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3S1PPPP/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3S1!!! J=3 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3S1PPP/20.13629,22.,24.,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3S1PPP/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3S1!! J=2 UNITS 10**-18 SCALE BY 1/E**2 ABOVE 50 EV DATA X3S1PP/20.13751,22.,24.,26.0,28.0,30.0,32.0,34.0,36.0,40.0, /45.0,50.0/ DATA Y3S1PP/0.0,.013,.022,.029,.032,.033,.032,.030,.025,.020, /.016,.011/ C 3S1! J=1 RESONANCE LEVEL USE BEF SCALING F=0.00676 61.5632 NM C C 3P SUM 3P10-3P6 UNITS 10**-18 SCALE BY 1/E**1.5 ABOVE 50 EV DATA X3P106/20.14965,21.0,22.0,23.0,24.0,25.0,26.0,27.0,28.0,30.0, /32.0,34.0,36.0,38.0,40.0,50.0/ DATA Y3P106/0.0,.110,.178,.242,.275,.320,.363,.418,.450,.500, /.500,.480,.460,.440,.410,.330/ C 3P SUM 3P5-3P2 UNITS 10**-18 SCALE BY 1/E**1.5 ABOVE 50 EV DATA X3P52/20.25918,21.0,22.0,23.0,24.0,25.0,26.0,27.0,28.0,30.0, /32.0,34.0,36.0,38.0,40.0,50.0/ DATA Y3P52/0.0,.088,.142,.194,.220,.256,.290,.335,.360,.400, /.400,.380,.370,.350,.330,.270/ C 3P1 J=0 UNITS 10**-18 SCALE 1/E BY ABOVE 50 EV DATA X3P1/20.36885,21.0,22.0,23.0,24.0,25.0,26.0,27.0,28.0,30.0, /32.0,34.0,36.0,38.0,40.0,50.0/ DATA Y3P1/0.0,.050,.100,.125,.145,.165,.175,.185,.192,.200, /.205,.207,.207,.205,.205,.190/ C HIGH RESONANCE LEVELS : C C 3S4 J=1 RESONANCE LEVEL USE BEF SCALING F=0.00635 60.2730 NM C 3S2 J=1 RESONANCE LEVEL USE BEF SCALING F=0.0044 60.0041 NM C 4D5 J=1 RESONANCE LEVEL USE BEF SCALING F=0.00705 59.8895 NM C 4D2 J=1 RESONANCE LEVEL USE BEF SCALING F=0.00235 59.8710 NM C 4S1! J=1 RESONANCE LEVEL USE BEF SCALING F=0.00435 59.5924 NM C 4S4 J=1 RESONANCE LEVEL USE BEF SCALING F=0.00325 59.1834 NM C 5D5 J=1 RESONANCE LEVEL USE BEF SCALING F=0.00383 59.0015 NM C 5D2 J=1 RESONANCE LEVEL USE BEF SCALING F=0.00127 58.9915 NM C 4S2 J=1 RESONANCE LEVEL USE BEF SCALING F=0.00165 58.9183 NM C 5S1! J=1 RESONANCE LEVEL USE BEF SCALING F=0.0025 58.7217 NM C SUM S STATES 5-INFINITY USE BEF SCALING F=0.00962 C SUM D STATES 6-INFINITY USE BEF SCALING F=0.01695 C TOTAL OSCILLATOR SUM F = 0.2926 C --------------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME='NEON ISOT 2010' ELSE NAME='NEON ANISO 2010' ENDIF 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 2007: INCREASED DATA BASE UP TO 10MEV ENERGY C 2007: INTRODUCED NEW ANGULAR DISTRIBUTION FUNCTION C 2007: INTRODUCED PENNING TRANSFER FRACTION C 2010: INTRODUCED MORE DETAILED RMPS CALCULATION OF ZATSARINNY AND C BARTSCHAT FROM THRESHOLD TO 20EV FOR THE FIRST S AND P STATES C WHICH ARE IN AGREEMENT WITH ALLANS PRECISE MEASUREMENTS C J.PHYS.B 42(2009)044009 C SCALED ZATSARINNY AND BARTSCHAT BY 0.95 TO BRING INTO EXACT C AGREEMENT WITH ALLANS MEASUREMENTS C NOW CLEAR EVIDENCE THAT THE TOWNSEND EXPERIMENTS ARE C INACCURATE ESPECIALLY AT LOW FIELDS DUE TO PENNING TRANFERS C TO IMPURITIES AT THE LEVEL OF 30PPM . NEED MODERN EXPERIMENTS C WITH LESS THAN 1PPM IMPURITIES TO GIVE ACCURATE TOWNSEND COEF. C C --------------------------------------------------------------------- C C BORN BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 API=DACOS(-1.0D0) A0=0.52917720859D-8 RY=13.60569193 BBCONST=16.0*API*A0*A0*RY*RY/EMASS2 C AM2=1.69 C=17.80 C NIN=45 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN 2 KIN(J)=NANISO C NEL=84 NDATA=87 NEPSI=158 NION=74 N1S5=111 N1S4=137 N1S3=117 N1S2=119 N2P10=73 N2P9=70 N2P8=72 N2P7=65 N2P6=59 N2P5=63 N2P4=66 N2P3=62 N2P2=62 N2P1=59 N2S5=19 N2S3=19 N3D6=12 N3D4P=12 N3D4=12 N3D3=12 N3D1PP=12 N3D1P=12 N3S1PPPP=12 N3S1PPP=12 N3S1PP=12 N3P106=16 N3P52=16 N3P1=16 E(1)=0.0 E(2)=2.0*EMASS/(20.1797*AMU) E(3)=21.56454 C EXCITATION X=SECTION AT 1.3MEV E(4)=0.492D-19 C ENTER IONISING X-SECTION AT 1.3MEV E(5)=0.415D-18 C ENTER EOBY FOR MINIMUM IONISING PARTICLE E(6)=19.5 C EOBY AT LOW ENERGY EOBY=24.2 IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) EIN(1)=16.61907 EIN(2)=16.67083 EIN(3)=16.71538 EIN(4)=16.84805 EIN(5)=18.38162 EIN(6)=18.55511 EIN(7)=18.57583 EIN(8)=18.61270 EIN(9)=18.63679 EIN(10)=18.69336 EIN(11)=18.70407 EIN(12)=18.71138 EIN(13)=18.72638 EIN(14)=18.96595 EIN(15)=19.66403 EIN(16)=19.68819 EIN(17)=19.76060 EIN(18)=19.77977 EIN(19)=20.02464 EIN(20)=20.02644 EIN(21)=20.03465 EIN(22)=20.03487 EIN(23)=20.03675 EIN(24)=20.04039 EIN(25)=20.04820 EIN(26)=20.04842 EIN(27)=20.13611 EIN(28)=20.13629 EIN(29)=20.13751 EIN(30)=20.13946 EIN(31)=20.14965 EIN(32)=20.25918 EIN(33)=20.36885 EIN(34)=20.57056 EIN(35)=20.66277 EIN(36)=20.70230 EIN(37)=20.70871 EIN(38)=20.80551 EIN(39)=20.94928 EIN(40)=21.01388 EIN(41)=21.01743 EIN(42)=21.04354 EIN(43)=21.11401 EIN(44)=21.14638 EIN(45)=21.18286 C***************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C PENNING TRANSFER EFFICIENCY IN NEON MIXTURES BETWEEN 0.3 AND 0.6 DO 50 NL=1,NIN PENFRA(1,NL)=0.5 C PENNING TRANSFER DISTANCE IN MICRONS PENFRA(2,NL)=1.0 C PENNING TRANSFER TIME IN PICOSECONDS 50 PENFRA(3,NL)=1.0 C---------------------------------------------------------------- C HORNBECK MOLNAR MOD (THRESHOLD 20.3 EV) C IF PURE GAS SET TO 0.0 FOR FIRST 32 LEVELS 0.3 FOR OTHER LEVELS C DO 51 NL=1,32 C 51 PENFRA(1,NL)=0.0 C***************************************************************** IF(IPEN.EQ.0) GO TO 4 DO 3 KDUM=1,NIN IF(PENFRA(1,KDUM).EQ.0.0) GO TO 3 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 3 CONTINUE C***************************************************************** 4 DO 5 NL=1,NIN 5 IOFFN(NL)=IFIX(SNGL(0.5+EIN(NL)/ESTEP)) SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC NEON ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC ISOTROPIC NEON ' ENDIF SCRPT(3)=' IONISATION ELOSS= 21.56454' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)='EX 1S5 J=2 M ELVL= 16.61907' SCRPT(8)='EX 1S4 J=1 R ELVL= 16.67083' SCRPT(9)='EX 1S3 J=0 M ELVL= 16.71538' SCRPT(10)='EX 1S2 J=1 R ELVL= 16.84805' SCRPT(11)='EX 2P10 J=1 ELVL= 18.38162' SCRPT(12)='EX 2P9 J=3 ELVL= 18.55511' SCRPT(13)='EX 2P8 J=2 ELVL= 18.57583' SCRPT(14)='EX 2P7 J=1 ELVL= 18.61270' SCRPT(15)='EX 2P6 J=2 ELVL= 18.63679' SCRPT(16)='EX 2P5 J=1 ELVL= 18.69336' SCRPT(17)='EX 2P4 J=2 ELVL= 18.70407' SCRPT(18)='EX 2P3 J=0 ELVL= 18.71138' SCRPT(19)='EX 2P2 J=1 ELVL= 18.72638' SCRPT(20)='EX 2P1 J=0 ELVL= 18.96595' SCRPT(21)='EX 2S5 J=2 ELVL= 19.66403' SCRPT(22)='EX 2S4 J=1 R ELVL= 19.68819' SCRPT(23)='EX 2S3 J=0 ELVL= 19.76060' SCRPT(24)='EX 2S2 J=1 R ELVL= 19.77977' SCRPT(25)='EX 3D6 J=0 ELVL= 20.02464' SCRPT(26)='EX 3D5 J=1 R ELVL= 20.02644' SCRPT(27)='EX 3D4! J=4 ELVL= 20.03465' SCRPT(28)='EX 3D4 J=3 ELVL= 20.03487' SCRPT(29)='EX 3D3 J=2 ELVL= 20.03675' SCRPT(30)='EX 3D2 J=1 R ELVL= 20.04039' SCRPT(31)='EX 3D1!! J=2 ELVL= 20.04820' SCRPT(32)='EX 3D1! J=3 ELVL= 20.04842' SCRPT(33)='EX 3S1!!!! J=2 ELVL= 20.13611' SCRPT(34)='EX 3S1!!! J=3 ELVL= 20.13629' SCRPT(35)='EX 3S1!! J=2 ELVL= 20.13751' SCRPT(36)='EX 3S1! J=1 ELVL= 20.13946' SCRPT(37)='EX SUM 3P10-6 ELVL= 20.14965' SCRPT(38)='EX SUM 3P5-2 ELVL= 20.25918' SCRPT(39)='EX 3P1 J=0 ELVL= 20.36885' SCRPT(40)='EX 3S4 J=1 R ELVL= 20.57056' SCRPT(41)='EX 3S2 J=1 R ELVL= 20.66277' SCRPT(42)='EX 4D5 J=1 R ELVL= 20.70230' SCRPT(43)='EX 4D2 J=1 R ELVL= 20.70871' SCRPT(44)='EX 4S1! J=1 R ELVL= 20.80551' SCRPT(45)='EX 4S4 J=1 R ELVL= 20.94928' SCRPT(46)='EX 5D5 J=1 R ELVL= 21.01388' SCRPT(47)='EX 5D2 J=1 R ELVL= 21.01743' SCRPT(48)='EX 4S2 J=1 R ELVL= 21.04354' SCRPT(49)='EX 5S1! J=1 R ELVL= 21.11401' SCRPT(50)='EX SUM S HIGH R ELVL= 21.14638' SCRPT(51)='EX SUM D HIGH R ELVL= 21.18286' 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 C EN=-ESTEP/2.0D0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.EIN(1)) THEN GAMMA1=(EMASS2+2.0D0*EN)/EMASS2 GAMMA2=GAMMA1*GAMMA1 BETA=DSQRT(1.0D0-1.0D0/GAMMA2) BETA2=BETA*BETA ENDIF IF(EN.GT.1.0) GO TO 7 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 12 AK=DSQRT(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*DLOG(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=(DSIN(AN0-AN1))**2 SUM=SUM+2.0*(DSIN(AN1-AN2))**2 SIGEL=(DSIN(AN0))**2+3.0*(DSIN(AN1))**2 DO 6 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)*(DSIN(API*APOL*AK2*SUMI))**2 SIGEL=SIGEL+(2.0*J+1.0)*(DSIN(ANLOW))**2 6 CONTINUE QELA=SIGEL*4.0*PIR2/AK2 QMOM=SUM*4.0*PIR2/AK2 GO TO 12 7 CONTINUE DO 8 J=2,NEL IF(EN.LE.XEL(J)) GO TO 9 8 CONTINUE J=NEL 9 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 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 11 10 CONTINUE J=NDATA 11 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 12 CONTINUE PQ1=0.5+(QELA-QMOM)/QELA DO 13 J=2,NEPSI IF(EN.LE.XEPS(J)) GO TO 14 13 CONTINUE J=NEPSI 14 A=(YEPS(J)-YEPS(J-1))/(XEPS(J)-XEPS(J-1)) B=(XEPS(J-1)*YEPS(J)-XEPS(J)*YEPS(J-1))/(XEPS(J-1)-XEPS(J)) PQ2=A*EN+B IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) THEN Q(2,I)=QMOM PEQEL(2,I)=0.5 ENDIF C GROSS IONISATION Q(3,I)=0.0D0 PEQEL(3,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 200 IF(EN.GT.XION(NION)) GO TO 121 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.0D-16 GO TO 122 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 121 AX2=1.0D0/BETA2 AX1=AX2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*AX1+C*AX2)/0.951 122 CONTINUE 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 200 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C ATTACHMENT 200 Q(4,I)=0.0D0 C COUNTING IONISATION Q(5,I)=0.0D0 PEQEL(5,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(5,I)=0.0D0 IF(EN.LE.E(3)) GO TO 250 IF(EN.GT.XION(NION)) GO TO 241 DO 230 J=2,NION IF(EN.LE.XION(J)) GO TO 240 230 CONTINUE J=NION 240 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.0D-16 GO TO 242 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 241 Q(5,I)=CONST*(AM2*AX1+C*AX2) 242 CONTINUE 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.0D0*E(3))) GO TO 250 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 250 Q(6,I)=0.0D0 C DO 251 NL=1,NIN QIN(NL,I)=0.0D0 PEQIN(NL,I)=0.5D0 IF(NANISO.EQ.2) THEN PEQIN(NL,I)=0.0D0 ENDIF 251 CONTINUE C C 1S5 METASTABLE LEVEL IF(EN.LE.EIN(1)) GO TO 2000 IF(EN.GT.X1S5(N1S5)) GO TO 311 DO 300 J=2,N1S5 IF(EN.LE.X1S5(J)) GO TO 310 300 CONTINUE J=N1S5 310 A=(Y1S5(J)-Y1S5(J-1))/(X1S5(J)-X1S5(J-1)) B=(X1S5(J-1)*Y1S5(J)-X1S5(J)*Y1S5(J-1))/(X1S5(J-1)-X1S5(J)) QIN(1,I)=(A*EN+B)*1.0D-18 GO TO 312 C IF ENERGY GT X1S5(N1S5) EV SCALE BY 1/E**3 311 QIN(1,I)=Y1S5(N1S5)*(X1S5(N1S5)/EN)**3*1.0D-18 312 IF(EN.LE.(2.0*EIN(1))) GO TO 320 PEQIN(1,I)=PEQEL(2,(I-IOFFN(1))) C C 1S4 RESONANCE LEVEL F=0.0118 320 IF(EN.LE.EIN(2)) GO TO 2000 IF(EN.GT.X1S4(N1S4)) GO TO 341 DO 330 J=2,N1S4 IF(EN.LE.X1S4(J)) GO TO 340 330 CONTINUE J=N1S4 340 A=(Y1S4(J)-Y1S4(J-1))/(X1S4(J)-X1S4(J-1)) B=(X1S4(J-1)*Y1S4(J)-X1S4(J)*Y1S4(J-1))/(X1S4(J-1)-X1S4(J)) QIN(2,I)=(A*EN+B)*1.0D-18 GO TO 342 C IF ENERGY GT X1S4(N1S4) EV USE BEF SCALING 341 QIN(2,I)=0.0118/(EIN(2)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(2)))-BETA2)*BBCONST*EN/(EN+EIN(2)+E(3)) QIN(2,I)=DABS(QIN(2,I)) 342 IF(EN.LE.(2.0*EIN(2))) GO TO 350 PEQIN(2,I)=PEQEL(2,(I-IOFFN(2))) C 1S3 METASTABLE LEVEL 350 IF(EN.LE.EIN(3)) GO TO 2000 IF(EN.GT.X1S3(N1S3)) GO TO 371 DO 360 J=2,N1S3 IF(EN.LE.X1S3(J)) GO TO 370 360 CONTINUE J=N1S3 370 A=(Y1S3(J)-Y1S3(J-1))/(X1S3(J)-X1S3(J-1)) B=(X1S3(J-1)*Y1S3(J)-X1S3(J)*Y1S3(J-1))/(X1S3(J-1)-X1S3(J)) QIN(3,I)=(A*EN+B)*1.0D-18 GO TO 372 C IF ENERGY GT X1S3(N1S3) EV SCALE BY 1/E**3 371 QIN(3,I)=Y1S3(N1S3)*(X1S3(N1S3)/EN)**3*1.D-18 372 IF(EN.LE.(2.0*EIN(3))) GO TO 380 PEQIN(3,I)=PEQEL(2,(I-IOFFN(3))) C 1S2 RESONANCE LEVEL F=0.159 380 IF(EN.LE.EIN(4)) GO TO 2000 IF(EN.GT.X1S2(N1S2)) GO TO 401 DO 390 J=2,N1S2 IF(EN.LE.X1S2(J)) GO TO 400 390 CONTINUE J=N1S2 400 A=(Y1S2(J)-Y1S2(J-1))/(X1S2(J)-X1S2(J-1)) B=(X1S2(J-1)*Y1S2(J)-X1S2(J)*Y1S2(J-1))/(X1S2(J-1)-X1S2(J)) QIN(4,I)=(A*EN+B)*1.0D-18 GO TO 402 C IF ENERGY GT X1S2(N1S2) EV USE BEF SCALING 401 QIN(4,I)=0.1590/(EIN(4)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(4)))-BETA2)*BBCONST*EN/(EN+EIN(4)+E(3)) QIN(4,I)=DABS(QIN(4,I)) 402 IF(EN.LE.(2.0*EIN(4))) GO TO 410 PEQIN(4,I)=PEQEL(2,(I-IOFFN(4))) C 2P10 410 IF(EN.LE.EIN(5)) GO TO 2000 IF(EN.GT.X2P10(N2P10)) GO TO 431 DO 420 J=2,N2P10 IF(EN.LE.X2P10(J)) GO TO 430 420 CONTINUE J=N2P10 430 A=(Y2P10(J)-Y2P10(J-1))/(X2P10(J)-X2P10(J-1)) B=(X2P10(J-1)*Y2P10(J)-X2P10(J)*Y2P10(J-1))/(X2P10(J-1)-X2P10(J)) QIN(5,I)=(A*EN+B)*1.0D-18 GO TO 432 C IF ENERGY GT X2P10(N2P10) EV SCALE BY 1/E**2 431 QIN(5,I)=Y2P10(N2P10)*(X2P10(N2P10)/EN)**2*1.D-18 432 IF(EN.LE.(2.0*EIN(5))) GO TO 440 PEQIN(5,I)=PEQEL(2,(I-IOFFN(5))) C 2P9 440 IF(EN.LE.EIN(6)) GO TO 2000 IF(EN.GT.X2P9(N2P9)) GO TO 461 DO 450 J=2,N2P9 IF(EN.LE.X2P9(J)) GO TO 460 450 CONTINUE J=N2P9 460 A=(Y2P9(J)-Y2P9(J-1))/(X2P9(J)-X2P9(J-1)) B=(X2P9(J-1)*Y2P9(J)-X2P9(J)*Y2P9(J-1))/(X2P9(J-1)-X2P9(J)) QIN(6,I)=(A*EN+B)*1.0D-18 GO TO 462 C IF ENERGY GT X2P9(N2P9) EV SCALE BY 1/E**2 461 QIN(6,I)=Y2P9(N2P9)*(X2P9(N2P9)/EN)**2*1.D-18 462 IF(EN.LE.(2.0*EIN(6))) GO TO 470 PEQIN(6,I)=PEQEL(2,(I-IOFFN(6))) C 2P8 470 IF(EN.LE.EIN(7)) GO TO 2000 IF(EN.GT.X2P8(N2P8)) GO TO 491 DO 480 J=2,N2P8 IF(EN.LE.X2P8(J)) GO TO 490 480 CONTINUE J=N2P8 490 A=(Y2P8(J)-Y2P8(J-1))/(X2P8(J)-X2P8(J-1)) B=(X2P8(J-1)*Y2P8(J)-X2P8(J)*Y2P8(J-1))/(X2P8(J-1)-X2P8(J)) QIN(7,I)=(A*EN+B)*1.0D-18 GO TO 492 C IF ENERGY GT X2P8(N2P8) EV SCALE BY 1/E 491 QIN(7,I)=Y2P8(N2P8)*(X2P8(N2P8)/EN)*1.D-18 492 IF(EN.LE.(2.0*EIN(7))) GO TO 500 PEQIN(7,I)=PEQEL(2,(I-IOFFN(7))) C 2P7 500 IF(EN.LE.EIN(8)) GO TO 2000 IF(EN.GT.X2P7(N2P7)) GO TO 521 DO 510 J=2,N2P7 IF(EN.LE.X2P7(J)) GO TO 520 510 CONTINUE J=N2P7 520 A=(Y2P7(J)-Y2P7(J-1))/(X2P7(J)-X2P7(J-1)) B=(X2P7(J-1)*Y2P7(J)-X2P7(J)*Y2P7(J-1))/(X2P7(J-1)-X2P7(J)) QIN(8,I)=(A*EN+B)*1.0D-18 GO TO 522 C IF ENERGY GT X2P7(N2P7) EV SCALE BY 1/E**2 521 QIN(8,I)=Y2P7(N2P7)*(X2P7(N2P7)/EN)**2*1.D-18 522 IF(EN.LE.(2.0*EIN(8))) GO TO 530 PEQIN(8,I)=PEQEL(2,(I-IOFFN(8))) C 2P6 530 IF(EN.LE.EIN(9)) GO TO 2000 IF(EN.GT.X2P6(N2P6)) GO TO 551 DO 540 J=2,N2P6 IF(EN.LE.X2P6(J)) GO TO 550 540 CONTINUE J=N2P6 550 A=(Y2P6(J)-Y2P6(J-1))/(X2P6(J)-X2P6(J-1)) B=(X2P6(J-1)*Y2P6(J)-X2P6(J)*Y2P6(J-1))/(X2P6(J-1)-X2P6(J)) QIN(9,I)=(A*EN+B)*1.0D-18 GO TO 552 C IF ENERGY GT X2P6(N2P6) EV SCALE BY 1/E 551 QIN(9,I)=Y2P6(N2P6)*(X2P6(N2P6)/EN)*1.D-18 552 IF(EN.LE.(2.0*EIN(9))) GO TO 560 PEQIN(9,I)=PEQEL(2,(I-IOFFN(9))) C 2P5 560 IF(EN.LE.EIN(10)) GO TO 2000 IF(EN.GT.X2P5(N2P5)) GO TO 581 DO 570 J=2,N2P5 IF(EN.LE.X2P5(J)) GO TO 580 570 CONTINUE J=N2P5 580 A=(Y2P5(J)-Y2P5(J-1))/(X2P5(J)-X2P5(J-1)) B=(X2P5(J-1)*Y2P5(J)-X2P5(J)*Y2P5(J-1))/(X2P5(J-1)-X2P5(J)) QIN(10,I)=(A*EN+B)*1.0D-18 GO TO 582 C IF ENERGY GT X2P5(N2P5) EV SCALE BY 1/E**2 581 QIN(10,I)=Y2P5(N2P5)*(X2P5(N2P5)/EN)**2*1.D-18 582 IF(EN.LE.(2.0*EIN(10))) GO TO 590 PEQIN(10,I)=PEQEL(2,(I-IOFFN(10))) C 2P4 590 IF(EN.LE.EIN(11)) GO TO 2000 IF(EN.GT.X2P4(N2P4)) GO TO 611 DO 600 J=2,N2P4 IF(EN.LE.X2P4(J)) GO TO 610 600 CONTINUE J=N2P4 610 A=(Y2P4(J)-Y2P4(J-1))/(X2P4(J)-X2P4(J-1)) B=(X2P4(J-1)*Y2P4(J)-X2P4(J)*Y2P4(J-1))/(X2P4(J-1)-X2P4(J)) QIN(11,I)=(A*EN+B)*1.0D-18 GO TO 612 C IF ENERGY GT X2P4(N2P4) EV SCALE BY 1/E 611 QIN(11,I)=Y2P4(N2P4)*(X2P4(N2P4)/EN)*1.D-18 612 IF(EN.LE.(2.0*EIN(11))) GO TO 620 PEQIN(11,I)=PEQEL(2,(I-IOFFN(11))) C 2P3 620 IF(EN.LE.EIN(12)) GO TO 2000 IF(EN.GT.X2P3(N2P3)) GO TO 641 DO 630 J=2,N2P3 IF(EN.LE.X2P3(J)) GO TO 640 630 CONTINUE J=N2P3 640 A=(Y2P3(J)-Y2P3(J-1))/(X2P3(J)-X2P3(J-1)) B=(X2P3(J-1)*Y2P3(J)-X2P3(J)*Y2P3(J-1))/(X2P3(J-1)-X2P3(J)) QIN(12,I)=(A*EN+B)*1.0D-18 GO TO 642 C IF ENERGY GT X2P3(N2P3) EV SCALE BY 1/E 641 QIN(12,I)=Y2P3(N2P3)*(X2P3(N2P3)/EN)*1.D-18 642 IF(EN.LE.(2.0*EIN(12))) GO TO 650 PEQIN(12,I)=PEQEL(2,(I-IOFFN(12))) C 2P2 650 IF(EN.LE.EIN(13)) GO TO 2000 IF(EN.GT.X2P2(N2P2)) GO TO 671 DO 660 J=2,N2P2 IF(EN.LE.X2P2(J)) GO TO 670 660 CONTINUE J=N2P2 670 A=(Y2P2(J)-Y2P2(J-1))/(X2P2(J)-X2P2(J-1)) B=(X2P2(J-1)*Y2P2(J)-X2P2(J)*Y2P2(J-1))/(X2P2(J-1)-X2P2(J)) QIN(13,I)=(A*EN+B)*1.0D-18 GO TO 672 C IF ENERGY GT X2P2(N2P2) EV SCALE BY 1/E**2 671 QIN(13,I)=Y2P2(N2P2)*(X2P2(N2P2)/EN)**2*1.D-18 672 IF(EN.LE.(2.0*EIN(13))) GO TO 680 PEQIN(13,I)=PEQEL(2,(I-IOFFN(13))) C 2P1 680 IF(EN.LE.EIN(14)) GO TO 2000 IF(EN.GT.X2P1(N2P1)) GO TO 701 DO 690 J=2,N2P1 IF(EN.LE.X2P1(J)) GO TO 700 690 CONTINUE J=N2P1 700 A=(Y2P1(J)-Y2P1(J-1))/(X2P1(J)-X2P1(J-1)) B=(X2P1(J-1)*Y2P1(J)-X2P1(J)*Y2P1(J-1))/(X2P1(J-1)-X2P1(J)) QIN(14,I)=(A*EN+B)*1.0D-18 GO TO 702 C IF ENERGY GT X2P1(N2P1) EV SCALE BY 1/E 701 QIN(14,I)=Y2P1(N2P1)*(X2P1(N2P1)/EN)*1.D-18 702 IF(EN.LE.(2.0*EIN(14))) GO TO 710 PEQIN(14,I)=PEQEL(2,(I-IOFFN(14))) C 2S5 710 IF(EN.LE.EIN(15)) GO TO 2000 IF(EN.GT.X2S5(N2S5)) GO TO 731 DO 720 J=2,N2S5 IF(EN.LE.X2S5(J)) GO TO 730 720 CONTINUE J=N2S5 730 A=(Y2S5(J)-Y2S5(J-1))/(X2S5(J)-X2S5(J-1)) B=(X2S5(J-1)*Y2S5(J)-X2S5(J)*Y2S5(J-1))/(X2S5(J-1)-X2S5(J)) QIN(15,I)=(A*EN+B)*1.0D-18 GO TO 732 C IF ENERGY GT X2S5(N2S5) EV SCALE BY 1/E**2 731 QIN(15,I)=Y2S5(N2S5)*(X2S5(N2S5)/EN)**2*1.D-18 732 IF(EN.LE.(2.0*EIN(15))) GO TO 740 PEQIN(15,I)=PEQEL(2,(I-IOFFN(15))) C 2S4 BEF SCALING 740 IF(EN.LE.EIN(16)) GO TO 2000 QIN(16,I)=0.0128/(EIN(16)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(16)))-BETA2)*BBCONST*EN/(EN+EIN(16)+E(3)) QIN(16,I)=DABS(QIN(16,I)) IF(EN.LE.(2.0*EIN(16))) GO TO 750 PEQIN(16,I)=PEQEL(2,(I-IOFFN(16))) C 2S3 750 IF(EN.LE.EIN(17)) GO TO 2000 IF(EN.GT.X2S3(N2S3)) GO TO 771 DO 760 J=2,N2S3 IF(EN.LE.X2S3(J)) GO TO 770 760 CONTINUE J=N2S3 770 A=(Y2S3(J)-Y2S3(J-1))/(X2S3(J)-X2S3(J-1)) B=(X2S3(J-1)*Y2S3(J)-X2S3(J)*Y2S3(J-1))/(X2S3(J-1)-X2S3(J)) QIN(17,I)=(A*EN+B)*1.0D-18 GO TO 772 C IF ENERGY GT X2S3(N2S3) EV SCALE BY 1/E**2 771 QIN(17,I)=Y2S3(N2S3)*(X2S3(N2S3)/EN)**2*1.D-18 772 IF(EN.LE.(2.0*EIN(17))) GO TO 780 PEQIN(17,I)=PEQEL(2,(I-IOFFN(17))) C 2S2 BEF SCALING 780 IF(EN.LE.EIN(18)) GO TO 2000 QIN(18,I)=0.0166/(EIN(18)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(18)))-BETA2)*BBCONST*EN/(EN+EIN(18)+E(3)) QIN(18,I)=DABS(QIN(18,I)) IF(EN.LE.(2.0*EIN(18))) GO TO 790 PEQIN(18,I)=PEQEL(2,(I-IOFFN(18))) C 3D6 790 IF(EN.LE.EIN(19)) GO TO 2000 IF(EN.GT.X3D6(N3D6)) GO TO 811 DO 800 J=2,N3D6 IF(EN.LE.X3D6(J)) GO TO 810 800 CONTINUE J=N3D6 810 A=(Y3D6(J)-Y3D6(J-1))/(X3D6(J)-X3D6(J-1)) B=(X3D6(J-1)*Y3D6(J)-X3D6(J)*Y3D6(J-1))/(X3D6(J-1)-X3D6(J)) QIN(19,I)=(A*EN+B)*1.0D-18 GO TO 812 C IF ENERGY GT X3D6(N3D6) EV SCALE BY 1/E**2 811 QIN(19,I)=Y3D6(N3D6)*(X3D6(N3D6)/EN)**2*1.D-18 812 IF(EN.LE.(2.0*EIN(19))) GO TO 820 PEQIN(19,I)=PEQEL(2,(I-IOFFN(19))) C 3D5 BEF SCALING 820 IF(EN.LE.EIN(20)) GO TO 2000 QIN(20,I)=0.0048/(EIN(20)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(20)))-BETA2)*BBCONST*EN/(EN+EIN(20)+E(3)) QIN(20,I)=DABS(QIN(20,I)) IF(EN.LE.(2.0*EIN(20))) GO TO 830 PEQIN(20,I)=PEQEL(2,(I-IOFFN(20))) C 3D4! 830 IF(EN.LE.EIN(21)) GO TO 2000 IF(EN.GT.X3D4P(N3D4P)) GO TO 851 DO 840 J=2,N3D4P IF(EN.LE.X3D4P(J)) GO TO 850 840 CONTINUE J=N3D4P 850 A=(Y3D4P(J)-Y3D4P(J-1))/(X3D4P(J)-X3D4P(J-1)) B=(X3D4P(J-1)*Y3D4P(J)-X3D4P(J)*Y3D4P(J-1))/(X3D4P(J-1)-X3D4P(J)) QIN(21,I)=(A*EN+B)*1.0D-18 GO TO 852 C IF ENERGY GT X3D4P(N3D4P) EV SCALE BY 1/E**2 851 QIN(21,I)=Y3D4P(N3D4P)*(X3D4P(N3D4P)/EN)**2*1.D-18 852 IF(EN.LE.(2.0*EIN(21))) GO TO 860 PEQIN(21,I)=PEQEL(2,(I-IOFFN(21))) C 3D4 860 IF(EN.LE.EIN(22)) GO TO 2000 IF(EN.GT.X3D4(N3D4)) GO TO 881 DO 870 J=2,N3D4 IF(EN.LE.X3D4(J)) GO TO 880 870 CONTINUE J=N3D4 880 A=(Y3D4(J)-Y3D4(J-1))/(X3D4(J)-X3D4(J-1)) B=(X3D4(J-1)*Y3D4(J)-X3D4(J)*Y3D4(J-1))/(X3D4(J-1)-X3D4(J)) QIN(22,I)=(A*EN+B)*1.0D-18 GO TO 882 C IF ENERGY GT X3D4(N3D4) EV SCALE BY 1/E**2 881 QIN(22,I)=Y3D4(N3D4)*(X3D4(N3D4)/EN)**2*1.D-18 882 IF(EN.LE.(2.0*EIN(22))) GO TO 890 PEQIN(22,I)=PEQEL(2,(I-IOFFN(22))) C 3D3 890 IF(EN.LE.EIN(23)) GO TO 2000 IF(EN.GT.X3D3(N3D3)) GO TO 911 DO 900 J=2,N3D3 IF(EN.LE.X3D3(J)) GO TO 910 900 CONTINUE J=N3D3 910 A=(Y3D3(J)-Y3D3(J-1))/(X3D3(J)-X3D3(J-1)) B=(X3D3(J-1)*Y3D3(J)-X3D3(J)*Y3D3(J-1))/(X3D3(J-1)-X3D3(J)) QIN(23,I)=(A*EN+B)*1.0D-18 GO TO 912 C IF ENERGY GT X3D3(N3D3) EV SCALE BY 1/E**2 911 QIN(23,I)=Y3D3(N3D3)*(X3D3(N3D3)/EN)**2*1.D-18 912 IF(EN.LE.(2.0*EIN(23))) GO TO 920 PEQIN(23,I)=PEQEL(2,(I-IOFFN(23))) C 3D2 BEF SCALING 920 IF(EN.LE.EIN(24)) GO TO 2000 QIN(24,I)=0.0146/(EIN(24)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(24)))-BETA2)*BBCONST*EN/(EN+EIN(24)+E(3)) QIN(24,I)=DABS(QIN(24,I)) IF(EN.LE.(2.0*EIN(24))) GO TO 930 PEQIN(24,I)=PEQEL(2,(I-IOFFN(24))) C 3D1!! 930 IF(EN.LE.EIN(25)) GO TO 2000 IF(EN.GT.X3D1PP(N3D1PP)) GO TO 951 DO 940 J=2,N3D1PP IF(EN.LE.X3D1PP(J)) GO TO 950 940 CONTINUE J=N3D1PP 950 A=(Y3D1PP(J)-Y3D1PP(J-1))/(X3D1PP(J)-X3D1PP(J-1)) B=(X3D1PP(J-1)*Y3D1PP(J)-X3D1PP(J)*Y3D1PP(J-1))/(X3D1PP(J-1)- /X3D1PP(J)) QIN(25,I)=(A*EN+B)*1.0D-18 GO TO 952 C IF ENERGY GT X3D1PP(N3D1PP) EV SCALE BY 1/E**2 951 QIN(25,I)=Y3D1PP(N3D1PP)*(X3D1PP(N3D1PP)/EN)**2*1.D-18 952 IF(EN.LE.(2.0*EIN(25))) GO TO 960 PEQIN(25,I)=PEQEL(2,(I-IOFFN(25))) C 3D1! 960 IF(EN.LE.EIN(26)) GO TO 2000 IF(EN.GT.X3D1P(N3D1P)) GO TO 981 DO 970 J=2,N3D1P IF(EN.LE.X3D1P(J)) GO TO 980 970 CONTINUE J=N3D1P 980 A=(Y3D1P(J)-Y3D1P(J-1))/(X3D1P(J)-X3D1P(J-1)) B=(X3D1P(J-1)*Y3D1P(J)-X3D1P(J)*Y3D1P(J-1))/(X3D1P(J-1)-X3D1P(J)) QIN(26,I)=(A*EN+B)*1.0D-18 GO TO 982 C IF ENERGY GT X3D1P(N3D1P) EV SCALE BY 1/E**2 981 QIN(26,I)=Y3D1P(N3D1P)*(X3D1P(N3D1P)/EN)**2*1.D-18 982 IF(EN.LE.(2.0*EIN(26))) GO TO 990 PEQIN(26,I)=PEQEL(2,(I-IOFFN(26))) C 3S1!!!! 990 IF(EN.LE.EIN(27)) GO TO 2000 IF(EN.GT.X3S1PPPP(N3S1PPPP)) GO TO 1011 DO 1000 J=2,N3S1PPPP IF(EN.LE.X3S1PPPP(J)) GO TO 1010 1000 CONTINUE J=N3S1PPPP 1010 A=(Y3S1PPPP(J)-Y3S1PPPP(J-1))/(X3S1PPPP(J)-X3S1PPPP(J-1)) B=(X3S1PPPP(J-1)*Y3S1PPPP(J)-X3S1PPPP(J)*Y3S1PPPP(J-1))/ /(X3S1PPPP(J-1)-X3S1PPPP(J)) QIN(27,I)=(A*EN+B)*1.0D-18 GO TO 1012 C IF ENERGY GT X3S1PPPP(N3S1PPPP) EV SCALE BY 1/E**2 1011 QIN(27,I)=Y3S1PPPP(N3S1PPPP)*(X3S1PPPP(N3S1PPPP)/EN)**2*1.D-18 1012 IF(EN.LE.(2.0*EIN(27))) GO TO 1020 PEQIN(27,I)=PEQEL(2,(I-IOFFN(27))) C 3S1!!! 1020 IF(EN.LE.EIN(28)) GO TO 2000 IF(EN.GT.X3S1PPP(N3S1PPP)) GO TO 1041 DO 1030 J=2,N3S1PPP IF(EN.LE.X3S1PPP(J)) GO TO 1040 1030 CONTINUE J=N3S1PPP 1040 A=(Y3S1PPP(J)-Y3S1PPP(J-1))/(X3S1PPP(J)-X3S1PPP(J-1)) B=(X3S1PPP(J-1)*Y3S1PPP(J)-X3S1PPP(J)*Y3S1PPP(J-1))/ /(X3S1PPP(J-1)-X3S1PPP(J)) QIN(28,I)=(A*EN+B)*1.0D-18 GO TO 1042 C IF ENERGY GT X3S1PPP(N3S1PPP) EV SCALE BY 1/E**2 1041 QIN(28,I)=Y3S1PPP(N3S1PPP)*(X3S1PPP(N3S1PPP)/EN)**2*1.D-18 1042 IF(EN.LE.(2.0*EIN(28))) GO TO 1050 PEQIN(28,I)=PEQEL(2,(I-IOFFN(28))) C 3S1!! 1050 IF(EN.LE.EIN(29)) GO TO 2000 IF(EN.GT.X3S1PP(N3S1PP)) GO TO 1071 DO 1060 J=2,N3S1PP IF(EN.LE.X3S1PP(J)) GO TO 1070 1060 CONTINUE J=N3S1PP 1070 A=(Y3S1PP(J)-Y3S1PP(J-1))/(X3S1PP(J)-X3S1PP(J-1)) B=(X3S1PP(J-1)*Y3S1PP(J)-X3S1PP(J)*Y3S1PP(J-1))/ /(X3S1PP(J-1)-X3S1PP(J)) QIN(29,I)=(A*EN+B)*1.0D-18 GO TO 1072 C IF ENERGY GT X3S1PP(N3S1PP) EV SCALE BY 1/E**2 1071 QIN(29,I)=Y3S1PP(N3S1PP)*(X3S1PP(N3S1PP)/EN)**2*1.D-18 1072 IF(EN.LE.(2.0*EIN(29))) GO TO 1080 PEQIN(29,I)=PEQEL(2,(I-IOFFN(29))) C 3S1! BEF SCALING 1080 IF(EN.LE.EIN(30)) GO TO 2000 QIN(30,I)=0.00676/(EIN(30)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(30)))-BETA2)*BBCONST*EN/(EN+EIN(30)+E(3)) QIN(30,I)=DABS(QIN(30,I)) IF(EN.LE.(2.0*EIN(30))) GO TO 1090 PEQIN(30,I)=PEQEL(2,(I-IOFFN(30))) C SUM 3P10--3P6 1090 IF(EN.LE.EIN(31)) GO TO 2000 IF(EN.GT.X3P106(N3P106)) GO TO 1111 DO 1100 J=2,N3P106 IF(EN.LE.X3P106(J)) GO TO 1110 1100 CONTINUE J=N3P106 1110 A=(Y3P106(J)-Y3P106(J-1))/(X3P106(J)-X3P106(J-1)) B=(X3P106(J-1)*Y3P106(J)-X3P106(J)*Y3P106(J-1))/ /(X3P106(J-1)-X3P106(J)) QIN(31,I)=(A*EN+B)*1.0D-18 GO TO 1112 C IF ENERGY GT X3P106(N3P106) EV SCALE BY 1/E**1.5 1111 QIN(31,I)=Y3P106(N3P106)*(X3P106(N3P106)/EN)**1.5*1.D-18 1112 IF(EN.LE.(2.0*EIN(31))) GO TO 1120 PEQIN(31,I)=PEQEL(2,(I-IOFFN(31))) C SUM 3P5--3P2 1120 IF(EN.LE.EIN(32)) GO TO 2000 IF(EN.GT.X3P52(N3P52)) GO TO 1141 DO 1130 J=2,N3P52 IF(EN.LE.X3P52(J)) GO TO 1140 1130 CONTINUE J=N3P52 1140 A=(Y3P52(J)-Y3P52(J-1))/(X3P52(J)-X3P52(J-1)) B=(X3P52(J-1)*Y3P52(J)-X3P52(J)*Y3P52(J-1))/(X3P52(J-1)-X3P52(J)) QIN(32,I)=(A*EN+B)*1.0D-18 GO TO 1142 C IF ENERGY GT X3P52(N3P52) EV SCALE BY 1/E**1.5 1141 QIN(32,I)=Y3P52(N3P52)*(X3P52(N3P52)/EN)**1.5*1.D-18 1142 IF(EN.LE.(2.0*EIN(32))) GO TO 1150 PEQIN(32,I)=PEQEL(2,(I-IOFFN(32))) C 3P1 1150 IF(EN.LE.EIN(33)) GO TO 2000 IF(EN.GT.X3P1(N3P1)) GO TO 1171 DO 1160 J=2,N3P1 IF(EN.LE.X3P1(J)) GO TO 1170 1160 CONTINUE J=N3P1 1170 A=(Y3P1(J)-Y3P1(J-1))/(X3P1(J)-X3P1(J-1)) B=(X3P1(J-1)*Y3P1(J)-X3P1(J)*Y3P1(J-1))/(X3P1(J-1)-X3P1(J)) QIN(33,I)=(A*EN+B)*1.0D-18 GO TO 1172 C IF ENERGY GT X3P1(N3P1) EV SCALE BY 1/E 1171 QIN(33,I)=Y3P1(N3P1)*(X3P1(N3P1)/EN)*1.D-18 1172 IF(EN.LE.(2.0*EIN(33))) GO TO 1180 PEQIN(33,I)=PEQEL(2,(I-IOFFN(33))) C 3S4 BEF SCALING 1180 IF(EN.LE.EIN(34)) GO TO 2000 QIN(34,I)=0.00635/(EIN(34)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(34)))-BETA2)*BBCONST*EN/(EN+EIN(34)+E(3)) QIN(34,I)=DABS(QIN(34,I)) IF(EN.LE.(2.0*EIN(34))) GO TO 1190 PEQIN(34,I)=PEQEL(2,(I-IOFFN(34))) C 3S2 BEF SCALING 1190 IF(EN.LE.EIN(35)) GO TO 2000 QIN(35,I)=0.00440/(EIN(35)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(35)))-BETA2)*BBCONST*EN/(EN+EIN(35)+E(3)) QIN(35,I)=DABS(QIN(35,I)) IF(EN.LE.(2.0*EIN(35))) GO TO 1200 PEQIN(35,I)=PEQEL(2,(I-IOFFN(35))) C 4D5 BEF SCALING 1200 IF(EN.LE.EIN(36)) GO TO 2000 QIN(36,I)=0.00705/(EIN(36)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(36)))-BETA2)*BBCONST*EN/(EN+EIN(36)+E(3)) QIN(36,I)=DABS(QIN(36,I)) IF(EN.LE.(2.0*EIN(36))) GO TO 1210 PEQIN(36,I)=PEQEL(2,(I-IOFFN(36))) C 4D2 BEF SCALING 1210 IF(EN.LE.EIN(37)) GO TO 2000 QIN(37,I)=0.00235/(EIN(37)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(37)))-BETA2)*BBCONST*EN/(EN+EIN(37)+E(3)) QIN(37,I)=DABS(QIN(37,I)) IF(EN.LE.(2.0*EIN(37))) GO TO 1220 PEQIN(37,I)=PEQEL(2,(I-IOFFN(37))) C 4S1! BEF SCALING 1220 IF(EN.LE.EIN(38)) GO TO 2000 QIN(38,I)=0.00435/(EIN(38)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(38)))-BETA2)*BBCONST*EN/(EN+EIN(38)+E(3)) QIN(38,I)=DABS(QIN(38,I)) IF(EN.LE.(2.0*EIN(38))) GO TO 1230 PEQIN(38,I)=PEQEL(2,(I-IOFFN(38))) C 4S4 BEF SCALING 1230 IF(EN.LE.EIN(39)) GO TO 2000 QIN(39,I)=0.00325/(EIN(39)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(39)))-BETA2)*BBCONST*EN/(EN+EIN(39)+E(3)) QIN(39,I)=DABS(QIN(39,I)) IF(EN.LE.(2.0*EIN(39))) GO TO 1240 PEQIN(39,I)=PEQEL(2,(I-IOFFN(39))) C 5D5 BEF SCALING 1240 IF(EN.LE.EIN(40)) GO TO 2000 QIN(40,I)=0.00383/(EIN(40)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(40)))-BETA2)*BBCONST*EN/(EN+EIN(40)+E(3)) QIN(40,I)=DABS(QIN(40,I)) IF(EN.LE.(2.0*EIN(40))) GO TO 1250 PEQIN(40,I)=PEQEL(2,(I-IOFFN(40))) C 5D2 BEF SCALING 1250 IF(EN.LE.EIN(41)) GO TO 2000 QIN(41,I)=0.00127/(EIN(41)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(41)))-BETA2)*BBCONST*EN/(EN+EIN(41)+E(3)) QIN(41,I)=DABS(QIN(41,I)) IF(EN.LE.(2.0*EIN(41))) GO TO 1260 PEQIN(41,I)=PEQEL(2,(I-IOFFN(41))) C 4S2 BEF SCALING 1260 IF(EN.LE.EIN(42)) GO TO 2000 QIN(42,I)=0.00165/(EIN(42)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(42)))-BETA2)*BBCONST*EN/(EN+EIN(42)+E(3)) QIN(42,I)=DABS(QIN(42,I)) IF(EN.LE.(2.0*EIN(42))) GO TO 1270 PEQIN(42,I)=PEQEL(2,(I-IOFFN(42))) C 5S1! BEF SCALING 1270 IF(EN.LE.EIN(43)) GO TO 2000 QIN(43,I)=0.00250/(EIN(43)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(43)))-BETA2)*BBCONST*EN/(EN+EIN(43)+E(3)) QIN(43,I)=DABS(QIN(43,I)) IF(EN.LE.(2.0*EIN(43))) GO TO 1280 PEQIN(43,I)=PEQEL(2,(I-IOFFN(43))) C SUM HIGHER RESONANCE S STATES 1280 IF(EN.LE.EIN(44)) GO TO 2000 QIN(44,I)=0.00962/(EIN(44)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(44)))-BETA2)*BBCONST*EN/(EN+EIN(44)+E(3)) QIN(44,I)=DABS(QIN(44,I)) IF(EN.LE.(2.0*EIN(44))) GO TO 1290 PEQIN(44,I)=PEQEL(2,(I-IOFFN(44))) C SUM HIGHER RESONANCE S STATES 1290 IF(EN.LE.EIN(45)) GO TO 2000 QIN(45,I)=0.01695/(EIN(45)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(45)))-BETA2)*BBCONST*EN/(EN+EIN(45)+E(3)) QIN(45,I)=DABS(QIN(45,I)) IF(EN.LE.(2.0*EIN(45))) GO TO 2000 PEQIN(45,I)=PEQEL(2,(I-IOFFN(45))) 2000 CONTINUE QINEL=0.0 DO 8000 ILVL=1,NIN 8000 QINEL=QINEL+QIN(ILVL,I) Q(1,I)=QELA+Q(5,I)+QINEL C WRITE TOTAL, COUNTING IONISATION, INELASTIC AND ELASTIC X-SECTIONS C WRITE(6,8001) EN,Q(1,I),Q(5,I),QINEL,QELA C8001 FORMAT(3X,' EN=',D12.4,' QTOT=',D12.4,' QION=',D12.4,' QINEL=', C /D12.4,' QELA=',D12.4) 9000 CONTINUE C SAVE COMPUTING TIME DO 9001 K=1,NIN IF(EFINAL.LE.EIN(K)) THEN NIN=K-1 GO TO 9011 ENDIF 9001 CONTINUE 9011 CONTINUE RETURN END SUBROUTINE GAS6(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(116),YXSEC(116),XEL(130),YEL(130), /XEPS(140),YEPS(140),XION(65),YION(65),YINC(65), /XEXC1(105),YEXC1(105),XEXC2(86),YEXC2(86), /X1S5(169),Y1S5(169),YP1S5(169),X1S4(130),Y1S4(130),YP1S4(130), /X1S3(168),Y1S3(168),YP1S3(168),X1S2(150),Y1S2(150),YP1S2(150), /X2P10(142),Y2P10(142),YP2P10(142),X2P9(117),Y2P9(117),YP2P9(117), /X2P8(120),Y2P8(120),YP2P8(120),X2P7(111),Y2P7(111),YP2P7(111), /X2P6(100),Y2P6(100),YP2P6(100),X2P5(102),Y2P5(102),YP2P5(102), /X3D6(69),Y3D6(69),YP3D6(69),X3D5(75),Y3D5(75),YP3D5(75), /X2P4(64),Y2P4(64),YP2P4(64),X3D3(74),Y3D3(74),YP3D3(74), /X3D4P(73),Y3D4P(73),YP3D4P(73),X2P3(73),Y2P3(73),YP2P3(73), /X2P2(75),Y2P2(75),YP2P2(75),X3D4(59),Y3D4(59),YP3D4(59), /X2P1(51),Y2P1(51),YP2P1(51),X3D1PP(48),Y3D1PP(48),YP3D1PP(48), /X3D1P(41),Y3D1P(41),YP3D1P(41),X2S5(44),Y2S5(44),YP2S5(44), /X3P10(20),Y3P10(20),YP3P10(20),X3P9(20),Y3P9(20),YP3P9(20), /X3P8(20),Y3P8(20),YP3P8(20),X3S1PP(20),Y3S1PP(20),YP3S1PP(20), /X3P7(20),Y3P7(20),YP3P7(20),X3P6(20),Y3P6(20),YP3P6(20), /X3S1PPPP(20),Y3S1PPPP(20),YP3S1PPPP(20), /X3S1PPP(20),Y3S1PPP(20),YP3S1PPP(20),X3P5(20),Y3P5(20),YP3P5(20), /X4D6(20),Y4D6(20),YP4D6(20),X4D4P(20),Y4D4P(20),YP4D4P(20), /X4D4(19),Y4D4(19),YP4D4(19),X4D3(19),Y4D3(19),YP4D3(19), /X2S3(19),Y2S3(19),YP2S3(19),X4D1PP(19),Y4D1PP(19),YP4D1PP(19), /X4D1P(19),Y4D1P(19),YP4D1P(19),X3S5(19),Y3S5(19),YP3S5(19), /X4FS(19),Y4FS(19),YP4FS(19),IOFFN(51) 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.75,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,8.50,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.,1250.,1500.,1750.,2000.,2500., /3000.,3500.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,1.0D4, /1.25D4,1.5D4,1.75D4,2.0D4,2.5D4,3.0D4,3.5D4,4.0D4,5.0D4, /6.0D4,8.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5,2.5D5,3.0D5, /4.0D5,5.0D5,6.0D5,8.0D5,1.0D6,1.25D6,1.50D6,2.0D6/ C ELFORD UP TO 2.0 EV THEN FIT TO NAKAMURA DRIFT VELOCITY 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.27,7.29,6.55,5.27,4.30,3.18,2.37, /1.47,.908,.548,.321,.184,.111,.0956,.0870,.0844,.0945, /.187,.339,.525,.729,1.15,1.63,2.60,3.38,4.75,6.35, /7.32,8.28,9.51,10.7,11.9,13.2,14.3,15.3,16.6,17.7, /18.6,19.0,18.9,18.7,18.1,17.1,15.7,14.2,12.7,11.1, /9.60,6.50,2.95,1.95,1.40,1.25,1.20,1.18,0.94,0.80, /0.64,0.54,0.48,0.41,.340,.270,.222,.183,.154,.113, /.0881,.0711,.0591,.0501,.0432,.033,.026,.0212,.0176,.0149, /.0104,.00778,.00605,.00486,.00336,.00248,.00192,.00153,.00105, /.000773,4.76D-4,3.28D-4,2.26D-4,1.68D-4,1.3D-4,1.05D-4,7.35D-5, /5.51D-5,3.53D-5,2.51D-5,1.90D-5,1.25D-5,8.81D-6,6.19D-6,4.68D-6, /3.69D-6/ C ELASTIC CONSISTENT WITHIN 1% OF TOTAL X-SECTION SUM 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.,1200., /1500.,1800.,2000.,2500.,3000.,3500.,4000.,4500.,5000.,5500., /6.0D3,7.0D3,8.0D3,1.0D4,1.25D4,1.5D4,1.75D4,2.0D4,2.5D4,3.0D4, /3.5D4,4.0D4,5.0D4,6.0D4,8.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5, /2.5D5,3.0D5,4.0D5,5.0D5,6.0D5,8.0D5,1.0D6,1.25D6,1.5D6,2.0D6/ 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.60,0.58,0.58, /0.59,0.60,0.62,0.66,0.73,0.81,0.90,0.98,1.17,1.41, /1.66,1.96,2.25,3.14,3.99,4.74,5.62,7.66,9.59,12.0, /16.0,20.1,23.0,25.9,27.2,28.1,28.2,28.2,27.5,26.6, /25.7,24.2,22.0,20.5,19.3,17.4,15.8,14.9,12.9,11.7, /10.8,9.88,8.85,8.00,7.12,6.44,5.84,5.08,4.38,4.15, /3.70,3.56,3.15,2.90,2.62,2.44,2.25,2.20,1.92,1.72, /1.61,1.41,1.40,1.28,1.13,1.06,.951,.895,.826,.798, /.744,.668,.617,.526,.450,.396,.354,.321,.272,.237, /.211,.191,.161,.141,.114,.0973,.0836,.0743,.0676,.0625, /.0554,.0507,.0448,.0414,.0392,.0365,.0350,.0338,.0331,.0323/ C ELASTIC ANGULAR DISTRIBUTION (EPSILON) DATA XEPS/0.00,.001,.003,.005,.007,.010,.015,.020,.030,.040, /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.55,0.56, /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.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,18.0,20.0, /22.5,25.0,27.5,30.0,35.0,40.0,45.0,50.0,60.0,70.0, /75.0,80.0,90.0,100.,125.,150.,175.,200.,250.,300., /400.,500.,600.,700.,800.,1000.,1200.,1250.,1500.,1750., /1800.,2000.,2500.,3000.,3500.,4000.,4500.,5000.,5500.,6000., /7000.,8000.,9000.,1.0D4,1.25D4,1.5D4,1.75D4,2.0D4,2.5D4,3.0D4, /3.5D4,4.0D4,5.0D4,6.0D4,8.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5, /2.5D5,3.0D5,4.0D5,5.0D5,6.0D5,8.0D5,1.0D6,1.25D6,1.5D6,2.0D6/ DATA YEPS/.0,.065,.0848,.1001,.1159,.1348,.1548,.1813,.2178,.2555, /.2775,.3074,.3389,.3622,.3934,.4113,.4541,.4904,.5467,.6280, /.7178,.7779,.8446,.8918,.9338,.9555,.9584,.9583,.9568,.9558, /.9439,.9052,.8374,.8059,.7687,.7338,.6584,.5757,.4998,.4338, /.3731,.3032,.2724,.2498,.2494,.2373,.2546,.2270,.2286,.2297, /.2532,.2517,.3053,.3162,.3328,.3492,.3390,.3375,.3520,.3872, /.4489,.5048,.5515,.6103,.6553,.6966,.7419,.7747,.8075,.8415, /.8802,.8991,.9110,.9220,.9288,.9392,.9463,.9517,.9520,.9464, /.9433,.9382,.9294,.9196,.9204,.9122,.9152,.9112,.9216,.9190, /.9287,.9303,.9305,.9309,.9306,.9337,.9422,.9440,.9519,.9593, /.9606,.9654,.9756,.9787,.9823,.9843,.9861,.9874,.9890,.9910, /.9914,.9926,.9935,.9942,.9955,.9963,.9969,.9973,.9977,.9983, /.9985,.99874,.999016,.999197,.999415,.999544,.999646,.999712, /.999760,.999795, /.999843,.999875,.999913,.999935,.999949,.999965,.999975,.999983, /.999987,.999990/ C IONISATION ( VALUES ABOVE 2OKEV GENERATED BY BORN BETHE IN SUB) DATA XION/13.9996,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./ C GROSS IONISATION DATA YION/0.00,.078,.160,.255,.360,.450,.552,.655,.766,.878, /.980,1.09,1.20,1.34,1.53,1.63,1.84,2.19,2.43,2.66, /2.86,3.02,3.15,3.27,3.37,3.55,3.73,3.86,3.96,4.06, /4.09,4.15,4.13,4.09,3.97,3.79,3.63,3.47,3.34,3.02, /2.76,2.37,2.07,1.86,1.69,1.53,1.42,1.31,1.15,1.03, /.930,.854,.781,.667,.579,.510,.458,.415,.387,.356, /.332,.293,.264,.240,.219/ C COUNTING IONISATION DATA YINC/0.00,.078,.160,.255,.360,.450,.552,.655,.766,.878, /.980,1.09,1.20,1.34,1.53,1.63,1.84,2.19,2.43,2.66, /2.86,3.02,3.15,3.27,3.37,3.53,3.64,3.72,3.77,3.83, /3.83,3.84,3.81,3.76,3.62,3.46,3.31,3.17,3.05,2.75, /2.50,2.12,1.84,1.65,1.49,1.34,1.25,1.14,.995,.886, /.795,.726,.664,.567,.492,.434,.389,.353,.329,.303, /.282,.249,.224,.204,.186/ C 1S5 METASTABLE E=9.91523166 EV J=2 C SHAPE FUNCTION BELOW 50 EV FROM BARTSCHAT AND ZATSARINNY C ABOVE 50 EV SCALED BY 1/E**3 DATA X1S5/9.9152,9.932,9.959,9.973,9.987,10.000,10.027,10.034, /10.041,10.048, /10.055,10.068,10.082,10.095,10.109,10.123,10.136,10.150,10.163, /10.177, /10.184,10.191,10.204,10.218,10.231,10.245,10.259,10.313,10.367, /10.422, /10.476,10.531,10.585,10.612,10.640,10.646,10.653,10.667,10.680, /10.694, /10.708,10.816,10.925,11.034,11.089,11.143,11.197,11.225,11.252, /11.263, /11.265,11.268,11.271,11.272,11.274,11.275,11.276,11.279,11.282, /11.284, /11.287,11.293,11.295,11.298,11.301,11.306,11.309,11.313,11.320, /11.327, /11.334,11.340,11.347,11.354,11.361,11.367,11.374,11.381,11.388, /11.395, /11.402,11.415,11.429,11.442,11.456,11.470,11.483,11.497,11.510, /11.524, /11.538,11.551,11.565,11.578,11.592,11.606,11.619,11.626,11.633, /11.640, /11.644,11.646,11.649,11.653,11.660,11.665,11.674,11.701,11.755, /11.796, /11.851,11.905,11.959,11.973,11.976,11.980,11.984,11.986,11.989, /11.993, /12.000,12.007,12.014,12.017,12.021,12.027,12.041,12.068,12.095, /12.150, /12.204,12.259,12.304,12.367,12.422,12.476,12.531,12.585,12.640, /12.694, /12.748,12.803,12.871,12.925,12.993,13.075,13.197,13.334,13.470, /13.578, /13.742,14.014,14.558,15.102,15.646,16.191,16.735,17.279,17.959, /19.048, /20.0,21.0,22.0,24.0,27.0,30.0,35.0,40.0,50.0/ DATA Y1S5/0.00,1.10,2.18,2.87,3.63,4.38,5.69,6.09,6.58,4.84, /3.88,3.18,2.69,2.46,2.40,2.44,2.62,3.01,4.01,6.71, /7.86,6.60,3.55,2.67,2.42,2.35,2.35,2.54,2.84,3.19, /3.58,4.02,4.42,4.70,5.05,5.19,5.39,5.33,5.29,5.42, /5.54,6.42,7.20,7.63,7.68,7.57,7.21,6.83,6.10,5.64, /5.66,6.12,7.67,8.69,9.58,9.36,9.07,8.29,7.66,7.20, /6.87,6.53,6.64,7.25,8.85,9.99,8.47,7.04,5.99,5.69, /5.16,5.23,5.49,6.00,6.85,8.06,9.28,9.92,9.98,9.87, /9.62,8.49,7.26,6.26,5.51,4.81,4.19,3.61,3.03,2.59, /2.39,3.10,3.69,3.90,3.97,3.97,3.95,4.03,4.40,5.31, /5.79,5.91,5.89,5.71,5.34,5.01,4.83,4.93,5.11,5.21, /5.28,5.30,5.04,4.80,4.81,5.16,5.83,5.86,5.72,5.48, /5.13,4.97,5.85,6.50,7.12,7.16,6.71,6.28,5.89,5.52, /5.65,5.63,5.67,5.41,5.29,5.41,5.60,5.77,5.95,6.00, /5.83,5.56,5.55,5.74,5.91,5.94,5.99,6.06,6.11,6.16, /6.14,6.01,5.80,6.07,6.73,7.37,7.84,8.23,8.57,8.64, /8.20,7.60,7.00,6.04,4.70,3.60,2.30,1.45,0.70/ DATA YP1S5/169*0.0/ C 1S4 E=10.032400 EV J=1 RESONANCE RADIATION 123.585 NM C USED BEF SCALING ABOVE 20 EV OSC STRENGTH=0.203 C SHAPE FUNCTION BELOW 20 EV FROM BARTSCHAT AND ZATSARINNY DATA X1S4/10.0324,10.034,10.041,10.048,10.055,10.068,10.082, /10.095,10.109,10.123, /10.136,10.150,10.163,10.204,10.218,10.231,10.245,10.259,10.286, /10.354, /10.422,10.490,10.558,10.626,10.680,10.748,10.816,10.884,10.953, /11.021, /11.089,11.157,11.238,11.252,11.265,11.271,11.274,11.276,11.282, /11.287, /11.295,11.301,11.306,11.309,11.313,11.320,11.334,11.347,11.361, /11.374, /11.381,11.388,11.395,11.402,11.415,11.429,11.442,11.456,11.483, /11.510, /11.538,11.565,11.592,11.619,11.633,11.644,11.649,11.660,11.674, /11.701, /11.728,11.755,11.776,11.796,11.823,11.851,11.878,11.905,11.932, /11.959, /11.976,11.984,11.989,12.000,12.014,12.021,12.041,12.068,12.095, /12.191, /12.245,12.300,12.354,12.408,12.463,12.517,12.572,12.626,12.680, /12.735, /12.803,12.871,12.925,12.966,13.061,13.157,13.225,13.279,13.347, /13.402, /13.497,13.606,13.878,14.150,14.422,14.694,14.966,15.238,15.510, /15.783, /16.055,16.327,16.599,16.871,17.143,17.415,17.687,17.959,19.048, /20.000/ DATA Y1S4/0.00,0.69,2.81,5.49,8.19,6.82,5.53,5.15,5.23,5.74, /6.94,9.75,17.4,17.8,9.03,5.97,4.62,3.93,3.42,2.97, /3.07,3.35,3.74,4.37,4.81,5.24,5.75,6.37,6.89,7.33, /7.66,7.83,7.61,7.46,7.20,7.79,8.62,8.45,8.03,7.78, /7.78,8.89,9.48,8.73,8.03,7.38,7.09,7.08,7.79,9.35, /9.77,9.75,9.60,9.37,8.58,7.64,6.70,6.56,6.73,6.48, /6.23,7.15,7.57,7.95,8.35,8.28,8.02,7.80,7.88,8.06, /8.16,8.25,8.31,8.36,8.43,8.49,8.55,8.59,8.62,8.60, /9.09,9.57,9.09,8.89,10.0,10.2,9.21,8.96,8.70,9.02, /9.25,9.71,9.84,9.76,9.75,9.90,10.1,10.3,10.4,10.8, /10.6,10.8,10.8,10.8,10.7,11.0,11.2,11.4,11.5,11.6, /11.6,11.8,11.7,11.5,11.4,11.6,12.0,12.5,13.1,13.8, /14.5,15.2,15.8,16.4,17.0,17.9,18.9,20.1,22.4,23.7/ DATA YP1S4/130*0.0/ C 1S3 METASTABLE E=10.56241436 EV J=0 C SHAPE FUNCTION BELOW 50 EV FROM BARTSCHAT AND ZATSARINNY C SCALED BY 1/E**3 ABOVE 50 EV DATA X1S3/10.5624,10.572,10.585,10.599,10.612,10.626,10.640, /10.646,10.653,10.667, /10.680,10.694,10.708,10.735,10.762,10.789,10.816,10.844,10.871, /10.898, /10.925,10.953,10.980,11.007,11.034,11.061,11.089,11.116,11.143, /11.170, /11.197,11.225,11.252,11.263,11.265,11.268,11.271,11.272,11.274, /11.275, /11.276,11.279,11.282,11.284,11.287,11.293,11.295,11.298,11.301, /11.306, /11.309,11.313,11.320,11.327,11.334,11.340,11.347,11.354,11.361, /11.367, /11.374,11.381,11.388,11.395,11.402,11.415,11.429,11.442,11.456, /11.470, /11.483,11.497,11.510,11.524,11.538,11.551,11.578,11.606,11.619, /11.626, /11.633,11.640,11.644,11.646,11.649,11.653,11.660,11.665,11.674, /11.701, /11.728,11.755,11.776,11.796,11.823,11.851,11.878,11.905,11.932, /11.959, /11.980,11.993,12.000,12.007,12.014,12.017,12.021,12.027,12.041, /12.055, /12.068,12.082,12.095,12.110,12.150,12.163,12.177,12.204,12.231, /12.259, /12.286,12.313,12.340,12.354,12.381,12.435,12.490,12.544,12.599, /12.653, /12.708,12.762,12.803,12.871,12.993,13.089,13.157,13.225,13.279, /13.347, /13.374,13.388,13.402,13.415,13.429,13.470,13.497,13.551,13.878, /14.422, /14.966,15.510,16.055,16.599,17.143,17.687,19.048,20.408,21.089, /22.177, /23.130,24.490,26.123,28.572,32.654,38.096,43.538,50.0/ DATA Y1S3/0.00,.255,.560,.671,.508,.377,.265,.211,.263,.459, /.428,.360,.330,.316,.320,.330,.344,.362,.375,.392, /.411,.428,.448,.468,.488,.509,.529,.547,.564,.577, /.581,.568,.511,.555,.674,1.01,1.74,2.09,2.21,2.11, /1.91,1.53,1.27,1.11,1.00,.875,.848,.865,.979,1.17, /1.07,.944,.815,.921,.792,.744,.718,.702,.698,.717, /.780,.891,1.04,1.18,1.28,1.31,1.22,1.14,1.10,1.11, /1.13,1.15,1.18,1.24,1.29,1.30,1.27,1.28,1.29,1.29, /1.26,1.19,1.16,1.15,1.16,1.18,1.21,1.24,1.24,1.25, /1.25,1.25,1.25,1.25,1.24,1.23,1.21,1.18,1.13,1.06, /.978,.885,.806,.806,1.15,1.36,1.52,1.47,1.26,1.15, /1.04,.937,.816,.706,.412,.403,.444,.520,.609,.644, /.686,.687,.729,.782,.840,.889,.919,.939,.951,.934, /.915,.916,.921,.969,.993,.914,.919,.956,.989,1.02, /1.04,1.05,1.06,1.05,1.02,.936,.938,.947,1.00,1.07, /1.07,1.12,1.23,1.30,1.38,1.57,1.86,1.77,1.68,1.54, /1.41,1.25,1.10,.906,.656,.422,.275,.172/ DATA YP1S3/168*0.0/ C 1S2 E=10.6436342 EV J=1 RESONANCE RADIATION 116.487 NM C USED BEF SCALING ABOVE 20 EV OSC STRENGTH=0.182 C SHAPE FUNCTION BELOW 20 EV FROM BARTSCHAT AND ZATSARINNY DATA X1S2/10.6436,10.646,10.653,10.667,10.680,10.694,10.708, /10.721,10.748,10.816, /10.884,10.953,11.021,11.089,11.157,11.225,11.238,11.252,11.263, /11.265, /11.268,11.271,11.272,11.274,11.275,11.276,11.279,11.282,11.284, /11.287, /11.293,11.295,11.298,11.301,11.306,11.309,11.313,11.334,11.367, /11.381, /11.388,11.395,11.402,11.415,11.429,11.456,11.483,11.510,11.538, /11.565, /11.592,11.619,11.626,11.633,11.640,11.644,11.646,11.649,11.653, /11.660, /11.665,11.674,11.687,11.714,11.742,11.762,11.783,11.810,11.837, /11.864, /11.891,11.918,11.946,11.973,11.980,11.986,11.993,12.000,12.007, /12.014, /12.017,12.021,12.027,12.041,12.055,12.068,12.082,12.095,12.109, /12.150, /12.163,12.177,12.191,12.204,12.286,12.340,12.395,12.449,12.504, /12.558, /12.612,12.667,12.721,12.735,12.748,12.762,12.769,12.776,12.789, /12.803, /12.871,12.884,12.898,12.912,12.925,12.966,12.993,13.061,13.075, /13.089, /13.129,13.170,13.197,13.238,13.265,13.293,13.334,13.361,13.388, /13.402, /13.415,13.429,13.470,13.497,13.551,13.606,13.878,14.150,14.422, /14.694, /14.966,15.238,15.510,15.783,16.055,16.327,16.599,17.959,19.048, /20.000/ DATA Y1S2/0.00,.367,1.32,4.25,3.25,2.45,2.09,1.91,1.74,1.66, /1.70,1.81,1.98,2.20,2.45,2.72,2.79,2.89,3.35,3.81, /4.80,6.47,7.04,6.96,6.49,5.87,4.90,4.36,4.08,3.94, /3.91,4.02,4.24,4.53,3.87,3.48,3.28,3.18,3.37,3.58, /3.84,4.15,4.40,4.50,4.37,4.26,4.48,4.70,5.09,5.29, /5.41,5.58,5.61,5.57,5.35,5.21,5.18,5.18,5.23,5.35, /5.46,5.52,5.58,5.66,5.74,5.79,5.83,5.88,5.91,5.91, /5.89,5.83,5.69,5.45,5.36,5.18,5.04,4.81,4.67,5.39, /5.96,6.52,6.55,6.08,5.77,5.48,5.14,4.66,4.28,3.67, /3.80,4.01,4.29,4.50,5.24,5.49,5.77,5.97,6.14,6.27, /6.37,6.45,6.53,6.55,6.47,6.32,6.27,6.22,6.16,6.33, /6.39,6.50,6.79,6.95,6.97,6.99,6.88,6.76,6.71,6.74, /6.86,6.98,7.06,7.18,7.26,7.35,7.49,7.54,7.65,7.68, /7.67,7.54,7.44,7.45,7.52,7.58,7.87,8.18,8.29,8.28, /8.35,8.58,8.97,9.50,10.1,10.7,11.2,14.3,16.8,18.0/ DATA YP1S2/150*0.0/ C 2P10 E=11.3034545 EV J=1 C SHAPE FUNCTION FROM B AND Z ABOVE 30 EV SCALED BY 1/E**3 DATA X2P10/11.3035,11.306,11.309,11.313,11.320,11.327,11.333, /11.340,11.347,11.354, /11.361,11.367,11.374,11.381,11.388,11.395,11.402,11.415,11.429, /11.442, /11.456,11.470,11.483,11.497,11.510,11.524,11.538,11.551,11.565, /11.578, /11.592,11.606,11.619,11.626,11.633,11.640,11.644,11.646,11.649, /11.653, /11.660,11.665,11.674,11.687,11.701,11.714,11.728,11.742,11.755, /11.762, /11.776,11.782,11.796,11.810,11.823,11.837,11.850,11.864,11.878, /11.891, /11.905,11.919,11.932,11.946,11.959,11.973,11.976,11.980,11.984, /11.987, /11.989,11.993,12.000,12.007,12.014,12.016,12.021,12.027,12.041, /12.055, /12.068,12.082,12.095,12.109,12.150,12.163,12.177,12.191,12.204, /12.218, /12.231,12.245,12.259,12.272,12.286,12.299,12.313,12.327,12.340, /12.354, /12.367,12.381,12.395,12.408,12.422,12.436,12.449,12.463,12.476, /12.490, /12.504,12.558,12.612,12.653,12.708,12.748,12.803,12.912,12.966, /13.061, /13.129,13.252,13.347,13.606,14.014,14.558,14.966,15.510,16.055, /16.463, /17.007,17.551,17.959,19.048,20.000,21.089,22.041,23.130,24.490, /26.123, /28.572,30.0/ DATA Y2P10/0.00,0.64,0.96,1.18,1.48,1.74,2.14,2.61,3.13,3.72, /4.35,4.87,5.00,4.66,4.16,3.59,2.85,1.39,0.71,0.58, /0.52,0.54,0.57,0.62,0.69,0.76,0.78,0.78,0.76,0.75, /0.76,0.80,0.92,1.11,1.54,2.19,2.35,2.27,2.12,1.86, /1.52,1.29,1.20,1.15,1.11,1.08,1.06,1.04,1.03,1.03, /1.02,1.02,1.02,1.01,1.01,1.01,1.02,1.02,1.03,1.04, /1.05,1.06,1.08,1.12,1.22,1.70,1.75,1.63,1.22,1.11, /1.13,1.22,1.44,1.75,1.84,1.62,1.21,0.87,0.82,0.86, /0.91,0.95,1.02,1.12,1.18,1.17,1.14,1.08,1.05,1.06, /1.10,1.15,1.15,1.17,1.17,1.18,1.16,1.14,1.12,1.17, /1.14,1.13,1.05,1.01,1.01,1.01,1.02,1.04,1.05,1.06, /1.07,1.09,1.10,1.16,1.44,1.11,1.11,1.13,1.07,1.16, /1.20,1.25,1.29,1.21,1.23,1.60,1.91,2.64,3.57,4.38, /5.45,6.53,7.73,8.54,8.17,7.21,6.26,5.26,4.25,3.39, /2.45,2.05/ DATA YP2P10/142*0.0/ C 2P9 E=11.4430466 EV J=3 C SHAPE FUNCTION FROM B AND Z ABOVE 30 EV SCALED BY 1/E**3 DATA X2P9/11.4430,11.456,11.470,11.483,11.497,11.510,11.524, /11.538,11.551,11.565, /11.578,11.592,11.606,11.619,11.626,11.633,11.640,11.644,11.646, /11.649, /11.653,11.660,11.665,11.674,11.687,11.701,11.714,11.728,11.742, /11.755, /11.762,11.776,11.782,11.796,11.810,11.823,11.837,11.850,11.864, /11.878, /11.891,11.905,11.919,11.932,11.946,11.959,11.973,11.976,11.980, /11.984, /11.987,11.989,11.993,12.000,12.007,12.014,12.016,12.021,12.027, /12.041, /12.055,12.068,12.082,12.095,12.109,12.150,12.163,12.177,12.191, /12.204, /12.218,12.231,12.245,12.259,12.272,12.286,12.299,12.313,12.327, /12.340, /12.354,12.367,12.381,12.395,12.408,12.422,12.436,12.449,12.463, /12.476, /12.490,12.504,12.558,12.612,12.653,12.748,12.803,12.898,13.061, /13.157, /13.252,13.497,13.742,14.014,14.996,16.055,17.007,17.959,19.048, /20.000, /21.089,22.041,23.130,24.490,26.123,28.572,30.000/ DATA Y2P9/0.00,0.42,0.67,0.75,0.78,0.83,0.95,1.03,1.09,1.02, /1.00,1.02,1.08,1.23,1.38,1.59,1.69,1.54,1.40,1.26, /1.10,0.97,0.93,0.96,0.99,1.01,1.02,1.04,1.05,1.06, /1.06,1.07,1.07,1.08,1.09,1.10,1.11,1.12,1.13,1.14, /1.17,1.16,1.18,1.19,1.21,1.23,1.32,1.35,1.39,1.42, /1.44,1.47,1.56,1.90,2.82,4.49,4.71,4.20,3.05,2.15, /1.92,1.84,1.82,1.80,1.74,1.98,1.94,1.60,1.64,1.73, /1.79,1.86,1.85,1.86,1.84,1.80,1.86,1.96,2.05,2.19, /1.86,1.68,1.61,1.60,1.57,1.57,1.58,1.60,1.62,1.64, /1.66,1.68,1.76,1.82,1.80,1.76,2.00,1.93,1.92,2.08, /2.12,2.13,2.16,2.22,3.50,5.50,6.90,7.83,8.15,7.72, /6.77,5.84,4.92,4.03,3.31,2.47,2.11/ DATA YP2P9/117*0.0/ C 2P8 E=11.4446556 EV J=2 C SHAPE FUNCTION FROM B AND Z ABOVE 30 EV SCALED BY 1/E DATA X2P8/11.4447,11.456,11.470,11.483,11.497,11.510,11.524, /11.538,11.551,11.565, /11.578,11.592,11.606,11.619,11.626,11.633,11.640,11.644,11.646, /11.649, /11.653,11.660,11.665,11.674,11.687,11.701,11.714,11.728,11.742, /11.755, /11.762,11.776,11.782,11.796,11.810,11.823,11.837,11.850,11.864, /11.878, /11.891,11.905,11.919,11.932,11.946,11.959,11.973,11.976,11.980, /11.984, /11.987,11.989,11.993,12.000,12.007,12.014,12.016,12.021,12.027, /12.041, /12.055,12.068,12.082,12.095,12.109,12.150,12.163,12.177,12.191, /12.204, /12.218,12.231,12.245,12.259,12.272,12.286,12.299,12.313,12.327, /12.340, /12.354,12.367,12.381,12.395,12.408,12.422,12.436,12.449,12.463, /12.476, /12.490,12.504,12.558,12.599,12.653,12.708,12.762,12.803,12.898, /12.993, /13.252,13.497,13.742,14.014,14.558,14.966,15.510,16.055,16.463, /17.007, /17.959,19.048,20.000,21.089,22.041,23.130,24.490,26.123,28.572, /30.0/ DATA Y2P8/0.00,0.36,0.72,1.01,1.22,1.36,1.45,1.43,1.35,1.29, /1.30,1.33,1.38,1.45,1.50,1.59,1.64,1.61,1.57,1.53, /1.48,1.44,1.42,1.41,1.43,1.45,1.47,1.48,1.50,1.52, /1.53,1.54,1.55,1.57,1.58,1.60,1.61,1.63,1.64,1.66, /1.73,1.68,1.69,1.69,1.70,1.71,1.55,1.67,2.20,2.64, /2.50,2.31,2.11,1.98,2.05,2.34,2.44,2.45,2.30,2.15, /2.09,2.06,2.04,2.06,2.07,1.97,1.97,1.92,1.92,1.95, /2.00,2.07,2.12,2.09,2.12,2.16,2.21,2.25,2.33,2.49, /2.26,2.08,2.02,2.03,2.02,1.99,1.97,1.96,1.95,1.96, /1.97,1.98,2.03,2.06,1.97,2.43,2.30,2.22,2.24,2.36, /2.34,2.43,2.51,2.61,3.01,3.52,4.27,4.97,5.45,5.98, /6.96,7.70,7.85,7.66,7.37,7.03,6.65,6.30,5.82,5.55/ DATA YP2P8/120*0.0/ C 2P7 E=11.5261152 EV J=1 C SHAPE FUNCTION FROM B AND Z ABOVE 30 EV SCALED BY 1/E**3 DATA X2P7/11.5261,11.538,11.551,11.565,11.578,11.592,11.606, /11.619,11.626,11.633, /11.640,11.644,11.646,11.649,11.653,11.660,11.665,11.674,11.687, /11.701, /11.714,11.728,11.742,11.755,11.762,11.776,11.782,11.796,11.810, /11.823, /11.837,11.850,11.864,11.878,11.891,11.905,11.919,11.932,11.946, /11.959, /11.973,11.976,11.980,11.984,11.987,11.989,11.993,12.000,12.007, /12.014, /12.016,12.021,12.027,12.041,12.055,12.068,12.082,12.095,12.109, /12.150, /12.163,12.177,12.191,12.204,12.218,12.231,12.245,12.259,12.272, /12.286, /12.299,12.313,12.327,12.340,12.354,12.367,12.381,12.395,12.408, /12.422, /12.463,12.504,12.558,12.612,12.653,12.694,12.708,12.735,12.762, /12.993, /13.197,13.293,13.497,13.742,14.014,14.558,14.966,15.510,16.055, /16.599, /17.007,17.959,19.048,20.000,21.089,22.041,23.130,24.490,26.123, /28.572,30.0/ DATA Y2P7/0.00,0.21,0.44,0.45,0.45,0.45,0.46,0.49,0.51,0.55, /0.57,0.55,0.53,0.51,0.50,0.49,0.50,0.52,0.57,0.60, /0.62,0.65,0.66,0.67,0.68,0.68,0.69,0.69,0.70,0.70, /0.71,0.71,0.72,0.72,0.72,0.73,0.74,0.74,0.75,0.73, /0.78,0.92,1.00,0.80,0.68,0.64,0.62,0.60,0.53,0.51, /0.56,0.66,0.74,0.75,0.76,0.74,0.70,0.65,0.81,0.88, /0.98,1.20,1.16,1.18,1.23,1.28,1.35,1.31,1.24,1.15, /1.10,1.02,0.99,0.99,0.97,0.94,0.88,0.91,0.88,0.86, /0.82,0.83,0.87,0.91,0.95,1.05,1.48,1.17,0.99,1.07, /1.03,1.06,1.06,1.09,1.19,1.50,1.81,2.33,2.78,3.11, /3.25,3.32,3.08,2.76,2.38,2.07,1.80,1.54,1.31,1.03, /0.90/ DATA YP2P7/111*0.0/ C 2P6 E=11.5458220 EV J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E ABOVE 30 EV DATA X2P6/11.5458,11.551,11.565,11.578,11.592,11.606,11.619, /11.626,11.633,11.640, /11.644,11.646,11.649,11.653,11.660,11.665,11.674,11.687,11.701, /11.714, /11.728,11.742,11.755,11.762,11.776,11.837,11.905,11.959,11.973, /11.976, /11.987,12.000,12.007,12.014,12.016,12.021,12.027,12.041,12.055, /12.068, /12.082,12.095,12.109,12.150,12.163,12.177,12.191,12.204,12.218, /12.231, /12.245,12.259,12.272,12.286,12.299,12.313,12.327,12.340,12.354, /12.367, /12.381,12.395,12.408,12.422,12.436,12.449,12.463,12.476,12.490, /12.504, /12.558,12.599,12.653,12.708,12.762,12.803,12.898,12.993,13.129, /13.252, /13.497,13.742,14.014,14.558,14.966,15.510,16.055,16.599,17.007, /17.415, /17.959,19.048,20.000,21.089,22.041,23.130,24.490,26.123,28.572, /30.000/ DATA Y2P6/0.00,0.27,0.84,1.06,1.15,1.20,1.23,1.25,1.28,1.29, /1.29,1.28,1.27,1.26,1.26,1.25,1.24,1.23,1.23,1.24, /1.25,1.25,1.26,1.26,1.27,1.28,1.27,1.24,1.52,1.49, /1.50,1.36,1.45,1.80,1.93,1.97,1.83,1.68,1.62,1.60, /1.65,1.91,2.49,2.06,2.00,1.94,1.82,1.75,1.69,1.59, /1.51,1.54,1.64,1.83,1.83,1.84,1.80,1.78,1.73,1.68, /1.62,1.63,1.60,1.58,1.56,1.53,1.51,1.49,1.48,1.47, /1.46,1.49,1.54,1.50,1.66,1.57,1.50,1.45,1.47,1.46, /1.39,1.39,1.45,1.70,1.84,2.17,2.53,2.83,3.05,3.16, /3.25,3.21,3.07,3.01,2.97,2.93,2.86,2.76,2.55,2.43/ DATA YP2P6/100*0.0/ C 2P5 E=11.6660274 EV J=0 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E ABOVE 108.84 EV DATA X2P5/11.6660,11.674,11.687,11.701,11.714,11.728,11.742, /11.755,11.762,11.776, /11.782,11.796,11.810,11.823,11.837,11.850,11.864,11.878,11.891, /11.905, /11.919,11.932,11.946,11.959,11.973,11.976,11.980,11.984,11.987, /11.989, /11.993,12.000,12.007,12.014,12.016,12.021,12.027,12.041,12.055, /12.068, /12.082,12.095,12.109,12.150,12.163,12.177,12.191,12.204,12.218, /12.231, /12.245,12.259,12.272,12.286,12.299,12.313,12.327,12.340,12.354, /12.367, /12.381,12.395,12.408,12.422,12.504,12.558,12.599,12.694,12.708, /12.748, /12.803,12.912,12.993,13.089,13.252,13.497,13.742,14.014,14.558, /14.966, /15.510,16.055,16.599,17.007,17.959,19.048,20.000,21.089,22.041, /23.130, /24.490,26.123,28.572,30.000,32.653,38.096,43.538,54.422,68.028, /81.634, /95.239,108.84/ DATA Y2P5/0.00,0.52,0.75,0.87,0.94,0.99,1.03,1.06,1.08,1.11, /1.12,1.14,1.16,1.18,1.21,1.23,1.25,1.27,1.30,1.32, /1.35,1.38,1.42,1.46,1.33,1.30,1.28,1.43,1.57,1.66, /1.76,1.96,2.22,2.24,2.02,1.66,1.40,1.42,1.48,1.54, /1.60,1.67,1.89,2.24,2.28,2.26,2.25,2.26,2.25,2.19, /2.12,2.16,2.11,2.02,1.86,1.66,1.59,1.74,2.21,2.19, /2.18,2.12,2.09,2.10,2.14,2.19,2.24,2.03,2.21,2.74, /2.71,2.65,2.52,2.98,2.93,2.87,3.09,3.48,4.86,6.32, /8.30,9.88,10.9,10.7,10.7,9.74,8.95,8.27,7.85,7.76, /7.21,6.91,6.59,6.42,6.19,5.82,5.54,5.00,4.42,3.92, /3.51,3.16/ DATA YP2P5/102*0.0/ C 3D6 E=11.998135 J=0 C SHAPE FUNCTION FRONM B AND Z SCALED BY 1/E**3 ABOVE 54.422 EV DATA X3D6/11.9981,12.014,12.068,12.082,12.095,12.109,12.150, /12.163,12.177,12.191, /12.204,12.218,12.231,12.245,12.259,12.272,12.286,12.299,12.313, /12.327, /12.340,12.354,12.367,12.381,12.395,12.408,12.449,12.463,12.476, /12.490, /12.504,12.517,12.558,12.599,12.626,12.640,12.653,12.694,12.748, /12.871, /12.993,13.129,13.197,13.293,13.402,13.524,13.606,14.014,14.422, /14.966, /15.510,16.055,16.599,17.007,17.551,17.959,19.048,20.000,21.089, /22.041, /23.130,24.490,25.851,28.572,30.000,32.653,38.096,43.538,54.422/ DATA Y3D6/0.00,.053,.058,.069,.088,.119,.155,.155,.157,.136, /.135,.136,.149,.118,.112,.113,.117,.120,.120,.117, /.126,.147,.140,.136,.126,.123,.123,.122,.121,.119, /.118,.117,.117,.118,.117,.113,.107,.124,.157,.151, /.163,.194,.230,.245,.248,.265,.280,.344,.442,.548, /.802,1.09,1.38,1.61,1.87,2.25,2.53,2.55,2.45,2.33, /2.16,1.94,1.79,1.48,1.35,1.14,.765,.539,.269/ DATA YP3D6/69*0.0/ C 3D5 E=12.037029 J=1 RESONANCE RADIATION 103.003 NM F=0.0053 C SHAPE FUNCTION FROM B AND Z UP TO 68 EV C ABOVE 68 EV USE BEF SCALING DATA X3D5/12.0370,12.041,12.055,12.068,12.082,12.095,12.109, /12.150,12.163,12.177, /12.191,12.204,12.218,12.231,12.245,12.259,12.272,12.286,12.299, /12.313, /12.327,12.340,12.354,12.367,12.381,12.395,12.408,12.422,12.436, /12.449, /12.463,12.476,12.490,12.504,12.558,12.612,12.653,12.708,12.762, /12.803, /12.898,13.061,13.252,13.524,13.742,14.014,14.286,14.558,14.830, /14.966, /15.238,15.510,15.783,16.055,16.327,16.599,16.871,17.007,17.279, /17.551, /17.959,19.048,20.000,21.089,22.041,23.130,24.490,26.123,28.572, /30.000, /32.653,38.096,43.538,54.422,68.028/ DATA Y3D5/0.00,.084,.113,.139,.173,.216,.238,.352,.381,.395, /.409,.439,.505,.568,.427,.392,.403,.407,.390,.348, /.353,.369,.431,.417,.412,.393,.397,.406,.414,.420, /.423,.425,.426,.427,.429,.434,.416,.476,.492,.548, /.581,.646,.773,.851,.955,1.08,1.27,1.50,1.67,1.80, /2.16,2.53,2.88,3.27,3.74,4.17,4.63,4.79,5.23,5.61, /6.40,7.40,7.54,7.31,6.96,6.48,5.90,5.37,4.63,4.25, /3.66,2.73,2.05,1.28,.812/ DATA YP3D5/75*0.0/ C 2P4 E=12.1003506 J=1 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E**3 ABOVE 30.0 EV DATA X2P4/12.1004,12.109,12.150,12.163,12.177,12.191,12.204, /12.218,12.231,12.245, /12.259,12.272,12.286,12.299,12.313,12.327,12.340,12.354,12.367, /12.381, /12.395,12.408,12.449,12.463,12.476,12.490,12.504,12.517,12.531, /12.544, /12.558,12.599,12.653,12.708,12.762,12.803,12.898,12.993,13.089, /13.197, /13.293,13.402,13.497,13.606,13.878,14.014,14.558,14.966,15.238, /15.510, /15.919,16.463,17.007,17.551,17.959,19.048,20.000,21.089,22.041, /23.130, /24.490,26.123,28.572,30.0/ DATA Y2P4/0.00,.121,.308,.308,.320,.339,.352,.369,.395,.408, /.435,.454,.453,.456,.473,.510,.552,.531,.482,.459, /.463,.465,.467,.469,.471,.475,.479,.483,.488,.493, /.499,.519,.571,.625,.633,.617,.822,.739,.627,.671, /.706,.800,.781,.785,.831,.854,.904,1.09,1.26,1.50, /1.80,2.27,2.62,2.88,3.20,3.49,3.48,3.15,2.76,2.34, /1.93,1.54,1.17,1.00/ DATA YP2P4/64*0.0/ C 3D3 E=12.111740 J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E**3 ABOVE 95.239 EV DATA X3D3/12.1117,12.150,12.163,12.177,12.191,12.204,12.218, /12.231,12.245,12.259, /12.272,12.286,12.299,12.313,12.327,12.340,12.354,12.367,12.381, /12.395, /12.408,12.422,12.436,12.449,12.463,12.476,12.490,12.504,12.517, /12.531, /12.558,12.572,12.612,12.626,12.640,12.653,12.667,12.694,12.748, /12.803, /12.898,12.993,13.061,13.129,13.197,13.293,13.402,13.606,13.878, /14.150, /14.558,14.966,15.510,16.055,16.599,17.007,17.551,17.959,19.048, /20.000, /21.089,22.041,23.130,24.490,26.123,28.572,30.000,32.653,38.096, /43.538, /54.422,68.028,81.634,95.239/ DATA Y3D3/0.00,.573,.543,.494,.395,.352,.346,.389,.400,.364, /.352,.345,.335,.318,.269,.246,.325,.343,.389,.413, /.420,.432,.447,.460,.472,.480,.486,.490,.492,.494, /.496,.496,.495,.493,.488,.482,.476,.447,.584,.610, /.616,.578,.663,.735,.815,.860,.870,.949,1.12,1.33, /1.85,2.49,3.35,4.06,4.96,5.51,6.45,7.54,8.83,9.11, /8.82,8.32,7.70,6.95,6.18,5.19,4.70,3.89,2.63,1.79, /.876,.409,.215,.126/ DATA YP3D3/74*0.0/ C 3D4! E=12.125317 J=4 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E**3 ABOVE 81.634 EV DATA X3D4P/12.1253,12.150,12.163,12.177,12.191,12.204,12.218, /12.231,12.245,12.259, /12.272,12.286,12.299,12.313,12.327,12.340,12.354,12.367,12.381, /12.395, /12.408,12.422,12.436,12.449,12.463,12.476,12.490,12.504,12.517, /12.531, /12.558,12.572,12.612,12.626,12.640,12.653,12.667,12.694,12.748, /12.803, /12.898,12.993,13.061,13.129,13.197,13.293,13.402,13.606,13.878, /14.150, /14.558,14.966,15.510,16.055,16.599,17.007,17.551,17.959,19.048, /20.000, /21.089,22.041,23.130,24.490,26.123,28.572,30.000,32.653,38.096, /43.538, /54.422,68.028,81.634/ DATA Y3D4P/0.00,.057,.081,.179,.137,.150,.184,.210,.245,.290, /.328,.327,.324,.305,.285,.303,.318,.296,.313,.330, /.334,.349,.363,.373,.380,.385,.390,.393,.397,.401, /.408,.412,.424,.427,.430,.447,.498,.525,.571,.713, /.691,.640,.702,.790,.836,.889,.944,1.02,1.20,1.47, /1.99,2.69,3.74,4.77,5.64,6.27,7.23,7.37,8.24,8.35, /7.91,7.30,6.58,5.73,4.92,3.88,3.41,2.69,1.68,1.09, /.508,.232,.122/ DATA YP3D4P/73*0.0/ C 2P3 E=12.1404262 J=1 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E**3 ABOVE 81.634 EV DATA X2P3/12.1404,12.150,12.163,12.177,12.191,12.204,12.218, /12.231,12.245,12.259, /12.272,12.286,12.299,12.313,12.327,12.340,12.354,12.367,12.381, /12.395, /12.408,12.422,12.436,12.449,12.463,12.476,12.490,12.504,12.517, /12.531, /12.558,12.572,12.612,12.626,12.640,12.653,12.667,12.694,12.748, /12.803, /12.898,12.993,13.061,13.129,13.197,13.293,13.402,13.606,13.878, /14.150, /14.558,14.966,15.510,16.055,16.599,17.007,17.551,17.959,19.048, /20.000, /21.089,22.041,23.130,24.490,26.123,28.572,30.000,32.653,38.096, /43.538, /54.422,68.028,81.634/ DATA Y2P3/0.00,.108,.284,.400,.456,.485,.496,.544,.568,.536, /.506,.485,.484,.495,.509,.559,.593,.581,.576,.562, /.559,.551,.543,.537,.533,.532,.532,.534,.536,.540, /.551,.557,.580,.586,.591,.613,.729,.777,.646,.678, /.873,.725,.672,.632,.644,.667,.723,.657,.690,.652, /.676,.818,1.07,1.26,1.74,2.23,2.61,2.94,3.35,3.27, /2.86,2.50,2.40,1.75,1.42,1.05,.890,.665,.384,.249, /.138,.080,.048/ DATA YP2P3/73*0.0/ C 2P2 E=12.1436522 J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E ABOVE 108.84 EV DATA X2P2/12.1437,12.150,12.163,12.177,12.191,12.204,12.218, /12.231,12.245,12.259, /12.272,12.286,12.299,12.313,12.327,12.340,12.354,12.367,12.381, /12.395, /12.408,12.422,12.436,12.449,12.463,12.476,12.490,12.504,12.517, /12.531, /12.558,12.572,12.612,12.626,12.640,12.653,12.667,12.694,12.748, /12.803, /12.898,12.993,13.061,13.129,13.197,13.293,13.402,13.606,13.878, /14.150, /14.558,14.966,15.510,16.055,16.599,17.007,17.551,17.959,19.048, /20.000, /21.089,22.041,23.130,24.490,26.123,28.572,30.000,32.653,38.096, /43.538, /54.422,68.028,81.634,95.239,108.84/ DATA Y2P2/0.00,.181,.402,.577,.690,.760,.798,.852,.876,.915, /.965,1.01,1.02,1.05,1.09,1.17,1.17,1.15,1.15,1.14, /1.12,1.11,1.11,1.11,1.12,1.12,1.14,1.15,1.16,1.18, /1.21,1.22,1.27,1.28,1.29,1.29,1.35,1.49,1.43,1.66, /1.53,1.76,1.52,1.45,1.50,1.56,1.75,1.70,1.64,1.71, /1.91,2.24,2.93,3.26,3.79,4.23,4.62,5.05,5.59,5.74, /5.62,5.34,5.00,4.65,4.29,3.88,3.66,3.31,2.76,2.38, /1.90,1.53,1.28,1.10,.962/ DATA YP2P2/75*0.0/ C 3D4 E=12.178504 J=3 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E ABOVE 108.84 EV DATA X3D4/12.1785,12.191,12.204,12.218,12.231,12.245,12.259, /12.272,12.286,12.299, /12.313,12.327,12.340,12.354,12.367,12.381,12.395,12.408,12.422, /12.436, /12.449,12.463,12.476,12.558,12.653,12.748,12.803,12.993,13.089, /13.388, /13.606,14.014,14.286,14.558,14.830,15.102,15.510,15.919,16.463, /17.007, /17.551,17.959,19.048,20.000,21.089,22.041,23.130,24.490,26.123, /28.572, /30.000,32.653,38.096,43.538,54.422,68.028,81.634,95.239,108.84/ DATA Y3D4/0.00,.363,.381,.395,.437,.491,.560,.630,.684,.700, /.655,.613,.672,.717,.706,.725,.735,.718,.702,.693, /.691,.691,.693,.717,.890,.870,.844,.734,.831,.857, /.864,.976,1.20,1.52,1.88,2.20,2.69,3.08,3.67,3.93, /4.10,4.36,4.66,4.67,4.50,4.26,3.97,3.62,3.28,2.84, /2.63,2.31,1.83,1.52,1.21,1.01,.878,.781,.704/ DATA YP3D4/59*0.0/ C 2P1 E=12.2564658 J=0 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E ABOVE 108.84 EV DATA X2P1/12.2565,12.272,12.286,12.299,12.313,12.327,12.340, /12.354,12.367,12.381, /12.463,12.504,12.558,12.612,12.653,12.708,12.762,12.803,12.898, /12.966, /13.061,13.197,13.402,13.551,13.742,14.014,14.558,14.966,15.510, /16.055, /16.463,17.007,17.551,17.959,19.048,20.000,21.089,22.041,23.130, /24.490, /26.123,28.572,30.000,32.653,38.096,43.538,54.422,68.028,81.634, /95.239,108.84/ DATA Y2P1/0.00,.200,.261,.282,.298,.321,.378,.554,.540,.517, /.478,.489,.518,.560,.508,.642,.789,.647,1.01,.822, /.922,.866,.995,1.06,1.11,1.20,1.59,2.23,3.27,4.28, /4.85,5.41,5.75,5.98,5.74,5.35,4.96,4.70,4.49,4.30, /4.14,3.95,3.86,3.73,3.53,3.38,3.09,2.75,2.46,2.20,2.00/ DATA YP2P1/51*0.0/ C 3D1!! E=12.257998 J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E**3 ABOVE 68.028 EV DATA X3D1PP/12.2580,12.272,12.286,12.299,12.313,12.327,12.340, /12.354,12.367,12.381, /12.463,12.504,12.558,12.612,12.653,12.708,12.762,12.803,12.898, /12.966, /13.061,13.197,13.402,13.551,13.742,14.014,14.558,14.966,15.510, /16.055, /16.463,17.007,17.551,17.959,19.048,20.000,21.089,22.041,23.130, /24.490, /26.123,28.572,30.000,32.653,38.096,43.538,54.422,68.028/ DATA Y3D1PP/0.00,.038,.055,.073,.093,.107,.125,.158,.178,.204, /.231,.253,.283,.319,.380,.368,.399,.473,.318,.348, /.450,.455,.524,.516,.552,.631,.926,1.24,1.54,1.75, /1.99,2.41,2.63,2.60,2.66,2.63,2.50,2.35,2.18,1.97, /1.79,1.48,1.33,1.08,.689,.444,.221,.116/ DATA YP3D1PP/48*0.0/ C 3D1! E=12.284275 J=3 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E ABOVE 38 EV DATA X3D1P/12.2843,12.327,12.340,12.354,12.367,12.381,12.463, /12.504,12.558,12.612, /12.653,12.708,12.762,12.803,12.898,12.966,13.061,13.197,13.402, /13.551, /13.742,14.014,14.558,14.966,15.510,16.055,16.463,17.007,17.551, /17.959, /19.048,20.000,21.089,22.041,23.130,24.490,26.123,28.572,30.000, /32.653,38.096/ DATA Y3D1P/0.00,.313,.357,.448,.451,.465,.527,.568,.604,.637, /.685,.742,.625,.781,.553,.538,.588,.591,.606,.566, /.535,.529,.688,.891,1.24,1.50,1.53,1.59,1.78,1.68, /1.56,1.47,1.42,1.41,1.40,1.40,1.37,1.29,1.23,1.11,.913/ DATA YP3D1P/41*0.0/ C 2S5 E=12.352158 J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E**3 ABOVE 68 EV DATA X2S5/12.3522,12.367,12.381,12.395,12.408,12.422,12.463, /12.504,12.558,12.612, /12.653,12.708,12.762,12.803,12.898,12.966,13.061,13.197,13.402, /13.551, /13.742,14.014,14.558,14.966,15.510,16.055,16.463,17.007,17.551, /17.959, /19.048,20.000,21.089,22.041,23.130,24.490,26.123,28.572,30.000, /32.653, /38.096,43.538,54.422,68.028/ DATA Y2S5/0.00,.235,.250,.475,.598,.674,.773,.845,.945,1.04, /1.06,1.18,.748,.861,1.05,1.05,1.17,1.14,1.12,1.07, /1.03,.989,1.09,1.22,1.49,1.76,1.85,1.93,1.98,2.03, /1.89,1.73,1.55,1.41,1.28,1.12,.995,.812,.725,.586, /.377,.246,.119,.058/ DATA YP2S5/44*0.0/ C 3D2 E=12.354555 J=1 RESONANCE RADIATION 100.356 NM F=0.082 C USE BEF SCALING C C 2S4 E=12.3852827 J=1 RESONANCE RADIATION 100.107 NM F=0.154 C USE BEF SCALING C C 3P10 E=12.7563854 EV J=1 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E**3 ABOVE 68 EV DATA X3P10/12.7564,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3P10/0.00,.459,.956,1.41,2.20,2.55,3.05,2.96,2.74,2.38, /2.04,1.70,1.36,1.07,0.75,0.61,0.23,0.14,.078,.046/ DATA YP3P10/20*0.0/ C 3P9 E=12.7847085 EV J=3 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/E**3 ABOVE 68 EV DATA X3P9/12.7847,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3P9/0.00,.511,1.48,2.40,3.02,3.44,3.57,3.57,3.36,2.94, /2.54,2.12,1.72,1.40,1.02,0.86,0.38,0.24,.122,.061/ DATA YP3P9/20*0.0/ C 3P8 E=12.7853913 EV J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN ABOVE 68 EV DATA X3P8/12.7854,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3P8/0.00,.575,1.19,2.00,2.64,2.86,3.08,3.11,3.06,2.91, /2.74,2.56,2.36,2.17,1.95,1.83,1.38,1.19,0.94,0.75/ DATA YP3P8/20*0.0/ C 3S1PP E=12.8033935 EV J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X3S1PP/12.8034,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3S1PP/0.00,.328,0.84,1.39,2.05,3.41,4.82,6.11,6.68,6.68, /6.40,5.94,5.36,4.81,4.05,3.69,2.14,1.49,0.76,0.36/ DATA YP3S1PP/20*0.0/ C 3P7 E=12.8092373 EV J=1 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X3P7/12.8092,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3P7/0.00,0.29,0.64,1.05,1.31,1.26,1.27,1.10,0.96,0.81, /0.70,0.60,0.51,0.44,0.35,0.31,0.17,0.12,.088,.067/ DATA YP3P7/20*0.0/ C 3P6 E=12.8153298 EV J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN ABOVE 68 EV DATA X3P6/12.8153,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3P6/0.00,0.33,1.18,1.44,1.73,1.98,1.95,1.71,1.50,1.34, /1.23,1.14,1.04,0.95,0.81,0.75,0.51,0.42,0.32,0.25/ DATA YP3P6/20*0.0/ C 3S1PPPP E=12.8252582 EV J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X3S1PPPP/12.8253,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3S1PPPP/0.00,0.16,0.41,0.83,1.71,2.50,3.10,3.56,3.83,3.78, /3.57,3.26,2.89,2.45,1.97,1.75,0.89,0.58,0.27,0.13/ DATA YP3S1PPPP/20*0.0/ C 3S1PPP E=12.8573390 EV J=3 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN ABOVE 68 EV DATA X3S1PPP/12.8573,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3S1PPP/0.00,0.29,0.54,0.99,2.02,2.69,3.38,3.90,4.10,4.05, /3.84,3.55,3.20,2.80,2.33,2.11,1.27,0.98,0.67,0.50/ DATA YP3S1PPP/20*0.0/ C 3P5 E=12.8648022 EV J=0 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN ABOVE 68 EV DATA X3P5/12.8648,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y3P5/0.00,0.56,2.30,4.54,6.23,6.30,6.01,5.23,4.62,4.10, /3.79,3.71,3.29,3.07,2.86,2.75,2.39,2.25,2.02,1.79/ DATA YP3P5/20*0.0/ C 4D5 E=12.8698 EV J=1 RESONANCE RADIATION 96.3338NM F=0.0140 C USE BEF SCALING C 4D6 E=12.9034651 EV J=0 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X4D6/12.9035,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y4D6/0.00,0.07,0.21,0.32,0.57,0.76,1.09,1.24,1.30,1.28, /1.22,1.12,0.98,0.90,0.74,0.67,0.34,0.25,0.12,.056/ DATA YP4D6/20*0.0/ C 4D4P E=12.972537 EV J=4 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X4D4P/12.9725,12.993,14.014,14.966,16.055,17.007,17.959, /19.048,20.000,21.089, /22.041,23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422, /68.028/ DATA Y4D4P/0.00,0.14,0.89,1.48,2.18,3.01,3.72,4.15,4.25,4.08, /3.81,3.48,3.07,2.64,2.09,1.84,0.92,0.60,0.28,0.13/ DATA YP4D4P/20*0.0/ C 3S1P E=13.0043688 EV J=1 RESONANCE RADIATION 95.341 NM F=0.0435 C USE BEF SCALING C C 4D4 E=13.0079847 EV J=3 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN ABOVE 68 EV DATA X4D4/13.0080,14.014,14.966,16.055,17.007,17.959,19.048, /20.000,21.089,22.041, /23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422,68.028/ DATA Y4D4/0.00,1.10,1.37,1.85,2.26,2.34,2.14,1.95,1.78,1.67, /1.56,1.46,1.38,1.26,1.20,0.95,0.90,0.84,0.78/ DATA YP4D4/19*0.0/ C 4D3 E=13.0192383 EV J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X4D3/13.0192,14.014,14.966,16.055,17.007,17.959,19.048, /20.000,21.089,22.041, /23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422,68.028/ DATA Y4D3/0.00,0.65,1.06,1.66,2.16,2.15,2.16,2.08,1.91,1.74, /1.58,1.41,1.29,1.05,0.94,0.48,0.32,0.16,0.09/ DATA YP4D3/19*0.0/ C 2S3 E=13.029666 EV J=0 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X2S3/13.0297,14.014,14.966,16.055,17.007,17.959,19.048, /20.000,21.089,22.041, /23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422,68.028/ DATA Y2S3/0.00,0.13,0.13,0.17,0.27,0.29,0.29,0.27,0.25,0.23, /0.21,0.19,0.17,0.15,0.14,.073,.054,.028,.015/ DATA YP2S3/19*0.0/ C 2S2 E=13.036483 EV J=1 RESONANCE RADIATION 95.106 NM F=0.0105 C USE BEF SCALING C C 4D1PP E=13.0386113 J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X4D1PP/13.0386,14.014,14.966,16.055,17.007,17.959,19.048, /20.000,21.089,22.041, /23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422,68.028/ DATA Y4D1PP/0.00,0.50,0.80,1.12,1.46,1.64,1.49,1.40,1.29,1.19, /1.17,1.02,0.94,0.80,0.73,0.32,0.22,.109,.059/ DATA YP4D1PP/19*0.0/ C 4D1P E=13.0441877 J=3 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X4D1P/13.0442,14.014,14.966,16.055,17.007,17.959,19.048, /20.000,21.089,22.041, /23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422,68.028/ DATA Y4D1P/0.00,0.63,0.92,1.47,1.58,1.70,1.50,1.30,1.13,1.02, /0.95,0.88,0.84,0.71,0.64,0.33,0.22,.123,.084/ DATA YP4D1P/19*0.0/ C 3S5 E=13.0986140 J=2 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN**3 ABOVE 68 EV DATA X3S5/13.0986,14.014,14.966,16.055,17.007,17.959,19.048, /20.000,21.089,22.041, /23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422,68.028/ DATA Y3S5/0.00,0.88,1.56,1.89,1.82,2.08,2.37,2.40,2.21,1.96, /1.65,1.30,1.02,0.69,0.57,0.22,0.13,.058,.027/ DATA YP3S5/19*0.0/ C 4D2 E=13.0987356 EV J=1 RESONANCE RADIATION 94.654 NM F=0.0970 C USE BEF SCALING C C 3S4 E=13.1138948 EV J=1 RESONANCE RADIATION 94.545 NM F=0.0808 C USE BEF SCALING C C SUM 4F STATES E=13.14 J=1,2,5,4,3,2,4,4 C SHAPE FUNCTION FROM B AND Z SCALED BY 1/EN ABOVE 68 EV DATA X4FS/13.14,14.014,14.966,16.055,17.007,17.959,19.048, /20.000,21.089,22.041, /23.130,24.490,26.123,28.572,30.000,38.096,43.538,54.422,68.028/ DATA Y4FS/0.00,1.58,3.51,4.86,4.89,4.50,3.60,2.89,2.24,1.85, /1.49,1.19,0.93,0.69,0.59,0.32,0.25,0.18,0.14/ DATA YP4FS/19*0.0/ C 5D5 E=13.3501402 EV J=1 RESONANCE RADIATION 92.872 NM F=0.0015 C USE BEF SCALING C C 5D2 E=13.4223741 EV J=1 RESONANCE RADIATION 92.372 NM F=0.0439 C USE BEF SCALING C C 4S4 E=13.4365439 EV J=1 RESONANCE RADIATION 92.274 NM F=0.0203 C USE BEF SCALING C C HIGH E=13.6 EV SUM OF HIGHER DIPOLE STATES F=0.168 C USE BEF SCALING C C TOTAL OSCILLATOR STRENGTH =1.1258 1.1058 C C---------------------------------------------------------------------- C NANISO=0 IF(NANISO.EQ.0) THEN NAME='KRYPTN ISO 2011' ELSE NAME='KRYPTN ANI 2011' ENDIF 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 2007: INCREASED UPPER ENERGY LIMIT TO 2MEV C 2007: INCLUDED NEW ANGULAR DISTRIBUTION FUNCTION C 2007: INCLUDED PENNING TRANSFER FRACTION C 2011: 51 EXCITATION LEVELS : USED BEF SCALED VALUES FOR DIPOLE STATES C THE 1S2 AND 1S4 DIPOLE STATES INCLUDE THE RESONANCE STRUCTURE C CALCULATED BY BARTSCHAT AND ZATSARINNY DBSR MODEL SCALED BY 0.87 C THE 2P AND HIGHER TRIPLET STATES CALCULATED IN THE DBSR MODEL C ARE ALSO SCALED TO AGREE WITH ELECTRON SCATTERING AND FIT TO THE C TO THE TOWNSEND GAIN MEASUREMENTS. C DRIFT VELOCITY DATA AT HIGH FIELD FROM NAKAMURA IS FIITED BY THE C MOMENTUM TRANSFER X-SECTION. C EXPERIMENTAL AND TOTAL X-SECTIONS AGREE TO 1%. C THE DRIFT VELOCITY FIT IS BETTER THAN 1% . C TOWNSEND CALC IS IN GOOD AGREEMENT WITH JACQUES ET AL AT LOW C ELECTRIC FIELD BUT NOW ABOUT 8% BELOW KRUITOFF AT HIGH FIELD. C -------------------------------------------------------------------- C C BORN BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 AM2=4.65 C=52.7 C BORN BETHE CONSTANT A0=0.52917720859D-8 RY=13.60569193 API=DACOS(-1.0D0) BBCONST=16.0*API*A0*A0*RY*RY/EMASS2 C AN1S=0.87 AN2P10=0.4 AN2P5=0.4 AN2P1=0.4 AN2P=0.75 AN3P=0.60 AN3P5=0.4 AN3D=0.65 AN4D=0.4 NIN=51 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN 2 KIN(J)=NANISO C NEL=130 NDATA=116 NEPSI=140 NION=65 N1S5=169 N1S4=130 N1S3=168 N1S2=150 N2P10=142 N2P9=117 N2P8=120 N2P7=111 N2P6=100 N2P5=102 N3D6=69 N3D5=75 N2P4=64 N3D3=74 N3D4P=73 N2P3=73 N2P2=75 N3D4=59 N2P1=51 N3D1PP=48 N3D1P=41 N2S5=44 N3P10=20 N3P9=20 N3P8=20 N3S1PP=20 N3P7=20 N3P6=20 N3S1PPPP=20 N3S1PPP=20 N3P5=20 N4D6=20 N4D4P=20 N4D4=19 N4D3=19 N2S3=19 N4D1PP=19 N4D1P=19 N3S5=19 N4FS=19 E(1)=0.0 E(2)=2.0*EMASS/(83.798*AMU) E(3)=13.9996 C EXCITATION X-SECTION AT 1.4MEV E(4)=0.296D-18 C IONISING X-SECTION AT 1.4MEV E(5)=0.1217D-17 C EOBY AT MINIMUM IONISING E(6)=23.0 C EOBY AT LOW ENERGY EOBY=9.6 IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) EIN(1)=9.9152 EIN(2)=10.0324 EIN(3)=10.5624 EIN(4)=10.6436 EIN(5)=11.3035 EIN(6)=11.4430 EIN(7)=11.4447 EIN(8)=11.5261 EIN(9)=11.5458 EIN(10)=11.6660 EIN(11)=11.9981 EIN(12)=12.0370 EIN(13)=12.1004 EIN(14)=12.1117 EIN(15)=12.1253 EIN(16)=12.1404 EIN(17)=12.1437 EIN(18)=12.1785 EIN(19)=12.2565 EIN(20)=12.2580 EIN(21)=12.2843 EIN(22)=12.3522 EIN(23)=12.3546 EIN(24)=12.3853 EIN(25)=12.7564 EIN(26)=12.7847 EIN(27)=12.7854 EIN(28)=12.8034 EIN(29)=12.8092 EIN(30)=12.8153 EIN(31)=12.8253 EIN(32)=12.8573 EIN(33)=12.8648 EIN(34)=12.8698 EIN(35)=12.9035 EIN(36)=12.9725 EIN(37)=13.0044 EIN(38)=13.0080 EIN(39)=13.0192 EIN(40)=13.0297 EIN(41)=13.0365 EIN(42)=13.0386 EIN(43)=13.0442 EIN(44)=13.0986 EIN(45)=13.0987 EIN(46)=13.1139 EIN(47)=13.14 EIN(48)=13.3501 EIN(49)=13.4224 EIN(50)=13.4365 EIN(51)=13.6 C********************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C USE PENNING TRANSFER FRACTION BETWEEN 0.0 AND 0.2 DO 50 NL=1,NIN PENFRA(1,NL)=0.0 C PENNING TRANSFER DISTANCE MICRONS PENFRA(2,NL)=1.0 C PENNING TRANSFER TIME 50 PENFRA(3,NL)=1.0 C********************************************************************** IF(IPEN.EQ.0) GO TO 4 DO 3 KDUM=1,NIN IF(PENFRA(1,KDUM).EQ.0.0) GO TO 3 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 3 CONTINUE 4 DO 5 NL=1,NIN 5 IOFFN(NL)=IFIX(SNGL(0.5+EIN(NL)/ESTEP)) SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) KRYPTON ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC (ISO) KRYPTON ' ENDIF SCRPT(3)=' IONISATION ELOSS= 13.9996 ' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EX 1S5 J=2 M ELVL= 9.9152' SCRPT(8)=' EX 1S4 J=1 R ELVL= 10.0324' SCRPT(9)=' EX 1S3 J=0 M ELVL= 10.5624' SCRPT(10)=' EX 1S2 J=1 R ELVL= 10.6436' SCRPT(11)=' EX 2P10 J=1 ELVL= 11.3035' SCRPT(12)=' EX 2P9 J=3 ELVL= 11.4430' SCRPT(13)=' EX 2P8 J=2 ELVL= 11.4447' SCRPT(14)=' EX 2P7 J=1 ELVL= 11.5261' SCRPT(15)=' EX 2P6 J=2 ELVL= 11.5458' SCRPT(16)=' EX 2P5 J=0 ELVL= 11.6660' SCRPT(17)=' EX 3D6 J=0 ELVL= 11.9981' SCRPT(18)=' EX 3D5 J=1 R ELVL= 12.0370' SCRPT(19)=' EX 2P4 J=1 ELVL= 12.1004' SCRPT(20)=' EX 3D3 J=2 ELVL= 12.1117' SCRPT(21)=' EX 3D4! J=4 ELVL= 12.1253' SCRPT(22)=' EX 2P3 J=1 ELVL= 12.1404' SCRPT(23)=' EX 2P2 J=2 ELVL= 12.1437' SCRPT(24)=' EX 3D4 J=3 ELVL= 12.1785' SCRPT(25)=' EX 2P1 J=0 ELVL= 12.2565' SCRPT(26)=' EX 3D1!! J=2 ELVL= 12.2580' SCRPT(27)=' EX 3D1! J=3 ELVL= 12.2843' SCRPT(28)=' EX 2S5 J=2 ELVL= 12.3522' SCRPT(29)=' EX 3D2 J=1 R ELVL= 12.3546' SCRPT(30)=' EX 2S4 J=1 R ELVL= 12.3853' SCRPT(31)=' EX 3P10 J=1 ELVL= 12.7564' SCRPT(32)=' EX 3P9 J=3 ELVL= 12.7847' SCRPT(33)=' EX 3P8 J=2 ELVL= 12.7854' SCRPT(34)=' EX 3S1!! J=2 ELVL= 12.8034' SCRPT(35)=' EX 3P7 J=1 ELVL= 12.8092' SCRPT(36)=' EX 3P6 J=2 ELVL= 12.8153' SCRPT(37)=' EX 3S1!!!! J=2 ELVL= 12.8253' SCRPT(38)=' EX 3S1!!! J=3 ELVL= 12.8573' SCRPT(39)=' EX 3P5 J=0 ELVL= 12.8648' SCRPT(40)=' EX 4D5 J=1 R ELVL= 12.8698' SCRPT(41)=' EX 4D6 J=0 ELVL= 12.9035' SCRPT(42)=' EX 4D4! J=4 ELVL= 12.9725' SCRPT(43)=' EX 3S1! J=1 R ELVL= 13.0044' SCRPT(44)=' EX 4D4 J=3 ELVL= 13.0080' SCRPT(45)=' EX 4D3 J=2 ELVL= 13.0192' SCRPT(46)=' EX 2S3 J=0 ELVL= 13.0297' SCRPT(47)=' EX 3S2 J=1 R ELVL= 13.0365' SCRPT(48)=' EX 4D1!! J=2 ELVL= 13.0386' SCRPT(49)=' EX 4D1! J=3 ELVL= 13.0442' SCRPT(50)=' EX 3S5 J=2 ELVL= 13.0986' SCRPT(51)=' EX 4D2 J=1 R ELVL= 13.0987' SCRPT(52)=' EX 3S4 J=1 R ELVL= 13.1139' SCRPT(53)=' EX 4F SUM ELVL= 13.14 ' SCRPT(54)=' EX 5D5 J=1 R ELVL= 13.3501' SCRPT(55)=' EX 5D2 J=1 R ELVL= 13.4224' SCRPT(56)=' EX 4S4 J=1 R ELVL= 13.4365' SCRPT(57)=' EX HIGH J=1 R ELVL= 13.6 ' EN=-ESTEP/2.0 C EN=ESTEP DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.EIN(1)) THEN GAMMA1=(EMASS2+2.0D0*EN)/EMASS2 GAMMA2=GAMMA1*GAMMA1 BETA=DSQRT(1.0D0-1.0D0/GAMMA2) BETA2=BETA*BETA ENDIF IF(EN.EQ.0.0) THEN QELA=37.8D-16 QMOM=37.8D-16 GO TO 200 ENDIF DO 110 J=2,NEL IF(EN.LE.XEL(J)) GO TO 120 110 CONTINUE J=NEL C USE LOG INTERPOLATION 120 Y1=DLOG(YEL(J-1)) Y2=DLOG(YEL(J)) X1=DLOG(XEL(J-1)) X2=DLOG(XEL(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) QELA=DEXP((A*DLOG(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=DLOG(YXSEC(J-1)) Y2=DLOG(YXSEC(J)) X1=DLOG(XEN(J-1)) X2=DLOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) QMOM=DEXP((A*DLOG(EN)+B))*1.0D-16 200 CONTINUE PQ1=0.5+(QELA-QMOM)/QELA DO 201 J=2,NEPSI IF(EN.LE.XEPS(J)) GO TO 202 201 CONTINUE J=NEPSI 202 A=(YEPS(J)-YEPS(J-1))/(XEPS(J)-XEPS(J-1)) B=(XEPS(J-1)*YEPS(J)-XEPS(J)*YEPS(J-1))/(XEPS(J-1)-XEPS(J)) PQ2=A*EN+B IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) THEN Q(2,I)=QMOM PEQEL(2,I)=0.5 ENDIF C GROSS IONISATION X-SECTION Q(3,I)=0.0 PEQEL(3,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 230 IF(EN.GT.XION(NION)) GO TO 221 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 GO TO 222 C USE BORN BETHE ABOVE XION(NION) EV. 221 X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2)/0.85 222 CONTINUE 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 ATTACHMENT 230 CONTINUE Q(4,I)=0.0 C COUNTING IONISATION Q(5,I)=0.0 PEQEL(5,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(5,I)=0.0D0 IF(EN.LE.E(3)) GO TO 250 IF(EN.GT.XION(NION)) GO TO 241 DO 231 J=2,NION IF(EN.LE.XION(J)) GO TO 240 231 CONTINUE J=NION 240 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.D-16 GO TO 242 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV. 241 Q(5,I)=CONST*(AM2*X1+C*X2) 242 CONTINUE 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 250 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 250 Q(6,I)=0.0 C DO 251 NL=1,NIN QIN(NL,I)=0.0D0 PEQIN(NL,I)=0.5D0 IF(NANISO.EQ.2) THEN PEQIN(NL,I)=0.0D0 ENDIF 251 CONTINUE C 1S5 IF(EN.LE.EIN(1)) GO TO 899 IF(EN.GT.X1S5(N1S5)) GO TO 352 DO 350 J=2,N1S5 IF(EN.LE.X1S5(J)) GO TO 351 350 CONTINUE J=N1S5 351 A=(Y1S5(J)-Y1S5(J-1))/(X1S5(J)-X1S5(J-1)) B=(X1S5(J-1)*Y1S5(J)-X1S5(J)*Y1S5(J-1))/(X1S5(J-1)-X1S5(J)) QIN(1,I)=(A*EN+B)*1.0D-18*AN1S GO TO 353 C SCALED X-SECTION ABOVE X1S5(N1S5) EV BY 1/E**3 352 QIN(1,I)=Y1S5(N1S5)*(X1S5(N1S5)/EN)**3*1.0D-18*AN1S 353 IF(EN.LE.(2.0*EIN(1))) GO TO 354 PEQIN(1,I)=PEQEL(2,(I-IOFFN(1))) C 1S4 F=0.203 354 IF(EN.LE.EIN(2)) GO TO 899 IF(EN.GT.X1S4(N1S4)) GO TO 357 DO 355 J=2,N1S4 IF(EN.LE.X1S4(J)) GO TO 356 355 CONTINUE J=N1S4 356 A=(Y1S4(J)-Y1S4(J-1))/(X1S4(J)-X1S4(J-1)) B=(X1S4(J-1)*Y1S4(J)-X1S4(J)*Y1S4(J-1))/(X1S4(J-1)-X1S4(J)) QIN(2,I)=(A*EN+B)*1.0D-18*AN1S GO TO 358 357 QIN(2,I)=0.203/(EIN(2)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(2)))-BETA2)*BBCONST*EN/(EN+EIN(2)+E(3)) 358 IF(EN.LE.(2.0*EIN(2))) GO TO 359 PEQIN(2,I)=PEQEL(2,(I-IOFFN(2))) C 1S3 359 IF(EN.LE.EIN(3)) GO TO 899 IF(EN.GT.X1S3(N1S3)) GO TO 362 DO 360 J=2,N1S3 IF(EN.LE.X1S3(J)) GO TO 361 360 CONTINUE J=N1S3 361 A=(Y1S3(J)-Y1S3(J-1))/(X1S3(J)-X1S3(J-1)) B=(X1S3(J-1)*Y1S3(J)-X1S3(J)*Y1S3(J-1))/(X1S3(J-1)-X1S3(J)) QIN(3,I)=(A*EN+B)*1.0D-18*AN1S GO TO 363 C SCALED X-SECTION ABOVE X1S3(N1S3) EV BY 1/E**3 362 QIN(3,I)=Y1S3(N1S3)*(X1S3(N1S3)/EN)**3*1.0D-18*AN1S 363 IF(EN.LE.(2.0*EIN(3))) GO TO 364 PEQIN(3,I)=PEQEL(2,(I-IOFFN(3))) C 1S2 F=0.182 364 IF(EN.LE.EIN(4)) GO TO 899 IF(EN.GT.X1S2(N1S2)) GO TO 367 DO 365 J=2,N1S2 IF(EN.LE.X1S2(J)) GO TO 366 365 CONTINUE J=N1S2 366 A=(Y1S2(J)-Y1S2(J-1))/(X1S2(J)-X1S2(J-1)) B=(X1S2(J-1)*Y1S2(J)-X1S2(J)*Y1S2(J-1))/(X1S2(J-1)-X1S2(J)) QIN(4,I)=(A*EN+B)*1.0D-18*AN1S GO TO 368 367 QIN(4,I)=0.182/(EIN(4)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(4)))-BETA2)*BBCONST*EN/(EN+EIN(4)+E(3)) 368 IF(EN.LE.(2.0*EIN(4))) GO TO 369 PEQIN(4,I)=PEQEL(2,(I-IOFFN(4))) C 2P10 369 IF(EN.LE.EIN(5)) GO TO 899 IF(EN.GT.X2P10(N2P10)) GO TO 372 DO 370 J=2,N2P10 IF(EN.LE.X2P10(J)) GO TO 371 370 CONTINUE J=N2P10 371 A=(Y2P10(J)-Y2P10(J-1))/(X2P10(J)-X2P10(J-1)) B=(X2P10(J-1)*Y2P10(J)-X2P10(J)*Y2P10(J-1))/(X2P10(J-1)-X2P10(J)) QIN(5,I)=(A*EN+B)*1.0D-18*AN2P10 GO TO 373 C SCALED X-SECTION ABOVE X2P10(N2P10) EV BY 1/E**3 372 QIN(5,I)=Y2P10(N2P10)*(X2P10(N2P10)/EN)**3*1.0D-18*AN2P10 373 IF(EN.LE.(2.0*EIN(5))) GO TO 374 PEQIN(5,I)=PEQEL(2,(I-IOFFN(5))) C 2P9 374 IF(EN.LE.EIN(6)) GO TO 899 IF(EN.GT.X2P9(N2P9)) GO TO 377 DO 375 J=2,N2P9 IF(EN.LE.X2P9(J)) GO TO 376 375 CONTINUE J=N2P9 376 A=(Y2P9(J)-Y2P9(J-1))/(X2P9(J)-X2P9(J-1)) B=(X2P9(J-1)*Y2P9(J)-X2P9(J)*Y2P9(J-1))/(X2P9(J-1)-X2P9(J)) QIN(6,I)=(A*EN+B)*1.0D-18*AN2P GO TO 378 C SCALED X-SECTION ABOVE X2P9(N2P9) EV BY 1/E**3 377 QIN(6,I)=Y2P9(N2P9)*(X2P9(N2P9)/EN)**3*1.0D-18*AN2P 378 IF(EN.LE.(2.0*EIN(6))) GO TO 379 PEQIN(6,I)=PEQEL(2,(I-IOFFN(6))) C 2P8 379 IF(EN.LE.EIN(7)) GO TO 899 IF(EN.GT.X2P8(N2P8)) GO TO 382 DO 380 J=2,N2P8 IF(EN.LE.X2P8(J)) GO TO 381 380 CONTINUE J=N2P8 381 A=(Y2P8(J)-Y2P8(J-1))/(X2P8(J)-X2P8(J-1)) B=(X2P8(J-1)*Y2P8(J)-X2P8(J)*Y2P8(J-1))/(X2P8(J-1)-X2P8(J)) QIN(7,I)=(A*EN+B)*1.0D-18*AN2P GO TO 383 C SCALED X-SECTION ABOVE X2P8(N2P8) EV BY 1/E 382 QIN(7,I)=Y2P8(N2P8)*(X2P8(N2P8)/EN)*1.0D-18*AN2P 383 IF(EN.LE.(2.0*EIN(7))) GO TO 384 PEQIN(7,I)=PEQEL(2,(I-IOFFN(7))) C 2P7 384 IF(EN.LE.EIN(8)) GO TO 899 IF(EN.GT.X2P7(N2P7)) GO TO 387 DO 385 J=2,N2P7 IF(EN.LE.X2P7(J)) GO TO 386 385 CONTINUE J=N2P7 386 A=(Y2P7(J)-Y2P7(J-1))/(X2P7(J)-X2P7(J-1)) B=(X2P7(J-1)*Y2P7(J)-X2P7(J)*Y2P7(J-1))/(X2P7(J-1)-X2P7(J)) QIN(8,I)=(A*EN+B)*1.0D-18*AN2P GO TO 388 C SCALED X-SECTION ABOVE X2P7(N2P7) EV BY 1/E**3 387 QIN(8,I)=Y2P7(N2P7)*(X2P7(N2P7)/EN)**3*1.0D-18*AN2P 388 IF(EN.LE.(2.0*EIN(8))) GO TO 389 PEQIN(8,I)=PEQEL(2,(I-IOFFN(8))) C 2P6 389 IF(EN.LE.EIN(9)) GO TO 899 IF(EN.GT.X2P6(N2P6)) GO TO 392 DO 390 J=2,N2P6 IF(EN.LE.X2P6(J)) GO TO 391 390 CONTINUE J=N2P6 391 A=(Y2P6(J)-Y2P6(J-1))/(X2P6(J)-X2P6(J-1)) B=(X2P6(J-1)*Y2P6(J)-X2P6(J)*Y2P6(J-1))/(X2P6(J-1)-X2P6(J)) QIN(9,I)=(A*EN+B)*1.0D-18*AN2P GO TO 393 C SCALED X-SECTION ABOVE X2P6(N2P6) EV BY 1/E 392 QIN(9,I)=Y2P6(N2P6)*(X2P6(N2P6)/EN)*1.0D-18*AN2P 393 IF(EN.LE.(2.0*EIN(9))) GO TO 394 PEQIN(9,I)=PEQEL(2,(I-IOFFN(9))) C 2P5 394 IF(EN.LE.EIN(10)) GO TO 899 IF(EN.GT.X2P5(N2P5)) GO TO 397 DO 395 J=2,N2P5 IF(EN.LE.X2P5(J)) GO TO 396 395 CONTINUE J=N2P5 396 A=(Y2P5(J)-Y2P5(J-1))/(X2P5(J)-X2P5(J-1)) B=(X2P5(J-1)*Y2P5(J)-X2P5(J)*Y2P5(J-1))/(X2P5(J-1)-X2P5(J)) QIN(10,I)=(A*EN+B)*1.0D-18*AN2P5 GO TO 398 C SCALED X-SECTION ABOVE X2P5(N2P5) EV BY 1/E 397 QIN(10,I)=Y2P5(N2P5)*(X2P5(N2P5)/EN)*1.0D-18*AN2P5 398 IF(EN.LE.(2.0*EIN(10))) GO TO 399 PEQIN(10,I)=PEQEL(2,(I-IOFFN(10))) C 3D6 399 IF(EN.LE.EIN(11)) GO TO 899 IF(EN.GT.X3D6(N3D6)) GO TO 402 DO 400 J=2,N3D6 IF(EN.LE.X3D6(J)) GO TO 401 400 CONTINUE J=N3D6 401 A=(Y3D6(J)-Y3D6(J-1))/(X3D6(J)-X3D6(J-1)) B=(X3D6(J-1)*Y3D6(J)-X3D6(J)*Y3D6(J-1))/(X3D6(J-1)-X3D6(J)) QIN(11,I)=(A*EN+B)*1.0D-18*AN3D GO TO 403 C SCALED X-SECTION ABOVE X3D6(N3D6) EV BY 1/E**3 402 QIN(11,I)=Y3D6(N3D6)*(X3D6(N3D6)/EN)**3*1.0D-18*AN3D 403 IF(EN.LE.(2.0*EIN(11))) GO TO 404 PEQIN(11,I)=PEQEL(2,(I-IOFFN(11))) C 3D5 404 IF(EN.LE.EIN(12)) GO TO 899 IF(EN.GT.X3D5(N3D5)) GO TO 407 DO 405 J=2,N3D5 IF(EN.LE.X3D5(J)) GO TO 406 405 CONTINUE J=N3D5 406 A=(Y3D5(J)-Y3D5(J-1))/(X3D5(J)-X3D5(J-1)) B=(X3D5(J-1)*Y3D5(J)-X3D5(J)*Y3D5(J-1))/(X3D5(J-1)-X3D5(J)) QIN(12,I)=(A*EN+B)*1.0D-18*AN3D GO TO 408 C USE BEF SCALING ABOVE X3D5(N3D5) EV F=0.0053 407 QIN(12,I)=0.0053/(EIN(12)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(12)))-BETA2)*BBCONST*EN/(EN+EIN(12)+E(3)) IF(QIN(12,I).LT.0.0) QIN(12,I)=0.0D0 408 IF(EN.LE.(2.0*EIN(12))) GO TO 409 PEQIN(12,I)=PEQEL(2,(I-IOFFN(12))) C 2P4 409 IF(EN.LE.EIN(13)) GO TO 899 IF(EN.GT.X2P4(N2P4)) GO TO 412 DO 410 J=2,N2P4 IF(EN.LE.X2P4(J)) GO TO 411 410 CONTINUE J=N2P4 411 A=(Y2P4(J)-Y2P4(J-1))/(X2P4(J)-X2P4(J-1)) B=(X2P4(J-1)*Y2P4(J)-X2P4(J)*Y2P4(J-1))/(X2P4(J-1)-X2P4(J)) QIN(13,I)=(A*EN+B)*1.0D-18*AN2P GO TO 413 C SCALED X-SECTION ABOVE X2P4(N2P4) EV BY 1/E**3 412 QIN(13,I)=Y2P4(N2P4)*(X2P4(N2P4)/EN)**3*1.0D-18*AN2P 413 IF(EN.LE.(2.0*EIN(13))) GO TO 414 PEQIN(13,I)=PEQEL(2,(I-IOFFN(13))) C 3D3 414 IF(EN.LE.EIN(14)) GO TO 899 IF(EN.GT.X3D3(N3D3)) GO TO 417 DO 415 J=2,N3D3 IF(EN.LE.X3D3(J)) GO TO 416 415 CONTINUE J=N3D3 416 A=(Y3D3(J)-Y3D3(J-1))/(X3D3(J)-X3D3(J-1)) B=(X3D3(J-1)*Y3D3(J)-X3D3(J)*Y3D3(J-1))/(X3D3(J-1)-X3D3(J)) QIN(14,I)=(A*EN+B)*1.0D-18*AN3D GO TO 418 C SCALED X-SECTION ABOVE X3D3(N3D3) EV BY 1/E**3 417 QIN(14,I)=Y3D3(N3D3)*(X3D3(N3D3)/EN)**3*1.0D-18*AN3D 418 IF(EN.LE.(2.0*EIN(14))) GO TO 419 PEQIN(14,I)=PEQEL(2,(I-IOFFN(14))) C 3D4P 419 IF(EN.LE.EIN(15)) GO TO 899 IF(EN.GT.X3D4P(N3D4P)) GO TO 422 DO 420 J=2,N3D4P IF(EN.LE.X3D4P(J)) GO TO 421 420 CONTINUE J=N3D4P 421 A=(Y3D4P(J)-Y3D4P(J-1))/(X3D4P(J)-X3D4P(J-1)) B=(X3D4P(J-1)*Y3D4P(J)-X3D4P(J)*Y3D4P(J-1))/(X3D4P(J-1)-X3D4P(J)) QIN(15,I)=(A*EN+B)*1.0D-18*AN3D GO TO 423 C SCALED X-SECTION ABOVE X3D4P(N3D4P) EV BY 1/E**3 422 QIN(15,I)=Y3D4P(N3D4P)*(X3D4P(N3D4P)/EN)**3*1.0D-18*AN3D 423 IF(EN.LE.(2.0*EIN(15))) GO TO 424 PEQIN(15,I)=PEQEL(2,(I-IOFFN(15))) C 2P3 424 IF(EN.LE.EIN(16)) GO TO 899 IF(EN.GT.X2P3(N2P3)) GO TO 427 DO 425 J=2,N2P3 IF(EN.LE.X2P3(J)) GO TO 426 425 CONTINUE J=N2P3 426 A=(Y2P3(J)-Y2P3(J-1))/(X2P3(J)-X2P3(J-1)) B=(X2P3(J-1)*Y2P3(J)-X2P3(J)*Y2P3(J-1))/(X2P3(J-1)-X2P3(J)) QIN(16,I)=(A*EN+B)*1.0D-18*AN2P GO TO 428 C SCALED X-SECTION ABOVE X2P3(N2P3) EV BY 1/E**3 427 QIN(16,I)=Y2P3(N2P3)*(X2P3(N2P3)/EN)**3*1.0D-18*AN2P 428 IF(EN.LE.(2.0*EIN(16))) GO TO 429 PEQIN(16,I)=PEQEL(2,(I-IOFFN(16))) C 2P2 429 IF(EN.LE.EIN(17)) GO TO 899 IF(EN.GT.X2P2(N2P2)) GO TO 432 DO 430 J=2,N2P2 IF(EN.LE.X2P2(J)) GO TO 431 430 CONTINUE J=N2P2 431 A=(Y2P2(J)-Y2P2(J-1))/(X2P2(J)-X2P2(J-1)) B=(X2P2(J-1)*Y2P2(J)-X2P2(J)*Y2P2(J-1))/(X2P2(J-1)-X2P2(J)) QIN(17,I)=(A*EN+B)*1.0D-18*AN2P GO TO 433 C SCALED X-SECTION ABOVE X2P2(N2P2) EV BY 1/E 432 QIN(17,I)=Y2P2(N2P2)*(X2P2(N2P2)/EN)*1.0D-18*AN2P 433 IF(EN.LE.(2.0*EIN(17))) GO TO 434 PEQIN(17,I)=PEQEL(2,(I-IOFFN(17))) C 3D4 434 IF(EN.LE.EIN(18)) GO TO 899 IF(EN.GT.X3D4(N3D4)) GO TO 437 DO 435 J=2,N3D4 IF(EN.LE.X3D4(J)) GO TO 436 435 CONTINUE J=N3D4 436 A=(Y3D4(J)-Y3D4(J-1))/(X3D4(J)-X3D4(J-1)) B=(X3D4(J-1)*Y3D4(J)-X3D4(J)*Y3D4(J-1))/(X3D4(J-1)-X3D4(J)) QIN(18,I)=(A*EN+B)*1.0D-18*AN3D GO TO 438 C SCALED X-SECTION ABOVE X3D4(N3D4) EV BY 1/E 437 QIN(18,I)=Y3D4(N3D4)*(X3D4(N3D4)/EN)*1.0D-18*AN3D 438 IF(EN.LE.(2.0*EIN(18))) GO TO 439 PEQIN(18,I)=PEQEL(2,(I-IOFFN(18))) C 2P1 439 IF(EN.LE.EIN(19)) GO TO 899 IF(EN.GT.X2P1(N2P1)) GO TO 442 DO 440 J=2,N2P1 IF(EN.LE.X2P1(J)) GO TO 441 440 CONTINUE J=N2P1 441 A=(Y2P1(J)-Y2P1(J-1))/(X2P1(J)-X2P1(J-1)) B=(X2P1(J-1)*Y2P1(J)-X2P1(J)*Y2P1(J-1))/(X2P1(J-1)-X2P1(J)) QIN(19,I)=(A*EN+B)*1.0D-18*AN2P1 GO TO 443 C SCALED X-SECTION ABOVE X2P1(N2P1) EV BY 1/E 442 QIN(19,I)=Y2P1(N2P1)*(X2P1(N2P1)/EN)*1.0D-18*AN2P1 443 IF(EN.LE.(2.0*EIN(19))) GO TO 444 PEQIN(19,I)=PEQEL(2,(I-IOFFN(19))) C 3D1PP 444 IF(EN.LE.EIN(20)) GO TO 899 IF(EN.GT.X3D1PP(N3D1PP)) GO TO 447 DO 445 J=2,N3D1PP IF(EN.LE.X3D1PP(J)) GO TO 446 445 CONTINUE J=N3D1PP 446 A=(Y3D1PP(J)-Y3D1PP(J-1))/(X3D1PP(J)-X3D1PP(J-1)) B=(X3D1PP(J-1)*Y3D1PP(J)-X3D1PP(J)*Y3D1PP(J-1))/(X3D1PP(J-1)- /X3D1PP(J)) QIN(20,I)=(A*EN+B)*1.0D-18*AN3D GO TO 448 C SCALED X-SECTION ABOVE X3D1PP(N3D1PP) EV BY 1/E**3 447 QIN(20,I)=Y3D1PP(N3D1PP)*(X3D1PP(N3D1PP)/EN)**3*1.0D-18*AN3D 448 IF(EN.LE.(2.0*EIN(20))) GO TO 449 PEQIN(20,I)=PEQEL(2,(I-IOFFN(20))) C 3D1P 449 IF(EN.LE.EIN(21)) GO TO 899 IF(EN.GT.X3D1P(N3D1P)) GO TO 452 DO 450 J=2,N3D1P IF(EN.LE.X3D1P(J)) GO TO 451 450 CONTINUE J=N3D1P 451 A=(Y3D1P(J)-Y3D1P(J-1))/(X3D1P(J)-X3D1P(J-1)) B=(X3D1P(J-1)*Y3D1P(J)-X3D1P(J)*Y3D1P(J-1))/(X3D1P(J-1)-X3D1P(J)) QIN(21,I)=(A*EN+B)*1.0D-18*AN3D GO TO 453 C SCALED X-SECTION ABOVE X3D1P(N3D1P) EV BY 1/E 452 QIN(21,I)=Y3D1P(N3D1P)*(X3D1P(N3D1P)/EN)*1.0D-18*AN3D 453 IF(EN.LE.(2.0*EIN(21))) GO TO 454 PEQIN(21,I)=PEQEL(2,(I-IOFFN(21))) C 2S5 454 IF(EN.LE.EIN(22)) GO TO 899 IF(EN.GT.X2S5(N2S5)) GO TO 457 DO 455 J=2,N2S5 IF(EN.LE.X2S5(J)) GO TO 456 455 CONTINUE J=N2S5 456 A=(Y2S5(J)-Y2S5(J-1))/(X2S5(J)-X2S5(J-1)) B=(X2S5(J-1)*Y2S5(J)-X2S5(J)*Y2S5(J-1))/(X2S5(J-1)-X2S5(J)) QIN(22,I)=(A*EN+B)*1.0D-18*AN1S GO TO 458 C SCALED X-SECTION ABOVE X2S5(N2S5) EV BY 1/E**3 457 QIN(22,I)=Y2S5(N2S5)*(X2S5(N2S5)/EN)**3*1.0D-18*AN1S 458 IF(EN.LE.(2.0*EIN(22))) GO TO 459 PEQIN(22,I)=PEQEL(2,(I-IOFFN(22))) C 3D2 BEF SCALED F=0.082 459 IF(EN.LE.EIN(23)) GO TO 899 QIN(23,I)=0.082/(EIN(23)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(23)))-BETA2)*BBCONST*EN/(EN+EIN(23)+E(3)) IF(QIN(23,I).LT.0.0) QIN(23,I)=0.0D0 IF(EN.LE.(2.0*EIN(23))) GO TO 460 PEQIN(23,I)=PEQEL(2,(I-IOFFN(23))) C 2S4 BEF SCALED F=0.154 460 IF(EN.LE.EIN(24)) GO TO 899 QIN(24,I)=0.154/(EIN(24)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(24)))-BETA2)*BBCONST*EN/(EN+EIN(24)+E(3)) IF(QIN(24,I).LT.0.0) QIN(24,I)=0.0 IF(EN.LE.(2.0*EIN(24))) GO TO 461 PEQIN(24,I)=PEQEL(2,(I-IOFFN(24))) C 3P10 461 IF(EN.LE.EIN(25)) GO TO 899 IF(EN.GT.X3P10(N3P10)) GO TO 464 DO 462 J=2,N3P10 IF(EN.LE.X3P10(J)) GO TO 463 462 CONTINUE J=N3P10 463 A=(Y3P10(J)-Y3P10(J-1))/(X3P10(J)-X3P10(J-1)) B=(X3P10(J-1)*Y3P10(J)-X3P10(J)*Y3P10(J-1))/(X3P10(J-1)-X3P10(J)) QIN(25,I)=(A*EN+B)*1.0D-18*AN3P GO TO 465 C SCALED X-SECTION ABOVE X3P10(N3P10) EV BY 1/E**3 464 QIN(25,I)=Y3P10(N3P10)*(X3P10(N3P10)/EN)**3*1.0D-18*AN3P 465 IF(EN.LE.(2.0*EIN(25))) GO TO 466 PEQIN(25,I)=PEQEL(2,(I-IOFFN(25))) C 3P9 466 IF(EN.LE.EIN(26)) GO TO 899 IF(EN.GT.X3P9(N3P9)) GO TO 469 DO 467 J=2,N3P9 IF(EN.LE.X3P9(J)) GO TO 468 467 CONTINUE J=N3P9 468 A=(Y3P9(J)-Y3P9(J-1))/(X3P9(J)-X3P9(J-1)) B=(X3P9(J-1)*Y3P9(J)-X3P9(J)*Y3P9(J-1))/(X3P9(J-1)-X3P9(J)) QIN(26,I)=(A*EN+B)*1.0D-18*AN3P GO TO 470 C SCALED X-SECTION ABOVE X3P9(N3P9) EV BY 1/E**3 469 QIN(26,I)=Y3P9(N3P9)*(X3P9(N3P9)/EN)**3*1.0D-18*AN3P 470 IF(EN.LE.(2.0*EIN(26))) GO TO 471 PEQIN(26,I)=PEQEL(2,(I-IOFFN(26))) C 3P8 471 IF(EN.LE.EIN(27)) GO TO 899 IF(EN.GT.X3P8(N3P8)) GO TO 474 DO 472 J=2,N3P8 IF(EN.LE.X3P8(J)) GO TO 473 472 CONTINUE J=N3P8 473 A=(Y3P8(J)-Y3P8(J-1))/(X3P8(J)-X3P8(J-1)) B=(X3P8(J-1)*Y3P8(J)-X3P8(J)*Y3P8(J-1))/(X3P8(J-1)-X3P8(J)) QIN(27,I)=(A*EN+B)*1.0D-18*AN3P GO TO 475 C SCALED X-SECTION ABOVE X3P8(N3P8) EV BY 1/E 474 QIN(27,I)=Y3P8(N3P8)*(X3P8(N3P8)/EN)*1.0D-18*AN3P 475 IF(EN.LE.(2.0*EIN(27))) GO TO 476 PEQIN(27,I)=PEQEL(2,(I-IOFFN(27))) C 3S1PP 476 IF(EN.LE.EIN(28)) GO TO 899 IF(EN.GT.X3S1PP(N3S1PP)) GO TO 479 DO 477 J=2,N3S1PP IF(EN.LE.X3S1PP(J)) GO TO 478 477 CONTINUE J=N3S1PP 478 A=(Y3S1PP(J)-Y3S1PP(J-1))/(X3S1PP(J)-X3S1PP(J-1)) B=(X3S1PP(J-1)*Y3S1PP(J)-X3S1PP(J)*Y3S1PP(J-1))/(X3S1PP(J-1)- /X3S1PP(J)) QIN(28,I)=(A*EN+B)*1.0D-18*AN3D GO TO 480 C SCALED X-SECTION ABOVE X3S1PP(N3S1PP) EV BY 1/E**3 479 QIN(28,I)=Y3S1PP(N3S1PP)*(X3S1PP(N3S1PP)/EN)**3*1.0D-18*AN3D 480 IF(EN.LE.(2.0*EIN(28))) GO TO 481 PEQIN(28,I)=PEQEL(2,(I-IOFFN(28))) C 3P7 481 IF(EN.LE.EIN(29)) GO TO 899 IF(EN.GT.X3P7(N3P7)) GO TO 484 DO 482 J=2,N3P7 IF(EN.LE.X3P7(J)) GO TO 483 482 CONTINUE J=N3P7 483 A=(Y3P7(J)-Y3P7(J-1))/(X3P7(J)-X3P7(J-1)) B=(X3P7(J-1)*Y3P7(J)-X3P7(J)*Y3P7(J-1))/(X3P7(J-1)-X3P7(J)) QIN(29,I)=(A*EN+B)*1.0D-18*AN3P GO TO 485 C SCALED X-SECTION ABOVE X3P7(N3P7) EV BY 1/E**3 484 QIN(29,I)=Y3P7(N3P7)*(X3P7(N3P7)/EN)**3*1.0D-18*AN3P 485 IF(EN.LE.(2.0*EIN(29))) GO TO 486 PEQIN(29,I)=PEQEL(2,(I-IOFFN(29))) C 3P6 486 IF(EN.LE.EIN(30)) GO TO 899 IF(EN.GT.X3P6(N3P6)) GO TO 489 DO 487 J=2,N3P6 IF(EN.LE.X3P6(J)) GO TO 488 487 CONTINUE J=N3P6 488 A=(Y3P6(J)-Y3P6(J-1))/(X3P6(J)-X3P6(J-1)) B=(X3P6(J-1)*Y3P6(J)-X3P6(J)*Y3P6(J-1))/(X3P6(J-1)-X3P6(J)) QIN(30,I)=(A*EN+B)*1.0D-18*AN3P GO TO 490 C SCALED X-SECTION ABOVE X3P6(N3P6) EV BY 1/E 489 QIN(30,I)=Y3P6(N3P6)*(X3P6(N3P6)/EN)*1.0D-18*AN3P 490 IF(EN.LE.(2.0*EIN(30))) GO TO 491 PEQIN(30,I)=PEQEL(2,(I-IOFFN(30))) C 3S1PPPP 491 IF(EN.LE.EIN(31)) GO TO 899 IF(EN.GT.X3S1PPPP(N3S1PPPP)) GO TO 494 DO 492 J=2,N3S1PPPP IF(EN.LE.X3S1PPPP(J)) GO TO 493 492 CONTINUE J=N3S1PPPP 493 A=(Y3S1PPPP(J)-Y3S1PPPP(J-1))/(X3S1PPPP(J)-X3S1PPPP(J-1)) B=(X3S1PPPP(J-1)*Y3S1PPPP(J)-X3S1PPPP(J)*Y3S1PPPP(J-1))/ /(X3S1PPPP(J-1)-X3S1PPPP(J)) QIN(31,I)=(A*EN+B)*1.0D-18*AN3D GO TO 495 C SCALED X-SECTION ABOVE X3S1PPPP(N3S1PPPP) EV BY 1/E**3 494 QIN(31,I)=Y3S1PPPP(N3S1PPPP)*(X3S1PPPP(N3S1PPPP)/EN)**3*1.0D-18* /AN3D 495 IF(EN.LE.(2.0*EIN(31))) GO TO 496 PEQIN(31,I)=PEQEL(2,(I-IOFFN(31))) C 3S1PPP 496 IF(EN.LE.EIN(32)) GO TO 899 IF(EN.GT.X3S1PPP(N3S1PPP)) GO TO 499 DO 497 J=2,N3S1PPP IF(EN.LE.X3S1PPP(J)) GO TO 498 497 CONTINUE J=N3S1PPP 498 A=(Y3S1PPP(J)-Y3S1PPP(J-1))/(X3S1PPP(J)-X3S1PPP(J-1)) B=(X3S1PPP(J-1)*Y3S1PPP(J)-X3S1PPP(J)*Y3S1PPP(J-1))/ /(X3S1PPP(J-1)-X3S1PPP(J)) QIN(32,I)=(A*EN+B)*1.0D-18*AN3D GO TO 500 C SCALED X-SECTION ABOVE X3S1PPP(N3S1PPP) EV BY 1/E 499 QIN(32,I)=Y3S1PPP(N3S1PPP)*(X3S1PPP(N3S1PPP)/EN)*1.0D-18*AN3D 500 IF(EN.LE.(2.0*EIN(32))) GO TO 501 PEQIN(32,I)=PEQEL(2,(I-IOFFN(32))) C 3P5 501 IF(EN.LE.EIN(33)) GO TO 899 IF(EN.GT.X3P5(N3P5)) GO TO 504 DO 502 J=2,N3P5 IF(EN.LE.X3P5(J)) GO TO 503 502 CONTINUE J=N3P5 503 A=(Y3P5(J)-Y3P5(J-1))/(X3P5(J)-X3P5(J-1)) B=(X3P5(J-1)*Y3P5(J)-X3P5(J)*Y3P5(J-1))/(X3P5(J-1)-X3P5(J)) QIN(33,I)=(A*EN+B)*1.0D-18*AN3P5 GO TO 505 C SCALED X-SECTION ABOVE X3P5(N3P5) EV BY 1/E 504 QIN(33,I)=Y3P5(N3P5)*(X3P5(N3P5)/EN)*1.0D-18*AN3P5 505 IF(EN.LE.(2.0*EIN(33))) GO TO 506 PEQIN(33,I)=PEQEL(2,(I-IOFFN(33))) C 4D5 BEF SCALED F=0.0140 506 IF(EN.LE.EIN(34)) GO TO 899 QIN(34,I)=0.014/(EIN(34)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(34)))-BETA2)*BBCONST*EN/(EN+EIN(34)+E(3)) IF(QIN(34,I).LT.0.0) QIN(34,I)=0.0D0 IF(EN.LE.(2.0*EIN(34))) GO TO 507 PEQIN(34,I)=PEQEL(2,(I-IOFFN(34))) C 4D6 507 IF(EN.LE.EIN(35)) GO TO 899 IF(EN.GT.X4D6(N4D6)) GO TO 510 DO 508 J=2,N4D6 IF(EN.LE.X4D6(J)) GO TO 509 508 CONTINUE J=N4D6 509 A=(Y4D6(J)-Y4D6(J-1))/(X4D6(J)-X4D6(J-1)) B=(X4D6(J-1)*Y4D6(J)-X4D6(J)*Y4D6(J-1))/(X4D6(J-1)-X4D6(J)) QIN(35,I)=(A*EN+B)*1.0D-18*AN4D GO TO 511 C SCALED X-SECTION ABOVE X4D6(N4D6) EV BY 1/E**3 510 QIN(35,I)=Y4D6(N4D6)*(X4D6(N4D6)/EN)**3*1.0D-18*AN4D 511 IF(EN.LE.(2.0*EIN(35))) GO TO 512 PEQIN(35,I)=PEQEL(2,(I-IOFFN(35))) C 4D4P 512 IF(EN.LE.EIN(36)) GO TO 899 IF(EN.GT.X4D4P(N4D4P)) GO TO 515 DO 513 J=2,N4D4P IF(EN.LE.X4D4P(J)) GO TO 514 513 CONTINUE J=N4D4P 514 A=(Y4D4P(J)-Y4D4P(J-1))/(X4D4P(J)-X4D4P(J-1)) B=(X4D4P(J-1)*Y4D4P(J)-X4D4P(J)*Y4D4P(J-1))/(X4D4P(J-1)-X4D4P(J)) QIN(36,I)=(A*EN+B)*1.0D-18*AN4D GO TO 516 C SCALED X-SECTION ABOVE X4D4P(N4D4P) EV BY 1/E**3 515 QIN(36,I)=Y4D4P(N4D4P)*(X4D4P(N4D4P)/EN)**3*1.0D-18*AN4D 516 IF(EN.LE.(2.0*EIN(36))) GO TO 517 PEQIN(36,I)=PEQEL(2,(I-IOFFN(36))) C 3S1P BEF SCALED F=0.0435 517 IF(EN.LE.EIN(37)) GO TO 899 QIN(37,I)=0.0435/(EIN(37)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(37)))-BETA2)*BBCONST*EN/(EN+EIN(37)+E(3)) IF(QIN(37,I).LT.0.0) QIN(37,I)=0.0D0 IF(EN.LE.(2.0*EIN(37))) GO TO 518 PEQIN(37,I)=PEQEL(2,(I-IOFFN(37))) C 4D4 518 IF(EN.LE.EIN(38)) GO TO 899 IF(EN.GT.X4D4(N4D4)) GO TO 521 DO 519 J=2,N4D4 IF(EN.LE.X4D4(J)) GO TO 520 519 CONTINUE J=N4D4 520 A=(Y4D4(J)-Y4D4(J-1))/(X4D4(J)-X4D4(J-1)) B=(X4D4(J-1)*Y4D4(J)-X4D4(J)*Y4D4(J-1))/(X4D4(J-1)-X4D4(J)) QIN(38,I)=(A*EN+B)*1.0D-18*AN4D GO TO 522 C SCALED X-SECTION ABOVE X4D4(N4D4) EV BY 1/E 521 QIN(38,I)=Y4D4(N4D4)*(X4D4(N4D4)/EN)*1.0D-18*AN4D 522 IF(EN.LE.(2.0*EIN(38))) GO TO 523 PEQIN(38,I)=PEQEL(2,(I-IOFFN(38))) C 4D3 523 IF(EN.LE.EIN(39)) GO TO 899 IF(EN.GT.X4D3(N4D3)) GO TO 526 DO 524 J=2,N4D3 IF(EN.LE.X4D3(J)) GO TO 525 524 CONTINUE J=N4D3 525 A=(Y4D3(J)-Y4D3(J-1))/(X4D3(J)-X4D3(J-1)) B=(X4D3(J-1)*Y4D3(J)-X4D3(J)*Y4D3(J-1))/(X4D3(J-1)-X4D3(J)) QIN(39,I)=(A*EN+B)*1.0D-18*AN4D GO TO 527 C SCALED X-SECTION ABOVE X4D3(N4D3) EV BY 1/E**3 526 QIN(39,I)=Y4D3(N4D3)*(X4D3(N4D3)/EN)**3*1.0D-18*AN4D 527 IF(EN.LE.(2.0*EIN(39))) GO TO 528 PEQIN(39,I)=PEQEL(2,(I-IOFFN(39))) C 2S3 528 IF(EN.LE.EIN(40)) GO TO 899 IF(EN.GT.X2S3(N2S3)) GO TO 531 DO 529 J=2,N2S3 IF(EN.LE.X2S3(J)) GO TO 530 529 CONTINUE J=N2S3 530 A=(Y2S3(J)-Y2S3(J-1))/(X2S3(J)-X2S3(J-1)) B=(X2S3(J-1)*Y2S3(J)-X2S3(J)*Y2S3(J-1))/(X2S3(J-1)-X2S3(J)) QIN(40,I)=(A*EN+B)*1.0D-18*AN1S GO TO 532 C SCALED X-SECTION ABOVE X2S3(N2S3) EV BY 1/E**3 531 QIN(40,I)=Y2S3(N2S3)*(X2S3(N2S3)/EN)**3*1.0D-18*AN1S 532 IF(EN.LE.(2.0*EIN(40))) GO TO 533 PEQIN(40,I)=PEQEL(2,(I-IOFFN(40))) C 2S2 BEF SCALED F=0.0105 533 IF(EN.LE.EIN(41)) GO TO 899 QIN(41,I)=0.0105/(EIN(41)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(41)))-BETA2)*BBCONST*EN/(EN+EIN(41)+E(3)) IF(QIN(41,I).LT.0.0) QIN(41,I)=0.0D0 IF(EN.LE.(2.0*EIN(41))) GO TO 534 PEQIN(41,I)=PEQEL(2,(I-IOFFN(41))) C 4D1PP 534 IF(EN.LE.EIN(42)) GO TO 899 IF(EN.GT.X4D1PP(N4D1PP)) GO TO 537 DO 535 J=2,N4D1PP IF(EN.LE.X4D1PP(J)) GO TO 536 535 CONTINUE J=N4D1PP 536 A=(Y4D1PP(J)-Y4D1PP(J-1))/(X4D1PP(J)-X4D1PP(J-1)) B=(X4D1PP(J-1)*Y4D1PP(J)-X4D1PP(J)*Y4D1PP(J-1))/ /(X4D1PP(J-1)-X4D1PP(J)) QIN(42,I)=(A*EN+B)*1.0D-18*AN4D GO TO 538 C SCALED X-SECTION ABOVE X4D1PP(N4D1PP) EV BY 1/E**3 537 QIN(42,I)=Y4D1PP(N4D1PP)*(X4D1PP(N4D1PP)/EN)**3*1.0D-18*AN4D 538 IF(EN.LE.(2.0*EIN(42))) GO TO 539 PEQIN(42,I)=PEQEL(2,(I-IOFFN(42))) C 4D1P 539 IF(EN.LE.EIN(43)) GO TO 899 IF(EN.GT.X4D1P(N4D1P)) GO TO 542 DO 540 J=2,N4D1P IF(EN.LE.X4D1P(J)) GO TO 541 540 CONTINUE J=N4D1P 541 A=(Y4D1P(J)-Y4D1P(J-1))/(X4D1P(J)-X4D1P(J-1)) B=(X4D1P(J-1)*Y4D1P(J)-X4D1P(J)*Y4D1P(J-1))/(X4D1P(J-1)-X4D1P(J)) QIN(43,I)=(A*EN+B)*1.0D-18*AN4D GO TO 543 C SCALED X-SECTION ABOVE X4D1P(N4D1P) EV BY 1/E**3 542 QIN(43,I)=Y4D1P(N4D1P)*(X4D1P(N4D1P)/EN)**3*1.0D-18*AN4D 543 IF(EN.LE.(2.0*EIN(43))) GO TO 544 PEQIN(43,I)=PEQEL(2,(I-IOFFN(43))) C 3S5 544 IF(EN.LE.EIN(44)) GO TO 899 IF(EN.GT.X3S5(N3S5)) GO TO 547 DO 545 J=2,N3S5 IF(EN.LE.X3S5(J)) GO TO 546 545 CONTINUE J=N3S5 546 A=(Y3S5(J)-Y3S5(J-1))/(X3S5(J)-X3S5(J-1)) B=(X3S5(J-1)*Y3S5(J)-X3S5(J)*Y3S5(J-1))/(X3S5(J-1)-X3S5(J)) QIN(44,I)=(A*EN+B)*1.0D-18*AN1S GO TO 548 C SCALED X-SECTION ABOVE X3S5(N3S5) EV BY 1/E**3 547 QIN(44,I)=Y3S5(N3S5)*(X3S5(N3S5)/EN)**3*1.0D-18*AN1S 548 IF(EN.LE.(2.0*EIN(44))) GO TO 549 PEQIN(44,I)=PEQEL(2,(I-IOFFN(44))) C 4D2 BEF SCALED F=0.0970 549 IF(EN.LE.EIN(45)) GO TO 899 QIN(45,I)=0.0970/(EIN(45)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(45)))-BETA2)*BBCONST*EN/(EN+EIN(45)+E(3)) IF(QIN(45,I).LT.0.0) QIN(45,I)=0.0D0 IF(EN.LE.(2.0*EIN(45))) GO TO 550 PEQIN(45,I)=PEQEL(2,(I-IOFFN(45))) C 3S4 BEF SCALED F=0.0808 550 IF(EN.LE.EIN(46)) GO TO 899 QIN(46,I)=0.0808/(EIN(46)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(46)))-BETA2)*BBCONST*EN/(EN+EIN(46)+E(3)) IF(QIN(46,I).LT.0.0) QIN(46,I)=0.0D0 IF(EN.LE.(2.0*EIN(46))) GO TO 551 PEQIN(46,I)=PEQEL(2,(I-IOFFN(46))) C 4FS 551 IF(EN.LE.EIN(47)) GO TO 899 IF(EN.GT.X4FS(N4FS)) GO TO 554 DO 552 J=2,N4FS IF(EN.LE.X4FS(J)) GO TO 553 552 CONTINUE J=N4FS 553 A=(Y4FS(J)-Y4FS(J-1))/(X4FS(J)-X4FS(J-1)) B=(X4FS(J-1)*Y4FS(J)-X4FS(J)*Y4FS(J-1))/(X4FS(J-1)-X4FS(J)) QIN(47,I)=(A*EN+B)*1.0D-18*AN4D GO TO 555 C SCALED X-SECTION ABOVE X4FS(N4FS) EV BY 1/E 554 QIN(47,I)=Y4FS(N4FS)*(X4FS(N4FS)/EN)*1.0D-18*AN4D 555 IF(EN.LE.(2.0*EIN(47))) GO TO 556 PEQIN(47,I)=PEQEL(2,(I-IOFFN(47))) C 5D5 BEF SCALED F=0.0015 556 IF(EN.LE.EIN(48)) GO TO 899 QIN(48,I)=0.0015/(EIN(48)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(48)))-BETA2)*BBCONST*EN/(EN+EIN(48)+E(3)) IF(QIN(48,I).LT.0.0) QIN(48,I)=0.0D0 IF(EN.LE.(2.0*EIN(48))) GO TO 557 PEQIN(48,I)=PEQEL(2,(I-IOFFN(48))) C 5D2 BEF SCALED F=0.0439 557 IF(EN.LE.EIN(49)) GO TO 899 QIN(49,I)=0.0439/(EIN(49)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(49)))-BETA2)*BBCONST*EN/(EN+EIN(49)+E(3)) IF(QIN(49,I).LT.0.0) QIN(49,I)=0.0D0 IF(EN.LE.(2.0*EIN(49))) GO TO 558 PEQIN(49,I)=PEQEL(2,(I-IOFFN(49))) C 4S4 BEF SCALED F=0.0203 558 IF(EN.LE.EIN(50)) GO TO 899 QIN(50,I)=0.0203/(EIN(50)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(50)))-BETA2)*BBCONST*EN/(EN+EIN(50)+E(3)) IF(QIN(50,I).LT.0.0) QIN(50,I)=0.0D0 IF(EN.LE.(2.0*EIN(50))) GO TO 559 PEQIN(50,I)=PEQEL(2,(I-IOFFN(50))) C SUM OF HIGHER DIPOLE STATES BEF SCALED F=0.1680 559 IF(EN.LE.EIN(51)) GO TO 899 QIN(51,I)=0.1680/(EIN(51)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(51)))-BETA2)*BBCONST*EN/(EN+EIN(51)+E(3)) IF(QIN(51,I).LT.0.0) QIN(51,I)=0.0D0 IF(EN.LE.(2.0*EIN(51))) GO TO 899 PEQIN(51,I)=PEQEL(2,(I-IOFFN(51))) 899 CONTINUE Q1SUM=QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) Q2SUM=QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I) Q3SUM=0.0 Q4SUM=0.0 DO 700 JK=11,24 700 Q3SUM=Q3SUM+QIN(JK,I) DO 701 JK=25,51 701 Q4SUM=Q4SUM+QIN(JK,I) QINEL=Q1SUM+Q2SUM+Q3SUM+Q4SUM Q(1,I)=QELA+QINEL+Q(5,I) C WRITE(6,8976) EN,Q1SUM,Q2SUM,Q3SUM,Q4SUM,QINEL C8976 FORMAT(' EN=',F9.1,' Q1=',D12.3,' Q2=',D12.3,' Q3=',D12.3,' Q4=', C /D12.3,' QSUM=',D12.3) 900 CONTINUE C SAVE COMPUTE TIME DO 910 K=1,NIN IF(EFINAL.LE.EIN(K)) THEN NIN=K-1 GO TO 911 ENDIF 910 CONTINUE 911 CONTINUE RETURN END SUBROUTINE GAS7(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(139),YMOM(139),XEL(131),YEL(131),XEPS(139),YEPS(139) DIMENSION XION(76),YION(76),YINC(76) DIMENSION X1S5(79),Y1S5(79),YP1S5(79),X1S4(38),Y1S4(38),YP1S4(38), /X1S3(57),Y1S3(57),YP1S3(57),X1S2(20),Y1S2(20),YP1S2(20), /X2P10(37),Y2P10(37),YP2P10(37),X2P9(38),Y2P9(38),YP2P9(38), /X2P8(33),Y2P8(33),YP2P8(33),X2P7(34),Y2P7(34),YP2P7(34), /X2P6(38),Y2P6(38),YP2P6(38),X3D6(40),Y3D6(40),YP3D6(40), /X2P5(30),Y2P5(30),YP2P5(30),X3D4P(40),Y3D4P(40),YP3D4P(40), /X3D3(40),Y3D3(40),YP3D3(40),X3D4(36),Y3D4(36),YP3D4(36), /X3D1PP(34),Y3D1PP(34),YP3D1PP(34),X3D1P(33),Y3D1P(33),YP3D1P(33), /X2S5(27),Y2S5(27),YP2S5(27),X3P105(33),Y3P105(33),YP3P105(33), /X2P4(23),Y2P4(23),YP2P4(23),X4DSUM(25),Y4DSUM(25),YP4DSUM(25), /X2P3(23),Y2P3(23),YP2P3(23),X2P2(23),Y2P2(23),YP2P2(23), /X2P1(24),Y2P1(24),YP2P1(24), /IOFFN(50) 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.,1.0D4,1.5D4,2.0D4,3.0D4,4.0D4,5.0D4,6.0D4, /8.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5,2.5D5,3.0D5,3.5D5,4.0D5, /4.5D5,5.0D5,6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.5D6,2.0D6/ DATA YMOM/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.8, /23.5,19.8,15.0,10.9,8.40,7.25,5.65,5.00,4.50,3.10, /2.42,2.17,2.00,1.89,1.80,1.73,1.65,1.50,1.39,1.26, /1.09,0.94,0.84,0.75,0.68,0.56,0.38,0.26,.155,.105, /.076,.059,.038,.027,.0148,.0094,.0050,.0031,.0022,.00163, /.001024,.000714,.000498,.000372,.000291,.000236,.000166,.000125, /.000099,.0000808,.0000676,.0000577,.0000438,.0000348,.0000285, /.0000239,.0000204,.0000108,.00000691/ 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.,1.0D4,1.5D4,2.0D4,3.0D4,4.0D4, /5.0D4,6.0D4,8.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5,2.5D5,3.0D5, /3.5D5,4.0D5,4.5D5,5.0D5,6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.5D6, /2.0D6/ 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,41.0,40.0,37.4,34.2,32.4,30.8,21.9,14.1, /8.58,6.78,5.97,5.49,5.29,5.21,5.10,4.66,4.58,4.67, /4.53,4.35,4.12,3.77,3.58,3.30,3.12,2.80,2.36,2.07, /1.72,1.52,1.34,1.13,.937,.817,.632,.523,.397,.326, /.279,.246,.203,.175,.152,.136,.124,.116,.103,.0946, /.0886,.0841,.0807,.0779,.0739,.0711,.0690,.0674,.0662,.0627, /.0612/ C ELASTIC ANGULAR DISTRIBUTION ( EPSILON) DATA XEPS/0.00,.001,.005,.007,.010,.015,.020,.025,.030,.040, /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.71,0.72,0.73,0.75,0.77,0.80,0.83,0.85,0.87, /0.90,1.00,1.10,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.,15000.,2.0D4,3.0D4,4.0D4,5.0D4,6.0D4, /8.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5,2.5D5,3.0D5,3.5D5,4.0D5, /4.5D5,5.0D5,6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.5D6,2.0D6/ DATA YEPS/.0,.0256,.0594,.0675,.0827,.1028,.1224,.1394,.155,.1852, /.2149,.2402,.2667,.2931,.3435,.3883,.4349,.4985,.5627,.6541, /.6823,.7316,.7579,.7956,.8197,.8410,.8674,.8859,.9019,.9178, /.9286,.9341,.9385,.9425,.9456,.9485,.9508,.9524,.9533,.9536, /.9533,.9520,.9507,.9477,.9440,.9386,.9322,.9249,.9155,.9063, /.8944,.8817,.8679,.8529,.8198,.7905,.7415,.7056,.6817,.6412, /.5753,.4668,.3741,.2896,.2352,.1953,.1692,.1283,.1485,.2062, /.2301,.1418,.2353,.2136,.2456,.2925,.3305,.3539,.3762,.4781, /.5912,.6783,.7707,.8403,.8835,.8989,.8844,.8113,.6465,.7171, /.7668,.7760,.7913,.8044,.8127,.7972,.8066,.8383,.8494,.8621, /.8799,.8902,.8997,.9044,.9101,.9208,.9421,.9592,.9741,.9818, /.9860,.9874,.9909,.9930,.9954,.99669,.99785,.99846,.99877,.99900, /.99927,.99943,.999558,.999641,.999696,.999744,.999804,.999844, /.999871,.999891,.999907,.999918,.999936,.999949,.999957,.999964, /.999969,.999984,.999990/ C IONISATION (VALUES ABOVE 20KEV GENERATED BY BORN BETHE IN SUB) DATA XION/12.129843,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./ C GROSS IONISATION DATA YION/0.00,.137,.344,.549,.748,.939,1.12,1.29,1.46,1.62, /1.77,2.04,2.30,2.52,2.73,2.93,3.10,3.27,3.56,3.81, /4.03,4.22,4.39,4.53,4.73,4.94,5.11,5.21,5.31,5.36, /5.40,5.46,5.56,5.68,5.75,5.75,5.70,5.58,5.48,5.35, /5.11,4.83,4.36,4.02,3.72,3.46,3.24,3.06,2.87,2.72, /2.49,2.26,2.10,1.94,1.68,1.48,1.35,1.23,1.13,.964, /.836,.736,.663,.602,.555,.515,.480,.424,.382,.346, /.319,.273,.242,.218,.200,.186/ C COUNTING IONISATION DATA YINC/0.00,.137,.344,.549,.748,.939,1.12,1.29,1.46,1.62, /1.77,2.04,2.30,2.52,2.73,2.93,3.10,3.27,3.56,3.81, /4.03,4.22,4.39,4.53,4.66,4.77,4.84,4.89,4.95,4.99, /5.02,5.04,5.03,5.02,4.98,4.90,4.80,4.69,4.60,4.49, /4.27,4.01,3.58,3.27,3.00,2.76,2.57,2.41,2.25,2.12, /1.93,1.75,1.62,1.49,1.28,1.12,1.03,.923,.855,.731, /.632,.557,.501,.455,.420,.389,.364,.320,.289,.262, /.241,.206,.183,.165,.152,.141/ C C EXCITATION UNITS OF 10**-18CM**2 C C 1S5 METASTABLE E=8.3153155 EV J=2 C SHAPE FUNCTION BELOW 11EV FROM BARTSCHAT AND ZATSARINNY DATA X1S5/8.3153,8.35,8.40,8.44,8.48,8.52,8.56,8.60,8.65,8.70, /8.75,8.80,8.85,9.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.516,9.52,9.525,9.53, /9.54,9.545,9.55,9.555,9.56,9.57,9.58,9.59,9.60,9.61, /9.615,9.62,9.625,9.63,9.64,9.65,9.66,9.67,9.68,9.70, /9.75,10.0,10.5,11.0,11.5,12.0,12.5,13.0,14.0,15.0, /16.0,18.0,20.0,25.0,30.0,40.0,50.0,60.0,80.0,100., /150.,200.,300.,600.,1000.,1.D4,1.D5,1.D6,1.D7/ DATA Y1S5/0.00,2.38,4.93,6.41,3.42,2.84,3.00,3.33,3.89,4.59, /5.45,6.48,7.72,9.05,10.4,11.5,12.3,12.2,10.8,9.45, /8.84,9.04,9.18,9.18,9.11,9.32,23.6,15.7,12.1,10.7, /9.79,11.4,15.8,18.0,15.9,13.1,13.6,12.6,10.4,12.1, /14.9,20.5,21.5,18.5,17.2,16.9,15.9,13.8,12.4,11.1, /10.1,10.0,9.90,9.80,9.70,9.60,9.30,8.80,8.10,7.45, /6.80,5.50,4.40,2.20,1.10,.500,.230,.150,.065,.034, /.010,.0042,.0013,1.7D-4,3.8D-5,4.D-8,4.D-11,4.D-14,4.D-17/ DATA YP1S5/79*0.0/ C 1S4 E=8.4365236 EV J=1 RESONANCE RADIATION 146.96 NM F=0.260 C USED BEF SCALING ABOVE 11.0EV C SHAPE FUNCTION BELOW 11EV FROM BARTSCHAT AND ZATSARINNY DATA X1S4/8.4365,8.45,8.46,8.47,8.48,8.49,8.50,8.52,8.54,8.56, /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.62,9.65,9.70,9.75,9.80,10.0,11.0/ DATA Y1S4/0.00,2.60,5.60,6.09,5.50,4.72,4.27,3.70,3.42,3.24, /3.10,3.02,3.34,3.70,4.25,5.03,6.00,7.23,8.70,9.67, /10.3,10.1,9.37,9.00,8.70,8.55,8.62,8.77,9.00,10.1, /10.5,10.7,10.2,9.22,9.40,9.60,10.8,16.87/ DATA YP1S4/38*0.0/ C 1S3 METASTABLE E=9.4471945 EV J=0 C SHAPE FUNCTION BELOW 11EV FROM BARTSCAT AND ZATSARINNY DATA X1S3/9.4472,9.45,9.47,9.48,9.49,9.50,9.506,9.51,9.52,9.525, /9.53,9.54,9.55,9.555,9.56,9.57,9.58,9.60,9.62,9.64, /9.67,9.68,9.69,9.70,9.71,9.72,9.73,9.74,9.75,9.80, /10.0,11.0,12.0,13.0,14.0,15.0,16.0,18.0,20.0,24.0, /30.0,40.0,50.0,60.0,80.0,100.,150.,200.,300.,400., ,600.,800.,1000.,1.D4,1.D5,1.D6,1.D7/ DATA Y1S3/0.00,.313,.324,.230,.360,1.67,3.78,2.57,1.26,1.71, /1.80,1.78,2.23,2.70,2.43,.635,1.14,1.04,1.49,1.59, /1.62,2.77,3.89,6.21,9.38,8.28,6.75,4.29,3.97,.556, /0.77,3.30,4.30,4.50,4.30,3.70,3.30,2.65,2.25,1.50, /0.80,0.32,0.17,0.10,.040,.021,.0064,.0026,7.5D-4,3.3D-4, /1.0D-4,4.D-5,2.D-5,2.D-8,2.D-11,2.D-14,2.D-17/ DATA YP1S3/57*0.0/ C 1S2 E=9.5697248 EV J=1 RESONANCE RADIATION 129.56 NM F=0.183 C USED BEF SCALING ABOVE 11.0EV C SHAPE FUNCTION BELOW 11EV FROM BARTSCHAT AND ZATSARINNY DATA X1S2/9.5697,9.58,9.59,9.60,9.61,9.62,9.63,9.64,9.65,9.67, /9.68,9.69,9.70,9.75,9.77,9.80,9.85,9.90,10.0,11.0/ DATA Y1S2/0.00,1.21,1.32,1.41,1.41,1.30,1.88,2.00,2.02,2.02, /2.83,2.11,2.07,1.78,2.10,1.96,1.75,1.87,2.17,5.305/ DATA YP1S2/20*0.0/ C 2P10 E=9.5801524 EV J=1 DATA X2P10/9.5802,9.80,10.0,10.5,11.0,11.5,12.0,12.5,13.0,14.0, /15.0,16.0,18.0,20.0,25.0,30.0,35.0,40.0,50.0,60.0, /80.0,100.,120.,160.,200.,250.,300.,500.,700.,1000., /2000.,4000.,7000.,1.D4,1.D5,1.D6,1.D7/ DATA Y2P10/0.00,0.69,1.23,2.34,3.15,3.73,4.14,4.41,4.59,4.76, /4.74,4.63,4.26,3.84,2.91,2.23,1.75,1.40,0.95,0.69, /.406,.267,.188,.108,.071,.046,.032,.011,.0059,.0029, /7.8D-4,1.9D-4,6.0D-5,2.9D-5,2.9D-7,2.9D-9,2.9D-11/ DATA YP2P10/37*0.0/ C 2P9 E=9.6856199 EV J=2 DATA X2P9/9.6856,10.0,10.5,11.0,11.5,12.0,12.5,13.0,14.0,15.0, /16.0,18.0,20.0,25.0,30.0,35.0,40.0,50.0,60.0,80.0, /100.,120.,140.,170.,200.,250.,300.,400.,600.,800., /1000.,2000.,4000.,7000.,1.D4,1.D5,1.D6,1.D7/ DATA Y2P9/0.00,1.50,3.37,4.49,5.47,6.04,6.48,6.91,7.41,7.49, /7.41,6.98,6.26,5.04,4.17,3.52,3.09,2.52,2.08,1.58, /1.22,1.00,0.87,0.72,0.61,0.51,0.41,0.30,0.21,0.16, /0.12,.061,.030,.017,.012,.0012,1.2D-4,1.2D-5/ DATA YP2P9/38*0.0/ C 2P8 E=9.7207401 EV J=3 DATA X2P8/9.7207,10.0,10.5,11.0,11.5,12.0,12.5,13.0,13.5,14.0, /15.0,16.0,18.0,20.0,25.0,30.0,35.0,40.0,50.0,60.0, /80.0,100.,200.,400.,700.,1000.,2000.,4000.,7000.,1.D4, /1.D5,1.D6,1.D7/ DATA Y2P8/0.00,1.16,2.78,3.88,4.86,5.44,5.83,6.02,6.35,6.41, /6.48,6.33,4.89,3.24,1.51,0.72,0.43,0.26,0.11,.061, /.021,.0093,.0011,1.4D-4,2.7D-5,9.4D-6,1.1D-6,1.4D-7,2.7D-8,9.4D-9, /9.4D-12,9.4D-15,9.4D-18/ DATA YP2P8/33*0.0/ C 2P7 E=9.7892996 EV J=1 DATA X2P7/9.7893,10.0,10.5,11.0,11.5,12.0,12.5,13.0,13.5,14.0, /15.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.,300.,400.,600.,1000.,2000., /1.D4,1.D5,1.D6,1.D7/ DATA Y2P7/0.00,0.66,1.68,2.52,3.12,3.48,3.72,3.90,4.02,4.14, /4.20,4.20,3.90,3.48,2.64,1.80,1.26,0.96,0.63,0.42, /0.24,0.15,0.11,.066,.036,.017,.0096,4.3D-3,1.6D-3,3.6D-4, /1.6D-5,1.6D-7,1.6D-9,1.6D-11/ DATA YP2P7/34*0.0/ C 2P6 E=9.8210934 EV J=2 DATA X2P6/9.8211,10.0,10.5,11.0,11.5,12.0,12.5,13.0,13.5,14.0, /15.0,16.0,18.0,20.0,25.0,30.0,35.0,40.0,50.0,60.0, /80.0,100.,120.,140.,170.,200.,300.,400.,600.,800., /1000.,1400.,2000.,4000.,1.D4,1.D5,1.D6,1.D7/ DATA Y2P6/0.00,0.26,1.05,1.47,1.92,2.19,2.32,2.43,2.53,2.62, /2.64,2.88,3.06,2.94,2.70,2.10,1.68,1.53,1.26,1.02, /0.78,0.60,0.51,0.44,0.36,0.31,0.20,0.16,0.10,.075, /0.06,.044,.031,.016,.006,.0006,.00006,.000006/ DATA YP2P6/38*0.0/ C 3D6 E=9.8903760 EV J=0 DATA X3D6/9.8904,10.0,10.5,11.0,11.5,12.0,12.5,13.0,13.5,14.0, /14.5,15.0,16.0,17.0,18.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,250.,300.,400., /600.,800.,1000.,1400.,2000.,4000.,1.D4,1.D5,1.D6,1.D7/ DATA Y3D6/0.00,0.23,0.83,1.50,2.17,2.77,3.22,3.60,3.90,4.20, /4.42,4.65,4.80,5.02,5.02,4.80,4.50,3.90,2.78,1.87, /1.35,1.01,0.66,0.48,0.36,0.25,0.17,0.12,0.09,5.8D-2, /3.2D-2,2.1D-2,1.5D-2,9.0D-3,5.4D-3,1.9D-3,4.5D-4,1.5D-5,4.5D-7, /1.5D-8/ DATA YP3D6/40*0.0/ C C 3D5 E=9.9170761 EV J=1 RESONACE RADIATION 125.02 NM F=0.010 C C 2P5 E=9.9334847 EV J=0 DATA X2P5/9.9335,13.0,16.0,17.5,20.0,24.0,26.0,28.0,30.0,35.0, /40.0,50.0,60.0,80.0,100.,120.,150.,200.,300.,400., /600.,800.,1000.,1400.,2000.,4000.,1.D4,1.D5,1.D6,1.D7/ DATA Y2P5/0.00,1.60,2.16,2.70,4.26,7.32,8.46,8.88,8.70,8.40, /7.50,5.70,4.80,3.60,3.00,2.46,1.98,1.50,1.02,0.76, /0.52,0.39,0.31,0.23,0.16,.078,.031,.0031,3.1D-4,3.1D-5/ DATA YP2P5/30*0.0/ C 3D4! E=9.9431141 EV J=4 DATA X3D4P/9.9431,10.0,10.5,11.0,11.5,12.0,12.5,13.0,13.5,14.0, /14.5,15.0,16.0,17.0,18.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,250.,300.,400., /600.,800.,1000.,1400.,2000.,4000.,1.D4,1.D5,1.D6,1.D7/ DATA Y3D4P/0.00,0.45,1.65,3.00,4.35,5.55,6.45,7.20,7.80,8.40, /8.85,9.30,9.60,10.1,10.1,9.60,9.00,7.80,5.77,3.75, /2.70,2.03,1.32,0.96,0.72,0.51,0.33,0.24,0.18,.117, /6.3D-2,4.2D-2,3.0D-2,1.8D-2,1.1D-2,3.8D-3,9.0D-4,3.D-5,9.0D-7, /3.D-8/ DATA YP3D4P/40*0.0/ C 3D3 E=9.9587506 EV J=2 DATA X3D3/9.9588,10.0,10.5,11.0,11.5,12.0,12.5,13.0,13.5,14.0, /14.5,15.0,16.0,17.0,18.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,250.,300.,400., /600.,800.,1000.,1400.,2000.,4000.,1.D4,1.D5,1.D6,1.D7/ DATA Y3D3/0.00,0.48,1.76,3.20,4.64,5.92,6.88,7.68,8.32,8.96, /9.44,9.92,10.2,10.7,10.7,10.2,9.60,8.32,5.92,4.00, /2.88,2.16,1.41,1.03,0.77,0.54,0.35,0.26,0.19,.125, /6.7D-2,4.5D-2,3.2D-2,1.9D-2,1.1D-2,4.0D-3,9.6D-4,3.2D-5,9.6D-7, /3.2D-8/ DATA YP3D3/40*0.0/ C 3D4 E=10.039054 EV J=3 DATA X3D4/10.0391,10.2,10.5,10.7,11.0,11.2,11.5,12.0,12.5,13.0, /13.5,14.0,14.5,15.0,16.0,18.0,20.0,22.0,25.0,30.0, /35.0,40.0,50.0,60.0,80.0,100.,120.,150.,200.,300., /600.,1000.,2000.,1.D5,1.D6,1.D7/ DATA Y3D4/0.00,0.50,1.50,2.20,3.30,4.00,5.00,6.90,8.70,10.7, /12.2,13.3,13.6,13.6,12.8,10.2,9.00,7.30,5.70,3.40, /2.90,2.20,1.45,1.00,0.56,0.36,0.25,0.16,.090,.040, /.010,.0036,9.D-4,3.6D-5,3.6D-7,3.6D-9/ DATA YP3D4/36*0.0/ C 3D1!! E=10.157469 EV J=2 DATA X3D1PP/10.1575,10.5,10.7,11.0,11.5,12.0,12.5,13.0,13.5,14.0, /14.5,15.0,16.0,18.0,20.0,22.0,25.0,30.0,40.0,50.0, /60.0,80.0,100.,120.,150.,200.,300.,600.,1000.,2000., /1.D4,1.D5,1.D6,1.D7/ DATA Y3D1PP/0.00,0.70,1.30,2.00,3.20,4.50,5.70,6.80,7.80,8.30, /8.50,8.50,8.20,6.70,5.30,3.80,2.90,1.55,0.67,0.35, /0.20,.085,.044,.025,.013,.0055,.0016,2.0D-4,4.4D-5,5.5D-6, /4.4D-8,4.4D-11,4.4D-14,4.4D-17/ DATA YP3D1PP/34*0.0/ C 3D1! E=10.220042 J=3 DATA X3D1P/10.2200,10.7,11.0,11.5,12.0,12.5,13.0,13.5,14.0,14.5, /15.0,16.0,18.0,20.0,22.0,25.0,30.0,40.0,50.0,60.0, /80.0,100.,120.,150.,200.,300.,600.,1000.,2000.,1.D4, /1.D5,1.D6,1.D7/ DATA Y3D1P/0.00,0.60,1.04,1.83,2.39,3.00,3.39,3.65,3.83,3.94, /4.00,4.00,3.95,3.85,3.70,3.45,2.90,2.15,1.70,1.45, /1.08,.875,0.73,0.58,0.44,0.30,0.15,0.09,.045,.009, /9.D-4,9.D-5,9.D-6/ DATA YP3D1P/33*0.0/ C C 3D2 E=10.401030 J=1 RESONANCE RADIATION 119.20 NM F=0.379 C C 2S5 E=10.562062 EV J=2 NOT OBSERVED USE 1S5 SCALED BY 0.25 DATA X2S5/10.5621,11.0,11.5,12.0,12.5,13.0,14.0,15.0,16.0,18.0, /20.0,25.0,30.0,40.0,50.0,60.0,80.0,100.,150.,200., /300.,600.,1000.,1.D4,1.D5,1.D6,1.D7/ DATA Y2S5/0.00,0.10,0.25,0.50,1.00,1.50,2.02,1.75,1.70,1.37, /1.10,.550,.275,.125,.057,.037,.016,.0085,.0025,.0010, /3.2D-4,4.2D-5,1.0D-5,1.D-8,1.D-11,1.D-14,1.D-17/ DATA YP2S5/27*0.0/ C C 2S4 E=10.593211 EV J=1 RESONANCE RADIATION 117.04 NM F=0.086 C C 3P10+3P9+3P8+3P7+3P6+3P5 E=10.9016 EV SCALED SUM OF 2P10--2P5 BY 0.25 DATA X3P105/10.9016,11.50,12.0,12.5,13.0,14.0,15.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.,300.,400.,600.,800.,1000.,1400.,2000.,4000.,1.D4, /1.D5,1.D6,1.D7/ DATA Y3P105/0.00,1.00,2.70,3.42,4.20,5.10,5.70,5.94,5.93,5.52, /5.31,4.71,4.09,3.54,2.68,2.18,1.59,1.26,1.02,0.81, /0.60,.405,0.30,0.20,0.15,0.12,.084,.060,.030,.012, /.0012,1.2D-4,1.2D-5/ DATA YP3P105/33*0.0/ C 2P4 E=10.957614 J=1 DATA X2P4/10.9576,13.0,14.0,15.0,16.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,400.,1000.,1.D4, /1.D5,1.D6,1.D7/ DATA Y2P4/0.00,0.75,1.10,1.20,1.10,0.75,0.60,0.38,0.25,.145, /.095,.065,.037,.025,.017,.011,.0065,.0016,2.5D-4,2.5D-6, /2.5D-8,1.5D-10,1.5D-12/ DATA YP2P4/23*0.0/ C 4D6+4D3+4D4!+4D4+4D1!!+4D1! SUM 4D E=10.9715 C SHAPE FROM PETROV NORMALISED TO HAYASHI TOTAL DATA X4DSUM/10.9715,12.0,13.0,14.0,15.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.,400., /1000.,1.D4,1.D5,1.D6,1.D7/ DATA Y4DSUM/0.00,1.50,4.35,4.65,4.50,4.05,3.00,2.25,0.96,0.57, /0.36,0.21,.099,.060,.024,.011,.0063,.0031,.0014,.00018, /1.1D-5,1.1D-8,1.1D-11,1.1D-14,1.1D-17/ DATA YP4DSUM/25*0.0/ C C 4D5 E=10.978772 J=1 RESONANCE RADIATION AT 112.93 NM F=0.001 C C 2P3 E=11.054723 J=2 DATA X2P3/11.0547,13.0,14.0,15.0,16.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,400.,1000.,1.D4, /1.D5,1.D6,1.D7/ DATA Y2P3/0.00,2.20,3.00,3.50,3.60,3.50,3.20,2.60,2.20,1.65, /1.35,1.10,0.83,0.65,0.54,0.44,0.33,.165,.065,.0065, /6.5D-4,6.5D-5,6.5D-6/ DATA YP2P3/23*0.0/ C 2P2 E=11.069148 J=1 DATA X2P2/11.0691,13.0,14.0,15.0,16.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,400.,1000.,1.D4, /1.D5,1.D6,1.D7/ DATA Y2P2/0.00,0.75,1.00,1.08,1.08,0.97,0.85,0.56,0.40,0.22, /.145,.100,.054,.035,.024,.0155,.0086,.0022,3.5D-4,3.5D-6, /3.5D-8,3.5D-10,3.5D-12/ DATA YP2P2/23*0.0/ C 2P1 E=11.141221 J=0 DATA X2P1/11.1412,13.0,14.0,15.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.,400.,1000., /1.D4,1.D5,1.D6,1.D7/ DATA Y2P1/0.00,0.80,1.50,1.90,1.90,1.80,1.60,1.30,1.05,0.91, /0.77,0.64,0.52,0.39,0.31,0.26,.205,.155,.077,.031, /.0031,3.1D-4,3.1D-5,3.1D-6/ DATA YP2P1/24*0.0/ C C 4D2 E=11.162564 EV J=1 RESONANCE RADIATION AT 111.07 NM F=0.0835 C 3S4 E=11.274184 EV J=1 RESONANCE RADIATION AT 109.97 NM F=0.0225 C 5D5 E=11.422451 EV J=1 RESONANCE RADIATION AT 108.55 NM F=0.0227 C 5D2 E=11.495075 EV J=1 RESONANCE RADIATION AT 107.86 NM F=0.002 C 4S4 E=11.582864 EV J=1 RESONANCE RADIATION AT 107.04 NM F=0.0005 C 3S1! E=11.60718 EV J=1 RESONANCE RADIATION AT 106.82 NM F=0.1910 C 6D5 E=11.682783 EV J=1 RESONANCE RADIATION AT 106.13 NM F=0.0088 C 6D2 E=11.739501 EV J=1 RESONANCE RADIATION AT 105.61 NM F=0.0967 C 5S4 E=11.752100 EV J=1 RESONANCE RADIATION AT 105.50 NM F=0.0288 C 7D5 E=11.806816 EV J=1 RESONANCE RADIATION AT 105.01 NM F=0.0042 C 7D2 E=11.84030 EV J=1 RESONANCE RADIATION AT 104.71 NM F=0.0625 C 6S4 E=11.85177 EV J=1 RESONANCE RADIATION AT 104.61 NM F=0.0025 C 2S2 E=11.877758 EV J=1 RESONANCE RADIATION AT 104.38 NM F=0.029 C 8D5 E=11.891681 EV J=1 RESONANCE RADIATION AT 104.26 NM F=0.0035 C 8D2 E=11.90816 EV J=1 RESONANCE RADIATION AT 104.12 NM F=0.0386 C 7S4 E=11.91770 EV J=1 RESONANCE RADIATION AT 104.03 NM F=0.005 C 9D5 E=11.94156 EV J=1 RESONANCE RADIATION AT 103.83 NM F=0.0005 C 9D2 E=11.95502 EV J=1 RESONANCE RADIATION AT 103.71 NM F=0.025 C 8S4 E=11.96207 EV J=1 RESONANCE RADIATION AT 103.64 NM F=0.0023 C 10D5 E=11.978893 EV J=1 RESONANCE RADIATION AT 103.50 NM F=0.0005 C 10D2 E=11.98858 EV J=1 RESONANCE RADIATION AT 103.42 NM F=0.0164 C 9S4 E=11.993947 EV J=1 RESONANCE RADIATION AT 103.37 NM F=0.0014 C SUM HIGHER STATES E=12.0 EV F=0.0831 C C TOTAL OSCILLATOR SUM =1.650 C C----------------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME='XENON (ISO)2011' ELSE NAME='XENON (ANI)2011' ENDIF C C -------------------------------------------------------------------- C DATA ON XENON NOT AS GOOD AS ARGON . C USED MOMENTUM TRANSFER X-SECTION FROM SCHMIDT UP TO 2 EV. C FIT TO TOWNSEND COEFFICIENT OF JACQUES ET AL J.PHYS D19(1986)1731 C AND KRUITHOF TO OBTAIN INELASTIC X-SECTIONS. C 2010: UPDATED IONISATION X-SECTIONS C 2009: INCLUDED ALL RESONANCE STATES AND SOME P AND D STATES C 2007: INCREASED ENERGY RANGE TO 2MEV C 2007: INCLUDED NEW ANGULAR DISTRIBUTION C 2007: INCLUDED PENNING TRANSFER FRACTION C -------------------------------------------------------------------- C C BORN BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 API=DACOS(-1.0D0) A0=0.52917720859D-8 RY=13.60569193 BBCONST=16.0*API*A0*A0*RY*RY/EMASS2 C AM2=8.04 C=75.25 C C NIN=50 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN 2 KIN(J)=NANISO C NDATA=139 NEL=131 NEPSI=139 NION=76 N1S5=79 N1S4=38 N1S3=57 N1S2=20 N2P10=37 N2P9=38 N2P8=33 N2P7=34 N2P6=38 N3D6=40 N2P5=30 N3D4P=40 N3D3=40 N3D4=36 N3D1PP=34 N3D1P=33 N2S5=27 N3PSUM=33 N2P4=23 N4DSUM=25 N2P3=23 N2P2=23 N2P1=24 E(1)=0.0 E(2)=2.0*EMASS/(131.30*AMU) E(3)=12.129843 C EXCITATION X-SECTION AT 1.3 MEV E(4)=0.511D-18 C IONISING X-SECTION AT 1.3 MEV E(5)=0.1782D-17 C EOBY FOR MINIMUM IONISING PARTICLE E(6)=23.7 C EOBY AT LOW ENERGY EOBY=8.7 IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) EIN(1)=8.3153 EIN(2)=8.4365 EIN(3)=9.4472 EIN(4)=9.5697 EIN(5)=9.5802 EIN(6)=9.6856 EIN(7)=9.7207 EIN(8)=9.7893 EIN(9)=9.8211 EIN(10)=9.8904 EIN(11)=9.9171 EIN(12)=9.9335 EIN(13)=9.9431 EIN(14)=9.9588 EIN(15)=10.0391 EIN(16)=10.1575 EIN(17)=10.2200 EIN(18)=10.4010 EIN(19)=10.5621 EIN(20)=10.5932 EIN(21)=10.9016 EIN(22)=10.9576 EIN(23)=10.9715 EIN(24)=10.9788 EIN(25)=11.0547 EIN(26)=11.0691 EIN(27)=11.1412 EIN(28)=11.1626 EIN(29)=11.2742 EIN(30)=11.4225 EIN(31)=11.4951 EIN(32)=11.5829 EIN(33)=11.6072 EIN(34)=11.6828 EIN(35)=11.7395 EIN(36)=11.7521 EIN(37)=11.8068 EIN(38)=11.8403 EIN(39)=11.8518 EIN(40)=11.8778 EIN(41)=11.8917 EIN(42)=11.9082 EIN(43)=11.9177 EIN(44)=11.9416 EIN(45)=11.9550 EIN(46)=11.9621 EIN(47)=11.9789 EIN(48)=11.9886 EIN(49)=11.9939 EIN(50)=12.0 C*********************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C USE TRANSFER FRACTION BETWEEN 0.0 AND 0.1 FOR XENON DO 50 NL=1,NIN PENFRA(1,NL)=0.0 C PENNING TRANSFER DISTANCE MICRONS PENFRA(2,NL)=1.0 C PENNING TRANSFER TIME PICOSECONDS 50 PENFRA(3,NL)=1.0 C*********************************************************************** IF(IPEN.EQ.0) GO TO 4 DO 3 KDUM=1,NIN IF(PENFRA(1,KDUM).EQ.0.0) GO TO 3 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 3 CONTINUE 4 DO 5 NL=1,NIN 5 IOFFN(NL)=IFIX(SNGL(0.5+EIN(NL)/ESTEP)) SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANIS) XENON ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC (ISO) XENON ' ENDIF SCRPT(3)=' IONISATION ELOSS= 12.12984' SCRPT(4)=' ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' EX 1S5 J=2 M ELVL= 8.3153' SCRPT(8)=' EX 1S4 J=1 R ELVL= 8.4365' SCRPT(9)=' EX 1S3 J=0 M ELVL= 9.4472' SCRPT(10)=' EX 1S2 J=1 R ELVL= 9.5697' SCRPT(11)=' EX 2P10 J=1 ELVL= 9.5802' SCRPT(12)=' EX 2P9 J=2 ELVL= 9.6856' SCRPT(13)=' EX 2P8 J=3 ELVL= 9.7207' SCRPT(14)=' EX 2P7 J=1 ELVL= 9.7893' SCRPT(15)=' EX 2P6 J=2 ELVL= 9.8211' SCRPT(16)=' EX 3D6 J=0 ELVL= 9.8904' SCRPT(17)=' EX 3D5 J=1 R ELVL= 9.9171' SCRPT(18)=' EX 2P5 J=0 ELVL= 9.9335' SCRPT(19)=' EX 3D4! J=4 ELVL= 9.9431' SCRPT(20)=' EX 3D3 J=2 ELVL= 9.9588' SCRPT(21)=' EX 3D4 J=3 ELVL=10.0391' SCRPT(22)=' EX 3D1!! J=2 ELVL=10.1575' SCRPT(23)=' EX 3D1! J=3 ELVL=10.2200' SCRPT(24)=' EX 3D2 J=1 R ELVL=10.4010' SCRPT(25)=' EX 2S5 J=2 ELVL=10.5621' SCRPT(26)=' EX 2S4 J=1 R ELVL=10.5932' SCRPT(27)=' EX SUM 3P10-5 ELVL=10.9016' SCRPT(28)=' EX 2P4 J=1 ELVL=10.9576' SCRPT(29)=' EX SUM 4D ELVL=10.9715' SCRPT(30)=' EX 4D5 J=1 R ELVL=10.9788' SCRPT(31)=' EX 2P3 J=2 ELVL=11.0547' SCRPT(32)=' EX 2P2 J=1 ELVL=11.0691' SCRPT(33)=' EX 2P1 J=0 ELVL=11.1412' SCRPT(34)=' EX 4D2 J=1 R ELVL=11.1626' SCRPT(35)=' EX 3S4 J=1 R ELVL=11.2742' SCRPT(36)=' EX 5D5 J=1 R ELVL=11.4225' SCRPT(37)=' EX 5D2 J=1 R ELVL=11.4951' SCRPT(38)=' EX 4S4 J=1 R ELVL=11.5829' SCRPT(39)=' EX 3S1! J=1 R ELVL=11.6072' SCRPT(40)=' EX 6D5 J=1 R ELVL=11.6828' SCRPT(41)=' EX 6D2 J=1 R ELVL=11.7395' SCRPT(42)=' EX 5S4 J=1 R ELVL=11.7521' SCRPT(43)=' EX 7D5 J=1 R ELVL=11.8068' SCRPT(44)=' EX 7D2 J=1 R ELVL=11.8403' SCRPT(45)=' EX 6S4 J=1 R ELVL=11.8518' SCRPT(46)=' EX 2S2 J=1 R ELVL=11.8778' SCRPT(47)=' EX 8D5 J=1 R ELVL=11.8917' SCRPT(48)=' EX 8D2 J=1 R ELVL=11.9082' SCRPT(49)=' EX 7S4 J=1 R ELVL=11.9177' SCRPT(50)=' EX 9D5 J=1 R ELVL=11.9416' SCRPT(51)=' EX 9D2 J=1 R ELVL=11.9550' SCRPT(52)=' EX 8S4 J=1 R ELVL=11.9621' SCRPT(53)=' EX 10D5 J=1 R ELVL=11.9789' SCRPT(54)=' EX 10D2 J=1 R ELVL=11.9886' SCRPT(55)=' EX 9S4 J=1 R ELVL=11.9939' SCRPT(56)=' EX HIGH J=1 R ELVL=12.0 ' EN=-ESTEP/2.0 DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.EIN(1)) THEN GAMMA1=(EMASS2+2.0D0*EN)/EMASS2 GAMMA2=GAMMA1*GAMMA1 BETA=DSQRT(1.0D0-1.0D0/GAMMA2) BETA2=BETA*BETA ENDIF 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=DLOG(YEL(J)) YXJ1=DLOG(YEL(J-1)) XNJ=DLOG(XEL(J)) XNJ1=DLOG(XEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=DEXP(A*DLOG(EN)+B)*1.D-16 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 YXJ=DLOG(YMOM(J)) YXJ1=DLOG(YMOM(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=DEXP(A*DLOG(EN)+B)*1.D-16 200 CONTINUE PQ1=0.5+(QELA-QMOM)/QELA DO 201 J=2,NEPSI IF(EN.LE.XEPS(J)) GO TO 202 201 CONTINUE J=NEPSI 202 A=(YEPS(J)-YEPS(J-1))/(XEPS(J)-XEPS(J-1)) B=(XEPS(J-1)*YEPS(J)-XEPS(J)*YEPS(J-1))/(XEPS(J-1)-XEPS(J)) PQ2=A*EN+B IF(NANISO.EQ.0) PEQEL(2,I)=0.5 IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) Q(2,I)=QMOM C GROSS IONISATION Q(3,I)=0.0 PEQEL(3,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(3,I)=0.0D0 IF(EN.LE.E(3)) GO TO 230 IF(EN.GT.XION(NION)) GO TO 221 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 GO TO 222 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 221 X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2)/0.75 222 CONTINUE 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 ATTACHMENT 230 Q(4,I)=0.0 C COUNTING IONISATION Q(5,I)=0.0 PEQEL(5,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(5,I)=0.0D0 IF(EN.LE.E(3)) GO TO 250 IF(EN.GT.XION(NION)) GO TO 241 DO 231 J=2,NION IF(EN.LE.XION(J)) GO TO 240 231 CONTINUE J=NION 240 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.0D-16 GO TO 242 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 241 Q(5,I)=CONST*(AM2*X1+C*X2) 242 CONTINUE 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 250 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 250 CONTINUE Q(6,I)=0.0 C DO 251 NL=1,NIN QIN(NL,I)=0.0 PEQIN(NL,I)=0.5D0 IF(NANISO.EQ.2) THEN PEQIN(NL,I)=0.0D0 ENDIF 251 CONTINUE C 1S5 IF(EN.LE.EIN(1)) GO TO 413 DO 310 J=2,N1S5 IF(EN.LE.X1S5(J)) GO TO 311 310 CONTINUE J=N1S5 311 A=(Y1S5(J)-Y1S5(J-1))/(X1S5(J)-X1S5(J-1)) B=(X1S5(J-1)*Y1S5(J)-X1S5(J)*Y1S5(J-1))/(X1S5(J-1)-X1S5(J)) QIN(1,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(1))) GO TO 312 PEQIN(1,I)=PEQEL(2,(I-IOFFN(1))) C 1S4 F=0.260 312 IF(EN.LE.EIN(2)) GO TO 413 DO 313 J=2,N1S4 IF(EN.LE.X1S4(J)) GO TO 314 IF(EN.GT.X1S4(N1S4)) GO TO 3141 313 CONTINUE J=N1S4 314 A=(Y1S4(J)-Y1S4(J-1))/(X1S4(J)-X1S4(J-1)) B=(X1S4(J-1)*Y1S4(J)-X1S4(J)*Y1S4(J-1))/(X1S4(J-1)-X1S4(J)) QIN(2,I)=(A*EN+B)*1.0D-18 GO TO 3142 3141 QIN(2,I)=0.260/(EIN(2)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(2)))-BETA2)*BBCONST*EN/(EN+EIN(2)+E(3)) 3142 IF(EN.LE.(2.0*EIN(2))) GO TO 315 PEQIN(2,I)=PEQEL(2,(I-IOFFN(2))) C 1S3 315 IF(EN.LE.EIN(3)) GO TO 413 DO 316 J=2,N1S3 IF(EN.LE.X1S3(J)) GO TO 317 316 CONTINUE J=N1S3 317 A=(Y1S3(J)-Y1S3(J-1))/(X1S3(J)-X1S3(J-1)) B=(X1S3(J-1)*Y1S3(J)-X1S3(J)*Y1S3(J-1))/(X1S3(J-1)-X1S3(J)) QIN(3,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(3))) GO TO 318 PEQIN(3,I)=PEQEL(2,(I-IOFFN(3))) C 1S2 F=0.183 318 IF(EN.LE.EIN(4)) GO TO 413 DO 319 J=2,N1S2 IF(EN.LE.X1S2(J)) GO TO 320 IF(EN.GT.X1S2(N1S2)) GO TO 3201 319 CONTINUE J=N1S2 320 A=(Y1S2(J)-Y1S2(J-1))/(X1S2(J)-X1S2(J-1)) B=(X1S2(J-1)*Y1S2(J)-X1S2(J)*Y1S2(J-1))/(X1S2(J-1)-X1S2(J)) QIN(4,I)=(A*EN+B)*1.0D-18 GO TO 3202 3201 QIN(4,I)=0.183/(EIN(4)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(4)))-BETA2)*BBCONST*EN/(EN+EIN(4)+E(3)) 3202 IF(EN.LE.(2.0*EIN(4))) GO TO 321 PEQIN(4,I)=PEQEL(2,(I-IOFFN(4))) C C P STATES C C 2P10 321 IF(EN.LE.EIN(5)) GO TO 413 DO 322 J=2,N2P10 IF(EN.LE.X2P10(J)) GO TO 323 322 CONTINUE J=N2P10 323 A=(Y2P10(J)-Y2P10(J-1))/(X2P10(J)-X2P10(J-1)) B=(X2P10(J-1)*Y2P10(J)-X2P10(J)*Y2P10(J-1))/(X2P10(J-1)-X2P10(J)) QIN(5,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(5))) GO TO 324 PEQIN(5,I)=PEQEL(2,(I-IOFFN(5))) C 2P9 324 IF(EN.LE.EIN(6)) GO TO 413 DO 325 J=2,N2P9 IF(EN.LE.X2P9(J)) GO TO 326 325 CONTINUE J=N2P9 326 A=(Y2P9(J)-Y2P9(J-1))/(X2P9(J)-X2P9(J-1)) B=(X2P9(J-1)*Y2P9(J)-X2P9(J)*Y2P9(J-1))/(X2P9(J-1)-X2P9(J)) QIN(6,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(6))) GO TO 327 PEQIN(6,I)=PEQEL(2,(I-IOFFN(6))) C 2P8 327 IF(EN.LE.EIN(7)) GO TO 413 DO 328 J=2,N2P8 IF(EN.LE.X2P8(J)) GO TO 329 328 CONTINUE J=N2P8 329 A=(Y2P8(J)-Y2P8(J-1))/(X2P8(J)-X2P8(J-1)) B=(X2P8(J-1)*Y2P8(J)-X2P8(J)*Y2P8(J-1))/(X2P8(J-1)-X2P8(J)) QIN(7,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(7))) GO TO 330 PEQIN(7,I)=PEQEL(2,(I-IOFFN(7))) C 2P7 330 IF(EN.LE.EIN(8)) GO TO 413 DO 331 J=2,N2P7 IF(EN.LE.X2P7(J)) GO TO 332 331 CONTINUE J=N2P7 332 A=(Y2P7(J)-Y2P7(J-1))/(X2P7(J)-X2P7(J-1)) B=(X2P7(J-1)*Y2P7(J)-X2P7(J)*Y2P7(J-1))/(X2P7(J-1)-X2P7(J)) QIN(8,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(8))) GO TO 333 PEQIN(8,I)=PEQEL(2,(I-IOFFN(8))) C 2P6 333 IF(EN.LE.EIN(9)) GO TO 413 DO 334 J=2,N2P6 IF(EN.LE.X2P6(J)) GO TO 335 334 CONTINUE J=N2P6 335 A=(Y2P6(J)-Y2P6(J-1))/(X2P6(J)-X2P6(J-1)) B=(X2P6(J-1)*Y2P6(J)-X2P6(J)*Y2P6(J-1))/(X2P6(J-1)-X2P6(J)) QIN(9,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(9))) GO TO 336 PEQIN(9,I)=PEQEL(2,(I-IOFFN(9))) C 3D6 336 IF(EN.LE.EIN(10)) GO TO 413 DO 337 J=2,N3D6 IF(EN.LE.X3D6(J)) GO TO 338 337 CONTINUE J=N3D6 338 A=(Y3D6(J)-Y3D6(J-1))/(X3D6(J)-X3D6(J-1)) B=(X3D6(J-1)*Y3D6(J)-X3D6(J)*Y3D6(J-1))/(X3D6(J-1)-X3D6(J)) QIN(10,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(10))) GO TO 339 PEQIN(10,I)=PEQEL(2,(I-IOFFN(10))) C 3D5 J=1 F=0.0100 339 IF(EN.LE.EIN(11)) GO TO 413 QIN(11,I)=0.0100/(EIN(11)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(11)))-BETA2)*BBCONST*EN/(EN+EIN(11)+E(3)) IF(QIN(11,I).LT.0.0) QIN(11,I)=0.0 IF(EN.LE.(2.0*EIN(11))) GO TO 340 PEQIN(11,I)=PEQEL(2,(I-IOFFN(11))) C 2P5 340 IF(EN.LE.EIN(12)) GO TO 413 DO 341 J=2,N2P5 IF(EN.LE.X2P5(J)) GO TO 342 341 CONTINUE J=N2P5 342 A=(Y2P5(J)-Y2P5(J-1))/(X2P5(J)-X2P5(J-1)) B=(X2P5(J-1)*Y2P5(J)-X2P5(J)*Y2P5(J-1))/(X2P5(J-1)-X2P5(J)) QIN(12,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(12))) GO TO 343 PEQIN(12,I)=PEQEL(2,(I-IOFFN(12))) C 3D4! 343 IF(EN.LE.EIN(13)) GO TO 413 DO 344 J=2,N3D4P IF(EN.LE.X3D4P(J)) GO TO 345 344 CONTINUE J=N3D4P 345 A=(Y3D4P(J)-Y3D4P(J-1))/(X3D4P(J)-X3D4P(J-1)) B=(X3D4P(J-1)*Y3D4P(J)-X3D4P(J)*Y3D4P(J-1))/(X3D4P(J-1)-X3D4P(J)) QIN(13,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(13))) GO TO 346 PEQIN(13,I)=PEQEL(2,(I-IOFFN(13))) C 3D3 346 IF(EN.LE.EIN(14)) GO TO 413 DO 347 J=2,N3D3 IF(EN.LE.X3D3(J)) GO TO 348 347 CONTINUE J=N3D3 348 A=(Y3D3(J)-Y3D3(J-1))/(X3D3(J)-X3D3(J-1)) B=(X3D3(J-1)*Y3D3(J)-X3D3(J)*Y3D3(J-1))/(X3D3(J-1)-X3D3(J)) QIN(14,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(14))) GO TO 349 PEQIN(14,I)=PEQEL(2,(I-IOFFN(14))) C 3D4 349 IF(EN.LE.EIN(15)) GO TO 413 DO 350 J=2,N3D4 IF(EN.LE.X3D4(J)) GO TO 351 350 CONTINUE J=N3D4 351 A=(Y3D4(J)-Y3D4(J-1))/(X3D4(J)-X3D4(J-1)) B=(X3D4(J-1)*Y3D4(J)-X3D4(J)*Y3D4(J-1))/(X3D4(J-1)-X3D4(J)) QIN(15,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(15))) GO TO 352 PEQIN(15,I)=PEQEL(2,(I-IOFFN(15))) C 3D1!! 352 IF(EN.LE.EIN(16)) GO TO 413 DO 353 J=2,N3D1PP IF(EN.LE.X3D1PP(J)) GO TO 354 353 CONTINUE J=N3D1PP 354 A=(Y3D1PP(J)-Y3D1PP(J-1))/(X3D1PP(J)-X3D1PP(J-1)) B=(X3D1PP(J-1)*Y3D1PP(J)-X3D1PP(J)*Y3D1PP(J-1))/(X3D1PP(J-1)- /X3D1PP(J)) QIN(16,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(16))) GO TO 355 PEQIN(16,I)=PEQEL(2,(I-IOFFN(16))) C 3D1! 355 IF(EN.LE.EIN(17)) GO TO 413 DO 356 J=2,N3D1P IF(EN.LE.X3D1P(J)) GO TO 357 356 CONTINUE J=N3D1P 357 A=(Y3D1P(J)-Y3D1P(J-1))/(X3D1P(J)-X3D1P(J-1)) B=(X3D1P(J-1)*Y3D1P(J)-X3D1P(J)*Y3D1P(J-1))/(X3D1P(J-1)-X3D1P(J)) QIN(17,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(17))) GO TO 358 PEQIN(17,I)=PEQEL(2,(I-IOFFN(17))) C 3D2 J=1 F=0.379 358 IF(EN.LE.EIN(18)) GO TO 413 QIN(18,I)=0.3790/(EIN(18)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(18)))-BETA2)*BBCONST*EN/(EN+EIN(18)+E(3)) IF(QIN(18,I).LT.0.0) QIN(18,I)=0.0 IF(EN.LE.(2.0*EIN(18))) GO TO 359 PEQIN(18,I)=PEQEL(2,(I-IOFFN(18))) C 2S5 359 IF(EN.LE.EIN(19)) GO TO 413 DO 360 J=2,N2S5 IF(EN.LE.X2S5(J)) GO TO 361 360 CONTINUE J=N2S5 361 A=(Y2S5(J)-Y2S5(J-1))/(X2S5(J)-X2S5(J-1)) B=(X2S5(J-1)*Y2S5(J)-X2S5(J)*Y2S5(J-1))/(X2S5(J-1)-X2S5(J)) QIN(19,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(19))) GO TO 362 PEQIN(19,I)=PEQEL(2,(I-IOFFN(19))) C 2S4 J=1 F=0.086 362 IF(EN.LE.EIN(20)) GO TO 413 QIN(20,I)=0.086/(EIN(20)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(20)))-BETA2)*BBCONST*EN/(EN+EIN(20)+E(3)) IF(QIN(20,I).LT.0.0) QIN(20,I)=0.0 IF(EN.LE.(2.0*EIN(20))) GO TO 363 PEQIN(20,I)=PEQEL(2,(I-IOFFN(20))) C SUM 3P10+3P9+3P8+3P7+3P6+3P5 363 IF(EN.LE.EIN(21)) GO TO 413 DO 364 J=2,N3PSUM IF(EN.LE.X3P105(J)) GO TO 365 364 CONTINUE J=N3PSUM 365 A=(Y3P105(J)-Y3P105(J-1))/(X3P105(J)-X3P105(J-1)) B=(X3P105(J-1)*Y3P105(J)-X3P105(J)*Y3P105(J-1))/(X3P105(J-1)- /X3P105(J)) QIN(21,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(21))) GO TO 366 PEQIN(21,I)=PEQEL(2,(I-IOFFN(21))) C 2P4 366 IF(EN.LE.EIN(22)) GO TO 413 DO 367 J=2,N2P4 IF(EN.LE.X2P4(J)) GO TO 368 367 CONTINUE J=N2P4 368 A=(Y2P4(J)-Y2P4(J-1))/(X2P4(J)-X2P4(J-1)) B=(X2P4(J-1)*Y2P4(J)-X2P4(J)*Y2P4(J-1))/(X2P4(J-1)-X2P4(J)) QIN(22,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(22))) GO TO 369 PEQIN(22,I)=PEQEL(2,(I-IOFFN(22))) C SUM 4D6+4D3+4D4P+4D4+4D1PP+4D1P 369 IF(EN.LE.EIN(23)) GO TO 413 DO 370 J=2,N4DSUM IF(EN.LE.X4DSUM(J)) GO TO 371 370 CONTINUE J=N4DSUM 371 A=(Y4DSUM(J)-Y4DSUM(J-1))/(X4DSUM(J)-X4DSUM(J-1)) B=(X4DSUM(J-1)*Y4DSUM(J)-X4DSUM(J)*Y4DSUM(J-1))/(X4DSUM(J-1)- /X4DSUM(J)) QIN(23,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(23))) GO TO 372 PEQIN(23,I)=PEQEL(2,(I-IOFFN(23))) C 4D5 J=1 F=0.0010 372 IF(EN.LE.EIN(24)) GO TO 413 QIN(24,I)=0.0010/(EIN(24)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(24)))-BETA2)*BBCONST*EN/(EN+EIN(24)+E(3)) IF(QIN(24,I).LT.0.0) QIN(24,I)=0.0 IF(EN.LE.(2.0*EIN(24))) GO TO 373 PEQIN(24,I)=PEQEL(2,(I-IOFFN(24))) C 2P3 373 IF(EN.LE.EIN(25)) GO TO 413 DO 374 J=2,N2P3 IF(EN.LE.X2P3(J)) GO TO 375 374 CONTINUE J=N2P3 375 A=(Y2P3(J)-Y2P3(J-1))/(X2P3(J)-X2P3(J-1)) B=(X2P3(J-1)*Y2P3(J)-X2P3(J)*Y2P3(J-1))/(X2P3(J-1)-X2P3(J)) QIN(25,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(25))) GO TO 376 C 2P2 376 IF(EN.LE.EIN(26)) GO TO 413 DO 377 J=2,N2P2 IF(EN.LE.X2P2(J)) GO TO 378 377 CONTINUE J=N2P2 378 A=(Y2P2(J)-Y2P2(J-1))/(X2P2(J)-X2P2(J-1)) B=(X2P2(J-1)*Y2P2(J)-X2P2(J)*Y2P2(J-1))/(X2P2(J-1)-X2P2(J)) QIN(26,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(26))) GO TO 379 C 2P1 379 IF(EN.LE.EIN(27)) GO TO 413 DO 380 J=2,N2P1 IF(EN.LE.X2P1(J)) GO TO 381 380 CONTINUE J=N2P1 381 A=(Y2P1(J)-Y2P1(J-1))/(X2P1(J)-X2P1(J-1)) B=(X2P1(J-1)*Y2P1(J)-X2P1(J)*Y2P1(J-1))/(X2P1(J-1)-X2P1(J)) QIN(27,I)=(A*EN+B)*1.0D-18 IF(EN.LE.(2.0*EIN(27))) GO TO 382 C 4D2 J=1 F=0.0835 382 IF(EN.LE.EIN(28)) GO TO 413 QIN(28,I)=0.0835/(EIN(28)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(28)))-BETA2)*BBCONST*EN/(EN+EIN(28)+E(3)) IF(QIN(28,I).LT.0.0) QIN(28,I)=0.0 IF(EN.LE.(2.0*EIN(28))) GO TO 383 PEQIN(28,I)=PEQEL(2,(I-IOFFN(28))) C 3S4 J=1 F=0.0225 383 IF(EN.LE.EIN(29)) GO TO 413 QIN(29,I)=0.0225/(EIN(29)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(29)))-BETA2)*BBCONST*EN/(EN+EIN(29)+E(3)) IF(QIN(29,I).LT.0.0) QIN(29,I)=0.0 IF(EN.LE.(2.0*EIN(29))) GO TO 384 PEQIN(29,I)=PEQEL(2,(I-IOFFN(29))) C 5D5 J=1 F=0.0227 384 IF(EN.LE.EIN(30)) GO TO 413 QIN(30,I)=0.0227/(EIN(30)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(30)))-BETA2)*BBCONST*EN/(EN+EIN(30)+E(3)) IF(QIN(30,I).LT.0.0) QIN(30,I)=0.0 IF(EN.LE.(2.0*EIN(30))) GO TO 385 PEQIN(30,I)=PEQEL(2,(I-IOFFN(30))) C 5D2 J=1 F=0.0020 385 IF(EN.LE.EIN(31)) GO TO 413 QIN(31,I)=0.0020/(EIN(31)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(31)))-BETA2)*BBCONST*EN/(EN+EIN(31)+E(3)) IF(QIN(31,I).LT.0.0) QIN(31,I)=0.0 IF(EN.LE.(2.0*EIN(31))) GO TO 386 PEQIN(31,I)=PEQEL(2,(I-IOFFN(31))) C 4S4 J=1 F=0.0005 386 IF(EN.LE.EIN(32)) GO TO 413 QIN(32,I)=0.0005/(EIN(32)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(32)))-BETA2)*BBCONST*EN/(EN+EIN(32)+E(3)) IF(QIN(32,I).LT.0.0) QIN(32,I)=0.0 IF(EN.LE.(2.0*EIN(32))) GO TO 387 PEQIN(32,I)=PEQEL(2,(I-IOFFN(32))) C 3S1! J=1 F=0.1910 387 IF(EN.LE.EIN(33)) GO TO 413 QIN(33,I)=0.1910/(EIN(33)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(33)))-BETA2)*BBCONST*EN/(EN+EIN(33)+E(3)) IF(QIN(33,I).LT.0.0) QIN(33,I)=0.0 IF(EN.LE.(2.0*EIN(33))) GO TO 388 PEQIN(33,I)=PEQEL(2,(I-IOFFN(33))) C 6D5 J=1 F=0.0088 388 IF(EN.LE.EIN(34)) GO TO 413 QIN(34,I)=0.0088/(EIN(34)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(34)))-BETA2)*BBCONST*EN/(EN+EIN(34)+E(3)) IF(QIN(34,I).LT.0.0) QIN(34,I)=0.0 IF(EN.LE.(2.0*EIN(34))) GO TO 389 PEQIN(34,I)=PEQEL(2,(I-IOFFN(34))) C 6D2 J=1 F=0.0967 389 IF(EN.LE.EIN(35)) GO TO 413 QIN(35,I)=0.0967/(EIN(35)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(35)))-BETA2)*BBCONST*EN/(EN+EIN(35)+E(3)) IF(QIN(35,I).LT.0.0) QIN(35,I)=0.0 IF(EN.LE.(2.0*EIN(35))) GO TO 390 PEQIN(35,I)=PEQEL(2,(I-IOFFN(35))) C 5S4 J=1 F=0.0288 390 IF(EN.LE.EIN(36)) GO TO 413 QIN(36,I)=0.0288/(EIN(36)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(36)))-BETA2)*BBCONST*EN/(EN+EIN(36)+E(3)) IF(QIN(36,I).LT.0.0) QIN(36,I)=0.0 IF(EN.LE.(2.0*EIN(36))) GO TO 391 PEQIN(36,I)=PEQEL(2,(I-IOFFN(36))) C 7D5 J=1 F=0.0042 391 IF(EN.LE.EIN(37)) GO TO 413 QIN(37,I)=0.0042/(EIN(37)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(37)))-BETA2)*BBCONST*EN/(EN+EIN(37)+E(3)) IF(QIN(37,I).LT.0.0) QIN(37,I)=0.0 IF(EN.LE.(2.0*EIN(37))) GO TO 392 PEQIN(37,I)=PEQEL(2,(I-IOFFN(37))) C 7D2 J=1 F=0.0625 392 IF(EN.LE.EIN(38)) GO TO 413 QIN(38,I)=0.0625/(EIN(38)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(38)))-BETA2)*BBCONST*EN/(EN+EIN(38)+E(3)) IF(QIN(38,I).LT.0.0) QIN(38,I)=0.0 IF(EN.LE.(2.0*EIN(38))) GO TO 393 PEQIN(38,I)=PEQEL(2,(I-IOFFN(38))) C 6S4 J=1 F=0.0025 393 IF(EN.LE.EIN(39)) GO TO 413 QIN(39,I)=0.0025/(EIN(39)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(39)))-BETA2)*BBCONST*EN/(EN+EIN(39)+E(3)) IF(QIN(39,I).LT.0.0) QIN(39,I)=0.0 IF(EN.LE.(2.0*EIN(39))) GO TO 394 PEQIN(39,I)=PEQEL(2,(I-IOFFN(39))) C 2S2 J=1 F=0.0290 394 IF(EN.LE.EIN(40)) GO TO 413 QIN(40,I)=0.0290/(EIN(40)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(40)))-BETA2)*BBCONST*EN/(EN+EIN(40)+E(3)) IF(QIN(40,I).LT.0.0) QIN(40,I)=0.0 IF(EN.LE.(2.0*EIN(40))) GO TO 395 PEQIN(40,I)=PEQEL(2,(I-IOFFN(40))) C 8D5 J=1 F=0.0035 395 IF(EN.LE.EIN(41)) GO TO 413 QIN(41,I)=0.0035/(EIN(41)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(41)))-BETA2)*BBCONST*EN/(EN+EIN(41)+E(3)) IF(QIN(41,I).LT.0.0) QIN(41,I)=0.0 IF(EN.LE.(2.0*EIN(41))) GO TO 396 PEQIN(41,I)=PEQEL(2,(I-IOFFN(41))) C 8D2 J=1 F=0.0386 396 IF(EN.LE.EIN(42)) GO TO 413 QIN(42,I)=0.0386/(EIN(42)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(42)))-BETA2)*BBCONST*EN/(EN+EIN(42)+E(3)) IF(QIN(42,I).LT.0.0) QIN(42,I)=0.0 IF(EN.LE.(2.0*EIN(42))) GO TO 397 PEQIN(42,I)=PEQEL(2,(I-IOFFN(42))) C 7S4 J=1 F=0.0050 397 IF(EN.LE.EIN(43)) GO TO 413 QIN(43,I)=0.0050/(EIN(43)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(43)))-BETA2)*BBCONST*EN/(EN+EIN(43)+E(3)) IF(QIN(43,I).LT.0.0) QIN(43,I)=0.0 IF(EN.LE.(2.0*EIN(43))) GO TO 398 PEQIN(43,I)=PEQEL(2,(I-IOFFN(43))) C 9D5 J=1 F=0.0005 398 IF(EN.LE.EIN(44)) GO TO 413 QIN(44,I)=0.0005/(EIN(44)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(44)))-BETA2)*BBCONST*EN/(EN+EIN(44)+E(3)) IF(QIN(44,I).LT.0.0) QIN(44,I)=0.0 IF(EN.LE.(2.0*EIN(44))) GO TO 399 PEQIN(44,I)=PEQEL(2,(I-IOFFN(44))) C 9D2 J=1 F=0.0250 399 IF(EN.LE.EIN(45)) GO TO 413 QIN(45,I)=0.0250/(EIN(45)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(45)))-BETA2)*BBCONST*EN/(EN+EIN(45)+E(3)) IF(QIN(45,I).LT.0.0) QIN(45,I)=0.0 IF(EN.LE.(2.0*EIN(45))) GO TO 400 PEQIN(45,I)=PEQEL(2,(I-IOFFN(45))) C 8S4 J=1 F=0.0023 400 IF(EN.LE.EIN(46)) GO TO 413 QIN(46,I)=0.0023/(EIN(46)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(46)))-BETA2)*BBCONST*EN/(EN+EIN(46)+E(3)) IF(QIN(46,I).LT.0.0) QIN(46,I)=0.0 IF(EN.LE.(2.0*EIN(46))) GO TO 401 PEQIN(46,I)=PEQEL(2,(I-IOFFN(46))) C 10D5 J=1 F=0.0005 401 IF(EN.LE.EIN(47)) GO TO 413 QIN(47,I)=0.0005/(EIN(47)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(47)))-BETA2)*BBCONST*EN/(EN+EIN(47)+E(3)) IF(QIN(47,I).LT.0.0) QIN(47,I)=0.0 IF(EN.LE.(2.0*EIN(47))) GO TO 402 PEQIN(47,I)=PEQEL(2,(I-IOFFN(47))) C 10D2 J=1 F=0.0164 402 IF(EN.LE.EIN(48)) GO TO 413 QIN(48,I)=0.0164/(EIN(48)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(48)))-BETA2)*BBCONST*EN/(EN+EIN(48)+E(3)) IF(QIN(48,I).LT.0.0) QIN(48,I)=0.0 IF(EN.LE.(2.0*EIN(48))) GO TO 403 PEQIN(48,I)=PEQEL(2,(I-IOFFN(48))) C 9S4 J=1 F=0.0014 403 IF(EN.LE.EIN(49)) GO TO 413 QIN(49,I)=0.0014/(EIN(49)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(49)))-BETA2)*BBCONST*EN/(EN+EIN(49)+E(3)) IF(QIN(49,I).LT.0.0) QIN(49,I)=0.0 IF(EN.LE.(2.0*EIN(49))) GO TO 404 PEQIN(49,I)=PEQEL(2,(I-IOFFN(49))) C HIGH J=1 F=0.0831 404 IF(EN.LE.EIN(50)) GO TO 413 QIN(50,I)=0.0831/(EIN(50)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(50)))-BETA2)*BBCONST*EN/(EN+EIN(50)+E(3)) IF(QIN(50,I).LT.0.0) QIN(50,I)=0.0 IF(EN.LE.(2.0*EIN(50))) GO TO 405 PEQIN(50,I)=PEQEL(2,(I-IOFFN(50))) 405 CONTINUE C C CALCULATE TOTAL X-SECTION 413 QEXC=0.0 DO 414 NLEV=1,NIN 414 QEXC=QEXC+QIN(NLEV,I) Q(1,I)=QELA+Q(5,I)+QEXC C C WRITE(6,997) EN,Q(1,I),QEXC,Q(5,I),QELA C 997 FORMAT(' EN =',D12.4,' QTOT =',D12.3,' QEXC =',D12.3,' QION =',D12 C /.3,' QELA = ',D12.3) C 900 CONTINUE C SAVE COMPUTE TIME DO 910 K=1,NIN IF(EFINAL.LE.EIN(K)) THEN NIN=K-1 GO TO 911 ENDIF 910 CONTINUE 911 CONTINUE RETURN END SUBROUTINE GAS8(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(115),YELM(115),YELT(115),YEPS(115),XATT(6),YATT(6), /XVBV4(27),YVBV4(27),XVBV2(34),YVBV2(34),XVBV1(35),YVBV1(35), /XVBV3(26),YVBV3(26),XVBH1(21),YVBH1(21),XVBH2(21),YVBH2(21), /XION(70),YION(70),YINC(70),XDET(9),YDET(9),XDIS1(19),YDIS1(19), /XDIS2(32),YDIS2(32),XDIS3(31),YDIS3(31),XDIS4(29),YDIS4(29), iXDIS5(16),YDIS5(16), /XCHD(42),YCHD(42),XCHB(43),YCHB(43),XHAL(42),YHAL(42), /XHBE(42),YHBE(42) 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.,1500.,2000.,3000.,4000., /5000.,6000.,7000.,8000.,9000.,1.D4,1.25D4,1.5D4,1.75D4,2.0D4, /2.5D4,3.0D4,3.5D4,4.0D4,4.5D4,5.0D4,6.0D4,7.0D4,8.0D4,9.0D4, /1.0D5,1.25D5,1.5D5,1.75D5,2.0D5,2.5D5,3.0D5,3.5D5,4.0D5,4.5D5, /5.0D5,6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.25D6,1.5D6,1.75D6,2.0D6, /2.5D6,3.0D6,4.0D6,7.0D6,1.0D7/ C ELASTIC MOMENTUM TRANSFER X-SECTION DATA YELM/26.7,25.4,22.6,18.8,16.5,14.8,13.9,13.0,12.0,11.0, /9.75,8.60,7.75,7.10,6.10,5.27,4.60,3.85,3.18,2.55, /1.74,1.19,0.70,.440,.300,.300,.345,.400,.470,.550, /.650,.850,1.08,1.30,1.75,2.25,2.70,3.50,4.35,6.00, /7.70,9.70,11.7,15.0,17.0,18.7,19.2,19.2,18.4,16.1, /12.6,8.70,5.15,3.60,2.70,2.15,1.50,1.10,0.62,0.42, /.235,0.16,.115,0.09,0.06,.045,.0223,.0134,.00654,.0039, /.00261,.00188,.00142,.00112,9.01D-4,7.44D-4,4.96D-4,3.56D-4, /2.69D-4,2.11D-4, /1.41D-4,1.01D-4,7.67D-5,6.03D-5,4.88D-5,4.04D-5,2.92D-5,2.22D-5, /1.76D-5,1.43D-5, /1.19D-5,8.09D-6,5.93D-6,4.57D-6,3.66D-6,2.54D-6,1.89D-6,1.48D-6, /1.20D-6,9.96D-7, /8.45D-7,6.38D-7,5.04D-7,4.11D-7,3.43D-7,2.92D-7,2.09D-7,1.58D-7, /1.24D-7,1.00D-7, /7.01D-8,5.21D-8,3.24D-8,1.24D-8,6.64D-9/ C ELASTIC TOTAL X-SECTION DATA YELT/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.70,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.10,6.90, /8.81,11.0,13.3,17.6,21.2,23.5,24.3,24.4,23.8,22.2, /19.6,15.6,10.7,8.10,6.60,5.60,4.15,3.40,2.20,1.80, /1.20,0.90,0.75,0.62,0.48,0.40,0.29,.235,0.17,.135, /0.11,.095,.085,.078,.070,.064,.054,.046,.040,.037, /.0315,.0266,.0231,.0205,.0185,.0169,.0144,.0127,.0117,.0104, /.00957,.00812,.00715,.00647,.00595,.00524,.00477,.00444,.00420, /.00401, /.00387,.00365,.00350,.00340,.00331,.00325,.00314,.00308,.00303, /.00300, /.00296,.00294,.00292,.00289,.00289/ C EPSILON FOR ELASTIC ANGULAR DISTRIBUTION DATA YEPS/0.00,.0117,.0450,.0828,.1170,.1457,.1541,.1812,.1942, /.2188, /.2365,.2785,.2926,.2966,.2909,.2917,.2847,.3149,.3548,.4467, /.5331,.6282,.7417,.8087,.8425,.8018,.7143,.6116,.4821,.3600, /.2312,.1571,.0273,-.0234,-.0262,0.000,.1493,.1862,.2185,.1942, /.1876,.1762,.1793,.2194,.2920,.3007,.3087,.3133,.3326,.3986, /.5064,.6091,.6926,.7297,.7634,.7861,.8056,.8365,.8678,.9006, /.9232,.9333,.9460,.9501,.9595,.9650,.9791,.9859,.9915,.9941, /.99535,.99628,.99697,.99748,.99779,.99804,.99852,.99880,.99898, /.999159, /.999366,.999477,.999552,.999610,.999656,.999693,.999746,.999785, /.999819,.999837, /.9998542,.9998865,.9999077,.9999229,.9999340,.9999494,.9999596, /.9999667,.9999719,.9999759, /.9999791,.9999837,.9999868,.9999891,.9999908,.9999921,.9999943, /.9999957,.9999967,.9999973, /.9999982,.9999986,.9999992,.9999997,.9999998/ / C V4 DIPOLE PART AS ANALYTIC FUNCTION DATA XVBV4/.1625135,0.20,0.30,0.40,0.50,0.60,0.80,1.00,1.50,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.,1.0D5,1.0D6,1.0D7/ DATA YVBV4/0.00,.0001,.060,.057,.055,.050,.040,.035,.041,.056, /.082,.278,.406,0.47,0.44,.383,.323,.266,.201,.126, /.051,.027,.0002,1.D-5,1.D-6,1.D-7,1.D-8/ C V2 DATA XVBV2/.1901087,.195,0.20,0.21,0.22,0.23,0.24,0.26,0.28,0.30, /0.40,0.50,0.60,0.80,1.00,1.50,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.,1.0D5,1.0D6,1.0D7/ DATA YVBV2/0.00,.028,.038,.051,.060,.066,.071,.075,.076,.077, /.080,.081,.082,.082,.083,.084,.086,.118,.308,.446, /0.49,0.46,.403,.333,.217,.171,.102,.040,.022,.0002, /1.D-5,1.D-6,1.D-7,1.D-8/ C V1 DATA XVBV1/.3615974,.363,.365,.367,0.37,.375,0.38,0.39,0.40,0.42, /0.45,0.50,0.60,0.70,0.80,1.00,1.50,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.,1.0D5,1.0D6,1.0D7/ DATA YVBV1/.0,.0028,.0043,.0054,.0066,.0083,.0095,.0115,.013,.015, /.017,.019,0.02,0.02,.021,.022,.023,.025,.042,.157, /.226,.260,.260,.215,.190,.151,.120,.085,.029,.012, /.0001,1.D-5,1.D-6,1.D-7,1.D-8/ C V3 DIPOLE PART AS ANALYTIC FUNCTION DATA XVBV3/.3743690,0.40,0.50,0.60,0.70,0.80,1.00,1.50,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.,1.0D5,1.0D6,1.0D7/ DATA YVBV3/.0,.004,0.01,.011,.011,.011,.011,.015,.019,.105, /.508,.696,.780,.730,.633,.453,.217,.132,.053,.024, /.009,.0001,1.D-5,1.D-6,1.D-7,1.D-8/ C VIBRATION HARMONIC DATA XVBH1/.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.,1.0D5,1.0D6, /1.0D7/ DATA YVBH1/0.00,.0007,.0028,.014,.053,.068,.075,.075,.061,.044, /.031,.021,.015,.011,.005,.0017,.0001,.00001,1.D-6,1.D-7, /1.D-8/ C VIBRATION HARMONIC DATA XVBH2/.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.,1.0D5,1.0D6, /1.0D7/ DATA YVBH2/0.00,.0005,.0022,.0135,.044,.058,.064,.064,.053,.039, /.024,.014,.010,.006,.004,.0017,.0001,.00001,1.D-6,1.D-7, /1.D-8/ C IONISATION X-SECTION ABOVE 1KEV GIVEN BY BORN-BETHE DATA XION/12.65,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./ C GROSS IONISATION (RAP AND ENGLANDER AND LINDSAY AND STEBBINGS) DATA YION/0.00,.035,.075,.132,.201,.282,.366,.451,.538,.625, /.715,.803,.892,.990,1.26,1.36,1.44,1.52,1.60,1.68, /1.75,2.00,2.23,2.41,2.58,2.72,2.83,2.95,3.06,3.25, /3.41,3.52,3.61,3.66,3.71,3.73,3.74,3.75,3.74,3.73, /3.71,3.68,3.66,3.63,3.60,3.57,3.53,3.50,3.46,3.42, /3.36,3.27,3.12,3.00,2.69,2.40,2.22,2.04,1.88,1.74, /1.64,1.53,1.44,1.36,1.30,1.25,1.19,1.15,1.10,1.053/ C COUNTING IONISATION DATA YINC/0.00,.035,.075,.132,.201,.282,.366,.451,.538,.625, /.715,.803,.892,.990,1.26,1.36,1.44,1.52,1.60,1.68, /1.75,2.00,2.22,2.40,2.57,2.71,2.82,2.93,3.04,3.23, /3.38,3.49,3.57,3.62,3.67,3.69,3.70,3.71,3.70,3.69, /3.67,3.64,3.62,3.59,3.56,3.53,3.49,3.46,3.43,3.39, /3.33,3.24,3.09,2.97,2.66,2.38,2.20,2.02,1.86,1.72, /1.62,1.52,1.43,1.35,1.29,1.24,1.18,1.14,1.09,1.042/ C ATTACHMENT - DEATTACHMENT VIA H- 9.8 EV RESONANCE (RAWAT ET AL) DATA XDET/7.80,8.00,9.00,9.80,10.0,11.0,12.0,13.0,14.0/ DATA YDET/0.00,.0049,.0134,.0153,.0150,.0113,.0038,.0095,0.00/ C ATTACHMENT VIA CH2- ONLY (RAWAT ET AL) DATA XATT/9.00,10.0,10.4,11.0,12.0,13.0/ DATA YATT/0.00,0.00092,.00112,.00089,.00027,0.00/ C DISSOCIATION ( HAYASHI ADJUSTED TO GIVE WINTERS TOTAL DISSOCIATION) DATA XDIS1/8.55,9.00,10.0,11.0,12.0,13.0,13.5,14.0,15.0,16.0, /17.0,18.0,19.0,20.0,22.0,25.0,30.0,35.0,40.0/ DATA YDIS1/0.00,0.15,.225,.288,.300,.285,.263,.238,.180,.130, /.091,.063,.042,.0308,.017,.0063,.00175,.00068,0.00/ DATA XDIS2/9.00,10.0,11.0,12.0,13.0,14.0,16.0,18.0,20.0,22.0, /25.0,30.0,35.0,40.0,50.0,60.0,80.0,100.,150.,200., /300.,400.,500.,700.,1000.,1500.,2000.,3000.,4000.,6000., /8000.,10000./ DATA YDIS2/0.00,.042,.084,.126,.168,.196,.259,.308,.339,.364, /.378,.382,.384,.386,.397,.419,.427,.419,.355,.324, /.282,.233,.195,.140,.0988,.0691,.0529,.0388,.0282,.0205, /.0155,.0127/ DATA XDIS3/10.5,11.0,12.0,13.0,14.0,16.0,18.0,20.0,22.0,25.0, /30.0,35.0,40.0,50.0,60.0,80.0,100.,150.,200.,300., /400.,500.,700.,1000.,1500.,2000.,3000.,4000.,6000.,8000., /10000./ DATA YDIS3/0.00,.035,.140,.231,.315,.476,.574,.619,.644,.658, /.633,.602,.608,.625,.643,.625,.608,.530,.483,.406, /.342,.284,.204,.141,.0987,.0756,.0554,.0403,.0292,.0222, /.0181/ DATA XDIS4/12.0,13.0,14.0,16.0,18.0,20.0,22.0,25.0,30.0,35.0, /40.0,50.0,60.0,80.0,100.,150.,200.,300.,400.,500., /700.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000./ DATA YDIS4/0.00,.140,.280,.525,.700,.800,.854,.889,.941,.964, /.993,1.07,1.13,1.22,1.26,1.15,1.07,.912,.746,.641, /.455,.320,.224,.172,.126,.0915,.0663,.0503,.0412/ DATA XDIS5/13.3,14.0,16.0,18.0,20.0,22.0,25.0,30.0,35.0,40.0, /50.0,60.0,80.0,100.,150.,200./ DATA YDIS5/0.00,.0315,.252,.462,.620,.714,.790,.842,.828,.772, /.639,.503,.275,.090,.064,0.00/ C LIGHT EMISSION FROM CH(A2DELTA TO X2PI) DATA XCHD/13.4,13.5,14.5,18.5,20.6,21.6,22.5,23.6,27.7,31.8, /33.5,33.9,35.4,37.5,39.2,40.0,44.0,49.1,55.6,58.3, /60.1,63.2,67.0,71.3,76.3,80.3,100.,150.,200.,400., /700.,1000.,1500.,2000.,2500.,3000.,3500.,4000.,1.D4,1.D5, /1.D6,1.D7/ DATA YCHD/0.00,.0041,.0065,.0116,.0169,.0205,.0232,.0261,.0299, /.0327, /.0339,.0355,.0363,.0392,.0411,.0441,.0462,.0469,.0476,.0479, /.0481,.0485,.0489,.0491,.0487,.0477,.0403,.0292,.0232,.0131, /.0082,.0060,.0043,.0033,.0027,.0023,.00205,.00181,.0008,.00015, /.000017,.000002/ C LIGHT EMISSION FROM CH(B2SIGMA- TO X2PI) DATA XCHB/13.7,13.8,14.8,18.8,20.9,21.9,22.8,23.9,28.0,32.1, /33.8,34.2,35.7,37.8,39.5,42.1,43.4,44.3,49.4,56.0, /58.6,60.4,63.5,67.3,71.6,76.6,80.6,100.,150.,200., /400.,700.,1000.,1500.,2000.,2500.,3000.,3500.,4000.,1.D4, /1.D5,1.D6,1.D7/ DATA YCHB/0.00,2.44D-4,3.91D-4,6.96D-4,.00102,.00123,.0014,.00157, /.0018,.00197, /.00204,.00214,.00219,.00236,.00248,.00259,.00265,.00278,.00283, /.00286, /.00289,.00290,.00292,.00295,.00296,.00293,.00287,.00242,.00176, /.00139, /7.88D-4,4.93D-4,3.63D-4,2.57D-4,2.00D-4,1.65D-4,1.40D-4,1.23D-4, /1.09D-4,5.D-5, /8.D-6,1.D-6,1.5D-7/ C LIGHT EMISSION FROM H(ALPHA) DATA XHAL/16.14,16.3,16.6,16.9,17.2,18.1,19.2,20.0,20.8,22.6, /25.2,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,144., /185.,200.,224.,245.,284.,364.,453.,500.,600.,700., /800.,1000.,1500.,2000.,2500.,3000.,3500.,4000.,1.D4,1.D5, /1.D6,1.D7/ DATA YHAL/0.00,2.54D-4,3.80D-4,5.05D-4,6.60D-4,.00101,.00142, /.00175,.00209,.00288, /.00431,.00686,.01225,.0156,.0181,.0195,.0204,.0203,.0200,.0181, /.0148,.0134,.0127,.0119,.0103,.00789,.00598,.00529,.00425,.00357, /.00309,.00227,.0016,.00125,.00103,8.75D-4,7.7D-4,6.82D-4,3.D-4, /3.8D-5,4.8D-6,6.D-7/ C LIGHT EMISSION FROM H(BETA) DATA XHBE/16.8,18.0,21.9,23.4,24.5,25.5,26.4,28.2,30.0,33.7, /37.2,40.0,50.0,57.7,80.0,100.,141.,169.,200.,226., /247.,284.,340.,363.,398.,455.,500.,550.,654.,700., /800.,999.,1500.,2000.,2500.,3000.,3500.,4000.,1.D4,1.D5, /1.D6,1.D7/ DATA YHBE/0.00,1.53D-4,5.44D-4,7.19D-4,8.85D-4,.00114,.00128, /.00159,.00194,.00228, /.00269,.00316,.00374,.00419,.00481,.00463,.00419,.00374,.00314, /.00288, /.00269,.00227,.00194,.00179,.00160,.00140,.00128,.00114,9.5D-4, /8.85D-4, /7.19D-4,5.45D-4,3.84D-4,3.00D-4,2.47D-4,2.10D-4,1.84D-4,1.63D-4, /7.5D-5,1.05D-5,1.5D-6,2.2D-7/ C----------------------------------------------------------------------- C 2007: UPDATE OF 2004 DATABASE C NOW SPLIT V24 AND V13 VIBRATIONS INTO V1 V2 V3 AND V4 X-SECTIONS C SHAPE OF VIBRATIONS GIVEN BY SHAPE FUNCTIONS FROM THEORETICAL C PREDICTIONS BY GIANTURCO ET AL. C VIBRATION ANGULAR DISTRIBUTIONS MODELLED BY MODIFIED CAPITELLI/LONGO C ELASTIC ANGULAR DISTRIBUTIONS CAN BE EITHER ISOTROPIC OR MODELLED C BY OKHRIMOVSKYY ET AL ALGORITHM C IONISATION AND DISSOCIATION ANGULAR DISTRIBUTIONS GIVEN BY ELASTIC C ANGULAR DISTRIBUTION WITH ENERGY OFFSET GIVEN BY THRESHOLD ENERGY. C DATABASE EXTENDED TO MIP REGION. C NOW INCLUDES LIGHT EMISSION X-SECTIONS FROM C SASIC ,PETROVIC ET AL NEW JOURNAL OF PHYSICS 6(2004)74 C---------------------------------------------------------------------- C ATTACHMENT CROSS-SECTION OF RAWAT ET AL : JOURNAL OF PHYSICS: C CONFERENCE SERIES 80(2007)012018 NOW USED INSTEAD OF SHARP AND DOWELL C DE-ATTACHMENT FOR PART OF ATTACHMENT TO H- ION ASSUMED DUE TO C HIGH COLLISIONAL ENERGY FORMATION. C --------------------------------------------------------------------- C FIT TO METHANE DRIFT VELOCITY OF HADDAD AND SCHMIDT AT LOW FIELD C AND HUNTER AND KLINE AT HIGH FIELD. C CALCULATED DRIFT VELOCITY IS WITHIN 1% AT ALL FIELDS UP TO 600 TD C TRANSVERSE DIFFUSION WITHIN 3% AT ALL FIELDS C LONGITUDINAL DIFFUSION WITHIN 3% AT ALL FIELDS C REPRODUCES DRIFT VELOCITY AND LORENTZ ANGLES IN ARGON METHANE MIXTURES C LORENTZ ANGLE ACCURACY LESS THAN 1 DEGREE IN ARGON MIXTURES C DRIFT VELOCITY BETTER THAN 0.75% IN ARGON MIXTURES. C ALL ENERGY DEPENDENT FANO FACTORS WITHIN EXPERIMENTAL ERRORS OF 5% C----------------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME=' CH4 2008 ISOT ' ELSE NAME=' CH4 2008 ANISO' ENDIF C----------------------------------------------------------------------- C BORN BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 AM2=3.75 C=42.5 C BORN BETHE FOR EXCITATION AM2EXC=1.40 CEXC=19.0 C NIN=18 DO 1 J=1,6 1 KEL(J)=NANISO C SUPERELASTIC AND HARMONIC VIBRATIONS ASSUMED ISOTROPIC KIN(1)=0 KIN(3)=0 KIN(7)=0 KIN(8)=0 C ATTACHMENT DE-ATTACHMENT ASSUMED ISOTROPIC KIN(9)=0 C V4,V2,V1 AND V3 VIBRATIONS ANISOTROPIC ( CAPITELLI-LONGO) KIN(2)=1 KIN(4)=1 KIN(5)=1 KIN(6)=1 C ANGULAR DISTRIBUTION FOR DISSOCIATIVE EXCITATION CAN BE EITHER C CAPITELLI LONGO OR OKHRIMOVSKYY TYPE DO 2 J=10,NIN 2 KIN(J)=NANISO C C RAT IS MOMENTUM TRANSFER TO TOTAL RATIO FOR VIBRATIONS IN THE C RESONANCE REGION AND ALSO FOR THE VIBRATIONS V1 AND V2 . C USED DIPOLE ANGULAR DISTRIBUTION FOR V3 AND V4 NEAR THRESHOLD. RAT=0.8 C NDATA=115 NVIBV4=27 NVIBV2=34 NVIBV1=35 NVIBV3=26 NVIBH1=21 NVIBH2=21 NION=70 NATT=6 NDET=9 NDIS1=19 NDIS2=32 NDIS3=31 NDIS4=29 NDIS5=16 NCHD=42 NCHB=43 NHAL=42 NHBE=42 C VIBRATIONAL DEGENERACY DEGV4=3.0 DEGV2=2.0 DEGV1=1.0 DEGV3=3.0 C E(1)=0.0 E(2)=2.0*EMASS/(16.0426*AMU) E(3)=12.65 C EXCITATION X-SECTION AT 1.2 MEV E(4)=0.0043D-16 C IONISING X-SECTION AT 1.2 MEV E(5)=0.00982D-16 C EOBY AT 1.5 MEV E(6)=8.0 C OPAL AND BEATY IONISATION ENERGY SPLITTING (LOW ENERGY) EOBY=7.3 C OFFSET ENERGY FOR IONISATION ELECTRON ANGULAR DISTRIBUTION IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) EIN(1)=-0.1625135 EIN(2)=0.1625135 EIN(3)=-0.1901087 EIN(4)=0.1901087 EIN(5)=0.3615974 EIN(6)=0.3743690 EIN(7)=0.544 EIN(8)=0.736 EIN(9)=7.80 EIN(10)=8.55 EIN(11)=9.00 EIN(12)=10.5 EIN(13)=12.0 EIN(14)=13.3 EIN(15)=13.4 EIN(16)=13.7 EIN(17)=16.14 EIN(18)=16.8 C OFFSET ENERGY FOR EXCITATION LEVELS ANGULAR DISTRIBUTION IOFF10=IFIX(SNGL(0.5+EIN(10)/ESTEP)) IOFF11=IFIX(SNGL(0.5+EIN(11)/ESTEP)) IOFF12=IFIX(SNGL(0.5+EIN(12)/ESTEP)) IOFF13=IFIX(SNGL(0.5+EIN(13)/ESTEP)) IOFF14=IFIX(SNGL(0.5+EIN(14)/ESTEP)) IOFF15=IFIX(SNGL(0.5+EIN(15)/ESTEP)) IOFF16=IFIX(SNGL(0.5+EIN(16)/ESTEP)) IOFF17=IFIX(SNGL(0.5+EIN(17)/ESTEP)) IOFF18=IFIX(SNGL(0.5+EIN(18)/ESTEP)) C*********************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C FIRST 9 LEVELS DO NOT HAVE ENOUGH ENERGY TO GIVE PENNING C HIGHEST LEVELS 15,16,17 AND 18 REPRESENT LIGHT EMISSION FRAGMENTS C AND SO DO NOT COUNT IN THE PENNING FRACTIONS DO 7 K=1,18 DO 7 L=1,3 7 PENFRA(L,K)=0.0 C PENNING TRANSFER FRACTION FOR LEVELS 10,11,12 13 AND 14 PENFRA(1,10)=0.0 PENFRA(1,11)=0.0 PENFRA(1,12)=0.0 PENFRA(1,13)=0.0 PENFRA(1,14)=0.0 C PENNING TRANSFER DISTANCE IN MICRONS PENFRA(2,10)=1.0 PENFRA(2,11)=1.0 PENFRA(2,12)=1.0 PENFRA(2,13)=1.0 PENFRA(2,14)=1.0 C PENNING TRANSFER TIME IN PICOSECONDS PENFRA(3,10)=1.0 PENFRA(3,11)=1.0 PENFRA(3,12)=1.0 PENFRA(3,13)=1.0 PENFRA(3,14)=1.0 IF(IPEN.EQ.0) GO TO 9 DO 8 KDUM=10,14 IF(PENFRA(1,KDUM).EQ.0.0) GO TO 8 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 8 CONTINUE C*********************************************************************** C 9 SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC METHANE ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC ISOTROPIC METHANE ' ENDIF SCRPT(3)=' IONISATION ELOSS= 12.65 ' SCRPT(4)=' ATTACHMENT (CH2- ONLY) ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' VIB V4 ELOSS=-0.162513' SCRPT(8)=' VIB V4 ELOSS= 0.162513' SCRPT(9)=' VIB V2 ELOSS=-0.190109' SCRPT(10)=' VIB V2 ELOSS= 0.190109' SCRPT(11)=' VIB V1 ELOSS= 0.361597' SCRPT(12)=' VIB V3 ELOSS= 0.374369' SCRPT(13)=' VIB HAR ELOSS= 0.544 ' SCRPT(14)=' VIB HAR ELOSS= 0.736 ' SCRPT(15)=' ATT - DEATT ELOSS= 7.8 ' SCRPT(16)=' EXC DISSOCIATN ELOSS= 8.55 ' SCRPT(17)=' EXC DISSOCIATN ELOSS= 9.0 ' SCRPT(18)=' EXC DISSOCIATN ELOSS= 10.5 ' SCRPT(19)=' EXC DISSOCIATN ELOSS= 12.0 ' SCRPT(20)=' EXC DISSOCIATN ELOSS= 13.3 ' SCRPT(21)=' A2D TO G.S. ELOSS= 13.4 ' SCRPT(22)=' B2PI TO G.S. ELOSS= 13.7 ' SCRPT(23)=' H(ALPHA) ELOSS= 16.14 ' SCRPT(24)=' H(BETA) ELOSS= 16.8 ' C CALC LEVEL POPULATIONS APOPV4=DEGV4*DEXP(EIN(1)/AKT) APOPV2=DEGV2*DEXP(EIN(3)/AKT) APOPGS=1.0 APOPSUM=APOPGS+APOPV4+APOPV2 APOPGS=1.0/APOPSUM APOPV4=APOPV4/APOPSUM APOPV2=APOPV2/APOPSUM C RENORMALISE GROUND STATE TO ALLOW FOR INCREASED EXCITATION X-SEC C FROM EXCITED VIBRATIONAL STATE ( EXACT FOR TWICE GROUND STATE XSEC) APOPGS=1.0 C EN=-ESTEP/2.0 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 PQ2=0.0 GO TO 30 ENDIF DO 3 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 4 3 CONTINUE J=NDATA 4 YXJ=DLOG(YELT(J)) YXJ1=DLOG(YELT(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=DEXP(A*DLOG(EN)+B)*1.D-16 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 C USE 1.0 OFFSET IN LOG INTERPOLATION (TO AVOID NEGATIVES) YXJ=DLOG(YEPS(J)+1.0) YXJ1=DLOG(YEPS(J-1)+1.0) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) PQ2=DEXP(A*DLOG(EN)+B)-1.0 30 CONTINUE PQ1=0.5+(QELA-QMOM)/QELA IF(NANISO.EQ.0) PEQEL(2,I)=0.5 IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) Q(2,I)=QMOM C GROSS IONISATION Q(3,I)=0.0 PEQEL(3,I)=0.5 IF(NANISO.EQ.2) PEQEL(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 IF(EN.GT.XION(NION)) GO TO 123 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 GO TO 124 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 123 GAMMA=(EMASS2+2.0D0*EN)/EMASS2 BETA=DSQRT(1.0D0-1.0D0/(GAMMA*GAMMA)) BETA2=BETA*BETA X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2)/0.99 124 CONTINUE 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 C ATTACHMENT 200 Q(4,I)=0.0 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 C COUNTING IONISATION 250 Q(5,I)=0.0 PEQEL(5,I)=0.5 IF(NANISO.EQ.2) PEQEL(5,I)=0.0 IF(EN.LE.E(3)) GO TO 300 IF(EN.GT.XION(NION)) GO TO 280 DO 260 J=2,NION IF(EN.LE.XION(J)) GO TO 270 260 CONTINUE J=NION 270 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.D-16 GO TO 290 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 280 Q(5,I)=CONST*(AM2*X1+C*X2) 290 CONTINUE 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 295 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 295 CONTINUE C 300 Q(6,I)=0.0 C V4 SUPERELASTIC ISOTROPIC QIN(1,I)=0.0 PEQIN(1,I)=0.5 IF(EN.LE.0.0) GO TO 350 DO 310 J=2,NVIBV4 IF((EN+EIN(2)).LE.XVBV4(J)) GO TO 320 310 CONTINUE J=NVIBV4 320 A=(YVBV4(J)-YVBV4(J-1))/(XVBV4(J)-XVBV4(J-1)) B=(XVBV4(J-1)*YVBV4(J)-XVBV4(J)*YVBV4(J-1))/(XVBV4(J-1)-XVBV4(J)) EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.077*DLOG((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)*APOPV4*1.D-16 QIN(1,I)=QIN(1,I)/DEGV4 350 CONTINUE C V4 ANISOTROPIC QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 DO 360 J=2,NVIBV4 IF(EN.LE.XVBV4(J)) GO TO 370 360 CONTINUE J=NVIBV4 370 A=(YVBV4(J)-YVBV4(J-1))/(XVBV4(J)-XVBV4(J-1)) B=(XVBV4(J-1)*YVBV4(J)-XVBV4(J)*YVBV4(J-1))/(XVBV4(J-1)-XVBV4(J)) EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.077*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*(A*EN+B))*APOPGS*1.D-16 QIN(2,I)=((A*EN+B)+QIN(2,I))*APOPGS*1.D-16 PEQIN(2,I)=0.5+(QIN(2,I)-XMT)/QIN(2,I) C V2 SUPERELASTIC ISOTROPIC 400 QIN(3,I)=0.0 PEQIN(3,I)=0.5 IF(EN.LE.0.0) GO TO 450 DO 410 J=2,NVIBV2 IF((EN+EIN(4)).LE.XVBV2(J)) GO TO 420 410 CONTINUE J=NVIBV2 420 A=(YVBV2(J)-YVBV2(J-1))/(XVBV2(J)-XVBV2(J-1)) B=(XVBV2(J-1)*YVBV2(J)-XVBV2(J)*YVBV2(J-1))/(XVBV2(J-1)-XVBV2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOPV2*1.D-16 QIN(3,I)=QIN(3,I)/DEGV2 C V2 ANISOTROPIC 450 QIN(4,I)=0.0 PEQIN(4,I)=0.5 IF(EN.LE.EIN(4)) GO TO 500 DO 460 J=2,NVIBV2 IF(EN.LE.XVBV2(J)) GO TO 470 460 CONTINUE J=NVIBV2 470 A=(YVBV2(J)-YVBV2(J-1))/(XVBV2(J)-XVBV2(J-1)) B=(XVBV2(J-1)*YVBV2(J)-XVBV2(J)*YVBV2(J-1))/(XVBV2(J-1)-XVBV2(J)) QIN(4,I)=(A*EN+B)*APOPGS*1.D-16 PEQIN(4,I)=1.5-RAT C V1 ANISOTROPIC 500 QIN(5,I)=0.0 PEQIN(5,I)=0.5 IF(EN.LE.EIN(5)) GO TO 550 DO 510 J=2,NVIBV1 IF(EN.LE.XVBV1(J)) GO TO 520 510 CONTINUE J=NVIBV1 520 A=(YVBV1(J)-YVBV1(J-1))/(XVBV1(J)-XVBV1(J-1)) B=(XVBV1(J-1)*YVBV1(J)-XVBV1(J)*YVBV1(J-1))/(XVBV1(J-1)-XVBV1(J)) QIN(5,I)=(A*EN+B)*1.D-16 PEQIN(5,I)=1.5-RAT C V3 ANISOTROPIC 550 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 600 DO 560 J=2,NVIBV3 IF(EN.LE.XVBV3(J)) GO TO 570 560 CONTINUE J=NVIBV3 570 A=(YVBV3(J)-YVBV3(J-1))/(XVBV3(J)-XVBV3(J-1)) B=(XVBV3(J-1)*YVBV3(J)-XVBV3(J)*YVBV3(J-1))/(XVBV3(J-1)-XVBV3(J)) EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.076*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) 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(6,I)+RAT*(A*EN+B))*1.D-16 QIN(6,I)=((A*EN+B)+QIN(6,I))*1.D-16 PEQIN(6,I)=0.5+(QIN(6,I)-XMT)/QIN(6,I) C VIBRATION HARMONICS 1 (ISOTROPIC) 600 QIN(7,I)=0.0 PEQIN(7,I)=0.5 IF(EN.LE.EIN(7)) GO TO 650 DO 610 J=2,NVIBH1 IF(EN.LE.XVBH1(J)) GO TO 620 610 CONTINUE J=NVIBH1 620 A=(YVBH1(J)-YVBH1(J-1))/(XVBH1(J)-XVBH1(J-1)) B=(XVBH1(J-1)*YVBH1(J)-XVBH1(J)*YVBH1(J-1))/(XVBH1(J-1)-XVBH1(J)) QIN(7,I)=(A*EN+B)*1.D-16 C VIBRATION HARMONICS 2 (ISOTROPIC) 650 QIN(8,I)=0.0 PEQIN(8,I)=0.5 IF(EN.LE.EIN(8)) GO TO 700 DO 660 J=2,NVIBH2 IF(EN.LE.XVBH2(J)) GO TO 670 660 CONTINUE J=NVIBH2 670 A=(YVBH2(J)-YVBH2(J-1))/(XVBH2(J)-XVBH2(J-1)) B=(XVBH2(J-1)*YVBH2(J)-XVBH2(J)*YVBH2(J-1))/(XVBH2(J-1)-XVBH2(J)) QIN(8,I)=(A*EN+B)*1.D-16 C ATTACHMENT - DEATTACHMENT RESONANCE VIA H- AT 9.8EV RESONANCE 700 QIN(9,I)=0.0 PEQIN(9,I)=0.5 IF(EN.LE.EIN(9)) GO TO 800 IF(EN.GT.XDET(NDET)) GO TO 800 DO 710 J=2,NDET IF(EN.LE.XDET(J)) GO TO 720 710 CONTINUE J=NDET 720 A=(YDET(J)-YDET(J-1))/(XDET(J)-XDET(J-1)) B=(XDET(J-1)*YDET(J)-XDET(J)*YDET(J-1))/(XDET(J-1)-XDET(J)) QIN(9,I)=(A*EN+B)*1.D-16 C DISSOCIATIVE EXCITATION 800 QIN(10,I)=0.0 PEQIN(10,I)=0.5 IF(NANISO.EQ.2) PEQIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 850 IF(EN.GT.XDIS1(NDIS1)) 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(10,I)=(A*EN+B)*1.D-16 IF(EN.LE.(3.0*EIN(10))) GO TO 850 PEQIN(10,I)=PEQEL(2,(I-IOFF10)) 850 CONTINUE C DISSOCIATIVE EXCITATION QIN(11,I)=0.0 PEQIN(11,I)=0.5 IF(NANISO.EQ.2) PEQIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 900 IF(EN.GT.XDIS2(NDIS2)) GO TO 880 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(11,I)=(A*EN+B)*1.D-16 GO TO 890 C USE BORN-BETHE X-SECTION ABOVE XDIS2(NDIS2) EV 880 QIN(11,I)=CONST*(AM2EXC*X1+CEXC*X2)*0.176 890 IF(EN.LE.(3.0*EIN(11))) GO TO 900 PEQIN(11,I)=PEQEL(2,(I-IOFF11)) 900 CONTINUE C DISSOCIATIVE EXCITATION QIN(12,I)=0.0 PEQIN(12,I)=0.5 IF(NANISO.EQ.2) PEQIN(12,I)=0.0 IF(EN.LE.EIN(12)) GO TO 950 IF(EN.GT.XDIS3(NDIS3)) GO TO 930 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(12,I)=(A*EN+B)*1.D-16 GO TO 940 C USE BORN-BETHE X-SECTION ABOVE XDIS3(NDIS3) EV 930 QIN(12,I)=CONST*(AM2EXC*X1+CEXC*X2)*0.251 940 IF(EN.LE.(3.0*EIN(12))) GO TO 950 PEQIN(12,I)=PEQEL(2,(I-IOFF12)) 950 CONTINUE C DISSOCIATIVE EXCITATION QIN(13,I)=0.0 PEQIN(13,I)=0.5 IF(NANISO.EQ.2) PEQIN(13,I)=0.0 IF(EN.LE.EIN(13)) GO TO 990 IF(EN.GT.XDIS4(NDIS4)) GO TO 980 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(13,I)=(A*EN+B)*1.D-16 GO TO 985 C USE BORN-BETHE X-SECTION ABOVE XDIS4(NDIS4) 980 QIN(13,I)=CONST*(AM2EXC*X1+CEXC*X2)*0.573 985 IF(EN.LE.(3.0*EIN(13))) GO TO 990 PEQIN(13,I)=PEQEL(2,(I-IOFF13)) 990 CONTINUE C DISSOCIATIVE EXCITATION QIN(14,I)=0.0 PEQIN(14,I)=0.5 IF(NANISO.EQ.2) PEQIN(14,I)=0.0 IF(EN.LE.EIN(14)) GO TO 1050 IF(EN.GT.XDIS5(NDIS5)) GO TO 1050 DO 1010 J=2,NDIS5 IF(EN.LE.XDIS5(J)) GO TO 1020 1010 CONTINUE J=NDIS5 1020 A=(YDIS5(J)-YDIS5(J-1))/(XDIS5(J)-XDIS5(J-1)) B=(XDIS5(J-1)*YDIS5(J)-XDIS5(J)*YDIS5(J-1))/(XDIS5(J-1)-XDIS5(J)) QIN(14,I)=(A*EN+B)*1.D-16 IF(EN.LE.(3.0*EIN(14))) GO TO 1050 PEQIN(14,I)=PEQEL(2,(I-IOFF14)) 1050 CONTINUE C DISSOCIATIVE EXC TO STATES DECAYING VIA CH(A2DELTA TO G.S.) QIN(15,I)=0.0 PEQIN(15,I)=0.5 IF(NANISO.EQ.2) PEQIN(15,I)=0.0 IF(EN.LE.EIN(15)) GO TO 1100 IF(EN.GT.XCHD(NCHD)) GO TO 1100 DO 1060 J=2,NCHD IF(EN.LE.XCHD(J)) GO TO 1070 1060 CONTINUE J=NCHD 1070 A=(YCHD(J)-YCHD(J-1))/(XCHD(J)-XCHD(J-1)) B=(XCHD(J-1)*YCHD(J)-XCHD(J)*YCHD(J-1))/(XCHD(J-1)-XCHD(J)) QIN(15,I)=(A*EN+B)*1.D-16 IF(EN.LE.(3.0*EIN(15))) GO TO 1100 PEQIN(15,I)=PEQEL(2,(I-IOFF15)) 1100 CONTINUE C DISSOCIATIVE EXC TO STATES DECAYING VIA CH(B2SIGMA- TO G.S.) QIN(16,I)=0.0 PEQIN(16,I)=0.5 IF(NANISO.EQ.2) PEQIN(16,I)=0.0 IF(EN.LE.EIN(16)) GO TO 1150 IF(EN.GT.XCHB(NCHB)) GO TO 1150 DO 1110 J=2,NCHB IF(EN.LE.XCHB(J)) GO TO 1120 1110 CONTINUE J=NCHB 1120 A=(YCHB(J)-YCHB(J-1))/(XCHB(J)-XCHB(J-1)) B=(XCHB(J-1)*YCHB(J)-XCHB(J)*YCHB(J-1))/(XCHB(J-1)-XCHB(J)) QIN(16,I)=(A*EN+B)*1.D-16 IF(EN.LE.(3.0*EIN(16))) GO TO 1150 PEQIN(16,I)=PEQEL(2,(I-IOFF16)) 1150 CONTINUE C DISSOCIATIVE EXC TO STATES DECAYING VIA H(ALPHA) QIN(17,I)=0.0 PEQIN(17,I)=0.5 IF(NANISO.EQ.2) PEQIN(17,I)=0.0 IF(EN.LE.EIN(17)) GO TO 1200 IF(EN.GT.XHAL(NHAL)) GO TO 1200 DO 1160 J=2,NHAL IF(EN.LE.XHAL(J)) GO TO 1170 1160 CONTINUE J=NHAL 1170 A=(YHAL(J)-YHAL(J-1))/(XHAL(J)-XHAL(J-1)) B=(XHAL(J-1)*YHAL(J)-XHAL(J)*YHAL(J-1))/(XHAL(J-1)-XHAL(J)) QIN(17,I)=(A*EN+B)*1.D-16 IF(EN.LE.(3.0*EIN(17))) GO TO 1200 PEQIN(17,I)=PEQEL(2,(I-IOFF17)) 1200 CONTINUE C DISSOCIATIVE EXC TO STATES DECAYING VIA H(BETA) QIN(18,I)=0.0 PEQIN(18,I)=0.5 IF(NANISO.EQ.2) PEQIN(18,I)=0.0 IF(EN.LE.EIN(18)) GO TO 1250 IF(EN.GT.XHBE(NHBE)) GO TO 1250 DO 1210 J=2,NHBE IF(EN.LE.XHBE(J)) GO TO 1220 1210 CONTINUE J=NHBE 1220 A=(YHBE(J)-YHBE(J-1))/(XHBE(J)-XHBE(J-1)) B=(XHBE(J-1)*YHBE(J)-XHBE(J)*YHBE(J-1))/(XHBE(J-1)-XHBE(J)) QIN(18,I)=(A*EN+B)*1.D-16 IF(EN.LE.(3.0*EIN(18))) GO TO 1250 PEQIN(18,I)=PEQEL(2,(I-IOFF18)) 1250 CONTINUE C C Q(1,I)=Q(2,I)+Q(5,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)+QIN(15,I)+QIN(16,I)+QIN(17,I)+ /QIN(18,I) C 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(18)) NIN=17 IF(EFINAL.LE.EIN(17)) NIN=16 IF(EFINAL.LE.EIN(16)) NIN=15 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 C RETURN END SUBROUTINE GAS9(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=' ETHANE 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=DEXP(EIN(1)/AKT) POPVH=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C SUPER V TORSION QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 1300 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.003*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 1301 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.003*DLOG((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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS10(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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='PROPANE 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=DEXP(EIN(1)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS11(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(122),YELM(122),YELT(122),YEPS(122), /XION(38),YION(38),YINC(38),XATT(10),YATT(10), /XVIB1(36),YVIB1(36),XVIB2(30),YVIB2(30),XVIB3(30),YVIB3(30), /XVIB4(35),YVIB4(35),XVIB5(21),YVIB5(21),XEXC1(24),YEXC1(24), /XEXC2(21),YEXC2(21),XEXC3(20),YEXC3(20) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC DATA XEN/0.00,0.001,0.002,0.003,0.004,0.005,0.007,0.01,0.014,0.02, /.025,0.03,.035,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,12.5,15.0,20.0,25.0, /30.0,40.0,50.0,60.0,70.0,80.0,100.,120.,140.,170., /200.,250.,300.,400.,500.,750.,1000.,1250.,1500.,1750., /2000.,2500.,3000.,3500.,4000.,4500.,5000.,6000.,7000.,8000., /9000.,1.D4,1.25D4,1.5D4,1.75D4,2.D4,2.5D4,3.D4,3.5D4,4.D4, /4.5D4,5.D4,6.D4,7.D4,8.D4,9.D4,1.D5,1.25D5,1.5D5,1.75D5, /2.0D5,2.5D5,3.D5,3.5D5,4.D5,4.5D5,5.D5,6.D5,7.D5,8.D5, /9.D5,1.D6,1.25D6,1.5D6,1.75D6,2.D6,2.5D6,3.D6,3.5D6,4.D6, /5.D6,1.D7/ C ELASTIC MOMENTUM TRANSFER X-SECTION DATA YELM/255.,255.,255.,255.,255.,210.,150.,105.,74.5,52.0, /41.4,34.5,29.6,25.9,20.7,17.2,14.8,13.0,11.7,10.8, /10.0,9.30,8.60,8.00,7.00,5.50,3.50,3.60,4.80,7.50, /9.60,11.2,12.9,13.8,14.7,15.3,16.1,17.3,19.8,23.2, /27.8,32.3,35.0,35.0,33.0,30.0,25.0,21.5,17.0,13.7, /11.5,9.00,7.30,6.10,5.20,4.50,3.50,2.80,2.21,1.72, /1.40,1.10,0.87,0.61,0.47,0.28,.171,.116,.0848,.0648, /.0505,.0345,.0249,.0189,.0149,.0120,.00996,.00717,.00542,.00426, /.00344,.00284,.00190,.00136,.00103,.000807,.000539,.000387, /.000293,.000231, /1.87D-4,1.55D-4,1.12D-4,8.50D-5,6.72D-5,5.46D-5,4.55D-5,3.10D-5, /2.27D-5,1.75D-5, /1.40D-5,9.71D-6,7.24D-6,5.66D-6,4.59D-6,3.81D-6,3.24D-6,2.44D-6, /1.93D-6,1.57D-6, /1.31D-6,1.12D-6,8.01D-7,6.04D-7,4.75D-7,3.84D-7,2.69D-7,2.00D-7, /1.55D-7,1.24D-7, /8.52D-8,2.55D-8/ C ELASTIC X-SECTION ASSUMED ISOTROPIC BELOW 2.0 EV DATA YELT/255.,255.,255.,255.,255.,210.,150.,105.,74.5,52.0, /41.4,34.5,29.6,25.9,20.7,17.2,14.8,13.0,11.7,10.8, /10.0,9.30,8.60,8.00,7.00,5.50,3.50,3.60,4.80,7.50, /9.60,11.2,12.9,13.8,14.7,15.3,16.1,17.3,25.0,32.0, /39.0,43.0,46.0,48.0,48.0,46.0,43.5,41.5,37.0,32.0, /27.5,22.5,19.0,16.5,14.7,13.3,11.0,9.60,8.40,7.20, /6.40,5.30,4.60,3.65,3.05,2.20,1.72,1.42,1.21,1.08, /0.96,0.80,.690,.600,.545,.490,.450,.385,.335,.305, /.275,.250,.210,.180,.158,.142,.119,.100,.0873,.0774, /.0698,.0636,.0545,.0479,.0443,.0392,.0361,.0306,.0270,.0244, /.0225,.0198,.0180,.0168,.0158,.0151,.0146,.0138,.0132,.0128, /.0125,.0123,.0119,.0116,.0114,.0113,.0112,.0111,.0110,.0110, /.0110,.0109/ C ELPSILON FOR ELASTIC ANGULAR DISTRIBUTION DATA YEPS/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0, /0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0, /0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0, /0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,.3060,.3989, /.4153,.3631,.3497,.3932,.4489,.4946,.5894,.6535,.7149,.7455, /.7549,.7717,.7859,.7985,.8120,.8247,.8407,.8607,.8809,.8970, /.9097,.9164,.9270,.9390,.9456,.9585,.9704,.9773,.9815,.9849, /.98728,.99015,.99214,.99338,.99445,.99516,.99573,.99654,.99709, /.99756, /.99787,.99810,.998551,.998829,.999016,.999162,.999357,.999465, /.999546,.999603, /.999650,.999686,.999742,.999781,.999817,.9998342,.9998519, /.9998843,.9999063,.9999216, /.9999331,.9999488,.9999589,.9999663,.9999714,.9999755,.9999788, /.9999835,.9999866,.9999889, /.9999907,.9999920,.9999943,.9999957,.9999966,.9999973,.9999981, /.9999986,.9999989,.9999992, /.9999994,.9999998/ C IONISATION DATA XION/10.67,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,22.0,24.0,26.0,28.0,30.0,33.0,36.0,40.0,45.0, /50.0,60.0,70.0,80.0,90.0,100.,125.,150.,200.,250., /300.,400.,500.,600.,700.,800.,900.,1000./ C GROSS IONISATION DATA YION/0.00,.004,.074,0.19,0.39,0.63,0.89,1.17,1.70,2.33, /3.07,4.35,5.62,6.89,7.63,8.35,9.06,9.90,10.5,11.4, /12.0,12.6,13.2,13.2,13.1,13.0,12.7,12.0,10.8,9.40, /8.40,7.10,6.07,5.29,4.70,4.23,3.86,3.555/ C COUNTING IONISATION DATA YINC/38*0.0/ C ATTACHMENT DATA XATT/10*0.0/ DATA YATT/10*0.0/ C VIBRATION/TORSION 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.00,8.00,10.0,15.0,20.0,30.0,40.0, /100.,1000.,1.D4,1.D5,1.D6,1.D7/ 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,.038,.025,.012,.008, /.003,3.D-4,3.D-5,3.D-6,3.D-7,3.D-8/ C VIBRATION 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.00,8.00,10.0, /15.0,20.0,30.0,40.0,100.,1000.,1.D4,1.D5,1.D6,1.D7/ 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.00,0.66,0.35,0.22,.088,.0088,8.8D-4,8.8D-5,8.8D-6,8.8D-7/ C VIBRATION 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.00,8.00,10.0, /15.0,20.0,30.0,40.0,100.,1000.,1.D4,1.D5,1.D6,1.D7/ 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.35, /0.80,0.52,0.28,.175,.070,.007,7.D-4,7.D-5,7.D-6,7.D-7/ C VIBRATION DATA XVIB4/.363,.365,0.37,0.38,0.39,0.40,0.42,0.45,0.50,0.55, /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,15.0,20.0,30.0,40.0,100., /1000.,1.D4,1.D5,1.D6,1.D7/ DATA YVIB4/0.00,.108,.198,.299,.366,.416,.487,.555,.615,.645, /.655,.650,.630,.605,.580,0.55,0.57,0.67,1.05,1.50, /2.00,2.45,2.70,2.70,2.10,1.15,0.76,0.42,0.27,0.11, /.011,.0011,1.1D-4,1.1D-5,1.1D-6/ C VIBRATION HARMONICS DATA XVIB5/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00, /10.0,15.0,20.0,30.0,40.0,100.,1000.,1.D4,1.D5,1.D6, /1.D7/ DATA YVIB5/0.00,.001,0.01,.033,.085,0.16,0.20,0.27,0.30,0.30, /0.23,.125,.085,.047,.032,.013,.0013,1.3D-4,1.3D-5,1.3D-6, /1.3D-7/ C EXCITATION DATA XEXC1/7.40,8.00,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0, /30.0,40.0,50.0,60.0,70.0,80.0,100.,125.,150.,200., /300.,400.,600.,1000./ DATA YEXC1/0.00,.019,.250,.500,0.68,0.87,1.15,1.36,1.56,1.80, /2.04,2.50,2.95,3.45,3.75,4.00,4.00,3.70,3.25,2.50,1.72, /1.32,0.91,0.56/ C EXCITATION DATA XEXC2/9.70,11.0,12.0,14.0,16.0,20.0,25.0,30.0,40.0,50.0, /60.0,70.0,80.0,100.,125.,150.,200.,300.,400.,600., /1000./ DATA YEXC2/0.00,.133,.350,.630,0.87,1.15,1.40,1.57,1.90,2.25, /2.60,2.90,3.15,3.15,2.90,2.55,1.92,1.30,0.99,0.68, /.424/ C EXCITATION DATA XEXC3/14.0,16.0,18.0,20.0,25.0,30.0,35.0,40.0,50.0,60.0, /70.0,80.0,100.,125.,150.,200.,300.,400.,600.,1000./ DATA YEXC3/0.00,.550,0.95,1.20,1.45,1.69,1.88,2.10,2.50,2.90, /3.25,3.50,3.50,3.25,2.85,2.25,1.55,1.18,0.82,0.51/ C********************************************************************** C 2009 UPDATE OF 1999 SUBROUTINE C VERSION INCLUDES ANISOTROPIC SCATTERING. USED ISOTROPIC ELASTIC C SCATTERING BELOW 2 EV DUE TO LACK OF EXPERIMENTAL ELECTRON C SCATTERING DATA. C ALSO INCLUDES BETTER TREATMENT OF TORSIONAL EXCITATION (USED A C 2-LEVEL APPROXIMATION FOR TORSION) C IMPROVED FANO FACTOR AND W FROM BETTER EXCITATION/DISSOCIATION C X-SECTIONS . PUBLISHED ELECTRON SCATTERING DATA UP TO 2009 IS C INCLUDED IN ANALYSIS. GOOD FIT +-1% TO SCHMIDTS HE/ISO DATA . C SCHMIDT AND MARTENS : HEIDELBERG PREPRINT :HD-PY 92/02 C STILL SOME PROBLEMS WITH AR/ISO FITS +-2% BUT PROBABLY CAUSED C BY POOR QUALITY EXPERIMENTAL DRIFT VELOCITY DATA. C E.G. NO CONSISTANCY AT 3% LEVEL BETWEEN : C FUJII ET AL: NIM A245(1986)35 C AND BECKER : HTTP://CYCLO.MIT.EDU/DRIFT/WWW C FUTURE IMPROVEMENT: INCLUDE EFFECTIVE ROTATIONAL STATE AT 0.005EV C*********************************************************************** C-------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME='ISOBUTANE 2009 ' ELSE NAME='ISOBUTANE 2009A' ENDIF C --------------------------------------------------------------------- C BORN BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 AM2=15.5 C=160.0 C BORN BETHE VALUES FOR EXCITATIONS AM2EXC=5.69 CEXC=62.6 C NIN=12 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN 2 KIN(J)=0 C ANGULAR DISTRIBUTION FOR EXCITATION CAN BE EITHER C CAPITELLI-LONGO OR OKHRIMOVSKKY TYPES KIN(10)=NANISO KIN(11)=NANISO KIN(12)=NANISO C NDATA=122 NION=38 NATT=10 NVIB1=36 NVIB2=30 NVIB3=30 NVIB4=35 NVIB5=21 NEXC1=24 NEXC2=21 NEXC3=20 C E(1)=0.0 E(2)=2.0*EMASS/(58.1234*AMU) E(3)=10.67 C EXCITATION X-SECTION AT 1.2 MEV E(4)=0.0145D-16 C IONISATION X-SECTION AT 1.2 MEV E(5)=0.0374D-16 C OPAL BEATY IONISATION ENERGY SPLITTING AT 1.2 MEV E(6)=7.00 C OPAL BEATY IONISATION ENERGY SPLITTING AT LOW ENERGY EOBY=8.80 C EIN(1)=-0.032 EIN(2)=0.032 EIN(3)=-0.108 EIN(4)=0.108 EIN(5)=-0.173 EIN(6)=0.173 EIN(7)=-0.363 EIN(8)=0.363 EIN(9)=0.519 EIN(10)=7.4 EIN(11)=9.70 EIN(12)=14.0 C OFFSET ENERGY FOR IONISATION ELECTRON ANGULAR DISTRIBUTION IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) C OFFSET ENERGY FOR EXCITATION ELECTRON ANGULAR DISTRIBUTION IOFF10=IFIX(SNGL(0.5+EIN(10)/ESTEP)) IOFF11=IFIX(SNGL(0.5+EIN(11)/ESTEP)) IOFF12=IFIX(SNGL(0.5+EIN(12)/ESTEP)) C*********************************************************************** C PENNING TRANSFER FRACTION FOR EACH LEVEL DO 5 K=1,12 DO 5 L=1,3 5 PENFRA(L,K)=0.0 C PENNING TRANSFER FRACTION FOR EXCITATION LEVELS ONLY PENFRA(1,10)=0.0 PENFRA(1,11)=0.0 PENFRA(1,12)=0.0 C PENNING TRANSFER DISTANCE IN MICRONS PENFRA(2,10)=1.0 PENFRA(2,11)=1.0 PENFRA(2,12)=1.0 C PENNING TRANSFER TIME IN PICOSECONDS PENFRA(3,10)=1.0 PENFRA(3,11)=1.0 PENFRA(3,12)=1.0 IF(IPEN.EQ.0) GO TO 8 IF((PENFRA(1,10)+PENFRA(1,11)+PENFRA(1,12)).EQ.0.0) GO TO 8 DO 6 K=10,12 6 WRITE(6,999) NAME,EIN(K),PENFRA(1,K),PENFRA(2,K),PENFRA(3,K) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY = ',F5.3,' ABS.LENGTH = ',F7.2,' DECAY TIME = ',F7.1,/) 8 CONTINUE C*********************************************************************** SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC I-C4H10 ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC ISOTROPIC I-C4H10 ' ENDIF SCRPT(3)=' IONISATION ELOSS= 10.67 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' TORSION ELOSS= -0.032 ' SCRPT(8)=' TORSION ELOSS= 0.032 ' SCRPT(9)=' VIB BEND ELOSS= -0.108 ' SCRPT(10)=' VIB BEND ELOSS= 0.108 ' SCRPT(11)=' VIB STRETCH ELOSS= -0.173 ' SCRPT(12)=' VIB STRETCH ELOSS= 0.173 ' SCRPT(13)=' VIB STRETCH ELOSS= -0.363 ' SCRPT(14)=' VIB STRETCH ELOSS= 0.363 ' SCRPT(15)=' VIB STRETCH ELOSS= 0.519 ' SCRPT(16)=' EXCITATION ELOSS= 7.4 ' SCRPT(17)=' EXC/DISOC. ELOSS= 9.70 ' SCRPT(18)=' EXC/DISOC. ELOSS= 14.0 ' C CALCULATE POPULATION OF TORSIONAL STATES APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(2.0*EIN(1)/AKT) APOP3=DEXP(3.0*EIN(1)/AKT) APOP4=DEXP(4.0*EIN(1)/AKT) APOP5=DEXP(5.0*EIN(1)/AKT) APOP6=DEXP(6.0*EIN(1)/AKT) APOP7=DEXP(7.0*EIN(1)/AKT) APOP8=DEXP(8.0*EIN(1)/AKT) APOP9=DEXP(9.0*EIN(1)/AKT) APOP10=DEXP(10.0*EIN(1)/AKT) APOPGST=1.0 APOPSUM=APOPGST+APOP1+APOP2+APOP3+APOP4+APOP5+APOP6+APOP7+APOP8+ /APOP9+APOP10 APOPGST=1.0/APOPSUM APOP1=APOP1/APOPSUM APOP2=APOP2/APOPSUM APOP3=APOP3/APOPSUM APOP4=APOP4/APOPSUM APOP5=APOP5/APOPSUM APOP6=APOP6/APOPSUM APOP7=APOP7/APOPSUM APOP8=APOP8/APOPSUM APOP9=APOP9/APOPSUM APOP10=APOP10/APOPSUM C USE 2 LEVEL APPROXIMATION FOR TORSION APOP1=APOP1+APOP2+APOP3+APOP4+APOP5+APOP6+APOP7+APOP8+APOP9+APOP10 APOPGST=1.0 C CALCULATE POPULATION OF VIBRATIONAL STATES C ASSUME ALL STATE DEGENERACIES ARE EQUAL APOPV2=DEXP(EIN(3)/AKT) APOPV3=DEXP(EIN(5)/AKT) APOPV4=DEXP(EIN(7)/AKT) APOPGS=1.0+APOPV2+APOPV3+APOPV4 APOPV2=APOPV2/APOPGS APOPV3=APOPV3/APOPGS APOPV4=APOPV4/APOPGS APOPGS=1.0/APOPGS C RENORMALISE GROUND STATE POPULATION ( GIVES CORRECTION THAT C ALLOWS FOR VIBRATIONAL EXCITATION FROM EXCITED VIBRATIONAL STATES) APOPGS=1.0 C EN=-ESTEP/2.0 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=(YELM(J)-YELM(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YELM(J)-XEN(J)*YELM(J-1))/(XEN(J-1)-XEN(J)) QMOM=(A*EN+B)*1.D-16 A=(YELT(J)-YELT(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YELT(J)-XEN(J)*YELT(J-1))/(XEN(J-1)-XEN(J)) QELA=(A*EN+B)*1.D-16 A=(YEPS(J)-YEPS(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YEPS(J)-XEN(J)*YEPS(J-1))/(XEN(J-1)-XEN(J)) PQ2=(A*EN+B) PQ1=0.5+(QELA-QMOM)/QELA IF(NANISO.EQ.0) PEQEL(2,I)=0.5 IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) Q(2,I)=QMOM C GROSS IONISATION Q(3,I)=0.0 PEQEL(3,I)=0.5 IF(NANISO.EQ.2) PEQEL(3,I)=0.0 IF(EN.LT.E(3)) GO TO 150 IF(EN.GT.XION(NION)) GO TO 123 DO 100 J=2,NION IF(EN.LE.XION(J)) GO TO 110 100 CONTINUE J=NION 110 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 GO TO 124 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 123 GAMMA=(EMASS2+2.0D0*EN)/EMASS2 BETA=DSQRT(1.0D0-1.0D0/(GAMMA*GAMMA)) BETA2=BETA*BETA X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2) 124 CONTINUE C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON AT C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISTRIBUTION EQUAL TO ELASTIC ANGULAR DISTRIBUTION C AT AN ENERGY OFFSET BY THE IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 150 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C ATTACHMENT (NO ATTACHMENT) 150 Q(4,I)=0.0 C COUNTING IONISATION 200 Q(5,I)=0.0 PEQEL(5,I)=0.5 IF(NANISO.EQ.2) PEQEL(5,I)=0.0 C SET COUNTING IONISATION = GROSS IONISATION (LACK OF EXPERIMENTAL DATA) Q(5,I)=Q(3,I) PEQEL(5,I)=PEQEL(3,I) C Q(6,I)=0.0 C SUPERELASTIC TORSION QIN(1,I)=0.0 PEQIN(1,I)=0.5 IF(NANISO.EQ.2) PEQIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.009*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=APOP1*QIN(1,I)*1.D-16 C TORSION 305 QIN(2,I)=0.0 PEQIN(2,I)=0.5 IF(NANISO.EQ.2) PEQIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.009*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=APOPGST*QIN(2,I)*1.D-16 C SUPERELASTIC VIB BEND MODES 400 QIN(3,I)=0.0 PEQIN(3,I)=0.5 IF(NANISO.EQ.2) PEQIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 450 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)=APOPV2*(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.D-16/EN C VIB BEND MODES 450 QIN(4,I)=0.0 PEQIN(4,I)=0.5 IF(NANISO.EQ.2) PEQIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 500 DO 460 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 470 460 CONTINUE J=NVIB2 470 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)=APOPGS*(A*EN+B)*1.D-16 C SUPERELASTIC VIB STRETCH MODES 500 CONTINUE QIN(5,I)=0.0 PEQIN(5,I)=0.5 IF(NANISO.EQ.2) PEQIN(5,I)=0.0 IF(EN.EQ.0.0) GO TO 550 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)=APOPV3*(EN+EIN(6))*(A*(EN+EIN(6))+B)*1.D-16/EN C VIB STRETCH MODES 550 CONTINUE QIN(6,I)=0.0 PEQIN(6,I)=0.5 IF(NANISO.EQ.2) PEQIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 600 DO 560 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 570 560 CONTINUE J=NVIB3 570 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)=APOPGS*(A*EN+B)*1.D-16 C SUPERELASTIC VIB STRETCH MODES 600 CONTINUE QIN(7,I)=0.0 PEQIN(7,I)=0.5 IF(NANISO.EQ.2) PEQIN(7,I)=0.0 IF(EN.EQ.0.0) GO TO 650 DO 610 J=2,NVIB4 IF((EN+EIN(8)).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)=APOPV4*(EN+EIN(8))*(A*(EN+EIN(8))+B)*1.D-16/EN C VIB STRETCH MODES 650 CONTINUE QIN(8,I)=0.0 PEQIN(8,I)=0.5 IF(NANISO.EQ.2) PEQIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 700 DO 660 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 670 660 CONTINUE J=NVIB4 670 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)=APOPGS*(A*EN+B)*1.D-16 C HIGHER VIBRATIONAL MODES 700 QIN(9,I)=0.0 PEQIN(9,I)=0.5 IF(NANISO.EQ.2) PEQIN(9,I)=0.0 IF(EN.LE.EIN(9)) 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(9,I)=(A*EN+B)*1.D-16 C EXCITATION 800 QIN(10,I)=0.0 PEQIN(10,I)=0.5 IF(NANISO.EQ.2) PEQIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 850 IF(EN.GT.XEXC1(NEXC1)) GO TO 830 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(10,I)=(A*EN+B)*1.D-16 GO TO 840 C USE BORN BETHE X-SECTION ABOVE XEXC1(NEXC1) EV 830 QIN(10,I)=CONST*(AM2EXC*X1+CEXC*X2)*0.375 C ANGULAR DISTRIBUTION COPIED FROM ELASTIC OFFSET BY TWICE THE C LEVEL ENERGY 840 IF(EN.LE.(2.0*EIN(10))) GO TO 850 PEQIN(10,I)=PEQEL(2,(I-IOFF10)) C EXCITATION 850 QIN(11,I)=0.0 PEQIN(11,I)=0.5 IF(NANISO.EQ.2) PEQIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 900 IF(EN.GT.XEXC2(NEXC2)) GO TO 880 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(11,I)=(A*EN+B)*1.D-16 GO TO 890 C USE BORN BETHE X-SECTION ABOVE XEXC2(NEXC2) EV 880 QIN(11,I)=CONST*(AM2EXC*X1+CEXC*X2)*0.284 C ANGULAR DISTRIBUTION COPIED FROM ELASTIC OFFSET BY TWICE THE C LEVEL ENERGY 890 IF(EN.LE.(2.0*EIN(11))) GO TO 900 PEQIN(11,I)=PEQEL(2,(I-IOFF11)) C EXCITATION 900 QIN(12,I)=0.0 PEQIN(12,I)=0.5 IF(NANISO.EQ.2) PEQIN(12,I)=0.0 IF(EN.LE.EIN(12)) GO TO 950 IF(EN.GT.XEXC3(NEXC3)) GO TO 930 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(12,I)=(A*EN+B)*1.D-16 GO TO 940 C USE BORN BETHE X-SECTION ABOVE XEXC3(NEXC3) EV 930 QIN(12,I)=CONST*(AM2EXC*X1+CEXC*X2)*0.341 C ANGULAR DISTRIBUTION COPIED FROM ELASTIC OFFSET BY TWICE THE C LEVEL ENERGY 940 IF(EN.LE.(2.0*EIN(12))) GO TO 950 PEQIN(12,I)=PEQEL(2,(I-IOFF12)) 950 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) 1000 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 RETURN END SUBROUTINE GAS12(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220), /PJ(220) DIMENSION XEN(124),YMOM(124),YEL(124),YVBMOM(124),YVBEL(124), /YEPS(124),XION(62),YION(62),YINC(62),XATT(74),YATT(74), /XV2(23),YV2(23),X2V2(25),Y2V2(25),XV1(32),YV1(32), /X3V2(17),Y3V2(17),XV3(17),YV3(17),XVPD3(22),YVPD3(22), /XV130(19),YV130(19),XVPD4(20),YVPD4(20),XVPD5(17),YVPD5(17), /XVPD6(17),YVPD6(17),XVPD7(17),YVPD7(17),XVPD8(17),YVPD8(17), /XVPD9(17),YVPD9(17),XVPDH(15),YVPDH(15), /XEXC1(53),YEXC1(53),XEXC2(53),YEXC2(53),XEXC3(51),YEXC3(51), /XEXC4(51),YEXC4(51),XEXC5(51),YEXC5(51),XEXC6(51),YEXC6(51) 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,40.0,50.0,60.0,70.0,80.0,90.0,100., /120.,150.,170.,200.,250.,300.,350.,400.,450.,500., /600.,700.,800.,900.,1000.,1500.,2000.,3000.,4000.,5000., /6000.,8000.,1.0D4,1.25D4,1.5D4,1.75D4,2.0D4,2.5D4,3.0D4,3.5D4, /4.0D4,4.5D4,5.0D4,6.0D4,7.0D4,8.0D4,9.0D4,1.0D5,1.25D5,1.5D5, /1.75D5,2.0D5,2.5D5,3.0D5,3.5D5,4.0D5,4.5D5,5.0D5,6.0D5,7.0D5, /8.0D5,9.0D5,1.0D6,1.25D6,1.5D6,1.75D6,2.0D6,2.5D6,3.0D6,3.5D6, /4.0D6,6.0D6,8.0D6,1.0D7/ 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,7.40,6.00,4.70,3.85,3.25,2.80,2.45, /1.95,1.45,1.22,1.00,0.74,0.59,0.48,0.41,0.35,.305, /0.24,0.20,0.17,.145,.125,.0685,.0414,.0216,.0135,.00928, /.00686,.00430,.00288,.00192,.00138,.00105,8.23D-4,5.5D-4,3.96D-4, /3.0D-4, /2.36D-4,1.91D-4,1.59D-4,1.15D-4,8.73D-5,6.90D-5,5.62D-5,4.68D-5, /3.19D-5,2.34D-5, /1.81D-5,1.45D-5,1.00D-5,7.48D-6,5.86D-6,4.75D-6,3.95D-6,3.36D-6, /2.54D-6,2.00D-6, /1.63D-6,1.37D-6,1.16D-6,8.32D-7,6.28D-7,4.94D-7,4.00D-7,2.80D-7, /2.08D-7,1.62D-7, /1.30D-7,6.51D-8,3.95D-8,2.66D-8/ 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,12.1,10.4,9.20,8.20,7.60,7.00,6.45, /5.79,4.90,4.48,4.05,3.67,3.33,2.98,2.75,2.50,2.32, /2.00,1.78,1.59,1.41,1.28,0.97,0.75,0.55,0.44,.365, /.315,.252,.204,.165,.139,.120,.106,.0865,.0731,.0636, /.0565,.0509,.0465,.0398,.0350,.0317,.0286,.0264,.0224,.0197, /.0178,.0164,.0145,.0132,.0123,.0116,.0111,.0107,.0101,.00967, /.00937,.00915,.00897,.00868,.00849,.00837,.00829,.00818,.00812, /.00808, /.00805,.00799,.00797,.00797/ 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,7.40,6.00,4.70,3.85,3.25,2.80,2.45, /1.95,1.45,1.22,1.00,0.74,0.59,0.48,0.41,0.35,.305, /0.24,0.20,0.17,.145,.125,.0685,.0414,.0216,.0135,.00928, /.00686,.00430,.00288,.00192,.00138,.00105,8.23D-4,5.5D-4,3.96D-4, /3.0D-4, /2.36D-4,1.91D-4,1.59D-4,1.15D-4,8.73D-5,6.90D-5,5.62D-5,4.68D-5, /3.19D-5,2.34D-5, /1.81D-5,1.45D-5,1.00D-5,7.48D-6,5.86D-6,4.75D-6,3.95D-6,3.36D-6, /2.54D-6,2.00D-6, /1.63D-6,1.37D-6,1.16D-6,8.32D-7,6.28D-7,4.94D-7,4.00D-7,2.80D-7, /2.08D-7,1.62D-7, /1.30D-7,6.51D-8,3.95D-8,2.66D-8/ C ELASTIC FOR BEND MODE VIBRATIONS. DATA YVBEL/148.,148.,146.,141.,135.,129.,120.,110.,96.0,86.0, /77.5,70.5,60.0,54.5,51.1,47.6,46.8,47.2,48.5,46.6, /38.7,32.9,25.4,19.1,15.4,11.9,9.37,7.33,6.20,5.68, /5.52,5.43,5.52,5.65,5.93,6.40,7.70,8.44,8.78,7.93, /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,12.1,10.4,9.20,8.20,7.60,7.00,6.45, /5.79,4.90,4.48,4.05,3.67,3.33,2.98,2.75,2.50,2.32, /2.00,1.78,1.59,1.41,1.28,0.97,0.75,0.55,0.44,.365, /.315,.252,.204,.165,.139,.120,.106,.0865,.0731,.0636, /.0565,.0509,.0465,.0398,.0350,.0317,.0286,.0264,.0224,.0197, /.0178,.0164,.0145,.0132,.0123,.0116,.0111,.0107,.0101,.00967, /.00937,.00915,.00897,.00868,.00849,.00837,.00829,.00818,.00812, /.00808, /.00805,.00799,.00797,.00797/ C EPSILON FOR ELASTIC ANGULAR DISTRIBUTION DATA YEPS/0.0,.00001,.0001,.001,.01111,.01162,.01249,.01363, /.01563,.01744, /.01935,.02127,.02500,.02803,.03092,.03571,.04053,.07136, /.16838,.30302, /.38441,.45366,.52155,.55591,.58136,.59099,.53607,.44734, /.33109,.26842, /.23335,.20060,.19416,.17264,.14643,.17460,.32377,.38639, /.42456,.33803, /.17884,.25277,.35423,.38173,.36044,.33916,.34362,.34620, /.25594,.29053, /.31927,.39402,.44108,.54525,.58678,.66131,.70472,.74599, /.77171,.78971, /.82594,.85753,.87452,.89179,.91987,.93361,.94210,.94813, /.95253,.95654, /.96172,.96505,.96735,.96904,.97115,.98131,.98646,.99126, /.99359,.99493, /.99581,.99689,.99753,.99804,.998381,.998607,.998791,.999045, /.9992083,.9993264, /.9994153,.9994836,.9995363,.9996182,.9996776,.9997242,.9997546, /.9997818,.9998299,.9998615, /.9998838,.9999008,.9999250,.9999398,.9999504,.9999581,.9999642, /.9999688,.9999756,.9999803, /.9999838,.9999862,.9999883,.9999916,.9999936,.9999950,.9999960, /.9999972,.9999980,.9999985, /.9999988,.9999994,.9999996,.9999998/ 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., /1.0D5,1.0D6,1.0D7/ 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, /1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ 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,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5, /1.0D6,1.0D7/ 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,1.0D-7, /1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ 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,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ DATA YV3/0.00,0.00,.002,.005,.010,.005,.002,.001,.001,.001, /.001,.0001,.00001,.000001,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5, /1.0D6,1.0D7/ 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,1.0D-7, /1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ 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,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ 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,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ DATA YVPD5/0.00,0.00,.003,0.07,0.14,0.24,0.24,0.14,0.08,.006, /.001,.0001,.00001,.000001,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ DATA YVPD6/0.00,0.00,.001,0.05,0.10,0.16,0.16,0.10,0.05,.004, /.001,.0001,.00001,.000001,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ DATA YVPD7/0.00,0.00,.001,0.03,0.06,0.10,0.10,0.06,0.03,.003, /.001,.0001,.00001,.000001,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ DATA YVPD8/0.00,0.00,.001,0.03,0.06,0.10,0.10,0.06,0.03,.003, /.001,.0001,.00001,.000001,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ DATA YVPD9/0.00,0.00,.001,0.03,0.06,0.10,0.10,0.06,0.03,.003, /.001,.0001,.00001,.000001,1.0D-7,1.0D-8,1.0D-9/ 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.,1.0D5,1.0D6,1.0D7/ DATA YVPDH/0.00,0.01,0.36,0.58,0.58,0.36,0.16,.045,.001,.0001, /.00001,.000001,1.0D-7,1.0D-8,1.0D-9/ C DATA FROM RAP AND BRIGLIA ( SCALED BY 1.031 FROM INCREASE IN CO2 C IONISATION X-SEC) DATA XATT/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,5.10,5.20, /5.30,5.40,5.50,5.60,5.70,5.80,5.90,6.00,6.10,6.20, /6.30,6.40,6.50,6.60,6.70,6.80,6.90,7.00,7.10,7.20, /7.30,7.40,7.50,7.60,7.70,7.80,7.90,8.00,8.10,8.20, /8.30,8.40,8.50,8.60,8.70,8.80,8.90,9.00,9.10,9.20, /9.30,9.40,9.50,9.60,9.70,9.80,9.90,10.0,15.0,100., /1000.,1.0D5,1.0D6,1.0D7/ DATA YATT/.0,1.81D-5,6.35D-5,1.45D-4,2.81D-4,5.44D-4,8.43D-4, /1.09D-3,1.32D-3,1.45D-3, /1.53D-3,1.40D-3,1.25D-3,1.01D-3,7.98D-4,6.17D-4,4.54D-4,2.91D-4, /2.00D-4,1.36D-4, /9.98D-5,6.35D-5,2.72D-5,1.81D-5,9.07D-6,1.00D-6,9.07D-6,1.81D-5, /2.72D-5,4.54D-5, /6.35D-5,1.09D-4,1.45D-4,2.08D-4,2.99D-4,3.99D-4,5.44D-4,9.25D-4, /9.25D-4,1.18D-3, /1.49D-3,1.84D-3,2.23D-3,2.75D-3,3.22D-3,3.68D-3,4.08D-3,4.37D-3, /4.41D-3,4.26D-3, /3.92D-3,3.46D-3,2.92D-3,2.22D-3,1.77D-3,1.40D-3,1.05D-3,8.07D-4, /6.35D-4,4.99D-4, /3.80D-4,2.99D-4,2.36D-4,1.81D-4,1.36D-4,1.09D-4,8.17D-5,1.00D-6, /1.0D-8,1.0D-9, /1.0D-10,1.0D-11,1.0D-12,1.0D-13/ 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.,80000., /1.0D5,1.5D5,2.0D5,4.0D5,6.0D5,8.0D5,1.0D6,1.5D6,2.0D6,3.0D6, /5.0D6,7.0D6,1.0D7/ 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,.00024,.00017,.00014, /1.16D-4,8.8D-5,7.4D-5,5.4D-5,4.8D-5,4.6D-5,4.5D-5,4.4D-5, /4.3D-5,4.4D-5, /4.5D-5,4.6D-5,4.8D-5/ 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.,80000., /1.0D5,1.5D5,2.0D5,4.0D5,6.0D5,8.0D5,1.0D6,1.5D6,2.0D6,3.0D6, /5.0D6,7.0D6,1.0D7/ 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,.0040, /3.37D-3,2.85D-3,2.2D-3,.0015,.00116,.00095,5.1D-4,2.81D-4, /2.02D-4,1.62D-4, /1.38D-4,1.05D-4,8.9D-5,6.5D-5,5.8D-5,5.5D-5,5.32D-5,5.19D-5, /5.18D-5,5.24D-5, /5.4D-5,5.53D-5,5.68D-5/ 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.,8.0D4,1.0D5,1.5D5, /2.0D5,4.0D5,6.0D5,8.0D5,1.0D6,1.5D6,2.0D6,3.0D6,5.0D6,7.0D6, /1.0D7/ DATA YEXC3/0.00,0.56,0.43,0.34,0.31,0.30,0.30,0.31,0.32,0.33, /0.35,0.38,0.41,0.43,0.44,.425,0.40,0.36,.325,0.29, /.258,.214,.184,.161,.136,.111,.081,.064,.053,.0444, /.0342,.024,.0180,.0148,.00795,.00439,.00315,.00253,.00214,.00164, /.0014,.00102,.00090,.00085,.00083,.00082,.00080,.00082,.00084, /.00086,.00089/ 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.,8.0D4,1.0D5,1.5D5, /2.0D5,4.0D5,6.0D5,8.0D5,1.0D6,1.5D6,2.0D6,3.0D6,5.0D6,7.0D6, /1.0D7/ DATA YEXC4/0.00,0.23,0.31,0.34,0.38,0.40,0.46,0.54,0.60,0.64, /0.67,0.74,0.80,0.82,0.82,0.79,0.75,0.68,0.59,0.51, /0.46,0.38,0.33,0.29,.233,.188,.133,.1016,.0829,.070, /.054,.038,.029,.0234,.0125,.0069,.0050,.0040,.00339,.00258, /.00218,.00160,.00143,.00135,.00131,.00128,.00128,.00129, /.00133,.00136,.00140/ 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.,8.0D4,1.0D5,1.5D5, /2.0D5,4.0D5,6.0D5,8.0D5,1.0D6,1.5D6,2.0D6,3.0D6,5.0D6,7.0D6, /1.0D7/ 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.55,1.68,1.78,1.85,1.81,1.71,1.59,1.39,1.25, /1.14,0.95,0.83,0.73,0.61,0.50,0.38,0.30,0.26,.225, /.175,.128,.099,.083,.045,.025,.0176,.0141,.01204,.00918, /.00775,.00566,.00505,.00478,.00465,.00454,.00453,.00458, /.00472,.00484,.00496/ 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.,8.0D4,1.0D5,1.5D5, /2.0D5,4.0D5,6.0D5,8.0D5,1.0D6,1.5D6,2.0D6,3.0D6,5.0D6,7.0D6, /1.0D7/ DATA YEXC6/0.0,.0005,.003,.006,.009,.013,.016,.025,.031,.034, /.037,.041,.046,.048,.048,.046,.044,.040,.035,.031, /.028,.024,.020,.018,.015,.013,.0090,.0078,.0064,.0056, /.0048,.0035,.0028,.00234,.00126,.0008,.0005,.00040,.00034,.000258, /.000218,.000160,.000143,.000135,.000131,.000128,.000128,.000129, /.000133,.000136,.000140/ C IONISATION VALUES ABOVE 1KEV GENERATED BY BORN BETHE IN SUB) C DATA FROM RAPP, LINDSAY AND RIEKE ALSO BB THEORY DATA XION/13.777,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.,225.,250.,275.,300.,350.,400., /450.,500.,550.,600.,650.,700.,750.,800.,850.,900., /950.,1000./ C GROSS IONISATION DATA YION/0.00,.055,.097,.135,.174,.215,.255,.293,.333,.373, /.428,.452,.577,.623,.676,.727,.777,.828,.880,1.14, /1.37,1.54,1.70,1.84,1.96,2.07,2.19,2.45,2.67,2.84, /3.02,3.16,3.27,3.36,3.45,3.51,3.56,3.64,3.66,3.65, /3.63,3.52,3.43,3.32,3.21,3.05,2.97,2.82,2.58,2.43, /2.23,2.09,1.96,1.85,1.77,1.68,1.61,1.53,1.45,1.41, /1.36,1.30/ C COUNTING IONISATION DATA YINC/0.00,.055,.097,.135,.174,.215,.255,.293,.333,.373, /.428,.452,.577,.623,.676,.727,.777,.828,.880,1.14, /1.37,1.54,1.70,1.84,1.96,2.07,2.19,2.45,2.67,2.84, /3.01,3.14,3.26,3.33,3.43,3.48,3.54,3.62,3.63,3.62, /3.60,3.48,3.40,3.29,3.17,3.02,2.94,2.79,2.55,2.41, /2.21,2.08,1.94,1.84,1.75,1.66,1.60,1.51,1.44,1.40, /1.35,1.29/ C --------------------------------------------------------------------- C C ANGULAR DISTRIBUTION ONLY ALLOWED FOR ELASTIC , IONISATION AND C EXCITATION ABOVE 10EV. C IN FUTURE IF ANGULAR DISTRIBUTION FOR VIBRATIONS ARE INCLUDED THEN C ELASTIC MOMENTUM TRANSFER X-SECTION WILL ALSO NEED MODIFIED AT THE C SAME TIME TO GIVE A GOOD QUALITY OF FIT TO THE TRANSPORT PROPERTIES. C --------------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME='CO2 2007 ISOT ' ELSE NAME='CO2 2007 ANISO' ENDIF C -------------------------------------------------------------------- C --------------------------------------------------------------------- C BORN-BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 AM2=5.60 C=57.91 C NIN=85 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=1,NIN KIN(J)=NANISO 2 IF(J.LT.80) KIN(J)=0 C NEL=124 NV2=23 N2V2=25 NV1=32 N3V2=17 NV3=17 NPD3=22 NV130=19 NPD4=20 NPD5=17 NPD6=17 NPD7=17 NPD8=17 NPD9=17 NPDH=15 NATT=74 NEXC1=53 NEXC2=53 NEXC3=51 NEXC4=51 NEXC5=51 NEXC6=51 NION=62 E(1)=0.0 E(2)=2.0*EMASS/(44.0095*AMU) E(3)=13.777 C EXCITATION X-SECTION (SUM OF 13.2 AND 15 EV ) AT 1.5MEV E(4)=0.00466D-16 C IONISING X-SECTION AT 1.5 MEV E(5)=0.01355D-16 C EOBY FOR MINIMUM IONISING PARTICLE E(6)=13.0 C OPAL AND BEATY IONISATION ENERGY SPLITTING EOBY=13.8 C OFFSET ENERGY FOR PRIMARY IONISATION ELECTRON ANGULAR DISTRIBUTION IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) C 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)*DEXP(-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 6 K=1,59,2 EIN(K)=B0*(4*K+2) 6 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 OFFSET ENERGY FOR EXCITATION LEVELS ANGULAR DISTRIBUTION IOFF80=IFIX(SNGL(0.5+EIN(80)/ESTEP)) IOFF81=IFIX(SNGL(0.5+EIN(81)/ESTEP)) IOFF82=IFIX(SNGL(0.5+EIN(82)/ESTEP)) IOFF83=IFIX(SNGL(0.5+EIN(83)/ESTEP)) IOFF84=IFIX(SNGL(0.5+EIN(84)/ESTEP)) IOFF85=IFIX(SNGL(0.5+EIN(85)/ESTEP)) C*********************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C FIRST 81 LEVELS UNLIKELY TO HAVE ENOUGH ENERGY DO 7 K=1,81 DO 7 L=1,3 7 PENFRA(L,K)=0.0 C PENNING TRANSFER FRACTION FOR LEVELS 82(10.5),83(12.2),84(13.2) AND C 85(15.0EV) PENFRA(1,82)=0.0 PENFRA(1,83)=0.0 PENFRA(1,84)=0.0 PENFRA(1,85)=0.0 C PENNING TRANSFER DISTANCE IN MICRONS PENFRA(2,82)=1.0 PENFRA(2,83)=1.0 PENFRA(2,84)=1.0 PENFRA(2,85)=1.0 C PENNING TRANSFER TIME IN PICOSECONDS PENFRA(3,82)=1.0 PENFRA(3,83)=1.0 PENFRA(3,84)=1.0 PENFRA(3,85)=1.0 IF(IPEN.EQ.0) GO TO 9 DO 8 KDUM=82,85 IF(PENFRA(1,KDUM).EQ.0.0) GO TO 8 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 8 CONTINUE C*********************************************************************** C C DEGENERACY OF VIBRATIONAL STATES 9 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*DEXP(EIN(61)/AKT) APOP2V2=DEG2V2*DEXP(EIN(63)/AKT) APOPV1=DEGV1*DEXP(EIN(65)/AKT) APOP3V2=DEG3V2*DEXP(EIN(67)/AKT) APOPV3=DEGV3*DEXP(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 WRITE(6,865) APOPGS,APOPV2,APOP2V2,APOPV1,APOP3V2,APOPV3,APBEND C 865 FORMAT(' APOPGS=',F8.6,' APOPV2=',F8.6,' APOP2V2=',F8.6,' APOPV1=' C /,F8.6,' APOP3V2=',F8.6,' APOPV3=',F8.6,/,' APBEND=',F12.10) 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 WRITE(6,866) APOPGS,AEXT20 C 866 FORMAT(' RENORMALISED GS POPULATION=', F6.4,' AEXT20=',F12.10) C------------------------------------------------------ SCRPT(1)=' ' SCRPT(2)=' ELASTIC ANISOTROPIC CO2 ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC ISOTROPIC CO2 ' ENDIF 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.0 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 PQ2=0.0 GO TO 20 ENDIF DO 10 J=2,NEL IF(EN.LE.XEN(J)) GO TO 15 10 CONTINUE J=NEL 15 YXJ=DLOG(YMOM(J)) YXJ1=DLOG(YMOM(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=DEXP(A*DLOG(EN)+B)*1.D-16 YXJ=DLOG(YEL(J)) YXJ1=DLOG(YEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=DEXP(A*DLOG(EN)+B)*1.D-16 YXJ=DLOG(YVBMOM(J)) YXJ1=DLOG(YVBMOM(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QBMOM=DEXP(A*DLOG(EN)+B)*1.D-16 YXJ=DLOG(YVBEL(J)) YXJ1=DLOG(YVBEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QBELA=DEXP(A*DLOG(EN)+B)*1.D-16 YXJ=DLOG(YEPS(J)) YXJ1=DLOG(YEPS(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) PQ2=DEXP(A*DLOG(EN)+B) 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 PQ1=0.5+(QELA-QMOM)/QELA C IF(NANISO.EQ.2) THEN Q(2,I)=QELA PEQEL(2,I)=PQ2 IF(EN.LT.10.0) PEQEL(2,I)=0.0 IF(EN.LT.10.0) Q(2,I)=QMOM ENDIF IF(NANISO.EQ.1) THEN Q(2,I)=QELA PEQEL(2,I)=PQ1 IF(EN.LT.10.0) PEQEL(2,I)=0.5 IF(EN.LT.10.0) Q(2,I)=QMOM ENDIF IF(NANISO.EQ.0) THEN PEQEL(2,I)=0.5 Q(2,I)=QMOM ENDIF C C GROSS IONISATION Q(3,I)=0.0 PEQEL(3,I)=0.5 IF(NANISO.EQ.2) PEQEL(3,I)=0.0 IF(EN.LE.E(3)) GO TO 30 IF(EN.GT.XION(NION)) GO TO 23 DO 21 J=2,NION IF(EN.LE.XION(J)) GO TO 22 21 CONTINUE J=NION 22 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) GO TO 24 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 23 GAMMA=(EMASS2+2.0D0*EN)/EMASS2 BETA=DSQRT(1.0D0-1.0D0/(GAMMA*GAMMA)) BETA2=BETA*BETA X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2)/0.9921 24 CONTINUE 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 30 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C C ATTACHMENT 30 Q(4,I)=0.0 IF(EN.LE.XATT(1)) 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)=1.0D-16*(A*EN+B) C COUNTING IONISATION 40 Q(5,I)=0.0 PEQEL(5,I)=0.5 IF(NANISO.EQ.2) PEQEL(5,I)=0.0 IF(EN.LE.E(3)) GO TO 45 IF(EN.GT.XION(NION)) GO TO 43 DO 41 J=2,NION IF(EN.LE.XION(J)) GO TO 42 41 CONTINUE J=NION 42 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.0D-16 GO TO 44 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 43 Q(5,I)=CONST*(AM2*X1+C*X2) 44 CONTINUE 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 45 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 45 CONTINUE Q(6,I)=0.0 C ---------------------------------------------------------------------- C QUADRUPOLE BORN ROTATIONAL STATES (GERJUOY AND STEIN) C ---------------------------------------------------------------------- C SUPERELASTIC ROTATION DO 51 K=2,60,2 AJ=DFLOAT(K) L=(K/2)+1 PEQIN(K,I)=0.5 IF(NANISO.EQ.2) PEQIN(K,I)=0.0 51 QIN(K,I)=PJ(L)*QBK*DSQRT(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.0 PEQIN(K,I)=0.5 IF(NANISO.EQ.2) PEQIN(K,I)=0.0 IF(EN.LE.EIN(K)) GO TO 52 AJ=DFLOAT(K-1) L=(K+1)/2 QIN(K,I)=PJ(L)*QBK*DSQRT(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 C AND SET TO EFFECTIVE ZERO ABOVE 1KEV. IF(EN.LT.6.0) GO TO 80 DO 70 K=1,60 QIN(K,I)=QIN(K,I)*6.0/EN 70 IF(EN.GT.1000.0) QIN(K,I)=1.0D-30 80 CONTINUE C C SUPERELASTIC V2 BEND MODE QIN(61,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=DSQRT(1.0-(EIN(61)/EN)) QIN(61,I)=AMPV2*DLOG((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.0 IF(EN.LE.EIN(62)) GO TO 200 EFAC=DSQRT(1.0-(EIN(62)/EN)) QIN(62,I)=AMPV2*DLOG((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.0 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.0 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.0 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.0 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.0 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.0 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.0 IF(EN.LE.0.0) GO TO 550 EFAC=DSQRT(1.0-(EIN(69)/EN)) QIN(69,I)=AMPV3*DLOG((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.0 IF(EN.LE.EIN(70)) GO TO 600 EFAC=DSQRT(1.0-(EIN(70)/EN)) QIN(70,I)=AMPV3*DLOG((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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 SET FLAT ANGULAR DISTRIBUTIONS FOR VIBRATIONS DO 1030 KDUM=61,79 PEQIN(KDUM,I)=0.5 IF(NANISO.EQ.2) PEQIN(KDUM,I)=0.0 1030 CONTINUE C 1050 CONTINUE QIN(80,I)=0.0 PEQIN(80,I)=0.5 IF(NANISO.EQ.2) PEQIN(80,I)=0.0 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 IF(EN.LE.(2.0*EIN(80))) GO TO 1100 PEQIN(80,I)=PEQEL(2,(I-IOFF80)) C 1100 CONTINUE QIN(81,I)=0.0 PEQIN(81,I)=0.5 IF(NANISO.EQ.2) PEQIN(81,I)=0.0 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 IF(EN.LE.(2.0*EIN(81))) GO TO 1150 PEQIN(81,I)=PEQEL(2,(I-IOFF81)) C 1150 CONTINUE QIN(82,I)=0.0 PEQIN(82,I)=0.5 IF(NANISO.EQ.2) PEQIN(82,I)=0.0 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 IF(EN.LE.(2.0*EIN(82))) GO TO 1200 PEQIN(82,I)=PEQEL(2,(I-IOFF82)) C 1200 CONTINUE QIN(83,I)=0.0 PEQIN(83,I)=0.5 IF(NANISO.EQ.2) PEQIN(83,I)=0.0 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 IF(EN.LE.(2.0*EIN(83))) GO TO 1250 PEQIN(83,I)=PEQEL(2,(I-IOFF83)) C 1250 CONTINUE QIN(84,I)=0.0 PEQIN(84,I)=0.5 IF(NANISO.EQ.2) PEQIN(84,I)=0.0 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 IF(EN.LE.(2.0*EIN(84))) GO TO 1300 PEQIN(84,I)=PEQEL(2,(I-IOFF84)) C 1300 CONTINUE QIN(85,I)=0.0 PEQIN(85,I)=0.5 IF(NANISO.EQ.2) PEQIN(85,I)=0.0 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 IF(EN.LE.(2.0*EIN(85))) GO TO 1400 PEQIN(85,I)=PEQEL(2,(I-IOFF85)) 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)=QELA+Q(5,I)+Q(4,I)+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 RETURN END SUBROUTINE GAS13(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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='NEO-PENTANE 03 ' 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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) APOP3=DEXP(EIN(5)/AKT) EN=-ESTEP/2.0 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=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 21 CONTINUE Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC VIB1 QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS14(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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)*DEXP(-ELEV(J)*1.D-3/AKT) DO 4 J=2,100,2 4 PJ(J)=GORTHO*(2.0*AJL(J)+1.0)*DEXP(-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.0 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=DLOG(YEL(J)) Y2=DLOG(YEL(J-1)) X1=DLOG(XEL(J)) X2=DLOG(XEL(J-1)) A=(Y1-Y2)/(X1-X2) B=(X2*Y1-X1*Y2)/(X2-X1) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.0D-16 C 25 Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C ---------------------------------------------------------------- C DIPOLE BORN ROTATIONAL STATES C---------------------------------------------------------------- ENRT=DSQRT(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))*DLOG((ENRT+DSQRT(EN-EIN(L)))/ /(DSQRT(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.0 PEQIN(L,I)=0.5 IF(EN.LE.EIN(L)) GO TO 150 AL=AJIN(L) L2=(L+1)/2 QIN(L,I)=DBK*SALPHA(L2)*PJ(IMAP(L))*DLOG((ENRT+DSQRT(EN-EIN(L)))/ /(ENRT-DSQRT(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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS15(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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(34),YROT(34) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME 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/ 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/ 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/ 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/ 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 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 DATA XROT/0.002,.020,0.025,1000./ C DATA YROT/0.00,0.00,0.15,0.15/ 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, /100.,1000., 10000.,100000./ DATA YROT/0.00,0.01,0.01,0.01,.0154,.01,0.01,.0316,.01,.010, /.0484,.01,0.01,.064,0.01,0.01,.077,0.01,0.01,0.09, /0.01,0.01,0.10,0.01,0.01,0.09,0.01,0.01,0.08,0.06, /0.02,.015,.0015,.00015/ 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 NAME=' OXYGEN 2003 ' C NIN=12 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 NROT=34 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 EIN(1)=-0.020 EIN(2)=0.020 EIN(3)=0.193 EIN(4)=0.386 EIN(5)=0.579 EIN(6)=0.772 EIN(7)=0.977 EIN(8)=1.627 EIN(9)=4.50 EIN(10)=6.10 EIN(11)=8.40 EIN(12)=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 ELOSS= -0.020 ' SCRPT(8)=' ROT ELOSS= 0.020 ' SCRPT(9)=' VIB V1 ELOSS= 0.193 ' SCRPT(10)=' VIB 2V1 ELOSS= 0.386 ' SCRPT(11)=' VIB 3V1 ELOSS= 0.579 ' SCRPT(12)=' VIB 4V1 ELOSS= 0.772 ' SCRPT(13)=' EXC A1(DEL)G ELOSS= 0.977 ' SCRPT(14)=' EXC B1(SIG)G ELOSS= 1.627 ' SCRPT(15)=' EXC C1+C3 ELOSS= 4.50 ' SCRPT(16)=' EXC A3 DISOC ELOSS= 6.10 ' SCRPT(17)=' EXC B3 DISOC ELOSS= 8.40 ' SCRPT(18)=' EXC ELOSS= 9.30 ' C CALCULATE DENSITY CORRECTION FOR THREE BODY ATTACHMENT CROSS-SECTION FAC=273.15*TORR/((TEMPC+273.15)*760.0) C APOP1=DEXP(EIN(1)/AKT) EN=-ESTEP/2.0 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.0 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 SINGLE=0.0 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-16 C 250 THREEB=0.0 IF(EN.LT.X3ATT(1)) GO TO 300 IF(EN.GT.X3ATT(N3ATT)) GO TO 300 DO 260 J=2,N3ATT IF(EN.LE.X3ATT(J)) GO TO 270 260 CONTINUE J=N3ATT 270 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 300 Q(4,I)=SINGLE+THREEB Q(5,I)=0.0 Q(6,I)=0.0 C SUPERELASTIC ROTATION QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 350 DO 330 J=2,NROT IF((EN+EIN(2)).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(1,I)=(A*(EN+EIN(2))+B)*(EN+EIN(2))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 350 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) 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(2,I)=(A*EN+B)/(1.0+APOP1)*1.D-16 400 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) 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(3,I)=(A*EN+B)*1.D-16 500 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) 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(4,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) 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(5,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) 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(6,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) 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(7,I)=(A*EN+B)*1.D-16 900 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) 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(8,I)=(A*EN+B)*1.D-16 1000 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) 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(9,I)=(A*EN+B)*1.D-16 1100 CONTINUE C QIN(10,I)=0.0 IF(EN.LE.EIN(10)) 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(10,I)=(A*EN+B)*1.D-16 1200 CONTINUE C QIN(11,I)=0.0 IF(EN.LE.EIN(11)) 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(11,I)=(A*EN+B)*1.D-16 1300 CONTINUE C QIN(12,I)=0.0 IF(EN.LE.EIN(12)) 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(12,I)=(A*EN+B)*1.D-16 1400 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,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) 9900 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 RETURN END SUBROUTINE GAS16(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220), /PJ(220) DIMENSION XELA(184),YELA(184),YMOM(184),YEPS(184), /XROT(70),YROT(70), /XVB1(91),YVB1(91),XVB2(73),YVB2(73),XVB3(74),YVB3(74), /XVB4(54),YVB4(54),XVB5(44),YVB5(44),XVB6(45),YVB6(45), /XVB7(46),YVB7(46),XVB8(44),YVB8(44),XVB9(39),YVB9(39), /XVB10(39),YVB10(39),XVB11(39),YVB11(39),XVB12(37),YVB12(37), /XVB13(35),YVB13(35),XVB14(32),YVB14(32),XVB15(36),YVB15(36), /XTRP1(30),YTRP1(30),YTP1M(30),XTRP2(30),YTRP2(30),YTP2M(30), /XTRP3(28),YTRP3(28),YTP3M(28),XTRP4(29),YTRP4(29),YTP4M(29), /XTRP5(30),YTRP5(30),YTP5M(30),XTRP6(28),YTRP6(28),YTP6M(28), /XTRP7(28),YTRP7(28),YTP7M(28),XTRP8(28),YTRP8(28),YTP8M(28), /XTRP9(27),YTRP9(27),YTP9M(27),XTRP10(27),YTRP10(27),YTP10M(27), /XTRP11(26),YTRP11(26),YTP11M(26),XTRP12(29),YTRP12(29),YTP12M(29), /XTRP13(17),YTRP13(17),YTP13M(17),XTRP14(17),YTRP14(17),YTP14M(17), /XSNG1(33),YSNG1(33),YSG1M(33),XSNG2(24),YSNG2(24),YSG2M(24), /XSNG3(24),YSNG3(24),YSG3M(24),XSNG4(33),YSNG4(33),YSG4M(33), /XSNG5(24),YSNG5(24),YSG5M(24),XSNG6(23),YSNG6(23),YSG6M(23), /XSNG7(19),YSNG7(19),YSG7M(19),XSNG8(54),YSNG8(54),YSG8M(54), /XSNG9(54),YSNG9(54),YSG9M(54),XSNG10(54),YSNG10(54),YSG10M(54), /XSNG11(54),YSNG11(54),YSG11M(54),XSNG12(54),YSNG12(54),YSG12M(54), /XSNG13(54),YSNG13(54),YSG13M(54),XSNG14(54),YSNG14(54),YSG14M(54), /XSNG15(28),YSNG15(28),YSG15M(28), /XION(87),YION(87),YINC(87) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME DATA XELA/0.00,.001,.0015,.0018,.002,.0025,.003,.004,.005,.006, /.007,.008,.009,.010,.012,.015,.018,.020,.025,.030, /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.10,1.20,1.30,1.40,1.50,1.60,1.70,1.80,1.85,1.90, /1.95,2.00,2.05,2.10,2.15,2.20,2.25,2.30,2.35,2.40, /2.45,2.50,2.55,2.60,2.65,2.70,2.75,2.80,2.85,2.90, /2.95,3.00,3.05,3.10,3.15,3.20,3.25,3.30,3.35,3.40, /3.45,3.50,3.60,3.70,3.80,3.90,4.00,4.50,5.00,5.50, /6.00,6.50,7.00,8.00,9.00,10.0,12.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.,3500.,4000.,4500.,5000.,6000.,7000.,8000.,9000., /10000.,1.25D4,1.5D4,1.75D4,2.0D4,2.5D4,3.0D4,3.5D4,4.0D4,4.5D4, /5.0D4,6.0D4,7.0D4,8.0D4,9.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5, /2.5D5,3.0D5,3.5D5,4.0D5,4.5D5,5.0D5,6.0D5,7.0D5,8.0D5,9.0D5, /1.0D6,1.25D6,1.50D6,1.75D6,2.0D6,2.5D6,3.0D6,4.0D6,5.0D6,6.0D6, /8.0D6,1.0D7,1.5D7,2.0D7/ C ELASTIC +ROTATION X-SECTION DATA YELA/1.12,1.377,1.446,1.484,1.510,1.570,1.640,1.738,1.830, /1.928, /2.020,2.082,2.151,2.210,2.362,2.570,2.780,2.900,3.170,3.430, /3.850,4.170,4.480,4.750,5.000,5.250,5.450,5.850,6.300,6.800, /7.000,7.600,8.000,8.600,9.000,9.200,9.300,9.450,9.650,9.840, /10.00,10.24,10.48,10.67,11.05,11.71,12.90,14.90,16.10,17.60, /17.40,17.10,16.30,17.10,20.30,24.10,21.70,18.80,17.90,22.20, /24.90,21.70,18.00,16.80,20.90,22.45,20.30,17.00,16.80,18.70, /18.70,16.50,15.30,15.70,16.00,15.40,14.60,14.50,14.70,14.30, /13.50,13.80,13.60,13.30,13.15,13.00,12.90,11.90,11.60,11.40, /11.20,11.10,11.10,10.90,10.80,11.20,11.40,11.80,11.80,11.30, /10.70,9.660,8.740,8.090,7.530,7.130,6.380,5.840,5.330,4.940, /4.650,4.100,3.600,3.300,2.990,2.620,2.320,2.100,1.930,1.780, /1.660,1.470,1.300,1.200,1.110,1.030,0.870,0.765,0.670,0.600, /0.496,0.420,0.364,0.321,0.288,0.261,0.219,0.189,0.167,0.149, /0.135,0.109,.0919,.0795,.0702,.0570,.0483,.0420,.0372,.0336, /.0306,.0262,.0231,.0207,.0189,.0174,.0148,.0130,.0118,.0108, /.00953,.00868,.00808,.00764,.00730,.00703,.00664,.00637,.00617, /.00602, /.00591,.00572,.00560,.00552,.00546,.00539,.00535,.00530,.00528, /.00527, /.00525,.00525,.00524,.00524/ C ELASTIC+ROTATION MOMENTUM TRANSFER X-SECTION DATA YMOM/1.12,1.377,1.446,1.484,1.510,1.570,1.640,1.738,1.830, /1.928, /2.020,2.082,2.151,2.210,2.362,2.570,2.780,2.900,3.170,3.430, /3.900,4.350,4.750,5.100,5.410,5.690,5.950,6.450,7.100,7.590, /7.900,8.500,9.000,9.700,10.30,10.90,11.25,11.40,11.30,11.10, /10.90,10.65,10.45,10.65,10.80,11.85,13.60,16.00,17.40,19.00, /18.80,18.60,17.80,18.50,21.70,25.50,23.10,20.20,19.30,23.50, /26.20,23.00,19.30,18.10,22.20,23.70,21.50,18.10,17.80,19.60, /19.40,17.10,15.70,15.90,15.90,15.10,14.00,13.50,13.30,12.50, /11.40,11.40,11.00,10.60,10.20,10.00,9.900,9.100,8.900,8.700, /8.500,8.400,8.300,8.200,8.200,8.300,8.400,8.500,8.500,8.300, /7.800,7.200,6.700,6.310,5.950,5.600,4.700,4.000,3.500,3.000, /2.650,2.100,1.650,1.370,1.179,0.861,0.662,0.527,0.431,0.360, /0.306,0.230,0.179,0.144,0.119,0.100,.0687,.0504,.0387,.0307, /.0208,.0151,.0115,.00904,.00733,.00607,.00438,.00332,.00261, /.00211, /.00174,.00116,8.37D-4,6.33D-4,4.97D-4,3.32D-4,2.39D-4,1.81D-4, /1.43D-4,1.15D-4, /9.56D-5,6.91D-5,5.26D-5,4.16D-5,3.39D-5,2.82D-5,1.92D-5,1.41D-5, /1.09D-5,8.71D-6, /6.04D-6,4.50D-6,3.52D-6,2.86D-6,2.38D-6,2.02D-6,1.52D-6,1.20D-6, /9.83D-7,8.21D-7, /6.99D-7,5.00D-7,3.77D-7,2.97D-7,2.40D-7,1.68D-7,1.25D-7,7.78D-8, /5.34D-8,3.91D-8, /2.37D-8,1.60D-8,7.73D-9,4.58D-9/ C ELASTIC ANISOTROPY FUNCTION DATA YEPS/20*0.00, /-.01974,-.06500,-.09085,-.11025,-.12263,-.12532,-.13709,-.15311, /-.18909,-.17321, /-.19143,-.17651,-.18619,-.19046,-.21464,-.27297,-.30840,-.30369, /-.25314,-.19066, /-.13451,-.06001,0.00429,0.00281,0.03393,-.01794,-.08128,-.11047, /-.12077,-.11898, /-.12034,-.13112,-.13750,-.12243,-.10323,-.08700,-.09660,-.11142, /-.11699,-.08770, /-.07822,-.08972,-.10807,-.11576,-.09314,-.08340,-.08852,-.09688, /-.08914,-.07212, /-.05611,-.05451,-.03920,-.01911,0.00937,0.02922,0.06160,0.10323, /0.14228,0.18747, /0.23082,0.25736,0.28211,0.29895,0.32902,0.33802,0.34052,0.34433, /0.34080,0.34648, /0.35236,0.35537,0.36780,0.36154,0.35190,0.37697,0.38275,0.40516, /0.40516,0.38593, /0.39347,0.37111,0.34171,0.32298,0.30861,0.31533,0.38298,0.45227, /0.48887,0.55047, /0.59500,0.65988,0.71600,0.75776,0.77685,0.83247,0.86526,0.88911, /0.90685,0.91951, /0.92969,0.94445,0.95363,0.96172,0.96723,0.97137,0.97832,0.98295, /0.98564,0.98773, /0.99049,0.99218,0.99335,0.99424,0.99492,0.99546,0.99623,0.99678, /0.99721,0.99752, /.997788,.998241,.998539,.998754,.998916,.999138,.999288,.999393, /.999469,.999536, /.999582,.999656,.999709,.999748,.999779,.999803,.999847,.9998751, /.9998958,.9999105, /.9999317,.9999455,.9999551,.9999621,.9999675,.9999717,.9999780, /.9999823,.9999853,.9999876, /.9999894,.9999924,.9999943,.9999955,.9999964,.9999975,.9999982, /.9999989,.9999992,.9999995, /.9999997,.9999998,.9999999,.9999999/ C ROTATIONAL RESONANCE FUNCTION DATA XROT/0.00,1.00,1.10,1.20,1.30,1.40,1.50,1.60,1.70,1.80, /1.85,1.90,1.95,1.98,2.00,2.05,2.10,2.15,2.20,2.25, /2.30,2.35,2.40,2.45,2.50,2.55,2.60,2.65,2.69,2.70, /2.75,2.80,2.85,2.90,2.95,3.00,3.05,3.10,3.15,3.20, /3.25,3.30,3.35,3.40,3.45,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,5.10,5.20,5.30,5.40,5.50,5.60,5.70,5.80,5.90/ DATA YROT/0.00,0.00,0.00,0.10,0.20,0.30,0.40,1.10,2.30,4.30, /5.50,7.00,6.80,7.10,6.50,5.70,6.50,9.70,13.5,11.1, /8.20,7.30,11.6,14.3,11.1,7.40,6.20,10.2,12.0,11.8, /9.60,6.30,6.10,8.00,8.00,5.80,4.60,5.00,5.30,4.70, /3.90,3.80,4.00,3.50,2.70,3.00,2.80,2.50,2.40,2.20, /2.10,1.90,1.70,1.50,1.20,1.00,0.80,0.70,0.60,0.50, /0.40,0.30,0.20,0.10,0.00,0.00,0.00,0.00,0.00,0.00/ C ALLAN AND VICIC FROM 1.6 EV TO 4.5 EV FOR VIBRATIONS DATA XVB1/.2889,.289,.290,.292,.293,.295,.300,.310,.320,.330, /.340,.360,.380,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.10,1.20,1.30,1.35,1.40,1.45,1.50,1.55,1.60,1.65, /1.70,1.75,1.80,1.85,1.90,1.95,2.00,2.05,2.10,2.15, /2.20,2.25,2.30,2.35,2.40,2.45,2.50,2.55,2.60,2.65, /2.70,2.75,2.80,2.85,2.90,2.95,3.00,3.05,3.10,3.15, /3.20,3.25,3.30,3.35,3.40,3.45,3.50,3.55,3.60,3.65, /3.70,3.75,3.80,3.90,4.00,4.50,5.00,7.50,10.0,15.0, /18.0,20.0,22.5,25.0,30.0,50.0,80.0,160.,1000.,1.D6, /1.D7/ C V1 DATA YVB1/.00,.00018,.00045,.00072,.00082,.00099,.00131, /.00174,.00203,.00225, /.00242,.00267,.00283,.00294,.00340,.00360,.0039,.0044,.0054,.0066, /.0086,.0125,.0182,.0230,.0295,.0370,.0475,.0580,.0750,.103, /.178,.320,.600,1.20,2.40,4.35,4.40,2.71,1.67,2.40, /3.62,4.90,4.46,3.31,2.26,1.74,2.90,4.15,4.25,2.95, /1.61,1.97,2.95,3.43,2.30,1.41,1.63,2.30,2.01,1.54, /1.12,1.27,1.37,1.27,0.96,0.84,.820,.768,.648,.600, /.624,.528,.432,.390,.330,.230,.075,.025,.012,.031, /.061,.156,.101,.066,.022,.012,.006,.003,0.00,0.00, /0.00/ C V2 DATA XVB2/.5742,.600,.700,.800,.900,1.00,1.10,1.20,1.30,1.40, /1.50,1.55,1.60,1.65,1.70,1.75,1.80,1.85,1.90,1.95, /2.00,2.05,2.10,2.15,2.20,2.25,2.30,2.35,2.40,2.45, /2.50,2.55,2.60,2.65,2.70,2.75,2.80,2.85,2.90,2.95, /3.00,3.05,3.10,3.15,3.20,3.25,3.30,3.35,3.40,3.45, /3.50,3.55,3.60,3.70,3.80,3.90,4.00,4.50,5.00,7.50, /10.0,15.0,18.0,20.0,22.5,25.0,30.0,50.0,80.0,160., /1000.,1.D6,1.D7/ DATA YVB2/.0,1.D-5,4.D-5,9.D-5,1.5D-4,2.0D-4,2.8D-4,3.2D-4,5.D-4, /8.1D-4, /.0026,.0059,.0115,.026,.051,.123,.236,.491,0.94,2.26, /2.90,2.55,2.20,1.45,.856,.682,1.33,2.40,3.05,2.78, /1.70,.672,.800,1.48,1.61,1.25,.805,.501,.670,.890, /.890,.650,.444,.428,.539,.491,.364,.225,.285,.238, /.200,.168,.156,.127,.101,.085,.072,.042,.014,.004, /.002,.006,.012,.030,.020,.012,.004,.002,.001,.0005, /0.00,0.00,0.00/ C V3 DATA XVB3/.8559,.900,1.00,1.10,1.20,1.30,1.40,1.50,1.60,1.65, /1.70,1.75,1.80,1.85,1.90,1.95,2.00,2.05,2.10,2.15, /2.16,2.20,2.25,2.30,2.35,2.40,2.45,2.50,2.55,2.60, /2.65,2.70,2.75,2.80,2.85,2.90,2.95,3.00,3.05,3.10, /3.15,3.20,3.25,3.30,3.35,3.40,3.45,3.50,3.55,3.60, /3.65,3.70,3.75,3.80,3.85,3.90,3.95,4.00,4.50,5.00, /7.50,10.0,15.0,18.0,20.0,22.5,25.0,30.0,50.0,80.0, /160.,1000.,1.D6,1.D7/ DATA YVB3/.0,1.D-5,3.7D-5,7.D-5,9.8D-5,1.3D-4,1.8D-4,4.1D-4, /.0021,.0050, /.012,.028,.071,.160,.300,.807,1.30,1.87,2.11,2.55, /2.57,2.35,1.52,.617,.438,.656,1.46,1.75,1.81,1.38, /.630,.250,.409,.747,1.00,.682,.309,.144,.263,.412, /.360,.212,.131,.148,.183,.200,.157,.114,.079,.101, /.101,.079,.057,.053,.058,.053,.044,.035,.023,.008, /.0023,.001,.003,.007,.017,.011,.006,.002,.001,.0005, /.00025,0.00,0.00,0.00/ C V4 DATA XVB4/1.1342,1.80,1.85,1.90,1.95,2.00,2.05,2.10,2.15,2.20, /2.22,2.25,2.30,2.35,2.40,2.45,2.50,2.55,2.60,2.65, /2.70,2.75,2.80,2.85,2.90,2.95,3.00,3.05,3.10,3.15, /3.20,3.25,3.30,3.35,3.40,3.50,3.60,3.80,4.00,4.50, /5.00,7.50,10.0,15.0,18.0,20.0,22.5,30.0,50.0,80.0, /160.,1000.,1.D6,1.D7/ DATA YVB4/0.0,0.00,9.D-5,.064,.170,.269,.465,.743,1.29,1.76, /1.79,1.72,1.41,1.04,.600,.234,.168,.439,.797,.994, /.806,.474,.215,.104,.197,.385,.394,.260,.198,.063, /.098,.151,.205,.089,.070,.078,.061,.044,.035,.026, /.009,.0026,.00105,.0016,.003,.008,.005,.003,.001,.0005, /.00025,0.00,0.00,0.00/ C V5 DATA XVB5/1.4088,1.90,1.95,2.00,2.05,2.10,2.15,2.20,2.25,2.30, /2.35,2.40,2.45,2.50,2.55,2.60,2.65,2.70,2.75,2.80, /2.85,2.90,2.95,3.00,3.05,3.10,3.15,3.20,3.25,3.30, /3.35,3.40,3.45,3.50,4.00,4.50,5.00,7.50,10.0,20.0, /100.,1000.,1.D6,1.D7/ DATA YVB5/0.00,0.00,.0009,.0118,.0531,.136,.313,.490,.655,.791, /1.04,1.18,1.01,.631,.295,.101,.068,.195,.395,.502, /.519,.313,.106,.024,.101,.195,.183,.112,.068,.018, /.035,.065,.065,.024,.014,.0096,.0032,.00096,.00024,.00012, /.00001,0.00,0.00,0.00/ C V6 DATA XVB6/1.6801,2.05,2.10,2.15,2.20,2.25,2.30,2.35,2.40,2.45, /2.50,2.55,2.60,2.65,2.70,2.75,2.80,2.85,2.90,2.95, /3.00,3.05,3.10,3.15,3.20,3.25,3.30,3.35,3.40,3.45, /3.50,3.55,3.60,3.65,3.70,4.00,4.50,5.00,7.50,10.0, /20.0,100.,1000.,1.D6,1.D7/ DATA YVB6/0.00,0.00,9.D-5,.0117,.0463,.124,.192,.344,.487,.602, /.615,.602,.577,.527,.307,.124,.050,.103,.193,.270, /.270,.180,.084,.0372,.0527,.103,.128,.096,.062,.0248, /.0186,.0312,.0372,.0372,.0155,.010,.052,.017,.0052,.0021, /.00105,.00001,0.00,0.00,0.00/ C V7 DATA XVB7/1.9475,2.25,2.30,2.35,2.40,2.45,2.50,2.55,2.60,2.65, /2.68,2.70,2.75,2.80,2.85,2.90,2.95,3.00,3.05,3.10, /3.15,3.20,3.25,3.30,3.35,3.40,3.45,3.50,3.55,3.60, /3.65,3.70,3.75,3.80,3.85,3.90,4.00,4.50,5.00,7.50, /10.0,20.0,100.,1000.,1.D6,1.D7/ DATA YVB7/0.00,0.00,.0009,.0255,.0526,.089,.133,.178,.232,.303, /.318,.304,.231,.159,.119,.0542,.0239,.0255,.0796,.113, /.108,.0812,.0413,.0112,.0064,.0207,.0334,.0366,.0224,.0128, /.0128,.0157,.0183,.0166,.0096,.0074,.0057,.0039,.0013,.00039, /.00015,.00008,.000008,0.00,0.00,0.00/ C V8 DATA XVB8/2.2115,2.40,2.45,2.50,2.55,2.60,2.65,2.70,2.75,2.80, /2.85,2.88,2.90,2.95,3.00,3.05,3.10,3.15,3.20,3.25, /3.30,3.35,3.40,3.45,3.50,3.55,3.60,3.65,3.70,3.75, /3.80,3.85,3.90,3.95,4.00,4.50,5.00,7.50,10.0,20.0, /100.,1000.,1.D6,1.D7/ DATA YVB8/0.00,0.00,9.D-6,.003,.011,.017,.042,.0656,.0739,.098, /.135,.140,.128,.084,.035,.014,.003,.007,.028,.0460, /.0460,.028,.011,.003,.0018,.011,.0123,.0140,.0084,.0035, /.0018,.0018,.0026,.0029,.0014,.0010,.0003,.00010,.000040,.000020, /.0000020,0.00,0.00,0.00/ C V9 DATA XVB9/2.4718,2.65,2.70,2.75,2.80,2.85,2.90,2.95,3.00,3.05, /3.07,3.10,3.15,3.20,3.25,3.30,3.35,3.40,3.45,3.50, /3.55,3.60,3.65,3.70,3.75,3.80,3.85,3.90,3.95,4.00, /4.50,5.00,7.50,10.0,20.0,100.,1000.,1.D6,1.D7/ DATA YVB9/0.00,.0011,.0028,.0069,.0132,.0264,.0412,.0474,.0438, /.0496, /.0528,.0438,.0247,.0739,.00295,.00581,.0159,.0232,.0264,.0206, /.0116,.00296,.00296,.00581,.00739,.00739,.00528,.00295,.00147, /.00070, /.00039,.00013,.000039,.0000157,.0000079,7.9D-7,0.00,0.00,0.00/ C V10 DATA XVB10/2.7284,2.90,2.95,3.00,3.05,3.10,3.15,3.20,3.25,3.30, /3.35,3.40,3.45,3.50,3.55,3.60,3.65,3.70,3.75,3.80, /3.85,3.90,3.95,4.00,4.05,4.10,4.15,4.20,4.25,4.30, /4.50,5.00,7.50,10.0,20.0,100.,1000.,1.D6,1.D7/ DATA YVB10/0.00,.000040,.00170,.00554,.0103,.0154,.0205,.0201, /.0147,.0103, /.00677,.00225,.00137,.00452,.00800,.0116,.0119,.00800,.00390, /.00137, /.00205,.00390,.00573,.00573,.00452,.00349,.00225,.00116,.00042, /.00026, /.00017,5.8D-5,1.7D-5,7.0D-6,3.5D-6,3.5D-7,0.00,0.00,0.00/ C V11 DATA XVB11/2.9815,3.10,3.15,3.20,3.25,3.30,3.35,3.40,3.45,3.50, /3.55,3.60,3.65,3.70,3.75,3.80,3.85,3.90,3.95,4.00, /4.05,4.10,4.15,4.20,4.25,4.30,4.35,4.40,4.45,4.50, /4.60,5.00,7.50,10.0,20.0,100.,1000.,1.D6,1.D7/ DATA YVB11/0.00,3.29D-4,.00170,.00291,.00445,.00550,.00462, /.00291,.00170,6.04D-4, /2.20D-4,.00105,.00275,.00344,.00303,.00198,7.70D-4,1.65D-4, /2.75D-4,4.40D-4, /.00116,.00110,3.85D-4,5.50D-5,5.50D-5,3.30D-4,3.85D-4,3.30D-4, /1.65D-4,8.70D-5, /2.88D-5,9.60D-6,2.88D-6,1.16D-6,5.8D-7,5.8D-8,0.00,0.00,0.00/ C V12 DATA XVB12/3.2310,3.30,3.35,3.40,3.45,3.50,3.55,3.60,3.65,3.70, /3.75,3.80,3.85,3.90,3.95,4.00,4.05,4.10,4.15,4.20, /4.25,4.30,4.35,4.40,4.45,4.50,4.55,4.60,4.65,5.00, /7.50,10.0,20.0,100.,1000.,1.D6,1.D7/ DATA YVB12/0.00,3.66D-5,3.78D-4,6.22D-4,.00107,.00119,.00092, /4.40D-4,1.59D-4,1.10D-4, /4.52D-4,8.06D-4,.00122,.00107,6.96D-4,3.17D-4,7.32D-5,8.55D-5, /3.05D-4,3.78D-4, /3.05D-4,1.53D-4,7.33D-5,1.22D-5,7.33D-5,1.46D-4,8.55D-5,1.22D-5, /6.10D-6,2.04D-6, /6.10D-7,2.44D-7,1.22D-7,1.22D-8,0.00,0.00,0.00/ C V13 DATA XVB13/3.4769,3.55,3.60,3.65,3.70,3.75,3.80,3.85,3.90,3.95, /4.00,4.05,4.10,4.15,4.20,4.25,4.30,4.35,4.40,4.45, /4.50,4.55,4.60,4.65,4.70,4.75,4.80,5.00,7.50,10.0, /20.0,100.,1000.,1.D6,1.D7/ DATA YVB13/0.00,4.90D-5,1.02D-4,1.96D-4,2.16D-4,1.18D-4,3.92D-5, /3.92D-5,1.46D-4,2.94D-4, /3.68D-4,3.92D-4,2.72D-4,1.22D-4,2.75D-5,6.28D-5,9.77D-5,1.49D-4, /1.18D-4,6.28D-5, /1.57D-5,1.57D-5,2.35D-5,4.71D-5,3.14D-5,1.96D-5,3.93D-6,1.31D-6, /3.93D-7,1.57D-7, /7.8D-8,7.8D-9,0.00,0.00,0.00/ C V14 DATA XVB14/3.7191,3.80,3.85,3.90,3.95,4.00,4.05,4.10,4.15,4.20, /4.25,4.30,4.35,4.40,4.45,4.50,4.55,4.60,4.65,4.70, /4.75,4.80,4.85,4.90,4.95,7.50,10.0,20.0,100.,1000., /1.D6,1.D7/ DATA YVB14/0.00,9.07D-6,1.70D-5,1.70D-5,6.80D-6,7.94D-6,3.51D-5, /7.83D-5,1.14D-4,1.09D-4, /7.14D-5,3.51D-5,6.80D-6,9.07D-6,4.31D-5,5.44D-5,3.51D-5,1.70D-5, /4.54D-6,6.80D-6, /1.02D-5,1.70D-5,9.07D-6,5.67D-6,1.75D-6,1.75D-7,6.98D-8,3.5D-8, /3.5D-9,0.00, /0.00,0.00/ C V15 DATA XVB15/3.9576,4.05,4.10,4.15,4.20,4.25,4.30,4.35,4.40,4.45, /4.50,4.55,4.60,4.65,4.70,4.75,4.80,4.85,4.90,4.95, /5.00,5.05,5.10,5.15,5.20,5.25,5.30,5.40,5.50,7.50, /10.0,20.0,100.,1000.,1.D6,1.D7/ DATA YVB15/0.00,9.42D-7,1.25D-6,2.51D-6,5.34D-6,1.94D-5,2.89D-5, /3.14D-5,2.16D-5,1.10D-5, /4.40D-6,5.96D-6,1.20D-5,1.98D-5,1.64D-5,9.07D-6,3.77D-6,3.77D-6, /7.22D-6,7.22D-6, /6.28D-6,3.77D-6,3.46D-6,4.39D-6,4.71D-6,4.71D-6,3.77D-6,2.18D-6, /1.09D-6,1.09D-7, /4.36D-8,2.2D-8,2.2D-9,0.00,0.00,0.00/ C A3SIG(V=0-4) (V=0 ENERGY=6.169 EV) AVERAGE ENERGY LOSS =6.725 EV DATA XTRP1/6.725,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,100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP1/0.00,.0035,.0100,.0440,.0280,.0240,.022,.021,.020,.019, /.016,.015,.014,.013,.0108,.0099,.0087,.0069,.0057,.0046, /.0033,.0019,.00094,.0003,.0001,2.5D-5,2.5D-6,0.00,0.00,0.00/ DATA YTP1M/0.92,0.92,0.92,0.92,0.92,0.92,0.93,0.94,0.94,0.95, /0.97,1.01,1.07,1.12,1.14,1.16,1.18,1.22,1.21,1.20, /1.18,1.00,0.92,0.72,0.42,0.22,0.03,.003,0.00,0.00/ C A3SIG(V=5-9) (V=5 ENERGY=7.023 EV) AVERAGE ENERGY LOSS =7.360 EV DATA XTRP2/7.360,7.50,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,100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP2/0.00,.0071,.0180,.072,.108,.096,.094,.092,.085,.081, /.069,.064,.059,.054,.049,.043,.038,.029,.024,.020, /.0136,.0076,.0040,.0013,.0004,.0001,1.D-5,0.00,0.00,0.00/ DATA YTP2M/0.92,0.92,0.92,0.92,0.92,0.92,0.93,0.94,0.94,0.95, /0.97,1.01,1.07,1.12,1.14,1.16,1.18,1.22,1.21,1.20, /1.18,1.00,0.92,0.72,0.42,0.22,0.03,.003,0.00,0.00/ C B3PI(V=0-3) (V=0 ENERGY=7.353 EV) AVERAGE ENERGY LOSS =7.744 EV DATA XTRP3/7.744,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, /100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP3/.0,.018,.132,.194,.188,.173,.161,.150,.138,.128, /.116,.108,.089,.077,.063,.053,.047,.035,.026,.0113, /.0039,.0013,.0004,.0001,1.D-5,0.00,0.00,0.00/ DATA YTP3M/1.06,1.06,1.06,1.06,1.12,1.18,1.18,1.16,1.14,1.12, /1.10,1.08,1.06,1.08,1.12,1.16,1.16,1.17,1.18,1.06, /0.94,0.72,0.42,0.22,0.03,.003,0.00,0.00/ C W3DEL(V=0-5) (V=0 ENERGY=7.362 EV) AVERAGE ENERGY LOSS = 8.050 EV DATA XTRP4/8.050,8.50,9.00,10.0,11.0,12.0,14.0,15.0,16.0,17.0, /18.0,20.0,22.0,24.0,26.0,28.0,30.0,34.0,40.0,50.0, /70.0,100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP4/.0,.0010,.007,.016,.023,.030,.044,.050,.053,.053, /.052,.047,.039,.032,.027,.023,.020,.015,.0112,.0073, /.00366,.00183,6.D-4,2.D-4,5.D-5,5.D-6,0.00,0.00,0.00/ DATA YTP4M/1.20,1.20,1.20,1.20,1.14,1.08,1.08,1.13,1.16,1.19, /1.21,1.22,1.23,1.24,1.25,1.26,1.27,1.26,1.23,1.19, /1.11,0.98,0.72,0.42,0.22,0.03,.003,0.00,0.00/ C A3SIG(V=10-21) (V=10 ENERGY=7.790 EV) AVERAGE ENERGY LOSS=8.217 EV DATA XTRP5/8.217,8.30,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,100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP5/0.0,.0069,.0365,.0450,.055,.096,.100,.097,.091,.086, /.073,.066,.060,.055,.050,.044,.038,.031,.024,.020, /.0145,.0080,.0043,.0014,.00046,.0001,1.D-5,0.00,0.00,0.00/ DATA YTP5M/0.92,0.92,0.92,0.92,0.92,0.92,0.93,0.94,0.94,0.95, /0.97,1.01,1.07,1.12,1.14,1.16,1.18,1.22,1.21,1.20, /1.18,1.00,0.92,0.72,0.42,0.22,0.03,.003,0.00,0.00/ C B3PI(V=4-16) (V=4 ENERGY=8.177 EV) AVERAGE ENERGY LOSS= 8.451 EV DATA XTRP6/8.451,8.50,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, /100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP6/.0,.011,.090,.133,.129,.119,.110,.102,.094,.088, /.079,.074,.061,.053,.044,.037,.032,.023,.017,.0077, /.0028,.0010,.0003,1.D-4,1.D-5,0.00,0.00,0.00/ DATA YTP6M/1.06,1.06,1.06,1.06,1.12,1.18,1.18,1.16,1.14,1.12, /1.10,1.08,1.06,1.08,1.12,1.16,1.16,1.17,1.18,1.06, /0.94,0.72,0.42,0.22,0.03,.003,0.00,0.00/ C W3DEL(V=6-10) (V=6 ENERGY=8.419 EV) AVERAGE ENERGY LOSS= 8.729 EV DATA XTRP7/8.729,9.00,10.0,11.0,12.0,14.0,15.0,16.0,17.0,18.0, /20.0,22.0,24.0,26.0,28.0,30.0,34.0,40.0,50.0,70.0, /100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP7/.0,0.004,.032,.048,.064,.092,.105,.110,.110, /.108, /.097,.082,.066,.056,.048,.041,.032,.023,.0153,.0076, /.0038,.0013,.0004,1.D-4,1.D-5,0.00,0.00,0.00/ DATA YTP7M/1.20,1.20,1.20,1.14,1.08,1.08,1.13,1.16,1.19,1.21, /1.22,1.23,1.24,1.25,1.26,1.27,1.26,1.23,1.19,1.11, /0.98,0.72,0.42,0.22,0.03,.003,0.00,0.00/ C A1PI(V=0-3) (V=0 ENERGY=8.549 EV) AVERAGE ENERGY LOSS= 8.950 EV DATA XSNG1/8.950,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0, /19.0,20.0,24.0,27.0,30.0,40.0,50.0,70.0,100.,150., /200.,250.,300.,500.,700.,1000.,2000.,4000.,10000.,20000., /1.D5,1.D6,1.D7/ DATA YSNG1/.0,.013,.025,.040,.059,.082,.101,.116,.123,.128, /.130,.130,.125,.119,.112,.087,.071,.051,.036,.0242, /.0182,.0147,.0122,.0074,.0054,.0038,.0019,.0010,.00038,.00019, /3.8D-5,3.8D-6,3.8D-7/ DATA YSG1M/0.80,0.80,0.75,0.70,0.66,0.60,0.55,0.53,0.51,0.50, /0.49,0.48,0.50,0.52,0.54,0.48,0.41,0.34,0.24,0.20, /0.19,0.18,0.17,0.16,0.12,.091,.051,.028,.013,.007, /.0016,.00012,.000010/ C B'3SIG(V=0-6) (V=0 ENERGY=8.165 EV) AVERAGE ENERGY LOSS= 8.974 EV DATA XTRP8/8.974,9.50,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0, /18.0,19.0,20.0,22.0,26.0,30.0,34.0,40.0,50.0,70.0, /100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP8/.0,.0002,.0010,.0032,.0081,.0136,.0203,.0252,.0274, /.0274, /.0264,.0250,.0236,.0209,.0151,.0114,.0089,.0064,.0041,.0020, /.0010,.0003,.0001,3.D-5,3.D-6,0.00,0.00,0.00/ DATA YTP8M/0.90,0.90,0.90,0.90,0.90,0.91,0.93,0.97,1.07,1.17, /1.22,1.22,1.23,1.26,1.32,1.37,1.35,1.32,1.29,1.20, /1.04,0.74,0.42,0.22,0.03,.003,0.00,0.00/ C A'1SIG (V=0-6) (V=0 ENERGY=8.398 EV) AVERAGE ENERGY LOSS= 9.191 EV DATA XSNG2/9.191,10.2,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,24.0,30.0,40.0,50.0,70.0,100.,200.,400.,1000., /10000.,1.D5,1.D6,1.D7/ DATA YSNG2/.0,.0013,.0071,.0106,.0139,.0146,.0145,.0143,.0139, /.0135, /.0132,.0105,.0072,.0045,.0031,.0017,.0010,.0003,.0001,3.D-5, /3.D-6,0.00,0.00,0.00/ DATA YSG2M/1.00,1.00,1.00,1.00,1.00,1.00,1.07,1.13,1.14,1.15, /1.16,1.21,1.27,1.17,1.07,0.93,0.72,0.66,0.42,0.22, /0.03,.003,0.00,0.00/ C W3DEL(V=11-19) (V=11 ENERGY=9.220 EV) AVERAGE ENERGY LOSS= 9.562 EV DATA XTRP9/9.562,10.0,11.0,12.0,14.0,15.0,16.0,17.0,18.0,20.0, /22.0,24.0,26.0,28.0,30.0,34.0,40.0,50.0,70.0,100., /200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP9/.0,.012,.029,.038,.056,.063,.067,.067,.065, /.058, /.049,.040,.034,.029,.024,.019,.0141,.0092,.00461,.00230, /.00076,.00026,6.D-5,6.D-6,0.00,0.00,0.00/ DATA YTP9M/1.20,1.20,1.14,1.08,1.08,1.13,1.16,1.19,1.21,1.22, /1.23,1.24,1.25,1.26,1.27,1.26,1.23,1.19,1.11,0.98, /0.72,0.42,0.22,0.03,.003,0.00,0.00/ C W1DEL(V=0-5) (V=0 ENERGY=8.895 EV) AVERAGE ENERGY LOSS= 9.590 EV DATA XSNG3/9.590,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0, /20.0,24.0,30.0,40.0,50.0,70.0,100.,200.,400.,1000., /10000.,1.D5,1.D6,1.D7/ DATA YSNG3/.0,.0002,.003,.009,.0109,.0144,.0141,.0138,.0134,.013, /.012,.0094,.0074,.0054,.0043,.0030,.0020,.0010,.00046,.00018, /1.8D-5,0.00,0.00,0.00/ DATA YSG3M/1.08,1.08,1.08,1.08,1.05,1.00,0.08,0.97,0.96,0.95, /0.92,0.90,0.86,0.76,0.66,0.55,0.36,0.28,0.19,.091, /.013,.0013,0.00,0.00/ C A1PI(V=4-15) (V=4 ENERGY=9.355 EV) AVERAGE ENERGY LOSS= 9.665 EV DATA XSNG4/9.665,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0, /19.0,20.0,24.0,27.0,30.0,40.0,50.0,70.0,100.,150., /200.,250.,300.,500.,700.,1000.,2000.,4000.,10000.,20000., /1.D5,1.D6,1.D7/ DATA YSNG4/.0,.009,.023,.039,.057,.077,.097,.109,.117,.121, /.123,.124,.119,.112,.106,.083,.067,.048,.034,.0230, /.0173,.0139,.0117,.0071,.0052,.0036,.0018,.0010,.00038,.00019, /3.7D-5,3.7D-6,3.7D-7/ DATA YSG4M/0.80,0.80,0.75,0.70,0.66,0.60,0.55,0.53,0.51,0.50, /0.49,0.48,0.50,0.52,0.54,0.48,0.41,0.34,0.24,0.20, /0.19,0.18,0.17,0.16,0.12,.091,.051,.028,.013,.007, /.0016,.00012,.000010/ C B'3SIG(V=7-18) (V=7 ENERGY=9.399 EV) AVERAGE ENERGY LOSS= 9.933 EV DATA XTRP10/9.933,10.2,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0, /19.0,20.0,22.0,26.0,30.0,34.0,40.0,50.0,70.0,100., /200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP10/.0,.0010,.0068,.0169,.0284,.0427,.0528,.0575,.0575, /.0552, /.0524,.0495,.0438,.0316,.0236,.0187,.0133,.0086,.0041,.0020, /.0007,.0002,6.D-5,6.D-6,0.00,0.00,0.00/ DATA YTP10M/0.90,0.90,0.90,0.90,0.90,0.91,0.93,0.97,1.07,1.17, /1.22,1.22,1.23,1.26,1.32,1.37,1.35,1.32,1.29,1.20, /1.04,0.54,0.22,0.03,.003,0.00,0.00/ C A'1SIG (V=7-19) (V=7 ENERGY=9.645 EV) AVERAGE ENERGY LOSS= 10.174 EV DATA XSNG5/10.174,10.5,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,24.0,30.0,40.0,50.0,70.0,100.,200.,400.,1000., /10000.,1.D5,1.D6,1.D7/ DATA YSNG5/.0,.0013,.0129,.0194,.0252,.0267,.0265,.0260,.0253, /.0247, /.0240,.0192,.0133,.0081,.0055,.0032,.0017,.00057,2.D-4,5.D-5, /5.D-6,0.00,0.00,0.00/ DATA YSG5M/1.00,1.00,1.00,1.00,1.00,1.00,1.07,1.13,1.14,1.15, /1.16,1.21,1.27,1.17,1.07,0.93,0.72,0.66,0.42,0.22, /0.03,.003,0.00,0.00/ C W1DEL(V=6-18) (V=6 ENERGY=9.994 EV) AVERAGE ENERGY LOSS= 10.536 EV DATA XSNG6/10.536,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,20.0, /24.0,30.0,40.0,50.0,70.0,100.,200.,400.,1000.,10000., /1.D5,1.D6,1.D7/ DATA YSNG6/.0,.003,.009,.0242,.032,.032,.031,.030,.029,.026, /.021,.0164,.0121,.0096,.0066,.0046,.0021,.00102,4.D-4,4.D-5, /0.00,0.00,0.00/ DATA YSG6M/1.08,1.08,1.08,1.05,1.00,0.08,0.97,0.96,0.95,0.92, /0.90,0.86,0.76,0.66,0.55,0.36,0.28,0.19,.091,.013, /.002,0.00,0.00/ C C3PI(V=0-4) (V=0 ENERGY=11.032 EV) AVERAGE ENERGY LOSS= 11.188 EV DATA XTRP11/11.188,12.0,12.5,13.0,13.5,14.0,14.5,15.0,16.0,17.0, /18.0,19.0,20.0,24.0,30.0,40.0,50.0,70.0,100.,200., /400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP11/.0,.057,.089,.130,.180,.225,.235,.225,.205,.190, /.170,.155,.140,.105,.074,.044,.031,.015,.0057,.0019, /.0006,2.5D-4,2.5D-5,0.00,0.00,0.00/ DATA YTP11M/1.03,1.03,1.03,1.03,1.03,1.03,1.03,1.03,1.02,1.01, /1.00,0.99,0.99,1.06,1.14,1.11,1.09,0.93,0.70,0.42, /0.22,.091,.013,.002,0.00,0.00/ C E3SIG V=0 DATA XTRP12/11.875,11.9,11.95,12.0,12.5,13.0,14.0,15.0,16.0,17.0, /18.0,19.0,20.0,21.0,25.0,30.0,35.0,40.0,45.0,50.0, /70.0,100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP12/.0,.157,.127,.101,.031,.021,.009,.003,.002,.004, /.008,.011,.013,.013,.010,.008,.005,.0037,.0027,.002, /.0010,.0004,.0001,.00004,.00001,1.D-6,0.00,0.00,0.00/ DATA YTP12M/29*1.0/ C A''1SIG(V=0-1) (V=0 ENERGY=12.255 EV) AVERAGE ENERGY LOSS= 12.289 EV DATA XSNG7/12.289,13.0,14.0,15.0,17.5,20.0,24.0,30.0,40.0,50.0, /70.0,100.,200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YSNG7/.0,.002,.005,.011,.022,.034,.037,.036,.031,.028, /.020,.0125,.0049,.0019,4.D-4,4.D-5,0.00,0.00,0.00/ DATA YSG7M/0.86,0.86,0.86,0.86,0.86,0.91,0.94,0.99,0.94,0.89, /0.73,0.50,0.33,0.19,.091,.013,.002,0.00,0.00/ C B1PI (V=0-6) (V=0 ENERGY=12.500 EV) AVERAGE ENERGY LOSS= 12.771 EV C USE DIPOLE FALL OFF WITH ENERGY ABOVE 500EV DATA XSNG8/12.771,17.5,20.0,30.0,40.0,50.0,70.0,100.,150.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1200.,1400.,1600.,1800.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000.,1.0D4,1.2D4, /1.4D4,1.6D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.0D6,1.0D7/ DATA YSNG8/0.0,.0357,.0855,.170,.173,.163,.142,.116,.0905,.0763, /.0668,.0599,.0551,.0501,.0463,.0440,.0374,.0334,.0299,.0273, /.0249,.0214,.0189,.0170,.0154,.0140,.0120,.01056,.00937,.00849, /.00775,.00701,.00640,.00587,.00545,.00479,.00425,.00384,.00350, /.00299, /.00261,.00232,.00191,.00156,.00133,.001024,8.42D-4,7.15D-4, /6.22D-4,5.49D-4, /4.96D-4,4.48D-4,1.5D-4,1.5D-4/ DATA YSG8M/0.76,0.76,0.67,0.46,0.34,0.22,0.13,0.05,0.04,0.03, /.028,.025,.022,.020,.018,.016,.014,.012,.011,.010, /.009,.008,.007,.006,.0055,.005,.0046,.0042,.0038,.0034, /.0030,.0028,.0026,.0024,.0022,.0020,.0018,.0016,.0014,.0013, /.0012,.0011,.0010,.0009,.0008,.0007,.0006,.0005,.0004,.0003, /.0002,.00015,.00002,.000002/ C C'1SIG (V=0-3) (V=0 ENERGY=12.934 EV) AVERAGE ENERGY LOSS= 12.950 EV C USE DIPOLE FALL OFF WITH ENERGY ABOVE 500EV C SCALED X-SECTION BY 1.212 TO ALLOW FOR HIGHER VIBRATIONS THAN V=3 DATA XSNG9/12.950,17.5,20.0,30.0,40.0,50.0,70.0,100.,150.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1200.,1400.,1600.,1800.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000.,1.0D4,1.2D4, /1.4D4,1.6D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.0D6,1.0D7/ DATA YSNG9/0.0,.0103,.0228,.067,.086,.093,.102,.100,.091,.083, /.075,.069,.063,.059,.054,.052,.0440,.0392,.0352,.0320, /.0293,.0252,.0222,.0198,.0180,.0164,.0141,.0124,.0110,.00999, /.00911,.00824,.00752,.00690,.00640,.00563,.00500,.00451,.00411, /.00351, /.00308,.00273,.00224,.00182,.00156,.00121,9.89D-4,8.40D-4, /7.32D-4,6.45D-4, /5.83D-4,5.27D-4,1.8D-4,1.8D-4/ DATA YSG9M/0.72,0.72,0.47,0.41,0.32,0.23,0.13,0.05,0.04,0.03, /.028,.025,.022,.020,.018,.016,.014,.012,.011,.010, /.009,.008,.007,.006,.0055,.005,.0046,.0042,.0038,.0034, /.0030,.0028,.0026,.0024,.0022,.0020,.0018,.0016,.0014,.0013, /.0012,.0011,.0010,.0009,.0008,.0007,.0006,.0005,.0004,.0003, /.0002,.00015,.00002,.000002/ C G3 PI (V=0-3) (V=0 ENERGY=12.810 EV) AVERAGE ENERGY LOSS=13.001 EV DATA XTRP13/13.001,17.5,20.0,23.0,26.0,30.0,40.0,50.0,70.0,100., /200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP13/.0,.0133,.0178,.0204,.0207,.0199,.0174,.0152,.0115, /.0065, /.0021,.0006,.00016,.00002,0.00,0.00,0.00/ DATA YTP13M/0.74,0.74,0.73,0.72,0.71,0.69,0.61,0.53,0.47,0.40, /0.33,0.19,.091,.013,.002,0.00,0.00/ C C3 1PI ( V=0-3) V=0 ENERGY=12.912 AVERAGE ENERGY LOSS= 13.093 EV C USE DIPOLE FALL OFF WITH ENERGY ABOVE 500EV DATA XSNG10/13.093,17.5,20.0,30.0,40.0,50.0,70.0,100.,150.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1200.,1400.,1600.,1800.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000.,1.0D4,1.2D4, /1.4D4,1.6D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.0D6,1.0D7/ DATA YSNG10/0.0,.0175,.040,.100,.102,.097,.084,.068,.053,.045, /.039,.035,.032,.030,.027,.026,.022,.0196,.0175,.0160, /.0146,.0126,.0111,.0100,.0090,.0082,.0070,.0062,.0055,.0050, /.0046,.0041,.0038,.0035,.0032,.0029,.0026,.0022,.00206, /.00175, /.00154,.00136,.00112,9.14D-4,7.79D-4,6.02D-4,4.94D-4,4.20D-4, /3.66D-4,3.22D-4, /2.92D-4,2.64D-4,9.0D-5,9.0D-5/ DATA YSG10M/0.69,0.69,0.55,0.40,0.28,0.16,0.11,0.05,0.04,0.03, /.028,.025,.022,.020,.018,.016,.014,.012,.011,.010, /.009,.008,.007,.006,.0055,.005,.0046,.0042,.0038,.0034, /.0030,.0028,.0026,.0024,.0022,.0020,.0018,.0016,.0014,.0013, /.0012,.0011,.0010,.0009,.0008,.0007,.0006,.0005,.0004,.0003, /.0002,.00015,.000015,.0000015/ C F3 PI (V=0-3) (V=0 ENERGY=12.985 EV) AVERAGE ENERGY LOSS=13.174 EV DATA XTRP14/13.174,17.5,20.0,23.0,26.0,30.0,40.0,50.0,70.0,100., /200.,400.,1000.,10000.,1.D5,1.D6,1.D7/ DATA YTRP14/.0,.0062,.0091,.0129,.0140,.0136,.0119,.0102,.0074, /.0040, /.0014,.0004,.0001,.00001,0.00,0.00,0.00/ DATA YTP14M/0.74,0.74,0.76,0.71,0.65,0.63,0.53,0.43,0.40,0.34, /0.29,0.19,.091,.013,.002,0.00,0.00/ C B! 1SIG (V=0-10) V=0 ENERGY=12.854 AVERAGE ENERGY LOSS= 13.371 EV C USE DIPOLE FALL OFF WITH ENERGY ABOVE 500EV DATA XSNG11/13.371,17.5,20.0,30.0,40.0,50.0,70.0,100.,150.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1200.,1400.,1600.,1800.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000.,1.0D4,1.2D4, /1.4D4,1.6D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.0D6,1.0D7/ DATA YSNG11/0.0,.0156,.027,.037,.046,.048,.048,.046,.039,.035, /.031,.029,.027,.024,.0228,.0216,.0185,.0164,.0147,.0135, /.0123,.0106,.0093,.0084,.0075,.0069,.0059,.0052,.0047,.0043, /.0038,.0035,.0032,.0029,.0027,.0023,.0021,.0019,.00173, /.00147, /.00128,.00115,9.4D-4,7.6D-4,6.6D-4,5.1D-4,4.1D-4,3.5D-4, /3.1D-4,2.70D-4, /2.45D-4,2.21D-4,7.0D-5,7.0D-5/ DATA YSG11M/0.81,0.81,0.71,0.47,0.33,0.20,0.15,0.09,0.05,0.04, /.030,.025,.022,.020,.018,.016,.014,.012,.011,.010, /.009,.008,.007,.006,.0055,.005,.0046,.0042,.0038,.0034, /.0030,.0028,.0026,.0024,.0022,.0020,.0018,.0016,.0014,.0013, /.0012,.0011,.0010,.0009,.0008,.0007,.0006,.0005,.0004,.0003, /.0002,.00015,.000015,.0000015/ C B1PI (V=7-14) (V=7 ENERGY=13.156 EV) AVERAGE ENERGY LOSS= 13.382 EV C USE DIPOLE FALL OFF WITH ENERGY ABOVE 500EV DATA XSNG12/13.382,17.5,20.0,30.0,40.0,50.0,70.0,100.,150.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1200.,1400.,1600.,1800.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000.,1.0D4,1.2D4, /1.4D4,1.6D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.0D6,1.0D7/ DATA YSNG12/0.0,.0120,.0288,.0571,.0582,.0550,.0478,.0387,.0304, /.0257, /.0225,.0201,.0186,.0169,.0156,.0148,.0126,.0112,.01007,.00916, /.00839,.00721,.00636,.00569,.00515,.00471,.00404,.00355,.00315, /.00286, /.00261,.00236,.00215,.00197,.00183,.00161,.00143,.00129,.00118, /.001005, /.000879,.000780,.000641,.000524,.000446,.000345,.000283,.000241, /.000210,.000185, /.000168,.000151,5.0D-5,5.0D-5/ DATA YSG12M/0.76,0.76,0.67,0.46,0.34,0.22,0.13,0.05,0.04,0.03, /.028,.025,.022,.020,.018,.016,.014,.012,.011,.010, /.009,.008,.007,.006,.0055,.005,.0046,.0042,.0038,.0034, /.0030,.0028,.0026,.0024,.0022,.0020,.0018,.0016,.0014,.0013, /.0012,.0011,.0010,.0009,.0008,.0007,.0006,.0005,.0004,.0003, /.0002,.00015,.000015,.0000015/ C O3 1PI (V=0-3) (V=0 ENERGY=13.103 EV) AVERAGE ENERGY LOSS= 13.564 EV C USE DIPOLE FALL OFF WITH ENERGY ABOVE 500EV C SCALED X-SECTION BY 1.096 TO ALLOW FOR VIBRATIONS HIGHER THAN V=3 DATA XSNG13/13.564,17.5,20.0,30.0,40.0,50.0,70.0,100.,150.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1200.,1400.,1600.,1800.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000.,1.0D4,1.2D4, /1.4D4,1.6D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.0D6,1.0D7/ DATA YSNG13/0.0,.0140,.028,.055,.056,.053,.046,.037,.030,.024, /.021,.019,.018,.017,.015,.0140,.0123,.0108,.0097,.0089, /.0081,.0070,.0062,.0055,.0050,.0045,.0038,.0034,.0031,.0027, /.00251,.00228,.00210,.00193,.00175,.00157,.00141,.00123,.00114, /9.7D-4, /8.4D-4,7.5D-4,6.2D-4,5.1D-4,4.3D-4,3.3D-4,2.7D-4,2.3D-4, /2.0D-4,1.8D-4, /1.6D-4,1.5D-4,5.0D-5,5.0D-5/ DATA YSG13M/0.86,0.86,0.77,0.60,0.45,0.30,0.19,0.08,0.05,0.04, /.030,.025,.022,.020,.018,.016,.014,.012,.011,.010, /.009,.008,.007,.006,.0055,.005,.0046,.0042,.0038,.0034, /.0030,.0028,.0026,.0024,.0022,.0020,.0018,.0016,.0014,.0013, /.0012,.0011,.0010,.0009,.0008,.0007,.0006,.0005,.0004,.0003, /.0002,.00015,.000015,.0000015/ C B! 1SIG (V=11-INF) (V=11 ENERGY=13.86 EV) AVERAGE ENERGY LOSS=14.0 EV C USE DIPOLE FALL OFF WITH ENERGY ABOVE 500EV C USE SCALING ( FRANK CONDON FACTORS) OF 91.75/8.25 FOR TRANSITION C STRENGTH COMPARED TO THE B! 1SIG (V=0-10) X-SECTION DATA XSNG14/14.0,17.5,20.0,30.0,40.0,50.0,70.0,100.,150.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1200.,1400.,1600.,1800.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000.,1.0D4,1.2D4, /1.4D4,1.6D4,2.0D4,2.5D4,3.0D4,4.0D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.0D6,1.0D7/ DATA YSNG14/0.0,.080,.229,.417,.507,.530,.534,.504,.439,.387, /.347,.317,.295,.275,.253,.241,.205,.182,.164,.150, /.137,.118,.1035,.0927,.0840,.0765,.0656,.0579,.0513,.0465, /.0424,.0385,.0350,.0322,.0298,.0263,.0233,.0210,.0192, /.0164, /.0143,.0127,.01044,.00852,.00726,.00561,.00461,.00391,.00340, /.00301, /.00273,.00245,8.0D-4,8.0D-4/ DATA YSG14M/0.81,0.81,0.71,0.47,0.33,0.20,0.15,0.09,0.05,0.04, /.030,.025,.022,.020,.018,.016,.014,.012,.011,.010, /.009,.008,.007,.006,.0055,.005,.0046,.0042,.0038,.0034, /.0030,.0028,.0026,.0024,.0022,.0020,.0018,.0016,.0014,.0013, /.0012,.0011,.0010,.0009,.0008,.0007,.0006,.0005,.0004,.0003, /.0002,.00015,.000015,.0000015/ C SUM SINGLET (SUMMED SINGLETS ABOVE 14.2 EV) DATA XSNG15/14.2,14.5,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.,1.D5,1.D6,1.D7/ DATA YSNG15/0.0,.037,.088,.133,.194,.240,.346,.442,.548,.682, /.811,.811,.774,.728,.613,.534,.485,.442,.341,.295, /.244,.129,.065,.028,.014,.0055,.0018,.0018/ DATA YSG15M/0.81,0.81,0.81,0.81,0.81,0.79,0.71,0.65,0.59,0.47, /0.33,0.19,0.13,0.09,0.05,0.04,0.03,.025,.016,.012, /.009,.005,.003,.0014,.0010,.00015,.000015,.000001/ C RAP UP TO 100 EV THEN LINDSAY TO 1KEV THEN SCHRAM TO 20KEV C ABOVE 20KEV USE MATRIX ELEMENTS COMPATIBLE WITH RIEKE AND BERKOWITZ DATA XION/15.581,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.,140.,160.,180.,200.,225.,250.,275., /300.,350.,400.,450.,500.,550.,600.,650.,700.,750., /800.,850.,900.,950.,1000.,1200.,1400.,1600.,1800.,2000., /2500.,3000.,3500.,4000.,4500.,5000.,5500.,6000.,7000.,8000., /9000.,10000.,12000.,14000.,16000.,18000.,20000./ C GROSS IONISATION DATA YION/0.00,.0211,.0466,.0713,.0985,.129,.164,.199,.230,.270, /.308,.344,.380,.418,.455,.492,.528,.565,.603,.640, /.677,.714,.875,1.03,1.15,1.27,1.38,1.49,1.57,1.78, /1.94,2.07,2.18,2.27,2.33,2.39,2.44,2.46,2.49,2.51, /2.51,2.50,2.48,2.45,2.36,2.28,2.19,2.08,1.98,1.89, /1.82,1.68,1.56,1.45,1.36,1.28,1.20,1.12,1.07,1.01, /.971,.936,.907,.879,.847,.728,.649,.585,.534,.491, /.408,.351,.310,.280,.255,.233,.217,.200,.178,.159, /.144,.132,.113,.0998,.0898,.0824,.0752/ C COUNTING IONISATION DATA YINC/0.00,.0211,.0466,.0713,.0985,.129,.164,.199,.230,.270, /.308,.344,.380,.418,.455,.492,.528,.565,.603,.640, /.677,.714,.875,1.03,1.15,1.27,1.38,1.49,1.57,1.78, /1.94,2.07,2.18,2.27,2.33,2.39,2.44,2.46,2.49,2.51, /2.51,2.49,2.47,2.44,2.35,2.26,2.17,2.06,1.97,1.88, /1.81,1.67,1.55,1.44,1.35,1.27,1.19,1.11,1.06,1.00, /.965,.931,.902,.874,.842,.724,.645,.581,.531,.488, /.405,.349,.308,.278,.253,.231,.215,.198,.176,.157, /.143,.131,.112,.0988,.0889,.0816,.0745/ C ********************************************************************* C NITROGEN UPDATE 2008. C USED ELECTRON SCATTERING DATA PUBLISHED UP TO DECEMBER 2008. C VIBRATIONAL X-SECTIONS MAINLY FROM ALLAN AND ALSO VICIC C ALLAN J.PHYS.B 18(1985) 4511 C VICIC J.PHYS.B 29(1996) 1273 C ELASTIC FROM ALLAN , ITIKAWA(REVIEW) ,SUN AND ALSO MUSE C ALLAN J.PHYS.B 38(2005) 3655 C ITIKAWA J.PHYS.CHEM.REF DATA 35(2006)31 C SUN PHYS.REV 52A(1995)1229 C MUSE J.PHYS.B 41(2008)095203 C EXCITATION FROM ITIKAWA (REVIEW) AND KHAKOO C KHAKOO PHYS.REV A 77(2008)012704 C KHAKOO PHYS.REV A 71(2005)062703 C IONISATION FROM RAP , LINDSAY, SCHRAM, RIEKE AND BERKOWITZ C RAP J.CHEM.PHYS 43(1965)1464 C LINDSAY LLANDOLT-BORNSTEIN I/17C C SCHRAM PHYSICA 31(1965)94 C RIEKE PHYS REV 6A (1972)1507 C BERKOWITZ PHOTOABSORPTION ,PHOTOIONISATION SPECTROSCOPY C C ROTATIONAL X-SECTIONS FROM QUADRUPOLE BORN APPROX. WITH TABULATED C VALUES FOR THE RESONANCE ENHANCEMENT. C INELASTIC X-SECTIONS ARE MAINLY FROM KHAKOO FOR LEVELS BELOW 14.0EV C USED FRANK-CONDON FACTORS TO WEIGHT THE VIBRATION-EXCITATION LEVELS C AND ADJUSTED THRESHOLDS TO GIVE CORRECT AVERAGE ENERGY LOSS. C THE REMAINING LEVEL STRENGTH IS IN THE EFFECTIVE SINGLET LEVEL C AT 14.2EV . THE 14.2 EV LEVEL WAS MADE TO BE CONSISTENT WITH C THE TOTAL LEVEL SUM FROM PITCHFORD AND PHELPS AND GIVES ACCURATE C FANO FACTORS C THE TOTAL X-SECTION BELOW 50 EV IS WITHIN 1% OF THE EXPERIMENTAL VALUE C OF KENNERLEY. ABOVE 50EV IS WITHIN 1% OF REVIEW BY ITIKAWA. C TOTAL ELASTIC AND ELASTIC MOMENTUM TRANSFER X-SECTION ARE ADJUSTED TO C FIT DATA IN MIXTURES: C NEON /NITROGEN VD ROBERTSON C ARGON /NITROGEN VD HADDAD C PURE NITROGEN VD DT DL AND ALPHA C LOW FIELD NITROGEN DATA VD AND DT FROM LOWKE AND HUXLEY AND CROMPTON. C C HIGH FIELD NITROGEN DATA VD AND DL FROM HASEGAWA C FIT TO DRIFT AND DIFFUSION DATA BETTER THAN 1% ACCURACY. C C TOWNSEND COEFICIENT FROM COMPILATION BY DUTTON. C C*********************************************************************** C--------------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME=' N2 2008 ISO ' ELSE IF(NANISO.EQ.1) THEN NAME='N2 2008 ANISO ' ELSE IF(NANISO.EQ.2) THEN NAME='N2 2008 ANISO ' ENDIF C -------------------------------------------------------------- C BORN BETHE VALUES FOR COUNTING IONISATION CONST=1.873884D-20 EMASS2=1021997.804 AM2=3.35 C=38.1 C ANGULAR DISTRIBUTIONS OF ELASTIC AND IONISATION CAN BE EITHER C ISOTROPIC (KEL=0) OR C CAPITELLI-LONGO (KEL =1) OR OKHRIMOVSKKY TYPES (KEL=2) NIN=121 DO 1 J=1,6 1 KEL(J)=NANISO C USE ISOTROPIC SCATTERING FOR ROTATIONAL AND VIBRATIONAL STATES DO 2 J=1,92 2 KIN(J)=0 C USE ANISOTROPIC SCATTERING FOR EXCITED STATES . C ANGULAR DISTRIBUTIONS ARE CAPITELLI-LONGO (FORWARD BACKWARD ASYMMETRY) DO 20 J=93,121 20 KIN(J)=1 C NELA=184 NROT=70 NVIB1=91 NVIB2=73 NVIB3=74 NVIB4=54 NVIB5=44 NVIB6=45 NVIB7=46 NVIB8=44 NVIB9=39 NVIB10=39 NVIB11=39 NVIB12=37 NVIB13=35 NVIB14=32 NVIB15=36 NTRP1=30 NTRP2=30 NTRP3=28 NTRP4=29 NTRP5=30 NTRP6=28 NTRP7=28 NTRP8=28 NTRP9=27 NTRP10=27 NTRP11=26 NTRP12=29 NTRP13=17 NTRP14=17 NSNG1=33 NSNG2=24 NSNG3=24 NSNG4=33 NSNG5=24 NSNG6=23 NSNG7=19 NSNG8=54 NSNG9=54 NSNG10=54 NSNG11=54 NSNG12=54 NSNG13=54 NSNG14=54 NSNG15=28 NION=87 E(1)=0.0 E(2)=2.0*EMASS/(27.7940*AMU) E(3)=15.581 C EXCITATION X-SECTION AT 1.4 MEV E(4)=0.0032D-16 C IONISATION X-SECTION AT 1.4MEV E(5)=0.008795D-16 C OPAL BEATY IONISATION ENERGY SPLITTING AT 1.4MEV E(6)=13.8 C OPAL BEATY IONISATION ENERGY SPLITTING AT LOW ENERGY EOBY=13.0 C CALC FRACTIONAL POPULATION DENSITY FOR ROTATIONAL STATES B0=2.4668D-4 A0=0.5291772083D-8 C ROTATIONAL QUADRUPOLE MOMENT QBQA=1.045 QBK=1.67552*(QBQA*A0)**2 DO 3 K=1,39,2 AK=DFLOAT(K) 3 PJ(K)=3.0*(2.0*AK+1.0)*DEXP(-AK*(AK+1.0)*B0/AKT) DO 4 K=2,38,2 AK=DFLOAT(K) 4 PJ(K)=6.0*(2.0*AK+1.0)*DEXP(-AK*(AK+1.0)*B0/AKT) SUM=6.0 DO 5 K=1,39 5 SUM=SUM+PJ(K) FROT0=6.0/SUM DO 6 K=1,39 6 PJ(K)=PJ(K)/SUM C CALC ROTATIONAL TRANSITION ENERGIES DO 7 K=1,38 J=K-1 AJ=DFLOAT(J) EIN(K+38)=B0*(4.0*AJ+6.0) 7 EIN(K)=-EIN(K+38) EIN(77)=-0.2889 EIN(78)=0.2889 EIN(79)=0.5742 EIN(80)=0.8559 EIN(81)=1.1342 EIN(82)=1.4088 EIN(83)=1.6801 EIN(84)=1.9475 EIN(85)=2.2115 EIN(86)=2.4718 EIN(87)=2.7284 EIN(88)=2.9815 EIN(89)=3.2310 EIN(90)=3.4769 EIN(91)=3.7191 EIN(92)=3.9576 EIN(93)=6.725 EIN(94)=7.360 EIN(95)=7.744 EIN(96)=8.050 EIN(97)=8.217 EIN(98)=8.451 EIN(99)=8.729 EIN(100)=8.950 EIN(101)=8.974 EIN(102)=9.191 EIN(103)=9.562 EIN(104)=9.590 EIN(105)=9.665 EIN(106)=9.933 EIN(107)=10.174 EIN(108)=10.536 EIN(109)=11.188 EIN(110)=11.875 EIN(111)=12.289 EIN(112)=12.771 EIN(113)=12.950 EIN(114)=13.001 EIN(115)=13.093 EIN(116)=13.174 EIN(117)=13.371 EIN(118)=13.382 EIN(119)=13.564 EIN(120)=14.0 EIN(121)=14.2 C OFFSET ENERGY FOR IONISATION ELECTRON ANGULAR DISTRIBUTION IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) C C********************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C SET PENNING TRANSFER FRACTION TO ZERO FOR LOW ENERGY LEVELS DO 8 K=1,106 DO 8 L=1,3 8 PENFRA(L,K)=0.0 C----------------------------------------------------------- C PENNING TRANSFER FRACTION FOR LEVELS ABOVE 10 EV DO 9 K=107,121 PENFRA(1,K)=0.0 C PENNING TRANSFER DISTANCE IN MICRONS PENFRA(2,K)=1.0 C PENNING TRANSFER TIME IN PICOSECONDS PENFRA(3,K)=1.0 IF(IPEN.EQ.0) GO TO 9 WRITE(6,999) NAME,EIN(K),PENFRA(1,K),PENFRA(2,K),PENFRA(3,K) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY = ',F5.3,' ABS.LENGTH = ',F7.2,' DECAY TIME = ',F7.1,/) 9 CONTINUE C********************************************************************** SCRPT(1)=' ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC ISOTROPIC NITROGEN ' ELSE IF(NANISO.EQ.1) THEN SCRPT(2)=' ELASTIC ANISOTROPIC CAP/LONGO' ELSE SCRPT(2)=' ELASTIC ANISOTROPIC NITROGEN ' ENDIF SCRPT(3)=' IONISATION ELOSS= 15.581 ' 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 30-28 ELOSS= -0.0291 ' SCRPT(36)=' ROT 31-29 ELOSS= -0.0301 ' SCRPT(37)=' ROT 32-30 ELOSS= -0.0311 ' SCRPT(38)=' ROT 33-31 ELOSS= -0.0321 ' SCRPT(39)=' ROT 34-32 ELOSS= -0.0331 ' SCRPT(40)=' ROT 35-33 ELOSS= -0.0340 ' SCRPT(41)=' ROT 36-34 ELOSS= -0.0350 ' SCRPT(42)=' ROT 37-35 ELOSS= -0.0360 ' SCRPT(43)=' ROT 38-36 ELOSS= -0.0370 ' SCRPT(44)=' ROT 39-37 ELOSS= -0.0380 ' SCRPT(45)=' ROT 0-2 ELOSS= 0.00148' SCRPT(46)=' ROT 1-3 ELOSS= 0.00247' SCRPT(47)=' ROT 2-4 ELOSS= 0.00345' SCRPT(48)=' ROT 3-5 ELOSS= 0.00444' SCRPT(49)=' ROT 4-6 ELOSS= 0.00543' SCRPT(50)=' ROT 5-7 ELOSS= 0.00641' SCRPT(51)=' ROT 6-8 ELOSS= 0.00740' SCRPT(52)=' ROT 7-9 ELOSS= 0.00839' SCRPT(53)=' ROT 8-10 ELOSS= 0.00937' SCRPT(54)=' ROT 9-11 ELOSS= 0.0104 ' SCRPT(55)=' ROT 10-12 ELOSS= 0.0113 ' SCRPT(56)=' ROT 11-13 ELOSS= 0.0123 ' SCRPT(57)=' ROT 12-14 ELOSS= 0.0133 ' SCRPT(58)=' ROT 13-15 ELOSS= 0.0143 ' SCRPT(59)=' ROT 14-16 ELOSS= 0.0153 ' SCRPT(60)=' ROT 15-17 ELOSS= 0.0163 ' SCRPT(61)=' ROT 16-18 ELOSS= 0.0173 ' SCRPT(62)=' ROT 17-19 ELOSS= 0.0183 ' SCRPT(63)=' ROT 18-20 ELOSS= 0.0192 ' SCRPT(64)=' ROT 19-21 ELOSS= 0.0202 ' SCRPT(65)=' ROT 20-22 ELOSS= 0.0212 ' SCRPT(66)=' ROT 21-23 ELOSS= 0.0222 ' SCRPT(67)=' ROT 22-24 ELOSS= 0.0232 ' SCRPT(68)=' ROT 23-25 ELOSS= 0.0242 ' SCRPT(69)=' ROT 24-26 ELOSS= 0.0252 ' SCRPT(70)=' ROT 25-27 ELOSS= 0.0261 ' SCRPT(71)=' ROT 26-28 ELOSS= 0.0271 ' SCRPT(72)=' ROT 27-29 ELOSS= 0.0281 ' SCRPT(73)=' ROT 28-30 ELOSS= 0.0291 ' SCRPT(74)=' ROT 29-31 ELOSS= 0.0301 ' SCRPT(75)=' ROT 30-32 ELOSS= 0.0311 ' SCRPT(76)=' ROT 31-33 ELOSS= 0.0321 ' SCRPT(77)=' ROT 32-34 ELOSS= 0.0331 ' SCRPT(78)=' ROT 33-35 ELOSS= 0.0340 ' SCRPT(79)=' ROT 34-36 ELOSS= 0.0350 ' SCRPT(80)=' ROT 35-37 ELOSS= 0.0360 ' SCRPT(81)=' ROT 36-38 ELOSS= 0.0370 ' SCRPT(82)=' ROT 37-39 ELOSS= 0.0380 ' SCRPT(83)=' VIB V1 ELOSS= -0.2889 ' SCRPT(84)=' VIB V1 ELOSS= 0.2889 ' SCRPT(85)=' VIB 2V1 ELOSS= 0.5742 ' SCRPT(86)=' VIB 3V1 ELOSS= 0.8559 ' SCRPT(87)=' VIB 4V1 ELOSS= 1.1342 ' SCRPT(88)=' VIB 5V1 ELOSS= 1.4088 ' SCRPT(89)=' VIB 6V1 ELOSS= 1.6801 ' SCRPT(90)=' VIB 7V1 ELOSS= 1.9475 ' SCRPT(91)=' VIB 8V1 ELOSS= 2.2115 ' SCRPT(92)=' VIB 9V1 ELOSS= 2.4718 ' SCRPT(93)=' VIB 10V1 ELOSS= 2.7284 ' SCRPT(94)=' VIB 11V1 ELOSS= 2.9815 ' SCRPT(95)=' VIB 12V1 ELOSS= 3.2310 ' SCRPT(96)=' VIB 13V1 ELOSS= 3.4769 ' SCRPT(97)=' VIB 14V1 ELOSS= 3.7191 ' SCRPT(98)=' VIB 15V1 ELOSS= 3.9576 ' SCRPT(99)=' A3SIG V=0-4 ELOSS= 6.725 ' SCRPT(100)=' A3SIG V=5-9 ELOSS= 7.360 ' SCRPT(101)=' B 3PI V=0-3 ELOSS= 7.744 ' SCRPT(102)=' W3DEL V=0-5 ELOSS= 8.050 ' SCRPT(103)=' A3SIG V=10-21 ELOSS= 8.217 ' SCRPT(104)=' B 3PI V=4-16 ELOSS= 8.451 ' SCRPT(105)=' W3DEL V=6-10 ELOSS= 8.729 ' SCRPT(106)=' A 1PI V=0-3 ELOSS= 8.950 ' SCRPT(107)=' B!3SIG V=0-6 ELOSS= 8.974 ' SCRPT(108)=' A!1SIG V=0-6 ELOSS= 9.191 ' SCRPT(109)=' W3DEL V=11-19 ELOSS= 9.562 ' SCRPT(110)=' W 1DEL V=0-5 ELOSS= 9.590 ' SCRPT(111)=' A 1PI V=4-15 ELOSS= 9.665 ' SCRPT(112)=' B!3SIG V=7-18 ELOSS= 9.933 ' SCRPT(113)=' A!1SIG V=7-19 ELOSS= 10.174 ' SCRPT(114)=' W 1DEL V=6-18 ELOSS= 10.536 ' SCRPT(115)=' C 3PI V=0-4 ELOSS= 11.188 ' SCRPT(116)=' E 3SIG ELOSS= 11.875 ' SCRPT(117)=' A!!1SIG V=0-1 ELOSS= 12.289 ' SCRPT(118)=' B 1PI V=0-6 ELOSS= 12.771 ' SCRPT(119)=' C!1SIG V=0-3 ELOSS= 12.950 ' SCRPT(120)=' G 3PI V=0-3 ELOSS= 13.001 ' SCRPT(121)=' C3 1PI V=0-3 ELOSS= 13.093 ' SCRPT(122)=' F 3PI V=0-3 ELOSS= 13.174 ' SCRPT(123)=' B!1SIG V=0-10 ELOSS= 13.371 ' SCRPT(124)=' B 1PI V=7-14 ELOSS= 13.382 ' SCRPT(125)=' O3 1PI V=0-3 ELOSS= 13.564 ' SCRPT(126)=' B!1SIG V=10-H ELOSS= 14.0 ' SCRPT(127)=' SUM SINGLETS ELOSS= 14.2 ' C CALC VIBRATIONAL LEVEL V1 POPULATION APOPV1=DEXP(EIN(77)/AKT) APOPGS=1.0 APOPSUM=APOPGS+APOPV1 APOPV1=APOPV1/APOPSUM APOPGS=APOPGS/APOPSUM C RENORMALISE GROUND STATE TO ALLOW FOR EXCITATION FROM C THE EXCITED VIBRATIONAL STATE APOPGS=1.0 C EN=-ESTEP/2.0 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)) C ELASTIC QELA=(A*EN+B)*1.0D-16 A=(YMOM(J)-YMOM(J-1))/(XELA(J)-XELA(J-1)) B=(XELA(J-1)*YMOM(J)-XELA(J)*YMOM(J-1))/(XELA(J-1)-XELA(J)) C MOMENTUM TRANSFER QMOM=(A*EN+B)*1.0D-16 A=(YEPS(J)-YEPS(J-1))/(XELA(J)-XELA(J-1)) B=(XELA(J-1)*YEPS(J)-XELA(J)*YEPS(J-1))/(XELA(J-1)-XELA(J)) C ANISOTROPY FUNCTIONS PQ2=(A*EN+B) PQ1=0.5+(QELA-QMOM)/QELA IF(NANISO.EQ.0) PEQEL(2,I)=0.5 IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) Q(2,I)=QMOM C GROSS IONISATION Q(3,I)=0.0 PEQEL(3,I)=0.5 IF(NANISO.EQ.2) PEQEL(3,I)=0.0 IF(EN.LT.E(3)) GO TO 43 IF(EN.GT.XION(NION)) GO TO 41 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 GO TO 42 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 41 GAMMA=(EMASS2+2.0D0*EN)/EMASS2 BETA=DSQRT(1.0D0-1.0D0/(GAMMA*GAMMA)) BETA2=BETA*BETA X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2)/0.991 42 CONTINUE C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON AT C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISRIBUTION SAME AS ELASTIC ANGULAR DISTRIBUTION C AT AN ENERGY OFFSET BY THE IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 43 PEQEL(3,I)=PEQEL(2,(I-IOFF)) C ATTACHMENT X-SECTION SET TO 0.0 43 Q(4,I)=0.0 C COUNTING IONISATION Q(5,I)=0.0 PEQEL(5,I)=0.5 IF(NANISO.EQ.2) PEQEL(5,I)=0.0 IF(EN.LE.E(3)) GO TO 48 IF(EN.GT.XION(NION)) GO TO 46 DO 44 J=2,NION IF(EN.LE.XION(J)) GO TO 45 44 CONTINUE J=NION 45 A=(YINC(J)-YINC(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YINC(J)-XION(J)*YINC(J-1))/(XION(J-1)-XION(J)) Q(5,I)=(A*EN+B)*1.D-16 GO TO 47 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 46 Q(5,I)=CONST*(AM2*X1+C*X2) 47 CONTINUE C USE ANISOTROPIC SCATTERING FOR PRIMARY IONISATION ELECTRON AT C ENERGIES ABOVE 2 * IONISATION ENERGY C ANISOTROPIC ANGULAR DISRIBUTION SAME AS ELASTIC ANGULAR DISTRIBUTION C AT AN ENERGY OFFSET BY THE IONISATION ENERGY IF(EN.LE.(2.0*E(3))) GO TO 48 PEQEL(5,I)=PEQEL(2,(I-IOFF)) 48 CONTINUE Q(6,I)=0.0 C--------------------------------------------------------------------- C QUADRUPOLE BORN ROTATIONAL STATES ( GERJUOY AND STEIN) C--------------------------------------------------------------------- C C SUPERELASTIC ROTATION C DO 53 K=1,38 QIN(K,I)=0.0 IF(EN.LE.0.0) GO TO 53 AJ=DFLOAT(K+1) QIN(K,I)=PJ(K+1)*QBK*DSQRT(1.0-EIN(K)/EN)*AJ*(AJ-1.0)/((2.0*AJ+1.0 /)*(2.0*AJ-1.0)) C CALCULATE ENHANCEMENT OF ROTATIONAL XSEC IN THE RESONANCE REGION DO 51 L=1,NROT IF((EN-EIN(K)).LE.XROT(L)) GO TO 52 51 CONTINUE L=NROT 52 A=(YROT(L)-YROT(L-1))/(XROT(L)-XROT(L-1)) B=(XROT(L-1)*YROT(L)-XROT(L)*YROT(L-1))/(XROT(L-1)-XROT(L)) RESFAC=(EN-EIN(K))*(A*(EN-EIN(K))+B)/EN C USE 30% FOR RESFAC RESFAC=RESFAC*0.3 C BORN ROTATIONAL X-SEC SUM IN RESONANCE REGION = 0.249 RESFAC=1.0+RESFAC/0.249 53 QIN(K,I)=QIN(K,I)*RESFAC C C INELASTIC ROTATION C C CALCULATE ENHANCEMENT OF ROTATIONAL XSEC IN THE RESONANCE REGION 54 DO 55 K=39,76 55 QIN(K,I)=0.0 IF(EN.LE.0.0) GO TO 80 DO 56 L=1,NROT IF(EN.LE.XROT(L)) GO TO 57 56 CONTINUE L=NROT 57 A=(YROT(L)-YROT(L-1))/(XROT(L)-XROT(L-1)) B=(XROT(L-1)*YROT(L)-XROT(L)*YROT(L-1))/(XROT(L-1)-XROT(L)) RESFAC=A*EN+B C USE 30% FOR RESFAC RESFAC=RESFAC*0.3 C BORN ROTATIONAL X-SEC SUM IN RESONANCE REGION = 0.249 RESFAC=1.0+RESFAC/0.249 C ROT 0-2 IF(EN.LE.EIN(39)) GO TO 80 QIN(39,I)=FROT0*QBK*DSQRT(1.0-EIN(39)/EN)*2.0/3.0 QIN(39,I)=QIN(39,I)*RESFAC C ROT 1-3 AND HIGHER DO 58 K=40,76 AJ=DFLOAT(K-39) IF(EN.LE.EIN(K)) GO TO 80 QIN(K,I)=PJ(K-39)*QBK*DSQRT(1.0-EIN(K)/EN)*(AJ+2.0)*(AJ+1.0)/((2.0 /*AJ+3.0)*(2.0*AJ+1.0)) 58 QIN(K,I)=QIN(K,I)*RESFAC C FORCE ROTATIONAL X-SEC TO FALL AT SAME RATE AS THE C ELASTIC X-SECTION ABOVE 5.0 EV 60 IF(EN.LT.5.0) GO TO 80 ASCALE=QMOM/8.90D-16 DO 70 K=1,76 70 QIN(K,I)=QIN(K,I)*ASCALE 80 CONTINUE C--------------------------------------------------------------------- C VIBRATIONAL AND EXCITATION X-SECTIONS C--------------------------------------------------------------------- C V1 SUPERELASTIC QIN(77,I)=0.0 IF(EN.LE.0.0) GO TO 87 DO 85 J=2,NVIB1 IF((EN-EIN(77)).LE.XVB1(J)) GO TO 86 85 CONTINUE J=NVIB1 86 A=(YVB1(J)-YVB1(J-1))/(XVB1(J)-XVB1(J-1)) B=(XVB1(J-1)*YVB1(J)-XVB1(J)*YVB1(J-1))/(XVB1(J-1)-XVB1(J)) QIN(77,I)=(EN-EIN(77))*(A*(EN-EIN(77))+B)/EN QIN(77,I)=APOPV1*QIN(77,I)*1.D-16 87 CONTINUE C V1 QIN(78,I)=0.0 IF(EN.LE.EIN(78)) GO TO 110 DO 90 J=2,NVIB1 IF(EN.LE.XVB1(J)) GO TO 100 90 CONTINUE J=NVIB1 100 A=(YVB1(J)-YVB1(J-1))/(XVB1(J)-XVB1(J-1)) B=(XVB1(J-1)*YVB1(J)-XVB1(J)*YVB1(J-1))/(XVB1(J-1)-XVB1(J)) QIN(78,I)=APOPGS*(A*EN+B)*1.D-16 110 CONTINUE C 2V1 QIN(79,I)=0.0 IF(EN.LE.EIN(79)) GO TO 140 DO 120 J=2,NVIB2 IF(EN.LE.XVB2(J)) GO TO 130 120 CONTINUE J=NVIB2 130 A=(YVB2(J)-YVB2(J-1))/(XVB2(J)-XVB2(J-1)) B=(XVB2(J-1)*YVB2(J)-XVB2(J)*YVB2(J-1))/(XVB2(J-1)-XVB2(J)) QIN(79,I)=APOPGS*(A*EN+B)*1.D-16 140 CONTINUE C 3V1 QIN(80,I)=0.0 IF(EN.LE.EIN(80)) GO TO 170 DO 150 J=2,NVIB3 IF(EN.LE.XVB3(J)) GO TO 160 150 CONTINUE J=NVIB3 160 A=(YVB3(J)-YVB3(J-1))/(XVB3(J)-XVB3(J-1)) B=(XVB3(J-1)*YVB3(J)-XVB3(J)*YVB3(J-1))/(XVB3(J-1)-XVB3(J)) QIN(80,I)=APOPGS*(A*EN+B)*1.D-16 170 CONTINUE C 4V1 QIN(81,I)=0.0 IF(EN.LE.EIN(81)) GO TO 200 DO 180 J=2,NVIB4 IF(EN.LE.XVB4(J)) GO TO 190 180 CONTINUE J=NVIB4 190 A=(YVB4(J)-YVB4(J-1))/(XVB4(J)-XVB4(J-1)) B=(XVB4(J-1)*YVB4(J)-XVB4(J)*YVB4(J-1))/(XVB4(J-1)-XVB4(J)) QIN(81,I)=APOPGS*(A*EN+B)*1.D-16 200 CONTINUE C 5V1 QIN(82,I)=0.0 IF(EN.LE.EIN(82)) GO TO 230 DO 210 J=2,NVIB5 IF(EN.LE.XVB5(J)) GO TO 220 210 CONTINUE J=NVIB5 220 A=(YVB5(J)-YVB5(J-1))/(XVB5(J)-XVB5(J-1)) B=(XVB5(J-1)*YVB5(J)-XVB5(J)*YVB5(J-1))/(XVB5(J-1)-XVB5(J)) QIN(82,I)=APOPGS*(A*EN+B)*1.D-16 230 CONTINUE C 6V1 QIN(83,I)=0.0 IF(EN.LE.EIN(83)) GO TO 260 DO 240 J=2,NVIB6 IF(EN.LE.XVB6(J)) GO TO 250 240 CONTINUE J=NVIB6 250 A=(YVB6(J)-YVB6(J-1))/(XVB6(J)-XVB6(J-1)) B=(XVB6(J-1)*YVB6(J)-XVB6(J)*YVB6(J-1))/(XVB6(J-1)-XVB6(J)) QIN(83,I)=APOPGS*(A*EN+B)*1.D-16 260 CONTINUE C 7V1 QIN(84,I)=0.0 IF(EN.LE.EIN(84)) GO TO 330 DO 310 J=2,NVIB7 IF(EN.LE.XVB7(J)) GO TO 320 310 CONTINUE J=NVIB7 320 A=(YVB7(J)-YVB7(J-1))/(XVB7(J)-XVB7(J-1)) B=(XVB7(J-1)*YVB7(J)-XVB7(J)*YVB7(J-1))/(XVB7(J-1)-XVB7(J)) QIN(84,I)=APOPGS*(A*EN+B)*1.D-16 330 CONTINUE C 8V1 QIN(85,I)=0.0 IF(EN.LE.EIN(85)) GO TO 360 DO 340 J=2,NVIB8 IF(EN.LE.XVB8(J)) GO TO 350 340 CONTINUE J=NVIB8 350 A=(YVB8(J)-YVB8(J-1))/(XVB8(J)-XVB8(J-1)) B=(XVB8(J-1)*YVB8(J)-XVB8(J)*YVB8(J-1))/(XVB8(J-1)-XVB8(J)) QIN(85,I)=APOPGS*(A*EN+B)*1.D-16 360 CONTINUE C 9V1 QIN(86,I)=0.0 IF(EN.LE.EIN(86)) GO TO 2030 DO 2010 J=2,NVIB9 IF(EN.LE.XVB9(J)) GO TO 2020 2010 CONTINUE J=NVIB9 2020 A=(YVB9(J)-YVB9(J-1))/(XVB9(J)-XVB9(J-1)) B=(XVB9(J-1)*YVB9(J)-XVB9(J)*YVB9(J-1))/(XVB9(J-1)-XVB9(J)) QIN(86,I)=APOPGS*(A*EN+B)*1.D-16 2030 CONTINUE C 10V1 QIN(87,I)=0.0 IF(EN.LE.EIN(87)) GO TO 2060 DO 2040 J=2,NVIB10 IF(EN.LE.XVB10(J)) GO TO 2050 2040 CONTINUE J=NVIB10 2050 A=(YVB10(J)-YVB10(J-1))/(XVB10(J)-XVB10(J-1)) B=(XVB10(J-1)*YVB10(J)-XVB10(J)*YVB10(J-1))/(XVB10(J-1)-XVB10(J)) QIN(87,I)=APOPGS*(A*EN+B)*1.D-16 2060 CONTINUE C 11V1 QIN(88,I)=0.0 IF(EN.LE.EIN(88)) GO TO 2130 DO 2110 J=2,NVIB11 IF(EN.LE.XVB11(J)) GO TO 2120 2110 CONTINUE J=NVIB11 2120 A=(YVB11(J)-YVB11(J-1))/(XVB11(J)-XVB11(J-1)) B=(XVB11(J-1)*YVB11(J)-XVB11(J)*YVB11(J-1))/(XVB11(J-1)-XVB11(J)) QIN(88,I)=APOPGS*(A*EN+B)*1.D-16 2130 CONTINUE C 12V1 QIN(89,I)=0.0 IF(EN.LE.EIN(89)) GO TO 2160 DO 2140 J=2,NVIB12 IF(EN.LE.XVB12(J)) GO TO 2150 2140 CONTINUE J=NVIB12 2150 A=(YVB12(J)-YVB12(J-1))/(XVB12(J)-XVB12(J-1)) B=(XVB12(J-1)*YVB12(J)-XVB12(J)*YVB12(J-1))/(XVB12(J-1)-XVB12(J)) QIN(89,I)=APOPGS*(A*EN+B)*1.D-16 2160 CONTINUE C 13V1 QIN(90,I)=0.0 IF(EN.LE.EIN(90)) GO TO 2230 DO 2210 J=2,NVIB13 IF(EN.LE.XVB13(J)) GO TO 2220 2210 CONTINUE J=NVIB13 2220 A=(YVB13(J)-YVB13(J-1))/(XVB13(J)-XVB13(J-1)) B=(XVB13(J-1)*YVB13(J)-XVB13(J)*YVB13(J-1))/(XVB13(J-1)-XVB13(J)) QIN(90,I)=APOPGS*(A*EN+B)*1.D-16 2230 CONTINUE C 14V1 QIN(91,I)=0.0 IF(EN.LE.EIN(91)) GO TO 2260 DO 2240 J=2,NVIB14 IF(EN.LE.XVB14(J)) GO TO 2250 2240 CONTINUE J=NVIB14 2250 A=(YVB14(J)-YVB14(J-1))/(XVB14(J)-XVB14(J-1)) B=(XVB14(J-1)*YVB14(J)-XVB14(J)*YVB14(J-1))/(XVB14(J-1)-XVB14(J)) QIN(91,I)=APOPGS*(A*EN+B)*1.D-16 2260 CONTINUE C 15V1 QIN(92,I)=0.0 IF(EN.LE.EIN(92)) GO TO 2330 DO 2310 J=2,NVIB15 IF(EN.LE.XVB15(J)) GO TO 2320 2310 CONTINUE J=NVIB15 2320 A=(YVB15(J)-YVB15(J-1))/(XVB15(J)-XVB15(J-1)) B=(XVB15(J-1)*YVB15(J)-XVB15(J)*YVB15(J-1))/(XVB15(J-1)-XVB15(J)) QIN(92,I)=APOPGS*(A*EN+B)*1.D-16 2330 CONTINUE C C A3SIGMA (V=0-4) QIN(93,I)=0.0 PEQIN(93,I)=0.5 IF(EN.LE.EIN(93)) 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(93,I)=(A*EN+B)*1.D-16 A=(YTP1M(J)-YTP1M(J-1))/(XTRP1(J)-XTRP1(J-1)) B=(XTRP1(J-1)*YTP1M(J)-XTRP1(J)*YTP1M(J-1))/(XTRP1(J-1)-XTRP1(J)) RAT=A*EN+B PEQIN(93,I)=1.5-RAT 450 CONTINUE C A3SIGMA (V=5-9) QIN(94,I)=0.0 PEQIN(94,I)=0.5 IF(EN.LE.EIN(94)) GO TO 480 DO 460 J=2,NTRP2 IF(EN.LE.XTRP2(J)) GO TO 470 460 CONTINUE J=NTRP2 470 A=(YTRP2(J)-YTRP2(J-1))/(XTRP2(J)-XTRP2(J-1)) B=(XTRP2(J-1)*YTRP2(J)-XTRP2(J)*YTRP2(J-1))/(XTRP2(J-1)-XTRP2(J)) QIN(94,I)=(A*EN+B)*1.D-16 A=(YTP2M(J)-YTP2M(J-1))/(XTRP2(J)-XTRP2(J-1)) B=(XTRP2(J-1)*YTP2M(J)-XTRP2(J)*YTP2M(J-1))/(XTRP2(J-1)-XTRP2(J)) RAT=A*EN+B PEQIN(94,I)=1.5-RAT 480 CONTINUE C B3PI (V=0-3) QIN(95,I)=0.0 PEQIN(95,I)=0.5 IF(EN.LE.EIN(95)) 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(95,I)=(A*EN+B)*1.D-16 A=(YTP3M(J)-YTP3M(J-1))/(XTRP3(J)-XTRP3(J-1)) B=(XTRP3(J-1)*YTP3M(J)-XTRP3(J)*YTP3M(J-1))/(XTRP3(J-1)-XTRP3(J)) RAT=A*EN+B PEQIN(95,I)=1.5-RAT 510 CONTINUE C W3DELTA (V=0-5) QIN(96,I)=0.0 PEQIN(96,I)=0.5 IF(EN.LE.EIN(96)) GO TO 540 DO 520 J=2,NTRP4 IF(EN.LE.XTRP4(J)) GO TO 530 520 CONTINUE J=NTRP4 530 A=(YTRP4(J)-YTRP4(J-1))/(XTRP4(J)-XTRP4(J-1)) B=(XTRP4(J-1)*YTRP4(J)-XTRP4(J)*YTRP4(J-1))/(XTRP4(J-1)-XTRP4(J)) QIN(96,I)=(A*EN+B)*1.D-16 A=(YTP4M(J)-YTP4M(J-1))/(XTRP4(J)-XTRP4(J-1)) B=(XTRP4(J-1)*YTP4M(J)-XTRP4(J)*YTP4M(J-1))/(XTRP4(J-1)-XTRP4(J)) RAT=A*EN+B PEQIN(96,I)=1.5-RAT 540 CONTINUE C A3SIGMA (V=10-21) QIN(97,I)=0.0 PEQIN(97,I)=0.5 IF(EN.LE.EIN(97)) 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(97,I)=(A*EN+B)*1.D-16 A=(YTP5M(J)-YTP5M(J-1))/(XTRP5(J)-XTRP5(J-1)) B=(XTRP5(J-1)*YTP5M(J)-XTRP5(J)*YTP5M(J-1))/(XTRP5(J-1)-XTRP5(J)) RAT=A*EN+B PEQIN(97,I)=1.5-RAT 570 CONTINUE C B3PI (V=4-16) QIN(98,I)=0.0 PEQIN(98,I)=0.5 IF(EN.LE.EIN(98)) GO TO 600 DO 580 J=2,NTRP6 IF(EN.LE.XTRP6(J)) GO TO 590 580 CONTINUE J=NTRP6 590 A=(YTRP6(J)-YTRP6(J-1))/(XTRP6(J)-XTRP6(J-1)) B=(XTRP6(J-1)*YTRP6(J)-XTRP6(J)*YTRP6(J-1))/(XTRP6(J-1)-XTRP6(J)) QIN(98,I)=(A*EN+B)*1.D-16 A=(YTP6M(J)-YTP6M(J-1))/(XTRP6(J)-XTRP6(J-1)) B=(XTRP6(J-1)*YTP6M(J)-XTRP6(J)*YTP6M(J-1))/(XTRP6(J-1)-XTRP6(J)) RAT=A*EN+B PEQIN(98,I)=1.5-RAT 600 CONTINUE C W3DEL (V=6-10) QIN(99,I)=0.0 PEQIN(99,I)=0.5 IF(EN.LE.EIN(99)) GO TO 603 DO 601 J=2,NTRP7 IF(EN.LE.XTRP7(J)) GO TO 602 601 CONTINUE J=NTRP7 602 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(99,I)=(A*EN+B)*1.D-16 A=(YTP7M(J)-YTP7M(J-1))/(XTRP7(J)-XTRP7(J-1)) B=(XTRP7(J-1)*YTP7M(J)-XTRP7(J)*YTP7M(J-1))/(XTRP7(J-1)-XTRP7(J)) RAT=A*EN+B PEQIN(99,I)=1.5-RAT 603 CONTINUE C A1PI (V=0-3) QIN(100,I)=0.0 PEQIN(100,I)=0.5 IF(EN.LE.EIN(100)) GO TO 630 DO 610 J=2,NSNG1 IF(EN.LE.XSNG1(J)) GO TO 620 610 CONTINUE J=NSNG1 620 A=(YSNG1(J)-YSNG1(J-1))/(XSNG1(J)-XSNG1(J-1)) B=(XSNG1(J-1)*YSNG1(J)-XSNG1(J)*YSNG1(J-1))/(XSNG1(J-1)-XSNG1(J)) QIN(100,I)=(A*EN+B)*1.D-16 A=(YSG1M(J)-YSG1M(J-1))/(XSNG1(J)-XSNG1(J-1)) B=(XSNG1(J-1)*YSG1M(J)-XSNG1(J)*YSG1M(J-1))/(XSNG1(J-1)-XSNG1(J)) RAT=A*EN+B PEQIN(100,I)=1.5-RAT 630 CONTINUE C B!3SIG (V=0-6) QIN(101,I)=0.0 PEQIN(101,I)=0.5 IF(EN.LE.EIN(101)) GO TO 633 DO 631 J=2,NTRP8 IF(EN.LE.XTRP8(J)) GO TO 632 631 CONTINUE J=NTRP8 632 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(101,I)=(A*EN+B)*1.D-16 A=(YTP8M(J)-YTP8M(J-1))/(XTRP8(J)-XTRP8(J-1)) B=(XTRP8(J-1)*YTP8M(J)-XTRP8(J)*YTP8M(J-1))/(XTRP8(J-1)-XTRP8(J)) RAT=A*EN+B PEQIN(101,I)=1.5-RAT 633 CONTINUE C A!1SIG (V=0-6) QIN(102,I)=0.0 PEQIN(102,I)=0.5 IF(EN.LE.EIN(102)) 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(102,I)=(A*EN+B)*1.D-16 A=(YSG2M(J)-YSG2M(J-1))/(XSNG2(J)-XSNG2(J-1)) B=(XSNG2(J-1)*YSG2M(J)-XSNG2(J)*YSG2M(J-1))/(XSNG2(J-1)-XSNG2(J)) RAT=A*EN+B PEQIN(102,I)=1.5-RAT 660 CONTINUE C W3DEL (V=11-19) QIN(103,I)=0.0 PEQIN(103,I)=0.5 IF(EN.LE.EIN(103)) GO TO 690 DO 670 J=2,NTRP9 IF(EN.LE.XTRP9(J)) GO TO 680 670 CONTINUE J=NTRP9 680 A=(YTRP9(J)-YTRP9(J-1))/(XTRP9(J)-XTRP9(J-1)) B=(XTRP9(J-1)*YTRP9(J)-XTRP9(J)*YTRP9(J-1))/(XTRP9(J-1)-XTRP9(J)) QIN(103,I)=(A*EN+B)*1.D-16 A=(YTP9M(J)-YTP9M(J-1))/(XTRP9(J)-XTRP9(J-1)) B=(XTRP9(J-1)*YTP9M(J)-XTRP9(J)*YTP9M(J-1))/(XTRP9(J-1)-XTRP9(J)) RAT=A*EN+B PEQIN(103,I)=1.5-RAT 690 CONTINUE C W1DEL (V=0-5) QIN(104,I)=0.0 PEQIN(104,I)=0.5 IF(EN.LE.EIN(104)) GO TO 720 DO 700 J=2,NSNG3 IF(EN.LE.XSNG3(J)) GO TO 710 700 CONTINUE J=NSNG3 710 A=(YSNG3(J)-YSNG3(J-1))/(XSNG3(J)-XSNG3(J-1)) B=(XSNG3(J-1)*YSNG3(J)-XSNG3(J)*YSNG3(J-1))/(XSNG3(J-1)-XSNG3(J)) QIN(104,I)=(A*EN+B)*1.D-16 A=(YSG3M(J)-YSG3M(J-1))/(XSNG3(J)-XSNG3(J-1)) B=(XSNG3(J-1)*YSG3M(J)-XSNG3(J)*YSG3M(J-1))/(XSNG3(J-1)-XSNG3(J)) RAT=A*EN+B PEQIN(104,I)=1.5-RAT 720 CONTINUE C A1PI (V=4-15) QIN(105,I)=0.0 PEQIN(105,I)=0.5 IF(EN.LE.EIN(105)) GO TO 723 DO 721 J=2,NSNG4 IF(EN.LE.XSNG4(J)) GO TO 722 721 CONTINUE J=NSNG4 722 A=(YSNG4(J)-YSNG4(J-1))/(XSNG4(J)-XSNG4(J-1)) B=(XSNG4(J-1)*YSNG4(J)-XSNG4(J)*YSNG4(J-1))/(XSNG4(J-1)-XSNG4(J)) QIN(105,I)=(A*EN+B)*1.D-16 A=(YSG4M(J)-YSG4M(J-1))/(XSNG4(J)-XSNG4(J-1)) B=(XSNG4(J-1)*YSG4M(J)-XSNG4(J)*YSG4M(J-1))/(XSNG4(J-1)-XSNG4(J)) RAT=A*EN+B PEQIN(105,I)=1.5-RAT 723 CONTINUE C B!3SIG (V=7-18) QIN(106,I)=0.0 PEQIN(106,I)=0.5 IF(EN.LE.EIN(106)) GO TO 750 DO 730 J=2,NTRP10 IF(EN.LE.XTRP10(J)) GO TO 740 730 CONTINUE J=NTRP10 740 A=(YTRP10(J)-YTRP10(J-1))/(XTRP10(J)-XTRP10(J-1)) B=(XTRP10(J-1)*YTRP10(J)-XTRP10(J)*YTRP10(J-1))/(XTRP10(J-1)- /XTRP10(J)) QIN(106,I)=(A*EN+B)*1.D-16 A=(YTP10M(J)-YTP10M(J-1))/(XTRP10(J)-XTRP10(J-1)) B=(XTRP10(J-1)*YTP10M(J)-XTRP10(J)*YTP10M(J-1))/(XTRP10(J-1)- /XTRP10(J)) RAT=A*EN+B PEQIN(106,I)=1.5-RAT 750 CONTINUE C A!1SIG (V=7-19) QIN(107,I)=0.0 PEQIN(107,I)=0.5 IF(EN.LE.EIN(107)) GO TO 780 DO 760 J=2,NSNG5 IF(EN.LE.XSNG5(J)) GO TO 770 760 CONTINUE J=NSNG5 770 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(107,I)=(A*EN+B)*1.D-16 A=(YSG5M(J)-YSG5M(J-1))/(XSNG5(J)-XSNG5(J-1)) B=(XSNG5(J-1)*YSG5M(J)-XSNG5(J)*YSG5M(J-1))/(XSNG5(J-1)-XSNG5(J)) RAT=A*EN+B PEQIN(107,I)=1.5-RAT 780 CONTINUE C W1DEL (V=6-18) QIN(108,I)=0.0 PEQIN(108,I)=0.5 IF(EN.LE.EIN(108)) GO TO 783 DO 781 J=2,NSNG6 IF(EN.LE.XSNG6(J)) GO TO 782 781 CONTINUE J=NSNG6 782 A=(YSNG6(J)-YSNG6(J-1))/(XSNG6(J)-XSNG6(J-1)) B=(XSNG6(J-1)*YSNG6(J)-XSNG6(J)*YSNG6(J-1))/(XSNG6(J-1)-XSNG6(J)) QIN(108,I)=(A*EN+B)*1.D-16 A=(YSG6M(J)-YSG6M(J-1))/(XSNG6(J)-XSNG6(J-1)) B=(XSNG6(J-1)*YSG6M(J)-XSNG6(J)*YSG6M(J-1))/(XSNG6(J-1)-XSNG6(J)) RAT=A*EN+B PEQIN(108,I)=1.5-RAT 783 CONTINUE C C3PI (V=0-4) QIN(109,I)=0.0 PEQIN(109,I)=0.5 IF(EN.LE.EIN(109)) GO TO 786 DO 784 J=2,NTRP11 IF(EN.LE.XTRP11(J)) GO TO 785 784 CONTINUE J=NTRP11 785 A=(YTRP11(J)-YTRP11(J-1))/(XTRP11(J)-XTRP11(J-1)) B=(XTRP11(J-1)*YTRP11(J)-XTRP11(J)*YTRP11(J-1))/(XTRP11(J-1)- /XTRP11(J)) QIN(109,I)=(A*EN+B)*1.D-16 A=(YTP11M(J)-YTP11M(J-1))/(XTRP11(J)-XTRP11(J-1)) B=(XTRP11(J-1)*YTP11M(J)-XTRP11(J)*YTP11M(J-1))/(XTRP11(J-1)- /XTRP11(J)) RAT=A*EN+B PEQIN(109,I)=1.5-RAT 786 CONTINUE C E3SIG QIN(110,I)=0.0 PEQIN(110,I)=0.5 IF(EN.LE.EIN(110)) GO TO 789 DO 787 J=2,NTRP12 IF(EN.LE.XTRP12(J)) GO TO 788 787 CONTINUE J=NTRP12 788 A=(YTRP12(J)-YTRP12(J-1))/(XTRP12(J)-XTRP12(J-1)) B=(XTRP12(J-1)*YTRP12(J)-XTRP12(J)*YTRP12(J-1))/(XTRP12(J-1)- /XTRP12(J)) QIN(110,I)=(A*EN+B)*1.D-16 A=(YTP12M(J)-YTP12M(J-1))/(XTRP12(J)-XTRP12(J-1)) B=(XTRP12(J-1)*YTP12M(J)-XTRP12(J)*YTP12M(J-1))/(XTRP12(J-1)- /XTRP12(J)) RAT=A*EN+B PEQIN(110,I)=1.5-RAT 789 CONTINUE C A!!1SIG (V=0-1) QIN(111,I)=0.0 PEQIN(111,I)=0.5 IF(EN.LE.EIN(111)) GO TO 792 DO 790 J=2,NSNG7 IF(EN.LE.XSNG7(J)) GO TO 791 790 CONTINUE J=NSNG7 791 A=(YSNG7(J)-YSNG7(J-1))/(XSNG7(J)-XSNG7(J-1)) B=(XSNG7(J-1)*YSNG7(J)-XSNG7(J)*YSNG7(J-1))/(XSNG7(J-1)-XSNG7(J)) QIN(111,I)=(A*EN+B)*1.D-16 A=(YSG7M(J)-YSG7M(J-1))/(XSNG7(J)-XSNG7(J-1)) B=(XSNG7(J-1)*YSG7M(J)-XSNG7(J)*YSG7M(J-1))/(XSNG7(J-1)-XSNG7(J)) RAT=A*EN+B PEQIN(111,I)=1.5-RAT 792 CONTINUE C B1PI (V=0-6) QIN(112,I)=0.0 PEQIN(112,I)=0.5 IF(EN.LE.EIN(112)) GO TO 795 DO 793 J=2,NSNG8 IF(EN.LE.XSNG8(J)) GO TO 794 793 CONTINUE J=NSNG8 794 A=(YSNG8(J)-YSNG8(J-1))/(XSNG8(J)-XSNG8(J-1)) B=(XSNG8(J-1)*YSNG8(J)-XSNG8(J)*YSNG8(J-1))/(XSNG8(J-1)-XSNG8(J)) QIN(112,I)=(A*EN+B)*1.D-16 A=(YSG8M(J)-YSG8M(J-1))/(XSNG8(J)-XSNG8(J-1)) B=(XSNG8(J-1)*YSG8M(J)-XSNG8(J)*YSG8M(J-1))/(XSNG8(J-1)-XSNG8(J)) RAT=A*EN+B PEQIN(112,I)=1.5-RAT 795 CONTINUE C C!1SIG (V=0-3) QIN(113,I)=0.0 PEQIN(113,I)=0.5 IF(EN.LE.EIN(113)) GO TO 798 DO 796 J=2,NSNG9 IF(EN.LE.XSNG9(J)) GO TO 797 796 CONTINUE J=NSNG9 797 A=(YSNG9(J)-YSNG9(J-1))/(XSNG9(J)-XSNG9(J-1)) B=(XSNG9(J-1)*YSNG9(J)-XSNG9(J)*YSNG9(J-1))/(XSNG9(J-1)-XSNG9(J)) QIN(113,I)=(A*EN+B)*1.D-16 A=(YSG9M(J)-YSG9M(J-1))/(XSNG9(J)-XSNG9(J-1)) B=(XSNG9(J-1)*YSG9M(J)-XSNG9(J)*YSG9M(J-1))/(XSNG9(J-1)-XSNG9(J)) RAT=A*EN+B PEQIN(113,I)=1.5-RAT 798 CONTINUE C G 3PI (V=0-3) QIN(114,I)=0.0 PEQIN(114,I)=0.5 IF(EN.LE.EIN(114)) GO TO 801 DO 799 J=2,NTRP13 IF(EN.LE.XTRP13(J)) GO TO 800 799 CONTINUE J=NTRP13 800 A=(YTRP13(J)-YTRP13(J-1))/(XTRP13(J)-XTRP13(J-1)) B=(XTRP13(J-1)*YTRP13(J)-XTRP13(J)*YTRP13(J-1))/(XTRP13(J-1)- /XTRP13(J)) QIN(114,I)=(A*EN+B)*1.D-16 A=(YTP13M(J)-YTP13M(J-1))/(XTRP13(J)-XTRP13(J-1)) B=(XTRP13(J-1)*YTP13M(J)-XTRP13(J)*YTP13M(J-1))/(XTRP13(J-1)- /XTRP13(J)) RAT=A*EN+B PEQIN(114,I)=1.5-RAT 801 CONTINUE C C3 1PI (V=0-3) QIN(115,I)=0.0 PEQIN(115,I)=0.5 IF(EN.LE.EIN(115)) GO TO 804 DO 802 J=2,NSNG10 IF(EN.LE.XSNG10(J)) GO TO 803 802 CONTINUE J=NSNG10 803 A=(YSNG10(J)-YSNG10(J-1))/(XSNG10(J)-XSNG10(J-1)) B=(XSNG10(J-1)*YSNG10(J)-XSNG10(J)*YSNG10(J-1))/(XSNG10(J-1)- /XSNG10(J)) QIN(115,I)=(A*EN+B)*1.D-16 A=(YSG10M(J)-YSG10M(J-1))/(XSNG10(J)-XSNG10(J-1)) B=(XSNG10(J-1)*YSG10M(J)-XSNG10(J)*YSG10M(J-1))/(XSNG10(J-1)- /XSNG10(J)) RAT=A*EN+B PEQIN(115,I)=1.5-RAT 804 CONTINUE C F 3PI (V=0-3) QIN(116,I)=0.0 PEQIN(116,I)=0.5 IF(EN.LE.EIN(116)) GO TO 807 DO 805 J=2,NTRP14 IF(EN.LE.XTRP14(J)) GO TO 806 805 CONTINUE J=NTRP14 806 A=(YTRP14(J)-YTRP14(J-1))/(XTRP14(J)-XTRP14(J-1)) B=(XTRP14(J-1)*YTRP14(J)-XTRP14(J)*YTRP14(J-1))/(XTRP14(J-1)- /XTRP14(J)) QIN(116,I)=(A*EN+B)*1.D-16 A=(YTP14M(J)-YTP14M(J-1))/(XTRP14(J)-XTRP14(J-1)) B=(XTRP14(J-1)*YTP14M(J)-XTRP14(J)*YTP14M(J-1))/(XTRP14(J-1)- /XTRP14(J)) RAT=A*EN+B PEQIN(116,I)=1.5-RAT 807 CONTINUE C B! 1SIG (V=0-10) QIN(117,I)=0.0 PEQIN(117,I)=0.5 IF(EN.LE.EIN(117)) GO TO 810 DO 808 J=2,NSNG11 IF(EN.LE.XSNG11(J)) GO TO 809 808 CONTINUE J=NSNG11 809 A=(YSNG11(J)-YSNG11(J-1))/(XSNG11(J)-XSNG11(J-1)) B=(XSNG11(J-1)*YSNG11(J)-XSNG11(J)*YSNG11(J-1))/(XSNG11(J-1)- /XSNG11(J)) QIN(117,I)=(A*EN+B)*1.D-16 A=(YSG11M(J)-YSG11M(J-1))/(XSNG11(J)-XSNG11(J-1)) B=(XSNG11(J-1)*YSG11M(J)-XSNG11(J)*YSG11M(J-1))/(XSNG11(J-1)- /XSNG11(J)) RAT=A*EN+B PEQIN(117,I)=1.5-RAT 810 CONTINUE C B1PI (V=7-14) QIN(118,I)=0.0 PEQIN(118,I)=0.5 IF(EN.LE.EIN(118)) GO TO 813 DO 811 J=2,NSNG12 IF(EN.LE.XSNG12(J)) GO TO 812 811 CONTINUE J=NSNG12 812 A=(YSNG12(J)-YSNG12(J-1))/(XSNG12(J)-XSNG12(J-1)) B=(XSNG12(J-1)*YSNG12(J)-XSNG12(J)*YSNG12(J-1))/(XSNG12(J-1)- /XSNG12(J)) QIN(118,I)=(A*EN+B)*1.D-16 A=(YSG12M(J)-YSG12M(J-1))/(XSNG12(J)-XSNG12(J-1)) B=(XSNG12(J-1)*YSG12M(J)-XSNG12(J)*YSG12M(J-1))/(XSNG12(J-1)- /XSNG12(J)) RAT=A*EN+B PEQIN(118,I)=1.5-RAT 813 CONTINUE C O3 1PI (V=0-3) QIN(119,I)=0.0 PEQIN(119,I)=0.5 IF(EN.LE.EIN(119)) GO TO 816 DO 814 J=2,NSNG13 IF(EN.LE.XSNG13(J)) GO TO 815 814 CONTINUE J=NSNG13 815 A=(YSNG13(J)-YSNG13(J-1))/(XSNG13(J)-XSNG13(J-1)) B=(XSNG13(J-1)*YSNG13(J)-XSNG13(J)*YSNG13(J-1))/(XSNG13(J-1)- /XSNG12(J)) QIN(119,I)=(A*EN+B)*1.D-16 A=(YSG13M(J)-YSG13M(J-1))/(XSNG13(J)-XSNG13(J-1)) B=(XSNG13(J-1)*YSG13M(J)-XSNG13(J)*YSG13M(J-1))/(XSNG13(J-1)- /XSNG12(J)) RAT=A*EN+B PEQIN(119,I)=1.5-RAT 816 CONTINUE C B! 1SIG (V=11-HIGH) QIN(120,I)=0.0 PEQIN(120,I)=0.5 IF(EN.LE.EIN(120)) GO TO 819 DO 817 J=2,NSNG14 IF(EN.LE.XSNG14(J)) GO TO 818 817 CONTINUE J=NSNG14 818 A=(YSNG14(J)-YSNG14(J-1))/(XSNG14(J)-XSNG14(J-1)) B=(XSNG14(J-1)*YSNG14(J)-XSNG14(J)*YSNG14(J-1))/(XSNG14(J-1)- /XSNG14(J)) QIN(120,I)=(A*EN+B)*1.D-16 A=(YSG14M(J)-YSG14M(J-1))/(XSNG14(J)-XSNG14(J-1)) B=(XSNG14(J-1)*YSG14M(J)-XSNG14(J)*YSG14M(J-1))/(XSNG14(J-1)- /XSNG14(J)) RAT=A*EN+B PEQIN(120,I)=1.5-RAT 819 CONTINUE C SUM OF HIGHER SINGLET STATES QIN(121,I)=0.0 PEQIN(121,I)=0.5 IF(EN.LE.EIN(121)) GO TO 895 DO 893 J=2,NSNG15 IF(EN.LE.XSNG15(J)) GO TO 894 893 CONTINUE J=NSNG15 894 A=(YSNG15(J)-YSNG15(J-1))/(XSNG15(J)-XSNG15(J-1)) B=(XSNG15(J-1)*YSNG15(J)-XSNG15(J)*YSNG15(J-1))/(XSNG15(J-1)- /XSNG15(J)) QIN(121,I)=(A*EN+B)*1.D-16 A=(YSG15M(J)-YSG15M(J-1))/(XSNG15(J)-XSNG15(J-1)) B=(XSNG15(J-1)*YSG15M(J)-XSNG15(J)*YSG15M(J-1))/(XSNG15(J-1)- /XSNG15(J)) RAT=A*EN+B PEQIN(121,I)=1.5-RAT 895 CONTINUE C ROTATIONAL SUM SUMR=0.0 DO 897 K=1,76 SUMR=SUMR+QIN(K,I) 897 CONTINUE C VIBRATIONAL SUM SUMV=0 DO 898 K=77,92 SUMV=SUMV+QIN(K,I) 898 CONTINUE C EXCITATION SUM SUMEX=0.0 DO 899 K=93,111 SUMEX=SUMEX+QIN(K,I) 899 CONTINUE C EXCITATION SUM SUMEX1=0.0 DO 8999 K=112,121 SUMEX1=SUMEX1+QIN(K,I) 8999 CONTINUE C GET CORRECT ELASTIC XSECTION BY SUBTRACTION OF ROTATION Q(2,I)=Q(2,I)-SUMR C FOR VERY HIGH TEMPERATURES SOMETIMES SUMR BECOMES LARGER THAN C THE ELASTIC+ROT (ONLY IN FIRST TWO ENERGY BINS) FIX GT 0 IF(Q(2,I).LE.0.0) THEN Q(2,I)=0.95D-16 ENDIF Q(1,I)=Q(2,I)+Q(3,I)+SUMR+SUMV+SUMEX+SUMEX1 C CAN PRINT OUT X-SECTION DATA C SUMR=SUMR*1.D16 C SUMV=SUMV*1.D16 C SUMEX=SUMEX*1.D16 C SUMEX1=SUMEX1*1.D16 C SUMVEX=SUMV+SUMEX+SUMEX1 C SUMVEXI=SUMVEX+Q(5,I)*1.D16 C WRITE(6,8769) EN,SUMR,SUMV,SUMEX,SUMEX1,SUMVEX,SUMVEXI C8769 FORMAT(' EN=',F8.3,' SUMR=',F8.3,' SUMV=',F8.3,' SUMEX=',F8.3,' SU C /MEX1=',F8.3,' SUMVEX=',F8.3,' TOT=',F8.3) 900 CONTINUE C SAVE COMPUTE TIME DO 1000 K=1,121 J=122-K IF(EFINAL.LE.EIN(J)) NIN=J-1 1000 CONTINUE IF(NIN.LT.77) NIN=77 C RETURN END SUBROUTINE GAS17(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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 WRITE(6,100) C 100 FORMAT(1H1) C WRITE(6,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.0 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.0 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.0 SINGLE=0.0 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.0 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.0 Q(6,I)=0.0 C QIN(1,I)=0.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS18(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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)*DEXP(-K*(K+1)*B0/AKT) SUM=1.0D0 DO 4 K=1,60 4 SUM=SUM+PJ(K) FROT0=1.0/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=DEXP(EIN(121)/AKT) APOPV1=DEXP(EIN(123)/AKT) C WRITE(6,99) FROT0,(PJ(J),J=1,60) C 99 FORMAT(2X,'POP OF STATES=',/,10(2X,D10.3)) C WRITE(6,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.0 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.0 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.0 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.0 Q(6,I)=0.0 C---------------------------------------------------------------------- C DIPOLE BORN ROTATIONAL STATES C--------------------------------------------------------------------- ENRT=DSQRT(EN) C SUPERELASTIC COLLISIONS DO 100 L=1,60 AL=DFLOAT(L) QIN(L,I)=PJ(L)*DBK*DLOG((ENRT+DSQRT(EN-EIN(L)))/(DSQRT(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 IF(EN.LE.EIN(61)) GO TO 200 QIN(61,I)=FROT0*DBK*DLOG((ENRT+DSQRT(EN-EIN(61)))/(ENRT-DSQRT(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 IF(EN.LE.EIN(L)) GO TO 200 AL=DFLOAT(L-61) QIN(L,I)=PJ(L-61)*DBK*DLOG((ENRT+DSQRT(EN-EIN(L)))/(ENRT-DSQRT(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.0 IF(EN.LE.0.0) GO TO 325 EFAC=DSQRT(1.0-(EIN(121)/EN)) QIN(121,I)=AMPV2*DLOG((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.0 IF(EN.LE.EIN(122)) GO TO 350 EFAC=DSQRT(1.0-(EIN(122)/EN)) QIN(122,I)=AMPV2*DLOG((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.0 IF(EN.LE.0.0) GO TO 375 EFAC=DSQRT(1.0-(EIN(123)/EN)) QIN(123,I)=AMPV1*DLOG((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.0 IF(EN.LE.EIN(124)) GO TO 400 EFAC=DSQRT(1.0-(EIN(124)/EN)) QIN(124,I)=AMPV1*DLOG((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.0 IF(EN.LE.EIN(125)) GO TO 450 EFAC=DSQRT(1.0-(EIN(125)/EN)) QIN(125,I)=AMPV3*DLOG((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.0 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.0 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.0 IF(EN.LE.EIN(128)) GO TO 600 QIN(128,I)=QIN(127,I)*0.9 600 CONTINUE QIN(129,I)=0.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS19(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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='ETHENE C2H4 99 ' 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=DEXP(EIN(1)/AKT) APOPH=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C C V7 SUPERELASTIC QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 350 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*DLOG((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.0 IF(EN.LE.0.0) GO TO 4150 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 450 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*DLOG((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.0 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.0 IF(EN.LE.EIN(6)) GO TO 550 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP3*DLOG((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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS20(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=' ACETYLENE 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.0 APOPV5=DEXP(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.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC V5 QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS21(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XELM(142),YELM(142),YELT(142),YEPS(142), /XROT0(53),YROT0(53),XROT1(43),YROT1(43),XROT2(28),YROT2(28), /XROT3(28),YROT3(28),XVIB1(43),YVIB1(43),XVIB2(42),YVIB2(42), /XVIB3(13),YVIB3(13),XVIB4(12),YVIB4(12), /XB3S1(3),YB3S1(3),XB3S2(6),YB3S2(6),XB3S3(5),YB3S3(5), /XB3S4(8),YB3S4(8),XC3PI(5),YC3PI(5),XA3SG(5),YA3SG(5), /XE3SG(5),YE3SG(5),XEFSG(34),YEFSG(34), /XEXC1(20),YEXC1(20),XEXC2(23),YEXC2(23), /XATT(18),YATT(18),XION(92),YION(92),IOFFN(106),PJ(7),ERLVL(7), /BEF(10) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C -------------------------------------------------------------- C ELASTIC MT DATA XELM/0.00,.001,.0012,.0015,.0018,.002,.0025,.003,.004,.005, /.006,.007,.008,.009,.010,.012,.015,.018,.020,.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,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.,175., /200.,250.,300.,350.,400.,450.,500.,600.,700.,800., /900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,3500.,4000., /4500.,5000.,6000.,7000.,8000.,9000.,1.0D4,1.25D4,1.5D4,1.75D4, /2.0D4,2.5D4,3.0D4,3.5D4,4.0D4,4.5D4,5.0D4,6.0D4,7.0D4,8.0D4, /9.0D4,1.0D5,1.25D5,1.5D5,1.75D5,2.0D5,2.5D5,3.0D5,3.5D5,4.0D5, /4.5D5,5.0D5,6.0D5,7.0D5,8.0D5,9.0D5,1.0D6,1.25D6,1.5D6,1.75D6, /2.0D6,2.5D6,3.0D6,3.5D6,4.0D6,4.5D6,5.0D6,6.0D6,7.0D6,8.0D6, /9.0D6,1.0D7/ DATA YELM/7.24,7.25,7.26,7.26,7.27,7.28,7.30,7.35,7.38,7.45, /7.48,7.54,7.59,7.64,7.70,7.78,7.90,8.04,8.14,8.33, /8.56,8.93,9.27,9.54,9.79,10.04,10.25,10.47,10.86,11.35, /11.78,12.02,12.54,13.00,13.81,14.52,15.16,15.66,16.17,16.58, /17.01,17.70,18.05,18.05,17.70,16.60,15.35,12.85,10.90,9.450, /8.20,7.20,6.30,5.60,4.45,3.275,2.529,2.154,1.476,1.100, /.702,.505,.375,.295,.238,.195,.170,.116,.0868,.0662, /.0524,.0353,.0256,.0195,.0154,.0125,.0103,.00747,.00567,.00446, /.00361,.00299,.0020,.00144,.00109,8.53D-4,5.69D-4,4.08D-4,3.08D-4, /2.41D-4, /1.94D-4,1.60D-4,1.15D-4,8.65D-5,6.77D-5,5.45D-5,4.49D-5,2.98D-5, /2.13D-5,1.60D-5, /1.26D-5,8.34D-6,5.97D-6,4.51D-6,3.54D-6,2.86D-6,2.36D-6,1.70D-6, /1.29D-6,1.02D-6, /8.26D-7,6.86D-7,4.65D-7,3.40D-7,2.62D-7,2.09D-7,1.44D-7,1.07D-7, /8.37D-8,6.76D-8, /5.62D-8,4.76D-8,3.58D-8,2.82D-8,2.30D-8,1.92D-8,1.63D-8,1.15D-8, /8.67D-9,6.80D-9, /5.49D-9,3.83D-9,2.84D-9,2.20D-9,1.76D-9,1.44D-9,1.20D-9,8.79D-10, /6.72D-10,5.31D-10, /4.31D-10,3.57D-10/ DATA YEPS/0.0,0.0,0.0,0.0,0.0,0.0,0.0,-.00204,-.00406,-.00403, /-.00402,-.00799,-.01195,-.01587,-.01974,-.02548,-.03497,-.04613, /-.05537,-.07162, /-.09485,-.11355,-.13538,-.15360,-.16779,-.18516,-.19550,-.20711, /-.22691,-.25186, /-.27686,-.29241,-.29958,-.33194,-.36128,-.39254,-.42965,-.43614, /-.42939,-.42749, /-.44093,-.43942,-.39970,-.34691,-.29121,-.15375,-.03498,0.18393, /0.31707,0.40003, /0.46174,0.51567,0.56204,0.58937,0.63888,0.68310,0.71518,0.73895, /0.79352,0.81348, /0.85049,0.86411,0.88575,0.89777,0.90257,0.91825,0.91958,0.93123, /0.93873,0.94796, /0.95404,0.96326,0.97004,0.97305,0.97513,0.97827,0.98027,0.98267, /0.98464,0.98629, /.987605,.988622,.990817,.992168,.993473,.994052,.995228,.995858, /.996455,.996914, /.987258,.997548,.997951,.998252,.998475,.998649,.998785,.9990334, /.9992007,.9993190, /.9994023,.9995276,.9996104,.9996674,.9997107,.9997456,.9997718, /.9998134,.9998419,.9998630, /.9998801,.9998934,.9999171,.9999328,.9999437,.9999520,.9999635, /.9999709,.9999760,.9999798, /.9999827,.9999850,.9999883,.9999906,.9999922,.9999934,.9999944, /.9999960,.9999970,.9999977, /.9999981,.9999987,.9999990,.9999993,.9999994,.9999995,.9999996, /.9999997,.9999998,.9999998, /.9999999,.9999999/ C ELASTIC FROM 100 EV DATA YELT/7.24,7.25,7.26,7.26,7.27,7.28,7.30,7.36,7.40,7.43, /7.46,7.50,7.53,7.56,7.60,7.65,7.72,7.80,7.85,7.95, /8.05,8.30,8.50,8.65,8.80,8.93,9.06,9.19,9.42,9.70, /9.92,10.03,10.42,10.60,11.07,11.43,11.68,12.02,12.46,12.79, /13.02,13.56,14.15,14.59,14.78,15.05,15.00,14.66,13.90,13.05, /12.10,11.33,10.54,9.744,8.375,6.678,5.508,4.952,3.931,3.125, /2.299,1.760,1.465,1.241,1.034,0.954,0.841,0.639,0.518,0.443, /.383,.303,.255,.210,.176,.158,.140,.112,.0932,.0800, /.070,.062,.049,.040,.035,.0295,.0235,.0189,.0162,.0142, /.0126,.0114,.00951,.00817,.00717,.00639,.00576,.00464,.00390, /.00336, /.00296,.00240,.00203,.00176,.00156,.00141,.00128,.00110, /9.66D-4,8.67D-4, /7.90D-4,7.28D-4,6.17D-4,5.44D-4,4.91D-4,4.52D-4,3.98D-4,3.63D-4, /3.38D-4,3.19D-4, /3.05D-4,2.94D-4,2.77D-4,2.66D-4,2.58D-4,2.52D-4,2.47D-4,2.39D-4, /2.34D-4,2.31D-4, /2.28D-4,2.25D-4,2.23D-4,2.22D-4,2.22D-4,2.21D-4,2.21D-4,2.20D-4, /2.20D-4,2.20D-4, /2.19D-4,2.19D-4/ C----------------------------------------------------------------------- C ROTATION J=0-2 C SCALED BY 1/E ABOVE 20 EV IN SUBROUTINE DATA XROT0/.043928,.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/ 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.47/ C----------------------------------------------------------------------- C ROTATION J=1-3 C SCALED BY 1/E ABOVE 20 EV IN SUBROUTINE DATA XROT1/0.072741,.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/ 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,.288/ C----------------------------------------------------------------------- C ROTATION J=2-4 C SCALED BY 1/E ABOVE 20 EV IN SUBROUTINE DATA XROT2/0.10085,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/ 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.20/ C ROTATION J=4-6 USE X-SECTION FOR J=2-4 SCALED BY 0.8 C ROTATION J=6-8 USE X-SECTION FOR J=2-4 SCALED BY 0.5 C----------------------------------------------------------------------- C ROTATION J=3-5 C SCALED BY 1/E ABOVE 20 EV IN SUBROUTINE DATA XROT3/0.12797,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/ 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.24/ C ROTATION J=5-7 USE X-SECTION FOR J=3-5 SCALED BY 0.8 C ROTATION J=7-9 USE X-SECTION FOR J=3-5 SCALED BY 0.5 C----------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=0 ROTATIONALLY ELASTIC C SCALE AS 1/E ABOVE 100 EV DATA XVIB1/.515916,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,25.0,30.0,40.0,50.0, /60.0,80.0,100./ DATA YVIB1/0.00,.0005,.0031,.0064,.0071,.0106,.0170,.0279,.0342, /.0399, /.0451,.0501,.0545,.0651,.0735,.0964,.1216,.1624,.1677,.1719, /.1916,.2008,.1860,.1630,.1460,.1160,.0876,.0655,.0510,.0430, /.0366,.0318,.0280,.0241,.0222,.0143,.0104,.0073,.0048,.00416, /.00351,.00262,.00194/ C----------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=2 ROTATIONALLY INELASTIC C SCALE AS 1/E ABOVE 100 EV DATA XVIB2/.568,.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,25.0,30.0,40.0,50.0,60.0, /80.0,100./ DATA YVIB2/0.00,.0002,.0016,.0028,.0058,.0110,.0204,.0264,.0316, /.0369, /.0423,.0477,.0602,.0697,.0994,.1334,.1910,.2008,.2141,.2494, /.2672,.2540,.2270,.2040,.1640,.1224,.0905,.0690,.0570,.0484, /.0422,.0370,.0319,.0294,.0189,.0138,.0097,.0064,.00552,.00466, /.00347,.00257/ C----------------------------------------------------------------------- C VIBRATION V=0-2 DATA XVIB3/1.00265,1.40,1.50,2.00,2.50,3.00,4.00,5.00,6.00,8.00, /10.0,15.0,20.0/ DATA YVIB3/0.00,.001,.002,.011,.025,.033,.035,.032,.027,.021, /.016,.0092,.0066/ C----------------------------------------------------------------------- C VIBRATION V=0-3 DATA XVIB4/1.46083,1.80,2.00,2.50,3.00,4.00,5.00,6.00,8.00, /10.0,15.0,20.0/ DATA YVIB4/.0,.0003,.001,.0025,.0033,.0035,.0032,.0027,.0021, /.0016,.00092,.00066/ C B3 SIGMA+ 100% DISSOCIATIVE SPLIT INTO 4 ENERGY LOSSES C SCALED BY1/E**3 ABOVE 50.0EV DATA XB3S1/8.00,9.20,9.20001/ DATA YB3S1/0.00,.109,0.00/ DATA XB3S2/9.00,9.20,9.20001,10.2,12.2,12.20001/ DATA YB3S2/0.00,0.00,.109,.187,.445,0.00/ DATA XB3S3/9.50,12.2,12.20001,15.2,15.20001/ DATA YB3S3/0.00,0.00,.445,0.63,0.00/ DATA XB3S4/10.0,15.2,15.20001,17.2,20.2,30.0,40.0,50.0/ DATA YB3S4/0.00,0.00,0.63,.516,.353,.153,.069,.035/ C C3 PI V=0-18 SUMMED VIBRATIONS METASTABLE LEVEL C SCALED BY 1/E**3 ABOVE 30 EV DATA XC3PI/11.779,15.0,17.5,20.0,30.0/ DATA YC3PI/0.00,0.09,.126,.135,.072/ C A3 SIGMA V=0-17 SUMMED VIBRATIONS C SCALED BY 1/E**3 ABOVE 30 EV DATA XA3SG/11.793,15.0,17.5,20.0,30.0/ DATA YA3SG/0.00,.072,.081,0.09,.027/ C E3 SIGMA V=0-10 SUMMED VIBRATIONS C SCALED BY 1/E**3 ABOVE 30 EV DATA XE3SG/13.253,15.0,17.5,20.0,30.0/ DATA YE3SG/0.00,.0108,.018,.0225,.0117/ C EF1 SIGMA V=0-19 SUMMED VIBRATIONS C BORN SCALED ABOVE XEFSG(NEFSG) EV DATA XEFSG/12.301,15.0,16.0,17.0,17.5,19.0,20.0,21.0,23.5,26.0, /30.0,40.0,50.0,60.0,70.0,80.0,100.,120.,140.,160., /180.,200.,220.,240.,260.,280.,300.,400.,500.,600., /700.,800.,900.,1000./ DATA YEFSG/0.00,.028,.033,.037,.038,.039,.040,.040,.040,.040, /.040,.041,.041,.039,.036,.034,.029,.026,.024,.022, /.021,.020,.019,.018,.017,.016,.015,.012,.0096,.0080, /.0069,.0061,.0054,.0049/ C B1 SIGMA OSCILLATOR SUM V=0-36 F=0.310770 C C1 PI OSCILLATOR SUM V=0-13 F=0.355995 C B!1 SIGMA OSCILLATOR SUM V=0-8 F=0.044610 C D1 PI OSCILLATOR SUM V=0-15 F=0.074070 C B!!1 SIGMA OSCILLATOR SUM V=0-6 F=0.022300 C D!1 PI OSCILLATOR SUM V=0-3 F=0.014500 C B!!!1 SIGMA + D!!1 PI OSCILLATOR SUM F=0.014500 C B!!!!1 SIGMA + D!!!1 PI OSCILLATOR SUM F=0.010100 C B!!!!!1 SIGMA + D!!!!1 PI OSCILLATOR SUM F=0.005000 C CONTINUUM EXCITATION F=0.026800 C PREDISSOCIATION F=0.017000 C C SUM EXCITATION OSCILLATOR F=0.895645 C SUM IONISATION OSCILLATOR F=1.1219 C TOTAL OSCILLATOR SUM F=2.017545 C----------------------------------------------------------------------- C ATTACHMENT GIVEN AS TABLES AND AS A TEMPERATURE DEPENDENT FUNCTION C C TABLES FOR 2SIGMAg ATTACHMENT DATA XATT/7.00,7.50,8.00,8.50,9.00,9.50,10.0,10.4,11.0,11.5, /12.0,12.5,13.0,13.5,14.0,14.5,15.0,15.5/ DATA YATT/0.00,2.8D-6,1.18D-5,3.08D-5,5.88D-5,1.01D-4,1.18D-4, /1.29D-4,1.18D-4,1.01D-4, /7.28D-5,4.48D-5,2.66D-5,1.26D-5,6.72D-6,3.20D-6,8.0D-7,0.0/ C SEE NOTES ON DERIVATION OF IONISATION X-SECTION DATA XION/15.418,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.,225.,250.,275.,300.,350.,400., /450.,500.,550.,600.,650.,700.,750.,800.,850.,900., /950.,1000.,1200.,1400.,1600.,1800.,2000.,2500.,3000.,3500., /4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000.,10000.,12000., /14000.,16000./ DATA YION/0.00,.0295,.0598,.0910,.121,.154,.184,.217,.245,.276, /.305,.331,.357,.384,.407,.433,.454,.477,.498,.516, /.536,.555,.623,.678,.725,.765,.800,.828,.853,.900, /.927,.945,.954,.957,.957,.956,.950,.944,.934,.920, /.910,.902,.890,.878,.865,.851,.840,.832,.818,.809, /.801,.776,.725,.687,.645,.605,.565,.537,.484,.443, /.404,.379,.343,.322,.307,.287,.276,.261,.251,.239, /.226,.214,.199,.165,.146,.133,.121,.101,.0865,.0754, /.0675,.0610,.0558,.0515,.0480,.0422,.0375,.0340,.0310,.0265, /.0234,.0208/ C*********************************************************************** C IONISATION FROM WEIGHTED AVERAGE OF RAPP AND STRAUB UP TO 180EV C NORMALISED STRAUB BETWEEN 180 AND 1000EV THEN NORMALISED SCHRAM C BETWEEN 1 AND 16KEV. C ABOVE 16KEV USED BORN-BETHE WITH M2=0.642 AND C=8.3 CLOSE FIT TO C RIEKE AND PREPEJCHAL AND CONSISTENT WITH BERKOWITZ C USE ORTHO IONISATION ENERGY AT ROOM TEMPERATURE C DISSOCIATION ENERGY D0=4.47806952 EV C ORTHO PARA ENERGY DIFFERENCE J=0 - J=1 FOR GROUND STATE =0.01469049 EV C C OSCILLATOR STRENGTHS FROM BERKOWITZ WITH SMALL CORRECTIONS FOR NEW C IMPROVED FRANCK-CONDON FACTORS FOR LYMAN (B1 SIGMA) AND WERNER (C1 PI) C TRIPLET X-SECTIONS FROM PUBLISHED ELECTRON SCATTERING UP TO 2010. C LOWEST TRIPLET DISSOCIATIVE STATE (B3 SIGMA) SPLIT INTO FOUR LEVELS IN C ORDER TO BETTER SIMULATE VARYING ENERGY LOSS. C TRIPLET X-SECTIONS SCALED BY 0.9 TO BETTER FIT TOWNSEND COEFICIENT. C TRIPLET SCALING FACTOR WITHIN EXPERIMENTAL MEASUREMENT ERRORS. C ATTACHMENT X-SECTION INCLUDES TEMPERATURE DEPENDENCE FROM ROTATIONAL C POPULATION SHOULD BE ACCURATE UP TO 1000 KELVIN. C MOMENTUM TRANSFER ELASTIC X-SECTION FROM SCHMIDT UP TO 1.0 EV , ABOVE C 1.0 EV X-SECTION FROM FIT TO DRIFT VELOCITY. C FIT TO WITHIN EXPERIMENTAL ERRORS OF DRIFT VELOCITY AND DIFFUSION FROM C TABLE 14.6 OF HUXLEY AND CROMPTON. C SOME EVIDENCE OF ELECTRON RUNAWAY ABOVE 300 TOWNSEND FROM CALCULATION. C----------------------------------------------------------------------- IF(NANISO.EQ.0) THEN NAME=' H2 ISOT 2010 ' ELSE NAME=' H2 ANIS 2010 ' ENDIF C ---------------------------------------------------------------------- C CONST=1.873884D-20 EMASS2=1021997.804 API=DACOS(-1.0D0) A0=0.52917720859D-8 RY=13.60569193 BBCONST=16.0*API*A0*A0*RY*RY/EMASS2 C BORN-BETHE CONSTANTS FOR IONISATION AM2=0.642 C=8.30 C----------------------------------------------------------------------- NIN=106 DO 1 J=1,6 1 KEL(J)=NANISO DO 2 J=13,NIN 2 KIN(J)=NANISO C SET VIBRATION AND ROTATION TO ISOTROPIC DO 22 J=1,12 22 KIN(J)=0 NELM=142 NROT0=53 NROT1=43 NROT2=28 NROT3=28 NVIB1=43 NVIB2=42 NVIB3=13 NVIB4=12 NB3S1=3 NB3S2=6 NB3S3=5 NB3S4=8 NC3PI=5 NA3SG=5 NE3SG=5 NEFSG=34 NION=92 NATT=18 E(1)=0.0 E(2)=2.0*EMASS/(2.015650*AMU) C IONISATION ENERGY FOR PARA =15.42580155 EV C IONISATION ENERGY FOR ORTHO=15.41833111 EV C USE ORTHO ENERGY FOR ROOM TEMPERATURE GAS E(3)=15.418 C EXCITATION X-SECTION AT 1.3 MEV E(4)=0.2228D-18 C IONISING X-SECTION AT 1.3 MEV E(5)=0.1889D-18 C EOBY FOR MINIMUM IONISING PARTICLES E(6)=6.5 C EOBY=12.0 IOFF=IFIX(SNGL(0.5+E(3)/ESTEP)) EIN(1)=-.043928 EIN(2)=-.072741 EIN(3)=-.10085 EIN(4)=-.12797 EIN(5)=0.043928 EIN(6)=0.072741 EIN(7)=0.10085 EIN(8)=0.12797 EIN(9)=0.515916 EIN(10)=0.568 EIN(11)=1.00265 EIN(12)=1.46083 C b3 SIGMA+ DISSOCIATION SPLIT INTO 4 ENERGY LOSSES EIN(13)=8.0 EIN(14)=9.0 EIN(15)=9.5 EIN(16)=10.0 C B1 SIGMA+ LYMAN BANDS EIN(17)=11.189 EIN(18)=11.353 EIN(19)=11.512 EIN(20)=11.666 EIN(21)=11.817 EIN(22)=11.963 EIN(23)=12.105 EIN(24)=12.244 EIN(25)=12.378 EIN(26)=12.509 EIN(27)=12.636 EIN(28)=12.759 EIN(29)=12.878 EIN(30)=12.994 EIN(31)=13.106 EIN(32)=13.215 EIN(33)=13.320 EIN(34)=13.422 EIN(35)=13.521 EIN(36)=13.617 EIN(37)=13.709 EIN(38)=13.798 EIN(39)=13.884 EIN(40)=13.967 EIN(41)=14.047 EIN(42)=14.124 EIN(43)=14.197 EIN(44)=14.268 EIN(45)=14.335 EIN(46)=14.399 EIN(47)=14.458 EIN(48)=14.514 EIN(49)=14.564 EIN(50)=14.608 EIN(51)=14.644 EIN(52)=14.668 EIN(53)=14.678 C C1 PI WERNER BANDS EIN(54)=12.285 EIN(55)=12.571 EIN(56)=12.840 EIN(57)=13.094 EIN(58)=13.332 EIN(59)=13.553 EIN(60)=13.758 EIN(61)=13.947 EIN(62)=14.119 EIN(63)=14.273 EIN(64)=14.408 EIN(65)=14.522 EIN(66)=14.611 EIN(67)=14.672 C C3 PI EIN(68)=11.779 EIN(69)=13.100 C A3 SIGMA EIN(70)=11.793 EIN(71)=12.684 EIN(72)=13.253 C E3 SIGMA EIN(73)=12.301 C EF SIGMA EIN(74)=12.841 C B!1 SIGMA BANDS EIN(75)=13.698 EIN(76)=13.931 EIN(77)=14.144 EIN(78)=14.333 EIN(79)=14.494 EIN(80)=14.613 EIN(81)=14.651 EIN(82)=14.664 EIN(83)=14.672 C D1 PI BANDS EIN(84)=13.994 EIN(85)=14.270 EIN(86)=14.530 EIN(87)=14.775 EIN(88)=15.003 EIN(89)=15.218 EIN(90)=15.418 EIN(91)=15.602 EIN(92)=15.772 EIN(93)=15.928 EIN(94)=16.068 EIN(95)=16.191 EIN(96)=16.299 EIN(97)=16.390 EIN(98)=16.462 EIN(99)=16.516 C B!!1 SIGMA EIN(100)=14.491 C D!1 PI EIN(101)=14.609 C B!!!1 SIGMA + D!!1 PI EIN(102)=14.899 C B!!!!1 SIGMA + D!!!1 PI EIN(103)=15.060 C B!!!!!1 SIGAM + D!!!!1 PI EIN(104)=15.150 C CONTINUUM DISSOCIATIVE EXC EIN(105)=15.300 C PREDISSOCIATION ABOVE IONISATION POTENTIAL EIN(106)=15.800 C BEF SCALING : BINDING ENERGIES BEF(1)=E(3) BEF(2)=E(3) BEF(3)=E(3) BEF(4)=E(3) BEF(5)=E(3) C C ATTACHMENT THRESHOLD EV FOR 2 SIGMAu EATTTH=3.723 C ATTACHMENT WIDTH FOR 2 SIGMAu EATTWD=0.45 C ATTACHMENT AMPLITUDE FOR 2 SIGMAu AMPATT=3.0D-21 C ATTACHMENT THRESHOLD EV FOR 2 SIGMAg EATTTH1=13.922 C ATTACHMENT WIDTH FOR 2 SIGMAg EATTWD1=0.95 C ATTACHMENT AMPLITUDE FOR 2 SIGMAg AMPATT1=3.0D-20 C----------------------------------------------------------------------- C ROTATIONAL ENERGY LEVELS: ERLVL(N) C PARA - ORTHO ENERGY DIFFERENCE ( J=0 - J=1 ROT LEVEL) = 0.01469049 EV C REF :ASTROPHYS J. 282(1984)L85 ERLVL(1)=0.01469049 ERLVL(2)=EIN(5) ERLVL(3)=0.01469049+EIN(6) ERLVL(4)=EIN(5)+EIN(7) ERLVL(5)=0.01469049+EIN(6)+EIN(8) ERLVL(6)=EIN(5)+EIN(7)+0.15381 ERLVL(7)=0.01469049+EIN(6)+EIN(8)+0.1794 C********************************************************************** C ENTER PENNING TRANSFER FRACTION FOR EACH LEVEL C USE TRANSFER FRACTION IN RANGE BETWEEN 0.0 AND 0.2 FOR MOST MIXTURES DO 50 NL=1,NIN PENFRA(1,NL)=0.0 C PENNING TRANSFER DISTANCE MICRONS PENFRA(2,NL)=1.0 C PENNING TRANSFER TIME PICOSECONDS 50 PENFRA(3,NL)=1.0 C********************************************************************** IF(IPEN.EQ.0) GO TO 4 DO 3 KDUM=1,NIN IF(PENFRA(1,KDUM).EQ.0.0) GO TO 3 WRITE(6,999) NAME,EIN(KDUM),PENFRA(1,KDUM),PENFRA(2,KDUM), /PENFRA(3,KDUM) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY =',F5.3,' ABS.LENGTH =',F7.2,' DECAY TIME =',F7.1,/) 3 CONTINUE C 4 DO 5 NL=1,NIN 5 IOFFN(NL)=IFIX(SNGL(0.5+EIN(NL)/ESTEP)) C C ROTATIONAL POPULATIONS DO 6 K=1,7,2 6 PJ(K)=3*(2*K+1)*DEXP(-ERLVL(K)/AKT) DO 7 K=2,6,2 7 PJ(K)=(2*K+1)*DEXP(-ERLVL(K)/AKT) SUM=1.0 DO 8 K=1,7 8 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 FROT6=PJ(6)/SUM FROT7=PJ(7)/SUM C WRITE(6,88) FROT0,FROT1,FROT2,FROT3,FROT4,FROT5,FROT6,FROT7 C 88 FORMAT(3X,' FROT0=',F9.6,' FROT1=',F9.6,' FROT2=',F9.6,' FROT3=', C /F9.6,' FROT4=',F9.6,' FROT5=',F9.6,' FROT6=',F9.6,' FROT7=',F9.6) C----------------------------------------------------------------------- C SCRPT(1)=' ' SCRPT(2)=' ELASTIC (ANISO) HYDROGEN ' IF(NANISO.EQ.0) THEN SCRPT(2)=' ELASTIC (ISOT) HYDROGEN ' ENDIF SCRPT(3)=' IONISATION ELOSS= 15.418 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT 2-0 ELOSS=-0.043928' SCRPT(8)=' ROT 3-1 ELOSS=-0.072741' SCRPT(9)=' ROT 4-2 ELOSS=-0.10085 ' SCRPT(10)=' ROT 5-3 ELOSS=-0.12797 ' SCRPT(11)=' ROT 0-2 ELOSS= 0.043928' SCRPT(12)=' ROT 1-3 ELOSS= 0.072741' SCRPT(13)=' ROT 2-4+46+68 ELOSS= 0.10085 ' SCRPT(14)=' ROT 3-5+57+79 ELOSS= 0.12797 ' SCRPT(15)=' VIB V1 DJ=0 ELOSS= 0.515916' SCRPT(16)=' VIB V1 DJ=2 ELOSS= 0.568 ' SCRPT(17)=' VIB 2V1 ELOSS= 1.00265 ' SCRPT(18)=' VIB 3V1 ELOSS= 1.46083 ' SCRPT(19)=' B3 SIG DIS ELOSS= 8.00 ' SCRPT(20)=' B3 SIG DIS ELOSS= 9.00 ' SCRPT(21)=' B3 SIG DIS ELOSS= 9.50 ' SCRPT(22)=' B3 SIG DIS ELOSS=10.00 ' SCRPT(23)=' B1SIG V=0 LY ELOSS=11.189' SCRPT(24)=' B1SIG V=1 LY ELOSS=11.353' SCRPT(25)=' B1SIG V=2 LY ELOSS=11.512' SCRPT(26)=' B1SIG V=3 LY ELOSS=11.666' SCRPT(27)=' B1SIG V=4 LY ELOSS=11.817' SCRPT(28)=' B1SIG V=5 LY ELOSS=11.963' SCRPT(29)=' B1SIG V=6 LY ELOSS=12.105' SCRPT(30)=' B1SIG V=7 LY ELOSS=12.244' SCRPT(31)=' B1SIG V=8 LY ELOSS=12.378' SCRPT(32)=' B1SIG V=9 LY ELOSS=12.509' SCRPT(33)=' B1SIG V=10 LY ELOSS=12.636' SCRPT(34)=' B1SIG V=11 LY ELOSS=12.759' SCRPT(35)=' B1SIG V=12 LY ELOSS=12.878' SCRPT(36)=' B1SIG V=13 LY ELOSS=12.994' SCRPT(37)=' B1SIG V=14 LY ELOSS=13.106' SCRPT(38)=' B1SIG V=15 LY ELOSS=13.216' SCRPT(39)=' B1SIG V=16 LY ELOSS=13.320' SCRPT(40)=' B1SIG V=17 LY ELOSS=13.422' SCRPT(41)=' B1SIG V=18 LY ELOSS=13.521' SCRPT(42)=' B1SIG V=19 LY ELOSS=13.617' SCRPT(43)=' B1SIG V=20 LY ELOSS=13.709' SCRPT(44)=' B1SIG V=21 LY ELOSS=13.798' SCRPT(45)=' B1SIG V=22 LY ELOSS=13.884' SCRPT(46)=' B1SIG V=23 LY ELOSS=13.967' SCRPT(47)=' B1SIG V=24 LY ELOSS=14.047' SCRPT(48)=' B1SIG V=25 LY ELOSS=14.124' SCRPT(49)=' B1SIG V=26 LY ELOSS=14.197' SCRPT(50)=' B1SIG V=27 LY ELOSS=14.268' SCRPT(51)=' B1SIG V=28 LY ELOSS=14.335' SCRPT(52)=' B1SIG V=29 LY ELOSS=14.399' SCRPT(53)=' B1SIG V=30 LY ELOSS=14.458' SCRPT(54)=' B1SIG V=31 LY ELOSS=14.514' SCRPT(55)=' B1SIG V=32 LY ELOSS=14.564' SCRPT(56)=' B1SIG V=33 LY ELOSS=14.608' SCRPT(57)=' B1SIG V=34 LY ELOSS=14.644' SCRPT(58)=' B1SIG V=35 LY ELOSS=14.668' SCRPT(59)=' B1SIG V=36 LY ELOSS=14.678' SCRPT(60)=' C1 PI V=0 WR ELOSS=12.285' SCRPT(61)=' C1 PI V=1 WR ELOSS=12.571' SCRPT(62)=' C1 PI V=2 WR ELOSS=12.840' SCRPT(63)=' C1 PI V=3 WR ELOSS=13.094' SCRPT(64)=' C1 PI V=4 WR ELOSS=13.332' SCRPT(65)=' C1 PI V=5 WR ELOSS=13.553' SCRPT(66)=' C1 PI V=6 WR ELOSS=13.758' SCRPT(67)=' C1 PI V=7 WR ELOSS=13.947' SCRPT(68)=' C1 PI V=8 WR ELOSS=14.119' SCRPT(69)=' C1 PI V=9 WR ELOSS=14.273' SCRPT(70)=' C1 PI V=10 WR ELOSS=14.408' SCRPT(71)=' C1 PI V=11 WR ELOSS=14.522' SCRPT(72)=' C1 PI V=12 WR ELOSS=14.611' SCRPT(73)=' C1 PI V=13 WR ELOSS=14.672' SCRPT(74)=' C3 PI V=0-4 DIS ELOSS=11.779' SCRPT(75)=' C3 PI V=5-18 DIS ELOSS=13.100' SCRPT(76)=' A3SIG V=0-3 DIS ELOSS=11.793' SCRPT(77)=' A3SIG V=3-17 DIS ELOSS=12.684' SCRPT(78)=' E3SIG V=0-9 DIS ELOSS=13.253' SCRPT(79)=' EF1SIG V=0-5 ELOSS=12.301' SCRPT(80)=' EF1SIG V=6-19 ELOSS=12.841' SCRPT(81)=' B!1SIG V=0 ELOSS=13.698' SCRPT(82)=' B!1SIG V=1 ELOSS=13.931' SCRPT(83)=' B!1SIG V=2 ELOSS=14.144' SCRPT(84)=' B!1SIG V=3 ELOSS=14.333' SCRPT(85)=' B!1SIG V=4 ELOSS=14.494' SCRPT(86)=' B!1SIG V=5 ELOSS=14.613' SCRPT(87)=' B!1SIG V=6 ELOSS=14.651' SCRPT(88)=' B!1SIG V=7 ELOSS=14.664' SCRPT(89)=' B!1SIG V=8 ELOSS=14.672' SCRPT(90)=' D1 PI V=0 ELOSS=13.994' SCRPT(91)=' D1 PI V=1 ELOSS=14.270' SCRPT(92)=' D1 PI V=2 ELOSS=14.530' SCRPT(93)=' D1 PI V=3 DIS ELOSS=14.775' SCRPT(94)=' D1 PI V=4 DIS ELOSS=15.003' SCRPT(95)=' D1 PI V=5 DIS ELOSS=15.218' SCRPT(96)=' D1 PI V=6 DIS ELOSS=15.418' SCRPT(97)=' D1 PI V=7 DIS ELOSS=15.602' SCRPT(98)=' D1 PI V=8 DIS ELOSS=15.772' SCRPT(99)=' D1 PI V=9 DIS ELOSS=15.928' SCRPT(100)=' D1 PI V=10 DIS ELOSS=16.068' SCRPT(101)=' D1 PI V=11 DIS ELOSS=16.191' SCRPT(102)=' D1 PI V=12 DIS ELOSS=16.299' SCRPT(103)=' D1 PI V=13 DIS ELOSS=16.390' SCRPT(104)=' D1 PI V=14 DIS ELOSS=16.462' SCRPT(105)=' D1 PI V=15 DIS ELOSS=16.516' SCRPT(106)=' B!!SIG V=0-6 DIS ELOSS=14.491' SCRPT(107)=' D!1 PI V=0-3 DIS ELOSS=14.609' SCRPT(108)=' 5P SIG 6P PI DIS ELOSS=14.899' SCRPT(109)=' 6P SIG 6P PI DIS ELOSS=15.060' SCRPT(110)=' 7P SIG 7P PI DIS ELOSS=15.150' SCRPT(111)=' CONTINUUM EX DIS EL0SS=15.300' SCRPT(112)=' PREDISS >IP DIS ELOSS=15.800' C c***************************** EN=-ESTEP/2.0 C************************** DO 900 I=1,NSTEP EN=EN+ESTEP IF(EN.GT.EIN(1)) THEN GAMMA1=(EMASS2+2.0D0*EN)/EMASS2 GAMMA2=GAMMA1*GAMMA1 BETA=DSQRT(1.0D0-1.0D0/GAMMA2) BETA2=BETA*BETA ENDIF C DO 60 J=2,NELM IF(EN.LE.XELM(J)) GO TO 70 60 CONTINUE J=NELM C ELASTIC MOMENTUM TRANSFER 70 A=(YELM(J)-YELM(J-1))/(XELM(J)-XELM(J-1)) B=(XELM(J-1)*YELM(J)-XELM(J)*YELM(J-1))/(XELM(J-1)-XELM(J)) QMOM=(A*EN+B)*1.0D-16 C ELASTIC X-SECTION A=(YELT(J)-YELT(J-1))/(XELM(J)-XELM(J-1)) B=(XELM(J-1)*YELT(J)-XELM(J)*YELT(J-1))/(XELM(J-1)-XELM(J)) QELA=(A*EN+B)*1.0D-16 C ANGULAR DISTRIBUTION FACTOR ( OKRIMOVSKKY) A=(YEPS(J)-YEPS(J-1))/(XELM(J)-XELM(J-1)) B=(XELM(J-1)*YEPS(J)-XELM(J)*YEPS(J-1))/(XELM(J-1)-XELM(J)) PQ2=A*EN+B PQ1=0.5+(QELA-QMOM)/QELA IF(NANISO.EQ.0) PEQEL(2,I)=0.5 IF(NANISO.EQ.1) PEQEL(2,I)=PQ1 IF(NANISO.EQ.2) PEQEL(2,I)=PQ2 Q(2,I)=QELA IF(NANISO.EQ.0) Q(2,I)=QMOM C GROSS IONISATION Q(3,I)=0.0 PEQEL(3,I)=0.5D0 IF(NANISO.EQ.2) PEQEL(3,I)=0.0D0 IF(EN.LT.E(3)) GO TO 200 IF(EN.GT.XION(NION)) GO TO 121 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 GO TO 122 C USE BORN-BETHE X-SECTION ABOVE XION(NION) EV 121 X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2) 122 CONTINUE 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 ATTCHMENT 200 Q(4,I)=0.0 PEQEL(4,I)=0.5 IF(NANISO.EQ.2) PEQEL(4,I)=0.0 C ROTATIONAL DEPENDANCE OF ATTACHMENT TO 2 SIGMAu IF(EN.LT.(EATTTH-ERLVL(7))) GO TO 300 Q(4,I)=AMPATT*5.00*FROT7*DEXP(-(EN-EATTTH+ERLVL(7))/EATTWD) IF(EN.LT.(EATTTH-ERLVL(6))) GO TO 300 Q(4,I)=Q(4,I)+AMPATT*3.96*FROT6*DEXP(-(EN-EATTTH+ERLVL(6))/EATTWD) IF(EN.LT.(EATTTH-ERLVL(5))) GO TO 300 Q(4,I)=Q(4,I)+AMPATT*3.15*FROT5*DEXP(-(EN-EATTTH+ERLVL(5))/EATTWD) IF(EN.LT.(EATTTH-ERLVL(4))) GO TO 300 Q(4,I)=Q(4,I)+AMPATT*2.50*FROT4*DEXP(-(EN-EATTTH+ERLVL(4))/EATTWD) IF(EN.LT.(EATTTH-ERLVL(3))) GO TO 300 Q(4,I)=Q(4,I)+AMPATT*1.99*FROT3*DEXP(-(EN-EATTTH+ERLVL(3))/EATTWD) IF(EN.LT.(EATTTH-ERLVL(2))) GO TO 300 Q(4,I)=Q(4,I)+AMPATT*1.58*FROT2*DEXP(-(EN-EATTTH+ERLVL(2))/EATTWD) IF(EN.LT.(EATTTH-ERLVL(1))) GO TO 300 Q(4,I)=Q(4,I)+AMPATT*1.26*FROT1*DEXP(-(EN-EATTTH+ERLVL(1))/EATTWD) IF(EN.LT.EATTTH) GO TO 300 Q(4,I)=Q(4,I)+AMPATT*FROT0*DEXP(-(EN-EATTTH)/EATTWD) IF(EN.LT.XATT(1)) GO TO 300 C ATTACHMENT TO 2 SIGMAg 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)=Q(4,I)+(A*EN+B)*1.D-16 C HIGH ENERGY ATTACHMENT TO 2 SIGMAg C 250 CONTINUE 250 IF(EN.LE.EATTTH1) GO TO 300 Q(4,I)=Q(4,I)+AMPATT1*DEXP(-(EN-EATTTH1)/EATTWD1) C COUNTING IONISATION ( SET EQUAL TO GROSS IONISATION) 300 Q(5,I)=Q(3,I) PEQEL(5,I)=PEQEL(3,I) Q(6,I)=0.0 C DO 1005 NL=1,NIN QIN(NL,I)=0.0D0 PEQIN(NL,I)=0.5D0 IF(NANISO.EQ.2) THEN PEQIN(NL,I)=0.0D0 ENDIF 1005 CONTINUE C--------------------------------------------------------------------- C SUPERELASTIC 2-0 IF(EN.LE.0.0) GO TO 1100 IF(EN.GT.XROT0(NROT0)) 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 C SUPERELASTIC 3-1 1100 IF(EN.LE.0.0) GO TO 1200 IF(EN.GT.XROT1(NROT1)) 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 C SUPERELASTIC 4-2 1200 IF(EN.LE.0.0) GO TO 1250 IF(EN.GT.XROT2(NROT2)) 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 C SUPERELASTIC 5-3 1250 IF(EN.LE.0.0) GO TO 1290 IF(EN.GT.XROT3(NROT3)) 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 C ROTATION 0-2 1290 IF(EN.LE.EIN(5)) GO TO 1400 IF(EN.GT.XROT0(NROT0)) GO TO 1330 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 GO TO 2330 1330 QIN(5,I)=YROT0(NROT0)*1.D-16*FROT0*XROT0(NROT0)/EN 2330 IF(EN.LE.(2.0*EIN(5))) GO TO 1400 PEQIN(5,I)=PEQEL(2,(I-IOFFN(5))) C ROTATION 1-3 1400 IF(EN.LE.EIN(6)) GO TO 1401 IF(EN.GT.XROT1(NROT1)) GO TO 1331 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 GO TO 2331 1331 QIN(6,I)=YROT1(NROT1)*1.D-16*FROT1*XROT1(NROT1)/EN 2331 IF(EN.LE.(2.0*EIN(6))) GO TO 1401 PEQIN(6,I)=PEQEL(2,(I-IOFFN(6))) C ROTATION 2-4 + 4-6 + 6-8 C USED SCALED 2-4 XSECTION FOR 4-6 AND 6-8 c ALSO SCALED FOR ENERGY LOSS BY 1.5 FOR 4-6 AND BY 2.0 FOR 6-8 1401 IF(EN.LE.EIN(7)) GO TO 1402 IF(EN.GT.XROT2(NROT2)) GO TO 1332 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*0.8*1.5+FROT6*0.5*2.0) GO TO 2332 1332 QIN(7,I)=YROT2(NROT2)*1.D-16*(FROT2+FROT4*0.8*1.5+FROT6*0.5*2.0) QIN(7,I)=QIN(7,I)*XROT2(NROT2)/EN 2332 IF(EN.LE.(2.0*EIN(7))) GO TO 1402 PEQIN(7,I)=PEQEL(2,(I-IOFFN(7))) C ROTATION 3-5 + 5-7 + 7-9 C USED SCALED 3-5 XSECTION FOR 5-7 AND 7-9 C ALSO SCALED FOR ENERGY LOSS BY 1.4 FOR 5-7 AND 1.8 FOR 7-9 1402 IF(EN.LE.EIN(8)) GO TO 1403 IF(EN.GT.XROT3(NROT3)) GO TO 1333 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*0.8*1.4+FROT7*0.5*1.8) GO TO 2333 1333 QIN(8,I)=YROT3(NROT3)*1.D-16*(FROT3+FROT5*0.8*1.4+FROT7*0.5*1.8) QIN(8,I)=QIN(8,I)*XROT3(NROT3)/EN 2333 IF(EN.LE.(2.0*EIN(8))) GO TO 1403 PEQIN(8,I)=PEQEL(2,(I-IOFFN(8))) C----------------------------------------------------------------------- C VIBRATION V1 WITH DJ=0 1403 IF(EN.LE.EIN(9)) GO TO 304 IF(EN.GT.XVIB1(NVIB1)) GO TO 303 DO 301 J=2,NVIB1 IF(EN.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(9,I)=(A*EN+B)*1.D-16 GO TO 1303 303 QIN(9,I)=YVIB1(NVIB1)*1.D-16*XVIB1(NVIB1)/EN 1303 IF(EN.LE.(2.0*EIN(9))) GO TO 304 PEQIN(9,I)=PEQEL(2,(I-IOFFN(9))) C C VIBRATION V1 WITH DJ=2 304 IF(EN.LE.EIN(10)) GO TO 308 IF(EN.GT.XVIB2(NVIB2)) GO TO 307 DO 305 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 306 305 CONTINUE J=NVIB2 306 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 GO TO 1307 307 QIN(10,I)=YVIB2(NVIB2)*1.D-16*XVIB2(NVIB2)/EN 1307 IF(EN.LE.(2.0*EIN(10))) GO TO 308 PEQIN(10,I)=PEQEL(2,(I-IOFFN(10))) C C VIBRATION V2 308 IF(EN.LE.EIN(11)) GO TO 312 IF(EN.GT.XVIB3(NVIB3)) GO TO 311 DO 309 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 310 309 CONTINUE J=NVIB3 310 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 GO TO 2311 311 QIN(11,I)=YVIB3(NVIB3)*1.D-16*XVIB3(NVIB3)/EN 2311 IF(EN.LE.(2.0*EIN(11))) GO TO 312 PEQIN(11,I)=PEQEL(2,(I-IOFFN(11))) C C VIBRATION V3 312 IF(EN.LE.EIN(12)) GO TO 316 IF(EN.GT.XVIB4(NVIB4)) GO TO 315 DO 313 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 314 313 CONTINUE J=NVIB4 314 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 GO TO 1315 315 QIN(12,I)=YVIB4(NVIB4)*1.D-16*XVIB4(NVIB4)/EN 1315 IF(EN.LE.(2.0*EIN(12))) GO TO 316 PEQIN(12,2)=PEQEL(2,(I-IOFFN(12))) C C B3 SIGMA DISSOCIATION ELOSS=8.0EV 316 IF(EN.LE.EIN(13)) GO TO 320 IF(EN.GT.XB3S1(NB3S1)) GO TO 320 DO 317 J=2,NB3S1 IF(EN.LE.XB3S1(J)) GO TO 318 317 CONTINUE J=NB3S1 318 A=(YB3S1(J)-YB3S1(J-1))/(XB3S1(J)-XB3S1(J-1)) B=(XB3S1(J-1)*YB3S1(J)-XB3S1(J)*YB3S1(J-1))/(XB3S1(J-1)-XB3S1(J)) QIN(13,I)=(A*EN+B)*1.D-16 IF(EN.LE.(2.0*EIN(13))) GO TO 320 PEQIN(13,2)=PEQEL(2,(I-IOFFN(13))) C C B3 SIGMA DISSOCIATION ELOSS=9.0EV 320 IF(EN.LE.EIN(14)) GO TO 324 IF(EN.GT.XB3S2(NB3S2)) GO TO 324 DO 321 J=2,NB3S2 IF(EN.LE.XB3S2(J)) GO TO 322 321 CONTINUE J=NB3S2 322 A=(YB3S2(J)-YB3S2(J-1))/(XB3S2(J)-XB3S2(J-1)) B=(XB3S2(J-1)*YB3S2(J)-XB3S2(J)*YB3S2(J-1))/(XB3S2(J-1)-XB3S2(J)) QIN(14,I)=(A*EN+B)*1.D-16 IF(EN.LE.(2.0*EIN(14))) GO TO 324 PEQIN(14,2)=PEQEL(2,(I-IOFFN(14))) C C B3 SIGMA DISSOCIATION ELOSS=9.5EV 324 IF(EN.LE.EIN(15)) GO TO 328 IF(EN.GT.XB3S3(NB3S3)) GO TO 328 DO 325 J=2,NB3S3 IF(EN.LE.XB3S3(J)) GO TO 326 325 CONTINUE J=NB3S3 326 A=(YB3S3(J)-YB3S3(J-1))/(XB3S3(J)-XB3S3(J-1)) B=(XB3S3(J-1)*YB3S3(J)-XB3S3(J)*YB3S3(J-1))/(XB3S3(J-1)-XB3S3(J)) QIN(15,I)=(A*EN+B)*1.D-16 IF(EN.LE.(2.0*EIN(15))) GO TO 328 PEQIN(15,2)=PEQEL(2,(I-IOFFN(15))) C C B3 SIGMA DISSOCIATION ELOSS=10.0EV C SCALED BY 1/E**3 ABOVE XB3S4(NB3S4) EV 328 IF(EN.LE.EIN(16)) GO TO 332 IF(EN.GT.XB3S4(NB3S4)) GO TO 331 DO 329 J=2,NB3S4 IF(EN.LE.XB3S4(J)) GO TO 330 329 CONTINUE J=NB3S4 330 A=(YB3S4(J)-YB3S4(J-1))/(XB3S4(J)-XB3S4(J-1)) B=(XB3S4(J-1)*YB3S4(J)-XB3S4(J)*YB3S4(J-1))/(XB3S4(J-1)-XB3S4(J)) QIN(16,I)=(A*EN+B)*1.D-16 GO TO 3331 331 QIN(16,I)=YB3S4(NB3S4)*1.D-16*(XB3S4(NB3S4)/EN)**3 3331 IF(EN.LE.(2.0*EIN(16))) GO TO 332 PEQIN(16,2)=PEQEL(2,(I-IOFFN(16))) C LYMAN BANDS FOR VIB=0 TO 36 B1 SIGMA--- GROUND STATE C DIPOLE ALLOWED C V=0 332 IF(EN.LE.EIN(17)) GO TO 333 QIN(17,I)=.0016884/(EIN(17)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(17)))-BETA2)*BBCONST*EN/(EN+EIN(17)+BEF(1)) IF(QIN(17,I).LT.0.0) QIN(17,I)=0.0 IF(EN.LE.(2.0*EIN(17))) GO TO 333 PEQIN(17,I)=PEQEL(2,(I-IOFFN(17))) C V=1 B1 SIGMA 333 IF(EN.LE.EIN(18)) GO TO 334 QIN(18,I)=.005782/(EIN(18)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(18)))-BETA2)*BBCONST*EN/(EN+EIN(18)+BEF(1)) IF(QIN(18,I).LT.0.0) QIN(18,I)=0.0 IF(EN.LE.(2.0*EIN(18))) GO TO 334 PEQIN(18,I)=PEQEL(2,(I-IOFFN(18))) C V=2 B1 SIGMA 334 IF(EN.LE.EIN(19)) GO TO 335 QIN(19,I)=.011536/(EIN(19)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(19)))-BETA2)*BBCONST*EN/(EN+EIN(19)+BEF(1)) IF(QIN(19,I).LT.0.0) QIN(19,I)=0.0 IF(EN.LE.(2.0*EIN(18))) GO TO 335 PEQIN(19,I)=PEQEL(2,(I-IOFFN(19))) C V=3 B1 SIGMA 335 IF(EN.LE.EIN(20)) GO TO 336 QIN(20,I)=.017531/(EIN(20)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(20)))-BETA2)*BBCONST*EN/(EN+EIN(20)+BEF(1)) IF(QIN(20,I).LT.0.0) QIN(20,I)=0.0 IF(EN.LE.(2.0*EIN(20))) GO TO 336 PEQIN(20,I)=PEQEL(2,(I-IOFFN(20))) C V=4 B1 SIGMA 336 IF(EN.LE.EIN(21)) GO TO 337 QIN(21,I)=.022477/(EIN(21)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(21)))-BETA2)*BBCONST*EN/(EN+EIN(21)+BEF(1)) IF(QIN(21,I).LT.0.0) QIN(21,I)=0.0 IF(EN.LE.(2.0*EIN(21))) GO TO 337 PEQIN(21,I)=PEQEL(2,(I-IOFFN(21))) C V=5 B1 SIGMA 337 IF(EN.LE.EIN(22)) GO TO 338 QIN(22,I)=.025688/(EIN(22)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(22)))-BETA2)*BBCONST*EN/(EN+EIN(22)+BEF(1)) IF(QIN(22,I).LT.0.0) QIN(22,I)=0.0 IF(EN.LE.(2.0*EIN(22))) GO TO 338 PEQIN(22,I)=PEQEL(2,(I-IOFFN(22))) C V=6 B1 SIGMA 338 IF(EN.LE.EIN(23)) GO TO 339 QIN(23,I)=.027021/(EIN(23)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(23)))-BETA2)*BBCONST*EN/(EN+EIN(23)+BEF(1)) IF(QIN(23,I).LT.0.0) QIN(23,I)=0.0 IF(EN.LE.(2.0*EIN(23))) GO TO 339 PEQIN(23,I)=PEQEL(2,(I-IOFFN(23))) C V=7 B1 SIGMA 339 IF(EN.LE.EIN(24)) GO TO 340 QIN(24,I)=.026731/(EIN(24)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(24)))-BETA2)*BBCONST*EN/(EN+EIN(24)+BEF(1)) IF(QIN(24,I).LT.0.0) QIN(24,I)=0.0 IF(EN.LE.(2.0*EIN(24))) GO TO 340 PEQIN(24,I)=PEQEL(2,(I-IOFFN(24))) C V=8 B1 SIGMA 340 IF(EN.LE.EIN(25)) GO TO 341 QIN(25,I)=.025233/(EIN(25)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(25)))-BETA2)*BBCONST*EN/(EN+EIN(25)+BEF(1)) IF(QIN(25,I).LT.0.0) QIN(25,I)=0.0 IF(EN.LE.(2.0*EIN(25))) GO TO 341 PEQIN(25,I)=PEQEL(2,(I-IOFFN(25))) C V=9 B1 SIGMA 341 IF(EN.LE.EIN(26)) GO TO 342 QIN(26,I)=.022980/(EIN(26)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(26)))-BETA2)*BBCONST*EN/(EN+EIN(26)+BEF(1)) IF(QIN(26,I).LT.0.0) QIN(26,I)=0.0 IF(EN.LE.(2.0*EIN(26))) GO TO 342 PEQIN(26,I)=PEQEL(2,(I-IOFFN(26))) C V=10 B1 SIGMA 342 IF(EN.LE.EIN(27)) GO TO 343 QIN(27,I)=.020362/(EIN(27)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(27)))-BETA2)*BBCONST*EN/(EN+EIN(27)+BEF(1)) IF(QIN(27,I).LT.0.0) QIN(27,I)=0.0 IF(EN.LE.(2.0*EIN(27))) GO TO 343 PEQIN(27,I)=PEQEL(2,(I-IOFFN(27))) C V=11 B1 SIGMA 343 IF(EN.LE.EIN(28)) GO TO 344 QIN(28,I)=.017653/(EIN(28)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(28)))-BETA2)*BBCONST*EN/(EN+EIN(28)+BEF(1)) IF(QIN(28,I).LT.0.0) QIN(28,I)=0.0 IF(EN.LE.(2.0*EIN(28))) GO TO 344 PEQIN(28,I)=PEQEL(2,(I-IOFFN(28))) C V=12 B1 SIGMA 344 IF(EN.LE.EIN(29)) GO TO 345 QIN(29,I)=.015054/(EIN(29)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(29)))-BETA2)*BBCONST*EN/(EN+EIN(29)+BEF(1)) IF(QIN(29,I).LT.0.0) QIN(29,I)=0.0 IF(EN.LE.(2.0*EIN(29))) GO TO 345 PEQIN(29,I)=PEQEL(2,(I-IOFFN(29))) C V=13 B1 SIGMA 345 IF(EN.LE.EIN(30)) GO TO 346 QIN(30,I)=.012678/(EIN(30)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(30)))-BETA2)*BBCONST*EN/(EN+EIN(30)+BEF(1)) IF(QIN(30,I).LT.0.0) QIN(30,I)=0.0 IF(EN.LE.(2.0*EIN(30))) GO TO 346 PEQIN(30,I)=PEQEL(2,(I-IOFFN(30))) C V=14 B1 SIGMA 346 IF(EN.LE.EIN(31)) GO TO 347 QIN(31,I)=.010567/(EIN(31)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(31)))-BETA2)*BBCONST*EN/(EN+EIN(31)+BEF(1)) IF(QIN(31,I).LT.0.0) QIN(31,I)=0.0 IF(EN.LE.(2.0*EIN(31))) GO TO 347 PEQIN(31,I)=PEQEL(2,(I-IOFFN(31))) C V=15 B1 SIGMA 347 IF(EN.LE.EIN(32)) GO TO 348 QIN(32,I)=.008746/(EIN(32)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(32)))-BETA2)*BBCONST*EN/(EN+EIN(32)+BEF(1)) IF(QIN(32,I).LT.0.0) QIN(32,I)=0.0 IF(EN.LE.(2.0*EIN(32))) GO TO 348 PEQIN(32,I)=PEQEL(2,(I-IOFFN(32))) C V=16 B1 SIGMA 348 IF(EN.LE.EIN(33)) GO TO 349 QIN(33,I)=.007201/(EIN(33)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(33)))-BETA2)*BBCONST*EN/(EN+EIN(33)+BEF(1)) IF(QIN(33,I).LT.0.0) QIN(33,I)=0.0 IF(EN.LE.(2.0*EIN(33))) GO TO 349 PEQIN(33,I)=PEQEL(2,(I-IOFFN(33))) C V=17 B1 SIGMA 349 IF(EN.LE.EIN(34)) GO TO 350 QIN(34,I)=.005909/(EIN(34)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(34)))-BETA2)*BBCONST*EN/(EN+EIN(34)+BEF(1)) IF(QIN(34,I).LT.0.0) QIN(34,I)=0.0 IF(EN.LE.(2.0*EIN(34))) GO TO 350 PEQIN(34,I)=PEQEL(2,(I-IOFFN(34))) C V=18 B1 SIGMA 350 IF(EN.LE.EIN(35)) GO TO 351 QIN(35,I)=.004838/(EIN(35)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(35)))-BETA2)*BBCONST*EN/(EN+EIN(35)+BEF(1)) IF(QIN(35,I).LT.0.0) QIN(35,I)=0.0 IF(EN.LE.(2.0*EIN(35))) GO TO 351 PEQIN(35,I)=PEQEL(2,(I-IOFFN(35))) C V=19 B1 SIGMA 351 IF(EN.LE.EIN(36)) GO TO 352 QIN(36,I)=.003956/(EIN(36)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(36)))-BETA2)*BBCONST*EN/(EN+EIN(36)+BEF(1)) IF(QIN(36,I).LT.0.0) QIN(36,I)=0.0 IF(EN.LE.(2.0*EIN(36))) GO TO 352 PEQIN(36,I)=PEQEL(2,(I-IOFFN(36))) C V=20 B1 SIGMA 352 IF(EN.LE.EIN(37)) GO TO 353 QIN(37,I)=.003233/(EIN(37)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(37)))-BETA2)*BBCONST*EN/(EN+EIN(37)+BEF(1)) IF(QIN(37,I).LT.0.0) QIN(37,I)=0.0 IF(EN.LE.(2.0*EIN(37))) GO TO 353 PEQIN(37,I)=PEQEL(2,(I-IOFFN(37))) C V=21 B1 SIGMA 353 IF(EN.LE.EIN(38)) GO TO 354 QIN(38,I)=.002644/(EIN(38)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(38)))-BETA2)*BBCONST*EN/(EN+EIN(38)+BEF(1)) IF(QIN(38,I).LT.0.0) QIN(38,I)=0.0 IF(EN.LE.(2.0*EIN(38))) GO TO 354 PEQIN(38,I)=PEQEL(2,(I-IOFFN(38))) C V=22 B1 SIGMA 354 IF(EN.LE.EIN(39)) GO TO 355 QIN(39,I)=.002165/(EIN(39)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(39)))-BETA2)*BBCONST*EN/(EN+EIN(39)+BEF(1)) IF(QIN(39,I).LT.0.0) QIN(39,I)=0.0 IF(EN.LE.(2.0*EIN(39))) GO TO 355 PEQIN(39,I)=PEQEL(2,(I-IOFFN(39))) C V=23 B1 SIGMA 355 IF(EN.LE.EIN(40)) GO TO 356 QIN(40,I)=.001775/(EIN(40)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(40)))-BETA2)*BBCONST*EN/(EN+EIN(40)+BEF(1)) IF(QIN(40,I).LT.0.0) QIN(40,I)=0.0 IF(EN.LE.(2.0*EIN(40))) GO TO 356 PEQIN(40,I)=PEQEL(2,(I-IOFFN(40))) C V=24 B1 SIGMA 356 IF(EN.LE.EIN(41)) GO TO 357 QIN(41,I)=.001457/(EIN(41)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(41)))-BETA2)*BBCONST*EN/(EN+EIN(41)+BEF(1)) IF(QIN(41,I).LT.0.0) QIN(41,I)=0.0 IF(EN.LE.(2.0*EIN(41))) GO TO 357 PEQIN(41,I)=PEQEL(2,(I-IOFFN(41))) C V=25 B1 SIGMA 357 IF(EN.LE.EIN(42)) GO TO 358 QIN(42,I)=.001199/(EIN(42)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(42)))-BETA2)*BBCONST*EN/(EN+EIN(42)+BEF(1)) IF(QIN(42,I).LT.0.0) QIN(42,I)=0.0 IF(EN.LE.(2.0*EIN(42))) GO TO 358 PEQIN(42,I)=PEQEL(2,(I-IOFFN(42))) C V=26 B1 SIGMA 358 IF(EN.LE.EIN(43)) GO TO 359 QIN(43,I)=.0009882/(EIN(43)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(43)))-BETA2)*BBCONST*EN/(EN+EIN(43)+BEF(1)) IF(QIN(43,I).LT.0.0) QIN(43,I)=0.0 IF(EN.LE.(2.0*EIN(43))) GO TO 359 PEQIN(43,I)=PEQEL(2,(I-IOFFN(43))) C V=27 B1 SIGMA 359 IF(EN.LE.EIN(44)) GO TO 360 QIN(44,I)=.0008153/(EIN(44)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(44)))-BETA2)*BBCONST*EN/(EN+EIN(44)+BEF(1)) IF(QIN(44,I).LT.0.0) QIN(44,I)=0.0 IF(EN.LE.(2.0*EIN(44))) GO TO 360 PEQIN(44,I)=PEQEL(2,(I-IOFFN(44))) C V=28 B1 SIGMA 360 IF(EN.LE.EIN(45)) GO TO 361 QIN(45,I)=.0006738/(EIN(45)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(45)))-BETA2)*BBCONST*EN/(EN+EIN(45)+BEF(1)) IF(QIN(45,I).LT.0.0) QIN(45,I)=0.0 IF(EN.LE.(2.0*EIN(45))) GO TO 361 PEQIN(45,I)=PEQEL(2,(I-IOFFN(45))) C V=29 B1 SIGMA 361 IF(EN.LE.EIN(46)) GO TO 362 QIN(46,I)=.0005561/(EIN(46)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(46)))-BETA2)*BBCONST*EN/(EN+EIN(46)+BEF(1)) IF(QIN(46,I).LT.0.0) QIN(46,I)=0.0 IF(EN.LE.(2.0*EIN(46))) GO TO 362 PEQIN(46,I)=PEQEL(2,(I-IOFFN(46))) C V=30 B1 SIGMA 362 IF(EN.LE.EIN(47)) GO TO 363 QIN(47,I)=.0004573/(EIN(47)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(47)))-BETA2)*BBCONST*EN/(EN+EIN(47)+BEF(1)) IF(QIN(47,I).LT.0.0) QIN(47,I)=0.0 IF(EN.LE.(2.0*EIN(47))) GO TO 363 PEQIN(47,I)=PEQEL(2,(I-IOFFN(47))) C V=31 B1 SIGMA 363 IF(EN.LE.EIN(48)) GO TO 364 QIN(48,I)=.0003731/(EIN(48)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(48)))-BETA2)*BBCONST*EN/(EN+EIN(48)+BEF(1)) IF(QIN(48,I).LT.0.0) QIN(48,I)=0.0 IF(EN.LE.(2.0*EIN(48))) GO TO 364 PEQIN(48,I)=PEQEL(2,(I-IOFFN(48))) C V=32 B1 SIGMA 364 IF(EN.LE.EIN(49)) GO TO 365 QIN(49,I)=.0002992/(EIN(49)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(49)))-BETA2)*BBCONST*EN/(EN+EIN(49)+BEF(1)) IF(QIN(49,I).LT.0.0) QIN(49,I)=0.0 IF(EN.LE.(2.0*EIN(49))) GO TO 365 PEQIN(49,I)=PEQEL(2,(I-IOFFN(49))) C V=33 B1 SIGMA 365 IF(EN.LE.EIN(50)) GO TO 366 QIN(50,I)=.0002309/(EIN(50)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(50)))-BETA2)*BBCONST*EN/(EN+EIN(50)+BEF(1)) IF(QIN(50,I).LT.0.0) QIN(50,I)=0.0 IF(EN.LE.(2.0*EIN(50))) GO TO 366 PEQIN(50,I)=PEQEL(2,(I-IOFFN(50))) C V=34 B1 SIGMA 366 IF(EN.LE.EIN(51)) GO TO 367 QIN(51,I)=.0001627/(EIN(51)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(51)))-BETA2)*BBCONST*EN/(EN+EIN(51)+BEF(1)) IF(QIN(51,I).LT.0.0) QIN(51,I)=0.0 IF(EN.LE.(2.0*EIN(51))) GO TO 367 PEQIN(51,I)=PEQEL(2,(I-IOFFN(51))) C V=35 B1 SIGMA 367 IF(EN.LE.EIN(52)) GO TO 368 QIN(52,I)=8.652D-5/(EIN(52)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(52)))-BETA2)*BBCONST*EN/(EN+EIN(52)+BEF(1)) IF(QIN(52,I).LT.0.0) QIN(52,I)=0.0 IF(EN.LE.(2.0*EIN(52))) GO TO 368 PEQIN(52,I)=PEQEL(2,(I-IOFFN(52))) C V=36 B1 SIGMA 368 IF(EN.LE.EIN(53)) GO TO 369 QIN(53,I)=2.256D-5/(EIN(53)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(53)))-BETA2)*BBCONST*EN/(EN+EIN(53)+BEF(1)) IF(QIN(53,I).LT.0.0) QIN(53,I)=0.0 IF(EN.LE.(2.0*EIN(53))) GO TO 369 PEQIN(53,I)=PEQEL(2,(I-IOFFN(53))) C V=0 C1 PI 369 IF(EN.LE.EIN(54)) GO TO 370 QIN(54,I)=.0476000/(EIN(54)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(54)))-BETA2)*BBCONST*EN/(EN+EIN(54)+BEF(2)) IF(QIN(54,I).LT.0.0) QIN(54,I)=0.0 IF(EN.LE.(2.0*EIN(54))) GO TO 370 PEQIN(54,I)=PEQEL(2,(I-IOFFN(54))) C V=1 C1 PI 370 IF(EN.LE.EIN(55)) GO TO 371 QIN(55,I)=.0728400/(EIN(55)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(55)))-BETA2)*BBCONST*EN/(EN+EIN(55)+BEF(2)) IF(QIN(55,I).LT.0.0) QIN(55,I)=0.0 IF(EN.LE.(2.0*EIN(55))) GO TO 371 PEQIN(55,I)=PEQEL(2,(I-IOFFN(55))) C V=2 C1 PI 371 IF(EN.LE.EIN(56)) GO TO 372 QIN(56,I)=.0698200/(EIN(56)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(56)))-BETA2)*BBCONST*EN/(EN+EIN(56)+BEF(2)) IF(QIN(56,I).LT.0.0) QIN(56,I)=0.0 IF(EN.LE.(2.0*EIN(56))) GO TO 372 PEQIN(56,I)=PEQEL(2,(I-IOFFN(56))) C V=3 C1 PI 372 IF(EN.LE.EIN(57)) GO TO 373 QIN(57,I)=.0547200/(EIN(57)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(57)))-BETA2)*BBCONST*EN/(EN+EIN(57)+BEF(2)) IF(QIN(57,I).LT.0.0) QIN(57,I)=0.0 IF(EN.LE.(2.0*EIN(57))) GO TO 373 PEQIN(57,I)=PEQEL(2,(I-IOFFN(57))) C V=4 C1 PI 373 IF(EN.LE.EIN(58)) GO TO 374 QIN(58,I)=.0387400/(EIN(58)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(58)))-BETA2)*BBCONST*EN/(EN+EIN(58)+BEF(2)) IF(QIN(58,I).LT.0.0) QIN(58,I)=0.0 IF(EN.LE.(2.0*EIN(58))) GO TO 374 PEQIN(58,I)=PEQEL(2,(I-IOFFN(58))) C V=5 C1 PI 374 IF(EN.LE.EIN(59)) GO TO 375 QIN(59,I)=.0259800/(EIN(59)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(59)))-BETA2)*BBCONST*EN/(EN+EIN(59)+BEF(2)) IF(QIN(59,I).LT.0.0) QIN(59,I)=0.0 IF(EN.LE.(2.0*EIN(59))) GO TO 375 PEQIN(59,I)=PEQEL(2,(I-IOFFN(59))) C V=6 C1 PI 375 IF(EN.LE.EIN(60)) GO TO 376 QIN(60,I)=.0170000/(EIN(60)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(60)))-BETA2)*BBCONST*EN/(EN+EIN(60)+BEF(2)) IF(QIN(60,I).LT.0.0) QIN(60,I)=0.0 IF(EN.LE.(2.0*EIN(60))) GO TO 376 PEQIN(60,I)=PEQEL(2,(I-IOFFN(60))) C V=7 C1 PI 376 IF(EN.LE.EIN(61)) GO TO 377 QIN(61,I)=.0109900/(EIN(61)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(61)))-BETA2)*BBCONST*EN/(EN+EIN(61)+BEF(2)) IF(QIN(61,I).LT.0.0) QIN(61,I)=0.0 IF(EN.LE.(2.0*EIN(61))) GO TO 377 PEQIN(61,I)=PEQEL(2,(I-IOFFN(61))) C V=8 C1 PI 377 IF(EN.LE.EIN(62)) GO TO 378 QIN(62,I)=.0070980/(EIN(62)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(62)))-BETA2)*BBCONST*EN/(EN+EIN(62)+BEF(2)) IF(QIN(62,I).LT.0.0) QIN(62,I)=0.0 IF(EN.LE.(2.0*EIN(62))) GO TO 378 PEQIN(62,I)=PEQEL(2,(I-IOFFN(62))) C V=9 C1 PI 378 IF(EN.LE.EIN(63)) GO TO 379 QIN(63,I)=.0045920/(EIN(63)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(63)))-BETA2)*BBCONST*EN/(EN+EIN(63)+BEF(2)) IF(QIN(63,I).LT.0.0) QIN(63,I)=0.0 IF(EN.LE.(2.0*EIN(63))) GO TO 379 PEQIN(63,I)=PEQEL(2,(I-IOFFN(63))) C V=10 C1 PI 379 IF(EN.LE.EIN(64)) GO TO 380 QIN(64,I)=.0029760/(EIN(64)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(64)))-BETA2)*BBCONST*EN/(EN+EIN(64)+BEF(2)) IF(QIN(64,I).LT.0.0) QIN(64,I)=0.0 IF(EN.LE.(2.0*EIN(64))) GO TO 380 PEQIN(64,I)=PEQEL(2,(I-IOFFN(64))) C V=11 C1 PI 380 IF(EN.LE.EIN(65)) GO TO 381 QIN(65,I)=.0019090/(EIN(65)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(65)))-BETA2)*BBCONST*EN/(EN+EIN(65)+BEF(2)) IF(QIN(65,I).LT.0.0) QIN(65,I)=0.0 IF(EN.LE.(2.0*EIN(65))) GO TO 381 PEQIN(65,I)=PEQEL(2,(I-IOFFN(65))) C V=12 C1 PI 381 IF(EN.LE.EIN(66)) GO TO 382 QIN(66,I)=.0011710/(EIN(66)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(66)))-BETA2)*BBCONST*EN/(EN+EIN(66)+BEF(2)) IF(QIN(66,I).LT.0.0) QIN(66,I)=0.0 IF(EN.LE.(2.0*EIN(66))) GO TO 382 PEQIN(66,I)=PEQEL(2,(I-IOFFN(66))) C V=13 C1 PI 382 IF(EN.LE.EIN(67)) GO TO 383 QIN(67,I)=.0005590/(EIN(67)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(67)))-BETA2)*BBCONST*EN/(EN+EIN(67)+BEF(2)) IF(QIN(67,I).LT.0.0) QIN(67,I)=0.0 IF(EN.LE.(2.0*EIN(67))) GO TO 383 PEQIN(67,I)=PEQEL(2,(I-IOFFN(67))) C C3PI V=0-4 METASTABLE LEVEL FRANCK-CONDON FAC=0.6967 C SCALED BY 1/E**3 ABOVE XC3PI(NC3PI) EV 383 IF(EN.LE.EIN(68)) GO TO 387 IF(EN.GT.XC3PI(NC3PI)) GO TO 386 DO 384 J=2,NC3PI IF(EN.LE.XC3PI(J)) GO TO 385 384 CONTINUE J=NC3PI 385 A=(YC3PI(J)-YC3PI(J-1))/(XC3PI(J)-XC3PI(J-1)) B=(XC3PI(J-1)*YC3PI(J)-XC3PI(J)*YC3PI(J-1))/(XC3PI(J-1)-XC3PI(J)) QIN(68,I)=(A*EN+B)*1.D-16*0.6967 GO TO 1386 386 QIN(68,I)=YC3PI(NC3PI)*1.D-16*((XC3PI(NC3PI)/EN)**3)*0.6967 1386 IF(EN.LE.(2.0*EIN(68))) GO TO 387 PEQIN(68,I)=PEQEL(2,(I-IOFFN(68))) C C3PI V=5-18 METASTABLE LEVEL FRANCK-CONDON FAC=0.3033 C SCALED BY 1/E**3 ABOVE XC3PI(NC3PI) EV 387 IF(EN.LE.EIN(69)) GO TO 391 IF(EN.GT.XC3PI(NC3PI)) GO TO 390 DO 388 J=2,NC3PI IF(EN.LE.XC3PI(J)) GO TO 389 388 CONTINUE J=NC3PI 389 A=(YC3PI(J)-YC3PI(J-1))/(XC3PI(J)-XC3PI(J-1)) B=(XC3PI(J-1)*YC3PI(J)-XC3PI(J)*YC3PI(J-1))/(XC3PI(J-1)-XC3PI(J)) QIN(69,I)=(A*EN+B)*1.D-16*0.3033 GO TO 1390 390 QIN(69,I)=YC3PI(NC3PI)*1.D-16*((XC3PI(NC3PI)/EN)**3)*0.3033 1390 IF(EN.LE.(2.0*EIN(69))) GO TO 391 PEQIN(69,I)=PEQEL(2,(I-IOFFN(69))) C A3SG V=0-2 FRANCK-CONDON FAC=0.6668 C SCALED BY 1/E**3 ABOVE XA3SG(NA3SG) EV 391 IF(EN.LE.EIN(70)) GO TO 395 IF(EN.GT.XA3SG(NA3SG)) GO TO 394 DO 392 J=2,NA3SG IF(EN.LE.XA3SG(J)) GO TO 393 392 CONTINUE J=NA3SG 393 A=(YA3SG(J)-YA3SG(J-1))/(XA3SG(J)-XA3SG(J-1)) B=(XA3SG(J-1)*YA3SG(J)-XA3SG(J)*YA3SG(J-1))/(XA3SG(J-1)-XA3SG(J)) QIN(70,I)=(A*EN+B)*1.D-16*0.6668 GO TO 1394 394 QIN(70,I)=YA3SG(NA3SG)*1.D-16*((XA3SG(NA3SG)/EN)**3)*0.6668 1394 IF(EN.LE.(2.0*EIN(70))) GO TO 395 PEQIN(70,I)=PEQEL(2,(I-IOFFN(70))) C A3SG V=3-17 FRANCK-CONDON FAC=0.3332 C SCALED BY 1/E**3 ABOVE XA3SG(NA3SG) EV 395 IF(EN.LE.EIN(71)) GO TO 399 IF(EN.GT.XA3SG(NA3SG)) GO TO 398 DO 396 J=2,NA3SG IF(EN.LE.XA3SG(J)) GO TO 397 396 CONTINUE J=NA3SG 397 A=(YA3SG(J)-YA3SG(J-1))/(XA3SG(J)-XA3SG(J-1)) B=(XA3SG(J-1)*YA3SG(J)-XA3SG(J)*YA3SG(J-1))/(XA3SG(J-1)-XA3SG(J)) QIN(71,I)=(A*EN+B)*1.D-16*0.3332 GO TO 1398 398 QIN(71,I)=YA3SG(NA3SG)*1.D-16*((XA3SG(NA3SG)/EN)**3)*0.3332 1398 IF(EN.LE.(2.0*EIN(71))) GO TO 399 PEQIN(71,I)=PEQEL(2,(I-IOFFN(71))) C E3SG V=0-9 C SCALED BY 1/E**3 ABOVE XE3SG(NE3SG) EV 399 IF(EN.LE.EIN(72)) GO TO 403 IF(EN.GT.XE3SG(NE3SG)) GO TO 402 DO 400 J=2,NE3SG IF(EN.LE.XE3SG(J)) GO TO 401 400 CONTINUE J=NE3SG 401 A=(YE3SG(J)-YE3SG(J-1))/(XE3SG(J)-XE3SG(J-1)) B=(XE3SG(J-1)*YE3SG(J)-XE3SG(J)*YE3SG(J-1))/(XE3SG(J-1)-XE3SG(J)) QIN(72,I)=(A*EN+B)*1.D-16 GO TO 2402 402 QIN(72,I)=YE3SG(NE3SG)*1.D-16*(XE3SG(NE3SG)/EN)**3 2402 IF(EN.LE.(2.0*EIN(72))) GO TO 403 PEQIN(72,I)=PEQEL(2,(I-IOFFN(72))) C EF1 SIGMA V=0-5 FRANCK-CONDON FACTOR=0.4 C USE BORN SCALING ABOVE XEFSG(NEFSG) EV 403 IF(EN.LE.EIN(73)) GO TO 407 IF(EN.GT.XEFSG(NEFSG)) GO TO 406 DO 404 J=2,NEFSG IF(EN.LE.XEFSG(J)) GO TO 405 404 CONTINUE J=NEFSG 405 A=(YEFSG(J)-YEFSG(J-1))/(XEFSG(J)-XEFSG(J-1)) B=(XEFSG(J-1)*YEFSG(J)-XEFSG(J)*YEFSG(J-1))/(XEFSG(J-1)-XEFSG(J)) QIN(73,I)=(A*EN+B)*1.D-16*0.4 GO TO 1406 406 QIN(73,I)=.0089000/(EIN(73)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(73)))-BETA2)*BBCONST*EN/(EN+EIN(73)+BEF(3)) IF(QIN(73,I).LT.0.0) QIN(73,I)=0.0 1406 IF(EN.LE.(2.0*EIN(73))) GO TO 407 PEQIN(73,I)=PEQEL(2,(I-IOFFN(73))) C EF1 SIGMA V=6-19 FRANCK-CONDON FACTOR=0.6 C USE BORN SCALING ABOVE XEFSG(NEFSG) EV 407 IF(EN.LE.EIN(74)) GO TO 411 IF(EN.GT.XEFSG(NEFSG)) GO TO 410 DO 408 J=2,NEFSG IF(EN.LE.XEFSG(J)) GO TO 409 408 CONTINUE J=NEFSG 409 A=(YEFSG(J)-YEFSG(J-1))/(XEFSG(J)-XEFSG(J-1)) B=(XEFSG(J-1)*YEFSG(J)-XEFSG(J)*YEFSG(J-1))/(XEFSG(J-1)-XEFSG(J)) QIN(74,I)=(A*EN+B)*1.D-16*0.6 GO TO 1410 410 QIN(74,I)=.0133000/(EIN(74)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(74)))-BETA2)*BBCONST*EN/(EN+EIN(74)+BEF(3)) IF(QIN(74,I).LT.0.0) QIN(74,I)=0.0 1410 IF(EN.LE.(2.0*EIN(74))) GO TO 411 PEQIN(74,I)=PEQEL(2,(I-IOFFN(74))) C B!1 SIGMA V=0 411 IF(EN.LE.EIN(75)) GO TO 412 QIN(75,I)=.003970/(EIN(75)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(75)))-BETA2)*BBCONST*EN/(EN+EIN(75)+BEF(4)) IF(QIN(75,I).LT.0.0) QIN(75,I)=0.0 IF(EN.LE.(2.0*EIN(75))) GO TO 412 PEQIN(75,I)=PEQEL(2,(I-IOFFN(75))) C B!1 SIGMA V=1 412 IF(EN.LE.EIN(76)) GO TO 413 QIN(76,I)=.008150/(EIN(76)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(76)))-BETA2)*BBCONST*EN/(EN+EIN(76)+BEF(4)) IF(QIN(76,I).LT.0.0) QIN(76,I)=0.0 IF(EN.LE.(2.0*EIN(76))) GO TO 413 PEQIN(76,I)=PEQEL(2,(I-IOFFN(76))) C B!1 SIGMA V=2 413 IF(EN.LE.EIN(77)) GO TO 414 QIN(77,I)=.009980/(EIN(77)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(77)))-BETA2)*BBCONST*EN/(EN+EIN(77)+BEF(4)) IF(QIN(77,I).LT.0.0) QIN(77,I)=0.0 IF(EN.LE.(2.0*EIN(77))) GO TO 414 PEQIN(77,I)=PEQEL(2,(I-IOFFN(77))) C B!1 SIGMA V=3 414 IF(EN.LE.EIN(78)) GO TO 415 QIN(78,I)=.009520/(EIN(78)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(78)))-BETA2)*BBCONST*EN/(EN+EIN(78)+BEF(4)) IF(QIN(78,I).LT.0.0) QIN(78,I)=0.0 IF(EN.LE.(2.0*EIN(78))) GO TO 415 PEQIN(78,I)=PEQEL(2,(I-IOFFN(78))) C B!1 SIGMA V=4 415 IF(EN.LE.EIN(79)) GO TO 416 QIN(79,I)=.007550/(EIN(79)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(79)))-BETA2)*BBCONST*EN/(EN+EIN(79)+BEF(4)) IF(QIN(79,I).LT.0.0) QIN(79,I)=0.0 IF(EN.LE.(2.0*EIN(79))) GO TO 416 PEQIN(79,I)=PEQEL(2,(I-IOFFN(79))) C B!1 SIGMA V=5 416 IF(EN.LE.EIN(80)) GO TO 417 QIN(80,I)=.004230/(EIN(80)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(80)))-BETA2)*BBCONST*EN/(EN+EIN(80)+BEF(4)) IF(QIN(80,I).LT.0.0) QIN(80,I)=0.0 IF(EN.LE.(2.0*EIN(80))) GO TO 417 PEQIN(80,I)=PEQEL(2,(I-IOFFN(80))) C B!1 SIGMA V=6 417 IF(EN.LE.EIN(81)) GO TO 418 QIN(81,I)=.000460/(EIN(81)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(81)))-BETA2)*BBCONST*EN/(EN+EIN(81)+BEF(4)) IF(QIN(81,I).LT.0.0) QIN(81,I)=0.0 IF(EN.LE.(2.0*EIN(81))) GO TO 418 PEQIN(81,I)=PEQEL(2,(I-IOFFN(81))) C B!1 SIGMA V=7 418 IF(EN.LE.EIN(82)) GO TO 419 QIN(82,I)=.000450/(EIN(82)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(82)))-BETA2)*BBCONST*EN/(EN+EIN(82)+BEF(4)) IF(QIN(82,I).LT.0.0) QIN(82,I)=0.0 IF(EN.LE.(2.0*EIN(82))) GO TO 419 PEQIN(82,I)=PEQEL(2,(I-IOFFN(82))) C B!1 SIGMA V=8 419 IF(EN.LE.EIN(83)) GO TO 420 QIN(83,I)=.000300/(EIN(83)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(83)))-BETA2)*BBCONST*EN/(EN+EIN(83)+BEF(4)) IF(QIN(83,I).LT.0.0) QIN(83,I)=0.0 IF(EN.LE.(2.0*EIN(83))) GO TO 420 PEQIN(83,I)=PEQEL(2,(I-IOFFN(83))) C D1 PI V=0 420 IF(EN.LE.EIN(84)) GO TO 421 QIN(84,I)=.007750/(EIN(84)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(84)))-BETA2)*BBCONST*EN/(EN+EIN(84)+BEF(5)) IF(QIN(84,I).LT.0.0) QIN(84,I)=0.0 IF(EN.LE.(2.0*EIN(85))) GO TO 421 PEQIN(84,I)=PEQEL(2,(I-IOFFN(84))) C D1 PI V=1 421 IF(EN.LE.EIN(85)) GO TO 422 QIN(85,I)=.013100/(EIN(85)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(85)))-BETA2)*BBCONST*EN/(EN+EIN(85)+BEF(5)) IF(QIN(85,I).LT.0.0) QIN(85,I)=0.0 IF(EN.LE.(2.0*EIN(85))) GO TO 422 PEQIN(85,I)=PEQEL(2,(I-IOFFN(85))) C D1 PI V=2 422 IF(EN.LE.EIN(86)) GO TO 423 QIN(86,I)=.013670/(EIN(86)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(86)))-BETA2)*BBCONST*EN/(EN+EIN(86)+BEF(5)) IF(QIN(86,I).LT.0.0) QIN(86,I)=0.0 IF(EN.LE.(2.0*EIN(86))) GO TO 423 PEQIN(86,I)=PEQEL(2,(I-IOFFN(86))) C D1 PI V=3 423 IF(EN.LE.EIN(87)) GO TO 424 QIN(87,I)=.011560/(EIN(87)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(87)))-BETA2)*BBCONST*EN/(EN+EIN(87)+BEF(5)) IF(QIN(87,I).LT.0.0) QIN(87,I)=0.0 IF(EN.LE.(2.0*EIN(87))) GO TO 424 PEQIN(87,I)=PEQEL(2,(I-IOFFN(87))) C D1 PI V=4 424 IF(EN.LE.EIN(88)) GO TO 425 QIN(88,I)=.008730/(EIN(88)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(88)))-BETA2)*BBCONST*EN/(EN+EIN(88)+BEF(5)) IF(QIN(88,I).LT.0.0) QIN(88,I)=0.0 IF(EN.LE.(2.0*EIN(88))) GO TO 425 PEQIN(88,I)=PEQEL(2,(I-IOFFN(88))) C D1 PI V=5 425 IF(EN.LE.EIN(89)) GO TO 426 QIN(89,I)=.006190/(EIN(89)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(89)))-BETA2)*BBCONST*EN/(EN+EIN(89)+BEF(5)) IF(QIN(89,I).LT.0.0) QIN(89,I)=0.0 IF(EN.LE.(2.0*EIN(89))) GO TO 426 PEQIN(89,I)=PEQEL(2,(I-IOFFN(89))) C D1 PI V=6 426 IF(EN.LE.EIN(90)) GO TO 427 QIN(90,I)=.004280/(EIN(90)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(90)))-BETA2)*BBCONST*EN/(EN+EIN(90)+BEF(5)) IF(QIN(90,I).LT.0.0) QIN(90,I)=0.0 IF(EN.LE.(2.0*EIN(90))) GO TO 427 PEQIN(90,I)=PEQEL(2,(I-IOFFN(90))) C D1 PI V=7 427 IF(EN.LE.EIN(91)) GO TO 428 QIN(91,I)=.002920/(EIN(91)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(91)))-BETA2)*BBCONST*EN/(EN+EIN(91)+BEF(5)) IF(QIN(91,I).LT.0.0) QIN(91,I)=0.0 IF(EN.LE.(2.0*EIN(91))) GO TO 428 PEQIN(91,I)=PEQEL(2,(I-IOFFN(91))) C D1 PI V=8 428 IF(EN.LE.EIN(92)) GO TO 429 QIN(92,I)=.001960/(EIN(92)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(92)))-BETA2)*BBCONST*EN/(EN+EIN(92)+BEF(5)) IF(QIN(92,I).LT.0.0) QIN(92,I)=0.0 IF(EN.LE.(2.0*EIN(92))) GO TO 429 PEQIN(92,I)=PEQEL(2,(I-IOFFN(92))) C D1 PI V=9 429 IF(EN.LE.EIN(93)) GO TO 430 QIN(93,I)=.001330/(EIN(93)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(93)))-BETA2)*BBCONST*EN/(EN+EIN(93)+BEF(5)) IF(QIN(93,I).LT.0.0) QIN(93,I)=0.0 IF(EN.LE.(2.0*EIN(93))) GO TO 430 PEQIN(93,I)=PEQEL(2,(I-IOFFN(93))) C D1 PI V=10 430 IF(EN.LE.EIN(94)) GO TO 431 QIN(94,I)=.000910/(EIN(94)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(94)))-BETA2)*BBCONST*EN/(EN+EIN(94)+BEF(5)) IF(QIN(94,I).LT.0.0) QIN(94,I)=0.0 IF(EN.LE.(2.0*EIN(94))) GO TO 431 PEQIN(94,I)=PEQEL(2,(I-IOFFN(94))) C D1 PI V=11 431 IF(EN.LE.EIN(95)) GO TO 432 QIN(95,I)=.000630/(EIN(95)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(95)))-BETA2)*BBCONST*EN/(EN+EIN(95)+BEF(5)) IF(QIN(95,I).LT.0.0) QIN(95,I)=0.0 IF(EN.LE.(2.0*EIN(95))) GO TO 432 PEQIN(95,I)=PEQEL(2,(I-IOFFN(95))) C D1 PI V=12 432 IF(EN.LE.EIN(96)) GO TO 433 QIN(96,I)=.000430/(EIN(96)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(96)))-BETA2)*BBCONST*EN/(EN+EIN(96)+BEF(5)) IF(QIN(96,I).LT.0.0) QIN(96,I)=0.0 IF(EN.LE.(2.0*EIN(96))) GO TO 433 PEQIN(96,I)=PEQEL(2,(I-IOFFN(96))) C D1 PI V=13 433 IF(EN.LE.EIN(97)) GO TO 434 QIN(97,I)=.000290/(EIN(97)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(97)))-BETA2)*BBCONST*EN/(EN+EIN(97)+BEF(5)) IF(QIN(97,I).LT.0.0) QIN(97,I)=0.0 IF(EN.LE.(2.0*EIN(97))) GO TO 434 PEQIN(97,I)=PEQEL(2,(I-IOFFN(97))) C D1 PI V=14 434 IF(EN.LE.EIN(98)) GO TO 435 QIN(98,I)=.000200/(EIN(98)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(98)))-BETA2)*BBCONST*EN/(EN+EIN(98)+BEF(5)) IF(QIN(98,I).LT.0.0) QIN(98,I)=0.0 IF(EN.LE.(2.0*EIN(98))) GO TO 435 PEQIN(98,I)=PEQEL(2,(I-IOFFN(98))) C D1 PI V=15 435 IF(EN.LE.EIN(99)) GO TO 436 QIN(99,I)=.000120/(EIN(99)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(99)))-BETA2)*BBCONST*EN/(EN+EIN(99)+BEF(5)) IF(QIN(99,I).LT.0.0) QIN(99,I)=0.0 IF(EN.LE.(2.0*EIN(99))) GO TO 436 PEQIN(99,I)=PEQEL(2,(I-IOFFN(99))) C B!!1 SIGMA SUM V=0-6 DISSOCIATIVE C SCALED BY 1.08 FOR INCREASED ENERGY LOSSES FROM VIB SERIES 436 IF(EN.LE.EIN(100)) GO TO 437 QIN(100,I)=.02230/(EIN(100)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(100)))-BETA2)*BBCONST*EN/(EN+EIN(100)+BEF(5))*1.08 IF(QIN(100,I).LT.0.0) QIN(100,I)=0.0 IF(EN.LE.(2.0*EIN(100))) GO TO 437 PEQIN(100,I)=PEQEL(2,(I-IOFFN(100))) C D!1 PI SUM V=0-3 DISSOCIATIVE C SCALED BY 1.08 FOR INCREASED ENERGY LOSSES FROM VIB SERIES 437 IF(EN.LE.EIN(101)) GO TO 438 QIN(101,I)=.01450/(EIN(101)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(101)))-BETA2)*BBCONST*EN/(EN+EIN(101)+BEF(5))*1.08 IF(QIN(101,I).LT.0.0) QIN(101,I)=0.0 IF(EN.LE.(2.0*EIN(101))) GO TO 438 PEQIN(101,I)=PEQEL(2,(I-IOFFN(101))) C B!!!1 SIGMA + D!!1 PI VIBRATION SUMMED DISSOCIATIVE C SCALED BY 1.08 FOR INCREASED ENERGY LOSSES FROM VIB SERIES 438 IF(EN.LE.EIN(102)) GO TO 439 QIN(102,I)=.01450/(EIN(102)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(102)))-BETA2)*BBCONST*EN/(EN+EIN(102)+BEF(5))*1.08 IF(QIN(102,I).LT.0.0) QIN(102,I)=0.0 IF(EN.LE.(2.0*EIN(102))) GO TO 439 PEQIN(102,I)=PEQEL(2,(I-IOFFN(102))) C B!!!!1 SIGMA + D!!!1 PI VIBRATION SUMMED DISSOCIATIVE C SCALED BY 1.08 FOR INCREASED ENERGY LOSSES FROM VIB SERIES 439 IF(EN.LE.EIN(103)) GO TO 440 QIN(103,I)=.01010/(EIN(103)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(103)))-BETA2)*BBCONST*EN/(EN+EIN(103)+BEF(5))*1.08 IF(QIN(103,I).LT.0.0) QIN(103,I)=0.0 IF(EN.LE.(2.0*EIN(103))) GO TO 440 PEQIN(103,I)=PEQEL(2,(I-IOFFN(103))) C B!!!!!1 SIGMA + D!!!!1 PI VIBRATION SUMMED DISSOCIATIVE C SCALED BY 1.08 FOR INCREASED ENERGY LOSSES FROM VIB SERIES 440 IF(EN.LE.EIN(104)) GO TO 441 QIN(104,I)=.00500/(EIN(104)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(104)))-BETA2)*BBCONST*EN/(EN+EIN(104)+BEF(5))*1.08 IF(QIN(104,I).LT.0.0) QIN(104,I)=0.0 IF(EN.LE.(2.0*EIN(104))) GO TO 441 PEQIN(104,I)=PEQEL(2,(I-IOFFN(104))) C CONTINUUM EXCITATION AROUND IONISATION ENERGY DISSOCIATIVE C SCALED BY 1.20 FOR INCREASED ENERGY LOSSES ABOVE THRESHOLD 441 IF(EN.LE.EIN(105)) GO TO 442 QIN(105,I)=.02680/(EIN(105)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(105)))-BETA2)*BBCONST*EN/(EN+EIN(105)+BEF(5))*1.20 IF(QIN(105,I).LT.0.0) QIN(105,I)=0.0 IF(EN.LE.(2.0*EIN(105))) GO TO 442 PEQIN(105,I)=PEQEL(2,(I-IOFFN(105))) C PREDISSOCIATION ABOVE IONISATION ENERGY DISSOCIATIVE C SCALED BY 1.2 FOR INCREASED ENERGY LOSSES ABOVE THRESHOLD 442 IF(EN.LE.EIN(106)) GO TO 443 QIN(106,I)=.01700/(EIN(106)*BETA2)*(DLOG(BETA2*GAMMA2*EMASS2/(4.0* /EIN(106)))-BETA2)*BBCONST*EN/(EN+EIN(106)+BEF(5))*1.20 IF(QIN(106,I).LT.0.0) QIN(106,I)=0.0 IF(EN.LE.(2.0*EIN(106))) GO TO 443 PEQIN(106,I)=PEQEL(2,(I-IOFFN(106))) 443 CONTINUE C--------------------------------------------------------------------- Q(1,I)=0.0 DO 555 NL=1,106 Q(1,I)=Q(1,I)+QIN(NL,I) 555 CONTINUE Q(1,I)=Q(1,I)+Q(2,I)+Q(4,I)+Q(5,I) C WRITE(6,991) EN,Q(2,I),Q(4,I),Q(5,I),Q(1,I) C 991 FORMAT(' EN=',D12.4,' ELAS=',D12.4,' ATT =',D12.4,'IONS=',D12.4,' C / TOT=',D12.4) 900 CONTINUE C SAVE COMPUTE TIME DO 910 K=1,20 IF(EFINAL.LE.EIN(K)) THEN NIN=K-1 GO TO 911 ENDIF 910 CONTINUE 911 CONTINUE C RETURN END SUBROUTINE GAS22(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=' DEUTERIUM 98 ' 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)*DEXP(-K*(K+1)*B0/AKT) DO 112 K=2,6,2 112 PJ(K)=6*(2*K+1)*DEXP(-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 WRITE(6,88) 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.0 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.0 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.0 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.0 Q(6,I)=0.0 C--------------------------------------------------------------------- C SUPERELASTIC 2-0 QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS23(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=' C-O 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)*DEXP(-K*(K+1)*B0/AKT) SUM=1.0 DO 4 K=1,26 4 SUM=SUM+PJ(K) FROT0=1.0/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 WRITE(6,99) FROT0,(PJ(J),J=1,30) C 99 FORMAT(2X,'POP OF STATES=',/,11(2X,D10.3)) C WRITE(6,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.0 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.0 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.0 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.0 Q(6,I)=0.0 C---------------------------------------------------------------------- C DIPOLE BORN ROTATIONAL STATES C---------------------------------------------------------------------- ENRT=DSQRT(EN) C SUPER ELASTIC ROTATIONAL COLLISIONS DO 150 L=1,26 AL=DFLOAT(L) QIN(L,I)=PJ(L)*DBK*DLOG((ENRT+DSQRT(EN-EIN(L)))/(DSQRT(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.0 C ROT 0-1 IF(EN.LE.EIN(27)) GO TO 200 QIN(27,I)=FROT0*DBK*DLOG((ENRT+DSQRT(EN-EIN(27)))/(ENRT-DSQRT(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=DFLOAT(L-27) QIN(L,I)=PJ(L-27)*DBK*DLOG((ENRT+DSQRT(EN-EIN(L)))/(ENRT-DSQRT(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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS24(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 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.0 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.0 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS25(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC OF VIBRATION C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 390 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AVIB1*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AVIB1*DLOG((1.0+EFAC)/(1.0-EFAC))/(EN*(1.0+APOP))*1.D-16 400 CONTINUE QIN(3,I)=0.0 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=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=(QIN(3,I)+AVIB2*DLOG((1.0+EFAC)/(1.0-EFAC))/EN)*1.D-16 430 CONTINUE QIN(4,I)=0.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS26(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 9000 I=1,NSTEP PEQEL(2,I)=0.0 PEQIN(1,I)=0.0 EN=EN+ESTEP Q(2,I)=1.0E-16 Q(3,I)=0.0 Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 QIN(1,I)=10.0E-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 RETURN END SUBROUTINE GAS27(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ---------------------------------------------------------------- C MAXWELL MODEL DECEMBER 1994 C --------------------------------------------------------------- NAME=' MAXWEL 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.0E-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.0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) THEN Q(2,I)=100000.E-16 GO TO 10 ENDIF Q(2,I)=SIGC/DSQRT(EN) 10 Q(3,I)=0.0 Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C Q(1,I)=Q(2,I) 9000 CONTINUE RETURN END SUBROUTINE GAS28(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 9000 I=1,NSTEP EN=EN+ESTEP Q(2,I)=6.0E-16 Q(3,I)=0.0 Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 QIN(1,I)=(EN-EIN(1))*10.0E-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 RETURN END SUBROUTINE GAS29(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(2)/AKT) APOP3=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTICS QIN(1,I)=0.0 QIN(2,I)=0.0 QIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V11 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.0363*DLOG((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=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.4230*DLOG((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=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=1.5000*DLOG((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.0 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=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0363*DLOG((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.0 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=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.4230*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(5) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(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.0 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=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=1.500*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS30(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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 ITOH ET AL ' 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.0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0D0) THEN BTA=-5.0 GO TO 3 ENDIF BTA=DLOG10(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*DEXP(-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*DEXP(-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-DEXP(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)=DEXP(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*DSQRT(1.0/EN)*DEXP(-1.0*(EN/0.0045)**2)+ /DEXP(-EN/0.0559)) GO TO 30 ENDIF IF(EN.LE.0.9746) THEN QA1=DEXP(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=DEXP(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=DEXP(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=DEXP(-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=DEXP(2.932*EN3-22.91*EN2+56.52*EN-53.37) GO TO 70 ENDIF IF(EN.LE.7.45) THEN QA5=DEXP(0.5554*EN3-9.613*EN2+52.832*EN-100.3) GO TO 70 ENDIF IF(EN.LE.10.6) THEN QA5=DEXP(0.1216*EN2-1.035*EN-9.723) GO TO 70 ENDIF IF(EN.LE.11.7) THEN QA5=DEXP(-1.114*EN2+25.12*EN-148.0)-0.00012 GO TO 70 ENDIF QA5=DEXP(-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)=(DEXP(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)=(DEXP(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*DEXP(-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 RETURN END SUBROUTINE GAS31(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DFLOAT(J) AK=DFLOAT(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)*DEXP(-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=DEXP(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=DLOG(YEL(J)) YXJ1=DLOG(YEL(J-1)) XNJ=DLOG(XEL(J)) XNJ1=DLOG(XEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(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=DSQRT(EN) C ROTATIONAL COLLISIONS (JK) C 10-->00 AJ=1.0 AJG=1.0 AJG2=AJG*AJG QIN(1,I)=DBK*DLOG((ENRT+DSQRT(EN-EIN(1)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(2)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(3)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(4)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(5)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(6)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(7)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(8)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(9)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(10)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(11)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(12)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(13)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(14)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(15)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(16)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(17)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(18)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(19)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(20)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(21)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(22)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(23)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(24)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(25)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(26)))/(ENRT-DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(27)))/(DSQRT(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*DLOG((ENRT+DSQRT(EN-EIN(28)))/(ENRT-DSQRT(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=DSQRT(1.0-(EIN(29)/EN)) QIN(29,I)=0.195*DLOG((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=DSQRT(1.0-(EIN(30)/EN)) QIN(30,I)=0.195*DLOG((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=DSQRT(1.0-(EIN(31)/EN)) QIN(31,I)=0.182*DLOG((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=DSQRT(1.0-(EIN(32)/EN)) QIN(32,I)=0.182*DLOG((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 RETURN END SUBROUTINE GAS32(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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='PROPENE C3H6 99' 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=DEXP(EIN(1)/AKT) APOP=DEXP(EIN(3)/AKT) APOPH=DEXP(EIN(5)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C SUPERELASTIC QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 3050 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 3060 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP*DLOG((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.0 IF(EN.LE.0.0) GO TO 350 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP1*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 400 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP1*DLOG((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.0 IF(EN.LE.0.0) GO TO 4150 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=AMP2*DLOG((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.0 IF(EN.LE.EIN(6)) GO TO 450 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP2*DLOG((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.0 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.0 IF(EN.LE.EIN(8)) GO TO 550 EFAC=DSQRT(1.0-(EIN(8)/EN)) QIN(8,I)=AMP3*DLOG((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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS33(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOPH=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C C V7 SUPERELASTIC QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 350 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*DLOG((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.0 IF(EN.LE.0.0) GO TO 4150 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 450 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*DLOG((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.0 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.0 IF(EN.LE.EIN(6)) GO TO 550 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP3*DLOG((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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS34(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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='METHANOL 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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 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=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*DLOG((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.0 IF(EN.LE.0.0) GO TO 250 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.40*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.40*DLOG((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.0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.44*DLOG((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.0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.84*DLOG((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.0 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.0 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.0 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) WRITE(6,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',E12.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 RETURN END SUBROUTINE GAS35(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=' ETHANOL 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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 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=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*DLOG((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.0 IF(EN.LE.0.0) GO TO 250 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.403*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.403*DLOG((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.0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.423*DLOG((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.0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.84*DLOG((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.0 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.0 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.0 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) WRITE(6,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',E12.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 RETURN END SUBROUTINE GAS36(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 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=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*DLOG((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.0 IF(EN.LE.0.0) GO TO 250 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.443*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.443*DLOG((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.0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.465*DLOG((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.0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.92*DLOG((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.0 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.0 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.0 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) WRITE(6,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',E12.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 RETURN END SUBROUTINE GAS37(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=' CESIUM 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.0 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.0 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.0 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.0 Q(6,I)=0.0 C QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS38(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC V1 QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS39(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOPV1=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC V2 BENDING MODE C QIN(1,I)=0.0 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.0 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.0 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.0 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.0 IF(EN.LE.EIN(5)) GO TO 600 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.710*DLOG((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.0 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 RETURN END SUBROUTINE GAS40(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOPV1=DEXP(EIN(3)/AKT) APOP2V2=DEXP(EIN(5)/AKT) EN=-ESTEP/2.0 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=DLOG(YXSEC(J-1)) Y2=DLOG(YXSEC(J)) X1=DLOG(XEN(J-1)) X2=DLOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=DEXP((A*DLOG(EN)+B))*1.0D-16 30 Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC V2 BENDING MODE C QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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=DSQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.639*DLOG((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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS41(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=IFIX(SNGL(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=DEXP(EIN(1)/AKT) C WRITE(6,99) APOP C 99 FORMAT(3X,'APOP=',D12.3) EN=-ESTEP/2.0 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=DLOG(YELAT(J)) YXJ1=DLOG(YELAT(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=DEXP(A*DLOG(EN)+B)*1.D-16 YXJ=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(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.5+(QELA-QMOM)/QELA Q(2,I)=QELA C Q(3,I)=0.0 PEQEL(3,I)=0.5 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.0 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.0 Q(6,I)=0.0 C V4 + V2 SUPERELASTIC QIN(1,I)=0.0 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=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AVIB1*DLOG((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.0 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=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AVIB1*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*(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.0 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=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AVIB2*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*(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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS42(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(2)/AKT) APOP3=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC OF VIBRATION V4 C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.018*DLOG((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.0 IF(EN.EQ.0.0) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.045*DLOG((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.0 IF(EN.EQ.0.0) GO TO 500 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.37*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 600 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.018*DLOG((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.0 IF(EN.LE.EIN(5)) GO TO 700 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.045*DLOG((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.0 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=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.37*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(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.0 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=DSQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.74*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(7) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(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.0 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.0 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 RETURN END SUBROUTINE GAS43(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XENM(53),YXMOM(53),XENT(50),YXTOT(50), /XVIB2(24),YVIB2(24),XVIB3(24),YVIB3(24),XVIB4(24),YVIB4(24), /XVIB5(24),YVIB5(24),XVIB6(24),YVIB6(24), /XDISS(29),YDISS(29),XATT(26),YATT(26),X3ATT(10),Y3ATT(10), /XION(50),YION(50) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER (USED LOG INTERPOLATION IN SUBROUTINE) DATA XENM/1.D-6,0.001,0.01,0.06,0.10,0.30,0.60,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, /25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,200., /300.,400.,500.,700.,1000.,1500.,2000.,3000.,5000.,7000., /1.0D4,2.0D4,4.0D4,7.0D4,1.0D5,2.0D5,4.0D5,7.0D5,1.0D6,2.0D6, /4.0D6,7.0D6,1.0D7/ DATA YXMOM/5500.,5500.,3250.,580.,320.,79.0,31.5,18.0,14.8,15.2, /15.9,16.4,16.8,17.1,17.3,17.3,17.2,17.0,15.0,12.5, /10.0,8.20,6.20,4.85,4.10,3.60,3.06,2.66,2.34,1.20, /0.82,0.64,.515,0.38,0.26,0.17,.112,.058,.0236,.0130, /.00685,.00196,5.65D-4,2.09D-4,7.65D-5,3.47D-5,1.14D-5,4.82D-6, /2.80D-6,9.63D-7, /3.12D-7,1.20D-7,6.42D-8/ C ELASTIC TOTAL 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.,150.,200.,300.,400.,500., /700.,1000.,1500.,2000.,3000.,5000.,7000.,1.D4,2.D4,4.D4, /7.D4,1.D5,2.D5,4.D5,7.D5,1.D6,2.D6,4.D6,7.D6,1.D7/ DATA YXTOT/5500.,5500.,3200.,320.,32.0,18.0,14.5,14.0,15.0,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,12.2,10.2,7.76,6.39,5.47, /4.28,3.26,2.35,1.84,1.29,.807,.590,.422,.221,.117, /.0728,.0549,.0342,.0241,.0201,.0187,.0173,.0168,.0166,.0166/ C VIBRATION V11 (RESONANCE ONLY) ANALYTIC DIPOLE IN SUBROUTINE 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.,1.D6,1.D7/ DATA YVIB2/0.0,0.0,.018,.041,.127,.118,.091,.082,.118,.137, /.137,.114,.041,.018,.009,.004,.0009,1.0D-4,1.0D-5,1.0D-6, /1.0D-7,1.0D-8,1.D-9,1.D-10/ C VIBRATION V2 (RESONANCE ONLY) ANALYTIC DIPOLE IN SUBROUTINE 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.,1.D6,1.D7/ DATA YVIB3/0.0,0.0,.114,.223,.702,.676,.501,.455,.663,.748, /.735,.624,.228,.100,.041,.018,.009,1.0D-3,1.0D-4,1.0D-5, /1.0D-6,1.0D-7,1.D-8,1.D-9/ C VIBRATION V1 (RESONANCE ONLY) ANALYTIC DIPOLE IN SUBROUTINE 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.,1.D6,1.D7/ DATA YVIB4/0.0,0.0,.246,.491,1.52,1.46,1.09,.982,1.45,1.64, /1.62,1.37,.500,.218,.091,.045,.023,1.0D-3,1.0D-4,1.0D-5, /1.0D-6,1.0D-7,1.D-8,1.D-9/ C VIBRATION HARMONIC 2(V1) RESONANCE + C-H STRETCH MODE C ANALYTIC DIPOLE IN SUBROUTINE 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.,1.D6,1.D7/ DATA YVIB5/0.0,0.0,.074,.149,.462,.437,.330,.297,.437,.495, /.487,.413,.149,.066,.025,.016,.008,1.0D-4,1.0D-5,1.0D-6, /1.0D-7,1.0D-8,1.D-9,1.D-10/ 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.,1.D6,1.D7/ DATA YVIB6/0.0,0.0,.216,.432,1.34,1.28,.960,.864,1.27,1.44, /1.42,1.20,.436,.192,.078,.042,.018,6.0D-5,6.0D-6,6.0D-7, /6.0D-8,6.0D-9,6.D-10,6.D-11/ C DISOCIATION X-SECTION (USED LOG INTERP HENCE FINITE AT THRESHOLD) 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.,10000,1.D6,1.D7/ DATA YDISS/1.D-9,.011,.108,0.60,1.05,1.92,2.38,3.15,3.60,3.98, /4.13,4.28,4.35,4.28,4.20,4.17,4.02,3.83,3.68,3.53, /3.23,2.70,2.28,1.23,.705,.315,.0315,.003,.0003/ C SCALED FROM C2F6 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.,1.D6,1.D7/ 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,.009,.0009/ C 2 BODY ATTACHMENT FIT TO BASILE ET AL 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,1.27D-5,3.40D-5,6.46D-5,9.01D-5,1.17D-4,1.41D-4, /1.46D-4,1.41D-4,1.26D-4, /1.02D-4,7.82D-5,5.95D-5,4.25D-5,2.89D-5,1.70D-5,1.16D-5,6.80D-6, /2.72D-6,1.19D-6, /5.10D-7,3.40D-7,1.0D-7,1.0D-8,1.0D-9,1.0D-10/ C 3-BODY ATTACHMENT TO FIT BASILE ET AL ( USES LOG INTERPOLATION) C VALUE AT 760 TORR : SCALE BY 760/P FOR OTHER PRESSURES DATA X3ATT/.001,0.01,0.04,0.15,0.20,0.40,0.50,0.60,1.50,3.00/ DATA Y3ATT/1.D-4,1.D-4,1.D-5,1.D-5,2.4D-4,2.4D-4,2.0D-4,1.6D-4, /1.2D-4,1.D-5/ C --------------------------------------------------------------------- C UPDATE 2010 USED ISOTROPIC X-SECTIONS C FIT TO DATA OF URQUIJO ET AL EUR PHYS J D 51 241-246 2009 C AND DATA OF BASILE ET AL PROC INT CONF PHEN IN ION GASES 1991 C GOOD FIT OBTAINED TO ARGON MIXTURE DATA OF URQUIIJO FOR 2 5 AND C 10% AND 20% MIXES . DATA OF 1% MIX IS 0.5% (MISSPRINT) C FIT TO THE LONGITUDINAL DIFFUSION DATA DOES NOT GIVE LARGE C THRESHOLD PEAK OF URQUIJO . C USED SCALED C2F6 X-SECTIONS FOR VIBRATIONS AND PLUS EXTRA C-H C STRETCH MODE. C INCLUDED A SMALL 3 BODY X-SECTION TO FIT ATTACHMENT MEASURED BY C BASILE ET AL. C X-SECTIONS NOW MORE ACCURATE THAN LAST DATA SET . NOW 3* C -------------------------------------------------------------------- NAME=' C2H2F4 2010 ' C NIN=9 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C NDATA=53 NETOT=50 NVIB2=24 NVIB3=24 NVIB4=24 NVIB5=24 NVIB6=24 NDISS=29 NATT=26 N3ATT=10 NION=50 E(1)=0.0 E(2)=2.0*EMASS/(102.0308928*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 C ********************************************************************* C PENNING TRANSFER FRACTION FOR EACH LEVEL DO 5 K=1,9 DO 5 L=1,3 5 PENFRA(L,K)=0.0 C PENNING TRANSFER FRACTION FOR EXCITATION LEVEL ONLY PENFRA(1,9)=0.0 C PENNING TRANSFER DISTANCE IN MICRONS PENFRA(2,9)=1.0 C PENNING TRANSFER TIME IN PICOSECONDS PENFRA(3,9)=1.0 IF(IPEN.EQ.0) GO TO 8 IF(PENFRA(1,9).EQ.0.0) GO TO 8 WRITE(6,999) NAME,EIN(9),PENFRA(1,9),PENFRA(2,9),PENFRA(3,9) 999 FORMAT(' GAS = ',A15,' ENERGY LEVEL = ',F7.4,' EV.',/,' PENNING PR /OBABILITY = ',F5.3,' ABS.LENGTH = ',F7.2,' DECAY TIME = ',F7.1,/) 8 CONTINUE C********************************************************************** SCRPT(1)=' ' SCRPT(2)=' ELASTIC ISOTROPIC C2H2F4 ' SCRPT(3)=' IONISATION ELOSS= 14.48 ' SCRPT(4)=' ATTACHMENT (2 AND 3 BODY) ' 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 C-H + 2V1 ELOSS= 0.35 ' SCRPT(14)=' VIB HARMONIC ELOSS= 0.50 ' SCRPT(15)=' EXC DISS0CTN ELOSS= 11.8 ' C CALCULATE DENSITY SCALING FOR 3-BODY ATTACHMENT FAC=(273.15+20.0)*TORR/((TEMPC+273.15)*760.0) C APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(2)/AKT) APOP3=DEXP(EIN(3)/AKT) APSUM=1.0+APOP1+APOP2+APOP3 APOP1=APOP1/APSUM APOP2=APOP2/APSUM APOP3=APOP3/APSUM C RENORMALISE GS POP TO ALLOW HIGHER EXCITATION APOPGS=1.0 C EN=-ESTEP/2.0 DO 9000 I=1,NSTEP EN=EN+ESTEP IF(EN.EQ.0.0) XMOMT=5500.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=DLOG(YXMOM(J-1)) Y2=DLOG(YXMOM(J)) X1=DLOG(XENM(J-1)) X2=DLOG(XENM(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) XMOMT=DEXP((A*DLOG(EN)+B))*1.0D-16 30 IF(EN.EQ.0.0) XTOT=5500.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=DLOG(YXTOT(J-1)) Y2=DLOG(YXTOT(J)) X1=DLOG(XENT(J-1)) X2=DLOG(XENT(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) XTOT=DEXP((A*DLOG(EN)+B))*1.0D-16 70 CONTINUE Q(2,I)=XTOT IF(KEL(2).EQ.0) Q(2,I)=XMOMT IF(KEL(2).EQ.0) PEQEL(2,I)=0.5 C Q(3,I)=0.0 PEQEL(3,I)=0.5 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 TWO BODY ATTACHMENT 200 Q(4,I)=0.0 PEQEL(4,I)=0.5 IF(EN.LT.XATT(1)) GO TO 230 IF(EN.GT.XATT(NATT)) GO TO 230 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 C THREE BODY ATTACHMENT USE LOG INTERPOLATION 230 THREEB=0.0 IF(EN.LT.X3ATT(1)) GO TO 255 IF(EN.GT.X3ATT(N3ATT)) GO TO 255 DO 240 J=2,N3ATT IF(EN.LE.X3ATT(J)) GO TO 250 240 CONTINUE J=N3ATT 250 Y1=DLOG(Y3ATT(J-1)) Y2=DLOG(Y3ATT(J)) X1=DLOG(X3ATT(J-1)) X2=DLOG(X3ATT(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) THREEB=DEXP(A*DLOG(EN)+B)*1.D-16*FAC 255 Q(4,I)=Q(4,I)+THREEB Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTICS QIN(1,I)=0.0 PEQIN(1,I)=0.5 QIN(2,I)=0.0 PEQIN(2,I)=0.5 QIN(3,I)=0.0 PEQIN(3,I)=0.5 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V11 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.0236*DLOG((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.D-16 C SUPERELASTIC OF VIBRATION V2 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.2750*DLOG((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.D-16 C SUPERELASTIC OF VIBRATION V1 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.9750*DLOG((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.D-16 C V11 305 CONTINUE QIN(4,I)=0.0 PEQIN(4,I)=0.5 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=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0236*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=((A*EN+B)+QIN(4,I))*APOPGS*1.D-16 400 CONTINUE C V2 QIN(5,I)=0.0 PEQIN(5,I)=0.5 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=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.2750*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(5,I)=((A*EN+B)+QIN(5,I))*APOPGS*1.D-16 500 CONTINUE C V1 QIN(6,I)=0.0 PEQIN(6,I)=0.5 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=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.975*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(6,I)=((A*EN+B)+QIN(6,I))*APOPGS*1.D-16 600 CONTINUE C C-H STRETCH MODE AND 2V1 QIN(7,I)=0.0 PEQIN(7,I)=0.5 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)) EFAC=DSQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.1925*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(7,I)=((A*EN+B)+QIN(7,I))*1.D-16 700 CONTINUE C 3V1 AND HIGHER MODES QIN(8,I)=0.0 PEQIN(8,I)=0.5 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 AND DISOCIATION 1 LEVEL APPROXIMATION QIN(9,I)=0.0 PEQIN(9,I)=0.5 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 Y1=DLOG(YDISS(J-1)) Y2=DLOG(YDISS(J)) X1=DLOG(XDISS(J-1)) X2=DLOG(XDISS(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) QIN(9,I)=DEXP((A*DLOG(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 RETURN END SUBROUTINE GAS44(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220) DIMENSION XEN(33),YELM(33),YELT(33),XION(42),YION(42),YINC(42), /XATT(10),YATT(10), /XTORS(32),YTORS(32),XVIB1(25),YVIB1(25),XVIB2(24),YVIB2(24), /XVIB3(28),YVIB3(28),XVHAR(15),YVHAR(15), /XEXC1(24),YEXC1(24),XEXC2(21),YEXC2(21),XEXC3(20),YEXC3(20) CHARACTER*30 SCRPT(226) CHARACTER*15 NAME C DATA XEN/0.00,.001,0.01,0.10,0.20,0.30,0.40,0.50,0.70,1.00, /1.50,2.00,3.00,4.00,5.00,7.00,8.00,10.0,12.0,15.0, /20.0,30.0,60.0,100.,200.,500.,1000.,1.D4,1.D5,1.D6, /2.D6,4.D6,1.D7/ C ELASTIC MOMENTUM TRANSFER DATA YELM/650.,650.,380.,38.0,19.5,15.0,13.0,12.5,13.0,14.0, /15.5,17.0,21.0,26.0,31.0,38.0,38.0,30.0,26.5,21.5, /17.0,11.5,6.10,3.50,1.40,0.47,.171,.00284,4.55D-5,1.12D-6, /3.84D-7,1.24D-7,2.55D-8/ C ELASTIC DATA YELT/650.,650.,380.,38.0,19.5,15.0,13.0,12.5,13.0,19.9, /21.1,21.9,25.6,33.5,40.4,49.8,52.8,54.5,51.0,44.3, /37.3,28.7,13.9,8.60,4.50,1.95,1.00,.145,.021,.0072, /.0066,.0064,.0063/ C YTORSION SCALED BY 1/E ABOVE 10 EV DATA XTORS/.0334,.034,.035,.036,.038,.040,.045,.050,.055,.060, /.070,.080,.100,.120,.140,.170,.200,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.00, /8.00,10.0/ DATA YTORS/0.00,.068,.072,.090,.114,.132,.150,.156,.162,.162, /.156,.150,.138,.126,.114,.102,.0932,.0798,.0702,.0576, /.0486,.0378,.0288,.0210,.0162,.0120,.0090,.0078,.0066,.00576, /.00516,.0042/ C YVIB1 SCALED BY 1/E ABOVE 40 EV DATA XVIB1/.103,0.12,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.00,8.00, /10.0,15.0,20.0,30.0,40.0/ DATA YVIB1/0.00,0.57,1.00,1.33,1.44,1.40,1.31,1.18,1.00,0.88, /0.73,0.57,0.48,0.63,1.02,1.34,1.73,2.26,2.26,1.86, /1.10,0.73,0.39,0.24,0.18/ C YVIB2 SCALED BY 1/E ABOVE 40 EV DATA XVIB2/.179,.185,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.00,8.00,10.0, /15.0,20.0,30.0,40.0/ DATA YVIB2/0.00,0.23,0.48,0.68,0.88,0.95,1.01,0.95,0.88,0.76, /0.61,0.53,0.53,0.79,1.03,1.33,1.75,1.75,1.48,0.88, /0.57,0.31,.193,.145/ C YVIB3 SCALED BY 1/E ABOVE 40 EV DATA XVIB3/.366,.373,0.38,0.39,0.40,0.42,0.45,0.50,0.55,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,15.0,20.0,30.0,40.0/ DATA YVIB3/0.00,.356,.538,.659,.749,.877,1.00,1.11,1.16,1.18, /1.17,1.13,1.09,1.04,1.03,1.03,1.16,1.65,2.20,2.70, /2.97,2.97,2.31,1.27,0.84,0.46,0.30,0.22/ C YVHAR SCALED BY 1/E ABOVE 40 EV DATA XVHAR/.480,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00, /10.0,15.0,20.0,30.0,40.0/ DATA YVHAR/0.00,.001,.033,.085,0.16,0.20,0.27,0.30,0.30,0.23, /.125,.085,.047,.032,.024/ C FIRST RYDBERG S AND P STATES DATA XEXC1/4.66,5.20,6.20,7.20,8.20,9.20,11.2,13.2,17.2,22.2, /27.2,37.2,47.2,57.2,67.2,77.2,100.,125.,150.,200., /300.,400.,600.,1000./ DATA YEXC1/0.00,.019,0.25,0.50,0.68,0.87,1.15,1.36,1.56,1.80, /2.04,2.50,2.95,3.45,3.75,4.00,4.00,3.70,3.25,2.50, /1.72,1.32,0.91,0.56/ C DATA XEXC2/6.90,8.20,9.20,11.2,13.2,17.2,22.2,27.2,37.2,47.2, /57.2,67.2,77.2,100.,125.,150.,200.,300.,400.,600., /1000./ DATA YEXC2/0.00,.133,0.35,0.63,0.87,1.15,1.40,1.57,1.90,2.25, /2.60,2.90,3.15,3.15,2.90,2.55,1.92,1.30,0.99,0.68, /.424/ C DATA XEXC3/10.0,12.0,14.0,16.0,21.0,26.0,31.0,36.0,46.0,56.0, /66.0,76.0,100.,125.,150.,200.,300.,400.,600.,1000./ DATA YEXC3/0.00,0.55,0.95,1.20,1.45,1.69,1.88,2.10,2.50,2.90, /3.25,3.50,3.50,3.25,2.85,2.25,1.55,1.18,0.82,0.51/ C DATA XION/7.75,8.40,9.40,10.4,11.4,12.4,13.4,14.4,15.4,16.4, /17.4,18.4,19.4,21.9,24.4,26.9,29.4,34.4,39.4,44.4, /50.0,60.0,70.0,80.0,90.0,100.,110.,120.,140.,160., /180.,200.,300.,400.,500.,600.,700.,800.,900.,1000., /2000.,3000./ C GROSS IONISATION DATA YION/0.00,.021,.286,.465,.637,.813,1.16,1.64,2.14,2.70, /3.27,3.83,4.35,5.54,6.58,7.49,8.29,9.56,10.5,11.1, /11.6,12.1,12.3,12.3,12.2,12.0,11.8,11.4,10.9,10.4, /9.95,9.48,7.66,6.42,5.54,4.89,4.38,3.97,3.64,3.35, /1.94,1.39/ C COUNTING IONISATION DATA YINC/42*0.0/ DATA XATT/10*0.0/ DATA YATT/10*0.0/ C ******************************************************************** NAME=' N-(CH3)3 2011' C ******************************************************************** C X-SECTIONS FROM SCALING AND SYSTEMATICS C TMA USED AS DOPANT AND FOR LIGHT EMISSION C LIGHT FROM TRANSITIONS IN S AND P RYDBERG STATES ( 4.6 EV LEVEL ) C TOTAL ELECTRON SCATTERING FROM GDANSK. C -------------------------------------------------------------------- C BORN BETHE VALUES FOR IONISATION CONST=1.873884D-20 EMASS2=1021997.804 AM2=16.3 C=160.0 C C FIX TO ISOTROPIC ANGULAR DISTRIBUTIONS C NIN=12 DO 1 J=1,6 1 KEL(J)=0 DO 2 J=1,NIN 2 KIN(J)=0 C NDATA=33 NION=42 NATT=10 NTORS=32 NVIB1=25 NVIB2=24 NVIB3=28 NVHAR=15 NEXC1=24 NEXC2=21 NEXC3=20 C E(1)=0.0 E(2)=2.0*EMASS/(59.11026*AMU) E(3)=7.80 E(4)=0.0 E(5)=0.0 E(6)=0.0 EOBY=7.75 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.0334 EIN(4)=0.0334 EIN(5)=-0.103 EIN(6)=0.103 EIN(7)=0.179 EIN(8)=0.366 EIN(9)=0.480 EIN(10)=4.66 EIN(11)=6.90 EIN(12)=10.0 C ************************************************************* C PENNING TRANSFER FRACTION FOR EACH LEVEL C SET TO 0 SINCE VERY LOW ENERGY EXCITATION LEVELS DO 5 K=1,10 DO 5 L=1,3 5 PENFRA(L,K)=0.0 C *********************************************************** SCRPT(1)=' ' SCRPT(2)=' ELASTIC ISOTROPIC N-(CH3)3 ' SCRPT(3)=' IONISATION ELOSS= 7.75 ' SCRPT(4)=' ATTACHMENT ' SCRPT(5)=' ' SCRPT(6)=' ' SCRPT(7)=' ROT ELOSS= -0.025 ' SCRPT(8)=' ROT ELOSS= 0.025 ' SCRPT(9)=' VIB TORS+ROT ELOSS= -0.0334 ' SCRPT(10)=' VIB TORS+ROT ELOSS= 0.0334 ' SCRPT(11)=' VIB V1 ELOSS= -0.103 ' SCRPT(12)=' VIB V1 ELOSS= 0.103 ' SCRPT(13)=' VIB V2 ELOSS= 0.179 ' SCRPT(14)=' VIB V3 ELOSS= 0.366 ' SCRPT(15)=' VIB HARMONIC ELOSS= 0.480 ' SCRPT(16)=' EXC (PHOTONS) ELOSS= 4.66 ' SCRPT(17)=' EXC ELOSS= 6.90 ' SCRPT(18)=' EXC ELOSS= 10.0 ' APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) APOP3=DEXP(EIN(5)/AKT) C EN=-ESTEP/2.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC IF(EN.LE.XEN(2)) THEN Q(2,I)=YELM(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=DLOG(YELM(J)) YXJ1=DLOG(YELM(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=DEXP(A*DLOG(EN)+B)*1.D-16 YXJ=DLOG(YELT(J)) YXJ1=DLOG(YELT(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELT=DEXP(A*DLOG(EN)+B)*1.D-16 Q(2,I)=QMOM C 30 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 40 IF(EN.GT.XION(NION)) GO TO 33 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 GO TO 40 C USE BORN BETHE X-SECTION ABOVE XION(NION) EV 33 GAMMA=(EMASS2+2.0D0*EN)/EMASS2 BETA=DSQRT(1.0D0-1.0D0/(GAMMA*GAMMA)) BETA2=BETA*BETA X2=1.0D0/BETA2 X1=X2*DLOG(BETA2/(1.0D0-BETA2))-1.0D0 Q(3,I)=CONST*(AM2*X1+C*X2) C NO ATTACHMENT 40 Q(4,I)=0.0 C C IF(EN.LT.XATT(1)) GO TO 50 C IF(EN.GE.XATT(NATT)) GO TO 50 C DO 41 J=2,NATT C IF(EN.LE.XATT(J)) GO TO 42 C 41 CONTINUE C J=NATT C 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) C B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) C Q(4,I)=(A*EN+B)*1.D-19 C 50 CONTINUE C SET COUNTING IONISATION = GROSS IONISATION Q(5,I)=Q(3,I) Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 100 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.30*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 100 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 150 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.30*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC TORSION C 150 QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 200 IF((EN+EIN(4)).GT.XTORS(NTORS)) GO TO 175 DO 160 J=2,NTORS IF((EN+EIN(4)).LE.XTORS(J)) GO TO 170 160 CONTINUE J=NTORS 170 A=(YTORS(J)-YTORS(J-1))/(XTORS(J)-XTORS(J-1)) B=(XTORS(J-1)*YTORS(J)-XTORS(J)*YTORS(J-1))/(XTORS(J-1)-XTORS(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 GO TO 200 C SCALED BY 1/E ABOVE XTORS(NTORS) EV 175 QIN(3,I)=YTORS(NTORS)*XTORS(NTORS)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC TORSION 200 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 250 IF(EN.GT.XTORS(NTORS)) GO TO 225 DO 210 J=2,NTORS IF(EN.LE.XTORS(J)) GO TO 220 210 CONTINUE J=NTORS 220 A=(YTORS(J)-YTORS(J-1))/(XTORS(J)-XTORS(J-1)) B=(XTORS(J-1)*YTORS(J)-XTORS(J)*YTORS(J-1))/(XTORS(J-1)-XTORS(J)) QIN(4,I)=(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 GO TO 250 C SCALED BY 1/E ABOVE XTORS(NTORS) EV 225 QIN(4,I)=YTORS(NTORS)*XTORS(NTORS)/EN QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C SUPERELASTIC VIB1 250 QIN(5,I)=0.0 IF(EN.LE.0.0) GO TO 300 IF((EN+EIN(6)).GT.XVIB1(NVIB1)) GO TO 275 DO 260 J=2,NVIB1 IF((EN+EIN(6)).LE.XVIB1(J)) GO TO 270 260 CONTINUE J=NVIB1 270 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)=(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(5,I)=QIN(5,I)*APOP3/(1.0+APOP3)*1.D-16 GO TO 300 C SCALED BY 1/E ABOVE XVIB1(NVIB1) EV 275 QIN(5,I)=YVIB1(NVIB1)*XVIB1(NVIB1)/EN QIN(5,I)=QIN(5,I)*APOP3/(1.0+APOP3)*1.D-16 C INELASTIC VIB1 300 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 350 IF(EN.GT.XVIB1(NVIB1)) GO TO 325 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(6,I)=(A*EN+B) QIN(6,I)=QIN(6,I)/(1.0+APOP3)*1.D-16 GO TO 350 C SCALED BY 1/E ABOVE XVIB1(NVIB1) EV 325 QIN(6,I)=YVIB1(NVIB1)*XVIB1(NVIB1)/EN QIN(6,I)=QIN(6,I)/(1.0+APOP3)*1.D-16 C INELASTIC VIB2 350 QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 400 IF(EN.GT.XVIB2(NVIB2)) GO TO 375 DO 360 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 370 360 CONTINUE J=NVIB2 370 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(7,I)=(A*EN+B)*1.D-16 GO TO 400 C SCALED BY 1/E ABOVE XVIB2(NVIB2) EV 375 QIN(7,I)=YVIB2(NVIB2)*XVIB2(NVIB2)/EN*1.D-16 C INELASTIC VIB3 400 QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 450 IF(EN.GT.XVIB3(NVIB3)) GO TO 425 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(8,I)=(A*EN+B)*1.D-16 GO TO 450 C SCALED BY 1/E ABOVE XVIB3(NVIB3) EV 425 QIN(8,I)=YVIB3(NVIB3)*XVIB3(NVIB3)/EN*1.D-16 C INELASTIC VIBRATION HARMONICS 450 QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 500 IF(EN.GT.XVHAR(NVHAR)) GO TO 475 DO 460 J=2,NVHAR IF(EN.LE.XVHAR(J)) GO TO 470 460 CONTINUE J=NVHAR 470 A=(YVHAR(J)-YVHAR(J-1))/(XVHAR(J)-XVHAR(J-1)) B=(XVHAR(J-1)*YVHAR(J)-XVHAR(J)*YVHAR(J-1))/(XVHAR(J-1)-XVHAR(J)) QIN(9,I)=(A*EN+B)*1.D-16 GO TO 500 C SCALED BY 1/E ABOVE XVHAR(NVHAR) EV 475 QIN(9,I)=YVHAR(NVHAR)*XVHAR(NVHAR)/EN*1.D-16 C EXCITATION 500 QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 550 IF(EN.GT.XEXC1(NEXC1)) GO TO 525 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(10,I)=(A*EN+B)*1.D-16 GO TO 550 C SCALED BY 1/E ABOVE XEXC1(NEXC1) EV 525 QIN(10,I)=YEXC1(NEXC1)*XEXC1(NEXC1)/EN*1.D-16 C EXCITATION 550 QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 600 IF(EN.GT.XEXC2(NEXC2)) GO TO 575 DO 560 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 570 560 CONTINUE J=NEXC2 570 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 GO TO 600 C SCALED BY 1/E ABOVE XEXC2(NEXC2) EV 575 QIN(11,I)=YEXC2(NEXC2)*XEXC2(NEXC2)/EN*1.D-16 C--------------------------------------------------------------------- C EXCITATION 600 QIN(12,I)=0.0 IF(EN.LE.EIN(12)) GO TO 650 IF(EN.GT.XEXC3(NEXC3)) GO TO 625 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(12,I)=(A*EN+B)*1.D-16 GO TO 650 C SCALED BY 1/E ABOVE XEXC3(NEXC3) EV 625 QIN(12,I)=YEXC3(NEXC3)*XEXC3(NEXC3)/EN*1.D-16 650 CONTINUE C--------------------------------------------------------------------- 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) WRITE(6,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',E12.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)+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 C RETURN END SUBROUTINE GAS45(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS46(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS47(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS48(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS49(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS50(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOPV=DEXP(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.0 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=DLOG(YXSEC(J-1)) Y2=DLOG(YXSEC(J)) X1=DLOG(XEN(J-1)) X2=DLOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=DEXP((A*DLOG(EN)+B))*1.0D-16 30 Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC EFFECTIVE ROTATION C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.100*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 350 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.100*DLOG((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.0 IF(EN.EQ.0.0) GO TO 365 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.152*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 400 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.152*DLOG((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.0 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=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.748*DLOG((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.0 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.0 IF(EN.LE.EIN(7)) GO TO 700 EFAC=DSQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.421*DLOG((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.0 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.0 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 RETURN END SUBROUTINE GAS51(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOPV2=DEXP(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.0 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=DLOG(YEL(J-1)) Y2=DLOG(YEL(J)) X1=DLOG(XEL(J-1)) X2=DLOG(XEL(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=DEXP((A*DLOG(EN)+B))*1.0D-16 30 Q(3,I)=0.0 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.0 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/DSQRT(EN) AT2=DEXP(-EN*EN/9.D-6) AT3=DEXP(-EN/0.0588) Q(4,I)=(AT1*AT2+AT3)*27.4D-16 200 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC VIBRATION V1 C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 250 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.100*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 300 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.100*DLOG((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.0 IF(EN.EQ.0.0) GO TO 350 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.110*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 400 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.110*DLOG((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.0 IF(EN.LE.EIN(5)) GO TO 500 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.750*DLOG((1.0+EFAC)/(1.0-EFAC))/EN*1.D-16 500 CONTINUE C C VIBRATION HARMONIC 2V3 QIN(6,I)=0.0 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.0 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 RETURN END SUBROUTINE GAS52(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(2)/AKT) APOP3=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 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.5 C Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTICS QIN(1,I)=0.0 QIN(2,I)=0.0 QIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V1 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.070*DLOG((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=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.850*DLOG((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=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=1.600*DLOG((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.0 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=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.070*DLOG((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.0 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=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.850*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(5) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(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.0 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=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=1.600*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS53(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=' OZONE 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=DEXP(EIN(1)/AKT) APOPV=DEXP(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.0 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=DLOG(YXSEC(J-1)) Y2=DLOG(YXSEC(J)) X1=DLOG(XEN(J-1)) X2=DLOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=DEXP((A*DLOG(EN)+B))*1.0D-16 30 Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC EFFECTIVE ROTATION C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.450*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 350 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.450*DLOG((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.0 IF(EN.EQ.0.0) GO TO 365 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.0133*DLOG((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.0 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=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0133*DLOG((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.0 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=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.090*DLOG((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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS54(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/RATIO/AN1,AN2,AN3,AN4,AN5,AN6,AN,FRAC(6) COMMON/GASN/NGASN(6) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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='MERCURY DIMER03' 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,6 IF(NGASN(IDGS).EQ.54) 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)=' DIMER SUPER ELOSS= -0.040 ' SCRPT(8)=' 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=DEXP(EIN(1)/AKT) EN=-ESTEP/2.0 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=DLOG(YEL(J)) YXJ1=DLOG(YEL(J-1)) XNJ=DLOG(XEL(J)) XNJ1=DLOG(XEL(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QELA=DEXP(A*DLOG(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=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) QMOM=DEXP(A*DLOG(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.0 Q(2,I)=QMOM C-------------------------------------------------------------- C IONISATION Q(3,I)=0.0 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.0 Q(5,I)=0.0 Q(6,I)=0.0 C DIMER SUPERELASTIC QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS55(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 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=DLOG(YEL(J)) Y2=DLOG(YEL(J-1)) X1=DLOG(XEL(J)) X2=DLOG(XEL(J-1)) A=(Y1-Y2)/(X1-X2) B=(X2*Y1-X1*Y2)/(X2-X1) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.0D-16 C 30 Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 1300 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*DLOG((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.0 IF(EN.LE.EIN(2)) GO TO 1400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*DLOG((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.0 IF(EN.LE.0.0) GO TO 1500 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*DLOG((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.0 IF(EN.LE.EIN(4)) GO TO 1600 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*DLOG((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.0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=AMPVIB1*DLOG((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.0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMPVIB2*DLOG((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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS56(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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-BUTANE 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=DEXP(EIN(1)/AKT) HPOP=DEXP(EIN(3)/AKT) EN=-ESTEP/2.0 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.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC VIB QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS57(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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-PENTANE 03 ' 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=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) APOP3=DEXP(EIN(5)/AKT) EN=-ESTEP/2.0 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=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 21 CONTINUE Q(3,I)=0.0 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.0 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.0 Q(6,I)=0.0 C C SUPERELASTIC VIB1 QIN(1,I)=0.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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 RETURN END SUBROUTINE GAS58(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,220), /PJ(120) 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 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 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 ANISOTROPIC INELASTIC FROM COPY (OFFSET) OF ELASTIC ANGULAR DIST KIN(65)=1 KIN(66)=1 KIN(67)=1 KIN(68)=1 KIN(69)=1 KIN(70)=1 KIN(71)=1 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=IFIX(SNGL(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)*DEXP(-K*(K+1)*B0/AKT) DO 4 K=2,28,2 4 PJ(K)=6*(2*K+1)*DEXP(-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 IOFF65=IFIX(SNGL(0.5+EIN(65)/ESTEP)) IOFF66=IFIX(SNGL(0.5+EIN(66)/ESTEP)) IOFF67=IFIX(SNGL(0.5+EIN(67)/ESTEP)) IOFF68=IFIX(SNGL(0.5+EIN(68)/ESTEP)) IOFF69=IFIX(SNGL(0.5+EIN(69)/ESTEP)) IOFF70=IFIX(SNGL(0.5+EIN(70)/ESTEP)) IOFF71=IFIX(SNGL(0.5+EIN(71)/ESTEP)) 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.0 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.0 PEQEL(3,I)=0.5 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.0 Q(5,I)=0.0 Q(6,I)=0.0 C--------------------------------------------------------------------- C QUADRUPOLE BORN ROTATIONAL STATES ( GERJUOY AND STEIN) C--------------------------------------------------------------------- C SUPERELASTIC ROTATION DO 51 K=1,28 AJ=DFLOAT(K+1) 51 QIN(K,I)=PJ(K+1)*QBK*DSQRT(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.0 C INELASTIC ROTATION C ROT 0-2 IF(EN.LE.EIN(29)) GO TO 60 QIN(29,I)=FROT0*QBK*DSQRT(1.0-EIN(29)/EN)*2.0/3.0 C ROT 1-3 AND HIGHER DO 53 K=30,56 AJ=DFLOAT(K-29) IF(EN.LE.EIN(K)) GO TO 60 53 QIN(K,I)=PJ(K-29)*QBK*DSQRT(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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 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.0 PEQIN(65,I)=0.5 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 IF(EN.LE.(2.0*EIN(65))) GO TO 450 PEQIN(65,I)=PEQEL(2,(I-IOFF65)) 450 CONTINUE C QIN(66,I)=0.0 PEQIN(66,I)=0.5 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 IF(EN.LE.(2.0*EIN(66))) GO TO 510 PEQIN(66,I)=PEQEL(2,(I-IOFF66)) 510 CONTINUE C QIN(67,I)=0.0 PEQIN(67,I)=0.5 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 IF(EN.LE.(2.0*EIN(67))) GO TO 570 PEQIN(67,I)=PEQEL(2,(I-IOFF67)) 570 CONTINUE C QIN(68,I)=0.0 PEQIN(68,I)=0.5 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 IF(EN.LE.(2.0*EIN(68))) GO TO 660 PEQIN(68,I)=PEQEL(2,(I-IOFF68)) 660 CONTINUE C QIN(69,I)=0.0 PEQIN(69,I)=0.5 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 IF(EN.LE.(2.0*EIN(69))) GO TO 720 PEQIN(69,I)=PEQEL(2,(I-IOFF69)) 720 CONTINUE C QIN(70,I)=0.0 PEQIN(70,I)=0.5 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 IF(EN.LE.(2.0*EIN(70))) GO TO 750 PEQIN(70,I)=PEQEL(2,(I-IOFF70)) 750 CONTINUE C QIN(71,I)=0.0 PEQIN(71,I)=0.5 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 IF(EN.LE.(2.0*EIN(71))) GO TO 810 PEQIN(71,I)=PEQEL(2,(I-IOFF71)) 810 CONTINUE C C SUM=0.0 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.0 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 RETURN END SUBROUTINE GAS59(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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 SUBROUTINE GAS60(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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 SUBROUTINE GAS61(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS62(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS63(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS64(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS65(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS66(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS67(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS68(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS69(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS70(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS71(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS72(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS73(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS74(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS75(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS76(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS77(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS78(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS79(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS80(Q,QIN,NIN,E,EIN,NAME,VIRIAL,EOBY /,PEQEL,PEQIN,PENFRA,KEL,KIN,SCRPT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,4000),PEQIN(220,4000),KIN(220),KEL(6) DIMENSION Q(6,4000),QIN(220,4000),E(6),EIN(220),PENFRA(3,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.0 DO 900 I=1,NSTEP EN=EN+ESTEP Q(2,I)=0.0 Q(3,I)=0.0 Q(4,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME RETURN END