    SUBROUTINE SPA88 (EXCTS   , CTSO3   , GXCTS   , SORC    , CSOUR   , CLDFAC  , TEMP    ,       &
    &                 PRESS   , VAR1    , VAR2    , P       , DELP    , DELP2   , TOTVO2  ,       &
    &                 TO3SP   , TO3SPC  , CO2SP1  , CO2SP2  , CO2SP)
!>--------------------------------------------------------------------------------------------------
!> SUBROUTINE SPA88
!>
!> SUBPROGRAM: SPA88 - COMPUTES EXACT CTS HEATING RATES AND FLUXES 
!> PROGRAMMER: ?????
!> ORG: ?????
!> DATE: ??-??-??
!>
!> ABSTRACT:
! SUBROUTINE SPA88 COMPUTES EXACT CTS HEATING RATES AND FLUXES AND CORRESPONDING CTS EMISSIVITY 
! QUANTITIES FOR H2O,CO2 AND O3.
!>
!> PROGRAM HISTORY LOG:
!> ??-??-??  ?????      - ORIGINATOR
!> 18-01-15  LUCCI      - MODERNIZATION OF THE CODE, INCLUDING:
!>                        * F77 TO F90/F95
!>                        * INDENTATION & UNIFORMIZATION CODE
!>                        * REPLACEMENT OF COMMONS BLOCK FOR MODULES
!>                        * DOCUMENTATION WITH DOXYGEN
!>                        * OPENMP FUNCTIONALITY
!>
!> INPUT ARGUMENT LIST:                                                                                                                                            
!> TEMP   -
!> PRESS  -                                        
!> VAR1   -
!> VAR2   -
!> P      -
!> DELP   -
!> DELP2  -         
!> TOTVO2 -
!> TO3SP  -
!> TO3SPC -                             
!> CO2SP1 -
!> CO2SP2 -
!> CO2SP  -                              
!> CLDFAC -                                                  
!> SKO2D  -                                                  
!> SORC   -
!> CSOUR  -                                        
!>  
!> OUTPUT ARGUMENT LIST:
!> EXCTS -
!> CTSO3 -                                       
!> GXCTS -  
!>
!> INPUT/OUTPUT ARGUMENT LIST:
!> NONE                                                 
!>        
!> USE MODULES: F77KINDS
!>              GLB_TABLE
!>              HCON
!>              MAPPINGS
!>              MPPCOM
!>              PARMETA
!>              PHYCON
!>              RNDDTA
!>              TEMPCOM
!>              TOPO
!>
!> DRIVER     : FST88
!>
!> CALLS      : -----
!>--------------------------------------------------------------------------------------------------
    USE F77KINDS
    USE GLB_TABLE
    USE HCON
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE PHYCON
    USE RNDDTA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
