SUBROUTINE ttblex (tref, ttbl, itb, jtb, knum, iarr, jarr, &
     pdsl, aetal, html, pt, pl, qq, pp, rdp, the0, &
     sthe, rdthe, thesp, iptb, ithtb)
  !
  ! $Author: CPTEC $
  ! $Date: 2000/02/24 13:15:43 $
  ! $Revision: 1.0 $
  !

  !*** extract temperature of the moist adiabat from
  !*** the appropriate ttbl

  IMPLICIT NONE
  INCLUDE "parmeta.f90"
  INTEGER, PARAMETER :: imjm=im*jm-jm/2
  INTEGER, PARAMETER :: imxjm=im*jm
  REAL   , DIMENSION(im,jm)        , INTENT(OUT) :: tref
  INTEGER,                           INTENT(IN ) :: itb 
  INTEGER,                           INTENT(IN ) :: jtb 
  REAL   , DIMENSION(jtb,itb)      , INTENT(IN ) :: ttbl
  INTEGER,                           INTENT(IN ) :: knum
  INTEGER, DIMENSION(imxjm)        , INTENT(IN ) :: iarr
  INTEGER, DIMENSION(imxjm)        , INTENT(IN ) :: jarr
  REAL   , DIMENSION(im,jm)        , INTENT(IN ) :: pdsl
  REAL   ,                           INTENT(IN ) :: aetal
  REAL   , DIMENSION(0:im+1,0:jm+1), INTENT(IN ) :: html
  REAL   ,                           INTENT(IN ) :: pt
  REAL   ,                           INTENT(IN ) :: pl
  REAL   , DIMENSION(im,jm)        , INTENT(OUT) :: qq
  REAL   , DIMENSION(im,jm)        , INTENT(OUT) :: pp
  REAL   ,                           INTENT(IN ) :: rdp
  REAL   , DIMENSION(itb)          , INTENT(IN ) :: the0
  REAL   , DIMENSION(itb)          , INTENT(IN ) :: sthe
  REAL   ,                           INTENT(IN ) :: rdthe
  REAL   , DIMENSION(im,jm)        , INTENT(IN ) :: thesp
  INTEGER, DIMENSION(im,jm)        , INTENT(OUT) :: iptb
  INTEGER, DIMENSION(im,jm)        , INTENT(OUT) :: ithtb

  INTEGER :: kk,i,j,iptbk,ith,ip
  REAL    :: pk,tpk,bthe00k,bthe10k,sthe00k,sthe10k,bthk,sthk
  REAL    :: tthk,t00k,t10k,t01k,t11k

!CDIR NODEP
  DO kk=1,knum

     !*** scaling pressure & tt table index

     i=iarr(kk)
     j=jarr(kk)
     pk=pdsl(i,j)*aetal+pt
     tpk=(pk-pl)*rdp
     qq(i,j)=tpk-AINT(tpk)
     iptb(i,j)=INT(tpk)+1

     !*** keeping indices within the table

     IF(iptb(i,j).LT.1)THEN
        iptb(i,j)=1
        qq(i,j)=0.
     ENDIF
     IF(iptb(i,j).GE.itb)THEN
        iptb(i,j)=itb-1
        qq(i,j)=0.
     ENDIF

     !*** base and scaling factor for the

     iptbk=iptb(i,j)
     bthe00k=the0(iptbk)
     sthe00k=sthe(iptbk)
     bthe10k=the0(iptbk+1)
     sthe10k=sthe(iptbk+1)

     !*** scaling the & tt table index

     bthk=(bthe10k-bthe00k)*qq(i,j)+bthe00k
     sthk=(sthe10k-sthe00k)*qq(i,j)+sthe00k
     tthk=(thesp(i,j)-bthk)/sthk*rdthe
     pp(i,j)=tthk-AINT(tthk)
     ithtb(i,j)=INT(tthk)+1

     !*** keeping indices within the table

     IF(ithtb(i,j).LT.1)THEN
        ithtb(i,j)=1
        pp(i,j)=0.
     ENDIF
     IF(ithtb(i,j).GE.jtb)THEN
        ithtb(i,j)=jtb-1
        pp(i,j)=0.
     ENDIF

     !*** temperature at four surrounding tt table pts

     ith=ithtb(i,j)
     ip=iptb(i,j)
     t00k=ttbl(ith  ,ip  )
     t10k=ttbl(ith+1,ip  )
     t01k=ttbl(ith  ,ip+1)
     t11k=ttbl(ith+1,ip+1)

     !*** parcel temperature

     tref(i,j)=(t00k+(t10k-t00k)*pp(i,j)+(t01k-t00k)*qq(i,j) &
          +(t00k-t10k-t01k+t11k)*pp(i,j)*qq(i,j))*html(i,j)
  END DO
END SUBROUTINE ttblex
