SUBROUTINE LWR88(HEATRA,GRNFLX,TOPFLX,
     1                 PRESS,TEMP,RH2O,QO3,CLDFAC,
     2                 CAMT,NCLDS,KTOP,KBTM)
C---------------------------------------------------------------------
C     SUBROUTINE LWR88 COMPUTES TEMPERATURE-CORRECTED CO2 TRANSMISSION
C   FUNCTIONS AND ALSO COMPUTES THE PRESSURE GRID AND LAYER OPTICAL
C   PATHS.
C          INPUTS:                (COMMON BLOCKS)
C      CLDFAC                          CLDCOM
C      PRESS,TEMP,RH2O,QO3             RADISW
C      CAMT,NCLDS,KTOP,KBTM            RADISW
C      CO251,CO258,CDT51,CDT58         CO2BD3
C      C2D51,C2D58,CO2M51,CO2M58       CO2BD3
C      CDTM51,CDTM58,C2DM51,C2DM58     CO2BD3
C      STEMP,GTEMP                     CO2BD3
C      CO231,CO238,CDT31,CDT38         CO2BD2
C      C2D31,C2D38                     CO2BD2
C      CO271,CO278,CDT71,CDT78         CO2BD4
C      C2D71,C2D78                     CO2BD4
C      BETINW                          BDWIDE
C          OUTPUTS:
C      HEATRA,GRNFLX,TOPFLX            LWOUT
C          CALLED BY:
C      RADMN OR INPUT ROUTINE OF MODEL
C          CALLS:
C      FST88
C
      COMMON/PHYCON/AMOLWT,CSUBP,DIFFCTR,G,GRAVDR,O3DIFCTR,P0,
     *            P0XZP2,P0XZP8,P0X2,RADCON,RGAS,RGASSP,SECPDA
      COMMON/PHYCON/RATCO2MW,RATH2OMW
      COMMON/PHYCON/RADCON1
      COMMON/PHYCON/GINV,P0INV,GP0INV
      COMMON/HCON/HUNDRED,HNINETY,SIXTY,FIFTY,TEN,EIGHT,FIVE,
     *            FOUR,THREE,TWO,ONE,HAF,QUARTR,ZERO
      COMMON/HCON/H83E26,H71E26,H1E15,H1E13,H1E11,H1E8,H4E5,
     *            H165E5,H5725E4,H488E4,H1E4,H24E3,H20788E3,
     *            H2075E3,H1224E3,H5E2,H3082E2,H3E2,H2945E2,
     *            H23E2,H15E2,H35E1,H3P6,H181E1,H18E1,H2P9,H2P8,
     *            H2P5,H1P8,H1P4387,H1P4,H1P25892,HP8,HP518,
     *            HP369,HP1
      COMMON/HCON/H44871M2,H559M3,H1M3,H987M4,H285M4,H1M4,
     *            H6938M5,H394M5,H37412M5,H1439M5,H128M5,H1M5,
     *            H7M6,H4999M6,H25452M6,H1M6,H391M7,H1174M7,
     *            H8725M8,H327M8,H257M8,H1M8,H23M10,H14M10,
     *            H11M10,H1M10,H83M11,H82M11,H8M11,H77M11,
     *            H72M11,H53M11,H48M11,H44M11,H42M11,H37M11,
     *            H35M11,H32M11,H3M11,H28M11,H24M11,H23M11,
     *            H2M11,H18M11,H15M11,H14M11,H114M11,H11M11,
     *            H1M11,H96M12,H93M12,H77M12,H74M12,H65M12,
     *            H62M12,H6M12,H45M12,H44M12,H4M12,H38M12,
     *            H37M12,H3M12,H29M12,H28M12,H24M12,H21M12,
     *            H16M12,H14M12,H12M12,H8M13,H46M13,H36M13,
     *            H135M13,H12M13,H1M13,H3M14,H15M14,H14M14,
     *            H1M17,H1M18,H1M19,H1M20,H1M21,H1M22,H1M23,
     *            H1M24,H26M30,H14M30,H25M31,H21M31,H12M31,
     *            H9M32,H55M32,H45M32,H4M33,H62M34,H1M60
      COMMON/HCON/HMP575,HM13EZ,HM19EZ,HM1E1,HM181E1,HM1E2
      COMMON/HCON/H1E6,H2E6,H1M2,HMP66667,HM6666M2,HP166666,
     *            H41666M2,HMP5,HM2M2,H29316E2,H1226E1,H3116E1,
     *            H9P94,HP6,H625M2,HP228,HP60241,HM1797E1,
     *            H8121E1,H2E2,HM1EZ,H26E2,H44194M2,H1P41819
      COMMON/HCON/HP219,HP144,HP816,H69766E5,H235M3,HP26,
     *            H129M2,H75826M4,H1P082,HP805,H1386E2,
     *            H658M2,H1036E2,H2118M2,H42M2,H323M4,
     *            H67390E2,HP3795,HP5048,H102M5,H451M6
      COMMON/HCON/H16E1,HM161E1,H161E1,H3M3,H101M16,
     *            HM1597E1,H25E2,HP118666,H15M5,H3P5,H18E3,
     *            H6P08108,HMP805,HP602409,HP526315,
     *            H28571M2,H1M16
      COMMON/HCON/H3M4
      COMMON/HCON/HM8E1
      COMMON/HCON/H28E1