#include "sp.h"
!--------------------------------------------------------------------------------------------------
! PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE:
! IMAX   =  NO. POINTS ALONG THE LAT. CIRCLE USED IN CALCS.
! L      =  NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL
! NOTE: THE USER NORMALLY WILL MODIFY ONLY THE IMAX AND L PARAMETERS
! NBLW   =  NO. FREQ. BANDS FOR APPROX COMPUTATIONS. SEE BANDTA FOR DEFINITION
! NBLX   =  NO. FREQ BANDS FOR APPROX CTS COMPUTATIONS
! NBLY   =  NO. FREQ. BANDS FOR EXACT CTS COMPUTATIONS. SEE BDCOMB FOR DEFINITION
! INLTE  =  NO. LEVELS USED FOR NLTE CALCS.
! NNLTE  =  INDEX NO. OF FREQ. BAND IN NLTE CALCS.
! NB, KO2 ARE SHORTWAVE PARAMETERS; OTHER QUANTITIES ARE DERIVED FROM THE ABOVE PARAMETERS.
!--------------------------------------------------------------------------------------------------
    INTEGER(KIND=I4KIND), PARAMETER :: L      = LM
    INTEGER(KIND=I4KIND), PARAMETER :: IMAX   = IM
    INTEGER(KIND=I4KIND), PARAMETER :: NCOL   = IMAX
    INTEGER(KIND=I4KIND), PARAMETER :: NBLX   = 47
    INTEGER(KIND=I4KIND), PARAMETER :: NBLM   = NBLY  -  1
    INTEGER(KIND=I4KIND), PARAMETER :: LP1    = L     +  1
    INTEGER(KIND=I4KIND), PARAMETER :: LP2    = L     +  2 
    INTEGER(KIND=I4KIND), PARAMETER :: LP3    = L     +  3
    INTEGER(KIND=I4KIND), PARAMETER :: LM1    = L     -  1
    INTEGER(KIND=I4KIND), PARAMETER :: LM2    = L     -  2
    INTEGER(KIND=I4KIND), PARAMETER :: LM3    = L     -  3
    INTEGER(KIND=I4KIND), PARAMETER :: LL     =  2    *  L
    INTEGER(KIND=I4KIND), PARAMETER :: LLP1   = LL    +  1 
    INTEGER(KIND=I4KIND), PARAMETER :: LLP2   = LL    +  2
    INTEGER(KIND=I4KIND), PARAMETER :: LLP3   = LL    +  3
    INTEGER(KIND=I4KIND), PARAMETER :: LLM1   = LL    -  1
    INTEGER(KIND=I4KIND), PARAMETER :: LLM2   = LL    -  2
    INTEGER(KIND=I4KIND), PARAMETER :: LLM3   = LL    -  3
    INTEGER(KIND=I4KIND), PARAMETER :: LP1M   = LP1   *  LP1
    INTEGER(KIND=I4KIND), PARAMETER :: LP1M1  = LP1M  -  1 
    INTEGER(KIND=I4KIND), PARAMETER :: LP1V   = LP1   * (1 + 2 * L / 2)
    INTEGER(KIND=I4KIND), PARAMETER :: LP121  = LP1   * NBLY
    INTEGER(KIND=I4KIND), PARAMETER :: LL3P   =  3    *  L + 2
    INTEGER(KIND=I4KIND), PARAMETER :: NB     = 12
    INTEGER(KIND=I4KIND), PARAMETER :: INLTE  =  3 
    INTEGER(KIND=I4KIND), PARAMETER :: INLTEP = INLTE + 1 
    INTEGER(KIND=I4KIND), PARAMETER :: NNLTE  = 56
    INTEGER(KIND=I4KIND), PARAMETER :: LP1I   = IMAX  * LP1 
    INTEGER(KIND=I4KIND), PARAMETER :: LLP1I  = IMAX  * LLP1
    INTEGER(KIND=I4KIND), PARAMETER :: LL3PI  = IMAX  * LL3P
    INTEGER(KIND=I4KIND), PARAMETER :: NB1    = NB    - 1
    INTEGER(KIND=I4KIND), PARAMETER :: KO2    = 12
    INTEGER(KIND=I4KIND), PARAMETER :: KO21   = KO2   + 1 
    INTEGER(KIND=I4KIND), PARAMETER :: KO2M   = KO2   - 1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1, NBLY)               , INTENT(IN)          ::&
    & SORC     
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1)                     , INTENT(IN)          ::&
    & CSOUR
!   
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1, LP1)                , INTENT(IN)          ::&
    & CLDFAC               
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1)                     , INTENT(IN)          ::&
    & TEMP    , PRESS   , P       , TOTVO2  , TO3SP   , CO2SP1  , CO2SP2  , CO2SP
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, L)                       , INTENT(IN)          ::&
    & VAR1    , VAR2    , DELP    , DELP2   , TO3SPC
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, L)                       , INTENT(OUT)         ::&
    & EXCTS   , CTSO3
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2)                          , INTENT(OUT)         ::&
    & GXCTS
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, L)                                             ::&
    & PHITMP  , PSITMP  , TT      , FAC1    , FAC2    , X       , Y       , TOPM    , TOPPHI
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1)                                           ::&
    & CTMP    , CTMP2   , CTMP3    
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, L)                                             ::&
    & F       , FF      , AG      , AGG
!------------------------
! IMPLICIT NONE VARIABLES
!------------------------
    INTEGER(KIND=I4KIND)                                                                        ::&
    & I       , K 
!
    EQUIVALENCE (F , AG , PHITMP)
    EQUIVALENCE (FF, AGG, PSITMP)
