C     SUBROUTINE SPA88 COMPUTES EXACT CTS HEATING RATES AND FLUXES AND
C  CORRESPONDING CTS EMISSIVITY QUANTITIES FOR H2O,CO2 AND O3.
C          INPUTS:                (COMMON BLOCKS)
C       ACOMB,BCOMB,APCM,BPCM                  BDCOMB
C       ATPCM,BTPCM,BETACM                     BDCOMB
C       BETINW                                 BDWIDE
C       TEMP,PRESS                             RADISW
C       VAR1,VAR2,P,DELP,DELP2                 KDACOM
C       TOTVO2,TO3SP,TO3SPC                    TFCOM
C       CO2SP1,CO2SP2,CO2SP                    TFCOM
C       CLDFAC                                 CLDCOM
C       SKO2D                                  TABCOM
C       SORC,CSOUR                             SRCCOM
C           OUTPUTS:
C       EXCTS,CTSO3                            TFCOM
C       GXCTS                                  RDFLUX
C           CALLED BY:
C       FST88
C            CALLS:
C
      SUBROUTINE SPA88(EXCTS,CTSO3,GXCTS,SORC,CSOUR,
     1                 CLDFAC,TEMP,PRESS,VAR1,VAR2,
     2                 P,DELP,DELP2,TOTVO2,TO3SP,TO3SPC,
     3                 CO2SP1,CO2SP2,CO2SP)
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          IMAX   =  NO. POINTS ALONG THE LAT. CIRCLE USED IN CALCS.
C          L      =  NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL
C***NOTE: THE USER NORMALLY WILL MODIFY ONLY THE IMAX AND L PARAMETERS
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 (IMAX=IM,NCOL=IMAX)
      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 (LP1I=IMAX*LP1,LLP1I=IMAX*LLP1,LL3PI=IMAX*LL3P)
      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          IMAX   =  NO. POINTS SENT TO RADFS
C          L      =  NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL
C***NOTE: THE USER NORMALLY WILL MODIFY ONLY THE IMAX AND L PARAMETERS
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    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
      DIMENSION SORC(IDIM1:IDIM2,LP1,NBLY),CSOUR(IDIM1:IDIM2,LP1)
      DIMENSION CLDFAC(IDIM1:IDIM2,LP1,LP1)
      DIMENSION TEMP(IDIM1:IDIM2,LP1),PRESS(IDIM1:IDIM2,LP1)
      DIMENSION VAR1(IDIM1:IDIM2,L),VAR2(IDIM1:IDIM2,L)
      DIMENSION P(IDIM1:IDIM2,LP1),DELP(IDIM1:IDIM2,L),
     1    DELP2(IDIM1:IDIM2,L)
      DIMENSION TOTVO2(IDIM1:IDIM2,LP1),TO3SPC(IDIM1:IDIM2,L),
     1    TO3SP(IDIM1:IDIM2,LP1)
      DIMENSION CO2SP1(IDIM1:IDIM2,LP1),CO2SP2(IDIM1:IDIM2,LP1),
     1    CO2SP(IDIM1:IDIM2,LP1)
      DIMENSION EXCTS(IDIM1:IDIM2,L),CTSO3(IDIM1:IDIM2,L),
     1    GXCTS(IDIM1:IDIM2)
C
      DIMENSION PHITMP(IDIM1:IDIM2,L),PSITMP(IDIM1:IDIM2,L),
     1          TT(IDIM1:IDIM2,L),
     2          FAC1(IDIM1:IDIM2,L),FAC2(IDIM1:IDIM2,L),
     3          CTMP(IDIM1:IDIM2,LP1),X(IDIM1:IDIM2,L),
     4          Y(IDIM1:IDIM2,L),
     5          TOPM(IDIM1:IDIM2,L),TOPPHI(IDIM1:IDIM2,L),
     6          CTMP3(IDIM1:IDIM2,LP1),CTMP2(IDIM1:IDIM2,LP1)
      DIMENSION F(IDIM1:IDIM2,L),FF(IDIM1:IDIM2,L),
     1          AG(IDIM1:IDIM2,L),AGG(IDIM1:IDIM2,L)