C-----------------------------------------------------------------------
       INCLUDE "parmeta"
       INCLUDE "mpp.h"
#include "sp.h"
C-----------------------------------------------------------------------
C     PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE:
C          L      =  NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL
C          NBLW   =  NO. FREQ. BANDS FOR APPROX COMPUTATIONS. SEE
C                      BANDTA FOR DEFINITION
C          NBLX   =  NO. FREQ BANDS FOR APPROX CTS COMPUTATIONS
C          NBLY   =  NO. FREQ. BANDS FOR EXACT CTS COMPUTATIONS. SEE
C                      BDCOMB FOR DEFINITION
C          INLTE  =  NO. LEVELS USED FOR NLTE CALCS.
C          NNLTE  =  INDEX NO. OF FREQ. BAND IN NLTE CALCS.
C          NB,KO2 ARE SHORTWAVE PARAMETERS; OTHER QUANTITIES ARE DERIVED
C                    FROM THE ABOVE PARAMETERS.
      PARAMETER (L=LM)
      PARAMETER (NBLW=163,NBLX=47,NBLY=15)
      PARAMETER (NBLM=NBLY-1)
      PARAMETER (LP1=L+1,LP2=L+2,LP3=L+3)
      PARAMETER (LM1=L-1,LM2=L-2,LM3=L-3)
      PARAMETER (LL=2*L,LLP1=LL+1,LLP2=LL+2,LLP3=LL+3)
      PARAMETER (LLM1=LL-1,LLM2=LL-2,LLM3=LL-3)
      PARAMETER (LP1M=LP1*LP1,LP1M1=LP1M-1)
      PARAMETER (LP1V=LP1*(1+2*L/2))
      PARAMETER (LP121=LP1*NBLY)
      PARAMETER (LL3P=3*L+2)
      PARAMETER (NB=12)
      PARAMETER (INLTE=3,INLTEP=INLTE+1,NNLTE=56)
      PARAMETER (NB1=NB-1)
      PARAMETER (KO2=12)
      PARAMETER (KO21=KO2+1,KO2M=KO2-1)
C     PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE:
C          L      =  NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL
C          NBLW   =  NO. FREQ. BANDS FOR APPROX COMPUTATIONS. SEE
C                      BANDTA FOR DEFINITION
C          NBLX   =  NO. FREQ BANDS FOR APPROX CTS COMPUTATIONS
C          NBLY   =  NO. FREQ. BANDS FOR EXACT CTS COMPUTATIONS. SEE
C                      BDCOMB FOR DEFINITION
C          INLTE  =  NO. LEVELS USED FOR NLTE CALCS.
C          NNLTE  =  INDEX NO. OF FREQ. BAND IN NLTE CALCS.
C          NB,KO2 ARE SHORTWAVE PARAMETERS; OTHER QUANTITIES ARE DERIVED
C                    FROM THE ABOVE PARAMETERS.
C   THE FOLLOWING COMMON BLOCKS CONTAIN PRETABULATED CO2 TRANSMISSION
C       FUNCTIONS, EVALUATED USING THE METHODS OF FELS AND
C       SCHWARZKOPF (1981) AND SCHWARZKOPF AND FELS (1985),
C***COMMON CO2BD3 CONTAINS CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE
C   AND PRESSURE DERIVATIVES FOR THE 560-800 CM-1 BAND. ALSO INCLUDED
C   ARE THE STANDARD TEMPERATURES AND THE WEIGHTING FUNCTION. THESE
C   DATA ARE IN BLOCK DATA BD3:
C         CO251    =  TRANSMISSION FCTNS FOR T0 (STD. PROFILE)
C                       WITH P(SFC)=1013.25 MB
C         CO258    =  TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)
C                       WITH P(SFC)= ^810 MB
C         CDT51    =  FIRST TEMPERATURE DERIVATIVE OF CO251
C         CDT58    =  FIRST TEMPERATURE DERIVATIVE OF CO258
C         C2D51    =  SECOND TEMPERATURE DERIVATIVE OF CO251
C         C2D58    =  SECOND TEMPERATURE DERIVATIVE OF CO251
C         CO2M51   =  TRANSMISSION FCTNS FOR T0 FOR ADJACENT PRESSURE
C                        LEVELS, WITH NO PRESSURE QUADRATURE. USED FOR
C                        NEARBY LAYER COMPUTATIONS. P(SFC)=1013.25 MB
C         CO2M58   =  SAME AS CO2M51,WITH P(SFC)= ^810 MB
C         CDTM51   =  FIRST TEMPERATURE DERIVATIVE OF CO2M51
C         CDTM58   =  FIRST TEMPERATURE DERIVATIVE OF CO2M58
C         C2DM51   =  SECOND TEMPERATURE DERIVATIVE OF CO2M51
C         C2DM58   =  SECOND TEMPERATURE DERIVATIVE OF CO2M58
C         STEMP    =  STANDARD TEMPERATURES FOR MODEL PRESSURE LEVEL
C                        STRUCTURE WITH P(SFC)=1013.25 MB
C         GTEMP    =  WEIGHTING FUNCTION FOR MODEL PRESSURE LEVEL
C                        STRUCTURE WITH P(SFC)=1013.25 MB.
C         B0       =  TEMP. COEFFICIENT USED FOR CO2 TRANS. FCTN.
C                        CORRECTION FOR T(K). (SEE REF. 4 AND BD3)
C         B1       =  TEMP. COEFFICIENT, USED ALONG WITH B0
C         B2       =  TEMP. COEFFICIENT, USED ALONG WITH B0
C         B3       =  TEMP. COEFFICIENT, USED ALONG WITH B0
C
      COMMON/CO2BD3/CO251(LP1,LP1),CO258(LP1,LP1),CDT51(LP1,LP1),
     1 CDT58(LP1,LP1),C2D51(LP1,LP1),C2D58(LP1,LP1),CO2M51(L),
     2 CO2M58(L),CDTM51(L),CDTM58(L),C2DM51(L),C2DM58(L),
     3 STEMP(LP1),GTEMP(LP1),B0,B1,B2,B3