!-------------------------------------------------- 
! 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 END DO
!--------------------------------------------------------------------------------------------------
! INITIALIZE CTMP(I,1),CTMP2(I,1),CTMP3(I,1) TO UNITY; THESE ARE TRANSMISSION FCTNS AT THE TOP.
!--------------------------------------------------------------------------------------------------
    DO 345 I=MYIS,MYIE
        CTMP (I,1) = ONE
        CTMP2(I,1) = 1.
        CTMP3(I,1) = 1.
    345 END DO
!---------------------------------- 
! BEGIN LOOP ON FREQUENCY BANDS (1) 
!---------------------------------- 
!
!-----------------------------------------
! CALCULATION FOR BAND 1 (COMBINED BAND 1)
!----------------------------------------- 
!
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------- 
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------- 
    DO 315 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    315 END DO
    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 END DO
    319 END DO
!----------------------------------------------- 
! 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 END DO
!--------------------------------------------------------------- 
! 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 END DO
!----------------------------------------------------------------- 
! 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)                               &
    &            + (HAF             * DELP(I,L)      * (  TT(I,LM1)    * (   P(I,LP1)             &
    &            - PRESS  (I,L))    + TT  (I,L)      * (   P(I,LP1)    + PRESS(I,L)               &
    &            - TWO              * P   (I,L))))   * (SORC(I,LP1,1)  -  SORC(I,L,1)))
    361 END DO
!----------------------------------------- 
! CALCULATION FOR BAND 2 (COMBINED BAND 2)
!----------------------------------------- 
!
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------- 
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------- 
    DO 415 I=MYIS,MYIE
        TOPM  (I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    415 END DO
    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 END DO
    419 END DO
!----------------------------------------------- 
! 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 END DO
!--------------------------------------------------------------- 
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    453 END DO
!----------------------------------------------------------------- 
! 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)            &
    &            + (HAF             *   DELP(I,L)     * (  TT(I,LM1)    * (   P(I,LP1)            &
    &            - PRESS(I,L))      +     TT(I,L)     * (   P(I,LP1)    + PRESS(I,L)              &
    &            - TWO              *      P(I,L))))  * (SORC(I,LP1, 2) -  SORC(I,L,2)))
    461 END DO
!
!----------------------------------------- 
! CALCULATION FOR BAND 3 (COMBINED BAND 3)
!----------------------------------------- 
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------- 
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------- 
    DO 515 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    515 END DO
    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 END DO
    519 END DO
!--------------------------------------------------------------------------------------------------
! 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 END DO
!--------------------------------------------------------------------------------------------------
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    553 END DO
!--------------------------------------------------------------------------------------------------
! 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)                 &
    &            + (HAF           *   DELP(I,L)      * ( TT(I,LM1) * (   P(I,LP1)                 &
    &            - PRESS(I,L))   +      TT(I,L)      * (  P(I,LP1) + PRESS(I,L)    - TWO          &
    &            *     P(I,L)))) * (  SORC(I,LP1,3)  - SORC(I,L,3)))
    561 END DO
!--------------------------------------------------------------------------------------------------
! CALCULATION FOR BAND 4 (COMBINED BAND 4)
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------------------------------------------
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------------------------------------------
    DO 615 I=MYIS,MYIE
        TOPM  (I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    615 END DO
    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 END DO
    619 END DO
!--------------------------------------------------------------------------------------------------
! 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 END DO
!--------------------------------------------------------------------------------------------------
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    653 END DO
!--------------------------------------------------------------------------------------------------
! 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)                 &
    &            + (HAF         *   DELP(I,L)     * (  TT(I,LM1)   * (   P(I,LP1)                 &
    &            - PRESS(I,L))  +     TT(I,L)     * (   P(I,LP1)   + PRESS(I,L)                   &
    &            - TWO          *      P(I,L))))  * (SORC(I,LP1,4) -  SORC(I,L,4)))
    661 END DO
!--------------------------------------------------------------------------------------------------
! CALCULATION FOR BAND 5 (COMBINED BAND 5)
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------------------------------------------
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------------------------------------------
    DO 715 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    715 END DO
    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 END DO
    719 END DO
!--------------------------------------------------------------------------------------------------
! 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))               &
    &                   + BETACM(5)     * TOTVO2(I,K+1) * SKO2D))
