C PROGRAM IMONTE VERSION2.5 NOVEMBER 2000 C -------------------------------------------------------------------- C HIGH FIELD VERSION OF MONTE USE WHERE IONISATION AND ATTACHMENT C ARE IMPORTANT AT HIGH FIELDS. C ------------------------------------------------------------------- C REVISION 2.1 INCLUDES CALCULATION OF EXCITATION RATES IN GAS1 C THIS ALLOWS ESTIMATE OF PENNING EFFECTS. C --------------------------------------------------------------------- C REVISION 2.2 INCLUDES ANISOTROPIC SCATTERING AND SOME SMALL C CORRECTIONS TO THE CODE C -------------------------------------------------------------------- C REVISION 2.3 INCLUDES EXTENDED GAS LIBRARY (FROM 30 TO 60 GASES) C EXTENDED TOTAL NUMBER OF LEVELS FROM 32 TO 64 . C ---------------------------------------------------------------------- C REVISION 2.4 CORRECTS SMALL ERRORS IN OUTPUT PLOT OF ENERGY OF C ELECTRON PRIMARIES. INCREASE IN NUMBER OF ALLOWED C PRIMARIES TO 4 MILLION ALLOWS GREATER ATTACHMENT GASSES C TO BE SIMULATED C ---------------------------------------------------------------------- C PROGRAM USES THE SAME INPUT GAS DATA BASE AS THE LOW ELECTRIC-MAGNETIC C FIELD VERSION NMONTE . THE MAGNETIC FIELD IS NOT YET INCLUDED IN THIS C PROGRAM . C THE CODE HAS BEEN MODIFIED TO ALLOW TRACKING OF ELECTRONS CREATED C IN IONISING COLLISIONS , TERMINATIONS AT FIXED DISTANCE OR FIXED C TIMES ARE ALLOWED . THE DIFERENT TERMINATIONS CAN BE RELATED TO C PULSED TOWNSEND , STEADY STATE OR TIME OF FLIGHT MEASUREMENTS C CF: SAKAI ET AL. J. PHYS. D10 (1035) 1977 . C THE PROGRAM PRODUCES OUTPUT SUMMARIES AT EACH TIME OR SPACE PLANE C THIS ALLOWS THE STATISTICAL ACCURACY AT EACH PLANE TO BE ASSESSED C AS THE ELECTRONS AVALANCHE/ATTENUATION DEVELOPS IN SPACE OR TIME. C--------------------------- C INPUT CARDS : C---------------------------------------------------------- C FIRST CARD: 2I10,2F10.5 : NGAS,NMAX,RSTART,EFINAL C NGAS: NUMBER OF GASES IN MIXTURE C NMAX: NUMBER OF REAL AND NULL COLLISIONS (MULTIPLE OF 10000000 ) C USE NMAX =10 FOR AVERAGE GAS MIX TO OBTAIN 1% ACCURACY C C RSTART: STARTING RANDOM NUMBER GENERATOR (DEPENDS ON COMPUTER RANDOM C NUMBER GENERATOR) C EFINAL: MAXIMUM POSSIBLE ELECTRON ENERGY . ( DETERMINED FROM TRIAL C AND ERROR) UNITS OF EV. C C------------------------------------------------------------ C SECOND CARD: 4I5 : NGAS1,NGAS2,NGAS3,NGAS4 C NGAS1,ETC : GAS NUMBER IDENTIFIER (BETWEEN 1 AND 28) C------------------------------------------------------------- C THIRD CARD: 6F10.4 : FRAC1,FRAC2,FRAC3,FRAC4,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 : 4F10.3 : WOPL(1),WOPL(2),WOPL(3),WOPL(4) C WOPL(N) : ENERGY SPLITTING FACTOR FROM OPAL,PETERSON AND C BEATY ,J.CHEM.PHYS. 55 4100 (1973) FOR GAS N. C C IF WOPL(N) SET TO 0.0 THEN USES IONISATION C ENERGY AS SPLITTING FACTOR. c--------------------------------------------------------------- C FIFTH CARD : 6F10.3 : EFIELD,BMAG,THETA C EFIELD : ELECTRIC FIELD IN VOLTS/ CM. C BMAG AND THETA NOT YET IMPLEMENTED C----------------------------------------------------------------------- C SIXTH CARD : 2F10.3,2I5 : ALPHAST,VDST,IFD,IFT C ALPHAST : ESTIMATE OF ALPHA IN CM**-1 C VDST : ESTIMATE OF DRIFT VELOCITY IN MICRONS/NANOSECOND. C IFD : SET TO 1 IF FIXED DISTANCE TERMINATION , 0 IF NOT. C IFT : SET TO 1 IF FIXED TIME TERMINATION , 0 IF NOT. C--------------------------------------------------------------------- C CARD 6*N+1 USES NGAS=0 TO TERMINATE CORRECTLY C-------------------------------------------------------------------- C C GAS NUMBER: C----------------------------------------------------------------- C GAS1 : CF4 (2001) (ANISOTROPIC SCATTERING ONLY) C GAS2 : ARGON (1997) C GAS3 : HELIUM 4 (1997) C GAS4 : HELIUM 3 (1992) C GAS5 : NEON (1992) C GAS6 : KRYPTON (2001) C GAS7 : XENON (2001) C GAS8 : METHANE (1994) C GAS9 : ETHANE (1999) C GAS10 : PROPANE (1999) C GAS11 : ISOBUTANE (1999) C GAS12 : CO2 (2001) C GAS13 : NEO-PENTANE (1995) C(CH3)4 C GAS14 : H20 (1998) C GAS15 : OXYGEN (1990) 3-BODY ATTACHMENT INCLUDED C GAS16 : NITROGEN (PITCHFORD AND PHELPS ) C GAS17 : NITRIC OXIDE (1995) ATTACHING GAS C GAS18 : NITROUS OXIDE (1995) ATTACHING GAS C GAS19 : ETHENE (1999) C2H4 C GAS20 : ACETYLENE (1992) C2H2 C GAS21 : HYDROGEN (2001) C GAS22 : DEUTERIUM (1998) C GAS23 : CARBON MONOXIDE (1998) C GAS24 : METHYLAL (1988) C GAS25 : DME (1998) C GAS26 : REID STEP MODEL (ANISOTROPIC) C GAS27 : MAXWELL MODEL C GAS28 : REID RAMP MODEL C GAS29 : C2F6 (1999) (ANISOTROPIC) C GAS30 : SF6 USE ONLY SMALL PERCENTAGE IN MIX C GAS31 : NH3 AMMONIA (1999) C GAS32 : C3H6 PROPENE (1999) C GAS33 : C3H6 CYCLOPROPANE (1999) C GAS34 : CH3OH METHANOL C GAS35 : C2H5OH ETHANOL C GAS36 : C3H7OH ISO-PROPANOL C GAS37 : CESIUM C GAS38 : FLUORINE (MORGAN) C GAS39 : CS2 (2001) ( ION DRIFT DARK MATTER) C GAS40 : COS (2001) C GAS50 : BF3 BORON TRIFLOURIDE (2001) ANISOTROPIC C GAS51 : C2HF5 OR C2H2F4 (ESTIMATED) C------------------------------------------------------------------ C C PROGRAM MONTE2 IMPLICIT REAL*8 (A-H,O-Z) COMMON/CON/IFD,IFT C 1 CALL SETUP(LAST) IF(LAST.EQ.1) GO TO 99 CALL MIXER CALL PRNTER IF(IFT.EQ.1) THEN CALL MONTEFT CALL FRIEDLAND CALL PT CALL TOF ELSE IF(IFD.EQ.1) THEN CALL MONTEFD CALL FRIEDLAND CALL SST ENDIF CALL OUTPUT GO TO 1 99 STOP END SUBROUTINE MIXER C MODIFICATIONS FROM STANDARD MIXER ROUTINE PRECEEDED BY C ** IMPLICIT REAL*8 (A-H,O-Z) C ** COMMON/FRED/FCION(2002),FCATT(2002) COMMON/RATIO/AN1,AN2,AN3,AN4,FRAC1,FRAC2,FRAC3,FRAC4,AN COMMON/GASN/NGAS1,NGAS2,NGAS3,NGAS4 COMMON/MIX1/QELM(2002),QSUM(2002),QION(4,2002),QIN1(20,2002), /QIN2(20,2002),QIN3(20,2002),QIN4(20,2002),QSATT(2002) COMMON/MIX2/E(2002),EROOT(2002),QTOT(2002),QREL(2002),QINEL(2002), /QEL(2002) COMMON/MIX3/NIN1,NIN2,NIN3,NIN4,LION(4),LIN1(20),LIN2(20), /LIN3(20),LIN4(20),ALION(4),ALIN1(20),ALIN2(20),ALIN3(20),ALIN4(20) COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 C ** COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,X,Y,Z,ST,TCFMAX(10), /RSTART,EFIELD,NMAX C ** COMMON/DEL/WOPL(4) COMMON/LARGE/CF(2000,64),EIN(64),TCF(2000),IARRY(64),RGAS(64), /IPN(64),WPL(64),IPLAST COMMON/ANIS/PEL(4,2002),PIN(8,2002),KEL(4),INDEX(64),NISO COMMON/MRATIO/VAN1,VAN2,VAN3,VAN4,VAN CHARACTER*15 NAME1,NAME2,NAME3,NAME4 COMMON/NAMES/NAME1,NAME2,NAME3,NAME4 DIMENSION Q1(6,2002),Q2(6,2002),Q3(6,2002),Q4(6,2002) DIMENSION E1(6),E2(6),E3(6),E4(6),EI1(20),EI2(20),EI3(20),EI4(20) DIMENSION QQROT(2002),QDROT(2002),QATT(4,2002),EION(4) DIMENSION PEQEL1(2002),PEQEL2(2002),PEQEL3(2002),PEQEL4(2002) DIMENSION PEQIN1(2,2002),PEQIN2(2,2002),PEQIN3(2,2002),PEQIN4(2, /2002) DIMENSION KIN1(2),KIN2(2),KIN3(2),KIN4(2) C C --------------------------------------------------------------------- C C SUBROUTINE MIXER FILLS ARRAYS OF COLLISION FREQUENCY C CAN HAVE A MIXTURE OF UP TO 4 GASES C C C --------------------------------------------------------------------- C NISO=0 KEL1=0 KEL2=0 KEL3=0 KEL4=0 NIN1=0 NIN2=0 NIN3=0 NIN4=0 NAME1='000000000000000' NAME2='000000000000000' NAME3='000000000000000' NAME4='000000000000000' DO 2 J=1,6 DO 1 I=1,2002 Q1(J,I)=0.0D0 Q2(J,I)=0.0D0 Q3(J,I)=0.0D0 Q4(J,I)=0.0D0 1 CONTINUE E1(J)=0.0D0 E2(J)=0.0D0 E3(J)=0.0D0 2 E4(J)=0.0D0 ESTEP=EFINAL/NSTEP EHALF=ESTEP/2.0D0 E(1)=EHALF DO 3 I=2,2002 AJ=DFLOAT(I-1) E(I)=EHALF+ESTEP*AJ 3 EROOT(I)=DSQRT(E(I)) EROOT(1)=DSQRT(EHALF) DO 4 I=1,2 KIN1(I)=0 KIN2(I)=0 KIN3(I)=0 4 KIN4(I)=0 DO 5 I=1,4 5 KEL(I)=0 DO 6 I=1,64 6 INDEX(I)=0 C C CALL GAS CROSS-SECTIONS CALL GASMIX(NGAS1,NISO,Q1,QIN1,NIN1,E1,EI1,NAME1,VIRIAL1, /PEQEL1,PEQIN1,KEL1,KIN1) IF(NGAS.EQ.1) GO TO 200 CALL GASMIX(NGAS2,NISO,Q2,QIN2,NIN2,E2,EI2,NAME2,VIRIAL2, /PEQEL2,PEQIN2,KEL2,KIN2) IF(NGAS.EQ.2) GO TO 200 CALL GASMIX(NGAS3,NISO,Q3,QIN3,NIN3,E3,EI3,NAME3,VIRIAL3, /PEQEL3,PEQIN3,KEL3,KIN3) IF(NGAS.EQ.3) GO TO 200 CALL GASMIX(NGAS4,NISO,Q4,QIN4,NIN4,E4,EI4,NAME4,VIRIAL4, /PEQEL4,PEQIN4,KEL4,KIN4) 200 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--------------------------------------------------------------- KEL(1)=KEL1 KEL(2)=KEL2 KEL(3)=KEL3 KEL(4)=KEL4 DO 700 IE=1,2000 C ** FCION(IE)=0.0D0 FCATT(IE)=0.0D0 KPIN=0 PIN(1,IE)=0.0D0 PIN(2,IE)=0.0D0 PEL(1,IE)=0.0D0 NP=1 L=1 CF(IE,NP)=Q1(2,IE)*VAN1*1.0D15 IF(KEL1.EQ.1) PEL(1,IE)=PEQEL1(IE) RGAS1=1.0D0+E1(2)/2.0D0 RGAS(NP)=RGAS1 EIN(NP)=0.0D0 IPN(NP)=0 IARRY(NP)=L IF(EFINAL.LT.E1(3)) GO TO 230 L=2 NP=NP+1 C ** FCION(IE)=FCION(IE)+Q1(3,IE)*VAN1*1.0D15 CF(IE,NP)=Q1(3,IE)*VAN1*1.0D15 RGAS(NP)=RGAS1 EIN(NP)=E1(3)/RGAS1 IPN(NP)=1 IARRY(NP)=L C ** WPL(NP)=WOPL(1) IF(WOPL(1).EQ.0.0D0) WPL(NP)=E1(3) 230 IF(EFINAL.LT.E1(4)) GO TO 240 L=3 NP=NP+1 C ** FCATT(IE)=FCATT(IE)+Q1(4,IE)*VAN1*1.0D15 CF(IE,NP)=Q1(4,IE)*VAN1*1.0D15 RGAS(NP)=RGAS1 EIN(NP)=0.0D0 C ** IPN(NP)=-1 IARRY(NP)=L 240 IF(NIN1.EQ.0) GO TO 260 DO 250 J=1,NIN1 L=4 NP=NP+1 CF(IE,NP)=QIN1(J,IE)*VAN1*1.0D15 IF(KIN1(1).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN1(1,IE) INDEX(NP)=KPIN ENDIF IF(KIN1(2).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN1(2,IE) INDEX(NP)=KPIN ENDIF RGAS(NP)=RGAS1 EIN(NP)=EI1(J)/RGAS1 IF(EI1(J).LT.0.0D0) L=5 IPN(NP)=0 250 IARRY(NP)=L 260 IF(NGAS.EQ.1) GO TO 600 PIN(3,IE)=0.0D0 PIN(4,IE)=0.0D0 PEL(2,IE)=0.0D0 NP=NP+1 L=6 CF(IE,NP)=Q2(2,IE)*VAN2*1.0D15 IF(KEL2.EQ.1) PEL(2,IE)=PEQEL2(IE) RGAS2=1.0D0+E2(2)/2.0D0 RGAS(NP)=RGAS2 EIN(NP)=0.0D0 IPN(NP)=0 IARRY(NP)=L IF(EFINAL.LT.E2(3)) GO TO 330 L=7 NP=NP+1 C ** FCION(IE)=FCION(IE)+Q2(3,IE)*VAN2*1.0D15 CF(IE,NP)=Q2(3,IE)*VAN2*1.0D15 RGAS(NP)=RGAS2 EIN(NP)=E2(3)/RGAS2 IPN(NP)=1 IARRY(NP)=L C ** WPL(NP)=WOPL(2) IF(WOPL(2).EQ.0.0D0) WPL(NP)=E2(3) 330 IF(EFINAL.LT.E2(4)) GO TO 340 L=8 NP=NP+1 C ** FCATT(IE)=FCATT(IE)+Q2(4,IE)*VAN2*1.0D15 CF(IE,NP)=Q2(4,IE)*VAN2*1.0D15 RGAS(NP)=RGAS2 EIN(NP)=0.0D0 C ** IPN(NP)=-1 IARRY(NP)=L 340 IF(NIN2.EQ.0) GO TO 360 DO 350 J=1,NIN2 L=9 NP=NP+1 CF(IE,NP)=QIN2(J,IE)*VAN2*1.0D15 IF(KIN2(1).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN2(1,IE) INDEX(NP)=KPIN ENDIF IF(KIN2(2).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN2(2,IE) INDEX(NP)=KPIN ENDIF RGAS(NP)=RGAS2 EIN(NP)=EI2(J)/RGAS2 IF(EI2(J).LT.0.0D0) L=10 IPN(NP)=0 350 IARRY(NP)=L 360 IF(NGAS.EQ.2) GO TO 600 PIN(5,IE)=0.0D0 PIN(6,IE)=0.0D0 PEL(3,IE)=0.0D0 NP=NP+1 L=11 CF(IE,NP)=Q3(2,IE)*VAN3*1.0D15 IF(KEL3.EQ.1) PEL(3,IE)=PEQEL3(IE) RGAS3=1.0D0+E3(2)/2.0D0 RGAS(NP)=RGAS3 EIN(NP)=0.0D0 IPN(NP)=0 IARRY(NP)=L IF(EFINAL.LT.E3(3)) GO TO 430 L=12 NP=NP+1 C ** FCION(IE)=FCION(IE)+Q3(3,IE)*VAN3*1.0D15 CF(IE,NP)=Q3(3,IE)*VAN3*1.0D15 RGAS(NP)=RGAS3 EIN(NP)=E3(3)/RGAS3 IPN(NP)=1 IARRY(NP)=L C ** WPL(NP)=WOPL(3) IF(WOPL(3).EQ.0.0D0) WPL(NP)=E3(3) 430 IF(EFINAL.LT.E3(4)) GO TO 440 L=13 NP=NP+1 C ** FCATT(IE)=FCATT(IE)+Q3(4,IE)*VAN3*1.0D15 CF(IE,NP)=Q3(4,IE)*VAN3*1.0D15 RGAS(NP)=RGAS3 EIN(NP)=0.0D0 C ** IPN(NP)=-1 IARRY(NP)=L 440 IF(NIN3.EQ.0) GO TO 460 DO 450 J=1,NIN3 L=14 NP=NP+1 CF(IE,NP)=QIN3(J,IE)*VAN3*1.0D15 IF(KIN3(1).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN3(1,IE) INDEX(NP)=KPIN ENDIF IF(KIN3(2).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN3(2,IE) INDEX(NP)=KPIN ENDIF RGAS(NP)=RGAS3 EIN(NP)=EI3(J)/RGAS3 IF(EI3(J).LT.0.0D0) L=15 IPN(NP)=0 450 IARRY(NP)=L 460 IF(NGAS.EQ.3) GO TO 600 PIN(7,IE)=0.0D0 PIN(8,IE)=0.0D0 PEL(4,IE)=0.0D0 NP=NP+1 L=16 CF(IE,NP)=Q4(2,IE)*VAN4*1.0D15 IF(KEL4.EQ.1) PEL(4,IE)=PEQEL4(IE) RGAS4=1.0D0+E4(2)/2.0D0 RGAS(NP)=RGAS4 EIN(NP)=0.0D0 IPN(NP)=0 IARRY(NP)=L IF(EFINAL.LT.E4(3)) GO TO 530 L=17 NP=NP+1 C ** FCION(IE)=FCION(IE)+Q4(3,IE)*VAN4*1.0D15 CF(IE,NP)=Q4(3,IE)*VAN4*1.0D15 RGAS(NP)=RGAS4 EIN(NP)=E4(3)/RGAS4 IPN(NP)=1 IARRY(NP)=L C ** WPL(NP)=WOPL(4) IF(WOPL(4).EQ.0.0D0) WPL(NP)=E4(3) 530 IF(EFINAL.LT.E4(4)) GO TO 540 L=18 NP=NP+1 C ** FCATT(IE)=FCATT(IE)+Q4(4,IE)*VAN4*1.0D15 CF(IE,NP)=Q4(4,IE)*VAN4*1.0D15 RGAS(NP)=RGAS4 EIN(NP)=0.0D0 C ** IPN(NP)=-1 IARRY(NP)=L 540 IF(NIN4.EQ.0) GO TO 560 DO 550 J=1,NIN4 L=19 NP=NP+1 CF(IE,NP)=QIN4(J,IE)*VAN4*1.0D15 IF(KIN4(1).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN4(1,IE) INDEX(NP)=KPIN ENDIF IF(KIN4(2).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN4(2,IE) INDEX(NP)=KPIN ENDIF RGAS(NP)=RGAS4 EIN(NP)=EI4(J)/RGAS4 IF(EI4(J).LT.0.0D0) L=20 IPN(NP)=0 550 IARRY(NP)=L 560 CONTINUE C 600 CONTINUE IPLAST=NP C ---------------------------------------------------------------- C CAN INCREASE ARRAY SIZE UP TO 132 IF MORE COMPLEX MIXTURES USED. C ------------------------------------------------------------------ IF(IPLAST.GT.64) WRITE(6,992) 992 FORMAT(/,/,6X,'WARNING TOO MANY LEVELS IN CALCULATION. CAN INCREAS /E THE ARRAY SIZES FROM 64 UP TO 132 MAXIMUM',/) IF(IPLAST.GT.64) 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 =',E12.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 C ** FCATT(IE)=FCATT(IE)*EROOT(IE) FCION(IE)=FCION(IE)*EROOT(IE) TCF(IE)=TCF(IE)*EROOT(IE) 700 CONTINUE C ------------------------------------------------------------------- C CALCULATE NULL COLLISION FREQUENCY C ------------------------------------------------------------------- BP=EFIELD*EFIELD*CONST1 F2=EFIELD*CONST3 ELOW=TMAX*(TMAX*BP-F2*DSQRT(0.5D0*EFINAL))/ESTEP-1.0D0 ELOW=DMIN1(ELOW,SMALL) EHI=TMAX*(TMAX*BP+F2*DSQRT(0.5D0*EFINAL))/ESTEP+1.0D0 IF(EHI.GT.10000.) EHI=10000. DO 810 I=1,10 JLOW=2000-200*(11-I)+1+INT(ELOW) JHI=2000-200*(10-I)+INT(EHI) JLOW=MAX0(JLOW,1) JHI=MIN0(JHI,2000) C ** C ** FIX COLLISION FREQUENCY TO MAXIMUM C DO 800 J=JLOW,JHI DO 800 J=1,2000 IF(TCF(J).GE.TCFMAX(I)) TCFMAX(I)=TCF(J) 800 CONTINUE 810 CONTINUE C ------------------------------------------------------------------- C CROSS SECTION DATA FOR INTEGRALS IN SUBROUTINE OUTPUT C --------------------------------------------------------------------- DO 900 I=1,NSTEP1+1 QTOT(I)=AN1*Q1(1,I)+AN2*Q2(1,I)+AN3*Q3(1,I)+AN4*Q4(1,I) QEL(I)=AN1*Q1(2,I)+AN2*Q2(2,I)+AN3*Q3(2,I)+AN4*Q4(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 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 C IF(NIN1.EQ.0) GO TO 820 DO 815 J=1,NIN1 815 QIN1(J,I)=QIN1(J,I)*AN1 820 IF(NIN2.EQ.0) GO TO 830 DO 825 J=1,NIN2 825 QIN2(J,I)=QIN2(J,I)*AN2 830 IF(NIN3.EQ.0) GO TO 840 DO 835 J=1,NIN3 835 QIN3(J,I)=QIN3(J,I)*AN3 840 IF(NIN4.EQ.0) GO TO 850 DO 845 J=1,NIN4 845 QIN4(J,I)=QIN4(J,I)*AN4 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) 865 IF(NIN2.EQ.0) GO TO 875 DO 870 J=1,NIN2 870 QSUM(I)=QSUM(I)+QIN2(J,I) 875 IF(NIN3.EQ.0) GO TO 885 DO 880 J=1,NIN3 880 QSUM(I)=QSUM(I)+QIN3(J,I) 885 IF(NIN4.EQ.0) GO TO 895 DO 890 J=1,NIN4 890 QSUM(I)=QSUM(I)+QIN4(J,I) 895 CONTINUE C 900 CONTINUE C RETURN END SUBROUTINE GASMIX(NGS,NISO,Q,QIN,NIN,E,EI,NAME,VIRIAL, /PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*15 NAME DIMENSION Q(6,2002),QIN(20,2002),E(6),EI(20),KIN(2) DIMENSION PEQEL(2002),PEQIN(2,2002) C MN=1 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) NGS 1 CALL GAS1(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 2 CALL GAS2(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 3 CALL GAS3(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 4 CALL GAS4(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 5 CALL GAS5(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 6 CALL GAS6(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 7 CALL GAS7(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 8 CALL GAS8(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 9 CALL GAS9(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 10 CALL GAS10(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 11 CALL GAS11(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 12 CALL GAS12(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 13 CALL GAS13(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 14 CALL GAS14(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 15 CALL GAS15(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 16 CALL GAS16(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 17 CALL GAS17(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 18 CALL GAS18(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 19 CALL GAS19(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 20 CALL GAS20(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 21 CALL GAS21(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 22 CALL GAS22(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 23 CALL GAS23(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 24 CALL GAS24(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 25 CALL GAS25(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 26 CALL GAS26(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 27 CALL GAS27(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 28 CALL GAS28(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 29 CALL GAS29(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 30 CALL GAS30(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 31 CALL GAS31(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 32 CALL GAS32(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 33 CALL GAS33(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 34 CALL GAS34(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 35 CALL GAS35(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 36 CALL GAS36(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 37 CALL GAS37(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 38 CALL GAS38(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 39 CALL GAS39(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 40 CALL GAS40(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 41 CALL GAS41(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 42 CALL GAS42(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 43 CALL GAS43(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 44 CALL GAS44(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 45 CALL GAS45(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 46 CALL GAS46(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 47 CALL GAS47(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 48 CALL GAS48(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 49 CALL GAS49(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN 50 CALL GAS50(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 51 CALL GAS51(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 52 CALL GAS52(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 53 CALL GAS53(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 54 CALL GAS54(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 55 CALL GAS55(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 56 CALL GAS56(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 57 CALL GAS57(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 58 CALL GAS58(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 59 CALL GAS59(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN,PEQEL,PEQIN,KEL,KIN) NISO=1 RETURN 60 CALL GAS60(Q,QIN,NIN,E,EI,NAME,VIRIAL,MN) RETURN END SUBROUTINE SETUP(LAST) IMPLICIT REAL*8 (A-H,O-Z) COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH COMMON/MIX2/E(2002),EROOT(2002),QTOT(2002),QREL(2002),QINEL(2002), /QEL(2002) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/RATIO/AN1,AN2,AN3,AN4,FRAC1,FRAC2,FRAC3,FRAC4,AN COMMON/GASN/NGAS1,NGAS2,NGAS3,NGAS4 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,X,Y,Z,ST,TCFMAX(10), /RSTART,EFIELD,NMAX COMMON/DIFFC/SUMDV(5),SUMDX(2),DSUM2,DXSUM2,DFTP,DFLP,STD,STD1, /DFTP1,DFTP2,DFTP3,DFLP1,DFLP2,DFLP3 COMMON/MRATIO/VAN1,VAN2,VAN3,VAN4,VAN COMMON/OUTPT/TIME(300),ICOLL(20),SPEC(2000),WE(61),WENE(61),TMAX1, /AVE,AVE2,XID,W,NNULL COMMON/CON/IFD,IFT COMMON/DEL/WOPL(4) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),NEXC1TPL(8) COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/SPLOUT/ESPL(8),XSPL(8),YSPL(8),ZSPL(8),TSPL(8),XXSPL(8), /YYSPL(8),ZZSPL(8),VZSPL(8),TSSUM(8),TSSUM2(8),NESST(9),NEX1SST(8) COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, /ZPLANE7,ZPLANE8,IZFINAL COMMON/SPL1/TMSPL(8),TTMSPL(8),RSPL(8),RRSPL(8),RRSPM(8) COMMON/TPLINIT/NEXC1 COMMON/SSTINIT/NEXC1SST,ICOLN(20) C---------------------------------------------------------------------- C C PHYSICAL CONSTANTS 1998 UPDATE OF TAYLOR AND COHEN C API=DACOS(-1.0D0) ARY=13.60569172D0 PIR2=8.79735534D-17 ECHARG=1.602176462D-19 EMASS=9.10938188D-31 AMU=1.66053873D-27 BOLTZ=8.617342D-5 AWB=1.758820174D10 ALOSCH=2.6867775D19 EOVM=DSQRT(2.0D0*ECHARG/EMASS)*100.0D0 ABZERO=273.15D0 ATMOS=760.0D0 CONST1=AWB/2.0D0*1.0D-19 CONST2=CONST1*1.0D-02 CONST3=DSQRT(0.2D0*AWB)*1.0D-09 CONST4=CONST3*ALOSCH*1.0D-15 CONST5=CONST3/2.0D0 C C C READ IN OUTPUT CONTROL AND INTEGRATION DATA C C TMAX=1000.0D0 LAST=0 NSCALE=960000 NSTEP=2000 NEXC1=0 NEXC1SST=0 NOUT=10 MDT=10 THETA=0.785 PHI=0.1 X=0.0 Y=0.0 Z=0.0 ST=0.0 STD=0.0 STD1=0.0 ZTOT=0.0 ZTOTS=0.0 TTOT=0.0 TTOTS=0.0 DO 60 I=1,8 ETPL(I)=0.0 ESPL(I)=0.0 TTPL(I)=0.0 TSPL(I)=0.0 VZTPL(I)=0.0 VZSPL(I)=0.0 XTPL(I)=0.0 XSPL(I)=0.0 YTPL(I)=0.0 YSPL(I)=0.0 RSPL(I)=0.0 ZTPL(I)=0.0 ZSPL(I)=0.0 ZZTPL(I)=0.0 ZZSPL(I)=0.0 YYTPL(I)=0.0 YYSPL(I)=0.0 XXTPL(I)=0.0 XXSPL(I)=0.0 RRSPL(I)=0.0 RRSPM(I)=0.0 TMSPL(I)=0.0 TTMSPL(I)=0.0 TSSUM(I)=0.0 TSSUM2(I)=0.0 NETPL(I)=0 NEXC1TPL(I)=0 NEX1SST(I)=0 60 NESST(I)=0 DO 65 J=1,300 65 TIME(J)=0.0 DO 70 K=1,20 ICOLN(K)=0 70 ICOLL(K)=0 DO 80 J=1,61 WE(J)=0.0 80 WENE(J)=0.0 DO 100 K=1,2000 100 SPEC(K)=0.0 DO 101 K=1,10 101 TCFMAX(K)=0.0 DO 102 K=1,5 102 SUMDV(K)=0.0 SUMDX(1)=0.0 SUMDX(2)=0.0 DSUM2=0.0 DXSUM2=0.0 DFTP=0.0 DFLP=0.0 ALPHA=0.0 C READ(5,2) NGAS,NMAX,RSTART,EFINAL 2 FORMAT(2I10,2F10.5) IF(NGAS.EQ.0) GO TO 99 ESTART=EFINAL/20.0D0 NMAX=NMAX*10000000 NSTEP1=NSTEP+1 DT=1.0D0/DFLOAT(MDT) C C GAS PARAMETERS C READ(5,3) NGAS1,NGAS2,NGAS3,NGAS4 3 FORMAT(4I5) READ(5,4)FRAC1,FRAC2,FRAC3,FRAC4,TEMPC,TORR 4 FORMAT(6F10.4) CORR=ABZERO*TORR/(ATMOS*(ABZERO+TEMPC)*100.0) AKT=(ABZERO+TEMPC)*BOLTZ AN1=FRAC1*CORR*ALOSCH AN2=FRAC2*CORR*ALOSCH AN3=FRAC3*CORR*ALOSCH AN4=FRAC4*CORR*ALOSCH AN=100.0*CORR*ALOSCH VAN1=FRAC1*CORR*CONST4 VAN2=FRAC2*CORR*CONST4 VAN3=FRAC3*CORR*CONST4 VAN4=FRAC4*CORR*CONST4 VAN=100.0*CORR*CONST4 C ENERGY SPLITTING FACTORS READ(5,45) WOPL(1),WOPL(2),WOPL(3),WOPL(4) 45 FORMAT(4F10.3) C C FIELD VALUES C READ(5,5) EFIELD,BMAG,BTHETA 5 FORMAT(6F10.3) READ(5,6) ALPHAST,VDST,IFD,IFT 6 FORMAT(2F10.3,2I5) C ESTIMATE TIME STEPS IN SIMULATION IN PICOSECONDS C FOR A TIME STEP EQUIVALENT TO MULTIPLICATION BY 4 TSTEP=DLOG(4.0D0)/(ALPHAST*VDST*1.0D5) C ESTIMATE OF SPACE STEP IN SIMULATION IN MICRONS. C FOR A SPACE STEP EQUIVALENT TO MULTIPLICATION BY 4. ZSTEP=DLOG(4.0D0)/ALPHAST C CONVERT TO METRES AND PICOSECONDS TSTEP=TSTEP*1.0D12 ZSTEP=ZSTEP*0.01 TFINAL=7.0*TSTEP ITFINAL=7 ZFINAL=8.0*ZSTEP IZFINAL=8 ZPLANE1=ZSTEP ZPLANE2=2.0*ZSTEP ZPLANE3=3.0*ZSTEP ZPLANE4=4.0*ZSTEP ZPLANE5=5.0*ZSTEP ZPLANE6=6.0*ZSTEP ZPLANE7=7.0*ZSTEP ZPLANE8=8.0*ZSTEP WB=AWB*BMAG IF(BMAG.NE.0.0) WRITE(6,88) 88 FORMAT(/,6X,'WARNING THIS VERSION OF MONTE CARLO HAS NO BFIELD',/) RETURN 99 LAST=1 RETURN END SUBROUTINE PRNTER IMPLICIT REAL*8 (A-H,O-Z) COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH COMMON/RATIO/AN1,AN2,AN3,AN4,FRAC1,FRAC2,FRAC3,FRAC4,AN COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,X,Y,Z,ST,TCFMAX(10), /RSTART,EFIELD,NMAX COMMON/LARGE/CF(2000,64),EIN(64),TCF(2000),IARRY(64),RGAS(64), /IPN(64),WPL(64),IPLAST COMMON/CON/IFD,IFT COMMON/DEL/WOPL(4) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/NAMES/NAME1,NAME2,NAME3,NAME4 CHARACTER*15 NAME1,NAME2,NAME3,NAME4 WRITE(6,9) 9 FORMAT(1H1,20X,'IMONTE VERSION 2.3 NOV 1999',/) WRITE(6,10) NGAS 10 FORMAT(1H1,20X,'MONTE CARLO SOLUTION FOR MIXTURE OF ',I2,' GASES.' /,/,15X,'------------------------------------------------------') IF(IFD.EQ.1) WRITE(6,12) IF(IFT.EQ.1) WRITE(6,11) 11 FORMAT(/,2X,'SOLUTION FOR PULSED TOWNSEND AND TIME OF FLIGHT PARAM /ETERS',/,' ------------------------------------------------------ /--------') 12 FORMAT(/,2X,'SOLUTION FOR STEADY STATE TOWNSEND PARAMETERS',/,' - /------------------------------------------------') WRITE(6,30) NAME1,NAME2,NAME3,NAME4 30 FORMAT(/,2X,' GASES USED =',5X,4(A15,1X)) WRITE(6,40) FRAC1,FRAC2,FRAC3,FRAC4 40 FORMAT(/,2X,' PERCENTAGE USED =',4(F15.3,1X)) WRITE(6,50) TEMPC,TORR 50 FORMAT(/,2X,' GAS TEMPERATURE =',F6.1,' DEGREES CENTIGRADE.',6X, /' GAS PRESSURE = ',F7.1,' TORR.') WRITE(6,60) EFINAL,NSTEP 60 FORMAT(/,2X,' INTEGRATION FROM 0.0 TO ',F8.2,' EV. IN ',I4,' STEP /S. ') WRITE(6,65) WOPL(1),WOPL(2),WOPL(3),WOPL(4) 65 FORMAT(/,2X,'ENERGY SPLITTING FACTORS (IF SET TO 0.0 PROGRAM USES /IONISATION ENERGY FOR SPLITTING FACTOR)',/,2X,' FACTORS =',4(F10.3 /,4X)) 74 WRITE(6,90) EFIELD,ESTART,RSTART 90 FORMAT(/,' ELECTRIC FIELD =',F12.3,' VOLTS/CM. INITIAL ELECTRO /N ENERGY =',F8.3,' EV.',/,' RANDOM NUMBER STARTER =',F9.5) ZSTEPM=ZSTEP*1.0D6 WRITE(6,92) ALPHAST,VDST,TSTEP,ZSTEPM 92 FORMAT(1(/),' ESTIMATED ALPHA =',F10.3,' /CM. ESTIMATED DRIFT V /ELOCITY =',F10.3,' MICRONS/NANOSEC. ',/,' CALCULATED TIME STEP FO /R AVALANCHE SIMULATION =',E12.5,' PICOSECONDS',/,' SPACE STEP FOR / AVALANCHE SIMULATION =',E12.5,' MICRONS.') WRITE(6,100) NMAX 100 FORMAT(/,2X,'MAXIMUM NUMBER OF REAL AND NULL COLLISIONS =',I10) WRITE(6,110) TCFMAX(1) 110 FORMAT(/,' NULL COLLISION FREQUENCY IN UNITS OF (10**12/SEC) =', /E10.3) WRITE(6,111) (TCF(L),L=100,1900,200) 111 FORMAT(/,' REAL COLLISION FREQUENCY AT 10 EQUALLY SPACED ENERGY I /NTERVALS (*10**12/SEC)',2(/,2X,5E10.3)) RETURN END SUBROUTINE MONTEFT IMPLICIT REAL*8 (A-H,O-Z) COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,X,Y,Z,ST,TCFMAX(10), /RSTART,EFIELD,NMAX COMMON/LARGE/CF(2000,64),EIN(64),TCF(2000),IARRY(64),RGAS(64), /IPN(64),WPL(64),IPLAST COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/DIFFC/SUMDV(5),SUMDX(2),DSUM2,DXSUM2,DFTP,DFLP,STD,STD1, /DFTP1,DFTP2,DFTP3,DFLP1,DFLP2,DFLP3 COMMON/OUTPT/TIME(300),ICOLL(20),SPEC(2000),WE(61),WENE(61),TMAX1, /AVE,AVE2,XID,W,NNULL COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/IPT/XS(200),YS(200),ZS(200),TS(200),ES(200), /DCX(200),DCY(200),DCZ(200),IPL(200) COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),NEXC1TPL(8) COMMON/TPLINIT/NEXC1 COMMON/ANIS/PEL(4,2002),PIN(8,2002),KEL(4),INDEX(64),NISO DIMENSION EPRM(4000000),IESPECP(100),ICANS(64) C ------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C THIS ROUTINE HANDLES TERMINATIONS AT FIXED DRIFT TIMES. C ------------------------------------------------------------------- C SET ANISOTROPY CONTROL FOR ELASTIC COLLISIONS DO 123 I=1,64 ICANS(I)=0 IF(IARRY(I).EQ.1.AND.KEL(1).EQ.1) ICANS(I)=1 IF(IARRY(I).EQ.6.AND.KEL(2).EQ.1) ICANS(I)=1 IF(IARRY(I).EQ.11.AND.KEL(3).EQ.1) ICANS(I)=1 123 IF(IARRY(I).EQ.16.AND.KEL(4).EQ.1) ICANS(I)=1 S=0.0D0 SUMDY=0.0D0 SUME=0.0D0 SUME2=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 DO 33 I=1,100 33 IESPECP(I)=0 ID=0 I100=0 NCOL=0 NNULL=0 NELEC=0 NEION=0 NMXADD=0 NPONT=0 NCLUS=0 J1=1 ZSTRT=0.0D0 TSSTRT=0.0D0 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) E100=E1 DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*API TLIM=TCFMAX(1) ITERMAX=NMAX JPRINT=ITERMAX/10 IPRINT=0 ITER=0 ITERM2=2*ITERMAX IPLANE=0 IPRIM=0 ITST=0 C LOOP FOR NEW STARTING ELECTRONS 544 IPRIM=IPRIM+1 IF(IPRIM.GT.1) THEN C CHECK IF PROGRAM WILL EXCEED MAXIMUM NUMBER OF ITERATIONS C IN THIS CYCLE IF SO OUTPUT CURRENT RESULTS. IF(ITER.GT.ITERMAX) THEN IPRIM=IPRIM-1 GO TO 700 ENDIF X=0.0D0 Y=0.0D0 Z=0.0D0 DCZ1=DCZ100 DCX1=DCX100 DCY1=DCY100 E1=E100 NCLUS=NCLUS+1 ST=0.0D0 TSSTRT=0.0D0 ZSTRT=0.0D0 IPLANE=0 ENDIF IF(IPRIM.GT.4000000) THEN WRITE(6,944) IPRIM 944 FORMAT(/,2X,'PROGRAM STOPPED TOO MANY PRIMARIES IPRIM =',I7) GO TO 700 ENDIF EPRM(IPRIM)=E1 IDUM=INT(E1)+1 IDUM=MIN0(IDUM,100) IESPECP(IDUM)=IESPECP(IDUM)+1 C START OF LOOP FOR NEWLY CREATED ELECTRONS 555 TDASH=0.0D0 NELEC=NELEC+1 TSTOP=TSTEP+IPLANE*TSTEP C MAIN LOOP 1 CONTINUE IF(ITER.GT.ITERM2) GO TO 315 ITER=ITER+1 IPRINT=IPRINT+1 C R1=RNDM2(RDUM) R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) 15 IF((T+ST).GE.TSTOP) THEN IPLANE=IPLANE+1 TSTOP=TSTOP+TSTEP C STORE POSITION AND ENERGY AT TIME PLANE =IPLANE. CALL TPLANE(T,ST,X,Y,Z,E1,DCX1,DCY1,DCZ1,AP,BP,EFIELD,IPLANE) C CHECK IF PASSED THROUGH MORE THAN ONE PLANE IN THIS STEP IF((T+ST).GE.TSTOP.AND.TSTOP.LE.TFINAL) GO TO 15 IF((T+ST).GE.TFINAL) THEN ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT TSTOP=TSTEP NEXC1=ICOLL(4) C NO MORE ELECTRONS IN CASCADE TRY NEW PRIMARY ELECTRON IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C TAKE ELECTRONS FROM STORE 20 X=XS(NPONT) Y=YS(NPONT) Z=ZS(NPONT) ST=TS(NPONT) E1=ES(NPONT) DCX1=DCX(NPONT) DCY1=DCY(NPONT) DCZ1=DCZ(NPONT) IPLANE=IPL(NPONT) NPONT=NPONT-1 ZSTRT=Z TSSTRT=ST GO TO 555 ENDIF ENDIF 913 FORMAT(3X,' AFTER STORE ITER=',I10,' E1=',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 WRITE(6,913)ITER,E,E1,AP,BP,DCZ1 E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=MIN0(IE,2000) C C TEST FOR REAL OR NULL COLLISION C C R5=RNDM2(RDUM) R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 CONST6=DSQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0D0+B/3.0D0) CONST7=CONST9*DSQRT(E1) A=T*CONST7 NCOL=NCOL+1 CZ1=DCZ1*CONST7 X=X+DCX1*A Y=Y+DCY1*A Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0D0) IT=MIN0(IT,300) TIME(IT)=TIME(IT)+1.0D0 CX1=DCX1*CONST7 CY1=DCY1*CONST7 SUMDX(1)=SUMDX(1)+0.5D0*CX1*CX1*T2 SUMDY=SUMDY+0.5D0*CY1*CY1*T2 SUME=SUME+E1+0.5D0*(AP*T+0.5D0*T2*BP) SPEC(IE)=SPEC(IE)+1.0D0 C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- C R2=RNDM2(RDUM) 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,ITER C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF A BINING ERROR OCCURS. EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 C ATTACHMENT IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ICOLL(IPT)=ICOLL(IPT)+1 IT=INT(T+1.0D0) IT=MIN0(IT,300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT IF((IPLANE+1).GT.8) GO TO 141 NEXC1TPL(IPLANE+1)=NEXC1TPL(IPLANE+1)+ICOLL(4)-NEXC1 141 NEXC1=ICOLL(4) C ELECTRON CAPTURED START NEW PRIMARY IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C ELECTRON CAPTURED TAKE NEXT ELECTRON FROM STORE GO TO 20 ENDIF C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN . C R9=RNDM2(RDUM) R9=drand48(RDUM) C ESEC=R9*(E-EI) C USE OPAL PETERSON AND BEATY SPLITTING FACTOR. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI C STORE POSITION ,ENERGY, DIRECTION COSINES AND TIME OF GENERATION C OF IONISATION ELECTRON NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED . NPONT=',I4,' ITER=',I10) STOP ENDIF XS(NPONT)=X YS(NPONT)=Y ZS(NPONT)=Z TS(NPONT)=ST ES(NPONT)=ESEC C RANDOMISE SECONDARY ELECTRON DIRECTION C R3=RNDM2(RDUM) R3=drand48(RDUM) F3=1.0-2.0D0*R3 THETA0=DACOS(F3) F6=DCOS(THETA0) F5=DSIN(THETA0) C R4=RNDM2(RDUM) R4=drand48(rdum) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) DCX(NPONT)=F9*F5 DCY(NPONT)=F8*F5 DCZ(NPONT)=F6 IPL(NPONT)=IPLANE C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ID=ID+1 ICOLL(IPT)=ICOLL(IPT)+1 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPY ANGLE CONTROL IF(NISO.EQ.0) GO TO 55 C ELASTIC ANISOTROPY IF(ICANS(I).EQ.1) THEN C R31=RNDM2(RDUM) R31=drand48(RDUM) C R3=RNDM2(RDUM) R3=drand48(RDUM) F3=R3 IF(IPT.EQ.1.AND.R31.GT.PEL(1,IE)) F3=-F3 IF(IPT.EQ.6.AND.R31.GT.PEL(2,IE)) F3=-F3 IF(IPT.EQ.11.AND.R31.GT.PEL(3,IE)) F3=-F3 IF(IPT.EQ.16.AND.R31.GT.PEL(4,IE)) F3=-F3 C INELASTIC ANISOTROPY ELSE IF(INDEX(I).NE.0) THEN C R31=RNDM2(RDUM) R31=drand48(RDUM) C R3=RNDM2(RDUM) R3=drand48(RDUM) F3=R3 IF(R31.GT.PIN(INDEX(I),IE)) F3=-F3 ELSE C ISOTROPIC C R3=RNDM2(RDUM) R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF GO TO 56 C 55 R3=RNDM2(RDUM) 55 R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 56 THETA0=DACOS(F3) C R4=RNDM2(RDUM) 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 WRITE(6,9232) ITER,ID,E1 9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 190 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 190 CONTINUE C STORE DIRECTION COSINES AND ENERGY AFTER N COLLISIONS C FOR LATER REUSE IN PRIMARY GENERATION I100=I100+1 IF(I100.EQ.200) THEN DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 E100=E1 I100=0 ENDIF IF(IPRINT.GT.JPRINT) GO TO 200 GO TO 1 C INTERMEDIATE PRINTOUT 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 DFTP1=1.0D+16*SUMDX(1)/TTOTS DFTP2=1.0D+16*SUMDY/TTOTS XID=DFLOAT(ID) AVE=SUME/XID AVE2=SUME2/TTOTS IF(J1.EQ.1) WRITE(6,201) 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VEL POS TIME / ENERGY ENERGY COUNT DFTP1 DFTP2') WRITE(6,202) W,ZTOTS,TTOTS,AVE,AVE2,ID,DFTP1,DFTP2 202 FORMAT(1X,F8.3,2(1X,E10.3),2(1X,F7.3),4X,I9,2X,2(3X,E10.4)) J1=J1+1 GO TO 1 C MAIN LOOP END 700 XID=DFLOAT(ID) IF(J1.EQ.1) THEN WRITE(6,940) NCLUS,ITER 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS), DECREASE THE /ESTIMATED ALPHA. NCLUS = ',I7,' ITER =',I9) STOP ENDIF WRITE(6,878) NCLUS,NMXADD,NELEC,NEION,IPRIM,ID 878 FORMAT(/,' NCLUS=',I8,' NMXADD=',I3,' NELEC=',I8,' NEION=',I6,' I /PRIM=',I6,' ID=',I10) EPRMBAR=0.0D0 E2PRM=0.0D0 IF(IPRIM.EQ.1) GO TO 315 DO 310 I=1,IPRIM E2PRM=E2PRM+EPRM(I)*EPRM(I) 310 EPRMBAR=EPRMBAR+EPRM(I) EBAR=EPRMBAR/IPRIM EERR=DSQRT(E2PRM/IPRIM-EBAR**2) WRITE(6,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY = +-',F10.3,' EV.') WRITE(6,835) (IESPECP(J),J=1,100) 835 FORMAT(/,2X,'ENERGY SPECTRUM OF PRIMARY ELECTRONS IN 1 EV. BINS',/ /,10(2X,10I5,/)) RETURN 315 IF(ITER.GT.ITERMAX) THEN WRITE(6,991) ITER,ITERMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' ITERMAX =',I10,/, /' NPONT=',I4,' NELEC=',I8,' IPRIM=',I4,' NMXADD=',I3) STOP ENDIF RETURN END SUBROUTINE TPLANE(T,ST,X,Y,Z,E1,DCX1,DCY1,DCZ1,AP,BP,EFLD,IPLANE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/TPLINIT/NEXC1 COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/OUTPT/TIME(300),ICOLL(20),SPEC(2000),WE(61),WENE(61),TMAX1, /AVE,AVE2,XID,W,NNULL COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),NEXC1TPL(8) C----------------------------------------------------------------------- C STORES POSITION, TIME AND ENERGY AND SUMS REQUIRED C TO CALCULATE DEVIATIONS AND MEANS AT PLANE =IPLANE C ALSO UPDATES NO OF COLLISIONS GIVING EXCITED STATES IN GAS 1 C (NEXC1TPL) THIS CAN BE USED FOR PENNING EFFECT CALCULATION. C----------------------------------------------------------------------- TIMESP=IPLANE*TSTEP C CALC TIME LEFT TO ARRIVE AT PLANE TIMLFT=TIMESP-ST T2LFT=TIMLFT*TIMLFT A=AP*TIMLFT B=BP*T2LFT EPLANE=E1+A+B CONST6=DSQRT(E1/EPLANE) C DCX2=DCX1*CONST6 C DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFLD*TIMLFT*CONST5/DSQRT(EPLANE) XPLANE=X+DCX1*TIMLFT*DSQRT(E1)*CONST3*0.01D0 YPLANE=Y+DCY1*TIMLFT*DSQRT(E1)*CONST3*0.01D0 ZPLANE=Z+DCZ1*TIMLFT*DSQRT(E1)*CONST3*0.01D0+T2LFT*EFLD*CONST2 VZPLANE=DCZ2*DSQRT(EPLANE)*CONST3*0.01D0 XTPL(IPLANE)=XTPL(IPLANE)+XPLANE YTPL(IPLANE)=YTPL(IPLANE)+YPLANE ZTPL(IPLANE)=ZTPL(IPLANE)+ZPLANE XXTPL(IPLANE)=XXTPL(IPLANE)+XPLANE*XPLANE YYTPL(IPLANE)=YYTPL(IPLANE)+YPLANE*YPLANE ZZTPL(IPLANE)=ZZTPL(IPLANE)+ZPLANE*ZPLANE ETPL(IPLANE)=ETPL(IPLANE)+EPLANE TTPL(IPLANE)=TTPL(IPLANE)+ST+TIMLFT VZTPL(IPLANE)=VZTPL(IPLANE)+VZPLANE NETPL(IPLANE)=NETPL(IPLANE)+1 NEXC1TPL(IPLANE)=NEXC1TPL(IPLANE)+(ICOLL(4)-NEXC1) NEXC1=ICOLL(4) RETURN END SUBROUTINE FRIEDLAND IMPLICIT REAL*8 (A-H,O-Z) COMMON/FRED/FCION(2002),FCATT(2002) COMMON/OUTPT/TIME(300),ICOLL(20),SPEC(2000),WE(61),WENE(61),TMAX1, /AVE,AVE2,XID,W,NNULL COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/LARGE/CF(2000,64),EIN(64),TCF(2000),IARRY(64),RGAS(64), /IPN(64),WPL(64),LAST COMMON/MIX2/E(2002),EROOT(2002),QTOT(2002),QREL(2002),QINEL(2002), /QEL(2002) DIMENSION FR(2000) C ------------------------------------------------------- C CALCULATE DISTRIBUTION FUNCTION USING FRIEDLAND TECHNIQUE C CF: J.FRIEDLAND PHYSICS OF FLUIDS 20(1461)1977 C USE DITRIBUTION FUNCTION TO CALCULATE AVERAGE ENERGY C IONISATION RATE AND ATTACHMENT RATE. C----------------------------------------------------- ALFBAR=0.0D0 ATTBAR=0.0D0 EBAR=0.0D0 FSUM=0.0D0 DO 100 I=1,2000 FR(I)=SPEC(I)/TCF(I) EBAR=EBAR+E(I)*SPEC(I)/TCF(I) ALFBAR=ALFBAR+FCION(I)*SPEC(I)/TCF(I) ATTBAR=ATTBAR+FCATT(I)*SPEC(I)/TCF(I) 100 FSUM=FSUM+FR(I) DO 200 I=1,2000 200 FR(I)=FR(I)/FSUM EBAR=EBAR/TTOTS ALFBAR=ALFBAR/TTOTS ATTBAR=ATTBAR/TTOTS WRITE(6,900) EBAR,ALFBAR,ATTBAR 900 FORMAT(2(/),' ESTIMATE USING FRIEDLAND : EBAR =',E10.4,'EV. ALFAB /AR = ',E10.3,' UNITS OF 10**12/SEC',/,' ALFATT =',E10.3,' UNITS O /F 10**12/SEC') RETURN END SUBROUTINE PT IMPLICIT REAL*8 (A-H,O-Z) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),NEXC1TPL(8) DIMENSION RI(8),EPT(8),VZPT(8),TTEST(8),REXC1(8) C ------------------------------------------------ C CALCULATES PULSED TOWNSEND COEFFICIENTS C------------------------------------------------- RI(1)=(DLOG(DFLOAT(NETPL(1)))-DLOG(DFLOAT(IPRIM)))/TSTEP EPT(1)=ETPL(1)/NETPL(1) TTEST(1)=TTPL(1)/NETPL(1) VZPT(1)=1.0D+09*VZTPL(1)/NETPL(1) REXC1(1)=NEXC1TPL(1)*RI(1)/(IPRIM*(DEXP(RI(1)*TSTEP)-1.0D0)) DO 10 I=2,ITFINAL IF(NETPL(I).EQ.0) THEN ITFINAL=I-1 GO TO 11 ENDIF RI(I)=(DLOG(DFLOAT(NETPL(I)))-DLOG(DFLOAT(NETPL(I-1))))/TSTEP APRIM=DFLOAT(NETPL(I-1)) REXC1(I)=NEXC1TPL(I)*RI(I)/(APRIM*(DEXP(RI(I)*TSTEP)-1.0D0)) EPT(I)=ETPL(I)/NETPL(I) TTEST(I)=TTPL(I)/NETPL(I) VZPT(I)=1.0D+09*VZTPL(I)/NETPL(I) 10 CONTINUE 11 WRITE(6,900) ITFINAL 900 FORMAT(2(/),' PULSED TOWNSEND RESULTS AT',I2,' SEQUENTIAL TIME PLA /NES',/,' PLANE NO. (ION-ATT) FREQ. MEAN ENERGY WV / NO. OF ELECTRONS GAS1 EXC FREQ.',/) DO 20 IPL=1,ITFINAL WRITE(6,910) IPL,RI(IPL),EPT(IPL),VZPT(IPL),NETPL(IPL),REXC1(IPL) 910 FORMAT(5X,I3,7X,3E15.4,5X,I8,6X,E12.5) 20 CONTINUE RETURN END SUBROUTINE TOF IMPLICIT REAL*8 (A-H,O-Z) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/TPLOUT/ETPL(8),XTPL(8),YTPL(8),ZTPL(8),TTPL(8),XXTPL(8), /YYTPL(8),ZZTPL(8),VZTPL(8),NETPL(8),NEXC1TPL(8) DIMENSION DLTF(8),DXTF(8),DYTF(8),WR(8) C---------------------------------------------------------- C CALCULATES TIME OF FLIGHT COEFFICIENTS C--------------------------------------------- WR(1)=ZTPL(1)/(NETPL(1)*TSTEP) DLTF(1)=((ZZTPL(1)/NETPL(1))-(ZTPL(1)/NETPL(1))**2)/(2.0D0*TSTEP) DXTF(1)=((XXTPL(1)/NETPL(1))-(XTPL(1)/NETPL(1))**2)/(2.0D0*TSTEP) DYTF(1)=((YYTPL(1)/NETPL(1))-(YTPL(1)/NETPL(1))**2)/(2.0D0*TSTEP) DO 10 I=2,ITFINAL WR(I)=((ZTPL(I)/NETPL(I))-(ZTPL(I-1)/NETPL(I-1)))/TSTEP DLTF(I)=((ZZTPL(I)/NETPL(I))-(ZTPL(I)/NETPL(I))**2-(ZZTPL(I-1)/NET /PL(I-1))+(ZTPL(I-1)/NETPL(I-1))**2)/(2.0D0*TSTEP) DXTF(I)=((XXTPL(I)/NETPL(I))-(XTPL(I)/NETPL(I))**2-(XXTPL(I-1)/NET /PL(I-1))+(XTPL(I-1)/NETPL(I-1))**2)/(2.0D0*TSTEP) DYTF(I)=((YYTPL(I)/NETPL(I))-(YTPL(I)/NETPL(I))**2-(YYTPL(I-1)/NET /PL(I-1))+(YTPL(I-1)/NETPL(I-1))**2)/(2.0D0*TSTEP) 10 CONTINUE DO 15 I=1,ITFINAL WR(I)=WR(I)*1.0D+09 DLTF(I)=DLTF(I)*1.0D+16 DXTF(I)=DXTF(I)*1.0D+16 DYTF(I)=DYTF(I)*1.0D+16 15 CONTINUE WRITE(6,900) ITFINAL 900 FORMAT(2(/),' TIME OF FLIGHT RESULTS AT',I2,' SEQUENTIAL TIME PLAN /ES',/,' PLANE NO. DL DX DY / WR ',/) DO 20 IPL=1,ITFINAL WRITE(6,910) IPL,DLTF(IPL),DXTF(IPL),DYTF(IPL),WR(IPL) 910 FORMAT(5X,I3,6X,4E15.4) 20 CONTINUE RETURN END SUBROUTINE MONTEFD IMPLICIT REAL*8 (A-H,O-Z) COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,X,Y,Z,ST,TCFMAX(10), /RSTART,EFIELD,NMAX COMMON/LARGE/CF(2000,64),EIN(64),TCF(2000),IARRY(64),RGAS(64), /IPN(64),WPL(64),LAST COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/DIFFC/SUMDV(5),SUMDX(2),DSUM2,DXSUM2,DFTP,DFLP,STD,STD1, /DFTP1,DFTP2,DFTP3,DFLP1,DFLP2,DFLP3 COMMON/OUTPT/TIME(300),ICOLL(20),SPEC(2000),WE(61),WENE(61),TMAX1, /AVE,AVE2,XID,W,NNULL COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/IPS/XSS(200),YSS(200),ZSS(200),TSS(200),ESS(200), /DCXS(200),DCYS(200),DCZS(200),IPLS(200) COMMON/SPLOUT/ESPL(8),XSPL(8),YSPL(8),ZSPL(8),TSPL(8),XXSPL(8), /YYSPL(8),ZZSPL(8),VZSPL(8),TSSUM(8),TSSUM2(8),NESST(9),NEX1SST(8) COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, /ZPLANE7,ZPLANE8,IZFINAL COMMON/SSTINIT/NEXC1SST,ICOLN(20) COMMON/ANIS/PEL(4,2002),PIN(8,2002),KEL(4),INDEX(64),NISO DIMENSION EPRM(4000000),IESPECP(100),ICANS(64) C---------------------------------------------------------------------- C CALCULATES COLLISION EVENTS AND UPDATES DIFFUSION AND VELOCITY. C THIS ROUTINE HANDLES TERMINATIONS AT FIXED DRIFT DISTANCES. C ------------------------------------------------------------------- C SET ANISOTROPY CONTROL FOR ELASTIC COLLISIONS DO 123 I=1,64 ICANS(I)=0 IF(IARRY(I).EQ.1.AND.KEL(1).EQ.1) ICANS(I)=1 IF(IARRY(I).EQ.6.AND.KEL(2).EQ.1) ICANS(I)=1 IF(IARRY(I).EQ.11.AND.KEL(3).EQ.1) ICANS(I)=1 123 IF(IARRY(I).EQ.16.AND.KEL(4).EQ.1) ICANS(I)=1 S=0.0D0 SUMDY=0.0D0 SUME=0.0D0 SUME2=0.0D0 SMALL=1.0D-20 TMAX1=0.0D0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01D0 DO 33 I=1,100 33 IESPECP(I)=0 ID=0 I100=0 NCOL=0 NNULL=0 NELEC=0 NEION=0 NMXADD=0 NPONT=0 NCLUS=0 J1=1 ZSTRT=0.0D0 TSSTRT=0.0D0 C INITIAL DIRECTION COSINES DCZ1=DCOS(THETA) DCX1=DSIN(THETA)*DCOS(PHI) DCY1=DSIN(THETA)*DSIN(PHI) DCX100=DCX1 DCY100=DCY1 DCZ100=DCZ1 E100=E1 BP=EFIELD*EFIELD*CONST1 F1=EFIELD*CONST2 F2=EFIELD*CONST3 F4=2.0D0*API TLIM=TCFMAX(1) ITERMAX=NMAX JPRINT=ITERMAX/10 IPRINT=0 ITER=0 ITERM2=2*ITERMAX IPRIM=0 C LOOP FOR NEW STARTING ELECTRONS 544 IPRIM=IPRIM+1 IZPLANE=0 TZSTOP=1000.0D0 IF(IPRIM.GT.1) THEN C CHECK IF PROGRAM WILL EXCEED MAXIMUM NUMBER OF ITERATIONS IN THIS C CYCLE , IF SO OUTPUT CURRENT RESULTS. IF(ITER.GT.ITERMAX) THEN IPRIM=IPRIM-1 GO TO 700 ENDIF X=0.0D0 Y=0.0D0 Z=0.0D0 DCZ1=DCZ100 DCX1=DCX100 DCY1=DCY100 NCLUS=NCLUS+1 E1=E100 ST=0.0 ZSTRT=0.0D0 TSSTRT=0.0D0 ENDIF IF(IPRIM.GT.4000000) THEN WRITE(6,944) IPRIM 944 FORMAT(2X,' PROGRAM STOPPED TOO MANY PRIMARIES IPRIM=',I7) STOP ENDIF EPRM(IPRIM)=E1 IDUM=INT(E1)+1 IDUM=MIN0(IDUM,100) IESPECP(IDUM)=IESPECP(IDUM)+1 C START OF LOOP FOR NEWLY CREATED ELECTRONS . 555 TDASH=0.0D0 NELEC=NELEC+1 C MAIN LOOP 1 CONTINUE IF(ITER.GT.ITERM2) GO TO 315 ITER=ITER+1 IPRINT=IPRINT+1 C R1=RNDM2(RDUM) R1=drand48(RDUM) T=-DLOG(R1)/TLIM+TDASH TOLD=TDASH TDASH=T AP=DCZ1*F2*DSQRT(E1) 15 IF(T.GE.TZSTOP.AND.TOLD.LT.TZSTOP) THEN TLFT=TZSTOP C STORE POSITION AND ENERGY AT Z PLANE = IZPLANE. CALL SPLANE(T,ST,X,Y,Z,E1,DCX1,DCY1,DCZ1,AP,BP,EFIELD,TLFT, /IZPLANE) C******************************************************************** C C CHANGE IF STATEMENT FROM (IZFINAL+1) TO (IZFINAL-1) C FOR ANODE TERMINATION . C********************************************************************* IF(IZPLANE.GE.(IZFINAL+1)) THEN 18 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT NEXC1SST=ICOLN(4) C NO MORE ELECTRONS IN CASCADE RETURN TO MAIN. IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C TAKE ELECTRONS FROM STORE 20 X=XSS(NPONT) Y=YSS(NPONT) Z=ZSS(NPONT) ST=TSS(NPONT) E1=ESS(NPONT) DCX1=DCXS(NPONT) DCY1=DCYS(NPONT) DCZ1=DCZS(NPONT) IZPLANE=IPLS(NPONT) NPONT=NPONT-1 ZSTRT=Z TSSTRT=ST IF(Z.GT.ZFINAL) THEN C CHECK IF ELECTRON HAS ENOUGH ENERGY TO GO BACK TO FINAL PLANE EPOT=EFIELD*(Z-ZFINAL)*100.0D0 IF(E1.LT.EPOT) THEN NELEC=NELEC+1 ISOL=1 GO TO 18 ENDIF ENDIF CALL TCALC(Z,DCZ1,E1,EFIELD,TZSTOP,TZSTOP1,ISOL,IZPLANE) IF(TZSTOP.EQ.-99.0D0) THEN C CATCH RUNAWAY ELECTRONS AT HIGH FIELD NELEC=NELEC+1 ISOL=1 GO TO 18 ENDIF GO TO 555 ENDIF C IF TWO SOLUTIONS REPEAT ENTRY FOR SECOND SOLUTION. IF(ISOL.EQ.2) THEN TZSTOP=TZSTOP1 ISOL=1 GO TO 15 ENDIF ENDIF E=E1+(AP+BP*T)*T IF(E.LT.0.0D0) THEN WRITE(6,999) E,E1,AP,BP,T,DCZ1,ITER 999 FORMAT(2X,' WARNING ENERGY LT.0. E=',E12.3,' E1=',E12.3,' AP=',E1 /2.3,' BP=',E12.3,' T=',E12.3,/,' DCZ1=',E12.3,' ITER=',I10) E=0.001D0 ENDIF IE=INT(E/ESTEP)+1 IE=MIN0(IE,2000) C C TEST FOR REAL OR NULL COLLISION C C R5=RNDM2(RDUM) R5=drand48(RDUM) TTEM=TCF(IE)/TLIM IF(R5.LE.TTEM)GO TO 137 NNULL=NNULL+1 GO TO 1 C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. 137 T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0D0 CONST6=DSQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0D0+B/3.0D0) CONST7=CONST9*DSQRT(E1) A=T*CONST7 NCOL=NCOL+1 CZ1=DCZ1*CONST7 X=X+DCX1*A Y=Y+DCY1*A Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0D0) IT=MIN0(IT,300) TIME(IT)=TIME(IT)+1.0D0 CX1=DCX1*CONST7 CY1=DCY1*CONST7 SUMDX(1)=SUMDX(1)+0.5D0*CX1*CX1*T2 SUMDY=SUMDY+0.5D0*CY1*CY1*T2 SUME=SUME+E1+0.5D0*(AP*T+0.5D0*T2*BP) SPEC(IE)=SPEC(IE)+1.0D0 C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- C R2=RNDM2(RDUM) 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 FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF A BINING ERROR OCCURS. C WRITE(6,994) E,EI,ITER C994 FORMAT(3X,' WARNING BINNING ERROR ENERGY =',F8.3,' EI=',F8.3,' ITE C /R =',I12) EI=E-0.0001D0 ENDIF IF(IPN(I).EQ.0) GO TO 666 C ATTACHMENT IF(IPN(I).EQ.-1) THEN NEION=NEION+1 IPT=IARRY(I) ID=ID+1 ICOLL(IPT)=ICOLL(IPT)+1 IF(Z.LT.ZPLANE8) ICOLN(IPT)=ICOLN(IPT)+1 IT=INT(T+1.0D0) IT=MIN0(IT,300) TIME(IT)=TIME(IT)+1.0D0 ZTOT=ZTOT+Z TTOT=TTOT+ST ZTOTS=ZTOTS+Z-ZSTRT TTOTS=TTOTS+ST-TSSTRT IDM1=1+INT(Z/ZSTEP) IF(IDM1.GT.9) IDM1=9 NESST(IDM1)=NESST(IDM1)-1 IF(IDM1.LE.8) THEN NEX1SST(IDM1)=NEX1SST(IDM1)+ICOLN(4)-NEXC1SST NEXC1SST=ICOLN(4) ELSE NEXC1SST=ICOLN(4) ENDIF C ELECTRON CAPTURED START NEW PRIMARY IF(NELEC.EQ.(NCLUS+1)) GO TO 544 C ELECTRON CAPTURED TAKE NEXT ELECTRON FROM STORE GO TO 20 ENDIF C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN . C R9=RNDM2(RDUM) R9=drand48(RDUM) C ESEC=R9*(E-EI) C USE OPAL PETERSON AND BEATY SPLITTING FACTOR. ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I)))) EI=ESEC+EI C STORE POSITION ,ENERGY, DIRECTION COSINES AND TIME OF GENERATION C OF IONISATION ELECTRON NCLUS=NCLUS+1 NPONT=NPONT+1 NMXADD=MAX(NPONT,NMXADD) IF(NPONT.GT.200) THEN WRITE(6,546) NPONT,ITER 546 FORMAT(2X,' PROGRAM STOPPED NPONT=',I3,' ITER=',I10) STOP ENDIF XSS(NPONT)=X YSS(NPONT)=Y ZSS(NPONT)=Z TSS(NPONT)=ST ESS(NPONT)=ESEC C RANDOMISE SECONDARY ELECTRON DIRECTION C R3=RNDM2(RDUM) R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 THETA0=DACOS(F3) F6=DCOS(THETA0) F5=DSIN(THETA0) C R4=RNDM2(RDUM) R4=drand48(RDUM) PHI0=F4*R4 F8=DSIN(PHI0) F9=DCOS(PHI0) DCXS(NPONT)=F9*F5 DCYS(NPONT)=F8*F5 DCZS(NPONT)=F6 IDM1=1+INT(Z/ZSTEP) IF(IDM1.GT.9) IDM1=9 IPLS(NPONT)=IDM1 NESST(IPLS(NPONT))=NESST(IPLS(NPONT))+1 C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 IPT=IARRY(I) ID=ID+1 ICOLL(IPT)=ICOLL(IPT)+1 IF(Z.LT.ZPLANE8) ICOLN(IPT)=ICOLN(IPT)+1 S2=(S1*S1)/(S1-1.0D0) C ANISOTROPY ANGLE CONTROL IF(NISO.EQ.0) GO TO 55 C ELASTIC ANISOTROPY IF(ICANS(I).EQ.1) THEN C R31=RNDM2(RDUM) R31=drand48(RDUM) C R3=RNDM2(RDUM) R3=drand48(RDUM) F3=R3 IF(IPT.EQ.1.AND.R31.GT.PEL(1,IE)) F3=-F3 IF(IPT.EQ.6.AND.R31.GT.PEL(2,IE)) F3=-F3 IF(IPT.EQ.11.AND.R31.GT.PEL(3,IE)) F3=-F3 IF(IPT.EQ.16.AND.R31.GT.PEL(4,IE)) F3=-F3 C INELASTIC ANISOTROPY ELSE IF(INDEX(I).NE.0) THEN C R31=RNDM2(RDUM) R31=drand48(RDUM) C R3=RNDM2(RDUM) R3=drand48(RDUM) F3=R3 IF(R31.GT.PIN(INDEX(I),IE)) F3=-F3 ELSE C ISOTROPIC C R3=RNDM2(RDUM) R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 ENDIF GO TO 56 C 55 R3=RNDM2(RDUM) 55 R3=drand48(RDUM) F3=1.0D0-2.0D0*R3 56 THETA0=DACOS(F3) C R4=RNDM2(RDUM) 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 WRITE(6,9232) ITER,ID,E1 9232 FORMAT(3X,' WARNING ARGZ= 0.0 AT ITER =',I10,' ID=',I10,' E1=',E /12.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GO TO 190 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 190 CONTINUE C STORE DIRECTION COSINES AND ENERGY AFTER N COLLISIONS C FOR LATER REUSE IN PRIMARY GENERATION. I100=I100+1 IF(I100.EQ.200) THEN DCZ100=DCZ1 DCX100=DCX1 DCY100=DCY1 E100=E1 I100=0 ENDIF IF(Z.GT.ZFINAL) THEN C CHECK IF ELECTRON HAS ENOUGH ENERGY TO GO BACK TO FINAL PLANE. EPOT=EFIELD*(Z-ZFINAL)*100.0D0 IF(E1.LT.EPOT) GO TO 18 ENDIF C CALCULATE TIME TZSTOP TO ARRIVE AT NEXT Z PLANE IZPLANE. CALL TCALC(Z,DCZ1,E1,EFIELD,TZSTOP,TZSTOP1,ISOL,IZPLANE) C CATCH RUNAWAY ELECTRONS AT HIGH FIELD IF(TZSTOP.EQ.-99.0D0) GO TO 18 IF(IPRINT.GT.JPRINT) GO TO 200 GO TO 1 C INTERMEDIATE PRINTOUT 200 IPRINT=0 W=ZTOTS/TTOTS W=W*1.0D+09 DFTP1=1.0D+16*SUMDX(1)/TTOTS DFTP2=1.0D+16*SUMDY/TTOTS XID=DFLOAT(ID) AVE=SUME/XID AVE2=SUME2/TTOTS IF(J1.EQ.1) WRITE(6,201) 201 FORMAT(/,7X,'INTERMEDIATE OUTPUT',/,' VEL POS TIME / ENERGY ENERGY COUNT DFTP1 DFTP2') WRITE(6,202) W,ZTOTS,TTOTS,AVE,AVE2,ID,DFTP1,DFTP2 202 FORMAT(1X,F8.3,2(1X,E10.3),1X,2(F7.3,2X),2X,I9,5X,2(E10.4,2X)) J1=J1+1 GO TO 1 C MAIN LOOP END 700 XID=DFLOAT(ID) IF(J1.EQ.1) THEN WRITE(6,940) NCLUS,ITER,NELEC,NEION 940 FORMAT(2(/),' PROGRAM STOPPED (TOO FEW COLLISIONS), DECREASE THE /ESTIMATED ALPHA. NCLUS=',I7,' ITER =',I9,' NELEC=',I9,' NEION =' /,I6) ENDIF WRITE(6,878) NCLUS,NMXADD,NELEC,NEION,IPRIM,ID 878 FORMAT(/,' NCLUS=',I8,' NMXADD=',I3,' NELEC=',I8,' NEION=',I6,' I /PRIM=',I6,' ID=',I10) EPRMBAR=0.0D0 E2PRM=0.0D0 IF(IPRIM.EQ.1) GO TO 315 DO 310 I=1,IPRIM E2PRM=E2PRM+EPRM(I)*EPRM(I) 310 EPRMBAR=EPRMBAR+EPRM(I) EBAR=EPRMBAR/IPRIM EERR=DSQRT(E2PRM/IPRIM-EBAR**2) WRITE(6,836) EBAR,EERR 836 FORMAT(/,2X,'AVERAGE ENERGY OF PRIMARY ELECTRON =',F10.3,' EV.',/, /' ENERGY SPREAD OF PRIMARY = +-',F10.3,' EV.') WRITE(6,837) (IESPECP(J),J=1,100) 837 FORMAT(/,2X,'ENERGY SPECTRUM OF PRIMARIES IN 1EV BINS',/,10(2X,10I /5,/)) RETURN 315 IF(ITER.GT.ITERMAX) THEN WRITE(6,991) ITER,ITERMAX,NPONT,NELEC,IPRIM,NMXADD 991 FORMAT(2(/),' PROGRAM STOPPED. ITER =',I10,' ITERMAX =',I10,/, /' NPONT=',I4,' NELEC=',I8,' IPRIM=',I6,' NMXADD=',I3) STOP ENDIF RETURN END SUBROUTINE SPLANE(T,ST,X,Y,Z,E1,DCX1,DCY1,DCZ1,AP,BP,EFLD,TIMLFT, /IZPLANE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/SPLOUT/ESPL(8),XSPL(8),YSPL(8),ZSPL(8),TSPL(8),XXSPL(8), /YYSPL(8),ZZSPL(8),VZSPL(8),TSSUM(8),TSSUM2(8),NESST(9),NEX1SST(8) COMMON/SPL1/TMSPL(8),TTMSPL(8),RSPL(8),RRSPL(8),RRSPM(8) COMMON/SSTINIT/NEXC1SST,ICOLN(20) C-------------------------------------------------------- C STORES POSITION, TIME AND ENERGY AND SUMS REQUIRED C TO CALCULATE DEVIATIONS AND MEANS AT PLANE =IZPLANE C---------------------------------------------------- IF(IZPLANE.GT.8) RETURN T2LFT=TIMLFT*TIMLFT A=AP*TIMLFT B=BP*T2LFT EPLANE=E1+A+B CONST6=DSQRT(E1/EPLANE) C DCX2=DCX1*CONST6 C DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EFLD*TIMLFT*CONST5/DSQRT(EPLANE) XPLANE=X+DCX1*TIMLFT*DSQRT(E1)*CONST3*0.01D0 YPLANE=Y+DCY1*TIMLFT*DSQRT(E1)*CONST3*0.01D0 ZPLANE=Z+DCZ1*TIMLFT*DSQRT(E1)*CONST3*0.01D0+T2LFT*EFLD*CONST2 VZPLANE=DCZ2*DSQRT(EPLANE)*CONST3*0.01D0 WGHT=DABS(1.0D0/VZPLANE) RPLANE=DSQRT(XPLANE**2+YPLANE**2) XSPL(IZPLANE)=XSPL(IZPLANE)+XPLANE*WGHT YSPL(IZPLANE)=YSPL(IZPLANE)+YPLANE*WGHT RSPL(IZPLANE)=RSPL(IZPLANE)+RPLANE*WGHT ZSPL(IZPLANE)=ZSPL(IZPLANE)+ZPLANE*WGHT TMSPL(IZPLANE)=TMSPL(IZPLANE)+(ST+TIMLFT)*WGHT TTMSPL(IZPLANE)=TTMSPL(IZPLANE)+(ST+TIMLFT)*(ST+TIMLFT)*WGHT XXSPL(IZPLANE)=XXSPL(IZPLANE)+XPLANE*XPLANE*WGHT YYSPL(IZPLANE)=YYSPL(IZPLANE)+YPLANE*YPLANE*WGHT RRSPM(IZPLANE)=RRSPM(IZPLANE)+RPLANE*RPLANE*WGHT ZZSPL(IZPLANE)=ZZSPL(IZPLANE)+ZPLANE*ZPLANE*WGHT ESPL(IZPLANE)=ESPL(IZPLANE)+EPLANE*WGHT TSPL(IZPLANE)=TSPL(IZPLANE)+WGHT/(ST+TIMLFT) VZSPL(IZPLANE)=VZSPL(IZPLANE)+VZPLANE*WGHT TSSUM(IZPLANE)=TSSUM(IZPLANE)+WGHT TSSUM2(IZPLANE)=TSSUM2(IZPLANE)+WGHT*WGHT IZP=0 IF(Z.GT.(IZPLANE*ZSTEP)) IZP=1 IZZ=IZPLANE+IZP IF(IZZ.GT.8) RETURN NEX1SST(IZZ)=NEX1SST(IZZ)+ICOLN(4)-NEXC1SST NEXC1SST=ICOLN(4) RETURN END SUBROUTINE TCALC(Z,DCZ1,E1,EFIELD,TZSTOP1,TZSTOP2,ISOL,IZPLANE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5 COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, /ZPLANE7,ZPLANE8,IZFINAL C---------------------------------------------------------------------- C CALCULATE ELAPSED TIME ,TZSTOP1, UNTIL ARRIVAL AT NEXT PLANE ,IZPLANE. C IF TWO POSITIVE SOLUTIONS SET ISOL=2 AND CALCULATE SECOND SOLUTION C TZSTOP2. C----------------------------------------------------------------------- ISOL=1 A=EFIELD*CONST2 B=DSQRT(E1)*CONST3*0.01D0*DCZ1 B2=B*B IF(Z.LT.ZPLANE1) THEN IZPLANE=1 C1=Z-ZPLANE1 ELSE IF(Z.LT.ZPLANE2) THEN IZPLANE=2 C1=Z-ZPLANE2 C2=Z-ZPLANE1 ELSE IF(Z.LT.ZPLANE3) THEN IZPLANE=3 C1=Z-ZPLANE3 C2=Z-ZPLANE2 ELSE IF(Z.LT.ZPLANE4) THEN IZPLANE=4 C1=Z-ZPLANE4 C2=Z-ZPLANE3 ELSE IF(Z.LT.ZPLANE5) THEN IZPLANE=5 C1=Z-ZPLANE5 C2=Z-ZPLANE4 ELSE IF(Z.LT.ZPLANE6) THEN IZPLANE=6 C1=Z-ZPLANE6 C2=Z-ZPLANE5 ELSE IF(Z.LT.ZPLANE7) THEN IZPLANE=7 C1=Z-ZPLANE7 C2=Z-ZPLANE6 ELSE IF(Z.LT.ZPLANE8) THEN IZPLANE=8 C1=Z-ZPLANE8 C2=Z-ZPLANE7 ELSE IZPLANE=9 C1=Z-ZPLANE8-10.0D0*ZSTEP C2=Z-ZPLANE8 ENDIF C CHECK PLANE IN DRIFT DIRECTION ( ONLY ONE TIME SOLUTION POSITIVE) FAC=B2-4.0D0*A*C1 IF(FAC.LT.0.0D0) THEN C PASSED FINAL PLANE (RUNAWAY ELECTRONS) TZSTOP1=-99.0D0 RETURN ENDIF TSTOP1=(-B+DSQRT(B2-4.0D0*A*C1))/(2.0D0*A) TSTOP2=(-B-DSQRT(B2-4.0D0*A*C1))/(2.0D0*A) IF(TSTOP1.LT.TSTOP2) THEN IF(TSTOP1.GE.0.0D0)THEN TZSTOP1=TSTOP1 ELSE TZSTOP1=TSTOP2 ENDIF IF(IZPLANE.EQ.1) RETURN ELSE IF(TSTOP2.GE.0.0D0) THEN TZSTOP1=TSTOP2 ELSE TZSTOP1=TSTOP1 ENDIF IF(IZPLANE.EQ.1) RETURN ENDIF C CHECK PLANE IN BACKWARD DIRECTION (ONLY IF REAL SOLUTION) FAC=B2-4.0D0*A*C2 IF(FAC.LT.0.0D0) RETURN TSTOP1=(-B+DSQRT(FAC))/(2.0D0*A) TSTOP2=(-B-DSQRT(FAC))/(2.0D0*A) C SOLUTIONS CAN BE EITHER BOTH POSITIVE OR BOTH NEGATIVE C PICK POSITIVE SOLUTIONS AND ORDER IN TIME SEQUENCE OR C RETURN IF NEGATIVE IF(TSTOP1.LT.0.0D0) RETURN C FOUND BACKWARD SOLUTIONS ISOL=2 IZPLANE=IZPLANE-1 IF(TSTOP1.LT.TSTOP2) THEN TZSTOP1=TSTOP1 TZSTOP2=TSTOP2 ELSE TZSTOP1=TSTOP2 TZSTOP2=TSTOP1 ENDIF RETURN END SUBROUTINE SST IMPLICIT REAL*8 (A-H,O-Z) COMMON/CION/ALPHAST,VDST,TSTEP,ZSTEP,TFINAL,ZFINAL,ITFINAL,IPRIM COMMON/SPLOUT/ESPL(8),XSPL(8),YSPL(8),ZSPL(8),TSPL(8),XXSPL(8), /YYSPL(8),ZZSPL(8),VZSPL(8),TSSUM(8),TSSUM2(8),NESST(9),NEX1SST(8) COMMON/SPL1/TMSPL(8),TTMSPL(8),RSPL(8),RRSPL(8),RRSPM(8) COMMON/CTCALC/ZPLANE1,ZPLANE2,ZPLANE3,ZPLANE4,ZPLANE5,ZPLANE6, /ZPLANE7,ZPLANE8,IZFINAL DIMENSION ESST(8),VDSST(8),WSSST(8),DXSST(8),DYSST(8),WTEMP(8) DIMENSION ALFNE(8),ALFNJ(8),ALFN(8),ZSST(8),DLSST(8) DIMENSION DRSS1(8),DRSS2(8),DRSS3(8),ALFEX1(8),NEPL(8) C---------------------------------------------------------------------- C CALCULATES STEADY STATE TOWNSEND COEFFICIENTS. C ------------------------------------------------------------------- JPRINT=IZFINAL C CALCULATE NUMBER OF ELECTRONS AT EACH PLANE NEPL(1)=IPRIM+NESST(1) DO 21 K=2,JPRINT NEPL(K)=NEPL(K-1)+NESST(K) 21 CONTINUE C SUBSTITUTE NEPL FOR NEEST DO 22 K=1,JPRINT 22 NESST(K)=NEPL(K) DO 23 I=1,JPRINT IF(NESST(I).EQ.0) THEN JPRINT=I-1 GO TO 24 ENDIF 23 CONTINUE 24 ESST(1)=ESPL(1)/TSSUM(1) ZSST(1)=ZSPL(1)/TSSUM(1) VDSST(1)=VZSPL(1)/TSSUM(1) WTEMP(1)=ZSTEP*TSSUM(1)/TMSPL(1) WSSST(1)=WTEMP(1) DXSST(1)=((XXSPL(1)/TSSUM(1))-(XSPL(1)/TSSUM(1))**2)*WSSST(1)/ /(2.0D0*ZSTEP) DYSST(1)=((YYSPL(1)/TSSUM(1))-(YSPL(1)/TSSUM(1))**2)*WSSST(1)/ /(2.0D0*ZSTEP) DLSST(1)=((TTMSPL(1)/TSSUM(1))-(TMSPL(1)/TSSUM(1))**2)*WSSST(1)**3 //(2.0D0*ZSTEP) IF(NESST(1).EQ.0) GO TO 1 ALFNE(1)=(DLOG(DFLOAT(NESST(1)))-DLOG(DFLOAT(IPRIM)))/ZSTEP APRIM=DFLOAT(IPRIM) ANEX1=DFLOAT(NEX1SST(1)) ALFEX1(1)=ANEX1*ALFNE(1)/(APRIM*(DEXP(ALFNE(1)*ZSTEP)-1.0D0)) 1 ALFNJ(1)=0.0D0 ALFN(1)=0.0D0 DO 10 I=2,JPRINT ESST(I)=ESPL(I)/TSSUM(I) ZSST(I)=ZSPL(I)/TSSUM(I) VDSST(I)=VZSPL(I)/TSSUM(I) WTEMP(I)=ZSTEP*DFLOAT(I)*TSSUM(I)/TMSPL(I) WSSST(I)=(WTEMP(I)*WTEMP(I-1))/(I*WTEMP(I-1)-(I-1)*WTEMP(I)) DXSST(I)=((XXSPL(I)/TSSUM(I))-(XSPL(I)/TSSUM(I))**2-(XXSPL(I-1)/ /TSSUM(I-1))+(XSPL(I-1)/TSSUM(I-1))**2)*WSSST(I)/(2.0D0*ZSTEP) DYSST(I)=((YYSPL(I)/TSSUM(I))-(YSPL(I)/TSSUM(I))**2-(YYSPL(I-1)/ /TSSUM(I-1))+(YSPL(I-1)/TSSUM(I-1))**2)*WSSST(I)/(2.0D0*ZSTEP) DLSST(I)=((TTMSPL(I)/TSSUM(I))-(TMSPL(I)/TSSUM(I))**2-(TTMSPL(I-1) //TSSUM(I-1))+(TMSPL(I-1)/TSSUM(I-1))**2)*WSSST(I)**3/(2.0D0*ZSTEP) ALFN(I)=(DLOG(TSSUM(I))-DLOG(TSSUM(I-1)))/ZSTEP ALFNJ(I)=(DLOG(TSSUM(I)*VDSST(I))-DLOG(TSSUM(I-1)*VDSST(I-1)))/ZST /EP IF(NESST(I).EQ.0.OR.NESST(I-1).EQ.0) GO TO 10 ALFNE(I)=(DLOG(DFLOAT(NESST(I)))-DLOG(DFLOAT(NESST(I-1))))/ZSTEP ANZRO=DFLOAT(NEPL(I-1)) IF(ANZRO.EQ.0.0) GO TO 10 ALFEX1(I)=NEX1SST(I)*ALFNE(I)/(ANZRO*(DEXP(ALFNE(I)*ZSTEP)-1.0D0)) 10 CONTINUE DXFIN=((XXSPL(JPRINT)/TSSUM(JPRINT))-(XSPL(JPRINT)/TSSUM(JPRINT)) /**2)*WSSST(JPRINT)/(JPRINT*2.0D0*ZSTEP) DXFIN=DXFIN*1.0D+16 DYFIN=((YYSPL(JPRINT)/TSSUM(JPRINT))-(YSPL(JPRINT)/TSSUM(JPRINT)) /**2)*WSSST(JPRINT)/(JPRINT*2.0D0*ZSTEP) DYFIN=DYFIN*1.0D+16 DLFIN=((TTMSPL(JPRINT)/TSSUM(JPRINT))-(TMSPL(JPRINT)/TSSUM(JPRINT) /)**2)*WSSST(JPRINT)**3/(JPRINT*2.0D0*ZSTEP) DLFIN=DLFIN*1.0D+16 ALNGTH=ZSTEP*DFLOAT(JPRINT) ALFIN=DLOG(DFLOAT(NESST(JPRINT))/DFLOAT(IPRIM))/ALNGTH ALFIN=ALFIN*0.01D0 DO 15 J=1,JPRINT VDSST(J)=VDSST(J)*1.0D+09 WSSST(J)=WSSST(J)*1.0D+09 DXSST(J)=DXSST(J)*1.0D+16 DYSST(J)=DYSST(J)*1.0D+16 DLSST(J)=DLSST(J)*1.0D+16 ALFN(J)=ALFN(J)*0.01D0 ALFNJ(J)=ALFNJ(J)*0.01D0 ALFNE(J)=ALFNE(J)*0.01D0 ALFEX1(J)=ALFEX1(J)*0.01D0 15 CONTINUE WRITE(6,800) JPRINT 800 FORMAT(2(/),' STEADY STATE TOWNSEND RESULTS FOR',I2,' SEQUENTIAL S /PACE PLANES',2(/),' PLANE NEL VD WS DL DX / DY EBAR ALFN ALFNJ ALFNE ALFEX1',/) DO 20 IPL=1,JPRINT 20 WRITE(6,810)IPL,NESST(IPL),VDSST(IPL),WSSST(IPL),DLSST(IPL),DXSST( /IPL),DYSST(IPL),ESST(IPL),ALFN(IPL),ALFNJ(IPL),ALFNE(IPL),ALFEX1(I /PL) 810 FORMAT(2X,I2,2X,I7,5F8.1,F8.3,3F8.1,1X,E12.3) WRITE(6,820) DXFIN,DYFIN,DLFIN,ALFIN 820 FORMAT(2(/),2X,'DXFIN=',F9.1,' DYFIN=',F9.1,' DLFIN=',F9.1,' AL /FIN (ION-ATT) =',F9.1) RETURN END SUBROUTINE OUTPUT IMPLICIT REAL*8 (A-H,O-Z) COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH COMMON/MIX2/E(2002),EROOT(2002),QTOT(2002),QREL(2002),QINEL(2002), /QEL(2002) COMMON/MIX1/QELM(2002),QSUM(2002),QION(4,2002),QIN1(20,2002), /QIN2(20,2002),QIN3(20,2002),QIN4(20,2002),QSATT(2002) COMMON/RATIO/AN1,AN2,AN3,AN4,FRAC1,FRAC2,FRAC3,FRAC4,AN COMMON/DIFFC/SUMDV(5),SUMDX(2),DSUM2,DXSUM2,DFTP,DFLP,STD,STD1, /DFTP1,DFTP2,DFTP3,DFLP1,DFLP2,DFLP3 COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,X,Y,Z,ST,TCFMAX(10), /RSTART,EFIELD,NMAX COMMON/OUTPT/TIME(300),ICOLL(20),SPEC(2000),WE(61),WENE(61),TMAX1, /AVE,AVE2,XID,W,NNULL COMMON/TTRM/ZTOT,TTOT,ZTOTS,TTOTS COMMON/SINT/SIMF(2002) COMMON/NAMES/NAME1,NAME2,NAME3,NAME4 CHARACTER*15 NAME1,NAME2,NAME3,NAME4 DIMENSION SPECS(20) WRITE(6,15) WRITE(6,15) 15 FORMAT('---------------------------------------------------------- /--------------------------------') W=W*1.0D05 NREAL=IFIX(SNGL(XID)) WRITE(6,109) TMAX1,NNULL,NREAL 109 FORMAT(/,3X,'CALCULATED MAX. COLLISION TIME =',F7.2,' PICOSECONDS. /',/,3X,'NUMBER OF NULL COLLISIONS =',I10,/,3X,'NUMBER OF REAL COLL /ISIONS =',I10) WRITE(6,110) SPEC(2000) 110 FORMAT(/,3X,'NUMBER OF COLLISIONS IN LAST ENERGY BIN =',F9.1) FREQ=NREAL/TTOTS 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) FREQIN=NINEL/TTOTS NELA=ICOLL(1)+ICOLL(6)+ICOLL(11)+ICOLL(16) FREQEL=NELA/TTOTS WRITE(6,220) FREQ,FREQIN,FREQEL 220 FORMAT(/,13X,'AVERAGE COLL. FREQ.=',E9.3,' (*10**12)/SEC.',/,3X,'A /VERAGE INELASTIC COLL. FREQ.=',E9.3,' (*10**12)/SEC.',/,5X,'AVERAG /E ELASTIC COLL. FREQ.=',E9.3,' (*10**12)/SEC.') WRITE(6,15) ILAST=INT(TMAX1)+1 IF(ILAST.GT.300) ILAST=300 WRITE(6,1010) (TIME(I),I=1,ILAST) 1010 FORMAT(/,3X,'DISTRIBUTION OF COLLISION TIMES IN 1 PECOSECOND BINS' /,2(/),30(1X,10(F10.1,1X)/)) WRITE(6,15) WRITE(6,1050) NAME1,NAME2,NAME3,NAME4 1050 FORMAT(/,2X,'COLLISION FREQUENCIES ACCORDING TO GAS AND TYPE OF /COLLISION IN UNITS OF 10**12/SEC.',2(/),10X,A15,5X,A15,5X,A15,5X, /A15) FREQEL1=ICOLL(1)/TTOTS FREQEL2=ICOLL(6)/TTOTS FREQEL3=ICOLL(11)/TTOTS FREQEL4=ICOLL(16)/TTOTS WRITE(6,160) FREQEL1,FREQEL2,FREQEL3,FREQEL4 160 FORMAT(/,1X,'ELASTIC =',4(E10.3,10X)) FREQSP1=ICOLL(5)/TTOTS FREQSP2=ICOLL(10)/TTOTS FREQSP3=ICOLL(15)/TTOTS FREQSP4=ICOLL(20)/TTOTS WRITE(6,170) FREQSP1,FREQSP2,FREQSP3,FREQSP4 170 FORMAT(/,1X,'SUPERELASTIC=',4(E10.3,10X)) FREINE1=ICOLL(4)/TTOTS FREINE2=ICOLL(9)/TTOTS FREINE3=ICOLL(14)/TTOTS FREINE4=ICOLL(19)/TTOTS WRITE(6,180) FREINE1,FREINE2,FREINE3,FREINE4 180 FORMAT(/,1X,' INELASTIC =',4(E10.3,10X)) FREATT1=ICOLL(3)/TTOTS FREATT2=ICOLL(8)/TTOTS FREATT3=ICOLL(13)/TTOTS FREATT4=ICOLL(18)/TTOTS WRITE(6,190) FREATT1,FREATT2,FREATT3,FREATT4 190 FORMAT(/,1X,' ATTACHMENT =',4(E10.3,10X)) FREION1=ICOLL(2)/TTOTS FREION2=ICOLL(7)/TTOTS FREION3=ICOLL(12)/TTOTS FREION4=ICOLL(17)/TTOTS WRITE(6,200) FREION1,FREION2,FREION3,FREION4 200 FORMAT(/,1X,' IONISATION =',4(E10.3,10X),/) WRITE(6,15) ERRATT=0.0D0 FREATT=(FREATT1+FREATT2+FREATT3+FREATT4)*TTOTS IF(FREATT.EQ.0.0) GO TO 222 ERRATT=100.0D0*DSQRT(FREATT)/FREATT 222 ERRION=0.0D0 FREION=(FREION1+FREION2+FREION3+FREION4)*TTOTS IF(FREION.EQ.0.0D0) GO TO 224 ERRION=100.0D0*DSQRT(FREION)/FREION 224 RATATT=DABS(FREATT/(FREION-FREATT)) ERRBOT=100.0D0*DSQRT((DABS(FREION-FREATT)))/(FREION-FREATT) ERRATT=DSQRT(ERRBOT*ERRBOT+ERRATT*ERRATT) WRITE(6,333) RATATT,ERRATT 333 FORMAT(/,2X,' RATIO OF ATTACHMENT / (IONISATION - ATTACHMNT) =',E1 /2.5,' +- ',F5.1,' PERCENT.') WRITE(6,301) 301 FORMAT(2(/),10X,' NORMALISED ENERGY DISTRIBUTION') J1=0 J2=0 SMSPEC=0 DO 350 K=1,2000 SPEC(K)=SPEC(K)/XID J1=J1+1 SMSPEC=SMSPEC+SPEC(K) IF(J1.LT.100) GO TO 350 J2=J2+1 SPECS(J2)=SMSPEC SMSPEC=0.0D0 J1=0 350 CONTINUE EPLT=EFINAL/20.0D0 DO 420 I=1,20 ENER=EPLT*(DFLOAT(I)-0.5D0) WRITE(6,302) ENER,SPECS(I) 302 FORMAT(6X,'E=',F7.3,6X,'SPEC=',E10.3) 420 CONTINUE C ESTP10=ESTEP*20.0D0 C WRITE(6,997) ESTP10 C 997 FORMAT(5(/),20X,'PROBABILITY DISTRIBUTION SPECTRUM IN STEPS OF',F7 C /.4,' ELECTRON VOLTS',/,20X,'-------------------------------------- C /-------------------------------') C K=-199 C DO 300 J=1,10 C K=K+200 C K1=K+199 C IF(K1.GT.NSTEP1+200) GO TO 300 C IF(K1.GT.2000) K1=2000 C WRITE(6,999) (SPEC(L),L=K,K1,20) C 300 CONTINUE RETURN END SUBROUTINE GAS1(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(72),YXSEC(72),XVIB2(14),YVIB2(14), /XVIB3(14),YVIB3(14),XVIB4(14),YVIB4(14),XVIB5(16),YVIB5(16), /XVIB6(16),YVIB6(16),XEXC(33),YEXC(33),XION(52),YION(52), /XATT(11),YATT(11) CHARACTER*15 NAME DATA XEN/0.0,.001,.002,.003,.004,.005,.006,.007,.008,.009, /0.01,.012,.014,.016,.018,0.02,.025,0.03,.035,0.04, /.045,0.05,.055,0.06,.065,0.07,.075,0.08,.085,0.09, /0.10,0.12,0.14,0.17,0.20,0.24,0.30,0.40,0.50,0.60, /0.80,1.00,1.20,1.40,1.70,2.00,3.00,5.00,6.00,7.00, /8.00,9.00,10.0,15.0,20.0,30.0,35.0,50.0,60.0,75.0, /100.,150.,200.,300.,500.,700.,1000.,2000.,4000.,10000., /20000.,100000./ C DATA YXSEC/13.5,9.50,7.80,6.90,6.20,5.80,5.45,5.20,4.85,4.65, /4.40,4.00,3.70,3.50,3.30,3.10,2.60,2.25,1.90,1.65, /1.45,1.27,1.10,0.98,0.87,0.75,0.66,0.55,0.49,0.41, /0.29,0.17,0.14,0.16,0.20,0.30,0.48,0.90,1.40,2.00, /3.70,4.70,5.60,6.00,6.30,6.50,6.80,6.90,7.00,7.20, /7.30,7.50,7.85,9.20,9.20,8.80,8.40,6.72,5.90,5.28, /4.16,2.99,1.92,1.13,0.63,0.42,0.27,0.12,0.06,0.02, /0.01,.002/ C VIBRATION V4 (RESONANCE ONLY) DATA XVIB2/0.0784,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,50.0, /100.,1000.,10000.,100000./ DATA YVIB2/0.0,0.0,0.11,0.93,1.40,1.20,0.80,0.07,.022,.0001, /.00001,.000001,.0000001,.00000001/ C VIBRATION V1 (RESONANCE ONLY) DATA XVIB3/0.1126,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,50.0, /100.,1000.,10000.,100000./ DATA YVIB3/0.0,0.0,.037,0.31,0.47,0.40,0.27,.023,.007,.00003, /.000003,.0000003,.00000003,.000000003/ C VIBRATION V3 (RESONANCE ONLY) DATA XVIB4/0.1589,5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,50.0, /100.,1000.,10000.,100000./ DATA YVIB4/0.0,0.0,0.33,2.80,4.20,3.60,2.33,0.20,.067,.0001, /.00001,.000001,.0000001,.00000001/ C VIBRATION HARMONIC 2(V3) DATA XVIB5/0.3178,1.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0, /20.0,50.0,100.0,1000.,10000.,100000./ DATA YVIB5/0.0,.001,0.01,0.04,0.06,0.47,0.70,0.60,0.40,.033, /.011,.0005,.00001,.000001,.0000001,.00000001/ C VIBRATION HARMONIC (3(V3) + ALL OTHER HARMONICS) DATA XVIB6/0.4767,1.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0,15.0, /20.0,50.0,100.,1000.,10000.,100000./ DATA YVIB6/0.0,.001,0.08,0.16,0.24,1.84,2.80,2.40,1.60,.128, /.040,.0008,.00008,.000008,.0000008,.00000008/ DATA XION/15.9,16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,32.0,34.0,36.0,38.0,40.0,42.0,44.0,46.0,48.0, /50.0,60.0,70.0,80.0,90.0,100.,125.,150.,175.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,900., /1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000.,10000.,20000., /40000.,100000./ DATA YION/0.0,.034,.080,.137,.204,.295,.479,.656,.937,1.19, /1.41,1.62,1.83,2.03,2.18,2.38,2.60,2.78,2.98,3.25, /3.41,3.97,4.39,4.76,4.91,5.12,5.31,5.28,5.31,5.10, /4.78,4.59,4.31,4.05,3.83,3.51,3.11,2.83,2.61,2.38, /2.23,1.89,1.64,1.50,1.34,1.15,0.99,0.70,0.44,.256, /.141,.072/ DATA XATT/4.00,4.10,5.00,6.00,7.00,8.00,9.00,10.0,11.0, /12.0,100./ DATA YATT/.0,.00001,.00092,.0066,.0135,.0142,.0051,.0010,.0004, /.00001,.0000001/ C DISOCIATION X-SECTION EXCLUDING DISOCIATIVE IONISATION X-SECTION DATA XEXC/12.5,13.0,14.0,15.0,16.0,18.0,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,100.,120.,140.,160., /180.,200.,250.,300.,400.,500.,600.,1000.,2000.,4000., /10000.,20000.,100000./ DATA YEXC/0.0,.036,.156,.288,0.43,0.67,0.84,1.15,1.32,1.44, /1.53,1.56,1.60,1.62,1.63,1.63,1.62,1.60,1.58,1.55, /1.52,1.48,1.40,1.30,1.12,0.94,0.82,0.54,0.32,0.18, /0.09,0.05,.013/ C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO MARCH 2001 C ALLOWS SUPERELASTIC SCATTERING TO V4 VIBRATIONAL LEVEL C BORN ANGULAR DISTRIBUTION FOR V4 LEVEL C INCLUDED NEW IONISATION X-SECTIONS BY NISHIMURA AND READJUSTED C DISOCIATION X-SECTION TO FIT TOWNSEND MEASUREMENTS. C --------------------------------------------------------------- NAME=' CF4 --2001--- ' KIN(1)=2 KIN(2)=4 KEL=0 FAC1=1.00 FAC2=0.71 NIN=7 N2RO=0 NDATA=72 NVIB2=14 NVIB3=14 NVIB4=14 NVIB5=16 NVIB6=16 NION=52 NATT=11 NEXC=33 E(1)=0.0 E(2)=2.0*EMASS/(88.0046*AMU) E(3)=15.90 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.0784 EIN(2)=0.0784 EIN(3)=0.1126 EIN(4)=0.1589 EIN(5)=0.3178 EIN(6)=0.4767 EIN(7)=12.5 APOP=DEXP(EIN(1)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16 300 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC OF VIBRATION V4 C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.0768*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.E-16 C 305 CONTINUE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.0768*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=((A*EN+B)+QIN(2,I))*1.0/(1.0+APOP)*1.E-16 PEQIN(1,I)=0.5+(QIN(2,I)-FAC1*QIN(2,I))/QIN(2,I) 400 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.0224*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(3,I)=((A*EN+B)+QIN(3,I))*1.E-16 500 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=1.584*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 ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.58 XMT=((1.5-FWD/(FWD+BCK))*QIN(4,I)+RAT4*(A*EN+B))*1.0E-16 QIN(4,I)=((A*EN+B)+QIN(4,I))*1.E-16 PEQIN(2,I)=0.5+(QIN(4,I)-XMT)/QIN(4,I) 600 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS2(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(44),YXSEC(44),XENI(76),YXENI(76),XIN(26),YXSIN(26),Y /XPIN(26),YXDIN(26) CHARACTER*15 NAME DATA XEN/1.00,1.20,1.50,1.70,2.00,2.50,3.00,4.00,4.90,5.00, /6.00,6.67,7.00,8.00,8.71,9.00,10.0,11.0,12.0,13.0, /13.6,14.0,15.0,16.0,16.5,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,400.,1000.,2000., /4000.,10000.,20000.,100000./ DATA YXSEC/1.3913,1.66,2.05,2.33,2.70,3.43,4.15,5.65,7.26,7.46, /9.32,10.6,11.3,13.1,14.1,14.4,15.4,15.8,15.8,15.4, /15.1,14.8,14.1,13.2,13.0,11.4,10.2,7.80,6.25,4.45, /3.50,2.80,2.20,2.00,1.45,0.90,0.63,0.28,0.60,0.20, /0.10,.0048,0.0018,.00009/ DATA XENI/15.7,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /20.5,21.0,21.5,22.0,22.5,23.0,23.5,24.0,24.5,25.0, /25.5,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,110.,120.,130.,140.,150.,160.,180.,200.,250., /300.,350.,400.,450.,500.,600.,700.,800.,900.,1000., /1200.,1400.,1600.,1800.,2000.,2500.,3000.,3500.,4000.,5000., /6000.,8000.,10000.,14000.,20000.,100000./ DATA YXENI/-0.200,0.306,0.825,1.126,1.326,1.468,1.577,1.663,1.737, /1.797,1.853,1.896,1.933,1.970,1.997,2.024,2.048,2.071,2.094, /2.115,2.132,2.148,2.204,2.256,2.293,2.325,2.351,2.368,2.379, /2.396,2.404,2.414,2.424,2.436,2.443,2.450,2.454,2.455,2.456, /2.456,2.455,2.452,2.448,2.441,2.436,2.429,2.419,2.401,2.379, /2.337,2.296,2.258,2.225,2.190,2.164,2.115,2.065,2.027,1.994, /1.961,1.892,1.844,1.811,1.767,1.727,1.656,1.591,1.538,1.486, /1.413,1.349,1.242,1.166,1.050,0.923,.224/ DATA XIN/11.55,13.0,13.2,13.4,14.0,16.0,20.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,500.,700.,1000.,1400., /2000.,4000.,6000.,10000.,20000.,100000./ DATA YXSIN/0.00,.069,.090,.087,.115,.205,0.22,0.25,0.29,0.34, /0.31,.265,0.24,0.18,0.15,.115,.080,.063,.047,.036, /.028,.016,.0115,.007,.0036,.00072/ DATA YXPIN/0.00,0.00,.012,.036,.072,.205,0.42,0.54,0.53,0.50, /0.46,0.39,0.34,0.26,0.21,.165,0.11,.083,0.06,.046, /.035,.020,.0140,.009,.0042,.0009/ DATA YXDIN/0.00,0.00,0.00,0.00,0.00,.067,0.15,0.29,0.35,0.39, /0.41,0.47,0.47,0.44,0.37,.285,0.19,0.15,0.11,.081, /.061,.035,.0245,.016,.008,.0016/ NAME=' ARGON 1997 ' 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----------------------------------------------------------------- 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=3.141592654 C NIN=3 NDATA=44 NIDATA=76 NXDATA=26 E(1)=0.0 E(2)=2.0*EMASS/(39.948*AMU) E(3)=15.7 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=11.55 EIN(2)=13.0 EIN(3)=14.0 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.GT.1.0) GO TO 100 IF(EN.EQ.0.0) Q(2,I)=7.79E-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) SUM=(DSIN(AN0-AN1))**2 SUM=SUM+2.0*(DSIN(AN1-AN2))**2 DO 10 J=2,LMAX-1 SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(DSIN(DATAN(API*APOL*AK2*SUMI)))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/AK2 GO TO 200 100 CONTINUE DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 200 CONTINUE Q(3,I)=0.0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NIDATA IF(EN.LE.XENI(J)) GO TO 220 210 CONTINUE J=NIDATA 220 A=(YXENI(J)-YXENI(J-1))/(XENI(J)-XENI(J-1)) B=(XENI(J-1)*YXENI(J)-XENI(J)*YXENI(J-1))/(XENI(J-1)-XENI(J)) Q(3,I)=1.0E-18*(10.0**(A*EN+B)) 230 CONTINUE Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 QIN(2,I)=0.0 QIN(3,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NXDATA IF(EN.LE.XIN(J)) GO TO 320 310 CONTINUE J=NXDATA 320 A=(YXSIN(J)-YXSIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXSIN(J)-XIN(J)*YXSIN(J-1))/(XIN(J-1)-XIN(J)) QIN(1,I)=(A*EN+B)*1.0E-16 IF(EN.LE.EIN(2)) GO TO 400 A=(YXPIN(J)-YXPIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXPIN(J)-XIN(J)*YXPIN(J-1))/(XIN(J-1)-XIN(J)) QIN(2,I)=(A*EN+B)*1.0E-16 IF(EN.LE.EIN(3)) GO TO 400 A=(YXDIN(J)-YXDIN(J-1))/(XIN(J)-XIN(J-1)) B=(XIN(J-1)*YXDIN(J)-XIN(J)*YXDIN(J-1))/(XIN(J-1)-XIN(J)) QIN(3,I)=(A*EN+B)*1.0E-16 400 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS3(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(67),YXSEC(67),XION(48),YION(48),XEXC(25),YEXC(25), /XEXS(34),YEXS(34) CHARACTER*15 NAME DATA XEN/0.00,0.008,0.009,0.01,0.013,0.017,0.020,0.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.18,0.20, /0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.20, /1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.6,16.5,18.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,75.0,80.0,90.0,100.,150.,200., /400.,600.,1000.,2000.,10000.,20000.,100000./ DATA YXSEC/4.90,5.18,5.19,5.21,5.26,5.31,5.35,5.41,5.46,5.54, /5.62,5.68,5.74,5.79,5.83,5.86,5.94,6.04,6.12,6.16, /6.27,6.35,6.49,6.59,6.66,6.73,6.77,6.82,6.85,6.91, /6.96,6.98,6.99,6.96,6.89,6.62,6.31,6.00,5.68,5.35, /5.03,4.72,4.44,4.15,3.83,3.25,2.99,2.58,2.00,1.60, /1.06,0.77,0.57,0.46,0.40,0.37,0.30,0.26,.132,.081, /.024,.012,.0048,.0014,.00008,.00002,.0000012/ C C DECOMMENT TO INCLUDE ANISOTROPIC SCATTERING FOR DELTA CALCULATION C /1.58,1.26,1.00,0.85,0.79,0.74,0.66,0.57,0.35,0.24, C /.095,.049,.018,.005,.00018,.00005,.00001/ C---------------------------------------------------------------- DATA XION/24.587,25.0,25.5,26.0,26.5,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0, /100.,120.,150.,175.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,4000.,5000.,6000.,8000.,10000.,20000.,100000./ DATA YION/0.0,.0051,.0111,.0172,.0232,.029,.042,.054,.066,.091, /.112,.133,.153,.169,.207,.239,.267,.286,.316,.339, /.361,.367,.364,.354,.342,.316,.293,.253,.221,.197, /.177,.163,.148,.138,.119,.103,.095,.086,.078,.065, /.055,.044,.036,.032,.025,.021,.0117,.0040/ C TRIPLET EXCITATION DATA XEXC/19.82,20.0,20.2,20.5,20.6,20.8,21.0,21.3,22.0,25.0, /30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,150.,200., /400.,1000.,10000.,20000.,100000./ DATA YEXC/0.00,.047,.053,.035,.029,.043,.042,.041,.046,.075, /.071,.054,.038,.026,.017,.013,.0094,.0075,.0022,.00094, /.00012,.000008,.000000008,.000000001,.0000000003/ C SINGLET EXCITATION DATA XEXS/20.61,20.9,21.0,21.5,22.0,22.5,25.0,28.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,150.,200., /300.,400.,500.,600.,800.,1000.,1500.,2000.,3000.,4000., /6000.,10000.,20000.,100000./ DATA YEXS/0.00,.025,.022,.0265,.0315,.036,.065,.082,.092,.115, /.133,.148,.155,.175,.177,.178,.178,.177,.163,.148, /.121,.099,.086,.075,.061,.051,.038,.030,.022,.017, /.013,.0088,.0052,.0018/ NAME=' HELIUM4 97 ' C -------------------------------------------------------------------- C HELIUM 4 BEST KNOWN GAS USED AS STANDARD ACCURACY BETTER THAN 0.2% C AT ALL FIELDS. C UPDATED 1992 TO INCLUDE 20KEV RANGE ALSO ELASTIC ANISOTROPIC C INCLUDED AS OPTION C -------------------------------------------------------------------- NIN=2 NDATA=67 NION=48 NEXC=25 NEXS=34 E(1)=0.0 E(2)=2.0*EMASS/(4.00260*AMU) E(3)=24.587 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=19.82 EIN(2)=20.61 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LE.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 CONTINUE Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(1,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 700 DO 610 J=2,NEXS IF(EN.LE.XEXS(J)) GO TO 620 610 CONTINUE J=NEXS 620 A=(YEXS(J)-YEXS(J-1))/(XEXS(J)-XEXS(J-1)) B=(XEXS(J-1)*YEXS(J)-XEXS(J)*YEXS(J-1))/(XEXS(J-1)-XEXS(J)) QIN(2,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS4(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(66),YXSEC(66),XION(47),YION(47),XEXC(17),YEXC(17), /XEXS(29),YEXS(29) CHARACTER*15 NAME DATA XEN/0.00,0.008,0.009,0.01,0.013,0.017,0.020,0.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.18,0.20, /0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.20, /1.50,1.80,2.00,2.50,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.6,16.5,18.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,75.0,80.0,90.0,100.,150.,200., /400.,600.,1000.,2000.,10000.,20000./ DATA YXSEC/4.90,5.18,5.19,5.21,5.26,5.31,5.35,5.41,5.46,5.54, /5.62,5.68,5.74,5.79,5.83,5.86,5.94,6.04,6.12,6.16, /6.27,6.35,6.49,6.59,6.66,6.73,6.77,6.82,6.85,6.91, /6.96,6.98,6.99,6.96,6.89,6.62,6.31,6.00,5.68,5.35, /5.03,4.72,4.44,4.15,3.83,3.25,2.99,2.58,1.95,1.51, /0.98,0.70,0.50,0.40,0.34,0.31,0.25,0.21,.104,.063, /.020,.010,.0035,.0010,.00008,.00002/ C C DECOMMENT TO INCLUDE ANISOTROPIC SCATTERING FOR DELTA CALCULATION C /1.58,1.26,1.00,0.85,0.79,0.74,0.66,0.57,0.35,0.24, C /.095,.049,.018,.005,.00018,.00005/ C---------------------------------------------------------------- DATA XION/24.59,25.0,25.5,26.0,26.5,27.0,28.0,29.0,30.0,32.0, /34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0, /100.,120.,150.,175.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,4000.,5000.,6000.,8000.,10000.,20000./ DATA YION/0.0,.0051,.0111,.0172,.0232,.029,.042,.054,.066,.091, /.112,.133,.153,.169,.207,.239,.267,.286,.316,.339, /.361,.367,.364,.354,.342,.316,.293,.253,.221,.197, /.177,.163,.148,.138,.119,.103,.095,.086,.078,.065, /.055,.044,.036,.032,.025,.021,.0117/ C TRIPLET EXCITATION DATA XEXC/19.82,20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.,150.,200.,400.,1000.,10000.,20000./ DATA YEXC/0.00,0.03,.075,.071,.054,.038,.026,.017,.013,.0094, /.0075,.0022,.00094,.00012,.000008,.000000008,.000000001/ C SINGLET EXCITATION DATA XEXS/20.6,22.0,25.0,28.0,30.0,35.0,40.0,45.0,50.0,60.0, /70.0,80.0,90.0,100.,150.,200.,300.,400.,500.,600., /800.,1000.,1500.,2000.,3000.,4000.,6000.,10000.,20000./ DATA YEXS/0.00,0.04,.065,.082,.092,.115,.133,.148,.155,.175, /.177,.178,.178,.177,.163,.148,.121,.099,.086,.075, /.061,.051,.038,.030,.022,.017,.013,.0088,.0052/ NAME=' HELIUM3 92 ' C -------------------------------------------------------------------- C HELIUM 3 BEST KNOWN GAS USED AS STANDARD ACCURACY BETTER THAN 0.2% C AT ALL FIELDS. C UPDATED 1992 TO INCLUDE 20KEV RANGE ALSO ELASTIC ANISOTROPIC C INCLUDED AS OPTION C -------------------------------------------------------------------- NIN=2 NDATA=66 NION=47 NEXC=17 NEXS=29 E(1)=0.0 E(2)=2.0*EMASS/(3.01600*AMU) E(3)=24.59 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=19.82 EIN(2)=20.6 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LE.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 CONTINUE Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(1,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 700 DO 610 J=2,NEXS IF(EN.LE.XEXS(J)) GO TO 620 610 CONTINUE J=NEXS 620 A=(YEXS(J)-YEXS(J-1))/(XEXS(J)-XEXS(J-1)) B=(XEXS(J-1)*YEXS(J)-XEXS(J)*YEXS(J-1))/(XEXS(J-1)-XEXS(J)) QIN(2,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS5(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(43),YXSEC(43),XEXC(50),YEXC(50),XION(68),YION(68) CHARACTER*15 NAME DATA XEN/1.00,1.20,1.50,1.80,2.00,2.50,3.00,4.00,5.00, /6.00,7.00,8.00,8.71,9.00,10.0,11.0,13.6,15.0,16.5, /19.6,20.0,30.0,40.0,50.0,60.0,70.0,77.0,100.,130., /150.,170.,200.,300.,400.,600.,800.,1000.,2000.,4000., /10000.,20000.,40000.,100000./ DATA YXSEC/1.62,1.69,1.75,1.79,1.82,1.86,1.91,1.98,2.07, /2.14,2.21,2.29,2.35,2.37,2.44,2.51,2.66,2.71,2.76, /2.83,2.84,2.84,2.78,2.58,2.30,2.12,2.03,1.53,1.21, /1.03,0.90,.756,0.52,0.42,0.33,0.27,0.25,0.13,.075, /.034,.019,.011,.005/ C CAN USE INSTEAD OF MOMENTUM X-SECT FOR DELTA CALC. C /2.83,2.84,2.84,2.84,2.84.2.84,2.72,2.57,2.22,1.93, C /1.74,1.63,1.45,1.12,0.90,0.72,0.59,0.49,0.28,.156, C /.070,.039,.022,.010/ DATA XION/21.56,22.0,22.5,23.0,23.5,24.0,24.5,25.0,25.5,26.0, /27.0,28.0,29.0,30.0,32.0,34.0,36.0,40.0,45.0,50.0, /55.0,60.0,65.0,70.0,75.0,80.0,90.0,100.,110.,120., /140.,150.,175.,200.,250.,300.,350.,400.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,3500.,4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000., /10000.,12000.,14000.,16000.,18000.,20000.,50000.,100000./ DATA YION/0.00,.0033,.0089,.0146,.020,.026,.032,.038,.044,.050, /.063,.076,.089,.102,.128,.154,.179,.228,.282,.338, /.391,.435,.477,.514,.547,.577,.628,.667,.700,.725, /.757,.772,.781,.781,.757,.722,.686,.628,.586,.528, /.484,.444,.413,.386,.333,.301,.273,.248,.230,.195, /.168,.149,.133,.122,.113,.104,.0976,.0860,.0772,.0706, /.0649,.0563,.0495,.0444,.0406,.0373,.0183,.0109/ DATA XEXC/16.615,16.78,16.97,17.3,18.4,18.7,18.8,19.8,20.0,21.0, /22.0,24.0,26.0,28.0,30.0,35.0,40.0,50.0,60.0,70.0, /80.0,90.0,100.,120.,150.,200.,250.,300.,400.,500., /600.,700.,800.,900.,1000.,1200.,1500.,2000.,2500.,3000., /4000.,5000.,6000.,7000.,8000.,9000.,10000.,20000.,50000.,100000./ DATA YEXC/0.0,.0034,.0185,.012,.0181,.0349,.0280,.05,.0523,.0732, /.0923,.123,.143,.162,.176,.195,.205,.207,.203,.195, /.187,.179,.171,.157,.138,.117,.102,.091,.075,.064, /.057,.051,.047,.043,.040,.035,.030,.024,.019,.017, /.014,.0118,.0103,.0092,.0083,.0075,.0070,.0041,.002,.0012/ C NAME=' NEON 92 ' NIN=1 NDATA=43 NION=68 NEXC=50 E(1)=0.0 E(2)=2.0*EMASS/(20.179*AMU) E(3)=21.56 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=16.615 APOL=2.672 LMAX=100 AA=0.2135 DD=3.86 FF=-2.656 A1=1.846 B1=3.29 A2=-0.037 API=3.141592654 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.GT.1.0) GO TO 100 IF(EN.EQ.0.0) Q(2,I)=0.161E-16 IF(EN.EQ.0.0) GO TO 200 AK=SQRT(EN/ARY) AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK*AK*LOG(AK))-(API*APOL/3.0)*AK*AK /+DD*AK*AK*AK+FF*AK*AK*AK*AK AN1=(0.560*AK*AK-A1*AK*AK*AK)/(1.0+B1*AK*AK) AN2=0.080*AK*AK-A2*AK*AK*AK*AK*AK SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 DO 10 J=2,LMAX-1 SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(API*APOL*AK*AK*SUMI))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/(AK*AK) GO TO 200 100 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 200 CONTINUE Q(3,I)=0.0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0E-16 230 CONTINUE Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 370 DO 350 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 360 350 CONTINUE J=NEXC 360 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(1,I)=(A*EN+B)*1.0E-16 370 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I) 900 CONTINUE IF(EFINAL.LT.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS6(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(83),YXSEC(83),XION(71),YION(71), /XEXC1(95),YEXC1(95),XEXC2(76),YEXC2(76), /XEXC3(71),YEXC3(71),XEXC4(63),YEXC4(63),XELA(93),YELA(93) CHARACTER*15 NAME C ELASTIC MOMENTUM TRANSFER DATA XEN/1.D-6,.001,.003,.005,.007,0.01,.015,0.02,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.52,0.54,0.56,0.60, /0.70,0.80,0.90,1.00,1.20,1.40,1.70,2.00,2.50,3.00, /3.30,3.60,4.00,4.40,4.80,5.20,5.60,6.00,6.50,7.00, /7.50,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /20.0,30.0,40.0,50.0,60.0,75.0,100.,150.,200.,300., /400.,500.,700.,1000.,1500.,2000.,3000.,4000.,6000.,8000., /10000.,20000.,100000./ DATA YXSEC/37.4,33.1,30.0,27.9,26.2,24.2,21.6,19.5,16.3,13.9, /12.1,10.6,9.30,8.35,7.38,6.65,5.45,4.40,3.25,2.45, /1.55,0.92,0.52,0.26,.145,.103,.100,.104,.110,.133, /.235,.375,.535,0.74,1.26,1.74,2.55,3.40,4.75,6.35, /7.32,8.28,9.51,10.7,11.9,13.2,14.2,15.2,16.2,17.2, /17.9,18.4,18.7,18.1,17.2,16.0,14.8,13.6,12.5,11.4, /8.18,4.08,2.47,1.71,1.43,1.35,1.30,0.90,0.80,0.64, /0.54,0.45,0.40,0.30,0.21,0.16,0.12,0.09,.065,.052, /.044,.025,.005/ C ELASTIC DATA XELA/1.D-6,.001,.003,.005,.007,0.01,.015,0.02,0.03,0.04, /0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.55,0.60,0.65,0.70, /0.72,0.74,0.76,0.80,0.85,0.90,0.95,1.00,1.10,1.20, /1.30,1.40,1.50,1.75,2.00,2.25,2.50,3.00,3.50,4.00, /5.00,6.00,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0, /15.0,16.0,18.0,20.0,22.5,25.0,27.5,30.0,35.0,40.0, /45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150.,175., /200.,250.,300.,400.,500.,600.,700.,800.,1000.,2000., /4000.,6000.,10000./ DATA YELA/37.4,34.6,31.8,29.9,28.4,26.6,24.1,22.2,19.1,16.8, /14.9,13.4,12.1,11.0,10.0,9.15,7.71,6.56,5.21,4.38, /3.22,2.31,1.75,1.30,1.04,0.83,0.65,0.57,0.50,0.46, /0.45,0.44,0.45,0.46,0.48,0.53,0.60,0.67,0.85,1.07, /1.32,1.54,1.84,2.23,3.02,3.83,4.68,6.36,8.24,10.1, /14.1,18.5,22.0,25.0,26.2,27.2,27.6,27.5,26.8,26.3, /24.9,23.7,22.3,21.0,19.3,17.3,15.8,14.9,13.2,11.5, /10.7,9.68,8.80,8.00,7.15,6.35,5.69,4.98,4.30,3.97, /3.73,3.43,3.06,2.71,2.45,2.33,2.15,1.99,1.81,1.36, /.974,.738,0.55/ C IONISATION DATA XION/13.996,14.5,15.0,15.5,16.0,16.5,17.0,17.5,18.0,18.5, /19.0,19.5,20.0,21.0,22.0,23.0,24.0,26.0,28.0,30.0, /32.0,34.0,36.0,38.0,40.0,45.0,50.0,55.0,60.0,65.0, /70.0,80.0,90.0,100.,120.,140.,160.,180.,200.,250., /300.,400.,500.,600.,700.,800.,900.,1000.,1200.,1400., /1600.,1800.,2000.,2500.,3000.,3500.,4000.,4500.,5000.,5500., /6000.,7000.,8000.,9000.,10000.,12000.,14000.,16000.,18000.,20000., /100000./ DATA YION/0.00,.078,.160,.255,.358,.465,.576,.684,.799,.906, /1.01,1.12,1.22,1.41,1.58,1.76,1.93,2.24,2.52,2.77, /2.96,3.13,3.26,3.39,3.49,3.67,3.84,3.97,4.09,4.17, /4.21,4.26,4.23,4.20,4.08,3.91,3.75,3.61,3.46,3.13, /2.87,2.46,2.16,1.94,1.76,1.60,1.49,1.39,1.20,1.07, /.975,.895,.818,.699,.606,.534,.480,.435,.405,.373, /.348,.307,.277,.251,.230,.199,.176,.157,.145,.132, /.039/ C EXCITATION TO FIRST 4 S STATES DATA XEXC1/9.915,9.92,9.93,9.94,9.95,9.96,9.98,10.0,10.02,10.04, /10.06,10.08,10.09,10.1,10.11,10.12,10.13,10.14,10.15,10.16, /10.17,10.18,10.19,10.2,10.25,10.3,10.4,10.5,10.6,10.7, /10.8,10.9,11.0,11.3,11.6,11.8,12.0,12.5,13.0,13.5, /14.0,14.5,15.0,15.5,16.0,17.0,18.0,19.0,20.0,22.0, /24.0,27.0,30.0,33.0,36.0,40.0,44.0,50.0,54.0,60.0, /70.0,80.0,90.0,100.,120.,140.,170.,200.,240.,280., /320.,360.,400.,450.,500.,600.,700.,800.,1000.,1400., /2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000.,40000., /100000.,200000.,400000.,1000000.,1500000./ DATA YEXC1/0.00, /.00033,.00103,.00173,.00242,.00310,.00445,.00578,.00709,.00856, /.0105,.0127,.0152,.0217,.0372,.0640,.0937,.108,.0971,.0697, /.0443,.0300,.0250,.0244,.0287,.0333,.0422,.0507,.0593,.0697, /.081,.092,.103,.132,.158,.173,.188,.219,.244,.265, /.282,.296,.308,.318,.326,.338,.347,.353,.357,.361, /.361,.357,.351,.343,.335,.324,.314,.299,.289,.276, /.256,.239,.225,.212,.190,.173,.153,.138,.122,.110, /.0998,.0918,.0850,.0780,.0722,.0630,.0561,.0506,.0426,.0327, /.0246,.0212,.0177,.0140,.0116,.0100,.0079,.0066,.0037,.0021, /.00109,.00072,.00054,.00046,.00046/ C EXCITATION TO NEXT GROUP OF P STATES DATA XEXC2/11.304,11.35,11.4,11.45,11.5,11.6,11.7,11.8,11.9,12.0, /12.1,12.2,12.3,12.4,12.5,12.6,12.7,12.8,12.9,13.0, /13.5,14.0,14.5,15.0,15.5,16.0,17.0,18.0,19.0,20.0, /22.0,24.0,27.0,30.0,33.0,36.0,40.0,44.0,50.0,54.0, /60.0,70.0,80.0,90.0,100.,120.,140.,170.,200.,240., /280.,320.,360.,400.,450.,500.,600.,700.,800.,1000., /1400.,2000.,2400.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /40000.,100000.,200000.,400000.,1000000.,1500000./ DATA YEXC2/0.0, /.00073,.00151,.0026,.0059,.0141,.0225,.0304,.0381,.0454, /.0523,.0589,.0653,.0713,.0771,.0826,.0878,.0928,.0976,.102, /.122,.137,.150,.159,.166,.171,.177,.180,.179,.177, /.170,.161,.147,.134,.122,.112,.101,.0911,.0797,.0735, /.0659,.0563,.0492,.0439,.0397,.0335,.0291,.0245,.0214,.0183, /.0161,.0145,.0132,.0121,.0110,.0101,.0087,.0077,.0069,.0058, /.00443,.00332,.00286,.00238,.00188,.00156,.00135,.00106,.00088, /.00050,.00029,.000146,.000097,.000073,.000063,.000063/ C EXCITATION TO GROUP OF S P AND D STATES ABOVE 12 EV DATA XEXC3/11.998,12.05,12.1,12.2,12.3,12.4,12.5,12.6,12.7,12.8, /12.9,13.0,13.2,13.4,13.6,13.8,14.0,14.5,15.0,15.5, /16.0,17.0,18.0,19.0,20.0,22.0,24.0,27.0,30.0,33.0, /36.0,40.0,44.0,50.0,54.0,60.0,70.0,80.0,90.0,100., /120.,140.,170.,200.,240.,280.,320.,360.,400.,450., /500.,600.,700.,800.,1000.,1400.,2000.,2400.,3000.,4000., /5000.,6000.,8000.,10000.,20000.,40000.,100000.,200000.,400000., /1000000.,1500000./ DATA YEXC3/0.0, /.0014,.0027,.0170,.0308,.0441,.0570,.0696,.0818,.0937, /.105,.116,.138,.158,.177,.195,.212,.250,.282,.308, /.331,.365,.388,.403,.412,.416,.411,.394,.373,.352, /.331,.307,.285,.257,.242,.222,.195,.175,.159,.146, /.126,.111,.0955,.0841,.0729,.0647,.0583,.0532,.0490,.0448, /.0412,.0358,.0317,.0285,.0239,.0183,.0137,.0118,.00986,.00779, /.00648,.00558,.00440,.00365,.00207,.00119,.00061,.00040,.00030, /.00026,.00026/ C EXCIATION OF ALL STATES ABOVE 12.75 EV DATA XEXC4/12.75,12.8,12.9,13.0,13.2,13.4,13.6,13.8,14.0,14.5, /15.0,15.5,16.0,17.0,18.0,19.0,20.0,22.0,24.0,27.0, /30.0,33.0,36.0,40.0,44.0,50.0,54.0,60.0,70.0,80.0, /90.0,100.,120.,140.,170.,200.,240.,280.,320.,360., /400.,450.,500.,600.,700.,800.,1000.,1400.,2000.,2400., /3000.,4000.,5000.,6000.,8000.,10000.,20000.,40000.,100000., /200000.,400000.,1000000.,1500000./ DATA YEXC4/0.0, /.00005,.000455,.00124,.00388,.00780,.0129,.0189,.0259,.0465, /.0705,.097,.125,.184,.243,.300,.354,.453,.536,.637, /.712,.768,.809,.846,.868,.884,.887,.883,.864,.838, /.809,.780,.725,.676,.612,.560,.503,.458,.420,.389, /.362,.334,.311,.273,.244,.221,.187,.145,.110,.0948, /.0793,.0628,.0524,.0451,.0356,.0296,.0168,.00965,.00495, /.00329,.00248,.0021,.0021/ C NAME=' KRYPTON 2001 ' C C -------------------------------------------------------------------- C DATA ON KRYPTON NOT AS GOOD AS ARGON . FIT TO HUNTERS DRIFT VELOCITY C AND DIFFUSION OF KOZUMI .TOWNSEND COEFFICIENT C OF KRUITOFF,HEYLEN AND BHATTACHYRA CONSISENT SO AVERAGED AND GOOD C AGREEMENT OBTAINED WITH CALCULATED VALUES. C -------------------------------------------------------------------- C NIN=4 NDATA=83 NION=71 NEXC1=95 NEXC2=76 NEXC3=71 NEXC4=63 E(1)=0.0 E(2)=2.0*EMASS/(83.80*AMU) E(3)=13.996 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=9.915 EIN(2)=11.304 EIN(3)=11.998 EIN(4)=12.75 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.EQ.0.0) Q(2,I)=37.8E-16 IF(EN.EQ.0.0) GO TO 200 DO 110 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 110 CONTINUE J=NDATA C USE LOG INTERPOLATION 160 Y1=DLOG(YXSEC(J-1)) Y2=DLOG(YXSEC(J)) X1=DLOG(XEN(J-1)) X2=DLOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=DEXP((A*DLOG(EN)+B))*1.0D-16 200 CONTINUE Q(3,I)=0.0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 230 CONTINUE Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C EXCITATION TO FIRST FOUR 5S-LEVELS QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 370 DO 350 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 360 350 CONTINUE J=NEXC1 360 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(1,I)=(A*EN+B)*1.0D-16 370 CONTINUE C EXCITATION TO 5P-LEVELS QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 470 DO 450 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 460 450 CONTINUE J=NEXC2 460 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(2,I)=(A*EN+B)*1.0D-16 470 CONTINUE C EXCITATION TO 5D + 4D + 5P' LEVELS (UP TO 12.5 EV) QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 570 DO 550 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 560 550 CONTINUE J=NEXC3 560 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 570 CONTINUE C EXCITATION TO ALL LEVELS ABOVE 12.75 EV. QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 670 DO 650 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 660 650 CONTINUE J=NEXC4 660 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 670 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS7(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(116),YXSEC(116),XION(77),YION(77) DIMENSION XEXC1(98),YEXC1(98),XEXC2(76),YEXC2(76),XEXC3(67) DIMENSION YEXC3(67),XEXC4(62),YEXC4(62) CHARACTER*15 NAME C DATA XEN/0.00,.001,.005,.007,0.01,.015,0.02,.025,0.03,0.04, /0.05,0.06,0.07,0.08,0.10,0.12,0.14,0.17,0.20,0.25, /0.27,0.30,0.32,0.35,0.37,0.40,0.42,0.44,0.46,0.48, /0.50,0.51,0.52,0.53,0.54,0.55,0.56,0.57,0.58,0.59, /0.60,0.61,0.62,0.63,0.64,0.65,0.66,0.67,0.68,0.69, /0.70,.715,0.73,0.75,0.77,0.80,0.83,0.85,0.87,0.90, /1.00,1.08,1.14,1.20,1.30,1.40,1.50,1.70,2.00,2.50, /3.00,3.50,4.00,4.50,5.00,5.50,6.00,6.50,7.00,8.00, /9.00,10.0,12.0,15.0,18.0,20.0,25.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,125.,150.,200.,250.,300., /400.,500.,600.,700.,800.,1000.,1500.,2000.,3000.,4000., /5000.,6000.,8000.,10000.,20000.,200000./ DATA YXSEC/131.,115.,97.0,91.1,83.9,74.6,67.3,61.2,56.1,47.9, /41.4,36.2,31.8,28.2,22.5,18.1,14.8,11.1,8.36,5.33, /4.47,3.43,2.88,2.22,1.86,1.43,1.20,1.01,.844,.708, /.596,.548,.504,.465,.430,.399,.372,.348,.328,.310, /.296,.285,.276,.270,.266,.265,.266,.270,.276,.287, /.306,.341,.377,.427,.479,.562,.651,.713,.778,.880, /1.26,1.62,1.92,2.25,2.85,3.51,4.22,5.73,7.97,11.8, /15.8,20.4,24.4,28.0,30.7,31.5,32.3,31.6,31.0,27.5, /22.8,18.5,14.0,9.71,7.73,6.72,5.35,4.43,3.42,2.81, /2.42,2.17,2.00,1.89,1.80,1.73,1.65,1.24,.982,.910, /.802,.741,.720,.702,.600,.490,.305,.222,.139,.100, /0.08,.065,.045,.036,0.02,.002/ C DATA XION/12.13,12.5,13.0,13.5,14.0,14.5,15.0,15.5,16.0,16.5, /17.0,18.0,19.0,20.0,21.0,22.0,23.0,24.0,26.0,28.0, /30.0,32.0,34.0,36.0,40.0,45.0,50.0,55.0,60.0,65.0, /70.0,80.0,90.0,100.,110.,120.,130.,140.,150.,160., /180.,200.,250.,300.,350.,400.,450.,500.,550.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,1800.,2000.,2500., /3000.,3500.,4000.,4500.,5000.,5500.,6000.,7000.,8000.,9000., /10000.,12000.,14000.,16000.,18000.,20000.,200000./ DATA YION/0.00,.110,.256,.412,.572,.742,.906,1.07,1.23,1.38, /1.53,1.80,2.05,2.28,2.49,2.74,2.93,3.10,3.37,3.62, /3.85,4.05,4.19,4.29,4.48,4.68,4.84,4.94,5.03,5.08, /5.12,5.18,5.27,5.38,5.45,5.45,5.42,5.29,5.19,5.07, /4.84,4.58,4.22,3.90,3.60,3.35,3.13,2.95,2.76,2.62, /2.38,2.18,2.01,1.88,1.65,1.45,1.34,1.21,1.12,.955, /.825,.727,.655,.595,.549,.509,.475,.418,.377,.342, /.315,.270,.239,.216,.198,.184,.015/ DATA XEXC1/8.315,8.35,8.40,8.45,8.50,8.55,8.60,8.65,8.70,8.75, /8.80,8.85,8.90,8.95,9.00,9.05,9.10,9.15,9.20,9.25, /9.30,9.35,9.40,9.45,9.50,9.55,9.60,9.65,9.70,9.75, /9.80,9.90,10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0, /15.0,16.0,18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,90.0,100.,120.,140.,160., /180.,200.,240.,280.,320.,360.,400.,450.,500.,600., /700.,800.,900.,1000.,1200.,1400.,1600.,2000.,2400.,2800., /3200.,3600.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000., /15000.,20000.,30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC1/0.00,.0121,.025,.028,.027,.030,.0360,.042,.0477,.0538, /.0608,.0698,.082,.097,.110,.120,.121,.117,.112,.110, /.111,0.12,0.13,0.16,.215,.250,.223,.175,.152,.150, /.153,.162,.170,.185,.200,.215,.242,.300,0.36,.403, /.443,.478,.533,.575,.605,.627,.642,.650,.655,.660, /.655,.615,.595,.560,.530,.500,.475,.430,.390,.365, /.340,.320,.280,.255,.230,.215,.200,.180,.165,.145, /.130,.115,.105,.0955,.083,.0735,.066,.055,.048,.042, /.0375,.034,.0315,.0285,.026,.0225,.020,.018,.016,.015, /.0105,.0085,.006,.005,.0035,.003,.0025,.0017/ DATA XEXC2/9.447,9.45,9.50,9.55,9.60,9.65,9.70,9.75,9.80,9.90, /10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0,15.0,16.0, /18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,120.,140.,160.,180.,200., /240.,280.,320.,360.,400.,450.,500.,600.,700.,800., /900.,1000.,1200.,1400.,1600.,2000.,2400.,2800.,3200.,3600., /4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000.,15000.,20000., /30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC2/0.00,.0036,.0112,.0165,.0164,.016,.0183,.028,.039,.066, /.0921,.140,.184,.223,.289,.408,.480,.525,.552,.567, /.580,.578,.570,.560,.548,.536,.524,.495,.469,.425, /.390,.360,.336,.315,.296,.266,.242,.223,.207,.193, /.171,.154,.140,.129,.119,.110,.101,.0886,.0788,.0712, /.0650,.0599,.0520,.0460,.0414,.0346,.0299,.0263,.0236,.0215, /.0197,.0179,.0164,.0141,.0124,.0111,.0101,.00921,.00658,.00520, /.00374,.00298,.00219,.00178,.00152,.00101/ DATA XEXC3/9.917,10.0,10.2,10.4,10.6,11.0,12.0,13.0,14.0,15.0, /16.0,18.0,20.0,22.0,24.0,26.0,28.0,30.0,35.0,40.0, /50.0,60.0,70.0,80.0,90.0,100.,120.,140.,160.,180., /200.,240.,280.,320.,360.,400.,450.,500.,600.,700., /800.,900.,1000.,1200.,1400.,1600.,2000.,2400.,2800.,3200., /3600.,4000.,4500.,5000.,6000.,7000.,8000.,9000.,10000.,15000., /20000.,30000.,40000.,60000.,80000.,100000.,200000./ DATA YEXC3/0.00,.000005,.0405,.123,.198,.328,.641,.844,.978,1.07, /1.13,1.19,1.22,1.22,1.21,1.20,1.18,1.16,1.11,1.06, /.969,.894,.830,.776,.730,.689,.621,.567,.522,.485, /.453,.402,.362,.331,.304,.282,.259,.240,.210,.187, /.169,.155,.143,.124,.110,.0986,.0825,.0713,.0629,.0564, /.0513,.0470,.0427,.0391,.0337,.0296,.0265,.0241,.0221,.0158, /.0125,.00897,.00715,.00525,.00426,.00366,.00243/ DATA XEXC4/11.70,12.0,13.0,14.0,15.0,16.0,18.0,20.0,22.0,24.0, /26.0,28.0,30.0,35.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.,120.,140.,160.,180.,200.,240.,280.,320.,360., /400.,450.,500.,600.,700.,800.,900.,1000.,1200.,1400., /1600.,2000.,2400.,2800.,3200.,3600.,4000.,4500.,5000.,6000., /7000.,8000.,9000.,10000.,15000.,20000.,30000.,40000.,60000.,8E4, /100000.,200000./ DATA YEXC4/0.00,.00202,.0311,.0808,.140,.202,.321,.427,.515,.588, /.648,.696,.734,.799,.834,.854,.841,.817,.787,.757, /.727,.672,.623,.581,.545,.513,.460,.417,.382,.354, /.329,.303,.282,.247,.221,.200,.183,.169,.147,.130, /.117,.0985,.0852,.0752,.0675,.0614,.0563,.0512,.0469,.0404, /.0356,.0319,.0289,.0265,.0190,.0150,.0108,.00862,.00633,.00515, /.00442,.00293/ C NAME=' XENON 2001 ' C C -------------------------------------------------------------------- C DATA ON XENON NOT AS GOOD AS ARGON . USED MOMENTUM TRANSFER C X-SECTION FROM SCHMIDT. AND FIT TO TOWNSEND COEFFICIENT OF C JACQUES ET AL J.PHYS D 19 (1986) 1731-1739 AND KRUITHOF TO OBTAIN C INELASTIC X-SECTIONS. C -------------------------------------------------------------------- C C NIN=4 NDATA=116 NION=77 NEXC1=98 NEXC2=76 NEXC3=67 NEXC4=62 E(1)=0.0 E(2)=2.0*EMASS/(131.30*AMU) E(3)=12.13 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=8.315 EIN(2)=9.447 EIN(3)=9.917 EIN(4)=11.70 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.LE.XEN(2)) THEN Q(2,I)=122.D-16 GO TO 200 ENDIF DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 160 150 CONTINUE J=NDATA 160 YXJ=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 200 CONTINUE Q(3,I)=0.0 IF(EN.LE.E(3)) GO TO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GO TO 220 210 CONTINUE J=NION 220 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.0D-16 230 CONTINUE Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 370 DO 350 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 360 350 CONTINUE J=NEXC1 360 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(1,I)=(A*EN+B)*1.0D-16 370 CONTINUE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 470 DO 450 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 460 450 CONTINUE J=NEXC2 460 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(2,I)=(A*EN+B)*1.0D-16 470 CONTINUE QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 570 DO 550 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 560 550 CONTINUE J=NEXC3 560 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.0D-16 570 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 670 DO 650 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 660 650 CONTINUE J=NEXC4 660 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.0D-16 670 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) 900 CONTINUE IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS8(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(70),YXSEC(70),XVIB1(30),YVIB1(30),XVIB2(27),YVIB2(27 /),XION(82),YION(82),XATT(14),YATT(14),XDIS1(31),YDIS1(31), /XDIS2(31),YDIS2(31),XDIS3(31),YDIS3(31),XDIS4(31),YDIS4(31) CHARACTER*15 NAME DATA XEN/0.00,0.001,0.004,0.007,0.01,0.012,0.014,0.017,0.02,0.025, /0.03,0.035,0.04,0.05,0.06,0.07,0.08,0.10,0.12,0.14, /0.17,0.20,0.25,0.28,0.32,0.36,0.40,0.45,0.50,0.60, /0.70,0.80,1.00,1.20,1.40,1.70,2.00,2.50,3.00,3.50, /4.00,5.00,6.00,7.00,8.00,9.00,10.0,12.0,15.0,20.0, /30.0,40.0,50.0,60.0,80.0,100.,150.,200.,300.,400., /500.,600.,800.,1000.,2000.,4000.,6000.,8000.,10000.,20000./ DATA YXSEC/23.0,23.0,18.8,17.0,15.6,14.0,13.0,12.2,11.5,10.0, /8.69,7.84,6.90,5.65,4.70,3.83,3.31,2.30,1.75,1.30, /0.81,.522,.335,.282,.252,.242,.261,.300,.400,.732, /1.08,1.29,1.84,2.13,2.54,3.20,4.05,5.80,7.90,10.5, /11.7,14.5,16.3,17.2,17.6,17.6,17.0,15.0,13.0,8.50, /4.70,3.30,2.40,2.10,1.60,1.30,1.00,0.80,0.65,0.55, /0.46,0.40,0.34,0.30,0.20,0.12,0.09,0.08,0.07,.035/ C ELASTIC CROSS-SECTION FOR RANGE CALCS. C /11.0,17.5,22.0,24.0,24.0,23.0,22.0,21.0,19.0,14.5, C /10.0,8.00,7.30,6.80,5.00,4.00,2.70,2.40,1.70,1.50, C /1.20,1.00,0.80,0.65,0.38,0.21,0.15,0.12,0.10,0.05/ DATA XVIB1/0.00,0.162,0.165,0.17,0.18,0.20,0.23,0.30,0.40,0.50, /0.60,0.70,0.80,1.00,2.00,2.50,3.00,5.00,6.00,7.00,7.50, /8.00,10.0,15.0,20.0,30.0,100.0,1000.,10000.,20000./ DATA YVIB1/0.00,0.00,.043,.241,.384,.527,.459,0.300,.181,.159, /.165,.170,.177,.180,0.18,0.20,0.25,0.75,1.00,1.05,1.05, /1.00,0.85,0.55,0.35,0.20,0.05,0.01,.001,.0005/ DATA XVIB2/0.00,0.374,0.38,0.40,0.45,0.50,0.55,0.60,0.65,0.70, /0.80,1.00,2.00,3.00,5.00,6.00,7.00,7.50,8.00,10.0,15.0, /20.0,30.0,100.,1000.,10000.,20000./ DATA YVIB2/0.00,0.00,.143,.330,.440,.495,.442,.360,.330,.308, /.273,.235,.235,0.34,0.85,1.00,1.05,1.05,1.00,0.85,0.55, /0.35,0.20,0.05,0.01,.001,.0005/ DATA XION/12.99,13.5,14.0,14.5,15.0,15.5,16.0,16.5,17.0,17.5, /18.0,18.5,19.0,19.5,21.0,21.5,22.0,22.5,23.0,23.5, /24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000., /1500.,2000.,3000.,4000.,5000.,7000.,10000.,12000.,15000.,20000., /40000.,100000./ DATA YION/0.00,.034,.074,0.13,.198,.278,.361,.445,.530,.610, /.706,.793,.880,.977,1.24,1.34,1.42,1.50,1.57,1.65, /1.72,1.97,2.20,2.38,2.54,2.68,2.79,2.91,3.02,3.21, /3.36,3.47,3.56,3.62,3.66,3.68,3.69,3.70,3.69,3.68, /3.66,3.63,3.62,3.59,3.55,3.52,3.48,3.45,3.41,3.38, /3.33,3.25,3.11,3.01,2.72,2.49,2.27,2.09,1.94,1.83, /1.72,1.63,1.54,1.47,1.40,1.34,1.28,1.24,1.20,1.18, /0.82,0.66,0.47,0.37,0.31,.235,.175,.151,.127,0.10, /.058,.028/ DATA XATT/7.00,7.50,8.00,8.50,9.00,9.50,10.0,10.5,11.0,11.5, /12.0,12.5,13.0,13.5/ DATA YATT/0.00,0.005,0.12,0.51,0.75,0.85,0.96,0.91,0.72,0.49, /0.27,0.13,0.06,0.00/ DATA XDIS1/9.00,10.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000.,20000./ DATA YDIS1/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.29, /0.25,0.19,0.15,0.10,.075,.050,.038,.025,.019,.015,.0075/ DATA XDIS2/10.0,11.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000.,20000./ DATA YDIS2/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.29, /0.25,0.19,0.15,0.10,.075,.050,.038,.025,.019,.015,.0075/ DATA XDIS3/11.0,12.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000.,20000./ DATA YDIS3/0.00,0.27,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.29, /0.25,0.19,0.15,0.10,.075,.050,.038,.025,.019,.015,.0075/ DATA XDIS4/11.8,12.0,13.0,15.0,17.0,20.0,22.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000.,20000./ DATA YDIS4/0.00,.045,0.27,0.36,0.45,0.53,0.58,0.59,0.58,0.57, /0.56,0.55,0.54,0.53,0.52,0.50,0.46,0.40,0.33,0.29, /0.25,0.19,0.15,0.10,.075,.050,.038,.025,.019,.015,.0075/ NAME='METHANE 1994 ' NIN=6 NDATA=70 NVIB1=30 NVIB2=27 NION=82 NATT=14 NDIS1=31 NDIS2=31 NDIS3=31 NDIS4=31 E(1)=0.0 E(2)=2.0*EMASS/(16.0426*AMU) E(3)=12.99 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.162 EIN(2)=0.374 EIN(3)=9.0 EIN(4)=10.0 EIN(5)=11.0 EIN(6)=11.8 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(14)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-19 300 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 600 DO 510 J=2,NDIS1 IF(EN.LE.XDIS1(J)) GO TO 520 510 CONTINUE J=NDIS1 520 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(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 700 DO 610 J=2,NDIS2 IF(EN.LE.XDIS2(J)) GO TO 620 610 CONTINUE J=NDIS2 620 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(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 800 DO 710 J=2,NDIS3 IF(EN.LE.XDIS3(J)) GO TO 720 710 CONTINUE J=NDIS3 720 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(5,I)=(A*EN+B)*1.E-16 800 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 900 DO 810 J=2,NDIS4 IF(EN.LE.XDIS4(J)) GO TO 820 810 CONTINUE J=NDIS4 820 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(6,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I)+QI /N(1,I)+QIN(2,I) C 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS9(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(55),YXSEC(55),XATT(16),YATT(16),XION(50),YION(50), /XVIB1(28),YVIB1(28),XVIB2(28),YVIB2(28),XVIB3(28),YVIB3(28), /XVIB4(25),YVIB4(25),XVIB5(19),YVIB5(19), /XEXC(25),YEXC(25),XEXC1(23),YEXC1(23),XEXC2(19),YEXC2(19) CHARACTER*15 NAME DATA XEN/0.00,.001,.002,.003,.004,.005,.007,0.01,.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.24,0.30,0.40,0.50,0.60, /0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,15.0,20.0,30.0,40.0,70.0,100.,140.,200., /1000.,2000.,10000.,20000.,100000./ C DATA YXSEC/45.0,45.0,44.0,42.0,40.0,39.0,36.0,32.0,26.5,20.0, DATA YXSEC/40.0,34.0,31.0,29.0,28.0,27.0,25.0,22.5,20.0,16.0, /12.0,7.25,4.70,3.25,2.40,1.80,1.40,1.15,1.10,1.10, /1.10,1.10,1.20,1.55,1.90,3.00,4.10,6.00,7.30,7.90, /8.30,8.80,9.60,10.6,12.6,15.8,19.8,22.2,23.0,21.5, /19.0,16.2,10.9,7.00,4.90,3.76,2.15,1.41,1.00,0.70, /0.14,0.07,.012,.006,.0012/ DATA XVIB1/.117,0.13,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,0.06,0.09,.115,0.12,0.12,0.11,0.09,.078,.055, /0.04,0.04,0.06,0.11,0.16,0.21,0.27,0.37,0.37,0.30, /0.21,0.11,0.06,.036,0.01,.001,.0001,.00001/ DATA XVIB2/.148,0.16,0.17,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,.057,0.10,0.14,0.15,0.16,0.16,0.14,0.12,0.09, /0.07,0.07,0.09,0.15,0.22,0.29,0.38,0.48,0.48,0.40, /0.28,0.16,0.09,0.06,.016,.0016,.00016,.000016/ DATA XVIB3/.182,0.19,0.20,0.23,0.25,0.30,0.35,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.11,0.13,0.27,0.33,0.37,0.38,0.37,0.32,0.23, /0.16,0.16,0.19,0.35,0.52,0.68,0.88,1.15,1.15,0.95, /0.65,0.37,0.20,0.12,0.03,.003,.0003,.00003/ DATA XVIB4/.366,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.20,0.32,0.34,0.36,0.37,0.37,0.34,0.30,0.36, /0.53,0.78,1.02,1.35,1.48,1.25,0.95,0.55,0.23,0.13, /0.08,.016,.0016,.00016,.000016/ DATA XVIB5/.548,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.001,0.01,.016,.035,0.06,0.09,0.12,0.13,0.11, /0.08,.045,0.02,0.01,.007,.0016,.00016,.000016,.0000016/ DATA XION/11.52,12.0,12.5,13.0,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,25.0,30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0, /90.0,100.,125.,150.,175.,200.,250.,300.,350.,400., /450.,500.,600.,700.,800.,900.,1000.,1250.,1500.,1750., /2000.,2500.,3000.,4000.,6000.,8000.,12000.,20000.,40000.,100000./ DATA YION/0.00,.014,0.06,.135,.345,0.63,0.94,1.28,1.62,1.95, /2.24,3.48,4.45,4.94,5.41,5.84,6.04,6.67,6.93,6.86, /6.84,6.89,6.53,6.32,5.98,5.68,5.01,4.60,4.18,3.86, /3.47,3.33,3.03,2.71,2.38,2.25,2.03,1.75,1.52,1.37, /1.22,1.08,0.90,0.72,0.53,0.42,0.30,0.20,0.11,.045/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ DATA XEXC/8.20,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.00,0.40,0.70,0.80,0.90,1.00,1.05,1.20,1.35,1.45, /1.50,1.50,1.50,1.40,1.30,1.20,1.00,0.90,0.70,0.50, /0.25,0.13,0.05,.025,.005/ DATA XEXC1/10.3,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,0.15,0.30,0.55,0.85,1.15,1.35,1.45, /1.50,1.50,1.50,1.40,1.30,1.20,1.00,0.90,0.70,0.50, /0.25,0.13,0.05,.025,.005/ DATA XEXC2/17.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.25,0.55,0.70, /0.75,0.70,0.67,0.64,0.58,0.50,0.40,0.32,0.23,0.15, /0.08,.045,0.02,0.01,.002/ NAME=' ETHANE 1999 ' C --------------------------------------------------------------------- C UPDATED TO DEC 1994 . INCLUDES LATEST ELECTRON SCATTERING RESULTS C GIVES BETTER FIT THAN PREVIOUS DATA SET C 1999 MOD USES VIBRATION AT 35.8 MV AND ALSO SUPER ELASTICS. C ALSO MOD TO ELASTIC AT LOW ENERGY BELOW 20 MV C --------------------------------------------------------------------- NIN=11 NDATA=55 NION=50 NATT=16 NVIB1=28 NVIB2=28 NVIB3=28 NVIB4=25 NVIB5=19 NEXC=25 NEXC1=23 NEXC2=19 E(1)=0.0 E(2)=2.0*EMASS/(30.06964*AMU) E(3)=11.52 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.0358 EIN(2)=0.0358 EIN(3)=-0.117 EIN(4)=0.117 EIN(5)=0.148 EIN(6)=0.182 EIN(7)=0.366 EIN(8)=0.548 EIN(9)=8.2 EIN(10)=10.3 EIN(11)=17.0 APOP=DEXP(EIN(1)/AKT) POPVH=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GE.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-21 300 Q(5,I)=0.0 Q(6,I)=0.0 C SUPER V TORSION QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 1300 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.003*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.E-16 C 1300 CONTINUE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 1301 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.003*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)*1.0/(1.0+APOP)*1.E-16 1301 CONTINUE C SUPERELASTIC VIB1 C QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EIN(4)).LE.XVIB1(J)) GO TO 302 301 CONTINUE J=NVIB1 302 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.E-16/EN QIN(3,I)=QIN(3,I)*POPVH/(1.0+POPVH) 305 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(4,I)=(A*EN+B)*1.E-16 QIN(4,I)=QIN(4,I)/(1.0+POPVH) 400 CONTINUE QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(5,I)=(A*EN+B)*1.E-16 500 CONTINUE QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(6,I)=(A*EN+B)*1.E-16 600 CONTINUE QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(7,I)=(A*EN+B)*1.E-16 700 CONTINUE QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 720 710 CONTINUE J=NVIB5 720 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(8,I)=(A*EN+B)*1.E-16 800 CONTINUE QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(9,I)=(A*EN+B)*1.E-16 900 CONTINUE QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 990 DO 910 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 920 910 CONTINUE J=NEXC1 920 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(10,I)=(A*EN+B)*1.E-16 990 CONTINUE QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 1990 DO 1910 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 1920 1910 CONTINUE J=NEXC2 1920 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(11,I)=(A*EN+B)*1.E-16 1990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS10(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(59),YXSEC(59),XION(46),YION(46),XATT(16),YATT(16), /XVIB1(28),YVIB1(28),XVIB2(28),YVIB2(28),XVIB3(25),YVIB3(25), /XVIB4(19),YVIB4(19),XEXC1(25),YEXC1(25),XEXC2(23),YEXC2(23), /XEXC3(19),YEXC3(19) CHARACTER*15 NAME DATA XEN/0.00,0.001,0.002,0.003,0.004,0.005,0.007,0.01,0.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.24,0.30,0.40,0.50, /0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00,7.50, /8.50,10.0,15.0,20.0,30.0,40.0,70.0,100.,140.,200., /250.,300.,500.,1000.,1500.,3000.,6000.,10000.,20000.,100000./ DATA YXSEC/55.0,55.0,46.0,40.0,36.0,32.0,27.5,22.5,19.5,16.5, /14.2,12.5,11.2,9.80,8.20,6.70,5.30,3.80,3.00,2.65, /2.60,2.60,2.90,3.40,4.30,6.10,8.40,10.0,11.2, /12.0,12.5,13.0,13.7,15.5,17.7,22.0,25.4,27.7,30.0, /26.0,23.1,16.7,13.0,9.00,6.80,4.00,2.88,1.70,1.05, /0.75,0.62,0.35,.155,0.10,.045,0.02,.012,.005,.001/ DATA XION/10.95,12.0,13.0,14.0,15.0,17.5,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.21,0.47,0.76,1.14,2.30,3.31,5.21,6.47,7.37, /8.00,8.54,9.22,9.79,10.1,10.2,10.2,10.2,9.90,9.36, /8.84,8.35,7.80,6.84,6.25,5.78,5.26,4.93,4.33,3.99, /3.67,3.27,3.05,2.64,2.27,2.06,1.88,1.62,1.39,0.92, /0.69,0.51,0.36,.195,.105,.066/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.90,1.48,2.23,3.78,5.94,8.91,13.9,19.8,16.6, /13.1,8.37,4.72,1.76,0.67,0.00/ DATA XVIB1/.108,.125,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,0.16,0.31,0.42,0.43,0.43,0.39,0.33,0.29,0.24, /0.19,0.19,0.23,0.37,0.55,0.72,0.93,1.22,1.22,1.00, /0.69,0.39,0.21,0.13,0.03,.003,.0003,.00003/ DATA XVIB2/.173,0.18,0.19,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.10,0.21,0.29,0.38,0.41,0.43,0.41,0.38,0.32, /0.26,0.24,0.25,0.37,0.55,0.72,0.93,1.22,1.22,1.00, /0.69,0.39,0.21,0.13,0.03,.003,.0003,.00003/ DATA XVIB3/.363,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.33,0.44,0.49,0.52,0.52,0.49,0.46,0.44,0.48, /0.70,1.00,1.30,1.68,1.85,1.60,1.18,0.68,0.30,0.17, /0.10,0.02,.002,.0002,.00002/ DATA XVIB4/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,.001,0.01,.020,.050,.094,0.12,0.16,0.18,0.15, /.114,.066,.028,.016,.010,.002,.0002,.00002,.000002/ DATA XEXC1/7.70,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,1.00,1.45,1.55,1.60,1.65,1.65,1.65,1.65,1.65, /1.70,1.70,1.65,1.55,1.30,1.20,1.00,0.94,0.80,0.52, /0.25,0.13,0.05,.026,.005/ DATA XEXC2/10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.15,0.31,0.58,0.89,1.20,1.40,1.52, /1.65,1.70,1.65,1.55,1.30,1.20,1.00,0.94,0.80,0.52, /0.25,0.13,0.05,.026,.005/ DATA XEXC3/17.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.33,0.72,1.00, /1.40,1.65,1.65,1.55,1.30,1.20,1.00,0.94,0.80,0.52, /0.25,0.13,0.05,.026,.005/ C NAME='PROPANE 1999 ' C --------------------------------------------------------------------- NIN=8 NDATA=59 NION=46 NATT=16 NVIB1=28 NVIB2=28 NVIB3=25 NVIB4=19 NEXC1=25 NEXC2=23 NEXC3=19 E(1)=0.0 E(2)=2.0*EMASS/(44.09652*AMU) E(3)=10.95 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.108 EIN(2)=0.108 EIN(3)=0.173 EIN(4)=0.363 EIN(5)=0.519 EIN(6)=7.7 EIN(7)=10.0 EIN(8)=17.0 APOP=DEXP(EIN(1)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-21 300 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 1100 DO 1010 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 1020 1010 CONTINUE J=NVIB1 1020 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.E-16/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP) 1100 CONTINUE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.E-16 QIN(2,I)=QIN(2,I)/(1.0+APOP) 400 CONTINUE QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 720 710 CONTINUE J=NEXC1 720 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 820 810 CONTINUE J=NEXC2 820 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 920 910 CONTINUE J=NEXC3 920 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(8,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS11(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(62),YXSEC(62),XION(46),YION(46),XATT(16),YATT(16), /XVIB1(34),YVIB1(34),XVIB2(28),YVIB2(28),XVIB3(28),YVIB3(28), /XVIB4(25),YVIB4(25),XVIB5(19),YVIB5(19),XEXC1(25),YEXC1(25), /XEXC2(23),YEXC2(23),XEXC3(19),YEXC3(19) CHARACTER*15 NAME DATA XEN/0.00,0.001,0.002,0.003,0.004,0.005,0.007,0.01,0.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.23,0.26,0.30,0.35,0.40, /0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0,70.0,100., /140.,200.,250.,300.,500.,1000.,1500.,3000.,6000.,10000., /20000.,100000./ DATA YXSEC/65.0,65.0,64.0,63.0,62.0,61.0,59.0,54.0,44.0,35.0, /27.5,23.0,19.0,16.5,15.0,14.0,13.0,12.5,11.5,11.0, /10.0,9.50,8.00,5.50,3.50,3.60,4.80,7.50,9.60,11.5, /13.0,14.0,15.0,16.0,17.0,19.0,21.5,26.0,30.0,33.0, /35.0,35.0,33.0,30.0,21.5,17.0,11.5,8.80,5.20,3.75, /2.21,1.36,0.98,0.81,0.46,0.20,0.13,0.06,.026,.016, /.0065,.0013/ DATA XION/10.67,11.2,12.7,13.7,14.7,17.2,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.27,0.61,0.99,1.48,3.00,4.30,6.77,8.41,9.58, /10.4,11.1,12.0,12.7,13.1,13.3,13.3,13.3,12.9,12.2, /11.5,10.9,10.1,8.89,8.12,7.51,6.84,6.41,5.63,5.19, /4.77,4.25,3.97,3.43,2.95,2.68,2.44,2.11,1.81,1.20, /0.90,0.66,0.47,.254,.136,.086/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,1.15,1.92,2.90,4.90,7.72,11.6,18.1,25.7,21.6, /17.0,10.9,6.14,2.30,0.87,0.00/ DATA XVIB1/.052,.055,.060,.065,.070,.075,0.08,0.10,0.12,0.14, /0.20,0.25,0.30,0.40,0.50,0.70,1.00,1.50,2.00,3.00, /4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0, /100.,1000.,10000.,100000./ DATA YVIB1/0.00,.014,.021,.024,.026,.027,.028,.028,.027,.025, /.021,.018,.016,.014,.012,.009,.008,.012,.015,.024, /.036,.047,.060,.079,.079,.065,.045,.025,.014,.008, /.002,.0002,.00002,.00002/ DATA XVIB2/.108,.125,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.27,0.52,0.71,0.73,0.73,0.66,0.56,0.49,0.41, /0.32,0.32,0.39,0.63,0.93,1.22,1.57,2.06,2.06,1.69, /1.17,0.66,0.35,0.22,0.05,.005,.0005,.00005/ DATA XVIB3/.173,0.18,0.19,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.13,0.27,0.38,0.49,0.53,0.56,0.53,0.49,0.42, /0.34,0.31,0.33,0.48,0.72,0.94,1.21,1.59,1.59,1.30, /0.90,0.51,0.27,0.17,0.04,.004,.0004,.00004/ DATA XVIB4/.363,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.47,0.63,0.70,0.74,0.74,0.70,0.66,0.63,0.69, /1.00,1.43,1.86,2.40,2.65,2.29,1.69,0.97,0.43,0.24, /0.14,0.03,.003,.0003,.00003/ DATA XVIB5/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.001,0.01,.033,.085,0.16,0.20,0.27,0.30,0.25, /.193,.112,.047,.027,.017,.003,.0003,.00003,.000003/ DATA XEXC1/7.40,8.70,9.70,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,1.30,1.89,2.02,2.08,2.15,2.15,2.15,2.15,2.15, /2.21,2.21,2.15,2.02,1.69,1.56,1.30,1.22,1.04,0.68, /0.33,0.17,0.06,.034,.007/ DATA XEXC2/9.70,10.7,11.7,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.19,0.40,0.75,1.16,1.56,1.82,1.98, /2.15,2.21,2.15,2.02,1.69,1.56,1.30,1.22,1.04,0.68, /0.32,0.17,0.06,.034,.006/ DATA XEXC3/17.0,20.0,25.0,30.0,40.0,60.0,80.0,100.,150.,200., /300.,400.,600.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.43,0.94,1.30,1.82,2.15,2.15,2.02,1.69,1.56, /1.30,1.22,1.04,0.68,0.33,0.17,0.07,.034,.006/ C-------------------------------------------------------- NAME='ISOBUTANE 1999 ' C --------------------------------------------------------------------- NIN=10 NDATA=62 NION=46 NATT=16 NVIB1=34 NVIB2=28 NVIB3=28 NVIB4=25 NVIB5=19 NEXC1=25 NEXC2=23 NEXC3=19 E(1)=0.0 E(2)=2.0*EMASS/(58.1234*AMU) E(3)=10.67 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.052 EIN(2)=0.052 EIN(3)=-0.108 EIN(4)=0.108 EIN(5)=0.173 EIN(6)=0.363 EIN(7)=0.519 EIN(8)=7.4 EIN(9)=9.70 EIN(10)=17.0 APOP=DEXP(EIN(1)/AKT) HPOP=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-21 300 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC VIB QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 302 301 CONTINUE J=NVIB1 302 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.E-16/EN QIN(1,I)=APOP*QIN(1,I)/(1.0+APOP) C 305 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 4000 DO 4100 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 4200 4100 CONTINUE J=NVIB1 4200 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.E-16/(1.0+APOP) 4000 CONTINUE QIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 1100 DO 307 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 308 307 CONTINUE J=NVIB2 308 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.E-16/EN QIN(3,I)=HPOP*QIN(3,I)/(1.0+HPOP) 1100 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B)*1.E-16/(1.0+HPOP) 400 CONTINUE QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(A*EN+B)*1.E-16 500 CONTINUE QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(6,I)=(A*EN+B)*1.E-16 600 CONTINUE QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.E-16 700 CONTINUE QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 720 710 CONTINUE J=NEXC1 720 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.E-16 800 CONTINUE QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 820 810 CONTINUE J=NEXC2 820 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.E-16 900 CONTINUE QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 920 910 CONTINUE J=NEXC3 920 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(10,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS12(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20), /XMOM(64),YMOM(64),XVIB1(39),YVIB1(39),XVIB2(29),YVIB2(29), /XVIB3(11),YVIB3(11),XVIB4(25),YVIB4(25),XVIB5(13),YVIB5(13), /XVIB6(10),YVIB6(10),XVIB7(10),YVIB7(10),XEXC1(8),YEXC1(8), /XATT(29),YATT(29),XEXC2(7),YEXC2(7),XEXC3(23),YEXC3(23), /XION(50),YION(50) CHARACTER*15 NAME DATA XMOM/1.D-6,.001,.002,.003,.005,.007,.0085,.010,.015,0.02, /0.03,0.04,0.05,0.07,0.10,0.12,0.15,0.17,0.20,0.25, /0.30,0.35,0.40,0.50,0.70,1.00,1.20,1.30,1.50,1.70, /1.90,2.10,2.20,2.50,2.80,3.00,3.30,3.60,4.00,4.50, /5.00,5.50,6.00,7.00,8.00,10.0,12.0,15.0,17.0,20.0, /25.0,30.0,50.0,75.0,100.,200.,400.,600.,1000.,2000., /4000.,10000.,20000.,100000./ C----------------------------------------------------- C NAKAMURAS ORIGINAL LOW ENERGY X-SECTION IS MODIFIED C BELOW 0.04 EV TO BETTER FIT ELFORDS DATA: C DATA YMOM/600.,578.,407.,328.,254.,214.,195.,182.,148.,128., C /104.,91.0,81.0,67.0,53.5,46.0,37.0,32.0,27.0,20.0, C TO USE NAKAMURAS X-SECTION DECOMMENT THE ABOVE TWO LINES C AND COMMENT THE TWO LINES BELOW. C------------------------------------------------------- DATA YMOM/550.,510.,372.,310.,240.,205.,186.,174.,142.,126., /103.,91.0,81.0,67.0,53.5,46.0,37.0,32.0,27.0,20.0, /15.0,12.4,10.5,8.00,5.70,4.20,3.70,3.50,3.30,3.20, /3.30,3.50,3.60,4.00,4.40,4.70,5.20,5.80,6.00,5.50, /5.10,5.00,5.20,6.10,7.30,8.80,10.0,11.0,11.0,10.7, /10.0,9.10,6.20,4.00,3.00,.697,.288,.158,.090,.042, /.020,.0077,.0038,.001/ DATA XVIB1/.083,.0844,.0862,.0932,.1035,.121,.138,.1726,.200,.250, /.350,0.50,0.70,0.90,1.10,1.40,1.60,1.90,2.60,3.10, /3.50,3.70,3.90,4.10,4.30,4.50,4.70,5.10,5.60,6.10, /6.50,7.50,8.50,10.5,20.0,50.0,100.,1000.,100000./ DATA YVIB1/0.00,0.85,1.16,1.85,2.30,2.60,2.68,2.40,2.00,1.55, /1.13,0.86,0.68,0.57,0.51,0.45,0.42,0.44,0.70,1.32, /2.64,3.15,3.50,3.56,3.52,3.35,2.74,1.85,0.80,0.61, /0.55,0.48,0.45,0.20,0.05,0.01,.001,.0001,0.0/ DATA XVIB2/0.167,0.172,0.18,0.20,0.25,0.50,1.00,1.50,2.00,2.20, /2.50,2.90,3.40,3.60,3.90,4.05,4.20,4.40,4.60,5.10, /5.50,5.70,6.50,8.50,10.5,20.0,100.,1000.,100000./ DATA YVIB2/0.00,0.30,0.33,0.35,0.325,0.117,0.05,0.04,0.06,0.08, /0.20,0.57,2.53,3.10,3.50,3.52,3.45,3.16,2.30,1.58, /0.71,0.60,0.37,0.25,0.21,0.02,0.001,.0001,0.0/ DATA XVIB3/0.252,2.50,3.50,4.06,4.60,5.10,5.56,6.00,100.,1000., /100000./ DATA YVIB3/0.00,.001,0.63,1.06,0.61,0.29,.066,.001,.0001,.00001, /.0000001/ DATA XVIB4/0.291,0.30,0.31,0.32,0.33,0.35,0.38,0.40,0.45,0.50, /0.60,0.80,1.00,1.50,2.00,3.00,4.50,6.00,8.00,10.0, /25.0,30.0,100.,1000.,100000./ DATA YVIB4/0.00,0.76,1.36,1.58,1.67,1.73,1.82,1.83,1.78,1.67, /1.46,1.17,1.00,0.76,0.64,0.49,0.44,0.41,0.48,0.26, /.135,0.10,0.001,.0001,0.000001/ DATA XVIB5/0.339,1.50,2.30,2.90,3.40,4.06,4.60,5.10,5.66,6.00, /100.,1000.,100000./ DATA YVIB5/0.00,.001,.125,0.36,0.81,1.30,0.61,0.278,0.01,.001, /.0001,.00001,.0000001/ DATA XVIB6/0.422,2.50,3.40,4.06,4.60,5.10,10.0,100.,1000., /100000./ DATA YVIB6/0.00,.001,.210,.444,0.18,.001,.001,.0001,.00001, /.0000001/ DATA XVIB7/0.505,2.50,3.40,4.06,4.60,5.10,10.0,100.,1000., /100000./ DATA YVIB7/0.00,.001,0.310,0.59,0.280,.001,.001,.0001,.00001, /.0000001/ DATA XEXC1/2.50,3.40,4.10,4.60,5.00,100.,1000.,100000./ DATA YEXC1/0.00,0.35,0.49,0.32,.001,.0001,.00001,.0000001/ DATA XATT/3.85,4.00,4.20,4.40,4.60,4.80,5.00,5.20,5.40,6.30, /6.60,6.90,7.20,7.40,7.60,7.80,8.00,8.20,8.40,8.60, /8.80,9.00,9.20,9.50,9.80,10.0,100.,1000.,100000./ DATA YATT/.0,.0005,.0014,.0014,.001,.0006,.0003,.0001,.0001,.0001, /.0001,.0002,.0008,.0018,.0027,.0036,.0042,.0041,.0034,.0020, /.0012,.0004,.0003,.0002,.0001,.0001,.00001,.000001,.0000001/ DATA XEXC2/7.00,8.00,8.50,11.0,100.,1000.,100000./ DATA YEXC2/0.00,0.50,0.50,.001,.0001,.00001,.0000001/ DATA XEXC3/10.5,12.0,13.0,14.0,15.0,17.0,20.0,25.0,30.0,40.0, /60.0,80.0,100.,150.,200.,400.,600.,1000.,2000.,4000., /10000.,20000.,100000./ DATA YEXC3/0.00,0.83,0.91,0.99,1.07,1.25,1.54,2.15,2.79,3.96, /5.28,6.16,6.93,7.26,6.60,3.80,2.55,1.60,0.89,0.47, /0.21,0.11,.026/ DATA XION/13.773,14.5,15.0,16.0,18.0,19.0,20.0,21.0,22.0,24.0, /26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0,50.0, /55.0,60.0,65.0,70.0,80.0,90.0,100.,110.,130.,140., /160.,180.,200.,250.,300.,400.,500.,600.,700.,800., /900.,1000.,1500.,2000.,4000.,7000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.055,.097,.174,.333,.427,.490,.577,.676,.880, /1.12,1.34,1.51,1.65,1.78,1.89,1.99,2.11,2.37,2.59, /2.76,2.93,3.07,3.18,3.35,3.46,3.52,3.55,3.55,3.52, /3.44,3.36,3.26,3.02,2.81,2.42,2.14,1.91,1.73,1.57, /1.47,1.40,1.07,0.83,0.46,0.26,0.19,0.10,.058,.026/ NAME=' CO2 2001 ' NIN=11 NMOM=64 NVIB1=39 NVIB2=29 NVIB3=11 NVIB4=25 NVIB5=13 NVIB6=10 NVIB7=10 NEXC1=8 NATT=29 NEXC2=7 NEXC3=23 NION=50 E(1)=0.0 E(2)=2.0*EMASS/(44.0095*AMU) E(3)=13.773 E(4)=3.85 E(5)=0.0 E(6)=0.0 EIN(1) = -0.083 EIN(2) = 0.083 EIN(3) = 0.167 EIN(4) = 0.252 EIN(5) = 0.291 EIN(6) = 0.339 EIN(7) = 0.422 EIN(8) = 0.505 EIN(9) = 2.500 EIN(10) = 7.000 EIN(11) = 10.500 APOPV1=DEXP(EIN(1)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP C ELASTIC USE LOG INTERPOLATION IF(EN.EQ.0.0) THEN Q(2,I)=YMOM(1)*1.D-16 GO TO 25 ENDIF DO 10 J=2,NMOM IF(EN.LE.XMOM(J)) GO TO 20 10 CONTINUE J=NMOM 20 YXJ=DLOG(YMOM(J)) YXJ1=DLOG(YMOM(J-1)) XNJ=DLOG(XMOM(J)) XNJ1=DLOG(XMOM(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 25 CONTINUE C IONISATION Q(3,I)=0.0 IF(EN.LE.E(3)) GO TO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GO TO 40 30 CONTINUE J=NION 40 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=1.0D-16*(A*EN+B) C ATTACHMENT 50 Q(4,I)=0.0 IF(EN.LE.E(4)) GO TO 100 DO 60 J=2,NATT IF(EN.LE.XATT(J)) GO TO 70 60 CONTINUE J=NATT 70 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=1.0D-16*(A*EN+B) C 100 Q(5,I)=0.0 Q(6,I)=0.0 C SUPERELASTIC VIB1 QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 DO 110 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GOTO 120 110 CONTINUE J=NVIB1 120 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN QIN(1,I)=QIN(1,I)*APOPV1/(1.0+APOPV1) C VIB1 150 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 200 DO 160 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 170 160 CONTINUE J=NVIB1 170 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=1.0D-16*(A*EN+B) QIN(2,I)=QIN(2,I)/(1.0+APOPV1) C VIB2 200 CONTINUE QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=1.0D-16*(A*EN+B) C 400 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=1.0D-16*(A*EN+B) C 500 CONTINUE QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=1.0D-16*(A*EN+B) C 600 CONTINUE QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(6,I)=1.0D-16*(A*EN+B) C 700 CONTINUE QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GOTO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(7,I)=1.0D-16*(A*EN+B) C 800 CONTINUE QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 900 DO 810 J=2,NVIB7 IF(EN.LE.XVIB7(J)) GOTO 820 810 CONTINUE J=NVIB7 820 A=(YVIB7(J)-YVIB7(J-1))/(XVIB7(J)-XVIB7(J-1)) B=(XVIB7(J-1)*YVIB7(J)-XVIB7(J)*YVIB7(J-1))/(XVIB7(J-1)-XVIB7(J)) QIN(8,I)=1.0D-16*(A*EN+B) C 900 CONTINUE QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 1000 DO 910 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 920 910 CONTINUE J=NEXC1 920 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(9,I)=1.0D-16*(A*EN+B) C 1000 CONTINUE QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 1100 DO 1010 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 1020 1010 CONTINUE J=NEXC2 1020 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(10,I)=1.0D-16*(A*EN+B) C 1100 CONTINUE QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 1200 DO 1110 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 1120 1110 CONTINUE J=NEXC3 1120 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(11,I)=1.0D-16*(A*EN+B) C 1200 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I) 9000 CONTINUE C C SAVE ON COMPUTING TIME C IF(EFINAL.LT.EIN(11)) NIN=10 IF(EFINAL.LT.EIN(10)) NIN=9 IF(EFINAL.LT.EIN(9)) NIN=8 IF(EFINAL.LT.EIN(8)) NIN=7 IF(EFINAL.LT.EIN(7)) NIN=6 IF(EFINAL.LT.EIN(6)) NIN=5 IF(EFINAL.LT.EIN(5)) NIN=4 IF(EFINAL.LT.EIN(4)) NIN=3 IF(EFINAL.LT.EIN(3)) NIN=2 IF(EFINAL.LT.EIN(2)) NIN=1 IF(EFINAL.LT.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS13(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(62),YXSEC(62),XION(46),YION(46),XATT(16),YATT(16), /XVIB1(34),YVIB1(34),XVIB2(28),YVIB2(28),XVIB3(28),YVIB3(28), /XVIB4(25),YVIB4(25),XVIB5(19),YVIB5(19),XEXC1(25),YEXC1(25), /XEXC2(23),YEXC2(23),XEXC3(19),YEXC3(19) CHARACTER*15 NAME DATA XEN/0.00,0.001,0.002,0.003,0.004,0.005,0.007,0.01,0.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.23,0.26,0.30,0.35,0.40, /0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0,70.0,100., /140.,200.,250.,300.,500.,1000.,1500.,3000.,6000.,10000., /20000.,100000./ DATA YXSEC/85.0,80.0,78.0,77.0,75.0,74.0,72.0,70.0,66.0,61.0, /54.0,49.0,44.0,40.0,35.0,31.0,27.0,24.0,20.5,17.0, /13.5,10.8,6.50,4.50,3.60,3.30,3.40,4.20,6.00,7.80, /12.5,16.7,21.8,25.0,27.5,30.0,34.0,37.0,40.0,43.0, /44.0,44.0,42.0,39.0,28.0,22.0,15.0,11.5,6.80,4.90, /2.90,1.78,1.28,1.06,0.60,0.26,0.17,0.08,.034,.021, /.0085,.0017/ DATA XION/10.35,11.0,12.5,13.5,14.5,17.0,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.33,0.75,1.22,1.82,3.69,5.29,8.33,10.3,11.8, /12.8,13.7,14.8,15.6,16.1,16.4,16.4,16.4,15.9,15.0, /14.1,13.4,12.4,10.9,9.99,9.24,8.41,7.88,6.92,6.38, /5.87,5.23,4.88,4.22,3.63,3.30,3.00,2.60,2.23,1.48, /1.11,0.81,0.58,0.31,.167,.106/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,1.41,2.36,3.57,6.03,9.50,14.3,22.3,31.6,26.6, /20.9,13.4,7.55,2.83,1.07,0.00/ DATA XVIB1/.052,.055,.060,.065,.070,.075,0.08,0.10,0.12,0.14, /0.20,0.25,0.30,0.40,0.50,0.70,1.00,1.50,2.00,3.00, /4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0, /100.,1000.,10000.,100000./ DATA YVIB1/0.00,.017,.026,.030,.032,.033,.034,.034,.033,.031, /.026,.022,.020,.017,.015,.011,.010,.015,.018,.030, /.044,.058,.074,.097,.097,.080,.055,.031,.017,.010, /.003,.0003,.00003,.00003/ DATA XVIB2/.108,.125,0.15,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.33,0.64,0.87,0.90,0.90,0.81,0.69,0.60,0.50, /0.39,0.39,0.48,0.77,1.14,1.50,1.93,2.53,2.53,2.08, /1.44,0.81,0.43,0.27,0.06,.006,.0006,.00006/ DATA XVIB3/.173,0.18,0.19,0.20,0.23,0.25,0.30,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.16,0.33,0.47,0.60,0.65,0.69,0.65,0.60,0.52, /0.42,0.38,0.41,0.59,0.89,1.16,1.49,1.96,1.96,1.60, /1.11,0.63,0.33,0.21,0.05,.005,.0005,.00005/ DATA XVIB4/.363,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.58,0.77,0.86,0.91,0.91,0.86,0.81,0.77,0.85, /1.23,1.76,2.29,2.95,3.26,2.82,2.08,1.19,0.53,0.30, /0.17,0.04,.004,.0004,.00004/ DATA XVIB5/.519,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,.001,0.01,.041,.105,0.20,0.25,0.33,0.37,0.31, /.237,.138,.058,.033,.021,.004,.0004,.00004,.000004/ DATA XEXC1/7.20,8.50,9.50,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,1.60,2.32,2.48,2.56,2.64,2.64,2.64,2.64,2.64, /2.72,2.72,2.64,2.48,2.08,1.92,1.60,1.50,1.28,0.84, /0.41,0.21,0.07,.042,.009/ DATA XEXC2/9.50,10.5,11.5,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.23,0.49,0.92,1.43,1.92,2.24,2.44, /2.65,2.72,2.65,2.48,2.08,1.92,1.60,1.50,1.28,0.84, /0.39,0.21,0.07,.042,.007/ DATA XEXC3/17.0,20.0,25.0,30.0,40.0,60.0,80.0,100.,150.,200., /300.,400.,600.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.53,1.16,1.60,2.24,2.64,2.64,2.48,2.08,1.92, /1.60,1.50,1.28,0.84,0.41,0.21,0.09,.042,.007/ C ---------------------------------------------------------------- C NO DIFFUSION EXPERIMENTAL DATA AVAILABLE USED INELASTICS FROM SCALING C ISOBUTANE INELASTIC X-SECT. ELASTIC DETERMINED FROM DRIFT VELOCITY. C HENCE DIFFUSION ACCURATE TO ONLY 10% , DRIFT VELOCITY TO 2% BELOW C 10KV/CM. C --------------------------------------------------------------- NAME='NEO-PENTANE 95 ' NIN=8 NDATA=62 NION=46 NATT=16 NVIB1=34 NVIB2=28 NVIB3=28 NVIB4=25 NVIB5=19 NEXC1=25 NEXC2=23 NEXC3=19 E(1)=0.0 E(2)=2.0*EMASS/(72.1503*AMU) E(3)=10.35 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.052 EIN(2)=0.108 EIN(3)=0.173 EIN(4)=0.363 EIN(5)=0.519 EIN(6)=7.2 EIN(7)=9.50 EIN(8)=17.0 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-21 300 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 4000 DO 4100 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 4200 4100 CONTINUE J=NVIB1 4200 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(A*EN+B)*1.E-16 4000 CONTINUE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(2,I)=(A*EN+B)*1.E-16 400 CONTINUE QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 720 710 CONTINUE J=NEXC1 720 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 820 810 CONTINUE J=NEXC2 820 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 920 910 CONTINUE J=NEXC3 920 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(8,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS14(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(35),YXSEC(35),XVIB1(25),YVIB1(25),XVIB2(27),YVIB2(27 /),XION(20),YION(20),XATT(15),YATT(15),XEXC(9),YEXC(9),XEXC1(17), /YEXC1(17),XEXC2(15),YEXC2(15) CHARACTER*15 NAME DATA XEN/0.00,0.01,0.02,0.05,0.08,0.10,0.16,0.25,0.40,0.60, /0.80,1.00,1.30,1.60,1.80,2.00,2.40,2.80,3.50,4.00, /5.00,6.00,8.00,10.0,12.0,16.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YXSEC/1310.,1040.,800.,545.,420.,362.,251.,162.,96.8,58.1, /36.0,23.5,12.0,6.30,4.05,2.60,1.45,1.36,1.46,1.77, /2.51,3.27,4.92,5.87,6.10,5.72,5.08,3.54,1.85,1.08, /0.70,0.23,0.15,.015,.0015/ DATA XVIB1/0.00,0.198,0.214,0.216,0.218,0.219,0.23,0.25,0.28,0.32, /0.35,0.40,0.50,0.60,0.80,1.00,1.60,2.50,4.00,7.00, /10.0,100.0,1000.0,10000.,100000./ DATA YVIB1/0.00,0.00,0.001,0.01,0.10,1.00,1.39,1.62,1.74,1.82, /1.78,1.58,1.20,0.74,0.47,0.35,0.24,0.17,0.15,0.16, /0.15,0.03,0.003,.0003,.00003/ DATA XVIB2/0.00,0.458,0.463,0.47,0.473,0.48,0.49,0.55,0.64,0.70, /0.75,0.80,0.90,1.00,1.40,2.00,2.50,4.00,6.00,8.00, /10.0,20.0,40.0,100.0,1000.0,10000.,100000./ DATA YVIB2/0.00,0.00,0.01,0.10,1.00,3.14,3.51,3.72,3.26,2.81, /2.17,1.00,0.68,0.53,0.36,0.31,0.31,0.36,0.47,0.50, /0.39,0.16,0.10,0.03,0.003,.0003,.00003/ DATA XION/12.6,13.1,14.1,15.0,17.0,20.0,25.0,30.0,40.0,50.0, /60.0,80.0,100.0,120.0,150.0,200.0,500.0,1000.0,10000.,100000./ DATA YION/0.00,0.001,0.01,0.03,0.10,0.29,0.61,0.92,1.23,1.50, /1.64,1.78,1.80,1.78,1.62,1.46,0.84,0.53,.053,.0053/ DATA XATT/5.60,5.65,5.75,6.00,6.50,7.00,7.50,8.00,8.50,10.0, /11.3,13.1,1000.0,10000.,100000./ DATA YATT/0.00,.001,0.004,.023,.069,.043,.018,.012,.013,.003, /.004,.001,0.0001,.00001,.000001/ DATA XEXC/4.20,4.50,5.00,6.00,10.0,100.,1000.0,10000.,100000./ DATA YEXC/0.00,.032,.064,.080,.064,0.004,0.0004,.00004,.000004/ DATA XEXC1/7.65,7.87,8.50,9.35,10.0,12.0,15.0,20.0,30.0,40.0, /50.0,80.0,100.0,200.0,1000.,10000.,100000./ DATA YEXC1/0.00,.016,.093,.155,.232,.357,.512,0.65,0.73,0.68, /0.64,0.51,0.47,0.30,.093,.0093,.00093/ DATA XEXC2/13.1,14.1,15.0,17.0,19.0,21.0,25.0,35.0,50.0,70.0, /100.0,200.0,1000.0,10000.,100000./ DATA YEXC2/0.00,.014,.056,0.14,.185,0.24,0.30,0.42,0.55,0.58, /0.55,0.41,0.14,.014,.0014/ NAME='H2O 1998' C -------------------------------------------------------------------- C EXPERIMENTAL DATA NOT ACCURATE IN WATER VAPOUR. ELECTRON SCATTERING C DATA USED IN ANALYSIS REPRODUCES DRIFT VELOCITY AND DIFFUSION C COEFFICIENTS TO AN ACCURACY OF 5%. C --------------------------------------------------------------------- NIN=9 NDATA=35 NVIB1=25 NVIB2=27 NION=20 NATT=15 NEXC=9 NEXC1=17 NEXC2=15 AMP1=0.60 AMP2=0.55 E(1)=0.0 E(2)=2.0*EMASS/(18.01528*AMU) E(3)=12.60 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.075 EIN(4)=0.075 EIN(5)=0.198 EIN(6)=0.458 EIN(7)=4.20 EIN(8)=7.65 EIN(9)=13.1 APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 CONTINUE C Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16 300 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 1300 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 1300 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 1400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC ROT2 C 1400 QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 1500 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C ROT2 1500 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 1600 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C 1600 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(5,I)=(A*EN+B)*1.E-16 400 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(6,I)=(A*EN+B)*1.E-16 500 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.E-16 800 CONTINUE C--------------------------------------------------------------------- Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(7,I)+QIN(8,I)+ /QIN(9,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS15(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(41),YXSEC(41),XVIB1(62),YVIB1(62),YVIB2(62),YVIB3(62 /),YVIB4(62),XION(54),YION(54),X3ATT(29),Y3ATT(29),XATT(31),YATT(31 /),XEXC1(20),YEXC1(20),XEXC2(13),YEXC2(13),XEXC3(17),YEXC3(17), /XEXC4(12),YEXC4(12),XEXC5(23),YEXC5(23),XEXC6(21),YEXC6(21), /XROT(4),YROT(4) CHARACTER*15 NAME DATA XEN/0.00,.001,.003,0.01,0.03,0.04,0.06,0.08,0.10,0.15, /0.20,0.30,0.40,0.50,0.60,0.80,1.00,1.20,1.50,2.00, /2.50,3.00,4.00,5.00,6.00,8.00,10.0,12.0,15.0,20.0, /25.0,30.0,40.0,50.0,60.0,80.0,100.,200.,300.,500., /1000./ DATA YXSEC/0.35,0.35,0.40,0.70,1.25,1.50,1.90,2.90,4.20,4.80, /5.30,5.70,5.80,5.85,6.00,6.80,7.40,7.80,7.70,6.80, /6.10,5.70,5.50,5.60,6.10,7.20,7.90,8.00,7.60,6.30, /5.40,4.75,3.75,3.12,2.67,2.07,1.71,0.93,0.67,0.33, /0.10/ DATA XVIB1/0.00,.193,0.20,0.21,0.23,0.32,0.33,0.35,0.44,0.45, /0.47,0.56,0.57,0.59,0.68,0.69,0.71,0.79,0.80,0.82, /0.90,0.91,0.93,1.02,1.03,1.05,1.13,1.14,1.16,1.23, /1.24,1.26,1.34,1.35,1.37,1.44,1.45,1.47,1.54,1.55, /1.57,1.63,1.65,1.67,4.00,5.00,6.00,7.00,8.00,8.50, /9.00,9.50,10.0,11.0,12.0,13.0,14.0,15.0,17.0,20.0, /45.0,1000./ DATA YVIB1/0.00,0.00,.075,.075,0.00,0.00,0.30,0.00,0.00,1.15, /0.00,0.00,1.60,0.00,0.00,1.40,0.00,0.00,0.88,0.00, /0.00,0.53,0.00,0.00,0.23,0.00,0.00,0.12,0.00,0.00, /0.06,0.00,0.00,.013,0.00,0.00,.0044,0.00,0.00,.0016, /0.00,0.00,.0005,0.00,.001,.042,.100,.176,.231,.245, /.247,.245,.234,.186,.143,.102,.071,.040,.020,.010, /0.00,0.00/ DATA YVIB2/0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00, /0.00,0.00,.112,0.00,0.00,.332,0.00,0.00,.428,0.00, /0.00,.372,0.00,0.00,.252,0.00,0.00,.160,0.00,0.00, /.076,0.00,0.00,.032,0.00,0.00,.014,0.00,0.00,.006, /0.00,0.00,.002,0.00,.001,.018,.040,.073,.094,.094, /.110,.113,.109,.093,.073,.051,.028,.013,.006,.005, /0.00,0.00/ DATA YVIB3/0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00, /0.00,0.00,0.00,0.00,0.00,.0029,.00,0.00,.0172,.00, /0.00,.072,0.00,0.00,.096,0.00,0.00,.092,0.00,0.00, /.076,0.00,0.00,.044,0.00,0.00,.024,0.00,0.00,.0132, /0.00,0.00,.0064,.00,0.00,0.00,.010,.029,.047,.054, /.060,.057,.054,.045,.038,.024,.014,.007,0.00,0.00, /0.00,0.00/ DATA YVIB4/0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00, /0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,.0012,.00, /0.00,.0044,.00,0.00,.0073,.00,0.00,.0132,.00,0.00, /.0252,.00,0.00,.026,0.00,0.00,.0228,.00,0.00,.0172, /0.00,0.00,.0132,.00,0.00,0.00,0.00,.022,.028,.031, /.033,.035,.037,.025,.020,.014,.007,0.00,0.00,0.00, /0.00,0.00/ C DATA XION/12.072,12.5,13.0,13.5,14.0,14.5,15.0,15.5,16.0,16.5, /17.0,17.5,18.0,18.5,19.0,19.5,20.0,20.5,21.0,21.5, /22.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,40.0,45.0, /50.0,55.0,60.0,70.0,80.0,90.0,100.,110.,120.,130., /140.,150.,160.,180.,200.,250.,300.,400.,500.,600., /700.,800.,900.,1000./ DATA YION/0.00,.0105,.023,.041,.054,.069,.085,.098,.114,.136, /.158,.180,.203,.229,.253,.279,.307,.333,.360,.387, /.416,.535,.654,.770,.897,1.03,1.15,1.27,1.47,1.70, /1.88,2.03,2.17,2.38,2.52,2.62,2.67,2.71,2.72,2.72, /2.71,2.69,2.67,2.62,2.53,2.36,2.18,1.88,1.67,1.49, /1.35,1.23,1.13,1.06/ C THREE BODY ATTACHMENT DATA X3ATT/0.035,0.04,.045,0.05,.055,.056,.058,0.06,.065,0.07, /.075,0.08,.081,.085,0.09,.095,0.10,.101,.105,0.11, /.115,0.20,0.30,0.40,0.50,0.80,1.00,2.00,1000./ DATA Y3ATT/0.00,.00058,.00127,.00260,.00520,.00578,.00723,.00983, /.0191,.0347, /.0665,.127,.130,.0665,.0289,.0520,.104,.113,.0578,.0116, /0.015,.022,.016,.012,.009,.004,.002,0.00,0.00/ C DISSOCIATIVE ATTACHMENT DATA XATT/4.20,4.40,4.60,4.80,5.00,5.20,5.40,5.60,5.80,6.00, /6.20,6.30,6.40,6.50,6.60,6.70,6.80,7.00,7.20,7.40, /7.60,7.80,8.00,8.20,8.40,8.60,8.80,9.00,9.40,10.0, /12.0/ DATA YATT/0.00,.00026,.00070,.00132,.00220,.00360,.00536,.00747, /.00958,.0114, /.0131,.0136,.0140,.0141,.0140,.0137,.0134,.0120,.0106,.00897, /.00738,.00571,.00448,.00334,.00237,.00167,.00123,.00088,.00053, /.00028,0.00/ C EXCITATION TO A1 DELTA G DATA XEXC1/.977,.982,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,30.0,40.0,50.0,60.0,80.0,100.,1000./ DATA YEXC1/0.00,.001,.0165,.037,.055,.068,.075,.0782,.079,.0773, /.075,.0575,.0435,.026,.0182,.0137,.0108,.0073,.0054,.0001/ C EXCITATION TO B1 SIGMA G+ DATA XEXC2/1.627,1.64,3.00,4.00,5.00,6.00,8.00,10.0,15.0,20.0, /40.0,100.,1000./ DATA YEXC2/0.00,.001,.015,.020,.025,.028,.030,.028,.022,.017, /.007,.002,0.00/ C EXCITATION SUM OF C1 SIGMA U- AND C3 DELTA U DATA XEXC3/4.50,4.80,5.00,5.50,6.00,6.50,7.00,7.50,8.00,9.00, /10.0,12.0,15.0,20.0,50.0,100.,1000./ DATA YEXC3/0.00,.003,.009,.030,.065,.085,.095,.100,.100,.085, /.070,.045,.020,.010,.005,.002,.001/ C EXCITATION TO A3 SIGMA U+ (MOLECULAR DISSOCIATION) DATA XEXC4/6.10,7.00,7.80,9.00,10.0,12.0,15.0,17.0,20.0,45.0, /100.,1000./ DATA YEXC4/0.00,.150,.250,.232,.210,.165,.105,.065,.048,.019, /.0096,.001/ C EXCITATION TO B3 SIGMA U- (MOLECULAR DISSOCIATION) DATA XEXC5/8.40,9.00,10.0,12.0,15.0,18.0,20.0,22.0,25.0,30.0, /40.0,50.0,60.0,80.0,100.,150.,200.,300.,400.,500., /600.,800.,1000./ DATA YEXC5/0.00,.117,.299,.702,1.05,1.19,1.22,1.23,1.22,1.15, /1.01,0.91,0.82,0.67,0.58,0.41,0.32,0.22,0.17,0.14, /0.12,.093,.078/ C EXCITATION TO HIGHER STATES SUMMED CROSS SECTION DATA XEXC6/9.30,10.0,12.0,15.0,18.0,20.0,25.0,30.0,35.0,40.0, /50.0,60.0,80.0,100.,150.,200.,300.,400.,500.,600.,1000./ DATA YEXC6/0.00,.013,.072,.121,.147,.155,.160,.157,.151,.141, /.125,.112,.093,.076,.050,.037,.023,.017,.013,.011,.005/ DATA XROT/0.002,.020,0.025,1000./ DATA YROT/0.00,0.00,0.15,0.15/ C ---------------------------------------------------------------------- C CORRECTED AND MODIFIED VERSION OF:- C KAJITA,USHIRODA AND KONDO J.APL.PHYS.67(1990)4015 C CONT. ROTATION NOT INCLUDED , 3-BODY ATTACHMENT INCLUDED C ---------------------------------------------------------------------- NAME=' OXYGEN 90 ' NIN=11 NROT=4 NDATA=41 NVIB1=62 NVIB2=62 NVIB3=62 NVIB4=62 NION=54 NATT=31 N3ATT=29 NEXC1=20 NEXC2=13 NEXC3=17 NEXC4=12 NEXC5=23 NEXC6=21 E(1)=0.0 E(2)=2.0*EMASS/(31.9988*AMU) E(3)=12.072 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.002 EIN(2)=0.193 EIN(3)=0.386 EIN(4)=0.579 EIN(5)=0.772 EIN(6)=0.977 EIN(7)=1.627 EIN(8)=4.50 EIN(9)=6.10 EIN(10)=8.40 EIN(11)=9.30 C CALCULATE DENSITY CORRECTION FOR THREE BODY ATTACHMENT CROSS-SECTION FAC=273.15*TORR/((TEMPC+273.15)*760.0) C EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 SINGLE=0.0 IF(EN.LT.XATT(1)) GO TO 250 IF(EN.GT.XATT(NATT)) GO TO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) SINGLE=(A*EN+B)*1.E-16 C 250 THREEB=0.0 IF(EN.LT.X3ATT(1)) GO TO 300 IF(EN.GT.X3ATT(N3ATT)) GO TO 300 DO 260 J=2,N3ATT IF(EN.LE.X3ATT(J)) GO TO 270 260 CONTINUE J=N3ATT 270 A=(Y3ATT(J)-Y3ATT(J-1))/(X3ATT(J)-X3ATT(J-1)) B=(X3ATT(J-1)*Y3ATT(J)-X3ATT(J)*Y3ATT(J-1))/(X3ATT(J-1)-X3ATT(J)) THREEB=FAC*(A*EN+B)*1.E-16 300 Q(4,I)=SINGLE+THREEB Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NROT IF(EN.LE.XROT(J)) GO TO 320 310 CONTINUE J=NROT 320 A=(YROT(J)-YROT(J-1))/(XROT(J)-XROT(J-1)) B=(XROT(J-1)*YROT(J)-XROT(J)*YROT(J-1))/(XROT(J-1)-XROT(J)) QIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 500 DO 410 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 420 410 CONTINUE J=NVIB1 420 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 600 DO 510 J=2,NVIB2 IF(EN.LE.XVIB1(J)) GO TO 520 510 CONTINUE J=NVIB2 520 A=(YVIB2(J)-YVIB2(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB2(J)-XVIB1(J)*YVIB2(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 700 DO 610 J=2,NVIB3 IF(EN.LE.XVIB1(J)) GO TO 620 610 CONTINUE J=NVIB3 620 A=(YVIB3(J)-YVIB3(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB3(J)-XVIB1(J)*YVIB3(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 800 DO 710 J=2,NVIB4 IF(EN.LE.XVIB1(J)) GO TO 720 710 CONTINUE J=NVIB4 720 A=(YVIB4(J)-YVIB4(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB4(J)-XVIB1(J)*YVIB4(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 900 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 820 810 CONTINUE J=NEXC1 820 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(6,I)=(A*EN+B)*1.E-16 900 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 1000 DO 910 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 920 910 CONTINUE J=NEXC2 920 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(7,I)=(A*EN+B)*1.E-16 1000 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 1100 DO 1010 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 1020 1010 CONTINUE J=NEXC3 1020 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(8,I)=(A*EN+B)*1.E-16 1100 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 1200 DO 1110 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 1120 1110 CONTINUE J=NEXC4 1120 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(9,I)=(A*EN+B)*1.E-16 1200 CONTINUE C QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 1300 DO 1210 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GO TO 1220 1210 CONTINUE J=NEXC5 1220 A=(YEXC5(J)-YEXC5(J-1))/(XEXC5(J)-XEXC5(J-1)) B=(XEXC5(J-1)*YEXC5(J)-XEXC5(J)*YEXC5(J-1))/(XEXC5(J-1)-XEXC5(J)) QIN(10,I)=(A*EN+B)*1.E-16 1300 CONTINUE C QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 1400 DO 1310 J=2,NEXC6 IF(EN.LE.XEXC6(J)) GO TO 1320 1310 CONTINUE J=NEXC6 1320 A=(YEXC6(J)-YEXC6(J-1))/(XEXC6(J)-XEXC6(J-1)) B=(XEXC6(J-1)*YEXC6(J)-XEXC6(J)*YEXC6(J-1))/(XEXC6(J-1)-XEXC6(J)) QIN(11,I)=(A*EN+B)*1.E-16 1400 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(1,I) 9900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS16(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XELA(60),YELA(60),XROT(27),YROT(27),XVIB1(49),YVIB1(49), /XVIB2(23),YVIB2(23),XVIB3(19),YVIB3(19),XVIB4(17),YVIB4(17), /XVIB5(17),YVIB5(17),XVIB6(17),YVIB6(17), /XTRP1(24),YTRP1(24),XTRP3(22),YTRP3(22),XTRP5(25),YTRP5(25), /XTRP7(28),YTRP7(28),XTRP8(18),YTRP8(18), /XSNG2(24),YSNG2(24),XSNG5(21),YSNG5(21),XION(26),YION(26) CHARACTER*15 NAME DATA XELA/0.00,0.001,0.02,.003,.005,.007,.0085, /0.010,0.015,0.02,0.03,0.04,0.05,0.07,0.10,0.12, C DATA XELA/0.00,0.010,0.015,0.02,0.03,0.04,0.05,0.07,0.10,0.12, /0.15,0.17,0.20,0.25,0.30,0.35,0.40,0.50,0.70,1.00, /1.20,1.30,1.50,1.70,1.90,2.10,2.20,2.50,2.80,3.00, /3.30,3.60,4.00,4.50,5.00,6.00,7.00,8.00,10.0,12.0, /15.0,17.0,20.0,25.0,30.0,50.0,75.0,100.,150.,200., /300.,500.,700.,1000.0/ DATA YELA/1.10,1.36,1.49,1.62,1.81,2.00,2.10, /2.19,2.55,2.85,3.38,3.82,4.30,5.08,5.92,6.42, C DATA YELA/1.10,2.19,2.55,2.85,3.38,3.82,4.30,5.08,5.92,6.42, /7.08,7.38,7.88,8.48,8.98,9.36,9.67,9.87,9.97,9.96, /10.34,10.92,11.87,13.47,16.41,16.85,18.02,17.92,21.0,17.20, /15.3,13.96,12.42,11.19,10.86,10.36,10.0,10.2,9.90,9.50, /8.70,8.26,7.60,6.70,5.90,3.80,2.56,1.80,1.13,0.80, /0.48,0.23,0.143,0.077/ DATA XROT/0.020,0.03,0.40,0.80,1.20,1.60,1.70,1.80,1.90,2.00, /2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00, /3.10,3.20,3.30,3.60,5.00,20.0,1000./ DATA YROT/0.00,.025,.025,.025,.047,.086,.15,.235,1.08,1.90, /2.03,2.77,2.50,2.19,2.40,2.17,1.62,1.38,1.18,1.03, /0.84,0.69,0.50,0.17,0.00,0.00,0.00/ DATA XVIB1/0.29,0.30,0.33,0.40,0.75,0.90,1.00,1.10,1.16,1.20, /1.22,1.40,1.50,1.60,1.65,1.70,1.80,1.90,2.00,2.10, /2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,3.60,4.00,5.00,15.0,18.0, /20.0,22.0,23.0,25.0,29.0,32.0,50.0,80.0,1000./ DATA YVIB1/.00,.001,.0017,.0025,.0037,.0055,.0065,.009,.011,.0125, /.0135,.070,.100,.150,.270,.315,.540,1.485,4.80,2.565, /1.20,4.50,2.76,1.59,3.15,1.545,0.60,1.35,.525,0.870, /1.17,0.855,0.66,0.60,.585,0.57,.055,.035,.035,0.04, /.065,.085,.085,0.06,0.03,.015,.012,0.00,0.00/ DATA XVIB2/0.59,1.70,1.80,1.90,2.00,2.10,2.20,2.30,2.40,2.50, /2.60,2.70,2.75,2.80,2.90,3.00,3.10,3.20,3.30,3.40, /3.50,3.60,1000.0/ DATA YVIB2/0.00,0.00,.015,0.63,1.935,3.30,1.47,0.54,2.115,3.00, /0.54,1.05,1.725,1.275,0.33,0.90,0.645,0.375,0.345,0.30, /0.213,0.00,0.00/ DATA XVIB3/0.88,1.90,2.00,2.10,2.20,2.30,2.40,2.50,2.60,2.70, /2.75,2.80,2.90,3.00,3.10,3.20,3.30,3.40,1000./ DATA YVIB3/0.00,0.00,0.96,2.055,2.70,1.695,0.075,0.96,1.47,0.45, /0.96,0.54,0.855,0.405,0.282,0.291,0.0615,0.00,0.00/ DATA XVIB4/1.17,2.00,2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.75, /2.80,2.90,3.00,3.10,3.20,3.30,1000./ DATA YVIB4/0.0,0.0,.2025,1.515,2.385,1.440,.555,.0825,1.2,1.095, /0.675,0.03,0.33,0.315,0.06,0.00,0.00/ DATA XVIB5/1.47,2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80, /2.90,3.00,3.10,3.20,3.30,3.40,1000./ DATA YVIB5/0.00,0.00,.825,1.23,1.53,1.44,0.345,.0225,.345,0.54, /0.66,.2175,.105,.315,.1035,0.00,0.00/ DATA XVIB6/1.76,2.20,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90, /3.00,3.10,3.20,3.30,3.40,3.50,1000.0/ DATA YVIB6/0.00,0.00,.0063,1.14,2.20,2.18,2.38,1.86,1.46,.917, /0.84,0.44,0.25,0.30,.056,0.00,0.00/ DATA XTRP1/6.17,7.00,7.80,8.50,9.00,10.0,11.0,12.0,13.0,14.0, /16.0,17.0,18.0,20.0,22.0,24.0,26.0,30.0,34.0,40.0, /50.0,70.0,150.,1000.0/ DATA YTRP1/0.00,.0033,.0085,.0213,.0307,.0468,.059,.069,.075,.082, /.089,.089,.084,.072,.061,.052,.045,.034,.029,.023, /.019,.004,0.0,0.0/ DATA XTRP3/7.35,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /17.0,18.0,20.0,22.0,26.0,30.0,34.0,40.0,50.0,70.0, /150.0,1000.0/ DATA YTRP3/.0,.0543,.1434,.2312,.2975,.343,.373,.387,.397,.399, /.383,.354,.289,.227,.165,.131,.106,.0777,.0469,.0168, /0.0,0.0/ DATA XTRP5/7.80,8.10,8.50,8.70,9.00,10.0,11.0,12.0,13.0,14.0, /16.0,17.0,18.0,20.0,22.0,24.0,26.0,30.0,34.0,40.0, /50.0,70.0,150.0,500.0,1000./ DATA YTRP5/0.0,.0015,.0097,.018,.029,.073,.115,.148,.180,.208, /.205,.178,.152,.122,.105,.091,.081,.066,.057,.047, /.041,.021,.007,0.00,0.00/ DATA XSNG2/8.55,9.00,12.0,14.0,15.0,16.0,17.0,18.0,19.0,20.0, /24.0,26.0,30.0,40.0,50.0,70.0,100.,150.,200.,250., /300.,500.,700.,1000.0/ DATA YSNG2/.0,.0141,.163,.2276,.2412,.2481,.2483,.238,.2268,.2150, /.1860,.1734,.1527,.1160,.0900,.0642,.0425,.0268,.0201,.0161, /.0134,.0082,.0060,.0042/ DATA XTRP7/11.03,11.5,12.0,12.5,13.0,13.5,13.8,14.0,14.2,14.5, /15.0,16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,36.0,40.0,50.0,70.0,100.0,150.0,1000.0/ DATA YTRP7/.0,.0405,.093,.1965,.435,.735,.93,.975,.96,.945, /.825,.645,.525,.450,.405,.375,.315,.2655,.225,.2085, /.1665,.117,.0945,.0585,.0225,.0023,0.0,0.0/ DATA XTRP8/11.87,11.92,12.7,17.0,19.0,20.0,22.0,24.0,26.0,28.0, /30.0,32.0,40.0,50.0,70.0,100.,150.0,1000.0/ DATA YTRP8/.0,.0496,.0041,.0346,.0436,.0448,.0405,.0338,.0289, /.0241,.0193,.0172,.0122,.010,.007,.005,0.0,0.0/ DATA XSNG5/13.0,14.0,15.0,16.0,17.0,18.0,20.0,22.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,250.,300.,500.,700.,1000./ DATA YSNG5/0.0,.081,0.19,0.25,0.42,0.52,0.75,0.96,1.19,1.48, /1.65,1.76,1.68,1.58,1.33,1.16,1.05,0.96,0.74,0.64,0.53/ DATA XION/15.6,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /21.0,22.0,23.0,25.0,30.0,34.0,45.0,60.0,75.0,100., /150.,200.,300.,500.,700.,1000./ DATA YION/0.00,.021,.046,.071,.098,.129,.163,.198,.229,.269, /.342,.416,.490,.637,1.03,1.26,1.77,2.17,2.38,2.52, /2.44,2.26,1.91,1.45,1.16,0.92/ NAME='N2 PTCH+PHELPS' C -------------------------------------------------------------- C NITROGEN FROM PITCHFORD AND PHELPS . JILA REPORT NO.26 (1985) C MULTI TERM CROSS SECTIONS WITH MODIFICATION CF:PHELPS PRIVATE C COMMUNICATION . REDUCED 11.03 ENERGY LOSS X-SECTION BY 0.6666 C IN CODE. C ACCURACY ABOUT 1% AT ALL FIELDS. C COMBINED SOME CLOSE LEVELS IN ORDER TO SAVE COMPUTING TIME C -------------------------------------------------------------- NIN=14 NELA=60 NROT=27 NVIB1=49 NVIB2=23 NVIB3=19 NVIB4=17 NVIB5=17 NVIB6=17 NTRP1=24 NTRP3=22 NTRP5=25 NTRP7=28 NTRP8=18 NSNG2=24 NSNG5=21 NION=26 E(1)=0.0 E(2)=2.0*EMASS/(27.7940*AMU) E(3)=15.60 E(4)=0.0 E(5)=0.0 E(6)=0.0 C EIN(1)=0.020 EIN(2)=0.290 EIN(3)=0.590 EIN(4)=0.880 EIN(5)=1.17 EIN(6)=1.47 EIN(7)=1.76 EIN(8)=6.17 EIN(9)=7.35 EIN(10)=7.80 EIN(11)=8.55 EIN(12)=11.03 EIN(13)=11.87 EIN(14)=13.0 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NELA IF(EN.LE.XELA(J)) GO TO 20 10 CONTINUE J=NELA 20 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)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GO TO 40 30 CONTINUE J=NION 40 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 50 CONTINUE Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C--------------------------------------------------------------------- C SINGLE LEVEL APPROXIMATION TO ROTATIONAL SCATTERING BELOW. C--------------------------------------------------------------------- QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 80 DO 60 J=2,NROT IF(EN.LE.XROT(J)) GO TO 70 60 CONTINUE J=NROT 70 A=(YROT(J)-YROT(J-1))/(XROT(J)-XROT(J-1)) B=(XROT(J-1)*YROT(J)-XROT(J)*YROT(J-1))/(XROT(J-1)-XROT(J)) QIN(1,I)=(A*EN+B)*1.E-16 C--------------------------------------------------------------------- 80 CONTINUE C--------------------------------------------------------------------- QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 110 DO 90 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 100 90 CONTINUE J=NVIB1 100 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.E-16 110 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 140 DO 120 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 130 120 CONTINUE J=NVIB2 130 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.E-16 140 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 170 DO 150 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 160 150 CONTINUE J=NVIB3 160 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.E-16 170 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 200 DO 180 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 190 180 CONTINUE J=NVIB4 190 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=(A*EN+B)*1.E-16 200 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 230 DO 210 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 220 210 CONTINUE J=NVIB5 220 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(6,I)=(A*EN+B)*1.E-16 230 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 260 DO 240 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 250 240 CONTINUE J=NVIB6 250 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(7,I)=(A*EN+B)*1.E-16 260 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 350 DO 330 J=2,NTRP1 IF(EN.LE.XTRP1(J)) GO TO 340 330 CONTINUE J=NTRP1 340 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(8,I)=(A*EN+B)*1.E-16 350 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 410 DO 390 J=2,NTRP3 IF(EN.LE.XTRP3(J)) GO TO 400 390 CONTINUE J=NTRP3 400 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(9,I)=(A*EN+B)*1.E-16 410 CONTINUE C QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 470 DO 450 J=2,NTRP5 IF(EN.LE.XTRP5(J)) GO TO 460 450 CONTINUE J=NTRP5 460 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(10,I)=(A*EN+B)*1.E-16 470 CONTINUE C QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 560 DO 540 J=2,NSNG2 IF(EN.LE.XSNG2(J)) GO TO 550 540 CONTINUE J=NSNG2 550 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(11,I)=(A*EN+B)*1.E-16 560 CONTINUE C QIN(12,I)=0.0 IF(EN.LE.EIN(12)) GO TO 620 DO 600 J=2,NTRP7 IF(EN.LE.XTRP7(J)) GO TO 610 600 CONTINUE J=NTRP7 610 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(12,I)=0.6666*(A*EN+B)*1.E-16 620 CONTINUE C QIN(13,I)=0.0 IF(EN.LE.EIN(13)) GO TO 650 DO 630 J=2,NTRP8 IF(EN.LE.XTRP8(J)) GO TO 640 630 CONTINUE J=NTRP8 640 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(13,I)=(A*EN+B)*1.E-16 650 CONTINUE QIN(14,I)=0.0 IF(EN.LE.EIN(14)) GO TO 710 DO 690 J=2,NSNG5 IF(EN.LE.XSNG5(J)) GO TO 700 690 CONTINUE J=NSNG5 700 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(14,I)=(A*EN+B)*1.E-16 710 CONTINUE C C SUM=0.0 DO 800 K=1,14 SUM=SUM+QIN(K,I) 800 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+SUM 900 CONTINUE C SAVE COMPUTE TIME DO 1000 K=1,14 J=15-K IF(EFINAL.LE.EIN(J)) NIN=J-1 1000 CONTINUE C RETURN END SUBROUTINE GAS17(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(58),YXSEC(58),XION(48),YION(48),XATT(23),YATT(23), /XROT1(18),YROT1(18),XVIB1(24),YVIB1(24),XVIB2(23),YVIB2(23), /XEXC1(32),YEXC1(32), /XAT3(18),YAT3(18) CHARACTER*15 NAME DATA XEN/0.00,.005,.007,0.01,.012,.015,0.02,0.03,0.04,0.05, /0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.20,0.30,0.40, /0.50,0.60,0.70,0.80,0.90,1.00,1.20,1.50,2.00,3.00, /4.00,5.00,6.00,7.00,8.00,9.00,10.0,12.0,15.0,20.0, /30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,120.,150., /200.,300.,400.,500.,1000.,2000.,10000.,100000./ DATA YXSEC/32.0,30.8,29.8,27.8,25.5,22.1,20.0,15.7,13.3,11.2, /10.0,9.25,8.63,8.34,8.24,8.00,6.73,6.00,6.00,6.14, /6.50,6.88,7.70,8.25,8.95,9.78,10.6,13.3,13.6,12.8, /10.2,9.78,8.45,7.10,6.10,5.20,4.75,4.10,2.85,1.85, /1.12,0.82,0.59,0.49,0.39,0.32,0.28,0.24,0.18,0.14, /0.09,0.05,.035,.025,0.01,.004,.0005,.0001/ DATA XION/9.2644,9.50,10.0,10.5,11.0,11.5,12.0,12.5,13.0,13.5, /14.0,15.0,16.0,17.0,18.0,19.0,20.0,22.0,24.0,26.0, /28.0,32.0,36.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0, /100.,120.,140.,160.,200.,300.,400.,500.,600.,700., /800.,900.,1000.,2000.,4000.,10000.,20000.,100000./ DATA YION/0.00,.011,.018,.031,.047,.064,.093,.131,.184,.244, /.305,.418,.503,.585,.663,.736,.813,.959,1.11,1.26, /1.40,1.65,1.87,2.08,2.30,2.48,2.74,2.91,3.04,3.11, /3.14,3.14,3.10,3.04,2.86,2.45,2.11,1.86,1.67,1.51, /1.39,1.27,1.21,0.80,0.45,0.23,0.14,.035/ DATA XATT/6.50,6.80,7.00,7.20,7.40,7.60,7.80,8.00,8.60,8.80, /9.00,9.20,9.40,9.60,9.80,10.0,10.4,10.6,10.8,11.0, /11.5,13.0,14.0/ DATA YATT/0.00,0.02,0.08,0.33,0.71,0.96,1.08,1.11,1.11,1.09, /1.04,0.95,0.83,0.65,0.51,0.38,0.18,0.11,0.08,0.06, /0.04,0.03,0.00/ DATA XAT3/0.01,.012,.015,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.12,0.15,0.20,0.30,1.00,10.0/ DATA YAT3/0.00,.085,0.24,0.14,0.07,.041,.029,.023,.019,.017, /.015,.014,.013,.012,.010,.0085,.0035,0.00/ DATA XROT1/.100,0.12,0.15,0.20,0.30,0.40,0.50,0.60,0.70,0.80, /0.90,1.00,1.20,1.50,2.00,10.0,100.,100000./ DATA YROT1/0.00,.037,.037,.033,.026,.018,.014,.011,.009,.006, /.005,.004,.003,.002,.001,.0001,.00001,.000001/ DATA XVIB1/.2326,0.24,0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90, /1.00,1.20,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00, /10.0,20.0,100.,100000./ DATA YVIB1/0.00,0.05,0.08,0.10,0.08,0.06,0.05,0.04,.032,.027, /.023,.018,.012,.008,.004,.002,.0015,.0012,.001,.0008, /.0005,.0001,.00002,.000001/ DATA XVIB2/0.60,0.63,0.70,0.80,0.90,1.00,1.20,1.50,2.00,3.00, /4.00,5.00,6.00,7.00,8.00,10.0,15.0,20.0,40.0,60.0, /100.,1000.,100000./ DATA YVIB2/0.00,0.60,0.90,0.90,0.85,0.80,0.70,0.50,0.31,0.16, /0.11,.075,.055,.042,.035,.025,.012,.008,.002,.001, /.0005,.00005,.000005/ DATA XEXC1/6.10,6.50,7.00,7.50,8.00,8.50,9.00,10.0,12.0,15.0, /20.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100.,120., /150.,200.,300.,400.,500.,1000.,2000.,4000.,10000.,20000., /40000.,100000./ DATA YEXC1/0.00,0.01,0.02,.085,0.20,0.55,0.70,1.00,1.65,2.21, /3.30,3.50,3.30,3.00,2.65,2.26,2.16,2.00,1.80,1.60, /1.40,1.03,0.85,0.65,0.52,0.25,0.13,0.06,.025,.012, /.0065,.0025/ NAME='NO 1995 ' C --------------------------------------------------------------------- C CALCULATE CORRECTION FACTOR FOR 3BODY ATTACHMENT CROSS-SECTION FAC=273.15*TORR/((TEMPC+273.15)*760.0) C--------------------------------------------- WRITE(6,100) 100 FORMAT(1H1) WRITE(6,100) FAC 101 FORMAT(' 3BODY ATTACHMENT INCLUDED DENSITY SCALING FACTOR =',F7.4) NIN=4 NDATA=58 NION=48 NATT=23 NAT3=18 NROT1=18 NVIB1=24 NVIB2=23 NEXC1=32 E(1)=0.0 E(2)=2.0*EMASS/(30.00614*AMU) E(3)=9.2644 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.100 EIN(2)=0.2326 EIN(3)=0.600 EIN(4)=6.10 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 SINGLE=0.0 IF(EN.LT.XATT(1)) GO TO 250 IF(EN.GT.XATT(NATT)) GO TO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) SINGLE=(A*EN+B)*1.E-18 250 THREEB=0.0 IF(EN.LT.XAT3(1)) GO TO 300 IF(EN.GT.XAT3(NAT3)) GO TO 300 DO 260 J=2,NAT3 IF(EN.LE.XAT3(J)) GO TO 270 260 CONTINUE J=NAT3 270 A=(YAT3(J)-YAT3(J-1))/(XAT3(J)-XAT3(J-1)) B=(XAT3(J-1)*YAT3(J)-XAT3(J)*YAT3(J-1))/(XAT3(J-1)-XAT3(J)) THREEB=FAC*(A*EN+B)*1.E-16 Q(4,I)=SINGLE+THREEB 300 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NROT1 IF(EN.LE.XROT1(J)) GO TO 320 310 CONTINUE J=NROT1 320 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 500 DO 410 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 420 410 CONTINUE J=NVIB1 420 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 600 DO 510 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 520 510 CONTINUE J=NVIB2 520 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS18(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(66),YXSEC(66),XION(43),YION(43),XATT(49),YATT(49), /XVIB1(29),YVIB1(29),XVIB2(33),YVIB2(33),XVIB3(33),YVIB3(33), /XEXC1(28),YEXC1(28),XEXC2(24),YEXC2(24),XEXC3(25),YEXC3(25) CHARACTER*15 NAME DATA XEN/0.00,0.001,.0034,0.01,.012,.014,.017,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.14,0.17, /0.20,0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.20,1.40,1.70,2.00,2.40,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,12.0,14.0,17.0,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,90.0,100.,140.,200.,250.,300., /400.,500.,700.,1000.,10000.,100000./ DATA YXSEC/200.,200.,100.,49.0,44.0,41.4,36.8,33.3,28.8,25.8, /21.4,18.9,17.3,16.1,14.6,13.4,12.3,11.4,10.0,8.00, /6.20,4.71,3.56,2.74,2.65,2.81,3.14,3.62,4.68,5.10, /5.92,6.72,7.76,8.37,9.42,9.43,8.81,8.66,9.03,9.67, /10.2,10.7,11.1,11.4,11.1,10.0,8.81,7.31,6.44,5.21, /4.40,3.81,3.41,2.88,2.65,2.33,1.59,1.14,0.88,0.73, /0.50,0.38,0.25,0.16,0.016,0.0016/ DATA XION/12.886,14.0,14.5,15.0,16.0,17.0,18.0,19.5,21.0,23.0, /26.0,30.0,34.0,40.0,45.0,50.0,55.0,60.0,70.0,80.0, /90.0,100.,110.,120.,140.,160.,200.,250.,300.,350., /400.,450.,500.,600.,700.,800.,900.,1000.,2000.,4000., /10000.,20000.,100000./ DATA YION/0.00,.054,.121,.158,.238,.319,.404,0.55,0.72,0.96, /1.28,1.64,1.94,2.31,2.59,2.81,3.01,3.18,3.44,3.61, /3.69,3.75,3.76,3.77,3.73,3.64,3.45,3.18,2.94,2.72, /2.52,2.37,2.23,1.97,1.78,1.63,1.50,1.42,0.90,0.56, /0.30,0.17,0.05/ DATA XATT/0.38,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.10,1.20, /1.30,1.40,1.50,1.60,1.70,1.80,1.90,2.00,2.10,2.20, /2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,3.10,3.20, /3.30,3.40,3.50,3.60,3.70,3.80,3.90,4.00,4.30,5.00, /6.00,7.00,8.00,9.00,10.0,11.0,12.0,14.0,16.0/ DATA YATT/0.00,0.46,1.33,1.73,1.93,2.04,2.08,2.16,2.23,2.33, /2.49,2.79,3.29,3.92,4.94,5.95,6.63,7.58,8.28,8.60, /8.57,8.04,7.10,5.98,4.84,3.57,2.60,1.92,1.39,0.97, /0.63,0.47,0.35,0.28,0.23,0.19,0.17,0.13,0.10,0.10, /0.11,0.15,0.30,0.44,0.74,0.90,0.60,0.20,0.00/ DATA XVIB1/.073,0.08,0.09,0.10,0.12,0.14,0.17,0.20,0.25,0.30, /0.40,0.50,0.70,1.00,1.40,2.00,3.00,5.00,7.00,10.0, /14.0,20.0,30.0,50.0,100.,200.,1000.,10000.,100000./ DATA YVIB1/0.00,0.15,0.20,0.21,.225,.225,.222,0.20,0.19,0.17, /0.15,0.12,0.10,.075,0.06,.044,.032,.021,.016,.012, /.009,.007,.005,.003,.002,.001,.0001,.00001,.000001/ DATA XVIB2/.159,0.17,0.20,0.25,0.30,0.40,0.50,0.60,0.70,0.80, /0.90,1.00,1.20,1.40,1.70,2.00,2.35,3.00,4.00,5.00, /6.00,8.00,10.0,12.0,14.0,20.0,40.0,70.0,100.,200., /1000.,10000.,100000./ DATA YVIB2/0.00,0.19,0.31,0.36,0.36,0.33,0.30,0.28,0.25,0.23, /0.22,0.20,0.18,0.17,0.20,0.44,1.43,0.14,.075,.067, /.057,.043,.037,.031,.027,.021,.012,.007,.005,.003, /.0008,.00008,.000008/ DATA XVIB3/.276,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.20, /1.40,1.70,2.00,2.35,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,12.0,14.0,20.0,40.0,70.0,100.,200.,400., /1000.,10000.,100000./ DATA YVIB3/0.00,0.82,1.14,1.18,1.16,1.10,1.04,1.00,0.92,0.86, /0.78,0.76,0.98,1.18,0.90,0.39,0.33,0.30,0.25,0.23, /0.21,0.19,0.17,0.15,0.11,0.06,.037,.028,.015,.009, /.004,.0004,.00004/ DATA XEXC1/4.06,4.50,5.00,6.00,7.00,8.00,9.00,10.0,12.0,14.0, /17.0,20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.,140.,200.,300.,500.,1000.,10000.,100000./ DATA YEXC1/0.00,0.55,0.83,0.93,0.93,0.84,0.78,0.69,0.60,0.50, /0.42,0.34,0.26,0.21,0.15,0.12,0.10,0.08,0.07,0.06, /0.05,.034,.022,.014,.008,.004,.0004,.00004/ DATA XEXC2/8.50,9.00,10.0,12.0,14.0,17.0,20.0,25.0,30.0,40.0, /50.0,60.0,70.0,80.0,100.,140.,200.,300.,400.,500., /700.,1000.,10000.,100000./ DATA YEXC2/0.00,.016,.048,0.12,0.22,0.34,0.47,0.62,0.73,0.81, /0.75,0.64,0.57,0.48,0.36,0.26,0.17,0.12,.083,.067, /.046,.034,.003,.0003/ DATA XEXC3/9.60,10.0,12.0,14.0,17.0,20.0,25.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,140.,200.,250.,300.,400., /500.,700.,1000.,10000.,100000./ DATA YEXC3/0.00,.036,0.26,0.76,1.44,2.23,3.20,3.87,4.40,4.40, /3.81,3.41,2.88,2.65,2.33,1.59,1.14,0.88,0.76,0.56, /0.44,0.33,0.25,.025,.0025/ NAME='N2O 1995 ' C --------------------------------------------------------------------- C SCALEAT = SCALE FACTOR TO ALLOW FOR DETATCHMENT COLLISIONS SCALEAT=0.04 NIN=6 NDATA=66 NION=43 NATT=49 NVIB1=29 NVIB2=33 NVIB3=33 NEXC1=28 NEXC2=24 NEXC3=25 E(1)=0.0 E(2)=2.0*EMASS/(44.01288*AMU) E(3)=12.886 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.073 EIN(2)=0.159 EIN(3)=0.276 EIN(4)=4.06 EIN(5)=8.50 EIN(6)=9.60 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-18*SCALEAT 300 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 900 DO 810 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 820 810 CONTINUE J=NEXC3 820 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(6,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS19(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(50),YXSEC(50),XVIB1(31),YVIB1(31),XVIB2(31), /YVIB2(31),XVIB3(18),YVIB3(18),XVIB4(31),YVIB4(31),XVIB5(21), /YVIB5(21),XEXC1(17),YEXC1(17),XEXC2(24),YEXC2(24),XEXC3(23), /YEXC3(23),XION(57),YION(57),XATT(16),YATT(16) CHARACTER*15 NAME DATA XEN/0.00,0.01,.014,0.02,.025,0.03,0.04,0.05,0.06,0.07, /0.08,0.09,0.10,0.12,0.14,0.17,0.20,0.25,0.30,0.40, /0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,10.0,14.0,20.0,30.0,40.0,50.0,70.0,100., /140.,200.,300.,400.,600.,800.,1000.,2000.,10000.,100000./ DATA YXSEC/8.40,8.40,7.80,7.20,6.60,6.00,4.90,3.90,3.00,2.70, /2.60,2.60,2.70,3.00,3.35,3.85,4.40,5.35,6.20,8.00, /9.60,11.0,13.0,14.5,16.0,17.0,17.0,16.5,16.5,17.5, /19.5,19.5,17.5,12.5,8.00,5.00,3.60,2.70,1.90,1.25, /0.85,0.58,0.37,0.27,0.17,0.12,0.10,.047,.008,.00006/ DATA XVIB1/.117,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB1/0.0,.001,.025,.044,.088,.094,.088,.063,.044,.029, /.014,.013,.038,.088,.125,.163,.212,.288,.312,.288, /.262,.125,0.10,.075,0.05,.025,0.01,.004,.0004,.000012, /.0000012/ DATA XVIB2/.166,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB2/0.00,.001,.138,0.47,2.36,3.30,2.91,2.04,1.35,0.76, /0.48,0.34,0.20,0.21,0.26,0.33,0.46,0.54,0.56,0.50, /0.41,0.23,0.18,0.14,0.10,.056,.024,0.01,.0012,.00004, /.000004/ DATA XVIB3/.333,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,10.0,100.0,1000.,10000.,100000./ DATA YVIB3/0.00,.001,.094,0.11,0.51,0.94,0.85,0.56,0.33,0.19, /.094,0.05,.025,.0012,.00012,.000012,.0000012,.00000012/ DATA XVIB4/.375,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB4/0.00,.001,.033,.056,0.34,0.54,0.50,0.40,0.29,0.20, /0.16,0.14,0.14,0.18,0.30,0.50,0.63,0.65,0.58,0.48, /0.36,0.20,0.15,0.13,0.09,0.05,.021,.009,.0011,.00004, /.000004/ DATA XVIB5/0.75,1.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB5/0.00,.0001,.001,.017,.030,0.05,0.06,.065,.058,.048, /.036,.020,.015,.012,.009,.005,.0021,.0009,.00011,.000004, /.0000004/ DATA XEXC1/3.70,3.77,4.00,4.50,5.00,6.00,7.00,8.00,9.00,10.0, /14.0,20.0,30.0,100.,1000.,10000.,100000./ DATA YEXC1/0.00,0.01,0.05,0.24,0.45,0.54,0.54,0.48,0.41,0.31, /0.12,.041,.010,.001,.0001,.00001,.000001/ DATA XEXC2/4.85,4.90,5.00,5.50,6.00,7.00,8.00,9.00,10.0,14.0, /20.0,30.0,40.0,50.0,70.0,100.,140.,200.,300.,500., /700.,1000.,10000.,100000./ DATA YEXC2/0.00,.009,.019,.056,0.23,0.56,0.80,1.08,1.30,2.17, /3.09,3.88,4.00,3.76,3.38,3.01,2.40,1.79,1.18,0.66, /0.48,0.35,0.035,.0035/ DATA XEXC3/7.10,7.15,8.00,8.50,9.00,10.0,14.0,20.0,25.0,30.0, /40.0,50.0,60.0,70.0,100.,140.,200.,300.,500.,700., /1000.,10000.,100000./ DATA YEXC3/0.00,0.01,0.08,0.14,0.25,0.41,0.82,1.07,1.10,1.12, /1.00,0.94,0.80,0.72,0.49,0.35,0.25,0.17,0.10,0.07, /0.05,.005,.0005/ DATA XION/10.5,10.55,11.0,11.5,12.0,12.5,13.0,13.5,14.0,14.5, /15.0,16.0,17.0,18.0,19.0,21.0,22.0,24.0,26.0,28.0, /30.0,32.0,34.0,36.0,38.0,40.0,45.0,50.0,60.0,70.0, /80.0,90.0,100.,120.,140.,150.,175.,200.,250.,300., /350.,400.,450.,500.,600.,700.,800.,900.,1000.,1250., /1500.,1750.,2000.,2500.,3000.,10000.,100000./ DATA YION/0.00,.011,.045,.087,.134,.193,.263,.345,.431,.533, /.641,.861,1.06,1.27,1.49,1.90,2.09,2.44,2.95,3.25, /3.52,3.76,3.98,4.18,4.35,4.50,4.80,5.07,5.47,5.69, /5.80,5.83,5.79,5.66,5.42,5.20,4.80,4.58,3.92,3.56, /3.18,2.87,2.64,2.45,2.19,1.96,1.75,1.63,1.52,1.28, /1.11,1.03,.908,.767,.678,0.26,.045/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ NAME='ETHENE C2H4 99 ' C --------------------------------------------------------------------- C 1999 INCLUDED VIBRATIONAL RESONACE SHAPE FROM WALKER ET AL C REF J.CHEM.PHYS. 69(1978) 5532 C NOW FITS ARGON-ETHENE MIXTURE DATA OF JEAN-MARIE ET AL. C AND SCHMIDTS DATA IN PURE ETHENE C --------------------------------------------------------------------- NIN=10 NDATA=50 NVIB1=31 NVIB2=31 NVIB3=18 NVIB4=31 NVIB5=21 NEXC1=17 NEXC2=24 NEXC3=23 NION=57 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(28.05376*AMU) E(3)=10.5 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.117 EIN(2)=0.117 EIN(3)=-0.166 EIN(4)=0.166 EIN(5)=0.333 EIN(6)=0.375 EIN(7)=0.750 EIN(8)=3.70 EIN(9)=4.85 EIN(10)=7.10 AMP1=0.091 AMP2=0.091 AMP3=0.10 APOP=DEXP(EIN(1)/AKT) APOPH=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 C 300 Q(5,I)=0.0 Q(6,I)=0.0 C C V7 SUPERELASTIC QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 350 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V7 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=QIN(2,I)+(A*EN+B) QIN(2,I)=QIN(2,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 4150 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 4120 4110 CONTINUE J=NVIB2 4120 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V2 + V3 (SUM OF VIBRATIONS AT 166 AND 201 MV) QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 450 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3+2V2 (HARMONICS) QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 500 DO 460 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 470 460 CONTINUE J=NVIB3 470 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 550 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP3*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 600 DO 560 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 570 560 CONTINUE J=NVIB5 570 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 899 DO 810 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 820 810 CONTINUE J=NEXC3 820 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(10,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS20(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(56),YXSEC(56),XVIB1(35),YVIB1(35),XVIB2(26), /YVIB2(26),XVIB3(26),YVIB3(26),XEXC1(26),YEXC1(26),XEXC2(15), /YEXC2(15),XEXC3(30),YEXC3(30),XION(33),YION(33), /XATT(16),YATT(16) CHARACTER*15 NAME DATA XEN/0.00,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08,0.09, /0.10,0.12,0.14,0.17,0.20,0.25,0.30,0.40,0.50,0.60, /0.80,1.00,1.20,1.40,1.70,2.00,2.50,3.00,4.00,5.00, /6.00,7.00,8.00,9.00,10.0,12.0,14.0,17.0,20.0,30.0, /40.0,50.0,60.0,70.0,80.0,90.0,100.,120.,140.,170., /200.,300.,400.,600.,800.,1000./ DATA YXSEC/10.2,10.2,10.2,10.2,10.2,10.2,10.2,10.2,10.2,10.2, /10.2,10.2,10.3,10.4,10.5,10.8,11.2,12.3,13.4,14.5, /16.7,18.5,20.3,22.0,24.5,27.0,27.0,23.0,18.0,13.5, /10.9,9.00,8.00,7.07,6.65,5.90,5.55,4.95,4.50,3.55, /3.15,2.70,2.47,2.25,2.00,1.85,1.62,1.35,1.16,0.92, /0.76,0.47,0.29,0.17,0.11,0.07/ DATA XVIB1/0.0,.0904,.092,.095,0.10,0.12,0.14,0.17,0.20,0.25, /0.30,0.40,0.50,0.60,0.80,1.00,1.20,1.40,1.70,2.00, /2.50,3.00,4.00,5.00,6.00,7.00,8.00,10.0,12.0,14.0, /20.0,30.0,50.0,100.,1000./ DATA YVIB1/0.0,0.00,0.28,2.55,3.00,3.80,3.80,3.70,3.60,3.50, /3.40,3.20,2.90,2.60,2.30,2.05,1.80,1.70,1.70,1.85, /2.00,1.65,1.10,0.80,0.60,0.50,0.40,0.25,0.20,0.15, /0.09,0.04,0.02,.001,.0001/ DATA XVIB2/0.00,0.18,0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90, /1.00,1.20,1.40,1.70,2.00,2.50,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,100.,1000./ DATA YVIB2/0.00,0.00,0.01,.015,0.02,.023,.026,0.03,.035,0.04, /0.05,0.07,0.11,0.26,0.64,1.27,1.00,0.35,0.15,0.08, /0.04,.025,.015,.011,.001,.0001/ DATA XVIB3/0.00,.408,.412,0.43,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.20,1.40,1.70,2.00,2.50,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,100.,1000./ DATA YVIB3/0.00,0.00,.018,0.15,0.22,0.35,0.49,0.56,0.57,0.57, /0.56,0.52,0.51,0.54,0.77,1.01,0.86,0.31,0.15,0.09, /0.05,0.03,0.02,0.01,.001,.0001/ DATA XEXC1/1.95,1.97,2.00,2.20,2.50,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,12.0,14.0,20.0,25.0,30.0,40.0,50.0, /70.0,100.,140.,200.,400.,1000./ DATA YEXC1/0.00,0.01,0.10,0.55,0.89,0.99,0.94,0.82,0.68,0.58, /0.50,0.44,0.40,0.33,0.29,0.20,0.16,0.13,0.10,0.08, /0.06,0.04,0.03,0.02,0.01,.001/ DATA XEXC2/4.90,5.00,6.00,7.00,8.00,9.00,10.0,12.0,14.0,17.0, /20.0,25.0,30.0,100.,1000./ DATA YEXC2/0.00,0.01,0.10,0.19,0.29,0.33,0.35,0.34,0.28,0.17, /.095,0.03,.008,.0001,.00001/ DATA XEXC3/7.90,8.00,8.20,8.50,8.80,9.00,10.0,12.0,14.0,17.0, /20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100., /120.,140.,170.,200.,250.,300.,400.,600.,800.,1000./ DATA YEXC3/0.00,0.01,0.18,0.36,0.72,1.30,2.30,2.75,2.88,2.90, /2.75,2.45,2.15,1.75,1.33,1.14,0.98,0.82,0.75,0.67, /0.54,0.48,0.40,0.33,0.27,0.22,0.17,0.11,0.09,.068/ DATA XION/11.42,11.6,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0,100., /120.,140.,170.,200.,250.,300.,400.,500.,600.,700., /800.,900.,1000./ DATA YION/0.00,0.01,.045,0.10,0.26,0.53,0.74,1.07,1.20,1.39, /1.59,2.32,3.05,3.83,4.24,4.37,4.50,4.50,4.45,4.37, /4.24,4.07,3.76,3.44,3.05,2.83,2.37,2.12,1.72,1.52, /1.39,1.23,1.16/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ NAME=' ACETYLENE 92 ' C --------------------------------------------------------------------- C C2H2 MODIFIED HAYASHI TO FIT GLOBAL DATA C --------------------------------------------------------------------- NIN=6 NDATA=56 NVIB1=35 NVIB2=26 NVIB3=26 NEXC1=26 NEXC2=15 NEXC3=30 NION=33 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(26.03788*AMU) E(3)=11.42 C CORRECT ENERGY E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.0904 EIN(2)=0.180 EIN(3)=0.408 EIN(4)=1.95 EIN(5)=4.90 EIN(6)=7.90 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-21 C 300 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 330 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(A*EN+B)*1.E-16 330 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 360 DO 340 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 350 340 CONTINUE J=NVIB2 350 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(2,I)=(A*EN+B)*1.E-16 360 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 430 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(3,I)=(A*EN+B)*1.E-16 430 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 460 DO 440 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 450 440 CONTINUE J=NEXC1 450 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(4,I)=(A*EN+B)*1.E-16 460 CONTINUE C 500 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 600 DO 510 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 520 510 CONTINUE J=NEXC2 520 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(5,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 700 DO 610 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 620 610 CONTINUE J=NEXC3 620 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(6,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS21(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(57),YXSEC(57),XROT0(57),YROT0(57),XROT1(47),YROT1(47 /),XROT2(32),YROT2(32),XROT3(32),YROT3(32),XVIB1(40),YVIB1(40), /XVIB2(39),YVIB2(39),XVIB3(16),YVIB3(16),XVIB4(15),YVIB4(15), /XEXC1(20),YEXC1(20),XEXC2(23),YEXC2(23),XATT(27),YATT(27), /XION(72),YION(72),PJ(5) CHARACTER*15 NAME C -------------------------------------------------------------- C ELASTIC MT DATA XEN/0.00,.001,.003,.005,.007,0.01,0.02,0.03,0.04,.046, /0.05,0.06,0.07,0.08,0.09,0.10,0.13,0.15,0.20,0.30, /0.40,0.50,0.60,0.70,0.90,1.00,1.10,1.40,1.50,1.60, /1.80,2.00,2.50,3.00,4.00,5.00,6.00,8.00,10.0,15.0, /20.0,30.0,40.0,50.0,60.0,80.0,100.,150.,200.,300., /400.,500.,600.,800.,1000.,10000.,100000./ DATA YXSEC/7.20,7.25,7.35,7.45,7.56,7.72,8.14,8.56,8.98,9.10, /9.27,9.53,9.79,10.04,10.25,10.47,11.08,11.43,12.06,13.00, /13.71,14.45,15.19,15.64,16.14,16.47,16.84,18.10,18.42,18.59, /18.15,17.90,17.30,16.40,13.80,11.80,9.800,7.20,5.10,2.80, /1.80,0.95,0.64,0.45,0.34,0.22,0.15,0.07,.043,.022, /.014,.010,.006,.004,.002,.0002,.00002/ C----------------------------------------------------------------------- C ROTATION J=0-2 DATA XROT0/.0439,.046,.047,.048,.049,.050,.051,.054,.055, /.060, /.065,.070,.080,.090,0.10,0.11,0.12,0.13,0.14,0.15, /0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.55,0.60,0.65, /0.70,0.80,0.90,1.00,1.10,1.20,1.35,1.50,1.75,2.00, /2.50,3.00,3.50,4.00,4.50,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YROT0/0.00,.0206,.0276,.0286,.0297,.0308,.0310,.0330,.0340, /.0394, /.0452,.0507,.0614,.0680,.0740,.0790,.0835,.088,.0925,.0970, /.115,.132,.152,.175,.200,.228,.260,.291,.323,.359, /.394,.469,.555,.636,.716,.796,.916,1.036,1.203,1.370, /1.585,1.704,1.755,1.758,1.732,1.689,1.579,1.462,1.350,1.248, /1.156,0.730,0.44,0.05,.0015,.0005,.00015/ C----------------------------------------------------------------------- C ROTATION J=1-3 DATA XROT1/0.0727,.075,.080,.085,.090,.095,0.10,0.11,0.12,0.13, /0.15,0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.56,0.60, /0.66,0.70,0.80,0.90,1.01,1.20,1.40,1.60,1.80,2.00, /2.50,3.00,3.50,4.00,4.50,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YROT1/0.00,.0085,.0149,.0203,.0238,.0266,.0282,.0351,.0403, /.0449,.0520,.0604,.0719,.0870,.1029,.1191,.1361,.1543,.1773,.1944, /.2212,.2396,.2839,.3328,.3842,.489,.569,.658,.743,.818, /.952,1.020,1.046,1.050,1.036,1.011,.946,.876,.809,.748, /.694,.440,.265,0.03,0.001,.0001,.00001/ C----------------------------------------------------------------------- C ROTATION J=2-4 (ALSO USE THESE VALUES FOR 4-6 TRANSITION) DATA XROT2/0.1008,0.15,0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.60, /0.70,0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00, /4.50,5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000., /10000.,100000./ DATA YROT2/0.00,.0249,.0367,.0475,.0577,.0694,.0834,.1003,.1192, /.145,.178,.216,.256,.299,.436,.543,.600,.649,.670,.672, /.662,.646,.627,.605,.561,.517,.444,0.17,.017,.0007, /.00007,.000007/ C----------------------------------------------------------------------- C ROTATION J=3-5 (ALSO USE THESE VALUES FOR 5-7 TRANSITION) DATA XROT3/0.1280,0.15,0.20,0.25,0.30,0.35,0.40,0.45,0.50,0.60, /0.70,0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00, /4.50,5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000., /10000.,100000./ DATA YROT3/0.00,.019,.033,.043,.050,.058,.066,.075,.085,.104, /.128,.154,.185,.214,.334,.565,.700,.750,.825,.828, /.818,.797,.774,.747,.692,.640,.548,0.18,0.02,.0007, /.00007,.000007/ C----------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=0 ROTATIONALLY ELASTIC DATA XVIB1/0.516,0.56,0.58,0.60,0.65,0.75,0.85,0.95,1.00,1.05, /1.10,1.15,1.20,1.30,1.40,1.60,1.80,2.20,2.40,2.60, /3.00,3.50,4.00,4.50,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,12.0,13.0,14.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,.0007,.0025,.0063,.0070,.0103,.0164,.0269,.0331, /.0386,.0435,.0483,.0525,.0626,.0707,.0926,.1166,.1556,.1635,.1719, /.1916,.2008,.1860,.1630,.1460,.1160,.0876,.0637,.0506,.0376, /.0292,.0215,.0180,.0170,.0150,.0092,.0018,.00006,.000006,.0000007/ C----------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=2 ROTATIONALLY INELASTIC DATA XVIB2/0.558,.575,0.60,0.65,0.75,0.85,0.95,1.00,1.05,1.10, /1.15,1.20,1.30,1.40,1.60,1.80,2.20,2.40,2.60,3.00, /3.50,4.00,4.50,5.00,6.00,7.00,8.00,9.00,10.0,11.0, /12.0,13.0,14.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,.0002,.0016,.0027,.0056,.0107,.0197,.0255,.0305, /.0356,.0408,.0459,.0579,.0671,.0954,.1279,.1829,.1963,.2141,.2494, /.2672,.2540,.2270,.2040,.1640,.1224,.0879,.0684,.0498,.0388, /.0285,.0200,.0150,.0100,.0062,.0012,.00004,.000004,.0000004/ C----------------------------------------------------------------------- C VIBRATION V=0-2 DATA XVIB3/1.023,1.34,1.50,2.00,3.00,4.00,5.00,6.00,8.00,10.0, /15.0,20.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,.001,.002,.014,.035,.037,.035,.029,.021,.014, /.002,.001,.0003,.00001,.000001,.0000001/ C----------------------------------------------------------------------- C VIBRATION V=0-3 DATA XVIB4/1.480,1.95,2.00,3.00,4.00,5.00,6.00,8.00,10.0,15.0, /20.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,.001,.0012,.0036,.0037,.0035,.0027,.0019,.0012, /.0002,.0001,.00003,.000001,.0000001,.00000001/ C----------------------------------------------------------------------- C EXCITATION TO TRIPLET STATES (DISSOCIATION) DATA XEXC1/8.85,8.92,9.34,10.0,11.0,12.0,15.0,20.0,25.0,30.0, /40.0,50.0,60.0,80.0,100.,150.,200.,1000.,10000.,100000./ DATA YEXC1/0.00,0.01,0.05,0.10,0.23,0.42,0.64,0.57,0.35,0.23, /0.10,.051,.031,.013,.006,.0015,.0006,.0001,.00002,.000004/ C EXCITATION TO SINGLET STATES DATA XEXC2/12.0,12.13,13.4,15.0,17.0,20.0,25.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,400.,500.,600.,800., /1000.,10000.,100000./ DATA YEXC2/0.00,0.10,0.10,0.27,0.44,0.64,0.95,1.12,1.19,1.23, /1.26,1.17,1.10,0.88,0.78,0.64,0.55,0.47,0.42,0.34, /0.27,0.06,.015/ C----------------------------------------------------------------------- DATA XATT/7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /17.0,18.0,30.0,40.0,50.0,60.0,70.0,80.0,100.,150., /200.,300.,400.,700.,1000.,10000.,100000./ DATA YATT/0.00,.000032,.00009,.000128,.000118,.000075,.000052, /.00021,.000087,.00009,.00010,.00011,.00091,.0170,.0330,.045,.053, /.056,.058,.053,.044,.031,.024,.013,.008,.001,.0001/ C----------------------------------------------------------------------- DATA XION/15.427,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /20.5,21.0,21.5,22.0,22.5,23.0,23.5,24.0,24.5,25.0, /25.5,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000., /10000.,100000./ DATA YION/0.00,.0299,.0607,.0924,.123,.156,.187,.220,.249,.280, /.310,.336,.362,.390,.413,.439,.461,.484,.505,.524, /.544,.563,.632,.688,.736,.776,.812,.840,.866,.913, /.941,.959,.968,.971,.971,.970,.964,.958,.948,.934, /.924,.916,.903,.891,.878,.864,.853,.844,.830,.821, /.813,.790,.752,.715,.636,.573,.518,.476,.438,.406, /.378,.354,.334,.315,.298,.283,.271,.260,.250,.240, /.060,.015/ C---------------------------------------------------------------------- NAME=' H2 2001 ' C -------------------------------------------------------------------- C CALCULATE FRACTIONAL POPULATION DENSITY FOR ROTATIONAL STATES B0=0.00753936 DO 111 K=1,5,2 111 PJ(K)=3*(2*K+1)*DEXP(-K*(K+1)*B0/AKT) DO 112 K=2,4,2 112 PJ(K)=(2*K+1)*DEXP(-K*(K+1)*B0/AKT) SUM=1.0 DO 113 K=1,5 113 SUM=SUM+PJ(K) FROT0=1.0/SUM FROT1=PJ(1)/SUM FROT2=PJ(2)/SUM FROT3=PJ(3)/SUM FROT4=PJ(4)/SUM FROT5=PJ(5)/SUM C WRITE(6,88) FROT0,FROT1,FROT2,FROT3,FROT4,FROT5 C 88 FORMAT(3X,' FROT0=',F9.6,' FROT1=',F9.6,' FROT2=',F9.6,' FROT3=', C /F9.6,' FROT4=',F9.6,' FROT5=',F9.6) C----------------------------------------------------------------------- NIN=14 NDATA=57 NROT0=57 NROT1=47 NROT2=32 NROT3=32 NVIB1=40 NVIB2=39 NVIB3=16 NVIB4=15 NEXC1=20 NEXC2=23 NION=72 NATT=27 E(1)=0.0 E(2)=2.0*EMASS/(2.015650*AMU) E(3)=15.427 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-.0439 EIN(2)=-.0727 EIN(3)=-.1008 EIN(4)=-.128 EIN(5)=0.0439 EIN(6)=0.0727 EIN(7)=0.1008 EIN(8)=0.128 EIN(9)=0.516 EIN(10)=0.558 EIN(11)=1.023 EIN(12)=1.480 EIN(13)=8.85 EIN(14)=12.0 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 CONTINUE C Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16 300 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 C--------------------------------------------------------------------- C SUPERELASTIC 2-0 QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 1100 DO 1010 J=2,NROT0 IF((EN+EIN(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.E-16/EN 1100 CONTINUE C SUPERELASTIC 3-1 QIN(2,I)=0.0 IF(EN.LE.0.0) GO TO 1200 DO 1110 J=2,NROT1 IF((EN+EIN(6)).LE.XROT1(J)) GO TO 1120 1110 CONTINUE J=NROT1 1120 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(2,I)=FROT3*(3.0/7.0)*(EN+EIN(6))*(A*(EN+EIN(6))+B)*1.E-16/EN 1200 CONTINUE C SUPERELASTIC 4-2 QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 1250 DO 1210 J=2,NROT2 IF((EN+EIN(7)).LE.XROT2(J)) GO TO 1220 1210 CONTINUE J=NROT2 1220 A=(YROT2(J)-YROT2(J-1))/(XROT2(J)-XROT2(J-1)) B=(XROT2(J-1)*YROT2(J)-XROT2(J)*YROT2(J-1))/(XROT2(J-1)-XROT2(J)) QIN(3,I)=FROT4*(5.0/9.0)*(EN+EIN(7))*(A*(EN+EIN(7))+B)*1.E-16/EN 1250 CONTINUE C SUPERELASTIC 5-3 QIN(4,I)=0.0 IF(EN.LE.0.0) GO TO 1290 DO 1260 J=2,NROT3 IF((EN+EIN(8)).LE.XROT3(J)) GO TO 1270 1260 CONTINUE J=NROT3 1270 A=(YROT3(J)-YROT3(J-1))/(XROT3(J)-XROT3(J-1)) B=(XROT3(J-1)*YROT3(J)-XROT3(J)*YROT3(J-1))/(XROT3(J-1)-XROT3(J)) QIN(4,I)=FROT5*(7.0/11.)*(EN+EIN(8))*(A*(EN+EIN(8))+B)*1.E-16/EN 1290 CONTINUE C ROTATION 0-2 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 1400 DO 1310 J=2,NROT0 IF(EN.LE.XROT0(J)) GO TO 1320 1310 CONTINUE J=NROT0 1320 A=(YROT0(J)-YROT0(J-1))/(XROT0(J)-XROT0(J-1)) B=(XROT0(J-1)*YROT0(J)-XROT0(J)*YROT0(J-1))/(XROT0(J-1)-XROT0(J)) QIN(5,I)=(A*EN+B)*1.E-16*FROT0 1400 CONTINUE C ROTATION 1-3 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 1401 DO 1311 J=2,NROT1 IF(EN.LE.XROT1(J)) GO TO 1321 1311 CONTINUE J=NROT1 1321 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(6,I)=(A*EN+B)*1.E-16*FROT1 1401 CONTINUE C ROTATION 2-4 +4-6 QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 1402 DO 1312 J=2,NROT2 IF(EN.LE.XROT2(J)) GO TO 1322 1312 CONTINUE J=NROT2 1322 A=(YROT2(J)-YROT2(J-1))/(XROT2(J)-XROT2(J-1)) B=(XROT2(J-1)*YROT2(J)-XROT2(J)*YROT2(J-1))/(XROT2(J-1)-XROT2(J)) QIN(7,I)=(A*EN+B)*1.E-16*(FROT2+FROT4) 1402 CONTINUE C ROTATION 3-5 +5-7 QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 1403 DO 1313 J=2,NROT3 IF(EN.LE.XROT3(J)) GO TO 1323 1313 CONTINUE J=NROT3 1323 A=(YROT3(J)-YROT3(J-1))/(XROT3(J)-XROT3(J-1)) B=(XROT3(J-1)*YROT3(J)-XROT3(J)*YROT3(J-1))/(XROT3(J-1)-XROT3(J)) QIN(8,I)=(A*EN+B)*1.E-16*(FROT3+FROT5) 1403 CONTINUE C----------------------------------------------------------------------- QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(9,I)=(A*EN+B)*1.E-16 400 CONTINUE C QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(10,I)=(A*EN+B)*1.E-16 500 CONTINUE C QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 501 DO 411 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 421 411 CONTINUE J=NVIB3 421 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(11,I)=(A*EN+B)*1.E-16 501 CONTINUE C QIN(12,I)=0.0 IF(EN.LE.EIN(12)) GO TO 502 DO 412 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 422 412 CONTINUE J=NVIB4 422 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(12,I)=(A*EN+B)*1.E-16 502 CONTINUE C----------------------------------------------------------------------- QIN(13,I)=0.0 IF(EN.LE.EIN(13)) GO TO 600 DO 510 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 520 510 CONTINUE J=NEXC1 520 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(13,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(14,I)=0.0 IF(EN.LE.EIN(14)) GO TO 700 DO 610 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 620 610 CONTINUE J=NEXC2 620 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(14,I)=(A*EN+B)*1.E-16 700 CONTINUE C--------------------------------------------------------------------- Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I)+ /QIN(12,I)+QIN(13,I)+QIN(14,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(14)) NIN=13 IF(EFINAL.LE.EIN(13)) NIN=12 IF(EFINAL.LE.EIN(12)) NIN=11 IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS22(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(51),YXSEC(51),XROT0(38),YROT0(38),XROT1(40),YROT1(40 /),XROT2(29),YROT2(29),XROT3(29),YROT3(29),XROT4(29),YROT4(29), /XROT5(28),YROT5(28),XVIB1(33),YVIB1(33),XVIB2(33),YVIB2(33), /XVIB3(14),YVIB3(14),XVIB4(14),YVIB4(14),XEXC1(18),YEXC1(18), /XEXC2(21),YEXC2(21),XATT(25),YATT(25),XION(70),YION(70),PJ(7) CHARACTER*15 NAME DATA XEN/0.00,0.01,0.02,0.03,0.04,.046,0.05,0.06,0.07,0.08, /0.09,0.10,0.13,0.15,0.20,0.30,0.40,0.50,0.60,0.70, /0.90,1.00,1.10,1.40,1.50,1.60,1.80,2.00,2.50,3.00, /4.00,5.00,6.00,8.00,10.0,15.0,20.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,400.,500.,600.,800.,1000./ DATA YXSEC/6.36,7.26,7.95,8.45,8.91,9.05,9.22,9.50,9.79,10.04, /10.24,10.44,10.93,11.33,11.93,12.92,13.82,14.61,15.51,16.20, /16.9,17.2,17.3,17.7,17.7,17.8,17.7,17.5,16.8,16.1, /14.2,13.5,13.2,12.3,11.2,7.30,4.30,1.60,0.77,0.50, /0.35,0.22,0.15,0.07,.043,.022,.014,.010,.006,.004,.002/ C----------------------------------------------------------------------- C ROTATION J=0-2 DATA XROT0/.0226,.025,0.03,0.04,0.05,0.06,0.07,0.08,0.10,0.15, /0.20,0.25,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.20,1.50,2.00,2.50,3.00,3.50,4.00,4.50,5.00,6.00, /7.00,8.00,9.00,10.0,15.0,20.0,100.,1000./ DATA YROT0/0.00,.024,.042,.061,.067,.073,.078,.082,.091,.110, /.129,.144,.170,.215,.264,.323,.394,.469,.555,.636, /.796,1.036,1.370,1.585,1.704,1.755,1.758,1.732,1.689,1.579, /1.462,1.350,1.248,1.156,0.730,0.44,0.05,0.0015/ C----------------------------------------------------------------------- C ROTATION J=1-3 DATA XROT1/.0377,0.04,0.05,0.06,0.07,0.08,0.10,0.15,0.20,0.25, /0.30,0.40,0.50,0.56,0.60,0.66,0.70,0.80,0.90,1.01, /1.20,1.40,1.60,1.80,2.00,2.50,3.00,3.50,4.00,4.50, /5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,100.,1000./ DATA YROT1/0.00,0.01,.026,.032,.036,.040,.046,.058,.071,.082, /.094,.122,.152,.165,.178,.200,.214,.252,.292,.334, /.420,.510,.610,.700,.786,.937,1.01,1.05,1.05,1.04, /1.01,.946,.876,.809,.748,.694,.440,.265,0.03,.001/ C----------------------------------------------------------------------- C ROTATION J=2-4 DATA XROT2/.0528,0.07,0.10,0.15,0.20,0.30,0.40,0.50,0.60,0.70, /0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00,4.50, /5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000./ DATA YROT2/0.00,.022,.034,.046,.055,.075,.099,.115,.132,.162, /.193,.227,.266,.463,.619,.719,.774,.799,.802,.790, /.771,.748,.721,.669,.617,.529,0.20,0.02,.0007/ C----------------------------------------------------------------------- C ROTATION J=3-5 DATA XROT3/.0679,0.10,0.15,0.20,0.25,0.30,0.40,0.50,0.60,0.70, /0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00,4.50, /5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000./ DATA YROT3/0.00,0.02,0.04,0.05,0.06,0.07,.095,.110,.129,.160, /.194,.233,.271,.478,.637,.742,.799,.825,.828,.818, /.797,.774,.747,.692,.640,.548,0.18,0.02,.0007/ C----------------------------------------------------------------------- C ROTATION J=4-6 DATA XROT4/.0830,0.10,0.15,0.20,0.25,0.30,0.40,0.50,0.60,0.70, /0.80,0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00,4.50, /5.00,5.50,6.00,7.00,8.00,10.0,20.0,100.,1000./ DATA YROT4/0.00,.012,0.03,.038,.045,.053,.071,.083,.097,.120, /.146,.175,0.20,0.36,0.48,0.56,0.60,0.62,0.62,0.61, /0.60,0.58,0.56,0.52,0.48,0.41,0.13,.015,.0005/ C----------------------------------------------------------------------- C ROTATION J=5-7 DATA XROT5/.0981,0.15,0.20,0.25,0.30,0.40,0.50,0.60,0.70,0.80, /0.90,1.00,1.50,2.00,2.50,3.00,3.50,4.00,4.50,5.00, /5.50,6.00,7.00,8.00,10.0,20.0,100.,1000./ DATA YROT5/0.00,.015,.028,.034,0.04,.053,.062,.073,0.09,0.11, /0.13,0.15,0.27,0.36,0.42,0.45,0.46,0.46,0.46,0.45, /0.44,0.42,0.39,0.36,0.31,0.10,0.01,.0004/ C---------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=0 ROTATIONALLY ELASTIC DATA XVIB1/0.371,0.50,0.60,0.65,0.75,0.85,1.00,1.15,1.25,1.50, /1.75,2.00,2.20,2.40,2.60,3.00,3.50,4.00,4.50,5.00, /6.00,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0, /20.0,100.,1000./ DATA YVIB1/0.00,.0045,.009,.011,.016,.020,.028,.037,.042,.064, /.084,.100,.110,.120,.128,.135,.140,.140,.135,.122, /.100,.077,.060,.046,.035,.027,.021,.017,.015,.013, /.0085,.0017,.00005/ C----------------------------------------------------------------------- C VIBRATION V=0-1 DELTAJ=2 ROTATIONALLY INELASTIC DATA XVIB2/0.391,0.50,0.60,0.65,0.75,0.85,1.00,1.15,1.25,1.50, /1.75,2.00,2.20,2.40,2.60,3.00,3.50,4.00,4.50,5.00, /6.00,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0, /20.0,100.,1000./ DATA YVIB2/0.00,.0025,.0055,.008,.012,.017,.026,.035,.040,.064, /.088,.115,.135,.150,.160,.176,.188,.188,.185,.172, /.142,.110,.082,.062,.045,.035,.026,.019,.014,.011, /.0074,.0015,.00004/ C----------------------------------------------------------------------- C VIBRATION V=0-2 DATA XVIB3/0.735,1.00,1.50,2.00,3.00,4.00,5.00,6.00,8.00,10.0, /15.0,20.0,100.,1000./ DATA YVIB3/0.00,.0005,.003,.007,.017,.018,.017,.015,.011,.007, /.001,.0005,.00015,.000005/ C----------------------------------------------------------------------- C VIBRATION V=0-3 DATA XVIB4/1.085,1.35,1.50,2.00,3.00,4.00,5.00,6.00,8.00,10.0, /15.0,20.0,100.,1000./ DATA YVIB4/0.00,.00015,.0003,.0008,.0016,.0016,.0015,.0012,.001, /.0015,.0005,.0001,.000025,.0000008/ C----------------------------------------------------------------------- C EXCITATION TO TRIPLET STATES (DISSOCIATION) DATA XEXC1/8.85,8.92,9.34,10.0,11.0,12.0,15.0,20.0,25.0,30.0, /40.0,50.0,60.0,80.0,100.,150.,200.,1000./ DATA YEXC1/0.00,.008,0.04,0.08,.184,.336,0.51,0.46,0.28,0.18, /0.08,.041,.025,.010,.005,.0012,.0005,.00008/ C EXCITATION TO SINGLET STATES DATA XEXC2/12.0,12.13,13.4,15.0,17.0,20.0,25.0,30.0,40.0,50.0, /60.0,80.0,100.,150.,200.,300.,400.,500.,600.,800.,1000./ DATA YEXC2/0.00,0.09,0.09,0.24,0.40,0.58,0.86,1.01,1.07,1.11, /1.13,1.05,0.99,0.79,0.70,0.58,0.50,0.42,0.38,0.31,0.24/ C----------------------------------------------------------------------- DATA XATT/7.40,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0, /17.0,18.0,30.0,40.0,50.0,60.0,70.0,80.0,100.,150., /200.,300.,400.,700.,1000./ DATA YATT/0.00,.000005,.000012,.000026,.000027,.00003,.000035, /.00010,.00008,.00009,.00010,.00011,.00091,.0170,.0330,.045,.053, /.056,.058,.053,.044,.031,.024,.013,.008/ C----------------------------------------------------------------------- DATA XION/15.427,16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0, /20.5,21.0,21.5,22.0,22.5,23.0,23.5,24.0,24.5,25.0, /25.5,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000./ DATA YION/0.00,.034,.069,.104,.138,.173,.207,.239,.272,.300, /.328,.355,.383,.406,.429,.454,.475,.498,.518,.537, /.556,.575,.641,.699,.744,.786,.821,.851,.876,.931, /.950,.968,.977,.981,.981,.980,.974,.968,.958,.948, /.939,.925,.913,.907,.889,.877,.866,.853,.839,.827, /.813,.792,.754,.716,.638,.576,.523,.482,.446,.414, /.387,.366,.344,.326,.310,.295,.282,.271,.257,.247/ C---------------------------------------------------------------------- NAME=' DEUTERIUM 98 ' C -------------------------------------------------------------------- C CALCULATE FRACTIONAL POPULATION DENSITY FOR ROTATIONAL STATES B0=0.00377272 DO 111 K=1,7,2 111 PJ(K)=3*(2*K+1)*DEXP(-K*(K+1)*B0/AKT) DO 112 K=2,6,2 112 PJ(K)=6*(2*K+1)*DEXP(-K*(K+1)*B0/AKT) SUM=6.0 DO 113 K=1,5 113 SUM=SUM+PJ(K) FROT0=6.0/SUM FROT1=PJ(1)/SUM FROT2=PJ(2)/SUM FROT3=PJ(3)/SUM FROT4=PJ(4)/SUM FROT5=PJ(5)/SUM FROT6=PJ(6)/SUM FROT7=PJ(7)/SUM C WRITE(6,88) FROT0,FROT1,FROT2,FROT3,FROT4,FROT5,FROT6,FROT7 C 88 FORMAT(2X,' FROT0=',F9.5,' FROT1=',F9.5,' FROT2=',F9.5,' FROT3=', C /F9.5,' FROT4=',F9.5,' FROT5=',F9.5,' FROT6=',F9.5,' FROT7=',F9.5) C----------------------------------------------------------------------- NIN=15 NDATA=51 NROT0=38 NROT1=40 NROT2=29 NROT3=29 NROT4=29 NROT5=28 NVIB1=33 NVIB2=33 NVIB3=14 NVIB4=14 NEXC1=18 NEXC2=21 NION=70 NATT=25 E(1)=0.0 E(2)=2.0*EMASS/(4.028204*AMU) E(3)=15.427 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-.0226 EIN(2)=-.0377 EIN(3)=-.0528 EIN(4)=0.0226 EIN(5)=0.0377 EIN(6)=0.0528 EIN(7)=0.0679 EIN(8)=0.0830 EIN(9)=0.0981 EIN(10)=0.371 EIN(11)=0.391 EIN(12)=0.735 EIN(13)=1.085 EIN(14)=8.85 EIN(15)=12.0 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 CONTINUE C Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16 300 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 C--------------------------------------------------------------------- C SUPERELASTIC 2-0 QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 1100 DO 1010 J=2,NROT0 IF((EN+EIN(4)).LE.XROT0(J)) GO TO 1020 1010 CONTINUE J=NROT0 1020 A=(YROT0(J)-YROT0(J-1))/(XROT0(J)-XROT0(J-1)) B=(XROT0(J-1)*YROT0(J)-XROT0(J)*YROT0(J-1))/(XROT0(J-1)-XROT0(J)) QIN(1,I)=FROT2*0.2*(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.E-16/EN 1100 CONTINUE C SUPERELASTIC 3-1 QIN(2,I)=0.0 IF(EN.LE.0.0) GO TO 1101 DO 1011 J=2,NROT1 IF((EN+EIN(5)).LE.XROT1(J)) GO TO 1021 1011 CONTINUE J=NROT1 1021 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(2,I)=FROT3*(3.0/7.0)*(EN+EIN(5))*(A*(EN+EIN(5))+B)*1.E-16/EN 1101 CONTINUE C SUPERELASTIC 4-2 QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 1102 DO 1012 J=2,NROT2 IF((EN+EIN(6)).LE.XROT2(J)) GO TO 1022 1012 CONTINUE J=NROT2 1022 A=(YROT2(J)-YROT2(J-1))/(XROT2(J)-XROT2(J-1)) B=(XROT2(J-1)*YROT2(J)-XROT2(J)*YROT2(J-1))/(XROT2(J-1)-XROT2(J)) QIN(3,I)=FROT4*(5.0/9.0)*(EN+EIN(6))*(A*(EN+EIN(6))+B)*1.E-16/EN 1102 CONTINUE C ROTATION 0-2 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 1400 DO 1310 J=2,NROT0 IF(EN.LE.XROT0(J)) GO TO 1320 1310 CONTINUE J=NROT0 1320 A=(YROT0(J)-YROT0(J-1))/(XROT0(J)-XROT0(J-1)) B=(XROT0(J-1)*YROT0(J)-XROT0(J)*YROT0(J-1))/(XROT0(J-1)-XROT0(J)) QIN(4,I)=(A*EN+B)*1.E-16*FROT0 1400 CONTINUE C ROTATION 1-3 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 1401 DO 1311 J=2,NROT1 IF(EN.LE.XROT1(J)) GO TO 1321 1311 CONTINUE J=NROT1 1321 A=(YROT1(J)-YROT1(J-1))/(XROT1(J)-XROT1(J-1)) B=(XROT1(J-1)*YROT1(J)-XROT1(J)*YROT1(J-1))/(XROT1(J-1)-XROT1(J)) QIN(5,I)=(A*EN+B)*1.E-16*FROT1 1401 CONTINUE C ROTATION 2-4 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 1402 DO 1312 J=2,NROT2 IF(EN.LE.XROT2(J)) GO TO 1322 1312 CONTINUE J=NROT2 1322 A=(YROT2(J)-YROT2(J-1))/(XROT2(J)-XROT2(J-1)) B=(XROT2(J-1)*YROT2(J)-XROT2(J)*YROT2(J-1))/(XROT2(J-1)-XROT2(J)) QIN(6,I)=(A*EN+B)*1.E-16*FROT2 1402 CONTINUE C ROTATION 3-5 QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 1403 DO 1313 J=2,NROT3 IF(EN.LE.XROT3(J)) GO TO 1323 1313 CONTINUE J=NROT3 1323 A=(YROT3(J)-YROT3(J-1))/(XROT3(J)-XROT3(J-1)) B=(XROT3(J-1)*YROT3(J)-XROT3(J)*YROT3(J-1))/(XROT3(J-1)-XROT3(J)) QIN(7,I)=(A*EN+B)*1.E-16*FROT3 1403 CONTINUE C ROTATION 4-6 + 6-8 QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 1404 DO 1314 J=2,NROT4 IF(EN.LE.XROT4(J)) GO TO 1324 1314 CONTINUE J=NROT4 1324 A=(YROT4(J)-YROT4(J-1))/(XROT4(J)-XROT4(J-1)) B=(XROT4(J-1)*YROT4(J)-XROT4(J)*YROT4(J-1))/(XROT4(J-1)-XROT4(J)) QIN(8,I)=(A*EN+B)*1.E-16*(FROT4+FROT6) 1404 CONTINUE C ROTATION 5-7 + 7-9 QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 1405 DO 1315 J=2,NROT5 IF(EN.LE.XROT5(J)) GO TO 1325 1315 CONTINUE J=NROT5 1325 A=(YROT5(J)-YROT5(J-1))/(XROT5(J)-XROT5(J-1)) B=(XROT5(J-1)*YROT5(J)-XROT5(J)*YROT5(J-1))/(XROT5(J-1)-XROT5(J)) QIN(9,I)=(A*EN+B)*1.E-16*(FROT5+FROT7) 1405 CONTINUE C----------------------------------------------------------------------- QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(10,I)=(A*EN+B)*1.E-16 400 CONTINUE C QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(11,I)=(A*EN+B)*1.E-16 500 CONTINUE C QIN(12,I)=0.0 IF(EN.LE.EIN(12)) GO TO 501 DO 411 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 421 411 CONTINUE J=NVIB3 421 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(12,I)=(A*EN+B)*1.E-16 501 CONTINUE C QIN(13,I)=0.0 IF(EN.LE.EIN(13)) GO TO 502 DO 412 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 422 412 CONTINUE J=NVIB4 422 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(13,I)=(A*EN+B)*1.E-16 502 CONTINUE C----------------------------------------------------------------------- QIN(14,I)=0.0 IF(EN.LE.EIN(14)) GO TO 600 DO 510 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 520 510 CONTINUE J=NEXC1 520 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(14,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(15,I)=0.0 IF(EN.LE.EIN(15)) GO TO 700 DO 610 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 620 610 CONTINUE J=NEXC2 620 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(15,I)=(A*EN+B)*1.E-16 700 CONTINUE C--------------------------------------------------------------------- C NB. ROTATIONAL AND VIBRATIONAL STATES INCLUDED IN Q(2,I) C ------------------------------------------------------------------- Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(14,I)+QIN(15,I) C GET CORRECT ELASTIC XSECTION IF(EN.LT.200.) THEN Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I)-QIN(3,I)-QIN(4,I)-QIN(5,I)-QIN(6,I /)-QIN(7,I)-QIN(8,I)-QIN(9,I)-QIN(10,I)-QIN(11,I)-QIN(12,I)-QIN(13, /I) ENDIF 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(15)) NIN=14 IF(EFINAL.LE.EIN(14)) NIN=13 IF(EFINAL.LE.EIN(13)) NIN=12 IF(EFINAL.LE.EIN(12)) NIN=11 IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS23(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(50),YXSEC(50),XVIB1(41),YVIB1(41),XVIB2(25),YVIB2(25 /),XVIB3(22),YVIB3(22),XVIB4(21),YVIB4(21),XVIB5(18),YVIB5(18), /XVIB6(17),YVIB6(17),XION(70),YION(70),XATT(50),YATT(50), /XEXC(28),YEXC(28),XEXC1(24),YEXC1(24),XEXC2(22),YEXC2(22), /XEXC3(20),YEXC3(20),XEXC4(19),YEXC4(19),XEXC5(17),YEXC5(17), /YROT(7),XROT(7) CHARACTER*15 NAME DATA XEN/0.00,.001,.002,.003,.005,.007,.0085,0.01,.015,0.02, /0.03,0.04,0.05,0.07,0.10,0.12,0.14,0.16,0.18,0.20, /0.25,0.30,0.40,0.50,0.60,0.80,1.00,1.20,1.40,1.60, /1.80,2.00,2.50,3.00,4.00,5.00,6.00,7.00,8.00,10.0, /12.0,15.0,17.0,20.0,25.0,30.0,50.0,75.0,100.,1000./ DATA YXSEC/60.0,40.0,25.0,17.7,12.3,9.80,8.60,7.80,6.50,5.90, /5.40,5.20,5.40,6.10,7.05,7.60,8.20,8.85,9.50,10.1, /12.0,13.7,15.6,16.4,16.8,17.1,18.0,23.5,33.3,42.4, /44.9,44.2,23.8,17.7,12.5,11.5,11.0,10.4,10.0,8.90, /8.50,8.40,8.10,7.60,6.60,5.80,3.60,2.30,1.70,0.15/ DATA XROT/.020,.030,0.10,1.00,10.0,100.,1000./ DATA YROT/0.00,0.26,0.10,.017,.0017,.00017,.000017/ DATA XVIB1/.266,0.28,0.30,0.32,0.35,0.40,0.45,0.50,0.60,0.70, /0.80,0.85,0.90,0.95,1.00,1.05,1.10,1.22,1.31,1.41, /1.51,1.65,1.74,1.82,1.90,1.98,2.09,2.17,2.28,2.32, /2.40,2.51,2.69,2.87,3.07,3.29,3.53,3.82,10.0,100., /1000./ DATA YVIB1/0.00,.071,.118,.131,.150,.165,.165,.160,.150,.135, /.118,.112,.115,.120,.130,.196,.320,0.77,1.31,2.30, /3.44,3.23,3.80,4.20,3.74,3.34,3.64,3.18,2.67,2.74, /2.39,2.00,1.57,1.17,0.83,0.55,0.35,0.18,.009,.0009, /.00009/ DATA XVIB2/.528,1.10,1.20,1.30,1.40,1.50,1.60,1.70,1.80,1.90, /2.00,2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.80,2.90, /3.00,3.20,10.0,100.,1000./ DATA YVIB2/0.00,.027,.055,.135,.495,1.11,1.66,1.43,1.22,1.66, /1.43,1.14,1.15,0.91,0.67,0.67,0.44,0.39,0.22,0.22, /0.11,.055,.005,.0005,.00005/ DATA XVIB3/.787,1.40,1.50,1.60,1.70,1.80,1.90,2.00,2.10,2.20, /2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,3.20,10.0, /100.,1000./ DATA YVIB3/0.00,.055,0.28,0.77,1.08,0.83,0.49,0.72,0.83,0.44, /0.39,0.44,0.22,0.25,0.17,0.11,0.12,.055,.022,.0022, /.00022,.000022/ DATA XVIB4/1.043,1.40,1.50,1.60,1.70,1.80,1.90,2.00,2.10,2.20, /2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,10.0,100., /1000./ DATA YVIB4/0.00,.013,0.11,0.25,0.61,0.77,0.61,0.20,0.32,0.41, /0.22,0.12,0.20,.045,.045,.012,.0032,.0027,.0003,.00003, /.000003/ DATA XVIB5/1.295,1.60,1.70,1.80,1.90,2.00,2.10,2.20,2.30,2.40, /2.50,2.60,2.70,2.80,3.00,10.0,100.,1000./ DATA YVIB5/0.00,.055,0.29,0.32,0.54,0.32,0.11,.049,0.20,.072, /.045,.045,.009,.004,.002,.0002,.00002,.000002/ DATA XVIB6/1.544,1.70,1.80,1.90,2.00,2.10,2.20,2.30,2.40,2.50, /2.60,2.70,2.80,3.00,10.0,100.,1000./ DATA YVIB6/0.00,.049,0.13,0.22,0.61,0.61,0.45,0.34,0.20,0.14, /0.13,.042,.014,.0045,.0005,.00005,.000005/ DATA XION/14.00,14.5,15.0,15.5,16.0,16.5,17.0,17.5,18.0,18.5, /19.0,19.5,20.0,20.5,21.0,21.5,22.0,22.5,23.0,23.5, /24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0,45.0, /50.0,55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0, /100.,105.,110.,115.,120.,125.,130.,135.,140.,145., /150.,160.,180.,200.,250.,300.,350.,400.,450.,500., /550.,600.,650.,700.,750.,800.,850.,900.,950.,1000./ DATA YION/0.00,.0273,.051,.077,.106,.139,.177,.214,.254,.297, /.340,.386,.428,.472,.516,.560,.601,.643,.684,.724, /.766,.933,1.09,1.24,1.38,1.50,1.60,1.70,1.79,1.97, /2.12,2.24,2.34,2.43,2.50,2.53,2.59,2.60,2.63,2.64, /2.65,2.66,2.66,2.65,2.64,2.63,2.62,2.60,2.59,2.58, /2.57,2.52,2.45,2.37,2.16,1.99,1.85,1.72,1.59,1.50, /1.43,1.35,1.27,1.21,1.15,1.11,1.06,1.03,.994,.959/ DATA XATT/9.00,9.20,9.30,9.35,9.40,9.45,9.60,9.65,9.70,9.75, /9.80,9.85,9.90,10.0,10.1,10.2,10.3,10.4,10.5,10.6, /10.7,10.8,10.9,11.0,11.1,11.2,11.3,11.4,11.5,11.6, /11.7,11.8,11.9,12.0,12.1,12.2,12.3,12.4,12.5,12.6, /12.8,13.0,19.0,25.0,30.0,35.0,40.0,60.0,100.,1000./ DATA YATT/0.00,.00009,.00018,.00026,.00034,.00073,.0011,.0017, /.0018,.0019,.0020,.0020,.0020,.0020,.0020,.0019,.0018,.0017,.0015, /.0014,.0012,.0011,.0010,.00088,.00077,.00065,.00055,.00047,.00040, /.00033,.00028,.00024,.00019,.00017,.00014,.00011,.00010,.00009, /.00008,.00007,.00006,.00006,.00006,.0010,.0018,.0019,.0019,.0017, /.0011,.0001/ C EXCITATION A3 PI DATA XEXC/6.04,6.20,6.40,6.60,7.00,7.15,8.00,9.00,10.0,11.0, /12.0,13.0,14.0,15.0,17.0,20.0,22.0,24.0,27.0,30.0, /35.0,40.0,50.0,60.0,70.0,80.0,100.,1000./ DATA YEXC/0.00,2.04,2.09,2.04,0.55,0.29,0.53,0.94,1.06,1.08, /1.02,0.92,0.81,0.71,0.55,0.39,0.34,0.29,.245,0.22, /0.21,0.20,0.18,0.17,0.15,0.14,.127,0.028/ C EXCITATION A3 SIGMA DATA XEXC1/6.82,7.00,8.00,9.00,10.0,11.0,12.0,13.0,14.0,15.0, /17.0,20.0,22.0,24.0,27.0,30.0,35.0,40.0,50.0,60.0, /70.0,80.0,100.0,1000./ DATA YEXC1/0.00,.013,0.07,0.34,0.46,0.50,0.49,0.46,0.42,0.38, /0.32,0.25,0.21,0.18,0.15,.118,.084,.056,.031,.018, /.0118,.007,.003,.00014/ C EXCITATION A1 PI DATA XEXC2/8.07,9.00,10.0,11.0,12.0,13.0,14.0,15.0,17.0,20.0, /22.0,24.0,27.0,30.0,35.0,40.0,50.0,60.0,70.0,80.0, /100.,1000./ DATA YEXC2/0.00,.108,0.18,0.24,0.27,0.29,0.32,0.35,0.38,0.39, /0.40,0.42,0.42,0.41,0.40,0.39,0.38,0.36,0.35,0.34, /0.31,0.084/ C EXCITATION B3 SIGMA DATA XEXC3/10.39,11.0,12.0,13.0,14.0,15.0,17.0,20.0,22.0,24.0, /27.0,30.0,35.0,40.0,50.0,60.0,70.0,80.0,100.,1000./ DATA YEXC3/0.00,.025,.035,.055,.066,.074,.077,.060,.042,.028, /.018,.015,.0137,.0127,.0118,.0118,.0108,.0108,.0099,.0014/ C EXCITATION C1 SIGMA +E1 PI DATA XEXC4/11.3,12.0,13.0,14.0,15.0,17.0,20.0,22.0,24.0,27.0, /30.0,35.0,40.0,50.0,60.0,70.0,80.0,100.,1000./ DATA YEXC4/0.00,.056,.087,0.12,0.14,.175,0.22,0.24,0.25,0.27, /0.28,0.28,0.28,0.27,0.25,.245,0.24,0.22,.063/ C EXCITATION SUM OF HIGHER LEVELS DATA XEXC5/13.5,14.0,15.0,17.0,20.0,22.0,24.0,27.0,30.0,35.0, /40.0,50.0,60.0,70.0,80.0,100.,1000./ DATA YEXC5/0.00,0.07,0.14,0.29,0.39,0.42,0.45,0.48,0.49,0.50, /0.52,0.52,0.50,0.49,0.48,0.46,.013/ C ---------------------------------------------------------------- C MODIFIED AMALGAM OF HADDAD AND MILLOY AND LONG C --------------------------------------------------------------- NAME=' C-O 1998 ' NIN=13 NDATA=50 NROT=7 NVIB1=41 NVIB2=25 NVIB3=22 NVIB4=21 NVIB5=18 NVIB6=17 NION=70 NATT=50 NEXC=28 NEXC1=24 NEXC2=22 NEXC3=20 NEXC4=19 NEXC5=17 E(1)=0.0 E(2)=2.0*EMASS/(28.0104*AMU) E(3)=14.013 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.020 EIN(2)=0.266 EIN(3)=0.528 EIN(4)=0.787 EIN(5)=1.043 EIN(6)=1.295 EIN(7)=1.544 EIN(8)=6.04 EIN(9)=6.82 EIN(10)=8.07 EIN(11)=10.39 EIN(12)=11.3 EIN(13)=13.5 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16 C 300 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 309 DO 301 J=2,NROT IF(EN.LE.XROT(J)) GO TO 302 301 CONTINUE J=NROT 302 A=(YROT(J)-YROT(J-1))/(XROT(J)-XROT(J-1)) B=(XROT(J-1)*YROT(J)-XROT(J)*YROT(J-1))/(XROT(J-1)-XROT(J)) QIN(1,I)=(A*EN+B)*1.E-16 309 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.E-16 400 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) 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(6,I)=(A*EN+B)*1.E-16 800 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) 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(7,I)=(A*EN+B)*1.E-16 900 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 1000 DO 910 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 920 910 CONTINUE J=NEXC 920 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(8,I)=(A*EN+B)*1.E-16 1000 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 1100 DO 1010 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 1020 1010 CONTINUE J=NEXC1 1020 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(9,I)=(A*EN+B)*1.E-16 1100 CONTINUE C QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 1200 DO 1110 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 1120 1110 CONTINUE J=NEXC2 1120 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(10,I)=(A*EN+B)*1.E-16 1200 CONTINUE C QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 1300 DO 1210 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 1220 1210 CONTINUE J=NEXC3 1220 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(11,I)=(A*EN+B)*1.E-16 1300 CONTINUE C QIN(12,I)=0.0 IF(EN.LE.EIN(12)) GO TO 1400 DO 1310 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 1320 1310 CONTINUE J=NEXC4 1320 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(12,I)=(A*EN+B)*1.E-16 1400 CONTINUE C QIN(13,I)=0.0 IF(EN.LE.EIN(13)) GO TO 1500 DO 1410 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GO TO 1420 1410 CONTINUE J=NEXC5 1420 A=(YEXC5(J)-YEXC5(J-1))/(XEXC5(J)-XEXC5(J-1)) B=(XEXC5(J-1)*YEXC5(J)-XEXC5(J)*YEXC5(J-1))/(XEXC5(J-1)-XEXC5(J)) QIN(13,I)=(A*EN+B)*1.E-16 1500 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I)+ /QIN(12,I)+QIN(13,I) C GET CORRECT ELASTIC SCATTERING Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I)-QIN(3,I)-QIN(4,I)-QIN(5,I)- /QIN(6,I)-QIN(7,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(13)) NIN=12 IF(EFINAL.LE.EIN(12)) NIN=11 IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS24(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(33),YXSEC(33),XVIB1(29),YVIB1(29),XVIB2(29),YVIB2(29 /),XVIB3(28),YVIB3(28),XION(25),YION(25),XEXC(26),YEXC(26), /XEXC1(31),YEXC1(31) CHARACTER*15 NAME DATA XEN/0.00,0.001,0.003,0.007,0.01,0.014,0.02,0.03,0.05,0.07, /0.10,0.14,0.20,0.30,0.40,0.60,0.80,1.00,1.40,2.00, /3.00,5.00,6.00,8.00,10.0,14.0,20.0,40.0,70.0,100., /140.,200.,1000./ DATA YXSEC/165.,145.,135.,122.,108.,98.0,92.0,83.0,71.0,62.0, /50.0,43.0,36.0,28.5,24.0,15.8,11.5,9.30,8.50,9.20, /12.5,22.0,26.0,38.0,40.0,30.0,20.0,10.0,6.00,4.00, /2.80,2.00,0.40/ DATA XVIB1/0.00,0.12,0.121,0.13,0.14,0.17,0.22,0.26,0.36,0.46, /0.56,0.66,0.76,0.96,1.36,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,14.0,20.0,40.0,100.,1000./ DATA YVIB1/0.00,0.00,.052,0.42,0.75,1.03,1.21,1.26,1.14,0.98, /0.84,0.74,0.66,0.58,0.49,0.56,0.77,1.23,1.75,2.27, /2.36,2.27,1.92,1.40,0.59,0.28,0.07,0.02,0.00/ DATA XVIB2/0.00,0.16,0.161,0.17,0.18,0.21,0.26,0.30,0.40,0.50, /0.60,0.70,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00, /7.00,8.00,9.00,10.0,14.0,20.0,40.0,100.,1000./ DATA YVIB2/0.00,0.00,.052,0.42,0.75,1.03,1.21,1.26,1.14,0.98, /0.84,0.74,0.66,0.58,0.49,0.56,0.77,1.23,1.75,2.27, /2.36,2.27,1.92,1.40,0.59,0.28,0.07,0.02,0.00/ DATA XVIB3/0.00,0.36,0.362,0.38,0.40,0.42,0.47,0.51,0.55,0.60, /0.70,0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00,7.00, /8.00,9.00,10.0,14.0,20.0,40.0,100.,1000./ DATA YVIB3/0.00,0.00,.053,.105,0.21,0.28,0.42,0.53,0.61,0.66, /0.75,0.75,0.73,0.66,0.72,0.88,1.28,1.75,2.10,2.36, /2.36,1.92,1.40,0.54,0.23,0.07,0.02,0.00/ DATA XION/10.0,10.8,13.3,18.3,19.3,20.3,23.3,28.3,33.3,38.3, /43.3,48.3,53.3,58.3,68.3,78.3,88.3,98.3,120.,140., /200.,300.,500.,700.,1000./ DATA YION/0.00,.251,2.28,5.93,6.84,7.52,9.01,11.1,12.6,13.6, /14.5,15.0,15.2,15.6,16.0,16.1,16.0,15.7,15.2,14.6, /12.5,9.67,6.74,5.04,4.01/ DATA XEXC/6.30,6.70,7.30,7.80,8.30,8.80,9.30,10.3,11.3,13.3, /15.3,19.3,24.3,29.3,39.3,49.3,59.3,69.3,79.3,100., /150.,200.,300.,400.,600.,1000./ DATA YEXC/0.00,0.35,0.65,1.00,1.31,1.55,1.75,2.16,2.45,3.02, /3.49,4.08,4.43,4.51,4.31,3.90,3.55,3.23,2.94,2.47, /1.78,1.40,0.98,0.73,0.47,0.33/ DATA XEXC1/8.30,8.50,9.10,9.60,10.1,10.6,11.1,12.1,13.1,14.1, /15.1,17.1,19.1,21.1,25.1,29.1,34.1,39.1,44.1,49.1, /59.1,69.1,79.1,100.,150.,200.,300.,400.,500.,600.,1000./ DATA YEXC1/0.00,0.12,0.26,0.38,0.47,0.58,0.70,1.06,1.60,2.36, /3.29,4.81,5.94,6.53,7.16,7.24,7.06,6.61,6.10,5.54, /4.61,3.96,3.47,2.80,2.04,1.67,1.22,0.96,0.79,0.67,0.49/ C C NO EXPERIMENTAL DATA ON TRANSVERSE DIFFUSION AVAILABLE SO TWO C DATA SETS CREATED WITH EXPECTED MAXIMUM AND MINIMUM DIFFUSION C HOT IS THE MORE DIFFUSING GAS. C NAME='METHYLAL HOT ' NIN=5 NDATA=33 NVIB1=29 NVIB2=29 NVIB3=28 NION=25 NEXC=26 NEXC1=31 E(1)=0.0 E(2)=2.0*EMASS/(76.09532*AMU) E(3)=10.0 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.12 EIN(2)=0.16 EIN(3)=0.36 EIN(4)=6.3 EIN(5)=8.3 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP C DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(2,I)=(A*EN+B)*1.E-16 430 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 460 DO 440 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 450 440 CONTINUE J=NVIB3 450 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(3,I)=(A*EN+B)*1.E-16 460 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+QIN(5,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS25(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(54),YXSEC(54),XION(29),YION(29),XATT(16),YATT(16), /XVIB3(19),YVIB3(19),XVIB4(28),YVIB4(28),XVIB5(25),YVIB5(25), /XVIB6(19),YVIB6(19),XEXC(27),YEXC(27),XEXC1(35),YEXC1(35) CHARACTER*15 NAME DATA XEN/0.00,.004,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.11,0.12,0.13,0.14,0.16,0.18,0.20,0.24, /0.30,0.40,0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00, /5.00,6.00,7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0, /70.0,100.,140.,200.,250.,300.,500.,1000.,1500.,3000., /6000.,10000.,20000.,100000./ DATA YXSEC/235.,235.,235.,233.,225.,215.,205.,190.,175.,160., /140.,125.,110.,95.0,80.0,74.0,62.0,51.0,43.0,34.0, /25.0,20.0,18.0,16.5,15.7,15.0,14.5,15.0,17.5,20.0, /22.0,23.5,24.0,24.5,24.0,22.0,15.0,11.5,8.00,6.20, /3.50,2.60,1.50,0.95,0.70,0.55,0.30,0.14,0.09,0.04, /0.02,.012,.005,.001/ DATA XION/10.04,10.9,13.4,18.4,19.4,20.4,23.4,28.4,33.4,38.4, /43.4,48.4,53.4,58.4,68.4,78.4,88.4,98.4,120.,140., /200.,300.,500.,700.,1000.,2000.,4000.,10000.,100000./ DATA YION/0.00,0.12,1.12,2.92,3.37,3.70,4.44,5.48,6.17,6.68, /7.13,7.41,7.52,7.66,7.84,7.89,7.84,7.75,7.53,7.20, /6.17,4.76,3.30,2.45,1.95,1.15,0.70,0.36,.06/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ C V2 AND V3 DIPOLE PARTS GIVEN ANALYTICALLY C NB V3 TABLE CONTAINS ONLY RESONANCE PART OF X-SECT. DATA XVIB3/.137,1.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,14.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB3/0.00,0.01,0.45,0.75,1.00,1.15,1.20,1.15,1.00,0.90, /0.80,0.50,0.35,0.21,0.16,0.05,.005,.0005,.00005/ DATA XVIB4/.180,0.19,0.20,0.23,0.25,0.30,0.35,0.40,0.50,0.70, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50,10.0, /15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.17,0.22,0.30,0.32,0.34,0.34,0.32,0.31,0.25, /0.21,0.19,0.19,0.32,0.47,0.61,0.79,1.03,1.03,0.85, /0.58,0.33,0.18,0.11,0.03,.003,.0003,.00003/ DATA XVIB5/.349,0.40,0.45,0.50,0.60,0.70,0.80,1.00,1.50,2.00, /3.00,4.00,5.00,6.00,7.50,8.50,10.0,15.0,20.0,30.0, /40.0,100.,1000.,10000.,100000./ DATA YVIB5/0.00,0.35,0.43,0.47,0.48,0.48,0.46,0.43,0.43,0.47, /0.69,1.00,1.30,1.75,1.90,1.60,1.20,0.72,0.30,0.17, /0.10,0.02,.002,.0002,.00002/ DATA XVIB6/.529,1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.50,8.50, /10.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YVIB6/0.00,.001,0.01,.016,.035,0.06,0.09,0.12,0.13,0.11, /0.08,.045,0.02,0.01,.007,.0016,.00016,.000016,.0000016/ DATA XEXC/7.70,8.50,9.00,9.50,10.5,11.5,13.0,15.0,20.0,25.0, /30.0,40.0,50.0,60.0,70.0,80.0,100.,150.,200.,300., /400.,600.,1000.,2000.,4000.,10000.,100000./ DATA YEXC/0.00,0.11,0.38,0.71,1.26,1.76,2.03,2.36,2.80,3.03, /3.08,3.19,3.25,3.25,3.20,3.10,2.81,1.93,1.49,1.10, /0.88,0.66,0.44,0.28,.160,.083,.0150/ DATA XEXC1/8.50,8.70,9.30,9.85,10.3,10.8,11.3,12.3,13.3,14.3, /15.3,17.3,20.0,22.0,25.0,30.0,35.0,40.0,45.0,50.0, /60.0,70.0,80.0,100.,150.,200.,300.,400.,500.,600., /1000.,2000.,4000.,10000.,100000./ DATA YEXC1/0.00,0.077,0.16,0.23,0.29,0.34,0.42,0.64,0.97,1.43, /1.99,2.91,3.79,4.07,4.73,5.50,5.94,6.16,6.44,6.60, /6.82,6.82,6.77,6.44,4.79,3.91,2.86,2.20,1.87,1.65, /1.16,0.68,0.40,0.20,.038/ NAME=' DME 1998 ' C --------------------------------------------------------------------- C UPDATES DME97 WITH MONTE CARLO SIMULATION OF STEADY STATE TOWNSEND C VALUE FOR ALPHA. C UPDATES DME94 WITH CORRECT VIBRATIONAL ANALYSIS FROM SVERDLOV. C UPDATES DME92 WITH BETTER FIT TO FANO AND EV/ION PAIR C --------------------------------------------------------------------- AVIB1=0.06 AVIB2=0.35 NIN=8 NDATA=54 NVIB3=19 NVIB4=28 NVIB5=25 NVIB6=19 NION=29 NATT=16 NEXC=27 NEXC1=35 E(1)=0.0 E(2)=2.0*EMASS/(46.06904*AMU) E(3)=10.04 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.051 EIN(2)=0.051 EIN(3)=0.137 EIN(4)=0.180 EIN(5)=0.349 EIN(6)=0.529 EIN(7)=7.70 EIN(8)=8.5 APOP=DEXP(EIN(1)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-21 300 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC OF VIBRATION C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 390 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AVIB1*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 C 390 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AVIB1*DLOG((1.0+EFAC)/(1.0-EFAC))/(EN*(1.0+APOP))*1.D-16 400 CONTINUE QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 430 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(3,I)=(A*EN+B) EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=(QIN(3,I)+AVIB2*DLOG((1.0+EFAC)/(1.0-EFAC))/EN)*1.E-16 430 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 500 DO 440 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 450 440 CONTINUE J=NVIB4 450 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(4,I)=(A*EN+B)*1.E-16 500 CONTINUE QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 600 DO 540 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 550 540 CONTINUE J=NVIB5 550 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(5,I)=(A*EN+B)*1.E-16 600 CONTINUE QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 700 DO 640 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 650 640 CONTINUE J=NVIB6 650 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(6,I)=(A*EN+B)*1.E-16 700 CONTINUE QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 800 DO 710 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 720 710 CONTINUE J=NEXC 720 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.E-16 800 CONTINUE QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 899 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 820 810 CONTINUE J=NEXC1 820 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.E-16 899 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS26(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE, /PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO DECEMBER 1994 C --------------------------------------------------------------- NAME='REID STEP(ANIS)' KIN(1)=1 KIN(2)=0 KEL=0 NIN=1 E(1)=0.0 E(2)=2.0*EMASS/(4.0*AMU) E(3)=15.90 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.2 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 PEQEL(I)=0.0 PEQIN(1,I)=0.0 PEQIN(2,I)=0.0 EN=EN+ESTEP Q(2,I)=1.0E-16 Q(3,I)=0.0 Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 QIN(1,I)=10.0E-16 PEQIN(1,I)=0.5+(QIN(1,I)-0.7*QIN(1,I))/QIN(1,I) 400 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+0.7*QIN(1,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS27(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C MAXWELL MODEL DECEMBER 1994 C --------------------------------------------------------------- NAME=' MAXWEL 1994-- ' NIN=0 SIGC=6.0E-16 E(1)=0.0 E(2)=2.0*EMASS/(4.0*AMU) E(3)=99. E(4)=0.0 E(5)=0.0 E(6)=0.0 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.EQ.0.0) THEN Q(2,I)=100000.E-16 GO TO 10 ENDIF Q(2,I)=SIGC/DSQRT(EN) 10 Q(3,I)=0.0 Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 C Q(1,I)=Q(2,I) 9000 CONTINUE RETURN END SUBROUTINE GAS28(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO DECEMBER 1994 C --------------------------------------------------------------- NAME=' REID RAMP S=10' NIN=1 E(1)=0.0 E(2)=2.0*EMASS/(4.0*AMU) E(3)=15.90 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.2 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP Q(2,I)=6.0E-16 Q(3,I)=0.0 Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 QIN(1,I)=(EN-EIN(1))*10.0E-16 400 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS29(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XENM(56),YXMOM(56),XENT(56),YXTOT(56), /XVIB2(22),YVIB2(22),XVIB3(22),YVIB3(22),XVIB4(22),YVIB4(22), /XVIB5(22),YVIB5(22),XVIB6(22),YVIB6(22), /XDISS(27),YDISS(27),XATT(26),YATT(26),XION(48),YION(48) CHARACTER*15 NAME DATA XENM/0.0,0.001,0.002,0.004,0.007,0.01,.015,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.0,200.,400.,1000.,10000.,100000./ C ELASTIC MOMENTUM TRANSFER DATA YXMOM/29.0,26.0,24.0,20.0,16.0,12.9,9.60,7.65,6.40,5.55, /4.25,3.40,2.80,2.40,2.00,1.90,2.00,2.50,3.15,4.20, /5.25,6.10,6.80,7.40,7.80,8.20,8.80,9.30,9.60,9.80, /10.0,10.4,10.7,11.0,11.2,11.4,11.5,11.6,11.8,12.0, /12.5,14.5,14.5,13.2,11.5,10.0,9.20,8.50,7.66,6.66, /5.86,3.00,1.50,0.60,0.06,.0006/ DATA XENT/0.0,0.001,0.002,0.004,0.007,0.01,.015,0.02,.025,0.03, /0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.12,0.15,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.50,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00, /10.0,15.0,20.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.0,200.,400.,1000.,10000.,100000./ C ELASTIC TOTAL DATA YXTOT/29.0,26.0,24.0,20.0,16.0,12.9,9.60,7.65,6.40,5.55, /4.25,3.40,2.80,2.40,2.00,1.90,2.00,2.50,3.15,4.20, /5.25,6.10,6.80,7.40,7.80,8.20,8.80,9.30,9.60,9.80, /11.3,12.5,13.5,14.5,15.5,16.5,17.5,18.5,19.5,20.0, /20.7,23.5,23.5,21.5,19.5,18.5,17.5,17.0,16.0,15.0, /14.5,11.5,9.00,7.00,0.70,0.07/ C VIBRATION V11 (RESONANCE ONLY) DATA XVIB2/0.065,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB2/0.0,0.0,.028,.063,.196,.182,0.14,.126,.182,0.21, /0.21,.175,.063,.028,.014,.007,.0014,.000007,.0000007,.00000007, /.000000007,.0000000007/ C VIBRATION V2 (RESONANCE ONLY) DATA XVIB3/0.1001,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB3/0.0,0.0,.175,.343,1.08,1.04,0.77,0.70,1.02,1.15, /1.13,.959,0.35,.154,.063,.028,.014,.000003,.0000003,.00000003, /.000000003,.0000000003/ C VIBRATION V1 (RESONANCE ONLY) DATA XVIB4/0.1523,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB4/0.0,0.0,.378,.756,2.34,2.24,1.68,1.51,2.23,2.52, /2.49,2.10,0.77,.336,0.14,0.07,.035,.00007,.000007,.0000007, /.00000007,.000000007/ C VIBRATION HARMONIC 2(V1) DATA XVIB5/0.35,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB5/0.0,0.0,.135,0.27,0.84,.795,0.60,0.54,.795,0.90, /.885,0.75,0.27,0.12,.045,0.03,.015,.00015,.000015,.0000015, /.00000015,.000000015/ C VIBRATION HARMONIC (3(V1) + ALL OTHER HARMONICS) DATA XVIB6/0.500,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB6/0.0,0.0,0.54,1.08,3.35,3.20,2.40,2.16,3.18,3.60, /3.56,3.00,1.09,0.48,.195,.105,.045,.00015,.000015,.0000015, /.00000015,.000000015/ C DISOCIATION X-SECTION DATA XDISS/11.8,12.0,13.0,14.0,15.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,300.,400.,500., /600.,800.,1000.,2000.,4000.,10000.,100000./ DATA YDISS/0.00,.007,.072,0.40,0.75,1.33,1.61,1.88,2.00,2.25, /2.40,2.50,2.60,2.60,2.60,2.55,2.50,2.40,2.30,2.20, /2.00,1.75,1.48,0.80,0.46,0.21,0.021/ DATA XION/14.48,17.0,18.0,19.0,21.0,23.0,25.0,27.0,29.0,31.0, /33.0,35.0,37.0,39.0,41.0,43.0,45.0,47.0,49.0,51.0, /61.0,71.0,81.0,91.0,101.,126.,151.,176.,201.,251., /301.,351.,401.,451.,501.,601.,701.,801.,901.,1001., /1251.,1501.,1751.,2001.,2501.,3001.,10000.,100000./ DATA YION/0.00,.0889,.211,.375,.782,1.18,1.59,2.11,2.49,2.81, /3.16,3.49,3.86,4.17,4.54,4.85,5.14,5.52,5.77,6.19, /6.82,7.57,7.84,8.17,8.39,8.77,8.75,8.76,8.57,8.17, /7.41,7.13,6.55,6.21,5.89,5.17,4.72,4.40,3.96,3.77, /3.19,2.79,2.44,2.28,1.88,1.67,0.60,0.09/ DATA XATT/2.00,2.25,2.50,2.75,3.00,3.25,3.50,3.75,4.00,4.25, /4.50,4.75,5.00,5.25,5.50,5.75,6.00,6.25,6.50,6.75, /7.00,8.00,10.0,20.0,100.0,100000./ DATA YATT/.0,.0075,.020,.038,.053,.069,.083,.086,.083,.074, /.060,.046,.035,.025,.017,.010,.0068,.004,.0016,.0007, /.0003,.0002,.0001,.00001,.000001,.0000001/ C --------------------------------------------------------------------- C NEW ANALYSIS UPDATED TO NOVEMBER 1999. C ALLOWS SUPERELASTIC SCATTERING TO ALL VIBRATIONAL LEVELS c EXCLUDING VIBRATION HARMONICS. C BORN ANGULAR DISTRIBUTION FOR V1(0.1001) AND V2(0.1523) LEVELS. C -------------------------------------------------------------------- NAME=' C2F6 -1999--- ' KIN(1)=5 KIN(2)=6 KEL=0 NIN=9 NDATA=56 NETOT=56 NVIB2=22 NVIB3=22 NVIB4=22 NVIB5=22 NVIB6=22 NDISS=27 NATT=26 NION=48 E(1)=0.0 E(2)=2.0*EMASS/(138.0118*AMU) E(3)=14.48 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.065 EIN(2)=-0.1001 EIN(3)=-0.1523 EIN(4)=0.065 EIN(5)=0.1001 EIN(6)=0.1523 EIN(7)=0.35 EIN(8)=0.500 EIN(9)=11.8 APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(2)/AKT) APOP3=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XENM(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXMOM(J)-YXMOM(J-1))/(XENM(J)-XENM(J-1)) B=(XENM(J-1)*YXMOM(J)-XENM(J)*YXMOM(J-1))/(XENM(J-1)-XENM(J)) XMOMT=(A*EN+B)*1.0E-16 DO 50 J=2,NETOT IF(EN.LE.XENT(J)) GO TO 60 50 CONTINUE J=NETOT 60 A=(YXTOT(J)-YXTOT(J-1))/(XENT(J)-XENT(J-1)) B=(XENT(J-1)*YXTOT(J)-XENT(J)*YXTOT(J-1))/(XENT(J-1)-XENT(J)) XTOT=(A*EN+B)*1.0E-16 Q(2,I)=XTOT PEQEL(I)=0.5+(XTOT-XMOMT)/XTOT IF(KEL.EQ.0) Q(2,I)=XMOMT IF(KEL.EQ.0) PEQEL(I)=0.5 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 250 IF(EN.GT.XATT(NATT)) GO TO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16 250 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTICS QIN(1,I)=0.0 QIN(2,I)=0.0 QIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V11 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.0363*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 260 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 270 260 CONTINUE J=NVIB2 270 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.E-16 C SUPERELASTIC OF VIBRATION V2 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.4230*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 280 J=2,NVIB3 IF((EN+EIN(5)).LE.XVIB3(J)) GO TO 290 280 CONTINUE J=NVIB3 290 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(2,I)=QIN(2,I)+(EN+EIN(5))*(A*(EN+EIN(5))+B)/EN QIN(2,I)=QIN(2,I)*APOP2/(1.0+APOP2)*1.E-16 C SUPERELASTIC OF VIBRATION V1 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=1.5000*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 300 J=2,NVIB4 IF((EN+EIN(6)).LE.XVIB4(J))GO TO 301 300 CONTINUE J=NVIB4 301 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(3,I)=QIN(3,I)*APOP3/(1.0+APOP3)*1.E-16 C 305 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0363*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=((A*EN+B)+QIN(4,I))*1.0/(1.0+APOP1)*1.E-16 400 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.4230*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(5) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM.T /TOT X-SECT FOR RESONANCE PART = RAT3 RAT3=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(5,I)+RAT3*(A*EN+B))*1.0E-16 XMT=XMT/(1.0+APOP2) QIN(5,I)=((A*EN+B)+QIN(5,I))*1.0/(1.0+APOP2)*1.E-16 PEQIN(1,I)=0.5+(QIN(5,I)-XMT)/QIN(5,I) 500 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=1.500*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(6,I)+RAT4*(A*EN+B))*1.0E-16 XMT=XMT/(1.0+APOP3) QIN(6,I)=((A*EN+B)+QIN(6,I))*1.0/(1.0+APOP3)*1.E-16 PEQIN(2,I)=0.5+(QIN(6,I)-XMT)/QIN(6,I) 600 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(8,I)=(A*EN+B)*1.E-16 800 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NDISS IF(EN.LE.XDISS(J)) GO TO 820 810 CONTINUE J=NDISS 820 A=(YDISS(J)-YDISS(J-1))/(XDISS(J)-XDISS(J-1)) B=(XDISS(J-1)*YDISS(J)-XDISS(J)*YDISS(J-1))/(XDISS(J-1)-XDISS(J)) QIN(9,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS30(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C SF6 FILE FROM ITOH ET AL J.PHYS.D. 26 (1993) 1975-1979 C --------------------------------------------------------------- NAME='SF6 ITOH ET AL ' NIN=2 E(1)=0.0 E(2)=2.0D0*EMASS/(146.05642*AMU) E(3)=15.8 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=0.095 EIN(2)=9.80 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.EQ.0.0D0) THEN BTA=-5.0 GO TO 1 ENDIF BTA=DLOG10(EN) 1 BTA2=BTA*BTA BTA3=BTA2*BTA EN2=EN*EN EN3=EN2*EN Q(2,I)=0.0D0 IF(EN.EQ.0.0) THEN Q(2,I)=20.0 GO TO 10 ENDIF IF(EN.LE.0.255) THEN Q(2,I)=10.0**(1.055-1.033*BTA-0.1632*BTA2+0.0126*BTA3) GO TO 10 ENDIF IF(EN.LE.0.92) THEN Q(2,I)=10.0**(1.041-0.189*BTA+2.091*BTA2+1.348*BTA3) GO TO 10 ENDIF IF(EN.LE.1.90) THEN Q(2,I)=10.0**(1.037-0.3741*BTA+1.193*BTA2+0.5179*BTA3) GO TO 10 ENDIF IF(EN.LE.6.20) THEN Q(2,I)=1.917+6.463*EN-1.027*EN2+0.05562*EN3 GO TO 10 ENDIF IF(EN.LE.28.2) THEN Q(2,I)=12.53+0.7762*EN-0.0457*EN2+0.0006344*EN3 GO TO 10 ENDIF IF(EN.LE.51.0) THEN Q(2,I)=20.44-0.3373*EN+0.002436*EN2-0.000006189*EN3 GO TO 10 ENDIF IF(EN.LE.80.0) THEN Q(2,I)=29.09-0.7115*EN+0.007397*EN2-0.00002485*EN3 GO TO 10 ENDIF IF(EN.LE.188.0) THEN Q(2,I)=10.51*DEXP(-0.00558*EN) GO TO 10 ENDIF IF(EN.LE.364.0) THEN Q(2,I)=1289.0*EN**(-1.118) GO TO 10 ENDIF Q(2,I)=4.881*DEXP(-0.002807*EN) 10 Q(2,I)=Q(2,I)*1.D-16 Q(3,I)=0.0D0 IF(EN.LE.15.8) GO TO 20 IF(EN.LE.38.9) THEN Q(3,I)=4.715-0.693*EN+0.0306*EN2-0.0003508*EN3 GO TO 20 ENDIF IF(EN.LE.122.0) THEN Q(3,I)=6.986-DEXP(2.07-0.0145*EN-0.00014*EN2) GO TO 20 ENDIF IF(EN.LE.201.0) THEN Q(3,I)=4.364+0.0323*EN-0.00009987*EN2 GO TO 20 ENDIF Q(3,I)=DEXP(2.151-0.00115*EN) 20 Q(3,I)=Q(3,I)*1.D-16 Q(4,I)=0.0D0 QA1=0.0D0 IF(EN.EQ.0.0) THEN QA1=4000.0 GO TO 30 ENDIF IF(EN.GT.25.0) THEN QA5=0.0D0 GO TO 70 ENDIF IF(EN.LE.0.14) THEN QA1=436.0*(0.0617*DSQRT(1.0/EN)*DEXP(-1.0*(EN/0.0045)**2)+ /DEXP(-EN/0.0559)) GO TO 30 ENDIF IF(EN.LE.0.9746) THEN QA1=DEXP(6.477-20.91*EN+1.183*EN2) ENDIF 30 Q(4,I)=QA1*1.D-16 QA2=0.0D0 IF(EN.LE.0.312) THEN QA2=2.85*EN+5.419*EN2+30.49*EN3 GO TO 40 ENDIF IF(EN.LE.0.425) THEN QA2=468.0*EN3-624.3*EN2+268.1*EN-34.75 GO TO 40 ENDIF IF(EN.LE.1.05) THEN QA2=8.751-22.15*EN+19.08*EN2-5.592*EN3 GO TO 40 ENDIF QA2=DEXP(8.054-10.42*EN) 40 Q(4,I)=Q(4,I)+QA2*1.D-16 QA3=0.0D0 IF(EN.LT.2.19) GO TO 50 IF(EN.LE.2.90) THEN QA3=-0.1069+0.08552*EN-0.01676*EN2 GO TO 50 ENDIF IF(EN.LT.3.32) GO TO 50 IF(EN.LE.4.27) THEN QA3=-0.2016+0.2133*EN-0.07421*EN2+0.00851*EN3 GO TO 50 ENDIF IF(EN.LE.5.59) THEN QA3=0.7777-0.6913*EN+0.1856*EN2-0.0153*EN3 GO TO 50 ENDIF IF(EN.LE.7.95) THEN QA3=0.9885-0.3216*EN+0.03252*EN2-0.0009533*EN3 GO TO 50 ENDIF IF(EN.LE.9.73) THEN QA3=-0.3504+0.08087*EN-0.0045*EN2 GO TO 50 ENDIF IF(EN.LE.11.1) THEN QA3=1.397-0.2724*EN+0.01335*EN2 GO TO 50 ENDIF IF(EN.LE.11.8) THEN QA3=-3.30+0.5801*EN-0.02533*EN2 GO TO 50 ENDIF QA3=DEXP(10.91-1.264*EN) 50 Q(4,I)=Q(4,I)+QA3*1.D-16 QA4=0.0D0 IF(EN.LT.3.92) GO TO 60 IF(EN.LE.8.25) THEN QA4=DEXP(-466.8+296.4*EN-71.09*EN2+7.573*EN3-0.3033*EN*EN3) ENDIF 60 Q(4,I)=Q(4,I)+QA4*1.D-16 QA5=0.0D0 IF(EN.LE.1.50) GO TO 70 IF(EN.LE.3.27) THEN QA5=DEXP(2.932*EN3-22.91*EN2+56.52*EN-53.37) GO TO 70 ENDIF IF(EN.LE.7.45) THEN QA5=DEXP(0.5554*EN3-9.613*EN2+52.832*EN-100.3) GO TO 70 ENDIF IF(EN.LE.10.6) THEN QA5=DEXP(0.1216*EN2-1.035*EN-9.723) GO TO 70 ENDIF IF(EN.LE.11.7) THEN QA5=DEXP(-1.114*EN2+25.12*EN-148.0)-0.00012 GO TO 70 ENDIF QA5=DEXP(-0.9386*EN2+21.0*EN-123.9) 70 Q(4,I)=Q(4,I)+QA5*1.D-16 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C VIBRATIONAL SUM QIN(1,I)=0.0D0 IF(EN.LE.EIN(1).OR.EN.GT.50.0) GO TO 400 IF(EN.LE.0.247) THEN QIN(1,I)=(14.06+4.425/EN-0.5472/EN2)*1.D-16 GO TO 400 ENDIF IF(EN.LE.0.505) THEN QIN(1,I)=(DEXP(11.19*EN3-13.91*EN2+4.663*EN+2.664))*1.D-16 GO TO 400 ENDIF IF(EN.LE.1.03) THEN QIN(1,I)=(DEXP(0.3166*EN2-1.341*EN+3.509))*1.D-16 GO TO 400 ENDIF QIN(1,I)=(22.0*10.0**(-0.2645*EN))*1.D-16 C EXCITATION 400 QIN(2,I)=0.0D0 IF(EN.LE.EIN(2)) GO TO 500 IF(EN.LE.26.66) THEN QIN(2,I)=(4.811*BTA-4.769)*1.D-16 GO TO 500 ENDIF IF(EN.LE.29.3) THEN QIN(2,I)=(3.643-0.204*EN+0.005477*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.56.6) THEN QIN(2,I)=(0.01382*EN**(1.522))*1.D-16 GO TO 500 ENDIF IF(EN.LE.65.2) THEN QIN(2,I)=(-25.26+0.9902*EN-0.007593*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.100.0) THEN QIN(2,I)=(2.197+0.1479*EN-0.001123*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.250.0) THEN QIN(2,I)=(17.11*DEXP(-0.0109*EN))*1.D-16 GO TO 500 ENDIF QIN(2,I)=(6566000.0*EN**(-2.821))*1.D-16 500 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS31(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(24),YXSEC(24),XVIBH(19),YVIBH(19),XION(47),YION(47), /XATT(30),YATT(30),XEXC1(18),YEXC1(18) CHARACTER*15 NAME DATA XEN/0.00,.001,0.01,0.10,0.40,1.00,1.50,2.00,2.75, /3.50,5.00,7.50,10.0,12.0,15.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YXSEC/2000.,2000.,1700.,170.,40.0,13.0,6.00,2.50,2.30, /2.50,6.00,8.50,10.0,10.0,9.00,8.40,5.73,2.90,1.55, /0.70,0.15,.075,.007,.0007/ DATA XVIBH/0.00,2.00,3.00,4.00,5.00,6.00,7.00,7.30,7.60,8.00, /9.00,10.0,12.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIBH/0.00,0.00,0.01,0.06,0.16,0.39,0.59,0.60,0.59,0.42, /0.31,0.16,0.06,0.01,.005,.001,.0001,.00001,.000001/ DATA XION/10.16,11.6,12.5,14.0,16.0,18.0,20.0,25.0,30.0,35.0, /40.0,45.0,50.0,55.0,60.0,65.0,70.0,80.0,90.0,100., /120.,140.,160.,180.,200.,240.,280.,320.,360.,400., /440.,500.,550.,600.,650.,700.,750.,800.,900.,1000., /2000.,4000.,6000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.067,0.16,0.29,0.46,0.63,0.80,1.25,1.65,2.02, /2.38,2.62,2.78,2.87,2.94,2.99,3.02,3.05,3.04,3.01, /2.91,2.80,2.70,2.60,2.50,2.30,2.13,1.98,1.85,1.74, /1.64,1.50,1.42,1.34,1.27,1.21,1.16,1.12,1.05,0.99, /0.53,0.30,0.21,0.14,.074,.040,.017/ DATA XATT/4.60,4.75,5.00,5.25,5.50,5.65,5.75,6.00,6.25,6.50, /6.75,7.00,7.50,8.00,8.50,9.00,9.50,10.0,10.5,11.0, /11.5,12.0,12.5,13.0,14.0,16.0,100.,1000.,10000.,100000./ DATA YATT/0.00,0.15,0.63,2.04,3.33,3.66,3.60,2.82,1.65,0.84, /0.36,0.12,.048,.048,.048,.081,.276,0.48,0.54,0.48, /0.36,.213,.114,0.06,0.03,.003,.0003,.00003,.000003,.0000003/ DATA XEXC1/7.00,7.50,8.00,9.00,10.0,12.0,15.0,20.0,30.0,40.0, /50.0,80.0,100.0,200.,500.0,1000.,10000.,100000./ DATA YEXC1/0.00,0.24,0.48,0.96,1.32,1.80,2.28,2.85,3.10,3.25, /3.35,3.20,3.00,2.40,1.35,0.72,.072,.0072/ C NAME='NH3 1999' C -------------------------------------------------------------------- C EXPERIMENTAL DATA NOT ACCURATE IN AMMONIA GAS. LACK OF GOOD QUALITY C TRANSVERSE DIFFUSION MEASUREMENTS. ELECTRON SCATTERING DATA IS C USED IN THE ANALYSIS AND REPRODUCES DRIFT VELOCITY AND DIFFUSION C COEFFICIENTS TO AN ACCURACY OF 5%. ATTACHMENT X-SEC FROM SHARP ET C AL. C --------------------------------------------------------------------- NIN=8 NDATA=24 NVIBH=19 NION=47 NATT=30 NEXC1=18 E(1)=0.0 E(2)=2.0*EMASS/(17.03056*AMU) E(3)=10.16 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.1178 EIN(4)=0.1178 EIN(5)=0.2013 EIN(6)=0.4137 EIN(7)=0.8274 EIN(8)=7.00 APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP Q(2,I)=0.0 IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC 20 YXJ=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 40 DO 31 J=2,NION IF(EN.LE.XION(J)) GO TO 32 31 CONTINUE J=NION 32 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 40 CONTINUE C Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 50 DO 41 J=2,NATT IF(EN.LE.XATT(J)) GO TO 42 41 CONTINUE J=NATT 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-18 50 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.5*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.5*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V2 C 200 QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 250 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.30*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EIN(4)).LE.XVIBH(J)) GO TO 230 220 CONTINUE J=NVIBH 230 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(3,I)=QIN(3,I)+0.25*(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C V2 250 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.30*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(4,I)=QIN(4,I)+0.25*(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C V4 300 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.28*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(5,I)=(QIN(5,I)+0.52*(A*EN+B))*1.D-16 400 CONTINUE C V1+V3 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.28*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(6,I)=(QIN(6,I)+1.10*(A*EN+B))*1.D-16 500 CONTINUE C HARMONICS (2V1,2V1+V4,3V1, ETC ) QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 520 510 CONTINUE J=NVIBH 520 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(7,I)=0.165*(A*EN+B)*1.D-16 600 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE 800 CONTINUE C--------------------------------------------------------------------- C SUBTRACT ROTATIONAL XSEC TO GET CORRECT ELASTIC XSEC. Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I) C IF(Q(2,I).LE.0.0) WRITE(6,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',E12.3,' I=',I5) C TOTAL Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+ /QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS32(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(49),YXSEC(49),XVIB1(31),YVIB1(31),XVIB2(31), /YVIB2(31),XVIB3(18),YVIB3(18),XVIB4(31),YVIB4(31),XVIB5(21), /YVIB5(21),XEXC1(17),YEXC1(17),XEXC2(23),YEXC2(23),XEXC3(20), /YEXC3(20),XION(46),YION(46),XATT(16),YATT(16) CHARACTER*15 NAME DATA XEN/0.00,0.01,.014,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.11,0.12,0.14,0.16,0.18,0.20,0.25,0.30, /0.40,0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00, /6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0,70.0, /100.,140.,200.,250.,300.,500.,1000.,1500.,10000.,100000./ DATA YXSEC/54.0,51.0,50.0,49.0,45.0,42.0,39.0,34.0,28.5,22.0, /15.5,9.40,6.80,4.80,4.40,4.80,6.10,8.80,15.5,19.5, /22.0,22.5,23.0,23.5,24.0,24.0,24.5,24.0,25.0,27.0, /28.0,30.0,27.0,22.0,15.4,12.0,8.31,6.28,3.69, /2.66,1.57,0.97,0.70,0.57,0.32,.143,.092,.011,.001/ DATA XVIB1/.114,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,3.00,3.20,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB1/0.0,.001,0.04,0.07,0.14,0.15,0.14,0.10,0.08,0.08, /0.08,0.08,0.08,0.20,0.28,0.36,0.48,0.64,0.70,0.64, /0.59,0.30,0.22,0.17,0.11,0.06,.022,.008,.0008,.00003, /.000003/ DATA XVIB2/.161,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB2/0.00,.001,0.22,0.75,3.77,5.28,4.65,3.26,2.16,1.21, /0.77,0.54,0.38,0.42,0.60,0.80,1.11,1.30,1.35,1.20, /1.00,0.56,0.44,0.33,0.24,0.14,0.06,.024,.003,.0001, /.00001/ DATA XVIB3/.322,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,10.0,100.0,1000.,10000.,100000./ DATA YVIB3/0.00,.001,0.15,0.17,0.82,1.50,1.36,0.90,0.52,0.30, /0.15,0.08,0.04,.002,.0002,.00002,.000002,.0000002/ DATA XVIB4/.360,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB4/0.00,.001,.052,.090,0.54,0.86,0.80,0.64,0.46,0.45, /0.45,0.45,0.50,0.60,1.00,1.40,1.80,1.85,1.70,1.50, /1.20,0.65,0.48,0.42,0.28,0.16,0.06,0.03,.004,.0001, /.00001/ DATA XVIB5/0.72,1.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB5/0.00,.0001,.008,0.05,0.10,0.16,0.20,0.21,0.18,0.15, /0.12,0.06,0.05,0.04,0.03,.015,.007,.003,.0004,.00001, /.000001/ DATA XEXC1/4.18,4.50,5.00,6.00,7.00,8.00,9.00,10.0,12.0,14.0, /16.0,20.0,30.0,100.,1000.,10000.,100000./ DATA YEXC1/0.00,0.11,0.21,0.42,0.84,0.80,0.67,0.61,0.45,0.34, /0.27,0.25,0.20,0.06,.006,.0006,.00006/ DATA XEXC2/7.30,7.50,8.00,8.50,9.00,10.0,11.0,14.0,20.0,25.0, /30.0,40.0,60.0,80.0,100.,150.,200.,400.,1000.,2000., /10000.,20000.,100000./ DATA YEXC2/0.00,.026,0.21,0.36,0.65,1.11,1.70,2.38,2.74,2.81, /2.86,2.81,2.69,2.55,2.38,2.14,1.87,1.46,0.82,0.41, /0.09,.044,.009/ DATA XEXC3/9.00,10.0,11.0,14.0,16.0,20.0,25.0,30.0,40.0,60.0, /80.0,100.,150.,200.,400.,1000.,2000.,10000.,20000.,100000./ DATA YEXC3/0.00,0.43,1.11,2.04,2.30,2.64,2.81,2.86,2.81,2.69, /2.55,2.38,2.14,1.87,1.46,0.82,0.41,0.09,.044,.009/ DATA XION/9.73,11.0,12.0,13.0,14.0,16.5,19.0,24.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.19,0.43,0.70,1.05,2.12,3.06,4.81,5.97,6.80, /7.38,7.88,8.51,9.04,9.32,9.42,9.42,9.42,9.14,8.64, /8.16,7.71,7.20,6.31,5.77,5.34,4.86,4.55,4.00,3.68, /3.39,3.02,2.82,2.44,2.10,1.90,1.74,1.50,1.28,0.85, /0.64,0.47,0.33,0.18,.097,.061/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ NAME='PROPENE C3H6 99' C --------------------------------------------------------------------- C 1999 INCLUDED VIBRATIONAL RESONACE SHAPE FROM ALLEN AND ALSO USED C SIMILAR RESONANCE SHAPE IN ETHENE FROM WALKER ET AL .: C REF J.CHEM.PHYS. 69(1978) 5532 (ETHENE RESONANCE MOVED TO 2.1 EV) C FIT TO SCHMIDTS ,GEE+FREEMAN AND BOWMAN+GORDON DATA IN PURE PROPENE C NO GOOD DATA AT HIGH FIELD THEREFORE X-SECTIONS ABOVE 3 EV ARE C DERIVED FROM SYSTEMATICS IN THE HYDROCARBONS. C --------------------------------------------------------------------- NIN=12 NDATA=49 NVIB1=31 NVIB2=31 NVIB3=18 NVIB4=31 NVIB5=21 NEXC1=17 NEXC2=23 NEXC3=20 NION=46 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(42.08064*AMU) E(3)=9.73 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.0716 EIN(2)=0.0716 EIN(3)=-0.114 EIN(4)=0.114 EIN(5)=-0.161 EIN(6)=0.161 EIN(7)=0.322 EIN(8)=0.360 EIN(9)=0.720 EIN(10)=4.18 EIN(11)=7.30 EIN(12)=9.00 AMP=0.070 AMP1=0.15 AMP2=0.15 AMP3=0.198 APOPL=DEXP(EIN(1)/AKT) APOP=DEXP(EIN(3)/AKT) APOPH=DEXP(EIN(5)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 C 300 Q(5,I)=0.0 Q(6,I)=0.0 C SUPERELASTIC QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 3050 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOPL/(1.0+APOPL)*1.D-16 3050 CONTINUE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 3060 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOPL)*1.D-16 3060 CONTINUE C C V7 SUPERELASTIC QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 350 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP1*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EIN(4)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V7 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 400 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP1*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QIN(5,I)=0.0 IF(EN.LE.0.0) GO TO 4150 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=AMP2*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EIN(6)).LE.XVIB2(J)) GO TO 4120 4110 CONTINUE J=NVIB2 4120 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(5,I)=QIN(5,I)+(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(5,I)=QIN(5,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V2 + V3 (SUM OF VIBRATIONS AT 166 AND 201 MV) QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 450 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP2*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(6,I)=QIN(6,I)+(A*EN+B) QIN(6,I)=QIN(6,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3+2V2 (HARMONICS) QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 500 DO 460 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 470 460 CONTINUE J=NVIB3 470 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(7,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 550 EFAC=DSQRT(1.0-(EIN(8)/EN)) QIN(8,I)=AMP3*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(8,I)=(QIN(8,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 600 DO 560 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 570 560 CONTINUE J=NVIB5 570 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(9,I)=(A*EN+B)*1.D-16 600 CONTINUE C QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(10,I)=(A*EN+B)*1.D-16 700 CONTINUE C QIN(11,I)=0.0 IF(EN.LE.EIN(11)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(11,I)=(A*EN+B)*1.D-16 800 CONTINUE C QIN(12,I)=0.0 IF(EN.LE.EIN(12)) GO TO 899 DO 810 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 820 810 CONTINUE J=NEXC3 820 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(12,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I)+QIN(11,I)+ /QIN(12,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(12)) NIN=11 IF(EFINAL.LE.EIN(11)) NIN=10 IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS33(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(49),YXSEC(49),XVIB1(32),YVIB1(32),XVIB2(31), /YVIB2(31),XVIB3(15),YVIB3(15),XVIB4(28),YVIB4(28),XVIB5(21), /YVIB5(21),XEXC1(23),YEXC1(23),XEXC2(20),YEXC2(20), /XION(46),YION(46),XATT(16),YATT(16) CHARACTER*15 NAME DATA XEN/0.00,0.01,.014,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.11,0.12,0.14,0.16,0.18,0.20,0.25,0.30, /0.40,0.50,0.60,0.80,1.00,1.40,2.00,3.00,4.00,5.00, /6.00,7.50,8.50,10.0,15.0,20.0,30.0,40.0,70.0, /100.,140.,200.,250.,300.,500.,1000.,1500.,10000.,100000./ DATA YXSEC/13.0,11.0,10.5,9.80,7.80,5.60,4.20,2.90,2.10,2.00, /2.20,2.65,3.25,3.90,5.65,7.30,9.15,10.8,14.2,16.8, /20.0,21.5,22.0,22.5,22.7,22.8,22.9,23.0,23.5,25.5, /27.0,29.0,27.0,22.0,15.4,12.0,8.31,6.28,3.69, /2.66,1.57,0.97,0.70,0.57,0.32,.143,.092,.011,.001/ DATA XVIB1/.107,1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /3.00,4.00,4.50,5.00,5.50,6.00,6.50,7.00,8.00,9.00, /10.0,11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000., /10000.,100000./ DATA YVIB1/0.0,.001,.022,.040,.080,.080,.080,.085,.085,.085, /0.13,0.22,0.70,1.10,1.25,1.15,0.75,0.60,0.71,0.77, /0.71,0.64,0.31,0.25,0.18,0.12,0.06,.025,0.01,.001, /.00003,.000003/ DATA XVIB2/.178,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB2/0.00,.001,0.15,0.25,0.40,0.45,0.47,0.50,0.52,0.55, /0.57,0.60,0.62,0.66,0.74,0.90,1.14,1.33,1.38,1.23, /1.01,0.56,0.44,0.34,0.25,0.14,.059,.025,.003,.0001, /.00001/ DATA XVIB3/.295,1.00,3.00,4.00,4.50,5.00,5.50,6.00,6.50,7.00, /10.0,100.0,1000.,10000.,100000./ DATA YVIB3/0.00,.001,0.01,0.01,0.05,0.10,0.15,0.10,0.05,0.01, /.001,.0001,.00001,.000001,.0000001/ DATA XVIB4/.374,1.00,1.40,1.60,1.80,2.00,2.20,2.40,2.60,3.00, /4.00,5.00,6.00,7.00,8.00,9.00,10.0,11.0,15.0,20.0, /25.0,30.0,50.0,100.,200.,1000.,10000.,100000./ DATA YVIB4/0.00,.001,.029,.049,0.30,0.44,0.47,0.50,0.55,0.70, /0.75,1.15,1.40,1.70,1.80,1.70,1.50,1.40,0.90,0.66, /0.57,0.40,0.22,0.92,0.04,.004,.0004,.00004/ DATA XVIB5/.748,1.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,15.0,20.0,25.0,30.0,50.0,100.,200.,1000.,10000., /100000./ DATA YVIB5/0.00,.0001,.002,.030,.052,.088,0.11,0.12,0.10,.084, /.065,.035,.025,.020,.016,.009,.004,.0014,.0002,.000005, /.0000005/ DATA XEXC1/7.30,7.50,8.00,8.50,9.00,10.0,11.0,14.0,20.0,25.0, /30.0,40.0,60.0,80.0,100.,150.,200.,400.,1000.,2000., /10000.,20000.,100000./ DATA YEXC1/0.00,.026,0.21,0.36,0.65,1.11,1.70,2.38,2.74,2.81, /2.86,2.81,2.69,2.55,2.38,2.14,1.87,1.46,0.82,0.41, /0.09,.044,.009/ DATA XEXC2/9.00,10.0,11.0,14.0,16.0,20.0,25.0,30.0,40.0,60.0, /80.0,100.,150.,200.,400.,1000.,2000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.43,1.11,2.04,2.30,2.64,2.81,2.86,2.81,2.69, /2.55,2.38,2.14,1.87,1.46,0.82,0.41,0.09,.044,.009/ DATA XION/9.86,11.0,12.0,13.0,14.0,16.5,19.0,24.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.19,0.43,0.70,1.05,2.12,3.06,4.81,5.97,6.80, /7.38,7.88,8.51,9.04,9.32,9.42,9.42,9.42,9.14,8.64, /8.16,7.71,7.20,6.31,5.77,5.34,4.86,4.55,4.00,3.68, /3.39,3.02,2.82,2.44,2.10,1.90,1.74,1.50,1.28,0.85, /0.64,0.47,0.33,0.18,.097,.061/ DATA XATT/6.85,7.00,7.20,7.50,8.00,8.50,9.00,9.50,10.0,10.5, /11.0,11.5,12.0,12.5,13.0,13.2/ DATA YATT/0.00,0.67,1.10,1.65,2.80,4.40,6.60,10.3,14.7,12.3, /9.70,6.20,3.50,1.30,0.50,0.00/ NAME=' CYCLO--C3H6 99' C --------------------------------------------------------------------- C 1999 INCLUDED VIBRATIONAL RESONACE SHAPES FROM ALLEN (ERHARDT AND C MORGAN) AND ASLO BOESTEN AND TANAKA XIX ICPEAC C FIT TO SCHMIDTS ,GEE+FREEMAN AND BOWMAN+GORDON DATA IN C PURE CYCLO - PROPANE AND SCHMIDT IN HELIUM/CYCLOPROPANE. C NO GOOD DATA AT HIGH FIELD THEREFORE X-SECTIONS ABOVE 1 EV ARE C DERIVED FROM SYSTEMATICS IN THE HYDROCARBONS AND ABOVE REFS. C --------------------------------------------------------------------- NIN=9 NDATA=49 NVIB1=32 NVIB2=31 NVIB3=15 NVIB4=28 NVIB5=21 NEXC1=23 NEXC2=20 NION=46 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(42.08064*AMU) E(3)=9.86 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.107 EIN(2)=0.107 EIN(3)=-0.178 EIN(4)=0.178 EIN(5)=0.295 EIN(6)=0.374 EIN(7)=0.748 EIN(8)=7.30 EIN(9)=9.00 AMP1=0.120 AMP2=0.090 AMP3=0.109 APOP=DEXP(EIN(1)/AKT) APOPH=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-21 C 300 Q(5,I)=0.0 Q(6,I)=0.0 C C V7 SUPERELASTIC QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 350 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=AMP1*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V11 + V3 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=AMP1*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=QIN(2,I)+(A*EN+B) QIN(2,I)=QIN(2,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 4150 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=AMP2*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 4120 4110 CONTINUE J=NVIB2 4120 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V9 + V2 (SUM OF VIBRATIONS AT 179 AND 183 MV) QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 450 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=AMP2*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3 (HARMONICS) QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 500 DO 460 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 470 460 CONTINUE J=NVIB3 470 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 + V8 + V12 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 550 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=AMP3*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 600 DO 560 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 570 560 CONTINUE J=NVIB5 570 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 850 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 820 810 CONTINUE J=NEXC1 820 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 850 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 899 DO 860 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 870 860 CONTINUE J=NEXC2 870 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS34(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(24),YXSEC(24),XVIBH(18),YVIBH(18),XION(47),YION(47), /XATT(17),YATT(17),XEXC(25),YEXC(25),XEXC1(23),YEXC1(23), /XEXC2(19),YEXC2(19) CHARACTER*15 NAME DATA XEN/0.00,.001,0.01,0.10,0.40,1.00,1.50,2.00,3.00, /4.00,5.00,7.50,10.0,12.0,15.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YXSEC/2060.,2060.,1750.,175.,42.5,16.5,13.5,12.5,13.5, /15.0,16.0,20.0,19.0,18.0,15.0,11.5,8.60,3.60,2.05, /0.80,0.20,0.10,.008,.0008/ DATA XVIBH/0.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,12.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIBH/0.00,0.00,.025,0.45,0.60,0.80,0.95,1.00,0.95,0.80, /0.60,0.45,0.30,0.18,0.02,.001,.0001,.00001/ DATA XION/10.85,11.5,12.0,12.5,13.5,14.5,15.5,16.5,17.5,18.5, /20.0,25.0,30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0, /90.0,100.,125.,150.,175.,200.,250.,300.,350.,400., /450.,500.,600.,700.,800.,900.,1000.,1250.,1500.,1750., /2000.,4000.,6000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.015,0.06,0.13,0.33,0.60,0.89,1.21,1.53,1.84, /2.12,3.29,4.20,4.67,5.11,5.52,5.70,6.30,6.54,6.48, /6.46,6.51,6.17,5.97,5.65,5.36,4.73,4.34,3.95,3.65, /3.28,3.15,2.86,2.56,2.25,2.12,1.92,1.65,1.44,1.29, /1.15,0.68,0.50,0.34,.189,.104,.043/ DATA XATT/5.00,5.50,6.00,7.00,7.50,8.00,8.50,9.00,9.50,10.0, /10.4,11.0,12.0,13.0,14.0,15.0,20.0/ DATA YATT/0.00,.145,0.44,0.38,0.32,0.24,0.26,0.36,0.66,1.24, /2.00,1.08,0.30,0.20,0.16,0.12,0.00/ DATA XEXC/7.50,8.00,9.00,10.0,11.0,14.0,17.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.00,0.21,0.46,0.53,0.60,0.67,0.69,0.79,0.90,0.96, /1.00,1.00,1.00,0.93,0.87,0.80,0.66,0.60,0.47,0.33, /0.17,0.09,.033,.017,.004/ DATA XEXC1/9.80,10.5,11.5,13.5,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,0.11,0.23,0.42,0.64,0.87,1.02,1.10, /1.15,1.15,1.15,1.07,1.00,0.93,0.78,0.70,0.54,0.40, /0.20,0.10,0.04,0.02,.004/ DATA XEXC2/17.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.24,0.52,0.66, /0.71,0.66,0.63,0.60,0.55,0.47,0.38,0.30,0.22,0.14, /.076,.043,.019,.009,.0019/ C NAME='METHANOL 1999' C -------------------------------------------------------------------- C X-SECTIONS FROM SCALING ETHANOL X-SECTIONS AND ALSO FROM C TOTAL ELECTRON SCATTERING FROM GDANSK. C --------------------------------------------------------------------- NIN=9 NDATA=24 NVIBH=18 NION=47 NATT=17 NEXC=25 NEXC1=23 NEXC2=19 E(1)=0.0 E(2)=2.0*EMASS/(32.04186*AMU) E(3)=10.85 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.1281 EIN(4)=0.1281 EIN(5)=0.1668 EIN(6)=0.3527 EIN(7)=7.50 EIN(8)=9.80 EIN(9)=17.0 APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP Q(2,I)=0.0 C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 YXJ=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 40 DO 31 J=2,NION IF(EN.LE.XION(J)) GO TO 32 31 CONTINUE J=NION 32 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 40 CONTINUE C Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 50 IF(EN.GE.XATT(NATT)) GO TO 50 DO 41 J=2,NATT IF(EN.LE.XATT(J)) GO TO 42 41 CONTINUE J=NATT 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 50 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 250 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.40*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EIN(4)).LE.XVIBH(J)) GO TO 230 220 CONTINUE J=NVIBH 230 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.40*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.44*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(5,I)=(QIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.84*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C--------------------------------------------------------------------- C SUBTRACT ROTATIONAL XSEC TO GET CORRECT ELASTIC XSEC. Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I) C IF(Q(2,I).LE.0.0) WRITE(6,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',E12.3,' I=',I5) C TOTAL Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+ /QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS35(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(24),YXSEC(24),XVIBH(18),YVIBH(18),XION(48),YION(48), /XATT(17),YATT(17),XEXC(25),YEXC(25),XEXC1(23),YEXC1(23), /XEXC2(19),YEXC2(19) CHARACTER*15 NAME DATA XEN/0.00,.001,0.01,0.10,0.40,1.00,1.50,2.00,3.00, /4.00,5.00,7.50,10.0,12.0,15.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YXSEC/2060.,2060.,1750.,175.,42.5,16.5,13.5,12.5,13.5, /18.0,21.0,27.0,26.5,25.0,21.0,16.0,12.0,5.00,2.90, /1.05,0.35,0.16,.012,.001/ DATA XVIBH/0.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,12.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIBH/0.00,0.00,.025,0.25,0.66,0.88,1.05,1.10,1.05,0.88, /0.66,0.50,0.33,0.19,.022,.0011,.00011,.000011/ DATA XION/10.48,11.0,12.0,12.5,13.0,14.0,15.0,17.0,20.0,25.0, /30.0,35.0,40.0,45.0,50.0,60.0,70.0,80.0,90.0,100., /125.,150.,175.,200.,250.,300.,350.,400.,450.,500., /600.,700.,800.,900.,1000.,1250.,1500.,1750.,2000.,2500., /3000.,5000.,7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.11,0.32,0.45,0.59,0.91,1.32,2.21,3.12,5.01, /6.22,7.09,7.69,8.21,8.87,9.41,9.71,9.81,9.81,9.81, /9.52,9.00,8.50,8.03,7.50,6.58,6.01,5.56,5.06,4.74, /4.16,3.84,3.53,3.14,2.93,2.54,2.18,1.98,1.81,1.56, /1.34,0.88,0.66,0.49,0.35,.188,.101,.063/ DATA XATT/5.00,5.50,6.00,7.00,7.50,8.00,8.50,9.00,9.50,10.0, /10.4,11.0,12.0,13.0,14.0,15.0,20.0/ DATA YATT/0.00,.145,0.44,0.38,0.32,0.24,0.26,0.36,0.66,1.24, /2.00,1.08,0.30,0.20,0.16,0.12,0.00/ DATA XEXC/7.20,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.00,0.81,1.18,1.27,1.31,1.35,1.35,1.35,1.35,1.35, /1.39,1.39,1.35,1.27,1.06,0.98,0.82,0.77,0.65,0.42, /0.20,0.10,.041,.021,.004/ DATA XEXC1/9.50,10.5,11.5,13.5,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,0.14,0.30,0.56,0.86,1.15,1.35,1.46, /1.59,1.64,1.59,1.49,1.25,1.15,0.96,0.90,0.77,0.50, /0.24,0.12,.048,.025,.005/ DATA XEXC2/16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.32,0.69,0.96, /1.35,1.59,1.59,1.49,1.25,1.15,0.96,0.90,0.77,0.50, /0.24,0.12,.048,.025,.005/ C NAME=' ETHANOL 1999' C -------------------------------------------------------------------- C VIBRATION EXCITATION AND IONISATION FROM SCALING PROPANE X-SECTIONS C EXPERIMENTAL DATA FROM CHRISTOPHOROU AND FROMMHOLD ALSO MIXTURE c DATA WITH ARGON FROM COLLI AND LEONARDIS C --------------------------------------------------------------------- NIN=9 NDATA=24 NVIBH=18 NION=48 NATT=17 NEXC=25 NEXC1=23 NEXC2=19 E(1)=0.0 E(2)=2.0*EMASS/(46.06904*AMU) E(3)=10.48 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.109 EIN(4)=0.109 EIN(5)=0.1668 EIN(6)=0.3527 EIN(7)=7.20 EIN(8)=9.50 EIN(9)=16.0 APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP Q(2,I)=0.0 C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 YXJ=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 40 DO 31 J=2,NION IF(EN.LE.XION(J)) GO TO 32 31 CONTINUE J=NION 32 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 40 CONTINUE C Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 50 IF(EN.GE.XATT(NATT)) GO TO 50 DO 41 J=2,NATT IF(EN.LE.XATT(J)) GO TO 42 41 CONTINUE J=NATT 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 50 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 250 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.403*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EIN(4)).LE.XVIBH(J)) GO TO 230 220 CONTINUE J=NVIBH 230 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.403*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.423*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(5,I)=(QIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.84*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C--------------------------------------------------------------------- C SUBTRACT ROTATIONAL XSEC TO GET CORRECT ELASTIC XSEC. Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I) C IF(Q(2,I).LE.0.0) WRITE(6,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',E12.3,' I=',I5) C TOTAL Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+ /QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS36(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(24),YXSEC(24),XVIBH(18),YVIBH(18),XION(46),YION(46), /XATT(17),YATT(17),XEXC(25),YEXC(25),XEXC1(23),YEXC1(23), /XEXC2(19),YEXC2(19) CHARACTER*15 NAME DATA XEN/0.00,.001,0.01,0.10,0.40,1.00,1.50,2.00,3.00, /4.00,5.00,7.50,10.0,12.0,15.0,20.0,30.0,60.0,100., /200.0,500.0,1000.0,10000.,100000./ DATA YXSEC/2160.,2160.,1840.,184.,44.5,17.0,14.0,13.0,14.0, /21.0,26.0,33.5,33.5,31.5,26.5,20.5,15.5,6.50,3.70, /1.30,0.45,0.21,.015,.0012/ DATA XVIBH/0.00,2.00,3.00,4.00,5.00,6.00,7.00,8.00,9.00,10.0, /11.0,12.0,15.0,20.0,100.,1000.,10000.,100000./ DATA YVIBH/0.00,0.00,.034,0.34,0.89,1.19,1.42,1.48,1.42,1.19, /0.89,0.68,0.45,0.25,.030,.0015,.00015,.000015/ DATA XION/10.18,10.7,12.0,13.0,14.0,16.5,19.5,25.0,30.0,35.0, /40.0,45.0,50.0,60.0,70.0,80.0,90.0,100.,125.,150., /175.,200.,250.,300.,350.,400.,450.,500.,600.,700., /800.,900.,1000.,1250.,1500.,1750.,2000.,2500.,3000.,5000., /7000.,10000.,15000.,30000.,60000.,100000./ DATA YION/0.00,0.26,0.59,0.96,1.43,2.91,4.17,6.57,8.16,9.30, /10.1,10.8,11.6,12.3,12.7,12.9,12.9,12.9,12.5,11.8, /11.2,10.6,9.80,8.63,7.88,7.29,6.64,6.22,5.46,5.04, /4.63,4.12,3.85,3.33,2.86,2.60,2.37,2.05,1.76,1.16, /0.87,0.64,0.46,0.25,0.11,.083/ DATA XATT/5.00,5.50,6.00,7.00,7.50,8.00,8.50,9.00,9.50,10.0, /10.4,11.0,12.0,13.0,14.0,15.0,20.0/ DATA YATT/0.00,.145,0.44,0.38,0.32,0.24,0.26,0.36,0.66,1.24, /2.00,1.08,0.30,0.20,0.16,0.12,0.00/ DATA XEXC/7.00,9.00,10.0,11.0,12.0,14.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.00,1.07,1.57,1.69,1.74,1.80,1.80,1.80,1.80,1.80, /1.85,1.85,1.80,1.69,1.41,1.30,1.09,1.02,0.86,0.56, /0.27,0.13,.055,.028,.005/ DATA XEXC1/9.00,10.0,11.0,13.0,16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC1/0.00,0.19,0.40,0.75,1.14,1.53,1.80,1.94, /2.11,2.18,2.11,1.98,1.66,1.53,1.28,1.20,1.02,0.67, /0.32,0.16,.064,.033,.007/ DATA XEXC2/16.0,20.0,25.0,30.0, /40.0,60.0,80.0,100.,150.,200.,300.,400.,600.,1000., /2000.,4000.,10000.,20000.,100000./ DATA YEXC2/0.00,0.42,0.92,1.28, /1.80,2.11,2.11,1.98,1.66,1.53,1.28,1.20,1.02,0.67, /0.32,0.16,.064,.033,.007/ C NAME='2-PROPANOL 1999' C -------------------------------------------------------------------- C X-SECTIONS FROM SCALING ETHANOL X-SECTIONS AT LOW ENERGY AND C FITS TO DRIFT VELOCITY OF CHRISTOPHOROU AND CHRISTODOULIDES. C --------------------------------------------------------------------- NIN=9 NDATA=24 NVIBH=18 NION=46 NATT=17 NEXC=25 NEXC1=23 NEXC2=19 E(1)=0.0 E(2)=2.0*EMASS/(60.09592*AMU) E(3)=10.18 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.025 EIN(2)=0.025 EIN(3)=-0.109 EIN(4)=0.109 EIN(5)=0.1668 EIN(6)=0.3527 EIN(7)=7.00 EIN(8)=9.00 EIN(9)=16.0 APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP Q(2,I)=0.0 C USE LOG INTERPOLATION BECAUSE OF RAPID CHANGE IN X-SEC IF(EN.LE.XEN(2)) THEN Q(2,I)=YXSEC(2)*1.D-16 GO TO 30 ENDIF DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 YXJ=DLOG(YXSEC(J)) YXJ1=DLOG(YXSEC(J-1)) XNJ=DLOG(XEN(J)) XNJ1=DLOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=DEXP(A*DLOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 40 DO 31 J=2,NION IF(EN.LE.XION(J)) GO TO 32 31 CONTINUE J=NION 32 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 40 CONTINUE C Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 50 IF(EN.GE.XATT(NATT)) GO TO 50 DO 41 J=2,NATT IF(EN.LE.XATT(J)) GO TO 42 41 CONTINUE J=NATT 42 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-19 50 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC ROT1 C QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.7*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 200 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.7*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(2,I)=QIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 250 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.443*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EIN(4)).LE.XVIBH(J)) GO TO 230 220 CONTINUE J=NVIBH 230 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 300 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.443*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(4,I)=QIN(4,I)+(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 400 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.465*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(5,I)=(QIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 500 EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.92*DLOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 520 510 CONTINUE J=NEXC 520 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 620 610 CONTINUE J=NEXC1 620 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 720 710 CONTINUE J=NEXC2 720 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C--------------------------------------------------------------------- C SUBTRACT ROTATIONAL XSEC TO GET CORRECT ELASTIC XSEC. Q(2,I)=Q(2,I)-QIN(1,I)-QIN(2,I) C IF(Q(2,I).LE.0.0) WRITE(6,966) Q(2,I),I C 966 FORMAT(3X,' ERROR IN GAS 27 Q(2,I)=',E12.3,' I=',I5) C TOTAL Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+ /QIN(3,I)+QIN(4,I)+QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 C RETURN END SUBROUTINE GAS37(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(67),YXSEC(67),XATT(3),YATT(3),XION(27),YION(27), /XEXC1(27),YEXC1(27),XEXC2(25),YEXC2(25),XEXC3(22),YEXC3(22), /XEXC4(20),YEXC4(20),XEXC5(18),YEXC5(18) CHARACTER*15 NAME DATA XEN/0.00,.00005,.0001,.00015,.0002,.0003,.0004,.0005,.0006, /.0007, /.0008,.0009,.001,.00125,.0015,.0017,.00185,.002,.0025,.003, /.004,.005,.0056,.006,.007,.008,.009,0.01,.0125,.013, /.015,0.02,.025,0.03,0.04,0.05,0.06,0.07,0.08,0.09, /0.10,0.20,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.20,1.40,1.50,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /4.00,10.0,1000.,2000.,10000.,20000.,100000./ DATA YXSEC/1190.,1188.,1005.,916.,851.,760.,708.,667.,639.,624., /609.,639.,696.,1149.,4745.,10930.,10930.,7038.,2782.,2130., /2354.,4620.,6849.,6300.,4016.,2848.,2520.,2876.,4365.,4745., /4515.,2876.,1775.,1430.,1039.,851.,790.,710.,670.,630., /600.,415.,340.,290.,260.,230.,210.,195.,180.,170., /135.,100.,80.0,65.0,58.5,52.5,47.6,44.4,43.1,41.2, /36.0,26.0,0.14,0.07,.012,.006,.0012/ DATA XION/3.8926,5.00,6.00,7.00,8.00,10.0,12.0,14.0,15.0,17.0, /20.0,25.0,30.0,40.0,50.0,60.0,80.0,100.,200.,300., /400.,500.,600.,700.,1000.,10000.,100000./ DATA YION/0.00,2.70,4.80,6.00,7.20,8.00,8.20,9.80,10.0,9.30, /8.40,9.90,10.2,9.92,9.82,9.58,9.08,8.79,7.40,6.25, /5.44,5.02,4.88,4.80,4.50,0.45,.045/ DATA XATT/10.0,100.0,100000./ DATA YATT/0.00,0.0000001,0.0000000001/ C P1/2 DATA XEXC1/1.3859,1.40,1.45,1.50,1.60,1.70,1.90,2.00,2.20,2.50, /3.00,3.50,4.00,5.00,6.00,7.00,8.00,10.0,15.0,20.0, /40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC1/0.00,1.47,15.4,23.7,17.8,17.1,14.2,12.7,12.0,11.2, /12.2,12.7,13.0,13.8,14.3,15.1,15.1,14.7,13.8,13.3, /8.32,6.24,4.94,4.16,0.42,.042,.0042/ C P3/2 DATA XEXC2/1.4546,1.50,1.60,1.70,1.90,2.00,2.20,2.50,3.00,3.50, /4.00,5.00,6.00,7.00,8.00,10.0,15.0,20.0,40.0,60.0, /80.0,100.,1000.,10000.,100000./ DATA YEXC2/0.00,23.7,34.6,32.3,26.9,24.2,21.5,19.5,20.5,21.5, /22.0,23.3,24.2,25.5,25.5,24.9,23.3,22.4,14.1,10.6, /8.36,7.04,0.70,0.07,.007/ C D3/2 + D5/2 DATA XEXC3/1.7977,1.90,2.00,2.20,2.50,3.00,3.50,4.00,5.00,6.00, /7.00,8.00,10.0,15.0,20.0,40.0,60.0,80.0,100.,1000., /10000.,100000./ DATA YEXC3/0.00,7.50,14.7,19.8,20.3,21.8,23.2,23.5,24.9,25.8, /27.3,27.3,26.6,24.9,24.0,15.0,11.3,8.93,7.52,0.75, /.075,.0075/ C S1/2 DATA XEXC4/2.2981,2.40,2.50,3.00,3.50,4.00,5.00,6.00,7.00,8.00, /10.0,15.0,20.0,40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC4/0.00,3.40,4.90,6.40,7.30,7.50,7.95,8.25,8.70,8.70, /8.47,7.95,7.65,4.80,3.60,2.85,2.40,0.24,.024,.0024/ C SUM OF HIGHER LEVELS DATA XEXC5/2.6986,3.00,3.50,4.00,5.00,6.00,7.00,8.00,10.0,15.0, /20.0,40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC5/0.00,1.90,3.30,4.40,4.66,4.84,5.10,5.10,4.97,4.66, /4.49,2.82,2.11,1.67,1.41,.141,.0141,.00141/ NAME=' CESIUM 2001 ' C --------------------------------------------------------------------- C --------------------------------------------------------------------- NIN=5 NDATA=67 NION=27 NATT=3 NEXC1=27 NEXC2=25 NEXC3=22 NEXC4=20 NEXC5=18 E(1)=0.0 E(2)=2.0*EMASS/(132.90545*AMU) E(3)=3.8926 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=1.3859 EIN(2)=1.4546 EIN(3)=1.7977 EIN(4)=2.2981 EIN(5)=2.6986 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GE.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16 300 Q(5,I)=0.0 Q(6,I)=0.0 C QIN(1,I)=0.0 IF(EN.LE.EIN(1)) GO TO 400 DO 310 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 320 310 CONTINUE J=NEXC1 320 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 500 DO 410 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 420 410 CONTINUE J=NEXC2 420 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 600 DO 510 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 520 510 CONTINUE J=NEXC3 520 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 700 DO 610 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 620 610 CONTINUE J=NEXC4 620 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 800 DO 710 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GO TO 720 710 CONTINUE J=NEXC5 720 A=(YEXC5(J)-YEXC5(J-1))/(XEXC5(J)-XEXC5(J-1)) B=(XEXC5(J-1)*YEXC5(J)-XEXC5(J)*YEXC5(J-1))/(XEXC5(J-1)-XEXC5(J)) QIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS38(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(29),YXSEC(29),XATT(65),YATT(65),XION(24),YION(24), /XVIB1(55),YVIB1(55),XVIB2(54),YVIB2(54),XVIB3(32),YVIB3(32), /XVIB4(24),YVIB4(24),XEXC1(18),YEXC1(18),XEXC2(17),YEXC2(17), /XEXC3(18),YEXC3(18),XEXC4(17),YEXC4(17) CHARACTER*15 NAME DATA XEN/0.00,0.01,.028,.109,.282,.471,.681,1.01,1.25,1.45, /1.49,1.53,1.56,1.62,2.16,2.57,3.58,6.19,9.89,16.3, /24.5,39.3,71.0,120.,218.,379.,953.,10000.,100000./ DATA YXSEC/10.3,10.3,10.2,10.3,10.5,11.1,12.7,16.6,21.6,32.6, /35.6,36.2,36.2,35.4,24.3,19.9,16.2,12.2,10.1,8.13, /6.24,4.19,2.52,1.44,.684,.301,.082,.009,.001/ DATA XVIB1/.1108,0.20,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.10,1.20,1.30,1.40,1.50,1.60,1.70,1.80,1.90,2.00, /2.10,2.20,2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,3.60,3.70,3.80,3.90,4.00, /4.10,4.20,4.30,4.40,4.50,4.60,4.70,4.80,4.90,5.00, /10.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,0.64,0.85,0.86,0.77,0.63,0.50,0.39,0.30,0.23, /0.18,0.14,0.12,.095,.079,.066,.057,.049,.043,.038, /.033,.030,.027,.024,.022,.020,.018,.017,.015,.014, /.013,.012,.011,.0105,.010,.0094,.0089,.0084,.0078,.0074, /.0071,.0067,.0063,.0060,.0057,.0054,.0052,.0050,.0048,.0046, /.0025,.00030,.00003,.000003,.0000003/ DATA XVIB2/.2188,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.10, /1.20,1.30,1.40,1.50,1.60,1.70,1.80,1.90,2.00,2.10, /2.20,2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,3.10, /3.20,3.30,3.40,3.50,3.60,3.70,3.80,3.90,4.00,4.10, /4.20,4.30,4.40,4.50,4.60,4.70,4.80,4.90,5.00,10.0, /100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.82,0.99,0.97,0.85,0.70,0.55,0.43,0.33,0.26, /0.21,0.16,0.13,0.11,.093,.080,.069,.060,.053,.047, /.042,.037,.034,.031,.028,.026,.024,.022,.020,.019, /.017,.016,.015,.014,.013,.012,.011,.011,.010,.010, /.0094,.0089,.0084,.0081,.0077,.0073,.0070,.0067,.0064,.0035, /.0004,.00004,.000004,.0000004/ DATA XVIB3/.3237,0.40,0.50,0.60,0.70,0.80,1.00,1.20,1.40,1.60, /1.80,2.00,2.20,2.40,2.60,2.80,3.00,3.20,3.40,3.60, /3.80,4.00,4.20,4.40,4.60,4.80,5.00,10.0,100.,1000., /10000.,100000./ DATA YVIB3/0.00,0.52,0.63,0.61,0.53,0.43,0.27,0.16,0.10,.069, /.050,.039,.031,.025,.021,.017,.015,.013,.011,.010, /.0088,.0079,.0071,.0064,.0058,.0053,.0048,.003,.0003,.00003, /.000003,.0000003/ DATA XVIB4/.4205,0.50,0.60,0.70,0.80,0.90,1.00,1.20,1.40,1.60, /1.80,2.00,2.20,2.50,3.00,3.50,4.00,4.50,4.90,10.0, /100.,1000.,10000.,100000./ DATA YVIB4/0.00,0.18,0.21,0.21,0.18,0.15,0.11,.060,.034,.023, /.016,.013,.010,.0078,.0052,.0038,.0028,.0022,.0018,.001, /.0001,.00001,.000001,.0000001/ DATA XION/15.69,16.54,16.56,16.83,17.4,18.2,19.6,21.8,25.5,28.6, /35.4,42.5,52.1,66.6,94.0,118.,176.,269.,381.,507., /720.,937.,10000.,100000./ DATA YION/0.0,.0103,.015,.0255,.0413,.066,.106,.172,.302,.436, /.628,.783,.934,1.066,1.18,1.22,1.18,1.04,.865,.721, /.572,.473,0.05,0.005/ DATA XATT/0.00,0.01,0.02,0.03,0.04,0.05,0.07,0.10,0.15,0.20, /0.25,0.30,0.35,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.20,1.40,1.60,1.80,2.00,2.20,2.40,2.60,2.80, /3.00,3.20,3.40,3.60,3.80,4.00,4.20,4.40,4.60,4.80, /5.00,5.20,5.40,5.60,5.80,6.00,6.20,6.40,6.60,6.80, /7.00,7.20,7.40,7.60,7.80,8.00,8.20,8.40,8.60,8.80, /10.0,100.,1000.,10000.,100000./ DATA YATT/80.0,44.4,24.7,13.7,8.20,7.40,7.10,6.50,5.45,4.80, /4.25,3.65,3.10,2.65,2.25,1.92,1.34,0.94,.655,.455, /.320,.153,.075,.036,.022,.014,.012,.011,.010,.0097, /.0093,.0082,.0069,.0056,.0046,.0039,.0035,.0036,.0038,.0042, /.0046,.0052,.0057,.0063,.0068,.0069,.0070,.0069,.0064,.0058, /.0052,.0049,.0040,.0035,.0030,.0025,.0021,.0017,.0014,.0012, /.0004,.00004,.000004,.0000004,.00000004/ DATA XEXC1/3.16,4.00,4.20,4.60,5.60,6.00,7.00,8.00,10.0,15.0, /20.0,27.0,34.0,40.0,100.,1000.,10000.,100000./ DATA YEXC1/0.0,.065,0.10,.145,0.20,0.22,0.23,0.22,0.20,0.14, /.107,.080,.060,.048,.024,.003,.0003,.00003/ DATA XEXC2/4.34,5.00,6.00,7.00,8.00,10.0,14.7,20.0,25.0,40.0, /54.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC2/0.00,0.04,0.06,.074,.080,.074,.060,.047,.040,.025, /.020,.017,.013,.010,.001,.0001,.00001/ DATA XEXC3/11.57,11.73,12.62,14.0,17.0,18.7,21.6,25.8,31.1,39.5, /51.9,78.4,142.,235.,396.,959.,10000.,100000./ DATA YEXC3/0.00,.0102,.0301,.0791,.232,.301,.373,.445,.502,.524, /.510,.477,.373,.282,.204,.119,.012,.0012/ DATA XEXC4/13.08,19.25,20.4,23.8,28.6,34.6,43.0,53.4,68.2,90.6, /121.,180.,284.,427.,970.,10000.,100000./ DATA YEXC4/.0,.0104,.0144,.025,.0396,.0552,.0666,.0722,.074,.0734, /.0693,.0588,.0442,.033,.0176,.0018,.00018/ NAME=' F2 MORGAN ' C --------------------------------------------------------------------- C COPIED FROM W.L.MORGAN C --------------------------------------------------------------------- NIN=9 NDATA=29 NION=24 NATT=65 NVIB1=55 NVIB2=54 NVIB3=32 NVIB4=24 NEXC1=18 NEXC2=17 NEXC3=18 NEXC4=17 E(1)=0.0 E(2)=2.0*EMASS/(38.00000*AMU) E(3)=15.69 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.1108 EIN(2)=0.1108 EIN(3)=0.2188 EIN(4)=0.3237 EIN(5)=0.4205 EIN(6)=3.16 EIN(7)=4.34 EIN(8)=11.57 EIN(9)=13.08 APOP=DEXP(EIN(1)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.E-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 200 Q(4,I)=0.0 IF(EN.GE.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16 300 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC V1 QIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 302 301 CONTINUE J=NVIB1 302 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.E-16/EN QIN(1,I)=QIN(1,I)*APOP/(1.0+APOP) 305 CONTINUE C V1 QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.E-16 QIN(2,I)=QIN(2,I)/(1.0+APOP) 400 CONTINUE C 2V1 QIN(3,I)=0.0 IF(EN.LE.EIN(3)) GO TO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE C 3V1 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C 4V1 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GO TO 720 710 CONTINUE J=NEXC1 720 A=(YEXC1(J)-YEXC1(J-1))/(XEXC1(J)-XEXC1(J-1)) B=(XEXC1(J-1)*YEXC1(J)-XEXC1(J)*YEXC1(J-1))/(XEXC1(J-1)-XEXC1(J)) QIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GO TO 820 810 CONTINUE J=NEXC2 820 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GO TO 920 910 CONTINUE J=NEXC3 920 A=(YEXC3(J)-YEXC3(J-1))/(XEXC3(J)-XEXC3(J-1)) B=(XEXC3(J-1)*YEXC3(J)-XEXC3(J)*YEXC3(J-1))/(XEXC3(J-1)-XEXC3(J)) QIN(8,I)=(A*EN+B)*1.E-16 990 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 1990 DO 1910 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GO TO 1920 1910 CONTINUE J=NEXC4 1920 A=(YEXC4(J)-YEXC4(J-1))/(XEXC4(J)-XEXC4(J-1)) B=(XEXC4(J-1)*YEXC4(J)-XEXC4(J)*YEXC4(J-1))/(XEXC4(J-1)-XEXC4(J)) QIN(9,I)=(A*EN+B)*1.E-16 1990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS39(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) C /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(30),YXSEC(30),XVIB1(39),YVIB1(39), /XVIB2(34),YVIB2(34),XEXC(18),YEXC(18),XION(69),YION(69), /XATT(30),YATT(30),XAT1(9),YAT1(9) CHARACTER*15 NAME C ELASTIC DATA XEN/0.00,0.01,0.02,0.04,0.07,0.10,0.15,0.20,0.30,0.50, /0.80,1.00,1.20,1.50,1.80,2.20,3.00,3.50,5.00,8.00, /10.0,12.0,15.0,20.0,30.0,40.0,100.,1000.,10000.,100000./ DATA YXSEC/99.0,90.0,80.0,58.0,45.0,36.5,28.5,23.0,16.0,9.82, /7.62,8.61,11.6,14.3,20.0,23.8,27.6,28.1,26.4,28.1, /29.2,29.2,26.4,17.1,9.90,6.50,2.70,0.27,.027,.0027/ C VIBRATION V2 (010) BENDING DATA XVIB1/.0490,0.05,.055,0.06,0.07,0.08,0.09,0.10,0.12,0.14, /0.17,0.20,0.25,0.30,0.35,0.40,0.50,0.60,0.80,1.00, /1.20,1.40,1.70,2.00,2.50,3.00,3.50,4.00,5.00,6.00, /8.00,10.0,15.0,20.0,40.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,2.40,10.0,18.5,21.0,22.0,21.0,19.5,14.0,10.0, /7.00,5.00,3.20,2.10,1.50,1.20,0.90,0.78,0.60,0.50, /0.43,0.39,0.33,0.29,0.25,0.22,0.25,0.32,0.40,0.45, /0.20,0.10,.075,.052,.032,.013,.0013,.00013,.000013/ C VIBRATION V1 (100) SYMMETRIC STRETCH DATA XVIB2/.0810,0.09,0.10,0.11,0.12,0.13,0.15,0.17,0.20,0.25, /0.30,0.35,0.40,0.50,0.60,0.80,1.00,1.20,1.40,1.70, /2.00,2.50,3.00,3.50,4.00,5.00,6.00,8.00,10.0,20.0, /100.,1000.,10000.,100000./ DATA YVIB2/0.00,2.50,6.00,7.50,8.00,7.50,5.80,4.20,2.50,1.50, /1.05,0.74,0.58,0.40,0.29,0.16,0.12,0.10,0.10,.125, /.165,0.27,0.43,0.51,0.49,0.20,0.12,0.07,.057,.033, /.008,.0008,.00008,.000008/ C VIBRATION V3 (001) ASYMMETRIC STRETCH : USED DIPOLE EXCITATION FUNC. C C IONISATION DATA XION/10.07,10.5,11.0,11.5,12.0,12.5,13.0,13.5,14.0,14.5, /15.0,15.5,16.0,16.5,17.0,18.0,19.0,20.0,21.0,22.0, /23.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0,40.0, /45.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0,90.0,100., /120.,140.,160.,180.,200.,220.,240.,250.,300.,350., /400.,450.,500.,550.,600.,650.,700.,800.,900.,1000., /1500.,2000.,2500.,3000.,5000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.192,.421,.652,.880,1.10,1.32,1.53,1.72,1.92, /2.20,2.48,2.74,3.03,3.31,3.84,4.34,4.83,5.28,5.69, /6.06,6.40,6.99,7.48,7.90,8.26,8.58,8.84,9.05,9.23, /9.53,9.69,9.75,9.74,9.68,9.59,9.47,9.34,9.06,8.76, /8.17,7.63,7.14,6.71,6.33,5.99,5.69,5.55,4.96,4.48, /4.10,3.79,3.52,3.29,3.09,2.92,2.76,2.50,2.29,2.12, /1.56,1.28,1.10,0.94,0.66,0.42,0.24,.134,.069/ C ATTACHMENT CS2 - (PROBABLY 3 BODY MORMALISED AT 40 TORR) DATA XAT1/.0001,.001,0.01,.017,.025,0.03,.035,0.04,10.0/ DATA YAT1/35.0,35.0,28.0,20.0,10.0,5.00,1.50,.00001,.0000001/ C DISOCIATIVE ATTACHMENT UNITS OF 10**-19 DATA XATT/2.41,2.50,2.60,2.70,2.80,3.00,3.20,3.35,3.60,3.70, /3.80,4.00,4.20,4.40,5.40,5.50,5.75,6.00,6.25,6.50, /6.75,7.00,7.50,7.75,8.00,8.25,8.50,10.0,100.,100000./ DATA YATT/0.00,0.01,0.02,0.04,0.08,0.40,2.00,3.70,3.00,3.10, /2.70,1.50,0.40,0.01,0.01,0.10,0.50,1.45,1.80,0.90, /0.30,0.20,0.30,0.90,0.50,0.10,0.01,0.01,.001,.0001/ C EXCITATION DATA XEXC/6.20,7.00,8.00,9.00,10.0,11.0,12.0,14.0,17.0,20.0, /30.0,40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC/0.00,0.60,1.50,3.30,5.20,7.00,8.00,8.80,9.20,8.90, /8.00,7.40,6.30,5.50,5.00,0.50,0.05,.005/ C ---------------------------------------------------------------- C LACK OF ELECTRON DRIFT DATA . C USED SOHNS ELECTRON SCATTERING DATA AND UNPUBLISHED DATA BY ALLEN. C THE ATTACHMENT IS PROBABLY 3 BODY EXCEPT FOR THE DISOCIATIVE C ATTACHMENT. C THE 3-BODY X-SECTION CORRESPONDS TO 40 TORR PRESSURE C --------------------------------------------------------------- NAME=' CS2 -2001--- ' KIN(1)=0 KIN(2)=0 KEL=0 NIN=6 NDATA=30 NVIB1=39 NVIB2=34 NION=69 NATT=30 NAT1=9 NEXC=18 E(1)=0.0 E(2)=2.0*EMASS/(76.1427*AMU) E(3)=10.07 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.049 EIN(2)=0.049 EIN(3)=-0.081 EIN(4)=0.081 EIN(5)=0.190 EIN(6)=6.20 APOPV2=DEXP(EIN(1)/AKT) APOPV1=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 30 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0 IF(EN.LT.XAT1(1)) GO TO 250 IF(EN.GT.XAT1(NAT1)) GO TO 250 DO 210 J=2,NAT1 IF(EN.LE.XAT1(J)) GO TO 220 210 CONTINUE J=NAT1 220 A=(YAT1(J)-YAT1(J-1))/(XAT1(J)-XAT1(J-1)) B=(XAT1(J-1)*YAT1(J)-XAT1(J)*YAT1(J-1))/(XAT1(J-1)-XAT1(J)) Q(4,I)=(A*EN+B)*1.D-16*1.3 250 CONTINUE IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 260 J=2,NATT IF(EN.LE.XATT(J)) GO TO 270 260 CONTINUE J=NATT 270 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=Q(4,I)+(A*EN+B)*1.D-19 300 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC V2 BENDING MODE C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 340 DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)*1.D-16/EN QIN(1,I)=QIN(1,I)*APOPV2/(1.0+APOPV2) 340 CONTINUE C C VIBRATION V2 BENDING MODE QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 DO 350 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 360 350 CONTINUE J=NVIB1 360 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B)*1.D-16 QIN(2,I)=QIN(2,I)/(1.0+APOPV2) 400 CONTINUE C C SUPERELASTIC OF V1 SYMMETRIC STRETCH VIBRATION C QIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 440 DO 410 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)*1.D-16/EN QIN(3,I)=QIN(3,I)*APOPV1/(1.0+APOPV1) 440 CONTINUE C C VIBRATION V3 SYMMETRIC STRETCH QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 500 DO 450 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 460 450 CONTINUE J=NVIB2 460 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B)*1.D-16 QIN(4,I)=QIN(4,I)/(1.0+APOPV1) 500 CONTINUE C C VIBRATION V3 ASYMMETRIC STRETCH QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 600 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.710*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(5,I)=QIN(5,I)*1.D-16 600 CONTINUE C C EXCITATION (DISOCIATION) QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(6,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 RETURN END SUBROUTINE GAS40(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) C /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(34),YXSEC(34),XVIB1(40),YVIB1(40), /XVIB2(39),YVIB2(39),XVIB3(31),YVIB3(31), /XVIB4(14),YVIB4(14),XVIB5(22),YVIB5(22),XVIB6(22),YVIB6(22), /XEXC(17),YEXC(17),XION(70),YION(70),XATT(20),YATT(20) CHARACTER*15 NAME C ELASTIC DATA XEN/1.D-6,.001,0.01,0.10,0.15,0.20,0.30,0.40,0.50,0.60, /0.70,0.80,1.00,1.20,1.50,1.70,2.00,2.50,3.00,4.00, /5.00,7.00,10.0,15.0,20.0,30.0,40.0,60.0,80.0,100., /200.,1000.,10000.,100000./ DATA YXSEC/1.9D3,1.9D3,190.,19.0,11.5,9.00,7.20,7.40,7.70,8.00, /8.40,8.80,10.0,10.7,10.0,9.50,9.00,10.0,11.5,14.5, /15.0,15.5,16.0,14.5,13.0,9.00,6.50,4.00,2.60,2.00, /1.00,0.20,0.02,.002/ C VIBRATION V2 (010) BENDING DATA XVIB1/.064,0.07,0.08,0.09,0.10,0.12,0.14,0.17,0.20,0.24, /0.28,0.32,0.36,0.40,0.45,0.50,0.60,0.70,0.80,0.90, /1.00,1.10,1.15,1.20,1.30,1.50,1.70,2.00,2.50,3.00, /4.00,5.00,6.00,7.00,8.00,10.0,100.,1000.,10000.,100000./ DATA YVIB1/0.00,2.75,4.20,4.80,4.80,4.50,3.50,2.60,2.10,1.60, /1.35,1.15,1.05,1.00,1.00,1.05,1.15,1.40,1.85,2.30, /2.80,3.40,3.80,3.80,3.30,2.20,1.30,0.80,0.35,0.25, /0.21,.165,0.14,.125,0.11,0.09,.013,.0013,.00013,.000013/ C VIBRATION V1 (100) SYMMETRIC STRETCH DATA XVIB2/.107,0.11,0.12,0.13,0.14,0.15,0.16,0.18,0.20,0.22, /0.25,0.30,0.35,0.40,0.50,0.60,0.70,0.80,0.90,1.00, /1.10,1.15,1.20,1.30,1.50,2.00,2.50,3.00,3.50,4.00, /4.50,5.00,6.00,8.00,10.0,100.,1000.,10000.,100000./ DATA YVIB2/0.00,0.30,0.56,0.68,0.75,0.78,0.81,0.81,0.75,0.64, /0.58,0.50,0.47,0.46,0.46,0.50,0.55,0.70,0.90,1.15, /1.40,1.50,1.50,1.30,0.90,0.50,0.40,0.40,0.68,0.84, /0.65,0.48,0.30,0.24,0.21,.021,.0021,.00021,.000021/ C VIBRATION HARMONIC 2V2 (020) BENDING DATA XVIB3/.128,0.13,0.14,0.15,0.16,0.18,0.20,0.22,0.25,0.30, /0.40,0.50,0.60,0.70,0.80,0.90,1.00,1.10,1.15,1.20, /1.30,1.50,1.70,2.00,3.00,5.00,10.0,100.,1000.,10000., /100000./ DATA YVIB3/0.00,1.07,2.40,3.00,3.35,3.70,3.75,3.50,2.75,1.95, /1.35,1.20,1.30,1.50,1.90,2.40,2.80,3.50,3.90,3.90, /3.60,2.50,1.50,0.90,0.20,.035,0.01,.001,.0001,.00001, /.000001/ C VIBRATION V3 (001) ASYMMETRIC STRETCH ( RESONANCE PART ONLY) DATA XVIB4/.256,0.70,0.80,0.90,1.00,1.10,1.15,1.20,1.30,1.50, /1.70,2.00,10.0,100000./ DATA YVIB4/0.00,0.02,0.60,1.50,2.60,3.00,3.50,3.50,3.00,1.80, /0.90,0.08,0.001,.000002/ C VIBRATION SUM OF HARMONICS NV1 DATA XVIB5/0.38,0.70,0.80,0.90,1.00,1.10,1.15,1.20,1.30,1.50, /1.70,2.00,3.00,3.50,4.00,4.50,5.00,6.00,10.0,100., /1000.,100000./ DATA YVIB5/0.00,.001,0.04,0.12,0.20,0.26,0.30,0.30,0.26,0.20, /0.12,0.02,0.05,0.10,0.15,0.10,0.05,0.02,0.01,.001, /.0001,.0000001/ C VIBRATION SUM OF HIGHER HARMONICS (0.512) DATA XVIB6/.512,0.70,0.80,0.90,1.00,1.10,1.15,1.20,1.30,1.50, /1.70,2.00,3.00,3.50,4.00,4.50,5.00,6.00,10.0,100., /1000.,100000./ DATA YVIB6/0.00,.001,0.03,0.08,0.13,0.17,0.20,0.20,0.17,0.13, /0.08,0.02,0.03,0.07,0.10,0.07,0.03,0.02,0.01,.001, /.0001,.0000001/ C IONISATION DATA XION/11.19,11.5,12.0,12.5,13.0,13.5,14.0,14.5,15.0,15.5, /16.0,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0,21.0, /22.0,23.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0,38.0, /40.0,45.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0,90.0, /100.,110.,120.,140.,160.,180.,200.,250.,300.,350., /400.,450.,500.,550.,600.,650.,700.,750.,800.,900., /1000.,1500.,2000.,2500.,3000.,5000.,10000.,20000.,40000.,100000./ DATA YION/0.00,.105,.279,.455,.630,.802,0.97,1.13,1.29,1.44, /1.58,1.72,1.85,1.99,2.14,2.28,2.43,2.58,2.73,3.01, /3.27,3.52,3.75,4.16,4.51,4.81,5.09,5.33,5.53,5.71, /5.85,6.14,6.33,6.44,6.50,6.53,6.52,6.50,6.46,6.34, /6.20,6.05,5.90,5.59,5.29,5.02,4.78,4.26,3.84,3.51, /3.23,2.99,2.79,2.62,2.47,2.34,2.22,2.11,2.01,1.85, /1.71,1.26,1.03,0.88,0.76,0.54,0.34,0.20,.108,.055/ DATA XATT/0.94,1.00,1.10,1.20,1.25,1.30,1.40,1.50,1.60,1.70, /1.80,1.90,2.00,2.10,2.20,2.30,2.40,2.50,10.0,100000./ DATA YATT/0.00,0.03,.182,.272,.290,.282,.263,.219,.151,.106, /.069,.042,.026,.015,.011,.005,.002,.001,.001,.0000001/ C EXCITATION DATA XEXC/7.00,8.00,9.00,10.0,11.0,12.0,14.0,17.0,20.0,30.0, /40.0,60.0,80.0,100.,1000.,10000.,100000./ DATA YEXC/0.0,0.60,1.40,2.80,4.00,5.00,5.75,6.10,6.00,5.40, /5.00,4.20,3.70,3.35,0.65,.065,.0065/ C ---------------------------------------------------------------- C LACK OF ELECTRON DRIFT DATA. C USED SOHNS ELECTRON SCATTERING DATA . C POSSIBLE 3-BODY ATTACHMENT NOT YET INCLUDED . C 3-BODY ATTACHMENT IS SMALLER THAN CARBON DISULPHIDE BUT MAY BE C SIGNIFICANT.. C --------------------------------------------------------------- NAME=' COS -2001--- ' KIN(1)=0 KIN(2)=0 KEL=0 NIN=10 NDATA=34 NVIB1=40 NVIB2=39 NVIB3=31 NVIB4=14 NVIB5=22 NVIB6=22 NION=70 NATT=20 NEXC=17 E(1)=0.0 E(2)=2.0*EMASS/(60.0761*AMU) E(3)=11.19 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.064 EIN(2)=0.064 EIN(3)=-0.107 EIN(4)=0.107 EIN(5)=-0.128 EIN(6)=0.128 EIN(7)=0.256 EIN(8)=0.380 EIN(9)=0.512 EIN(10)=7.00 APOPV2=DEXP(EIN(1)/AKT) APOPV1=DEXP(EIN(3)/AKT) APOP2V2=DEXP(EIN(5)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.EQ.0.0) Q(2,I)=1900.D-16 IF(EN.EQ.0.0) GO TO 30 DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA C USE LOG INTERPOLATION 20 Y1=DLOG(YXSEC(J-1)) Y2=DLOG(YXSEC(J)) X1=DLOG(XEN(J-1)) X2=DLOG(XEN(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) Q(2,I)=DEXP((A*DLOG(EN)+B))*1.0D-16 30 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC V2 BENDING MODE C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 340 DO 310 J=2,NVIB1 IF((EN+EIN(2)).LE.XVIB1(J)) GO TO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(1,I)=(EN+EIN(2))*(A*(EN+EIN(2))+B)/EN QIN(1,I)=QIN(1,I)*APOPV2/(1.0+APOPV2)*1.D-16 340 CONTINUE C C VIBRATION V2 BENDING MODE C QIN(2,I)=0.0 IF(EN.LE.EIN(2)) GO TO 400 DO 350 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 360 350 CONTINUE J=NVIB1 360 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QIN(2,I)=(A*EN+B) QIN(2,I)=QIN(2,I)/(1.0+APOPV2)*1.D-16 400 CONTINUE C C SUPERELASTIC OF VIBRATION V1 SYMMETRIC STRETCH C QIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 440 DO 410 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(3,I)=(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(3,I)=QIN(3,I)*APOPV1/(1.0+APOPV1)*1.D-16 440 CONTINUE C C VIBRATION V1 SYMMETRIC STRETCH C QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 500 DO 450 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 460 450 CONTINUE J=NVIB2 460 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(4,I)=(A*EN+B) QIN(4,I)=QIN(4,I)/(1.0+APOPV1)*1.D-16 500 CONTINUE C C SUPERELASTIC VIBRATION HARMONIC 2V2 BENDING MODE C QIN(5,I)=0.0 IF(EN.EQ.0.0) GO TO 540 DO 510 J=2,NVIB3 IF((EN+EIN(6)).LE.XVIB3(J)) GO TO 520 510 CONTINUE J=NVIB3 520 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(5,I)=(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(5,I)=QIN(5,I)*APOP2V2/(1.0+APOP2V2)*1.D-16 540 CONTINUE C C VIBRATION HARMONIC 2V2 BENDING MODE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 600 DO 550 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 560 550 CONTINUE J=NVIB3 560 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(6,I)=(A*EN+B) QIN(6,I)=QIN(6,I)/(1.0+APOP2V2)*1.D-16 600 CONTINUE C C VIBRATION V3 ASYMMETRIC STRETCH C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 620 610 CONTINUE J=NVIB4 620 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=DSQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.639*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(7,I)=(QIN(7,I)+(A*EN+B))*1.D-16 700 CONTINUE C C SUM OF HARMONICS NV1 C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 740 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 720 710 CONTINUE J=NVIB5 720 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(8,I)=(A*EN+B)*1.D-16 740 CONTINUE C C SUM OF HIGHER HARMONICS (0.512) C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 800 DO 750 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 760 750 CONTINUE J=NVIB6 760 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C C EXCITATION (DISOCIATION) C QIN(10,I)=0.0 IF(EN.LE.EIN(10)) GO TO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 820 810 CONTINUE J=NEXC 820 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(10,I)=(A*EN+B)*1.D-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I)+QIN(10,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(10)) NIN=9 IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 RETURN END SUBROUTINE GAS41(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XEN(62),YXSEC(62),XVIBH(15),YVIBH(15), /XVIB1(15),YVIB1(15),XVIB3(15),YVIB3(15),XEXC(34),YEXC(34), /XION(71),YION(71),XATT(33),YATT(33) CHARACTER*15 NAME C DATA XEN/0.0,.001,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08, /0.09,0.10,0.12,0.14,0.16,0.18,0.20,0.24,0.30,0.35, /0.40,0.50,0.60,0.70,0.80,1.00,1.50,2.00,2.50,3.00, /3.50,4.00,5.00,6.00,7.00,8.00,10.0,12.0,14.0,17.0, /20.0,24.0,28.0,32.0,36.0,40.0,45.0,50.0,60.0,75.0, /100.,150.,200.,300.,500.,700.,1000.,2000.,4000.,10000., /20000.,100000./ C DATA YXSEC/100.,80.0,50.3,43.0,39.0,35.5,33.0,31.0,29.4,27.8, /26.8,25.5,23.5,21.0,18.5,16.0,14.0,10.5,7.20,5.65, /4.25,3.15,2.70,2.70,3.30,4.30,6.20,7.80,9.30,10.4, /11.1,11.3,11.3,10.9,10.5,10.0,9.00,8.50,8.00,7.50, /7.20,6.80,6.50,6.40,6.30,6.20,6.00,5.75,5.05,4.50, /3.75,2.70,1.75,1.00,0.57,0.38,0.24,0.11,0.05,0.02, /0.01,.002/ C C VIBRATION V1 DATA XVIB1/0.110,1.00,1.50,2.00,2.50,3.00,3.50,4.00,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVIB1/0.0,.00001,0.20,0.48,0.72,0.80,0.72,0.48,0.32,0.12, /.0016,.001,.0001,.00001,.000001/ C VIBRATION V3 DATA XVIB3/0.180,1.00,1.50,2.00,2.50,3.00,3.50,4.00,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVIB3/0.0,.00001,0.40,0.96,1.44,1.60,1.44,0.96,0.64,0.24, /.0032,.001,.0001,.00001,.000001/ C VIBRATION HARMONIC (2V1+2V3 AND HIGHER HARMONICS) DATA XVIBH/0.360,1.00,1.50,2.00,2.50,3.00,3.50,4.00,5.00,6.00, /10.0,100.,1000.,10000.,100000./ DATA YVIBH/0.0,.00001,0.21,0.54,0.78,0.90,0.78,0.54,0.36,0.18, /.0024,.001,.0001,.00001,.000001/ C DATA XION/15.56,16.5,17.0,17.5,18.0,18.5,19.0,19.5,20.0,20.5, /21.0,22.0,23.0,24.0,26.0,28.0,30.0,32.0,34.0,36.0, /38.0,40.0,45.0,50.0,55.0,60.0,65.0,70.0,75.0,80.0, /85.0,90.0,95.0,100.,105.,110.,115.,120.,125.,130., /135.,140.,150.,160.,170.,180.,200.,220.,250.,300., /350.,400.,450.,500.,600.,700.,800.,900.,1000.,1200., /1400.,2000.,2500.,3000.,4000.,5000.,6000.,8000.,10000.,20000., /100000./ DATA YION/0.0,0.045,.064,.079,.130,.183,.236,.295,.356,.419, /.493,.645,0.80,0.96,1.26,1.54,1.80,2.03,2.25,2.45, /2.63,2.79,3.15,3.48,3.76,3.99,4.19,4.35,4.48,4.58, /4.67,4.74,4.80,4.84,4.88,4.90,4.92,4.93,4.93,4.93, /4.93,4.92,4.89,4.86,4.81,4.76,4.66,4.54,4.37,4.08, /3.83,3.59,3.38,3.20,2.88,2.62,2.41,2.23,2.07,1.85, /1.66,1.37,1.15,1.02,0.82,0.67,0.58,0.45,0.36,0.21, /.06/ C ATTACHMENT DATA XATT/10.0,10.4,10.5,10.6,10.7,10.8,10.9,11.0,11.1,11.2, /11.3,11.4,11.5,11.6,11.7,11.8,11.9,12.0,12.1,12.2, /12.3,12.4,12.5,12.6,12.7,12.8,12.9,13.0,20.0,100., /1000.,10000.,100000./ DATA YATT/0.00,.0015,.0032,.0046,.0063,.0084,.010,.014,.017,.020, /.022,.024,.025,.025,.023,.021,.018,.015,.012,.0097, /.0069,.0048,.0033,.0022,.0015,.00092,.00061,.00024,.0002,.0001, /.00001,.000001,.0000001/ C DISOCIATION X-SECTION EXCLUDING DISOCIATIVE IONISATION X-SECTION DATA XEXC/10.0,10.1,10.6,11.1,11.6,12.1,12.6,13.1,13.6,14.1, /14.6,15.1,16.2,17.2,18.2,20.2,22.2,24.2,27.2,30.3, /40.0,50.0,100.,200.,300.,400.,500.,600.,1000.,2000., /4000.,10000.,20000.,100000./ DATA YEXC/0.00,0.01,0.11,0.21,0.39,0.58,0.65,0.73,0.82,0.89, /0.97,1.03,1.15,1.24,1.33,1.49,1.61,1.68,1.78,1.82, /1.81,1.83,1.88,1.88,1.70,1.40,1.10,0.88,0.49,0.22, /0.11,0.05,0.03,.008/ C ---------------------------------------------------------------- C --------------------------------------------------------------- NAME=' BF3 -2001--- ' KIN(1)=6 KIN(2)=7 KEL=0 NIN=9 NDATA=62 NVIB1=15 NVIB3=15 NVIBH=15 NION=71 NATT=33 NEXC=34 E(1)=0.0 E(2)=2.0*EMASS/(67.8062*AMU) E(3)=15.56 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.0596 EIN(2)=-0.086 EIN(3)=-0.110 EIN(4)=0.0596 EIN(5)=0.086 EIN(6)=0.110 EIN(7)=0.180 EIN(8)=0.360 EIN(9)=10.0 APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(2)/AKT) APOP3=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GO TO 20 10 CONTINUE J=NDATA 20 A=(YXSEC(J)-YXSEC(J-1))/(XEN(J)-XEN(J-1)) B=(XEN(J-1)*YXSEC(J)-XEN(J)*YXSEC(J-1))/(XEN(J-1)-XEN(J)) Q(2,I)=(A*EN+B)*1.0D-16 Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.D-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 300 IF(EN.GT.XATT(NATT)) GO TO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.D-16 300 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTIC OF VIBRATION V4 C QIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.018*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 305 CONTINUE C C SUPERELASTIC OF VIBRATION V2 QIN(2,I)=0.0 IF(EN.EQ.0.0) GO TO 400 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.045*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(2,I)=QIN(2,I)*APOP2/(1.0+APOP2)*1.D-16 400 CONTINUE C SUPERELASTIC OF VIBRATION V1 QIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 500 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=0.37*DLOG((EFAC+1.0)/(EFAC-1.0))/EN QIN(3,I)=QIN(3,I)*APOP3/(1.0+APOP3)*1.D-16 500 CONTINUE C V4 QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 600 EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.018*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=QIN(4,I)*1.0/(1.0+APOP1)*1.D-16 600 CONTINUE C V2 QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 700 EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.045*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(5,I)=QIN(5,I)*1.0/(1.0+APOP2)*1.D-16 700 CONTINUE C V1 QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 800 DO 710 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 720 710 CONTINUE J=NVIB1 720 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=0.37*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.58 XMT=((1.5-FWD/(FWD+BCK))*QIN(6,I)+RAT4*(A*EN+B))*1.D-16 QIN(6,I)=(QIN(6,I)+(A*EN+B))*1.D-16 PEQIN(1,I)=0.5+(QIN(6,I)-XMT)/QIN(6,I) QIN(6,I)=QIN(6,I)*1.0/(1.0+APOP3) 800 CONTINUE C V3 QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 900 DO 810 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 820 810 CONTINUE J=NVIB3 820 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=DSQRT(1.0-(EIN(7)/EN)) QIN(7,I)=0.74*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(7) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.58 XMT=((1.5-FWD/(FWD+BCK))*QIN(7,I)+RAT4*(A*EN+B))*1.D-16 QIN(7,I)=(QIN(7,I)+(A*EN+B))*1.D-16 PEQIN(2,I)=0.5+(QIN(7,I)-XMT)/QIN(7,I) 900 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 1000 DO 910 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 920 910 CONTINUE J=NVIBH 920 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QIN(8,I)=(A*EN+B)*1.D-16 1000 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 1100 DO 1010 J=2,NEXC IF(EN.LE.XEXC(J)) GO TO 1020 1010 CONTINUE J=NEXC 1020 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QIN(9,I)=(A*EN+B)*1.D-16 1100 CONTINUE C C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS51(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) DIMENSION XENM(30),YXMOM(30),XENT(30),YXTOT(30), /XVIB2(22),YVIB2(22),XVIB3(22),YVIB3(22),XVIB4(22),YVIB4(22), /XVIB5(22),YVIB5(22),XVIB6(22),YVIB6(22), /XDISS(27),YDISS(27),XATT(26),YATT(26),XION(48),YION(48) CHARACTER*15 NAME DATA XENM/1.D-6,0.001,0.01,0.10,1.00,1.50,2.00,3.00,4.00,5.00, /6.00,7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,200.,400.,1000.,10000.,100000./ C ELASTIC MOMENTUM TRANSFER DATA YXMOM/2500.,2500.,1700.,170.,17.0,12.0,10.0,8.60,8.20,8.80, /9.80,10.7,11.4,12.0,12.5,14.5,14.5,13.2,11.5,10.0, /9.20,8.50,7.66,6.66,5.86,3.00,1.50,0.60,0.06,.006/ C ELASTIC DATA XENT/1.D-6,0.001,0.01,0.10,1.00,1.50,2.00,3.00,4.00,5.00, /6.00,7.00,8.00,9.00,10.0,15.0,20.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,200.,400.,1000.,10000.,100000./ C ELASTIC TOTAL DATA YXTOT/2500.,2500.,1700.,170.,17.0,13.0,13.5,14.5,15.5,16.5, /17.5,18.5,19.5,20.0,20.7,23.5,23.5,21.5,19.5,18.5, /17.5,17.0,16.0,15.0,14.5,11.5,9.00,7.00,0.70,0.07/ C VIBRATION V11 (RESONANCE ONLY) DATA XVIB2/0.065,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB2/0.0,0.0,.028,.063,.196,.182,0.14,.126,.182,0.21, /0.21,.175,.063,.028,.014,.007,.0014,.000007,.0000007,.00000007, /.000000007,.0000000007/ C VIBRATION V2 (RESONANCE ONLY) DATA XVIB3/0.1001,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB3/0.0,0.0,.175,.343,1.08,1.04,0.77,0.70,1.02,1.15, /1.13,.959,0.35,.154,.063,.028,.014,.000003,.0000003,.00000003, /.000000003,.0000000003/ C VIBRATION V1 (RESONANCE ONLY) DATA XVIB4/0.1523,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB4/0.0,0.0,.378,.756,2.34,2.24,1.68,1.51,2.23,2.52, /2.49,2.10,0.77,.336,0.14,0.07,.035,.00007,.000007,.0000007, /.00000007,.000000007/ C VIBRATION HARMONIC 2(V1) DATA XVIB5/0.35,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB5/0.0,0.0,.135,0.27,0.84,.795,0.60,0.54,.795,0.90, /.885,0.75,0.27,0.12,.045,0.03,.015,.00015,.000015,.0000015, /.00000015,.000000015/ C VIBRATION HARMONIC (3(V1) + ALL OTHER HARMONICS) DATA XVIB6/0.500,1.00,2.00,3.00,4.00,4.50,5.00,6.00,7.00,8.00, /9.00,10.0,11.0,12.0,13.0,15.0,20.0,50.0,100.,1000., /10000.,100000./ DATA YVIB6/0.0,0.0,0.54,1.08,3.35,3.20,2.40,2.16,3.18,3.60, /3.56,3.00,1.09,0.48,.195,.105,.045,.00015,.000015,.0000015, /.00000015,.000000015/ C DISOCIATION X-SECTION DATA XDISS/11.8,12.0,13.0,14.0,15.0,18.0,20.0,25.0,30.0,40.0, /50.0,60.0,80.0,100.,120.,150.,200.,300.,400.,500., /600.,800.,1000.,2000.,4000.,10000.,100000./ DATA YDISS/0.00,.007,.072,0.40,0.75,1.33,1.61,1.88,2.00,2.25, /2.40,2.50,2.60,2.60,2.60,2.55,2.50,2.40,2.30,2.20, /2.00,1.75,1.48,0.80,0.46,0.21,0.021/ DATA XION/14.48,17.0,18.0,19.0,21.0,23.0,25.0,27.0,29.0,31.0, /33.0,35.0,37.0,39.0,41.0,43.0,45.0,47.0,49.0,51.0, /61.0,71.0,81.0,91.0,101.,126.,151.,176.,201.,251., /301.,351.,401.,451.,501.,601.,701.,801.,901.,1001., /1251.,1501.,1751.,2001.,2501.,3001.,10000.,100000./ DATA YION/0.00,.0889,.211,.375,.782,1.18,1.59,2.11,2.49,2.81, /3.16,3.49,3.86,4.17,4.54,4.85,5.14,5.52,5.77,6.19, /6.82,7.57,7.84,8.17,8.39,8.77,8.75,8.76,8.57,8.17, /7.41,7.13,6.55,6.21,5.89,5.17,4.72,4.40,3.96,3.77, /3.19,2.79,2.44,2.28,1.88,1.67,0.60,0.09/ DATA XATT/2.00,2.25,2.50,2.75,3.00,3.25,3.50,3.75,4.00,4.25, /4.50,4.75,5.00,5.25,5.50,5.75,6.00,6.25,6.50,6.75, /7.00,8.00,10.0,20.0,100.0,100000./ DATA YATT/.0,.0075,.020,.038,.053,.069,.083,.086,.083,.074, /.060,.046,.035,.025,.017,.010,.0068,.004,.0016,.0007, /.0003,.0002,.0001,.00001,.000001,.0000001/ C --------------------------------------------------------------------- C DATA SET USES C2F6 FOR ALL XSECS EXCEPT LOW ENERGY ELASTIC WHICH C IS DOMINATED BY DIPOLE SCATTERING BELOW 1 EV ENRGY . c ABOVE 1EV SMOOTH JOIN TO C2F6 ELASTIC IS USED . C THE LARGEST ERRORS IN SWARM PARAMETERS PROBABLY WILL BE FOR THE C ATTACHMENT WHICH MAY BE VERY SENSITIVE TO DETAILED MOLECULAR C STRUCTURE. C -------------------------------------------------------------------- NAME=' C2HF5/C2H2F4 ' KIN(1)=5 KIN(2)=6 KEL=0 NIN=9 NDATA=30 NETOT=30 NVIB2=22 NVIB3=22 NVIB4=22 NVIB5=22 NVIB6=22 NDISS=27 NATT=26 C RENORMALISE ATTACHMENT X-SECTION ATTNRM=0.05 NION=48 E(1)=0.0 E(2)=2.0*EMASS/(120.*AMU) E(3)=14.48 E(4)=0.0 E(5)=0.0 E(6)=0.0 EIN(1)=-0.065 EIN(2)=-0.1001 EIN(3)=-0.1523 EIN(4)=0.065 EIN(5)=0.1001 EIN(6)=0.1523 EIN(7)=0.35 EIN(8)=0.500 EIN(9)=11.8 APOP1=DEXP(EIN(1)/AKT) APOP2=DEXP(EIN(2)/AKT) APOP3=DEXP(EIN(3)/AKT) EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.EQ.0.0) XMOMT=2500.D-16 IF(EN.EQ.0.0) GO TO 30 DO 10 J=2,NDATA IF(EN.LE.XENM(J)) GO TO 20 10 CONTINUE J=NDATA C USE LOG INTERPOLATION 20 Y1=DLOG(YXMOM(J-1)) Y2=DLOG(YXMOM(J)) X1=DLOG(XENM(J-1)) X2=DLOG(XENM(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) XMOMT=DEXP((A*DLOG(EN)+B))*1.0D-16 30 IF(EN.EQ.0.0) XTOT=2500.D-16 IF(EN.EQ.0.0) GO TO 70 DO 50 J=2,NETOT IF(EN.LE.XENT(J)) GO TO 60 50 CONTINUE J=NETOT 60 Y1=DLOG(YXTOT(J-1)) Y2=DLOG(YXTOT(J)) X1=DLOG(XENT(J-1)) X2=DLOG(XENT(J)) A=(Y2-Y1)/(X2-X1) B=(X1*Y2-X2*Y1)/(X1-X2) XTOT=DEXP((A*DLOG(EN)+B))*1.0D-16 70 CONTINUE Q(2,I)=XTOT PEQEL(I)=0.5+(XTOT-XMOMT)/XTOT IF(KEL.EQ.0) Q(2,I)=XMOMT IF(KEL.EQ.0) PEQEL(I)=0.5 C Q(3,I)=0.0 IF(EN.LT.E(3)) GO TO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GO TO 120 110 CONTINUE J=NION 120 A=(YION(J)-YION(J-1))/(XION(J)-XION(J-1)) B=(XION(J-1)*YION(J)-XION(J)*YION(J-1))/(XION(J-1)-XION(J)) Q(3,I)=(A*EN+B)*1.E-16 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GO TO 250 IF(EN.GT.XATT(NATT)) GO TO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GO TO 220 210 CONTINUE J=NATT 220 A=(YATT(J)-YATT(J-1))/(XATT(J)-XATT(J-1)) B=(XATT(J-1)*YATT(J)-XATT(J)*YATT(J-1))/(XATT(J-1)-XATT(J)) Q(4,I)=(A*EN+B)*1.E-16*ATTNRM 250 Q(5,I)=0.0 Q(6,I)=0.0 C C SUPERELASTICS QIN(1,I)=0.0 QIN(2,I)=0.0 QIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V11 EFAC=DSQRT(1.0-(EIN(1)/EN)) QIN(1,I)=0.0363*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 260 J=2,NVIB2 IF((EN+EIN(4)).LE.XVIB2(J)) GO TO 270 260 CONTINUE J=NVIB2 270 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QIN(1,I)=QIN(1,I)+(EN+EIN(4))*(A*(EN+EIN(4))+B)/EN QIN(1,I)=QIN(1,I)*APOP1/(1.0+APOP1)*1.E-16 C SUPERELASTIC OF VIBRATION V2 EFAC=DSQRT(1.0-(EIN(2)/EN)) QIN(2,I)=0.4230*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 280 J=2,NVIB3 IF((EN+EIN(5)).LE.XVIB3(J)) GO TO 290 280 CONTINUE J=NVIB3 290 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) QIN(2,I)=QIN(2,I)+(EN+EIN(5))*(A*(EN+EIN(5))+B)/EN QIN(2,I)=QIN(2,I)*APOP2/(1.0+APOP2)*1.E-16 C SUPERELASTIC OF VIBRATION V1 EFAC=DSQRT(1.0-(EIN(3)/EN)) QIN(3,I)=1.5000*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 300 J=2,NVIB4 IF((EN+EIN(6)).LE.XVIB4(J))GO TO 301 300 CONTINUE J=NVIB4 301 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QIN(3,I)=QIN(3,I)+(EN+EIN(6))*(A*(EN+EIN(6))+B)/EN QIN(3,I)=QIN(3,I)*APOP3/(1.0+APOP3)*1.E-16 C 305 CONTINUE QIN(4,I)=0.0 IF(EN.LE.EIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=DSQRT(1.0-(EIN(4)/EN)) QIN(4,I)=0.0363*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QIN(4,I)=((A*EN+B)+QIN(4,I))*1.0/(1.0+APOP1)*1.E-16 400 CONTINUE C QIN(5,I)=0.0 IF(EN.LE.EIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=DSQRT(1.0-(EIN(5)/EN)) QIN(5,I)=0.4230*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(5) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM.T /TOT X-SECT FOR RESONANCE PART = RAT3 RAT3=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(5,I)+RAT3*(A*EN+B))*1.0E-16 XMT=XMT/(1.0+APOP2) QIN(5,I)=((A*EN+B)+QIN(5,I))*1.0/(1.0+APOP2)*1.E-16 PEQIN(1,I)=0.5+(QIN(5,I)-XMT)/QIN(5,I) 500 CONTINUE C QIN(6,I)=0.0 IF(EN.LE.EIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=DSQRT(1.0-(EIN(6)/EN)) QIN(6,I)=1.500*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EIN(6) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*DSQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*DSQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.80 XMT=((1.5-FWD/(FWD+BCK))*QIN(6,I)+RAT4*(A*EN+B))*1.0E-16 XMT=XMT/(1.0+APOP3) QIN(6,I)=((A*EN+B)+QIN(6,I))*1.0/(1.0+APOP3)*1.E-16 PEQIN(2,I)=0.5+(QIN(6,I)-XMT)/QIN(6,I) 600 CONTINUE C QIN(7,I)=0.0 IF(EN.LE.EIN(7)) GO TO 700 DO 610 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GO TO 620 610 CONTINUE J=NVIB5 620 A=(YVIB5(J)-YVIB5(J-1))/(XVIB5(J)-XVIB5(J-1)) B=(XVIB5(J-1)*YVIB5(J)-XVIB5(J)*YVIB5(J-1))/(XVIB5(J-1)-XVIB5(J)) QIN(7,I)=(A*EN+B)*1.E-16 700 CONTINUE C QIN(8,I)=0.0 IF(EN.LE.EIN(8)) GO TO 800 DO 710 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GO TO 720 710 CONTINUE J=NVIB6 720 A=(YVIB6(J)-YVIB6(J-1))/(XVIB6(J)-XVIB6(J-1)) B=(XVIB6(J-1)*YVIB6(J)-XVIB6(J)*YVIB6(J-1))/(XVIB6(J-1)-XVIB6(J)) QIN(8,I)=(A*EN+B)*1.E-16 800 CONTINUE C QIN(9,I)=0.0 IF(EN.LE.EIN(9)) GO TO 900 DO 810 J=2,NDISS IF(EN.LE.XDISS(J)) GO TO 820 810 CONTINUE J=NDISS 820 A=(YDISS(J)-YDISS(J-1))/(XDISS(J)-XDISS(J-1)) B=(XDISS(J-1)*YDISS(J)-XDISS(J)*YDISS(J-1))/(XDISS(J-1)-XDISS(J)) QIN(9,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QIN(1,I)+QIN(2,I)+QIN(3,I)+QIN(4,I)+ /QIN(5,I)+QIN(6,I)+QIN(7,I)+QIN(8,I)+QIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EIN(9)) NIN=8 IF(EFINAL.LE.EIN(8)) NIN=7 IF(EFINAL.LE.EIN(7)) NIN=6 IF(EFINAL.LE.EIN(6)) NIN=5 IF(EFINAL.LE.EIN(5)) NIN=4 IF(EFINAL.LE.EIN(4)) NIN=3 IF(EFINAL.LE.EIN(3)) NIN=2 IF(EFINAL.LE.EIN(2)) NIN=1 IF(EFINAL.LE.EIN(1)) NIN=0 RETURN END SUBROUTINE GAS52(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C DUMMY ANISOTROPIC ROUTINE C --------------------------------------------------------------- NAME=' DUMMY ' KEL=0 NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 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) 9000 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS53(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C DUMMY ANISOTROPIC ROUTINE C --------------------------------------------------------------- NAME=' DUMMY ' KEL=0 NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 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) 9000 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS54(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C DUMMY ANISOTROPIC ROUTINE C --------------------------------------------------------------- NAME=' DUMMY ' KEL=0 NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 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) 9000 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS55(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C DUMMY ANISOTROPIC ROUTINE C --------------------------------------------------------------- NAME=' DUMMY ' KEL=0 NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 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) 9000 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS56(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C DUMMY ANISOTROPIC ROUTINE C --------------------------------------------------------------- NAME=' DUMMY ' KEL=0 NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 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) 9000 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS57(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C DUMMY ANISOTROPIC ROUTINE C --------------------------------------------------------------- NAME=' DUMMY ' KEL=0 NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 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) 9000 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS58(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C DUMMY ANISOTROPIC ROUTINE C --------------------------------------------------------------- NAME=' DUMMY ' KEL=0 NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 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) 9000 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS59(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE /,PEQEL,PEQIN,KEL,KIN) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION PEQEL(2002),PEQIN(2,2002),KIN(2) DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME C ---------------------------------------------------------------- C DUMMY ANISOTROPIC ROUTINE C --------------------------------------------------------------- NAME=' DUMMY ' KEL=0 NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 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) 9000 CONTINUE C SAVE COMPUTE TIME RETURN END SUBROUTINE GAS60(Q,QIN,NIN,E,EIN,NAME,VIRIAL,MONTE) IMPLICIT REAL*8 (A-H,O-Z) COMMON/CNSTS/ECHARG,EMASS,AMU,PIR2 COMMON/INPT/NOUT,ITMAX,I2TYPE,NGAS,NSTEP,NSTEP1,CONV,EFINAL,ESTEP, /AKT,ARY,TEMPC,TORR,IDBUG,ISFB,CONALP,ALPNEW,ALPOLD,ALPNAX,ALPNAY, /ALPNAZ,ALPHA,ALPOAX,ALPOAY,ALPOAZ,NITALP,IDLONG,LHIGH DIMENSION Q(6,2002),QIN(20,2002),E(6),EIN(20) CHARACTER*15 NAME NAME=' DUMMY ' C --------------------------------------------------------------------- C DUMMY ROUTINE FOR ISOTROPIC SCATTERING C --------------------------------------------------------------------- NIN=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 EN=-ESTEP IF(MONTE.EQ.1) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 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