C
C***COMMON CO2BD2 CONTAINS CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE
C   AND PRESSURE DERIVATIVES FOR THE 560-670 CM-1 PART OF THE 15 UM
C   CO2 BAND.  THESE DATA ARE IN BLOCK DATA BD2.
C         CO231    =  TRANSMISSION FCTNS FOR T0 (STD. PROFILE)
C                       WITH P(SFC)=1013.25 MB
C         CO238    =  TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)
C                       WITH P(SFC)= ^810 MB
C         CDT31    =  FIRST TEMPERATURE DERIVATIVE OF CO231
C         CDT38    =  FIRST TEMPERATURE DERIVATIVE OF CO238
C         C2D31    =  SECOND TEMPERATURE DERIVATIVE OF CO231
C         C2D38    =  SECOND TEMPERATURE DERIVATIVE OF CO231
C
      COMMON / CO2BD2 / CO231(LP1),CO238(LP1),CDT31(LP1),
     1 CDT38(LP1),C2D31(LP1),C2D38(LP1)
C
C***COMMON CO2BD4 CONTAINS CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE
C   AND PRESSURE DERIVATIVES FOR THE 670-800 CM-1 PART OF THE 15 UM
C   CO2 BAND.  THESE DATA ARE IN BLOCK DATA BD4.
C         CO271    =  TRANSMISSION FCTNS FOR T0 (STD. PROFILE)
C                       WITH P(SFC)=1013.25 MB
C         CO278    =  TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)
C                       WITH P(SFC)= ^810 MB
C         CDT71    =  FIRST TEMPERATURE DERIVATIVE OF CO271
C         CDT78    =  FIRST TEMPERATURE DERIVATIVE OF CO278
C         C2D71    =  SECOND TEMPERATURE DERIVATIVE OF CO271
C         C2D78    =  SECOND TEMPERATURE DERIVATIVE OF CO271
C
      COMMON / CO2BD4 / CO271(LP1),CO278(LP1),CDT71(LP1),
     1 CDT78(LP1),C2D71(LP1),C2D78(LP1)
C
C***COMMON CO2BD5 CONTAINS CO2 TRANSMISSION FUNCTIONS FOR THE 2270-
C   2380 PART OF THE 4.3 UM CO2 BAND. THESE DATA ARE IN BLOCK DATA BD5.
C         CO211    =  TRANSMISSION FCTNS FOR T0 (STD. PROFILE)
C                       WITH P(SFC)=1013.25 MB
C         CO218    =  TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)
C                       WITH P(SFC)= ^810 MB
C
      COMMON / CO2BD5 / CO211(LP1),CO218(LP1)
C
C    COMMON BLOCK BANDTA CONTAINS RANDOM BAND PARAMETERS FOR THE LW
C    CALCULATIONS USING 10 CM-1 WIDE BANDS.THE 15 UM CO2 COMPLEX
C    IS 2 BANDS,560-670 AND 670-800 CM-1. OZONE COEFFICIENTS ARE
C    IN 3 BANDS,670-800 (14.1 UM),990-1070 AND 1070-1200 (9.6 UM).
C    THE  (NBLW) BANDS NOW INCLUDE:
C                56 BANDS, 10  CM-1 WIDE    0  -   560  CM-1
C                 2 BANDS, 15 UM COMPLEX  560  -   670  CM-1
C                                         670  -   800  CM-1
C                 3 "CONTINUUM" BANDS     800  -   900  CM-1
C                                         900  -   990  CM-1
C                                        1070  -   1200 CM-1
C                 1 BAND FOR 9.6 UM BAND  990  -   1070 CM-1
C               100 BANDS, 10 CM-1 WIDE  1200  -   2200 CM-1
C                 1 BAND FOR 4.3 UM SRC  2270  -   2380 CM-1
C    THUS NBLW PRESENTLY EQUALS    163
C    ALL BANDS ARE ARRANGED IN ORDER OF INCREASING WAVENUMBER
C
C        ARNDM   =   RANDOM "A" PARAMETER FOR (NBLW) BANDS
C        BRNDM   =   RANDOM "B" PARAMETER FOR (NBLW) BANDS
C        BETAD   =   CONTINUUM COEFFICIENTS FOR (NBLW) BANDS
C        AP,BP   =   CAPPHI COEFFICIENTS FOR (NBLW) BANDS
C        ATP,BTP =   CAPPSI COEFFICIENTS FOR (NBLW) BANDS
C        BANDLO  =   LOWEST FREQUENCY IN EACH OF (NBLW) FREQ. BANDS
C        BANDHI  =   HIGHEST FREQUENCY IN EACH OF (NBLW) FREQ. BANDS
C        AO3RND  =   RANDOM "A" PARAMETER FOR OZONE IN (3) OZONE
C                    BANDS
C        BO3RND  =   RANDOM "B" PARAMETER FOR OZONE IN (3) OZONE
C                    BANDS
C        AB15    =   THE PRODUCT ARNDM*BRNDM FOR THE TWO BANDS
C                    REPRESENTING THE 15 UM BAND COMPLEX OF CO2
C     DATA FOR ARNDM,BRNDM,AP,BP,ATP,BTP,AO3RND,BO3RND ARE OBTAINED BY
C     USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS ARE FROM
C     ROBERTS (1976).
      COMMON / BANDTA / ARNDM(NBLW),BRNDM(NBLW),BETAD(NBLW),AP(NBLW),
     1                  BP(NBLW),ATP(NBLW),BTP(NBLW),BANDLO(NBLW),
     2                  BANDHI(NBLW),AO3RND(3),BO3RND(3),AB15(2)