!            
            CTMP(I,K+1) =     TT(I,K)   * CLDFAC(I,K+1,1)
    721 END DO
!--------------------------------------------------------------------------------------------------
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    753 END DO
!--------------------------------------------------------------------------------------------------
! 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)          &
    &            + (HAF             *   DELP(I,L)      * (  TT(I,LM1)    * (   P(I,LP1)           & 
    &            - PRESS(I,L))      +     TT(I,L)      * (   P(I,LP1)    + PRESS(I,L)             &
    &            - TWO              *      P(I,L))))   * (SORC(I,LP1,5)  -  SORC(I,L,5)))
    761 END DO
!--------------------------------------------------------------------------------------------------
! CALCULATION FOR BAND 6 (COMBINED BAND 6)
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED  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 END DO
!--------------------------------------------------------------------------------------------------
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------------------------------------------
    DO 815 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    815 END DO
    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 END DO
    819 END DO
!--------------------------------------------------------------------------------------------------
! 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))                &
    &                   + BETACM(6)    * TOTVO2(I,K+1) * SKO2D))
!
            CTMP(I,K+1) =     TT(I,K)  * CLDFAC(I,K+1,1)
    821 END DO
!--------------------------------------------------------------------------------------------------
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    853 END DO
!--------------------------------------------------------------------------------------------------
! 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)                 &
    &            + ( HAF           *   DELP(I,L)     * ( TT(I,LM1) * (   P(I,LP1)                 &
    &            - PRESS(I,L))     +     TT(I,L)     * (  P(I,LP1) + PRESS(I,L)   - TWO           &
    &            *     P(I,L))))   * ( SORC(I,LP1,6) - SORC(I,L,6)))
    861 END DO
!--------------------------------------------------------------------------------------------------
! CALCULATION FOR BAND 7 (COMBINED BAND 7)
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------------------------------------------
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------------------------------------------
    DO 915 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    915 END DO
    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 END DO
    919 END DO
!--------------------------------------------------------------------------------------------------
! 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))               &
    &                    + BETACM(7)    * TOTVO2(I,K+1) * SKO2D))
!
            CTMP(I,K+1) =      TT(I,K)  * CLDFAC(I,K+1,1)
    921 END DO
!--------------------------------------------------------------------------------------------------
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    953 END DO
!--------------------------------------------------------------------------------------------------
! 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)                 & 
    &            + (HAF         *   DELP(I,L)     * (  TT(I,LM1)   * (   P(I,LP1)                 &
    &            - PRESS(I,L))  +     TT(I,L)     * (   P(I,LP1)   + PRESS(I,L)                   &
    &            - TWO          *      P(I,L))))  * (SORC(I,LP1,7) -  SORC(I,L,7)))
    961 END DO
!--------------------------------------------------------------------------------------------------
! CALCULATION FOR BAND 8 (COMBINED BAND 8)
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------------------------------------------
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------------------------------------------
    DO 1015 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    1015 END DO
    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 END DO
    1019 END DO
!--------------------------------------------------------------------------------------------------
! 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))                &
    &                   + BETACM(8)    * TOTVO2(I,K+1) * SKO2D))
!
            CTMP(I,K+1) =     TT(I,K)  * CLDFAC(I,K+1,1)
    1021 END DO
!--------------------------------------------------------------------------------------------------
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    1053 END DO
!--------------------------------------------------------------------------------------------------
! 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)                & 
    &            + (HAF        *   DELP(I,L)      * (  TT(I,LM1)    * (   P(I,LP1)                & 
    &            - PRESS(I,L)) +     TT(I,L)      * (   P(I,LP1)    + PRESS(I,L)                  &
    &            - TWO         *      P(I,L))))   * (SORC(I,LP1,8)  -  SORC(I,L,8)))
1061 END DO
!--------------------------------------------------------------------------------------------------
! CALCULATION FOR BAND 9 ( 560-670 CM-1; INCLUDES CO2)
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------------------------------------------
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------------------------------------------
    DO 1115 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    1115 END DO
    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 END DO
    1119 END DO
!--------------------------------------------------------------------------------------------------
! 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))                &
    &                   + BETACM(9)    * TOTVO2(I,K+1) * SKO2D))    * CO2SP1(I,K+1)
