+TITLE. MAGBOLTZ 2.03 /00 990901 00.00 C PROGRAM MAGBOLTZ 2 CALCULATES DRIFT AND DIFFUSION IN E AND B FIELDS. C VERSION 3.0 SEPT 1999 C --------------------------------------------------------------------- C PROGRAM USES SAME DATA BASE AS THE BOLTZMANN CALCULATION . C THE PROGRAM IS ONLY LIMITED IN ACCURACY BY THE STATISTICAL PRECISION C OF THE RESULTS IT IS EASY TO OBTAIN A STATISTICAL PRECISION C OF BETTER THAN 0.1% ON THE DRIFT VELOCITY AND 1% ON THE C DIFFUSION COEFICIENTS IN MOST COUNTING GAS MIXTURES IN ABOUT C 10 SECONDS OF COMPUTING TIME ON A PC , ALPHA OR WORKSTATION. C THE STATISTICAL PRECISION VARIES AS THE SQUARE ROOT OF THE COMPUTING C TIME. C THE CODE USES ONLY THE ORIGINAL ELECTRON IN THE IONISATION COLLISIONS C AND THEREFORE SHOULD ONLY BE COMPARED WITH THE BOLTZMANN CODE WITH C NALPHA=0. C THE MONTE CARLO FOR THE CASE WHERE THE GENERATED IONISATION ELECTRONS C ARE INCLUDED CAN BE OBTAINED FROM THE AUTHOR. (SFB@HEP.PH.LIV.AC.UK) C---------------------------------------------------------------------- C IHE MAGNETIC FIELD CAN BE AT ANY ANGLE WITH RESPECT TO THE ELECTRIC C FIELD. C THE PROGRAM ALLOWS ANISOTROPIC ELASTIC AND INELASTIC SCATTERING : C REF : NIM A 421 (1999) 234-240 C THE GAS DATA BASE LIST BELOW SHOWS THOSE X-SECTIONS WHICH CONTAIN C ANISOTROPIC SCATTERING DATA. C-------------------------------------------------------------------- C GEOMETRY: C-------------- C THE ELECTRIC FIELD IS TAKEN ALONG THE Z-AXIS AND THE C MAGNETIC FIELD IS TAKEN IN THE Z-X PLANE AT AN ANGLE, BTHETA , C TO THE ELECTRIC FIELD. C C THE RESULTS OF THE CALCULATION ARE LOADED INTO COMMON BLOCKS: C COMMON/VEL/WX,WY,WZ C COMMON/DIFLAB/DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ C COMMON/DIFVEL/DIFLN,DIFTR C C WX,WY,WZ ARE THE DRIFT VELOCITY VECTORS C DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ ARE THE VALUES OF THE DIFFUSION C TENSOR IN THE CARTESIAN COORDINATE SYSTEM. C ------------------------------- C NOTE : OFF-DIAGONAL ELEMENTS ARE DEFINED SO THAT THE COEFFICIENTS C ARE EQUAL : DIFXY=DIFYX , DIFXZ=DIFZX AND DIFYZ=DIFZY . C ----------------------------- C DIFLN,DIFTR,DIFXX ARE THE DIFFUSION COEFFICIENTS IN THE COORDINATE C SYSTEM ALIGNED ALONG THE DRIFT DIRECTION (IT IS ONLY CALCULATED C FOR THE CASE WHERE THE MAGNETIC FIELD IS AT 90 DEGREES TO EFIELD). C IF THERE IS NO MAGNETIC FIELD THE VALUES DIFLN AND DIFTR C REPRESENT THE LONGITUDINAL AND TRANSVERSE DIFFUSION. C C OUTPUT UNITS IN ARRAYS : VELOCITY :CM/SEC C DIFFUSION: CM**2/SEC C C--------------------------- C INPUT CARDS : C---------------------------------------------------------- C FIRST CARD: 2I10,F10.5 : NGAS,NMAX,EFINAL C NGAS: NUMBER OF GASES IN MIXTURE C NMAX: NUMBER OF REAL AND NULL COLLISIONS (MULTIPLE OF 960000 ) C USE NMAX =BETWEEN 1 OR 2 FOR INELASTIC GAS TO OBTAIN 1% ACCURACY C NAMX = ABOVE 10 FOR BETTER THAN 0.5% ACCURACY. C NMAX = AT LEAST 10 FOR PURE ELASTIC GASES LIKE ARGON C EFINAL= UPPER LIMIT OF THE ELECTRON ENERGY IN ELECTRON VOLTS. C EFINAL= 0.0 (PROGRAM AUTOMATICALLY CALCULATES UPPER INTEGRATION C ENERGY LIMIT) C------------------------------------------------------------- C SECOND CARD : 4I5 : NGAS1 , NGAS2, NGAS3 , NGAS4 C NGAS1,ETC : GAS NUMBER IDENTIFIERS (BETWEEN 1 AND 28) C SEE GAS LIST BELOW FOR IDENTIFYING NUMBERS. C 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 : 6F10.3 : EFIELD,BMAG,BTHETA C EFIELD : ELECTRIC FIELD IN VOLTS/ CM. C BMAG : MAGNITUDE OF THE MAGNETIC FIELD IN KILOGAUSS C BTHETA : ANGLE BETWEEN THE ELECTRIC AND MAGNETIC FIELDS IN DEGREES. C----------------------------------------------------------------------- C CARD 4*N+1 USES NGAS=0 TO TERMINATE CORRECTLY C-------------------------------------------------------------------- C DATA BASE: C C GAS NUMBER: C----------------------------------------------------------------- C GAS1 : CF4 (1998) (ANISOTROPIC SCATTERING ONLY) 1 C GAS2 : ARGON (1997) 2 C GAS3 : HELIUM 4 (1997) 3 C GAS4 : HELIUM 3 (1992) 4 C GAS5 : NEON (1992) 5 C GAS6 : KRYPTON (1989) 6 C GAS7 : XENON (1989) 7 C GAS8 : METHANE (1994) 8 C GAS9 : ETHANE (1995) 9 C GAS10 : PROPANE (1995) 10 C GAS11 : ISOBUTANE (1995) 11 C GAS12 : CO2 (1997) 12 C GAS13 : NEO-PENTANE (1995) C(CH3)4 13 C GAS14 : H20 (1998) 14 C GAS15 : OXYGEN (1990) 3-BODY ATTACHMENT INCLUDED 15 C GAS16 : NITROGEN - PITCHFORD AND POHELPS N2MOD 16 C GAS17 : NITRIC OXIDE (1995) ATTACHING GAS 17 C GAS18 : NITROUS OXIDE (1995) ATTACHING GAS 18 C GAS19 : ETHENE (1992) C2H4 19 C GAS20 : ACETYLENE (1992) C2H2 20 C GAS21 : HYDROGEN (1998) 21 C GAS22 : DEUTERIUM (1998) 22 C GAS23 : CARBON MONOXIDE (1998) 23 C GAS24 : METHYLAL (1988) 24 C GAS25 : DME (1998) 25 C GAS26 : REID STEP MODEL (ANISOTROPIC VERSION) 26 C GAS27 : MAXWELL MODEL 27 C GAS28 : REID RAMP MODEL 28 C GAS29 : HEXAFLUOROETHANE ('99) (ANISOTROPIC ) 29 C GAS30 : ?????????????????????? 30 C------------------------------------------------------------------ +PATCH,*MAGGARF. Pilot patch +USE,MAGCOM. +USE,MAGINTER. +USE,MAGBOL1. +USE,MAGBOL2. +USE,MAGGAS. +PATCH,MAGCOM. Common blocks +KEEP,MAGBDATA. *----------------------------------------------------------------------- * Commons - Set of common blocks used by Magboltz 2, contains general * purpose parameters such as pressure, temperature, E and * B field. * Author - Steve Biagi * (Last changed on 26/ 9/99.) *----------------------------------------------------------------------- INTEGER MXNGAS,MXGLEV PARAMETER(MXNGAS=4) PARAMETER(MXGLEV=64) DOUBLE PRECISION EOVB,WB,BTHETA,BMAG COMMON /BFLD/ EOVB,WB,BTHETA,BMAG DOUBLE PRECISION CONV,EFINAL,ESTEP,AKT,TEMPC,TORR,CONALP, - ALPNEW,ALPOLD,ALPNAX,ALPNAY,ALPNAZ,ALPHA, - ALPOAX,ALPOAY,ALPOAZ INTEGER NOUT,ITMAX,I2TYPE,NGASES,NSTEP,NSTEP1,IDBUG,ISFB, - NITALP,IDLONG,LHIGH COMMON /INPT/ CONV,EFINAL,ESTEP,AKT,TEMPC,TORR,CONALP, - ALPNEW,ALPOLD,ALPNAX,ALPNAY,ALPNAZ,ALPHA, - ALPOAX,ALPOAY,ALPOAZ, - NOUT,ITMAX,I2TYPE,NGASES,NSTEP,NSTEP1,IDBUG,ISFB, - NITALP,IDLONG,LHIGH INTEGER IGAS COMMON /GASN/ IGAS(MXNGAS) DOUBLE PRECISION TMAX,SMALL,ESTART,THETA,PHI,TCFMAX, - RSTART,EMAG INTEGER NMAX COMMON /SETP/ TMAX,SMALL,ESTART,THETA,PHI,TCFMAX(10),RSTART, - EMAG,NMAX DOUBLE PRECISION TIME,SPEC,TMAX1,AVE,XID,X,Y,Z,ST INTEGER ICOLL,NNULL COMMON /OUTPT/ TIME(300),SPEC(2000),TMAX1, - AVE,XID,X,Y,Z,ST,ICOLL(20),NNULL DOUBLE PRECISION WX,WY,WZ COMMON /VEL/ WX,WY,WZ DOUBLE PRECISION DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ COMMON /DIFLAB/ DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ DOUBLE PRECISION DIFLN,DIFTR COMMON /DIFVEL/ DIFLN,DIFTR DOUBLE PRECISION AN,FRAC,VAN COMMON /RATIO/ AN(MXNGAS),FRAC(MXNGAS),VAN(MXNGAS) DOUBLE PRECISION QELM,QSUM,QION,QIN,QSATT COMMON /MIX1/ QELM(2002),QSUM(2002),QION(MXNGAS,2002), - QIN(MXNGAS,20,2002),QSATT(2002) DOUBLE PRECISION ES,EROOT,QTOT,QREL,QINEL,QEL COMMON /MIX2/ ES(2002),EROOT(2002),QTOT(2002),QREL(2002), - QINEL(2002),QEL(2002) DOUBLE PRECISION ALION,ALIN INTEGER NIN,LION,LIN COMMON /MIX3/ ALION(MXNGAS),ALIN(MXNGAS,20), - NIN(MXNGAS),LION(MXNGAS),LIN(MXNGAS,20) DOUBLE PRECISION CF,EIN,TCF,RGAS INTEGER IPN,IPLAST,IARRY COMMON /LARGE/ CF(2000,MXGLEV),EIN(MXGLEV),TCF(2000), - IARRY(MXGLEV),RGAS(MXGLEV),IPN(MXGLEV),IPLAST DOUBLE PRECISION PEL,PIN INTEGER KEL,INDKIN,NISO,KIN COMMON /ANIS/ PEL(MXNGAS,2002),PIN(2*MXNGAS,2002),KEL(MXNGAS), - KIN(MXNGAS,2),INDKIN(MXGLEV),NISO CHARACTER*15 NAME COMMON /CNAMES/ NAME(MXNGAS) *** Error integral. DOUBLE PRECISION ERFINT,CON INTEGER ITHRM COMMON /THRM/ ERFINT(25),CON,ITHRM *** Integration vector. DOUBLE PRECISION SIMF COMMON /SINT/ SIMF(2002) *** Magboltz 1 commons. DOUBLE PRECISION QEF,DENOM,COD2,SOD2,SCD,SOD, - QEEEF,QEEF,QFEMAG,EF,QE COMMON /MAG/ QEF(2002),DENOM(2002),COD2(2002),SOD2(2002), - SCD(2002),SOD(2002),QEEEF(2002), - QEEF(2002),QFEMAG(2002),EF(2002),QE(2002) +KEEP,MAGBDIST. *----------------------------------------------------------------------- * Commons - Magboltz 1 distribution functions. * Author - Steve Biagi * (Last changed on 26/ 9/99.) *----------------------------------------------------------------------- DOUBLE PRECISION F,DF,DF0 COMMON /F0C/ F(2002),DF(2002),DF0(2002) DOUBLE PRECISION F1,DF1 COMMON /F1C/ F1(2002),DF1(2002) DOUBLE PRECISION F2,DF2 COMMON /FF2COM/ F2(2002),DF2(2003) DOUBLE PRECISION F3,DF3 COMMON /F3C/ F3(2002),DF3(2002) DOUBLE PRECISION G,DG,DG0 COMMON /G0C/ G(2002),DG(2002),DG0(2002) DOUBLE PRECISION G1,DG1 COMMON /G1C/ G1(2002),DG1(2002) DOUBLE PRECISION G2,DG2 COMMON /G2C/ G2(2002),DG2(2002) DOUBLE PRECISION H1,DH1 COMMON /H1C/ H1(2002),DH1(2002) +KEEP,MAGBPARM. *----------------------------------------------------------------------- * MAGPAR - Interface parameters for gas mixing with Magboltz. * (Last changed on 5/ 2/00.) *----------------------------------------------------------------------- INTEGER MXGNAM PARAMETER(MXGNAM=126) DOUBLE PRECISION FRAMIX LOGICAL LF0PLT,LCALIB,LIONIS(MXGNAM) INTEGER KTDIFF,KLDIFF COMMON /MAGPAR/ FRAMIX(MXGNAM),LIONIS,KTDIFF,KLDIFF,LF0PLT,LCALIB +KEEP,MAGBCONS. *----------------------------------------------------------------------- * const - Physical constants (1987 update of Taylor + Cohen, * BOLTZ from 1988 update) * (Last changed on 26/ 9/99.) *----------------------------------------------------------------------- DOUBLE PRECISION ECHARG,EMASS,AMU,PIR2,ATMOS,AWB,BOLTZ,BOLTZJ, - ABZERO,ALOSCH,CONST1,CONST2,CONST3,CONST4,CONST5,EOVM,PI,ARY PARAMETER(PIR2=8.79735669D-17) PARAMETER(ECHARG=1.60217733D-19) PARAMETER(EMASS=9.1093897D-31) PARAMETER(AMU=1.6605402D-27) PARAMETER(BOLTZ=8.617343D-5) PARAMETER(BOLTZJ=1.380658D-23) PARAMETER(AWB=1.75881962D10) PARAMETER(ALOSCH=2.686763D19) PARAMETER(ABZERO=273.15D0) PARAMETER(ATMOS=760.0D0) PARAMETER(CONST1=AWB/2.0*1.0D-19) PARAMETER(CONST2=CONST1*1.0D-02) PARAMETER(PI=3.141592653589793238462643383279502884197D0) PARAMETER(ARY=13.6056981D0) COMMON /CNSTS/ EOVM,CONST3,CONST4,CONST5 +KEEP,MAGBCROS. *----------------------------------------------------------------------- * MAGCRS - Cross section data. * (Last changed on 3/10/99.) *----------------------------------------------------------------------- DOUBLE PRECISION Q,EG,EI COMMON /MAGCRS/ Q(MXNGAS,6,2002),EG(MXNGAS,6),EI(MXNGAS,20) +PATCH,MAGINTER. +DECK,GASBMC. SUBROUTINE GASBMC(IFAIL) *----------------------------------------------------------------------- * GASBMC - Interface routine for Magboltz 2 called from Garfield. * (Last changed on 21/ 2/01.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,GASDATA. +SEQ,BFIELD. +SEQ,PRINTPLOT. +SEQ,GLOBALS. +SEQ,MATDATA. +SEQ,MAGBPARM. +SEQ,CONSTANTS. DOUBLE PRECISION FRTOT REAL AUX,EPMIN,EPMAX,EPMINR,EPMAXR,ACRIT,ACRITR, - BANGMN,BANGMX,BAMINR,BAMAXR,BTABMN,BTABMX,BTMINR,BTMAXR, - VAR(MXVAR),RES(1),EFLDR,BFLDR,ANGR INTEGER INPTYP,INPCMP,MODVAR(MXVAR),MODRES(1),NCMOB,KHIGH,ISLOT, - KITALP,I,J,K,IFAIL,IFAIL1,IFAIL2,INEXT,NGASR,NBANGR,NBTABR, - KHIGHR,NWORD,NCOUT,NRES,NC,IENTRY,NNMAX,NMAXR,IGLB,NCSTR, - MATSLT LOGICAL EPLOG,USE(MXVAR),SWITCH,OK,MC,ESET,BSET,ASET CHARACTER*(MXCHAR) STRING CHARACTER*500 STR CHARACTER*20 OUTSTR CHARACTER*10 VARLIS(MXVAR) EXTERNAL INPTYP,INPCMP,MATSLT *** Identify. IF(LIDENT)PRINT *,' /// ROUTINE GASBMC ///' PRINT *,' ------ GASBMC MESSAGE : Calling interfaced Magboltz'// - ' version 2.2, last changed on 29/5/00.' *** Initial values for the E/p scale. EPMIN=100.0/PGAS EPMAX=100000.0/PGAS EPLOG=.TRUE. NGAS=20 ESET=.FALSE. * E-B angles. IF(MAGOK)THEN BANGMN=0 BANGMX=PI/2 NBANG=4 ELSE BANGMN=PI/2 BANGMX=PI/2 NBANG=1 ENDIF ASET=.FALSE. * B field magnitude. IF(MAGOK)THEN IF(ABS((BFMIN-BFMAX)*BSCALE).LT.0.0001)THEN BTABMN=BFMIN*BSCALE BTABMX=BFMAX*BSCALE NBTAB=1 ELSE BTABMN=BFMIN*BSCALE BTABMX=BFMAX*BSCALE NBTAB=6 ENDIF ELSE BTABMN=0 BTABMX=0 NBTAB=1 ENDIF BSET=.FALSE. * Plotting distribution functions. LF0PLT=.FALSE. * Mobility. VARLIS(1)='EP' NCMOB=0 * Analytic accuracy parameters, KHIGH=2 KITALP=0 SWITCH=.TRUE. ACRIT=50.0/PGAS KTDIFF=1 KLDIFF=3 * MC accuracy parameters. NNMAX=10 * Version MC=.TRUE. *** Prepare for progress printing. CALL PROINT('MAGBOLTZ',1,6) *** Preset failure flag to 0: success. IFAIL=0 *** Preset the gas mixture fractions. DO 20 I=1,MXGNAM FRAMIX(I)=0.0 LIONIS(I)=.TRUE. 20 CONTINUE *** Read the command line. CALL PROFLD(1,'Reading command',-1.0) CALL PROSTA(1,0.0) CALL INPNUM(NWORD) INEXT=2 * Control of whether to proceed. OK=.TRUE. DO 100 I=2,NWORD IF(I.LT.INEXT)GOTO 100 *** Fractions, CF4 (current data). IF(INPCMP(I,'CF4')+INPCMP(I,'FREON-#14')+ - INPCMP(I,'TETRAFLUOROMETHANE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(1)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Argon (current data). ELSEIF(INPCMP(I,'AR#GON').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(2)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Helium 4 (current data). ELSEIF(INPCMP(I,'HE#LIUM-#4').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(3)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Helium 3 (current data). ELSEIF(INPCMP(I,'HE#LIUM-3').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(4)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Neon (current data). ELSEIF(INPCMP(I,'NEON').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(5)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF IF(INPCMP(I+2,'ION#ISATION').NE.0)THEN LIONIS(5)=.TRUE. INEXT=I+3 ELSEIF(INPCMP(I+2,'NOION#ISATION').NE.0)THEN LIONIS(5)=.FALSE. INEXT=I+3 ELSE INEXT=I+2 ENDIF * Krypton (current data). ELSEIF(INPCMP(I,'KR#YPTON').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(6)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Xenon (current data). ELSEIF(INPCMP(I,'XE#NON').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(7)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methane (current data). ELSEIF(INPCMP(I,'METHANE')+INPCMP(I,'CH4').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(8)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethane (current data). ELSEIF(INPCMP(I,'ETHANE')+INPCMP(I,'C2H6').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(9)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Propane (current data). ELSEIF(INPCMP(I,'PROPANE')+INPCMP(I,'C3H8').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(10)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Cyclopropane. ELSEIF(INPCMP(I,'C#YCLO-PROPA#NE')+ - INPCMP(I,'C#YCLO-C3H6').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(33)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Propene (current data). ELSEIF(INPCMP(I,'PROPE#NE')+INPCMP(I,'C3H6').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(32)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Isobutane (current data). ELSEIF(INPCMP(I,'ISO#BUTANE')+INPCMP(I,'C4H10').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(11)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CO2 (current, modified Nakamura). ELSEIF(INPCMP(I,'CO2')+ - INPCMP(I,'CARB#ON-DIOX#IDE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(12)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF IF(INPCMP(I+2,'ION#ISATION').NE.0)THEN LIONIS(12)=.TRUE. INEXT=I+3 ELSEIF(INPCMP(I+2,'NOION#ISATION').NE.0)THEN LIONIS(12)=.FALSE. INEXT=I+3 ELSE INEXT=I+2 ENDIF * Neopentane (current data) ELSEIF(INPCMP(I,'NEOPE#NTANE')+INPCMP(I,'C5H12').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(13)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Water (current data). ELSEIF(INPCMP(I,'WA#TER')+INPCMP(I,'H2O').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(14)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Oxygen (current data). ELSEIF(INPCMP(I,'OX#YGEN')+INPCMP(I,'O2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(15)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitrogen (current data). ELSEIF(INPCMP(I,'NI#TROGEN')+INPCMP(I,'N2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(16)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitrogen (alternative data, ex-Nitrogen-B). ELSEIF(INPCMP(I,'NI#TROGEN-A')+INPCMP(I,'N2-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(105)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitrogen (old data). ELSEIF(INPCMP(I,'NI#TROGEN-B')+INPCMP(I,'N2-B').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(122)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitric oxide (NO, current data). ELSEIF(INPCMP(I,'NITRI#C-OX#IDE')+INPCMP(I,'NO').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(17)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Nitrous oxide (N2O, current data). ELSEIF(INPCMP(I,'NITRO#US-OX#IDE')+INPCMP(I,'N2O').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(18)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethene (C2H4, current data). ELSEIF(INPCMP(I,'ETHE#NE')+INPCMP(I,'C2H4').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(19)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethene (C2H4, old data). ELSEIF(INPCMP(I,'ETHE#NE-A')+INPCMP(I,'C2H4-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(123)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Acetylene (C2H2, current data). ELSEIF(INPCMP(I,'ACETYL#ENE')+INPCMP(I,'C2H2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(20)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Hydrogen (current data, former set B). ELSEIF(INPCMP(I,'HYDROGEN')+INPCMP(I,'H2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(21)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Deuterium (current data). ELSEIF(INPCMP(I,'DEUTERIUM')+INPCMP(I,'D2').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(22)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Carbon monoxyde (CO, current data). ELSEIF(INPCMP(I,'CO')+ - INPCMP(I,'CARB#ON-MONOX#IDE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(23)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methylal hot (dimethoxymethane, CH3-O-CH2-O-CH3, current data). ELSEIF(INPCMP(I,'METHY#LAL-#HOT')+ - INPCMP(I,'DMM-#HOT')+ - INPCMP(I,'C3H8O2-#HOT').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(24)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * DME (current data). ELSEIF(INPCMP(I,'DME').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(25)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Reid step. ELSEIF(INPCMP(I,'REID-STEP').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(26)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Maxwell model. ELSEIF(INPCMP(I,'MAXWELL').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(27)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Reid ramp. ELSEIF(INPCMP(I,'REID-RAMP').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(28)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * C2F6 (current data). ELSEIF(INPCMP(I,'C2F6')+INPCMP(I,'FREON-116')+ - INPCMP(I,'ZYRON-116-#N5')+ - INPCMP(I,'HEXAFLUOROETHANE').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(29)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * SF6 (current data). ELSEIF(INPCMP(I,'SF6').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(30)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * NH3 (current data). ELSEIF(INPCMP(I,'NH3').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(31)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methanol. ELSEIF(INPCMP(I,'METHANOL').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(34)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethanol. ELSEIF(INPCMP(I,'ETHANOL').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(35)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Propanol. ELSEIF(INPCMP(I,'PROPANOL')+INPCMP(I,'2-PROP#ANOL')+ - INPCMP(I,'ISOPROPYL-#ALCOHOL').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(36)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Argon (old data). ELSEIF(INPCMP(I,'AR#GON-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(101)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methane (old data). ELSEIF(INPCMP(I,'METHANE-A')+INPCMP(I,'CH4-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(102)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methane (old data). ELSEIF(INPCMP(I,'METHANE-B')+INPCMP(I,'CH4-B').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(103)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methane (old data). ELSEIF(INPCMP(I,'METHANE-C')+INPCMP(I,'CH4-C').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(104)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CO2 (old data). ELSEIF(INPCMP(I,'CO2-A')+ - INPCMP(I,'CARB#ON-DIOX#IDE-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(106)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CO2 (alternative data, pure Nakamura). ELSEIF(INPCMP(I,'CO2-NAKA#MURA')+ - INPCMP(I,'CARB#ON-DIOX#IDE-NAKA#MURA').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(107)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Neon (old data). ELSEIF(INPCMP(I,'NEON-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(108)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Xenon (old data). ELSEIF(INPCMP(I,'XENON-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(109)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethane (old data). ELSEIF(INPCMP(I,'ETHA#NE-A')+INPCMP(I,'C2H6-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(110)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Ethane (old data). ELSEIF(INPCMP(I,'ETHA#NE-B')+INPCMP(I,'C2H6-B').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(124)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Isobutane (old data). ELSEIF(INPCMP(I,'ISO#BUTANE-A')+ - INPCMP(I,'C4H10-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(111)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Isobutane (old data). ELSEIF(INPCMP(I,'ISO#BUTANE-B')+ - INPCMP(I,'C4H10-B').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(112)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Isobutane (old data). ELSEIF(INPCMP(I,'ISO#BUTANE-C')+ - INPCMP(I,'C4H10-C').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(126)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Methylal cold (dimethoxymethane, CH3-O-CH2-O-CH3). ELSEIF(INPCMP(I,'METHY#LAL-C#OLD')+ - INPCMP(I,'DMM-C#OLD')+ - INPCMP(I,'C3H8O2-C#OLD').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(113)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Propane (old data). ELSEIF(INPCMP(I,'PROPA#NE-A')+INPCMP(I,'C3H8-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(114)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Propane (old data). ELSEIF(INPCMP(I,'PROPA#NE-B')+INPCMP(I,'C3H8-B').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(125)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Neopentane (old data) ELSEIF(INPCMP(I,'NEOPE#NTANE-A')+ - INPCMP(I,'C5H12-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(115)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CF4 (old data) ELSEIF(INPCMP(I,'CF4-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(116)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CF4 (old data) ELSEIF(INPCMP(I,'CF4-B').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(117)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * CF4 (1998 data) ELSEIF(INPCMP(I,'CF4-C').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(121)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * DME (old data). ELSEIF(INPCMP(I,'DME-A').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(118)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * DME (old data). ELSEIF(INPCMP(I,'DME-B').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(119)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * DME (old data). ELSEIF(INPCMP(I,'DME-C').NE.0)THEN IF(INPTYP(I+1).NE.1.AND.INPTYP(I+1).NE.2.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing.') OK=.FALSE. ELSE CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,AUX,0.0) FRAMIX(120)=AUX IF(IFAIL1.NE.0)OK=.FALSE. ENDIF INEXT=I+2 * Range of E/p. ELSEIF(INPCMP(I,'E/P-RAN#GE').NE.0)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPCHK(I+2,2,IFAIL2) IF(IFAIL1.EQ.0.AND.IFAIL2.EQ.0.AND.NWORD.GE.I+2)THEN CALL INPRDR(I+1,EPMINR,EPMIN) CALL INPRDR(I+2,EPMAXR,EPMAX) IF(EPMINR.NE.EPMAXR.AND.EPMINR.GT.0.0.AND. - EPMAXR.GT.0.0)THEN EPMIN=MIN(EPMINR,EPMAXR) EPMAX=MAX(EPMINR,EPMAXR) ELSE CALL INPMSG(I+1,'Zero range and negative values') CALL INPMSG(I+2,'are not permitted in RANGE. ') OK=.FALSE. ENDIF ELSE CALL INPMSG(I,'Missing or invalid arguments. ') OK=.FALSE. ENDIF ESET=.FALSE. INEXT=I+3 * Listed E/p values. ELSEIF(INPCMP(I,'E/P').NE.0)THEN IF(INPTYP(I+1).EQ.0)THEN CALL INPSTR(I+1,I+1,STRING,NCSTR) DO 250 IGLB=1,NGLB IF(STRING(1:NCSTR).EQ.GLBVAR(IGLB))THEN IF(GLBMOD(IGLB).NE.5)THEN CALL INPMSG(I+1,'Not of type Matrix.') OK=.FALSE. ELSEIF(MLEN(NINT(GLBVAL(IGLB))).GT.MXLIST)THEN CALL INPMSG(I+1,'More than MXLIST elements.') OK=.FALSE. ELSE ISLOT=MATSLT(NINT(GLBVAL(IGLB))) IF(ISLOT.LE.0)THEN CALL INPMSG(I+1,'Matrix inaccessible.') OK=.FALSE. GOTO 260 ENDIF NGAS=MLEN(ISLOT) DO 270 J=1,NGAS IF(MVEC(MORG(ISLOT)+J).LE.0)THEN CALL INPMSG(I+1,'Contains values <= 0.') OK=.FALSE. GOTO 260 ELSE EGAS(J)=MVEC(MORG(ISLOT)+J) ENDIF 270 CONTINUE ESET=.TRUE. ENDIF GOTO 260 ENDIF 250 CONTINUE CALL INPMSG(I+1,'Not a global variable.') OK=.FALSE. 260 CONTINUE INEXT=I+2 ELSEIF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN NGAS=0 DO 280 J=I+1,NWORD IF(INPTYP(J).NE.1.AND.INPTYP(J).NE.2)THEN INEXT=J GOTO 290 ELSEIF(NGAS+1.GT.MXLIST)THEN CALL INPMSG(J,'Too many values, ignored.') OK=.FALSE. GOTO 280 ENDIF CALL INPCHK(J,2,IFAIL1) IF(IFAIL1.EQ.0)THEN CALL INPRDR(J,EFLDR,0.0) IF(EFLDR.GT.0.0)THEN NGAS=NGAS+1 EGAS(NGAS)=EFLDR ELSE CALL INPMSG(J,'Not strictly positive.') OK=.FALSE. ENDIF ELSE CALL INPMSG(J,'Invalid field value.') OK=.FALSE. ENDIF 280 CONTINUE INEXT=NWORD+1 290 CONTINUE ESET=.TRUE. ELSE CALL INPMSG(I,'Invalid field specification.') OK=.FALSE. INEXT=I+2 ENDIF * Range of E. ELSEIF(INPCMP(I,'E#LECTRIC-RAN#GE')+ - INPCMP(I,'E#LECTRIC-F#IELD-RAN#GE').NE.0)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPCHK(I+2,2,IFAIL2) IF(IFAIL1.EQ.0.AND.IFAIL2.EQ.0.AND.NWORD.GE.I+2)THEN CALL INPRDR(I+1,EPMINR,EPMIN*PGAS) CALL INPRDR(I+2,EPMAXR,EPMAX*PGAS) IF(EPMINR.NE.EPMAXR.AND.EPMINR.GT.0.0.AND. - EPMAXR.GT.0.0)THEN EPMIN=MIN(EPMINR,EPMAXR)/PGAS EPMAX=MAX(EPMINR,EPMAXR)/PGAS ELSE CALL INPMSG(I+1,'Zero range and negative values') CALL INPMSG(I+2,'are not permitted in RANGE. ') OK=.FALSE. ENDIF ELSE CALL INPMSG(I,'Missing or invalid arguments. ') OK=.FALSE. ENDIF ESET=.FALSE. INEXT=I+3 * Listed values of E. ELSEIF(INPCMP(I,'E-FIELD').NE.0)THEN IF(INPTYP(I+1).EQ.0)THEN CALL INPSTR(I+1,I+1,STRING,NCSTR) DO 200 IGLB=1,NGLB IF(STRING(1:NCSTR).EQ.GLBVAR(IGLB))THEN IF(GLBMOD(IGLB).NE.5)THEN CALL INPMSG(I+1,'Not of type Matrix.') OK=.FALSE. ELSEIF(MLEN(NINT(GLBVAL(IGLB))).GT.MXLIST)THEN CALL INPMSG(I+1,'More than MXLIST elements.') OK=.FALSE. ELSE ISLOT=MATSLT(NINT(GLBVAL(IGLB))) IF(ISLOT.LE.0)THEN CALL INPMSG(I+1,'Matrix inaccessible.') OK=.FALSE. GOTO 210 ENDIF NGAS=MLEN(ISLOT) DO 220 J=1,NGAS IF(MVEC(MORG(ISLOT)+J).LE.0)THEN CALL INPMSG(I+1,'Contains values <= 0.') OK=.FALSE. GOTO 210 ELSE EGAS(J)=MVEC(MORG(ISLOT)+J)/PGAS ENDIF 220 CONTINUE ESET=.TRUE. ENDIF GOTO 210 ENDIF 200 CONTINUE CALL INPMSG(I+1,'Not a global variable.') OK=.FALSE. 210 CONTINUE INEXT=I+2 ELSEIF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN NGAS=0 DO 230 J=I+1,NWORD IF(INPTYP(J).NE.1.AND.INPTYP(J).NE.2)THEN INEXT=J GOTO 240 ELSEIF(NGAS+1.GT.MXLIST)THEN CALL INPMSG(J,'Too many values, ignored.') OK=.FALSE. GOTO 230 ENDIF CALL INPCHK(J,2,IFAIL1) IF(IFAIL1.EQ.0)THEN CALL INPRDR(J,EFLDR,0.0) IF(EFLDR.GT.0.0)THEN NGAS=NGAS+1 EGAS(NGAS)=EFLDR/PGAS ELSE CALL INPMSG(J,'Not strictly positive.') OK=.FALSE. ENDIF ELSE CALL INPMSG(J,'Invalid field value.') OK=.FALSE. ENDIF 230 CONTINUE INEXT=NWORD+1 240 CONTINUE ESET=.TRUE. ELSE CALL INPMSG(I,'Invalid field specification.') OK=.FALSE. INEXT=I+2 ENDIF * Plot distribution functions. ELSEIF(INPCMP(I,'PL#OT-DIST#RIBUTION-#FUNCTIONS').NE.0)THEN LF0PLT=.TRUE. ELSEIF(INPCMP(I,'NOPL#OT-DIST#RIBUTION-#FUNCTIONS').NE.0)THEN LF0PLT=.FALSE. * Kind of E/p scale. ELSEIF(INPCMP(I,'LIN#EAR-#E/P-#SCALE')+ - INPCMP(I,'LIN#EAR-#ELECTRIC-#SCALE')+ - INPCMP(I,'LIN#EAR-#ELECTRIC-#FIELD-#SCALE').NE.0)THEN EPLOG=.FALSE. ESET=.FALSE. ELSEIF(INPCMP(I,'LOG#ARITHMIC-#E/P-#SCALE')+ - INPCMP(I,'LOG#ARITHMIC-#ELECTRIC-#SCALE')+ - INPCMP(I,'LOG#ARITHMIC-#ELECTRIC-#FIELD-#SCALE').NE.0)THEN EPLOG=.TRUE. ESET=.FALSE. * Number of points. ELSEIF(INPCMP(I,'N-E#/P')+ - INPCMP(I,'N-E#LECTRIC-#FIELD').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) IF(IFAIL1.NE.0)OK=.FALSE. CALL INPRDI(I+1,NGASR,20) IF(NGASR.LE.0.OR.NGASR.GT.MXLIST)THEN CALL INPMSG(I+1,'Value is out of range. ') OK=.FALSE. ELSE NGAS=NGASR ENDIF ENDIF ESET=.FALSE. INEXT=I+2 * Range of E-B angle. ELSEIF(MAGOK.AND.INPCMP(I,'ANG#LE-RAN#GE').NE.0)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPCHK(I+2,2,IFAIL2) IF(IFAIL1.EQ.0.AND.IFAIL2.EQ.0.AND.NWORD.GE.I+2)THEN CALL INPRDR(I+1,BAMINR,180*BANGMN/PI) CALL INPRDR(I+2,BAMAXR,180*BANGMX/PI) IF(BAMINR.LT.0.OR.BAMINR.GT.90.0.OR. - BAMAXR.LT.0.OR.BAMAXR.GT.90.0)THEN IF(BAMINR.LT.0.OR.BAMINR.GT.90.0) - CALL INPMSG(I+1,'Out of range [0,90].') IF(BAMAXR.LT.0.OR.BAMAXR.GT.90.0) - CALL INPMSG(I+2,'Out of range [0,90].') OK=.FALSE. ELSEIF(BAMINR.NE.BAMAXR)THEN BANGMN=PI*MIN(BAMINR,BAMAXR)/180 BANGMX=PI*MAX(BAMINR,BAMAXR)/180 ELSE CALL INPMSG(I+1,'A zero range is not permitted ') CALL INPMSG(I+2,'for the E-B angular range. ') OK=.FALSE. ENDIF ELSE CALL INPMSG(I,'Missing or invalid arguments. ') OK=.FALSE. ENDIF ASET=.FALSE. INEXT=I+3 ELSEIF(INPCMP(I,'ANG#LE-RAN#GE').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') CALL INPMSG(I+2,'Has been ignored.') OK=.FALSE. INEXT=I+3 ELSEIF(MAGOK.AND.INPCMP(I,'ANG#LES').NE.0)THEN IF(INPTYP(I+1).EQ.0)THEN CALL INPSTR(I+1,I+1,STRING,NCSTR) DO 350 IGLB=1,NGLB IF(STRING(1:NCSTR).EQ.GLBVAR(IGLB))THEN IF(GLBMOD(IGLB).NE.5)THEN CALL INPMSG(I+1,'Not of type Matrix.') OK=.FALSE. ELSEIF(MLEN(NINT(GLBVAL(IGLB))).GT.MXBANG)THEN CALL INPMSG(I+1,'More than MXBANG elements.') OK=.FALSE. ELSE ISLOT=MATSLT(NINT(GLBVAL(IGLB))) IF(ISLOT.LE.0)THEN CALL INPMSG(I+1,'Matrix inaccessible.') OK=.FALSE. GOTO 360 ENDIF NBANG=MLEN(ISLOT) DO 370 J=1,NBANG IF(MVEC(MORG(ISLOT)+J).LT.0.OR. - MVEC(MORG(ISLOT)+J).GT.90)THEN CALL INPMSG(I+1,'Out of range [0,90].') OK=.FALSE. GOTO 360 ELSE BANG(J)=PI*MVEC(MORG(ISLOT)+J)/180 ENDIF 370 CONTINUE ASET=.TRUE. ENDIF GOTO 360 ENDIF 350 CONTINUE CALL INPMSG(I+1,'Not a global variable.') OK=.FALSE. 360 CONTINUE INEXT=I+2 ELSEIF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN NBANG=0 DO 380 J=I+1,NWORD IF(INPTYP(J).NE.1.AND.INPTYP(J).NE.2)THEN INEXT=J GOTO 390 ELSEIF(NBANG+1.GT.MXBANG)THEN CALL INPMSG(J,'Too many values, ignored.') OK=.FALSE. GOTO 380 ENDIF CALL INPCHK(J,2,IFAIL1) IF(IFAIL1.EQ.0)THEN CALL INPRDR(J,ANGR,0.0) IF(ANGR.GE.0.0.AND.ANGR.LE.90.0)THEN NBANG=NBANG+1 BANG(NBANG)=PI*ANGR/180 ELSE CALL INPMSG(J,'Out of range [0,90].') OK=.FALSE. ENDIF ELSE CALL INPMSG(J,'Invalid angle value.') OK=.FALSE. ENDIF 380 CONTINUE INEXT=NWORD+1 390 CONTINUE ASET=.TRUE. ELSE CALL INPMSG(I,'Invalid angle specification.') OK=.FALSE. INEXT=I+2 ENDIF ELSEIF(INPCMP(I,'ANG#LE').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') OK=.FALSE. INEXT=I+2 * Number of points. ELSEIF(MAGOK.AND.INPCMP(I,'N-ANG#LE').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) IF(IFAIL1.NE.0)OK=.FALSE. CALL INPRDI(I+1,NBANGR,NBANG) IF(NBANGR.LE.0.OR.NBANGR.GT.MXBANG)THEN CALL INPMSG(I+1,'Value is out of range. ') OK=.FALSE. ELSEIF(NBANGR.GT.1.AND..NOT.MAGOK)THEN CALL INPMSG(I+1,'Not meaningful since B=0. ') OK=.FALSE. ELSE NBANG=NBANGR ENDIF ENDIF ASET=.FALSE. INEXT=I+2 ELSEIF(INPCMP(I,'N-ANG#LE').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') OK=.FALSE. INEXT=I+2 * Range of B field. ELSEIF(MAGOK.AND.INPCMP(I,'B-RAN#GE')+ - INPCMP(I,'MAG#NETIC-F#IELD-RAN#GE')+ - INPCMP(I,'B-F#IELD-RAN#GE').NE.0)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPCHK(I+2,2,IFAIL2) IF(IFAIL1.EQ.0.AND.IFAIL2.EQ.0.AND.NWORD.GE.I+2)THEN CALL INPRDR(I+1,BTMINR,BTABMN/100) CALL INPRDR(I+2,BTMAXR,BTABMX/100) IF(BTMINR.LT.0.OR.BTMAXR.LT.0)THEN IF(BTMINR.LT.0)CALL INPMSG(I+1,'Is not > 0.') IF(BTMAXR.LT.0)CALL INPMSG(I+1,'Is not > 0.') OK=.FALSE. ELSEIF(BTMINR.NE.BTMAXR)THEN BTABMN=100*MIN(BTMINR,BTMAXR) BTABMX=100*MAX(BTMINR,BTMAXR) ELSE CALL INPMSG(I+1,'A zero range is not permitted') CALL INPMSG(I+2,'for the B field range.') OK=.FALSE. ENDIF ELSE CALL INPMSG(I,'Missing or invalid arguments. ') OK=.FALSE. ENDIF INEXT=I+3 ELSEIF(INPCMP(I,'B-RAN#GE')+INPCMP(I,'B-FIELD-RAN#GE').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') CALL INPMSG(I+2,'Has been ignored.') OK=.FALSE. INEXT=I+3 * Listed B fields. ELSEIF(MAGOK.AND.INPCMP(I,'B-FIELD').NE.0)THEN IF(INPTYP(I+1).EQ.0)THEN CALL INPSTR(I+1,I+1,STRING,NCSTR) DO 300 IGLB=1,NGLB IF(STRING(1:NCSTR).EQ.GLBVAR(IGLB))THEN IF(GLBMOD(IGLB).NE.5)THEN CALL INPMSG(I+1,'Not of type Matrix.') OK=.FALSE. ELSEIF(MLEN(NINT(GLBVAL(IGLB))).GT.MXBTAB)THEN CALL INPMSG(I+1,'More than MXBTAB elements.') OK=.FALSE. ELSE ISLOT=MATSLT(NINT(GLBVAL(IGLB))) IF(ISLOT.LE.0)THEN CALL INPMSG(I+1,'Matrix inaccessible.') OK=.FALSE. GOTO 310 ENDIF NBTAB=MLEN(ISLOT) DO 320 J=1,NBTAB IF(MVEC(MORG(ISLOT)+J).LE.0)THEN CALL INPMSG(I+1,'Contains values <= 0.') OK=.FALSE. GOTO 310 ELSE BTAB(J)=100*MVEC(MORG(ISLOT)+J) ENDIF 320 CONTINUE BSET=.TRUE. ENDIF GOTO 310 ENDIF 300 CONTINUE CALL INPMSG(I+1,'Not a global variable.') OK=.FALSE. 310 CONTINUE INEXT=I+2 ELSEIF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN NBTAB=0 DO 330 J=I+1,NWORD IF(INPTYP(J).NE.1.AND.INPTYP(J).NE.2)THEN INEXT=J GOTO 340 ELSEIF(NBTAB+1.GT.MXBTAB)THEN CALL INPMSG(J,'Too many values, ignored.') OK=.FALSE. GOTO 330 ENDIF CALL INPCHK(J,2,IFAIL1) IF(IFAIL1.EQ.0)THEN CALL INPRDR(J,BFLDR,0.0) IF(BFLDR.GT.0.0)THEN NBTAB=NBTAB+1 BTAB(NBTAB)=100*BFLDR ELSE CALL INPMSG(J,'Not strictly positive.') OK=.FALSE. ENDIF ELSE CALL INPMSG(J,'Invalid field value.') OK=.FALSE. ENDIF 330 CONTINUE INEXT=NWORD+1 340 CONTINUE BSET=.TRUE. ELSE CALL INPMSG(I,'Invalid field specification.') OK=.FALSE. INEXT=I+2 ENDIF ELSEIF(INPCMP(I,'B-FIELD').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') OK=.FALSE. INEXT=I+2 * Number of points. ELSEIF(MAGOK.AND.INPCMP(I,'N-B-#FIELD')+ - INPCMP(I,'N-MAG#NETIC-#FIELD').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) IF(IFAIL1.NE.0)OK=.FALSE. CALL INPRDI(I+1,NBTABR,NBTAB) IF(NBTABR.LE.0.OR.NBTABR.GT.MXBTAB)THEN CALL INPMSG(I+1,'Value is out of range. ') OK=.FALSE. ELSEIF(NBTABR.GT.1.AND..NOT.MAGOK)THEN CALL INPMSG(I+1,'Not meaningful since B=0. ') OK=.FALSE. ELSE NBTAB=NBTABR ENDIF ENDIF INEXT=I+2 ELSEIF(INPCMP(I,'N-B-#FIELD')+ - INPCMP(I,'N-MAG#NETIC-#FIELD').NE.0)THEN CALL INPMSG(I,'Not meaningful since B=0.') CALL INPMSG(I+1,'Has been ignored.') OK=.FALSE. INEXT=I+2 * Switch preference. ELSEIF(INPCMP(I,'SWIT#CH').NE.0)THEN SWITCH=.TRUE. IF(INPTYP(I+1).EQ.1.OR.INPTYP(I+1).EQ.2)THEN CALL INPCHK(I+1,2,IFAIL1) CALL INPRDR(I+1,ACRITR,ACRIT) IF(IFAIL1.EQ.0.AND.ACRITR.LT.0)THEN CALL INPMSG(I+1,'Should be > 0.') OK=.FALSE. ELSEIF(IFAIL1.EQ.0)THEN ACRIT=ACRITR ENDIF INEXT=I+2 ENDIF ELSEIF(INPCMP(I,'NOSWIT#CH').NE.0)THEN SWITCH=.FALSE. * Iterate on alpha. ELSEIF(INPCMP(I,'NOIT#ERATE-#ALPHA').NE.0)THEN KITALP=0 SWITCH=.FALSE. ELSEIF(INPCMP(I,'IT#ERATE-#ALPHA').NE.0)THEN KITALP=1 SWITCH=.FALSE. * Precision. ELSEIF(INPCMP(I,'HIGH-PR#ECISION')+ - INPCMP(I,'SEC#OND-ORD#ER-#TERMS').NE.0)THEN KHIGH=2 SWITCH=.FALSE. ELSEIF(INPCMP(I,'LOW-PR#ECISION')+ - INPCMP(I,'FIR#ST-ORD#ER-#TERMS').NE.0)THEN KHIGH=1 SWITCH=.FALSE. ELSEIF(INPCMP(I,'PREC#ISION')+ - INPCMP(I,'ORD#ERS').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) CALL INPRDI(I+1,KHIGHR,KHIGH) IF(KHIGHR.LT.1)THEN CALL INPMSG(I+1,'Value must be at least 1. ') OK=.FALSE. ELSE KHIGH=KHIGHR SWITCH=.FALSE. ENDIF ENDIF INEXT=I+2 * Number of MC collisions. ELSEIF(INPCMP(I,'COLL#ISIONS').NE.0)THEN IF(INPTYP(I+1).NE.1.OR.I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPCHK(I+1,1,IFAIL1) IF(IFAIL1.NE.0)OK=.FALSE. CALL INPRDI(I+1,NMAXR,5) IF(NMAXR.LE.0)THEN CALL INPMSG(I+1,'Value is out of range. ') OK=.FALSE. ELSE NNMAX=NMAXR ENDIF ENDIF INEXT=I+2 * Type of diffusion requested. ELSEIF(INPCMP(I,'F0-TRANS#VERSE-DIFF#USION').NE.0)THEN KTDIFF=1 ELSEIF(INPCMP(I,'H1-TRANS#VERSE-DIFF#USION').NE.0)THEN KTDIFF=2 ELSEIF(INPCMP(I,'MEAN-E#NERGY-TRANS#VERSE-DIFF#USION').NE. - 0)THEN KTDIFF=3 ELSEIF(INPCMP(I,'F0-LONG#ITUDINAL-DIFF#USION').NE.0)THEN KLDIFF=1 ELSEIF(INPCMP(I,'H1-LONG#ITUDINAL-DIFF#USION').NE.0)THEN KLDIFF=2 ELSEIF(INPCMP(I,'G0-LONG#ITUDINAL-DIFF#USION').NE.0)THEN KLDIFF=3 * Mobility. ELSEIF(INPCMP(I,'ION-MOB#ILITY')+ - INPCMP(I,'MOB#ILITY').NE.0)THEN IF(I.GE.NWORD)THEN CALL INPMSG(I,'Argument invalid or missing. ') OK=.FALSE. ELSE CALL INPSTR(I+1,I+1,STRING,NCMOB) ENDIF INEXT=I+2 * Program version. ELSEIF(INPCMP(I,'ANAL#YTIC-#INTEGRATION').NE.0)THEN MC=.FALSE. ELSEIF(INPCMP(I,'MC-#INTEGRATION')+ - INPCMP(I,'M#ONTE-C#ARLO-#INTEGRATION').NE.0)THEN MC=.TRUE. * Other options are not known. ELSE CALL INPMSG(I,'Not a recognised keyword. ') OK=.FALSE. ENDIF 100 CONTINUE *** Dump error messages. CALL INPERR *** Check consistency of KHIGH and KITALP. IF((.NOT.MC).AND.KHIGH.GT.1.AND.KITALP.GE.1)THEN PRINT *,' !!!!!! GASBMC WARNING : Not permissible to have'// - ' both HIGH-PRECISION and ITERATE-ALPHA; kept only'// - ' HIGH-PRECISION.' KITALP=0 OK=.FALSE. ENDIF *** Ensure there are no non-isotropic gases uses in the analytic version. IF((FRAMIX(1).GT.0.OR.FRAMIX(26).GT.0.OR.FRAMIX(29).GT.0.OR. - FRAMIX(121).GT.0).AND..NOT.MC)THEN PRINT *,' !!!!!! GASBMC WARNING : Non-isotropic gases can'// - ' only be used with the MC version; eliminated.' FRAMIX(1)=0 FRAMIX(26)=0 FRAMIX(29)=0 FRAMIX(121)=0 OK=.FALSE. ENDIF *** Check whether we have to continue or not. IF(JFAIL.EQ.2.AND..NOT.OK)THEN PRINT *,' ###### GASBMC ERROR : Magboltz not called'// - ' because of the above errors.' IFAIL=1 NGAS=0 CALL PROEND RETURN ELSEIF(JFAIL.EQ.3.AND..NOT.OK)THEN PRINT *,' ###### GASBMC ERROR : Program terminated'// - ' because of the above errors.' IFAIL=1 NGAS=0 CALL PROEND CALL QUIT RETURN ENDIF *** Progress printing. CALL PROFLD(1,'Initialisation',-1.0) CALL PROSTA(1,0.0) *** Set the scale of the E/p points. IF(NGAS.GT.1.AND..NOT.ESET)THEN DO 60 I=1,NGAS IF(EPLOG)THEN EGAS(I)=EPMIN*(EPMAX/EPMIN)** - (REAL(I-1)/REAL(MAX(1,NGAS-1))) ELSE EGAS(I)=EPMIN+(EPMAX-EPMIN)* - (REAL(I-1)/REAL(MAX(1,NGAS-1))) ENDIF 60 CONTINUE ELSEIF(.NOT.ESET)THEN IF(EPLOG)THEN EGAS(1)=SQRT(EPMIN*EPMAX) ELSE EGAS(1)=(EPMIN+EPMAX)/2 ENDIF ENDIF *** Compute the E-B angles. IF(NBANG.GT.1.AND..NOT.ASET)THEN DO 110 J=1,NBANG BANG(J)=BANGMN+REAL(J-1)*(BANGMX-BANGMN)/REAL(NBANG-1) 110 CONTINUE ELSEIF(.NOT.ASET)THEN BANG(1)=(BANGMN+BANGMX)/2 ENDIF *** Compute the B field strengths. IF(NBTAB.GT.1.AND..NOT.BSET)THEN DO 150 J=1,NBTAB BTAB(J)=(BTABMN+REAL(J-1)*(BTABMX-BTABMN)/REAL(NBTAB-1)) 150 CONTINUE ELSEIF(.NOT.BSET)THEN BTAB(1)=(BTABMN+BTABMX)/2 ENDIF *** Renormalise the fractions. FRTOT=0.0 DO 120 I=1,MXGNAM IF(FRAMIX(I).LT.0)FRAMIX(I)=0.0 FRTOT=FRTOT+FRAMIX(I) 120 CONTINUE IF(FRTOT.LE.0.0)THEN PRINT *,' !!!!!! GASBMC WARNING : Please have at least'// - ' one gas in your mixture; nothing done.' NGAS=0 IFAIL=1 RETURN ELSE DO 130 I=1,MXGNAM FRAMIX(I)=100*FRAMIX(I)/FRTOT 130 CONTINUE ENDIF *** Name of the mixture. STR=' ' NC=0 * Loop over the gasses. DO 140 I=1,MXGNAM * Skip gases that are absent. IF(FRAMIX(I).LE.0)GOTO 140 * Format the percentage. CALL OUTFMT(REAL(FRAMIX(I)),2,OUTSTR,NCOUT,'LEFT') * Hydrogen and Deuterium. IF(I.EQ.21)THEN STR(NC+1:NC+6+NCOUT)='H2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.22)THEN STR(NC+1:NC+6+NCOUT)='D2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Helium 3 and 4. ELSEIF(I.EQ.3)THEN STR(NC+1:NC+8+NCOUT)='He-4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.4)THEN STR(NC+1:NC+8+NCOUT)='He-3 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Neon. ELSEIF(I.EQ.5)THEN STR(NC+1:NC+6+NCOUT)='Ne '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.108)THEN STR(NC+1:NC+6+NCOUT)='Ne_a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Argon. ELSEIF(I.EQ.2)THEN STR(NC+1:NC+6+NCOUT)='Ar '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.101)THEN STR(NC+1:NC+6+NCOUT)='Ar_a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Krypton. ELSEIF(I.EQ.6)THEN STR(NC+1:NC+6+NCOUT)='Kr '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Xenon. ELSEIF(I.EQ.7)THEN STR(NC+1:NC+6+NCOUT)='Xe '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.109)THEN STR(NC+1:NC+8+NCOUT)='Xe_a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Methane. ELSEIF(I.EQ.8)THEN STR(NC+1:NC+7+NCOUT)='CH4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.102)THEN STR(NC+1:NC+8+NCOUT)='CH4a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.103)THEN STR(NC+1:NC+8+NCOUT)='CH4b '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.104)THEN STR(NC+1:NC+8+NCOUT)='CH4c '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Ethane. ELSEIF(I.EQ.9)THEN STR(NC+1:NC+8+NCOUT)='C2H6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.110)THEN STR(NC+1:NC+9+NCOUT)='C2H6a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+9+NCOUT ELSEIF(I.EQ.124)THEN STR(NC+1:NC+9+NCOUT)='C2H6b '//OUTSTR(1:NCOUT)//'%, ' NC=NC+9+NCOUT * Ethene. ELSEIF(I.EQ.19)THEN STR(NC+1:NC+8+NCOUT)='C2H4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.123)THEN STR(NC+1:NC+9+NCOUT)='C2H4a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+9+NCOUT * Acetylene. ELSEIF(I.EQ.20)THEN STR(NC+1:NC+8+NCOUT)='C2H2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Propane. ELSEIF(I.EQ.10)THEN STR(NC+1:NC+8+NCOUT)='C3H8 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.114)THEN STR(NC+1:NC+9+NCOUT)='C3H8a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+9+NCOUT ELSEIF(I.EQ.125)THEN STR(NC+1:NC+9+NCOUT)='C3H8b '//OUTSTR(1:NCOUT)//'%, ' NC=NC+9+NCOUT ELSEIF(I.EQ.33)THEN STR(NC+1:NC+9+NCOUT)='cycloC3H6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+13+NCOUT * Propene. ELSEIF(I.EQ.32)THEN STR(NC+1:NC+9+NCOUT)='C3H6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Isobutane. ELSEIF(I.EQ.11)THEN STR(NC+1:NC+10+NCOUT)='iC4H10 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT ELSEIF(I.EQ.111)THEN STR(NC+1:NC+11+NCOUT)='iC4H10a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+11+NCOUT ELSEIF(I.EQ.112)THEN STR(NC+1:NC+11+NCOUT)='iC4H10b '//OUTSTR(1:NCOUT)//'%, ' NC=NC+11+NCOUT ELSEIF(I.EQ.126)THEN STR(NC+1:NC+11+NCOUT)='iC4H10c '//OUTSTR(1:NCOUT)//'%, ' NC=NC+11+NCOUT * neo-Pentane. ELSEIF(I.EQ.13)THEN STR(NC+1:NC+12+NCOUT)='neoC5H12 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+12+NCOUT ELSEIF(I.EQ.115)THEN STR(NC+1:NC+13+NCOUT)='neoC5H12a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+13+NCOUT * Nitrogen. ELSEIF(I.EQ.16)THEN STR(NC+1:NC+6+NCOUT)='N2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.105)THEN STR(NC+1:NC+7+NCOUT)='N2a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.122)THEN STR(NC+1:NC+7+NCOUT)='N2b '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * Water vapour. ELSEIF(I.EQ.14)THEN STR(NC+1:NC+7+NCOUT)='H2O '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * Carbon monoxide and dioxide. ELSEIF(I.EQ.23)THEN STR(NC+1:NC+6+NCOUT)='CO '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.12)THEN STR(NC+1:NC+7+NCOUT)='CO2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.106)THEN STR(NC+1:NC+7+NCOUT)='CO2a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.107)THEN STR(NC+1:NC+16+NCOUT)='CO2_Nakamura '//OUTSTR(1:NCOUT)// - '%, ' NC=NC+16+NCOUT * Hot and col methylal. ELSEIF(I.EQ.24)THEN STR(NC+1:NC+14+NCOUT)='C3H8O2_hot '//OUTSTR(1:NCOUT)//'%, ' NC=NC+14+NCOUT ELSEIF(I.EQ.113)THEN STR(NC+1:NC+15+NCOUT)='C3H8O2_cold '//OUTSTR(1:NCOUT)//'%, ' NC=NC+15+NCOUT * SF6. ELSEIF(I.EQ.30)THEN STR(NC+1:NC+7+NCOUT)='SF6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * NH3. ELSEIF(I.EQ.31)THEN STR(NC+1:NC+7+NCOUT)='NH3 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * Freons (Freon 14 and Zyron 116N5). ELSEIF(I.EQ.1)THEN STR(NC+1:NC+7+NCOUT)='CF4 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.116)THEN STR(NC+1:NC+8+NCOUT)='CF4a '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.117)THEN STR(NC+1:NC+8+NCOUT)='CF4b '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.121)THEN STR(NC+1:NC+8+NCOUT)='CF4c '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.29)THEN STR(NC+1:NC+8+NCOUT)='C2F6 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Oxygen. ELSEIF(I.EQ.15)THEN STR(NC+1:NC+6+NCOUT)='O2 '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT * Nitrous and nitric oxide. ELSEIF(I.EQ.17)THEN STR(NC+1:NC+6+NCOUT)='NO '//OUTSTR(1:NCOUT)//'%, ' NC=NC+6+NCOUT ELSEIF(I.EQ.18)THEN STR(NC+1:NC+7+NCOUT)='N2O '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT * DME. ELSEIF(I.EQ.25)THEN STR(NC+1:NC+7+NCOUT)='DME '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ELSEIF(I.EQ.118)THEN STR(NC+1:NC+8+NCOUT)='DMEa '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.119)THEN STR(NC+1:NC+8+NCOUT)='DMEb '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT ELSEIF(I.EQ.120)THEN STR(NC+1:NC+8+NCOUT)='DMEc '//OUTSTR(1:NCOUT)//'%, ' NC=NC+8+NCOUT * Alcohols. ELSEIF(I.EQ.34)THEN STR(NC+1:NC+9+NCOUT)='CH3OH '//OUTSTR(1:NCOUT)//'%, ' NC=NC+9+NCOUT ELSEIF(I.EQ.35)THEN STR(NC+1:NC+10+NCOUT)='C2H5OH '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT ELSEIF(I.EQ.36)THEN STR(NC+1:NC+10+NCOUT)='C3H7OH '//OUTSTR(1:NCOUT)//'%, ' NC=NC+10+NCOUT * Reid step, Reid ramp and Maxwell model. ELSEIF(I.EQ.26)THEN STR(NC+1:NC+13+NCOUT)='Reid-step '//OUTSTR(1:NCOUT)//'%, ' NC=NC+13+NCOUT ELSEIF(I.EQ.28)THEN STR(NC+1:NC+13+NCOUT)='Reid-ramp '//OUTSTR(1:NCOUT)//'%, ' NC=NC+13+NCOUT ELSEIF(I.EQ.27)THEN STR(NC+1:NC+11+NCOUT)='Maxwell '//OUTSTR(1:NCOUT)//'%, ' NC=NC+11+NCOUT * Obsolete components. ELSE STR(NC+1:NC+7+NCOUT)='??? '//OUTSTR(1:NCOUT)//'%, ' NC=NC+7+NCOUT ENDIF * Next component. 140 CONTINUE * Gas temperature. CALL OUTFMT(TGAS,2,OUTSTR,NCOUT,'LEFT') STR(NC+1:NC+NCOUT+6)='T='//OUTSTR(1:NCOUT)//' K, ' NC=NC+NCOUT+6 * Gas pressure. CALL OUTFMT(PGAS/760.0,2,OUTSTR,NCOUT,'LEFT') STR(NC+1:NC+NCOUT+6)='p='//OUTSTR(1:NCOUT)//' atm' NC=NC+NCOUT+6 * Copy to the gas identifier. IF(NC.GT.LEN(GASID))THEN GASID=STR(1:NC-2)//'...' NC=LEN(GASID) ELSE GASID=STR(1:NC) ENDIF *** Debugging output. IF(LDEBUG)THEN WRITE(LUNOUT,'('' ++++++ GASBMC DEBUG : Mixing the'', - '' following gasses:''// - '' CF4 '',F6.3,'' Argon '',F6.3/ - '' Helium 4 '',F6.3,'' Helium 3 '',F6.3/ - '' Neon '',F6.3,'' Krypton '',F6.3/ - '' Xenon '',F6.3,'' CH4 '',F6.3/ - '' C2H6 '',F6.3,'' C3H8 '',F6.3/ - '' iso C4H10 '',F6.3,'' CO2 '',F6.3/ - '' neo C5H12 '',F6.3,'' H2O '',F6.3/ - '' Oxygen '',F6.3,'' Nitrogen '',F6.3/ - '' NO '',F6.3,'' N2O '',F6.3/ - '' C2H4 '',F6.3,'' C2H2 '',F6.3/ - '' Hydrogen '',F6.3,'' Deuterium '',F6.3/ - '' CO '',F6.3,'' Methylal H '',F6.3/ - '' DME '',F6.3,'' Reid step '',F6.3/ - '' Maxwell '',F6.3,'' Reid ramp '',F6.3/ - '' C2F6 '',F6.3,'' SF6 '',F6.3/ - '' NH3 '',F6.3,'' C3H6 '',F6.3/ - '' cyclo C3H6 '',F6.3,'' CH3OH '',F6.3/ - '' C2H5OH '',F6.3,'' C3H7OH '',F6.3// - '' Argon a '',F6.3,'' CH4 a '',F6.3/ - '' CH4 b '',F6.3,'' CH4 c '',F6.3/ - '' Nitrogen a '',F6.3,'' CO2 a '',F6.3/ - '' CO2 Nakam. '',F6.3,'' Neon a '',F6.3/ - '' Xenon a '',F6.3,'' C2H6 a '',F6.3/ - '' iC4H10 a '',F6.3,'' iC4H10 b '',F6.3/ - '' Methylal C '',F6.3,'' C3H8 a '',F6.3/ - '' neo C5H12 a'',F6.3,'' CF4 a '',F6.3/ - '' CF4 b '',F6.3,'' DME a '',F6.3/ - '' DME b '',F6.3,'' DME c '',F6.3/ - '' CF4 c '',F6.3,'' Nitrogen b '',F6.3/ - '' C2H4 a '',F6.3,'' C2H6 a '',F6.3/ - '' C3H8 b '',F6.3,'' iC4H10 c '',F6.3)') - (0.01*REAL(FRAMIX(I)),I=1,36), - (0.01*REAL(FRAMIX(I)),I=101,126) WRITE(LUNOUT,'('' With the following parameters:''// - '' E/p range: '',2F10.3, - '' V/cm.Torr''/ - '' Number of E/p points: '',I6/ - '' Magnetic field range: '',2F10.3,'' T''/ - '' Number of B field points: '',I6/ - '' angle(E,B) range: '',2F10.3, - '' degrees''/ - '' Number of (E,B) points: '',I6/ - '' Pressure of the gas: '',F10.3,'' Torr''/ - '' Temperature of the gas: '',F10.3,'' K'')') - EPMIN,EPMAX,NGAS,BTABMN/100,BTABMX/100,NBTAB, - 180*BANGMN/PI,180*BANGMX/PI,NBANG,PGAS,TGAS WRITE(LUNOUT,'('' Accuracy settings: '')') IF(SWITCH)THEN WRITE(LUNOUT,'('' Switching from LHIGH=2,'', - '' NITALP=0 to 1, 1 at alpha/p='',E12.5)') ACRIT ELSE WRITE(LUNOUT,'('' Using LHIGH='',I2, - '', NITALP='',I2,''.'')') KHIGH,KITALP ENDIF WRITE(LUNOUT,'('' MC iterations: '',I5)') NNMAX WRITE(LUNOUT,'('' Identifier: '',A)') GASID(1:NC) ENDIF *** Compute the mobilities for the various points. IF(NCMOB.GT.0)THEN CALL PROFLD(1,'Adding mobility',-1.0) CALL PROSTA(1,0.0) * Call editor of specified as @. IF(INDEX(STRING(1:NCMOB),'@').NE.0)THEN NRES=1 CALL ALGEDT(VARLIS,1,IENTRY,USE,NRES) IFAIL1=0 * Usual function translation if not. ELSE CALL ALGPRE(STRING,NCMOB,VARLIS,1,NRES,USE,IENTRY, - IFAIL1) ENDIF * Check return code of translation. IF(IFAIL1.NE.0)THEN PRINT *,' !!!!!! GASBMC WARNING : Ion mobility'// - ' function rejected; no ion mobility in table.' CALL ALGCLR(IENTRY) NCMOB=0 ENDIF * Check number of results returned by the function. IF(NRES.NE.1)THEN PRINT *,' !!!!!! GASBMC WARNING : Number of'// - ' results returned by the mobility function'// - ' is not 1; rejected.' CALL ALGCLR(IENTRY) NCMOB=0 ENDIF * Evaluate. DO 160 I=1,NGAS VAR(1)=EGAS(I) MODVAR(1)=2 CALL ALGEXE(IENTRY,VAR,MODVAR,1,RES,MODRES,1,IFAIL1) MGAS(I)=RES(1) DO 170 J=1,NBANG DO 180 K=1,NBTAB MGAS2(I,J,K)=RES(1) 180 CONTINUE 170 CONTINUE 160 CONTINUE * Clear the mobility entry point - no longer needed. CALL ALGCLR(IENTRY) * Dump algebra error messages. CALL ALGERR ENDIF *** Fill the gas tables. IF(MC)THEN CALL GASB2(NNMAX,IFAIL) ELSE CALL GASB1(KITALP,KHIGH,SWITCH,ACRIT,IFAIL) ENDIF IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! GASBMC WARNING : Computing the transport'// - ' properties failed ; no gas tables.' RETURN ENDIF *** Set the GASOK flags. GASOK(1)=.TRUE. IF(NCMOB.GT.0)THEN GASOK(2)=.TRUE. ELSE GASOK(2)=.FALSE. ENDIF GASOK(3)=.TRUE. GASOK(4)=.TRUE. GASOK(6)=.TRUE. IF(MAGOK)THEN GASOK(7)=.TRUE. GASOK(9)=.TRUE. GASOK(10)=.TRUE. ELSE GASOK(7)=.FALSE. GASOK(9)=.FALSE. GASOK(10)=.FALSE. ENDIF GASOK(8)=.TRUE. *** Interpolation flags. IVMETH=2 IMMETH=2 IDMETH=2 IOMETH=2 IAMETH=2 IBMETH=2 IWMETH=2 *** Extrapolation flags. IF(NGAS.LE.1)THEN IVEXTR=0 IMEXTR=0 IDEXTR=0 IAEXTR=0 IBEXTR=0 IWEXTR=0 IOEXTR=0 JVEXTR=0 JMEXTR=0 JDEXTR=0 JAEXTR=0 JBEXTR=0 JWEXTR=0 JOEXTR=0 ENDIF END +DECK,GASB1. SUBROUTINE GASB1(KITALP,KHIGH,SWITCH,ACRIT,IFAIL) *----------------------------------------------------------------------- * GASB1 - Interface to Magboltz 1. * (Last changed on 13/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,GASDATA. +SEQ,BFIELD. +SEQ,PRINTPLOT. +SEQ,CONSTANTS. +SEQ,MAGBPARM. DOUBLE PRECISION EFINP REAL ACRIT,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL INTEGER ISTART,I,J,K,KITALP,KHIGH,IFAIL LOGICAL SWITCH *** Assume this will work. IFAIL=0 *** Set the calibration flag to False. LCALIB=.FALSE. *** If there is a magnetic field. IF(MAGOK)THEN * Adjust progress printing. CALL PRORED(1) CALL PROFLD(1,'B-field',REAL(NBTAB)) * Loop over the B fields. DO 20 K=1,NBTAB CALL PROSTA(1,REAL(K)) * When using the F0 or H1 long. diffusions, compute fudge factors. IF(KLDIFF.EQ.1.OR.KLDIFF.EQ.2)THEN * Inform user. CALL PRORED(2) CALL PROFLD(2,'Correction factors',REAL(NGAS)) * Set flag so that SET1B1 doesn't change B and OUTPUT saves ratio. LCALIB=.TRUE. * Loop over E/p. EFINP = 1.0D0/SQRT(DBLE(PGAS)/760.0D0) ISTART = 1 DO 70 I=1,NGAS CALL PROSTA(2,REAL(I)) CALL SET1B1(PGAS,TGAS,KHIGH,KITALP,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Preparation'// - ' step failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF CALL MAGBOL(DBLE(EGAS(I)*PGAS),DBLE(BTAB(K)/10), - 0.0D0,EFINP,ISTART, - IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Computing'// - ' transport properties failed;'// - ' no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF CALL OUTB1(5,I,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) 70 CONTINUE * Reset calibration flag. LCALIB=.FALSE. ENDIF ** Next loop over the angles. CALL PRORED(3) CALL PROFLD(2,'angle(E,B)',REAL(NBANG)) TAB2D = .TRUE. IF(LDEBUG)PRINT *,' ++++++ GASB1 DEBUG : Preparing a'// - ' 2D table with ',NBANG,' E-B angles:', - (180*BANG(J)/PI,J=1,NBANG) DO 30 J = 1,NBANG CALL PROSTA(2,REAL(J)) IF(SWITCH)THEN KHIGH=2 KITALP=0 ENDIF CALL SET1B1(PGAS,TGAS,KHIGH,KITALP,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Preparation step'// - ' failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF EFINP = 1.0D0/SQRT(DBLE(PGAS)/760.0D0) ISTART = 1 CALL PROFLD(3,'E-field',REAL(NGAS)) DO 10 I=1,NGAS CALL PROSTA(3,REAL(I)) CALL MAGBOL(DBLE(EGAS(I)*PGAS),DBLE(BTAB(K)/10), - DBLE(180*BANG(J)/PI),EFINP,ISTART,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Computing'// - ' transport properties failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF IF(SWITCH.AND.KHIGH.EQ.2.AND. - AGAS2(I,J,1).GT.ACRIT)THEN IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASB1 '', - '' DEBUG : LHIGH/NITALP from 2/0 to 1/1'', - '' at E='',E12.5,'' V/cm.'')') EGAS(I)*PGAS KHIGH=1 KITALP=1 CALL SET1B1(PGAS,TGAS,KHIGH,KITALP,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Preparation'// - ' step failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF CALL MAGBOL(DBLE(EGAS(I)*PGAS),DBLE(BTAB(K)/10), - DBLE(180*BANG(J)/PI),EFINP,ISTART,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Computing'// - ' transport properties failed;'// - ' no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF ELSEIF(SWITCH.AND.KHIGH.EQ.1.AND. - AGAS2(I,J,1).LT.ACRIT)THEN IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASB1 '', - '' DEBUG : LHIGH/NITALP from 1/1 to 2/0'', - '' at E='',E12.5,'' V/cm.'')') EGAS(I)*PGAS KHIGH=2 KITALP=0 CALL SET1B1(PGAS,TGAS,KHIGH,KITALP,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Preparation'// - ' step failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF CALL MAGBOL(DBLE(EGAS(I)*PGAS),DBLE(BTAB(K)/10), - DBLE(180*BANG(J)/PI),EFINP,ISTART,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Computing'// - ' transport properties failed;'// - ' no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF ENDIF * Output the results. CALL OUTB1(5,I,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) VGAS2(I,J,K)=VBOL XGAS2(I,J,K)=XBOL YGAS2(I,J,K)=YBOL WGAS2(I,J,K)=WBOL DGAS2(I,J,K)=DBOL OGAS2(I,J,K)=OBOL AGAS2(I,J,K)=ABOL BGAS2(I,J,K)=BBOL * Plot the distribution functions. IF(LF0PLT)CALL F0PLT1(GASID) * Next E field. 10 CONTINUE * Next angle. 30 CONTINUE * Next B field. 20 CONTINUE * Transfer the data from the VGAS2 etc to VGAS. IF(NBANG.EQ.1)THEN PRINT *,' ------ GASB1 MESSAGE : The table is'// - ' 1-dimensional even though B/=0.' TAB2D = .FALSE. DO 55 I=1,NGAS VGAS(I) = VGAS2(I,1,1) XGAS(I) = XGAS2(I,1,1) YGAS(I) = YGAS2(I,1,1) DGAS(I) = DGAS2(I,1,1) AGAS(I) = AGAS2(I,1,1) BGAS(I) = BGAS2(I,1,1) OGAS(I) = OGAS2(I,1,1) WGAS(I) = WGAS2(I,1,1) 55 CONTINUE ENDIF *** If there is no magnetic field. ELSE CALL PRORED(1) CALL PROFLD(1,'Electric field',REAL(NGAS)) * First fill the 2 dimensional arrays as for the B field case. NBANG = 1 IF(LDEBUG)PRINT *,' ++++++ GASB1 DEBUG : Preparing a'// - ' 1D table.' IF(SWITCH)THEN KHIGH=2 KITALP=0 ENDIF CALL SET1B1(PGAS,TGAS,KHIGH,KITALP,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Preparation step'// - ' failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF EFINP = 1.0D0/SQRT(DBLE(PGAS)/760.0D0) ISTART = 1 DO 40 I=1,NGAS CALL PROSTA(1,REAL(I)) CALL MAGBOL(DBLE(EGAS(I)*PGAS),0.0D0,0.0D0, - EFINP,ISTART,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Computing'// - ' transport properties failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF IF(SWITCH.AND.KHIGH.EQ.2.AND. - AGAS2(I,1,1).GT.ACRIT)THEN IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASB1 '', - '' DEBUG : LHIGH/NITALP from 2/0 to 1/1'', - '' at E='',E12.5,'' V/cm.'')') EGAS(I)*PGAS KHIGH=1 KITALP=1 CALL SET1B1(PGAS,TGAS,KHIGH,KITALP,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Preparation'// - ' step failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF CALL MAGBOL(DBLE(EGAS(I)*PGAS),0.0D0,0.0D0, - EFINP,ISTART,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Computing'// - ' transport properties failed;'// - ' no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF ELSEIF(SWITCH.AND.KHIGH.EQ.1.AND. - AGAS2(I,1,1).LT.ACRIT)THEN IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ GASB1 '', - '' DEBUG : LHIGH/NITALP from 1/1 to 2/0'', - '' at E='',E12.5,'' V/cm.'')') EGAS(I)*PGAS KHIGH=2 KITALP=0 CALL SET1B1(PGAS,TGAS,KHIGH,KITALP,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Preparation'// - ' step failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF CALL MAGBOL(DBLE(EGAS(I)*PGAS),0.0D0,0.0D0, - EFINP,ISTART,IFAIL) IF(IFAIL.GT.0)THEN PRINT *,' !!!!!! GASB1 WARNING : Computing'// - ' transport properties failed;'// - ' no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF ENDIF * Plot the distribution functions. IF(LF0PLT)CALL F0PLT1(GASID) * Output the results. CALL OUTB1(5,I,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) VGAS(I)=VBOL XGAS(I)=XBOL YGAS(I)=YBOL WGAS(I)=WBOL DGAS(I)=DBOL OGAS(I)=OBOL AGAS(I)=ABOL BGAS(I)=BBOL * Next E value. 40 CONTINUE * Remember this is a 1D table. TAB2D=.FALSE. ENDIF *** End of progress printing. CALL PROEND *** Record CPU time used. CALL TIMLOG('Magboltz gas mixing: ') END +DECK,GASB2. SUBROUTINE GASB2(NNMAX,IFAIL) *----------------------------------------------------------------------- * GASB2 - Interface to Magboltz 2. * (Last changed on 13/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,DIMENSIONS. +SEQ,GASDATA. +SEQ,BFIELD. +SEQ,PRINTPLOT. +SEQ,CONSTANTS. +SEQ,MAGBPARM. INTEGER I,J,K,IFAIL,NNMAX REAL VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL *** If there is a magnetic field. IF(MAGOK)THEN ** Next loop over the angles. TAB2D = .TRUE. IF(LDEBUG)PRINT *,' ++++++ GASB2 DEBUG : Preparing a'// - ' 3D table.' * Loop over the B fields. CALL PRORED(3) CALL PROFLD(1,'B-field',REAL(NBTAB)) DO 50 K=1,NBTAB CALL PROSTA(1,REAL(K)) * Loop over the angles. CALL PROFLD(2,'angle(E,B)',REAL(NBANG)) DO 10 J=1,NBANG CALL PROSTA(2,REAL(J)) ** Loop over the electric field. CALL PROFLD(3,'E-field',REAL(NGAS)) DO 20 I=1,NGAS * Progress printing. CALL PROSTA(3,REAL(I)) C print *,' Starting for:' C print *,' E = ',EGAS(I)*PGAS C print *,' B = ',BTAB(K)/100,' T' C print *,' angle = ',180*BANG(J)/PI,' degrees' * Initialisation. CALL SETB2(EGAS(I)*PGAS,BTAB(K)/10,180*BANG(J)/PI, - TGAS,PGAS,NNMAX,IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! GASB2 WARNING : Preparation step'// - ' of Magboltz 2 for E/p=',EGAS(I), - ' angle=',180*BANG(J)/PI,' failed; no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF IF(LDEBUG)CALL PRINT2 * Choose routine depending on B field configuration. IF(ABS(BTAB(K)).LT.0.0001)THEN CALL MONTE ELSEIF(BANG(J).EQ.0)THEN CALL MONTEA ELSEIF(ABS(BANG(J)-PI/2).LT.0.001)THEN CALL MONTEB ELSE CALL MONTEC ENDIF * Plot distribution function if requested. IF(LF0PLT)CALL F0PLT2(GASID) * Output the results. CALL OUTB2(VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) VGAS2(I,J,K)=VBOL XGAS2(I,J,K)=XBOL YGAS2(I,J,K)=YBOL WGAS2(I,J,K)=WBOL DGAS2(I,J,K)=DBOL OGAS2(I,J,K)=OBOL AGAS2(I,J,K)=ABOL BGAS2(I,J,K)=BBOL * Next E field. 20 CONTINUE * Next angle. 10 CONTINUE * Next B field 50 CONTINUE ** Transfer the data from the VGAS2 etc to VGAS. IF(NBANG.EQ.1.AND.NBTAB.EQ.1)THEN PRINT *,' ------ GASB2 MESSAGE : The table is'// - ' 1-dimensional even though B/=0.' TAB2D=.FALSE. DO 30 I=1,NGAS VGAS(I) = VGAS2(I,1,1) XGAS(I) = XGAS2(I,1,1) YGAS(I) = YGAS2(I,1,1) DGAS(I) = DGAS2(I,1,1) AGAS(I) = AGAS2(I,1,1) BGAS(I) = BGAS2(I,1,1) OGAS(I) = OGAS2(I,1,1) WGAS(I) = WGAS2(I,1,1) 30 CONTINUE ENDIF *** If there is no magnetic field. ELSE CALL PRORED(1) CALL PROFLD(1,'Electric field',REAL(NGAS)) * First fill the 2 dimensional arrays as for the B field case. NBANG=1 IF(LDEBUG)PRINT *,' ++++++ GASB2 DEBUG : Preparing a'// - ' 1D table.' ** Loop over the electric field. CALL PROFLD(1,'Electric field',REAL(NGAS)) DO 40 I=1,NGAS * Progress printing. CALL PROSTA(1,REAL(I)) * Initialisation. CALL SETB2(EGAS(I)*PGAS,0.0,0.0,TGAS,PGAS,NNMAX,IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! GASB2 WARNING : Preparation step'// - ' of Magboltz 2 for E/p=',EGAS(I),' failed;'// - ' no gas tables.' IFAIL=1 NGAS=0 RETURN ENDIF IF(LDEBUG)CALL PRINT2 * Call the MC routine. CALL MONTE * Plot distribution function if requested. IF(LF0PLT)CALL F0PLT2(GASID) * Output the results. CALL OUTB2(VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) VGAS(I)=VBOL XGAS(I)=XBOL YGAS(I)=YBOL WGAS(I)=WBOL DGAS(I)=DBOL OGAS(I)=OBOL AGAS(I)=ABOL BGAS(I)=BBOL * Next E field. 40 CONTINUE ** Declate the table to be 1-dimensional. TAB2D=.FALSE. ENDIF *** End of progress printing. CALL PROEND *** Record CPU time used. CALL TIMLOG('Magboltz gas mixing: ') END +DECK,GASDMC. SUBROUTINE GASDMC *----------------------------------------------------------------------- * GASDMC - Dumps the commons used by the Monte Carlo routines. * (Last changed on 5/ 2/00.) *----------------------------------------------------------------------- implicit none INTEGER I,J +SEQ,MAGBDATA. OPEN(UNIT=12,FILE='magmc.dump',STATUS='UNKNOWN') WRITE(12,'('' EIN IARRY'', - '' RGAS IPN'')') DO 20 I=1,MXGLEV WRITE(12,'(2X,E15.8,I5,E15.8,I5)') EIN(I),IARRY(I),RGAS(I),IPN(I) 20 CONTINUE DO 10 I=1,2000 WRITE(12,'('' TCF '',I5,'' = '',E15.8)') I,TCF(I) WRITE(12,'(4(2X,8E15.8/))') (CF(I,J),J=1,MXGLEV) 10 CONTINUE CLOSE(12) END +DECK,RNDM2. DOUBLE PRECISION FUNCTION RNDM2(DUMMY) *----------------------------------------------------------------------- * RNDM2 - Returns double precision random numbers by calling RM48. * (Last changed on 5/ 2/00.) *----------------------------------------------------------------------- implicit none INTEGER NVEC PARAMETER(NVEC=1000) DOUBLE PRECISION RVEC(NVEC),DUMMY INTEGER IVEC DATA IVEC/0/ +SELF,IF=SAVE. SAVE RVEC,IVEC +SELF. *** Now generate random number between 0 and one. IF(IVEC.EQ.0.OR.IVEC.GE.NVEC)THEN CALL RM48(RVEC,NVEC) IVEC=1 ELSE IVEC=IVEC+1 ENDIF RNDM2=RVEC(IVEC) END +PATCH,MAGBOL1. +DECK,MAGBOL. SUBROUTINE MAGBOL(EE,BB,BTH,EFINP,ISTART,IFAIL) *----------------------------------------------------------------------- * MAGBOL - Main routine of the interface. * Author - Steve Biagi, modified by Georg Viehhauser and RV * (Last changed on 30/ 1/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBPARM. +SEQ,MAGBDIST. +SEQ,PRINTPLOT. INTEGER NITER,ISTART,I,L,M,ITOT,IOUT,IOK,IST,IFAIL DOUBLE PRECISION EE,BB,BTH,EFOLD,EFINP,AOLD,ANEW,ANORM,ACONV, - DIV,SLOPE,CONST *** Declarations for commented parts. C INTEGER J C REAL VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL *** Assume this will work. IFAIL=0 *** Start iteration counter. NITER=0 *** Set up the mixture, maybe return here until a good EFINAL is found. 900 CONTINUE * Increment iteration counter. NITER=NITER+1 * Prepare tables and mixture. CALL SET2B1(EE,BB,BTH,EFINP) CALL MIXER1(IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! MAGBOL WARNING : Mixing gasses failed;'// - ' transport properties not computed.' IFAIL=1 RETURN ELSEIF(LDEBUG.AND.ISTART.EQ.1)THEN CALL PRTHDR ISTART=0 ENDIF IF (LDEBUG) CALL PRINT1 CALL MFIELD *** Backward prolongation and Gauss-Seidel iteration. DO 3000 L = 1,LHIGH AOLD = 1.0D0 ITOT = 0 IOUT = 0 CALL F0CALC(0,ANEW,L,IOK,DIV) * Check the F0CALC has indeed been able to compute F0. IF (IOK .EQ. 0)THEN EFINP = EFINP/DIV GOTO 900 ENDIF *** If the final prob is very small, redefine the upper energy limit. IF (F(NSTEP1) .LT. 1.0D-12)THEN DO 910 I = 1,NSTEP1 IF (F(I) .LT. 1.0D-8)THEN IF(LDEBUG)WRITE(LUNOUT,'( - '' ++++++ MAGBOL DEBUG : Reducing'', - '' EFINAL from '',E15.8,'' by a factor '', - E15.8)') EFINP,REAL(I)/REAL(NSTEP1) EFINP = EFINP * DBLE(I)/DBLE(NSTEP1) GOTO 900 ENDIF 910 CONTINUE PRINT *,' !!!!!! MAGBOL WARNING : Unable to find an'// - ' appropriate new Efinal value; not changing.' *** If too large but iteration limit reached, simply issue warning. ELSEIF(F(NSTEP1).GT.1.0D-5.AND.NITER.GT.5)THEN PRINT *,' !!!!!! MAGBOL WARNING : Maximum number of'// - ' Efinal iterations reached; not changed.' *** If it is too large on the other hand, extend the integration range. ELSEIF(F(NSTEP1).GT.1.0D-5)THEN * Georg's original. C SLOPE = 2.0D0 * (LOG10(F(NSTEP1))- C & LOG10(F(INT(DBLE(NSTEP1)/2.0D0))))/EFINP C CONST = 2.0D0*LOG10(F(INT(DBLE(NSTEP1)/2.0D0)))- C & LOG10(F(NSTEP1)) C EFINP = MIN(3.0D0*EFINP,(-7.5D0 - CONST)/SLOPE) * New version. SLOPE=LOG10(F(NSTEP1-100)/F(NSTEP1-200))/ - (100*EFINP/DBLE(NSTEP1)) CONST=LOG10(F(NSTEP1-100))-SLOPE*EFINP EFOLD=EFINP IF(SLOPE.LT.0.AND.(6+CONST).GT.0.AND. - -(6+CONST).GT.5*EFINP*SLOPE)THEN EFINP=-(6+CONST)/SLOPE ELSE EFINP=3*EFINP ENDIF IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ MAGBOL DEBUG :'', - '' Extending Efinal from '',E15.8,'' to '',E15.8)') - EFOLD,EFINP * End of modification. GOTO 900 ENDIF GO TO 100 1 CALL F0CALC(1,ANEW,L,IOK,DIV) 100 ITOT = ITOT + 1 IOUT = IOUT + 1 ANORM = ABS(1.0D0 - ANEW/AOLD) IF (LDEBUG)WRITE(LUNOUT,90) ANEW,AOLD,ANORM,ITOT 90 FORMAT(10X,' NEW SUM =',F10.6,5X,' OLD SUM =',F10.6,10X, & 'FRACTIONAL DIFFERENCE =',E10.3,8X,'ITERATION NUMBER =',I4) AOLD = ANEW IF(IOUT .EQ. NOUT) THEN C CALL OUTB1(0,-1,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) IOUT = 0 ENDIF IF(ITOT .GT. ITMAX) GO TO 20 IF(ANORM .GT. CONV) GO TO 1 CALL STEPPH(L) IF(IDLONG .EQ. 1) CALL STEPPR(L) C CALL OUTB1(L,-1,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) IF(I2TYPE .EQ. 1) GO TO 50 IF(NITALP .EQ. 1 .AND. ALPHA .NE. 0.0D0) GO TO 30 C GO TO 3000 GO TO 60 C--------INCLUDE COLLISIONS OF 2ND KIND 50 ITOT = 0 IOUT = 0 10 CALL F0CALC(1,ANEW,L,IOK,DIV) CALL STEPPH(L) IOUT = IOUT + 1 ITOT = ITOT + 1 ANORM = ABS(1.0D0 - ANEW/AOLD) IF (LDEBUG)WRITE(LUNOUT,90) ANEW,AOLD,ANORM,ITOT AOLD = ANEW IF(IOUT .EQ. NOUT) THEN C CALL OUTB1(0,-1,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) IOUT = 0 ENDIF IF(ITOT .GT. ITMAX) GO TO 20 IF(ANORM .GE. CONV) GO TO 10 IF(IDLONG .EQ. 1) CALL STEPPR(L) C CALL OUTB1(3,-1,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) GO TO 60 C--------INCLUDE NET IONISATION AND ATTACHMENT TO ALL ORDERS 30 ITOT = 0 IST = 0 40 CALL F0CALC(1,ANEW,L,IOK,DIV) CALL STEPPH(L) ITOT = ITOT + 1 ANORM = ABS(1.0D0 - ANEW/AOLD) IF(LDEBUG .AND. ANORM.LT.CONV)WRITE(LUNOUT,90) - ANEW,AOLD,ANORM,ITOT AOLD = ANEW IF(ITOT .GT. ITMAX) GO TO 20 IF(ANORM .GE. CONV) GO TO 40 C--------ITERATE ON NET IONISATION CALL NALPHA IST = IST + 1 IF(ALPOLD .EQ. 0.0D0) ALPOLD = 1.0D-10 IF(ALPNEW .LT. 700.0D0) GO TO 876 IF(IST .EQ. 1) THEN ALPNEW = ALPNEW * 0.5D0 ALPNAX = ALPNAX * 0.5D0 ALPNAY = ALPNAY * 0.5D0 ALPNAZ = ALPNAZ * 0.5D0 ENDIF 876 ACONV = ABS(1.0D0 - ALPNEW/ALPOLD) IF(ACONV .GE. CONALP) GO TO 40 C CALL STEPPH(L) IF(IDLONG .EQ. 1) CALL STEPPR(L) C CALL OUTB1(4,-1,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) C--------CALCULATE HIGHER MULTIPOLE TERM IN F-DISTRIBUTION TO 1ST ORDER C--------REDUCED OUTPUT 60 CONTINUE IF(L .EQ. 1) GO TO 3000 C--------REDUCED OUTPUT CALL FNCALC(L) CALL STEPPH(L) IF(IDLONG .EQ. 1) CALL STEPPR(L) M = L + 4 C CALL OUTB1(M,-1,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) *** Commented out reset of F2 (RV 6/10/99.) C DO 433 J = 1,2002 C F2(J) = 0.0D0 C DF2(J) = 0.0D0 C 433 CONTINUE *** End of modification. 3000 CONTINUE RETURN 20 IF (LDEBUG) WRITE(LUNOUT,98) ITOT 98 FORMAT(3(/),10X,'NUMBER OF ITERATIONS GREATER THAN ALLOWED =',I4) END +DECK,MIXER1. SUBROUTINE MIXER1(IFAIL) *----------------------------------------------------------------------- * MIXER1 - Fills arrays used in subroutine F0CALC * (Last changed on 30/ 9/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,MAGBCROS. +SEQ,PRINTPLOT. DOUBLE PRECISION QQROT(2002),QDROT(2002),QATT(MXNGAS,2002), - EION(MXNGAS),EN,AION,AIN,QAUX(6,2002),EAUX(6),EIAUX(20), - PQEAUX(2002),PQIAUX(2,2002),VIRIAL(MXNGAS) INTEGER I,J,K,IFAIL LOGICAL MONTE *** Assume this will work. IFAIL=0 *** Initialise the arrays. DO 110 I=1,MXNGAS NIN(I)=0 DO 120 J=1,6 EG(I,J)=0.0 DO 130 K=1,2002 Q(I,J,K)=0.0 130 CONTINUE 120 CONTINUE 110 CONTINUE *** Get gas cross-sections. MONTE=.FALSE. DO 20 K=1,NGASES * Retrieve the gas. CALL GETGAS(K,QAUX,EAUX,EIAUX,VIRIAL(K),MONTE,PQEAUX,PQIAUX) * Transfer data. DO 30 I=1,6 EG(K,I)=EAUX(I) DO 40 J=1,NSTEP1+1 Q(K,I,J)=QAUX(I,J) 40 CONTINUE 30 CONTINUE DO 50 I=1,20 EI(K,I)=EIAUX(I) 50 CONTINUE 20 CONTINUE *** Debugging output. IF(IDBUG.NE.0) WRITE(LUNOUT,999) (AN(I),I=1,NGASES),AKT 999 FORMAT(1X,'AN1-27 =',5(E12.5,1X),' AKT =',E12.5) IF(IDBUG.NE.0) WRITE(LUNOUT,998) (NIN(I),I=1,NGASES),NSTEP1 998 FORMAT(1X,' NIN =',5I4,' NSTEP1 =',I4) IF(IDBUG.NE.0) WRITE(LUNOUT,997) 997 FORMAT(/,5X,' QTOT QEL QELM QQROT / QDROT QSUM QIN1(1,J) ENERGY') C C----------------------------------------------------------------------- C CORRECTION FOR NUMBER DENSITY DUE TO SECOND VIRIAL COEFFICIENT TO C BE ENTERED HERE (NOT YET IMPLEMENTED) . IMPORTANT FOR HIGH PRESSURE. C----------------------------------------------------------------------- C DO 400 I = 1,NSTEP1+1 QTOT(I) = 0.0D0 QEL(I) = 0.0D0 QELM(I) = 0.0D0 QQROT(I) = 0.0D0 IF (ES(I) .EQ. 0.0D0) THEN EN = 1.0D-08 ELSE EN = 2.0 * ES(I) ENDIF QDROT(I) = 0.0D0 DO 401 J = 1,NGASES QTOT(I) = QTOT(I) + AN(J)*Q(J,1,I) QEL(I) = QEL(I) + AN(J)*Q(J,2,I) QELM(I) = QELM(I) + AN(J)*Q(J,2,I)*EG(J,2) QQROT(I) = QQROT(I) + AN(J)*Q(J,5,I)*EG(J,5) IF(EG(J,6) .NE. 0.0D0)QDROT(I) = QDROT(I) + AN(J)*Q(J,6,I) & * 2.0D0 * EG(J,6) * ARY * LOG(EN/SQRT(EG(J,6)*AKT)) QION(J,I) = Q(J,3,I) * AN(J) * ES(I) QATT(J,I) = Q(J,4,I) * AN(J) * ES(I) DO 181 K = 1,NIN(J) QIN(J,K,I) = QIN(J,K,I) * AN(J) * ES(I) 181 CONTINUE 401 CONTINUE QQROT(I) = 4.D0 * QQROT(I) QELM(I) = QELM(I) * ES(I)*ES(I) + QQROT(I) * ES(I) + QDROT(I) QREL(I) = 0.0D0 QSATT(I) = 0.0D0 QSUM(I) = 0.0D0 DO 90 J = 1,NGASES QSUM(I) = QSUM(I) + QION(J,I) + QATT(J,I) QSATT(I) = QSATT(I) + QATT(J,I) QREL(I) = QREL(I) + QION(J,I) - QATT(J,I) DO 91 K = 1,NIN(J) QSUM(I) = QSUM(I) + QIN(J,K,I) 91 CONTINUE 90 CONTINUE IF (ES(I) .EQ. 0.0D0) THEN EN = 1.0D-08 ELSE EN = ES(I) ENDIF QINEL(I) = QSUM(I)/EN C IF(IDBUG.NE.0)WRITE(LUNOUT,996)QTOT(I),QEL(I),QELM(I), C - QQROT(I),QDROT(I),QSUM(I),QIN(1,1,I),ES(I) C 996 FORMAT(5X,9E13.3) 400 CONTINUE C DO 500 I = 1,NGASES EION(I) = EG(I,3) AION = EION(I)/ESTEP LION(I) = INT(AION) ALION(I) = AION - DBLE(LION(I)) DO 301 J = 1,NIN(I) AIN = EI(I,J)/ESTEP LIN(I,J) = INT(AIN) ALIN(I,J) = AIN - DBLE(LIN(I,J)) 301 CONTINUE 500 CONTINUE END +DECK,F0CALC. SUBROUTINE F0CALC(IBACK,ANEW,L,IOK,DIV) *----------------------------------------------------------------------- * F0CALC - Computes F0. Returns IOK=0 if the energy range is not * suitable, in this case DIV contains the factor by which * the end point is to be multiplied. * Author - Steve Biagi, modified by Georg Viehhauser * (Last changed on 5/10/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBDIST. +SEQ,PRINTPLOT. DOUBLE PRECISION ANEW,DIV,SUM,ASUM,SSUM,FNSUM,FNSSM1,FNSSM2,AI, - F2SUM,F2SUM1,F2SUM2,EXT,F1SUM,F2T1,F2T2,FMUS,SFB INTEGER IBACK,I,J,K,L,M,IOK,MION,MIN *** Initial setting of the range-correct flag. IOK = 0 *** Starting values. IF(IBACK .EQ. 1)GOTO 10 IF(L .NE. 1) GOTO 10 DF(NSTEP+2) = 0.0D0 F(NSTEP1) = 1.0D-07 10 SSUM = 0.0D0 F2SUM = 0.0D0 FNSSM1 = 0.0D0 FNSSM2 = 0.0D0 Z = 0.0D0 DO 1000 M = 1,NSTEP I = NSTEP - M + 2 AI = I DO 60 J = 1,NGASES MION = LION(J) + I IF(MION .GE. NSTEP1) GO TO 60 Z = Z + F(MION) * QION(J,MION) / AI + ALION(J)/AI * & (F(MION+1) * QION(J,MION+1) - F(MION) * QION(J,MION)) 60 CONTINUE ASUM = F(I) * (QEF(I)*ALPNAZ*ALPNEW+QEEF(I)*ALPNEW*DF(I)) *** Protect against exponent overflow. IF (F(I) .GT. 1.0D15)THEN IOK = 0 DIV = 2.0D0 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ F0CALC DEBUG :'', - '' Reducing Efinal by '',E11.4,'' (F>1E15).'')') DIV RETURN ENDIF SUM = Z - F(I)*QSUM(I) + ASUM DO 100 K = 1,NGASES DO 61 J = 1,NIN(K) MIN = LIN(K,J) + I IF(MIN .GE. NSTEP1) GO TO 61 SUM = SUM + F(MIN) * QIN(K,J,MIN) + ALIN(K,J) * & (F(MIN+1) * QIN(K,J,MIN+1) - F(MIN)*QIN(K,J,MIN)) 61 CONTINUE 100 CONTINUE FNSUM = SUM - ASUM FNSUM = FNSUM * ESTEP FNSSM1 = FNSSM1 + FNSUM SUM = SUM * ESTEP SSUM = SSUM + SUM F2SUM1 = 0.4D0 * ALPNAZ * ALPNEW * F2(I) * QEF(J) * ESTEP F2SUM2 = 0.4D0*ALPNEW*QEEF(I)*(DF2(I)+1.5D0*F2(I)/ES(I))*ESTEP F2SUM = F2SUM + F2SUM1 + F2SUM2 F2T1 = 0.4D0 * QEEEF(I) * (DF2(I)+1.5D0*F2(I)/ES(I)) F2T2 = 0.4D0 * QFEMAG(I) * ALPNAZ * F2(I) IF(ISFB .EQ. 1)THEN SFB = QEEEF(I) * F(I) + & ((QELM(I)+QFEMAG(I)*ALPNAZ) * F(I) - SSUM)*AKT ELSE SFB = QEEEF(I) * F(I) + QELM(I) * F(I) * AKT ENDIF *** Take care of the case that SFB=0. IF(SFB.EQ.0)THEN DF(I)=0 ELSE DF(I) = (SSUM - F(I) * (QELM(I)+QFEMAG(I)*ALPNAZ) & + F2SUM - F2T1 - F2T2)/SFB ENDIF *** End of modification. EXT = QELM(I) * F(I) + QELM(I) * F(I) * DF(I) * AKT F1(I) = (FNSSM2 + EXT - FNSSM1) * 3.0D0/(EMAG*ES(I)) F1SUM=ALPNEW * (2.0D0*ES(I)*F1(I)-ES(I+1)*F1(I+1))*ESTEP/3.0D0 FNSSM2 = FNSSM2 + F1SUM IF(I .LT. (NSTEP1-2)) THEN DF1(I) = (F1(I+2)-F1(I))/ESTEP - DF1(I+2) DF1(I+1) = (F1(I+2)-F1(I))/(2.0D0*ESTEP) ELSE IF(I .EQ. NSTEP1) DF1(I) = -F1(NSTEP1)/(2.0D0*ESTEP) IF(I .EQ. (NSTEP1-1)) DF1(I)=(F1(NSTEP1)-F1(NSTEP1-1))/ESTEP IF(I.EQ.(NSTEP1-2)) DF1(I)=(F1(NSTEP1-1)-F1(NSTEP1-2))/ESTEP ENDIF IF(L .EQ. 1) GO TO 629 F2(I) = -2.0D0 * QE(I) * (DF1(I)-F1(I)/(2.0D0*ES(I)))/3.0D0 - & ALPNAZ*2.0D0*F1(I)/(3.0D0*QTOT(I)) DF2(I) = -2.5D0 * DF(I) * F(I) - 2.5D0 * ALPNAZ * F(I)/EF(I) - & 1.5D0 * F2(I)/ES(I) - ALPNAZ * F2(I)/EF(I) - - 2.5D0 * F1(I)/QE(I) DF2(NSTEP1+1) = DF2(NSTEP1) DF2(NSTEP1+2) = DF2(NSTEP1) F2(I-1) = F2(I) - ESTEP*(1.5D0*DF2(I)-DF2(I+1)*0.5D0) DF2(I-1) = 2.0D0 * DF2(I) - DF2(I+1) GO TO 296 629 IF(IBACK .EQ. 1) GO TO 1000 *** Protect against exponent overflow. 296 IF ((DF(I+1)-3*DF(I))*ESTEP/2 .GT. 20)THEN IOK = 0 DIV = 1.33D0 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ F0CALC DEBUG :'', - '' Reducing Efinal by '',E11.4,'' (dF>20).'')') DIV RETURN ENDIF C--------BACKWARD PROLONGATION F(I-1) = F(I) * DEXP(-(3.0D0*DF(I)-DF(I+1))*0.5D0*ESTEP) 1000 CONTINUE DF(1) = 0.0D0 C *** Protect against exponent overflow. IF ((DF(1)+DF(2))*ESTEP/2.GT.20.OR. - (DF(3)-3*DF(2))*ESTEP/2.GT.20.OR. - (DF(1)+4*DF(2)+DF(3))*ESTEP/2.GT.20)THEN IOK = 0 DIV = 1.33D0 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ F0CALC DEBUG :'', - '' Reducing Efinal by '',E11.4,'' (dF_123>20).'')') DIV RETURN ENDIF C-----GAUSS-SEIDEL ITERATION F(2) = DEXP((DF(1)+DF(2))*0.5D0*ESTEP) F(1) = F(2) * DEXP(-(3.0D0*DF(2)-DF(3))*0.5D0*ESTEP) F(3) = DEXP(ESTEP*(DF(1)+4.0D0*DF(2)+DF(3))/3.0D0) DO 300 I = 5,NSTEP1,2 *** Protect against exponent overflow. IF ((DF(I-2)+4*DF(I-1)+DF(I))*ESTEP/3.GT.20)THEN IOK = 0 DIV = 1.33D0 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ F0CALC DEBUG :'', - '' Reducing Efinal by '',E11.4,'' (dF>20).'')') DIV RETURN ENDIF *** Otherwise integrate. F(I) = F(I-2) * DEXP(ESTEP*(DF(I-2)+4.0D0*DF(I-1)+DF(I))/3.0D0) 300 CONTINUE DO 310 I = 4,NSTEP,2 *** Protect against exponent overflow. IF ((DF(I-2)+4*DF(I-1)+DF(I))*ESTEP/3.GT.20)THEN IOK = 0 DIV = 1.33D0 IF(LDEBUG)WRITE(LUNOUT,'('' ++++++ F0CALC DEBUG :'', - '' Reducing Efinal by '',E11.4,'' (dF>20).'')') DIV RETURN ENDIF *** Otherwise integrate. F(I) = F(I-2) * DEXP(ESTEP*(DF(I-2)+4.0D0*DF(I-1)+DF(I))/3.0D0) 310 CONTINUE C-----NORMALIZATION OF PROBABILITY DISTRIBUTION DO 400 J = 1,NSTEP1 SIMF(J) = F(J) * EROOT(J) 400 CONTINUE CALL SIMP(ANEW) FMUS = 1.0D0/ANEW DO 410 J = 1,NSTEP1 F(J) = F(J) * FMUS C write(53,'('' F0 '',I10,5X,E15.3)') J,F(J) DF0(J) = DF(J) * F(J) 410 CONTINUE C IOK = 1 END +DECK,SIMP. SUBROUTINE SIMP(SUM) *----------------------------------------------------------------------- * SIMP - Simpson integration. * Author - Steve Biagi *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. DOUBLE PRECISION AODD,EVEN,SUM INTEGER I,N0 *** Initialise even and odd sum terms. AODD = 0.0D0 EVEN = 0.0D0 *** Loop over the odd terms. DO 1 I = 2,NSTEP,2 AODD = AODD + SIMF(I) 1 CONTINUE *** Loop over the even terms. N0 = NSTEP - 1 DO 2 I = 3,N0,2 EVEN = EVEN + SIMF(I) 2 CONTINUE *** Compute the result. SUM = ESTEP*(SIMF(1)+SIMF(NSTEP+1)+4.0D0*AODD+2.0D0*EVEN)/3.0D0 END +DECK,MFIELD. SUBROUTINE MFIELD *----------------------------------------------------------------------- * MFIELD - Magnetic field initialisation. * Author - Steve Biagi *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. DOUBLE PRECISION ATHETA,BSIN,BCOS,SIN2,COS2,SINCOS,EMAG2,EN,EF2 INTEGER J *** Convert angle to radians. ATHETA = BTHETA*PI/180.0D0 *** Store sin and cos copies. BSIN = SIN(ATHETA) BCOS = COS(ATHETA) *** Remove rounding errors in sin and cos at 90 degrees. IF(BTHETA .EQ. 90.0) THEN BSIN = 1.0D0 BCOS = 0.0D0 ENDIF *** Store squares. SIN2 = BSIN * BSIN COS2 = BCOS * BCOS SINCOS = BSIN * BCOS EMAG2 = EMAG * EMAG DO 100 J=1,NSTEP1+1 IF(ES(J) .EQ. 0.0D0) THEN EN = 1.0D-04 ELSE EN = ES(J) ENDIF DENOM(J) = ECHARG * BMAG**2 / (2.0D6 * EMASS * EN * QTOT(J)**2) SOD(J) = SQRT(DENOM(J)) * BSIN COD2(J) = (DENOM(J) * COS2 + 1.0D0) SOD2(J) = (DENOM(J) * SIN2 + 1.0D0) SCD(J) = DENOM(J) * SINCOS DENOM(J) = DENOM(J) + 1.0D0 SOD(J) = SOD(J)/DENOM(J) SOD2(J) = SOD2(J)/DENOM(J) COD2(J) = COD2(J)/DENOM(J) SCD(J) = SCD(J)/DENOM(J) EF2 = EMAG2*COS2 + (EMAG2*SIN2)/DENOM(J) EF(J) = EF2/EMAG QE(J) = EF(J)/QTOT(J) QEF(J) = EN/(3.0D0*QTOT(J)) QFEMAG(J) = QEF(J) * EMAG QEEF(J) = QEF(J) * EF(J) QEEEF(J) = EF2 * QEF(J) 100 CONTINUE END +DECK,SET1B1. SUBROUTINE SET1B1(PP,TT,KHIGH,KITALP,IFAIL) *----------------------------------------------------------------------- * SET1B1 - Initialisation part 1 of Magboltz 1 * Author - Steve Biagi and Georg Viehhauser * (Last changed on 31/ 1/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,MAGBDIST. +SEQ,MAGBPARM. +SEQ,DIMENSIONS. +SEQ,BFIELD. +SEQ,PRINTPLOT. DOUBLE PRECISION CORR,TOTFRAC REAL PP,TT INTEGER KHIGH,KITALP,IFAIL,I *** Physical constants 1987 update of Taylor and Cohen. EOVM = SQRT(2.0D0*ECHARG/EMASS)*100.0D0 *** Set output control and integration data, integration accuracy 0.1 %. CONV = 1.0D-3 * Number of integration steps. NSTEP = 2000 NSTEP1 = NSTEP + 1 * Calculate alpha to 1% accuracy. CONALP = 1.0D-2 NOUT = 10 ITMAX = 1200 * Standard kT term. ISFB = 0 * No debugging output. IF(LDEBUG)THEN IDBUG = 1 ELSE IDBUG = 0 ENDIF *** Various options, first second kind (inelastic) scatterings I2TYPE = 0 * Iterate on the Townsend coefficient, useful when alpha > 30 NITALP = KITALP * Compute longitudinal diffusion explicitely IDLONG = 1 * Refinements (Georg's value = 1, Steve recommends 2) LHIGH = KHIGH *** Establish the gas mixture. NGASES=0 TOTFRAC=0.0 DO 10 I=1,MXGNAM IF(FRAMIX(I).GT.0)THEN * Ensure the limit on gas components is not exceeded. IF(NGASES.GE.MXNGAS)THEN PRINT *,' !!!!!! SET1B1 WARNING : The mixture'// - ' consists of more than MXNGAS components.' PRINT *,' Ajust this'// - ' parameter and recompile the program.' IFAIL=1 RETURN ENDIF * Add a new gas to the list. NGASES=NGASES+1 FRAC(NGASES)=FRAMIX(I) TOTFRAC=TOTFRAC+FRAC(NGASES) IGAS(NGASES)=I ENDIF 10 CONTINUE *** Pressure + temperature scaling and kT. TORR=DBLE(PP) TEMPC=DBLE(TT)-ABZERO CORR=ABZERO*TORR/(ATMOS*(ABZERO+TEMPC)) AKT=(ABZERO+TEMPC)*BOLTZ *** Scale the fractions. IF(TOTFRAC.LE.0.OR.NGASES.LE.0)THEN PRINT *,' !!!!!! SET1B1 WARNING : No gas present in the'// - ' mixture; setup aborted.' IFAIL=1 RETURN ENDIF DO 20 I=1,NGASES AN(I)=FRAC(I)*CORR*ALOSCH/TOTFRAC 20 CONTINUE END ********************************************************************* +DECK,SET2B1. SUBROUTINE SET2B1(EE,BB,BTH,EFINP) *----------------------------------------------------------------------- * SET1B1 - Initialisation part 2 of Magboltz 1 * Author - Steve Biagi and Georg Viehhauser * (Last changed on 6/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBDIST. +SEQ,MAGBCONS. DOUBLE PRECISION EE,BB,BTH,EFINP,AJ INTEGER I,J *** Copy settings for the final energy. EFINAL = EFINP ESTEP = EFINAL/NSTEP DO 10 I=1,2002 J = I - 1 AJ = J ES(I) = AJ * ESTEP EROOT(I) = SQRT(ES(I)) 10 CONTINUE EROOT(1) = 1.D-10 *** Electric field and magnetic field. EMAG=EE BMAG=BB BTHETA=BTH WB = AWB * BMAG *** Zero the distribution functions. DO 6 J=1,2002 F1(J) = 0.0D0 DF1(J) = 0.0D0 F2(J) = 0.0D0 DF2(J) = 0.0D0 F3(J) = 0.0D0 DF3(J) = 0.0D0 H1(J) = 0.0D0 DH1(J) = 0.0D0 G2(J) = 0.0D0 DG2(J) = 0.0D0 G1(J) = 0.0D0 DG1(J) = 0.0D0 G(J) = 0.0D0 DG0(J) = 0.0D0 DG(J) = 0.0D0 F(J) = 0.0D0 DF0(J) = 0.0D0 DF(J) = 0.0D0 6 CONTINUE *** Initialise Townsend coefficients. ALPNEW = 0.0D0 ALPOLD = 0.0D0 ALPNAX = 0.0D0 ALPNAY = 0.0D0 ALPNAZ = 0.0D0 ALPOAX = 0.0D0 ALPOAY = 0.0D0 ALPOAZ = 0.0D0 ALPHA = 0.0D0 END ******************************************************************** +DECK,PRTHDR. SUBROUTINE PRTHDR C IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,DIMENSIONS. +SEQ,PRINTPLOT. WRITE(LUNOUT,10) NGASES 10 FORMAT(1H1,20X,'BOLTZMAN SOLUTION FOR MIXTURE OF ',I2,' GASES.',/, /15X,'------------------------------------------------------') WRITE(LUNOUT,20) 20 FORMAT(//10X,' GASES REQUESTED ',10X,' PERCENTAGE USED '/) DO 30 I = 1,NGASES WRITE(LUNOUT,40) NAME(I),FRAC(I) 40 FORMAT(12X,A15,13X,F10.3) 30 CONTINUE WRITE(LUNOUT,50) TEMPC,TORR 50 FORMAT(2(/),2X,'GAS TEMPERATURE =',F6.1,' DEGREES CENTIGRADE.',2X /,'GAS PRESSURE = ',F7.1,' TORR.') WRITE(LUNOUT,60) NSTEP,CONV WRITE(LUNOUT,90) BMAG,BTHETA 90 FORMAT(/,2X,'MAGNETIC FIELD =' /,F10.3,' KGAUSS. ANGLE BETWEEN MAGNETIC AND ELECTRIC FIELD =', /F6.1,' DEGREES.',/) 60 FORMAT(2(/),2X,'INTEGRATION IN ',I4,' STEPS. CONVERGENCE ERROR LES /S THAN ',F10.6) IF(I2TYPE .EQ. 1) WRITE(LUNOUT,70) 70 FORMAT(/,2X,'COLLISIONS OF SECOND TYPE INCLUDED.') IF(IDLONG .NE. 1) THEN WRITE(LUNOUT,80) NOUT,ITMAX 80 FORMAT(/,2X,'PRINTOUT EVERY ',I2,' ITERATIONS. MAX. NUMBER OF' / ,' ITERATIONS ALLOWED: ',I4) WRITE(LUNOUT,82) 82 FORMAT(/,2X,'LONGITUDINAL DIFFUSION NOT CALCULATED') ELSE WRITE(LUNOUT,81) NOUT,ITMAX 81 FORMAT(/,2X,'PRINTOUT EVERY ',I2,' ITERATIONS. MAX. NUMBER OF' / ,' ITERATIONS ALLOWED: ',I4) WRITE(LUNOUT,83) 83 FORMAT(/,2X,'LONGITUDINAL DIFFUSION CALCULATED') ENDIF IF(ISFB .EQ. 0) WRITE(LUNOUT,91) 91 FORMAT(/,2X,'STANDARD PARAMETERISATION OF KT TERM.') IF(ISFB .EQ. 1) WRITE(LUNOUT,92) 92 FORMAT(/,2X,'INELASTIC LEVELS IN KT TERM.') WRITE(LUNOUT,100) 100 FORMAT(/,2X,'N.B. MULTIPLY DIFFUSION COEFFICIENTS BELOW BY :- DZ /Z=DZZ*FUDGE, DYZ=DYZ*SQRT(FUDGE), DXZ=DXZ*SQRT(FUDGE).',/,2X,'US /E (FUDGE) FACTOR = RATIO OF LONGITUDINAL/TRANSVERSE DIFFUSION COEF /FICIENTS IN ZERO MAGNETIC FIELD.',/) C RETURN END +DECK,OUTB1. SUBROUTINE OUTB1(N,IND,VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) *----------------------------------------------------------------------- * OUTB1 - Computes and outputs the parameters that are of interest. * Author - Steve Biagi, modified RV * (Last changed on 17/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,MAGBDIST. +SEQ,MAGBPARM. +SEQ,DIMENSIONS. +SEQ,PRINTPLOT. DOUBLE PRECISION FUDGE(MXLIST),EROOTF(2002),VELX1,VELY1,VELZ1, - SUM,DXX,DYY,DZZ,DXZ,DYZ,DSS,RI,RATEI,ANGLE,VTOT1,VTOT12, - VTOT2,VELX,VELY,VELZ,VTOT,CJK,EMEAN,FAC,FACI,RTEINL,RTEEL, - DL,DOVMB,DLOVMB,RATATT,ALPATT,WM,SELECT,COLRTE REAL VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL INTEGER N,J,IND DATA FUDGE/MXLIST*-1/ +SELF,IF=SAVE. SAVE FUDGE +SELF. *** Compute preliminary drift velocity. DO 1 J = 1,NSTEP1 SIMF(J) = COD2(J) * (QFEMAG(J) * DF(J) * F(J) + & 0.4D0*EMAG * (ES(J) * DF2(J) + 1.5D0*F2(J))/(3.0D0*QTOT(J))) 1 CONTINUE CALL SIMP(SUM) VELZ1 = -SUM * EOVM IF(LDEBUG .AND. N .EQ. 0 .AND. I2TYPE .EQ. 1) WRITE(LUNOUT,900) 900 FORMAT(/,5X,'COLLISIONS OF 2ND KIND INCLUDED.') IF(LDEBUG .AND. N .EQ. 0) WRITE(LUNOUT,910) VELZ1 910 FORMAT(10X,'INTERMEDIATE VALUE FOR DRIFT VELOCITY =',E11.4,' CM./S /EC.') *** No output for N=0. IF(N .EQ. 0) RETURN IF(IND.LT.1)THEN PRINT *,' !!!!!! OUTB1 WARNING : Called with invalid'// - ' output index; not executed.' RETURN ENDIF *** Compute diffusion matrix diagonal elements using F. DO 5 J = 1,NSTEP1 SIMF(J) = ES(J) * F(J) / (DENOM(J)*QTOT(J)) 5 CONTINUE CALL SIMP(SUM) DXX = SUM * EOVM/3.0D0 DO 6 J=1,NSTEP1 SIMF(J) = ES(J) * F(J) * SOD2(J)/QTOT(J) 6 CONTINUE CALL SIMP(SUM) DYY = SUM * EOVM/3.0D0 DO 7 J=1,NSTEP1 SIMF(J) = ES(J) * F(J) * COD2(J)/QTOT(J) 7 CONTINUE CALL SIMP(SUM) DZZ = SUM * EOVM/3.0D0 DSS = (DZZ + DYY + DXX)/3.0D0 * Store in output arrays if requested. IF(KTDIFF.EQ.1)OBOL=DYY IF(KLDIFF.EQ.1)THEN IF(LCALIB)THEN IF(DYY.GT.0)THEN FUDGE(IND)=1/DYY ELSE PRINT *,' !!!!!! OUTB1 WARNING : Not able'// - ' to compute longitudinal diffusion'// - ' correction factor.' FUDGE(IND)=1 ENDIF ELSEIF(ABS(BMAG).GT.0)THEN DBOL=DZZ*FUDGE(IND) ELSE DBOL=DZZ ENDIF ENDIF *** Compute Townsend and attachment. DO 10 J = 1,NSTEP1 SIMF(J) = QREL(J)*F(J) 10 CONTINUE CALL SIMP(SUM) RATEI = SUM * EOVM DO 11 J = 1,NSTEP1 SIMF(J) = COD2(J) * (QFEMAG(J) * DF(J) * F(J) + & 0.4D0 * EMAG * (ES(J)*DF2(J)+1.5D0*F2(J))/(3.0D0*QTOT(J))) 11 CONTINUE CALL SIMP(SUM) VELZ1 = -SUM * EOVM DO 12 J = 1,NSTEP1 SIMF(J) = SCD(J) * (QFEMAG(J) * DF(J) * F(J) + & 0.4D0 * EMAG * (ES(J)*DF2(J)+1.5D0*F2(J))/(3.0D0*QTOT(J))) 12 CONTINUE CALL SIMP(SUM) VELY1 = -SUM * EOVM DO 13 J = 1,NSTEP1 SIMF(J) = SOD(J) * (QFEMAG(J) * DF(J) * F(J) + & 0.4D0 * EMAG * (ES(J)*DF2(J)+1.5D0*F2(J))/(3.0D0*QTOT(J))) 13 CONTINUE CALL SIMP(SUM) VELX1 = -SUM * EOVM VTOT12 = VELX1*VELX1 + VELY1*VELY1 + VELZ1*VELZ1 VTOT1 = SQRT(VTOT12) CJK = (VTOT1/(2.0D0*DSS))**2 - RATEI/DSS IF(CJK .LT. 0.0D0) THEN PRINT *,' !!!!!! OUTB1 WARNING : Alpha for E=',EMAG, - ' V/cm is not useable.' PRINT *,' Approximating with', - ' Alpha=Rate/velocity.' ENDIF IF(CJK .LT. 0.0D0 .OR. RATEI .EQ. 0.0) THEN ALPHA = RATEI/VTOT1 ELSE ALPHA = VTOT1/(2.0D0*DSS) - SQRT(CJK) ENDIF *** Compute Lorentz angle. DO 20 J = 1,NSTEP1 SIMF(J)=COD2(J)*(QFEMAG(J)*DF(J)*F(J)+0.4D0*EMAG*(ES(J)*DF2(J)+ & 1.5D0*F2(J))/(3.0D0*QTOT(J))-QEF(J)*ALPHA*(F(J)+0.4D0*F2(J))) 20 CONTINUE CALL SIMP(SUM) VELZ = -SUM * EOVM DO 30 J = 1,NSTEP1 SIMF(J)=SCD(J)*(QFEMAG(J)*DF(J)*F(J)+0.4D0*EMAG*(ES(J)*DF2(J)+ & 1.5D0*F2(J))/(3.0D0*QTOT(J))-QEF(J)*ALPHA*(F(J)+0.4D0*F2(J))) 30 CONTINUE CALL SIMP(SUM) VELY = -SUM * EOVM DO 40 J = 1,NSTEP1 SIMF(J)=SOD(J)*(QFEMAG(J)*DF(J)*F(J)+0.4D0*EMAG*(ES(J)*DF2(J)+ & 1.5D0*F2(J))/(3.0D0*QTOT(J))-QEF(J)*ALPHA*(F(J)+0.4D0*F2(J))) 40 CONTINUE CALL SIMP(SUM) VELX = -SUM * EOVM VTOT2 = VELX*VELX + VELY*VELY + VELZ*VELZ VTOT = SQRT(VTOT2) RI = ALPHA * VTOT1 *** Compute diffusion matrix using H1. DO 50 J = 1,NSTEP1 SIMF(J) = ES(J) * H1(J)/DENOM(J) 50 CONTINUE CALL SIMP(SUM) DXX = SUM * EOVM/3.0 DO 60 J=1,NSTEP1 SIMF(J) = ES(J) * H1(J) * SOD2(J) 60 CONTINUE CALL SIMP(SUM) DYY = SUM * EOVM/3.0 DO 70 J=1,NSTEP1 SIMF(J) = ES(J) * H1(J) * COD2(J) 70 CONTINUE CALL SIMP(SUM) DZZ = SUM * EOVM/3.0D0 DO 80 J = 1,NSTEP1 SIMF(J) = ES(J) * H1(J) * 2.0D0 * SCD(J) 80 CONTINUE CALL SIMP(SUM) DYZ = SUM * EOVM/3.0D0 DO 90 J = 1,NSTEP1 SIMF(J) = ES(J) * H1(J) * 2.0D0 * SOD(J) 90 CONTINUE CALL SIMP(SUM) DXZ = SUM * EOVM/3.0D0 * Store in output arrays if requested. IF(KTDIFF.EQ.2)OBOL=DYY IF(KLDIFF.EQ.2)THEN IF(LCALIB)THEN IF(DYY.GT.0)THEN FUDGE(IND)=1/DYY ELSE PRINT *,' !!!!!! OUTB1 WARNING : Not able'// - ' to compute longitudinal diffusion'// - ' correction factor.' FUDGE(IND)=1 ENDIF ELSEIF(ABS(BMAG).GT.0)THEN DBOL=DZZ*FUDGE(IND) ELSE DBOL=DZZ ENDIF ENDIF *** Mean energy. DO 100 J = 1,NSTEP1 SIMF(J) = ES(J) * EROOT(J) * F(J) 100 CONTINUE CALL SIMP(SUM) EMEAN = SUM * Derive transverse diffusion from mean energy. IF(KTDIFF.EQ.3)OBOL=0.8*EMEAN*VTOT1/EMAG DO 110 J = 1,NSTEP1 SIMF(J) = EROOT(J) * F(J)/DENOM(J) 110 CONTINUE CALL SIMP(SUM) FAC = SUM DO 120 J = 1,NSTEP1 SIMF(J) = QTOT(J) * ES(J) * F(J) 120 CONTINUE CALL SIMP(SUM) COLRTE = SUM * EOVM FACI = 1.0D0/(1.0D0+(WB/COLRTE)**2) DO 130 J = 1,NSTEP1 EROOTF(J) = EROOT(J) * F(J) SIMF(J) = QINEL(J) * ES(J) * F(J) 130 CONTINUE CALL SIMP(SUM) RTEINL = SUM * EOVM DO 150 J = 1,NSTEP1 SIMF(J) = QEL(J) * ES(J) * F(J) 150 CONTINUE CALL SIMP(SUM) RTEEL = SUM * EOVM *** Compute accurate longitudinal diffusion. DO 160 J = 1,NSTEP1 SIMF(J) = G1(J) * ES(J) 160 CONTINUE CALL SIMP(SUM) DL = SUM * EOVM/3.0D0 * Use this for the fudge factor. IF(LCALIB.AND.(KLDIFF.EQ.1.OR.KLDIFF.EQ.2)) - FUDGE(IND)=DL*FUDGE(IND) * If using this longitudinal diffusion directly, store it. IF(KLDIFF.EQ.3)DBOL=DL DO 161 J = 1,NSTEP1 SIMF(J) = F(J) * (QIN(1,3,J)+QIN(1,2,J)) 161 CONTINUE CALL SIMP(SUM) SELECT = SUM * EOVM IF(LDEBUG) WRITE(LUNOUT,882) SELECT 882 FORMAT(/,3X,'SELECTED INELASTIC FREQUENCY=',E9.3,'/SEC',/) DO 170 J = 1,NSTEP1 SIMF(J) = F(J) * QSATT(J) 170 CONTINUE CALL SIMP(SUM) RATATT = SUM * EOVM ALPATT = RATATT/VTOT1 WM = 0.0 IF(BMAG .GT. 0.0D0) WM = VELX * EMAG * 1.0D5/(VELZ*BMAG) DOVMB = (DZZ+DYY+DXX) * EMAG/(3.0D0*VTOT1) DLOVMB = DL * EMAG/VTOT1 ANGLE = 180.0D0 * ATAN(VELX/VELZ)/ACOS(-1.0D0) *** Fill the output arrays. IF(.NOT.LCALIB)THEN VBOL=MAX(0.0,REAL(VELZ1*1.0D-6)) XBOL=VELX1*1.0D-6 YBOL=VELY1*1.0D-6 WBOL=REAL(ATAN2(SQRT(VELX1**2+VELY1**2),VELZ1)) IF(ALPHA.GT.0)THEN ABOL=REAL(LOG(ALPHA/TORR)) ELSE ABOL=-30 ENDIF IF(ALPATT.GT.0)THEN BBOL=REAL(LOG(ALPATT/TORR)) ELSE BBOL=-30 ENDIF * Previous definition with transverse fudge factor 0.8 (RV 6/2/97) C OGAS2(IND,INDANG)= C - REAL(SQRT(MAX(0.0D0,1.6D0*EMEAN*TORR/EMAG))) C DGAS2(IND,INDANG)= C - REAL(SQRT(MAX(0.0D0,2.0D0*DLOVMB*TORR/EMAG))) * Transform cm**2/sec to sqrt(cm Torr). DBOL=REAL(SQRT(MAX(0.0D0,2*DBOL*TORR/VTOT1))) OBOL=REAL(SQRT(MAX(0.0D0,2*OBOL*TORR/VTOT1))) ENDIF *** Printed output, only produced with the DEBUG option on. IF(LDEBUG) THEN WRITE(LUNOUT,915) 915 FORMAT('---------------------------------------------------------- &----------------------------------------------------------------') IF(N .EQ. 1) WRITE(LUNOUT,920) 920 FORMAT(/,3X,'FINAL VALUES WITHOUT COLLISIONS OF 2ND KIND. '// & 'LORENTZ SOLUTION (L=1).',/) IF(N .EQ. 2) WRITE(LUNOUT,921) 921 FORMAT(/,3X,'FINAL VALUES WITH L=2 TERM FULLY INCLUDED IN '// & 'CALCULATION.',/) IF(N .EQ. 3) WRITE(LUNOUT,930) 930 FORMAT(/,3X,'FINAL VALUES WITH COLLISIONS OF 2ND KIND. ',/) IF(N .EQ. 4) WRITE(LUNOUT,935) 935 FORMAT(/,3X,'FINAL VALUES CONVERGED ON ALPHA TO ALL ORDERS.',/) IF(N .EQ. 5) WRITE(LUNOUT,965) 965 FORMAT(/,3X,'FINAL VALUES WITH HIGHER MULTIPOLE. (L=2 TERM)',/, & ' HIGHER TERM ONLY TO FIRST ORDER .',/) IF(N .EQ. 6) WRITE(LUNOUT,966) 966 FORMAT(/,3X,'FINAL VALUES WITH HIGHER MULTIPOLE. (L=3 TERM)',/, & ' HIGHER TERM ONLY TO FIRST ORDER .',/) WRITE(LUNOUT,980) ANGLE WRITE(LUNOUT,940) VELZ,VELY,VELX,VTOT 940 FORMAT(/,10X,'VELZ =',E11.4,4X,'VELY =',E11.4,4X,'VELX =', & E11.4,9X,'VTOT =',E11.4,' CM./SEC. ( WITH IONISATION )') WRITE(LUNOUT,941) VELZ1,VELY1,VELX1,VTOT1 941 FORMAT(/,9X,'VELZ1 =',E11.4,3X,'VELY1 =',E11.4,3X,'VELX1 =', & E11.4,8X,'VTOT1 =',E11.4,' CM./SEC. ( WITHOUT IONISATION )') WRITE(LUNOUT,950) DZZ,DYY,DXX,DYZ,DXZ 950 FORMAT(/,10X,' DZZ =',E11.4,4X,' DYY =',E11.4,4X,' DXX =', & E11.4,6X,' DYZ =',E11.4,4X,' DXZ =',E11.4,' CM.**2/SEC.') WRITE(LUNOUT,960) EMEAN,DOVMB 960 FORMAT(/,10X,'MEAN ELECTRON ENERGY =',F8.4,' EV.',5X, & 'DIFFUSION/MO/BILITY =',F8.4,' EV. = CHARACTERISTIC ENERGY.') WRITE(LUNOUT,970) ALPHA,RATEI,ALPATT 970 FORMAT(/,10X,'NET ( IONISATION - ATTACHMENT ) RATE =',E10.3, & ' / CM. =',E10.3,' / SEC.',/,' ATTACHMENT RATE =',E10.3, & ' / CM.') 980 FORMAT(/,30X,'N.B. LORENTZ ANGLE = VELX/VELZ =',E7.2, & ' DEGREES.') WRITE(LUNOUT,990) WB,COLRTE,FACI,FAC 990 FORMAT(/,10X,'CYCLOTRON FREQUENCY =',E9.3,' RADS./SEC.',10X, & 'TOTAL COLLISION FREQUENCY =',E9.3,' /SEC.',2(/),10X, & '1/(1+(CYCLOTRON FREQ./COLL.FREQ.)**2) = K FACTOR =',F6.3,10X, & 'TRUE K FACTOR =',F6.3) WRITE(LUNOUT,994) WM 994 FORMAT(/,10X,'MAGNETIC DRIFT VELOCITY =',E11.4,' CM/SEC. '// & '(ONLY VALID FOR E AND B AT 90 DEGREES TO EACH OTHER.)') WRITE(LUNOUT,995) RTEINL,RTEEL 995 FORMAT(/,10X,'INELASTIC COLLISION FREQUENCY =',E9.3,' /SEC.' & ,10X,'/ELASTIC COLLISION FREQUENCY =',E9.3,' /SEC.') WRITE(LUNOUT,9951) F(NSTEP1),EFINAL 9951 FORMAT(/,10X,' F0 =',E11.3,5X,'AT FINAL ENERGY OF ', & E7.2,' EV.') WRITE(LUNOUT,9920) DL,DLOVMB 9920 FORMAT(/,10X,'LONGITUDINAL DIFFUSION =',E10.3,' CM.**2/SEC. = & ',F8.4,' EV.',/) WRITE(LUNOUT,9922) RI 9922 FORMAT(/,10X,'PULSED TOWNSEND OR TOF IONISATION RATE=',E10.3, & ' /SEC.',/) ENDIF IF(N .LT. 5) RETURN C ESTP10 = ESTEP * 20.0D0 C WRITE(LUNOUT,996) ESTP10 C 996 FORMAT(1H1,20X,'PROBABILITY DISTRIBUTION F0 IN STEPS OF',E7.4,' EL C /ECTRON VOLTS',/,20X,'--------------------------------------------- C /-------------------') C K = -199 C DO 200 J = 1,10 C K = K + 200 C K1 = K + 199 C IF(K1 .GT. NSTEP1 + 200) GO TO 200 C IF(K1 .GT. 2002) K1 = 2002 C WRITE(LUNOUT,999) (F(L),L=K,K1,20) C 999 FORMAT(10(2X,D11.3)) C 200 CONTINUE C WRITE(LUNOUT,896) ESTP10 C 896 FORMAT(5(/),20X,'PROBABILITY DISTRIBUTION F1 IN STEPS OF',E7.4,' E C /LECTRON VOLTS',/,20X,'-------------------------------------------- C /---------------------') C K= - 199 C DO 250 J = 1,10 C K = K + 200 C K1 = K + 199 C IF(K1 .GT. NSTEP1 + 200) GO TO 250 C IF(K1 .GT. 2002) K1 = 2002 C WRITE(LUNOUT,999) (F1(L),L=K,K1,20) C 250 CONTINUE C WRITE(LUNOUT,856) ESTP10 C 856 FORMAT(5(/),20X,'PROBABILITY DISTRIBUTION F2 IN STEPS OF',E7.4,' E C /LECTRON VOLTS',/,20X,'-------------------------------------------- C /---------------------') C K = -199 C DO 251 J = 1,10 C K = K + 200 C K1 = K + 199 C IF(K1 .GT. NSTEP1 + 200) GO TO 251 C IF(K1 .GT. 2002) K1 = 2002 C WRITE(LUNOUT,999) (F2(L),L=K,K1,20) C 251 CONTINUE C IF(N .EQ. 5) GO TO 261 C WRITE(LUNOUT,857) ESTP10 C 857 FORMAT(5(/),20X,'PROBABILITY DISTRIBUTION F3 IN STEPS OF',E7.4,' E C /LECTRON VOLTS',/,20X,'-------------------------------------------- C /---------------------') C K = -199 C DO 260 J = 1,10 C K = K + 200 C K1 = K + 199 C IF(K1 .GT. NSTEP1 + 200) GO TO 260 C IF(K1 .GT. 2002) K1 = 2002 C WRITE(LUNOUT,999) (F3(L),L=K,K1,20) C 260 CONTINUE C 261 CONTINUE C WRITE(LUNOUT,997) ESTP10 C 997 FORMAT(5(/),20X,'PROBABILITY DISTRIBUTION EROOT*F0 IN STEPS OF',E7 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. 2002) K1 = 2002 C WRITE(LUNOUT,999) (EROOTF(L),L=K,K1,20) C 300 CONTINUE C RETURN END C ********************************************************************** +DECK,NALPHA. SUBROUTINE NALPHA *----------------------------------------------------------------------- * NALPHA - * Author - Steve Biagi * (Last changed on 10/ 1/95.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,MAGBDIST. +SEQ,PRINTPLOT. ALPOLD = ALPNEW ALPOAX = ALPNAX ALPOAY = ALPNAY ALPOAZ = ALPNAZ DO 50 J = 1,NSTEP1 SIMF(J) = ES(J) * F(J)/(DENOM(J)*QTOT(J)) 50 CONTINUE CALL SIMP(SUM) DXX = SUM * EOVM/3.0D0 DO 60 J = 1,NSTEP1 SIMF(J) = ES(J) * F(J) * SOD2(J)/QTOT(J) 60 CONTINUE CALL SIMP(SUM) DYY = SUM * EOVM/3.0D0 DO 70 J = 1,NSTEP1 SIMF(J) = ES(J) * F(J) * COD2(J)/QTOT(J) 70 CONTINUE CALL SIMP(SUM) DZZ = SUM * EOVM/3.0D0 DSS = (DZZ+DYY+DXX)/3.0 DO 100 J = 1,NSTEP1 SIMF(J) = COD2(J) * QFEMAG(J) * DF(J) * F(J) 100 CONTINUE CALL SIMP(SUM) VELZ1 = -SUM * EOVM DO 200 J = 1,NSTEP1 SIMF(J) = SCD(J) * QFEMAG(J) * DF(J) * F(J) 200 CONTINUE CALL SIMP(SUM) VELY1 = -SUM * EOVM DO 300 J = 1,NSTEP1 SIMF(J) = SOD(J) * QFEMAG(J) * DF(J) * F(J) 300 CONTINUE CALL SIMP(SUM) VELX1 = -SUM * EOVM VTOT1 = SQRT(VELX1*VELX1 + VELY1*VELY1 + VELZ1*VELZ1) DO 10 J = 1,NSTEP1 SIMF(J) = QREL(J) * F(J) 10 CONTINUE CALL SIMP(SUM) RATEI = SUM * EOVM CJK = (VTOT1/(2.0D0*DSS))**2 - RATEI/DSS IF(CJK .LT. 0.0) THEN ALPNEW = RATEI/VTOT1 ELSE ALPNEW = VTOT1/(2.0D0*DSS) - SQRT(CJK) ENDIF DO 20 J = 1,NSTEP1 SIMF(J) = COD2(J) * (QFEMAG(J)*DF(J)-QEF(J)*ALPNEW) * F(J) 20 CONTINUE CALL SIMP(SUM) VELZ = -SUM * EOVM DO 30 J = 1,NSTEP1 SIMF(J) = SCD(J) * (QFEMAG(J)*DF(J)-QEF(J)*ALPNEW) * F(J) 30 CONTINUE CALL SIMP(SUM) VELY = -SUM * EOVM DO 40 J = 1,NSTEP1 SIMF(J) = SOD(J) * (QFEMAG(J)*DF(J)-QEF(J)*ALPNEW) * F(J) 40 CONTINUE CALL SIMP(SUM) VELX = -SUM * EOVM VTOT = SQRT(VELX*VELX + VELY*VELY + VELZ*VELZ) IF(CJK .LT. 0.0D0) PRINT *,' !!!!!! NALPHA WARNING : Alpha for', - ' E=',EMAG,' V/cm did not converge.' ALPNAX = VELX1 * ALPNEW/VTOT1 ALPNAY = VELY1 * ALPNEW/VTOT1 ALPNAZ = VELZ1 * ALPNEW/VTOT1 IF (LDEBUG) WRITE(LUNOUT,222) ALPNEW,ALPOLD,VELZ,VTOT 222 FORMAT(/,10X,'NEW ALPHA =',E10.3,' / CM. OLD ALPHA =',E10.3,' / /CM. VELZ =',E11.4,4X,'VTOT =',E11.4,' CM./SEC.') C RETURN END C *********************************************************************** +DECK,FNCALC. SUBROUTINE FNCALC(LMAX) *----------------------------------------------------------------------- * FNCALC - * Author - Steve Biagi * (Last changed on 10/ 1/95.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBDIST. INTEGER LMAX,J IF(LMAX .NE. 2) THEN F2(NSTEP1+1) = 0.0D0 DO 100 J = 2,NSTEP1 F2(J)=-(2.0D0*EF(J)*(ES(J)*DF1(J)-F1(J)/2.0D0)/ & (3.0D0*QTOT(J)*ES(J))+2.0D0*F1(J)*ALPNAZ/(3.0D0*QTOT(J))) 100 CONTINUE F2(1) = 0.0D0 DO 150 J = 2,NSTEP DF2(J) = (F2(J+1)-F2(J-1)) / (2.0D0*ESTEP) 150 CONTINUE DF2(NSTEP1) = (F2(NSTEP1)-F2(NSTEP)) / ESTEP DF2(1) = F2(2)/ESTEP RETURN ENDIF F3(NSTEP1+1) = 0.0D0 DO 310 J = 2,NSTEP1 F3(J)=-QE(J)*0.6D0*(DF2(J)-F2(J)/ES(J))- & ALPNAZ*0.6D0*F2(J)/QTOT(J) 310 CONTINUE F3(1) = 0.0D0 DO 350 J = 2,NSTEP DF3(J) = (F3(J+1)-F3(J-1)) / (2.0D0*ESTEP) 350 CONTINUE DF3(NSTEP1) = (F3(NSTEP1)-F3(NSTEP)) / ESTEP DF3(1) = F3(2)/ESTEP END +DECK,H1CALC. SUBROUTINE H1CALC(L,DHFNAL,DXX,DHFRST) *----------------------------------------------------------------------- * H1CALC - * Author - Steve Biagi *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBDIST. +SEQ,PRINTPLOT. +SEQ,MAGBCONS. IF(L .NE. 2) THEN DO 1000 I = 1,NSTEP1 H1(I) = (F(I)-0.2D0*F2(I))/QTOT(I) 1000 CONTINUE DO 200 J = 2,NSTEP1 DH1(J) = (H1(J+1)-H1(J-1))/(2.0D0*ESTEP) 200 CONTINUE DH1(1) = H1(1)/ESTEP RETURN ENDIF C SSUM0 = 0.0D0 DO 344 J = 1,2002 DH1(J) = 0.0D0 H1(J) = 0.0D0 344 CONTINUE H1(NSTEP1) = 0.0D0 DH1(NSTEP1) = -DHFNAL H1(NSTEP) = -ESTEP * DH1(NSTEP1) DH1(NSTEP) = DH1(NSTEP1) DO 500 M = 1,NSTEP-1 I = NSTEP - M + 1 SUM0 = H1(I) SUM1 = ((F(I)-0.2D0*F2(I))/QTOT(I)) SUM2 = 0.3D0 * QE(I) * F1(I)/(ES(I)*QTOT(I)) SUM3 = 0.3D0 * QE(I) * QE(I) * DH1(I)/ES(I) SUM4 = 0.15D0 * QE(I) * QE(I) * H1(I)/(ES(I)*ES(I)) SUM5 = 1.8D0 * QE(I) * F3(I)/(ES(I)*QTOT(I)*14.0D0) SUM = SUM1 - SUM0 - SUM2 + SUM3 - SUM4 + SUM5 SUM = SUM * ESTEP SSUM0 = SSUM0 + SUM *** Addition to protect overflow (RV, 15/8/96). +SELF,IF=-VAX. IF(ABS(SSUM0).GT.1.0D200)THEN IF(LDEBUG)WRITE(LUNOUT,'('' !!!!!! H1CALC WARNING :'', - '' Truncating H1 to energy > '',E10.3, - '' eV to avoid overflow.'')') ES(I) GOTO 501 ENDIF +SELF,IF=VAX. IF(ABS(SSUM0).GT.1.0D38)THEN IF(LDEBUG)WRITE(LUNOUT,'('' !!!!!! H1CALC WARNING :'', - '' Truncating H1 to energy > '',E10.3, - '' eV to avoid overflow.'')') ES(I) GOTO 501 ENDIF +SELF. *** End of modification. TERMT = 0.2D0 * QE(I) * (1.0D0*F1(I)/QTOT(I)+QE(I)* & H1(I)/(2.0D0*ES(I))-3.0D0*F3(I)/(7.0D0*QTOT(I))) TERMB = 0.2D0 * QE(I) * QE(I) DH1(I) = (SSUM0+TERMT)/TERMB DH1(I) = DH1(I) - DHFNAL H1(I-1) = H1(I) - ESTEP*(1.5D0*DH1(I)-DH1(I+1)*0.5D0) DH1(I-1) = 2.0D0*DH1(I)-DH1(I+1) 500 CONTINUE 501 CONTINUE DHFRST = DH1(1) C DHFRST = H1(1) DO 125 J = 1,NSTEP1 SIMF(J) = ES(J) * H1(J) 125 CONTINUE CALL SIMP(SUM) DXX = SUM * EOVM/3.0D0 C IF(LDEBUG) WRITE(LUNOUT,126) DXX,DH1(NSTEP1),H1(1) C 126 FORMAT(5X,'DXX =',E13.4,5X,'DH1(NSTEP1)=',E13.4,3X,'H1(1)=',E13.4) END +DECK,STEPPR. SUBROUTINE STEPPR(LMAX) *----------------------------------------------------------------------- * STEPPR - * Author - Steve Biagi * (Last changed on 10/ 1/95.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,MAGBDIST. +SEQ,PRINTPLOT. C-----ACCURACY 0.5% ACCUR = 0.003 DLOLD = 0.0 KSTEP = 0 C-----INITIALLY USE WIDE STEPS GSTEP = 0.01 GFINAL = 10.0**(-2) CALL G0CALC(GFINAL,EG0SUM,LMAX) 10 G01 = GFINAL EGSUM1 = EG0SUM KSTEP = KSTEP + 1 IF(KSTEP .GT. 10) GO TO 876 GFINAL = GFINAL * GSTEP CALL G0CALC(GFINAL,EG0SUM,LMAX) EGSUM2 = EG0SUM IF((EGSUM1/EGSUM2) .LE. 0.0D0) GO TO 25 GO TO 10 C-----SMALLER STEPS CLOSER TO MINIMUM 25 GSTEP = G01 30 GSTEP = GSTEP * 0.5D0 GFINAL = G01 GFINAL = GFINAL - GSTEP KSTEP = KSTEP + 1 CALL G0CALC(GFINAL,EG0SUM,LMAX) DO 161 J = 1,NSTEP1 SIMF(J) = G1(J) * ES(J) 161 CONTINUE CALL SIMP(SUM) DL = SUM * EOVM/3.0D0 IF(KSTEP .GT. 40) GO TO 60 C IF(LDEBUG) WRITE(LUNOUT,90) GFINAL,EG0SUM,KSTEP,DL C 90 FORMAT(5X,'GFINAL =',E13.6,5X,'EG0SUM =',E10.3,5X,'NSTEP =',I3,5X, C /'DL =',E11.4) EGSUM2 = EG0SUM FRACT= ABS((DL-DLOLD)/DL) IF(FRACT.LT. ACCUR) GO TO 70 DLOLD = DL IF((EGSUM1/EGSUM2) .LE. 0.0D0) GO TO 30 G01 = GFINAL EGSUM1 = EG0SUM GO TO 30 *** Error processing, longitudinal diffusion slow in converging. 60 CONTINUE IF(LDEBUG)WRITE(LUNOUT,'('' !!!!!! STEPPR WARNING : Sigma_L'', - '' did not converge in '',I5,'' iterations at E='',E12.5, - '' V/cm.''/26X,''Using result of last iteration: '',E12.5)') - KSTEP,EMAG,DL DO 823 K=1,2002 823 G1(K) = 0.0D0 RETURN *** Convergence achieved for longitudinal diffusion. 70 IF (LDEBUG) WRITE(LUNOUT,74) KSTEP 74 FORMAT(6X,'LONGITUDINAL DIFFUSION CONVERGED AFTER ',I3,' ITERATION /S.',/) RETURN *** No convergence at all for longitudinal diffusion. 876 CONTINUE PRINT *,' !!!!!! STEPPR WARNING : Sigma_L did not approach', - ' converge in ',KSTEP-1,' iterations for E=',EMAG,' V/cm.' RETURN END *********************************************************************** +DECK,G0CALC. SUBROUTINE G0CALC(GFINAL,EG0SUM,LMAX) C IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBDIST. +SEQ,MAGBCONS. ALPNEW = 0.0D0 ALPNAZ = 0.0D0 DO 10 J = 1,NSTEP1 SIMF(J) = ES(J) * F1(J) 10 CONTINUE CALL SIMP(SUM) VEL = SUM * EOVM/3.0D0 C-----STARTING VALUES G(NSTEP1) = GFINAL G2(NSTEP1) = 0.0D0 DG2(NSTEP1) = 0.0D0 SSUM = 0.0D0 SUM4 = 0.0D0 GNSSUM = 0.0D0 GSSUM = 0.0D0 Z = 0.0D0 DO 1000 M = 1,NSTEP I = NSTEP - M + 2 AI = I DO 60 J = 1,NGASES MION = LION(J) + I IF(MION .GE. NSTEP1) GO TO 60 Z = Z + G(MION) * QION(J,MION)/AI+ & (G(MION+1)*QION(J,MION+1)-G(MION)*QION(J,MION))*ALION(J)/AI 60 CONTINUE ASUM = G(I) * (QEF(I)*ALPNAZ*ALPNEW + QEEF(I)*ALPNEW*DG(I)) SUM = Z - G(I)*QSUM(I) + ASUM IF(LMAX .NE. 1) THEN BSUM = ALPNEW * (ALPNAZ*QEF(I)*G2(I)+QEEF(I)*(DG2(I)+ & 1.5D0*G2(I)/ES(I))) SUM = SUM + 0.4D0*BSUM ENDIF DO 70 K = 1,NGASES DO 61 J = 1,NIN(K) MIN = LIN(K,J)+I IF(MIN .GE. NSTEP1) GO TO 61 SUM = SUM + G(MIN) * QIN(K,J,MIN) + ALIN(K,J) * & (G(MIN+1)*QIN(K,J,MIN+1)-G(MIN)*QIN(K,J,MIN)) 61 CONTINUE 70 CONTINUE SUM1 = -QEF(I) * ALPNEW * (F(I)+0.4D0*F2(I))+ & ALPNEW*EROOT(I)*VEL*F1(I)/(3.0D0*EOVM*QTOT(I))+ES(I)*F1(I)/ - 3.0D0-EROOT(I)*VEL*F(I)/EOVM GNSUM = SUM - ASUM IF(LMAX .NE. 1) GNSUM = GNSUM - 0.4D0 * BSUM GNSUM = GNSUM + ES(I)*F1(I)/3.0-EROOT(I)*VEL*F(I)/EOVM SUM = SUM + SUM1 SUM = SUM * ESTEP GNSUM = GNSUM * ESTEP GNSSUM = GNSSUM + GNSUM SSUM = SSUM + SUM SUM2 = QFEMAG(I) * (F(I)+0.4D0*F2(I)-VEL*F1(I)/(EOVM*EROOT(I))) C--------PARKER + LOWKE C SUM2=QFEMAG(I)*(F(I)+0.4*F2(I)) SUM3 = -G(I) * (QELM(I)+QFEMAG(I)*ALPNAZ) IF(LMAX .NE. 1)SUM4 = 0.4D0 * (G2(I)*ALPNAZ*QFEMAG(I)+QEEEF(I)* & (DG2(I)+1.5D0*G2(I)/ES(I))) DG0(I) = (SSUM+SUM2+SUM3-SUM4) / (QEEEF(I)+QELM(I)*AKT) EXT = G(I) * QELM(I) + QELM(I) * DG0(I) * AKT G1(I) = (EXT+GSSUM-GNSSUM) * 3.0D0/(EMAG*ES(I)) G1SUM = ALPNEW * (2.0D0*ES(I)*G1(I)-ES(I+1)*G1(I+1))*ESTEP/ - 3.0D0 GSSUM = GSSUM + G1SUM IF(I .LT. (NSTEP1-2)) THEN DG1(I) = (G1(I+2)-G1(I)) / ESTEP-DG1(I+2) DG1(I+1) = (G1(I+2)-G1(I)) / (2.0D0*ESTEP) ELSE DG1(I) = (G1(I+1)-G1(I)) / ESTEP IF(I .EQ. NSTEP1) DG1(I) = -G1(I)/(2.0D0*ESTEP) ENDIF IF(LMAX .NE. 1) THEN G2(I) = 2.0D0 * F1(I)/3.0D0 - VEL*F2(I)/(EROOT(I)*EOVM)- & 2.0D0*EF(I)*(DG1(I)-G1(I)/(2.0D0*ES(I)))/3.0D0- & ALPNAZ*2.0D0*G1(I)/3.0D0+3.0D0*F3(I)/7.0D0 G2(I) = G2(I)/QTOT(I) DG2(I) = -2.5D0*DG0(I) - 1.5D0*G2(I)/ES(I) - 2.5D0*ALPNAZ* & (G(I)+0.4D0*G2(I))/EF(I)-2.5D0*G1(I)/QE(I)+2.5D0*(F(I)+ & 0.4D0*F2(I))/EF(I)-2.5D0*VEL*F1(I)/(EROOT(I)*EOVM*EF(I)) DG2(NSTEP1+1) = DG2(NSTEP1) G2(I-1) = G2(I) - ESTEP*(1.5*DG2(I)-DG2(I+1)*0.5) DG2(I-1) = 2.0D0*DG2(I) - DG2(I+1) ENDIF G(I-1) = G(I) - ESTEP*(1.5*DG0(I)-DG0(I+1)*0.5) DG(I) = DG0(I)/G(I) 1000 CONTINUE DO 400 J = 1,NSTEP1 SIMF(J) = G(J) * EROOT(J) 400 CONTINUE CALL SIMP(ANEW) EG0SUM = ANEW C RETURN END C *********************************************************************** +DECK,STEPPH. SUBROUTINE STEPPH(L) *----------------------------------------------------------------------- * STEPPH - * Author - Steve Biagi * (Last changed on 10/ 1/95.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBDIST. +SEQ,PRINTPLOT. IF(L .NE. 2) THEN CALL H1CALC(1,DUM,DUM,DUM) RETURN ENDIF C-----ACCURACY 3.0% 21 ACCUR = 0.020 DXOLD = 0.0 DHLAST = 0.0 KPRINT = 0 KSTEP = 0 C-----INITIALLY USE WIDE STEPS DHSTEP = 100. DHFNAL = 10.0**(-10) 146 CALL H1CALC(2,DHFNAL,DXX,DHFRST) 10 H01 = DHFNAL DHFRS1 = DHFRST KSTEP = KSTEP + 1 IF(KSTEP .GT. 9) GO TO 160 DHFNAL = DHFNAL * DHSTEP CALL H1CALC(2,DHFNAL,DXX,DHFRST) DHFRS2 = DHFRST *** Changed the next line (RV, 15/8/96). C IF((DHFRS1/DHFRS2) .LE. 0.0D0) GO TO 20 IF((DHFRS1.GE.0.AND.DHFRS2.LE.0).OR. - (DHFRS1.LE.0.AND.DHFRS2.GE.0))GOTO 20 *** End of modification. IF(KSTEP .GT. 1 .OR. ABS(DHFRS1) .GT. ABS(DHFRS2)) GO TO 10 DHSTEP = 1.0D0/DHSTEP GO TO 10 C-----SMALLER STEPS CLOSER TO MINIMUM 20 IF(DHSTEP .GT. 1.0)THEN H01 = DHFNAL DHFRS1 = DHFRS2 ENDIF DHSTEP = 0.5 * H01 30 DHFNAL = H01 DHFNAL = DHFNAL - DHSTEP KSTEP = KSTEP + 1 CALL H1CALC(2,DHFNAL,DXX,DHFRST) IF(DHLAST .EQ. DHFRST) GO TO 60 DHLAST = DHFRST C KPRINT = KPRINT + 1 C IF(KPRINT .LT. 10) GO TO 77 C IF (LDEBUG) WRITE(LUNOUT,90) DHFNAL,DHFRST,KSTEP,DXX,DHSTEP C 90 FORMAT(5X,'DHFNAL =',E13.6,5X,'DHFRST =',E10.3,5X,'NSTEP =',I3,5X, C /' DXX =',E13.4,5X,'DHSTEP =',E13.4) C KPRINT = 0 C 77 CONTINUE DHFRS2 = DHFRST FRACT= ABS((DXX-DXOLD)/DXX) IF(FRACT.LT. ACCUR) GO TO 70 DXOLD = DXX *** Changed the next line (RV, 15/8/96). C 46 IF((DHFRS1/DHFRS2) .LE. 0.0D0) GO TO 50 46 CONTINUE IF((DHFRS1.GE.0.AND.DHFRS2.LE.0).OR. - (DHFRS1.LE.0.AND.DHFRS2.GE.0))GOTO 50 *** End of modification. H01 = DHFNAL DHFRS1 = DHFRST 50 DHSTEP = DHSTEP * 0.5D0 GO TO 30 *** Slow convergence transverse diffusion. 60 CONTINUE IF(LDEBUG)WRITE(LUNOUT,'('' !!!!!! STEPPH WARNING : Sigma_T'', - '' did not converge in '',I5,'' iterations at E='',E12.5, - '' V/cm.''/26X,''Using result of last iteration: '',E12.5)') - KSTEP,EMAG,DXX DO 91 K = 1,2002 91 H1(K) = 0.0 RETURN *** Transverse diffusion did converge. 70 IF(LDEBUG) WRITE(LUNOUT,98) KSTEP 98 FORMAT(6X,'TRANSVERSE DIFFUSION CONVERGED AFTER ',I3,' ITERATIONS. /',/) RETURN *** Fix for poor convergence. 160 IF(DHFNAL .LT. 0.0D0) GO TO 876 DHFNAL = -10.0**(-10) DHSTEP = 100. KSTEP = 0 GO TO 146 *** No convergence. 876 CONTINUE PRINT *,' !!!!!! STEPPH WARNING : Sigma_T did not approach', - ' converge for E=',EMAG,' V/cm.' RETURN END +DECK,F0PLT1. SUBROUTINE F0PLT1(GASID) *----------------------------------------------------------------------- * F0PLT1 - Plots F0, F1, F2 and F3 * (Last changed on 3/10/98.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBDIST. REAL XPL(2002),YPL(2002),F0MIN,F0MAX CHARACTER*80 AUX CHARACTER*80 GASID INTEGER I,NC *** Determine maximum of F0, F1, F2 and F3 F0MAX=-1 F0MIN=-1 DO 10 I=1,NSTEP1 XPL(I)=I*ESTEP IF(F (I).GT.0.AND.F (I).GT.F0MAX)F0MAX=F (I) IF(F1(I).GT.0.AND.F1(I).GT.F0MAX)F0MAX=F1(I) IF(F2(I).GT.0.AND.F2(I).GT.F0MAX)F0MAX=F2(I) IF(F3(I).GT.0.AND.F3(I).GT.F0MAX)F0MAX=F3(I) IF(F (I).GT.0.AND.(F (I).LT.F0MIN.OR.F0MIN.LE.0))F0MIN=F (I) IF(F1(I).GT.0.AND.(F1(I).LT.F0MIN.OR.F0MIN.LE.0))F0MIN=F1(I) IF(F2(I).GT.0.AND.(F2(I).LT.F0MIN.OR.F0MIN.LE.0))F0MIN=F2(I) IF(F3(I).GT.0.AND.(F3(I).LT.F0MIN.OR.F0MIN.LE.0))F0MIN=F3(I) 10 CONTINUE *** Check range. IF(F0MAX.LE.0)THEN PRINT *,' !!!!!! F0PLT1 WARNING : Range is zero; F0,'// - ' F1, F2 and F3 not plotted.' RETURN ELSEIF(F0MIN.LE.0)THEN F0MIN=F0MAX/1000 ENDIF *** Prepare a frame, first choose axes. CALL GRAOPT('LOG-Y') * Plot frame. CALL GRCART(0.0,0.9*F0MIN,REAL(NSTEP1*ESTEP),1.1*F0MAX, - 'Energy [eV]','F0, F1, F2 and F3', - 'Electron energy distributions') * Prepare a label. IF(GASID.NE.' ')CALL GRCOMM(3,'Gas: '//GASID) CALL OUTFMT(REAL(EMAG),2,AUX,NC,'LEFT') CALL GRCOMM(1,'E = '//AUX(1:NC)//' V/cm') CALL OUTFMT(REAL(BMAG/10),2,AUX,NC,'LEFT') CALL GRCOMM(2,'B = '//AUX(1:NC)//' T') CALL OUTFMT(REAL(BTHETA),2,AUX,NC,'LEFT') CALL GRCOMM(2,'Angle = '//AUX(1:NC)//' degrees') *** Plot F0, copy the array. DO 20 I=1,NSTEP1 YPL(I)=F(I) 20 CONTINUE * Plot the curve. CALL GRATTS('FUNCTION-1','POLYLINE') CALL GRLINE(NSTEP1,XPL,YPL) *** Plot F1, copy the array. DO 30 I=1,NSTEP1 YPL(I)=F1(I) 30 CONTINUE * Plot the curve. CALL GRATTS('FUNCTION-2','POLYLINE') CALL GRLINE(NSTEP1,XPL,YPL) *** Plot F2, copy the array. DO 40 I=1,NSTEP1 YPL(I)=F2(I) 40 CONTINUE * Plot the curve. CALL GRATTS('FUNCTION-3','POLYLINE') CALL GRLINE(NSTEP1,XPL,YPL) *** Plot F3, copy the array. DO 50 I=1,NSTEP1 YPL(I)=F3(I) 50 CONTINUE * Plot the curve. CALL GRATTS('FUNCTION-4','POLYLINE') CALL GRLINE(NSTEP1,XPL,YPL) *** Close the plot and register. CALL GRNEXT CALL GRALOG('Plot of F0-F3 - Magboltz:') END +PATCH,MAGBOL2. +DECK,MIXER2. SUBROUTINE MIXER2(IFAIL) *----------------------------------------------------------------------- * MIXER2 - Fills arrays of collision frequency * can have a mixture of up to 4 gases. * (Last changed on 10/ 3/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,MAGBCROS. INTEGER P,I,J,K,IE,L,IF,JHI,JLOW,KPIN,IFAIL DOUBLE PRECISION QAUX(6,2002),EAUX(6),EIAUX(20), - QATT(MXNGAS,2002),PEQEL(MXNGAS,2002),PQEAUX(2002), - PEQIN(MXNGAS,2,2002),PQIAUX(2,2002), - EHALF,VIRIAL(MXNGAS),EHI,ELOW,F2,BP,RGAST LOGICAL MONTE *** Assume this will work. IFAIL=0 *** Assume no anisotropic cross sections. NISO=0 *** Initial settings of gas name etc. DO 10 I=1,MXNGAS NIN(I)=0 NAME(I)='000000000000000' KEL(I)=0 KIN(I,1)=0 KIN(I,2)=0 * Cross sections and energy levels. DO 1 J=1,6 EG(I,J)=0 DO 2 K=1,NSTEP1+1 Q(I,J,K)=0 2 CONTINUE 1 CONTINUE 10 CONTINUE DO 6 I=1,MXGLEV INDKIN(I)=0 6 CONTINUE *** Energy scale. ESTEP=EFINAL/DBLE(NSTEP) EHALF=ESTEP/2 DO 3 I=1,NSTEP1+1 ES(I)=EHALF+ESTEP*DBLE(I-1) EROOT(I)=SQRT(ES(I)) 3 CONTINUE *** Cleaned up version of gas data loading (RV 23/9/99). MONTE=.TRUE. DO 20 K=1,NGASES * Retrieve the gas. CALL GETGAS(K,QAUX,EAUX,EIAUX,VIRIAL(K),MONTE,PQEAUX,PQIAUX) * Transfer data. DO 30 I=1,6 EG(K,I)=EAUX(I) DO 40 J=1,NSTEP1+1 Q(K,I,J)=QAUX(I,J) 40 CONTINUE 30 CONTINUE DO 50 I=1,20 EI(K,I)=EIAUX(I) 50 CONTINUE DO 60 I=1,NSTEP1+1 PEQEL(K,I)=PQEAUX(I) PEQIN(K,1,I)=PQIAUX(1,I) PEQIN(K,2,I)=PQIAUX(2,I) 60 CONTINUE 20 CONTINUE C --------------------------------------------------------------- C CORRECTION OF NUMBER DENSITY DUE TO VIRIAL COEFFICIENT C CAN BE PROGRAMMED HERE NOT YET IMPLEMENTED. C----------------------------------------------------------------- C----------------------------------------------------------------- C CALCULATION OF COLLISION FREQUENCIES FOR AN ARRAY OF C ELECTRON ENERGIES IN THE RANGE ZERO TO EFINAL C C L=5*N-4 ELASTIC NTH GAS C L=5*N-3 IONISATION NTH GAS C L=5*N-2 ATTACHMENT NTH GAS C L=5*N-1 INELASTIC NTH GAS C L=5*N SUPERELASTIC NTH GAS C--------------------------------------------------------------- DO 700 IE=1,2000 KPIN=0 P=0 DO 440 K=1,NGASES PIN(2*K-1,IE)=0.0 PIN(2*K,IE)=0.0 PEL(K,IE)=0.0 IF(P+1.GT.MXGLEV)THEN PRINT *,' !!!!!! MIXER2 WARNING : Too many energy'// - ' levels; increase MXGLEV and recompile.' IFAIL=1 RETURN ENDIF P=P+1 L=5*(K-1)+1 CF(IE,P)=Q(K,2,IE)*VAN(K)*1.0E15 IF(KEL(K).EQ.1) PEL(K,IE)=PEQEL(K,IE) RGAST=1.0+EG(K,2)/2.0 RGAS(P)=RGAST EIN(P)=0.0 IPN(P)=0 IARRY(P)=L IF(EFINAL.GE.EG(K,3))THEN L=5*(K-1)+2 IF(P+1.GT.MXGLEV)THEN PRINT *,' !!!!!! MIXER2 WARNING : Too many energy'// - ' levels; increase MXGLEV and recompile.' IFAIL=1 RETURN ENDIF P=P+1 CF(IE,P)=Q(K,3,IE)*VAN(K)*1.0E15 RGAS(P)=RGAST EIN(P)=EG(K,3)/RGAST IPN(P)=1 IARRY(P)=L ENDIF IF(EFINAL.GE.EG(K,4))THEN L=5*(K-1)+3 IF(P+1.GT.MXGLEV)THEN PRINT *,' !!!!!! MIXER2 WARNING : Too many energy'// - ' levels; increase MXGLEV and recompile.' IFAIL=1 RETURN ENDIF P=P+1 CF(IE,P)=Q(K,4,IE)*VAN(K)*1.0E15 RGAS(P)=RGAST EIN(P)=0.0 IPN(P)=0 IARRY(P)=L ENDIF DO 450 J=1,NIN(K) L=5*(K-1)+4 IF(P+1.GT.MXGLEV)THEN PRINT *,' !!!!!! MIXER2 WARNING : Too many energy'// - ' levels; increase MXGLEV and recompile.' IFAIL=1 RETURN ENDIF P=P+1 CF(IE,P)=QIN(K,J,IE)*VAN(K)*1.0E15 IF(KIN(K,1).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN(K,1,IE) INDKIN(P)=KPIN ENDIF IF(KIN(K,2).EQ.J) THEN KPIN=KPIN+1 PIN(KPIN,IE)=PEQIN(K,2,IE) INDKIN(P)=KPIN ENDIF RGAS(P)=RGAST EIN(P)=EI(K,J)/RGAST IF(EI(K,J).LT.0.0) L=5*(K-1)+5 IPN(P)=0 IARRY(P)=L 450 CONTINUE 440 CONTINUE *** Store final number of energy levels. IPLAST=P C -------------------------------------------------------------------- C CALCULATION OF TOTAL COLLISION FREQUENCY C --------------------------------------------------------------------- TCF(IE)=0.0 DO 610 IF=1,IPLAST TCF(IE)=TCF(IE)+CF(IE,IF) 610 CONTINUE DO 620 IF=1,IPLAST IF(TCF(IE).EQ.0.0) GOTO 615 CF(IE,IF)=CF(IE,IF)/TCF(IE) GOTO 620 615 CF(IE,IF)=0.0 620 CONTINUE DO 630 IF=2,IPLAST CF(IE,IF)=CF(IE,IF)+CF(IE,IF-1) 630 CONTINUE TCF(IE)=TCF(IE)*EROOT(IE) 700 CONTINUE C ------------------------------------------------------------------- C CALCULATE NULL COLLISION FREQUENCY C ------------------------------------------------------------------- BP=EMAG*EMAG*CONST1 F2=EMAG*CONST3 ELOW=TMAX*(TMAX*BP-F2*SQRT(0.5*EFINAL))/ESTEP-1.0 ELOW=MIN(ELOW,SMALL) EHI=TMAX*(TMAX*BP+F2*SQRT(0.5*EFINAL))/ESTEP+1.0 *** Modification for high E and low ELIMIT (Steve Biagi, 10/3/00) IF(EHI.GT.10000.) EHI=10000. *** End of modification. DO 810 I=1,10 JLOW=2000-200*(11-I)+1+INT(ELOW) JHI=2000-200*(10-I)+INT(EHI) JLOW=MAX(JLOW,1) JHI=MIN(JHI,2000) DO 800 J=JLOW,JHI IF(TCF(J).GE.TCFMAX(I)) TCFMAX(I)=TCF(J) 800 CONTINUE 810 CONTINUE C ------------------------------------------------------------------- C CROSS SECTION DATA FOR INTEGRALS IN SUBROUTINE OUTPUT C --------------------------------------------------------------------- DO 900 I=1,NSTEP1+1 QTOT(I)=0 QEL(I) =0 QREL(I)=0.0 QSATT(I)=0.0 QSUM(I)=0.0 DO 910 K=1,NGASES QTOT(I)=QTOT(I)+AN(K)*Q(K,1,I) QEL(I) =QEL(I) +AN(K)*Q(K,2,I) QION(K,I)=Q(K,3,I)*AN(K) QATT(K,I)=Q(K,4,I)*AN(K) QSUM(I)=QSUM(I)+QION(K,I)+QATT(K,I) QSATT(I)=QSATT(I)+QATT(K,I) QREL(I)=QREL(I)+QION(K,I)-QATT(K,I) DO 920 J=1,NIN(K) QIN(K,J,I)=QIN(K,J,I)*AN(K) QSUM(I)=QSUM(I)+QIN(K,J,I) 920 CONTINUE 910 CONTINUE 900 CONTINUE C do i=1,10 C print '(2x,'' CF : '',10f10.5)',(cf(i,j),j=1,10) C enddo C print '(2x,'' TCF : '',10f10.5)',(tcf(i),i=1,10) C print '(2x,'' TCFMAX:'',10f10.5)',(tcfmax(i),i=1,10) C print '(2x,'' IARRY: '',32i3)',(iarry(i),i=1,mxglev) C print '(2x,'' KEL: '',4i3)',(kel(i),i=1,4) C print '(2x,'' PEL1: '',10f10.5)',(pel(1,j),j=1,10) C print '(2x,'' PEL2: '',10f10.5)',(pel(2,j),j=1,10) C print '(2x,'' PEL3: '',10f10.5)',(pel(3,j),j=1,10) C print '(2x,'' PEL4: '',10f10.5)',(pel(4,j),j=1,10) CC print '(2x,'' KIN1: '',4i3)',kin(1,1),kin(1,2) CC print '(2x,'' KIN2: '',4i3)',kin(2,1),kin(2,2) CC print '(2x,'' KIN3: '',4i3)',kin(3,1),kin(3,2) CC print '(2x,'' KIN4: '',4i3)',kin(4,1),kin(4,2) C print '(2x,'' INDKIN:'',32i3)',(indkin(i),i=1,mxglev) C print '(2x,'' PIN1: '',10f10.5)',(pin(1,j),j=1,10) C print '(2x,'' PIN2: '',10f10.5)',(pin(2,j),j=1,10) C print '(2x,'' PIN3: '',10f10.5)',(pin(3,j),j=1,10) C print '(2x,'' PIN4: '',10f10.5)',(pin(4,j),j=1,10) C print '(2x,'' PIN5: '',10f10.5)',(pin(5,j),j=1,10) C print '(2x,'' PIN6: '',10f10.5)',(pin(6,j),j=1,10) C print '(2x,'' PIN7: '',10f10.5)',(pin(7,j),j=1,10) C print '(2x,'' PIN8: '',10f10.5)',(pin(8,j),j=1,10) END +DECK,GETGAS. SUBROUTINE GETGAS(IREF,Q,E,EI,VIRIAL,MONTE,PEQEL,PEQIN) *----------------------------------------------------------------------- * GETGAS - Loads one gas. * (Last modified on 29/ 5/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. INTEGER NINAUX,KELAUX,KINAUX(2),IREF,I,J DOUBLE PRECISION Q(6,2002),QINAUX(20,2002),E(6),EI(20),VIRIAL, - PEQEL(2002),PEQIN(2,2002) CHARACTER*15 NAMAUX LOGICAL MONTE *** Initial values for anisotropic gasses. KINAUX(1)=0 KINAUX(2)=0 KELAUX=0 *** Identify the gas, first current gases. IF(IGAS(IREF).EQ.1)THEN CALL GAS1(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE, - PEQEL,PEQIN,KELAUX,KINAUX) NISO=1 ELSEIF(IGAS(IREF).EQ.2)THEN CALL GAS2(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.3)THEN CALL GAS3(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.4)THEN CALL GAS4(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.5)THEN CALL GAS5(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.6)THEN CALL GAS6(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.7)THEN CALL GAS7(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.8)THEN CALL GAS8(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.9)THEN CALL GAS9(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.10)THEN CALL GAS10(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.11)THEN CALL GAS11(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.12)THEN CALL GAS12(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.13)THEN CALL GAS13(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.14)THEN CALL GAS14(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.15)THEN CALL GAS15(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.16)THEN CALL GAS16(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.17)THEN CALL GAS17(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.18)THEN CALL GAS18(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.19)THEN CALL GAS19(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.20)THEN CALL GAS20(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.21)THEN CALL GAS21(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.22)THEN CALL GAS22(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.23)THEN CALL GAS23(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.24)THEN CALL GAS24(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.25)THEN CALL GAS25(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.26)THEN CALL GAS26(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE, - PEQEL,PEQIN,KELAUX,KINAUX) NISO=1 ELSEIF(IGAS(IREF).EQ.27)THEN CALL GAS27(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.28)THEN CALL GAS28(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.29)THEN CALL GAS29(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE, - PEQEL,PEQIN,KELAUX,KINAUX) NISO=1 ELSEIF(IGAS(IREF).EQ.30)THEN CALL GAS30(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.31)THEN CALL GAS31(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.32)THEN CALL GAS32(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.33)THEN CALL GAS33(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.34)THEN CALL GAS34(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.35)THEN CALL GAS35(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.36)THEN CALL GAS36(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) * Former gases. ELSEIF(IGAS(IREF).EQ.101)THEN CALL GAS101(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.102)THEN CALL GAS102(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.103)THEN CALL GAS103(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.104)THEN CALL GAS104(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.105)THEN CALL GAS105(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.106)THEN CALL GAS106(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.107)THEN CALL GAS107(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.108)THEN CALL GAS108(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.109)THEN CALL GAS109(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.110)THEN CALL GAS110(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.111)THEN CALL GAS111(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.112)THEN CALL GAS112(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.113)THEN CALL GAS113(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.114)THEN CALL GAS114(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.115)THEN CALL GAS115(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.116)THEN CALL GAS116(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.117)THEN CALL GAS117(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.118)THEN CALL GAS118(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.119)THEN CALL GAS119(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.120)THEN CALL GAS120(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.121)THEN CALL GAS121(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE, - PEQEL,PEQIN,KELAUX,KINAUX) NISO=1 ELSEIF(IGAS(IREF).EQ.122)THEN CALL GAS122(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.123)THEN CALL GAS123(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.124)THEN CALL GAS124(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.125)THEN CALL GAS125(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSEIF(IGAS(IREF).EQ.126)THEN CALL GAS126(Q,QINAUX,NINAUX,E,EI,NAMAUX,VIRIAL,MONTE) ELSE PRINT *,' !!!!!! GETGAS WARNING : Received an invalid'// - ' gas identifier.' ENDIF *** Transfer data. DO 10 I=1,20 DO 20 J=1,NSTEP1+1 QIN(IREF,I,J)=QINAUX(I,J) 20 CONTINUE 10 CONTINUE NIN(IREF)=NINAUX KEL(IREF)=KELAUX NAME(IREF)=NAMAUX KIN(IREF,1)=KINAUX(1) KIN(IREF,2)=KINAUX(2) END +DECK,SETB2. SUBROUTINE SETB2(EE,BB,BTH,TT,PP,NNMAX,IFAIL) *----------------------------------------------------------------------- * SETB2 - Sets constants for Magboltz 2. * (Last changed on 6/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,MAGBPARM. INTEGER LAST,I,J,K,NSCALE,IFAIL,IELOW,NNMAX DOUBLE PRECISION TOTFRAC,CORR REAL EE,BB,BTH,TT,PP *** Initialise constants. LOGICAL INIT DATA INIT/.FALSE./ IF(.NOT.INIT)THEN * Integral of error function. ERFINT( 1)=0.112462916 ERFINT( 2)=0.222702589 ERFINT( 3)=0.328626759 ERFINT( 4)=0.428392355 ERFINT( 5)=0.520499878 ERFINT( 6)=0.603856091 ERFINT( 7)=0.677801194 ERFINT( 8)=0.742100965 ERFINT( 9)=0.796908212 ERFINT(10)=0.842700793 ERFINT(11)=0.880205070 ERFINT(12)=0.910313978 ERFINT(13)=0.934007945 ERFINT(14)=0.952285120 ERFINT(15)=0.966105146 ERFINT(16)=0.976348383 ERFINT(17)=0.983790459 ERFINT(18)=0.989090502 ERFINT(19)=0.992790429 ERFINT(20)=0.995322265 ERFINT(21)=0.997020533 ERFINT(22)=0.998137154 ERFINT(23)=0.998856823 ERFINT(24)=0.999311486 ERFINT(25)=0.999593048 * Other constants. EOVM=SQRT(2.0*ECHARG/EMASS)*100.0 CONST3=SQRT(0.2*AWB)*1.0D-09 CONST4=CONST3*ALOSCH*1.0D-15 CONST5=CONST3/2 * Remember initialisation is done. INIT=.TRUE. ENDIF *** Assume this will work. IFAIL=0 *** Set the E field. EMAG=DBLE(EE) BMAG=DBLE(BB) BTHETA=DBLE(BTH) *** Pressure + temperature scaling and kT. TORR=DBLE(PP) TEMPC=DBLE(TT)-ABZERO CORR=ABZERO*TORR/(ATMOS*(ABZERO+TEMPC)) AKT=(ABZERO+TEMPC)*BOLTZ *** Set the number of iterations. NMAX=NNMAX *** Establish the gas mixture. NGASES=0 TOTFRAC=0.0 DO 10 I=1,MXGNAM IF(FRAMIX(I).GT.0)THEN * Ensure the limit on gas components is not exceeded. IF(NGASES.GE.MXNGAS)THEN PRINT *,' !!!!!! SETB2 WARNING : The mixture'// - ' consists of more than MXNGAS components.' PRINT *,' Ajust this'// - ' parameter and recompile the program.' IFAIL=1 RETURN ENDIF * Add a new gas to the list. NGASES=NGASES+1 FRAC(NGASES)=FRAMIX(I) TOTFRAC=TOTFRAC+FRAC(NGASES) IGAS(NGASES)=I ENDIF 10 CONTINUE *** Scale the fractions. IF(TOTFRAC.LE.0.OR.NGASES.LE.0)THEN PRINT *,' !!!!!! SETB2 WARNING : No gas present in the'// - ' mixture; setup aborted.' IFAIL=1 RETURN ENDIF DO 20 J=1,NGASES AN(J)=FRAC(J)*CORR*ALOSCH/TOTFRAC VAN(J)=FRAC(J)*CORR*CONST4/TOTFRAC 20 CONTINUE *** Initial values for velocity, diffusion. WX=0.0 WY=0.0 WZ=0.0 DIFXX=0.0 DIFYY=0.0 DIFZZ=0.0 DIFYZ=0.0 DIFXY=0.0 DIFXZ=0.0 DIFLN=0.0 DIFTR=0.0 *** MC parameters. LAST=0 TMAX=100.0 NSCALE=960000 NMAX=NMAX*NSCALE NSTEP=2000 NSTEP1=NSTEP+1 NOUT=10 THETA=0.785 PHI=0.1 DO 65 J=1,300 65 TIME(J)=0.0 DO 70 K=1,20 70 ICOLL(K)=0 DO 100 K=1,2000 100 SPEC(K)=0.0 DO 101 K=1,10 101 TCFMAX(K)=0.0 ALPHA=0.0 RSTART=0.666 ESTART=EFINAL/20.0 ITHRM=0 *** Calculate thermal velocity distribution integrals. CON=1.0D-13/SQRT(AMU/(2.0*BOLTZJ*(TEMPC+ABZERO))) *** Radians per picosecond. WB=AWB*BMAG*1.0D-12 *** Metres per picosecond. IF(BMAG.NE.0)EOVB=EMAG*1.D-9/BMAG *** Calculate EFINAL, starting from 0.5 eV. IF(EMAG.LT.1000*CORR)THEN EFINAL=0.5 ELSEIF(EMAG.LT.10000*CORR)THEN EFINAL=0.5 ELSEIF(EMAG.LT.100000*CORR)THEN EFINAL=8 ELSE EFINAL=32 ENDIF * Mix gasses, establishing energy scale. 2 CONTINUE CALL MIXER2(IFAIL) IF(IFAIL.NE.0)THEN PRINT *,' !!!!!! SETB2 WARNING : Mixing the gasses'// - ' failed; no transport properties computed.' IFAIL=1 RETURN ENDIF C call gasdmc * See whether this EFINAL is satisfactory. IF(BMAG.EQ.0.OR.BTHETA.EQ.0)THEN CALL ELIMIT(IELOW) ELSEIF(ABS(BTHETA-90).LT.0.001)THEN CALL ELIMITB(IELOW) ELSE CALL ELIMITC(IELOW) ENDIF IF(IELOW.EQ.1) THEN EFINAL=EFINAL*SQRT(2.0D0) ESTART=EFINAL/20.0 GOTO 2 ENDIF C print *,' At E=',EMAG,' Starting from EFINAL = ',efinal,' eV' END +DECK,PRINT1. SUBROUTINE PRINT1 *----------------------------------------------------------------------- * PRINT1 - Prints a header. * (Last changed on 2/10/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBMIX. +SEQ,PRINTPLOT. WRITE(LUNOUT,90) EMAG 90 FORMAT(2(/),5X,'ELECTRIC FIELD =',F8.1,' VOLTS/CM.') WRITE(LUNOUT,60) EFINAL 60 FORMAT(/,5X,'INTEGRATION FROM 0.0 TO ',F7.2,' EV.') IF(IDBUG .NE. 0) WRITE(LUNOUT,110) 110 FORMAT(15X,'Z',11X,'SUM',10X,'SSUM',9X,'SFB',9X,'QELM',10X, - 'QEF',11X,'F',12X,'DF',12X,'E') END +DECK,PRINT2. SUBROUTINE PRINT2 *----------------------------------------------------------------------- * PRINT2 - Prints a header. * (Last changed on 27/ 9/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. INTEGER L,I WRITE(6,1) 1 FORMAT(10X,'PROGRAM MAGBOLTZ 2 ',/) WRITE(6,10) NGASES 10 FORMAT(1H1,20X,'MONTE CARLO SOLUTION FOR MIXTURE OF ',I2,' GASES.' /,/,15X,'------------------------------------------------------') WRITE(6,30) (NAME(I),I=1,NGASES) 30 FORMAT(/,5X,' GASES USED =',5X,5(A15,5X,:)) WRITE(6,40) (FRAC(I),I=1,NGASES) 40 FORMAT(/,5X,' PERCENTAGE USED =',5(F15.3,5X,:)) WRITE(6,50) TEMPC,TORR 50 FORMAT(2(/),10X,'GAS TEMPERATURE =',F6.1,' DEGREES CENTIGRADE.',9X /,' GAS PRESSURE = ',F7.1,' TORR.') WRITE(6,60) EFINAL,NSTEP 60 FORMAT(2(/),5X,' INTEGRATION FROM 0.0 TO ',F8.2,' EV. IN ',I4,' S /TEPS. ') C IF(ITHRM.EQ.0) WRITE(6,64) C IF(ITHRM.NE.0) WRITE(6,65) C 64 FORMAT(2(/),' THERMAL MOTION OF GAS NOT INCLUDED') C 65 FORMAT(2(/),' THERMAL MOTION OF GAS INCLUDED') 74 WRITE(6,90) EMAG,BMAG,BTHETA,WB 90 FORMAT(2(/),' ELECTRIC FIELD =',F12.4,' VOLTS/CM. MAGNETIC FIEL /D =',F11.4,' KILOGAUSS.',/,' ANGLE BETWEEN ELECTRIC AND MAGNETIC /FIELD =',F10.3,' DEGREES.',/,' CYCLOTRON FREQ. =',E12.3,' RADIANS //PICOSECOND') WRITE(6,95) ESTART,RSTART 95 FORMAT(2(/),' INITIAL ELECTRON ENERGY =',F8.3,' EV. RANDOM NUMBE /R STARTER =',F9.5) WRITE(6,100) NMAX,TMAX 100 FORMAT(2(/),' TOTAL NUMBER OF REAL AND NULL COLLISIONS =',I9,5X,' 1MAXIMUM TIME BETWEEN COLLISIONS =',F7.2,' PICOSECONDS') WRITE(6,110) (TCFMAX(L),L=1,10) 110 FORMAT(2(/),' NULL COLLISION FREQUENCY AT 10 EQUALLY SPACED ENERG /Y INTERVALS (*10**12/SEC)',/,2X,10(E10.3,1X)) WRITE(6,111) (TCF(L),L=100,1900,200) 111 FORMAT(2(/),' REAL COLLISION FREQUENCY AT 10 EQUALLY SPACED ENERG /Y INTERVALS (*10**12/SEC)',/,2X,10(E10.3,1X)) END +DECK,MONTE. SUBROUTINE MONTE *----------------------------------------------------------------------- * MONTE - Calculates collision events and updates diffusion and * velocity. used with magnetic field B=0 and electric field * in z direction. * (Last changed on 5/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,PRINTPLOT. DOUBLE PRECISION XST(10000),YST(10000),ZST(10000),STO(10000), - RNDM2,STD1,STD2,SUME2,SUMZSQ,PHI0,THETA0, - SDIF,SUMXSQ,SUMYSQ,RDUM,E1,CONST6,CONST7,CONST9,ARAT,TDASH, - R1,R2,R5,R6,R9,R31,S1,S2,S3,S4, - F1,F2,F3,F4,F5,F6,F8,F9, - A,B,D,Q,U,CSQD,ARG1,ARGZ,TLIM,T,T2,BP,AP,E, - CX1DEL,CY1DEL,CZ1DEL,DCX1,DCY1,DCZ1,DCX2,DCY2,DCZ2,DELTAE, - CX1,CY1,CZ1,EI,EXTRA,COR1,ANO,VTOT,DFTP1,DFTP2 INTEGER I,J,JGAS,INTEM,ID,NCOL,NCOLM,PRINT,IJ,J1,J2,IT,PT,J2M,IE, - ICANS(MXGLEV) EXTERNAL RNDM2 *** Identification. IF(LIDENT)PRINT *,' /// ROUTINE MONTE ///' *** Set elastic anisotropy control. DO 20 I=1,MXGLEV ICANS(I)=0 DO 10 J=1,NGASES IF(IARRY(I).EQ.5*(J-1)+1.AND.KEL(J).EQ.1) ICANS(I)=1 10 CONTINUE 20 CONTINUE WX=0.0 WY=0.0 X=0.0 Y=0.0 Z=0.0 ST=0.0 STD1=0.0 STD2=0.0 SUME2=0.0 SUMZSQ=0.0 SUMXSQ=0.0 SUMYSQ=0.0 SMALL=1.0D-20 TMAX1=0.0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01 ARAT=EMASS/AMU INTEM=10 ITMAX=60 ID=0 NCOL=0 NNULL=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=9998 PRINT=0 TDASH=0.0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2*PI DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M R1=RNDM2(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,10) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) E=E1+(AP+BP*T)*T IE=INT(E/ESTEP)+1 IE=MIN(IE,2000) IF(TCF(IE).GT.TLIM)THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05*TCFMAX(I) C WRITE(6,'('' Warning null collision time increased.'')') GOTO 133 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=RNDM2(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM)THEN NNULL=NNULL+1 GOTO 133 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0+B/3.0) CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 CX1=DCX1*CONST7 CY1=DCY1*CONST7 CZ1=DCZ1*CONST7 X=X+DCX1*A Y=Y+DCY1*A Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0 SPEC(IE)=SPEC(IE)+1.0 WZ=Z/ST IF(ID.EQ.0) GOTO 121 STD2=STD2+T SDIF=ST-STO(NCOL) SUMXSQ=SUMXSQ+((X-XST(NCOL))**2)*T/SDIF SUMYSQ=SUMYSQ+((Y-YST(NCOL))**2)*T/SDIF IF(J1.LT.6) GOTO 121 STD1=STD1+T SUMZSQ=SUMZSQ+((Z-ZST(NCOL)-WZ*SDIF)**2)*T/SDIF 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM)THEN ID=ID+1 XID=DBLE(ID) NCOL=0 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=RNDM2(RDUM) I=0 140 I=I+1 IF(CF(IE,I).LT.R2) GOTO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).EQ.0) GOTO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=RNDM2(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 PT=IARRY(I) ICOLL(PT)=ICOLL(PT)+1 IF(E.LT.EI) THEN C WRITE(6,994) E,EI,J2 C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001 ENDIF S2=(S1*S1)/(S1-1.0) *** Anisotropy angle control, first anisotropy. IF(NISO.NE.0)THEN * Elastic anisotropy IF(ICANS(I).EQ.1) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) JGAS=1+(PT-1)/5 IF(PT.EQ.5*(JGAS-1)+1.AND.R31.GT.PEL(JGAS,IE)) F3=-F3 * Inelastic anisotropy ELSEIF(INDKIN(I).NE.0) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) IF(R31.GT.PIN(INDKIN(I),IE)) F3=-F3 * Isotropic ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF *** No anisotropic gas. ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF THETA0=ACOS(F3) PHI0=F4*RNDM2(RDUM) F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0-F3*SQRT(ARG1) E1=E*(1.-EI/(S1*E)-2.0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.)*(S1-1.)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0.AND.CSQD.GT.U) F6=-1.0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0) THEN C WRITE(6,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 C /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GOTO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 130 CONTINUE IF(ITHRM.NE.0) THEN C CALCULATE VELOCITY CHANGE DUE TO MOLECULAR MOTION IN GAS. S3=S1-1.0 S4=1.0/S3 ANO=S4*ARAT COR1=1.0/SQRT(ANO) R5=RNDM2(RDUM) R6=2.0*R5-1.0 R5=DABS(R6) DO 260 IJ=1,25 260 IF(R5.LT.ERFINT(IJ)) GOTO 261 IJ=26 261 CX1DEL=CON*(DBLE(IJ)-0.5)*COR1 IF(R6.LT.0.0) CX1DEL=-CX1DEL R5=RNDM2(RDUM) R6=2.0*R5-1.0 R5=DABS(R6) DO 262 IJ=1,25 262 IF(R5.LT.ERFINT(IJ)) GOTO 263 IJ=26 263 CY1DEL=CON*(DBLE(IJ)-0.5)*COR1 IF(R6.LT.0.0) CY1DEL=-CY1DEL R5=RNDM2(RDUM) R6=2.0*R5-1.0 R5=DABS(R6) DO 264 IJ=1,25 264 IF(R5.LT.ERFINT(IJ)) GOTO 265 IJ=26 265 CZ1DEL=CON*(DBLE(IJ)-0.5)*COR1 IF(R6.LT.0.0) CZ1DEL=-CZ1DEL VTOT=CONST9*SQRT(E) CX1DEL=VTOT*DCX2*S3+CX1DEL CY1DEL=VTOT*DCY2*S3+CY1DEL CZ1DEL=VTOT*DCZ2*S3+CZ1DEL VTOT=CONST9*SQRT(E1) CX1=VTOT*DCX1+CX1DEL CY1=VTOT*DCY1+CY1DEL CZ1=VTOT*DCZ1+CZ1DEL VTOT=SQRT(CX1*CX1+CY1*CY1+CZ1*CZ1) DCX1=CX1/VTOT DCY1=CY1/VTOT DCZ1=CZ1/VTOT E1=VTOT*VTOT/(CONST9*CONST9) ENDIF 133 CONTINUE C ------------------------------------------ PRINT=PRINT+1 IF(LDEBUG.AND.J1.EQ.10) WRITE(6,201) 201 FORMAT(/,' VEL POS TIME ENERGY COUNT / DIFTR(X) DIFTR(Y) DIFLN ',/) IF(PRINT.EQ.10) THEN WZ=WZ*1.0D+08 AVE=SUME2/ST IF(STD1.NE.0.0) DIFLN=5.0E+15*SUMZSQ/STD1 IF(STD2.NE.0.0) DFTP1=5.0D+15*SUMXSQ/STD2 IF(STD2.NE.0.0) DFTP2=5.0D+15*SUMYSQ/STD2 DIFTR=(DFTP1+DFTP2)/2.0 DIFXX=DFTP1 DIFYY=DFTP2 DIFZZ=DIFLN IF(LDEBUG)WRITE(6,202) WZ,Z,ST,AVE,ID,DFTP1,DFTP2,DIFLN 202 FORMAT(1X,F8.3,2(1X,E10.3),1X,F9.4,2X,I8,3X,3(2X,F8.1),/) PRINT=0 ENDIF C LOOP 210 CONTINUE C call rndm2prt C CONVERT CM/SEC WZ=WZ*1.0D06 DIFYZ=0.0 DIFXY=0.0 DIFXZ=0.0 END +DECK,MONTEA. SUBROUTINE MONTEA *----------------------------------------------------------------------- * MONTEA - Calculates collision events and updates diffusion and * velocity. Used with magnetic field B parallel to electric * field E in the z direction. * (Last changed on 5/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,PRINTPLOT. DOUBLE PRECISION XST(10000),YST(10000),ZST(10000),STO(10000), - RNDM2,STD1,STD2,SUME2,SUMZSQ,PHI0,THETA0, - SDIF,SUMXSQ,SUMYSQ,RDUM,E1,CONST6,CONST7,CONST9,TDASH, - R1,R2,R5,R9,R31,S1,S2, - F1,F2,F3,F4,F5,F6,F8,F9, - A,B,D,Q,U,CSQD,ARG1,ARGZ,TLIM,T,T2,BP,AP,E, - DCX1,DCY1,DCZ1,DCX2,DCY2,DCZ2,DELTAE, - CX1,CY1,CZ1,CX2,CY2,EI,EXTRA,VTOT,DFTP1,DFTP2, - SINWT,COSWT,DX,DY,WBT INTEGER ICANS(MXGLEV),I,J,JGAS,INTEM,ID,NCOL,NCOLM,PRINT,J1,J2, - IT,PT,J2M,IE EXTERNAL RNDM2 *** Identification. IF(LIDENT)PRINT *,' /// ROUTINE MONTEA ///' *** Set elastic anisotropy control. DO 20 I=1,MXGLEV ICANS(I)=0 DO 10 J=1,NGASES IF(IARRY(I).EQ.5*(J-1)+1.AND.KEL(J).EQ.1) ICANS(I)=1 10 CONTINUE 20 CONTINUE WX=0.0 WY=0.0 X=0.0 Y=0.0 Z=0.0 ST=0.0 STD1=0.0 STD2=0.0 SUME2=0.0 SUMXSQ=0.0 SUMYSQ=0.0 SUMZSQ=0.0 SMALL=1.0D-20 TMAX1=0.0 RDUM=RSTART E1=ESTART CONST9=CONST3*0.01 INTEM=10 ITMAX=60 ID=0 NCOL=0 NNULL=0 C NUMBER OD COLLISIONS FOR DE-CORRELATION NCOLM=9998 PRINT=0 TDASH=0.0 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C INITIAL VELOCITY VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2*PI DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M R1=RNDM2(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,10) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) E=E1+(AP+BP*T)*T IE=INT(E/ESTEP)+1 IE=MIN(IE,2000) IF(TCF(IE).GT.TLIM)THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05*TCFMAX(I) C WRITE(6,'('' Warning null collision time increased.'')') GOTO 133 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=RNDM2(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM)THEN NNULL=NNULL+1 GOTO 133 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0 WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) CONST6=SQRT(E1/E) CX2=CX1*COSWT-CY1*SINWT CY2=CY1*COSWT+CX1*SINWT VTOT=CONST9*SQRT(E) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) A=AP*T B=BP*T2 SUME2=SUME2+T*(E1+A/2.0+B/3.0) CONST7=CONST9*SQRT(E1) A=T*CONST7 NCOL=NCOL+1 DX=(CX1*SINWT-CY1*(1.0-COSWT))/WB X=X+DX DY=(CY1*SINWT+CX1*(1.0-COSWT))/WB Y=Y+DY Z=Z+DCZ1*A+T2*F1 ST=ST+T IT=INT(T+1.0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0 SPEC(IE)=SPEC(IE)+1.0 WZ=Z/ST IF(ID.EQ.0) GOTO 121 STD2=STD2+T SDIF=ST-STO(NCOL) SUMXSQ=SUMXSQ+((X-XST(NCOL))**2)*T/SDIF SUMYSQ=SUMYSQ+((Y-YST(NCOL))**2)*T/SDIF IF(J1.LT.6) GOTO 121 STD1=STD1+T SUMZSQ=SUMZSQ+((Z-ZST(NCOL)-WZ*SDIF)**2)*T/SDIF 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM)THEN ID=ID+1 XID=DBLE(ID) NCOL=0 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=RNDM2(RDUM) I=0 140 I=I+1 IF(CF(IE,I).LT.R2) GOTO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).EQ.0) GOTO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=RNDM2(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 PT=IARRY(I) ICOLL(PT)=ICOLL(PT)+1 IF(E.LT.EI) THEN C WRITE(6,994) E,EI,J2 C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001 ENDIF S2=(S1*S1)/(S1-1.0) *** Anisotropy angle control, first anisotropy. IF(NISO.NE.0)THEN * Elastic anisotropy IF(ICANS(I).EQ.1) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) JGAS=1+(PT-1)/5 IF(PT.EQ.5*(JGAS-1)+1.AND.R31.GT.PEL(JGAS,IE)) F3=-F3 * Inelastic anisotropy ELSEIF(INDKIN(I).NE.0) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) IF(R31.GT.PIN(INDKIN(I),IE)) F3=-F3 * Isotropic ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF *** No anisotropic gas. ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF THETA0=ACOS(F3) PHI0=F4*RNDM2(RDUM) F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0-F3*SQRT(ARG1) E1=E*(1.-EI/(S1*E)-2.0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.)*(S1-1.)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0.AND.CSQD.GT.U) F6=-1.0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0) THEN C WRITE(6,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 C /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GOTO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) C CALCULATE VELOCITY VECTORS AFTER COLLISION 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT 133 CONTINUE C ------------------------------------------ PRINT=PRINT+1 IF(LDEBUG.AND.J1.EQ.10) WRITE(6,201) 201 FORMAT(/,' VEL POS TIME ENERGY COUNT / DIFTR(X) DIFTR(Y) DIFLN ',/) IF(PRINT.EQ.10) THEN WZ=WZ*1.0D+08 AVE=SUME2/ST IF(STD1.NE.0.0) DIFLN=5.0E+15*SUMZSQ/STD1 IF(STD2.NE.0.0) DFTP1=5.0D+15*SUMXSQ/STD2 IF(STD2.NE.0.0) DFTP2=5.0D+15*SUMYSQ/STD2 DIFTR=(DFTP1+DFTP2)/2.0 DIFXX=DFTP1 DIFYY=DFTP2 DIFZZ=DIFLN IF(LDEBUG)WRITE(6,202) WZ,Z,ST,AVE,ID,DFTP1,DFTP2,DIFLN 202 FORMAT(1X,F8.3,2(1X,E10.3),1X,F9.4,2X,I8,3X,3(2X,F8.1),/) PRINT=0 ENDIF C LOOP 210 CONTINUE C CONVERT TO CM/SEC WZ=WZ*1.0D06 DIFXY=0.0 DIFYZ=0.0 DIFXZ=0.0 END +DECK,MONTEB. SUBROUTINE MONTEB *----------------------------------------------------------------------- * MONTEB - Calculates collision events and updates diffusion and * velocity. Subroutine handles magnetic field and electric * field, B along x-axis, E along z-axis (90 degrees). * (Last changed on 5/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,PRINTPLOT. DOUBLE PRECISION XST(10000),YST(10000),ZST(10000),STO(10000), - RNDM2,STD1,STD2,SUME2,SUMZSQ,PHI0,THETA0, - SUMXSQ,SUMYSQ,SUMYZ,RDUM,E1,CONST9,TDASH, - R1,R2,R5,R9,R31,S1,S2,F3,F4,F5,F6,F8,F9, - D,Q,U,CSQD,ARG1,ARGZ,TLIM,T,T2,E, - DCX1,DCY1,DCZ1,DCX2,DCY2,DCZ2,DELTAE, - CX1,CY1,CZ1,CX2,CY2,CZ2,EI,EXTRA,VTOT, - SINWT,COSWT,DELT,SUMDX,SUMTSQ,SUMLSQ,EBAR,A2,B2,C2, - DT2,DL2,WBT,EF100,DZ INTEGER ICANS(MXGLEV),I,J,JGAS,INTEM,ID,NCOL,NCOLM,PRINT,J1,J2, - IT,PT,J2M,IE,IK EXTERNAL RNDM2 *** Identification. IF(LIDENT)PRINT *,' /// ROUTINE MONTEB ///' *** Set elastic anisotropy control. DO 20 I=1,MXGLEV ICANS(I)=0 DO 10 J=1,NGASES IF(IARRY(I).EQ.5*(J-1)+1.AND.KEL(J).EQ.1) ICANS(I)=1 10 CONTINUE 20 CONTINUE *** Initial values for velocities etc. WX=0.0 X=0.0 Y=0.0 Z=0.0 ST=0.0 STD1=0.0 STD2=0.0 SUME2=0.0 SUMXSQ=0.0 SUMYSQ=0.0 SUMZSQ=0.0 SUMYZ=0.0 SUMLSQ=0.0 SUMTSQ=0.0 SMALL=1.0D-20 TMAX1=0.0 EF100=EMAG*100.0 RDUM=RSTART E1=ESTART INTEM=10 ITMAX=60 ID=0 NCOL=0 NNULL=0 C NUMBER OF COLLISIONS FOR DE-CORRELATION NCOLM=9998 PRINT=0 TDASH=0.0 CONST9=CONST3*0.01 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C INITIAL VELOCITY VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2*PI DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M R1=RNDM2(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,10) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0-COSWT))/WB E=E1+DZ*EF100 C IF(E.LT.0.0) WRITE(6,983) J2,DZ,E1,COSWT,SINWT,WBT,CY1 C983 FORMAT(2X,' J2=',I12,' DZ=',E12.3,' E1=',E12.3,' COSWT=',E12.3 C /,' SINWT=',E12.3,' WBT=',E12.3,' CY1=',E12.3) IE=INT(E/ESTEP)+1 IE=MIN(IE,2000) IF(TCF(IE).GT.TLIM)THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05*TCFMAX(I) C WRITE(6,'('' Warning null collision time increased.'')') GOTO 133 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=RNDM2(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM)THEN NNULL=NNULL+1 GOTO 133 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0 C CALC VELOCITY CX2=CX1 CY2=(CY1-EOVB)*COSWT+CZ1*SINWT+EOVB CZ2=CZ1*COSWT-(CY1-EOVB)*SINWT C CALC DIRECTION COSINE VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT NCOL=NCOL+1 C CALC NEW POSITION X=X+CX1*T Y=Y+EOVB*T+((CY1-EOVB)*SINWT+CZ1*(1.0-COSWT))/WB Z=Z+DZ ST=ST+T IT=INT(T+1.0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0 SPEC(IE)=SPEC(IE)+1.0 WZ=Z/ST WY=Y/ST SUMDX=SUMDX+CX1*CX1*T2 IF(ID.EQ.0) GOTO 121 STD2=STD2+T DELT=ST-STO(NCOL) SUMXSQ=SUMXSQ+((X-XST(NCOL))**2)*T/DELT IF(J1.LT.6) GOTO 121 STD1=STD1+T DELT=ST-STO(NCOL) SUMZSQ=SUMZSQ+((Z-ZST(NCOL)-WZ*DELT)**2)*T/DELT SUMYSQ=SUMYSQ+((Y-YST(NCOL)-WY*DELT)**2)*T/DELT SUMYZ=SUMYZ+(Z-ZST(NCOL)-WZ*DELT)*(Y-YST(NCOL)-WY*DELT)*T/DELT A2=(WZ*DELT)**2+(WY*DELT)**2 B2=(Z-WZ*DELT-ZST(NCOL))**2+(Y-WY*DELT-YST(NCOL))**2 C2=(Z-ZST(NCOL))**2+(Y-YST(NCOL))**2 DL2=(A2+B2-C2)**2/(4.0*A2) DT2=B2-DL2 SUMLSQ=SUMLSQ+DL2*T/DELT SUMTSQ=SUMTSQ+DT2*T/DELT 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM)THEN ID=ID+1 XID=DBLE(ID) NCOL=0 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=RNDM2(RDUM) I=0 140 I=I+1 IF(CF(IE,I).LT.R2) GOTO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).EQ.0) GOTO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=RNDM2(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 PT=IARRY(I) ICOLL(PT)=ICOLL(PT)+1 IF(E.LT.EI) THEN C WRITE(6,994) E,EI,J2 C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001 ENDIF S2=(S1*S1)/(S1-1.0) *** Anisotropy angle control, first anisotropy. IF(NISO.NE.0)THEN * Elastic anisotropy IF(ICANS(I).EQ.1) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) JGAS=1+(PT-1)/5 IF(PT.EQ.5*(JGAS-1)+1.AND.R31.GT.PEL(JGAS,IE)) F3=-F3 * Inelastic anisotropy ELSEIF(INDKIN(I).NE.0) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) IF(R31.GT.PIN(INDKIN(I),IE)) F3=-F3 * Isotropic ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF *** No anisotropic gas. ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF THETA0=ACOS(F3) PHI0=F4*RNDM2(RDUM) F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0-F3*SQRT(ARG1) E1=E*(1.-EI/(S1*E)-2.0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.)*(S1-1.)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0.AND.CSQD.GT.U) F6=-1.0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0) THEN C WRITE(6,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 C /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GOTO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) C CALCULATE VELOCITY VECTORS AFTER COLLISION 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT 133 CONTINUE C ------------------------------------------ PRINT=PRINT+1 IF(LDEBUG.AND.J1.EQ.10) WRITE(6,201) 201 FORMAT(/,' VELZ VELY POS TIME ENERGY COUNT / DIFXX DIFYY DIFZZ DIFYZ DIFLONG DIFTRANS',/) IF(PRINT.EQ.10) THEN WZ=WZ*1.0D+08 WY=WY*1.0D+08 IF(STD2.NE.0.0) DIFXX=5.0E+15*SUMXSQ/STD2 IF(STD1.NE.0.0) DIFYY=5.0E+15*SUMYSQ/STD1 IF(STD1.NE.0.0) DIFZZ=5.0E+15*SUMZSQ/STD1 IF(STD1.NE.0.0) DIFYZ=-5.0E+15*SUMYZ/STD1 IF(STD1.NE.0.0) DIFLN=5.0E+15*SUMLSQ/STD1 IF(STD1.NE.0.0) DIFTR=5.0E+15*SUMTSQ/STD1 EBAR=0.0 DO 300 IK=1,2000 300 EBAR=EBAR+ES(IK)*SPEC(IK)/TCF(IK) AVE=EBAR/ST IF(LDEBUG)WRITE(6,202) WZ,WY,Z,ST,AVE,ID,DIFXX,DIFYY,DIFZZ, /DIFYZ,DIFLN,DIFTR 202 FORMAT(2(F7.3,1X),2(E8.2,1X),1X,F7.4,2X,I6,6(1X,F8.1),/) PRINT=0 ENDIF C LOOP 210 CONTINUE C CONVERT TO CM/SEC WZ=WZ*1.0D06 WY=WY*1.0D06 DIFXZ=0.0 DIFXY=0.0 END +DECK,MONTEC. SUBROUTINE MONTEC *----------------------------------------------------------------------- * MONTEC - Calculates collision events and updates diffusion and * velocity. Subroutine solves motion in coordinate system * with B aligned along x axis and electric field E at an * angle BTHETA in the x-z plane. The velocity vectors and * diffusion are then rotated into the standard coordinate * frame with the electric field along z-axis and the B field * at an angle BTHETA to the electric field in the x-z plane. * (Last changed on 5/ 2/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,PRINTPLOT. DOUBLE PRECISION XST(10000),YST(10000),ZST(10000),STO(10000), - RNDM2,STD1,STD2,SUME2,SUMZSQ,PHI0,THETA0, - SUMXSQ,SUMYSQ,SUMXY,SUMYZ,SUMXZ,RDUM,E1,CONST9,TDASH, - R1,R2,R5,R9,R31,S1,S2,F1,F3,F4,F5,F6,F8,F9, - D,Q,U,CSQD,ARG1,ARGZ,TLIM,T,T2,E,RTHETA,RCS,RSN, - DCX1,DCY1,DCZ1,DCX2,DCY2,DCZ2,DELTAE, - CX1,CY1,CZ1,CX2,CY2,CZ2,EI,EXTRA,VTOT, - SINWT,COSWT,DELT,SUMTSQ,SUMLSQ,EBAR,A2,B2,C2, - DT2,DL2,WBT,DX,DZ,WXR,WYR,WZR,EFX100,EFZ100, - DIFXXR,DIFYYR,DIFZZR,DIFXYR,DIFXZR,DIFYZR INTEGER ICANS(MXGLEV),I,J,JGAS,INTEM,ID,NCOL,NCOLM,PRINT,J1,J2, - IT,PT,J2M,IE,IK EXTERNAL RNDM2 *** Identification. IF(LIDENT)PRINT *,' /// ROUTINE MONTEC ///' *** Set elastic anisotropy control. DO 20 I=1,MXGLEV ICANS(I)=0 DO 10 J=1,NGASES IF(IARRY(I).EQ.5*(J-1)+1.AND.KEL(J).EQ.1) ICANS(I)=1 10 CONTINUE 20 CONTINUE *** Initial values for velocities etc. X=0.0 Y=0.0 Z=0.0 ST=0.0 STD2=0.0 STD1=0.0 SUME2=0.0 SUMXSQ=0.0 SUMYSQ=0.0 SUMZSQ=0.0 SUMYZ=0.0 SUMXY=0.0 SUMXZ=0.0 SUMLSQ=0.0 SUMTSQ=0.0 SMALL=1.0D-20 TMAX1=0.0 C CALC ROTATION MATRIX ANGLES RCS=COS((BTHETA-90)*PI/180) RSN=SIN((BTHETA-90)*PI/180) C RTHETA=BTHETA*PI/180 EFZ100=EMAG*100.0*SIN(RTHETA) EFX100=EMAG*100.0*COS(RTHETA) F1=EMAG*CONST2*COS(RTHETA) EOVB=EOVB*SIN(RTHETA) RDUM=RSTART E1=ESTART INTEM=10 ITMAX=60 ID=0 NCOL=0 NNULL=0 NCOLM=9998 PRINT=0 TDASH=0.0 CONST9=CONST3*0.01 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C INITIAL VELOCITY VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2*PI DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ITMAX C MAIN LOOP DO 210 J1=1,ITMAX DO 133 J2=1,J2M R1=RNDM2(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,10) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0-COSWT))/WB DX=CX1*T+F1*T*T E=E1+DZ*EFZ100+DX*EFX100 C IF(E.LT.0.0) WRITE(6,983) J2,DZ,E1,COSWT,SINWT,WBT,CY1 C983 FORMAT(2X,' J2=',I12,' DZ=',E12.3,' E1=',E12.3,' COSWT=',E12.3 C /,' SINWT=',E12.3,' WBT=',E12.3,' CY1=',E12.3) IE=INT(E/ESTEP)+1 IE=MIN(IE,2000) IF(TCF(IE).GT.TLIM)THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05*TCFMAX(I) C WRITE(6,'('' Warning null collision time increased.'')') GOTO 133 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=RNDM2(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM)THEN NNULL=NNULL+1 GOTO 133 ENDIF C C CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION C ALSO UPDATE DIFFUSION AND ENERGY CALCULATIONS. T2=T*T IF(T.GE.TMAX1) TMAX1=T TDASH=0.0 C CALC VELOCITY CX2=CX1+F1*T CY2=(CY1-EOVB)*COSWT+CZ1*SINWT+EOVB CZ2=CZ1*COSWT-(CY1-EOVB)*SINWT C CALC DIRECTION COSINE VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT NCOL=NCOL+1 C CALC NEW POSITION X=X+DX Y=Y+EOVB*T+((CY1-EOVB)*SINWT+CZ1*(1.0-COSWT))/WB Z=Z+DZ ST=ST+T IT=INT(T+1.0) IT=MIN(IT,300) TIME(IT)=TIME(IT)+1.0 SPEC(IE)=SPEC(IE)+1.0 WZ=Z/ST WY=Y/ST WX=X/ST IF(ID.EQ.0) GOTO 121 IF(J1.LT.6) GOTO 121 STD1=STD1+T DELT=ST-STO(NCOL) SUMZSQ=SUMZSQ+((Z-ZST(NCOL)-WZ*DELT)**2)*T/DELT SUMYSQ=SUMYSQ+((Y-YST(NCOL)-WY*DELT)**2)*T/DELT SUMXSQ=SUMXSQ+((X-XST(NCOL)-WX*DELT)**2)*T/DELT SUMYZ=SUMYZ+(Z-ZST(NCOL)-WZ*DELT)*(Y-YST(NCOL)-WY*DELT)*T/DELT SUMXY=SUMXY+(X-XST(NCOL)-WX*DELT)*(Y-YST(NCOL)-WY*DELT)*T/DELT SUMXZ=SUMXZ+(X-XST(NCOL)-WX*DELT)*(Z-ZST(NCOL)-WZ*DELT)*T/DELT A2=(WZ*DELT)**2+(WY*DELT)**2 B2=(Z-WZ*DELT-ZST(NCOL))**2+(Y-WY*DELT-YST(NCOL))**2 C2=(Z-ZST(NCOL))**2+(Y-YST(NCOL))**2 DL2=(A2+B2-C2)**2/(4.0*A2) DT2=B2-DL2 SUMLSQ=SUMLSQ+DL2*T/DELT SUMTSQ=SUMTSQ+DT2*T/DELT 121 XST(NCOL)=X YST(NCOL)=Y ZST(NCOL)=Z STO(NCOL)=ST IF(NCOL.GE.NCOLM)THEN ID=ID+1 XID=DBLE(ID) NCOL=0 ENDIF C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=RNDM2(RDUM) I=0 140 I=I+1 IF(CF(IE,I).LT.R2) GOTO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).EQ.0) GOTO 666 C USE FLAT DISTRIBUTION OF ELECTRON ENERGY BETWEEN E-EION AND 0.0 EV C SAME AS IN BOLTZMANN R9=RNDM2(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 PT=IARRY(I) ICOLL(PT)=ICOLL(PT)+1 IF(E.LT.EI) THEN C WRITE(6,994) E,EI,J2 C994 FORMAT(2X,' WARNING ENERGY =',F8.3,' LESS THAN ENERGY LOSS EI=',F8 C /.3,' AT ITER=',I12,' DUE TO BINNING ERROR') C FIX ENERGY LOSS SMALLER THAN INCIDENT ENERGY IF ERROR OCCURS EI=E-0.0001 ENDIF S2=(S1*S1)/(S1-1.0) *** Anisotropy angle control, first anisotropy. IF(NISO.NE.0)THEN * Elastic anisotropy IF(ICANS(I).EQ.1) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) JGAS=1+(PT-1)/5 IF(PT.EQ.5*(JGAS-1)+1.AND.R31.GT.PEL(JGAS,IE)) F3=-F3 * Inelastic anisotropy ELSEIF(INDKIN(I).NE.0) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) IF(R31.GT.PIN(INDKIN(I),IE)) F3=-F3 * Isotropic ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF *** No anisotropic gas. ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF THETA0=ACOS(F3) PHI0=F4*RNDM2(RDUM) F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0-F3*SQRT(ARG1) E1=E*(1.-EI/(S1*E)-2.0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.)*(S1-1.)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0.AND.CSQD.GT.U) F6=-1.0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0) THEN C WRITE(6,9232) ITER,ID,E1 C9232 FORMAT(3X,'WARNING ARGZ= 0.0 AT ITER =',I10,' ID =',I10,' E1=',E1 C /2.3) DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GOTO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) C CALCULATE VELOCITY VECTORS AFTER COLLISION 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT 133 CONTINUE C ------------------------------------------ PRINT=PRINT+1 IF(LDEBUG.AND.J1.EQ.10) WRITE(6,201) 201 FORMAT(/,' VELZ VELY VELX POS TIME ENERGY CO /UNT DIFTXX DIFYY DIFZZ DIFYZ DIFXZ DIFXY',/) IF(PRINT.EQ.10) THEN WZ=WZ*1.0D+08 WY=WY*1.0D+08 WX=WX*1.0D+08 IF(STD1.NE.0.0) DIFXX=5.0E+15*SUMXSQ/STD1 IF(STD1.NE.0.0) DIFYY=5.0E+15*SUMYSQ/STD1 IF(STD1.NE.0.0) DIFZZ=5.0E+15*SUMZSQ/STD1 IF(STD1.NE.0.0) DIFYZ=5.0E+15*SUMYZ/STD1 IF(STD1.NE.0.0) DIFXZ=5.0E+15*SUMXZ/STD1 IF(STD1.NE.0.0) DIFXY=5.0E+15*SUMXY/STD1 EBAR=0.0 DO 300 IK=1,2000 300 EBAR=EBAR+ES(IK)*SPEC(IK)/TCF(IK) AVE=EBAR/ST C CALCULATE ROTATED VECTORS AND TENSOR . WZR=WZ*RCS-WX*RSN WYR=WY WXR=WZ*RSN+WX*RCS DIFXXR=DIFXX*RCS*RCS+DIFZZ*RSN*RSN+2.0*RCS*RSN*DIFXZ DIFYYR=DIFYY DIFZZR=DIFXX*RSN*RSN+DIFZZ*RCS*RCS-2.0*RCS*RSN*DIFXZ DIFXYR=RCS*DIFXY+RSN*DIFYZ DIFYZR=RSN*DIFXY-RCS*DIFYZ DIFXZR=(RCS*RCS-RSN*RSN)*DIFXZ-RSN*RCS*(DIFXX-DIFZZ) C OUTPUT ROTATED VECTORS AND TENSOR IF(LDEBUG)WRITE(6,202) WZR,WYR,WXR,Z,ST,AVE,ID, - DIFXXR,DIFYYR,DIFZZR,DIFYZR,DIFXZR,DIFXYR 202 FORMAT(3(F7.3,1X),2(E8.2,1X),1X,F7.4,2X,I6,6(1X,F8.1),/) PRINT=0 ENDIF C LOOP 210 CONTINUE C LOAD ROTATED VALUES INTO ARRAYS WZ=WZR WX=WXR WY=WYR DIFXX=DIFXXR DIFYY=DIFYYR DIFZZ=DIFZZR DIFYZ=DIFYZR DIFXZ=DIFXZR DIFXY=DIFXYR C CONVERT TO CM/SEC. WZ=WZ*1.0D06 WY=WY*1.0D06 WX=WX*1.0D06 END +DECK,ELIMIT. SUBROUTINE ELIMIT(IELOW) *----------------------------------------------------------------------- * ELIMIT - Calculates collision events and tests to find if the upper * energy limit for the electron energy is exceeded. * If energy limit is OK IELOW = 0 * If energy limit is exceeded IELOW = 1 * The test is carried out for a sample of collisions that are * smaller than the full sample by a factor of 1/ISAMP. * Used with magnetic field B=0 electric field in z direction. * (Last changed on 28/ 9/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBPARM. +SEQ,MAGBCONS. +SEQ,PRINTPLOT. DOUBLE PRECISION RNDM2,RDUM,E1,TDASH,DCX1,DCY1,DCZ1, - DCX2,DCY2,DCZ2,D,U,Q,PHI0,THETA0,EXTRA,EI,E, - F1,F2,F3,F4,F5,F6,F8,F9,R1,R2,R31,S1,S2,CONST6, - DELTAE,TLIM,AP,BP,T,ARG1,ARGZ,CSQD INTEGER IELOW,ICANS(MXGLEV),ISAMP,I,J,JGAS,INTEM,PT,J1,J2M,IE EXTERNAL RNDM2 *** Identification. IF(LIDENT)PRINT *,' /// ROUTINE ELIMIT ///' *** Set sample fraction. ISAMP=30 *** Set elastic anisotropy control. DO 20 I=1,MXGLEV ICANS(I)=0 DO 10 J=1,NGASES IF(IARRY(I).EQ.5*(J-1)+1.AND.KEL(J).EQ.1) ICANS(I)=1 10 CONTINUE 20 CONTINUE SMALL=1.0D-20 RDUM=RSTART E1=ESTART INTEM=10 TDASH=0.0 *** Initial direction cosines DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C BP=EMAG*EMAG*CONST1 F1=EMAG*CONST2 F2=EMAG*CONST3 F4=2*PI DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ISAMP *** Main loop. DO 210 J1=1,J2M R1=RNDM2(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,10) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T AP=DCZ1*F2*SQRT(E1) E=E1+(AP+BP*T)*T IE=INT(E/ESTEP)+1 IE=MIN(IE,2000) IF(TCF(IE).GT.TLIM)THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05*TCFMAX(I) GOTO 210 ENDIF *** Test for real or null collision TLIM=TCF(IE)/TLIM IF(RNDM2(RDUM).GT.TLIM)GOTO 210 *** Calculate direction cosines at instant before collision IF(IE.EQ.2000)THEN * Electron energy out of range IELOW=1 RETURN ENDIF TDASH=0.0 CONST6=SQRT(E1/E) DCX2=DCX1*CONST6 DCY2=DCY1*CONST6 DCZ2=DCZ1*CONST6+EMAG*T*CONST5/SQRT(E) C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=RNDM2(RDUM) I=0 140 I=I+1 IF(CF(IE,I).LT.R2) GOTO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).EQ.0) GOTO 666 EXTRA=RNDM2(RDUM)*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 PT=IARRY(I) IF(E.LT.EI) THEN EI=E-0.0001 ENDIF S2=(S1*S1)/(S1-1.0) *** Anisotropy angle control, first anisotropy. IF(NISO.NE.0)THEN * Elastic anisotropy IF(ICANS(I).EQ.1) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) JGAS=1+(PT-1)/5 IF(PT.EQ.5*(JGAS-1)+1.AND.R31.GT.PEL(JGAS,IE)) F3=-F3 * Inelastic anisotropy ELSEIF(INDKIN(I).NE.0) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) IF(R31.GT.PIN(INDKIN(I),IE)) F3=-F3 * Isotropic ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF *** No anisotropic gas. ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF THETA0=ACOS(F3) PHI0=F4*RNDM2(RDUM) F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0-F3*SQRT(ARG1) E1=E*(1.-EI/(S1*E)-2.0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.)*(S1-1.)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0.AND.CSQD.GT.U) F6=-1.0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0) THEN DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GOTO 210 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) C LOOP 210 CONTINUE IELOW=0 END +DECK,ELIMITB. SUBROUTINE ELIMITB(IELOW) *----------------------------------------------------------------------- * ELIMITB- Calculates collision events and tests to find if the upper * energy limit for the electron energy is exceeded. * If energy limit is OK IELOW = 0 * If energy limit is exceeded IELOW = 1 * The test is carried out for a sample of collisions that are * smaller than the full sample by a factor of 1/ISAMP. * Used with magnetic field B at 90 degrees to electric field. * (Last changed on 28/ 9/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,PRINTPLOT. DOUBLE PRECISION RNDM2,RDUM,E1,TDASH,DCX1,DCY1,DCZ1, - DCX2,DCY2,DCZ2,D,U,Q,PHI0,THETA0,EXTRA,EI,E,DZ, - F3,F4,F5,F6,F8,F9,R1,R2,R5,R9,R31,S1,S2, - CONST9, - DELTAE,TLIM,T,ARG1,ARGZ,CSQD,SINWT,COSWT, - CX1,CY1,CZ1,CX2,CY2,CZ2,WBT,VTOT,EF100 INTEGER IELOW,ICANS(MXGLEV),ISAMP,I,J,JGAS,INTEM,PT,J1,J2M,IE EXTERNAL RNDM2 *** Identification. IF(LIDENT)PRINT *,' /// ROUTINE ELIMITB ///' *** Set sampling fraction. ISAMP=30 *** Set elastic anisotropy control. DO 20 I=1,MXGLEV ICANS(I)=0 DO 10 J=1,NGASES IF(IARRY(I).EQ.5*(J-1)+1.AND.KEL(J).EQ.1) ICANS(I)=1 10 CONTINUE 20 CONTINUE SMALL=1.0D-20 EF100=EMAG*100.0 RDUM=RSTART E1=ESTART INTEM=10 TDASH=0.0 CONST9=CONST3*0.01 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2*PI DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ISAMP C MAIN LOOP DO 210 J1=1,J2M R1=RNDM2(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,10) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVB-CY1)*(1.0-COSWT))/WB E=E1+DZ*EF100 IE=INT(E/ESTEP)+1 IE=MIN(IE,2000) IF(TCF(IE).GT.TLIM)THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05*TCFMAX(I) GOTO 210 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=RNDM2(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM)GOTO 210 C C CALCULATE DIRECTION COSINES AT INSTANT BEFORE COLLISION C IF(IE.EQ.2000) THEN C ELECTRON ENERGY OUT OF RANGE IELOW=1 RETURN ENDIF TDASH=0.0 CX2=CX1 CY2=(CY1-EOVB)*COSWT+CZ1*SINWT+EOVB CZ2=CZ1*COSWT-(CY1-EOVB)*SINWT VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=RNDM2(RDUM) I=0 140 I=I+1 IF(CF(IE,I).LT.R2) GOTO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).EQ.0) GOTO 666 R9=RNDM2(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 PT=IARRY(I) IF(E.LT.EI) THEN EI=E-0.0001 ENDIF S2=(S1*S1)/(S1-1.0) *** Anisotropy angle control, first anisotropy. IF(NISO.NE.0)THEN * Elastic anisotropy IF(ICANS(I).EQ.1) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) JGAS=1+(PT-1)/5 IF(PT.EQ.5*(JGAS-1)+1.AND.R31.GT.PEL(JGAS,IE)) F3=-F3 * Inelastic anisotropy ELSEIF(INDKIN(I).NE.0) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) IF(R31.GT.PIN(INDKIN(I),IE)) F3=-F3 * Isotropic ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF *** No anisotropic gas. ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF THETA0=ACOS(F3) PHI0=F4*RNDM2(RDUM) F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0-F3*SQRT(ARG1) E1=E*(1.-EI/(S1*E)-2.0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.)*(S1-1.)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0.AND.CSQD.GT.U) F6=-1.0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0) THEN DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GOTO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT C LOOP 210 CONTINUE IELOW=0 END +DECK,ELIMITC. SUBROUTINE ELIMITC(IELOW) *----------------------------------------------------------------------- * ELIMITC- Calculates collision events and tests to find if the upper * energy limit for the electron energy is exceeded. * If energy limit is OK IELOW = 0 * If energy limit is exceeded IELOW = 1 * The test is carried out for a sample of collisions that are * smaller than the full sample by a factor of 1/ISAMP. * Used with magnetic field B at angles between 0 and 90 * degrees to the electric field. * (Last changed on 28/ 9/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. +SEQ,PRINTPLOT. DOUBLE PRECISION RNDM2,RDUM,E1,TDASH,DCX1,DCY1,DCZ1, - DCX2,DCY2,DCZ2,D,U,Q,PHI0,THETA0,EXTRA,EI,E,DX,DZ, - F1,F3,F4,F5,F6,F8,F9,R1,R2,R5,R9,R31,S1,S2, - CONST9,EOVB1,RTHETA,EFX100,EFZ100,WBT,VTOT, - DELTAE,TLIM,T,ARG1,ARGZ,CSQD,SINWT,COSWT, - CX1,CY1,CZ1,CX2,CY2,CZ2 INTEGER IELOW,ICANS(MXGLEV),ISAMP,I,J,JGAS,INTEM,PT,J1,J2M,IE EXTERNAL RNDM2 *** Identification. IF(LIDENT)PRINT *,' /// ROUTINE ELIMITC ///' *** Set sampling fraction. ISAMP=30 *** Set elastic anisotropy control. DO 20 I=1,MXGLEV ICANS(I)=0 DO 10 J=1,NGASES IF(IARRY(I).EQ.5*(J-1)+1.AND.KEL(J).EQ.1) ICANS(I)=1 10 CONTINUE 20 CONTINUE SMALL=1.0D-20 RTHETA=BTHETA*PI/180 EFZ100=EMAG*100.0*SIN(RTHETA) EFX100=EMAG*100.0*COS(RTHETA) F1=EMAG*CONST2*COS(RTHETA) EOVB1=EOVB*SIN(RTHETA) RDUM=RSTART E1=ESTART INTEM=10 TDASH=0.0 CONST9=CONST3*0.01 C C INITIAL DIRECTION COSINES C DCZ1=COS(THETA) DCX1=SIN(THETA)*COS(PHI) DCY1=SIN(THETA)*SIN(PHI) C VTOT=CONST9*SQRT(E1) CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT F4=2*PI DELTAE=EFINAL/DBLE(INTEM) J2M=NMAX/ISAMP C MAIN LOOP DO 210 J1=1,J2M R1=RNDM2(RDUM) I=INT(E1/DELTAE)+1 I=MIN(I,10) TLIM=TCFMAX(I) T=-LOG(R1)/TLIM+TDASH TDASH=T WBT=WB*T COSWT=COS(WBT) SINWT=SIN(WBT) DZ=(CZ1*SINWT+(EOVB1-CY1)*(1.0-COSWT))/WB DX=CX1*T+F1*T*T E=E1+DZ*EFZ100+DX*EFX100 IE=INT(E/ESTEP)+1 IE=MIN(IE,2000) IF(TCF(IE).GT.TLIM)THEN TDASH=TDASH+LOG(R1)/TLIM TCFMAX(I)=1.05*TCFMAX(I) GOTO 210 ENDIF C C TEST FOR REAL OR NULL COLLISION C R5=RNDM2(RDUM) TLIM=TCF(IE)/TLIM IF(R5.GT.TLIM)GOTO 210 C C CALCULATE DIRECTION COSINES AT INSTANT BEFORE COLLISION C IF(IE.EQ.2000) THEN C ELECTRON ENERGY OUT OF RANGE IELOW=1 RETURN ENDIF TDASH=0.0 CX2=CX1+F1*T CY2=(CY1-EOVB1)*COSWT+CZ1*SINWT+EOVB1 CZ2=CZ1*COSWT-(CY1-EOVB1)*SINWT VTOT=SQRT(CX2*CX2+CY2*CY2+CZ2*CZ2) DCX2=CX2/VTOT DCY2=CY2/VTOT DCZ2=CZ2/VTOT C --------------------------------------------------------------------- C DETERMINATION OF REAL COLLISION TYPE C --------------------------------------------------------------------- R2=RNDM2(RDUM) I=0 140 I=I+1 IF(CF(IE,I).LT.R2) GOTO 140 S1=RGAS(I) EI=EIN(I) IF(IPN(I).EQ.0) GOTO 666 R9=RNDM2(RDUM) EXTRA=R9*(E-EI) EI=EXTRA+EI C C GENERATE SCATTERING ANGLES AND UPDATE LABORATORY COSINES AFTER C COLLISION ALSO UPDATE ENERGY OF ELECTRON. C 666 PT=IARRY(I) IF(E.LT.EI) THEN EI=E-0.0001 ENDIF S2=(S1*S1)/(S1-1.0) *** Anisotropy angle control, first anisotropy. IF(NISO.NE.0)THEN * Elastic anisotropy IF(ICANS(I).EQ.1) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) JGAS=1+(PT-1)/5 IF(PT.EQ.5*(JGAS-1)+1.AND.R31.GT.PEL(JGAS,IE)) F3=-F3 * Inelastic anisotropy ELSEIF(INDKIN(I).NE.0) THEN R31=RNDM2(RDUM) F3=RNDM2(RDUM) IF(R31.GT.PIN(INDKIN(I),IE)) F3=-F3 * Isotropic ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF *** No anisotropic gas. ELSE F3=1.0-2.0*RNDM2(RDUM) ENDIF THETA0=ACOS(F3) PHI0=F4*RNDM2(RDUM) F8=SIN(PHI0) F9=COS(PHI0) ARG1=1.0-S1*EI/E ARG1=MAX(ARG1,SMALL) D=1.0-F3*SQRT(ARG1) E1=E*(1.-EI/(S1*E)-2.0*D/S2) E1=MAX(E1,SMALL) Q=SQRT((E/E1)*ARG1)/S1 Q=MIN(Q,1.0D0) THETA=ASIN(Q*SIN(THETA0)) F6=COS(THETA) U=(S1-1.)*(S1-1.)/ARG1 CSQD=F3*F3 IF(F3.LT.0.0.AND.CSQD.GT.U) F6=-1.0*F6 F5=SIN(THETA) DCZ2=MIN(DCZ2,1.0D0) VTOT=CONST9*SQRT(E1) ARGZ=SQRT(DCX2*DCX2+DCY2*DCY2) IF(ARGZ.EQ.0.0) THEN DCZ1=F6 DCX1=F9*F5 DCY1=F8*F5 GOTO 130 ENDIF DCZ1=DCZ2*F6+ARGZ*F5*F8 DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8) DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8) 130 CX1=DCX1*VTOT CY1=DCY1*VTOT CZ1=DCZ1*VTOT C LOOP 210 CONTINUE IELOW=0 END +DECK,OUTB2. SUBROUTINE OUTB2(VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL) *----------------------------------------------------------------------- * OUTB2 - Stores the results in the output arrays. * (Last changed on 12/ 5/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,PRINTPLOT. DOUBLE PRECISION SPECS(20),WMNX,WMNY,WMNZ,FREQINT,FREQELT, - FREQEL(MXNGAS),FREQSP(MXNGAS),FREINE(MXNGAS), - FREATT(MXNGAS),FREATTT,DELATT,ERRATT, - FREION(MXNGAS),FREIONT,DELION,ERRION, - ATTCH,SMSPEC,ENER,EPLT,DTMN,DLMN,DTOVMB,DLOVMB,FREQ REAL VBOL,XBOL,YBOL,WBOL,DBOL,OBOL,ABOL,BBOL INTEGER NREAL,NINEL,NELA,ILAST,I,J1,J2,K IF(LDEBUG)WRITE(LUNOUT,'(//,12(''----------''))') NREAL=NMAX-NNULL IF(LDEBUG)WRITE(LUNOUT,109) TMAX1,NNULL,NREAL 109 FORMAT(/,3X,'CALCULATED MAX. COLLISION TIME =',F7.2,' PICOSECONDS. /',/,3X,'NUMBER OF NULL COLLISIONS =',I9,' NUMBER OF REAL COLLISIO /NS =',I9) IF(LDEBUG)WRITE(LUNOUT,110) SPEC(2000) 110 FORMAT(/,6X,'NUMBER OF COLLISIONS IN LAST ENERGY BIN =',F6.1) *** Drift velocities. WMNZ=WZ*1.0D-05 WMNY=WY*1.0D-05 WMNX=WX*1.0D-05 IF(LDEBUG)WRITE(LUNOUT,940) WZ,WMNZ,WY,WMNY,WX,WMNX 940 FORMAT(/,10X,'Z DRIFT VELOCITY =',E11.4,' CM./SEC. =',E11.4,' /MICRONS/NANOSECOND',/,10X,'Y DRIFT VELOCITY =',E11.4,' CM./SEC. / =',E11.4,' MICRONS/NANOSECOND',/,10X,'X DRIFT VELOCITY =',E11.4, /' CM./SEC. =',E11.4,' MICRONS/NANOSECOND',/) * Output for interface. VBOL=MAX(0.0,REAL(WZ*1D-6)) XBOL=REAL(WX*1D-6) YBOL=REAL(WY*1D-6) WBOL=REAL(ATAN2(SQRT(WX**2+WY**2),WZ)) *** Compute diffusion coefficients. IF(BMAG.GT.0.AND.(BTHETA.GT.0.AND.BTHETA.LT.180))THEN IF(LDEBUG)WRITE(LUNOUT,954) 954 FORMAT(/,10X,' DIFFUSION IN CM**2/SEC.',/) IF(LDEBUG)WRITE(LUNOUT,955) - DIFXX,DIFYY,DIFZZ,DIFYZ,DIFXY,DIFXZ 955 FORMAT(/,10X,' DIFFUSION TENSOR DIFXX =',D10.3,' DIFYY =', - D10.3,'DIFZZ =',D10.3,/,28X,'DIFYZ =',D10.3,' DIFXY =', - D10.3,' DIFXZ =',D10.3,/) IF(ABS(BTHETA-90).LT.0.01.AND.LDEBUG)WRITE(LUNOUT,956) - DIFLN,DIFTR,DIFXX 956 FORMAT(/,10X,' DIFFUSION LONGITUDINAL =',D10.3, - ' DIFFUSION TRANSVERSE =',D10.3,/,10X, - ' DIFFUSION TRANSVERSE (OUT OF EB PLANE) =',D10.3,/) ELSE DTOVMB=DIFTR*EMAG/WZ DTMN=SQRT(2.0*DIFTR/WZ)*10000.0 IF(LDEBUG)WRITE(LUNOUT,950) DIFTR,DTOVMB,DTMN 950 FORMAT(/,10X,'TRANSVERSE DIFFUSION =',E10.3, - ' CM.**2/SEC. =',F9.3,' EV. =',F6.1, - ' MICRONS/CENTIMETER**0.5',/) DLOVMB=DIFLN*EMAG/WZ DLMN=SQRT(2.0*DIFLN/WZ)*10000. IF(LDEBUG)WRITE(LUNOUT,992) DIFLN,DLOVMB,DLMN 992 FORMAT(/,10X,'LONGITUDINAL DIFFUSION =',E10.3, - ' CM.**2/SEC. =',F9.3,' EV. =',F6.1, - ' MICRONS/CENTIMETER**0.5',/) ENDIF * Output for interface. DBOL=SQRT(2D-6*DIFZZ*TORR/VBOL) OBOL=SQRT(2D-6*0.5*(DIFXX+DIFYY)*TORR/VBOL) *** Mean energy. IF(LDEBUG)WRITE(LUNOUT,960) AVE 960 FORMAT(/,11X,'Mean electron energy =',F9.4,' eV.',/) *** Count frequencies of collisions. FREQ=NREAL/ST NINEL=0 NELA=0 DO 10 I=1,NGASES NELA=NELA+ICOLL(5*I-4) NINEL=NINEL+ICOLL(5*I-3)+ICOLL(5*I-2)+ICOLL(5*I-1)+ICOLL(5*I) 10 CONTINUE FREQINT=NINEL/ST FREQELT=NELA/ST IF(LDEBUG)WRITE(LUNOUT,220) FREQ,FREQINT,FREQELT 220 FORMAT(/,2X,'Total coll. freq. =',E9.3, - ' Inelastic coll. freq. =',E9.3, - ' Elastic coll. freq.=',E9.3,' (*10**12)/sec.',/) *** Collision time distribution. ILAST=INT(TMAX1)+1 IF(ILAST.GT.300) ILAST=300 IF(LDEBUG)WRITE(LUNOUT,1010) (TIME(I),I=1,ILAST) 1010 FORMAT(/,' Distribution of collision times in 1 picosecond', - ' bins'/,2(/),30(1X,10(F10.1,1X)/)) IF(LDEBUG)WRITE(LUNOUT,1050) (NAME(I),I=1,NGASES) 1050 FORMAT(/,' Collision frequencies sorted according to gas', - ' and type of collision in units of 10**12/sec.'//, - 8X,10(A15,:,15X)) FREATTT=0 FREIONT=0 DO 20 I=1,NGASES FREQEL(I)=ICOLL(5*I-4)/ST FREION(I)=ICOLL(5*I-3)/ST FREIONT=FREIONT+FREION(I) FREATT(I)=ICOLL(5*I-2)/ST FREATTT=FREATTT+FREATT(I) FREINE(I)=ICOLL(5*I-1)/ST FREQSP(I)=ICOLL(5*I )/ST 20 CONTINUE IF(LDEBUG)WRITE(LUNOUT,160) (FREQEL(I),I=1,NGASES) 160 FORMAT(2X,'Elastic =',10(E10.3,20X)) IF(LDEBUG)WRITE(LUNOUT,170) (FREQSP(I),I=1,NGASES) 170 FORMAT(2X,'Superelastic=',10(E10.3,20X)) IF(LDEBUG)WRITE(LUNOUT,180) (FREINE(I),I=1,NGASES) 180 FORMAT(2X,'Inelastic =',10(E10.3,20X)) IF(LDEBUG)WRITE(LUNOUT,190) (FREATT(I),I=1,NGASES) 190 FORMAT(2X,'Attachment =',10(E10.3,20X)) IF(LDEBUG)WRITE(LUNOUT,200) (FREION(I),I=1,NGASES) 200 FORMAT(2X,'Ionisation =',10(E10.3,20X)/) *** Estimate attachment and ionisation rates. IF(FREATTT.GT.0)THEN DELATT=SQRT(FREATTT*ST)/ST ERRATT=100.0*DELATT/FREATTT ELSE DELATT=0 ERRATT=0 ENDIF ATTCH=FREATTT/WZ*1.0D12 IF(FREIONT.GT.0)THEN DELION=SQRT(FREIONT*ST)/ST ERRION=100.0*DELION/FREIONT ELSE DELION=0 ERRION=0 ENDIF ALPHA=FREIONT/WZ*1.0D12 IF(LDEBUG)WRITE(LUNOUT,333) ALPHA,ERRION,ATTCH,ERRATT 333 FORMAT(/2X,'Ionisation rate /cm.=',E10.3,' +/-',F6.1,' %', - /2X,'Attachment rate /cm.=',E10.3,' +/-',F6.1,' %', - /2X,'Note that generated electrons not yet included.') * Output to interface. IF(ALPHA.GT.0)THEN ABOL=REAL(LOG(ALPHA/TORR)) ELSE ABOL=-30 ENDIF IF(ATTCH.GT.0)THEN BBOL=REAL(LOG(ATTCH/TORR)) ELSE BBOL=-30 ENDIF *** Energy distribution. IF(LDEBUG)WRITE(LUNOUT,'('' Normalised energy distribution''// - '' Energy [eV] Probability'')') * Compute sum over 100 bins each. 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) GOTO 350 J2=J2+1 SPECS(J2)=SMSPEC SMSPEC=0.0 J1=0 350 CONTINUE * Output the result. EPLT=EFINAL/20.0 DO 420 I=1,20 ENER=EPLT*(DBLE(I)-0.5) IF(LDEBUG)WRITE(LUNOUT,'(2X,F15.3,2X,E15.3)') ENER,SPECS(I) 420 CONTINUE END +DECK,F0PLT2. SUBROUTINE F0PLT2(GASID) *----------------------------------------------------------------------- * F0PLT2 - Plots the distribution functions. * (Last changed on 3/10/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,DIMENSIONS. CHARACTER*20 AUX CHARACTER*80 GASID INTEGER NC *** Plot the function. CALL GRAOPT('LOG-Y') * Plot frame. CALL GRGRP2(ES,SPEC,2000, - 'Energy [eV]','Distribution function', - 'Electron energy distribution') * Prepare a label. IF(GASID.NE.' ')CALL GRCOMM(3,'Gas: '//GASID) CALL OUTFMT(REAL(EMAG),2,AUX,NC,'LEFT') CALL GRCOMM(1,'E = '//AUX(1:NC)//' V/cm') CALL OUTFMT(REAL(BMAG/10),2,AUX,NC,'LEFT') CALL GRCOMM(2,'B = '//AUX(1:NC)//' T') *** Close the plot and register. CALL GRNEXT CALL GRALOG('Magboltz energy distribution plot:') END +PATCH,MAGGAS. +DECK,GAS1. SUBROUTINE GAS1(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE, - PEQEL,PEQIN,KKEL,KKIN) *----------------------------------------------------------------------- * GAS1 - CF4, Not in Magboltz 1. * (Last changed on 29/ 1/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION PEQEL(2002),PEQIN(2,2002),Q(6,2002), - QQIN(20,2002),E(6),EEIN(20),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(46),YEXC(46), - XION(52),YION(52),XATT(11),YATT(11),APOP,EN,A,B,FAC1,FAC2, - EFAC,VIRIAL,RAT4,ELF,FWD,BCK,XMT INTEGER KKEL,KKIN(2),I,J,NDATA,NVIB2,NVIB3,NVIB4,NVIB5,NVIB6, - NION,NATT,NEXC,NNIN CHARACTER*15 NNAME *** Energy vector. 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,18.0,20.0,25.0,30.0,35.0,40.0,45.0,50.0, /55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0,100., /110.,120.,130.,140.,150.,160.,170.,180.,190.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,1000., /1200.,1400.,2000.,2500.,3000.,4000.,5000.,6000.,8000.,10000., /20000.,100000./ DATA YION/0.0,0.016,0.21,.384,1.15,2.07,2.78,3.28,3.88,4.35, /4.69,5.03,5.36,5.57,5.72,5.85,5.95,6.05,6.16,6.24, /6.37,6.40,6.40,6.35,6.32,6.26,6.20,6.13,6.05,5.98, /5.67,5.39,5.13,4.91,4.73,4.58,4.15,3.85,3.60,3.25, /2.90,2.60,2.15,1.80,1.60,1.28,1.05,0.91,0.71,0.56, /0.28,.056/ 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,55.0,60.0,65.0,70.0,75.0,80.0,85.0, /90.0,95.0,100.,110.,120.,130.,140.,150.,160.,170., /180.,190.,200.,250.,300.,350.,400.,450.,500.,600., /1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.0,.045,.195,.360,0.54,0.84,1.05,1.44,1.65,1.81, /1.92,1.96,2.00,2.05,2.08,2.06,2.08,2.13,2.17,2.20, /2.21,2.19,2.18,2.16,2.16,2.16,2.19,2.20,2.21,2.22, /2.22,2.22,2.22,2.07,2.00,1.85,1.65,1.50,1.30,1.00, /0.56,0.25,0.13,0.06,0.03,.006/ C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO MARCH 1998 C ALLOWS SUPERELASTIC SCATTERING TO V4 VIBRATIONAL LEVEL C BORN ANGULAR DISTRIBUTION FOR V4 LEVEL C --------------------------------------------------------------- NNAME=' CF4 --1999--- ' KKIN(1)=2 KKIN(2)=4 KKEL=0 FAC1=1.00 FAC2=0.71 NNIN=7 NDATA=72 NVIB2=14 NVIB3=14 NVIB4=14 NVIB5=16 NVIB6=16 NION=52 NATT=11 NEXC=46 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 EEIN(1)=-0.0784 EEIN(2)=0.0784 EEIN(3)=0.1126 EEIN(4)=0.1589 EEIN(5)=0.3178 EEIN(6)=0.4767 EEIN(7)=12.5 APOP=EXP(EEIN(1)/AKT) EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.0768*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP/(1.0+APOP)*1.E-16 C 305 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.0768*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=((A*EN+B)+QQIN(2,I))*1.0/(1.0+APOP)*1.E-16 PEQIN(1,I)=0.5+(QQIN(2,I)-FAC1*QQIN(2,I))/QQIN(2,I) 400 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=0.0224*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(3,I)=((A*EN+B)+QQIN(3,I))*1.E-16 500 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=1.584*LOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EEIN(4) FWD=LOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=LOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.58 XMT=((1.5-FWD/(FWD+BCK))*QQIN(4,I)+RAT4*(A*EN+B))*1.0E-16 QQIN(4,I)=((A*EN+B)+QQIN(4,I))*1.E-16 PEQIN(2,I)=0.5+(QQIN(4,I)-XMT)/QQIN(4,I) 600 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE C QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS2. SUBROUTINE GAS2(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS2 - Argon, Magboltz 1 gas 40 *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20),XEN(44), - YXSEC(44),XENI(76),YXENI(76),XIN(26),YXSIN(26),YXPIN(26), - YXDIN(26),APOL,AA,DD,FF,A1,EN,AK,AK2,AK3,AK4,AN0,AN1,AN2, - SUM,SUMI,A,B,VIRIAL INTEGER LMAX,NNIN,NDATA,NIDATA,NXDATA,I,J CHARACTER*15 NNAME 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/ NNAME=' 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 C NNIN=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 EEIN(1)=11.55 EEIN(2)=13.0 EEIN(3)=14.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.GT.1.0) GOTO 100 IF(EN.EQ.0.0) Q(2,I)=7.79E-16 IF(EN.EQ.0.0) GOTO 200 AK=SQRT(EN/ARY) AK2=AK*AK AK3=AK2*AK AK4=AK3*AK AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK2*LOG(AK))-(PI*APOL/3.0)*AK2+ /DD*AK3+FF*AK4 AN1=(PI/15.0)*APOL*AK2-A1*AK3 AN2=PI*APOL*AK2/105.0 AN0=ATAN(AN0) AN1=ATAN(AN1) AN2=ATAN(AN2) SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 DO 10 J=2,LMAX-1 SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(ATAN(PI*APOL*AK2*SUMI)))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/AK2 GOTO 200 100 CONTINUE DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 230 DO 210 J=2,NIDATA IF(EN.LE.XENI(J)) GOTO 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 QQIN(1,I)=0.0 QQIN(2,I)=0.0 QQIN(3,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NXDATA IF(EN.LE.XIN(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.0E-16 IF(EN.LE.EEIN(2)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.0E-16 IF(EN.LE.EEIN(3)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.0E-16 400 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS3. SUBROUTINE GAS3(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS3 - Helium 4, extended Magboltz 1 gas 9 *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20),XEN(67), - YXSEC(67),EN,VIRIAL,A,B, - XION(48),YION(48),XEXC(25),YEXC(25),XEXS(34),YEXS(34) INTEGER NNIN,NDATA,NION,NEXC,NEXS,I,J CHARACTER*15 NNAME 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/ NNAME=' 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 -------------------------------------------------------------------- NNIN=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 EEIN(1)=19.82 EEIN(2)=20.61 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 700 DO 610 J=2,NEXS IF(EN.LE.XEXS(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I)+QQIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS4. SUBROUTINE GAS4(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS4 - Helium 3, extended Magboltz 1 gas 10 *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20),XEN(66), - YXSEC(66),XION(47),YION(47),XEXC(17),YEXC(17), - XEXS(29),YEXS(29),VIRIAL,EN,A,B INTEGER NNIN,NDATA,NION,NEXC,NEXS,I,J CHARACTER*15 NNAME 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/ NNAME=' 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 -------------------------------------------------------------------- NNIN=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 EEIN(1)=19.82 EEIN(2)=20.6 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 700 DO 610 J=2,NEXS IF(EN.LE.XEXS(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I)+QQIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS5. SUBROUTINE GAS5(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS5 - Neon, extended Magboltz 1 gas 24 *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20),VIRIAL, - XEN(43),YXSEC(43),XEXC(50),YEXC(50),XION(68),YION(68), - APOL,AA,DD,FF,A1,B1,A2,EN,AK,AN0,AN1,AN2,SUM,SUMI,A,B INTEGER NNIN,NDATA,NION,NEXC,LMAX,I,J CHARACTER*15 NNAME 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 NNAME=' NEON 92 ' NNIN=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 EEIN(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 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.GT.1.0) GOTO 100 IF(EN.EQ.0.0) Q(2,I)=0.161E-16 IF(EN.EQ.0.0) GOTO 200 AK=SQRT(EN/ARY) AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK*AK*LOG(AK))-(PI*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(PI*APOL*AK*AK*SUMI))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/(AK*AK) GOTO 200 100 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 370 DO 350 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.0E-16 370 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I) 900 CONTINUE IF(EFINAL.LT.EEIN(1)) NNIN=0 END +DECK,GAS6. SUBROUTINE GAS6(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS6 - Krypton, extended Magboltz 1 gas 20 * (Last changed on 26/ 9/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - XEN(84),YXSEC(84),XEXC(40),YEXC(40),XION(70),YION(70), - VIRIAL,AA,DD,FF,A1,APOL,EN,AK,AN0,AN1,AN2,A,B,SUM,SUMI INTEGER NNIN,LMAX,NDATA,NION,NEXC,I,J CHARACTER*15 NNAME DATA XEN/0.34,0.36,0.38,0.40,0.42,0.44,0.46,0.48,0.50,0.52, /0.54,0.56,0.58,0.60,0.62,0.64,0.66,0.68,0.70,0.72, /0.74,0.76,0.78,0.80,0.84,0.88,0.92,0.96,1.00,1.05, /1.10,1.20,1.30,1.40,1.60,1.80,2.00,2.20,2.40,2.60, /2.80,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./ DATA YXSEC/0.42,0.32,0.25,0.20,.182,.172,.168,.167,.166,.167, /.171,.175,.181,.191,.204,.219,.234,.250,.268,.290, /.312,.336,.361,.386,.442,.501,.563,.632,.705,.800, /.893,1.11,1.32,1.57,2.08,2.63,3.19,3.78,4.41,5.05, /5.71,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/ DATA XION/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,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./ 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/ DATA XEXC/9.915,10.0,10.5,11.0,11.5,12.0,12.5,13.0,14.0,15.0, /16.0,18.0,20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0, /90.0,100.,150.,200.,300.,400.,500.,600.,700.,800., /900.,1000.,1500.,2000.,3000.,4000.,6000.,8000.,10000.,20000./ DATA YEXC/0.00,0.06,0.06,0.08,0.12,0.17,0.23,0.31,0.47,0.68, /1.10,1.80,2.00,2.25,2.33,2.31,2.00,1.70,1.55,1.35, /1.20,1.10,0.80,0.65,0.47,0.38,0.32,0.28,0.25,.225, /.205,0.19,.135,.105,.078,.064,.044,.035,0.03,.017/ C NNAME=' KRYPTON HUNTER' 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 CROSS-SECTIONS CONSTRAINED BY ELECTRON SCATTERING AND PHASE SHIFT C ANALYSIS. C -------------------------------------------------------------------- C C PARAMETERS OF PHASE SHIFT ANALYSIS C APOL=16.737 LMAX=200 AA=-3.36 DD=178.8 FF=-283.3 A1=12.5 C NNIN=1 NDATA=84 NION=70 NEXC=40 E(1)=0.0 E(2)=2.0*EMASS/(83.80*AMU) E(3)=14.0 E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=9.915 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.GT.0.34) GOTO 100 IF(EN.EQ.0.0) Q(2,I)=39.727E-16 IF(EN.EQ.0.0) GOTO 200 AK=SQRT(EN/ARY) AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK*AK*LOG(AK))-(PI*APOL/3.0)*AK*A /K+DD*AK*AK*AK+FF*AK*AK*AK*AK AN1=(PI/15.0)*APOL*AK*AK-A1*AK*AK*AK AN2=PI*APOL*AK*AK/105.0 AN0=ATAN(AN0) AN1=ATAN(AN1) AN2=ATAN(AN2) SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 DO 10 J=2,LMAX-1 SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(ATAN(PI*APOL*AK*AK*SUMI)))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/(AK*AK) GOTO 200 100 CONTINUE DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 370 DO 350 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.0E-16 370 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I) 900 CONTINUE IF(EFINAL.LT.EEIN(1)) NNIN=0 END +DECK,GAS7. SUBROUTINE GAS7(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS7 - Xenon, extended Magboltz 1 gas 19 * (Last changed on 26/ 9/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - XEN(69),YXSEC(69),XEXC(45),YEXC(45),XION(76),YION(76), - VIRIAL,APOL,AA,DD,FF,A1,EN,AK,AN0,AN1,AN2,SUM,SUMI,A,B INTEGER NNIN,NDATA,NION,NEXC,LMAX,I,J CHARACTER*15 NNAME C DATA XEN/0.12,0.15,.175,0.20,.225,0.25,.275,0.30,0.35,0.40, /0.45,0.50,0.60,0.70,0.80,0.90,1.00,1.20,1.50,1.60, /1.80,2.00,2.20,2.40,2.60,2.80,3.00,3.30,3.60,4.00, /4.40,4.80,5.20,5.60,6.00,6.50,7.00,8.00,10.0,12.0, /15.0,20.0,25.0,30.0,40.0,50.0,60.0,80.0,100.,125., /150.,200.,250.,300.,400.,500.,600.,700.,800.,1000., /1500.,2000.,3000.,4000.,5000.,6000.,8000.,10000.,20000./ DATA YXSEC/17.2,13.2,10.7,8.60,6.80,5.25,4.05,3.15,2.05,1.35, /0.85,0.55,0.45,0.47,0.65,0.90,1.25,2.20,3.85,4.50, /5.85,7.35,8.95,10.6,12.4,14.3,16.1,18.8,21.4,24.1, /26.2,27.6,28.7,29.2,29.5,29.5,28.5,23.5,17.0,12.5, /9.35,6.62,5.73,5.11,4.05,2.78,1.95,1.39,1.50,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/ 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./ DATA YION/0.00,.123,.287,.462,.640,.832,1.01,1.20,1.38,1.55, /1.71,2.02,2.30,2.55,2.79,3.06,3.28,3.47,3.77,4.05, /4.32,4.53,4.69,4.81,5.02,5.24,5.42,5.54,5.64,5.70, /5.73,5.80,5.90,6.03,6.11,6.11,6.07,5.92,5.81,5.68, /5.42,5.13,4.73,4.36,4.03,3.75,3.51,3.30,3.09,2.94, /2.67,2.44,2.26,2.11,1.85,1.63,1.50,1.36,1.26,1.07, /.926,.815,.734,.667,.615,.571,.532,.469,.423,.384, /.353,.303,.268,.242,.222,.206/ DATA XEXC/8.32,8.50,9.00,9.50,10.0,10.5,11.0,11.5,12.0,12.5, /13.0,14.0,15.0,16.0,18.0,20.0,25.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,150.,200.,300.,400.,500., /600.,700.,800.,900.,1000.,1500.,2000.,2500.,3000.,4000., /5000.,6000.,8000.,10000.,20000./ DATA YEXC/0.00,.032,.152,0.24,0.39,0.58,0.72,0.84,1.01,1.26, /1.54,2.04,2.57,3.06,3.55,3.73,3.85,3.57,2.85,2.40, /2.10,1.85,1.66,1.52,1.38,1.00,0.80,.568,.465,.395, /.344,.302,.277,.252,.231,.165,.132,.110,.095,.075, /.063,.053,.042,.036,.020/ C NNAME=' XENON 89 ' C C -------------------------------------------------------------------- C DATA ON XENON NOT AS GOOD AS ARGON . DATA USED VELOCITY:HUNTER C KOZUMI:DIFFUSION. THE FIT ACHEIVES A MUCH BETTER AGREEMENT TO THE C DIFFUSION OF KOZUMI AND IS ONLY 1% WORSE THAN HUNTERS FIT TO HIS C OWN DATA. C DATA CONSTRAINED BY ELECTRON SCATTERING AND PHASE SHIFT ANALYSIS C RESULTS . IMPROVES DATA SET 1. C -------------------------------------------------------------------- C C PARAMETERS OF PHASE SHIFT ANALYSIS C APOL=27.292 LMAX=200 AA=-6.09 DD=490.2 FF=-627.5 A1=22.0 C NNIN=1 NDATA=69 NION=76 NEXC=45 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 EEIN(1)=8.32 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.GT.0.12) GOTO 100 IF(EN.EQ.0.0) Q(2,I)=130.51E-16 IF(EN.EQ.0.0) GOTO 200 AK=SQRT(EN/ARY) AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK*AK*LOG(AK))-(PI*APOL/3.0)*AK*A /K+DD*AK*AK*AK+FF*AK*AK*AK*AK AN1=(PI/15.0)*APOL*AK*AK-A1*AK*AK*AK AN2=PI*APOL*AK*AK/105.0 AN0=ATAN(AN0) AN1=ATAN(AN1) AN2=ATAN(AN2) SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 DO 10 J=2,LMAX-1 SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(ATAN(PI*APOL*AK*AK*SUMI)))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/(AK*AK) GOTO 200 100 CONTINUE DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 370 DO 350 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.0E-16 370 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I) 900 CONTINUE IF(EFINAL.LT.EEIN(1)) NNIN=0 END +DECK,GAS8. SUBROUTINE GAS8(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS8 - Methane, Magboltz 1 gas 29 *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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), - VIRIAL,EN,A,B INTEGER NNIN,NDATA,NVIB1,NVIB2,NION,NATT,NDIS1,NDIS2,NDIS3,NDIS4, - I,J CHARACTER*15 NNAME 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/ NNAME='METHANE 1994 ' NNIN=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 EEIN(1)=0.162 EEIN(2)=0.374 EEIN(3)=9.0 EEIN(4)=10.0 EEIN(5)=11.0 EEIN(6)=11.8 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(14)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NDIS1 IF(EN.LE.XDIS1(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NDIS2 IF(EN.LE.XDIS2(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 800 DO 710 J=2,NDIS3 IF(EN.LE.XDIS3(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 900 DO 810 J=2,NDIS4 IF(EN.LE.XDIS4(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(3,I)+QQIN(4,I)+QQIN(5,I)+ - QQIN(6,I)+QQIN(1,I)+QQIN(2,I) C 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS9. SUBROUTINE GAS9(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS9 - Ethane, version '99. * (Last changed on 28/5/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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), - VIRIAL,APOP,POPVH,EN,A,B,EFAC INTEGER NNIN,NDATA,NION,NATT,NVIB1,NVIB2,NVIB3,NVIB4,NVIB5, - NEXC,NEXC1,NEXC2,I,J CHARACTER*15 NNAME *** Cross section data. 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/ NNAME=' 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 --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.0358 EEIN(2)=0.0358 EEIN(3)=-0.117 EEIN(4)=0.117 EEIN(5)=0.148 EEIN(6)=0.182 EEIN(7)=0.366 EEIN(8)=0.548 EEIN(9)=8.2 EEIN(10)=10.3 EEIN(11)=17.0 APOP=EXP(EEIN(1)/AKT) POPVH=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 1300 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.003*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP/(1.0+APOP)*1.E-16 C 1300 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 1301 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.003*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=QQIN(2,I)*1.0/(1.0+APOP)*1.E-16 1301 CONTINUE C SUPERELASTIC VIB1 C QQIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EEIN(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)) QQIN(3,I)=(EN+EEIN(4))*(A*(EN+EEIN(4))+B)*1.E-16/EN QQIN(3,I)=QQIN(3,I)*POPVH/(1.0+POPVH) 305 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(4,I)=(A*EN+B)*1.E-16 QQIN(4,I)=QQIN(4,I)/(1.0+POPVH) 400 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(5,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(6,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(9,I)=(A*EN+B)*1.E-16 900 CONTINUE QQIN(10,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(10,I)=(A*EN+B)*1.E-16 990 CONTINUE QQIN(11,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(11,I)=(A*EN+B)*1.E-16 1990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+ - QQIN(9,I)+QQIN(10,I)+QQIN(11,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(11)) NNIN=10 IF(EFINAL.LE.EEIN(10)) NNIN=9 IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS10. SUBROUTINE GAS10(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS10 - Propane, version '99. * (Last changed on 28/5/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),APOP,EN,A,B,VIRIAL INTEGER NNIN,NDATA,NION,NATT,NVIB1,NVIB2,NVIB3,NVIB4,NEXC1,NEXC2, - NEXC3,I,J CHARACTER*15 NNAME *** Cross section data. 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 NNAME='PROPANE 1999 ' C --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.108 EEIN(2)=0.108 EEIN(3)=0.173 EEIN(4)=0.363 EEIN(5)=0.519 EEIN(6)=7.7 EEIN(7)=10.0 EEIN(8)=17.0 APOP=EXP(EEIN(1)/AKT) EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 1100 DO 1010 J=2,NVIB1 IF((EN+EEIN(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)) QQIN(1,I)=(EN+EEIN(2))*(A*(EN+EEIN(2))+B)*1.E-16/EN QQIN(1,I)=QQIN(1,I)*APOP/(1.0+APOP) 1100 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(2,I)=(A*EN+B)*1.E-16 QQIN(2,I)=QQIN(2,I)/(1.0+APOP) 400 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS11. SUBROUTINE GAS11(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS11 - Isobutane, version '99. * (Last changed on 28/5/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),APOP,HPOP,EN,A,B, - VIRIAL INTEGER NNIN,NDATA,NION,NATT,NVIB1,NVIB2,NVIB3,NVIB4,NVIB5,NEXC1, - NEXC2,NEXC3,I,J CHARACTER*15 NNAME *** Cross section data. 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-------------------------------------------------------- NNAME='ISOBUTANE 1999 ' C --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.052 EEIN(2)=0.052 EEIN(3)=-0.108 EEIN(4)=0.108 EEIN(5)=0.173 EEIN(6)=0.363 EEIN(7)=0.519 EEIN(8)=7.4 EEIN(9)=9.70 EEIN(10)=17.0 APOP=EXP(EEIN(1)/AKT) HPOP=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.EQ.0.0) GO TO 305 DO 301 J=2,NVIB1 IF((EN+EEIN(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)) QQIN(1,I)=(EN+EEIN(2))*(A*(EN+EEIN(2))+B)*1.E-16/EN QQIN(1,I)=APOP*QQIN(1,I)/(1.0+APOP) C 305 QQIN(2,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(2,I)=(A*EN+B)*1.E-16/(1.0+APOP) 4000 CONTINUE QQIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 1100 DO 307 J=2,NVIB2 IF((EN+EEIN(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)) QQIN(3,I)=(EN+EEIN(4))*(A*(EN+EEIN(4))+B)*1.E-16/EN QQIN(3,I)=HPOP*QQIN(3,I)/(1.0+HPOP) 1100 QQIN(4,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(4,I)=(A*EN+B)*1.E-16/(1.0+HPOP) 400 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(5,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(6,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(9,I)=(A*EN+B)*1.E-16 900 CONTINUE QQIN(10,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(10,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+ - QQIN(9,I)+QQIN(10,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(10)) NNIN=9 IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS12. SUBROUTINE GAS12(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS12 - CO2, Magboltz 1 gas 38 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), /XMOM(64),YMOM(64),XVIB1(39),YVIB1(39),XVIB2(29),YVIB2(29), /XVIB3(13),YVIB3(13),XVIB4(25),YVIB4(25),XVIB5(13),YVIB5(13), /XVIB6(13),YVIB6(13),XVIB7(13),YVIB7(13),XEXC1(8),YEXC1(8), /XATT(29),YATT(29),XEXC2(7),YEXC2(7),XEXC3(23),YEXC3(23), /XION(50),YION(50) CHARACTER*15 NNAME DATA XMOM/0.00,.001,.002,.003,.005,.007,.0085,.010,.015,0.02, /0.03,0.04,0.05,0.07,0.10,0.12,0.15,0.17,0.20,0.25, /0.30,0.35,0.40,0.50,0.70,1.00,1.20,1.30,1.50,1.70, /1.90,2.10,2.20,2.50,2.80,3.00,3.30,3.60,4.00,4.50, /5.00,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.17 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/600.,540.,380.,307.,237.,200.,182.,170.,138.,120., /97.0,85.0,76.0,63.0,50.0,44.0,36.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,1.50,1.95,2.50,3.50,4.06,4.60,5.10,5.56,6.00, /100.,1000.,100000./ DATA YVIB3/0.00,0.00,0.00,0.00,0.63,1.06,0.61,0.29,0.066,0.001, /.0001,.00001,0.0/ 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.0/ 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,0.00,.125,0.36,0.81,1.30,0.61,0.278,0.01,.001, /.0001,0.00,0.00/ DATA XVIB6/0.422,1.50,1.95,2.50,3.40,4.06,4.60,5.10,5.56,6.00, /100.,1000.,100000./ DATA YVIB6/0.00,0.00,0.00,0.00,0.210,0.444,0.18,0.00,0.00,0.00, /0.00,0.00,0.00/ DATA XVIB7/0.505,1.50,1.95,2.50,3.40,4.06,4.60,5.10,5.56,6.00, /100.,1000.,100000./ DATA YVIB7/0.00,0.00,0.00,0.00,0.310,0.59,0.280,0.00,0.00,0.00, /0.00,0.00,0.00/ 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,0.00,0.00,0.00,0.0/ 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,0.0/ DATA XEXC2/7.00,8.00,8.50,11.0,100.,1000.,100000./ DATA YEXC2/0.00,0.50,0.50,0.00,0.00,0.00,0.0/ 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.76,0.83,0.90,0.97,1.14,1.40,1.95,2.54,3.60, /4.80,5.60,6.30,6.60,6.00,3.20,2.15,1.35,0.75,0.40, /0.18,0.09,.022/ DATA XION/13.3,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,0.06,.104,.188,.359,.460,.532,.622,.729,.950, /1.21,1.45,1.63,1.78,1.92,2.04,2.15,2.28,2.56,2.79, /2.98,3.16,3.31,3.43,3.61,3.73,3.80,3.83,3.83,3.80, /3.71,3.62,3.52,3.26,3.03,2.61,2.31,2.06,1.86,1.69, /1.58,1.51,1.15,0.90,0.50,0.29,0.21,0.11,.063,.029/ NNAME='C02 NAKAMURA ' NNIN=10 NMOM=64 NVIB1=39 NVIB2=29 NVIB3=13 NVIB4=25 NVIB5=13 NVIB6=13 NVIB7=13 NEXC1=8 NATT=29 NEXC2=7 NEXC3=23 NION=50 E(1)=0.0 E(2)=2.0*EMASS/(44.0098*AMU) E(3)=13.3 E(4)=3.85 E(5)=0.0 E(6)=0.0 EEIN(1) = 0.083 EEIN(2) = 0.167 EEIN(3) = 0.252 EEIN(4) = 0.291 EEIN(5) = 0.339 EEIN(6) = 0.422 EEIN(7) = 0.505 EEIN(8) = 2.500 EEIN(9) = 7.000 EEIN(10) = 10.500 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 100 J=2,NMOM IF(EN.LE.XMOM(J)) GOTO 150 100 CONTINUE J=NMOM 150 A=(YMOM(J)-YMOM(J-1))/(XMOM(J)-XMOM(J-1)) B=(XMOM(J-1)*YMOM(J)-XMOM(J)*YMOM(J-1))/(XMOM(J-1)-XMOM(J)) Q(2,I)=1.0D-16*(A*EN+B) C QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 260 DO 200 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 250 200 CONTINUE J=NVIB1 250 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)) QQIN(1,I)=1.0D-16*(A*EN+B) C 260 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 360 DO 300 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 350 300 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)) QQIN(2,I)=1.0D-16*(A*EN+B) C 360 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 460 DO 400 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 450 400 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)) QQIN(3,I)=1.0D-16*(A*EN+B) C 460 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 560 DO 500 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 550 500 CONTINUE J=NVIB4 550 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)) QQIN(4,I)=1.0D-16*(A*EN+B) C 560 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 660 DO 600 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 650 600 CONTINUE J=NVIB5 650 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)) QQIN(5,I)=1.0D-16*(A*EN+B) C 660 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 760 DO 700 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GOTO 750 700 CONTINUE J=NVIB6 750 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)) QQIN(6,I)=1.0D-16*(A*EN+B) C 760 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 860 DO 800 J=2,NVIB7 IF(EN.LE.XVIB7(J)) GOTO 850 800 CONTINUE J=NVIB7 850 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)) QQIN(7,I)=1.0D-16*(A*EN+B) C 860 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 960 DO 900 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 950 900 CONTINUE J=NEXC1 950 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)) QQIN(8,I)=1.0D-16*(A*EN+B) C 960 CONTINUE Q(4,I)=0.0 IF(EN.LE.E(4)) GOTO 1060 DO 1000 J=2,NATT IF(EN.LE.XATT(J)) GOTO 1050 1000 CONTINUE J=NATT 1050 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 1060 CONTINUE QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 1160 DO 1100 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 1150 1100 CONTINUE J=NEXC2 1150 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)) QQIN(9,I)=1.0D-16*(A*EN+B) C 1160 CONTINUE QQIN(10,I)=0.0 IF(EN.LE.EEIN(10)) GOTO 1260 DO 1200 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 1250 1200 CONTINUE J=NEXC3 1250 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)) QQIN(10,I)=1.0D-16*(A*EN+B) C 1260 CONTINUE Q(3,I)=0.0 IF(EN.LE.E(3)) GOTO 1360 DO 1300 J=2,NION IF(EN.LE.XION(J)) GOTO 1350 1300 CONTINUE J=NION 1350 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 1360 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+ - QQIN(9,I)+QQIN(10,I) 9000 CONTINUE C C SAVE ON COMPUTING TIME C IF(EFINAL.LT.EEIN(10)) NNIN=9 IF(EFINAL.LT.EEIN(9)) NNIN=8 IF(EFINAL.LT.EEIN(8)) NNIN=7 IF(EFINAL.LT.EEIN(7)) NNIN=6 IF(EFINAL.LT.EEIN(6)) NNIN=5 IF(EFINAL.LT.EEIN(5)) NNIN=4 IF(EFINAL.LT.EEIN(4)) NNIN=3 IF(EFINAL.LT.EEIN(3)) NNIN=2 IF(EFINAL.LT.EEIN(2)) NNIN=1 IF(EFINAL.LT.EEIN(1)) NNIN=0 END +DECK,GAS13. SUBROUTINE GAS13(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS13 - Neopentane, Magboltz 1 gas 36 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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 --------------------------------------------------------------- NNAME='NEO-PENTANE 95 ' NNIN=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 EEIN(1)=0.052 EEIN(2)=0.108 EEIN(3)=0.173 EEIN(4)=0.363 EEIN(5)=0.519 EEIN(6)=7.2 EEIN(7)=9.50 EEIN(8)=17.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 4000 DO 4100 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 4000 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 400 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS14. SUBROUTINE GAS14(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS14 - Water, extended Magboltz 1 gas 7 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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/ NNAME='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 --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.025 EEIN(2)=0.025 EEIN(3)=-0.075 EEIN(4)=0.075 EEIN(5)=0.198 EEIN(6)=0.458 EEIN(7)=4.20 EEIN(8)=7.65 EEIN(9)=13.1 APOP1=DEXP(EEIN(1)/AKT) APOP2=DEXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GOTO 1300 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=AMP1*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 1300 QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 1400 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=AMP1*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=QQIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC ROT2 C 1400 QQIN(3,I)=0.0 IF(EN.LE.0.0) GOTO 1500 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=AMP2*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(3,I)=QQIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C ROT2 1500 QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 1600 EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=AMP2*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(4,I)=QQIN(4,I)/(1.0+APOP2)*1.D-16 C 1600 QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 700 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(9,I)=(A*EN+B)*1.E-16 800 CONTINUE C--------------------------------------------------------------------- Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(7,I)+QQIN(8,I)+QQIN(9,I)+ - QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+QQIN(4,I)+QQIN(5,I)+QQIN(6,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS15. SUBROUTINE GAS15(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS15 - Oxygen, Magboltz 1 gas 22 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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 ---------------------------------------------------------------------- NNAME=' OXYGEN 90 ' NNIN=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 EEIN(1)=0.002 EEIN(2)=0.193 EEIN(3)=0.386 EEIN(4)=0.579 EEIN(5)=0.772 EEIN(6)=0.977 EEIN(7)=1.627 EEIN(8)=4.50 EEIN(9)=6.10 EEIN(10)=8.40 EEIN(11)=9.30 C CALCULATE DENSITY CORRECTION FOR THREE BODY ATTACHMENT CROSS-SECTION FAC=ABZERO*TORR/((TEMPC+ABZERO)*760.0) C EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 9900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 250 IF(EN.GT.XATT(NATT)) GOTO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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)) GOTO 300 IF(EN.GT.X3ATT(N3ATT)) GOTO 300 DO 260 J=2,N3ATT IF(EN.LE.X3ATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NROT IF(EN.LE.XROT(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NVIB2 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NVIB3 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 800 DO 710 J=2,NVIB4 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 900 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 900 CONTINUE C QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 1000 DO 910 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 1000 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 1100 DO 1010 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 1100 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 1200 DO 1110 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GOTO 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)) QQIN(9,I)=(A*EN+B)*1.E-16 1200 CONTINUE C QQIN(10,I)=0.0 IF(EN.LE.EEIN(10)) GOTO 1300 DO 1210 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GOTO 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)) QQIN(10,I)=(A*EN+B)*1.E-16 1300 CONTINUE C QQIN(11,I)=0.0 IF(EN.LE.EEIN(11)) GOTO 1400 DO 1310 J=2,NEXC6 IF(EN.LE.XEXC6(J)) GOTO 1320 1310 CONTINUE J=NEXC6 1320 A=(YEXC6(J)-YEXC6(J-1))/(XEXC6(J)-XEXC6(J-1)) B=(XEXC6(J-1)*YEXC6(J)-XEXC6(J)*YEXC6(J-1))/(XEXC6(J-1)-XEXC6(J)) QQIN(11,I)=(A*EN+B)*1.E-16 1400 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+ - QQIN(9,I)+QQIN(10,I)+QQIN(11,I)-QQIN(1,I) 9900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(11)) NNIN=10 IF(EFINAL.LE.EEIN(10)) NNIN=9 IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS16. SUBROUTINE GAS16(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS16 - Nitrogen. * (Last changed on 29/ 1/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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), - EN,A,B,SUM,VIRIAL INTEGER NNIN,NELA,NROT,NVIB1,NVIB2,NVIB3,NVIB4,NVIB5,NVIB6, - NTRP1,NTRP3,NTRP5,NTRP7,NTRP8,NSNG2,NSNG5,NION,I,J,K CHARACTER*15 NNAME *** Cross section data. 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/ NNAME='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 -------------------------------------------------------------- NNIN=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 EEIN(1)=0.020 EEIN(2)=0.290 EEIN(3)=0.590 EEIN(4)=0.880 EEIN(5)=1.17 EEIN(6)=1.47 EEIN(7)=1.76 EEIN(8)=6.17 EEIN(9)=7.35 EEIN(10)=7.80 EEIN(11)=8.55 EEIN(12)=11.03 EEIN(13)=11.87 EEIN(14)=13.0 EN=-ESTEP IF(MONTE) 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--------------------------------------------------------------------- QQIN(1,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(1,I)=(A*EN+B)*1.E-16 C--------------------------------------------------------------------- 80 CONTINUE C--------------------------------------------------------------------- QQIN(2,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(2,I)=(A*EN+B)*1.E-16 110 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(3,I)=(A*EN+B)*1.E-16 140 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(4,I)=(A*EN+B)*1.E-16 170 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(5,I)=(A*EN+B)*1.E-16 200 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(6,I)=(A*EN+B)*1.E-16 230 CONTINUE C QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.E-16 260 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.E-16 350 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(9,I)=(A*EN+B)*1.E-16 410 CONTINUE C QQIN(10,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(10,I)=(A*EN+B)*1.E-16 470 CONTINUE C QQIN(11,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(11,I)=(A*EN+B)*1.E-16 560 CONTINUE C QQIN(12,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(12,I)=0.6666*(A*EN+B)*1.E-16 620 CONTINUE C QQIN(13,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(13,I)=(A*EN+B)*1.E-16 650 CONTINUE QQIN(14,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(14,I)=(A*EN+B)*1.E-16 710 CONTINUE C C SUM=0.0 DO 800 K=1,14 SUM=SUM+QQIN(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.EEIN(J)) NNIN=J-1 1000 CONTINUE END +DECK,GAS17. SUBROUTINE GAS17(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS17 - Nitric oxide (NO), Magboltz 1 gas 33 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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/ NNAME='NO 1995 ' C --------------------------------------------------------------------- C CALCULATE CORRECTION FACTOR FOR 3BODY ATTACHMENT CROSS-SECTION FAC=ABZERO*TORR/((TEMPC+ABZERO)*760.0) C--------------------------------------------- WRITE(6,100) 100 FORMAT(1H1) WRITE(6,100) FAC 101 FORMAT(' 3BODY ATTACHMENT INCLUDED DENSITY SCALING FACTOR =',F7.4) NNIN=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 EEIN(1)=0.100 EEIN(2)=0.2326 EEIN(3)=0.600 EEIN(4)=6.10 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 250 IF(EN.GT.XATT(NATT)) GOTO 250 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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)) GOTO 300 IF(EN.GT.XAT3(NAT3)) GOTO 300 DO 260 J=2,NAT3 IF(EN.LE.XAT3(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NROT1 IF(EN.LE.XROT1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS18. SUBROUTINE GAS18(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS18 - Nitrous oxide (N2O), Magboltz 1 gas 34 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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/ NNAME='N2O 1995 ' C --------------------------------------------------------------------- C SCALEAT = SCALE FACTOR TO ALLOW FOR DETATCHMENT COLLISIONS SCALEAT=0.04 NNIN=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 EEIN(1)=0.073 EEIN(2)=0.159 EEIN(3)=0.276 EEIN(4)=4.06 EEIN(5)=8.50 EEIN(6)=9.60 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 800 DO 710 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 900 DO 810 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS19. SUBROUTINE GAS19(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS19 - Ethene. * (Last changed on 5/ 2/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),VIRIAL, - AMP1,AMP2,AMP3,APOP,APOPH,EN,A,B,EFAC INTEGER NNIN,NDATA,NVIB1,NVIB2,NVIB3,NVIB4,NVIB5,NEXC1,NEXC2, - NEXC3,NION,NATT,I,J CHARACTER*15 NNAME *** Cross section data. 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/ NNAME='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 --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.117 EEIN(2)=0.117 EEIN(3)=-0.166 EEIN(4)=0.166 EEIN(5)=0.333 EEIN(6)=0.375 EEIN(7)=0.750 EEIN(8)=3.70 EEIN(9)=4.85 EEIN(10)=7.10 AMP1=0.091 AMP2=0.091 AMP3=0.10 APOP=EXP(EEIN(1)/AKT) APOPH=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 350 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=AMP1*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EEIN(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)) QQIN(1,I)=QQIN(1,I)+(EN+EEIN(2))*(A*(EN+EEIN(2))+B)/EN QQIN(1,I)=QQIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V7 QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 400 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=AMP1*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QQIN(2,I)=QQIN(2,I)+(A*EN+B) QQIN(2,I)=QQIN(2,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QQIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 4150 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=AMP2*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EEIN(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)) QQIN(3,I)=QQIN(3,I)+(EN+EEIN(4))*(A*(EN+EEIN(4))+B)/EN QQIN(3,I)=QQIN(3,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V2 + V3 (SUM OF VIBRATIONS AT 166 AND 201 MV) QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 450 EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=AMP2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QQIN(4,I)=QQIN(4,I)+(A*EN+B) QQIN(4,I)=QQIN(4,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3+2V2 (HARMONICS) QQIN(5,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GO TO 550 EFAC=SQRT(1.0-(EEIN(6)/EN)) QQIN(6,I)=AMP3*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QQIN(6,I)=(QQIN(6,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(9,I)=(A*EN+B)*1.D-16 800 CONTINUE C QQIN(10,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(10,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+ - QQIN(9,I)+QQIN(10,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(10)) NNIN=9 IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS20. SUBROUTINE GAS20(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS20 - Acetylene, Magboltz 1 gas 27 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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/ NNAME=' ACETYLENE 92 ' C --------------------------------------------------------------------- C C2H2 MODIFIED HAYASHI TO FIT GLOBAL DATA C --------------------------------------------------------------------- NNIN=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 EEIN(1)=0.0904 EEIN(2)=0.180 EEIN(3)=0.408 EEIN(4)=1.95 EEIN(5)=4.90 EEIN(6)=7.90 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 330 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 330 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 360 DO 340 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 360 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 430 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)) QQIN(3,I)=(A*EN+B)*1.E-16 430 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 460 DO 440 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 460 CONTINUE C 500 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 600 DO 510 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 700 DO 610 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS21. SUBROUTINE GAS21(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS21 - Hydrogen, not in Magboltz 1 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(20) DIMENSION XEN(51),YXSEC(51),XROT0(43),YROT0(43),XROT1(45),YROT1(45 /),XROT2(30),YROT2(30),XROT3(30),YROT3(30),XVIB1(37),YVIB1(37), /XVIB2(37),YVIB2(37),XVIB3(14),YVIB3(14),XVIB4(13),YVIB4(13), /XEXC1(18),YEXC1(18),XEXC2(21),YEXC2(21),XATT(25),YATT(25), /XION(70),YION(70),PJ(5) CHARACTER*15 NNAME 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, /17.00,17.30,17.59,18.09,18.14,18.19,18.09,17.89,17.69,16.90, /14.71,12.92,11.93,9.30,7.60,3.80,2.37,1.12,0.71,0.48, /0.35,0.22,0.15,0.07,.043,.022,.014,.010,.006,.004,.002/ C----------------------------------------------------------------------- C ROTATION J=0-2 DATA XROT0/.0439,.047,.050,.055,.060,.065,.070,.080,.090,0.10, /0.11,0.13,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.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,.0185,.027,.035,.042,.048,.053,.062,.068,.074, /.079,.088,.097,.115,.132,.152,.175,.200,.228,.260, /.323,.394,.469,.555,.636,.796,1.036,1.370,1.585,1.704, /1.755,1.758,1.732,1.689,1.579,1.462,1.350,1.248,1.156,0.730, /0.44,0.05,.0015/ 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./ DATA YROT1/0.00,.0070,.0140,.0198,.0237,.0265,.0280,.0330,.0364, /.0394,.0450,.0580,.0719,.0860,.1000,.1140,.1285,.1439,.1633,.1776, /.1996,.2135,.2518,.2919,.3338,.420,.510,.610,.700,.786, /.937,1.014,1.046,1.050,1.036,1.011,.946,.876,.809,.748, /.694,.440,.265,0.03,0.001/ C----------------------------------------------------------------------- C ROTATION J=2-4 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./ DATA YROT2/0.00,.0272,.0424,.0557,.0663,.0766,.0872,.0955,.1054, /.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/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./ DATA YROT3/0.00,.016,.037,.051,.062,.072,.082,.093,.104,.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 VIBRATION V=0-1 DELTAJ=0 ROTATIONALLY ELASTIC DATA XVIB1/0.516,0.56,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./ DATA YVIB1/0.00,.0028,.0053,.0082,.0143,.0206,.0280,.0322,.0363, /.0407,.0450,.0499,.0594,.0688,.0865,.1038,.1394,.1561,.1709,.1916, /.2008,.1860,.1630,.1460,.1160,.0876,.0637,.0506,.0376,.0292, /.0215,.0180,.0170,.0150,.0092,.0018,.00006/ 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./ DATA YVIB2/0.00,.0005,.0013,.0032,.0078,.0134,.0205,.0248,.0287, /.0333,.0380,.0437,.0549,.0653,.0892,.1139,.1639,.1869,.2121,.2494, /.2672,.2540,.2270,.2040,.1640,.1224,.0879,.0684,.0498,.0388, /.0285,.0200,.0150,.0100,.0062,.0012,.00004/ 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./ DATA YVIB3/0.00,.001,.002,.014,.035,.037,.035,.029,.021,.014, /.002,.001,.0003,.00001/ 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./ DATA YVIB4/0.00,.001,.0012,.0036,.0037,.0035,.0027,.0019,.0012, /.0002,.0001,.00003,.000001/ 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,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/ 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.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/ 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./ 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/ 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,.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/ C---------------------------------------------------------------------- NNAME=' H2 ' 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----------------------------------------------------------------------- NNIN=12 NDATA=51 NROT0=43 NROT1=45 NROT2=30 NROT3=30 NVIB1=37 NVIB2=37 NVIB3=14 NVIB4=13 NEXC1=18 NEXC2=21 NION=70 NATT=25 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 EEIN(1)=-.0439 EEIN(2)=-.0727 EEIN(3)=0.0439 EEIN(4)=0.0727 EEIN(5)=0.1008 EEIN(6)=0.128 EEIN(7)=0.516 EEIN(8)=0.558 EEIN(9)=1.023 EEIN(10)=1.480 EEIN(11)=8.85 EEIN(12)=12.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GOTO 1100 DO 1010 J=2,NROT0 IF((EN+EEIN(3)).LE.XROT0(J)) GOTO 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)) QQIN(1,I)=FROT2*0.2*(EN+EEIN(3))*(A*(EN+EEIN(3))+B)*1.E-16/EN 1100 CONTINUE C SUPERELASTIC 3-1 QQIN(2,I)=0.0 IF(EN.LE.0.0) GOTO 1200 DO 1110 J=2,NROT1 IF((EN+EEIN(4)).LE.XROT1(J)) GOTO 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)) QQIN(2,I)=FROT3*(3.0/7.0)*(EN+EEIN(4))*(A*(EN+EEIN(4))+B)*1.E-16/ - EN 1200 CONTINUE C ROTATION 0-2 QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 1400 DO 1310 J=2,NROT0 IF(EN.LE.XROT0(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16*FROT0 1400 CONTINUE C ROTATION 1-3 QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 1401 DO 1311 J=2,NROT1 IF(EN.LE.XROT1(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16*FROT1 1401 CONTINUE C ROTATION 2-4 +4-6 QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 1402 DO 1312 J=2,NROT2 IF(EN.LE.XROT2(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16*(FROT2+FROT4) 1402 CONTINUE C ROTATION 3-5 +5-7 QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 1403 DO 1313 J=2,NROT3 IF(EN.LE.XROT3(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16*(FROT3+FROT5) 1403 CONTINUE C----------------------------------------------------------------------- QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 501 DO 411 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(9,I)=(A*EN+B)*1.E-16 501 CONTINUE C QQIN(10,I)=0.0 IF(EN.LE.EEIN(10)) GOTO 502 DO 412 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 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)) QQIN(10,I)=(A*EN+B)*1.E-16 502 CONTINUE C----------------------------------------------------------------------- QQIN(11,I)=0.0 IF(EN.LE.EEIN(11)) GOTO 600 DO 510 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(11,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(12,I)=0.0 IF(EN.LE.EEIN(12)) GOTO 700 DO 610 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(12,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)+QQIN(11,I)+QQIN(12,I) C GET CORRECT ELASTIC XSECTION Q(2,I)=Q(2,I)-QQIN(1,I)-QQIN(2,I)-QQIN(3,I)-QQIN(4,I)-QQIN(5,I)- - QQIN(6,I)-QQIN(7,I)-QQIN(8,I)-QQIN(9,I)-QQIN(10,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(12)) NNIN=11 IF(EFINAL.LE.EEIN(11)) NNIN=10 IF(EFINAL.LE.EEIN(10)) NNIN=9 IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS22. SUBROUTINE GAS22(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS22 - Deuterium, not in Magboltz 1 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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---------------------------------------------------------------------- NNAME=' 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 WRITE(6,88) FROT0,FROT1,FROT2,FROT3,FROT4,FROT5,FROT6,FROT7 88 FORMAT(2X,' FROT0=',F9.5,' FROT1=',F9.5,' FROT2=',F9.5,' FROT3=', /F9.5,' FROT4=',F9.5,' FROT5=',F9.5,' FROT6=',F9.5,' FROT7=',F9.5) C----------------------------------------------------------------------- NNIN=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 EEIN(1)=-.0226 EEIN(2)=-.0377 EEIN(3)=-.0528 EEIN(4)=0.0226 EEIN(5)=0.0377 EEIN(6)=0.0528 EEIN(7)=0.0679 EEIN(8)=0.0830 EEIN(9)=0.0981 EEIN(10)=0.371 EEIN(11)=0.391 EEIN(12)=0.735 EEIN(13)=1.085 EEIN(14)=8.85 EEIN(15)=12.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GOTO 1100 DO 1010 J=2,NROT0 IF((EN+EEIN(4)).LE.XROT0(J)) GOTO 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)) QQIN(1,I)=FROT2*0.2*(EN+EEIN(4))*(A*(EN+EEIN(4))+B)*1.E-16/EN 1100 CONTINUE C SUPERELASTIC 3-1 QQIN(2,I)=0.0 IF(EN.LE.0.0) GOTO 1101 DO 1011 J=2,NROT1 IF((EN+EEIN(5)).LE.XROT1(J)) GOTO 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)) QQIN(2,I)=FROT3*(3.0/7.0)*(EN+EEIN(5))*(A*(EN+EEIN(5))+B)*1.E-16/ - EN 1101 CONTINUE C SUPERELASTIC 4-2 QQIN(3,I)=0.0 IF(EN.LE.0.0) GOTO 1102 DO 1012 J=2,NROT2 IF((EN+EEIN(6)).LE.XROT2(J)) GOTO 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)) QQIN(3,I)=FROT4*(5.0/9.0)*(EN+EEIN(6))*(A*(EN+EEIN(6))+B)*1.E-16/ - EN 1102 CONTINUE C ROTATION 0-2 QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 1400 DO 1310 J=2,NROT0 IF(EN.LE.XROT0(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16*FROT0 1400 CONTINUE C ROTATION 1-3 QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 1401 DO 1311 J=2,NROT1 IF(EN.LE.XROT1(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16*FROT1 1401 CONTINUE C ROTATION 2-4 QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 1402 DO 1312 J=2,NROT2 IF(EN.LE.XROT2(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16*FROT2 1402 CONTINUE C ROTATION 3-5 QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 1403 DO 1313 J=2,NROT3 IF(EN.LE.XROT3(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16*FROT3 1403 CONTINUE C ROTATION 4-6 + 6-8 QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 1404 DO 1314 J=2,NROT4 IF(EN.LE.XROT4(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16*(FROT4+FROT6) 1404 CONTINUE C ROTATION 5-7 + 7-9 QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 1405 DO 1315 J=2,NROT5 IF(EN.LE.XROT5(J)) GOTO 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)) QQIN(9,I)=(A*EN+B)*1.E-16*(FROT5+FROT7) 1405 CONTINUE C----------------------------------------------------------------------- QQIN(10,I)=0.0 IF(EN.LE.EEIN(10)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(10,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(11,I)=0.0 IF(EN.LE.EEIN(11)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(11,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(12,I)=0.0 IF(EN.LE.EEIN(12)) GOTO 501 DO 411 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(12,I)=(A*EN+B)*1.E-16 501 CONTINUE C QQIN(13,I)=0.0 IF(EN.LE.EEIN(13)) GOTO 502 DO 412 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 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)) QQIN(13,I)=(A*EN+B)*1.E-16 502 CONTINUE C----------------------------------------------------------------------- QQIN(14,I)=0.0 IF(EN.LE.EEIN(14)) GOTO 600 DO 510 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(14,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(15,I)=0.0 IF(EN.LE.EEIN(15)) GOTO 700 DO 610 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(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)+QQIN(14,I)+QQIN(15,I) C GET CORRECT ELASTIC XSECTION Q(2,I)=Q(2,I)-QQIN(1,I)-QQIN(2,I)-QQIN(3,I)-QQIN(4,I)-QQIN(5,I)- - QQIN(6,I)-QQIN(7,I)-QQIN(8,I)-QQIN(9,I)-QQIN(10,I)- - QQIN(11,I)-QQIN(12,I)-QQIN(13,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(15)) NNIN=14 IF(EFINAL.LE.EEIN(14)) NNIN=13 IF(EFINAL.LE.EEIN(13)) NNIN=12 IF(EFINAL.LE.EEIN(12)) NNIN=11 IF(EFINAL.LE.EEIN(11)) NNIN=10 IF(EFINAL.LE.EEIN(10)) NNIN=9 IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS23. SUBROUTINE GAS23(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS23 - Carbon monoxide (CO), not in Magboltz 1 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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 --------------------------------------------------------------- NNAME=' C-O 1998 ' NNIN=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 EEIN(1)=0.020 EEIN(2)=0.266 EEIN(3)=0.528 EEIN(4)=0.787 EEIN(5)=1.043 EEIN(6)=1.295 EEIN(7)=1.544 EEIN(8)=6.04 EEIN(9)=6.82 EEIN(10)=8.07 EEIN(11)=10.39 EEIN(12)=11.3 EEIN(13)=13.5 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 309 DO 301 J=2,NROT IF(EN.LE.XROT(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 309 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 800 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE C QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 900 DO 810 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 1000 DO 910 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 1000 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 1100 DO 1010 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(9,I)=(A*EN+B)*1.E-16 1100 CONTINUE C QQIN(10,I)=0.0 IF(EN.LE.EEIN(10)) GOTO 1200 DO 1110 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 1120 1110 CONTINUE J=NEXC2 1120 A=(YEXC2(J)-YEXC2(J-1))/(XEXC2(J)-XEXC2(J-1)) B=(XEXC2(J-1)*YEXC2(J)-XEXC2(J)*YEXC2(J-1))/(XEXC2(J-1)-XEXC2(J)) QQIN(10,I)=(A*EN+B)*1.E-16 1200 CONTINUE C QQIN(11,I)=0.0 IF(EN.LE.EEIN(11)) GOTO 1300 DO 1210 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(11,I)=(A*EN+B)*1.E-16 1300 CONTINUE C QQIN(12,I)=0.0 IF(EN.LE.EEIN(12)) GOTO 1400 DO 1310 J=2,NEXC4 IF(EN.LE.XEXC4(J)) GOTO 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)) QQIN(12,I)=(A*EN+B)*1.E-16 1400 CONTINUE C QQIN(13,I)=0.0 IF(EN.LE.EEIN(13)) GOTO 1500 DO 1410 J=2,NEXC5 IF(EN.LE.XEXC5(J)) GOTO 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)) QQIN(13,I)=(A*EN+B)*1.E-16 1500 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(8,I)+QQIN(9,I)+QQIN(10,I)+ - QQIN(11,I)+QQIN(12,I)+QQIN(13,I) C GET CORRECT ELASTIC SCATTERING Q(2,I)=Q(2,I)-QQIN(1,I)-QQIN(2,I)-QQIN(3,I)-QQIN(4,I)- - QQIN(5,I)-QQIN(6,I)-QQIN(7,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(13)) NNIN=12 IF(EFINAL.LE.EEIN(12)) NNIN=11 IF(EFINAL.LE.EEIN(11)) NNIN=10 IF(EFINAL.LE.EEIN(10)) NNIN=9 IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS24. SUBROUTINE GAS24(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS24 - Methylal (hot), Magboltz 1 gas 15 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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 NNAME='METHYLAL HOT ' NNIN=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 EEIN(1)=0.12 EEIN(2)=0.16 EEIN(3)=0.36 EEIN(4)=6.3 EEIN(5)=8.3 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP C DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 430 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 460 DO 440 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 460 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+QQIN(4,I)+ - QQIN(5,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS25. SUBROUTINE GAS25(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS25 - DME, not in Magboltz 1 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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/ NNAME=' 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 NNIN=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 EEIN(1)=-0.051 EEIN(2)=0.051 EEIN(3)=0.137 EEIN(4)=0.180 EEIN(5)=0.349 EEIN(6)=0.529 EEIN(7)=7.70 EEIN(8)=8.5 APOP=DEXP(EEIN(1)/AKT) EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.EQ.0.0) GOTO 390 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=AVIB1*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP/(1.0+APOP)*1.D-16 C 390 QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 400 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=AVIB1*LOG((1.0+EFAC)/(1.0-EFAC))/(EN*(1.0+APOP))*1.D-16 400 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 430 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)) QQIN(3,I)=(A*EN+B) EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=(QQIN(3,I)+AVIB2*LOG((1.0+EFAC)/(1.0-EFAC))/EN)*1.E-16 430 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 500 DO 440 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 600 DO 540 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 700 DO 640 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 800 DO 710 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 899 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 899 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS26. SUBROUTINE GAS26(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE, /PEQEL,PEQIN,KKEL,KKIN) *----------------------------------------------------------------------- * GAS26 - Reid step, anisotropic version *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBCONS. +SEQ,MAGBDATA. LOGICAL MONTE DIMENSION PEQEL(2002),PEQIN(2,2002),KKIN(2) DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(20) CHARACTER*15 NNAME C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO DECEMBER 1994 C --------------------------------------------------------------- NNAME='REID STEP(ANIS)' KKIN(1)=1 KKIN(2)=0 KKEL=0 NNIN=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 EEIN(1)=0.2 EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 QQIN(1,I)=10.0E-16 PEQIN(1,I)=0.5+(QQIN(1,I)-0.7*QQIN(1,I))/QQIN(1,I) 400 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+0.7*QQIN(1,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS27. SUBROUTINE GAS27(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS27 - Maxwell model. * (Last changed on 11/ 3/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20),SIGC,EN, - VIRIAL INTEGER NNIN,I CHARACTER*15 NNAME C ---------------------------------------------------------------- C MAXWELL MODEL DECEMBER 1994 C --------------------------------------------------------------- NNAME=' MAXWEL 1994-- ' NNIN=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)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/SQRT(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 END +DECK,GAS28. SUBROUTINE GAS28(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS28 - Reid ramp S=10 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(20) CHARACTER*15 NNAME C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO DECEMBER 1994 C --------------------------------------------------------------- NNAME=' REID RAMP S=10' NNIN=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 EEIN(1)=0.2 EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 QQIN(1,I)=(EN-EEIN(1))*10.0E-16 400 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS29. SUBROUTINE GAS29(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE, - PEQEL,PEQIN,KKEL,KKIN) *----------------------------------------------------------------------- * GAS29 - Hexafluoroethane. * (Received from Steve Biagi 18/11/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION PEQEL(2002),PEQIN(2,2002), - Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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), - VIRIAL,APOP1,APOP2,APOP3,EN,A,B,XTOT,XMOMT,EFAC,ELF,RAT3, - RAT4,FWD,BCK,XMT INTEGER NNIN,KKIN(2),KKEL,NDATA,NETOT,NVIB2,NVIB3,NVIB4,NVIB5, - NVIB6,NDISS,I,J,NATT,NION CHARACTER*15 NNAME *** Energy vector. 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 -------------------------------------------------------------------- NNAME=' C2F6 -1999--- ' KKIN(1)=5 KKIN(2)=6 KKEL=0 NNIN=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 EEIN(1)=-0.065 EEIN(2)=-0.1001 EEIN(3)=-0.1523 EEIN(4)=0.065 EEIN(5)=0.1001 EEIN(6)=0.1523 EEIN(7)=0.35 EEIN(8)=0.500 EEIN(9)=11.8 APOP1=EXP(EEIN(1)/AKT) APOP2=EXP(EEIN(2)/AKT) APOP3=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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(KKEL.EQ.0) Q(2,I)=XMOMT IF(KKEL.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 QQIN(1,I)=0.0 QQIN(2,I)=0.0 QQIN(3,I)=0.0 IF(EN.EQ.0.0) GO TO 305 C SUPERELASTIC OF VIBRATION V11 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.0363*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 260 J=2,NVIB2 IF((EN+EEIN(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)) QQIN(1,I)=QQIN(1,I)+(EN+EEIN(4))*(A*(EN+EEIN(4))+B)/EN QQIN(1,I)=QQIN(1,I)*APOP1/(1.0+APOP1)*1.E-16 C SUPERELASTIC OF VIBRATION V2 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.4230*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 280 J=2,NVIB3 IF((EN+EEIN(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)) QQIN(2,I)=QQIN(2,I)+(EN+EEIN(5))*(A*(EN+EEIN(5))+B)/EN QQIN(2,I)=QQIN(2,I)*APOP2/(1.0+APOP2)*1.E-16 C SUPERELASTIC OF VIBRATION V1 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=1.5000*DLOG((EFAC+1.0)/(EFAC-1.0))/EN DO 300 J=2,NVIB4 IF((EN+EEIN(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)) QQIN(3,I)=QQIN(3,I)+(EN+EEIN(6))*(A*(EN+EEIN(6))+B)/EN QQIN(3,I)=QQIN(3,I)*APOP3/(1.0+APOP3)*1.E-16 C 305 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 400 DO 310 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 320 310 CONTINUE J=NVIB2 320 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=0.0363*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(4,I)=((A*EN+B)+QQIN(4,I))*1.0/(1.0+APOP1)*1.E-16 400 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GO TO 500 DO 410 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GO TO 420 410 CONTINUE J=NVIB3 420 A=(YVIB3(J)-YVIB3(J-1))/(XVIB3(J)-XVIB3(J-1)) B=(XVIB3(J-1)*YVIB3(J)-XVIB3(J)*YVIB3(J-1))/(XVIB3(J-1)-XVIB3(J)) EFAC=SQRT(1.0-(EEIN(5)/EN)) QQIN(5,I)=0.4230*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EEIN(5) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM.T /TOT X-SECT FOR RESONANCE PART = RAT3 RAT3=0.80 XMT=((1.5-FWD/(FWD+BCK))*QQIN(5,I)+RAT3*(A*EN+B))*1.0E-16 XMT=XMT/(1.0+APOP2) QQIN(5,I)=((A*EN+B)+QQIN(5,I))*1.0/(1.0+APOP2)*1.E-16 PEQIN(1,I)=0.5+(QQIN(5,I)-XMT)/QQIN(5,I) 500 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GO TO 600 DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) EFAC=SQRT(1.0-(EEIN(6)/EN)) QQIN(6,I)=1.500*DLOG((1.0+EFAC)/(1.0-EFAC))/EN ELF=EN-EEIN(6) FWD=DLOG((EN+ELF)/(EN+ELF-2.0*SQRT(EN*ELF))) BCK=DLOG((EN+ELF+2.0*SQRT(EN*ELF))/(EN+ELF)) C ASSUME RATIO MOM T./ TOT X-SECT FOR RESONANCE PART = RAT4 RAT4=0.80 XMT=((1.5-FWD/(FWD+BCK))*QQIN(6,I)+RAT4*(A*EN+B))*1.0E-16 XMT=XMT/(1.0+APOP3) QQIN(6,I)=((A*EN+B)+QQIN(6,I))*1.0/(1.0+APOP3)*1.E-16 PEQIN(2,I)=0.5+(QQIN(6,I)-XMT)/QQIN(6,I) 600 CONTINUE C QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.E-16 700 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.E-16 800 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(9,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+QQIN(9,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS30. SUBROUTINE GAS30(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS30 - SF6. * (Last changed on 29/ 1/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - EN,EN2,EN3,BTA,BTA2,BTA3,QA1,QA2,QA3,QA4,QA5,VIRIAL INTEGER I,NNIN CHARACTER*15 NNAME C ---------------------------------------------------------------- C SF6 FILE FROM ITOH ET AL J.PHYS.D. 26 (1993) 1975-1979 C --------------------------------------------------------------- NNAME='SF6 ITOH ET AL ' NNIN=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 EEIN(1)=0.095 EEIN(2)=9.80 EN=-ESTEP IF(MONTE) 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*EXP(-0.00558*EN) GO TO 10 ENDIF IF(EN.LE.364.0) THEN Q(2,I)=1289.0*EN**(-1.118) GO TO 10 ENDIF Q(2,I)=4.881*EXP(-0.002807*EN) 10 Q(2,I)=Q(2,I)*1.D-16 Q(3,I)=0.0D0 IF(EN.LE.15.8) GO TO 20 IF(EN.LE.38.9) THEN Q(3,I)=4.715-0.693*EN+0.0306*EN2-0.0003508*EN3 GO TO 20 ENDIF IF(EN.LE.122.0) THEN Q(3,I)=6.986-EXP(2.07-0.0145*EN-0.00014*EN2) GO TO 20 ENDIF IF(EN.LE.201.0) THEN Q(3,I)=4.364+0.0323*EN-0.00009987*EN2 GO TO 20 ENDIF Q(3,I)=EXP(2.151-0.00115*EN) 20 Q(3,I)=Q(3,I)*1.D-16 Q(4,I)=0.0D0 QA1=0.0D0 IF(EN.EQ.0.0) THEN QA1=4000.0 GO TO 30 ENDIF IF(EN.GT.25.0) THEN QA5=0.0D0 GO TO 70 ENDIF IF(EN.LE.0.14) THEN QA1=436.0*(0.0617*SQRT(1.0/EN)*EXP(-1.0*(EN/0.0045)**2)+ /EXP(-EN/0.0559)) GO TO 30 ENDIF IF(EN.LE.0.9746) THEN QA1=EXP(6.477-20.91*EN+1.183*EN2) ENDIF 30 Q(4,I)=QA1*1.D-16 QA2=0.0D0 IF(EN.LE.0.312) THEN QA2=2.85*EN+5.419*EN2+30.49*EN3 GO TO 40 ENDIF IF(EN.LE.0.425) THEN QA2=468.0*EN3-624.3*EN2+268.1*EN-34.75 GO TO 40 ENDIF IF(EN.LE.1.05) THEN QA2=8.751-22.15*EN+19.08*EN2-5.592*EN3 GO TO 40 ENDIF QA2=EXP(8.054-10.42*EN) 40 Q(4,I)=Q(4,I)+QA2*1.D-16 QA3=0.0D0 IF(EN.LT.2.19) GO TO 50 IF(EN.LE.2.90) THEN QA3=-0.1069+0.08552*EN-0.01676*EN2 GO TO 50 ENDIF IF(EN.LT.3.32) GO TO 50 IF(EN.LE.4.27) THEN QA3=-0.2016+0.2133*EN-0.07421*EN2+0.00851*EN3 GO TO 50 ENDIF IF(EN.LE.5.59) THEN QA3=0.7777-0.6913*EN+0.1856*EN2-0.0153*EN3 GO TO 50 ENDIF IF(EN.LE.7.95) THEN QA3=0.9885-0.3216*EN+0.03252*EN2-0.0009533*EN3 GO TO 50 ENDIF IF(EN.LE.9.73) THEN QA3=-0.3504+0.08087*EN-0.0045*EN2 GO TO 50 ENDIF IF(EN.LE.11.1) THEN QA3=1.397-0.2724*EN+0.01335*EN2 GO TO 50 ENDIF IF(EN.LE.11.8) THEN QA3=-3.30+0.5801*EN-0.02533*EN2 GO TO 50 ENDIF QA3=EXP(10.91-1.264*EN) 50 Q(4,I)=Q(4,I)+QA3*1.D-16 QA4=0.0D0 IF(EN.LT.3.92) GO TO 60 IF(EN.LE.8.25) THEN QA4=EXP(-466.8+296.4*EN-71.09*EN2+7.573*EN3-0.3033*EN*EN3) ENDIF 60 Q(4,I)=Q(4,I)+QA4*1.D-16 QA5=0.0D0 IF(EN.LE.1.50) GO TO 70 IF(EN.LE.3.27) THEN QA5=EXP(2.932*EN3-22.91*EN2+56.52*EN-53.37) GO TO 70 ENDIF IF(EN.LE.7.45) THEN QA5=EXP(0.5554*EN3-9.613*EN2+52.832*EN-100.3) GO TO 70 ENDIF IF(EN.LE.10.6) THEN QA5=EXP(0.1216*EN2-1.035*EN-9.723) GO TO 70 ENDIF IF(EN.LE.11.7) THEN QA5=EXP(-1.114*EN2+25.12*EN-148.0)-0.00012 GO TO 70 ENDIF QA5=EXP(-0.9386*EN2+21.0*EN-123.9) 70 Q(4,I)=Q(4,I)+QA5*1.D-16 Q(5,I)=0.0D0 Q(6,I)=0.0D0 C VIBRATIONAL SUM QQIN(1,I)=0.0D0 IF(EN.LE.EEIN(1).OR.EN.GT.50.0) GO TO 400 IF(EN.LE.0.247) THEN QQIN(1,I)=(14.06+4.425/EN-0.5472/EN2)*1.D-16 GO TO 400 ENDIF IF(EN.LE.0.505) THEN QQIN(1,I)=(EXP(11.19*EN3-13.91*EN2+4.663*EN+2.664))*1.D-16 GO TO 400 ENDIF IF(EN.LE.1.03) THEN QQIN(1,I)=(EXP(0.3166*EN2-1.341*EN+3.509))*1.D-16 GO TO 400 ENDIF QQIN(1,I)=(22.0*10.0**(-0.2645*EN))*1.D-16 C EXCITATION 400 QQIN(2,I)=0.0D0 IF(EN.LE.EEIN(2)) GO TO 500 IF(EN.LE.26.66) THEN QQIN(2,I)=(4.811*BTA-4.769)*1.D-16 GO TO 500 ENDIF IF(EN.LE.29.3) THEN QQIN(2,I)=(3.643-0.204*EN+0.005477*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.56.6) THEN QQIN(2,I)=(0.01382*EN**(1.522))*1.D-16 GO TO 500 ENDIF IF(EN.LE.65.2) THEN QQIN(2,I)=(-25.26+0.9902*EN-0.007593*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.100.0) THEN QQIN(2,I)=(2.197+0.1479*EN-0.001123*EN2)*1.D-16 GO TO 500 ENDIF IF(EN.LE.250.0) THEN QQIN(2,I)=(17.11*EXP(-0.0109*EN))*1.D-16 GO TO 500 ENDIF QQIN(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)+QQIN(1,I)+QQIN(2,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS31. SUBROUTINE GAS31(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS31 - NH3 * (Last changed on 29/ 1/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - XEN(24),YXSEC(24),XVIBH(19),YVIBH(19),XION(47),YION(47), - XATT(30),YATT(30),XEXC1(18),YEXC1(18),APOP1,APOP2,EN,A,B, - YXJ,YXJ1,XNJ,XNJ1,VIRIAL,EFAC INTEGER NNIN,NDATA,NVIBH,NION,NATT,NEXC1,I,J CHARACTER*15 NNAME *** Cross section data. 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 NNAME='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 --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.025 EEIN(2)=0.025 EEIN(3)=-0.1178 EEIN(4)=0.1178 EEIN(5)=0.2013 EEIN(6)=0.4137 EEIN(7)=0.8274 EEIN(8)=7.00 APOP1=EXP(EEIN(1)/AKT) APOP2=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.5*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 200 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.5*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=QQIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V2 C 200 QQIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 250 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=0.30*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EEIN(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)) QQIN(3,I)=QQIN(3,I)+0.25*(EN+EEIN(4))*(A*(EN+EEIN(4))+B)/EN QQIN(3,I)=QQIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C V2 250 QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 300 EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=0.30*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(4,I)=QQIN(4,I)+0.25*(A*EN+B) QQIN(4,I)=QQIN(4,I)/(1.0+APOP2)*1.D-16 C V4 300 QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GO TO 400 EFAC=SQRT(1.0-(EEIN(5)/EN)) QQIN(5,I)=0.28*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(5,I)=(QQIN(5,I)+0.52*(A*EN+B))*1.D-16 400 CONTINUE C V1+V3 QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GO TO 500 EFAC=SQRT(1.0-(EEIN(6)/EN)) QQIN(6,I)=0.28*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(6,I)=(QQIN(6,I)+1.10*(A*EN+B))*1.D-16 500 CONTINUE C HARMONICS (2V1,2V1+V4,3V1, ETC ) QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=0.165*(A*EN+B)*1.D-16 600 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(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)-QQIN(1,I)-QQIN(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)+QQIN(1,I)+QQIN(2,I)+ /QQIN(3,I)+QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS32. SUBROUTINE GAS32(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS32 - Propene. * (Last changed on 11/ 3/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),AMP,AMP1,AMP2, - AMP3,APOP,APOPL,APOPH,EN,A,B,VIRIAL,EFAC INTEGER NNIN,NDATA,NVIB1,NVIB2,NVIB3,NVIB4,NVIB5,NEXC1,NEXC2, - NEXC3,NION,NATT,I,J CHARACTER*15 NNAME *** Cross section data. 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/ NNAME='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 --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.0716 EEIN(2)=0.0716 EEIN(3)=-0.114 EEIN(4)=0.114 EEIN(5)=-0.161 EEIN(6)=0.161 EEIN(7)=0.322 EEIN(8)=0.360 EEIN(9)=0.720 EEIN(10)=4.18 EEIN(11)=7.30 EEIN(12)=9.00 AMP=0.070 AMP1=0.15 AMP2=0.15 AMP3=0.198 APOPL=EXP(EEIN(1)/AKT) APOP=EXP(EEIN(3)/AKT) APOPH=EXP(EEIN(5)/AKT) EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 3050 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=AMP*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOPL/(1.0+APOPL)*1.D-16 3050 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 3060 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=AMP*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=QQIN(2,I)/(1.0+APOPL)*1.D-16 3060 CONTINUE C C V7 SUPERELASTIC QQIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 350 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=AMP1*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EEIN(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)) QQIN(3,I)=QQIN(3,I)+(EN+EEIN(4))*(A*(EN+EEIN(4))+B)/EN QQIN(3,I)=QQIN(3,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V7 QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 400 EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=AMP1*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QQIN(4,I)=QQIN(4,I)+(A*EN+B) QQIN(4,I)=QQIN(4,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QQIN(5,I)=0.0 IF(EN.LE.0.0) GO TO 4150 EFAC=SQRT(1.0-(EEIN(5)/EN)) QQIN(5,I)=AMP2*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EEIN(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)) QQIN(5,I)=QQIN(5,I)+(EN+EEIN(6))*(A*(EN+EEIN(6))+B)/EN QQIN(5,I)=QQIN(5,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V2 + V3 (SUM OF VIBRATIONS AT 166 AND 201 MV) QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GO TO 450 EFAC=SQRT(1.0-(EEIN(6)/EN)) QQIN(6,I)=AMP2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QQIN(6,I)=QQIN(6,I)+(A*EN+B) QQIN(6,I)=QQIN(6,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3+2V2 (HARMONICS) QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GO TO 550 EFAC=SQRT(1.0-(EEIN(8)/EN)) QQIN(8,I)=AMP3*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QQIN(8,I)=(QQIN(8,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(9,I)=(A*EN+B)*1.D-16 600 CONTINUE C QQIN(10,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(10,I)=(A*EN+B)*1.D-16 700 CONTINUE C QQIN(11,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(11,I)=(A*EN+B)*1.D-16 800 CONTINUE C QQIN(12,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(12,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+ - QQIN(9,I)+QQIN(10,I)+QQIN(11,I)+QQIN(12,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(12)) NNIN=11 IF(EFINAL.LE.EEIN(11)) NNIN=10 IF(EFINAL.LE.EEIN(10)) NNIN=9 IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS33. SUBROUTINE GAS33(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS33 - Cyclopropane * (Last changed on 11/ 3/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),AMP1,AMP2,AMP3,APOP, - APOPH,EN,A,B,VIRIAL,EFAC INTEGER NNIN,NDATA,NVIB1,NVIB2,NVIB3,NVIB4,NVIB5,NEXC1,NEXC2, - NION,NATT,I,J CHARACTER*15 NNAME *** Cross section data. 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/ NNAME=' 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 --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.107 EEIN(2)=0.107 EEIN(3)=-0.178 EEIN(4)=0.178 EEIN(5)=0.295 EEIN(6)=0.374 EEIN(7)=0.748 EEIN(8)=7.30 EEIN(9)=9.00 AMP1=0.120 AMP2=0.090 AMP3=0.109 APOP=EXP(EEIN(1)/AKT) APOPH=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 350 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=AMP1*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 310 J=2,NVIB1 IF((EN+EEIN(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)) QQIN(1,I)=QQIN(1,I)+(EN+EEIN(2))*(A*(EN+EEIN(2))+B)/EN QQIN(1,I)=QQIN(1,I)*APOP/(1.0+APOP)*1.D-16 350 CONTINUE C C V11 + V3 QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 400 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=AMP1*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 360 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GO TO 370 360 CONTINUE J=NVIB1 370 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) QQIN(2,I)=QQIN(2,I)+(A*EN+B) QQIN(2,I)=QQIN(2,I)/(1.0+APOP)*1.D-16 400 CONTINUE C C SUPERELASTIC QQIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 4150 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=AMP2*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 4110 J=2,NVIB2 IF((EN+EEIN(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)) QQIN(3,I)=QQIN(3,I)+(EN+EEIN(4))*(A*(EN+EEIN(4))+B)/EN QQIN(3,I)=QQIN(3,I)*APOPH/(1.0+APOPH)*1.D-16 4150 CONTINUE C V9 + V2 (SUM OF VIBRATIONS AT 179 AND 183 MV) QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 450 EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=AMP2*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GO TO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) QQIN(4,I)=QQIN(4,I)+(A*EN+B) QQIN(4,I)=QQIN(4,I)/(1.0+APOPH)*1.D-16 450 CONTINUE C C 2V3 (HARMONICS) QQIN(5,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(5,I)=(A*EN+B)*1.D-16 500 CONTINUE C C V1 + V8 + V12 QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GO TO 550 EFAC=SQRT(1.0-(EEIN(6)/EN)) QQIN(6,I)=AMP3*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 510 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GO TO 520 510 CONTINUE J=NVIB4 520 A=(YVIB4(J)-YVIB4(J-1))/(XVIB4(J)-XVIB4(J-1)) B=(XVIB4(J-1)*YVIB4(J)-XVIB4(J)*YVIB4(J-1))/(XVIB4(J-1)-XVIB4(J)) QQIN(6,I)=(QQIN(6,I)+(A*EN+B))*1.D-16 550 CONTINUE C C 2V1 (HARMONIC) QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C C QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.D-16 850 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(9,I)=(A*EN+B)*1.D-16 899 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+ - QQIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS34. SUBROUTINE GAS34(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS34 - methanol * (Last changed on 29/5/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),VIRIAL,APOP1,APOP2,EN,YXJ,YXJ1,XNJ,XNJ1, - A,B,EFAC INTEGER NNIN,NDATA,NVIBH,NION,NATT,NEXC,NEXC1,NEXC2,I,J CHARACTER*15 NNAME *** Cross section data. 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 NNAME='METHANOL 1999' C -------------------------------------------------------------------- C X-SECTIONS FROM SCALING ETHANOL X-SECTIONS AND ALSO FROM C TOTAL ELECTRON SCATTERING FROM GDANSK. C --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.025 EEIN(2)=0.025 EEIN(3)=-0.1281 EEIN(4)=0.1281 EEIN(5)=0.1668 EEIN(6)=0.3527 EEIN(7)=7.50 EEIN(8)=9.80 EEIN(9)=17.0 APOP1=EXP(EEIN(1)/AKT) APOP2=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.7*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 200 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.7*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=QQIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QQIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 250 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=0.40*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EEIN(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)) QQIN(3,I)=QQIN(3,I)+(EN+EEIN(4))*(A*(EN+EEIN(4))+B)/EN QQIN(3,I)=QQIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 300 EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=0.40*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(4,I)=QQIN(4,I)+(A*EN+B) QQIN(4,I)=QQIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GO TO 400 EFAC=SQRT(1.0-(EEIN(5)/EN)) QQIN(5,I)=0.44*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(5,I)=(QQIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GO TO 500 EFAC=SQRT(1.0-(EEIN(6)/EN)) QQIN(6,I)=0.84*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(6,I)=(QQIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(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)-QQIN(1,I)-QQIN(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)+QQIN(1,I)+QQIN(2,I)+ - QQIN(3,I)+QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+ - QQIN(8,I)+QQIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS35. SUBROUTINE GAS35(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS35 - ethanol * (Last changed on 28/5/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),VIRIAL,APOP1,APOP2,EN,YXJ,YXJ1,XNJ,XNJ1, - A,B,EFAC INTEGER NNIN,NDATA,NVIBH,NION,NATT,NEXC,NEXC1,NEXC2,I,J CHARACTER*15 NNAME *** Cross section data. 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 NNAME=' 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 --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.025 EEIN(2)=0.025 EEIN(3)=-0.109 EEIN(4)=0.109 EEIN(5)=0.1668 EEIN(6)=0.3527 EEIN(7)=7.20 EEIN(8)=9.50 EEIN(9)=16.0 APOP1=EXP(EEIN(1)/AKT) APOP2=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.7*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 200 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.7*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=QQIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QQIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 250 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=0.403*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EEIN(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)) QQIN(3,I)=QQIN(3,I)+(EN+EEIN(4))*(A*(EN+EEIN(4))+B)/EN QQIN(3,I)=QQIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 300 EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=0.403*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(4,I)=QQIN(4,I)+(A*EN+B) QQIN(4,I)=QQIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GO TO 400 EFAC=SQRT(1.0-(EEIN(5)/EN)) QQIN(5,I)=0.423*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(5,I)=(QQIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GO TO 500 EFAC=SQRT(1.0-(EEIN(6)/EN)) QQIN(6,I)=0.84*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(6,I)=(QQIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(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)-QQIN(1,I)-QQIN(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)+QQIN(1,I)+QQIN(2,I)+ - QQIN(3,I)+QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+ - QQIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS36. SUBROUTINE GAS36(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS36 - 2-propanol * (Last changed on 28/5/00.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),VIRIAL,APOP1,APOP2,EN,YXJ,YXJ1,XNJ,XNJ1, - A,B,EFAC INTEGER NNIN,NDATA,NVIBH,NION,NATT,NEXC,NEXC1,NEXC2,I,J CHARACTER*15 NNAME *** Cross section data. 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 NNAME='2-PROPANOL 1999' C -------------------------------------------------------------------- C X-SECTIONS FROM SCALING ETHANOL X-SECTIONS AT LOW ENERGY FITS C TO DRIFT VELOCITY OF CGRISTOPHOROU AND CHRISTOLIDES. C --------------------------------------------------------------------- NNIN=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 EEIN(1)=-0.025 EEIN(2)=0.025 EEIN(3)=-0.109 EEIN(4)=0.109 EEIN(5)=0.1668 EEIN(6)=0.3527 EEIN(7)=7.00 EEIN(8)=9.00 EEIN(9)=16.0 APOP1=EXP(EEIN(1)/AKT) APOP2=EXP(EEIN(3)/AKT) EN=-ESTEP IF(MONTE) 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=LOG(YXSEC(J)) YXJ1=LOG(YXSEC(J-1)) XNJ=LOG(XEN(J)) XNJ1=LOG(XEN(J-1)) A=(YXJ-YXJ1)/(XNJ-XNJ1) B=(XNJ1*YXJ-XNJ*YXJ1)/(XNJ1-XNJ) Q(2,I)=EXP(A*LOG(EN)+B)*1.D-16 C 30 Q(3,I)=0.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 QQIN(1,I)=0.0 IF(EN.LE.0.0) GO TO 150 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.7*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP1/(1.0+APOP1)*1.D-16 C ROT1 150 QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GO TO 200 EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.7*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=QQIN(2,I)/(1.0+APOP1)*1.D-16 C C SUPERELASTIC V1 C 200 QQIN(3,I)=0.0 IF(EN.LE.0.0) GO TO 250 EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=0.443*LOG((EFAC+1.0)/(EFAC-1.0))/EN DO 220 J=2,NVIBH IF((EN+EEIN(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)) QQIN(3,I)=QQIN(3,I)+(EN+EEIN(4))*(A*(EN+EEIN(4))+B)/EN QQIN(3,I)=QQIN(3,I)*APOP2/(1.0+APOP2)*1.D-16 C INELASTIC V1 250 QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GO TO 300 EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=0.443*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 270 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 280 270 CONTINUE J=NVIBH 280 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(4,I)=QQIN(4,I)+(A*EN+B) QQIN(4,I)=QQIN(4,I)/(1.0+APOP2)*1.D-16 C VIB 2 300 QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GO TO 400 EFAC=SQRT(1.0-(EEIN(5)/EN)) QQIN(5,I)=0.465*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 310 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 320 310 CONTINUE J=NVIBH 320 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(5,I)=(QQIN(5,I)+(A*EN+B))*1.D-16 400 CONTINUE C VIB 3 QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GO TO 500 EFAC=SQRT(1.0-(EEIN(6)/EN)) QQIN(6,I)=0.92*LOG((1.0+EFAC)/(1.0-EFAC))/EN DO 410 J=2,NVIBH IF(EN.LE.XVIBH(J)) GO TO 420 410 CONTINUE J=NVIBH 420 A=(YVIBH(J)-YVIBH(J-1))/(XVIBH(J)-XVIBH(J-1)) B=(XVIBH(J-1)*YVIBH(J)-XVIBH(J)*YVIBH(J-1))/(XVIBH(J-1)-XVIBH(J)) QQIN(6,I)=(QQIN(6,I)+(A*EN+B))*1.D-16 500 CONTINUE C EXC QQIN(7,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(7,I)=(A*EN+B)*1.D-16 600 CONTINUE C EXC 1 QQIN(8,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(8,I)=(A*EN+B)*1.D-16 700 CONTINUE C EXC 2 QQIN(9,I)=0.0 IF(EN.LE.EEIN(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)) QQIN(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)-QQIN(1,I)-QQIN(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)+QQIN(1,I)+QQIN(2,I)+ - QQIN(3,I)+QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+ - QQIN(8,I)+QQIN(9,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(9)) NNIN=8 IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS101. SUBROUTINE GAS101(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS101 - Argon, Magboltz 1 gas 1. *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(34),YXSEC(34),XENI(54),YXENI(54),XIN(15),YXSIN(15),Y /XPIN(15),YXDIN(15) CHARACTER*15 NNAME 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,30.0,30.6,50.0,54.4, /100.0,400.0,1000.0/ DATA YXSEC/1.39,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,6.13,6.01,4.17,3.97, /2.71,1.30,1.00/ 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,50.0, /60.0,70.0,80.0,90.0,100.,110.,120.,130.,140.,150., /160.,180.,200.,250.,300.,350.,400.,450.,500.,600., /700.,800.,900.,1000./ 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.404,2.424,2.443,2.454,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/ DATA XIN/11.55,13.0,13.2,13.4,14.0,16.0,20.0,30.0,40.0,50.0, /80.0,100.0,200.0,500.0,1000.0/ DATA YXSIN/0.00,.057,.075,.072,.096,0.17,0.18,0.21,0.24,0.28, /0.22,0.17,0.11,0.06,0.04/ DATA YXPIN/0.00,0.00,0.01,0.03,0.06,0.17,0.35,0.45,0.44,0.41, /0.30,0.27,0.18,0.09,0.05/ DATA YXDIN/0.00,0.00,0.00,0.00,0.00,0.05,0.11,0.22,0.26,0.28, /0.35,0.35,0.26,0.13,0.08/ NNAME=' ARGON 1988 ' 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 10% BELOW 500,000VOLTS. C----------------------------------------------------------------------- C C PARAMETERS OF PHASE SHIFT ANALYSIS. C APOL=11.08 LMAX=100 AA=-1.488 DD=65.4 FF=-84.3 E1=0.883 C NNIN=3 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 EEIN(1)=11.55 EEIN(2)=13.0 EEIN(3)=14.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.GT.1.0) GOTO 100 IF(EN.EQ.0.0) Q(2,I)=7.79E-16 IF(EN.EQ.0.0) GOTO 200 AK=SQRT(EN/ARY) AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK*AK*LOG(AK))-(PI*APOL/3.0)*AK*A /K+DD*AK*AK*AK+FF*AK*AK*AK*AK AN1=(PI/15.0)*APOL*AK*AK*(1.0-SQRT(EN/E1)) AN2=PI*APOL*AK*AK/105.0 AN0=ATAN(AN0) AN1=ATAN(AN1) AN2=ATAN(AN2) SUM=(SIN(AN0-AN1))**2 SUM=SUM+2.0*(SIN(AN1-AN2))**2 DO 10 J=2,LMAX-1 SUMI=6.0/((2.0*J+5.0)*(2.0*J+3.0)*(2.0*J+1.0)*(2.0*J-1.0)) SUM=SUM+(J+1.0)*(SIN(ATAN(PI*APOL*AK*AK*SUMI)))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/(AK*AK) GOTO 200 100 CONTINUE NDATA=34 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 230 NIDATA=54 DO 210 J=2,NIDATA IF(EN.LE.XENI(J)) GOTO 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 QQIN(1,I)=0.0 QQIN(2,I)=0.0 QQIN(3,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 NXDATA=15 DO 310 J=2,NXDATA IF(EN.LE.XIN(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.0E-16 IF(EN.LE.EEIN(2)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.0E-16 IF(EN.LE.EEIN(3)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.0E-16 400 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS102. SUBROUTINE GAS102(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS102 - Methane - Magboltz 1 gas 6 * Author - Steve Biagi *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(48),YXSEC(48),XVIB1(26),YVIB1(26),XVIB2(23),YVIB2(23 /),XION(29),YION(29),XATT(14),YATT(14),XEXC(20),YEXC(20) CHARACTER*15 NNAME 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,10.0,20.0,100./ DATA YXSEC/190.,100.,50.0,33.0,24.5,21.0,18.0,14.8,12.2,9.70, /8.20,7.00,6.30,5.30,4.30,3.60,3.00,2.30,1.80,1.48, /1.10,0.90,0.72,0.70,0.69,0.73,0.78,0.87,0.92,1.02, /1.18,1.37,1.80,2.25,2.70,3.40,4.10,5.30,6.60,8.00, /9.50,12.4,14.5,15.9,15.9,13.1,6.50,5.00/ 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,7.00,7.50, /8.00,10.0,15.0,20.0,30.0,100.0/ DATA YVIB1/0.00,0.00,0.13,0.22,0.35,0.385,0.385,0.335,0.30,0.28, /0.27,0.26,0.25,0.24,0.22,0.22,0.22,0.30,0.45,0.62, /0.50,0.36,0.15,0.13,0.05,0.00/ 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,7.00,7.50,8.00,10.0,15.0, /20.0,30.0,100.0/ DATA YVIB2/0.00,0.00,0.13,0.20,0.30,0.32,0.32,0.30,0.29,0.28, /0.26,0.24,0.21,0.21,0.33,0.50,0.72,0.51,0.41,0.23, /0.20,0.15,0.00/ DATA XION/13.0,13.5,14.0,14.5,15.0,16.0,18.0,20.0,22.0,24.0, /26.0,28.0,30.0,32.0,40.0,50.0,60.0,70.0,85.0,100., /140.,200.,300.,400.,500.,600.,700.,800.,1000./ DATA YION/0.00,0.04,0.08,0.13,0.20,0.36,0.71,1.07,1.42,1.72, /1.97,2.20,2.38,2.54,3.02,3.36,3.56,3.66,3.69,3.66, /3.41,3.01,2.49,2.09,1.83,1.63,1.47,1.34,1.18/ 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.03,0.13,0.51,0.75,0.85,0.96,0.91,0.72,0.49, /0.27,0.13,0.06,0.00/ DATA XEXC/8.00,9.00,10.0,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.,500.,1000./ DATA YEXC/0.00,0.08,0.25,0.70,1.25,1.75,2.40,2.60,2.50,2.30, /2.00,1.85,1.65,1.40,1.20,0.92,0.72,0.53,0.35,0.20/ NNAME='METHANE OLD ' C----------------------------------------------------------------------- C MULTI TERM CROSS SECTION FROM G.N.HADDAD C MODIFIED ABOVE 6 ELECTRON VOLTS TO EXTEND TO HIGH FIELDS. C NOT ACCURATE ABOVE 2000 VOLTS/CM. 1% BELOW 1000 VOLTS/CM. C----------------------------------------------------------------------- NNIN=3 NDATA=48 NVIB1=26 NVIB2=23 NION=29 NATT=14 NEXC=20 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 EEIN(1)=0.162 EEIN(2)=0.374 EEIN(3)=8.00 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(14)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C----------------------------------------------------------------------- C QQIN(1,I) AND QQIN(2,I) NOT SUMMED BECAUSE MOMENTUM TRANSFER XSEC. HAS C BEEN USED IN ANALYSIS AT LOW ENERGY C----------------------------------------------------------------------- Q(1,I)=Q(2,I)+QQIN(3,I)+Q(3,I)+Q(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 C END +DECK,GAS103. SUBROUTINE GAS103(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS103 - Methane data - Magboltz 1 gas 2 * Author - Steve Biagi *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(51),YXSEC(51),XVIB1(27),YVIB1(27),XVIB2(24),YVIB2(24 /),XION(29),YION(29),XATT(14),YATT(14),XEXC(20),YEXC(20) CHARACTER*15 NNAME 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,10.0,12.0,20.0,100.,200.,1000./ DATA YXSEC/22.3,19.0,16.0,14.5,13.4,12.8,12.1,11.2,10.5,9.55, /8.50,7.25,6.50,5.45,4.45,3.80,3.20,2.40,1.85,1.48, /1.10,0.90,0.72,0.70,0.69,0.73,0.78,0.87,0.92,1.02, /1.18,1.37,2.00,2.60,3.50,4.50,5.60,7.80,9.90,12.1, /13.8,15.5,16.5,17.0,17.0,16.5,15.0,8.50,1.20,0.60,0.30/ 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,7.00,7.50, /8.00,10.0,15.0,20.0,30.0,100.0,1000./ DATA YVIB1/0.00,0.00,0.13,0.22,0.35,0.40,0.40,0.355,0.31,0.29, /0.28,0.27,0.26,0.25,0.24,0.26,0.30,0.60,1.00,1.00, /0.90,0.55,0.17,0.13,0.05,.001,0.00/ 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,7.00,7.50,8.00,10.0,15.0, /20.0,30.0,100.,1000./ DATA YVIB2/0.00,0.00,.135,.208,.312,.333,.333,.312,.302,.291, /0.27,0.25,0.26,.385,0.88,1.30,1.25,1.14,0.62,0.26, /0.21,0.16,.001,0.00/ DATA XION/13.0,13.5,14.0,14.5,15.0,16.0,18.0,19.5,22.0,24.0, /26.0,28.0,30.0,32.0,40.0,50.0,60.0,70.0,85.0,100., /140.,200.,300.,400.,500.,600.,700.,800.,1000./ DATA YION/0.00,0.034,0.074,0.13,0.20,0.36,0.71,0.98,1.42,1.72, /1.97,2.20,2.38,2.54,3.02,3.36,3.56,3.66,3.69,3.66, /3.41,3.01,2.49,2.09,1.83,1.63,1.47,1.34,1.18/ 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 XEXC/8.00,9.00,10.0,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.,500.,1000./ DATA YEXC/0.00,0.07,0.23,0.64,1.40,1.80,2.21,2.39,2.30,2.12, /1.84,1.70,1.52,1.29,1.10,0.85,0.66,0.49,0.32,0.18/ NNAME='METHANE 10/9/88' NNIN=3 NDATA=51 NVIB1=27 NVIB2=24 NION=29 NATT=14 NEXC=20 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 EEIN(1)=0.162 EEIN(2)=0.374 EEIN(3)=8.00 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(14)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C C QQIN(1,I) AND QQIN(2,I) NOT SUMMED BECAUSE MOMENTUM TRANSFER XSEC. HAS C BEEN USED IN ANALYSIS AT LOW ENERGY Q(1,I)=Q(2,I)+QQIN(3,I)+Q(3,I)+Q(4,I) C GET CORRECT ELASTIC XSECTION Q(2,I)=Q(2,I)-QQIN(1,I)-QQIN(2,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 C END +DECK,GAS104. SUBROUTINE GAS104(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS104 - Methane - Magboltz 1 gas 5 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) CHARACTER*15 NNAME NNAME='CH4 KLEB+DAVIS ' C----------------------------------------------------------------------- C CONTAINS OLD LITERATURE PARAMETERISATIONS OF METHANE C NOT ACCURATE ONLY FOR COMPARISON. C----------------------------------------------------------------------- NNIN=1 E(1)=0.0 E(2)=2.0*EMASS/(16.0426*AMU) E(3)=100. E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.169 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP EFF=EN IF(EFF.EQ.0.0) EFF=1.0E-6 Q(2,I)=0.0 C KLEBAN AND DAVIS DO NOT STOP AT 0.169 EV IF(EN.LT.0.256) Q(2,I)=(0.654/EFF-2.36)*1.0E-16 C C LIN ROBSON AND MASON INTRODUCE BREAK AT 0.0284 EV C IF(EN.LT.0.0284) Q(2,I)=(8.43/SQRT(EFF)-29.36)*1.0E-16 C IF(EN.GE.0.0284.AND.EN.LT.0.256) Q(2,I)=(0.654/EN-2.36)*1.E-16 C C PITCHFORD AND PHELPS C IF(EN.LT.0.169) Q(2,I)=2.14E-16 C IF(EN.GE.0.169.AND.EN.LT.0.256) Q(2,I)=(0.654/EN-2.36)*1.E-16 C IF(EN.GE.0.256.AND.EN.LT.0.712) Q(2,I)=0.2E-16 IF(EN.GE.0.712) Q(2,I)=(9.88*SQRT(EN)-8.133)*1.E-16 Q(3,I)=0.0 Q(4,I)=0.0 Q(5,I)=0.0 Q(6,I)=0.0 QQIN(1,I)=0.0 IF(EN.GT.0.169) QQIN(1,I)=0.63E-16 Q(1,I)=Q(2,I)+QQIN(1,I) 900 CONTINUE END +DECK,GAS105. SUBROUTINE GAS105(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS105 - Nitrogen - Magboltz 1 gas 4 * Author - Steve Biagi *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) 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(14),YVIB6(14),XVIB7(16),YVIB7(16), /XVIB8(14),YVIB8(14),XTRP1(24),YTRP1(24),XTRP2(24),YTRP2(24), /XTRP3(22),YTRP3(22),XTRP4(24),YTRP4(24),XTRP5(24),YTRP5(24), /XTRP6(22),YTRP6(22),XTRP7(28),YTRP7(28),XTRP8(16),YTRP8(16), /XSNG1(19),YSNG1(19),XSNG2(23),YSNG2(23),XSNG3(18),YSNG3(18), /XSNG4(23),YSNG4(23),XSNG5(21),YSNG5(21),XION(26),YION(26) DIMENSION YQUAD(27) CHARACTER*15 NNAME 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 YQUAD/0.00,0.00,0.00,0.00,0.06,0.18,0.23,0.40,1.41,5.13, /5.42,5.14,6.90,6.04,6.45,5.10,4.24,3.75,2.11,2.32, /1.94,1.40,0.94,0.38,0.00,0.00,0.00/ DATA XROT/0.02,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,.015,.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,1000.0/ DATA YVIB6/0.00,0.00,.0063,1.125,1.74,1.38,0.78,0.45,.315,.246, /0.48,.1635,0.00,0.00/ DATA XVIB7/2.06,2.30,2.40,2.50,2.60,2.70,2.75,2.80,2.90,3.00, /3.10,3.20,3.30,3.40,3.50,1000.0/ DATA YVIB7/0.0,0.0,0.0126,0.39,0.66,0.96,0.795,0.60,0.18,0.0063, /0.192,0.204,0.078,0.0189,0.00,0.00/ DATA XVIB8/2.35,2.50,2.60,2.70,2.75,2.80,2.90,3.00,3.10,3.20, /3.30,3.40,3.50,1000.0/ DATA YVIB8/0.0,0.0,0.0189,0.36,0.36,0.33,0.345,0.264,.0375,.0063, /0.1545,0.0252,0.0,0.0/ 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,.001,.0028,.0043,.0057,.0082,.010,.012,.013,.014, /.015,.015,.014,.012,.010,.0089,.0076,.0059,.0049,.0039, /.0034,.0007,0.0,0.0/ DATA XTRP2/7.00,7.30,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.0,1000.0/ DATA YTRP2/0.0,.002,.005,.015,.022,.034,.043,.050,.055,.060, /.065,.065,.062,.053,.045,.038,.033,.025,.021,.017, /.014,.0029,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,.0362,.0938,.1508,.1863,.2003,.199,.1816,.1615,.1447 /,.1307,.1199,.1112,.0951,.0804,.0677,.0563,.0429,.0268,.0067, /0.0,0.0/ DATA XTRP4/7.36,8.00,9.00,10.0,11.0,12.0,14.0,15.0,16.0,17.0, /18.0,20.0,22.0,24.0,26.0,28.0,30.0,34.0,40.0,50.0, /70.0,100.,150.,1000.0/ DATA YTRP4/.0,.0181,.0496,.0804,.1112,.1427,.205,.2352,.2546,.2519 /,.2345,.1776,.132,.1025,.0844,.0724,.0630,.0496,.0348,.0201, /.0101,.0047,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,1000./ DATA YTRP5/0.0,.0015,.004,.007,.011,.029,.044,.051,.056,.060, /.066,.067,.063,.054,.046,.039,.033,.026,.021,.017, /.015,.003,0.00,0.00/ DATA XTRP6/8.16,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0, /18.0,19.0,20.0,22.0,26.0,30.0,34.0,40.0,50.0,70.0, /150.0,1000.0/ DATA YTRP6/.0,.0107,.0235,.0369,.0496,.063,.0757,.0838,.0764,.0616 /,.0489,.0409,.0362,.0315,.0268,.0228,.0194,.0161,.0127,.0067, /0.0,0.0/ DATA XSNG1/8.40,9.00,11.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0, /20.0,24.0,30.0,40.0,50.0,70.0,150.0,500.0,1000.0/ DATA YSNG1/.0,.0067,.0302,.0536,.0643,.0697,.057,.0429,.0348,.0308 /,.0275,.0201,.0154,.0124,.0121,.0101,.0067,0.0,0.0/ DATA XSNG2/8.55,9.00,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,.0127,.1474,.1715,.1916,.2023,.199,.1923,.1849,.1621 /,.1528,.1367,.1065,.0851,.0603,.0402,.0268,.0201,.0161,.0134, /.0082,.0060,.0042/ DATA XSNG3/8.89,9.00,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0, /18.0,20.0,22.0,30.0,38.0,50.0,150.0,1000.0/ DATA YSNG3/.0,.0013,.0261,.0476,.0663,.0784,.0771,.067,.0543,.0442 /,.0375,.0288,.0241,.0154,.0094,.0047,0.0,0.0/ 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,150.0,1000.0/ DATA YTRP8/.0,.0496,.0007,.0034,.0042,.0047,.0052,.0054,.0054, /.0044,.0034,.0027,.0012,.005,0.0,0.0/ DATA XSNG4/12.25,13.0,15.0,16.0,17.0,18.0,19.0,20.0,22.0,24.0, /26.0,30.0,36.0,40.0,50.0,70.0,100.,150.,200.,300., /500.,700.,1000./ DATA YSNG4/.0,.0054,.0188,.0248,.0302,.0348,.0382,.0389,.0342, /.0275,.0228,.0154,.0114,.0107,.009,.0068,.005,.0036,.0029,.002, /.0013,.001,.0008/ 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/ NNAME='N2 EXACT P+P. ' C -------------------------------------------------------------- C NITROGEN FROM PITCHFORD AND PHELPS . JILA REPORT NO.26 (1985) C MULTI TERM CROSS SECTIONS WITH MODIFICATION CF:PHELPS PRIVATE C COMMUNICATION . ACCURACY ABOUT 1% AT ALL FIELDS. C -------------------------------------------------------------- NNIN=22 NELA=60 NROT=27 NVIB1=49 NVIB2=23 NVIB3=19 NVIB4=17 NVIB5=17 NVIB6=14 NVIB7=16 NVIB8=14 NTRP1=24 NTRP2=24 NTRP3=22 NTRP4=24 NTRP5=24 NTRP6=22 NTRP7=28 NTRP8=16 NSNG1=19 NSNG2=23 NSNG3=18 NSNG4=23 NSNG5=21 NION=26 E(1)=0.0 E(2)=2.0*EMASS/(27.7940*AMU) E(3)=15.60 E(4)=0.0 C----------------------------------------------------------------------- C E(5)=0.0 GIVES SINGLE LEVEL APPROX TO ROTATIONAL SCATTERING C E(5)=2.47E-4 GIVES CONTINUOUS QUADRUPOLE ROTATIONAL APPROX. C----------------------------------------------------------------------- E(5)=0.0 C E(5)=2.47E-4 C----------------------------------------------------------------------- E(6)=0.0 EEIN(1)=0.020 EEIN(2)=0.290 EEIN(3)=0.590 EEIN(4)=0.880 EEIN(5)=1.17 EEIN(6)=1.47 EEIN(7)=1.76 EEIN(8)=2.06 EEIN(9)=2.35 EEIN(10)=6.17 EEIN(11)=7.00 EEIN(12)=7.35 EEIN(13)=7.36 EEIN(14)=7.80 EEIN(15)=8.16 EEIN(16)=8.40 EEIN(17)=8.55 EEIN(18)=8.89 EEIN(19)=11.03 EEIN(20)=11.87 EEIN(21)=12.25 EEIN(22)=13.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NELA IF(EN.LE.XELA(J)) GOTO 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)) GOTO 50 DO 30 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 C----------------------------------------------------------------------- C Q(5,I)=0.0 AND QQIN(1,I)=YROT. GIVES SINGLE LEVEL APPROX TO ROT.SCATT. C Q(5,I)=YQUAD(N) AND QQIN(1,I)=0.0 GIVES CONTINUOUS QUADRUPOLE ROT.SCATT C----------------------------------------------------------------------- C CONTINUOUS QUADRUPOLE ROTATIONAL SCATTERING BELOW C----------------------------------------------------------------------- C IF(EN.LE.EEIN(1)) GOTO 53 C DO 51 J=2,NROT C IF(EN.LE.XROT(J)) GOTO 52 C 51 CONTINUE C J=NROT C 52 A=(YQUAD(J)-YQUAD(J-1))/(XROT(J)-XROT(J-1)) C B=(XROT(J-1)*YQUAD(J)-XROT(J)*YQUAD(J-1))/(XROT(J-1)-XROT(J)) C Q(5,I)=(A*EN+B)*1.E-16 C 53 CONTINUE C GOTO 80 C----------------------------------------------------------------------- C SINGLE LEVEL APPROXIMATION TO ROTATIONAL SCATTERING BELOW. C----------------------------------------------------------------------- IF(EN.LE.EEIN(1)) GOTO 80 DO 60 J=2,NROT IF(EN.LE.XROT(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 C----------------------------------------------------------------------- 80 CONTINUE C----------------------------------------------------------------------- QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 110 DO 90 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 110 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 140 DO 120 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 140 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 170 DO 150 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 170 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 200 DO 180 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 200 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 230 DO 210 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 230 CONTINUE C QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 260 DO 240 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 260 CONTINUE C QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 290 DO 270 J=2,NVIB7 IF(EN.LE.XVIB7(J)) GOTO 280 270 CONTINUE J=NVIB7 280 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)) QQIN(8,I)=(A*EN+B)*1.E-16 290 CONTINUE C QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 320 DO 300 J=2,NVIB8 IF(EN.LE.XVIB8(J)) GOTO 310 300 CONTINUE J=NVIB8 310 A=(YVIB8(J)-YVIB8(J-1))/(XVIB8(J)-XVIB8(J-1)) B=(XVIB8(J-1)*YVIB8(J)-XVIB8(J)*YVIB8(J-1))/(XVIB8(J-1)-XVIB8(J)) QQIN(9,I)=(A*EN+B)*1.E-16 320 CONTINUE C QQIN(10,I)=0.0 IF(EN.LE.EEIN(10)) GOTO 350 DO 330 J=2,NTRP1 IF(EN.LE.XTRP1(J)) GOTO 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)) QQIN(10,I)=(A*EN+B)*1.E-16 350 CONTINUE C QQIN(11,I)=0.0 IF(EN.LE.EEIN(11)) GOTO 380 DO 360 J=2,NTRP2 IF(EN.LE.XTRP2(J)) GOTO 370 360 CONTINUE J=NTRP2 370 A=(YTRP2(J)-YTRP2(J-1))/(XTRP2(J)-XTRP2(J-1)) B=(XTRP2(J-1)*YTRP2(J)-XTRP2(J)*YTRP2(J-1))/(XTRP2(J-1)-XTRP2(J)) QQIN(11,I)=(A*EN+B)*1.E-16 380 CONTINUE C QQIN(12,I)=0.0 IF(EN.LE.EEIN(12)) GOTO 410 DO 390 J=2,NTRP3 IF(EN.LE.XTRP3(J)) GOTO 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)) QQIN(12,I)=(A*EN+B)*1.E-16 410 CONTINUE C QQIN(13,I)=0.0 IF(EN.LE.EEIN(13)) GOTO 440 DO 420 J=2,NTRP4 IF(EN.LE.XTRP4(J)) GOTO 430 420 CONTINUE J=NTRP4 430 A=(YTRP4(J)-YTRP4(J-1))/(XTRP4(J)-XTRP4(J-1)) B=(XTRP4(J-1)*YTRP4(J)-XTRP4(J)*YTRP4(J-1))/(XTRP4(J-1)-XTRP4(J)) QQIN(13,I)=(A*EN+B)*1.E-16 440 CONTINUE C QQIN(14,I)=0.0 IF(EN.LE.EEIN(14)) GOTO 470 DO 450 J=2,NTRP5 IF(EN.LE.XTRP5(J)) GOTO 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)) QQIN(14,I)=(A*EN+B)*1.E-16 470 CONTINUE C QQIN(15,I)=0.0 IF(EN.LE.EEIN(15)) GOTO 500 DO 480 J=2,NTRP6 IF(EN.LE.XTRP6(J)) GOTO 490 480 CONTINUE J=NTRP6 490 A=(YTRP6(J)-YTRP6(J-1))/(XTRP6(J)-XTRP6(J-1)) B=(XTRP6(J-1)*YTRP6(J)-XTRP6(J)*YTRP6(J-1))/(XTRP6(J-1)-XTRP6(J)) QQIN(15,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(16,I)=0.0 IF(EN.LE.EEIN(16)) GOTO 530 DO 510 J=2,NSNG1 IF(EN.LE.XSNG1(J)) GOTO 520 510 CONTINUE J=NSNG1 520 A=(YSNG1(J)-YSNG1(J-1))/(XSNG1(J)-XSNG1(J-1)) B=(XSNG1(J-1)*YSNG1(J)-XSNG1(J)*YSNG1(J-1))/(XSNG1(J-1)-XSNG1(J)) QQIN(16,I)=(A*EN+B)*1.E-16 530 CONTINUE C QQIN(17,I)=0.0 IF(EN.LE.EEIN(17)) GOTO 560 DO 540 J=2,NSNG2 IF(EN.LE.XSNG2(J)) GOTO 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)) QQIN(17,I)=(A*EN+B)*1.E-16 560 CONTINUE C QQIN(18,I)=0.0 IF(EN.LE.EEIN(18)) GOTO 590 DO 570 J=2,NSNG3 IF(EN.LE.XSNG3(J)) GOTO 580 570 CONTINUE J=NSNG3 580 A=(YSNG3(J)-YSNG3(J-1))/(XSNG3(J)-XSNG3(J-1)) B=(XSNG3(J-1)*YSNG3(J)-XSNG3(J)*YSNG3(J-1))/(XSNG3(J-1)-XSNG3(J)) QQIN(18,I)=(A*EN+B)*1.E-16 590 CONTINUE C QQIN(19,I)=0.0 IF(EN.LE.EEIN(19)) GOTO 620 DO 600 J=2,NTRP7 IF(EN.LE.XTRP7(J)) GOTO 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)) QQIN(19,I)=(A*EN+B)*1.E-16 620 CONTINUE C QQIN(20,I)=0.0 IF(EN.LE.EEIN(20)) GOTO 650 DO 630 J=2,NTRP8 IF(EN.LE.XTRP8(J)) GOTO 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)) QQIN(20,I)=(A*EN+B)*1.E-16 650 CONTINUE C QQIN(21,I)=0.0 IF(EN.LE.EEIN(21)) GOTO 680 DO 660 J=2,NSNG4 IF(EN.LE.XSNG4(J)) GOTO 670 660 CONTINUE J=NSNG4 670 A=(YSNG4(J)-YSNG4(J-1))/(XSNG4(J)-XSNG4(J-1)) B=(XSNG4(J-1)*YSNG4(J)-XSNG4(J)*YSNG4(J-1))/(XSNG4(J-1)-XSNG4(J)) QQIN(21,I)=(A*EN+B)*1.E-16 680 CONTINUE C QQIN(22,I)=0.0 IF(EN.LE.EEIN(22)) GOTO 710 DO 690 J=2,NSNG5 IF(EN.LE.XSNG5(J)) GOTO 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)) QQIN(22,I)=(A*EN+B)*1.E-16 710 CONTINUE C C SUM=0.0 DO 800 K=1,22 SUM=SUM+QQIN(K,I) 800 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+SUM+Q(5,I) 900 CONTINUE C SAVE COMPUTE TIME DO 1000 K=1,22 J=23-K IF(EFINAL.LE.EEIN(J)) NNIN=J-1 1000 CONTINUE C END +DECK,GAS106. SUBROUTINE GAS106(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS106 - CO2 - Magboltz 1 gas 8. * Data from Lasota * Author - Steve Biagi, modified by Georg Viehhauser * (Last changed on 12/9/94.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24), /XMOM(54),YMOM(54),XVIB1(38),YVIB1(38),XVIB2(28),YVIB2(28), /XVIB3(12),YVIB3(12),XVIB4(24),YVIB4(24),XVIB5(12),YVIB5(12), /XVIB6(12),YVIB6(12),XVIB7(12),YVIB7(12),XEXC1(7),YEXC1(7), /XATT(12),YATT(12),XEXC2(6),YEXC2(6),XEXC3(10),YEXC3(10), /XION(12),YION(12) CHARACTER*15 NNAME DATA XMOM/0.00,.001,.002,.003,.005,.007,.0085,.010,.015,0.02, + 0.03,0.04,0.05,0.07,0.10,0.12,0.15,0.17,0.20,0.25, + 0.30,0.35,0.40,0.50,0.70,1.00,1.20,1.30,1.50,1.70, + 1.90,2.10,2.20,2.50,2.80,3.00,3.30,3.60,4.00,4.50, + 5.00,6.00,7.00,8.00,10.0,12.0,15.0,17.0,20.0,25.0, + 30.0,50.0,75.0,100./ DATA YMOM/600.,540.,380.,307.,237.,200.,182.,170.,138.,120., + 97.0,85.0,76.0,63.0,50.0,44.0,39.0,34.0,29.0,24.0, + 18.0,15.0,13.0,10.0,7.10,5.20,4.80,4.70,4.65,4.65, + 4.85,5.05,5.20,6.40,7.60,9.00,11.5,14.0,15.2,14.8, + 12.7,10.0,10.0,10.8,12.1,13.1,14.4,15.0,15.8,16.0, + 15.8,12.6,9.50,8.00/ DATA XVIB1/.0,.083,.0844,.0862,.0932,.1035,.1208,.1382,.1726,.207, + .275,.345,0.50,0.70,0.90,1.10,1.40,1.60,1.80,2.30, + 2.60,3.00,3.20,3.40,3.60,3.80,4.00,4.20,4.60,5.10, + 5.50,6.00,7.00,8.00,10.0,20.0,50.0,100./ DATA YVIB1/0.00,0.00,0.85,1.16,1.85,2.30,2.60,2.68,2.54,2.20, + 1.72,1.43,1.08,0.80,0.66,0.57,0.45,0.42,0.44,0.70, + 0.93,1.34,1.58,1.75,1.80,1.79,1.70,1.52,1.05,0.57, + 0.51,0.50,0.48,0.45,0.20,0.00,0.00,0.00/ DATA XVIB2/0.00,0.167,0.172,0.18,0.20,0.25,0.50,1.00,1.50,1.90, + 2.00,2.25,2.50,3.00,3.20,3.40,3.55,3.70,3.90,4.10, + 4.50,4.90,5.20,6.00,8.00,10.0,20.0,100./ DATA YVIB2/0.00,0.00,0.30,0.33,0.35,0.325,0.117,0.05,0.04,0.06, + 0.08,0.20,0.40,1.28,1.57,1.77,1.78,1.75,1.60,1.28, + 0.88,0.39,0.33,0.27,0.25,0.21,0.00,0.00/ DATA XVIB3/0.00,0.252,1.50,1.95,2.50,3.00,3.56,4.10,4.50,5.06, + 6.00,100./ DATA YVIB3/0.00,0.00,0.00,0.00,0.00,0.32,0.54,0.34,0.16,0.044, + 0.00,0.00/ DATA XVIB4/0.00,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./ DATA YVIB4/0.00,0.00,0.95,1.70,1.85,2.00,2.15,2.20,2.15,2.00, + 1.85,1.55,1.23,1.00,0.76,0.64,0.49,0.44,0.41,0.48, + 0.26,.135,0.10,0.00/ DATA XVIB5/0.00,0.339,1.50,1.95,2.50,3.00,3.56,4.10,4.50,5.06, + 6.00,100./ DATA YVIB5/0.00,0.00,0.00,0.07,0.20,0.41,0.66,0.34,0.155,0.00, + 0.00,0.00/ DATA XVIB6/0.00,0.422,1.50,1.95,2.50,3.00,3.56,4.10,4.50,5.06, + 6.00,100./ DATA YVIB6/0.00,0.00,0.00,0.00,0.00,0.105,0.225,0.10,0.00,0.00, + 0.00,0.00/ DATA XVIB7/0.00,0.505,1.50,1.95,2.50,3.00,3.56,4.10,4.50,5.06, + 6.00,100./ DATA YVIB7/0.00,0.00,0.00,0.00,0.00,0.156,0.33,0.156,0.00,0.00, + 0.00,0.00/ DATA XEXC1/0.0,2.50,3.00,3.60,4.10,4.50,100./ DATA YEXC1/0.0,0.00,0.18,0.25,0.18,0.00,0.00/ DATA XATT/0.00,3.85,4.30,4.50,5.10,6.60,7.20,8.20,8.40,8.90, + 9.70,100./ DATA YATT/0.00,0.00,.0014,.0014,0.00,0.00,.0007,.0045,.0042,.001, + 0.00,0.00/ DATA XEXC2/0.00,7.00,8.00,8.50,11.0,100./ DATA YEXC2/0.00,0.00,0.60,0.60,0.00,0.00/ DATA XEXC3/0.00,10.5,12.0,12.7,13.5,15.0,17.0,20.0,40.0,100./ DATA YEXC3/0.00,0.00,0.69,0.73,0.78,0.88,1.04,1.24,3.60,6.30/ DATA XION/0.00,13.3,14.5,15.0,16.0,18.0,20.0,30.0,40.0,50.0, + 70.0,100./ DATA YION/0.00,0.00,0.06,0.104,0.188,0.359,0.532,1.63,2.28,2.79, + 3.43,3.79/ C NNAME='C02 TEST # 2 ' NNIN=10 NMOM=54 NVIB1=38 NVIB2=28 NVIB3=12 NVIB4=24 NVIB5=12 NVIB6=12 NVIB7=12 NEXC1=7 NATT=12 NEXC2=6 NEXC3=10 NION=12 E(1)=0.0 E(2)=2.0*EMASS/(44.0098*AMU) E(3)=13.3 E(4)=3.85 E(5)=0.0 E(6)=0.0 EEIN(1) = 0.083 EEIN(2) = 0.167 EEIN(3) = 0.252 EEIN(4) = 0.291 EEIN(5) = 0.339 EEIN(6) = 0.422 EEIN(7) = 0.505 EEIN(8) = 2.500 EEIN(9) = 7.000 EEIN(10) = 10.500 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP C DO 100 J=2,NMOM IF(EN.LE.XMOM(J)) GOTO 150 100 CONTINUE *** The next line is J=NDATA in original Magboltz (RV 12/9/94) J=NMOM 150 A=(YMOM(J)-YMOM(J-1))/(XMOM(J)-XMOM(J-1)) B=(XMOM(J-1)*YMOM(J)-XMOM(J)*YMOM(J-1))/(XMOM(J-1)-XMOM(J)) Q(2,I)=1.0E-16*(A*EN+B) C QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 260 DO 200 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 250 200 CONTINUE J=NVIB1 250 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)) QQIN(1,I)=1.0E-16*(A*EN+B) C 260 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 360 DO 300 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 350 300 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)) QQIN(2,I)=1.0E-16*(A*EN+B) C 360 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 460 DO 400 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 450 400 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)) QQIN(3,I)=1.0E-16*(A*EN+B) C 460 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 560 DO 500 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 550 500 CONTINUE J=NVIB4 550 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)) QQIN(4,I)=1.0E-16*(A*EN+B) C 560 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 660 DO 600 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 650 600 CONTINUE J=NVIB5 650 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)) QQIN(5,I)=1.0E-16*(A*EN+B) C 660 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 760 DO 700 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GOTO 750 700 CONTINUE J=NVIB6 750 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)) QQIN(6,I)=1.0E-16*(A*EN+B) C 760 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 860 DO 800 J=2,NVIB7 IF(EN.LE.XVIB7(J)) GOTO 850 800 CONTINUE J=NVIB7 850 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)) QQIN(7,I)=1.0E-16*(A*EN+B) C 860 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 960 DO 900 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 950 900 CONTINUE J=NEXC1 950 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)) QQIN(8,I)=1.0E-16*(A*EN+B) C 960 CONTINUE Q(4,I)=0.0 IF(EN.LE.E(4)) GOTO 1060 DO 1000 J=2,NATT IF(EN.LE.XATT(J)) GOTO 1050 1000 CONTINUE J=NATT 1050 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.0E-16*(A*EN+B) C 1060 CONTINUE QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 1160 DO 1100 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 1150 1100 CONTINUE J=NEXC2 1150 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)) QQIN(9,I)=1.0E-16*(A*EN+B) C 1160 CONTINUE QQIN(10,I)=0.0 IF(EN.LE.EEIN(10)) GOTO 1260 DO 1200 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 1250 1200 CONTINUE J=NEXC3 1250 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)) QQIN(10,I)=1.0E-16*(A*EN+B) C 1260 CONTINUE Q(3,I)=0.0 IF(EN.LE.E(3)) GOTO 1360 DO 1300 J=2,NION IF(EN.LE.XION(J)) GOTO 1350 1300 CONTINUE J=NION 1350 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.0E-16*(A*EN+B) C 1360 CONTINUE Q(1,I)= Q(2,I) + Q(3,I) + Q(4,I) Q(2,I)= Q(2,I) - QQIN(1,I) - QQIN(2,I) - QQIN(3,I) - QQIN(4,I) - + QQIN(5,I) - QQIN(6,I) - QQIN(7,I) - QQIN(8,I) - + QQIN(9,I) - QQIN(10,I) Q(5,I)=0.0 Q(6,I)=0.0 9000 CONTINUE C C SAVE ON COMPUTING TIME C IF(EFINAL.LT.EEIN(10)) NNIN=9 IF(EFINAL.LT.EEIN(9)) NNIN=8 IF(EFINAL.LT.EEIN(8)) NNIN=7 IF(EFINAL.LT.EEIN(7)) NNIN=6 IF(EFINAL.LT.EEIN(6)) NNIN=5 IF(EFINAL.LT.EEIN(5)) NNIN=4 IF(EFINAL.LT.EEIN(4)) NNIN=3 IF(EFINAL.LT.EEIN(3)) NNIN=2 IF(EFINAL.LT.EEIN(2)) NNIN=1 IF(EFINAL.LT.EEIN(1)) NNIN=0 END +DECK,GAS107. SUBROUTINE GAS107(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS107 - CO2, Magboltz 1 gas 39 * Pure Nakamura cross sections, * The cross sections now give a much better fit to * Zhao et al. NIM A340 (1994) 485. * Author - Steve Biagi * (Last modified on 20/ 5/97.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24), /XMOM(64),YMOM(64),XVIB1(39),YVIB1(39),XVIB2(29),YVIB2(29), /XVIB3(13),YVIB3(13),XVIB4(25),YVIB4(25),XVIB5(13),YVIB5(13), /XVIB6(13),YVIB6(13),XVIB7(13),YVIB7(13),XEXC1(8),YEXC1(8), /XATT(29),YATT(29),XEXC2(7),YEXC2(7),XEXC3(23),YEXC3(23), /XION(50),YION(50) CHARACTER*15 NNAME DATA XMOM/0.00,.001,.002,.003,.005,.007,.0085,.010,.015,0.02, /0.03,0.04,0.05,0.07,0.10,0.12,0.15,0.17,0.20,0.25, /0.30,0.35,0.40,0.50,0.70,1.00,1.20,1.30,1.50,1.70, /1.90,2.10,2.20,2.50,2.80,3.00,3.30,3.60,4.00,4.50, /5.00,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.17 EV TO BETTER FIT ELFORDS DATA: DATA YMOM/600.,578.,407.,328.,254.,214.,195.,182.,148.,128., /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------------------------------------------------------- C DATA YMOM/600.,540.,380.,307.,237.,200.,182.,170.,138.,120., C /97.0,85.0,76.0,63.0,50.0,44.0,36.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,1.50,1.95,2.50,3.50,4.06,4.60,5.10,5.56,6.00, /100.,1000.,100000./ DATA YVIB3/0.00,0.00,0.00,0.00,0.63,1.06,0.61,0.29,0.066,0.001, /.0001,.00001,0.0/ 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.0/ 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,0.00,.125,0.36,0.81,1.30,0.61,0.278,0.01,.001, /.0001,0.00,0.00/ DATA XVIB6/0.422,1.50,1.95,2.50,3.40,4.06,4.60,5.10,5.56,6.00, /100.,1000.,100000./ DATA YVIB6/0.00,0.00,0.00,0.00,0.210,0.444,0.18,0.00,0.00,0.00, /0.00,0.00,0.00/ DATA XVIB7/0.505,1.50,1.95,2.50,3.40,4.06,4.60,5.10,5.56,6.00, /100.,1000.,100000./ DATA YVIB7/0.00,0.00,0.00,0.00,0.310,0.59,0.280,0.00,0.00,0.00, /0.00,0.00,0.00/ 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,0.00,0.00,0.00,0.0/ 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,0.0/ DATA XEXC2/7.00,8.00,8.50,11.0,100.,1000.,100000./ DATA YEXC2/0.00,0.50,0.50,0.00,0.00,0.00,0.0/ 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.76,0.83,0.90,0.97,1.14,1.40,1.95,2.54,3.60, /4.80,5.60,6.30,6.60,6.00,3.20,2.15,1.35,0.75,0.40, /0.18,0.09,.022/ DATA XION/13.3,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,0.06,.104,.188,.359,.460,.532,.622,.729,.950, /1.21,1.45,1.63,1.78,1.92,2.04,2.15,2.28,2.56,2.79, /2.98,3.16,3.31,3.43,3.61,3.73,3.80,3.83,3.83,3.80, /3.71,3.62,3.52,3.26,3.03,2.61,2.31,2.06,1.86,1.69, /1.58,1.51,1.15,0.90,0.50,0.29,0.21,0.11,.063,.029/ NNAME='C02 NAKAMURA ' NNIN=10 NMOM=64 NVIB1=39 NVIB2=29 NVIB3=13 NVIB4=25 NVIB5=13 NVIB6=13 NVIB7=13 NEXC1=8 NATT=29 NEXC2=7 NEXC3=23 NION=50 E(1)=0.0 E(2)=2.0*EMASS/(44.0098*AMU) E(3)=13.3 E(4)=3.85 E(5)=0.0 E(6)=0.0 EEIN(1) = 0.083 EEIN(2) = 0.167 EEIN(3) = 0.252 EEIN(4) = 0.291 EEIN(5) = 0.339 EEIN(6) = 0.422 EEIN(7) = 0.505 EEIN(8) = 2.500 EEIN(9) = 7.000 EEIN(10) = 10.500 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 100 J=2,NMOM IF(EN.LE.XMOM(J)) GOTO 150 100 CONTINUE J=NMOM 150 A=(YMOM(J)-YMOM(J-1))/(XMOM(J)-XMOM(J-1)) B=(XMOM(J-1)*YMOM(J)-XMOM(J)*YMOM(J-1))/(XMOM(J-1)-XMOM(J)) Q(2,I)=1.0D-16*(A*EN+B) C QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 260 DO 200 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 250 200 CONTINUE J=NVIB1 250 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)) QQIN(1,I)=1.0D-16*(A*EN+B) C 260 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 360 DO 300 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 350 300 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)) QQIN(2,I)=1.0D-16*(A*EN+B) C 360 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 460 DO 400 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 450 400 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)) QQIN(3,I)=1.0D-16*(A*EN+B) C 460 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 560 DO 500 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 550 500 CONTINUE J=NVIB4 550 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)) QQIN(4,I)=1.0D-16*(A*EN+B) C 560 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 660 DO 600 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 650 600 CONTINUE J=NVIB5 650 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)) QQIN(5,I)=1.0D-16*(A*EN+B) C 660 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 760 DO 700 J=2,NVIB6 IF(EN.LE.XVIB6(J)) GOTO 750 700 CONTINUE J=NVIB6 750 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)) QQIN(6,I)=1.0D-16*(A*EN+B) C 760 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 860 DO 800 J=2,NVIB7 IF(EN.LE.XVIB7(J)) GOTO 850 800 CONTINUE J=NVIB7 850 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)) QQIN(7,I)=1.0D-16*(A*EN+B) C 860 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 960 DO 900 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 950 900 CONTINUE J=NEXC1 950 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)) QQIN(8,I)=1.0D-16*(A*EN+B) C 960 CONTINUE Q(4,I)=0.0 IF(EN.LE.E(4)) GOTO 1060 DO 1000 J=2,NATT IF(EN.LE.XATT(J)) GOTO 1050 1000 CONTINUE J=NATT 1050 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 1060 CONTINUE QQIN(9,I)=0.0 IF(EN.LE.EEIN(9)) GOTO 1160 DO 1100 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 1150 1100 CONTINUE J=NEXC2 1150 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)) QQIN(9,I)=1.0D-16*(A*EN+B) C 1160 CONTINUE QQIN(10,I)=0.0 IF(EN.LE.EEIN(10)) GOTO 1260 DO 1200 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 1250 1200 CONTINUE J=NEXC3 1250 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)) QQIN(10,I)=1.0D-16*(A*EN+B) C 1260 CONTINUE Q(3,I)=0.0 IF(EN.LE.E(3)) GOTO 1360 DO 1300 J=2,NION IF(EN.LE.XION(J)) GOTO 1350 1300 CONTINUE J=NION 1350 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 1360 CONTINUE Q(5,I)=0.0 Q(6,I)=0.0 Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I)+QQIN(9,I)+ - QQIN(10,I) 9000 CONTINUE C C SAVE ON COMPUTING TIME C IF(EFINAL.LT.EEIN(10)) NNIN=9 IF(EFINAL.LT.EEIN(9)) NNIN=8 IF(EFINAL.LT.EEIN(8)) NNIN=7 IF(EFINAL.LT.EEIN(7)) NNIN=6 IF(EFINAL.LT.EEIN(6)) NNIN=5 IF(EFINAL.LT.EEIN(5)) NNIN=4 IF(EFINAL.LT.EEIN(4)) NNIN=3 IF(EFINAL.LT.EEIN(3)) NNIN=2 IF(EFINAL.LT.EEIN(2)) NNIN=1 IF(EFINAL.LT.EEIN(1)) NNIN=0 RETURN END +DECK,GAS108. SUBROUTINE GAS108(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS108 - Neon - Magboltz 1 gas 12 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(33),YXSEC(33),XEXC(19),YEXC(19),XION(34),YION(34) CHARACTER*15 NNAME 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,30.6,50.0,54.4,65.0,77.0,100.,130., /150.,170.,200.,1000./ 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.83,2.82,2.45,2.36,2.18,1.97,1.56,1.22, /1.05,0.91,0.76,0.25/ 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, /60.0,70.0,80.0,90.0,100.,120.,140.,175.,200.,300., /400.,600.,800.,1000./ DATA YION/0.00,.0033,.0089,.0146,.020,.026,.032,.038,.044,.050, /.063,.076,.089,.102,.128,.154,.179,.228,.282,.338, /.435,.514,0.58,0.63,0.67,0.72,0.76,0.78,0.78,0.72, /0.63,0.53,0.44,0.39/ DATA XEXC/16.67,20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,90.0, /100.,125.,150.,200.,250.,300.,500.,700.,1000./ DATA YEXC/0.00,0.07,0.10,0.20,0.22,0.23,0.23,0.23,0.21,0.20, /0.19,0.17,0.13,0.11,0.10,0.09,0.08,0.05,0.02/ C NNAME=' NEON 88 ' NNIN=1 NDATA=33 NION=34 NEXC=19 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 EEIN(1)=16.67 APOL=2.672 LMAX=100 AA=0.2135 DD=3.86 FF=-2.656 A1=1.846 B1=3.29 A2=-0.037 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP IF(EN.GT.1.0) GOTO 100 IF(EN.EQ.0.0) Q(2,I)=0.161E-16 IF(EN.EQ.0.0) GOTO 200 AK=SQRT(EN/ARY) AN0=-AA*AK*(1.0+(4.0*APOL/3.0)*AK*AK*LOG(AK))-(PI*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(PI*APOL*AK*AK*SUMI))**2 10 CONTINUE Q(2,I)=SUM*4.0*PIR2/(AK*AK) GOTO 200 100 DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 370 DO 350 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.0E-16 370 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I) 900 CONTINUE IF(EFINAL.LT.EEIN(1)) NNIN=0 END +DECK,GAS109. SUBROUTINE GAS109(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS109 - Xenon - Magboltz 1 gas 11 * Author - Steve Biagi, modified by Georg Viehhauser * (Last changed on 12/9/94.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(58),YXSEC(58),XEXC(35),YEXC(35),XION(34),YION(34) CHARACTER*15 NNAME DATA XEN/0.00,.005,0.01,0.02,0.03,0.04,0.05,0.07,0.09,0.11, /0.15,.175,0.20,.225,0.25,.275,0.30,0.35,0.40,0.45, /0.50,0.60,0.70,0.80,0.90,1.00,1.20,1.50,1.75,2.00, /2.50,2.75,3.00,4.00,5.00,6.00,7.00,8.00,10.0,12.0, /15.0,20.0,25.0,30.0,40.0,50.0,60.0,80.0,100.,125., /150.,200.,250.,300.,400.,500.,700.,1000./ DATA YXSEC/174.,132.,116.,80.0,61.0,48.0,39.5,29.0,23.0,18.0, /13.0,10.4,8.30,6.80,5.40,4.25,3.25,2.05,1.35,0.85, /0.48,0.40,0.40,0.55,0.90,1.30,2.25,4.15,6.05,8.12, /12.6,15.0,17.0,23.5,26.5,27.0,26.5,25.0,19.0,13.5, /9.35,6.62,5.73,5.11,4.05,2.78,1.95,1.39,1.50,1.73, /1.65,1.24,.982,.910,.802,.741,.702,.490/ 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,23.0,26.0,30.0,40.0,50.0,60.0, /70.0,80.0,90.0,100.,150.,200.,300.,400.,500.,600., /700.,800.,900.,1000./ DATA YION/0.00,.123,.287,.462,.640,.832,1.01,1.20,1.38,1.55, /1.71,2.02,2.30,2.55,3.28,3.77,4.32,5.02,5.42,5.64, /5.73,5.80,5.90,6.03,5.81,5.13,4.36,3.75,3.30,2.94, /2.67,2.44,2.26,2.11/ DATA XEXC/8.32,8.50,9.00,9.50,10.0,10.5,11.0,11.5,12.0,12.5, /13.0,14.0,15.0,16.0,18.0,20.0,25.0,30.0,40.0,50.0, /60.0,70.0,80.0,90.0,100.,150.,200.,300.,400.,500., /600.,700.,800.,900.,1000./ DATA YEXC/0.00,.032,.152,0.24,0.39,0.58,0.72,0.84,1.01,1.26, /1.54,2.04,2.57,3.06,3.55,3.73,3.85,3.57,2.85,2.40, /2.10,1.85,1.66,1.52,1.38,1.00,0.80,.568,.465,.395, /.344,.302,.277,.252,.231/ C NNAME=' XENON 88 ' C C -------------------------------------------------------------------- C DATA ON XENON NOT AS GOOD AS ARGON . GOOD FIT IS OBTAINED TO THE C AVAILABLE DATA. ACCURACY PROBABLY ABOUT 2% ON DRIFT VELOCITY C BELOW 10KV/CM, ABOVE BECAUSE OF LACK OF DATA ACCURACY IS 4%. C TOWNSEND GAIN COEFFICIENT, ALPHA, ACCURATE TO 5%. C FIT TO DIFFUSION DATA OF KOZUMI AND DRIFT VELOCITY OF PACK AND C PHELPS. C -------------------------------------------------------------------- NNIN=1 NDATA=58 NION=34 NEXC=35 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 EEIN(1)=8.32 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 150 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 230 DO 210 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 370 DO 350 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.0E-16 370 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I) 900 CONTINUE IF(EFINAL.LT.EEIN(1)) NNIN=0 END +DECK,GAS110. SUBROUTINE GAS110(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS110 - Ethane - Magboltz 1 gas 13 * Author - Steve Biagi *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(51),YXSEC(51),XVIB1(29),YVIB1(29),XVIB2(28),YVIB2(28 /),XION(25),YION(25),XATT(16),YATT(16),XEXC(26),YEXC(26),XEXC1(31), /YEXC1(31) CHARACTER*15 NNAME 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.00,8.00, /9.00,10.0,14.0,20.0,30.0,40.0,70.0,100.,140.,200.,1000./ DATA YXSEC/60.0,48.0,40.0,35.0,31.0,28.5,24.5,20.0,16.0,11.5, /7.71,5.45,4.00,3.15,2.40,1.80,1.36,1.15,1.10,1.12, /1.23,1.31,1.64,1.98,2.38,3.12,4.12,5.75,7.00,7.85, /8.95,9.60,10.6,11.6,13.2,15.8,19.8,22.0,23.0,21.5, /19.0,16.2,11.8,8.20,5.13,3.65,1.88,1.24,0.85,0.60,0.12/ DATA XVIB1/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 YVIB1/0.00,0.00,0.03,0.24,0.43,0.59,0.69,0.72,0.65,0.56, /0.48,0.42,0.38,0.33,0.28,0.32,0.44,0.70,1.00,1.30, /1.35,1.30,1.10,0.80,0.34,0.16,0.04,0.01,0.00/ DATA XVIB2/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 YVIB2/0.00,0.00,0.03,0.06,0.12,0.16,0.24,0.30,0.35,0.38, /0.43,0.43,0.42,0.38,0.41,0.50,0.73,1.00,1.20,1.35, /1.35,1.10,0.80,0.31,0.13,0.04,0.01,0.00/ DATA XION/11.65,12.5,15.0,20.0,21.0,22.0,25.0,30.0,35.0,40.0, /45.0,50.0,55.0,60.0,70.0,80.0,90.0,100.,120.,140., /200.,300.,500.,700.,1000./ DATA YION/0.00,0.11,1.00,2.60,3.00,3.30,3.95,4.88,5.50,5.95, /6.35,6.60,6.70,6.82,6.98,7.03,6.98,6.90,6.71,6.41, /5.50,4.24,2.96,2.21,1.76/ 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/7.00,7.40,8.00,8.50,9.00,9.50,10.0,11.0,12.0,14.0, /16.0,20.0,25.0,30.0,40.0,50.0,60.0,70.0,80.0,100., /150.,200.,300.,400.,600.,1000./ DATA YEXC/0.00,0.17,0.32,0.49,0.64,0.76,0.86,1.06,1.20,1.48, /1.71,2.00,2.17,2.21,2.11,1.91,1.74,1.58,1.44,1.21, /0.87,0.69,0.48,0.36,0.23,0.16/ DATA XEXC1/9.20,9.40,10.0,10.5,11.0,11.5,12.0,13.0,14.0,15.0, /16.0,18.0,20.0,22.0,26.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./ DATA YEXC1/0.00,0.06,0.13,0.19,0.23,0.28,0.34,0.52,0.78,1.16, /1.61,2.36,2.91,3.20,3.51,3.55,3.46,3.24,2.99,2.72, /2.26,1.94,1.70,1.37,1.00,0.82,0.60,0.47,0.39,0.33,0.24/ NNAME=' ETHANE 1988 ' C --------------------------------------------------------------------- C CROSS-SECTION DERIVED FROM HAYASHI'S 1983 DATA SET . MODIFIED TO GIVE C THE CORRECT CROSS-SECTIONS USING MULTI-TERM CODE C ACCCURACY OF VELOCITY IS ABOUT 1.0% BELOW 3000 VOLTS, 2% BELOW 8000 C VOLTS AND 3% BELOW 20000 VOLTS/CM. DIFFUSION 4% AT ALL VOLTAGES C IONISATION IS ACCURATE TO 6% BELOW 300,000 VOLTS. C --------------------------------------------------------------------- NNIN=4 NDATA=51 NVIB1=29 NVIB2=28 NION=25 NATT=16 NEXC=26 NEXC1=31 E(1)=0.0 E(2)=2.0*EMASS/(30.06964*AMU) E(3)=11.65 E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.160 EEIN(2)=0.360 EEIN(3)=7.00 EEIN(4)=9.2 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS111. SUBROUTINE GAS111(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS111 - Isobutane - Magboltz 1 gas 14 * Author - Steve Biagi *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(53),YXSEC(53),XVIB1(29),YVIB1(29),XVIB2(28),YVIB2(28 /),XION(25),YION(25),XATT(16),YATT(16),XEXC(26),YEXC(26),XEXC1(31), /YEXC1(31) CHARACTER*15 NNAME 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.,1000./ DATA YXSEC/77.0,64.0,63.0,61.0,60.0,58.0,55.0,50.0,46.0,41.0, /35.0,30.5,26.5,23.5,21.0,18.8,17.0,15.4,13.5,12.0, /10.8,9.20,6.60,4.00,3.00,3.00,4.80,7.50,9.60,11.1, /12.8,13.8,15.0,16.0,17.5,19.5,22.5,25.0,27.0,29.0, /31.0,32.0,31.0,29.0,17.0,12.0,7.00,5.00,2.40,1.50,0.95,0.60,0.12/ DATA XVIB1/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 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.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 YVIB2/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.56,11.4,13.9,18.9,19.9,20.9,23.9,28.9,33.9,38.9, /43.9,48.9,53.9,58.9,68.9,78.9,88.9,98.9,120.,140., /200.,300.,500.,700.,1000./ DATA YION/0.00,.209,1.90,4.94,5.70,6.27,7.51,9.27,10.5,11.3, /12.1,12.5,12.7,13.0,13.3,13.4,13.3,13.1,12.7,12.2, /10.4,8.06,5.62,4.20,3.34/ DATA XATT/6.25,6.40,6.60,6.90,7.40,7.90,8.40,8.90,9.40,9.90, /10.4,10.9,11.4,11.9,12.4,12.6/ DATA YATT/0.00,1.14,1.87,2.80,4.76,7.48,11.2,17.5,25.0,20.9, /16.5,10.5,5.95,2.21,0.85,0.00/ 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.29,0.54,0.83,1.09,1.29,1.46,1.80,2.04,2.52, /2.91,3.40,3.69,3.76,3.59,3.25,2.96,2.69,2.45,2.06, /1.48,1.17,0.82,0.61,0.39,0.27/ 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.10,0.22,0.32,0.39,0.48,0.58,0.88,1.33,1.97, /2.74,4.01,4.95,5.44,5.97,6.03,5.88,5.51,5.08,4.62, /3.84,3.30,2.89,2.33,1.70,1.39,1.02,0.80,0.66,0.56,0.41/ C ---------------------------------------------------------------- C MULTI TERM CROSS-SECTIONS FIT GOOD TO 1% FOR DRIFT VELOCITY BELOW C 10KV/CM. (DIFFUSION DATA NOT ACCURATE SO DIFFUSION MAY BE IN ERROR BY C 5% IN THIS RANGE.) IONISATION FITTED TO N-BUTANE RESULTS SINCE C NO DATA ON TOWNSEND COEFFICIENT AVAILABLE IN ISO-BUTANE. C --------------------------------------------------------------- NNAME='ISOBUTANE 88 ' NNIN=4 NDATA=53 NVIB1=29 NVIB2=28 NION=25 NATT=16 NEXC=26 NEXC1=31 E(1)=0.0 E(2)=2.0*EMASS/(58.1234*AMU) E(3)=10.56 E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.16 EEIN(2)=0.36 EEIN(3)=6.3 EEIN(4)=8.3 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS112. SUBROUTINE GAS112(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS112 - Isobutane - Magboltz 1 gas 32 * Author - Steve Biagi * (Last changed on 10/ 2/95.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) 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 NNAME 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-------------------------------------------------------- NNAME='ISOBUTANE 1995 ' C --------------------------------------------------------------------- NNIN=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/(58.1234*AMU) E(3)=10.67 E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.052 EEIN(2)=0.108 EEIN(3)=0.173 EEIN(4)=0.363 EEIN(5)=0.519 EEIN(6)=7.4 EEIN(7)=9.70 EEIN(8)=17.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 4000 DO 4100 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 4000 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 400 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 RETURN END +DECK,GAS113. SUBROUTINE GAS113(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS113 - Cold methylal - Magboltz 1 gas 16 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) 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 NNAME 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.,110.,101.,95.0,90.0,75.0,65.0, /53.0,44.0,36.0,25.0,19.5,14.5,12.1,10.7,10.2,12.2, /16.0,26.0,30.0,40.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,.062,0.50,0.90,1.24,1.45,1.51,1.37,1.18, /1.01,0.89,0.79,0.70,0.59,0.67,0.92,1.48,2.10,2.72, /2.83,2.72,2.30,1.68,0.71,0.34,0.08,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,.062,0.50,0.90,1.24,1.45,1.51,1.37,1.18, /1.01,0.89,0.79,0.70,0.59,0.67,0.92,1.48,2.10,2.72, /2.83,2.72,2.30,1.68,0.71,0.34,0.08,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,.064,.126,0.25,0.34,0.50,0.64,0.73,0.79, /0.90,0.90,0.88,0.79,0.86,1.06,1.54,2.10,2.52,2.83, /2.83,2.30,1.68,0.65,0.28,0.08,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 TWO DATA SETS CREATED FOR METHYLAL WITH DIFFERENT TRANSVERSE C DIFFUSION SINCE NO EXPERIMENTAL DATA AVAILABLE. TWO DATA SETS C GIVE MAXIMUM AND MINIMUM EXPECTED TRANSVERSE DIFFUSION. C COLD GIVES SMALLER TRANSVERSE DIFFUSION. C NNAME='METHYLAL COLD ' NNIN=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 EEIN(1)=0.12 EEIN(2)=0.16 EEIN(3)=0.36 EEIN(4)=6.3 EEIN(5)=8.3 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP C DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 430 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 460 DO 440 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 460 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+QQIN(4,I)+ - QQIN(5,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS114. SUBROUTINE GAS114(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS114 - Propane - Magboltz 1 gas 17 * Author - Steve Biagi *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(51),YXSEC(51),XVIB1(29),YVIB1(29),XVIB2(28),YVIB2(28 /),XION(25),YION(25),XATT(16),YATT(16),XEXC(26),YEXC(26),XEXC1(31), /YEXC1(31) CHARACTER*15 NNAME 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.00,8.00, /9.00,10.0,14.0,20.0,30.0,40.0,70.0,100.,140.,200.,1000./ DATA YXSEC/84.0,67.0,56.0,50.0,46.0,42.0,36.0,30.0,25.5,21.0, /15.0,12.0,9.50,7.70,6.30,5.30,4.40,3.50,3.00,2.80, /2.80,3.00,3.60,4.25,5.00,6.50,8.40,10.9,12.0,13.0, /14.4,15.5,17.5,19.8,23.0,26.0,28.0,31.0,32.0,30.0, /26.6,22.7,16.5,11.5,7.18,5.11,2.63,1.74,1.19,0.84,0.17/ DATA XVIB1/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 YVIB1/0.00,0.00,0.04,0.34,0.60,0.83,0.97,1.01,0.91,0.78, /0.67,0.59,0.53,0.46,0.39,0.45,0.62,0.98,1.40,1.82, /1.89,1.82,1.54,1.12,0.48,0.22,0.06,.014,0.00/ DATA XVIB2/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 YVIB2/0.00,0.00,0.04,0.08,0.17,0.22,0.34,0.42,0.49,0.53, /0.60,0.60,0.59,0.53,0.57,0.70,1.02,1.40,1.68,1.89, /1.89,1.54,1.12,0.43,0.18,0.06,.014,0.00/ DATA XION/11.07,11.9,14.4,19.4,20.4,21.4,24.4,29.4,34.4,39.4, /44.4,50.0,55.0,60.0,70.0,80.0,90.0,100.,120.,140., /200.,300.,500.,700.,1000./ DATA YION/0.00,0.16,1.45,3.77,4.35,4.78,5.73,7.08,7.98,8.63, /9.21,9.57,9.72,9.89,10.1,10.2,10.1,10.0,9.73,9.29, /7.98,6.15,4.29,3.20,2.55/ DATA XATT/6.45,6.60,6.80,7.10,7.60,8.10,8.60,9.10,9.60,10.1, /10.6,11.1,11.6,12.1,12.6,12.8/ 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 XEXC/6.45,6.85,7.45,7.95,8.45,8.95,9.45,10.4,11.4,13.4, /15.4,19.4,24.4,29.4,39.4,50.0,60.0,70.0,80.0,100., /150.,200.,300.,400.,600.,1000./ DATA YEXC/0.00,0.23,0.43,0.66,0.86,1.03,1.16,1.43,1.62,2.00, /2.31,2.70,2.93,2.98,2.85,2.58,2.35,2.13,1.94,1.63, /1.17,0.93,0.65,0.49,0.31,0.22/ DATA XEXC1/8.65,8.85,9.45,9.95,10.4,10.9,11.4,12.4,13.4,14.4, /15.4,17.4,19.4,21.4,25.4,29.4,34.4,39.4,44.4,50.0, /60.0,70.0,80.0,100.,150.,200.,300.,400.,500.,600.,1000./ DATA YEXC1/0.00,0.08,0.18,0.26,0.31,0.38,0.46,0.70,1.05,1.57, /2.17,3.19,3.93,4.32,4.74,4.79,4.67,4.37,4.04,3.67, /3.05,2.62,2.29,1.85,1.35,1.11,0.81,0.63,0.53,0.45,0.32/ NNAME='PROPANE 1988 ' C --------------------------------------------------------------------- C ACCCURACY OF VELOCITY IS ABOUT 1.5% BELOW 4000 VOLTS, 4% BELOW 8000 C VOLTS AND 5% BELOW 20000 VOLTS/CM. DIFFUSION 4% AT ALL VOLTAGES C IONISATION IS ACCURATE TO 5% BELOW 300,000 VOLTS. C --------------------------------------------------------------------- NNIN=4 NDATA=51 NVIB1=29 NVIB2=28 NION=25 NATT=16 NEXC=26 NEXC1=31 E(1)=0.0 E(2)=2.0*EMASS/(44.09652*AMU) E(3)=11.07 E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.160 EEIN(2)=0.360 EEIN(3)=6.45 EEIN(4)=8.65 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS115. SUBROUTINE GAS115(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS115 - Neopentane - Magboltz 1 gas 18 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(53),YXSEC(53),XVIB1(29),YVIB1(29),XVIB2(28),YVIB2(28 /),XION(25),YION(25),XATT(16),YATT(16),XEXC(26),YEXC(26),XEXC1(31), /YEXC1(31) CHARACTER*15 NNAME 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.,1000./ DATA YXSEC/115.,100.,97.0,96.0,94.0,93.0,90.0,87.0,83.0,76.0, /67.0,61.0,55.0,50.0,45.0,41.0,37.0,32.0,27.0,23.0, /19.0,15.0,9.50,5.80,4.20,3.40,3.25,3.25,3.65,4.50, /7.00,9.80,14.5,17.5,21.5,25.5,30.0,33.0,36.0,38.0, /39.0,40.0,39.0,38.0,23.0,16.0,9.00,6.00,3.00,1.80,1.25,0.75,0.15/ DATA XVIB1/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 YVIB1/0.00,0.00,.062,0.50,0.90,1.24,1.45,1.51,1.37,1.18, /1.01,0.89,0.79,0.70,0.59,0.67,0.92,1.48,2.10,2.72, /2.83,2.72,2.30,1.68,0.71,0.34,0.08,0.02,0.00/ DATA XVIB2/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 YVIB2/0.00,0.00,.064,.126,0.25,0.34,0.50,0.64,0.73,0.79, /0.90,0.90,0.88,0.79,0.86,1.06,1.54,2.10,2.52,2.83, /2.83,2.30,1.68,0.65,0.28,0.08,0.02,0.00/ DATA XION/10.35,11.2,13.7,18.7,19.7,20.7,23.7,28.7,33.7,38.7, /43.7,48.7,53.7,58.7,68.7,78.7,88.7,98.7,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 XATT/6.25,6.40,6.60,6.90,7.40,7.90,8.40,8.90,9.40,9.90, /10.4,10.9,11.4,11.9,12.4,12.6/ DATA YATT/0.00,1.37,2.24,3.36,5.71,8.98,13.4,21.0,30.0,25.1, /19.8,12.6,7.14,2.65,1.02,0.00/ 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.22,2.94,2.47, /1.78,1.40,0.98,0.73,0.47,0.32/ 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 DIFFUSION EXPERIMENTAL DATA AVAILABLE USED INELASTICS FROM SCALING C LOWER SATURATED HYDROCARBONS. ELASTIC DETERMINED FROM DRIFT VELOCITY. C HENCE DIFFUSION ACCURATE TO ONLY 10% , DRIFT VELOCITY TO 3% BELOW C 10KV/CM. C --------------------------------------------------------------- NNAME='NEO-PENTANE 88 ' NNIN=4 NDATA=53 NVIB1=29 NVIB2=28 NION=25 NATT=16 NEXC=26 NEXC1=31 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 EEIN(1)=0.16 EEIN(2)=0.36 EEIN(3)=6.3 EEIN(4)=8.3 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 C END +DECK,GAS116. SUBROUTINE GAS116(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS116 - CF4, Magboltz 1 gas 21 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(35),YXSEC(35),XVIB1(32),YVIB1(32),XVIB2(38),YVIB2(38 /),XVIB3(23),YVIB3(23),XEXC(57),YEXC(57),XION(51),YION(51), /XATT(45),YATT(45) CHARACTER*15 NNAME DATA XEN/0.0,.00053,.001,.0017,.0047,.0079,.013,.0206,.0324,.0423, /.060,.089,.116,.144,.172,.204,.227,.266,.294,.343, /.444,.499,.632,.861,1.20,1.58,2.08,2.81,3.07,4.30, /11.3,22.3,65.8,100.,1000./ DATA YXSEC/30.0,26.0,21.4,19.6,15.4,12.5,9.34,5.57,2.85,1.85, /1.05,.374,.125,.0363,.0115,.0070,.0067,.0069,.0074,.0089, /.0136,.0185,.0395,.118,.513,1.60,4.03,8.00,8.54,7.89, /6.55,5.53,4.26,3.77,1.0/ DATA XVIB1/.0,.0539,.0692,.0706,.0733,.076,.0786,.0811,.0833,.086, /.090,.097,.106,.113,.120,.137,.151,.178,.203,.307, /.341,.346,.432,.559,.831,1.22,1.89,3.10,4.36,46.0, /100.,1000./ DATA YVIB1/.0,.0,.085,.097,.108,.116,.122,.122,.120,.116, /.106,.087,.064,.056,.049,.042,.040,.040,.041,.051, /.053,.054,.061,.072,.096,.149,.218,.357,.532,.361, /.30,.01/ DATA XVIB2/.0,.113,.1334,.1362,.1458,.156,.164,.170,.176,.1815, /.191,.201,.216,.231,.235,.250,.276,.302,.324,.372, /.430,.499,.607,.924,1.28,1.86,2.53,3.38,4.05,6.46, /8.48,11.8,18.2,24.4,35.7,51.3,100.,1000./ DATA YVIB2/.0,.0,.540,.661,1.27,2.12,2.69,3.09,2.97,2.54, /1.88,1.43,.858,.600,.501,.362,.271,.231,.200,.182, /.186,.200,.209,.277,.384,.421,.458,.519,.564,.503, /.451,.406,.354,.305,.272,.254,.200,.010/ DATA XVIB3/.0,.159,.1763,.2012,.2279,.232,.239,.244,.272,.291, /.322,.372,.430,.511,.610,.862,1.43,1.85,2.57,4.20, /5.0,100.,1000./ DATA YVIB3/.0,.0,1.55,6.08,16.0,17.0,17.5,16.9,13.0,9.77, /7.91,6.41,5.15,4.13,3.72,3.37,3.23,3.16,3.38,3.58, /3.50,0.1,0.001/ C NOTE IONISATION CROSS-SECTIONS SCALED IN SUBROUTINE BY *1.35 DATA XION/15.9,16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0,24.0, /25.0,26.0,27.0,28.0,29.0,30.0,31.0,32.0,33.0,34.0, /35.0,36.0,37.0,38.0,39.0,40.0,41.0,42.0,43.0,44.0, /45.0,46.0,47.0,48.0,49.0,50.0,51.0,52.0,53.0,54.0, /55.0,56.0,57.0,58.0,59.0,60.0,65.0,70.0,75.0,80.0, /1000./ DATA YION/.0,.0114,.039,.087,.153,.231,.321,.425,.540,.660, /.790,.930,1.07,1.21,1.35,1.48,1.60,1.69,1.78,1.86, /1.93,2.00,2.06,2.11,2.17,2.23,2.29,2.35,2.42,2.48, /2.55,2.60,2.66,2.71,2.75,2.80,2.84,2.87,2.91,2.94, /2.97,3.00,3.02,3.05,3.07,3.10,3.20,3.28,3.33,3.38, /0.01/ C NOTE ATTACHMENT CROSS-SECTIONS SCALED IN SUBROUTINE BY *2.0 DATA XATT/4.65,5.00,5.50,5.96,6.06,6.15,6.25,6.32,6.42,6.54, /6.66,6.74,6.82,6.95,7.03,7.15,7.24,7.35,7.46,7.56, /7.61,7.71,7.84,7.96,8.04,8.16,8.22,8.32,8.45,8.56, /8.66,8.77,8.84,9.04,9.11,9.33,9.53,9.74,9.82,10.0, /10.3,10.6,10.8,11.0,1000./ DATA YATT/.0,.001,.004,.0061,.0068,.0073,.0077,.0080,.0081,.0084, /.0086,.0086,.0086,.0086,.0083,.0080,.0078,.0073,.0069,.0063, /.0060,.0055,.0048,.0044,.0040,.0036,.0032,.0029,.0025,.0023, /.0020,.0018,.0015,.0012,.0011,.0009,.0007,.0005,.0005,.0004, /.0003,.0001,.00004,.00001,.0000001/ C NOTE EXCITATION CROSS-SECTIONS SCALED IN SUBROUTINE BY *1.35 DATA XEXC/12.5,12.7,13.5,14.5,15.1,15.5,15.9,16.0,16.5,17.0, /17.2,18.0,18.2,19.0,20.0,20.5,21.0,22.0,23.0,24.0, /25.0,26.0,27.0,28.0,29.0,30.0,31.0,32.0,33.0,34.0, /35.0,36.0,37.0,38.0,39.0,40.0,41.0,42.0,43.0,44.0, /45.0,46.0,47.0,48.0,49.0,50.0,51.0,52.0,53.0,54.0, /55.0,56.0,57.0,58.0,59.0,60.0,1000./ DATA YEXC/.0,.0355,.0814,.135,.171,.236,.284,.286,.335,.399, /.421,.491,.507,.558,.612,.633,.674,.745,.796,.843, /.879,.905,.931,.958,.984,1.02,1.00,1.01,1.02,1.04, /1.07,1.10,1.14,1.19,1.23,1.27,1.29,1.31,1.32,1.34, /1.35,1.38,1.40,1.43,1.47,1.50,1.50,1.51,1.51,1.52, /1.53,1.54,1.57,1.58,1.60,1.61,0.01/ C ---------------------------------------------------------------- C YOUSFI'S DATA SET (PRELIMINARY) C NOTE : DATA ANLAYSIS NOT COMPLETED BY YOUSFI . C BOLTZMANN CODE WILL NOT GIVE CORRECT ANSWERS FOR PURE CF4 BECAUSE C HIGHER TERMS ARE LARGER THAN FIRST THREE TERMS OF EXPANSION. C HOWEVER, BOLTZMANN WITH MAGNETIC FIELD IS GOOD BECAUSE C THE MAGNETIC FIELD SUPPRESSES THE HIGHER TERMS. C THE BOLTZMANN CODE GIVES ACCURATE ANSWERS FOR LOW MIXTURES OF CF4 C IN OTHER GASSES WITHOUT MAGNETIC FIELD. C THE MONTE CARLO GIVES GOOD ANSWERS FOR ANY CF4 MIXTURE BUT HAS C NO MAGNETIC FIELD. C --------------------------------------------------------------- NNAME=' CF4 --YOUSFI ' NNIN=4 NDATA=35 NVIB1=32 NVIB2=38 NVIB3=23 NION=51 NATT=45 NEXC=57 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 EEIN(1)=0.0539 EEIN(2)=0.113 EEIN(3)=0.159 EEIN(4)=12.5 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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 SCALE FACTOR Q(3,I)=Q(3,I)*1.35 C 200 Q(4,I)=0.0 IF(EN.LT.XATT(1)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 SCALE FACTOR Q(4,I)=Q(4,I)*2.0 C 300 Q(5,I)=0.0 Q(6,I)=0.0 C QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 620 610 CONTINUE J=NEXC 620 A=(YEXC(J)-YEXC(J-1))/(XEXC(J)-XEXC(J-1)) B=(XEXC(J-1)*YEXC(J)-XEXC(J)*YEXC(J-1))/(XEXC(J-1)-XEXC(J)) QQIN(4,I)=(A*EN+B)*1.E-16 C SCALE FACTOR QQIN(4,I)=QQIN(4,I)*1.35 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 C END +DECK,GAS117. SUBROUTINE GAS117(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS117 - CF4, Magboltz 1 gas 28 * Author - Steve Biagi * (Last changed: 25/ 1/95.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(72),YXSEC(72),XVIB1(14),YVIB1(14), /XVIB2(14),YVIB2(14),XVIB3(14),YVIB3(14),XVIB4(16),YVIB4(16), /XVIB5(16),YVIB5(16),XEXC(46),YEXC(46),XION(52),YION(52), /XATT(11),YATT(11) CHARACTER*15 NNAME 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./ DATA YXSEC/19.6,15.2,13.5,12.4,11.4,10.6,9.96,9.36,8.83,8.36, /7.92,7.16,6.51,5.94,5.44,5.00,4.08,3.37,2.80,2.33, /1.95,1.64,1.38,1.16,0.97,0.82,0.69,0.58,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 XVIB1/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 YVIB1/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 XVIB2/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 YVIB2/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 XVIB3/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 YVIB3/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 XVIB4/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 YVIB4/0.0,.001,0.01,0.04,0.06,0.47,0.70,0.60,0.40,.033, /.011,.0001,.00001,.000001,.0000001,.00000001/ C VIBRATION HARMONIC (3(V3) + ALL OTHER HARMONICS) DATA XVIB5/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 YVIB5/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,18.0,20.0,25.0,30.0,35.0,40.0,45.0,50.0, /55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0,100., /110.,120.,130.,140.,150.,160.,170.,180.,190.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,1000., /1200.,1400.,2000.,2500.,3000.,4000.,5000.,6000.,8000.,10000., /20000.,100000./ DATA YION/0.0,0.016,0.21,.384,1.15,2.07,2.78,3.28,3.88,4.35, /4.69,5.03,5.36,5.57,5.72,5.85,5.95,6.05,6.16,6.24, /6.37,6.40,6.40,6.35,6.32,6.26,6.20,6.13,6.05,5.98, /5.67,5.39,5.13,4.91,4.73,4.58,4.15,3.85,3.60,3.25, /2.90,2.60,2.15,1.80,1.60,1.28,1.05,0.91,0.71,0.56, /0.28,.056/ 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,55.0,60.0,65.0,70.0,75.0,80.0,85.0, /90.0,95.0,100.,110.,120.,130.,140.,150.,160.,170., /180.,190.,200.,250.,300.,350.,400.,450.,500.,600., /1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.0,.045,.195,.360,0.54,0.84,1.05,1.44,1.65,1.81, /1.92,1.96,2.00,2.05,2.08,2.06,2.08,2.13,2.17,2.20, /2.21,2.19,2.18,2.16,2.16,2.16,2.19,2.20,2.21,2.22, /2.22,2.22,2.22,2.07,2.00,1.85,1.65,1.50,1.30,1.00, /0.56,0.25,0.13,0.06,0.03,.006/ C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO DECEMBER 1994 C CONTAINS ANISOTROPIC ANALYSIS OF VIBRATIONAL BAND GOOD FIT C OBTAINED TO ALL DATA . SUPERCEDES PREVIOUS ANALYSIS. C ROUTINE CAN BE USED IN BOTH MONTE CARLO OR BOLTZMAN CODE BY C ALTERING THE SUBROUTINE HEADER. C --------------------------------------------------------------- NNAME=' CF4 --1994--- ' C KEL=0 FAC1=1.00 FAC2=0.75 NNIN=6 NDATA=72 NVIB1=14 NVIB2=14 NVIB3=14 NVIB4=16 NVIB5=16 NION=52 NATT=11 NEXC=46 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 EEIN(1)=0.0784 EEIN(2)=0.1126 EEIN(3)=0.1589 EEIN(4)=0.3178 *** Next line changed on 25/ 1/95 (fix from Steve Biagi) C EEIN(5)=0.4304 EEIN(5)=0.4767 EEIN(6)=12.5 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 9000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 320 310 CONTINUE J=NVIB1 320 A=(YVIB1(J)-YVIB1(J-1))/(XVIB1(J)-XVIB1(J-1)) B=(XVIB1(J-1)*YVIB1(J)-XVIB1(J)*YVIB1(J-1))/(XVIB1(J-1)-XVIB1(J)) EFAC=DSQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.0768*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(1,I)=((A*EN+B)+QQIN(1,I))*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 420 410 CONTINUE J=NVIB2 420 A=(YVIB2(J)-YVIB2(J-1))/(XVIB2(J)-XVIB2(J-1)) B=(XVIB2(J-1)*YVIB2(J)-XVIB2(J)*YVIB2(J-1))/(XVIB2(J-1)-XVIB2(J)) EFAC=DSQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.0224*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=((A*EN+B)+QQIN(2,I))*1.E-16 500 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) EFAC=DSQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=1.584*DLOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(3,I)=((A*EN+B)+QQIN(3,I))*1.E-16 600 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 800 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+FAC1*QQIN(1,I)+QQIN(2,I)+ - FAC2*QQIN(3,I)+QQIN(4,I)+QQIN(5,I)+QQIN(6,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS118. SUBROUTINE GAS118(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS118 - DME, Magboltz 1 gas 23 * Author - Steve Biagi * (Last changed 1/ 2/92.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(45),YXSEC(45),XVIB3(29),YVIB3(29),XVIB4(28),YVIB4(28 /),XION(25),YION(25),XATT(16),YATT(16),XEXC(26),YEXC(26),XEXC1(31), /YEXC1(31),XVIB1(11),YVIB1(11),XVIB2(11),YVIB2(11) CHARACTER*15 NNAME DATA XEN/0.00,0.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,14.0,20.0,30.0,40.0,70.0,100.,140.,200.,1000./ DATA YXSEC/280.0,280.0,280.0,278.0, /270.,262.,246.,215.,175.,150.,129.,114.,100.,88.0, /78.0,70.0,62.0,55.0,47.0,38.0,31.0,24.0,20.0,19.0, /18.0,17.0,16.0,16.0,17.0,18.0,19.0,21.0,23.0,21.5, /19.0,17.0,11.8,8.20,5.13,3.65,1.88,1.24,0.85,0.60,0.12/ DATA XVIB1/0.0,.051,0.06,0.07,0.08,0.09,0.10,0.20,0.40,1.00,1000./ DATA YVIB1/0.0,0.00,0.05,0.15,0.20,0.20,0.20,0.20,0.10,0.01,0.00/ DATA XVIB2/0.0,.115,0.13,0.15,0.18,0.20,0.30,0.40,1.00,2.00,1000./ DATA YVIB2/0.0,0.00,1.80,1.80,1.80,1.80,1.80,1.35,0.09,0.09,0.00/ DATA XVIB3/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 YVIB3/0.00,0.00,0.02,0.17,0.30,0.41,0.48,0.50,0.46,0.39, /0.34,0.29,0.27,0.23,0.20,0.20,0.20,0.20,0.20,0.20, /0.20,0.20,0.20,0.20,0.10,0.05,0.01,0.01,0.00/ DATA XVIB4/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 YVIB4/0.00,0.00,0.10,0.15,0.30,0.40,0.60,0.70,0.80,0.90, /1.10,1.10,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00, /1.00,1.00,1.00,1.00,0.20,0.10,0.10,0.00/ 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./ 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.32,2.48,1.98/ 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/6.31,6.71,7.31,7.81,8.31,8.81,9.31,10.3,11.3,13.3, /15.3,19.3,24.3,29.3,39.3,49.3,59.3,69.3,79.3,99.3, /150.,200.,300.,400.,600.,1000./ DATA YEXC/0.00,0.19,0.36,0.55,0.72,0.85,0.97,1.19,1.35,1.66, /1.92,2.25,2.44,2.48,2.37,2.14,1.95,1.77,1.62,1.36, /0.98,0.77,0.54,0.40,0.26,0.18/ 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,19.3,21.3,25.3,29.3,34.3,39.3,44.3,49.3, /59.3,69.3,79.3,100.,150.,200.,300.,400.,500.,600.,1000./ DATA YEXC1/0.00,0.07,0.15,0.21,0.26,0.31,0.38,0.58,0.88,1.30, /1.81,2.65,3.27,3.59,3.94,3.99,3.88,3.64,3.36,3.05, /2.54,2.18,1.91,1.54,1.12,0.92,0.67,0.53,0.44,0.37,0.27/ NNAME=' DME NOT FINAL ' C --------------------------------------------------------------------- C PRELIMINARY DATA SET FOR DME NOT YET CORRECT 1/2/92 C --------------------------------------------------------------------- ASCALE1=0.0 ASCALE2=1.0 ASCALE3=1.0 ASCALE4=1.0 NNIN=6 NDATA=45 NVIB1=11 NVIB2=11 NVIB3=29 NVIB4=28 NION=25 NATT=16 NEXC=26 NEXC1=31 E(1)=0.0 E(2)=2.0*EMASS/(46.06904*AMU) E(3)=10.04 C CORRECT ENERGY E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.051 EEIN(2)=0.115 EEIN(3)=0.160 EEIN(4)=0.360 EEIN(5)=6.31 EEIN(6)=8.5 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 QQIN(1,I)=QQIN(1,I)*ASCALE1 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 QQIN(2,I)=QQIN(2,I)*ASCALE2 430 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 460 DO 440 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 QQIN(3,I)=QQIN(3,I)*ASCALE3 460 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 500 DO 470 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 480 470 CONTINUE J=NVIB4 480 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)) QQIN(4,I)=(A*EN+B)*1.E-16 QQIN(4,I)=QQIN(4,I)*ASCALE4 500 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 C END +DECK,GAS119. SUBROUTINE GAS119(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS119 - DME, Magboltz 1 gas 25 * Author - Steve Biagi *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(45),YXSEC(45),XVIB3(28),YVIB3(28), /XION(25),YION(25),XATT(16),YATT(16),XEXC(26),YEXC(26),XEXC1(31), /YEXC1(31),XVIB1(11),YVIB1(11),XVIB2(29),YVIB2(29) CHARACTER*15 NNAME DATA XEN/0.00,0.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,14.0,20.0,30.0,40.0,70.0,100.,140.,200.,1000./ DATA YXSEC/272.0,272.0,272.0,270.0, /262.,254.,238.,208.,169.,145.,125.,110.,97.0,85.0, /74.5,66.5,57.5,50.0,43.0,34.0,25.0,20.0,18.0,17.5, /17.0,16.2,16.5,17.0,18.6,21.0,22.5,23.0,22.5,21.5, /19.0,17.0,11.8,8.00,5.15,3.65,1.88,1.24,0.85,0.60,0.12/ DATA XVIB1/0.0,.099,0.12,0.15,0.18,0.25,0.30,0.40,0.60,1.00,1000./ DATA YVIB1/0.0,0.00,3.50,3.80,4.00,4.00,1.50,0.25,0.05,.005,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,0.02,0.17,0.30,0.41,0.48,0.50,0.46,0.39, /0.37,0.33,0.32,0.30,0.33,0.40,0.50,0.75,1.00,1.20, /1.20,1.10,1.00,0.80,0.55,0.35,0.15,0.01,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,0.10,0.15,0.30,0.40,0.60,0.70,0.80,0.92, /1.10,1.10,1.00,0.95,0.95,1.00,1.20,1.50,1.70,2.00, /2.00,1.90,1.70,1.20,0.80,0.35,0.10,0.00/ 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./ 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.32,2.48,1.98/ 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/6.31,6.71,7.31,7.81,8.31,8.81,9.31,10.3,11.3,13.3, /15.3,19.3,24.3,29.3,39.3,49.3,59.3,69.3,79.3,99.3, /150.,200.,300.,400.,600.,1000./ DATA YEXC/0.00,0.19,0.36,0.55,0.72,0.85,0.97,1.19,1.35,1.66, /1.92,2.25,2.44,2.48,2.37,2.14,1.95,1.77,1.62,1.36, /0.98,0.77,0.54,0.40,0.26,0.18/ 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,19.3,21.3,25.3,29.3,34.3,39.3,44.3,49.3, /59.3,69.3,79.3,100.,150.,200.,300.,400.,500.,600.,1000./ DATA YEXC1/0.00,0.07,0.15,0.21,0.26,0.31,0.38,0.58,0.88,1.30, /1.81,2.65,3.27,3.59,3.94,3.99,3.88,3.64,3.36,3.05, /2.54,2.18,1.91,1.54,1.12,0.92,0.67,0.53,0.44,0.37,0.27/ NNAME=' DME 1992 ' C --------------------------------------------------------------------- C REPLACES PROVISIONAL DME 91 C --------------------------------------------------------------------- NNIN=5 NDATA=45 NVIB1=11 NVIB2=29 NVIB3=28 NION=25 NATT=16 NEXC=26 NEXC1=31 E(1)=0.0 E(2)=2.0*EMASS/(46.06904*AMU) E(3)=10.04 C CORRECT ENERGY E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.099 EEIN(2)=0.160 EEIN(3)=0.360 EEIN(4)=6.31 EEIN(5)=8.5 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 430 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 460 DO 440 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 460 CONTINUE C 500 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 600 DO 510 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 700 DO 610 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 C END +DECK,GAS120. SUBROUTINE GAS120(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS120 - DME, Magboltz 1 gas 37 * Corrected vibrational fit from Sverdlov. * Author - Steve Biagi * (Last changed on 5/ 4/95.) *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(24,2002),E(6),EEIN(24) DIMENSION XEN(54),YXSEC(54),XION(29),YION(29),XATT(16),YATT(16), /XVIB2(19),YVIB2(19),XVIB3(28),YVIB3(28),XVIB4(25),YVIB4(25), /XVIB5(19),YVIB5(19),XEXC(27),YEXC(27),XEXC1(35),YEXC1(35) CHARACTER*15 NNAME 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 V1 AND V2 DIPOLE PARTS GIVEN ANALYTICALLY C NB V2 TABLE CONTAINS ONLY RESONANCE PART OF X-SECT. DATA XVIB2/.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 YVIB2/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 XVIB3/.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 YVIB3/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 XVIB4/.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 YVIB4/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 XVIB5/.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 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 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.10,0.35,0.65,1.15,1.60,1.85,2.15,2.55,2.75, /2.80,2.90,2.95,2.95,2.90,2.80,2.55,1.75,1.35,1.00, /0.80,0.60,0.40,0.25,.145,.075,.0135/ 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.07,0.15,0.21,0.26,0.31,0.38,0.58,0.88,1.30, /1.81,2.65,3.45,3.70,4.30,5.00,5.40,5.60,5.85,6.00, /6.20,6.20,6.15,5.85,4.35,3.55,2.60,2.00,1.70,1.50, /1.05,0.62,0.36,0.18,.034/ NNAME=' DME 1995 ' C --------------------------------------------------------------------- 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 NNIN=7 NDATA=54 NVIB2=19 NVIB3=28 NVIB4=25 NVIB5=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 EEIN(1)=0.051 EEIN(2)=0.137 EEIN(3)=0.180 EEIN(4)=0.349 EEIN(5)=0.529 EEIN(6)=7.70 EEIN(7)=8.5 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 EFAC=DSQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=AVIB1*DLOG((1.0+EFAC)/(1.0-EFAC))/EN*1.E-16 400 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B) EFAC=DSQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=(QQIN(2,I)+AVIB2*DLOG((1.0+EFAC)/(1.0-EFAC))/EN)*1.E-16 430 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 500 DO 440 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 600 DO 540 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 550 540 CONTINUE J=NVIB4 550 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 700 DO 640 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 650 640 CONTINUE J=NVIB5 650 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 800 DO 710 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 899 DO 810 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 899 CONTINUE Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 RETURN END +DECK,GAS121. SUBROUTINE GAS121(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE, - PEQEL,PEQIN,KKEL,KKIN) *----------------------------------------------------------------------- * GAS121 - CF4, Not in Magboltz 1 --> new * (Last changed on 26/ 9/99.) *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION PEQEL(2002),PEQIN(2,2002),Q(6,2002), - QQIN(20,2002),E(6),EEIN(20),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(46),YEXC(46), - XION(52),YION(52),XATT(11),YATT(11),APOP,EN,A,B,FAC1,FAC2, - EFAC,VIRIAL INTEGER KKEL,KKIN(2),I,J,NDATA,NVIB2,NVIB3,NVIB4,NVIB5,NVIB6, - NION,NATT,NEXC,NNIN CHARACTER*15 NNAME *** Energy vector. 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./ *** Cross section. 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/ *** 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/ *** 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/ *** 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/ *** 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/ *** 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,18.0,20.0,25.0,30.0,35.0,40.0,45.0,50.0, /55.0,60.0,65.0,70.0,75.0,80.0,85.0,90.0,95.0,100., /110.,120.,130.,140.,150.,160.,170.,180.,190.,200., /250.,300.,350.,400.,450.,500.,600.,700.,800.,1000., /1200.,1400.,2000.,2500.,3000.,4000.,5000.,6000.,8000.,10000., /20000.,100000./ DATA YION/0.0,0.016,0.21,.384,1.15,2.07,2.78,3.28,3.88,4.35, /4.69,5.03,5.36,5.57,5.72,5.85,5.95,6.05,6.16,6.24, /6.37,6.40,6.40,6.35,6.32,6.26,6.20,6.13,6.05,5.98, /5.67,5.39,5.13,4.91,4.73,4.58,4.15,3.85,3.60,3.25, /2.90,2.60,2.15,1.80,1.60,1.28,1.05,0.91,0.71,0.56, /0.28,.056/ 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/ *** 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,55.0,60.0,65.0,70.0,75.0,80.0,85.0, /90.0,95.0,100.,110.,120.,130.,140.,150.,160.,170., /180.,190.,200.,250.,300.,350.,400.,450.,500.,600., /1000.,2000.,4000.,10000.,20000.,100000./ DATA YEXC/0.0,.045,.195,.360,0.54,0.84,1.05,1.44,1.65,1.81, /1.92,1.96,2.00,2.05,2.08,2.06,2.08,2.13,2.17,2.20, /2.21,2.19,2.18,2.16,2.16,2.16,2.19,2.20,2.21,2.22, /2.22,2.22,2.22,2.07,2.00,1.85,1.65,1.50,1.30,1.00, /0.56,0.25,0.13,0.06,0.03,.006/ C ---------------------------------------------------------------- C NEW ANALYSIS UPDATED TO MARCH 1998 C ALLOWS SUPERELASTIC SCATTERING TO V4 VIBRATIONAL LEVEL C --------------------------------------------------------------- NNAME=' CF4 --1998--- ' KKIN(1)=2 KKIN(2)=4 KKEL=0 FAC1=1.00 FAC2=0.71 NNIN=7 NDATA=72 NVIB2=14 NVIB3=14 NVIB4=14 NVIB5=16 NVIB6=16 NION=52 NATT=11 NEXC=46 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 EEIN(1)=-0.0784 EEIN(2)=0.0784 EEIN(3)=0.1126 EEIN(4)=0.1589 EEIN(5)=0.3178 EEIN(6)=0.4767 EEIN(7)=12.5 APOP=DEXP(EEIN(1)/AKT) EN=-ESTEP IF(MONTE) 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 DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.EQ.0.0) GOTO 305 EFAC=SQRT(1.0-(EEIN(1)/EN)) QQIN(1,I)=0.0768*LOG((EFAC+1.0)/(EFAC-1.0))/EN QQIN(1,I)=QQIN(1,I)*APOP/(1.0+APOP)*1.E-16 C 305 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 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)) EFAC=SQRT(1.0-(EEIN(2)/EN)) QQIN(2,I)=0.0768*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(2,I)=((A*EN+B)+QQIN(2,I))*1.0/(1.0+APOP)*1.E-16 PEQIN(1,I)=0.5+(QQIN(2,I)-FAC1*QQIN(2,I))/QQIN(2,I) 400 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 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)) EFAC=SQRT(1.0-(EEIN(3)/EN)) QQIN(3,I)=0.0224*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(3,I)=((A*EN+B)+QQIN(3,I))*1.E-16 500 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 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)) EFAC=SQRT(1.0-(EEIN(4)/EN)) QQIN(4,I)=1.584*LOG((1.0+EFAC)/(1.0-EFAC))/EN QQIN(4,I)=((A*EN+B)+QQIN(4,I))*1.E-16 PEQIN(2,I)=0.5+(QQIN(4,I)-FAC2*QQIN(4,I))/QQIN(4,I) 600 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE C QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE C QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 9000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS122. SUBROUTINE GAS122(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS16 - Nitrogen, Magboltz 1 gas 3 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(20) DIMENSION XEN(60),YXSEC(60),XVIB1(33),YVIB1(33),XTRIP(25),YTRIP(25 /),XION(26),YION(26),XSING(21),YSING(21),XROT(27),YROT(27) CHARACTER*15 NNAME DATA XEN/0.00,0.001,0.002,0.003,.005,.007,.0085,.010,.015,.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 YXSEC/1.10,1.36,1.49,1.62,1.81,2.00,2.10,2.19,2.55,2.85, /3.40,3.85,4.33,5.10,5.95,6.45,7.10,7.40,7.90,8.50, /9.00,9.40,9.70,9.90,10.0,10.0,10.4,11.0,12.0,13.8, /19.6,27.0,28.5,30.0,28.0,21.7,17.2,14.7,12.6,11.3, /10.9,10.4,10.1,10.0,10.4,10.9,11.0,10.7,10.2,9.50, /9.00,8.60,6.60,5.80,4.90,4.20,3.30,2.44,1.96,1.55/ DATA XROT/0.02,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,.015,.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/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,100.0,1000.0/ DATA YVIB1/.00,.0044,.0053,.0060,.0066,.0345,.048,.066,.078,.0915, /.1650,.8025,3.375,4.740,6.570,7.725,8.055,9.705,6.960,7.095, /7.095,5.775,3.720,3.330,2.265,1.695,1.125,.4500,.2955,.1650, /.0000,.0000,.0000/ DATA XTRIP/7.50,8.00,9.00,10.0,11.0,12.0,14.0,15.0,16.0,17.0, /18.0,20.0,22.0,24.0,26.0,28.0,30.0,34.0,40.0,50.0, /70.0,100.,150.,500.,1000./ DATA YTRIP/0.00,.100,.294,.480,.640,1.02,1.77,1.74,1.67,1.45, /1.30,1.04,0.85,0.71,0.62,0.52,0.48,0.36,0.29,.196, /.096,.044,.000,.000,.000/ DATA XSING/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 YSING/0.00,0.26,0.52,0.62,0.73,0.83,1.04,1.19,1.42,1.67, /1.79,1.86,1.75,1.64,1.37,1.19,1.09,0.98,0.75,0.65, /0.54/ 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/ NNAME='N2 N2MOD P.&P. ' C -------------------------------------------------------------- C NITROGEN FROM PITCHFORD AND PHELPS . JILA REPORT NO.26 (1985) C N2MOD DATA SET. ACCURACY FEW PERCENT AT ALL FIELDS C -------------------------------------------------------------- NNIN=4 NDATA=60 NROT=27 NVIB1=33 NTRIP=25 NSING=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 EEIN(1)=0.020 EEIN(2)=1.00 EEIN(3)=7.50 EEIN(4)=13.00 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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(1,I)=(A*EN+B)*1.0E-16 C Q(3,I)=0.0 IF(EN.LT.E(3)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 230 DO 210 J=2,NROT IF(EN.LE.XROT(J)) GOTO 220 210 CONTINUE J=NROT 220 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)) QQIN(1,I)=(A*EN+B)*1.E-16 230 CONTINUE C-------------------------------------------------------------------- C REMOVED ROTOR FROM THIS RUN QQIN(1,I)=0.0 C-------------------------------------------------------------------- QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 500 DO 410 J=2,NTRIP IF(EN.LE.XTRIP(J)) GOTO 420 410 CONTINUE J=NTRIP 420 A=(YTRIP(J)-YTRIP(J-1))/(XTRIP(J)-XTRIP(J-1)) B=(XTRIP(J-1)*YTRIP(J)-XTRIP(J)*YTRIP(J-1))/(XTRIP(J-1)-XTRIP(J)) QQIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 600 DO 510 J=2,NSING IF(EN.LE.XSING(J)) GOTO 520 510 CONTINUE J=NSING 520 A=(YSING(J)-YSING(J-1))/(XSING(J)-XSING(J-1)) B=(XSING(J-1)*YSING(J)-XSING(J)*YSING(J-1))/(XSING(J-1)-XSING(J)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C Q(2,I)=Q(1,I)-QQIN(1,I)-QQIN(2,I)-QQIN(3,I)-QQIN(4,I)-Q(3,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS123. SUBROUTINE GAS123(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS123 - Ethene, Magboltz 1 gas 26 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(20) DIMENSION XEN(47),YXSEC(47),XVIB1(36),YVIB1(36),XVIB2(28), /YVIB2(28),XEXC1(15),YEXC1(15),XEXC2(22),YEXC2(22),XEXC3(21), /YEXC3(21),XION(42),YION(42),XATT(16),YATT(16) CHARACTER*15 NNAME 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./ DATA YXSEC/8.40,8.40,8.20,7.60,6.80,5.90,4.50,3.35,3.00,2.90, /2.80,2.90,3.05,3.35,3.65,4.15,4.70,5.45,6.55,8.70, /10.5,12.0,15.5,18.0,18.0,14.0,12.0,12.0,14.5,17.5, /19.5,19.5,17.5,15.5,13.5,9.85,7.35,5.90,4.00,2.55, /2.20,0.94,0.49,0.30,0.16,0.10,.075/ DATA XVIB1/0.0,.117,.118,.120,.122,.124,0.14,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.00,8.00,10.0,14.0,20.0,30.0,40.0,50.0, /70.0,100.,140.,200.,300.,1000./ DATA YVIB1/0.0,0.00,.006,.065,0.65,1.30,1.37,1.30,1.24,1.02, /0.88,0.70,0.61,0.57,0.59,0.63,0.68,0.78,0.81,0.85, /0.85,0.81,0.78,0.72,0.59,0.42,0.33,0.23,0.16,0.12, /0.09,0.06,0.05,0.03,0.02,.007/ DATA XVIB2/0.00,.375,0.38,0.39,0.40,0.45,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,10.0, /14.0,20.0,30.0,40.0,50.0,70.0,100.,1000./ DATA YVIB2/0.00,0.00,0.01,0.10,0.46,0.57,0.55,0.48,0.39,0.32, /0.27,0.28,0.32,0.36,0.37,0.37,0.35,0.32,0.30,0.25, /0.17,0.12,0.08,.065,.055,.035,.026,.003/ 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./ 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/ 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./ 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/ 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./ 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/ 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.,200.,300.,400.,500.,600.,800.,1000./ 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,4.54,3.63,2.99,2.54,2.23,1.84,1.52/ 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/ NNAME=' ETHYLENE 92 ' C --------------------------------------------------------------------- C C2H4 MODIFIED HAYASHI TO FIT GLOBAL DATA INCLUDING SCHMIDT S C --------------------------------------------------------------------- NNIN=5 NDATA=47 NVIB1=36 NVIB2=28 NEXC1=15 NEXC2=22 NEXC3=21 NION=42 NATT=16 E(1)=0.0 E(2)=2.0*EMASS/(28.05376*AMU) E(3)=10.5 C CORRECT ENERGY E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.117 EEIN(2)=0.375 EEIN(3)=3.70 EEIN(4)=4.85 EEIN(5)=7.10 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 900 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE C QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 430 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 430 CONTINUE C QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 460 DO 440 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 460 CONTINUE C 500 CONTINUE C QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 600 DO 510 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE C QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 700 DO 610 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I) 900 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS124. SUBROUTINE GAS124(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS124 - Ethane, Magboltz 1 gas 30 *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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), - VIRIAL,EN,A,B INTEGER NNIN,NDATA,NION,NATT,NVIB1,NVIB2,NVIB3,NVIB4,NVIB5, - NEXC,NEXC1,NEXC2,I,J CHARACTER*15 NNAME DATA XEN/0.00,.001,.002,.003,.004,.005,.007,0.01,.014,0.02, /0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12, /0.13,0.14,0.16,0.18,0.20,0.24,0.30,0.40,0.50,0.60, /0.80,1.00,1.40,2.00,3.00,4.00,5.00,6.00,7.00,8.00, /9.00,10.0,15.0,20.0,30.0,40.0,70.0,100.,140.,200., /1000.,2000.,10000.,20000.,100000./ DATA YXSEC/45.0,45.0,44.0,42.0,40.0,39.0,36.0,32.0,26.5,20.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/ NNAME=' ETHANE 1995 ' C --------------------------------------------------------------------- C UPDATED TO DEC 1994 . INCLUDES LATEST ELECTRON SCATTERING RESULTS C GIVES BETTER FIT THAN PREVIOUS DATA SET C --------------------------------------------------------------------- NNIN=8 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 EEIN(1)=0.117 EEIN(2)=0.148 EEIN(3)=0.182 EEIN(4)=0.366 EEIN(5)=0.548 EEIN(6)=8.2 EEIN(7)=10.3 EEIN(8)=17.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GE.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 800 DO 710 J=2,NVIB5 IF(EN.LE.XVIB5(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 900 DO 810 J=2,NEXC IF(EN.LE.XEXC(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 900 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 990 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)) QQIN(7,I)=(A*EN+B)*1.E-16 990 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 1990 DO 1910 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 1990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS125. SUBROUTINE GAS125(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS125 - Propane, Magboltz 1 gas 31 *----------------------------------------------------------------------- implicit none +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DOUBLE PRECISION Q(6,2002),QQIN(20,2002),E(6),EEIN(20), - 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),VIRIAL,A,B,EN INTEGER NNIN,NDATA,NION,NATT,NVIB1,NVIB2,NVIB3,NVIB4,NEXC1,NEXC2, - NEXC3,I,J CHARACTER*15 NNAME 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/ NNAME='PROPANE 1995 ' C --------------------------------------------------------------------- NNIN=7 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 EEIN(1)=0.108 EEIN(2)=0.173 EEIN(3)=0.363 EEIN(4)=0.519 EEIN(5)=7.7 EEIN(6)=10.0 EEIN(7)=17.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 400 DO 310 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 400 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 500 DO 410 J=2,NVIB2 IF(EN.LE.XVIB2(J)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 600 DO 510 J=2,NVIB3 IF(EN.LE.XVIB3(J)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 700 DO 610 J=2,NVIB4 IF(EN.LE.XVIB4(J)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 900 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +DECK,GAS126. SUBROUTINE GAS126(Q,QQIN,NNIN,E,EEIN,NNAME,VIRIAL,MONTE) *----------------------------------------------------------------------- * GAS126 - Isobutane, Magboltz 1 gas 35 *----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) +SEQ,MAGBDATA. +SEQ,MAGBCONS. LOGICAL MONTE DIMENSION Q(6,2002),QQIN(20,2002),E(6),EEIN(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 NNAME 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-------------------------------------------------------- NNAME='ISOBUTANE 1995 ' C --------------------------------------------------------------------- NNIN=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/(58.1234*AMU) E(3)=10.67 E(4)=0.0 E(5)=0.0 E(6)=0.0 EEIN(1)=0.052 EEIN(2)=0.108 EEIN(3)=0.173 EEIN(4)=0.363 EEIN(5)=0.519 EEIN(6)=7.4 EEIN(7)=9.70 EEIN(8)=17.0 EN=-ESTEP IF(MONTE) EN=-ESTEP/2.0 DO 1000 I=1,NSTEP1+1 EN=EN+ESTEP DO 10 J=2,NDATA IF(EN.LE.XEN(J)) GOTO 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)) GOTO 200 DO 110 J=2,NION IF(EN.LE.XION(J)) GOTO 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)) GOTO 300 IF(EN.GT.XATT(NATT)) GOTO 300 DO 210 J=2,NATT IF(EN.LE.XATT(J)) GOTO 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 QQIN(1,I)=0.0 IF(EN.LE.EEIN(1)) GOTO 4000 DO 4100 J=2,NVIB1 IF(EN.LE.XVIB1(J)) GOTO 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)) QQIN(1,I)=(A*EN+B)*1.E-16 4000 CONTINUE QQIN(2,I)=0.0 IF(EN.LE.EEIN(2)) GOTO 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)) QQIN(2,I)=(A*EN+B)*1.E-16 400 CONTINUE QQIN(3,I)=0.0 IF(EN.LE.EEIN(3)) GOTO 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)) QQIN(3,I)=(A*EN+B)*1.E-16 500 CONTINUE QQIN(4,I)=0.0 IF(EN.LE.EEIN(4)) GOTO 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)) QQIN(4,I)=(A*EN+B)*1.E-16 600 CONTINUE QQIN(5,I)=0.0 IF(EN.LE.EEIN(5)) GOTO 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)) QQIN(5,I)=(A*EN+B)*1.E-16 700 CONTINUE QQIN(6,I)=0.0 IF(EN.LE.EEIN(6)) GOTO 800 DO 710 J=2,NEXC1 IF(EN.LE.XEXC1(J)) GOTO 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)) QQIN(6,I)=(A*EN+B)*1.E-16 800 CONTINUE QQIN(7,I)=0.0 IF(EN.LE.EEIN(7)) GOTO 900 DO 810 J=2,NEXC2 IF(EN.LE.XEXC2(J)) GOTO 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)) QQIN(7,I)=(A*EN+B)*1.E-16 900 CONTINUE QQIN(8,I)=0.0 IF(EN.LE.EEIN(8)) GOTO 990 DO 910 J=2,NEXC3 IF(EN.LE.XEXC3(J)) GOTO 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)) QQIN(8,I)=(A*EN+B)*1.E-16 990 CONTINUE C Q(1,I)=Q(2,I)+Q(3,I)+Q(4,I)+QQIN(1,I)+QQIN(2,I)+QQIN(3,I)+ - QQIN(4,I)+QQIN(5,I)+QQIN(6,I)+QQIN(7,I)+QQIN(8,I) 1000 CONTINUE C SAVE COMPUTE TIME IF(EFINAL.LE.EEIN(8)) NNIN=7 IF(EFINAL.LE.EEIN(7)) NNIN=6 IF(EFINAL.LE.EEIN(6)) NNIN=5 IF(EFINAL.LE.EEIN(5)) NNIN=4 IF(EFINAL.LE.EEIN(4)) NNIN=3 IF(EFINAL.LE.EEIN(3)) NNIN=2 IF(EFINAL.LE.EEIN(2)) NNIN=1 IF(EFINAL.LE.EEIN(1)) NNIN=0 END +QUIT.