C
C    COMMON BLOCK BDWIDE CONTAINS RANDOM BAND PARAMETERS FOR SPECIFIC
C    WIDE BANDS. AT PRESENT,THE INFORMATION CONSISTS OF 1) RANDOM
C    MODEL PARAMETERS FOR THE 15 UM BAND,560-800 CM-1; 2) THE
C    CONTINUUM COEFFICIENT FOR THE 800-990,1070-1200 CM-1 BAND
C        SPECIFICALLY:
C        AWIDE       =   RANDOM "A" PARAMETER FOR  BAND
C        BWIDE       =   RANDOM "B" PARAMETER FOR  BAND
C        BETAWD      =   CONTINUUM COEFFICIENTS FOR BAND
C        APWD,BPWD   =   CAPPHI COEFFICIENTS FOR  BAND
C        ATPWD,BTPWD =   CAPPSI COEFFICIENTS FOR BAND
C        BDLOWD      =   LOWEST FREQUENCY IN EACH  FREQ  BAND
C        BDHIWD      =   HIGHEST FREQUENCY IN EACH FREQ  BAND
C        AB15WD      =   THE PRODUCT ARNDM*BRNDM FOR THE ONE BAND
C                        REPRESENTING THE 15 UM BAND COMPLEX OF CO2
C        BETINW      =   CONT.COEFFICIENT FOR A SPECIFIED WIDE
C                        FREQ.BAND (800-990 AND 1070-1200 CM-1).
C        SKO2D       =   1./BETINW, USED IN SPA88 FOR CONT. COEFFS
C        SKC1R       =   BETAWD/BETINW, USED FOR CONT. COEFF. FOR
C                        15 UM BAND IN FST88
C        SKO3R       =   RATIO OF CONT. COEFF. FOR 9.9 UM BAND TO
C                        BETINW, USED FOR 9.6 UM CONT COEFF IN FST88
C     DATA FOR AWIDE,BWIDE,APWD,BPWD,ATPWD,BTPWD,AO3WD,BO3WD ARE
C     OBTAINED BY USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS
C     ARE FROM ROBERTS (1976).
      COMMON / BDWIDE / AWIDE,BWIDE,BETAWD,
     1                  APWD,BPWD,ATPWD,BTPWD,
     2                  BDLOWD,BDHIWD,BETINW,
     3                  AB15WD,SKO2D,SKC1R,SKO3R
C
C    COMMON BLOCK BDCOMB CONTAINS RANDOM BAND PARAMETERS FOR THE LW
C    CALCULATIONS USING COMBINED WIDE FREQUENCY BANDS BETWEEN 160 AND
C    1200 CM-1,AS WELL AS THE 2270-2380 BAND FOR SOURCE CALC.
C        BANDS 1-8: COMBINED WIDE FREQUENCY BANDS FOR 160-560 CM-1
C        BANDS 9-14: FREQUENCY BANDS,AS IN BANDTA (NARROW BANDS)
C                    FOR 560-1200 CM-1
C        BAND  15:  FREQUENCY BAND 2270-2380 CM-1,USED FOR SOURCE
C                   CALCULATION ONLY
C        THUS NBLY PRESENTLY EQUALS   15
C
C        BANDS ARE ARRANGED IN ORDER OF INCREASING WAVENUMBER
C        ACOMB       =   RANDOM "A" PARAMETER FOR (NBLY) BANDS
C        BCOMB       =   RANDOM "B" PARAMETER FOR (NBLY) BANDS
C        BETACM      =   CONTINUUM COEFFICIENTS FOR (NBLY) BANDS
C        APCM,BPCM   =   CAPPHI COEFFICIENTS FOR (NBLY) BANDS
C        ATPCM,BTPCM =   CAPPSI COEFFICIENTS FOR (NBLY) BANDS
C        BDLOCM      =   LOWEST FREQUENCY IN EACH OF (NBLY) FREQ. BANDS
C        BDHICM      =   HIGHEST FREQUENCY IN EACH OF (NBLY) FREQ. BANDS
C        AO3CM       =   RANDOM "A" PARAMETER FOR OZONE IN (3) OZONE
C                        BANDS
C        BO3CM       =   RANDOM "B" PARAMETER FOR OZONE IN (3) OZONE
C                        BANDS
C        AB15CM      =   THE PRODUCT ARNDM*BRNDM FOR THE TWO BANDS
C                        REPRESENTING THE 15 UM BAND COMPLEX OF CO2
C        BETINC      =   CONT.COEFFICIENT FOR A SPECIFIED WIDE
C                        FREQ.BAND (800-990 AND 1070-1200 CM-1).
C        IBAND       =   INDEX NO OF THE 40 WIDE BANDS USED IN
C                        COMBINED WIDE BAND CALCULATIONS. IN OTHER
C                        WORDS,INDEX TELLING WHICH OF THE 40 WIDE
C                        BANDS BETWEEN 160-560 CM-1 ARE INCLUDED IN
C                        EACH OF THE FIRST 8 COMBINED WIDE BANDS
C     DATA FOR ACOMB,BCOMB,APCM,BPCM,ATPCM,BTPCM,AO3CM,BO3CM ARE
C     OBTAINED BY USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS
C     ARE FROM ROBERTS (1976). IBAND INDEX VALUES ARE OBTAINED BY
C     EXPERIMENTATION.
      COMMON / BDCOMB / IBAND(40),ACOMB(NBLY),BCOMB(NBLY),
     1                  BETACM(NBLY),APCM(NBLY),BPCM(NBLY),ATPCM(NBLY),
     2                  BTPCM(NBLY),BDLOCM(NBLY),BDHICM(NBLY),BETINC,
     3                  AO3CM(3),BO3CM(3),AB15CM(2)
