    SUBROUTINE E1E290(G1, G2, G3, G4, G5, EMISS, FXOE1, DTE1, FXOE2, DTE2, AVEPHI, TEMP, T)
!--------------------------------------------------------------------------------------------------
!> SUBROUTINE E1E290
!>
!> SUBPROGRAM: E1E290 - ?????
!> PROGRAMMER: ?????
!> ORG: ?????
!> DATE: ??-??-??
!>
!> ABSTRACT:
!> SUBROUTINE E1E290 COMPUTES THE EXCHANGE TERMS IN THE FLUX EQUATION FOR LONGWAVE RADIATION FOR ALL
!> TERMS EXCEPT THE EXCHANGE WITH THE TOP OF THE ATMOSPHERE.
!> THE METHOD IS A TABLE LOOKUP ON A PRE-COMPUTED E2 FUNCTION (DEFINED IN REF. (4)).
!> THE E1 FUNCTION  CALCULATIONS (FORMERLY DONE IN SUBROUTINE E1V88 COMPUTE THE FLUX RESULTING FROM
!> THE EXCHANGE OF PHOTONS BETWEEN A LAYER AND THE TOP OF THE ATMOSPHERE.
!> THE METHOD IS A TABLE LOOKUP ON A PRE-COMPUTED E1 FUNCTION.
!> CALCULATIONS ARE DONE IN TWO FREQUENCY RANGES:
!> 1)   0-560, 1200-2200 CM-1   FOR Q(APPROX)
!> 2) 160-560            CM-1   FOR Q(APPROX,CTS).
!> MOTIVATION FOR THESE CALCULATIONS IS IN REFERENCES (1) AND (4).
!>
!> 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:
!> FXOE1  - 
!> FXOE2  - 
!> DTE1   - 
!> DTE2   - 
!> AVEPHI - 
!> TEMP   - 
!> T      - 
!>
!> OUTPUT ARGUMENT LIST:
!> G1     -
!> G2     - 
!> G3     - 
!> G4     - 
!> G5     - 
!>
!> INPUT/OUTPUT ARGUMENT LIST:
!> EMISS  - 
!>
!> USE MODULES: F77KINDS 
!>              GLB_TABLE
!>              HCON
!>              MAPPINGS
!>              MPPCOM
!>              PARMETA
!>              PHYCON
!>              TABCOM
!>              TEMPCOM
!>              TOPO
!>
!> DRIVER     : FST88
!>
!> CALLS      : -----
!>--------------------------------------------------------------------------------------------------
    USE F77KINDS
    USE GLB_TABLE
    USE HCON
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE PHYCON
    USE TABCOM
    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 :: NCOL   = IMAX
    INTEGER(KIND=I4KIND), PARAMETER :: NBLW   = 163
    INTEGER(KIND=I4KIND), PARAMETER :: NBLX   = 47
    INTEGER(KIND=I4KIND), PARAMETER :: NBLM   = NBLY  - 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 :: 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
!--------------------------------------------------------------------------------------------------
! PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE:
! IMAX   =  NO. POINTS SENT TO RADFS
! 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.
!
! COMMON BLOCK TABCOM CONTAINS QUANTITIES PRECOMPUTED IN SUBROUTINE
! TABLE FOR USE IN THE LONGWAVE RADIATION PROGRAM:
! EM1     =  E1 FUNCTION, EVALUATED OVER THE 0-560 AND 1200-2200 CM-1 INTERVALS
! EM1WDE  =  E1 FUNCTION, EVALUATED OVER THE 160-560 CM-1 INTERVAL
! TABLE1  =  E2 FUNCTION, EVALUATED OVER THE 0-560 AND 1200-2200 CM-1 INTERVALS
! TABLE2  =  TEMPERATURE DERIVATIVE OF TABLE1
! TABLE3  =  MASS DERIVATIVE OF TABLE1
! EM3     =  E3 FUNCTION, EVALUATED OVER THE 0-560 AND 1200-2200 CM-1 INTERVALS
! SOURCE  =  PLANCK FUNCTION, EVALUATED AT SPECIFIED TEMPS. FOR BANDS USED IN CTS CALCULATIONS
! DSRCE   =  TEMPERATURE DERIVATIVE OF SOURCE
! IND     =  INDEX, WITH VALUE IND(I)=I. USED IN FST88
! INDX2   =  INDEX VALUES USED IN OBTAINING "LOWER TRIANGLE" ELEMENTS OF AVEPHI,ETC., IN FST88
! KMAXV   =  INDEX VALUES USED IN OBTAINING "UPPER TRIANGLE" ELEMENTS OF AVEPHI,ETC.,IN FST88
! KMAXVM  =  KMAXV(L),USED FOR DO LOOP INDICES
!--------------------------------------------------------------------------------------------------
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1)                     , INTENT(IN)          ::&
    & TEMP    , T       , AVEPHI  
