Molecule.for

      SUBROUTINE MOLECULE
      INCLUDE 'Soldiv.fi'
      PARAMETER (NH = 5)
      DIMENSION RN(NH,NH),FOG(NH),FPG(NH),FOEX(NH),FPEX(NH),
     2          SVDIS(NH),SVEXC(NH),FNEG(NH)
      real fdis,bmol0,bmolp
C           CALCULATES MOLECULAR DISSOCIATION NEUTRAL & ION SOURCES
C     IMOL = 0    ATOMS ONLY
C          = 1    GROUND STATE MOLECULES ONLY
C          = 2  GROUND + EXCITED STATE MOLECULES
C     TEMPERATURE INTERVAL SELECTION 1-10, 10-100, > 100eV
      IF(IMOL.EQ.0) GOTO 150
      IF(TD.GE.TINT(2).AND.TD.LT.TINT(3)) IN = 2
      IF(TD.GE.TINT(3).AND.TD.LE.TINT(4)) IN = 3
      IF(TD.GT.TINT(4)) GOTO 10
      IF(TD.LT.TINT(2)) GOTO 15

C      NEUTRAL ATOM REFLECTION COEFICIENTS @ 1, 10 AND 100 eV
C           (POP,2,3740,1995)
C     ACTUALLY TABULATE & INTERPOLATE 1 - RN
C           BERYLLIUM
      RN(1,2) = 0.82
      RN(1,3) = 0.82
      RN(1,4) = 0.91
C           CARBON
      RN(2,2) = 0.67
      RN(2,3) = 0.67
      RN(2,4) = 0.82
C           TUNGSTEN
      RN(3,2) = 0.24
      RN(3,3) = 0.24
      RN(3,4) = 0.40

C           TEMPERATURE INTERPOLATION

      W = LOG10(RN(IMAT,IN)) + LOG10(RN(IMAT,IN+1)/RN(IMAT,IN))*
     2    LOG10(TD/TINT(IN))/LOG10(TINT(IN+1)/TINT(IN))
      FMOL = 10.**W
      RNN = 1. - FMOL
      GOTO 20
C     USE THE 100 eV RE-EMISSION COEF FOR T > 100 eV
 10   FMOL = RN(IMAT,4)
      RNN = 1. - FMOL
      IF(IMOL.EQ.0) GOTO 150

      GOTO 20
C     USE THE 1 eV RE-EMISSION COEF FOR T < 1 eV
 15   FMOL = RN(IMAT,2)
      RNN = 1. - FMOL

 20   CONTINUE

C           MOLECULAR DISSOCIATION COEFFICIENTS (POP,4,678,1997)
C     GROUND STATE
      FOG(2) = 1.77
      FOG(3) = 1.44
      FOG(4) = 1.0
      FPG(2) = 0.23
      FPG(3) = 0.56
      FPG(4) = 1.0
C     EXCITED STATE
      FOEX(2) = 3.0
      FOEX(3) = 1.65
      FOEX(4) = 1.0
      FPEX(2) =-1.0
      FPEX(3) = 0.35
      FPEX(4) = 1.0

      IF(TD.GT.TINT(4)) GOTO 30
      IF(TD.LT.TINT(2)) GOTO 31
C           TEMPERATURE INTERPOLATION
      W = LOG10(FOG(IN)) + LOG10(FOG(IN+1)/FOG(IN))*
     2    LOG10(TD/TINT(IN))/LOG10(TINT(IN+1)/TINT(IN))
      F0G = 10.**W

C     W = LOG10(FPG(IN)) + LOG10(FPG(IN+1)/FPG(IN))*
C    2    LOG10(TD/TINT(IN))/LOG10(TINT(IN+1)/TINT(IN))
C      FIONG = 10.**W
      FIONG = 2. - F0G

      W = LOG10(FOEX(IN)) + LOG10(FOEX(IN+1)/FOEX(IN))*
     2    LOG10(TD/TINT(IN))/LOG10(TINT(IN+1)/TINT(IN))
      F0EX = 10.**W
      FIONEX = 2. - F0EX