C
C
      DIMENSION PRESS(IDIM1:IDIM2,LP1),TEMP(IDIM1:IDIM2,LP1),
     1   RH2O(IDIM1:IDIM2,L),QO3(IDIM1:IDIM2,L)
      DIMENSION CLDFAC(IDIM1:IDIM2,LP1,LP1),CAMT(IDIM1:IDIM2,LP1)
      DIMENSION NCLDS(IDIM1:IDIM2),KTOP(IDIM1:IDIM2,LP1),
     1   KBTM(IDIM1:IDIM2,LP1)
      DIMENSION HEATRA(IDIM1:IDIM2,L),GRNFLX(IDIM1:IDIM2),
     1   TOPFLX(IDIM1:IDIM2)
      DIMENSION DELP2(IDIM1:IDIM2,L)
C
      DIMENSION QH2O(IDIM1:IDIM2,L),T(IDIM1:IDIM2,LP1)
      DIMENSION P(IDIM1:IDIM2,LP1),DELP(IDIM1:IDIM2,L)
      DIMENSION CO21(IDIM1:IDIM2,LP1,LP1),CO2NBL(IDIM1:IDIM2,L)
      DIMENSION CO2SP1(IDIM1:IDIM2,LP1),CO2SP2(IDIM1:IDIM2,LP1)
      DIMENSION VAR1(IDIM1:IDIM2,L),VAR2(IDIM1:IDIM2,L),
     1   VAR3(IDIM1:IDIM2,L),VAR4(IDIM1:IDIM2,L)
      DIMENSION CNTVAL(IDIM1:IDIM2,LP1)
      DIMENSION TOTO3(IDIM1:IDIM2,LP1),TPHIO3(IDIM1:IDIM2,LP1),
     1   TOTPHI(IDIM1:IDIM2,LP1)
      DIMENSION TOTVO2(IDIM1:IDIM2,LP1),EMX1(IDIM1:IDIM2),
     1   EMX2(IDIM1:IDIM2),EMPL(IDIM1:IDIM2,LLP1)
C
      DIMENSION CO2R(IDIM1:IDIM2,LP1),DIFT(IDIM1:IDIM2,LP1)
      DIMENSION CO2R1(IDIM1:IDIM2,LP1),DCO2D1(IDIM1:IDIM2,LP1)
      DIMENSION D2CD21(IDIM1:IDIM2,LP1),D2CD22(IDIM1:IDIM2,LP1)
      DIMENSION CO2R2(IDIM1:IDIM2,LP1),DCO2D2(IDIM1:IDIM2,LP1)
      DIMENSION CO2MR(IDIM1:IDIM2,L),CO2MD(IDIM1:IDIM2,L),
     1   CO2M2D(IDIM1:IDIM2,L)
      DIMENSION TDAV(IDIM1:IDIM2,LP1),TSTDAV(IDIM1:IDIM2,LP1),
     1 VV(IDIM1:IDIM2,L),VSUM3(IDIM1:IDIM2,LP1),VSUM1(IDIM1:IDIM2),
     2 VSUM2(IDIM1:IDIM2)
      DIMENSION A1(IDIM1:IDIM2),A2(IDIM1:IDIM2)
      DIMENSION DCO2DT(IDIM1:IDIM2,LP1),D2CDT2(IDIM1:IDIM2,LP1)
C
      DIMENSION TEXPSL(IDIM1:IDIM2,LP1),TLSQU(IDIM1:IDIM2,LP1)
      DIMENSION VSUM4(IDIM1:IDIM2,L)
      EQUIVALENCE (VSUM3,TLSQU,TEXPSL)
      EQUIVALENCE (VV,VSUM4)
c
C
C****COMPUTE FLUX PRESSURES (P) AND DIFFERENCES (DELP2,DELP)
C****COMPUTE FLUX LEVEL TEMPERATURES (T) AND CONTINUUM TEMPERATURE
C    CORRECTIONS (TEXPSL)
      DO 103 K=2,L
      DO 103 I=MYIS,MYIE
      P(I,K)=HAF*(PRESS(I,K-1)+PRESS(I,K))
      T(I,K)=HAF*(TEMP(I,K-1)+TEMP(I,K))
