SUBROUTINE GPRH_2D(LDWMORH,KHORIZ,KPROMA,KSTART,KPROF,KFLEV,&
 & PRHMAX,PRHMIN,PQ,PT,PRESF,PES,PRH)  

!**** *GPRH_2D* - COMPUTES ES AND RH FROM T AND Q

!     PURPOSE.  COMPUTES SATURATION VAPOUR PRESSURE AND RELATIVE
!     --------  HUMIDITY FROM TEMPERATURE AND SPECIFIC HUMIDITY.

!**   INTERFACE.
!     ----------
!        *CALL* *GPRH_2D(..)*

!        EXPLICIT ARGUMENTS
!        --------------------

!        LDWMORH              - WMO CONSIDER WATER PHASE ONLY          (INPUT)
!        KPROMA               - HORIZONTAL DIMENSIONS.                 (INPUT)
!        KSTART               - START OF WORK                          (INPUT)
!        KPROF                - DEPTH OF WORK                          (INPUT)
!        KFLEV                - NUMBER OF MODEL LEVELS                 (INPUT)
!        PRHMAX               - MAXIMUM RELATIVE HUMIDITY              (INPUT)
!        PRHMIN               - MINIMUM RELATIVE HUMIDITY              (INPUT)
!        PQ(KPROMA,KFLEV,KHORIZ)     - SPECIFIC HUMIDITY ON FULL MODEL LEVELS (INPUT)
!        PT(KPROMA,KFLEV,KHORIZ)     - TEMPERATURE ON FULL MODEL LEVELS       (INPUT)
!        PRESF(KPROMA,KFLEV,KHORIZ)  - MODEL FULL LEVEL PRESSURES             (INPUT)

!        PES(KPROMA,KFLEV,KHORIZ)    - SATURATION PRESSURE                    (OUTPUT)
!        PRH(KPROMA,KFLEV,KHORIZ)    - RELATIVE HUMIDITY                      (OUTPUT)

!        IMPLICIT ARGUMENTS :   PHYSICAL CONSTANTS FROM COMMONS YOMCST
!        --------------------   AND YOMPHY, FUNCTIONS FROM FCTTRM.

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.     NONE.
!     ----------

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 88-02-04
!     Per Unden : 1997-04-29  Use Tetens formula with new coefficients
!     E. Andersson  99-08-17  and Pedro, WMO consider water phase only.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     E. Wattrelot 10-July-2007 Adapted from gprh.F90
!     A.Bogatchev : 25-Oct-2007 removing of severe breaks of coding rools
!     ------------------------------------------------------------------

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

USE YOMCST   , ONLY : RV       ,RCPV     ,RETV     ,RCW      ,&
 & RCS      ,RLVTT    ,RLSTT    ,RTT      ,RALPW    ,&
 & RBETW    ,RGAMW    ,RALPS    ,RBETS    ,RGAMS    ,&
 & RALPD    ,RBETD    ,RGAMD  
USE YOMPHY   , ONLY : LNEIGE
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP ,R5ALSCP  ,&
 & RALVDCP  ,RALSDCP  ,RTWAT    ,RTICE   ,RTICECU,&
 & RTWAT_RTICE_R      ,RTWAT_RTICECU_R  
USE YOMCT0B  , ONLY : LECMWF

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
LOGICAL           ,INTENT(IN)    :: LDWMORH 
INTEGER(KIND=JPIM),INTENT(IN)    :: KHORIZ
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRHMAX 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRHMIN 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KPROMA,KFLEV,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA,KFLEV,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF(KPROMA,KFLEV,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PES(KPROMA,KFLEV,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRH(KPROMA,KFLEV,KHORIZ) 

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

INTEGER(KIND=JPIM) :: JL, JLEV,JROF

REAL(KIND=JPRB) :: ZDELTA, ZRH
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "fcttre.h"
#include "fcttrm.h"

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

IF (LHOOK) CALL DR_HOOK('GPRH_2D',0,ZHOOK_HANDLE)

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

!*       1.    COMPUTES ES AND RH.
!              -------------------

DO JROF = 1,KHORIZ
DO JLEV=1,KFLEV
  IF(LECMWF) THEN
    IF(LDWMORH) THEN
      DO JL=KSTART,KPROF
        PES(JL,JLEV,JROF)=(RETV+1.0_JPRB)*FOEEWMO(PT(JL,JLEV,JROF))
      ENDDO
    ELSE
      DO JL=KSTART,KPROF
        PES(JL,JLEV,JROF)=(RETV+1.0_JPRB)*FOEEWM(PT(JL,JLEV,JROF))
      ENDDO
    ENDIF
  ELSE
    IF(LNEIGE) THEN
      DO JL=KSTART,KPROF
        ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PT(JL,JLEV,JROF)))
        PES(JL,JLEV,JROF)=FOEW(PT(JL,JLEV,JROF),ZDELTA)
      ENDDO
    ELSE
      DO JL=KSTART,KPROF
        ZDELTA=0.0_JPRB
        PES(JL,JLEV,JROF)=FOEW(PT(JL,JLEV,JROF),ZDELTA)
      ENDDO
    ENDIF
  ENDIF
  DO JL=KSTART,KPROF
   IF ((1.0_JPRB+RETV*PQ(JL,JLEV,JROF))*PES(JL,JLEV,JROF)/=0.0_JPRB) THEN
     ZRH=(PRESF(JL,JLEV,JROF)*PQ(JL,JLEV,JROF)*(RETV+1.0_JPRB))&
      & /((1.0_JPRB+RETV*PQ(JL,JLEV,JROF))*PES(JL,JLEV,JROF))  
     PRH(JL,JLEV,JROF)=MAX(PRHMIN,MIN(ZRH,PRHMAX))
   ELSE 
     PRH(JL,JLEV,JROF)=0.0_JPRB
   ENDIF
  ENDDO
ENDDO
ENDDO

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

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