C PROGRAM DELTA VERSION 2.5 C ********************************************************************** C COPYRIGHT 2011 : STEPHEN FRANCIS BIAGI C ********************************************************************* C C----------------------------------------------------------------------- C VERSION 2.5 INCLUDES KRYPTON 2011 UPDATE C----------------------------------------------------------------------- C VERSION 2.4 INCLUDES ARGON 2011 UPDATE C ---------------------------------------------------------------------- C VERSION 2.3 INCLUDES XENON 2011 IONISATION UPDATE C----------------------------------------------------------------------- C C VERSION 2.2 RAW DATA OUTPUT IS SENT TO DATA STREAM 50 WITH FILE NAME C IMIP.OUT C----------------------------------------------------------------------- C VERSION 2.1 CALCULATES FANO FACTOR AND W VALUE FOR DIRECT EXCITATION C ASSUMING NO IONISATION-RECOMBINATION IT GIVES LIGHT C YIELD IN NOBLE GASES ASSUMING NO MOLECULAR CONTAMINATION. C AUTOMATIC CALCULATION OF UPPER INTEGRATION ENERGY RANGE DUE TO C ELECTRIC AND MAGNETIC FIELDS INTRODUCED IN THIS VERSION. C INPUT CONTROL CHARACTER IWRITE INTRODUCED TO OUTPUT RAW DATA C TO OUTPUT FILE FOR LATER ANALYSIS. C RAW DATA OUPUT FILE FORMAT GIVEN BELOW C----------------------------------------------------------------------- C VERSION 1.10 INCLUDES XENON IONISATION UPDATE C VERSION 1.9 INCLUDES HYDROGEN UPDATE C VESRION 1.8 INCLUDES NEON UPDATE C VERSION 1.7 INCLUDES HELIUM UPDATE C VESRION 1.6 INCLUDES XENON UPDATE C VERSION 1.5 INCLUDES ARGON UPDATE C VESRION 1.4 INCLUDES ISOBUTANE UPDATE C VERSION 1.2 INCLUDES NITROGEN UPDATE C*********************************************************************** C THIS PROGRAM CAN BE USED TO GIVE THE CLUSTER SIZE DISTRIBUTION AND C PRIMARY CLUSTER DISTRIBUTION IN GAS MIXTURES FOR MINIMUM IONISING C PARTICLES ( SET ESTART TO 0.0 SEE BELOW). THE SPATIAL DISTRIBUTION C OF THE THERMALISED ELECTRONS WITHIN THE DISTRIBUTION IS GIVEN C AND PLOTTED AS A CUMULATED SUM . THE INDIVIDUAL EVENTS CAN ALSO BE C OUTPUT USING CONTROL WORD ,IWRITE , SO THAT A MORE DETAILED ANALAYSIS C CAN BE PERFORMED WITH OTHER DETECTOR SIMULATION PROGRAMS. C MIP CLUSTERS ARE CREATED WITH A START POSITION OF THE C PRIMARY ELECTRON IN X Y AND Z OF (0,0,0) .IT IS EASY TO TRANSFORM AND C PLACE THE GENERATED CLUSTERS ON A TRACK WITH THE CALCULATED PRIMARY C CLUSTER SPACING ALONG THE TRACK GIVEN BY A POISSON DISTRIBUTION. C THERE IS AT THE MOMENT NO FACILITY TO ALLOW THE CALCULATION OF THE C CHANGE IN CLUSTER SPACING CAUSED BY THE RELATIVISTIC RISE ABOVE MIN C IONISING . HOWEVER THIS MAY BE DONE BY SCALING THE PRIMARY CLUSTER C SPACING ACCORDING TO PUBLISHED VALUES OF THE RELATIVISTIC RISE FROM C THE CALCULATED MINIMUM IONISING VALUE. C C THE PROGRAM ALSO CALCULATES THE RANGE AND ALL FANO FACTORS FOR THE C CASE OF ELECTRONS INJECTED WITH AN ENERGY ESTART INTO THE GAS. C THIS ALLOWS THE SIMULATION OF THE RANGE AND CLUSTER SIZE OF X-RAYS C INCIDENT ON THE GAS MIXTURE. THE CONVERSION POINT IS TAKEN SIMILARLY C TO THE MIP CASE TO BE AT (0,0,0). C THE PROGRAM CAN OUTPUT THE RAW DATA SUCHA AS CONVERTED X-RAY CLOUD C COORDINATES OF THE THERMALISED ELECTRONS FOR LATER USE BY DETECTOR C SIMULATION PROGRAMS THIS ALLOWS POSSIBLE LIMITING ACCURACY IN IMAGING C X-RAYS WITH ANY GAS TO BE OBTAINED. C THE RAW DATA OUTPUT CAN BE USED TO SIMULATE X-RAY ABSORPTION BY C EITHER A CRUDE APPROXIMATION ASSUMING PHOTOELCTRIC ABSORPTION , C I.E.: THE INITIAL ELECTRON ENERGY IS THE X-RAY ENERGY, OR BY USING A C CASCADE PROGRAM TO CALCULATE THE PERCENTAGE OF AUGER , CASTER KRONIG C OR PHOTOELECTRIC THEN USING THE RAW OUTPUT TO REGENERATE A MORE C ACCURATE ELECTRON CLOUD. NOTE THE EFFECT OF ASSUMING ONLY A C PHOTOELECTRIC ABSORPTION IS ALREADY ACCURATE TO 1% IN THE NUMBER C OF ELECTRONS/X-RAY IN MOST CASES BUT WILL NOT GIVE ESCAPE PEAKS C AND FINER DETAIL IN THE ELECTRON CLOUD SIZES . C THE PRELIMINARY TESTS ON THE NOBLE GASES GIVE FANO FACTORS AND RANGE C TO BETTER THAN 5% ACCURACY UP TO 20KEV. CLUSTER SIZE DISTRIBUTIONS C FOR MIPS SEEM TO BE IN AGREEMENT WITH THE ONLY ACCURATE DATA OF C FISCHLE ET AL.. C THE AUTHOR WOULD LIKE FEEDBACK FROM USERS OF THE PROGRAM C SPECIFICALLY THE USE OF THE PENNING OPTION REQUIRES SOME INPUT TO C THE PROGRAM. THE PROBABILITY OF PENNING TRANSFER IS MIXTURE C DEPENDENT AND ONLY WITH SOME GOOD FEEDBACK FROM USERS SO THAT A C PENNING FRACTION DATABASE BE BUILT UP. C THE PENNING FRACTION CAN BE INSERTED BY USERS IN EACH OF THE GAS C DATABASE SUBROUTINES THEN RECOMPILED AND RUN . NOTE THERE IS A LOT OF C MISLEADING STATEMENTS ON PENNING MIXTURES IN THE LITERATURE. THE C LARGEST EFFECTS ON CLUSTER SIZE OCCUR PROPORTIONALLY TO THE AVERAGE C DE/DX CHANGE WITH GAS MIXTURE THE PENNING EFFECTS ARE ONLY A C FEW % ON THE CLUSTER SIZE. C NOTE THE PROGRAM STARTS TO LOSE ACCURACY ABOVE 30 KEV X-RAY/DELTA C ENERGY BECAUSE OF THE FINITE NUMBER OF ENERGY BINS , EACH ENERGY BIN C BECOMES LARGE AND DETAILS ARE LOST OF STRUCTURE IN THE CROSS-SECTION. C IN ORDER TO AVOID THIS PROBLEM IT IS POSSIBLE TO MODIFY THE PROGRAM C AND INCREASE THE NUMBER OF STEPS FROM THE PRESENT VALUE OF 20000, C THUS DECREASING THE ENERGY BIN WIDTH AND IMPROVING THE ACCURACY WITH C ONLY A LINEAR INCREASE IN COMPUTER MEMORY REQUIRED. C -------------------------------------------------------------------- C RAW DATA OUTPUT FILE FORMAT: C C IF IWRITE EQ 0 :ONLY NORMAL OUTPUT C C IF IWRITE EQ 1 : OUTPUT TO FILE IMIP.OUT C C LINE 1 EVENT NUMBER (NEVENT), ELECTRON CLUSTER SIZE (NCLUS) AND C EXCITATION CLUSTER SIZE (NSTEXC) C LINE 2 X,Y,Z AND T FOR EACH OF THE NCLUS ELECTRONS C IF IWRITE EQ 2 : OUTPUT TO FILE IMIP.OUT C C LINE 1 EVENT NUMBER (NEVENT), ELECTRON CLUSTER SIZE (NCLUS) AND C EXCITATION CLUSTER SIZE (NSTEXC) C LINE 2 X,Y,Z AND T FOR EACH OF THE NCLUS ELECTRONS C LINE 3 X,Y,Z AND T FOR EACH OF THE NSTEXC EXCIATIONS C C C TIME IN PICOSECONDS C X,Y,Z IN MICRONS C C ********************************************************************* C C ELASTIC ANISOTROPIC SCATTERING IS IN DATA BASE . IF THERE IS NO C DATA ON ANISOTROPIC SCATTERING OF THE INELASTIC LEVELS THE PROGRAM C ESTIMATES THE ANISOTROPIC INELASTIC SCATTERING FROM THE ELASTIC C ANISOTROPIC SCATTERING . THE IONISATION SCATTERING IS SIMILARLILY C INTERPOLATED FROM THE ELASTIC ANISOTROPIC SCATTERING. C C POSTSCRIPT PLOTS OF THE DATABASE X-SECTIONS CAN BE OBTAINED ON:- C HTTP://CONSULT.CERN.CH/WRITEUPS/MAGBOLTZ/CROSS/ C NOTE PLOTS HAVE NOT BEEN UPDATED FOR MULTIPLE EXCITATION C LEVELS 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---------------------------------------------------------------- C--------------------------------------------------------------- C INPUT CARDS : C------------------------------------------------------------------- C FIRST CARD: 4I10,2F10.5 : NGAS,NDELTA,NANISO,NDVEC,ESTART,ETHRM C NGAS = NUMBER OF GASES IN MIXTURE C NDELTA = NUMBER OF DELTA ELECTRONS (CONVERTED X-RAYS) OR MIPS C MAXIMUM NUMBER OF MIPS =4000000 C NANISO = 0 ISOTROPIC SCATTERING C NANISO = 1 ANISOTROPIC SCATTERING (CAPITELLI/LONGO) IF AVAILABLE C NANISO = 2 ANISOTROPIC SCATTERING (OKHRIMOVSKYY ET AL) IF AVAILABLE C THE OKHRIMOVSKYY PARAMETERISATION GIVES BETTER RANGES C NOTE USE NANISO =2 FOR ACCURATE RANGES C NDVEC = 1 DELTA DIRECTION PARALLEL TO E-FIELD (Z) C NDVEC =-1 DELTA DIRECTION ANTI PARALLEL TO E-FIELD (-Z) C NDVEC = 0 DELTA PERPENDICULAR TO E-FIELD IN XY PLANE C ESTART = DELTA / X-RAY ENERGY IN EV. C IF SET TO 0.0 THEN USE MIPS GENERATED DELTA SPECTRUM C ETHRM = ELECTRONS TRACKED UNTIL THEY FALL TO THIS ENERGY EV. C FOR FAST CALCULATION THE THERMALISATION ENERGY SHOULD BE C SET TO THE LOWEST IONISATION IN THE MIXTURE. C FOR MORE ACCURATE THERMALISATION RANGE THE THERMALISATION C ENERGY SHOULD BE SET TO 2.0 EV. 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 : 3F10.3,2I5 : EFIELD,BMAG,BTHETA,IWRITE,IPEN 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 IWRITE : =0 STANDARD OUTPUT C IWRITE : =1 C LINE1 OUTPUT NO OF ELECTRONS AND NO OF EXCITATIONS FOR EACH EVENT C LINE2 OUTPUTS X,Y,Z AND T FOR EACH THERMALISED ELECTRON C IWRITE : =2 C LINE1 OUTPUT NO OF ELECTRONS AND NO OF EXCITATIONS FOR EACH EVENT C LINE2 OUTPUTS X,Y,Z AND T FOR EACH THERMALISED ELECTRON C LINE3 OUTPUTS X,Y,Z AND T FOR EACH EXCITATION C C IPEN : =0 NO PENNING TRANSFERS C =1 PENNING TRANSFERS ALLOWED C ( MODIFY GAS SUBROUTINE TO CHANGE PENNING FRACTIONS) C 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 NOT YET DONE 5* C GAS10 : PROPANE NOT YET DONE 4* C GAS11 : ISOBUTANE (2009) 4* C GAS12 : CO2 (2007) 5* C GAS13 : NEO-PENTANE NOT YET DONE 4* C GAS14 : H20 NOT YET DONE 4* C GAS15 : OXYGEN NOT YET DONE 4* C GAS16 : NITROGEN (2008) 5* C GAS17 : NITRIC OXIDE NOT YET DONE 2* C GAS18 : NITROUS OXIDE NOT YET DONE 4* C GAS19 : ETHENE NOT YET DONE 4* C GAS20 : ACETYLENE NOT YET DONE 4* C GAS21 : HYDROGEN (2010) 5* C GAS22 : DEUTERIUM NOT YET DONE 5* C GAS23 : CARBON MONOXIDE NOT YET DONE 5* C GAS24 : METHYLAL NOT YET DONE 2* C GAS25 : DME NOT YET DONE 4* C GAS26 : REID STEP MODEL NOT YET DONE C GAS27 : MAXWELL MODEL NOT YET DONE C GAS28 : REID RAMP MODEL NOT YET DONE C GAS29 : C2F6 NOT YET DONE 4* C GAS30 : SF6 NOT YET DONE 3* C GAS31 : NH3 AMMONIA NOT YET DONE 4* C GAS32 : C3H6 PROPENE NOT YET DONE 4* C GAS33 : C3H6 CYCLOPROPANE NOT YET DONE 4* C GAS34 : CH3OH METHANOL NOT YET DONE 3* C GAS35 : C2H5OH ETHANOL NOT YET DONE 3* C GAS36 : C3H7OH ISO PROPANOL(1999) NOT YET DONE 3* C GAS37 : CESIUM (2001) NOT YET DONE 2* C GAS38 : FLOURINE (MORGAN) NOT YET DONE 2* C GAS39 : CS2 (2001) ( ION DRIFT,DARK MATTER ) NOT YET DONE 2* C GAS40 : COS (2001) NOT YET DONE 2* C GAS41 : CD4 (2004) NOT YET DONE 4* C GAS42 : BF3 BORON TRIFLOURIDE (2001) (ANISOTROPIC) NOT YET DONE4* C GAS43 : C2HF5 OR C2H2F4 NOT YET DONE 2* C GAS44 : C GAS45 : C GAS46 : C GAS47 : C GAS48 : C GAS49 : C GAS50 : CHF3 (2001) NOT YET DONE 3* C GAS51 : CF3BR (2002) NOT YET DONE 3* C GAS52 : C3F8 (2002) NOT YET DONE 3* C GAS53 : OZONE (2002) NOT YET DONE 3* C GAS54 : MERCURY (2003) NOT YET DONE 2* C GAS55 : H2S (2003) NOT YET DONE 2* C GAS56 : N-BUTANE (2003) NOT YET DONE 4* C GAS57 : N-PENTANE(2003) NOT YET DONE 4* C GAS58-80 :DUMMY ROUTINES C------------------------------------------------------------------ C PROGRAM DELTA IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/BFLD/EOVB,WB,BTHETA,BMAG 1 CALL SETUP(LAST) IF(LAST.EQ.1) GO TO 99 CALL MIXER CALL PRNTER IF(BMAG.EQ.0.0D0) CALL MONTEFE IF(BMAG.NE.0.0D0) THEN IF(BTHETA.EQ.0.0D0.OR.BTHETA.EQ.180.0D0) THEN CALL MONTEFA ELSE IF(BTHETA.EQ.90.0D0) THEN CALL MONTEFB ELSE CALL MONTEFC ENDIF ENDIF CALL STATS2 CALL OUTPUT 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.0 PSCT2=PSCT1 IF(PSCT1.LE.1.0) RETURN API=DACOS(-1.0D0) RADS=2.0/API CNS=PSCT1-0.5 THETAC=DASIN(2.0*DSQRT(CNS-CNS*CNS)) FAC=(1.0-DCOS(THETAC))/(DSIN(THETAC)*DSIN(THETAC)) PSCT2=(CNS*FAC)+0.5 ANGC=THETAC*RADS RETURN END SUBROUTINE MIXER IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) CHARACTER*15 NAMEG,NAME1,NAME2,NAME3,NAME4,NAME5,NAME6 COMMON/RATIO/AN1,AN2,AN3,AN4,AN5,AN6,AN,FRAC(6) CHARACTER*30 DSCRPT,SCRP1(226),SCRP2(226),SCRP3(226),SCRP4(226), /SCRP5(226),SCRP6(226) COMMON/GASN/NGASN(6) COMMON/MIX1/QELM(20000),QSUM(20000),QION(6,20000),QIN1(220,20000), /QIN2(220,20000),QIN3(220,20000),QIN4(220,20000),QIN5(220,20000), /QIN6(220,20000),QSATT(20000) COMMON/MIX2/E(20000),EROOT(20000),QTOT(20000),QREL(20000), /QINEL(20000),QEL(20000) 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(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/LARGE/CF(20000,512),EIN(512),TCF(20000),IARRY(512), /RGAS(512),IPN(512),WPL(512),IPLAST,PENFRA(3,512) COMMON/ANIS/PSCT(20000,512),ANGCT(20000,512),INDEX(512),NISO COMMON/FRED/FCION(20000),FCATT(20000) COMMON/MRATIO/VAN1,VAN2,VAN3,VAN4,VAN5,VAN6,VAN COMMON/IONC/DOUBLE(6,20000),CMINIXSC(6),CMINEXSC(6),ECLOSS(6), /WPLN(6),ICOUNT,AVPFRAC(3,6) COMMON/NAMES/NAMEG(6) COMMON/SCRIP/DSCRPT(512) DIMENSION Q1(6,20000),Q2(6,20000),Q3(6,20000),Q4(6,20000), /Q5(6,20000),Q6(6,20000) 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(20000),QDROT(20000),QATT(6,20000),EION(6) DIMENSION PEQEL1(6,20000),PEQEL2(6,20000),PEQEL3(6,20000), /PEQEL4(6,20000),PEQEL5(6,20000),PEQEL6(6,20000) DIMENSION PEQIN1(220,20000),PEQIN2(220,20000),PEQIN3(220,20000), /PEQIN4(220,20000),PEQIN5(220,20000),PEQIN6(220,20000) 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 MOD: STORE COUNTING IONISATION X-SECTION IN ARRAY CMINIXSC(6) C AT MINIMUM IONISING ENERGY C --------------------------------------------------------------------- C NISO=0 NIN1=0 NIN2=0 NIN3=0 NIN4=0 NIN5=0 NIN6=0 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,20000 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 DOUBLE(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/NSTEP EHALF=ESTEP/2.0D0 E(1)=EHALF DO 3 I=2,20000 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,20000 FCION(IE)=0.0D0 FCATT(IE)=0.0D0 NP=1 CF(IE,NP)=Q1(2,IE)*VAN1 PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 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 AVPFRAC(1,1)=0.0 AVPFRAC(2,1)=0.0 AVPFRAC(3,1)=0.0 CMINEXSC(1)=E1(4)*AN1 CMINIXSC(1)=E1(5)*AN1 ECLOSS(1)=E1(3) WPLN(1)=E1(6) 12 IF(EFINAL.LT.E1(3)) GO TO 30 NP=NP+1 C CHOOSE BETWEEN COUNTING AND GROSS IONISATION X-SECTION IF(ICOUNT.EQ.1) THEN CF(IE,NP)=Q1(5,IE)*VAN1 FCION(IE)=FCION(IE)+CF(IE,NP) DOUBLE(1,IE)=Q1(3,IE)/Q1(5,IE)-1.0D0 ELSE CF(IE,NP)=Q1(3,IE)*VAN1 FCION(IE)=FCION(IE)+CF(IE,NP) ENDIF PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 IF(ICOUNT.EQ.1) THEN IF(KEL1(5).EQ.1) THEN PSCT1=PEQEL1(5,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL1(5).EQ.2) THEN PSCT(IE,NP)=PEQEL1(5,IE) INDEX(NP)=2 ENDIF ELSE 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 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.5 ANGCT(IE,NP)=1.0 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.5 ANGCT(IE,NP)=1.0 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-6/DSQRT(3.0D0) PENFRA(3,NP)=PENFRA1(3,J) IF(PENFRA(1,NP).GT.AVPFRAC(1,1)) THEN AVPFRAC(1,1)=PENFRA(1,NP) AVPFRAC(2,1)=PENFRA(2,NP) AVPFRAC(3,1)=PENFRA(3,NP) ENDIF IF(J.EQ.NIN1) CMINEXSC(1)=CMINEXSC(1)*AVPFRAC(1,1) 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.5 ANGCT(IE,NP)=1.0 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 AVPFRAC(1,2)=0.0 AVPFRAC(2,2)=0.0 AVPFRAC(3,2)=0.0 CMINEXSC(2)=E2(4)*AN2 CMINIXSC(2)=E2(5)*AN2 ECLOSS(2)=E2(3) WPLN(2)=E2(6) 62 IF(EFINAL.LT.E2(3)) GO TO 130 NP=NP+1 C CHOOSE BETWEEN COUNTING AND GROSS IONISATION X-SECTION IF(ICOUNT.EQ.1) THEN CF(IE,NP)=Q2(5,IE)*VAN2 FCION(IE)=FCION(IE)+CF(IE,NP) DOUBLE(2,IE)=Q2(3,IE)/Q2(5,IE)-1.0D0 ELSE CF(IE,NP)=Q2(3,IE)*VAN2 FCION(IE)=FCION(IE)+CF(IE,NP) ENDIF PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 C IF(ICOUNT.EQ.1) THEN IF(KEL2(5).EQ.1) THEN PSCT1=PEQEL2(5,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL2(5).EQ.2) THEN PSCT(IE,NP)=PEQEL2(5,IE) INDEX(NP)=2 ENDIF ELSE 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 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.5 ANGCT(IE,NP)=1.0 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.5 ANGCT(IE,NP)=1.0 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 ENDIF IF(KIN2(J).EQ.2) THEN PSCT(IE,NP)=PEQIN2(J,IE) INDEX(NP)=2 ENDIF C 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) IF(PENFRA(1,NP).GT.AVPFRAC(1,2)) THEN AVPFRAC(1,2)=PENFRA(1,NP) AVPFRAC(2,2)=PENFRA(2,NP) AVPFRAC(3,2)=PENFRA(3,NP) ENDIF IF(J.EQ.NIN2) CMINEXSC(2)=CMINEXSC(2)*AVPFRAC(1,2) 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.5 ANGCT(IE,NP)=1.0 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 AVPFRAC(1,3)=0.0 AVPFRAC(2,3)=0.0 AVPFRAC(3,3)=0.0 CMINEXSC(3)=E3(4)*AN3 CMINIXSC(3)=E3(5)*AN3 ECLOSS(3)=E3(3) WPLN(3)=E3(6) 162 IF(EFINAL.LT.E3(3)) GO TO 230 NP=NP+1 C CHOOSE BETWEEN COUNTING AND GROSS IONISATION X-SECTION IF(ICOUNT.EQ.1) THEN CF(IE,NP)=Q3(5,IE)*VAN3 FCION(IE)=FCION(IE)+CF(IE,NP) DOUBLE(3,IE)=Q3(3,IE)/Q3(5,IE)-1.0D0 ELSE CF(IE,NP)=Q3(3,IE)*VAN3 FCION(IE)=FCION(IE)+CF(IE,NP) ENDIF PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 C IF(ICOUNT.EQ.1) THEN IF(KEL3(5).EQ.1) THEN PSCT1=PEQEL3(5,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL3(5).EQ.2) THEN PSCT(IE,NP)=PEQEL3(5,IE) INDEX(NP)=2 ENDIF ELSE 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 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.5 ANGCT(IE,NP)=1.0 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.5 ANGCT(IE,NP)=1.0 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) IF(PENFRA(1,NP).GT.AVPFRAC(1,3)) THEN AVPFRAC(1,3)=PENFRA(1,NP) AVPFRAC(2,3)=PENFRA(2,NP) AVPFRAC(3,3)=PENFRA(3,NP) ENDIF IF(J.EQ.NIN3) CMINEXSC(3)=CMINEXSC(3)*AVPFRAC(1,3) 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.5 ANGCT(IE,NP)=1.0 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 AVPFRAC(1,4)=0.0 AVPFRAC(2,4)=0.0 AVPFRAC(3,4)=0.0 CMINEXSC(4)=E4(4)*AN4 CMINIXSC(4)=E4(5)*AN4 ECLOSS(4)=E4(3) WPLN(4)=E4(6) 262 IF(EFINAL.LT.E4(3)) GO TO 330 NP=NP+1 C CHOOSE BETWEEN COUNTING AND GROSS IONISATION X-SECTION IF(ICOUNT.EQ.1) THEN CF(IE,NP)=Q4(5,IE)*VAN4 FCION(IE)=FCION(IE)+CF(IE,NP) DOUBLE(4,IE)=Q4(3,IE)/Q4(5,IE)-1.0D0 ELSE CF(IE,NP)=Q4(3,IE)*VAN4 FCION(IE)=FCION(IE)+CF(IE,NP) ENDIF PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 C IF(ICOUNT.EQ.1) THEN IF(KEL4(5).EQ.1) THEN PSCT1=PEQEL4(5,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL4(5).EQ.2) THEN PSCT(IE,NP)=PEQEL4(5,IE) INDEX(NP)=2 ENDIF ELSE 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 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.5 ANGCT(IE,NP)=1.0 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.5 ANGCT(IE,NP)=1.0 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) IF(PENFRA(1,NP).GT.AVPFRAC(1,4)) THEN AVPFRAC(1,4)=PENFRA(1,NP) AVPFRAC(2,4)=PENFRA(2,NP) AVPFRAC(3,4)=PENFRA(3,NP) ENDIF IF(J.EQ.NIN4) CMINEXSC(4)=CMINEXSC(4)*AVPFRAC(1,4) 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.5 ANGCT(IE,NP)=1.0 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 AVPFRAC(1,5)=0.0 AVPFRAC(2,5)=0.0 AVPFRAC(3,5)=0.0 CMINEXSC(NP)=E5(4)*AN5 CMINIXSC(5)=E5(5)*AN5 ECLOSS(5)=E5(3) WPLN(5)=E5(6) 362 IF(EFINAL.LT.E5(3)) GO TO 430 NP=NP+1 C CHOOSE BETWEEN COUNTING AND GROSS IONISATION X-SECTION IF(ICOUNT.EQ.1) THEN CF(IE,NP)=Q5(5,IE)*VAN5 FCION(IE)=FCION(IE)+CF(IE,NP) DOUBLE(5,IE)=Q5(3,IE)/Q5(5,IE)-1.0D0 ELSE CF(IE,NP)=Q5(3,IE)*VAN5 FCION(IE)=FCION(IE)+CF(IE,NP) ENDIF PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 C IF(ICOUNT.EQ.1) THEN IF(KEL5(5).EQ.1) THEN PSCT1=PEQEL5(5,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL5(5).EQ.2) THEN PSCT(IE,NP)=PEQEL5(5,IE) INDEX(NP)=2 ENDIF ELSE 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 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.5 ANGCT(IE,NP)=1.0 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.5 ANGCT(IE,NP)=1.0 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) IF(PENFRA(1,NP).GT.AVPFRAC(1,5)) THEN AVPFRAC(1,5)=PENFRA(1,NP) AVPFRAC(2,5)=PENFRA(2,NP) AVPFRAC(3,5)=PENFRA(3,NP) ENDIF IF(J.EQ.NIN5) CMINEXSC(5)=CMINEXSC(5)*AVPFRAC(1,5) 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.5 ANGCT(IE,NP)=1.0 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 AVPFRAC(1,6)=0.0 AVPFRAC(2,6)=0.0 AVPFRAC(3,6)=0.0 CMINEXSC(6)=E6(4)*AN6 CMINIXSC(6)=E6(5)*AN6 ECLOSS(6)=E6(3) WPLN(6)=E6(6) 462 IF(EFINAL.LT.E6(3)) GO TO 530 NP=NP+1 C CHOOSE BETWEEN COUNTING AND GROSS IONISATION X-SECTION IF(ICOUNT.EQ.1) THEN CF(IE,NP)=Q6(5,IE)*VAN6 FCION(IE)=FCION(IE)+CF(IE,NP) DOUBLE(6,IE)=Q6(3,IE)/Q6(5,IE)-1.0D0 ELSE CF(IE,NP)=Q6(3,IE)*VAN6 FCION(IE)=FCION(IE)+CF(IE,NP) ENDIF PSCT(IE,NP)=0.5 ANGCT(IE,NP)=1.0 INDEX(NP)=0 C IF(ICOUNT.EQ.1) THEN IF(KEL6(5).EQ.1) THEN PSCT1=PEQEL6(5,IE) CALL ANGCUT(PSCT1,ANGC,PSCT2) ANGCT(IE,NP)=ANGC PSCT(IE,NP)=PSCT2 INDEX(NP)=1 ENDIF IF(KEL6(5).EQ.2) THEN PSCT(IE,NP)=PEQEL6(5,IE) INDEX(NP)=2 ENDIF ELSE 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 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.5 ANGCT(IE,NP)=1.0 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.5 ANGCT(IE,NP)=1.0 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) IF(PENFRA(1,NP).GT.AVPFRAC(1,6)) THEN AVPFRAC(1,6)=PENFRA(1,NP) AVPFRAC(2,6)=PENFRA(2,NP) AVPFRAC(3,6)=PENFRA(3,NP) ENDIF IF(J.EQ.NIN6) CMINEXSC(6)=CMINEXSC(6)*AVPFRAC(1,6) 550 CONTINUE 560 CONTINUE C 600 CONTINUE IPLAST=NP 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.20000.0) EHI=20000.0 JONE=1 JLARGE=20000 DO 810 I=1,10 JLOW=20000-2000*(11-I)+1+INT(ELOW) JHI=20000-2000*(10-I)+INT(EHI) JLOW=DMAX0(JLOW,JONE) JHI=DMIN0(JHI,JLARGE) DO 800 J=JLOW,JHI IF(TCF(J).GE.TCFMAX(I)) TCFMAX(I)=TCF(J) 800 CONTINUE 810 CONTINUE C--------------------------------------------------------------------- C FIND MAXIMUM COLLISION FREQUENCY TLIM=TCFMAX(1) DO 835 I=1,10 835 IF(TLIM.LT.TCFMAX(I)) TLIM=TCFMAX(I) TCFMAX1=TLIM 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,20000),QIN(220,20000),E(6),EI(220),KIN(220) DIMENSION PEQEL(6,20000),PEQIN(220,20000),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(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/IONC/DOUBLE(6,20000),CMINIXSC(6),CMINEXSC(6),ECLOSS(6), /WPLN(6),ICOUNT,AVPFRAC(3,6) COMMON/MRATIO/VAN1,VAN2,VAN3,VAN4,VAN5,VAN6,VAN COMMON/OUTPT/ICOLL(30),NETOT,NPRIME,TMAX1,TIME(300),NNULL, /NITOT,ICOLN(512),NREAL,NEXCTOT COMMON/PLOT/NXPL10(31),NYPL10(31),NZPL10(31),NXPL40(31), /NYPL40(31),NZPL40(31),NXPL100(31),NYPL100(31),NZPL100(31), /NXPL400(31),NYPL400(31),NZPL400(31),NXPL1000(31),NYPL1000(31), /NZPL1000(31),NXPL2(31),NYPL2(31),NZPL2(31),NXPL4000(31), /NYPL4000(31),NZPL4000(31),NXPL10000(31),NYPL10000(31), /NZPL10000(31),NXPL40000(31),NYPL40000(31),NZPL40000(31), /NXPL100000(31),NYPL100000(31),NZPL100000(31),NEPL1(100), /NEPL10(100),NEPL100(100),MELEC(300),MELEC10(300) C-------------------------------------------------------------------- C C NEW UPDATE OF CONSTANTS 2008 C API=DACOS(-1.0D0) ARY=13.60569193D0 PIR2=8.7973553523D-17 ECHARG=1.602176487D-19 EMASS=9.10938215D-31 AMU=1.660538782D-27 BOLTZ=8.617342D-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 MINIMUM IONISING ENERGY FOR MIPS ELECTRONS IN EV EMIP=1.5D6 C -------------------------------------------- C C READ IN OUTPUT CONTROL AND INTEGRATION DATA C READ(5,2) NGAS,NDELTA,NANISO,NDVEC,ESTART,ETHRM 2 FORMAT(4I10,2F10.5) IMIP=0 ICOUNT=0 IF(ESTART.EQ.0.0) THEN IMIP=1 ICOUNT=1 ENDIF IF(NGAS.EQ.0) GO TO 99 IF(NDELTA.GT.4000000) THEN WRITE(6,665) NDELTA 665 FORMAT(' PROGRAM STOPPED NUMBER OF EVENTS =',I7,' LARGER THAN ARR /AY LIMIT OF 4000000') STOP ENDIF 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,IWRITE,IPEN 5 FORMAT(3F10.3,2I5) C WRITE(6,656) IWRITE C 656 FORMAT(' IWRITE=',I3) IF(IWRITE.NE.0) OPEN(UNIT=50,FILE='IMIP.OUT') IF(IMIP.EQ.1) EFINAL=10100.0 C CALCULATE EFINAL FOR XRAYS (INCREASE CAUSED BY ELECTRIC FIELD) IF(IMIP.EQ.0) THEN EBIG=0.05*ESTART/1000. EFINAL=ESTART*1.0001+760.0*EBIG/TORR*(TEMPC+ABZERO)/293.15*EFIELD ENDIF C CHECK INPUT 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 NOUT=10 NSTEP=20000 C INITIAL ANGLES PHI=0.0D0 IF(NDVEC.EQ.1) THEN THETA=0.0D0 ELSE IF(NDVEC.EQ.(-1)) THEN THETA=DACOS(-1.D0) ELSE IF(NDVEC.EQ.0) THEN THETA=API/2.0 ELSE WRITE(6,992) NDVEC 992 FORMAT(/,2X,'DIRECTION OF DELTA NOT DEFINED NDVEC =',I5) STOP ENDIF C ZERO COMMON BLOCKS OF OUTPUT RESULTS 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,10 100 TCFMAX(K)=0.0D0 C ZERO PLOT ARRAYS DO 110 K=1,31 NXPL2(K)=0 NYPL2(K)=0 NZPL2(K)=0 NXPL10(K)=0 NYPL10(K)=0 NZPL10(K)=0 NXPL40(K)=0 NYPL40(K)=0 NZPL40(K)=0 NXPL100(K)=0 NYPL100(K)=0 NZPL100(K)=0 NXPL400(K)=0 NYPL400(K)=0 NZPL400(K)=0 NXPL1000(K)=0 NYPL1000(K)=0 NZPL1000(K)=0 NXPL4000(K)=0 NYPL4000(K)=0 NZPL4000(K)=0 NXPL10000(K)=0 NYPL10000(K)=0 NZPL10000(K)=0 NXPL40000(K)=0 NYPL40000(K)=0 NZPL40000(K)=0 NXPL100000(K)=0 NYPL100000(K)=0 110 NZPL100000(K)=0 DO 111 K=1,100 NEPL1(K)=0 NEPL10(K)=0 111 NEPL100(K)=0 DO 112 K=1,300 MELEC(K)=0 112 MELEC10(K)=0 C --------------------------------------------- C CAN SET RANDOM NUMBER SEED TO SEED VALUE HERE C C RSTART=0.666D0 C RANDOM NUMBER SEED FUNCTION (RSTART) C----------------------------------------------- C C ALLOW INCREASE IN EENERGY IN ELECTRIC FIELD BEFORE ENERGY LOSS C BY DELTA THEREFORE INCREASE ALLOWED ENERGY RANGE EFINAL C 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 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(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/IONC/DOUBLE(6,20000),CMINIXSC(6),CMINEXSC(6),ECLOSS(6), /WPLN(6),ICOUNT,AVPFRAC(3,6) COMMON/LARGE/CF(20000,512),EIN(512),TCF(20000),IARRY(512), /RGAS(512),IPN(512),WPL(512),IPLAST,PENFRA(3,512) COMMON/NAMES/NAMEG(6) CHARACTER*15 NAMEG WRITE(6,1) 1 FORMAT(2(/),10X,'DELTA ELECTRON SIMULATION V2.5',2(/)) WRITE(6,10) NGAS 10 FORMAT(3X,'MONTE CARLO SOLUTION FOR MIXTURE OF ',I2,' GASES.',/,3X /,'DELTA RAY CALCULATION ALL TIMES IN PICOSECS, DISTANCE IN MICRONS /',/,3X,'---------------------------------------------------------- /-------') 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.') IF(IPEN.EQ.0) WRITE(6,55) 55 FORMAT(2(/),2X,' PENNING IONISATION NOT ALLOWED') IF(IPEN.EQ.1) WRITE(6,56) 56 FORMAT(2(/),2X,' PENNING IONISATION ALLOWED') WRITE(6,60) EFINAL,NSTEP 60 FORMAT(1(/),2X,'INTEGRATION FROM 0.0 TO ',F9.1,' EV. IN ',I5,' ST /EPS. ') 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. =',E12.3,' RADI /ANS/PICOSECOND') IF(NANISO.EQ.0) WRITE(6,41) IF(NANISO.EQ.1) WRITE(6,42) IF(NANISO.EQ.2) WRITE(6,43) IF(NANISO.LT.0.OR.NANISO.GT.2) THEN WRITE(6,44) STOP ENDIF 41 FORMAT(/,' USED ISOTROPIC X-SECTIONS') 42 FORMAT(/,' USED ANISOTROPIC X-SECTIONS (CAPITELLI/LONGO) IF AVAILA /BLE') 43 FORMAT(/,' USED ANISOTROPIC X-SECTIONS (OKHRIMOVSKYY ET AL) IF AVA /ILABLE') 44 FORMAT(/,' INPUT ERROR FOR NANISO PROGRAM STOPPED') IF(ICOUNT.EQ.1) THEN WRITE(6,34) 34 FORMAT(' USED COUNTING IONISATION X-SECTIONS') ELSE WRITE(6,35) 35 FORMAT(' USE GROSS IONISATION X-SECTIONS') ENDIF IF(IMIP.EQ.0) THEN WRITE(6,91) ESTART,NDELTA,ETHRM 91 FORMAT(1(/),' INITIAL ELECTRON ENERGY =',F9.1,' EV.',/,9X,'NUMBER / OF DELTAS =',I9,/,4X,'THERMALISATION ENERGY =',F6.2,' EV.') ELSE WRITE(6,911) EMIP,NDELTA,ETHRM 911 FORMAT(1(/),' INITIAL MIP ENERGY =',D9.3,' EV.',/,9X,'NUMBER OF /MIPS =',I9,/,4X,'THERMALISATION ENERGY =',F6.2,' EV.') APRIME=0.0 EXPRIME=0.0 DO 36 J=1,NGAS EXPRIME=EXPRIME+CMINEXSC(J) 36 APRIME=APRIME+CMINIXSC(J) ASUMPRM=APRIME+EXPRIME WRITE(6,912) APRIME 912 FORMAT(1(/),' NUMBER OF PRIMARY CLUSTERS /CM =',F7.3) IF(IPEN.EQ.1) THEN WRITE(6,913) EXPRIME 913 FORMAT(' NUMBER OF PRIMARY EXCITATION CLUSTERS /CM =',F7.3) WRITE(6,914) ASUMPRM 914 FORMAT(' TOTAL NUMBER OF PRIMARY CLUSTERS /CM =',F7.3,/) ENDIF ENDIF IF(DCOS(THETA).LT.1.D-10) WRITE(6,92) IF(DCOS(THETA).EQ.1.0) WRITE(6,93) IF(DCOS(THETA).EQ.-1.0) WRITE(6,94) 92 FORMAT(2X,'DELTA ELECTRON PERPENDICULAR TO E-FIELD IN X-Y PLANE') 93 FORMAT(2X,'DELTA ELECTRON ALONG Z-AXIS IN E-FIELD DIRECTION') 94 FORMAT(2X,'DELTA ELECTRON ALONG Z-AXIS OPPOSITE TO E-FIELD DIRECTI /ON') WRITE(6,96) TCFMAX1 96 FORMAT(/,2X,'NULL COLLISION FREQUENCY =',D10.3,' *(10**12/SEC)',/) WRITE(6,111) (TCF(L),L=500,9500,1000) 111 FORMAT(2X,'REAL COLLISION FREQUENCY AT 10 EQUALLY SPACED ENERGY IN /TERVALS (*10**12/SEC)',/,2(5(3X,D10.3)/)) 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/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(10),TCFMAX1, /RSTART,EFIELD,EMIP,ETHRM,NDELTA,IMIP,IWRITE COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(20000,512),EIN(512),TCF(20000),IARRY(512), /RGAS(512),IPN(512),WPL(512),LAST,PENFRA(3,512) COMMON/OUTPT/ICOLL(30),NETOT,NPRIME,TMAX1,TIME(300),NNULL, /NITOT,ICOLN(512),NREAL,NEXCTOT COMMON/FANO/AFAN1,AFAN2,AFAN3,AFAN4,ASKEW,AKURT,AFAN1EXC,AFAN2EXC, /AFAN3EXC,AFAN4EXC,ASKEWEXC,AKURTEXC,AFAN1TOT,AFAN2TOT,AFAN3TOT, /AFAN4TOT,ASKEWTOT,AKURTTOT,FUDGE COMMON/RNGE/XBAR,YBAR,ZBAR,TBAR,XYBAR,XYZBAR,DXBAR,DYBAR,DZBAR, /DTBAR,DXYBAR,DXYZBAR,XMAX,YMAX,ZMAX,XYMAX,RMAX,SUMTT,XNEG1,YNEG1, /ZNEG1,FARXBAR,FARYBAR,FARZBAR,FARXYBAR,RMAXBAR,EBAR,EBAR2 COMMON/PLOT/NXPL10(31),NYPL10(31),NZPL10(31),NXPL40(31), /NYPL40(31),NZPL40(31),NXPL100(31),NYPL100(31),NZPL100(31), /NXPL400(31),NYPL400(31),NZPL400(31),NXPL1000(31),NYPL1000(31), /NZPL1000(31),NXPL2(31),NYPL2(31),NZPL2(31),NXPL4000(31), /NYPL4000(31),NZPL4000(31),NXPL10000(31),NYPL10000(31), /NZPL10000(31),NXPL40000(31),NYPL40000(31),NZPL40000(31), /NXPL100000(31),NYPL100000(31),NZPL100000(31),NEPL1(100), /NEPL10(100),NEPL100(100),MELEC(300),MELEC10(300) COMMON/NAMES/NAMEG(6) COMMON/SCRIP/DSCRPT(512) DIMENSION BIN100000(31) DIMENSION BIN2(31),BIN4000(31),BIN10000(31),BIN40000(31) DIMENSION BIN10(31),BIN40(31),BIN100(31),BIN400(31),BIN1000(31) CHARACTER*30 DSCRPT CHARACTER*15 NAMEG DIMENSION FREQEL(6),FREQSP(6),FREINE(6),FREATT(6),FREION(6) WRITE(6,15) WRITE(6,15) 15 FORMAT('---------------------------------------------------------- /-------------------') WRITE(6,100) TMAX1,NNULL,NREAL 100 FORMAT(/,2X,'CALCULATED MAX. COLLISION TIME =',F7.1,' PICOSECONDS. /',/,2X,'NO.OF NULL COLLISIONS =',I12,/,2X,'NO.OF REAL COLLISIONS = /',I12,/) WRITE(6,101) NPRIME,NITOT,NETOT 101 FORMAT(2X,'NUMBER OF PRIMARIES =',I10,/,2X,'NUMBER OF NEGATIVE ION /S =',I8,/,2X,'TOTAL OF PRIMARIES AND SECONDARIES =',I12) C C CALCULATE STATISTICAL ERROR ON NETOT AND EV/ION PAIR C WRITE(6,702) EBAR,EBAR2 702 FORMAT(' AVERAGE DELTA ENERGY =',F12.3,' EV.',/,' AVERAGE DELTA /ENERGY WITHOUT CUT =',F12.3,' EV.') IF(IMIP.EQ.1) GO TO 110 ERFRAC1=DSQRT(DFLOAT(NETOT))/DFLOAT(NETOT) ERFRAC2=DSQRT(DFLOAT(NEXCTOT))/DFLOAT(NEXCTOT) NEXCT1=DINT(DFLOAT(NEXCTOT)*FUDGE) ERFRAC3=DSQRT(DFLOAT(NEXCT1+NETOT))/DFLOAT(NEXCT1+NETOT) DAFAN1=AFAN1*ERFRAC1 DAFAN1EXC=AFAN1EXC*ERFRAC2 DAFAN1TOT=AFAN1TOT*ERFRAC3 C FAN1=ESTART/AFAN1 FAN1=EBAR/AFAN1 FAN1EXC=EBAR/AFAN1EXC FAN1TOT=EBAR/AFAN1TOT DFAN1=FAN1*ERFRAC1 DFAN1EXC=FAN1EXC*ERFRAC2 DFAN1TOT=FAN1TOT*ERFRAC3 FAN2=AFAN2*AFAN2/AFAN1 FAN2EXC=AFAN2EXC*AFAN2EXC/AFAN1EXC FAN2TOT=AFAN2TOT*AFAN2TOT/AFAN1TOT C ION OUT WRITE(6,102) AFAN1,DAFAN1 WRITE(6,103) FAN1,DFAN1,FAN2 WRITE(6,104) AFAN3,ASKEW,AFAN4,AKURT 102 FORMAT(/,2X,'NUMBER OF ION PAIRS PER CLUSTER =',F10.4,' +- ',F7.4) 103 FORMAT(/,2X,'FANO1, ENERGY PER ION PAIR =',F8.4,'+-',F6.4,' EV.',/ /,2X,'FANO2, FLUCTUATION WIDTH = ',F7.4,/) 104 FORMAT(2X,'HIGHER FANO FACTORS :',/,2X,'FANO3 =',D11.3,6X,'SKEW =' /,D11.3,/,2X,'FANO4 =',D11.3,2X,'KURTOSIS =',D11.3) C EXC OUT WRITE(6,105) AFAN1EXC,DAFAN1EXC WRITE(6,106) FAN1EXC,DFAN1EXC,FAN2EXC WRITE(6,107) AFAN3EXC,ASKEWEXC,AFAN4EXC,AKURTEXC 105 FORMAT(/,2X,'NUMBER OF EXCITATIONS / CLUSTER =',F10.4,' +- ',F7.4) 106 FORMAT(/,2X,'FANO1, ENERGY PER EXCITATION =',F8.4,'+-',F6.4,' EV.' /,/,2X,'FANO2, FLUCTUATION WIDTH = ',F7.4,/) 107 FORMAT(2X,'HIGHER FANO FACTORS :',/,2X,'FANO3 =',D11.3,6X,'SKEW =' /,D11.3,/,2X,'FANO4 =',D11.3,2X,'KURTOSIS =',D11.3) C COMBINED EXC AND ION OUT WRITE(6,108) AFAN1TOT,DAFAN1TOT WRITE(6,109) FAN1TOT,DFAN1TOT,FAN2TOT WRITE(6,1011) AFAN3TOT,ASKEWTOT,AFAN4TOT,AKURTTOT 108 FORMAT(/,2X,'NUMBER OF (EXCS + IONS)/CLUSTER =',F10.4,' +- ',F7.4) 109 FORMAT(/,2X,'FANO1, ENERGY PER EXC+ION =',F8.4,'+-',F6.4,' EV.' /,/,2X,'FANO2, FLUCTUATION WIDTH = ',F7.4,/) 1011 FORMAT(2X,'HIGHER FANO FACTORS :',/,2X,'FANO3 =',D11.3,6X,'SKEW =' /,D11.3,/,2X,'FANO4 =',D11.3,2X,'KURTOSIS =',D11.3) C 110 WRITE(6,15) WRITE(6,15) WRITE(6,112) NDELTA 112 FORMAT(/,' RANGE PARAMETERS FROM AVERAGES OVER ',I7,' DELTAS IN MI /CRONS AND PICOSECONDS') WRITE(6,15) WRITE(6,113) XBAR,DXBAR,XNEG1 113 FORMAT(' XBAR =',F8.1,4X,' XWIDTH =',F8.1,' NEGATIVE FRAC =',F /7.4) WRITE(6,114) YBAR,DYBAR,YNEG1 114 FORMAT(' YBAR =',F8.1,4X,' YWIDTH =',F8.1,' NEGATIVE FRAC =',F /7.4) WRITE(6,115) ZBAR,DZBAR,ZNEG1 115 FORMAT(' ZBAR =',F8.1,4X,' ZWIDTH =',F8.1,' NEGATIVE FRAC =',F /7.4) WRITE(6,116) XYBAR,DXYBAR 116 FORMAT(' XYBAR =',F8.1,4X,' XYWIDTH =',F8.1) WRITE(6,117) XYZBAR,DXYZBAR 117 FORMAT(' XYZBAR =',F8.1,4X,' XYZWIDTH =',F8.1) WRITE(6,118) TBAR,DTBAR 118 FORMAT(' THERMALISATION TIME =',D10.3,' TIME SPREAD =',D10.3) WRITE(6,15) WRITE(6,119) NDELTA 119 FORMAT(' MAXIMUM ELECTRON RANGE AVERAGED OVER ',I7,' DELTAS') WRITE(6,120) FARXBAR,FARYBAR,FARZBAR,FARXYBAR,RMAXBAR 120 FORMAT(' AV.MAX. RANGE IN X =',F9.1,/,' AV.MAX. RANGE IN Y =',F9 /.1,/,' AV.MAX. RANGE IN Z =',F9.1,/,' AV.MAX. RANGE IN XY =',F9.1 /,/,' AV.MAX. RANGE IN XYZ=',F9.1) WRITE(6,15) WRITE(6,121) NDELTA 121 FORMAT(' MAXIMUM ELECTRON RANGE FOUND IN TOTAL SAMPLE OF ',I7,' DE /LTAS') WRITE(6,122) XMAX,YMAX,ZMAX,XYMAX,RMAX 122 FORMAT(' MAX. RANGE IN X =',F9.1,/,' MAX. RANGE IN Y / =',F9.1,/,' MAX. RANGE IN Z =',F9.1,/,' MAX. RANGE IN XY P /LANE =',F9.1,/,' MAX. RANGE IN XYZ =',F9.1) C CALCULATE PLOT AXIS AND OUTPUT PLOTS IN X Y AND Z WRITE(6,15) BIN2(1)=-30.0 BIN10(1)=-150.0 BIN40(1)=-600.0 BIN100(1)=-1500.0 BIN400(1)=-6000.0 BIN1000(1)=-15000.0 BIN4000(1)=-60000.0 BIN10000(1)=-150000.0 BIN40000(1)=-600000.0 BIN100000(1)=-1500000.0 DO 1221 K=2,31 BIN2(K)=BIN2(K-1)+2.0 BIN10(K)=BIN10(K-1)+10.0 BIN40(K)=BIN40(K-1)+40.0 BIN100(K)=BIN100(K-1)+100.0 BIN400(K)=BIN400(K-1)+400.0 BIN1000(K)=BIN1000(K-1)+1000.0 BIN4000(K)=BIN4000(K-1)+4000.0 BIN10000(K)=BIN10000(K-1)+10000.0 BIN40000(K)=BIN40000(K-1)+40000.0 1221 BIN100000(K)=BIN100000(K-1)+100000.0 M=NDELTA IPLOT=0 124 FORMAT(F10.1,3I10) WRITE(6,1222) 1222 FORMAT(' NOTE FIRST AND LAST BINS CONTAIN OVER/UNDER FLOWS') IF(NXPL2(31).GT.M.OR.NYPL2(31).GT.M.OR.NZPL2(31).GT.M) GO TO 1 IPLOT=IPLOT+1 WRITE(6,123) 123 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 2 MICRON BINS',/,' POSIT /ION X Y Z',/) WRITE(6,124) (BIN2(K),NXPL2(K),NYPL2(K),NZPL2(K), K=1,31) WRITE(6,15) 1 IF(NXPL10(31).GT.M.OR.NYPL10(31).GT.M.OR.NZPL10(31).GT.M) GO TO 2 IPLOT=IPLOT+1 WRITE(6,125) 125 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 10 MICRON BINS',/,' POSIT /ION X Y Z',/) WRITE(6,124) (BIN10(K),NXPL10(K),NYPL10(K),NZPL10(K), K=1,31) WRITE(6,15) 2 IF(NXPL40(31).GT.M.OR.NYPL40(31).GT.M.OR.NZPL40(31).GT.M) GO TO 3 IPLOT=IPLOT+1 IF(IPLOT.GT.4) GO TO 10 WRITE(6,126) 126 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 40 MICRON BINS',/,' POSIT /ION X Y Z',/) WRITE(6,124) (BIN40(K),NXPL40(K),NYPL40(K),NZPL40(K), K=1,31) WRITE(6,15) 3 IF(NXPL100(31).GT.M.OR.NYPL100(31).GT.M.OR.NZPL100(31).GT.M) GO TO / 4 IPLOT=IPLOT+1 IF(IPLOT.GT.4) GO TO 10 WRITE(6,127) 127 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 100 MICRON BINS',/,' POSI /TION X Y Z',/) WRITE(6,124) (BIN100(K),NXPL100(K),NYPL100(K),NZPL100(K), K=1,31) WRITE(6,15) 4 IF(NXPL400(31).GT.M.OR.NYPL400(31).GT.M.OR.NZPL400(31).GT.M) GO TO / 5 IPLOT=IPLOT+1 IF(IPLOT.GT.4) GO TO 10 WRITE(6,128) 128 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 400 MICRON BINS',/,' POSI /TION X Y Z',/) WRITE(6,124) (BIN400(K),NXPL400(K),NYPL400(K),NZPL400(K), K=1,31) WRITE(6,15) 5 IF(NXPL1000(31).GT.M.OR.NYPL1000(31).GT.M.OR.NZPL1000(31).GT.M) GO / TO 6 IPLOT=IPLOT+1 IF(IPLOT.GT.4) GO TO 10 WRITE(6,129) 129 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 1000 MICRON BINS',/,' POS /ITION X Y Z',/) WRITE(6,124) (BIN1000(K),NXPL1000(K),NYPL1000(K),NZPL1000(K), K=1, /31) WRITE(6,15) 6 IF(NXPL4000(31).GT.M.OR.NYPL4000(31).GT.M.OR.NZPL4000(31).GT.M) GO / TO 7 IPLOT=IPLOT+1 IF(IPLOT.GT.3) GO TO 10 WRITE(6,130) 130 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 4000 MICRON BINS',/,' POS /ITION X Y Z',/) WRITE(6,124) (BIN4000(K),NXPL4000(K),NYPL4000(K),NZPL4000(K), K=1, /31) WRITE(6,15) 7 IF(NXPL10000(31).GT.M.OR.NYPL10000(31).GT.M.OR.NZPL10000(31).GT.M) / GO TO 8 IPLOT=IPLOT+1 IF(IPLOT.GT.3) GO TO 10 WRITE(6,131) 131 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 10000 MICRON BINS',/,' PO /SITION X Y Z',/) WRITE(6,124) (BIN10000(K),NXPL10000(K),NYPL10000(K),NZPL10000(K), /K=1,31) WRITE(6,15) 8 IF(NXPL40000(31).GT.M.OR.NYPL40000(31).GT.M.OR.NZPL40000(31).GT.M) / GO TO 9 IPLOT=IPLOT+1 IF(IPLOT.GT.3) GO TO 10 WRITE(6,132) 132 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 40000 MICRON BINS',/,' PO /SITION X Y Z',/) WRITE(6,124) (BIN40000(K),NXPL40000(K),NYPL40000(K),NZPL40000(K), / K=1,31) WRITE(6,15) 9 CONTINUE IPLOT=IPLOT+1 IF(IPLOT.GT.3) GO TO 10 WRITE(6,133) 133 FORMAT(' DISTRIBUTION IN X,Y AND Z FOR 100000 MICRON BINS',/,' P /OSITION X Y Z',/) WRITE(6,124) (BIN100000(K),NXPL100000(K),NYPL100000(K), /NZPL100000(K), K=1,31) WRITE(6,15) 10 CONTINUE IF(IMIP.EQ.0) GO TO 137 WRITE(6,134) (NEPL1(K), K=1,100) 134 FORMAT(' DISTRIBUTION IN ELECTRON ENERGY IN 1 EV BINS',/,100(I10 /,/)) WRITE(6,135) (NEPL10(K), K=1,100) 135 FORMAT(' DISTRIBUTION IN ELECTRON ENERGY IN 10 EV BINS',/,100(I10 /,/)) WRITE(6,136) (NEPL100(K), K=1,100) 136 FORMAT(' DISTRIBUTION IN ELECTRON ENERGY IN 100 EV BINS',/,100(I10 /,/)) 137 NHIGH=NDELTA-200 IF(IMIP.EQ.0.AND.MELEC(300).GT.NHIGH) GO TO 141 WRITE(6,138) (MELEC(K), K=1,300) 138 FORMAT(' DISTRIBUTION IN CLUSTER SIZE IN UNIT BINS',/,300(I10,/)) C NOVFL=0 DO 139 K=21,300 139 NOVFL=NOVFL+MELEC(K) WRITE(6,140) NOVFL 140 FORMAT(' NO OF CLUSTERS GT 20 =',I6) GO TO 143 141 WRITE(6,142) (MELEC10(K), K=1,300) 142 FORMAT(' DISTRIBUTION IN CLUSTER SIZE IN BINS OF 10',/,300(I10,/)) 143 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) ANDELTA=DFLOAT(NDELTA) ERRNDEL=DSQRT(ANDELTA)/ANDELTA FRTOND=DFLOAT(NREAL)/ANDELTA FRINOND=DFLOAT(NINEL)/ANDELTA FRELOND=DFLOAT(NELA)/ANDELTA WRITE(6,221) FRTOND,FRINOND,FRELOND 221 FORMAT(/,7X,'NUMBER OF COLLISIONS PER DELTA =',F10.2,/,2X,'NUMBER /OF INELASTIC COLL. PER DELTA =',F10.2,/,4X,'NUMBER OF ELASTIC COLL /. PER DELTA =',F10.2) C WRITE(6,15) C ILAST=INT(TMAX1)+1 C IF(ILAST.GT.300) ILAST=300 C WRITE(6,1010) (TIME(I),I=1,ILAST) C1010 FORMAT(/,6X,'DISTRIBUTION OF COLLISION TIMES IN 1 PECOSECOND BINS' C /,2(/),30(1X,10E10.3/)) WRITE(6,15) DO 1020 I=1,NGAS FREQEL(I)=DFLOAT(ICOLL((5*I)-4))/ANDELTA FREQSP(I)=DFLOAT(ICOLL(5*I))/ANDELTA FREINE(I)=DFLOAT(ICOLL((5*I)-1))/ANDELTA FREATT(I)=DFLOAT(ICOLL((5*I)-2))/ANDELTA FREION(I)=DFLOAT(ICOLL((5*I)-3))/ANDELTA 1020 CONTINUE WRITE(6,1050) (NAMEG(I),FREQEL(I),FREQSP(I),FREINE(I),FREATT(I), /FREION(I),I=1,NGAS) 1050 FORMAT(/,5X,'COLLISIONS PER DELTA SORTED ACCORDING TO GAS AND TYPE / OF COLLISION',2(/),3X,'GASES USED ELASTIC SUPERELAS INE /LASTIC ATTACHMENT IONISATION ',2(/),6(1X,A15,1X,5(F10.2,2X),/)) WRITE(6,15) WRITE(6,1060) 1060 FORMAT(/,2X,'NUMBER OF COLLISIONS PER DELTA FOR EACH GAS :',2(/)) DO 1100 J=1,NGAS WRITE(6,1065) NAMEG(J) 1065 FORMAT(/,3X,A15,/,'------------------',/) DO 1090 K=1,LAST IF(IARRY(K).LE.(5*J).AND.IARRY(K).GT.(5*(J-1))) THEN ACLL=DFLOAT(ICOLN(K)) FRELV=ACLL/ANDELTA IF(ICOLN(K).EQ.0) THEN ERRFRE=0.0 ELSE ERRFR=100.0*DSQRT(ACLL)/ACLL ERRAN=100.0*DSQRT(ANDELTA)/ANDELTA ERRFRE=DSQRT(ERRFR*ERRFR+ERRAN*ERRAN) ENDIF WRITE(6,1070) DSCRPT(K),FRELV,ERRFRE 1070 FORMAT(3X,A30,3X,F11.2,' +-',F8.2,' %') ENDIF 1090 CONTINUE 1100 CONTINUE RETURN END SUBROUTINE MONTEFE 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(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/LARGE/CF(20000,512),EIN(512),TCF(20000),IARRY(512), /RGAS(512),IPN(512),WPL(512),IPLAST,PENFRA(3,512) COMMON/OUTPT/ICOLL(30),NETOT,NPRIME,TMAX1,TIME(300),NNULL, /NITOT,ICOLN(512),NREAL,NEXCTOT COMMON/STTS/XST(50000),YST(50000),ZST(50000),TST(50000), /TTIME(50000),NELEC,NEGION,EST1,EST2 COMMON/STEXC/XSTEXC(50000),YSTEXC(50000),ZSTEXC(50000), /TSTEXC(50000),NSTEXC COMMON/IONC/DOUBLE(6,20000),CMINIXSC(6),CMINEXSC(6),ECLOSS(6), /WPLN(6),ICOUNT,AVPFRAC(3,6) COMMON/ANIS/PSCT(20000,512),ANGCT(20000,512),INDEX(512),NISO DIMENSION XS(50000),YS(50000),ZS(50000),TS(50000),ES(50000), /DCX(50000),DCY(50000),DCZ(50000),ESTORE(2) DIMENSION ETEMP(1000) C ---------------------------------------------------------------------- C ELECTRIC FIELD ALONG Z AXIS. NO MAGNETIC FIELD. C TRACKS DELTA ELECTRONS AND UPDATES ARRAYS CONTAINING POSITION AND C TIME OF THERMALISED ELECTRONS. C CALCULATES NUMBER OF PRODUCED ELECTRONS PER PRIMARY AND OTHER C HIGHER FANO FACTORS. C RANGE IS ACCURATE ONLY FOR ANISOTROPIC X-SECTIONS C ---------------------------------------------------------------------- NPRINT=0 J20000=20000 J300=300 API=DACOS(-1.0D0) SMALL=1.0D-20 TMAX1=0.0D0 EMAX=0.0D0 RDUM=RSTART 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 NREAL=0 NNULL=0 NETOT=0 NEXCTOT=0 NITOT=0 NMXADD=0 BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*API THETA1=THETA PHI1=PHI TLIM=TCFMAX1 NEOVFL=0 IF(IMIP.EQ.0) GO TO 31 C CALCULATE PROBABILITY FOR PRIMARY MIP INTERACTION WITH EACH GAS ASUM=0.0 EXSUM=0.0 DO 28 JDUM=1,NGAS EXSUM=EXSUM+CMINEXSC(JDUM) 28 ASUM=ASUM+CMINIXSC(JDUM) ASUM=ASUM+EXSUM DO 29 JDUM=1,NGAS CMINEXSC(JDUM)=CMINEXSC(JDUM)/ASUM 29 CMINIXSC(JDUM)=CMINIXSC(JDUM)/ASUM IF(NGAS.EQ.1) GO TO 31 DO 30 JDUM=2,NGAS CMINEXSC(JDUM)=CMINEXSC(JDUM)+CMINEXSC(JDUM-1) 30 CMINIXSC(JDUM)=CMINIXSC(JDUM)+CMINIXSC(JDUM-1) 31 CONTINUE C START OF PRIMARY DELTA LOOP DO 210 J1=1,NDELTA IF(IMIP.EQ.0) GO TO 33 C FIND WHICH GAS WAS HIT 311 R9=drand48(RDUM) DO 32 K=1,NGAS I=K IF(CMINIXSC(K).GE.R9) GO TO 33 32 CONTINUE IF(IPEN.EQ.0) GO TO 311 C POSSIBLE PENNING PROCESS C FIND WHICH GAS WAS EXCITED R9=R9-CMINIXSC(NGAS) DO 321 K=1,NGAS I=K IF(CMINEXSC(K).GE.R9) GO TO 322 321 CONTINUE 322 IF(AVPFRAC(1,I).EQ.0.0) GO TO 311 RAN=drand48(RDUM) IF(RAN.GT.AVPFRAC(1,I)) GO TO 311 C EXCITATION (PENNING TRANSFER) TO IONISATION FROM PRIMARY MIP NELEC=1 NETOT=NETOT+1 NEGION=0 C ENTER HERE POSSIBLE DELOCALISATION LENGTH OF PENNING TRANSFER DELOCR=AVPFRAC(2,I) DELOCT=AVPFRAC(3,I) IF(DELOCR.EQ.0.0) THEN XST(1)=0.0 YST(1)=0.0 ZST(1)=0.0 TST(1)=0.0 GO TO 323 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZST(1)=-DLOG(RAN)*DELCOR*ASIGN RAN=drand48(RDUM) TST(1)=-DLOG(RAN)*DELOCT 323 TTIME(1)=TST(1) EST1=12.0 EST2=12.0 CALL STATS(J1) GO TO 210 33 CONTINUE NPRIME=J1 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA1) IF(THETA1.EQ.(API/2.0)) THEN C IF DELTA IN XY PLANE RANDOMISE DIRECTION IN XY PLANE) R1=drand48(RDUM) PHI1=F4*R1 ENDIF DCX1=DSIN(THETA1)*DCOS(PHI1) DCY1=DSIN(THETA1)*DSIN(PHI1) IF(IMIP.EQ.0) GO TO 34 C PICK ESTART FROM OPAL BEATY E=EMIP EI=ECLOSS(I) R9=drand48(RDUM) ESTART=WPLN(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPLN(I)))) ESTART=WPLN(I)*(ESTART/WPLN(I))**0.9524 EST2=ESTART IF(ESTART.GT.10000.) THEN NEOVFL=NEOVFL+1 C WRITE(6,829) ESTART C 829 FORMAT('ESTART OVERFLOW =',D12.3) ESTART=9999.0 ENDIF 34 EST1=ESTART E1=ESTART C WRITE(6,876) DCZ1,DCX1,DCY1 C 876 FORMAT(' DCZ1=',D12.3,' DCX1=',D12.3,' DCY1=',D12.3) X=0.0D0 Y=0.0D0 Z=0.0D0 K1=0 KEXC=0 NSTEXC=0 NCLUS=0 NELEC=0 NEGION=0 TLAST=0.0D0 ST=0.0D0 TDASH=0.0D0 C START OF LOOP FOR NEWLY CREATED ELECTRONS 1 CONTINUE R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) 913 FORMAT(3X,' AFTER STORE NREAL=',I10,' E1=',E12.3,' T=',E12.3,' AP= /',E12.3,' BP=',E12.3,' DCZ1=',E12.3) E=E1+(AP+BP*T)*T IF(E.LT.0.0D0) THEN C IF(NPRINT.EQ.0) WRITE(6,913)NREAL,E1,T,AP,BP,DCZ1 C NPRINT=1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=DMIN0(IE,J20000) 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 137 T2=T*T IF(E.GT.EMAX) EMAX=E IF(T.GT.TMAX1) TMAX1=T TDASH=0.0D0 NREAL=NREAL+1 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 X=X+DCX1*A Y=Y+DCY1*A Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0D0) IT=DMIN0(IT,J300) TIME(IT)=TIME(IT)+1.0D0 C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) I=0 140 I=I+1 IF(CF(IE,I).LT.R2) GO TO 140 S1=RGAS(I) EI=EIN(I) IF(E.LT.EI) THEN EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 C ATTACHMENT IF(IPN(I).EQ.-1) THEN NETOT=NETOT+1 NITOT=NITOT+1 NELEC=NELEC+1 NEGION=NEGION+1 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=DMIN0(IT,J300) TIME(IT)=TIME(IT)+1.0D0 GO TO 335 ENDIF C USE COUNTING OR GROSS IONISATION ION2=1 IF(ICOUNT.EQ.1) THEN c FIND PROB OF DOUBLE IONISATION JD2=(IARRY(I)+3)/5 PROB2=DOUBLE(JD2,IE) C WRITE(6,998) PROB2,JD2,IE 998 FORMAT(' PROB2=',D12.3,' JD2=',I5,' IE=',I6) R9=drand48(RDUM) IF(R9.LT.PROB2) THEN ION2=2 EI=2.0*EI ENDIF ENDIF C DO 547 JDUM=1,ION2 R9=drand48(RDUM) 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 SECONDARY IONISATION ELECTRONS IF(ION2.EQ.2) THEN R9=drand48(RDUM) ESTORE(1)=ESEC*R9 ESTORE(2)=ESEC-ESTORE(1) ELSE ESTORE(1)=ESEC ENDIF DO 547 JDUM=1,ION2 NCLUS=NCLUS+1 NMXADD=MAX(NCLUS,NMXADD) IF(NCLUS.GT.50000) THEN WRITE(6,546) NCLUS,NREAL 546 FORMAT(2X,' PROGRAM STOPPED . NCLUS=',I7,' NREAL=',I10) STOP ENDIF XS(NCLUS)=X YS(NCLUS)=Y ZS(NCLUS)=Z TS(NCLUS)=ST ES(NCLUS)=ESTORE(JDUM) C ES(NCLUS)=ESEC C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0-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(NCLUS)=F9*F5 DCY(NCLUS)=F8*F5 DCZ(NCLUS)=F6 547 CONTINUE 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 C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I),OF TRANSFER TO GIVE 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 NCLUS=NCLUS+1 C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XS(NCLUS)=X YS(NCLUS)=Y ZS(NCLUS)=Z GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XS(NCLUS)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YS(NCLUS)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZS(NCLUS)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN 667 RAN=drand48(RDUM) TS(NCLUS)=ST-DLOG(RAN)*PENFRA(3,I) C ASSIGN EXCESS ENERGY OF 1EV TO PENNING CREATED ELECTRON ES(NCLUS)=1.0 DCX(NCLUS)=DCX1 DCY(NCLUS)=DCY1 DCZ(NCLUS)=DCZ1 ENDIF GO TO 6 C CALCULATE SUM OF EXCITATION PER CLUSTER AND STORE EXCITATION X Y Z T 5 IF(IPN(I).EQ.0) THEN IF((RGAS(I)*EIN(I)).GT.8.0) THEN KEXC=KEXC+1 NEXCTOT=NEXCTOT+1 NSTEXC=NSTEXC+1 XSTEXC(KEXC)=X YSTEXC(KEXC)=Y ZSTEXC(KEXC)=Z TSTEXC(KEXC)=ST ENDIF ENDIF 6 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 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 TEST IF ELECTRON IS THERMALISED IF(E1.GT.ETHRM) GO TO 1 C STORE POSITION AND TIME OF ELECTRON K1=K1+1 XST(K1)=X YST(K1)=Y ZST(K1)=Z TST(K1)=ST TTIME(K1)=ST-TLAST NELEC=NELEC+1 NETOT=NETOT+1 335 IF(K1.EQ.50000) GO TO 888 C CATCH SINGLE ELECTRON CLUSTER THAT WAS ATTACHED. c IF(NELEC.EQ.1.AND.NCLUS.EQ.0) GO TO 210 C IF(NELEC.EQ.(NCLUS+1)) THEN C LAST ELECTRON IN CLUSTER DO STATISTICS OVER PRIMARY CLUSTER CALL STATS(J1) GO TO 210 ENDIF C GET NEW IONISATION ELECTRON FROM STORE X=XS(NELEC) Y=YS(NELEC) Z=ZS(NELEC) ST=TS(NELEC) TLAST=TS(NELEC) E1=ES(NELEC) DCX1=DCX(NELEC) DCY1=DCY(NELEC) DCZ1=DCZ(NELEC) GO TO 1 C MAIN LOOP END 210 CONTINUE WRITE(6,887) EMAX,NEOVFL 887 FORMAT(' EMAX=',D12.7,' NEOVFL=',I5) IF(EMAX.GT.EFINAL) THEN WRITE(6,889) EFINAL,EMAX 889 FORMAT('INCREASE ENERGY LIMIT FROM',D12.6,' EV TO AT LEAST',D12.6, /' EV.') STOP ENDIF RETURN 888 NLEFT=NCLUS-NELEC WRITE(6,992) NPRIME,NLEFT,NCLUS 992 FORMAT(3(/),' WARNING STOPPED AFTER NPRIME=',I6,' LAST PRIMARY HAS /AT LEAST ',I6,' SECONDARIES LEFT TO TRACK OUT OF ',I6,' ELECTRONS /ALREADY IN CLUSTER') STOP RETURN END SUBROUTINE MONTEFA 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(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(20000,512),EIN(512),TCF(20000),IARRY(512), /RGAS(512),IPN(512),WPL(512),IPLAST,PENFRA(3,512) COMMON/OUTPT/ICOLL(30),NETOT,NPRIME,TMAX1,TIME(300),NNULL, /NITOT,ICOLN(512),NREAL,NEXCTOT COMMON/STTS/XST(50000),YST(50000),ZST(50000),TST(50000), /TTIME(50000),NELEC,NEGION,EST1,EST2 COMMON/STEXC/XSTEXC(50000),YSTEXC(50000),ZSTEXC(50000), /TSTEXC(50000),NSTEXC COMMON/IONC/DOUBLE(6,20000),CMINIXSC(6),CMINEXSC(6),ECLOSS(6), /WPLN(6),ICOUNT,AVPFRAC(3,6) COMMON/ANIS/PSCT(20000,512),ANGCT(20000,512),INDEX(512),NISO DIMENSION XS(50000),YS(50000),ZS(50000),TS(50000),ES(50000), /DCX(50000),DCY(50000),DCZ(50000),ESTORE(2) C ---------------------------------------------------------------------- C ELECTRIC AND MAGNETIC FIELDS PARALLEL TO Z-AXIS C TRACKS DELTA ELECTRONS AND UPDATES ARRAYS CONTAINING POSITION AND C TIME OF THERMALISED ELECTRONS. C CALCULATES NUMBER OF PRODUCED ELECTRONS PER PRIMARY DELTA AND OTHER C HIGHER FANO FACTORS C RANGE CALCULATION IS ACCURATE ONLY FOR ANISOTROPIC X-SECTIONS. C ---------------------------------------------------------------------- NPRINT=0 J300=300 J20000=20000 API=DACOS(-1.0D0) SMALL=1.0D-20 EMAX=0.0D0 TMAX1=0.0D0 RDUM=RSTART 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 NREAL=0 NNULL=0 NETOT=0 NEXCTOT=0 NITOT=0 NMXADD=0 BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*API TLIM=TCFMAX1 THETA1=THETA PHI1=PHI NEOVFL=0 IF(IMIP.EQ.0) GO TO 31 C CALC PROBABILITY FOR PRIMARY MIP INTERACTION WITH EACH GAS ASUM=0.0 EXSUM=0.0 DO 28 JDUM=1,NGAS EXSUM=EXSUM+CMINEXSC(JDUM) 28 ASUM=ASUM+CMINIXSC(JDUM) ASUM=ASUM+EXSUM DO 29 JDUM=1,NGAS CMINEXSC(JDUM)=CMINEXSC(JDUM)/ASUM 29 CMINIXSC(JDUM)=CMINIXSC(JDUM)/ASUM IF(NGAS.EQ.1) GO TO 31 DO 30 JDUM=2,NGAS CMINEXSC(JDUM)=CMINEXSC(JDUM)+CMINEXSC(JDUM-1) 30 CMINIXSC(JDUM)=CMINIXSC(JDUM)+CMINIXSC(JDUM-1) 31 CONTINUE C START OF PRIMARY DELTA LOOP DO 210 J1=1,NDELTA IF(IMIP.EQ.0) GO TO 33 C FIND WHICH GAS IS HIT 311 R9=drand48(RDUM) DO 32 K=1,NGAS I=K IF(CMINIXSC(K).GE.R9) GO TO 33 32 CONTINUE IF(IPEN.EQ.0) GO TO 311 C POSSIBLE PENNING PROCESS C FIND WHICH GAS WAS EXCITED R9=R9-CMINIXSC(NGAS) DO 321 K=1,NGAS I=K IF(CMINEXSC(K).GE.R9) GO TO 322 321 CONTINUE 322 IF(AVPFRAC(1,I).EQ.0.0) GO TO 311 RAN=drand48(RDUM) IF(RAN.GT.AVPFRAC(1,I)) GO TO 311 C EXCITATION (PENNING TRANSFER) TO IONISATION FROM PRIMARY MIP NELEC=1 NETOT=NETOT+1 NEGION=0 C ENTER HERE POSSIBLE DELOCALISATION LENGTH OF PENNING TRANSFER DELOCR=AVPFRAC(2,I) DELOCT=AVPFRAC(3,I) IF(DELOCR.EQ.0.0) THEN XST(1)=0.0 YST(1)=0.0 ZST(1)=0.0 TST(1)=0.0 GO TO 323 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) TST(1)=-DLOG(RAN)*DELOCT 323 TTIME(1)=TST(1) EST1=12.0 EST2=12.0 CALL STATS(J1) GO TO 210 33 CONTINUE NPRIME=J1 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA1) IF(THETA1.EQ.(API/2.0)) THEN C IF DELTA IN XY PLANE RANDOMISE DIRECTION IN XY PLANE) R1=drand48(RDUM) PHI1=F4*R1 ENDIF DCX1=DSIN(THETA1)*DCOS(PHI1) DCY1=DSIN(THETA1)*DSIN(PHI1) IF(IMIP.EQ.0) GO TO 34 C PICK ESTART FROM OPAL BEATY E=EMIP EI=ECLOSS(I) R9=drand48(RDUM) ESTART=WPLN(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPLN(I)))) ESTART=WPLN(I)*(ESTART/WPLN(I))**0.9524 EST2=ESTART IF(ESTART.GT.10000.) THEN NEOVFL=NEOVFL+1 ESTART=9999.0 ENDIF 34 EST1=ESTART C INITIAL VELOCITY E1=ESTART VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT X=0.0D0 Y=0.0D0 Z=0.0D0 K1=0 KEXC=0 NSTEXC=0 NCLUS=0 NELEC=0 NEGION=0 TLAST=0.0D0 ST=0.0D0 TDASH=0.0D0 C START OF LOOP FOR NEWLY CREATED ELECTRONS 1 CONTINUE R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) 913 FORMAT(3X,' AFTER STORE NREAL=',I10,' E1=',E12.3,' T=',E12.3,' AP= /',E12.3,' BP=',E12.3,' DCZ1=',E12.3) E=E1+(AP+BP*T)*T IF(E.LT.0.0D0) THEN C IF(NPRINT.EQ.0) WRITE(6,913)NREAL,E1,T,AP,BP,DCZ1 C NPRINT=1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=DMIN0(IE,J20000) 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 137 T2=T*T IF(E.GT.EMAX) EMAX=E IF(T.GT.TMAX1) TMAX1=T TDASH=0.0D0 NREAL=NREAL+1 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 DX=(CX1*SINWT-CY1*(1.0D0-COSWT))/WB X=X+DX DY=(CY1*SINWT+CX1*(1.0D0-COSWT))/WB Y=Y+DY Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0D0) IT=DMIN0(IT,J300) TIME(IT)=TIME(IT)+1.0D0 C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) I=0 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,NREAL C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT NREAL =',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 NETOT=NETOT+1 NITOT=NITOT+1 NELEC=NELEC+1 NEGION=NEGION+1 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=DMIN0(IT,J300) TIME(IT)=TIME(IT)+1.0D0 GO TO 335 ENDIF C USE COUNTING OR GROSS IONISATION ION2=1 IF(ICOUNT.EQ.1) THEN C FIND PROB OF DOUBLE IONISATION JD2=(IARRY(I)+3)/5 PROB2=DOUBLE(JD2,IE) R9=drand48(RDUM) IF(R9.LT.PROB2) THEN ION2=2 EI=2.0*EI ENDIF ENDIF R9=drand48(RDUM) 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 SECONDARY IONISATION ELECTRON IF(ION2.EQ.2) THEN R9=drand48(RDUM) ESTORE(1)=ESEC*R9 ESTORE(2)=ESEC-ESTORE(1) ELSE ESTORE(1)=ESEC ENDIF DO 547 JDUM=1,ION2 NCLUS=NCLUS+1 NMXADD=MAX(NCLUS,NMXADD) IF(NCLUS.GT.50000) THEN WRITE(6,546) NCLUS,NREAL 546 FORMAT(2X,' PROGRAM STOPPED . NCLUS=',I7,' NREAL =',I10) STOP ENDIF XS(NCLUS)=X YS(NCLUS)=Y ZS(NCLUS)=Z TS(NCLUS)=ST ES(NCLUS)=ESTORE(JDUM) C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0-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(NCLUS)=F9*F5 DCY(NCLUS)=F8*F5 DCZ(NCLUS)=F6 547 CONTINUE 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 C IF EXCITATION THEN ADD PROBABILITY,PENFRA(1,I), OF TRANSFER TO GIVE 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 NCLUS=NCLUS+1 C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XS(NCLUS)=X YS(NCLUS)=Y ZS(NCLUS)=Z GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XS(NCLUS)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YS(NCLUS)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZS(NCLUS)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN 667 RAN=drand48(RDUM) TS(NCLUS)=ST-DLOG(RAN)*PENFRA(3,I) C ASSIGN EXCESS ENERGY OF 1EV TO PENNING CREATED ELECTRON ES(NCLUS)=1.0 DCX(NCLUS)=DCX1 DCY(NCLUS)=DCY1 DCZ(NCLUS)=DCZ1 ENDIF GO TO 6 C CALCULATE SUM OF EXCITATION PER CLUSTER AND STORE EXCITATION X Y Z T 5 IF(IPN(I).EQ.0) THEN IF((RGAS(I)*EIN(I)).GT.8.0) THEN KEXC=KEXC+1 NEXCTOT=NEXCTOT+1 NSTEXC=NSTEXC+1 XSTEXC(KEXC)=X YSTEXC(KEXC)=Y ZSTEXC(KEXC)=Z TSTEXC(KEXC)=ST ENDIF ENDIF 6 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 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 TEST IF ELECTRON IS THERMALISED IF(E1.GT.ETHRM) GO TO 1 C STORE POSITION AND TIME OF THERMALISED ELECTRON K1=K1+1 XST(K1)=X YST(K1)=Y ZST(K1)=Z TST(K1)=ST TTIME(K1)=ST-TLAST NELEC=NELEC+1 NETOT=NETOT+1 335 IF(K1.EQ.50000) GO TO 888 IF(NELEC.EQ.(NCLUS+1)) THEN C LAST ELECTRON IN CLUSTER, DO STATISTICS ON PRIMARY CALL STATS(J1) GO TO 210 ENDIF C GET NEW IONISATION ELECTRON FROM STORE X=XS(NELEC) Y=YS(NELEC) Z=ZS(NELEC) ST=TS(NELEC) TLAST=TS(NELEC) E1=ES(NELEC) DCX1=DCX(NELEC) DCY1=DCY(NELEC) DCZ1=DCZ(NELEC) GO TO 1 C MAIN LOOP END 210 CONTINUE WRITE(6,887) EMAX,NEOVFL 887 FORMAT(' EMAX=',D12.7,' NEOVFL =',I5) IF(EMAX.GT.EFINAL) THEN WRITE(6,889) EFINAL,EMAX 889 FORMAT('INCREASE ENERGY LIMIT FROM',D12.6,' EV TO AT LEAST',D12.6, /' EV.') STOP ENDIF RETURN 888 NLEFT=NCLUS-NELEC WRITE(6,992) NPRIME,NLEFT,NCLUS 992 FORMAT(3(/),' WARNING STOPPED AFTER NPRIME=',I6,' LAST PRIMARY HAS / AT LEAST ',I6,' SECONDARIES LEFT TO TRACK, OUT OF ',I6,' ELECTRON /S ALREADY IN CLUSTER') STOP RETURN END SUBROUTINE MONTEFB 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(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(20000,512),EIN(512),TCF(20000),IARRY(512), /RGAS(512),IPN(512),WPL(512),IPLAST,PENFRA(3,512) COMMON/OUTPT/ICOLL(30),NETOT,NPRIME,TMAX1,TIME(300),NNULL, /NITOT,ICOLN(512),NREAL,NEXCTOT COMMON/STTS/XST(50000),YST(50000),ZST(50000),TST(50000), /TTIME(50000),NELEC,NEGION,EST1,EST2 COMMON/STEXC/XSTEXC(50000),YSTEXC(50000),ZSTEXC(50000), /TSTEXC(50000),NSTEXC COMMON/IONC/DOUBLE(6,20000),CMINIXSC(6),CMINEXSC(6),ECLOSS(6), /WPLN(6),ICOUNT,AVPFRAC(3,6) COMMON/ANIS/PSCT(20000,512),ANGCT(20000,512),INDEX(512),NISO DIMENSION XS(50000),YS(50000),ZS(50000),TS(50000),ES(50000), /DCX(50000),DCY(50000),DCZ(50000),ESTORE(2) C ------------------------------------------------------------------- C ELECTRIC FIELD ALONG Z-AXIS MAGNETIC FIELD ALONG X-AXIS. C TRACKS DELTA ELECTRONS AND UPDATES ARRAYS CONTAINING POSITION AND C TIME OF THERMALISED ELECTRONS. C CALCULATES NUMBER OF PRODUCED ELECTRONS PER PRIMARY DELTA AND OTHER C HIGHER FANO FACTORS . C RANGE IS ACCURATE ONLY FOR ANISOTROPIC X-SECTIONS. C ------------------------------------------------------------------- NPRINT=0 J20000=20000 J300=300 API=DACOS(-1.0D0) SMALL=1.0D-20 EMAX=0.0D0 TMAX1=0.0D0 RDUM=RSTART 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 NREAL=0 NNULL=0 NETOT=0 NEXCTOT=0 NITOT=0 NMXADD=0 THETA1=THETA PHI1=PHI F4=2.0D0*API TLIM=TCFMAX1 NEOVFL=0 IF(IMIP.EQ.0) GO TO 31 C CALCULATE PROBABILITY FOR PRIMARY MIP INTERACTION WITH EACH GAS ASUM=0.0 EXSUM=0.0 DO 28 JDUM=1,NGAS EXSUM=EXSUM+CMINEXSC(JDUM) 28 ASUM=ASUM+CMINIXSC(JDUM) ASUM=ASUM+EXSUM DO 29 JDUM=1,NGAS CMINEXSC(JDUM)=CMINEXSC(JDUM)/ASUM 29 CMINIXSC(JDUM)=CMINIXSC(JDUM)/ASUM IF(NGAS.EQ.1) GO TO 31 DO 30 JDUM=2,NGAS CMINEXSC(JDUM)=CMINEXSC(JDUM)+CMINEXSC(JDUM-1) 30 CMINIXSC(JDUM)=CMINIXSC(JDUM)+CMINIXSC(JDUM-1) 31 CONTINUE C LOOP FOR PRIMARY DELTA ELECTRONS DO 210 J1=1,NDELTA IF(IMIP.EQ.0) GO TO 33 C FIND WHICH GAS WAS HIT 311 R9=drand48(RDUM) DO 32 K=1,NGAS I=K IF(CMINIXSC(K).GE.R9) GO TO 33 32 CONTINUE IF(IPEN.EQ.0) GO TO 311 C POSSIBLE PENNING PROCESS C FIND WHICH GAS WAS EXCITED R9=R9-CMINIXSC(NGAS) DO 321 K=1,NGAS I=K IF(CMINEXSC(K).GE.R9) GO TO 322 321 CONTINUE 322 IF(AVPFRAC(1,I).EQ.0.0) GO TO 311 RAN=drand48(RDUM) IF(RAN.GT.AVPFRAC(1,I)) GO TO 311 C EXCITATION (PENNING TRANSFER) TO IONISATION FROM PRIMARY MIP NELEC=1 NETOT=NETOT+1 NEGION=0 C ENTER HERE POSSIBLE DELOCALISATION LENGTH OF PENNING TRANSFER DELOCR=AVPFRAC(2,I) DELOCT=AVPFRAC(3,I) IF(DELOCR.EQ.0.0) THEN XST(1)=0.0 YST(1)=0.0 ZST(1)=0.0 TST(1)=0.0 GO TO 323 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) TST(1)=-DLOG(RAN)*DELOCT 323 TTIME(1)=TST(1) EST1=12.0 EST2=12.0 CALL STATS(J1) GO TO 210 33 CONTINUE NPRIME=J1 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA1) IF(THETA1.EQ.(API/2.0)) THEN C IF DELTA IN XY PLANE RANDOMISE DIRECTION IN XY PLANE R1=drand48(RDUM) PHI1=F4*R1 ENDIF DCX1=DSIN(THETA1)*DCOS(PHI1) DCY1=DSIN(THETA1)*DSIN(PHI1) IF(IMIP.EQ.0) GO TO 34 C GET ESTART FROM OPAL AND BEATY E=EMIP EI=ECLOSS(I) R9=drand48(RDUM) ESTART=WPLN(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPLN(I)))) ESTART=WPLN(I)*(ESTART/WPLN(I))**0.9524 EST2=ESTART IF(ESTART.GT.10000.) THEN NEOVFL=NEOVFL+1 ESTART=9999.0 ENDIF 34 EST1=ESTART C INITIAL VELOCITY,TIME AND POSITION E1=ESTART VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT X=0.0D0 Y=0.0D0 Z=0.0D0 K1=0 KEXC=0 NSTEXC=0 NCLUS=0 NELEC=0 NEGION=0 TLAST=0.0D0 ST=0.0D0 TDASH=0.0D0 C START OF LOOP FOR NEWLY CREATED ELECTRONS 1 CONTINUE R1=drand48(RDUM) 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*EFIELD*100.0D0 913 FORMAT(3X,' AFTER STORE NREAL=',I10,' DZ=',D12.3,'E1=',D12.3,' COS /WT=',D12.3,' SINWT=',D12.3,' WBT=',D12.3,' CY1=',D12.3) IF(E.LT.0.0D0) THEN C IF(NPRINT.EQ.0) WRITE(6,913)NREAL,DZ,E1,COSWT,SINWT,WBT,CY1 C NPRINT=1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=DMIN0(IE,J20000) 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 137 T2=T*T IF(E.GT.EMAX) EMAX=E IF(T.GT.TMAX1) TMAX1=T TDASH=0.0D0 NREAL=NREAL+1 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 C CALC NEW POSITION X=X+CX1*T Y=Y+EOVB*T+((CY1-EOVB)*SINWT+CZ1*(1.0D0-COSWT))/WB Z=Z+DZ ST=ST+T IT=INT(T+1.0D0) IT=DMIN0(IT,J300) TIME(IT)=TIME(IT)+1.0D0 C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) I=0 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,NREAL C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT NREAL=',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 NETOT=NETOT+1 NITOT=NITOT+1 NELEC=NELEC+1 NEGION=NEGION+1 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=DMIN0(IT,J300) TIME(IT)=TIME(IT)+1.0D0 GO TO 335 ENDIF C USE COUNTING OR GROSS IONISATION ION2=1 IF(ICOUNT.EQ.1) THEN C FIND PROB OF DOUBLE IONISATION JD2=(IARRY(I)+3)/5 PROB2=DOUBLE(JD2,IE) R9=drand48(RDUM) IF(R9.LT.PROB2) THEN ION2=2 EI=2.0*EI ENDIF ENDIF R9=drand48(RDUM) 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 SECONDARY IONISATION ELECTRON IF(ION2.EQ.2) THEN R9=drand48(RDUM) ESTORE(1)=ESEC*R9 ESTORE(2)=ESEC-ESTORE(1) ELSE ESTORE(1)=ESEC ENDIF DO 547 JDUM=1,ION2 NCLUS=NCLUS+1 NMXADD=MAX(NCLUS,NMXADD) IF(NCLUS.GT.50000) THEN WRITE(6,546) NCLUS,NREAL 546 FORMAT(2X,' PROGRAM STOPPED . NCLUS=',I7,' NREAL=',I10) STOP ENDIF XS(NCLUS)=X YS(NCLUS)=Y ZS(NCLUS)=Z TS(NCLUS)=ST ES(NCLUS)=ESTORE(JDUM) C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0-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(NCLUS)=F9*F5 DCY(NCLUS)=F8*F5 DCZ(NCLUS)=F6 547 CONTINUE 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 C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I), OF TRANSFER TO GIVE 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 NCLUS=NCLUS+1 C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XS(NCLUS)=X YS(NCLUS)=Y ZS(NCLUS)=Z GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XS(NCLUS)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YS(NCLUS)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZS(NCLUS)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN 667 RAN=drand48(RDUM) TS(NCLUS)=ST-DLOG(RAN)*PENFRA(3,I) C ASSIGN EXCESS ENERGY OF 1EV TO PENNING CREATED ELECTRON ES(NCLUS)=1.0 DCX(NCLUS)=DCX1 DCY(NCLUS)=DCY1 DCZ(NCLUS)=DCZ1 ENDIF GO TO 6 C CALCULATE SUM OF EXCITATION PER CLUSTER AND STORE EXCITATION X Y Z T 5 IF(IPN(I).EQ.0) THEN IF((RGAS(I)*EIN(I)).GT.8.0) THEN KEXC=KEXC+1 NEXCTOT=NEXCTOT+1 NSTEXC=NSTEXC+1 XSTEXC(KEXC)=X YSTEXC(KEXC)=Y ZSTEXC(KEXC)=Z TSTEXC(KEXC)=ST ENDIF ENDIF 6 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 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 TEST IF ELECTRON IS THERMALISED IF(E1.GT.ETHRM) GO TO 1 C STORE POSITION AND TIME OF THERMALISED ELECTRON K1=K1+1 XST(K1)=X YST(K1)=Y ZST(K1)=Z TST(K1)=ST TTIME(K1)=ST-TLAST NELEC=NELEC+1 NETOT=NETOT+1 335 IF(K1.EQ.50000) GO TO 888 IF(NELEC.EQ.(NCLUS+1)) THEN C LAST ELECTRON IN CLUSTER , DO STATISTICS ON CLUSTER CALL STATS(J1) GO TO 210 ENDIF C GET NEW IONISATION ELECTRON FROM STORE X=XS(NELEC) Y=YS(NELEC) Z=ZS(NELEC) ST=TS(NELEC) TLAST=TS(NELEC) E1=ES(NELEC) DCX1=DCX(NELEC) DCY1=DCY(NELEC) DCZ1=DCZ(NELEC) GO TO 1 C MAIN LOOP END 210 CONTINUE WRITE(6,887) EMAX,NEOVFL 887 FORMAT(' EMAX=',D12.7,' NEOVFL =',I5) IF(EMAX.GT.EFINAL) THEN WRITE(6,889) EFINAL,EMAX 889 FORMAT('INCREASE ENERGY LIMIT FROM',D12.6,' EV TO AT LEAST',D12.6, /' EV.') STOP ENDIF RETURN 888 NLEFT=NCLUS-NELEC WRITE(6,992) NPRIME,NLEFT,NCLUS 992 FORMAT(3(/),' WARNING STOPPED AFTER NPRIME=',I6,' LAST PRIMARY HAS / AT LEAST ',I6,' SECONDARIES LEFT TO TRACK,OUT OF ',I6,' ELECTRONS / ALREADY IN CLUSTER') STOP RETURN END SUBROUTINE MONTEFC 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(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/BFLD/EOVB,WB,BTHETA,BMAG COMMON/LARGE/CF(20000,512),EIN(512),TCF(20000),IARRY(512), /RGAS(512),IPN(512),WPL(512),IPLAST,PENFRA(3,512) COMMON/OUTPT/ICOLL(30),NETOT,NPRIME,TMAX1,TIME(300),NNULL, /NITOT,ICOLN(512),NREAL,NEXCTOT COMMON/STTS/XST(50000),YST(50000),ZST(50000),TST(50000), /TTIME(50000),NELEC,NEGION,EST1,EST2 COMMON/STEXC/XSTEXC(50000),YSTEXC(50000),ZSTEXC(50000), /TSTEXC(50000),NSTEXC COMMON/IONC/DOUBLE(6,20000),CMINIXSC(6),CMINEXSC(6),ECLOSS(6), /WPLN(6),ICOUNT,AVPFRAC(3,6) COMMON/ANIS/PSCT(20000,512),ANGCT(20000,512),INDEX(512),NISO DIMENSION XS(50000),YS(50000),ZS(50000),TS(50000),ES(50000), /DCX(50000),DCY(50000),DCZ(50000),ESTORE(2) 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 ------------------------------------------------------------------- NPRINT=0 J20000=20000 J300=300 API=DACOS(-1.0D0) SMALL=1.0D-20 EMAX=0.0D0 TMAX1=0.0D0 RDUM=RSTART 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 NREAL=0 NNULL=0 NETOT=0 NEXCTOT=0 NITOT=0 NMXADD=0 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) F4=2.0D0*API EOVBR=EOVB*DSIN(RTHETA) THETA1=THETA PHI1=PHI TLIM=TCFMAX1 NEOVFL=0 IF(IMIP.EQ.0) GO TO 31 C CALCULATE PROBABILITY FOR PRIMARY MIP INTERACTION WITH EACH GAS ASUM=0.0 EXSUM=0.0 DO 28 JDUM=1,NGAS EXSUM=EXSUM+CMINEXSC(JDUM) 28 ASUM=ASUM+CMINIXSC(JDUM) ASUM=ASUM+EXSUM DO 29 JDUM=1,NGAS CMINEXSC(JDUM)=CMINEXSC(JDUM)/ASUM 29 CMINIXSC(JDUM)=CMINIXSC(JDUM)/ASUM IF(NGAS.EQ.1) GO TO 31 DO 30 JDUM=2,NGAS CMINEXSC(JDUM)=CMINEXSC(JDUM)+CMINEXSC(JDUM-1) 30 CMINIXSC(JDUM)=CMINIXSC(JDUM)+CMINIXSC(JDUM-1) 31 CONTINUE C START OF PRIMARY DELTA ELECTRON LOOP DO 210 J1=1,NDELTA IF(IMIP.EQ.0) GO TO 33 C FIND WHICH GAS WAS HIT 311 R9=drand48(RDUM) DO 32 K=1,NGAS I=K IF(CMINIXSC(K).GE.R9) GO TO 33 32 CONTINUE IF(IPEN.EQ.0) GO TO 311 C POSSIBLE PENNING PROCESS C FIND WHICH GAS WAS EXCITED R9=R9-CMINIXSC(NGAS) DO 321 K=1,NGAS I=K IF(CMINEXSC(K).GE.R9) GO TO 322 321 CONTINUE 322 IF(AVPFRAC(1,I).EQ.0.0) GO TO 311 RAN=drand48(RDUM) IF(RAN.GT.AVPFRAC(1,I)) GO TO 311 C EXCITATION (PENNING TRANSFER) TO IONISATION FROM PRIMARY MIP NELEC=1 NETOT=NETOT+1 NEGION=0 C ENTER HERE POSSIBLE DELOCALISATION LENGTH OF PENNING TRANSFER DELOCR=AVPFRAC(2,I) DELOCT=AVPFRAC(3,I) IF(DELOCR.EQ.0.0) THEN XST(1)=0.0 YST(1)=0.0 ZST(1)=0.0 TST(1)=0.0 GO TO 323 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZST(1)=-DLOG(RAN)*DELOCR*ASIGN RAN=drand48(RDUM) TST(1)=-DLOG(RAN)*DELOCT 323 TTIME(1)=TST(1) EST1=12.0 EST2=12.0 CALL STATS(J1) GO TO 210 33 CONTINUE NPRIME=J1 C INITIAL DIRECTION COSINES IF(THETA1.EQ.(API/2.0)) THEN C ONLY ALLOW CASE WHERE DELTA IS ALONG E-FIELD DIRECTION WRITE(6,22) 22 FORMAT(2(/),3X,'PROGRAM STOPPED ONLY ALLOWED TO HAVE DELTA ELECTR /ON PRALLEL TO E-FIELD IN CASE WITH ARBITRARY ANGLE FOR B-FIELD') STOP ENDIF C FIX DELTA TO E - FIELD DIRECTION PHI1=0.0D0 THETA1=(API/2.0)-RTHETA DCZ1=DCOS(THETA1) DCX1=DSIN(THETA1)*DCOS(PHI1) DCY1=DSIN(THETA1)*DSIN(PHI1) IF(IMIP.EQ.0) GO TO 34 C PICK ESTART FROM OPAL BEATY E=EMIP EI=ECLOSS(I) R9=drand48(RDUM) ESTART=WPLN(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPLN(I)))) ESTART=WPLN(I)*(ESTART/WPLN(I))**0.9524 EST2=ESTART IF(ESTART.GT.10000.) THEN NEOVFL=NEOVFL+1 ESTART=9999.0 ENDIF 34 EST1=ESTART C INITIAL VELOCITY E1=ESTART VTOT=CONST9*DSQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT X=0.0D0 Y=0.0D0 Z=0.0D0 K1=0 KEXC=0 NSTEXC=0 NCLUS=0 NELEC=0 NEGION=0 TLAST=0.0D0 ST=0.0D0 TDASH=0.0D0 C WRITE(6,776)E1,J1,NELEC C 776 FORMAT('EMAX=',D12.7,' J1=',I3,' NELEC=',I7) C START OF LOOP FOR NEW ELECTRONS 1 CONTINUE R1=drand48(RDUM) 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 WRITE(6,779) E 779 FORMAT(' E=',D12.7) 913 FORMAT(3X,' AFTER STORE NREAL=',I10,' DZ=',D12.3,'E1=',D12.3,' COS /WT=',D12.3,' SINWT=',D12.3,' WBT=',D12.3,' CY1=',D12.3) IF(E.LT.0.0D0) THEN C IF(NPRINT.EQ.0) WRITE(6,913)NREAL,DZ,E1,COSWT,SINWT,WBT,CY1 C NPRINT=1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=DMIN0(IE,J20000) 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 137 T2=T*T IF(E.GT.EMAX) EMAX=E IF(T.GT.TMAX1) TMAX1=T CC WRITE(6,776) EMAX,J1,NELEC,E 776 FORMAT('EMAX=',D12.7,' J1=',I3,' NELEC=',I7,' E=',D12.7) TDASH=0.0D0 NREAL=NREAL+1 C CALC VELOCITY CX2=CX1+2.0*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 C CALC NEW POSITION X=X+DX Y=Y+EOVBR*T+((CY1-EOVBR)*SINWT+CZ1*(1.0D0-COSWT))/WB Z=Z+DZ ST=ST+T IT=INT(T+1.0D0) IT=DMIN0(IT,J300) TIME(IT)=TIME(IT)+1.0D0 C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=drand48(RDUM) I=0 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,NREAL C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT NREAL=',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 NETOT=NETOT+1 NITOT=NITOT+1 NELEC=NELEC+1 NEGION=NEGION+1 IPT=IARRY(I) ICOLL(IPT)=ICOLL(IPT)+1 ICOLN(I)=ICOLN(I)+1 IT=INT(T+1.0D0) IT=DMIN0(IT,J300) TIME(IT)=TIME(IT)+1.0D0 GO TO 335 ENDIF C USE COUNTING OR GROSS IONISATION ION2=1 IF(ICOUNT.EQ.1) THEN C FIND PROB OF DOUBLE IONISATION JD2=(IARRY(I)+3)/5 PROB2=DOUBLE(JD2,IE) R9=drand48(RDUM) IF(R9.LT.PROB2) THEN ION2=2 EI=2.0*EI ENDIF ENDIF R9=drand48(RDUM) 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 SECONDARY IONISATION ELECTRON IF(ION2.EQ.2) THEN R9=drand48(RDUM) ESTORE(1)=ESEC*R9 ESTORE(2)=ESEC-ESTORE(1) ELSE ESTORE(1)=ESEC ENDIF DO 547 JDUM=1,ION2 NCLUS=NCLUS+1 NMXADD=MAX(NCLUS,NMXADD) IF(NCLUS.GT.50000) THEN WRITE(6,546) NCLUS,NREAL 546 FORMAT(2X,' PROGRAM STOPPED . NCLUS=',I7,' NREAL=',I10) STOP ENDIF XS(NCLUS)=X YS(NCLUS)=Y ZS(NCLUS)=Z TS(NCLUS)=ST ES(NCLUS)=ESTORE(JDUM) C RANDOMISE SECONDARY ELECTRON DIRECTION R3=drand48(RDUM) F3=1.0-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(NCLUS)=F9*F5 DCY(NCLUS)=F8*F5 DCZ(NCLUS)=F6 547 CONTINUE 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 C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I), OF TRANSFER TO GIVE 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 NCLUS=NCLUS+1 C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER IF(PENFRA(2,I).EQ.0.0) THEN XS(NCLUS)=X YS(NCLUS)=Y ZS(NCLUS)=Z GO TO 667 ENDIF ASIGN=1.0 RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN XS(NCLUS)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN YS(NCLUS)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN RAN=drand48(RDUM) RAN1=drand48(RDUM) IF(RAN1.LT.0.5) ASIGN=-ASIGN ZS(NCLUS)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN 667 RAN=drand48(RDUM) TS(NCLUS)=ST-DLOG(RAN)*PENFRA(3,I) C ASSIGN EXCESS ENERGY OF 1EV TO PENNING CREATED ELECTRON ES(NCLUS)=1.0 DCX(NCLUS)=DCX1 DCY(NCLUS)=DCY1 DCZ(NCLUS)=DCZ1 ENDIF GO TO 6 C CALCULATE SUM OF EXCITATION PER CLUSTER AND STORE EXCITATION X Y Z T 5 IF(IPN(I).EQ.0) THEN IF((RGAS(I)*EIN(I)).GT.8.0) THEN KEXC=KEXC+1 NEXCTOT=NEXCTOT+1 NSTEXC=NSTEXC+1 XSTEXC(KEXC)=X YSTEXC(KEXC)=Y ZSTEXC(KEXC)=Z TSTEXC(KEXC)=ST ENDIF ENDIF 6 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 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 TEST IF ELECTRON IS THERMALISED IF(E1.GT.ETHRM) GO TO 1 C STORE POSITION AND TIME OF THERMALISED ELECTRONS K1=K1+1 C ROTATE INTO COORDINATE SYSTEM WITH EFIELD ALONG Z ZR=Z*RCS-X*RSN YR=Y XR=Z*RSN+X*RCS XST(K1)=XR YST(K1)=YR ZST(K1)=ZR TST(K1)=ST TTIME(K1)=ST-TLAST NELEC=NELEC+1 NETOT=NETOT+1 C WRITE(6,775) EMAX,J1,NELEC,E 775 FORMAT('EMAX=',D12.7,' J1=',I3,' NELEC=',I7,'EL=',D12.7) 335 IF(K1.EQ.50000) GO TO 888 IF(NELEC.EQ.(NCLUS+1)) THEN C LAST ELECTRON IN CLUSTER. DO STATISTICS ON CLUSTER CALL STATS(J1) GO TO 210 ENDIF C GET NEW IONISATION ELECTRON FROM STORE X=XS(NELEC) Y=YS(NELEC) Z=ZS(NELEC) ST=TS(NELEC) TLAST=TS(NELEC) E1=ES(NELEC) DCX1=DCX(NELEC) DCY1=DCY(NELEC) DCZ1=DCZ(NELEC) GO TO 1 C MAIN LOOP END 210 CONTINUE WRITE(6,887) EMAX,NEOVFL 887 FORMAT(' EMAX=',D12.7,' NEOVFL =',I5) IF(EMAX.GT.EFINAL) THEN WRITE(6,889) EFINAL,EMAX 889 FORMAT('INCREASE ENERGY LIMIT FROM',D12.6,' EV TO AT LEAST',D12.6, /' EV.') STOP ENDIF RETURN 888 NLEFT=NCLUS-NELEC WRITE(6,992) NPRIME,NLEFT,NCLUS 992 FORMAT(3(/),' WARNING STOPPED AFTER NPRIME=',I6,' LAST PRIMARY HAS / AT LEAST ',I6,' SECONDARIES LEFT TO TRACK. OUT OF ',I6,' ELECTRON /S ALREADY IN CLUSTER') STOP RETURN END SUBROUTINE STATS(NEVENT) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/STTS/XST(50000),YST(50000),ZST(50000),TIME(50000), /TTIME(50000),NELEC,NEGION,EST1,EST2 COMMON/STEXC/XSTEXC(50000),YSTEXC(50000),ZSTEXC(50000), /TSTEXC(50000),NSTEXC COMMON/CLUS/XAV(4000000),YAV(4000000),ZAV(4000000),TAV(4000000), /XYAV(4000000),XYZAV(4000000),DX(4000000),DY(4000000),DZ(4000000), /DT(4000000),DXY(4000000),DXYZ(4000000),NCL(4000000),FARX1(4000000) /,FARY1(4000000),FARZ1(4000000),FARXY1(4000000),RMAX1(4000000), /TSUM(4000000),XNEG(4000000), /YNEG(4000000),ZNEG(4000000),EDELTA(4000000),EDELTA2(4000000), /NCLEXC(4000000) COMMON/PLOT/NXPL10(31),NYPL10(31),NZPL10(31),NXPL40(31), /NYPL40(31),NZPL40(31),NXPL100(31),NYPL100(31),NZPL100(31), /NXPL400(31),NYPL400(31),NZPL400(31),NXPL1000(31),NYPL1000(31), /NZPL1000(31),NXPL2(31),NYPL2(31),NZPL2(31),NXPL4000(31), /NYPL4000(31),NZPL4000(31),NXPL10000(31),NYPL10000(31), /NZPL10000(31),NXPL40000(31),NYPL40000(31),NZPL40000(31), /NXPL100000(31),NYPL100000(31),NZPL100000(31),NEPL1(100), /NEPL10(100),NEPL100(100),MELEC(300),MELEC10(300) C----------------------------------------------------------------------- C FORMS AVERAGES OVER EACH DELTA AND DOES SOME STATISTICS C LOADS PLOT ARRAYS XPLOT YPLOT AND ZPLOT (SCALED BY 1 10 AND 100) C OUTPUTS RAW DATA TO FILE IF IWRITE CONTROL GT 0 C OUTPUTS THERMALISED ELECTRON X,YZ AND T IF IWRITE EQ 1 C OUTPUTS ALSO X,Y,Z AND T FOR EACH EXCITATION IF C IWRITE EQ 2 C ---------------------------------------------------------------------- NCLUS=NELEC-NEGION IF(NCLUS.GT.50000) GO TO 99 SUMX=0.0D0 SUMX2=0.0D0 SUMY=0.0D0 SUMY2=0.0D0 SUMZ=0.0D0 SUMZ2=0.0D0 SUMRXY=0.0D0 SUMRXY2=0.0D0 SUMRXYZ=0.0D0 SUMRXYZ2=0.0D0 SUMT=0.0D0 SUMT2=0.0D0 FARX=0.0D0 FARY=0.0D0 FARZ=0.0D0 FARXY=0.0D0 RMAX=0.0D0 SUMTT=0.0D0 NXNEG=0 NYNEG=0 NZNEG=0 ESUM=0.0 C DO 400 IS=1,NCLUS XST(IS)=XST(IS)*1.D6 X=XST(IS) IF(X.LT.0.0) THEN NXNEG=NXNEG+1 I1=INT(X/2.0-0.5) I2=INT(X/10.0-0.5) I3=INT(X/40.0-0.5) I4=INT(X/100.0-0.5) I5=INT(X/400.0-0.5) I6=INT(X/1000.0-0.5) I7=INT(X/4000.0-0.5) I8=INT(X/10000.0-0.5) I9=INT(X/40000.0-0.5) I10=INT(X/100000.0-0.5) ELSE I1=INT(X/2.0+0.5) I2=INT(X/10.0+0.5) I3=INT(X/40.0+0.5) I4=INT(X/100.0+0.5) I5=INT(X/400.0+0.5) I6=INT(X/1000.0+0.5) I7=INT(X/4000.0+0.5) I8=INT(X/10000.0+0.5) I9=INT(X/40000.0+0.5) I10=INT(X/100000.0+0.5) ENDIF I1=I1+16 I2=I2+16 I3=I3+16 I4=I4+16 I5=I5+16 I6=I6+16 I7=I7+16 I8=I8+16 I9=I9+16 I10=I10+16 IF(I1.LT.1) I1=1 IF(I1.GT.31) I1=31 IF(I2.LT.1) I2=1 IF(I2.GT.31) I2=31 IF(I3.LT.1) I3=1 IF(I3.GT.31) I3=31 IF(I4.LT.1) I4=1 IF(I4.GT.31) I4=31 IF(I5.LT.1) I5=1 IF(I5.GT.31) I5=31 IF(I6.LT.1) I6=1 IF(I6.GT.31) I6=31 IF(I7.LT.1) I7=1 IF(I7.GT.31) I7=31 IF(I8.LT.1) I8=1 IF(I8.GT.31) I8=31 IF(I9.LT.1) I9=1 IF(I9.GT.31) I9=31 IF(I10.LT.1) I10=1 IF(I10.GT.31) I10=31 NXPL2(I1)=NXPL2(I1)+1 NXPL10(I2)=NXPL10(I2)+1 NXPL40(I3)=NXPL40(I3)+1 NXPL100(I4)=NXPL100(I4)+1 NXPL400(I5)=NXPL400(I5)+1 NXPL1000(I6)=NXPL1000(I6)+1 NXPL4000(I7)=NXPL4000(I7)+1 NXPL10000(I8)=NXPL10000(I8)+1 NXPL40000(I9)=NXPL40000(I9)+1 NXPL100000(I10)=NXPL100000(I10)+1 X2=X*X SUMX=SUMX+X SUMX2=SUMX2+X2 IF(DABS(X).GT.DABS(FARX)) FARX=DABS(X) YST(IS)=YST(IS)*1.D6 Y=YST(IS) IF(Y.LT.0.0) THEN NYNEG=NYNEG+1 I1=INT(Y/2.0-0.5) I2=INT(Y/10.0-0.5) I3=INT(Y/40.0-0.5) I4=INT(Y/100.0-0.5) I5=INT(Y/400.0-0.5) I6=INT(Y/1000.0-0.5) I7=INT(Y/4000.0-0.5) I8=INT(Y/10000.0-0.5) I9=INT(Y/40000.0-0.5) I10=INT(Y/100000.0-0.5) ELSE I1=INT(Y/2.0+0.5) I2=INT(Y/10.0+0.5) I3=INT(Y/40.0+0.5) I4=INT(Y/100.0+0.5) I5=INT(Y/400.0+0.5) I6=INT(Y/1000.0+0.5) I7=INT(Y/4000.0+0.5) I8=INT(Y/10000.0+0.5) I9=INT(Y/40000.0+0.5) I10=INT(Y/100000.0+0.5) ENDIF I1=I1+16 I2=I2+16 I3=I3+16 I4=I4+16 I5=I5+16 I6=I6+16 I7=I7+16 I8=I8+16 I9=I9+16 I10=I10+16 IF(I1.LT.1) I1=1 IF(I1.GT.31) I1=31 IF(I2.LT.1) I2=1 IF(I2.GT.31) I2=31 IF(I3.LT.1) I3=1 IF(I3.GT.31) I3=31 IF(I4.LT.1) I4=1 IF(I4.GT.31) I4=31 IF(I5.LT.1) I5=1 IF(I5.GT.31) I5=31 IF(I6.LT.1) I6=1 IF(I6.GT.31) I6=31 IF(I7.LT.1) I7=1 IF(I7.GT.31) I7=31 IF(I8.LT.1) I8=1 IF(I8.GT.31) I8=31 IF(I9.LT.1) I9=1 IF(I9.GT.31) I9=31 IF(I10.LT.1) I10=1 IF(I10.GT.31) I10=31 NYPL2(I1)=NYPL2(I1)+1 NYPL10(I2)=NYPL10(I2)+1 NYPL40(I3)=NYPL40(I3)+1 NYPL100(I4)=NYPL100(I4)+1 NYPL400(I5)=NYPL400(I5)+1 NYPL1000(I6)=NYPL1000(I6)+1 NYPL4000(I7)=NYPL4000(I7)+1 NYPL10000(I8)=NYPL10000(I8)+1 NYPL40000(I9)=NYPL40000(I9)+1 NYPL100000(I10)=NYPL100000(I10)+1 Y2=Y*Y SUMY=SUMY+Y SUMY2=SUMY2+Y2 IF(DABS(Y).GT.DABS(FARY)) FARY=DABS(Y) ZST(IS)=ZST(IS)*1.D6 Z=ZST(IS) IF(Z.LT.0.0) THEN NZNEG=NZNEG+1 I1=INT(Z/2.0-0.5) I2=INT(Z/10.0-0.5) I3=INT(Z/40.0-0.5) I4=INT(Z/100.0-0.5) I5=INT(Z/400.0-0.5) I6=INT(Z/1000.0-0.5) I7=INT(Z/4000.0-0.5) I8=INT(Z/10000.0-0.5) I9=INT(Z/40000.0-0.5) I10=INT(Z/100000.0-0.5) ELSE I1=INT(Z/2.0+0.5) I2=INT(Z/10.0+0.5) I3=INT(Z/40.0+0.5) I4=INT(Z/100.0+0.5) I5=INT(Z/400.0+0.5) I6=INT(Z/1000.0+0.5) I7=INT(Z/4000.0+0.5) I8=INT(Z/10000.0+0.5) I9=INT(Z/40000.0+0.5) I10=INT(Z/100000.0+0.5) ENDIF I1=I1+16 I2=I2+16 I3=I3+16 I4=I4+16 I5=I5+16 I6=I6+16 I7=I7+16 I8=I8+16 I9=I9+16 I10=I10+16 IF(I1.LT.1) I1=1 IF(I1.GT.31) I1=31 IF(I2.LT.1) I2=1 IF(I2.GT.31) I2=31 IF(I3.LT.1) I3=1 IF(I3.GT.31) I3=31 IF(I4.LT.1) I4=1 IF(I4.GT.31) I4=31 IF(I5.LT.1) I5=1 IF(I5.GT.31) I5=31 IF(I6.LT.1) I6=1 IF(I6.GT.31) I6=31 IF(I7.LT.1) I7=1 IF(I7.GT.31) I7=31 IF(I8.LT.1) I8=1 IF(I8.GT.31) I8=31 IF(I9.LT.1) I9=1 IF(I9.GT.31) I9=31 IF(I10.LT.1) I10=1 IF(I10.GT.31) I10=31 NZPL2(I1)=NZPL2(I1)+1 NZPL10(I2)=NZPL10(I2)+1 NZPL40(I3)=NZPL40(I3)+1 NZPL100(I4)=NZPL100(I4)+1 NZPL400(I5)=NZPL400(I5)+1 NZPL1000(I6)=NZPL1000(I6)+1 NZPL4000(I7)=NZPL4000(I7)+1 NZPL10000(I8)=NZPL10000(I8)+1 NZPL40000(I9)=NZPL40000(I9)+1 NZPL100000(I10)=NZPL100000(I10)+1 Z2=Z*Z SUMZ=SUMZ+Z SUMZ2=SUMZ2+Z2 IF(DABS(Z).GT.DABS(FARZ)) FARZ=DABS(Z) RXY=DSQRT(X2+Y2) RXYZ=DSQRT(X2+Y2+Z2) SUMRXY=SUMRXY+RXY SUMRXY2=SUMRXY2+RXY*2 SUMRXYZ=SUMRXYZ+RXYZ SUMRXYZ2=SUMRXYZ2+RXYZ*2 IF(RXY.GT.FARXY) FARXY=RXY IF(RXYZ.GT.RMAX) RMAX=RXYZ T=TIME(IS) SUMT=SUMT+T SUMT2=SUMT2+T*T SUMTT=SUMTT+TTIME(IS) C XSTEXC(IS)=XSTEXC(IS)*1.D6 YSTEXC(IS)=YSTEXC(IS)*1.D6 ZSTEXC(IS)=ZSTEXC(IS)*1.D6 400 CONTINUE C OUTPUT THERMAL ELECTRON POSITIONS AND TIME IF(IWRITE.EQ.1) THEN WRITE(50,*) NEVENT,NCLUS,NSTEXC WRITE(50,*) (XST(IPR),YST(IPR),ZST(IPR),TIME(IPR),IPR=1,NCLUS) ENDIF C OUTPUT EXCITATION CLOUD COORDINATES HERE IF(IWRITE.EQ.2) THEN WRITE(50,*) NEVENT,NCLUS,NSTEXC WRITE(50,*) (XST(IPR),YST(IPR),ZST(IPR),TIME(IPR),IPR=1,NCLUS) WRITE(50,*) (XSTEXC(IPR),YSTEXC(IPR),ZSTEXC(IPR),TSTEXC(IPR), /IPR=1,NSTEXC) ENDIF C--------------------------------------------------- I1=INT(EST1+1.0) I2=INT(EST1/10.0+1.0) I3=INT(EST1/100.0+1.0) IF(I1.GT.100) I1=100 IF(I2.GT.100) I2=100 IF(I3.GT.100) I3=100 NEPL1(I1)=NEPL1(I1)+1 NEPL10(I2)=NEPL10(I2)+1 NEPL100(I3)=NEPL100(I3)+1 KDUM=NELEC KDUM10=1+(NELEC/10) IF(NELEC.GT.300) KDUM=300 MELEC(KDUM)=MELEC(KDUM)+1 IF(NELEC.GT.3000) KDUM10=300 MELEC10(KDUM10)=MELEC10(KDUM10)+1 C C STORE AVERAGES AND WIDTHS FOR EACH DELTA C IF(NCLUS.EQ.0) RETURN ACLUS=DFLOAT(NCLUS) XAV(NEVENT)=SUMX/ACLUS YAV(NEVENT)=SUMY/ACLUS ZAV(NEVENT)=SUMZ/ACLUS TAV(NEVENT)=SUMT/ACLUS XYAV(NEVENT)=SUMRXY/ACLUS XYZAV(NEVENT)=SUMRXYZ/ACLUS C IONISATION CLUSTER SIZE NCL(NEVENT)=NCLUS C EXCITATION CLUSTER SIZE NCLEXC(NEVENT)=NSTEXC C FARX1(NEVENT)=FARX FARY1(NEVENT)=FARY FARZ1(NEVENT)=FARZ FARXY1(NEVENT)=FARXY RMAX1(NEVENT)=RMAX TSUM(NEVENT)=SUMTT XNEG(NEVENT)=FLOAT(NXNEG)/ACLUS YNEG(NEVENT)=FLOAT(NYNEG)/ACLUS ZNEG(NEVENT)=FLOAT(NZNEG)/ACLUS EDELTA(NEVENT)=EST1 EDELTA2(NEVENT)=EST2 IF(NCLUS.GT.1) THEN NC2=NCLUS*NCLUS-NCLUS ANC2=DFLOAT(NC2) DX(NEVENT)=DSQRT(ABS((ACLUS*SUMX2-SUMX*SUMX)/ANC2)) DY(NEVENT)=DSQRT(ABS((ACLUS*SUMY2-SUMY*SUMY)/ANC2)) DZ(NEVENT)=DSQRT(ABS((ACLUS*SUMZ2-SUMZ*SUMZ)/ANC2)) DT(NEVENT)=DSQRT(ABS((ACLUS*SUMT2-SUMT*SUMT)/ANC2)) DXY(NEVENT)=DSQRT(ABS((ACLUS*SUMRXY2-SUMRXY*SUMRXY)/ANC2)) DXYZ(NEVENT)=DSQRT(ABS((ACLUS*SUMRXYZ2-SUMRXYZ*SUMRXYZ)/ANC2)) ELSE DX(NEVENT)=0.0 DY(NEVENT)=0.0 DZ(NEVENT)=0.0 DZ(NEVENT)=0.0 DT(NEVENT)=0.0 DXY(NEVENT)=0.0 DXYZ(NEVENT)=0.0 ENDIF RETURN 99 WRITE(6,991) NCLUS 991 FORMAT(3(/),' WARNING OVERFLOW IN ARRAYS IN SUBROUTINE STATS. NCLU /S =',I4,' STOPPED PROGRAM') STOP END SUBROUTINE STATS2 IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*8 (I-N) COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(10),TCFMAX1, /RSTART,EFIELD,ETHRM,EMIP,NDELTA,IMIP,IWRITE COMMON/CLUS/XAV(4000000),YAV(4000000),ZAV(4000000),TAV(4000000), /XYAV(4000000),XYZAV(4000000),DX(4000000),DY(4000000),DZ(4000000), /DT(4000000),DXY(4000000),DXYZ(4000000),NCL(4000000),FARX1(4000000) /,FARY1(4000000),FARZ1(4000000),FARXY1(4000000),RMAX1(4000000), /TSUM(4000000),XNEG(4000000), /YNEG(4000000),ZNEG(4000000),EDELTA(4000000),EDELTA2(4000000), /NCLEXC(4000000) COMMON/FANO/AFAN1,AFAN2,AFAN3,AFAN4,ASKEW,AKURT,AFAN1EXC,AFAN2EXC, /AFAN3EXC,AFAN4EXC,ASKEWEXC,AKURTEXC,AFAN1TOT,AFAN2TOT,AFAN3TOT, /AFAN4TOT,ASKEWTOT,AKURTTOT,FUDGE COMMON/RNGE/XBAR,YBAR,ZBAR,TBAR,XYBAR,XYZBAR,DXBAR,DYBAR,DZBAR, /DTBAR,DXYBAR,DXYZBAR,XMAX,YMAX,ZMAX,XYMAX,RMAX,SUMTT,XNEG1,YNEG1, /ZNEG1,FARXBAR,FARYBAR,FARZBAR,FARXYBAR,RMAXBAR,EBAR,EBAR2 C----------------------------------------------------------------------- C CALCULATES AVERAGES OVER TOTAL NUMBER OF DELTAS C CALCULATES FANO FACTORS FO,F1,F2 AND F3 C CALCULATES FANO FACTORS FOR EXCITATION ALSO C----------------------------------------------------------------------- C ANCL1=0.0D0 ANCL2=0.0D0 ANCL3=0.0D0 ANCL4=0.0D0 ANCL1EXC=0.0D0 ANCL2EXC=0.0D0 ANCL3EXC=0.0D0 ANCL4EXC=0.0D0 ANCL1TOT=0.0D0 ANCL2TOT=0.0D0 ANCL3TOT=0.0D0 ANCL4TOT=0.0D0 NF=0 FUDGE=1.0 WRITE(6,998) FUDGE 998 FORMAT(' FUDGE=', D12.3) DO 10 I=1,NDELTA NCLUS=NCL(I) NCLUS1=NCLUS-1 NEXC=NCLEXC(I) C INSERT EXTRA ELECTRON FOR CONSISTENCY IN CLUSTER DEF FOR DELTAS c NCLUS1=NCLUS ANC1=DFLOAT(NCLUS1) ANCL1=ANCL1+ANC1 ANCL2=ANCL2+ANC1*ANC1 ANCL3=ANCL3+ANC1*ANC1*ANC1 ANCL4=ANCL4+ANC1*ANC1*ANC1*ANC1 ANC1EXC=DFLOAT(NEXC) ANCL1EXC=ANCL1EXC+ANC1EXC ANCL2EXC=ANCL2EXC+ANC1EXC*ANC1EXC ANCL3EXC=ANCL3EXC+ANC1EXC*ANC1EXC*ANC1EXC ANCL4EXC=ANCL4EXC+ANC1EXC*ANC1EXC*ANC1EXC*ANC1EXC ANCTOT=ANC1+ANC1EXC*FUDGE ANCL1TOT=ANCL1TOT+ANCTOT ANCL2TOT=ANCL2TOT+ANCTOT*ANCTOT ANCL3TOT=ANCL3TOT+ANCTOT*ANCTOT*ANCTOT ANCL4TOT=ANCL4TOT+ANCTOT*ANCTOT*ANCTOT*ANCTOT NF=NF+1 10 CONTINUE C CALCULATE FANO FACTORS ANF=DFLOAT(NF) ANF1=ANF*ANF IF(ANF1.EQ.0.0) ANF1=1.0D0 AFAN1=ANCL1/ANF AFAN1EXC=ANCL1EXC/ANF AFAN1TOT=ANCL1TOT/ANF AFAN2=DSQRT((ANF*ANCL2-ANCL1*ANCL1)/ANF1) AFAN2EXC=DSQRT((ANF*ANCL2EXC-ANCL1EXC*ANCL1EXC)/ANF1) AFAN2TOT=DSQRT((ANF*ANCL2TOT-ANCL1TOT*ANCL1TOT)/ANF1) AFAN3=(ANCL3-3.0D0*AFAN1*ANCL2+2.0D0*ANCL1*AFAN1*AFAN1)/ANF AFAN3EXC=(ANCL3EXC-3.0D0*AFAN1EXC*ANCL2EXC+2.0D0*ANCL1EXC*AFAN1EXC /*AFAN1EXC)/ANF AFAN3TOT=(ANCL3TOT-3.0D0*AFAN1TOT*ANCL2TOT+2.0D0*ANCL1TOT*AFAN1TOT /*AFAN1TOT)/ANF AFAN4=(ANCL4-4.0D0*AFAN1*ANCL3+6.0D0*AFAN1*AFAN1*ANCL2-3.0D0*AFAN1 /*AFAN1*AFAN1*ANCL1)/ANF AFAN4=AFAN4-3.0D0*AFAN2*AFAN2*AFAN2*AFAN2 AFAN4EXC=(ANCL4EXC-4.0D0*AFAN1EXC*ANCL3EXC+6.0D0*AFAN1EXC*AFAN1EXC /*ANCL2EXC-3.0D0*AFAN1EXC*AFAN1EXC*AFAN1EXC*ANCL1EXC)/ANF AFAN4EXC=AFAN4EXC-3.0D0*AFAN2EXC*AFAN2EXC*AFAN2EXC*AFAN2EXC AFAN4TOT=(ANCL4TOT-4.0D0*AFAN1TOT*ANCL3TOT+6.0D0*AFAN1TOT*AFAN1TOT /*ANCL2TOT-3.0D0*AFAN1TOT*AFAN1TOT*AFAN1TOT*ANCL1TOT)/ANF AFAN4TOT=AFAN4TOT-3.0D0*AFAN2TOT*AFAN2TOT*AFAN2TOT*AFAN2TOT ASKEW=AFAN3/(AFAN2**3) AKURT=AFAN4/(AFAN2**4) AFAN3=AFAN3/AFAN1 AFAN4=AFAN4/AFAN1 ASKEWEXC=AFAN3EXC/(AFAN2EXC**3) AKURTEXC=AFAN4EXC/(AFAN2EXC**4) AFAN3EXC=AFAN3EXC/AFAN1EXC AFAN4EXC=AFAN4EXC/AFAN1EXC ASKEWTOT=AFAN3TOT/(AFAN2TOT**3) AKURTTOT=AFAN4TOT/(AFAN2TOT**4) AFAN3TOT=AFAN3TOT/AFAN1TOT AFAN4TOT=AFAN4TOT/AFAN1TOT C CALCULATE AVERAGES OVER TOTAL NUMBER OF DELTAS XBAR=0.0D0 YBAR=0.0D0 ZBAR=0.0D0 TBAR=0.0D0 XYBAR=0.0D0 XYZBAR=0.0D0 DXBAR=0.0D0 DYBAR=0.0D0 DZBAR=0.0D0 DTBAR=0.0D0 DXYBAR=0.0D0 DXYZBAR=0.0D0 FARXBAR=0.0D0 FARYBAR=0.0D0 FARZBAR=0.0D0 FARXYBAR=0.0D0 RMAXBAR=0.0D0 XMAX=0.0D0 YMAX=0.0D0 ZMAX=0.0D0 XYMAX=0.0D0 RMAX=0.0D0 SUMTT=0.0D0 XNEGSUM=0.0D0 YNEGSUM=0.0D0 ZNEGSUM=0.0D0 EBAR=0.0D0 EBAR2=0.0D0 DO 20 I=1,NDELTA XBAR=XBAR+XAV(I) YBAR=YBAR+YAV(I) ZBAR=ZBAR+ZAV(I) TBAR=TBAR+TAV(I) XYBAR=XYBAR+XYAV(I) XYZBAR=XYZBAR+XYZAV(I) DXBAR=DXBAR+DX(I) DYBAR=DYBAR+DY(I) DZBAR=DZBAR+DZ(I) DTBAR=DTBAR+DT(I) DXYBAR=DXYBAR+DXY(I) DXYZBAR=DXYZBAR+DXYZ(I) SUMTT=SUMTT+TSUM(I) FARXBAR=FARXBAR+FARX1(I) IF(FARX1(I).GT.XMAX) XMAX=FARX1(I) FARYBAR=FARYBAR+FARY1(I) IF(FARY1(I).GT.YMAX) YMAX=FARY1(I) FARZBAR=FARZBAR+FARZ1(I) IF(FARZ1(I).GT.ZMAX) ZMAX=FARZ1(I) FARXYBAR=FARXYBAR+FARXY1(I) IF(FARXY1(I).GT.XYMAX) XYMAX=FARXY1(I) RMAXBAR=RMAXBAR+RMAX1(I) IF(RMAX1(I).GT.RMAX) RMAX=RMAX1(I) XNEGSUM=XNEGSUM+XNEG(I) YNEGSUM=YNEGSUM+YNEG(I) ZNEGSUM=ZNEGSUM+ZNEG(I) EBAR=EBAR+EDELTA(I) EBAR2=EBAR2+EDELTA2(I) 20 CONTINUE ANDELTA=DFLOAT(NDELTA) XBAR=XBAR/ANDELTA YBAR=YBAR/ANDELTA ZBAR=ZBAR/ANDELTA TBAR=TBAR/ANDELTA XYBAR=XYBAR/ANDELTA XYZBAR=XYZBAR/ANDELTA DXBAR=DXBAR/ANDELTA DYBAR=DYBAR/ANDELTA DZBAR=DZBAR/ANDELTA DTBAR=DTBAR/ANDELTA DXYBAR=DXYBAR/ANDELTA DXYZBAR=DXYZBAR/ANDELTA FARXBAR=FARXBAR/ANDELTA FARYBAR=FARYBAR/ANDELTA FARZBAR=FARZBAR/ANDELTA FARXYBAR=FARXYBAR/ANDELTA RMAXBAR=RMAXBAR/ANDELTA XNEG1=XNEGSUM/ANDELTA YNEG1=YNEGSUM/ANDELTA ZNEG1=ZNEGSUM/ANDELTA EBAR=EBAR/ANDELTA EBAR2=EBAR2/ANDELTA 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 *0 * $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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 MASS VALUE 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,83,84 AND 85 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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.,22.0,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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN DIMENSION PEQEL(6,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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 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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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,20000),PEQIN(220,20000),KIN(220),KEL(6) DIMENSION Q(6,20000),QIN(220,20000),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