C
      EQUIVALENCE (F,AG,PHITMP)
      EQUIVALENCE (FF,AGG,PSITMP)
C---COMPUTE TEMPERATURE QUANTITIES FOR USE IN PROGRAM
      DO 101 K=1,L
      DO 101 I=MYIS,MYIE
      X(I,K)=TEMP(I,K)-H25E2
      Y(I,K)=X(I,K)*X(I,K)
101   CONTINUE
C---INITIALIZE CTMP(I,1),CTMP2(I,1),CTMP3(I,1) TO UNITY; THESE ARE
C   TRANSMISSION FCTNS AT THE TOP.
      DO 345 I=MYIS,MYIE
      CTMP(I,1)=ONE
      CTMP2(I,1)=1.
      CTMP3(I,1)=1.
345   CONTINUE
C***BEGIN LOOP ON FREQUENCY BANDS (1)***
C
C---CALCULATION FOR BAND 1 (COMBINED BAND 1)
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 301 K=1,L
      DO 301 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(1)*X(I,K)+BPCM(1)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(1)*X(I,K)+BTPCM(1)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
301   CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 315 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
315   CONTINUE
      DO 319 K=2,L
      DO 317 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
317   CONTINUE
319   CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 321 K=1,L
      DO 321 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(1)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(1)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*FAC1(I,K)/SQRT(1.+FAC2(I,K)))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
321   CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 353 K=1,L
      DO 353 I=MYIS,MYIE
      EXCTS(I,K)=SORC(I,K,1)*(CTMP(I,K+1)-CTMP(I,K))
353   CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 361 I=MYIS,MYIE
      GXCTS(I)=CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,1)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,1)-SORC(I,L,1)))
361   CONTINUE
C
C
C-----CALCULATION FOR BAND 2 (COMBINED BAND 2)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 401 K=1,L
      DO 401 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(2)*X(I,K)+BPCM(2)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(2)*X(I,K)+BTPCM(2)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
401   CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 415 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
415   CONTINUE
      DO 419 K=2,L
      DO 417 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
417   CONTINUE
419   CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 421 K=1,L
      DO 421 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(2)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(2)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*FAC1(I,K)/SQRT(1.+FAC2(I,K)))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
421   CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 453 K=1,L
      DO 453 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,2)*
     1             (CTMP(I,K+1)-CTMP(I,K))
453   CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 461 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,2)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,2)-SORC(I,L,2)))
461   CONTINUE
C
C-----CALCULATION FOR BAND 3 (COMBINED BAND 3)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 501 K=1,L
      DO 501 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(3)*X(I,K)+BPCM(3)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(3)*X(I,K)+BTPCM(3)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
501   CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 515 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
515   CONTINUE
      DO 519 K=2,L
      DO 517 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
517   CONTINUE
519   CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 521 K=1,L
      DO 521 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(3)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(3)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*FAC1(I,K)/SQRT(1.+FAC2(I,K)))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
521   CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 553 K=1,L
      DO 553 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,3)*
     1             (CTMP(I,K+1)-CTMP(I,K))
553   CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 561 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,3)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,3)-SORC(I,L,3)))
561   CONTINUE
C
C-----CALCULATION FOR BAND 4 (COMBINED BAND 4)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 601 K=1,L
      DO 601 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(4)*X(I,K)+BPCM(4)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(4)*X(I,K)+BTPCM(4)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
601   CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 615 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
615   CONTINUE
      DO 619 K=2,L
      DO 617 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
617   CONTINUE
619   CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 621 K=1,L
      DO 621 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(4)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(4)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*FAC1(I,K)/SQRT(1.+FAC2(I,K)))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
621   CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 653 K=1,L
      DO 653 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,4)*
     1             (CTMP(I,K+1)-CTMP(I,K))
