SUBROUTINE SATURTL (KIDIA , KFDIA , KLON  , KTDIA , KLEV,&
 & PAPRSF5, PT5    , PQSAT5, &
 & PAPRSF , PT     , PQSAT   )  

!***

! **   *SATURTL* -  COMPUTES SPECIFIC HUMIDITY AT SATURATION
!                    (Tangent linear)

!       J.F. MAHFOUF       E.C.M.W.F.     16/05/96

!       PURPOSE.
!       --------

!       SPECIFIC HUMIDITY AT SATURATION IS USED BY THE
!       DIAGNOSTIC CLOUD SCHEME TO COMPUTE RELATIVE HUMIDITY
!       AND LIQUID WATER CONTENT 

!       INTERFACE
!       ---------

!       THIS ROUTINE IS CALLED FROM *CALLPARTL*.

!       PARAMETER     DESCRIPTION                                 UNITS
!       ---------     -----------                                 -----
!       INPUT PARAMETERS (INTEGER):

!      *KIDIA*        START POINT
!      *KFDIA*        END POINT
!      *KLON*         NUMBER OF GRID POINTS PER PACKET
!      *KTDIA*        START OF THE VERTICAL LOOP
!      *KLEV*         NUMBER OF LEVELS

!       INPUT PARAMETERS (REAL):

!      *PAPRSF5*       PRESSURE ON FULL LEVELS                (Trajectory)
!      *PT5*           TEMPERATURE AT T-DT                    (Trajectory)
!      *PAPRSF*        PRESSURE ON FULL LEVELS                      PA
!      *PT*            TEMPERATURE AT T-DT                          K

!       OUTPUT PARAMETER (REAL):

!      *PQSAT5*        SATURATION SPECIFIC HUMIDITY            (Trajectory) 
!      *PQSAT*         SATURATION SPECIFIC HUMIDITY                 KG/KG

!-------------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCST   , ONLY : R        ,RETV     ,RLVTT    ,RLSTT    ,RTT
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,&
 & RALVDCP  ,RALSDCP  ,RTWAT    ,RTICE   ,RTICECU   ,&
 & RTWAT_RTICE_R      ,RTWAT_RTICECU_R  
IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQSAT5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQSAT(KLON,KLEV) 
INTEGER(KIND=JPIM) :: JK, JL

REAL(KIND=JPRB) :: ZCOR, ZCOR5, ZFOEEW, ZFOEEW5
REAL(KIND=JPRB) :: ZALFA, ZFOEEWL, ZFOEEWL5, ZFOEEWI, ZFOEEWI5
REAL(KIND=JPRB) :: ZQMAX, ZQS, ZQS5, ZTARG, ZTARG5  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!DIR$ VFUNCTION EXPHF

#include "fcttre.h"

!----------------------------------------------------------------------

!*    1.           DEFINE CONSTANTS
!                  ----------------

IF (LHOOK) CALL DR_HOOK('SATURTL',0,ZHOOK_HANDLE)
ZQMAX=0.5_JPRB

!*
!----------------------------------------------------------------------

!*    2.           CALCULATE SATURATION SPECIFIC HUMIDITY
!                  --------------------------------------

DO JK=KTDIA,KLEV
  DO JL=KIDIA, KFDIA
    ZTARG  = PT (JL,JK)
    ZTARG5 = PT5(JL,JK)
    ZALFA = FOEALFA(ZTARG5)

    ZFOEEWL5 = R2ES*EXP(R3LES*(ZTARG5-RTT)/(ZTARG5-R4LES))
    ZFOEEWL  = R3LES*(RTT-R4LES)*ZTARG*ZFOEEWL5/(ZTARG5-R4LES)**2
    ZFOEEWI5 = R2ES*EXP(R3IES*(ZTARG5-RTT)/(ZTARG5-R4IES))
    ZFOEEWI  = R3IES*(RTT-R4IES)*ZTARG*ZFOEEWI5/(ZTARG5-R4IES)**2
    ZFOEEW  = ZALFA*ZFOEEWL +(1.0_JPRB-ZALFA)*ZFOEEWI
    ZFOEEW5 = ZALFA*ZFOEEWL5+(1.0_JPRB-ZALFA)*ZFOEEWI5

    ZQS     = ZFOEEW /PAPRSF5(JL,JK) - PAPRSF(JL,JK)*&
     & ZFOEEW5/PAPRSF5(JL,JK)**2  
    ZQS5    = ZFOEEW5/PAPRSF5(JL,JK)
    IF (ZQS5 > ZQMAX) THEN
      ZQS =0.0_JPRB
      ZQS5=ZQMAX
    ENDIF
    ZCOR  = RETV*ZQS/(1.0_JPRB-RETV*ZQS5)**2
    ZCOR5 = 1.0_JPRB/(1.0_JPRB-RETV*ZQS5)
    PQSAT (JL,JK)=ZQS *ZCOR5  + ZQS5*ZCOR
    PQSAT5(JL,JK)=ZQS5*ZCOR5
  ENDDO
ENDDO

IF (LHOOK) CALL DR_HOOK('SATURTL',1,ZHOOK_HANDLE)
END SUBROUTINE SATURTL