103   CONTINUE
      DO 105 I=MYIS,MYIE
      P(I,1)=ZERO
      P(I,LP1)=PRESS(I,LP1)
      T(I,1)=TEMP(I,1)
      T(I,LP1)=TEMP(I,LP1)
105   CONTINUE
      DO 107 K=1,L
      DO 107 I=MYIS,MYIE
      DELP2(I,K)=P(I,K+1)-P(I,K)
      DELP(I,K)=ONE/DELP2(I,K)
107   CONTINUE
C****COMPUTE ARGUMENT FOR CONT.TEMP.COEFF.
C    (THIS IS 1800.(1./TEMP-1./296.))
      DO 125 K=1,LP1
      DO 125 I=MYIS,MYIE
      TEXPSL(I,K)=H18E3/TEMP(I,K)-H6P08108
C...THEN TAKE EXPONENTIAL
      TEXPSL(I,K)=EXP(TEXPSL(I,K))
125   CONTINUE
C***COMPUTE OPTICAL PATHS FOR H2O AND O3, USING THE DIFFUSIVITY
C   APPROXIMATION FOR THE ANGULAR INTEGRATION (1.66). OBTAIN THE
C   UNWEIGHTED VALUES(VAR1,VAR3) AND THE WEIGHTED VALUES(VAR2,VAR4).
C   THE QUANTITIES H3M4(.0003) AND H3M3(.003) APPEARING IN THE VAR2 AND
C   VAR4 EXPRESSIONS ARE THE APPROXIMATE VOIGT CORRECTIONS FOR H2O AND
C   O3,RESPECTIVELY.
C
      DO 131 K=1,L
      DO 131 I=MYIS,MYIE
      QH2O(I,K)=RH2O(I,K)*DIFFCTR
C---VV IS THE LAYER-MEAN PRESSURE (IN ATM),WHICH IS NOT THE SAME AS
C   THE LEVEL PRESSURE (PRESS)
      VV(I,K)=HAF*(P(I,K+1)+P(I,K))*P0INV
      VAR1(I,K)=DELP2(I,K)*QH2O(I,K)*GINV
      VAR3(I,K)=DELP2(I,K)*QO3(I,K)*DIFFCTR*GINV
      VAR2(I,K)=VAR1(I,K)*(VV(I,K)+H3M4)
      VAR4(I,K)=VAR3(I,K)*(VV(I,K)+H3M3)
C  COMPUTE OPTICAL PATH FOR THE H2O CONTINUUM, USING ROBERTS COEFFS.
C  (BETINW),AND TEMP. CORRECTION (TEXPSL). THE DIFFUSIVITY FACTOR
C  (WHICH CANCELS OUT IN THIS EXPRESSION) IS ASSUMED TO BE 1.66. THE
C  USE OF THE DIFFUSIVITY FACTOR HAS BEEN SHOWN TO BE A SIGNIFICANT
C  SOURCE OF ERROR IN THE CONTINUUM CALCS.,BUT THE TIME PENALTY OF
C  AN ANGULAR INTEGRATION IS SEVERE.
C
      CNTVAL(I,K)=TEXPSL(I,K)*RH2O(I,K)*VAR2(I,K)*BETINW/
     1             (RH2O(I,K)+RATH2OMW)
131   CONTINUE
C   COMPUTE SUMMED OPTICAL PATHS FOR H2O,O3 AND CONTINUUM
      DO 201 I=MYIS,MYIE
      TOTPHI(I,1)=ZERO
      TOTO3(I,1)=ZERO
      TPHIO3(I,1)=ZERO
      TOTVO2(I,1)=ZERO
201   CONTINUE
      DO 203 K=2,LP1
      DO 203 I=MYIS,MYIE
      TOTPHI(I,K)=TOTPHI(I,K-1)+VAR2(I,K-1)
      TOTO3(I,K)=TOTO3(I,K-1)+VAR3(I,K-1)
      TPHIO3(I,K)=TPHIO3(I,K-1)+VAR4(I,K-1)
      TOTVO2(I,K)=TOTVO2(I,K-1)+CNTVAL(I,K-1)
203   CONTINUE
C---EMX1 IS THE ADDITIONAL PRESSURE-SCALED MASS FROM PRESS(L) TO
C   P(L). IT IS USED IN NEARBY LAYER AND EMISS CALCULATIONS.
C---EMX2 IS THE ADDITIONAL PRESSURE-SCALED MASS FROM PRESS(L) TO
C   P(LP1). IT IS USED IN CALCULATIONS BETWEEN FLUX LEVELS L AND LP1.
C
      DO 801 I=MYIS,MYIE
      EMX1(I)=QH2O(I,L)*PRESS(I,L)*(PRESS(I,L)-P(I,L))*GP0INV
      EMX2(I)=QH2O(I,L)*PRESS(I,L)*(P(I,LP1)-PRESS(I,L))*GP0INV
801   CONTINUE
C---EMPL IS THE PRESSURE SCALED MASS FROM P(K) TO PRESS(K) (INDEX 2-LP1)
C   OR TO PRESS(K+1) (INDEX LP2-LL)
      DO 811 K=1,L
      DO 811 I=MYIS,MYIE
      EMPL(I,K+1)=QH2O(I,K)*P(I,K+1)*(P(I,K+1)-PRESS(I,K))*GP0INV