653   CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 661 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,4)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,4)-SORC(I,L,4)))
661   CONTINUE
C
C-----CALCULATION FOR BAND 5 (COMBINED BAND 5)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 701 K=1,L
      DO 701 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(5)*X(I,K)+BPCM(5)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(5)*X(I,K)+BTPCM(5)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
701   CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 715 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
715   CONTINUE
      DO 719 K=2,L
      DO 717 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
717   CONTINUE
719   CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 721 K=1,L
      DO 721 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(5)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(5)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(5)*TOTVO2(I,K+1)*SKO2D))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
721   CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 753 K=1,L
      DO 753 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,5)*
     1             (CTMP(I,K+1)-CTMP(I,K))
753   CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 761 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,5)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,5)-SORC(I,L,5)))
761   CONTINUE
C
C-----CALCULATION FOR BAND 6 (COMBINED BAND 6)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 801 K=1,L
      DO 801 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(6)*X(I,K)+BPCM(6)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(6)*X(I,K)+BTPCM(6)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
801   CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 815 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
815   CONTINUE
      DO 819 K=2,L
      DO 817 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
817   CONTINUE
819   CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 821 K=1,L
      DO 821 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(6)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(6)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(6)*TOTVO2(I,K+1)*SKO2D))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
821   CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 853 K=1,L
      DO 853 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,6)*
     1             (CTMP(I,K+1)-CTMP(I,K))
853   CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 861 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,6)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,6)-SORC(I,L,6)))
861   CONTINUE
C
C-----CALCULATION FOR BAND 7 (COMBINED BAND 7)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 901 K=1,L
      DO 901 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(7)*X(I,K)+BPCM(7)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(7)*X(I,K)+BTPCM(7)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
901   CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 915 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
915   CONTINUE
      DO 919 K=2,L
      DO 917 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
917   CONTINUE
919   CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 921 K=1,L
      DO 921 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(7)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(7)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(7)*TOTVO2(I,K+1)*SKO2D))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
921   CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 953 K=1,L
      DO 953 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,k,7)*
     1             (CTMP(I,K+1)-CTMP(I,K))
953   CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 961 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,7)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,7)-SORC(I,L,7)))
961   CONTINUE
C
C-----CALCULATION FOR BAND 8 (COMBINED BAND 8)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 1001 K=1,L
      DO 1001 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(8)*X(I,K)+BPCM(8)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(8)*X(I,K)+BTPCM(8)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
1001  CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 1015 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
1015  CONTINUE
      DO 1019 K=2,L
      DO 1017 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
1017  CONTINUE
1019  CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 1021 K=1,L
      DO 1021 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(8)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(8)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(8)*TOTVO2(I,K+1)*SKO2D))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
1021  CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 1053 K=1,L
      DO 1053 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,8)*
     1             (CTMP(I,K+1)-CTMP(I,K))
1053  CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 1061 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,8)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,8)-SORC(I,L,8)))
1061  CONTINUE
C
C-----CALCULATION FOR BAND 9 ( 560-670 CM-1; INCLUDES CO2)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 1101 K=1,L
      DO 1101 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(9)*X(I,K)+BPCM(9)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(9)*X(I,K)+BTPCM(9)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
1101  CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 1115 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
1115  CONTINUE
      DO 1119 K=2,L
      DO 1117 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
1117  CONTINUE
1119  CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 1121 K=1,L
      DO 1121 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(9)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(9)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(9)*TOTVO2(I,K+1)*SKO2D))*CO2SP1(I,K+1)
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
1121  CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 1153 K=1,L
      DO 1153 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,9)*
     1             (CTMP(I,K+1)-CTMP(I,K))
1153  CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 1161 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,9)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,9)-SORC(I,L,9)))
1161  CONTINUE
C
C-----CALCULATION FOR BAND 10 (670-800 CM-1; INCLUDES CO2)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 1201 K=1,L
      DO 1201 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(10)*X(I,K)+BPCM(10)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(10)*X(I,K)+BTPCM(10)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
1201  CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 1215 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
1215  CONTINUE
      DO 1219 K=2,L
      DO 1217 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
