SUBROUTINE e290(emissb,emiss,avephi,klen,fxoe2,dte2)
  !
  ! $Author: CPTEC $
  ! $Date: 2000/02/24 13:15:43 $
  ! $Revision: 1.0 $
  !
  !subroutine e290 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)).
  !calculations are done in the frequency range:
  !  1) 0-560,1200-2200 cm-1   for q(approx)
  !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
  INTEGER,PARAMETER :: nnlte=56,lp1i=imax*lp1,llp1i=imax*llp1, ll3pi=imax*ll3p
  INTEGER,PARAMETER :: nb1=nb-1,ko2=12,ko21=ko2+1,ko2m=ko2-1

  INTEGER,INTENT(in)                     :: klen
  REAL,INTENT(in),DIMENSION(imax,lp1)   :: fxoe2,dte2
  REAL,INTENT(out),DIMENSION (imax,lp1) :: emissb,emiss
  REAL,INTENT(in out)                    :: avephi(imax,lp1)

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

  INTEGER,DIMENSION(imax,lp1) :: ival
  REAL,DIMENSION(imax,lp1) :: dt,fyo,du,tmp3 
  REAL,DIMENSION(5040) :: t1,t2,t4

  EQUIVALENCE (tmp3,dt)
  EQUIVALENCE (t1(1),table1(1,1)),(t2(1),table2(1,1)), (t4(1),table3(1,1))

  INTEGER :: i,k

  !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.
  !calculations for varying kp (from kp=k+1 to lp1, including special
  !case: results are in emiss

  DO  i=1,imax*(lp2-klen)
     tmp3(i,1)=LOG10(avephi(i,klen))+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,klen)
     emiss(i,klen)=t1(ival(i,1))+du(i,1)*t2(ival(i,1))  &
          +dte2(i,klen)*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

  !note that emiss(i,lp1) is not useful after this point.
  !calculations for kp=klen and varying k; results are in emissb.
  !in this case, the temperature index is unchanged, always being
  !fxo(i,klen-1); the water index changes, but is symmetrical with
  !that for the varying kp case.note that the special case is not
  !involved here.
  !(fixed level) k varies from (klen+1) to lp1; results are in
  !emissb(i,(klen) to l)

  DO  k=1,lp1-klen
     DO  i=1,imax
        dt(i,k)=dte2(i,klen-1)
        ival(i,k)=fyo(i,k)+fxoe2(i,klen-1)
     END DO
  END DO

  DO  i=1,imax*(lp1-klen)
     emissb(i,klen)=t1(ival(i,1))+du(i,1)*t2(ival(i,1)) +dt(i,1)*t4(ival(i,1))
  END DO
END SUBROUTINE e290
