TTBLEX.f

      SUBROUTINE ttblex(TREF,TTBL,ITB,JTB,KARR,PMIDL         &
                       ,PL,QQ,PP,RDP,THE0,STHE,RDTHE,THESP   &
      ,                 IPTB,ITHTB)
!FPP$ NOCONCUR R
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:    TTBLEX      COMPUTES T ALONG A MOIST ADIABAT
!   PRGRMMR: BLACK           ORG: W/NP2      DATE: ??-??-??
!
! ABSTRACT:
!     THIS ROUTINE COMPUTES THE TEMPERATURE ALONG A MOIST
!     ADIABAT GIVEN THE SATURATION POTENTIAL TEMPERATURE
!     AND THE PRESSURE
!   .
!
! PROGRAM HISTORY LOG:
!   ??-??-??  T BLACK - ORIGINATOR
!   98-06-12  T BLACK - CONVERSION FROM 1-D TO 2-D
!   00-01-04  JIM TUCCILLO - MPI VERSION
!   01-10-22  H CHUANG - MODIFIED TO PROCESS HYBRID MODEL OUTPUT
!   02-01-15  MIKE BALDWIN - WRF VERSION
!   21-09-13  J MENG  - 2D DECOMPOSITION
!
!   OUTPUT FILES:
!     NONE
!
!   SUBPROGRAMS CALLED:
!     UTILITIES:
!       NONE
!
!   ATTRIBUTES:
!     LANGUAGE: FORTRAN
!----------------------------------------------------------------------
      use ctlblk_mod, only: jsta, jend, im, jsta_2l, jend_2u, me, &
                            ista, iend, ista_2l, iend_2u
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!----------------------------------------------------------------------
 
      integer,intent(in) :: ITB,JTB
      integer,intent(in) ::  KARR(ista:iend,jsta:jend)
      real,dimension(JTB,ITB),intent(in)             :: TTBL
      real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(in)  :: PMIDL
      real,dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),intent(out) :: TREF
      real,dimension(ista:iend,jsta:jend),intent(out)       :: QQ,PP
      real,dimension(ista:iend,jsta:jend),intent(in)        :: THESP
      real,dimension(ITB),  intent(in)               :: THE0,STHE
      integer,dimension(ista:iend,jsta:jend),intent(out)    :: IPTB,ITHTB
      real,intent(in)                                :: PL,RDP,RDTHE
 
!
      integer I,J,ITH,IP,IPTBK
      real PK,TPK,T00K,T10K,T01K,T11K,BTHE00K,STHE00K,BTHK,STHK, &
           tthk,bthe10k,sthe10k
!-----------------------------------------------------------------------
!$omp  parallel do                                                      &
!$omp& private(i,j,bthe00k,bthe10k,bthk,ip,iptbk,ith,pk,sthe00k,sthe10k,&
!$omp&         sthk,t00k,t01k,t10k,t11k,tpk,tthk)
      DO j=jsta,jend
        DO i=ista,iend
          IF(karr(i,j) > 0) THEN
!--------------SCALING PRESSURE & TT TABLE INDEX------------------------
            pk  = pmidl(i,j)
            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) < 1) THEN
              iptb(i,j) = 1
              qq(i,j)   = 0.
            ENDIF
!
            IF(iptb(i,j) >= 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)
!     write(1000+me,*)' i=',i,' j=',j,' tthk=',tthk,' thesp=',thesp(i,j) &
!            , ' bthk=',bthk,' sthk=',sthk,' rdthe=',rdthe
 
            ithtb(i,j) = int(tthk)+1
!--------------KEEPING INDICES WITHIN THE TABLE-------------------------
            IF(ithtb(i,j) < 1) THEN
              ithtb(i,j) = 1
              pp(i,j)    = 0.
            ENDIF
!
            IF(ithtb(i,j) >= 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))
          ENDIF
        ENDDO
      ENDDO
!
      RETURN
      END SUBROUTINE ttblex
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!
!-------------------------------------------------------------------------------------
!