1217  CONTINUE
1219  CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 1221 K=1,L
      DO 1221 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(10)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(10)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(10)*TOTVO2(I,K+1)*SKO2D))*CO2SP2(I,K+1)
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
1221  CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 1253 K=1,L
      DO 1253 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,10)*
     1             (CTMP(I,K+1)-CTMP(I,K))
1253  CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 1261 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,10)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,10)-SORC(I,L,10)))
1261  CONTINUE
C
C-----CALCULATION FOR BAND 11 (800-900 CM-1)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 1301 K=1,L
      DO 1301 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(11)*X(I,K)+BPCM(11)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(11)*X(I,K)+BTPCM(11)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
1301  CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 1315 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
1315  CONTINUE
      DO 1319 K=2,L
      DO 1317 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
1317  CONTINUE
1319  CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 1321 K=1,L
      DO 1321 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(11)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(11)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(11)*TOTVO2(I,K+1)*SKO2D))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
1321  CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 1353 K=1,L
      DO 1353 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,11)*
     1             (CTMP(I,K+1)-CTMP(I,K))
1353  CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 1361 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,11)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,11)-SORC(I,L,11)))
1361  CONTINUE
C
C-----CALCULATION FOR BAND 12 (900-990 CM-1)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 1401 K=1,L
      DO 1401 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(12)*X(I,K)+BPCM(12)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(12)*X(I,K)+BTPCM(12)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
1401  CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 1415 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
1415  CONTINUE
      DO 1419 K=2,L
      DO 1417 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
1417  CONTINUE
1419  CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 1421 K=1,L
      DO 1421 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(12)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(12)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(12)*TOTVO2(I,K+1)*SKO2D))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
1421  CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 1453 K=1,L
      DO 1453 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,12)*
     1             (CTMP(I,K+1)-CTMP(I,K))
1453  CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 1461 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,12)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,12)-SORC(I,L,12)))
1461  CONTINUE
C
C-----CALCULATION FOR BAND 13 (990-1070 CM-1; INCLUDES O3))
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 1501 K=1,L
      DO 1501 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(13)*X(I,K)+BPCM(13)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(13)*X(I,K)+BTPCM(13)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
1501  CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 1515 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
1515  CONTINUE
      DO 1519 K=2,L
      DO 1517 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
1517  CONTINUE
1519  CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 1521 K=1,L
      DO 1521 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(13)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(13)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(13)*TOTVO2(I,K+1)*SKO2D+TO3SPC(I,K)))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
1521  CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 1553 K=1,L
      DO 1553 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,13)*
     1             (CTMP(I,K+1)-CTMP(I,K))
1553  CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 1561 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,13)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,13)-SORC(I,L,13)))
1561  CONTINUE
C
C-----CALCULATION FOR BAND 14 (1070-1200 CM-1)
C
C
C---OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY
C   BY OPTICAL PATH (VAR1,VAR2) TO COMPUTE TEMPERATURE-CORRECTED
C   OPTICAL PATH AND MEAN PRESSURE FOR A LAYER (PHITMP,PSITMP)
      DO 1601 K=1,L
      DO 1601 I=MYIS,MYIE
      F(I,K)=H44194M2*(APCM(14)*X(I,K)+BPCM(14)*Y(I,K))
      FF(I,K)=H44194M2*(ATPCM(14)*X(I,K)+BTPCM(14)*Y(I,K))
      AG(I,K)=(H1P41819+F(I,K))*F(I,K)+ONE
      AGG(I,K)=(H1P41819+FF(I,K))*FF(I,K)+ONE
      PHITMP(I,K)=VAR1(I,K)*(((( AG(I,K)*AG(I,K))**2)**2)**2)
      PSITMP(I,K)=VAR2(I,K)*(((( AGG(I,K)*AGG(I,K))**2)**2)**2)
1601  CONTINUE
C---OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
C   P(K) (TOPM,TOPPHI)
      DO 1615 I=MYIS,MYIE
      TOPM(I,1)=PHITMP(I,1)
      TOPPHI(I,1)=PSITMP(I,1)
