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

!***

! **   *SATURAD* -  COMPUTES SPECIFIC HUMIDITY AT SATURATION
!                    (Adjoint)

!       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 *CALLPARAD*.

!       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(INOUT) :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: 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, ZQS55, ZTARG, ZTARG5  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!DIR$ VFUNCTION EXPHF

#include "fcttre.h"

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

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

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

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

!               ------  TRAJECTORY COMPUTATIONS  ------

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

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

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

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

    ZQS5    = ZFOEEW5/PAPRSF5(JL,JK)
    ZQS55   = ZQS5
    IF (ZQS5 > ZQMAX) THEN
      ZQS5=ZQMAX
    ENDIF
    ZCOR5 = 1.0_JPRB/(1.0_JPRB-RETV*ZQS5)
    PQSAT5(JL,JK)=ZQS5*ZCOR5

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

!*                 ------ ADJOINT COMPUTATIONS ------

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

!*                          INITIALIZATIONS
!                          -----------------

    ZQS     = 0.0_JPRB
    ZCOR    = 0.0_JPRB
    ZFOEEW  = 0.0_JPRB
    ZFOEEWL = 0.0_JPRB
    ZFOEEWI = 0.0_JPRB
    ZTARG   = 0.0_JPRB

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

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

    ZFOEEWL = ZFOEEWL+ZALFA*ZFOEEW
    ZFOEEWI = ZFOEEWI+(1.0_JPRB-ZALFA)*ZFOEEW
    ZTARG = ZTARG + ZFOEEWI*R3IES*(RTT-R4IES)*ZFOEEWI5/(ZTARG5-R4IES)**2
    ZTARG = ZTARG + ZFOEEWL*R3LES*(RTT-R4LES)*ZFOEEWL5/(ZTARG5-R4LES)**2
    PT (JL,JK) = PT (JL,JK) + ZTARG
  ENDDO
ENDDO

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