!            
            CTMP(I,K+1) =     TT(I,K)  * CLDFAC(I,K+1,1)
    1121 END DO
!--------------------------------------------------------------------------------------------------
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    1153 END DO
!--------------------------------------------------------------------------------------------------
! 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)               &
    &            + (HAF         *   DELP(I,L)      * (  TT(I,LM1)    * (   P(I,LP1)               &
    &            - PRESS(I,L))  +     TT(I,L)      * (   P(I,LP1)    + PRESS(I,L)                 & 
    &            - TWO          *      P(I,L))))   * (SORC(I,LP1,9)  -  SORC(I,L,9)))
1161 END DO
!--------------------------------------------------------------------------------------------------
! CALCULATION FOR BAND 10 (670-800 CM-1; INCLUDES CO2)
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------------------------------------------
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------------------------------------------
    DO 1215 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    1215 END DO
    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 END DO
    1219 END DO
!---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))                   &
    &                  + BETACM(10)  * TOTVO2(I,K+1) * SKO2D))   * CO2SP2(I,K+1)
!              
            CTMP(I,K+1)=TT(I,K)*CLDFAC(I,K+1,1)
    1221 END DO
!--------------------------------------------------------------- 
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    1253 END DO
!----------------------------------------------------------------- 
! 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)                &
    &             +(HAF        *   DELP(I,L)     * (  TT(I,LM1)    * (   P(I,LP1)                 &
    &             -PRESS(I,L)) +     TT(I,L)     * (   P(I,LP1)    + PRESS(I,L)                   &
    &             -TWO         *      P(I,L))))  * (SORC(I,LP1,10) -  SORC(I,L,10)))
1261 END DO
!--------------------------------------- 
! CALCULATION FOR BAND 11 (800-900 CM-1)
!--------------------------------------- 
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------- 
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------- 
    DO 1315 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    1315 END DO
    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 END DO
    1319 END DO
!----------------------------------------------- 
! 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))                 &
    &                 + BETACM(11)    * TOTVO2(I,K+1) * SKO2D))
!              
            CTMP(I,K+1) =   TT(I,K)   * CLDFAC(I,K+1,1)
    1321 END DO
!--------------------------------------------------------------- 
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    1353 END DO
!----------------------------------------------------------------- 
! 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)                &
    &            + (HAF        *   DELP(I,L)     * (  TT(I,LM1)    * (   P(I,LP1)                 &
    &            - PRESS(I,L)) +     TT(I,L)     * (   P(I,LP1)    + PRESS(I,L)                   &
    &            - TWO         *      P(I,L))))  * (SORC(I,LP1,11) -  SORC(I,L,11)))
1361 END DO
!--------------------------------------- 
! CALCULATION FOR BAND 12 (900-990 CM-1)
!--------------------------------------- 
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO 
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------- 
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------- 
    DO 1415 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    1415 END DO
    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 END DO
    1419 END DO
!----------------------------------------------- 
! 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))                &
    &                   + BETACM(12)   * TOTVO2(I,K+1) * SKO2D))
!              
            CTMP(I,K+1) =     TT(I,K)  * CLDFAC(I,K+1,1)
    1421 END DO
!----------------------------------------------------------------- 
!---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) * (CTMP(I,K+1) - CTMP(I,K))
    1453 END DO
!---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)                 &
    &            + (HAF        *   DELP(I,L)     * (  TT(I,LM1)    * (  P(I,LP1)                  &
    &            - PRESS(I,L)) +     TT(I,L)     * (   P(I,LP1)    + PRESS(I,L)                   &
    &            - TWO         *      P(I,L))))  * (SORC(I,LP1,12) -  SORC(I,L,12)))
1461 END DO
!------------------------------------------------------ 
! CALCULATION FOR BAND 13 (990-1070 CM-1; INCLUDES O3))
!------------------------------------------------------ 
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO  
! COMPUTE TEMPERATURE-CORRECTED !   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 END DO
!--------------------------------------------------------------- 
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------- 
    DO 1515 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    1515 END DO
    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 END DO
    1519 END DO
!------------------------------------------------- 
!---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))                  &
    &                   + BETACM(13)   * TOTVO2(I,K+1) * SKO2D      + TO3SPC(I,K)))