C     IF(TD.LT.TINT(3)) GOTO 25
C     W = LOG10(FPEX(IN)) + LOG10(FPEX(IN+1)/FPEX(IN))*
C    2    LOG10(TD/TINT(IN))/LOG10(TINT(IN+1)/TINT(IN))
C      FIONEX = 10.**W
C     GOTO 35
C     SPECIAL INTERPOLATION 1 TO 10 eV BECAUSE NEGATIVE VALUE @ 1eV
C25   FIONEX = FPEX(2) + (FPEX(3)-FPEX(2))*(TD-1.)/(10.-1.)
      GOTO 35

C     USE 100 eV VALUES FOR T > 100 eV
 30   F0G = 1.0
      FIONG = 1.0
      F0EX = 1.0
      FIONEX = 1.0
      GOTO 35
C     USE 1 eV VALUES FOR T < 1 eV
 31   F0G = 1.77
      FIONG = 0.23
      F0EX = 3.0
      FIONEX = -1.0

 35   CONTINUE

C           GROUND STATE MOLECULAR DISSOCIATION & EXCITATION RATES SIGV
      SVDIS(2) = 3.0E-17
      SVDIS(3) = 9.1E-15
      SVDIS(4) = 5.2E-14
      SVEXC(2) = 7.0E-18
      SVEXC(3) = 3.5E-17
      SVEXC(4) = 1.3E-17

C           TEMPERATURE INTERPOLATION
      IF(TD.GT.TINT(4)) GOTO 40
      IF(TD.LT.TINT(2)) GOTO 41
      W = LOG10(SVDIS(IN)) + LOG10(SVDIS(IN+1)/SVDIS(IN))*
     2    LOG10(TD/TINT(IN))/LOG10(TINT(IN+1)/TINT(IN))
      DISSOC = 10.**W
      W = LOG10(SVEXC(IN)) + LOG10(SVEXC(IN+1)/SVEXC(IN))*
     2    LOG10(TD/TINT(IN))/LOG10(TINT(IN+1)/TINT(IN))
      EXCITE = 10.**W
      GOTO 45

C     USE 100 eV VALUES FOR T > 100 eV
 40   DISSOC = SVDIS(4)
      EXCITE = SVEXC(4)
      GOTO 45
C     USE 1 eV VALUES FOR T < 1 eV
 41   DISSOC = SVDIS(2)
      EXCITE = SVEXC(2)

 45   CONTINUE

C     EXCITED STATE NEGATIVE ION DISSOCIATION FRACTION
      FNEG(2) = 1.0
      FNEG(3) = 0.14
      FNEG(4) = 0.0001
C           TEMPERATURE INTERPOLATION
      W = LOG10(FNEG(IN)) + LOG10(FNEG(IN+1)/FNEG(IN))*
     2    LOG10(TD/TINT(IN))/LOG10(TINT(IN+1)/TINT(IN))
      FNEGIONEX = 10.**W


C     GROUND STATE DISSOCIATION FRACTION
      FDIS = DISSOC/(DISSOC + EXCITE)
      IF(IMOL.EQ.1) FDIS = 1.0
      FEXC = 1. - FDIS
C     NEUTRAL ATOM DISSOCIATION MULTIPLIER FOR GAMZERO*DEL*
      BMOL0 = (FEX*F0EX + (1.-FEX)*(FDIS*F0G+FEXC*F0EX))
      HDIS0 = (0.5*FMOL/(1.-FMOL))*BMOL0
C     ION DISSOCIATION MULTIPLIER FOR GAMZERO*DEL*
      BMOLP = (FEX*FIONEX + (1.-FEX)*(FDIS*FIONG+FEXC*FIONEX))
      HDISP = (0.5*FMOL/(1.-FMOL))*BMOLP
      GOTO 175
C           IMOL = 0, ALL PARTICLES RECYCLE AS ATOMS
 150  FMOL = 0.
      RNN = 1. - FMOL

 175  RETURN
      END