811   CONTINUE
      DO 812 K=1,LM1
      DO 812 I=MYIS,MYIE
      EMPL(I,LP2+K-1)=QH2O(I,K+1)*P(I,K+1)*(PRESS(I,K+1)-P(I,K+1))
     1               *GP0INV
812   CONTINUE
      DO 821 I=MYIS,MYIE
      EMPL(I,1)=VAR2(I,L)
      EMPL(I,LLP1)=EMPL(I,LL)
821   CONTINUE
C***COMPUTE WEIGHTED TEMPERATURE (TDAV) AND PRESSURE (TSTDAV) INTEGRALS
C   FOR USE IN OBTAINING TEMP. DIFFERENCE BET. SOUNDING AND STD.
C   TEMP. SOUNDING (DIFT)
      DO 161 I=MYIS,MYIE
      TSTDAV(I,1)=ZERO
      TDAV(I,1)=ZERO
161   CONTINUE
      DO 162 K=1,LP1
      DO 162 I=MYIS,MYIE
      VSUM3(I,K)=TEMP(I,K)-STEMP(K)
162   CONTINUE
      DO 163 K=1,L
      DO 165 I=MYIS,MYIE
      VSUM2(I)=GTEMP(K)*DELP2(I,K)
      VSUM1(I)=VSUM2(I)*VSUM3(I,K)
      TSTDAV(I,K+1)=TSTDAV(I,K)+VSUM2(I)
      TDAV(I,K+1)=TDAV(I,K)+VSUM1(I)
165   CONTINUE
163   CONTINUE
C
C****EVALUATE COEFFICIENTS FOR CO2 PRESSURE INTERPOLATION (A1,A2)
      DO 171 I=MYIS,MYIE
      A1(I)=(PRESS(I,LP1)-P0XZP8)/P0XZP2
      A2(I)=(P0-PRESS(I,LP1))/P0XZP2
171   CONTINUE
C***PERFORM CO2 PRESSURE INTERPOLATION ON ALL INPUTTED TRANSMISSION
C   FUNCTIONS AND TEMP. DERIVATIVES
C---SUCCESSIVELY COMPUTING CO2R,DCO2DT AND D2CDT2 IS DONE TO SAVE
C   STORAGE (AT A SLIGHT LOSS IN COMPUTATION TIME)
      DO 184 K=1,LP1
      DO 184 I=MYIS,MYIE
        CO2R1(I,K)=A1(I)*CO231(K)+A2(I)*CO238(K)
        D2CD21(I,K)=H1M3*(A1(I)*C2D31(K)+A2(I)*C2D38(K))
        DCO2D1(I,K)=H1M2*(A1(I)*CDT31(K)+A2(I)*CDT38(K))
        CO2R2(I,K)=A1(I)*CO271(K)+A2(I)*CO278(K)
        D2CD22(I,K)=H1M3*(A1(I)*C2D71(K)+A2(I)*C2D78(K))
        DCO2D2(I,K)=H1M2*(A1(I)*CDT71(K)+A2(I)*CDT78(K))
184   CONTINUE
      DO 190 K=1,L
      DO 190 I=MYIS,MYIE
        CO2MR(I,K)=A1(I)*CO2M51(K)+A2(I)*CO2M58(K)
        CO2MD(I,K)=H1M2*(A1(I)*CDTM51(K)+A2(I)*CDTM58(K))
        CO2M2D(I,K)=H1M3*(A1(I)*C2DM51(K)+A2(I)*C2DM58(K))
190   CONTINUE
C***COMPUTE CO2 TEMPERATURE INTERPOLATIONS FOR ALL BANDS,USING DIFT
C
C   THE CASE WHERE K=1 IS HANDLED FIRST. WE ARE NOW REPLACING
C   3-DIMENSIONAL ARRAYS BY 2-D ARRAYS, TO SAVE SPACE. THUS THIS
C   CALCULATION IS FOR (I,KP,1)
      DO 211 KP=2,LP1
      DO 211 I=MYIS,MYIE
      DIFT(I,KP)=TDAV(I,KP)/TSTDAV(I,KP)
211   CONTINUE
      DO 212 I=MYIS,MYIE
      CO21(I,1,1)=1.0
      CO2SP1(I,1)=1.0
      CO2SP2(I,1)=1.0
212   CONTINUE
      DO 215 KP=2,LP1
      DO 215 I=MYIS,MYIE
C---CALCULATIONS FOR KP>1 FOR K=1
      CO2R(I,KP)=A1(I)*CO251(KP,1)+A2(I)*CO258(KP,1)
      DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(KP,1)+A2(I)*CDT58(KP,1))
      D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(KP,1)+A2(I)*C2D58(KP,1))
      CO21(I,KP,1)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+
     1             HAF*DIFT(I,KP)*D2CDT2(I,KP))
C---CALCULATIONS FOR (EFFECTIVELY) KP=1,K>KP. THESE USE THE
C   SAME VALUE OF DIFT DUE TO SYMMETRY
      CO2R(I,KP)=A1(I)*CO251(1,KP)+A2(I)*CO258(1,KP)
      DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(1,KP)+A2(I)*CDT58(1,KP))
      D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(1,KP)+A2(I)*C2D58(1,KP))
      CO21(I,1,KP)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+
     1             HAF*DIFT(I,KP)*D2CDT2(I,KP))