!              
            CTMP(I,K+1) =     TT(I,K)  * CLDFAC(I,K+1,1)
    1521 END DO
!----------------------------------------------------------------- 
!---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) * (CTMP(I,K+1) - CTMP(I,K))
    1553 END DO
!------------------------------------------------------------------- 
!---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)                & 
    &            + (HAF        *   DELP(I,L)     * (  TT(I,LM1)    * (   P(I,LP1)                 &
    &            - PRESS(I,L)) +     TT(I,L)     * (   P(I,LP1)    + PRESS(I,L)                   &
    &            - TWO         *      P(I,L))))  * (SORC(I,LP1,13) -  SORC(I,L,13)))
1561 END DO
!----------------------------------------- 
! CALCULATION FOR BAND 14 (1070-1200 CM-1)
!----------------------------------------- 
!--------------------------------------------------------------------------------------------------
! OBTAIN TEMPERATURE CORRECTION (CAPPHI,CAPPSI),THEN MULTIPLY BY OPTICAL PATH (VAR1,VAR2) TO  
! COMPUTE TEMPERATURE-CORRECTED 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 END DO
!--------------------------------------------------------------- 
! OBTAIN OPTICAL PATH,MEAN PRESSURE FROM THE TOP TO THE PRESSURE
! P(K) (TOPM,TOPPHI)
!--------------------------------------------------------------- 
    DO 1615 I=MYIS,MYIE
          TOPM(I,1) = PHITMP(I,1)
        TOPPHI(I,1) = PSITMP(I,1)
    1615 END DO
    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 END DO
    1619 END DO
!----------------------------------------------- 
! 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))                &
    &                   + BETACM(14)   * TOTVO2(I,K+1) * SKO2D))
!              
            CTMP(I,K+1) =     TT(I,K)  * CLDFAC(I,K+1,1)
    1621 END DO
!--------------------------------------------------------------- 
! 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) * (CTMP(I,K+1) - CTMP(I,K))
    1653 END DO
!----------------------------------------------------------------- 
! 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)                &
    &            + (HAF        *   DELP(I,L)     * (  TT(I,LM1)    * (   P(I,LP1)                 &
    &            - PRESS(I,L)) +     TT(I,L)     * (   P(I,LP1)    + PRESS(I,L)                   &
    &            - TWO         *      P(I,L))))  * (SORC(I,LP1,14) -  SORC(I,L,14)))
1661 END DO
!--------------------------------------------------------------------------------------------------
! OBTAIN CTS FLUX AT THE TOP BY INTEGRATION OF HEATING RATES AND USING CTS FLUX AT THE BOTTOM  
! (CURRENT VALUE OF GXCTS). NOTE THAT THE PRESSURE QUANTITIES AND CONVERSION FACTORS HAVE NOT
! BEEN INCLUDED EITHER IN EXCTS OR IN GXCTS. THESE CANCEL OUT, THUS REDUCING COMPUTATIONS
!--------------------------------------------------------------------------------------------------
    DO 1731 K=1,L
        DO 1731 I=MYIS,MYIE
            GXCTS(I) = GXCTS(I) - EXCTS(I,K)
1731 END DO
!--------------------------------------------------------------------------------------------------
! NOW SCALE THE COOLING RATE (EXCTS) BY INCLUDING THE PRESSURE 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 END DO
!---------------------------------------------------------------------------------------------- 
! THIS IS THE END OF THE EXACT CTS COMPUTATIONS; AT THIS POINT EXCTS HAS ITS APPROPRIATE VALUE.
!---------------------------------------------------------------------------------------------- 
!------------------------------------------------------------------------ 
! COMPUTE APPROXIMATE CTS HEATING RATES FOR 15UM AND 9.6 UM BANDS (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 END DO
    DO 1701 K=1,L
        DO 1701 I=MYIS,MYIE
           CTSO3(I,K) = RADCON       *   DELP(I,K)   * (CSOUR(I,K) * (CTMP2(I,K+1) - CTMP2(I,K))  &
    &                 + SORC(I,K,13) * (CTMP3(I,K+1) -  CTMP3(I,K)))
    1701 END DO
!
    RETURN
!
    END SUBROUTINE SPA88
