SUBROUTINE e3v88(emv,tv,av)
  !
  ! $Author: CPTEC $
  ! $Date: 2000/02/24 13:15:43 $
  ! $Revision: 1.0 $
  !
  !subroutine e3v88 computes nearby layer transmissivities for
  !h2o using a table lookup of the pre-computed e3 function
  !(described in ref. (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(in),DIMENSION(imax,llp1)     :: tv
  REAL, INTENT(in out),DIMENSION(imax,llp1) :: av
  REAL, INTENT(out),DIMENSION(imax,llp1)    :: emv

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

  INTEGER,DIMENSION(imax,llp1) :: it
  REAL,DIMENSION(imax,llp1) :: ww1,dt,ww2,du,fxo,fyo,tmp3
  REAL,DIMENSION(5040) :: em3v

  EQUIVALENCE (em3v(1),em3(1,1))
  EQUIVALENCE (fxo,ww1),(fyo,ww2),(it,tmp3)

  INTEGER :: i

  !the following loop replaces a double loop over i (1-imax) and
  !k (1-llp1)

  DO  i=1,imax*llp1
     fxo(i,1)=AINT(tv(i,1)*hp1)
     tmp3(i,1)=LOG10(av(i,1))+h16e1
     dt(i,1)=tv(i,1)-ten*fxo(i,1)
     fyo(i,1)=AINT(tmp3(i,1)*ten)
     du(i,1)=tmp3(i,1)-hp1*fyo(i,1)
     !obtain index for table lookup; this value will have to be
     !decremented by 9 to account for table temps starting at 100k.
     it(i,1)=fxo(i,1)+fyo(i,1)*h28e1
     ww1(i,1)=ten-dt(i,1)
     ww2(i,1)=hp1-du(i,1)
     emv(i,1)=ww1(i,1)*ww2(i,1)*em3v(it(i,1)-9)+  &
          ww2(i,1)*dt(i,1)*em3v(it(i,1)-8)+ &
          ww1(i,1)*du(i,1)*em3v(it(i,1)+19)+  &
          dt(i,1)*du(i,1)*em3v(it(i,1)+20)
  END DO
END SUBROUTINE e3v88