!
    INTEGER(KIND=I4KIND), DIMENSION(IDIM1:IDIM2, LL3P)                                          ::&
    & IT1 
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1)                                           ::&
    & FYO     ,                                                                                   &
    & DU      , WW1     ,  WW2    ,                                                               &
    & TMP3    
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1)                     , INTENT(INOUT)       ::&
    & EMISS
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2)                                                ::&
    & TMP5    , TMP9
!
    INTEGER(KIND=I4KIND), DIMENSION(IDIM1:IDIM2, LP1)                                           ::&
    & IVAL
!------------------------------- 
! VARIABLES IN THE ARGUMENT LIST
!------------------------------- 
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1)                     , INTENT(IN)          ::&
    & FXOE1   , DTE1    ,                                                                         &
    & FXOE2   , DTE2
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1)                     , INTENT(INOUT)       ::&
    & G1      , G3      , G4
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, L)                       , INTENT(OUT)         ::&
    & G2      , G5
!------------------------
! IMPLICIT NONE VARIABLES
!------------------------
    INTEGER(KIND=I4KIND)                                                                        ::&
    & I       , K       , KP 
!--------------------------------------------------------------------------------------------------
! FIRST WE OBTAIN THE EMISSIVITIES AS A FUNCTION OF TEMPERATURE (INDEX FXO) AND WATER AMOUNT 
! (INDEX FYO). 
! THIS PART OF THE CODE THUS GENERATES THE E2 FUNCTION. THE FXO INDICES HAVE BEEN OBTAINED IN FST88
! FOR CONVENIENCE.
!
! THIS SUBROUTINE EVALUATES THE K=1 CASE ONLY
!
! THIS LOOP REPLACES LOOPS GOING FROM I=1,IMAX AND KP=2,LP1 
! PLUS THE SPECIAL CASE FOR THE LP1TH LAYER
!--------------------------------------------------------------------------------------------------
    DO 132 K=1,LP1
        DO 132 I=MYIS,MYIE
            TMP3 (I,K) = LOG10(AVEPHI(I,K)) + H16E1
            FYO  (I,K) = AINT(TMP3(I,K) * TEN)
            DU   (I,K) = TMP3(I,K) - HP1 * FYO(I,K)
            FYO  (I,K) = H28E1 * FYO(I,K)
            IVAL (I,K) = FYO(I,K) + FXOE2(I,K)
            EMISS(I,K) = T1(IVAL(I,K)) + DU(I,K) * T2(IVAL(I,K)) + DTE2(I,K) * T4(IVAL(I,K))
132 END DO
!--------------------------------------------------------------------------------------------------
! THE SPECIAL CASE EMISS(I,L) (LAYER KP) IS OBTAINED NOW BY AVERAGING THE VALUES FOR L AND LP1:
!--------------------------------------------------------------------------------------------------
    DO 134 I=MYIS,MYIE
        EMISS(I,L) = HAF * (EMISS(I,L) + EMISS(I,LP1))
134 END DO
!--------------------------------------------------------------------------------------------------
! CALCULATIONS FOR THE KP=1 LAYER ARE NOT PERFORMED, AS THE RADIATION CODE ASSUMES THAT THE TOP 
! FLUX LAYER (ABOVE THE TOP DATA LEVEL) IS ISOTHERMAL, AND HENCE CONTRIBUTES NOTHING TO THE FLUXES 
! AT OTHER LEVELS.
!
! THE FOLLOWING IS THE CALCULATION FOR THE E1 FUNCTION, FORMERLY DONE IN SUBROUTINE E1V88. 
! THE MOVE TO E1E288 IS DUE TO THE SAVINGS IN OBTAINING INDEX VALUES (THE TEMP. INDICES HAVE BEEN 
! OBTAINED IN FST88, WHILE THE U-INDICES ARE OBTAINED IN THE E2 CALCS., WITH K=1).
!
! FOR TERMS INVOLVING TOP LAYER, DU IS NOT KNOWN; IN FACT, WE USE INDEX 2 TO REPERSENT INDEX 1 IN 
! PREV. CODE. THIS MEANS THAT THE IT1 INDEX 1 AND LLP1 HAS TO BE CALCULATED SEPARATELY. 
! THE INDEX LLP2 GIVES THE SAME VALUE AS 1; IT CAN BE OMITTED.
!--------------------------------------------------------------------------------------------------
    DO 208 I=MYIS,MYIE
        IT1(I,1) = FXOE1(I,1)
        WW1(I,1) = TEN - DTE1(I,1)
        WW2(I,1) = HP1
