SUBROUTINE e1e290(g1,g2,g3,g4,g5,emiss,fxoe1,dte1,fxoe2,dte2,avephi,temp,t)
  !
  ! $Author: CPTEC $
  ! $Date: 2000/02/24 13:15:43 $
  ! $Revision: 1.0 $
  !
  !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).
  IMPLICIT NONE

  INCLUDE "parmeta.f90"

  INTEGER,PARAMETER :: l=lm,imax=2*im-1,ncol=imax,nblw=163,nblx=47,nbly=15
  INTEGER,PARAMETER :: nblm=nbly-1,lp1=l+1,lp2=l+2,lp3=l+3,lm1=l-1,lm2=l-2
  INTEGER,PARAMETER :: lm3=l-3,ll=2*l,llp1=ll+1,llp2=ll+2,llp3=ll+3,llm1=ll-1
  INTEGER,PARAMETER :: llm2=ll-2,llm3=ll-3,lp1m=lp1*lp1,lp1m1=lp1m-1
  INTEGER,PARAMETER :: lp1v=lp1*(1+2*l/2),lp121=lp1*nbly,ll3p=3*l+2,nb=12
  INTEGER,PARAMETER :: inlte=3,inltep=inlte+1,nnlte=56,lp1i=imax*lp1
  INTEGER,PARAMETER :: llp1i=imax*llp1,ll3pi=imax*ll3p,nb1=nb-1,ko2=12
  INTEGER,PARAMETER :: ko21=ko2+1,ko2m=ko2-1

  REAL,INTENT(out),DIMENSION(imax,lp1)    :: g1,g3,g4,emiss
  REAL,INTENT(out),DIMENSION(imax,l)      :: g2,g5
  REAL,INTENT(in),DIMENSION(imax,lp1)     :: fxoe1,dte1,fxoe2
  REAL,INTENT(in out),DIMENSION(imax,lp1) :: dte2,avephi,temp,t

  INCLUDE "hcon.f90" 
  INCLUDE "tabcom.f90"

  INTEGER,DIMENSION(imax,ll3p) :: it1
  INTEGER,DIMENSION(imax,lp1)  :: ival
  REAL,DIMENSION(imax,lp1) :: fyo,du,ww1,ww2,tmp3
  REAL,DIMENSION(5040) :: t1,t2,t4,em1v,em1vw

  EQUIVALENCE (em1v(1),em1(1,1)),(em1vw(1),em1wde(1,1))
  EQUIVALENCE (t1(1),table1(1,1)),(t2(1),table2(1,1)), (t4(1),table3(1,1))

  INTEGER i,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 fromi=1,imax and kp=2,lp1 plus
  !the special case for the lp1th layer.
  DO  i=1,imax*lp1
     tmp3(i,1)=LOG10(avephi(i,1))+h16e1
     fyo(i,1)=AINT(tmp3(i,1)*ten)
     du(i,1)=tmp3(i,1)-hp1*fyo(i,1)
     fyo(i,1)=h28e1*fyo(i,1)
     ival(i,1)=fyo(i,1)+fxoe2(i,1)
     emiss(i,1)=t1(ival(i,1))+du(i,1)*t2(ival(i,1)) +dte2(i,1)*t4(ival(i,1))
  END DO

  !the special case emiss(i,l) (layer kp) is obtained now
  !by averaging the values for l and lp1:
  DO  i=1,imax
     emiss(i,l)=haf*(emiss(i,l)+emiss(i,lp1))
  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  i=1,imax
     it1(i,1)=fxoe1(i,1)
     ww1(i,1)=ten-dte1(i,1)
     ww2(i,1)=hp1
  END DO
  DO  i=1,imax*l
     it1(i,2)=fyo(i,1)+fxoe1(i,2)
     it1(i,lp2)=fyo(i,1)+fxoe1(i,1)
     ww1(i,2)=ten-dte1(i,2)
     ww2(i,2)=hp1-du(i,1)
  END DO
  DO  kp=1,l
     DO  i=1,imax
        it1(i,kp+llp1)=fyo(i,kp)+fxoe1(i,1)
     END DO
  END DO

  !g3(i,1) has the same values as g1 (and did all along)
  DO  i=1,imax
     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)
  END DO
  DO  i=1,imax*l
     g1(i,2)=ww1(i,2)*ww2(i,2)*em1v(it1(i,2))+  &
          ww2(i,2)*dte1(i,2)*em1v(it1(i,2)+1)+ &
          ww1(i,2)*du(i,1)*em1v(it1(i,2)+28)+  &
          dte1(i,2)*du(i,1)*em1v(it1(i,2)+29)
     g2(i,1)=ww1(i,1)*ww2(i,2)*em1v(it1(i,lp2))+  &
          ww2(i,2)*dte1(i,1)*em1v(it1(i,lp2)+1)+  &
          ww1(i,1)*du(i,1)*em1v(it1(i,lp2)+28)+ &
          dte1(i,1)*du(i,1)*em1v(it1(i,lp2)+29)
  END DO
  DO  kp=2,lp1
     DO  i=1,imax
        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)
     END DO
  END DO

  DO  i=1,imax
     g4(i,1)=ww1(i,1)*ww2(i,1)*em1vw(it1(i,1))+  &
          ww2(i,1)*dte1(i,1)*em1vw(it1(i,1)+1)
  END DO
  DO  i=1,imax*l
     g4(i,2)=ww1(i,2)*ww2(i,2)*em1vw(it1(i,2))+  &
          ww2(i,2)*dte1(i,2)*em1vw(it1(i,2)+1)+  &
          ww1(i,2)*du(i,1)*em1vw(it1(i,2)+28)+ &
          dte1(i,2)*du(i,1)*em1vw(it1(i,2)+29)
     g5(i,1)=ww1(i,1)*ww2(i,2)*em1vw(it1(i,lp2))+  &
          ww2(i,2)*dte1(i,1)*em1vw(it1(i,lp2)+1)+  &
          ww1(i,1)*du(i,1)*em1vw(it1(i,lp2)+28)+  &
          dte1(i,1)*du(i,1)*em1vw(it1(i,lp2)+29)
  END DO
END SUBROUTINE e1e290
