IF(OMEGA>5000._EB .OR. OMEGA<1125._EB) THEN   SDWEAK=0.0_EB   GDINV=1._EB   GDDINV=1._EBELSE   BE=5.2412_EB   Q2=1.4388_EB   WM=16._EB   GD=5.94E-6_EB*OMEGA*(TEMP/(273._EB*WM))**.5_EB   IF(OMEGA>=3400._EB) THEN! CONTRIBUTION TO 2.4 MICRON BAND FROM (0000)-(0110), (0000)-(0011),! (0000)-(1001), AND (0000)-(0102) TRANS.  THE INTEGRATED BAND INTENSITIES! OF VINCENT-GEISSE (ANNALES DE PHYSIQUE SER.12, V. 10, 1955) HAVE! BEEN MULTIPLIED BY A FACTOR OF 4 AND THE LINE SPACING IS THAT! OF V4 FROM GRAY AND PENNER (JQSRT V. 5, 1965).      OM1=2914.2_EB      OM2=1526.0_EB      OM3=3020.3_EB      OM4=1306.2_EB      BCNT(1)=4123.0_EB      BCNT(2)=4216.3_EB      BCNT(3)=4313.2_EB      BCNT(4)=4546.0_EB      COM1=OM2+2._EB*OM4      COM2=OM1+OM4      COM3=OM3+OM4      COM4=OM2+OM3      ATOT(1)=.64_EB*273._EB/TEMP**(1._EB-EXP(-Q2*COM1/TEMP))/ (1._EB-EXP(-Q2*OM2/TEMP))/(1._EB-EXP(-Q2*OM4/TEMP))**2      ATOT(2)=17.6_EB*273._EB/TEMP*(1._EB-EXP(-Q2*COM2/TEMP))/(1._EB-EXP(-Q2*OM1/TEMP))/(1._EB-EXP(-Q2*OM4/TEMP))      ATOT(3)=14.8_EB*273._EB/TEMP*(1._EB-EXP(-Q2*COM3/TEMP))/(1._EB-EXP(-Q2*OM3/TEMP))/(1._EB-EXP(-Q2*OM4/TEMP))      ATOT(4)=5.04_EB*273._EB/TEMP*(1._EB-EXP(-Q2*COM4/TEMP))/(1._EB-EXP(-Q2*OM2/TEMP))/(1._EB-EXP(-Q2*OM3/TEMP))      DINV=1._EB/5.74_EB      GDINV=GC3*DINV      GDDINV=GD*DINV      SDWEAK=0.0_EB      DO I=1,4         SDWEAK=SDWEAK+2._EB*(OMEGA-BCNT(I))**2*(Q2*BE/TEMP)**1.5_EB  *ATOT(I)/PI**0.5_EB*DINV**3*EXP(-Q2*BE*DINV**2/TEMP &         *(OMEGA-BCNT(I))**2)      ENDDO      SDWEAK=SDWEAK*(TEMP/273._EB)   ELSE      PE=PTOT+.3_EB*PCH4      IF(OMEGA>=2625._EB) THEN! CONTRIBUTION TO 3.3 MICRON BAND FROM (0000)-(0010) TRANS.! REFER TO BROSMER AND TIEN, JQSRT V. 33, P. 521         GDINV=.00734_EB*PE*(273._EB/TEMP)**.5_EB*EXP(1.02_EB*(TEMP-273._EB)/273._EB)         GDDINV=GD/9.4_EB         J=(OMEGA-2600._EB)/25._EB         W1=2600._EB+25._EB*FLOAT(J)         SDB=SD3(2,J)+(OMEGA-W1)/25._EB*(SD3(2,J+1)-SD3(2,J))         IF(TEMP>600._EB) THEN            SDC=SD3(3,J)+(OMEGA-W1)/25._EB*(SD3(3,J+1)-SD3(3,J))            SDWEAK=SDB+(TEMP-600._EB)/250._EB*(SDC-SDB)            IF(SDWEAK<0._EB)SDWEAK=0._EB         ELSE            SDA=SD3(1,J)+(OMEGA-W1)/25._EB*(SD3(1,J+1)-SD3(1,J))            SDWEAK=SDA+(TEMP-290._EB)/310._EB*(SDB-SDA)            IF(SDWEAK<0._EB)SDWEAK=0._EB         ENDIF      ELSEIF(OMEGA>1450._EB) THEN         SDWEAK=0.0_EB         GDINV=1._EB         GDDINV=1._EB      ELSE! CONTRIBUTION TO 7.7 MICRON BAND FROM (0000)-(0001) TRANS.! REFER TO BROSMER AND TIEN, JQSRT V. 33, P. 521.         GDINV=.0243_EB*PE*(TEMP/273._EB)**.8_EB         GDDINV=GD/5.1_EB         J=(OMEGA-1100._EB)/25._EB         W1=1100._EB+25._EB*FLOAT(J)         SDB=SD7(2,J)+(OMEGA-W1)/25._EB*(SD7(2,J+1)-SD7(2,J))         IF(TEMP>600._EB) THEN            SDC=SD7(3,J)+(OMEGA-W1)/25._EB*(SD7(3,J+1)-SD7(3,J))            SDWEAK=SDB+(TEMP-600._EB)/250._EB*(SDC-SDB)            IF(SDWEAK<0._EB)SDWEAK=0._EB         ELSE            SDA=SD7(1,J)+(OMEGA-W1)/25._EB*(SD7(1,J+1)-SD7(1,J))            SDWEAK=SDA+(TEMP-290._EB)/310._EB*(SDB-SDA)            IF(SDWEAK<0._EB)SDWEAK=0._EB         ENDIF      ENDIF   ENDIFENDIFEND SUBROUTINE FUEL!*******************************************************************************REAL(EB) FUNCTION PLANCK(A,B)REAL (EB) Q1,Q2,OVRFLO,A,B!    COMPUTES BLACKBODY FUNCTION IN UNITS OF W/M-2/MICRON/SRQ1=.59544E8_EBQ2=14388._EBIF(A==0._EB) THEN    PLANCK=0._EBELSE   OVRFLO=Q2/A/B   IF(OVRFLO>38._EB) THEN      PLANCK=0._EB   ELSE      PLANCK=2._EB*Q1*(B**(-5))/(EXP(Q2/A/B)-1._EB)   ENDIFENDIFEND FUNCTION PLANCKSUBROUTINE RCALLOC  ALLOCATE(SVF(50))ALLOCATE(RCT(50))ALLOCATE(DD(50))ALLOCATE(XPART(50))ALLOCATE(P(6,50))ALLOCATE(SPECIE(5))ALLOCATE(QW(600))ALLOCATE(TTAU(600))ALLOCATE(XTOT(50))ALLOCATE(XT(600))ALLOCATE(XSTAR(50))ALLOCATE(X(4,50))ALLOCATE(TAU(50))ALLOCATE(AC(50))ALLOCATE(AD(50))ALLOCATE(GC(4,50))ALLOCATE(AMBDA(600))ALLOCATE(TAUS(50))ALLOCATE(UUU(4,50))ALLOCATE(AB(600))ALLOCATE(PKPA(50))ALLOCATE(ATOT(4))ALLOCATE(BCNT(4))ALLOCATE(GAMMA(4,7))ALLOCATE(SD15(6,80))ALLOCATE(SD(6,376))ALLOCATE(SD7(3,16))ALLOCATE(SD3(3,32))!  Initialize SD Array! TEMP,K= 300     600      1000      1500      2000      2500       SD(1:6,1:8) = RESHAPE ((/  & ! 50-225.950E+00_EB, .103E+00_EB, .420E-01_EB, .114E-01_EB, .450E-02_EB, .300E-02_EB, &.208E+01_EB, .365E+00_EB, .113E+00_EB, .375E-01_EB, .195E-01_EB, .134E-01_EB, &.368E+01_EB, .990E+00_EB, .300E+00_EB, .104E+00_EB, .577E-01_EB, .365E-01_EB,  & .650E+01_EB, .201E+01_EB, .650E+00_EB, .214E+00_EB, .128E+00_EB, .845E-01_EB, &   .825E+01_EB, .325E+01_EB, .121E+01_EB, .415E+00_EB, .260E+00_EB, .168E+00_EB, &  .870E+01_EB, .452E+01_EB, .189E+01_EB, .765E+00_EB, .450E+00_EB, .289E+00_EB, &  .810E+01_EB, .540E+01_EB, .261E+01_EB, .126E+01_EB, .695E+00_EB, .460E+00_EB, &  .682E+01_EB, .600E+01_EB, .337E+01_EB, .179E+01_EB, .101E+01_EB, .679E+00_EB/), &(/6,8/))SD(1:6,9:16) = RESHAPE ((/ &  ! 250-425.493E+01_EB, .622E+01_EB, .407E+01_EB, .230E+01_EB, .135E+01_EB, .935E+00_EB,  &   .316E+01_EB, .592E+01_EB, .456E+01_EB, .281E+01_EB, .172E+01_EB, .122E+01_EB,  &  .199E+01_EB, .528E+01_EB, .479E+01_EB, .328E+01_EB, .213E+01_EB, .149E+01_EB,  &   .113E+01_EB, .450E+01_EB, .484E+01_EB, .361E+01_EB, .249E+01_EB, .179E+01_EB,  &   .585E+00_EB, .370E+01_EB, .471E+01_EB, .383E+01_EB, .284E+01_EB, .208E+01_EB, &    .293E+00_EB, .289E+01_EB, .443E+01_EB, .394E+01_EB, .312E+01_EB, .237E+01_EB, &    .138E+00_EB, .205E+01_EB, .400E+01_EB, .396E+01_EB, .330E+01_EB, .260E+01_EB, &    .620E-01_EB, .143E+01_EB, .347E+01_EB, .388E+01_EB, .341E+01_EB, .280E+01_EB/), &  (/6,8/))SD(1:6,17:24) = RESHAPE ((/ & ! 450-625.255E-01_EB, .950E+00_EB, .292E+01_EB, .370E+01_EB, .345E+01_EB, .295E+01_EB,   &  .940E-02_EB, .610E+00_EB, .236E+01_EB, .343E+01_EB, .342E+01_EB, .304E+01_EB,  &   .340E-02_EB, .386E+00_EB, .188E+01_EB, .310E+01_EB, .334E+01_EB, .309E+01_EB,   &  .105E-02_EB, .236E+00_EB, .145E+01_EB, .274E+01_EB, .319E+01_EB, .307E+01_EB,   &  .350E-03_EB, .144E+00_EB, .110E+01_EB, .238E+01_EB, .300E+01_EB, .301E+01_EB,   & .126E-03_EB, .820E-01_EB, .818E+00_EB, .204E+01_EB, .276E+01_EB, .289E+01_EB,   &  .430E-04_EB, .445E-01_EB, .598E+00_EB, .174E+01_EB, .248E+01_EB, .275E+01_EB,  &  .150E-04_EB, .242E-01_EB, .427E+00_EB, .145E+01_EB, .222E+01_EB, .260E+01_EB/), & (/6,8/))SD(1:6,25:32) = RESHAPE ((/  &! 650-825.510E-05_EB, .127E-01_EB, .294E+00_EB, .118E+01_EB, .195E+01_EB, .241E+01_EB,   &  .170E-05_EB, .630E-02_EB, .200E+00_EB, .950E+00_EB, .169E+01_EB, .221E+01_EB,   &  .570E-06_EB, .300E-02_EB, .134E+00_EB, .748E+00_EB, .146E+01_EB, .200E+01_EB,   &  .195E-06_EB, .140E-02_EB, .902E-01_EB, .580E+00_EB, .124E+01_EB, .178E+01_EB,   &  .680E-07_EB, .620E-03_EB, .590E-01_EB, .443E+00_EB, .103E+01_EB, .156E+01_EB,   &  .385E-07_EB, .275E-03_EB, .450E-01_EB, .330E+00_EB, .845E+00_EB, .136E+01_EB,   &  .670E-07_EB, .113E-03_EB, .355E-01_EB, .242E+00_EB, .695E+00_EB, .117E+01_EB,   &  .113E-06_EB, .500E-04_EB, .289E-01_EB, .174E+00_EB, .560E+00_EB, .100E+01_EB/),  & (/6,8/))SD(1:6,33:40) = RESHAPE ((/ & ! 850-1025.195E-06_EB, .230E-04_EB, .245E-01_EB, .123E+00_EB, .450E+00_EB, .855E+00_EB,   &  .328E-06_EB, .103E-04_EB, .214E-01_EB, .100E+00_EB, .357E+00_EB, .718E+00_EB,  &   .560E-06_EB, .460E-05_EB, .189E-01_EB, .830E-01_EB, .278E+00_EB, .595E+00_EB,  &   .950E-06_EB, .205E-05_EB, .174E-01_EB, .730E-01_EB, .239E+00_EB, .492E+00_EB,  &   .160E-05_EB, .140E-05_EB, .166E-01_EB, .665E-01_EB, .211E+00_EB, .405E+00_EB, &    .275E-05_EB, .350E-05_EB, .165E-01_EB, .630E-01_EB, .195E+00_EB, .352E+00_EB, &    .470E-05_EB, .850E-05_EB, .167E-01_EB, .620E-01_EB, .190E+00_EB, .312E+00_EB, &   .810E-05_EB, .215E-04_EB, .175E-01_EB, .630E-01_EB, .191E+00_EB, .289E+00_EB/), &  (/6,8/))SD(1:6,41:48) = RESHAPE ((/ & ! 1050-1225.136E-04_EB, .570E-04_EB, .188E-01_EB, .675E-01_EB, .194E+00_EB, .281E+00_EB,   &  .235E-04_EB, .150E-03_EB, .208E-01_EB, .745E-01_EB, .202E+00_EB, .283E+00_EB,   &  .400E-04_EB, .380E-03_EB, .233E-01_EB, .865E-01_EB, .223E+00_EB, .314E+00_EB,  &   .680E-04_EB, .950E-03_EB, .268E-01_EB, .122E+00_EB, .260E+00_EB, .380E+00_EB,  &   .120E-03_EB, .245E-02_EB, .343E-01_EB, .176E+00_EB, .328E+00_EB, .461E+00_EB,  &   .200E-03_EB, .620E-02_EB, .638E-01_EB, .251E+00_EB, .411E+00_EB, .511E+00_EB,  &   .365E-03_EB, .140E-01_EB, .107E+00_EB, .330E+00_EB, .458E+00_EB, .542E+00_EB,  &   .680E-03_EB, .330E-01_EB, .166E+00_EB, .405E+00_EB, .487E+00_EB, .571E+00_EB/),&   (/6,8/))SD(1:6,49:56) = RESHAPE ((/ & ! 1250-1425.130E-02_EB, .635E-01_EB, .244E+00_EB, .459E+00_EB, .535E+00_EB, .557E+00_EB,  &   .250E-02_EB, .123E+00_EB, .341E+00_EB, .477E+00_EB, .502E+00_EB, .562E+00_EB,  &   .500E-02_EB, .212E+00_EB, .407E+00_EB, .547E+00_EB, .531E+00_EB, .514E+00_EB,  &   .103E-01_EB, .285E+00_EB, .489E+00_EB, .592E+00_EB, .497E+00_EB, .486E+00_EB,  &   .219E-01_EB, .328E+00_EB, .491E+00_EB, .558E+00_EB, .489E+00_EB, .485E+00_EB,  &   .485E-01_EB, .345E+00_EB, .505E+00_EB, .521E+00_EB, .477E+00_EB, .484E+00_EB,  &   .114E+00_EB, .361E+00_EB, .538E+00_EB, .563E+00_EB, .503E+00_EB, .502E+00_EB,  &   .249E+00_EB, .460E+00_EB, .621E+00_EB, .624E+00_EB, .538E+00_EB, .538E+00_EB/), &  (/6,8/))SD(1:6,57:64) = RESHAPE ((/ & ! 1450-1625.397E+00_EB, .569E+00_EB, .749E+00_EB, .768E+00_EB, .581E+00_EB, .565E+00_EB,  &   .418E+00_EB, .627E+00_EB, .824E+00_EB, .849E+00_EB, .640E+00_EB, .594E+00_EB,  &   .108E+01_EB, .125E+01_EB, .113E+01_EB, .940E+00_EB, .807E+00_EB, .663E+00_EB,  &   .165E+01_EB, .155E+01_EB, .118E+01_EB, .670E+00_EB, .562E+00_EB, .483E+00_EB,  &   .142E+01_EB, .675E+00_EB, .557E+00_EB, .349E+00_EB, .276E+00_EB, .263E+00_EB,  &   .451E+00_EB, .202E+00_EB, .132E+00_EB, .118E+00_EB, .134E+00_EB, .156E+00_EB,  &   .603E-01_EB, .538E-01_EB, .863E-01_EB, .112E+00_EB, .120E+00_EB, .125E+00_EB,  &   .501E+00_EB, .252E+00_EB, .118E+00_EB, .112E+00_EB, .131E+00_EB, .140E+00_EB/), &  (/6,8/))SD(1:6,65:72) = RESHAPE ((/ & ! 1650-1825.730E+00_EB, .430E+00_EB, .237E+00_EB, .191E+00_EB, .171E+00_EB, .170E+00_EB,   &  .149E+01_EB, .506E+00_EB, .294E+00_EB, .238E+00_EB, .210E+00_EB, .201E+00_EB,  &   .100E+01_EB, .553E+00_EB, .434E+00_EB, .340E+00_EB, .260E+00_EB, .220E+00_EB,   &  .802E+00_EB, .658E+00_EB, .528E+00_EB, .411E+00_EB, .300E+00_EB, .240E+00_EB,    & .580E+00_EB, .527E+00_EB, .460E+00_EB, .378E+00_EB, .322E+00_EB, .283E+00_EB,  &   .330E+00_EB, .403E+00_EB, .430E+00_EB, .356E+00_EB, .318E+00_EB, .270E+00_EB,  &   .250E+00_EB, .393E+00_EB, .405E+00_EB, .342E+00_EB, .301E+00_EB, .275E+00_EB,  &   .147E+00_EB, .249E+00_EB, .313E+00_EB, .318E+00_EB, .291E+00_EB, .268E+00_EB/), &  (/6,8/))SD(1:6,73:80) = RESHAPE ((/ & ! 1850-2025.910E-01_EB, .252E+00_EB, .298E+00_EB, .295E+00_EB, .269E+00_EB, .253E+00_EB,   &  .580E-01_EB, .158E+00_EB, .214E+00_EB, .244E+00_EB, .244E+00_EB, .245E+00_EB,   &  .370E-01_EB, .113E+00_EB, .184E+00_EB, .218E+00_EB, .214E+00_EB, .218E+00_EB,   &  .244E-01_EB, .118E+00_EB, .156E+00_EB, .188E+00_EB, .195E+00_EB, .200E+00_EB,   & .162E-01_EB, .606E-01_EB, .976E-01_EB, .141E+00_EB, .166E+00_EB, .179E+00_EB,   & .112E-01_EB, .425E-01_EB, .903E-01_EB, .133E+00_EB, .148E+00_EB, .156E+00_EB,   & .780E-02_EB, .400E-01_EB, .765E-01_EB, .112E+00_EB, .129E+00_EB, .137E+00_EB,   & .540E-02_EB, .352E-01_EB, .647E-01_EB, .876E-01_EB, .110E+00_EB, .118E+00_EB/),  &(/6,8/))SD(1:6,81:88) = RESHAPE ((/ & ! 2050-2225.380E-02_EB, .252E-01_EB, .507E-01_EB, .705E-01_EB, .888E-01_EB, .100E+00_EB,  &   .260E-02_EB, .179E-01_EB, .377E-01_EB, .546E-01_EB, .724E-01_EB, .828E-01_EB,  &   .180E-02_EB, .123E-01_EB, .294E-01_EB, .443E-01_EB, .608E-01_EB, .686E-01_EB,  &   .127E-02_EB, .850E-02_EB, .212E-01_EB, .378E-01_EB, .579E-01_EB, .640E-01_EB,   &  .880E-03_EB, .680E-02_EB, .152E-01_EB, .275E-01_EB, .449E-01_EB, .521E-01_EB,  &   .620E-02_EB, .400E-02_EB, .107E-01_EB, .214E-01_EB, .374E-01_EB, .453E-01_EB,  &   .480E-03_EB, .298E-02_EB, .931E-02_EB, .189E-01_EB, .329E-01_EB, .403E-01_EB,  &   .405E-03_EB, .175E-02_EB, .696E-02_EB, .152E-01_EB, .295E-01_EB, .365E-01_EB/), &  (/6,8/))SD(1:6,89:96) = RESHAPE ((/ & ! 2250-2425 .321E-03_EB, .120E-02_EB, .452E-02_EB, .101E-01_EB, .252E-01_EB, .331E-01_EB, &    .229E-03_EB, .721E-03_EB, .364E-02_EB, .930E-02_EB, .225E-01_EB, .305E-01_EB,  &   .195E-03_EB, .544E-03_EB, .318E-02_EB, .750E-02_EB, .202E-01_EB, .284E-01_EB, &    .154E-03_EB, .375E-03_EB, .185E-02_EB, .603E-02_EB, .175E-01_EB, .269E-01_EB, &    .101E-03_EB, .263E-03_EB, .119E-02_EB, .480E-02_EB, .156E-01_EB, .253E-01_EB, &    .852E-04_EB, .185E-03_EB, .909E-03_EB, .360E-02_EB, .133E-01_EB, .241E-01_EB,  &   .763E-04_EB, .137E-03_EB, .711E-03_EB, .316E-02_EB, .122E-01_EB, .237E-01_EB,  &   .615E-04_EB, .126E-03_EB, .610E-03_EB, .257E-02_EB, .101E-01_EB, .218E-01_EB/), &  (/6,8/))SD(1:6,97:104) = RESHAPE ((/ & ! 2450-2625 .480E-04_EB, .113E-03_EB, .518E-03_EB, .201E-02_EB, .920E-02_EB, .200E-01_EB, &    .372E-04_EB, .106E-03_EB, .435E-03_EB, .168E-02_EB, .785E-02_EB, .183E-01_EB,  &   .355E-04_EB, .101E-03_EB, .376E-03_EB, .168E-02_EB, .669E-02_EB, .166E-01_EB, &    .358E-04_EB, .990E-04_EB, .366E-03_EB, .167E-02_EB, .651E-02_EB, .156E-01_EB,  &   .389E-04_EB, .102E-03_EB, .376E-03_EB, .167E-02_EB, .641E-02_EB, .152E-01_EB,  &   .422E-04_EB, .106E-03_EB, .373E-03_EB, .168E-02_EB, .656E-02_EB, .150E-01_EB,  &   .521E-04_EB, .111E-03_EB, .371E-03_EB, .170E-02_EB, .673E-02_EB, .152E-01_EB,  &   .646E-04_EB, .121E-03_EB, .384E-03_EB, .179E-02_EB, .798E-02_EB, .179E-01_EB/), &  (/6,8/)) SD(1:6,105:112) = RESHAPE ((/ & ! 2650-2825 .742E-04_EB, .129E-03_EB, .479E-03_EB, .201E-02_EB, .788E-02_EB, .175E-01_EB,   &  .953E-04_EB, .165E-03_EB, .544E-03_EB, .249E-02_EB, .945E-02_EB, .204E-01_EB,   &  .101E-03_EB, .190E-03_EB, .761E-03_EB, .324E-02_EB, .106E-01_EB, .231E-01_EB,   &  .147E-03_EB, .272E-03_EB, .892E-03_EB, .441E-02_EB, .125E-01_EB, .257E-01_EB,    & .195E-03_EB, .326E-03_EB, .100E-02_EB, .499E-02_EB, .147E-01_EB, .295E-01_EB,    & .261E-03_EB, .421E-03_EB, .145E-02_EB, .568E-02_EB, .161E-01_EB, .306E-01_EB,   &  .305E-03_EB, .515E-03_EB, .195E-02_EB, .754E-02_EB, .185E-01_EB, .363E-01_EB,   &  .362E-03_EB, .645E-03_EB, .237E-02_EB, .830E-02_EB, .205E-01_EB, .373E-01_EB/), &  (/6,8/))SD(1:6,113:120) = RESHAPE ((/ & ! 2850-3025