208 END DO
!
    DO 209 K=1,L
        DO 209 I=MYIS,MYIE
            IT1(I,K+1)     = FYO(I,K) + FXOE1(I,K+1)
            IT1(I,LP2+K-1) = FYO(I,K) + FXOE1(I,K)
            WW1(I,K+1)     = TEN - DTE1(I,K+1)
            WW2(I,K+1)     = HP1 - DU(I,K)
209 END DO
!
    DO 211 KP=1,L
        DO 211 I=MYIS,MYIE
            IT1(I,KP+LLP1) = FYO(I,KP) + FXOE1(I,1)
211 END DO
!------------------------------------------------------ 
! G3(I,1) HAS THE SAME VALUES AS G1 (AND DID ALL ALONG)
!------------------------------------------------------ 
    DO 230 I=MYIS,MYIE
        G1(I,1) = WW1(I,1) * WW2(I,1) * EM1V(IT1(I,1)) + WW2(I,1) * DTE1(I,1) * EM1V(IT1(I,1)+1)
        G3(I,1) =  G1(I,1)
230 END DO
!
    DO 240 K=1,L
        DO 240 I=MYIS,MYIE
            G1(I,K+1)  =  WW1(I,K+1) *  WW2(I,K+1)  *  EM1V(IT1(I,K+1))                           &
    &                  +  WW2(I,K+1) * DTE1(I,K+1)  *  EM1V(IT1(I,K+1) +  1)                      &
    &                  +  WW1(I,K+1) *   DU(I,K)    *  EM1V(IT1(I,K+1) + 28)                      &
    &                  + DTE1(I,K+1) *   DU(I,K)    *  EM1V(IT1(I,K+1) + 29)
!
            G2(I,K)   =   WW1(I,K)   *  WW2(I,K+1)  *  EM1V(IT1(I,K+LP2-1))                       &
    &                 +   WW2(I,K+1) * DTE1(I,K)    *  EM1V(IT1(I,K+LP2-1) +  1)                  &
    &                 +   WW1(I,K)   *   DU(I,K)    *  EM1V(IT1(I,K+LP2-1) + 28)                  &
    &                 +  DTE1(I,K)   *   DU(I,K)    *  EM1V(IT1(I,K+LP2-1) + 29)
240 END DO
!
    DO 241 KP=2,LP1
        DO 241 I=MYIS,MYIE
            G3(I,KP)  =   WW1(I,1)   *  WW2(I,KP)   *  EM1V(IT1(I,LL+KP))                         &
    &                 +   WW2(I,KP)  * DTE1(I,1)    *  EM1V(IT1(I,LL+KP) +  1)                    &
    &                 +   WW1(I,1)   *   DU(I,KP-1) *  EM1V(IT1(I,LL+KP) + 28)                    &
    &                 +  DTE1(I,1)   *   DU(I,KP-1) *  EM1V(IT1(I,LL+KP) + 29)
241 END DO
!
    DO 244 I=MYIS,MYIE
        G4(I,1) = WW1(I,1) * WW2(I,1) * EM1VW(IT1(I,1)) + WW2(I,1) * DTE1(I,1) * EM1VW(IT1(I,1)+1)
244 END DO
!
    DO 242 K=1,L
        DO 242 I=MYIS,MYIE
            G4(I,K+1) =   WW1(I,K+1) *  WW2(I,K+1)  *  EM1VW(IT1(I,K+1))                          &
    &                 +   WW2(I,K+1) * DTE1(I,K+1)  *  EM1VW(IT1(I,K+1) +  1)                     &
    &                 +   WW1(I,K+1) *   DU(I,K)    *  EM1VW(IT1(I,K+1) + 28)                     &
    &                 +  DTE1(I,K+1) *   DU(I,K)    *  EM1VW(IT1(I,K+1) + 29)
!
            G5(I,K)   =   WW1(I,K)   *  WW2(I,K+1)  *  EM1VW(IT1(I,K+LP2-1))                      &
    &                 +   WW2(I,K+1) * DTE1(I,K)    *  EM1VW(IT1(I,K+LP2-1) +  1)                 &
    &                 +   WW1(I,K)   *   DU(I,K)    *  EM1VW(IT1(I,K+LP2-1) + 28)                 &
    &                 +  DTE1(I,K)   *   DU(I,K)    *  EM1VW(IT1(I,K+LP2-1) + 29)
242 END DO
!
    RETURN
!
    END SUBROUTINE E1E290