215   CONTINUE
C   THE TRANSMISSION FUNCTIONS USED IN SPA88 MAY BE COMPUTED NOW.
C---(IN THE 250 LOOP,DIFT REALLY SHOULD BE (I,1,K), BUT DIFT IS
C    INVARIANT WITH RESPECT TO K,KP,AND SO (I,1,K)=(I,K,1))
      DO 250 K=2,LP1
      DO 250 I=MYIS,MYIE
      CO2SP1(I,K)=CO2R1(I,K)+DIFT(I,K)*(DCO2D1(I,K)+HAF*DIFT(I,K)*
     1 D2CD21(I,K))
      CO2SP2(I,K)=CO2R2(I,K)+DIFT(I,K)*(DCO2D2(I,K)+HAF*DIFT(I,K)*
     1 D2CD22(I,K))
250   CONTINUE
C
C   NEXT THE CASE WHEN K=2...L
      DO 220 K=2,L
      DO 222 KP=K+1,LP1
      DO 222 I=MYIS,MYIE
      DIFT(I,KP)=(TDAV(I,KP)-TDAV(I,K))/
     1              (TSTDAV(I,KP)-TSTDAV(I,K))
      CO2R(I,KP)=A1(I)*CO251(KP,K)+A2(I)*CO258(KP,K)
      DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(KP,K)+A2(I)*CDT58(KP,K))
      D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(KP,K)+A2(I)*C2D58(KP,K))
      CO21(I,KP,K)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+
     1             HAF*DIFT(I,KP)*D2CDT2(I,KP))
      CO2R(I,KP)=A1(I)*CO251(K,KP)+A2(I)*CO258(K,KP)
      DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(K,KP)+A2(I)*CDT58(K,KP))
      D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(K,KP)+A2(I)*C2D58(K,KP))
      CO21(I,K,KP)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+
     1             HAF*DIFT(I,KP)*D2CDT2(I,KP))
222   CONTINUE
220   CONTINUE
C   FINALLY THE CASE WHEN K=KP,K=2..LP1
      DO 206 K=2,LP1
      DO 206 I=MYIS,MYIE
      DIFT(I,K)=HAF*(VSUM3(I,K)+VSUM3(I,K-1))
      CO2R(I,K)=A1(I)*CO251(K,K)+A2(I)*CO258(K,K)
      DCO2DT(I,K)=H1M2*(A1(I)*CDT51(K,K)+A2(I)*CDT58(K,K))
      D2CDT2(I,K)=H1M3*(A1(I)*C2D51(K,K)+A2(I)*C2D58(K,K))
      CO21(I,K,K)=CO2R(I,K)+DIFT(I,K)*(DCO2DT(I,K)+
     1             HAF*DIFT(I,K)*D2CDT2(I,K))
206   CONTINUE
C--- WE AREN'T DOING NBL TFS ON THE 100 CM-1 BANDS .
      DO 260 K=1,L
      DO 260 I=MYIS,MYIE
      CO2NBL(I,K)=CO2MR(I,K)+VSUM3(I,K)*(CO2MD(I,K)+HAF*
     1 VSUM3(I,K)*CO2M2D(I,K))
260   CONTINUE
C***COMPUTE TEMP. COEFFICIENT BASED ON T(K) (SEE REF.2)
      DO 264 K=1,LP1
      DO 264 I=MYIS,MYIE
      IF (T(I,K).LE.H25E2) THEN
         TLSQU(I,K)=B0+(T(I,K)-H25E2)*
     1                      (B1+(T(I,K)-H25E2)*
     2                   (B2+B3*(T(I,K)-H25E2)))
      ELSE
         TLSQU(I,K)=B0
      ENDIF
264   CONTINUE
C***APPLY TO ALL CO2 TFS
      DO 280 K=1,LP1
      DO 282 KP=1,LP1
      DO 282 I=MYIS,MYIE
      CO21(I,KP,K)=CO21(I,KP,K)*(ONE-TLSQU(I,KP))+TLSQU(I,KP)
282   CONTINUE
280   CONTINUE
      DO 284 K=1,LP1
      DO 286 I=MYIS,MYIE
      CO2SP1(I,K)=CO2SP1(I,K)*(ONE-TLSQU(I,1))+TLSQU(I,1)
      CO2SP2(I,K)=CO2SP2(I,K)*(ONE-TLSQU(I,1))+TLSQU(I,1)
286   CONTINUE
284   CONTINUE
      DO 288 K=1,L
      DO 290 I=MYIS,MYIE
      CO2NBL(I,K)=CO2NBL(I,K)*(ONE-TLSQU(I,K))+TLSQU(I,K)
290   CONTINUE
288   CONTINUE
      CALL FST88(HEATRA,GRNFLX,TOPFLX,
     1           QH2O,PRESS,P,DELP,DELP2,TEMP,T,
     2           CLDFAC,NCLDS,KTOP,KBTM,CAMT,
     3           CO21,CO2NBL,CO2SP1,CO2SP2,
     4           VAR1,VAR2,VAR3,VAR4,CNTVAL,
     5           TOTO3,TPHIO3,TOTPHI,TOTVO2,
     6           EMX1,EMX2,EMPL)
      RETURN
      END