1615  CONTINUE
      DO 1619 K=2,L
      DO 1617 I=MYIS,MYIE
      TOPM(I,K)=TOPM(I,K-1)+PHITMP(I,K)
      TOPPHI(I,K)=TOPPHI(I,K-1)+PSITMP(I,K)
1617  CONTINUE
1619  CONTINUE
C---TT IS THE CLOUD-FREE CTS TRANSMISSION FUNCTION
      DO 1621 K=1,L
      DO 1621 I=MYIS,MYIE
      FAC1(I,K)=ACOMB(14)*TOPM(I,K)
      FAC2(I,K)=FAC1(I,K)*TOPM(I,K)/(BCOMB(14)*TOPPHI(I,K))
      TT(I,K)=EXP(HM1EZ*(FAC1(I,K)/SQRT(ONE+FAC2(I,K))+
     1           BETACM(14)*TOTVO2(I,K+1)*SKO2D))
      CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
1621  CONTINUE
C---EXCTS IS THE CTS COOLING RATE ACCUMULATED OVER FREQUENCY BANDS
      DO 1653 K=1,L
      DO 1653 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)+SORC(I,K,14)*
     1             (CTMP(I,K+1)-CTMP(I,K))
1653  CONTINUE
C---GXCTS IS THE EXACT CTS TOP FLUX ACCUMULATED OVER FREQUENCY BANDS
      DO 1661 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)+CLDFAC(I,LP1,1)*(TT(I,L)*SORC(I,L,14)+
     1   (HAF*DELP(I,L)*(TT(I,LM1)*(P(I,LP1)-PRESS(I,L)) +
     2   TT(I,L)*(P(I,LP1)+PRESS(I,L)-TWO*P(I,L)))) *
     3   (SORC(I,LP1,14)-SORC(I,L,14)))
1661  CONTINUE
C
C
C   OBTAIN CTS FLUX AT THE TOP BY INTEGRATION OF HEATING RATES AND
C   USING CTS FLUX AT THE BOTTOM (CURRENT VALUE OF GXCTS). NOTE
C   THAT THE PRESSURE QUANTITIES AND CONVERSION FACTORS HAVE NOT
C   BEEN INCLUDED EITHER IN EXCTS OR IN GXCTS. THESE CANCEL OUT, THUS
C   REDUCING COMPUTATIONS!
      DO 1731 K=1,L
      DO 1731 I=MYIS,MYIE
      GXCTS(I)=GXCTS(I)-EXCTS(I,K)
1731  CONTINUE
C
C   NOW SCALE THE COOLING RATE (EXCTS) BY INCLUDING THE PRESSURE
C   FACTOR (DELP) AND THE CONVERSION FACTOR (RADCON)
      DO 1741 K=1,L
      DO 1741 I=MYIS,MYIE
      EXCTS(I,K)=EXCTS(I,K)*RADCON*DELP(I,K)
1741  CONTINUE
C---THIS IS THE END OF THE EXACT CTS COMPUTATIONS; AT THIS POINT
C   EXCTS HAS ITS APPROPRIATE VALUE.
C
C*** COMPUTE APPROXIMATE CTS HEATING RATES FOR 15UM AND 9.6 UM BANDS
C     (CTSO3)
      DO 1711 K=1,L
      DO 1711 I=MYIS,MYIE
      CTMP2(I,K+1)=CO2SP(I,K+1)*CLDFAC(I,K+1,1)
      CTMP3(I,K+1)=TO3SP(I,K)*CLDFAC(I,K+1,1)
1711  CONTINUE
      DO 1701 K=1,L
      DO 1701 I=MYIS,MYIE
      CTSO3(I,K)=RADCON*DELP(I,K)*
     1     (CSOUR(I,K)*(CTMP2(I,K+1)-CTMP2(I,K)) +
     2      SORC(I,K,13)*(CTMP3(I,K+1)-CTMP3(I,K)))
1701  CONTINUE
      RETURN
      END
