MODULE VSURFSTL_MOD
CONTAINS
SUBROUTINE VSURFSTL(KIDIA,KFDIA,KLON,KLEVS,KTILE,&
 & KTVL,KTVH,&
 & PLAIL, PLAIH,&
 & PTMLEV5 ,PQMLEV5  ,PAPHMS5 ,&
 & PTSKM1M5,PWSAM1M5 ,PTSAM1M5,KSOTY,&
 & PSRFD5  ,PRAQ5    ,PQSAM5  ,&
 & PQS5    ,PDQS5    ,&
 & PWETB5  ,PCPTS5   ,PWETL5  , PWETH5, PWETHS5, &
 & PTMLEV  ,PQMLEV   ,PAPHMS  ,&
 & PTSKM1M ,PWSAM1M  ,PTSAM1M ,&
 & PSRFD   ,PRAQ     ,PQSAM   ,&
 & PQS     ,PDQS     ,&
 & PWETB   ,PCPTS    ,PWETL   , PWETH , PWETHS)

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

USE YOS_VEG   ,ONLY : RCEPSW   ,RVROOTSA ,RVRSMIN  ,RVHSTR   ,RVLAI
USE YOS_CST   ,ONLY : RCPD     ,RETV     ,RLVTT    ,RLSTT    ,RTT
USE YOS_THF   ,ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,R4IES &
                  &  ,R5LES    ,R5IES    ,RVTMP2
USE YOS_SOIL  ,ONLY : RWCAP    ,RWPWP    ,RQWEVAP  &
                  &  ,RWCAPM   ,RWPWPM   ,RQWEVAPM , RWRESTM &
                  &  ,RTF1     ,RTF2     ,RTF3     ,RTF4 &
                  &  ,LEVGEN

#ifdef DOC
!     ------------------------------------------------------------------

!**   *VSURFSTL* - PREPARES SURFACE BOUNDARY CONDITION FOR T AND Q
!                   (Tangent linear)

!  AUTHOR:
!    M. Janiskova       ECMWF   February 2006
!  Modified:
!    G. Balsamo         ECMWF   January 2007 Add soil type
!    M. Janiskova       ECMWF   August 2007  Cleanning for soil type
!    S. Boussetta/G.Balsamo May 2009 Add lai

!     PURPOSE
!     -------

!     PREPARE SURFACE BOUNDARY CONDITION FOR Q AND T, E.G. FRACTIONAL
!     SURFACE COVER (SNOW AND VEGETATION), SATURATION SPECIFIC HUMIDITY
!     AT THE SURFACE, RELATIVE HUMIDITY OVER BARE LAND AND THE STOMATAL
!     RESISTANCE.

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

!     *VSURFSTL* IS CALLED BY *SURFEXCDRIVERSTL*

!     INPUT PARAMETERS (INTEGER):

!     *KIDIA*        START POINT
!     *KFDIA*        END POINT
!     *KLON*         NUMBER OF GRID POINTS PER PACKET
!     *KLEVS*        NUMBER OF SOIL LAYERS
!     *KTILE*        TILE INDEX
!     *KTVL*         VEGETATION TYPE FOR LOW VEGETATION FRACTION
!     *KTVH*         VEGETATION TYPE FOR HIGH VEGETATION FRACTION
!     *PLAIL*        LAI OF LOW VEGETATION
!     *PLAIH*        LAI OF HIGH VEGETATION
!     *KSOTY*        SOIL TYPE (1-7)

!     INPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                               Unit
!  PTMLEV5     PTMLEV        TEMPERATURE AT T-1, lowest model level    K
!  PQMLEV5     PQMLEV        SPECIFIC HUMIDITY AT T-1, lowest model 
!                            level                                     kg/kg
!  PAPHMS5     PAPHMS        PRESSURE AT T-1, surface                  Pa
!  PTSKM1M5    PTSKM1M       SURFACE TEMPERATURE                       K
!  PWSAM1M5    PWSAM1M       SOIL MOISTURE ALL LAYERS                 m**3/m**3
!  PTSAM1M5    PTSAM1M       SOIL TEMPERATURE ALL LAYERS               K
!  PSRFD5      PSRFD         DOWNWARD SHORT WAVE RADIATION FLUX AT 
!                            SURFACE                                   W/m2
!  PRAQ5       PRAQ          PRELIMINARY AERODYNAMIC RESISTANCE

!     OUTPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description
!  PQSAM5      PQSAM         SPECIFIC HUMIDITY AT THE SURFACE          kg/kg
!  PQS5        PQS           SATURATION Q AT SURFACE                   kg/kg
!  PDQS5       PDQS          DERIVATIVE OF SATURATION Q-CURVE AT
!                            SURFACE T
!  PWETB5      PWETB         BARE SOIL RESISTANCE
!  PCPTS5      PCPTS         DRY STATIC ENRGY AT SURFACE               J/kg
!  PWETL5      PWETL         CANOPY RESISTANCE LOW VEGETATION
!  PWETH5      PWETH         CANOPY RESISTANCE HIGH VEGETATION, 
!                            SNOW FREE
!  PWETHS5     PWETHS        CANOPY RESISTANCE HIGH VEGETATION 
!                            WITH SNOW

!     METHOD
!     ------

!     SEE DOCUMENTATION

!     ------------------------------------------------------------------
#endif

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTILE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTVL(:) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTVH(:)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAIL(:)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAIH(:)
INTEGER(KIND=JPIM),INTENT(IN)    :: KSOTY(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTMLEV5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQMLEV5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHMS5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSKM1M5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWSAM1M5(:,:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSAM1M5(:,:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSRFD5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAQ5(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQSAM5(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQS5(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDQS5(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETB5(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCPTS5(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETL5(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETH5(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETHS5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTMLEV(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQMLEV(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHMS(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSKM1M(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWSAM1M(:,:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSAM1M(:,:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSRFD(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAQ(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQSAM(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQS(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDQS(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETB(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCPTS(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETL(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETH(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETHS(:) 

!*    LOCAL STORAGE
!     ----- -------

REAL(KIND=JPRB) :: ZLIQ(KLON,KLEVS)
REAL(KIND=JPRB) :: ZLIQ5(KLON,KLEVS)

INTEGER(KIND=JPIM) :: JK, JL, JS

REAL(KIND=JPRB) ::   &
 & ZCOR, ZEPSF3, ZF, ZF1H, ZF1L, ZF2H, ZF2L, ZF2B, &
 & ZF3H, ZF3L, ZHSTRH, ZHSTRL, ZLAIH, ZLAIL, &
 & ZQSAIR, ZROOT1H, ZROOT1L, ZROOT2H, ZROOT2L, &
 & ZROOT3H, ZROOT3L, ZROOT4H, ZROOT4L, ZRSMINH, &
 & ZRSMINL, ZRSMINB, ZRVA, ZRVB, ZSRFL, ZWROOTH, ZWROOTL
REAL(KIND=JPRB) :: ZQWEVAP, ZWPWP

REAL(KIND=JPRB) :: ZCOR5, ZF5, ZWROOTL5, ZWROOTH5, ZF2L5, ZF2H5, ZF2B5
REAL(KIND=JPRB) :: ZSRFL5, ZF1L5, ZQSAIR5, ZF3H5, ZF3L5, ZF1H5

REAL(KIND=JPRB) :: Z3S, Z4S, ZLIQP1, ZLIQP2, ZF2LP1, ZF2LP2
REAL(KIND=JPRB) :: ZF2HP1, ZF2HP2, ZF2BP1, ZF2BP2, ZF1LP
REAL(KIND=JPRB) :: Z5S, Z6S, ZWETL, ZWETH
REAL(KIND=JPRB) :: Z3S5, Z4S5, ZLIQP15, ZLIQP25, ZF2LP15, ZF2LP25
REAL(KIND=JPRB) :: ZF2HP15, ZF2HP25, ZF2BP15, ZF2BP25, ZF1LPI5, ZF1LP5
REAL(KIND=JPRB) :: Z5S5, Z6S5, ZWETL5, ZWETLI5, ZWETH5, ZWETHI5, ZF2BI5
REAL(KIND=JPRB) :: ZDIV15, ZDIV25, ZDIV35, ZDIV45, ZDIV55, ZDIV65
REAL(KIND=JPRB) :: ZDIV75, ZDIV85, ZDIV95
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*       1.     INITIALIZE CONSTANTS
!               ---------- ----------

IF (LHOOK) CALL DR_HOOK('VSURFSTL_MOD:VSURFSTL',0,ZHOOK_HANDLE)

ZRVA=5000._JPRB
ZRVB=10._JPRB
ZEPSF3=0.00001_JPRB ! security value for exponential sat-deficit dependence
ZRSMINB=50._JPRB  ! bare soil minimum resistance

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

!          2.    PREPARE SURFACE BOUNDARY CONDITION
!                ------- ------- -------- ---------

!*         2.1   RELATIVE HUMIDITY OVER THE BARE LAND PART

!                BARE SOIL RESISTANCE IS COMPUTED FOR KTILE=4

!*         2.2   SATURATION PARAMETERS,

DO JL=KIDIA,KFDIA
  IF (PTSKM1M5(JL) > RTT) THEN
    ZDIV15 = 1.0_JPRB/(PTSKM1M5(JL)-R4LES)
    Z3S  = R3LES*(RTT-R4LES)*ZDIV15*ZDIV15*PTSKM1M (JL)
    Z3S5 = R3LES*(PTSKM1M5(JL)-RTT)*ZDIV15
  ELSE
    ZDIV15 = 1.0_JPRB/(PTSKM1M5(JL)-R4IES)
    Z3S  = R3IES*(RTT-R4IES)*ZDIV15*ZDIV15*PTSKM1M (JL)
    Z3S5 = R3IES*(PTSKM1M5(JL)-RTT)*ZDIV15
  ENDIF
  Z4S5 = EXP(Z3S5)
  Z4S  = Z4S5*Z3S
  ZDIV25 = 1.0_JPRB/PAPHMS5(JL)
  PQS (JL) =  R2ES*(Z4S *PAPHMS5(JL)-Z4S5*PAPHMS (JL))*ZDIV25*ZDIV25
  PQS5(JL) = (R2ES*Z4S5)*ZDIV25
  ZCOR5 = 1.0_JPRB/(1.0_JPRB-RETV*PQS5(JL))
  ZCOR  = (RETV*PQS(JL))*ZCOR5*ZCOR5
  PQS (JL) = ZCOR*PQS5(JL)+ZCOR5*PQS(JL)
  PQS5(JL) = PQS5(JL)*ZCOR5

  IF (PTSKM1M5(JL) > RTT) THEN
    ZDIV35 = 1.0_JPRB/(PTSKM1M5(JL)-R4LES)
    PDQS (JL) = R5LES*(PQS5(JL)*ZCOR + PQS (JL)*ZCOR5)*ZDIV35*ZDIV35 &
     & -2.0_JPRB*R5LES*PQS5(JL)*ZCOR5*ZDIV35*ZDIV35*ZDIV35*PTSKM1M(JL)
    PDQS5(JL) = R5LES*PQS5(JL)*ZCOR5*ZDIV35*ZDIV35
  ELSE
    ZDIV35 = 1.0_JPRB/(PTSKM1M5(JL)-R4IES)
    PDQS (JL) = R5IES*(PQS5(JL)*ZCOR + PQS (JL)*ZCOR5)*ZDIV35*ZDIV35 &
     & -2.0_JPRB*R5IES*PQS5(JL)*ZCOR5*ZDIV35*ZDIV35*ZDIV35*PTSKM1M(JL)
    PDQS5(JL) = R5IES*PQS5(JL)*ZCOR5*ZDIV35*ZDIV35
  ENDIF
ENDDO

!*         2.3   DEFINITION OF THE STOMATAL RESISTANCE AND BARE SOIL RES
!*               DOES WORK FOR TYPE 4, 6 AND 8 WHEN ROUTINE IS CALLED FOR 
!*               TYPE 4

IF (KTILE  ==  4) THEN

!                Compute first liquid fraction of soil water to 
!                be used later in stress functions
!          CONTRIBUTION TO APPARENT ENERGY, TAKING INTO ACCOUNT
!          FREEZING/MELTING OF SOIL WATER.

  DO JK=1,KLEVS
    DO JL=KIDIA,KFDIA
      IF (PTSAM1M5(JL,JK) < RTF1.AND.PTSAM1M5(JL,JK) > RTF2) THEN
        ZF  = -0.5_JPRB*RTF4*COS(RTF4*(PTSAM1M5(JL,JK)-RTF3)) &
         &  * PTSAM1M(JL,JK)
        ZF5 = 0.5_JPRB*(1.0_JPRB-SIN(RTF4*(PTSAM1M5(JL,JK)-RTF3)))
      ELSEIF (PTSAM1M5(JL,JK) <= RTF2) THEN
        ZF  = 0.0_JPRB
        ZF5 = 1.0_JPRB
      ELSE
        ZF  = 0.0_JPRB
        ZF5 = 0.0_JPRB
      ENDIF
      ZLIQP1  = (1.0_JPRB-ZF5)*PWSAM1M(JL,JK)-PWSAM1M5(JL,JK)*ZF
      ZLIQP15 = PWSAM1M5(JL,JK)*(1.0_JPRB-ZF5)
      IF (LEVGEN) THEN
        JS=KSOTY(JL)
        IF (ZLIQP15 < RWCAPM(JS)) THEN
          ZLIQP2  = ZLIQP1
          ZLIQP25 = ZLIQP15
        ELSE
          ZLIQP2  = 0.0_JPRB
          ZLIQP25 = RWCAPM(JS)
        ENDIF
        IF (ZLIQP25 > RWPWPM(JS)) THEN
          ZLIQ (JL,JK) = ZLIQP2
          ZLIQ5(JL,JK) = ZLIQP25
        ELSE
          ZLIQ (JL,JK) = 0.0_JPRB
          ZLIQ5(JL,JK) = RWPWPM(JS)
        ENDIF
      ELSE
        IF (ZLIQP15 < RWCAP) THEN
          ZLIQP2  = ZLIQP1
          ZLIQP25 = ZLIQP15
        ELSE
          ZLIQP2  = 0.0_JPRB
          ZLIQP25 = RWCAP
        ENDIF
        IF (ZLIQP25 > RWPWP) THEN
          ZLIQ (JL,JK) = ZLIQP2
          ZLIQ5(JL,JK) = ZLIQP25
        ELSE
          ZLIQ (JL,JK) = 0.0_JPRB
          ZLIQ5(JL,JK) = RWPWP
        ENDIF
      ENDIF
    ENDDO
  ENDDO

  DO JL=KIDIA,KFDIA
!           minimal stomatal resistance : ZRSMIN
    ZRSMINL = RVRSMIN(KTVL(JL))
    ZRSMINH = RVRSMIN(KTVH(JL))

!           leaf area index  : ZLAI
    ZLAIL = PLAIL(JL)
    ZLAIH = PLAIH(JL)

!           soil moisture stress function : F2
    ZROOT1L = RVROOTSA(1,KTVL(JL))
    ZROOT2L = RVROOTSA(2,KTVL(JL))
    ZROOT3L = RVROOTSA(3,KTVL(JL))
    ZROOT4L = RVROOTSA(4,KTVL(JL))
    ZROOT1H = RVROOTSA(1,KTVH(JL))
    ZROOT2H = RVROOTSA(2,KTVH(JL))
    ZROOT3H = RVROOTSA(3,KTVH(JL))
    ZROOT4H = RVROOTSA(4,KTVH(JL))
    ZWROOTL  = ZLIQ (JL,1)*ZROOT1L+ZLIQ (JL,2)*ZROOT2L &
     &       + ZLIQ (JL,3)*ZROOT3L+ZLIQ (JL,4)*ZROOT4L 
    ZWROOTL5 = ZLIQ5(JL,1)*ZROOT1L+ZLIQ5(JL,2)*ZROOT2L &
     &       + ZLIQ5(JL,3)*ZROOT3L+ZLIQ5(JL,4)*ZROOT4L
    ZWROOTH  = ZLIQ (JL,1)*ZROOT1H+ZLIQ (JL,2)*ZROOT2H &
     &       + ZLIQ (JL,3)*ZROOT3H+ZLIQ (JL,4)*ZROOT4H 
    ZWROOTH5 = ZLIQ5(JL,1)*ZROOT1H+ZLIQ5(JL,2)*ZROOT2H &
     &       + ZLIQ5(JL,3)*ZROOT3H+ZLIQ5(JL,4)*ZROOT4H 

    IF (LEVGEN) THEN
      JS=KSOTY(JL)
      ZWPWP=RWPWPM(JS)
      ZQWEVAP=RQWEVAPM(JS)
    ELSE
      ZWPWP=RWPWP
      ZQWEVAP=RQWEVAP
    ENDIF

    ZF2LP1  =  ZQWEVAP*ZWROOTL
    ZF2LP15 = (ZWROOTL5-ZWPWP)*ZQWEVAP
    IF (ZF2LP15 < 1.0_JPRB) THEN
      ZF2LP2  = ZF2LP1
      ZF2LP25 = ZF2LP15
    ELSE
      ZF2LP2  = 0.0_JPRB
      ZF2LP25 = 1.0_JPRB
    ENDIF
    IF (ZF2LP25 > RCEPSW) THEN
      ZF2L  = ZF2LP2
      ZF2L5 = ZF2LP25
    ELSE
      ZF2L  = 0.0_JPRB
      ZF2L5 = RCEPSW
    ENDIF
    ZF2HP1  =  ZQWEVAP*ZWROOTH
    ZF2HP15 = (ZWROOTH5-ZWPWP)*ZQWEVAP
    IF (ZF2HP15 < 1.0_JPRB) THEN
      ZF2HP2  = ZF2HP1
      ZF2HP25 = ZF2HP15
    ELSE
      ZF2HP2  = 0.0_JPRB
      ZF2HP25 = 1.0_JPRB
    ENDIF
    IF (ZF2HP25 > RCEPSW) THEN
      ZF2H  = ZF2HP2
      ZF2H5 = ZF2HP25
    ELSE
      ZF2H  = 0.0_JPRB
      ZF2H5 = RCEPSW
    ENDIF
    ZF2BP1  = ZLIQ(JL,1)*ZQWEVAP
    ZF2BP15 = (ZLIQ5(JL,1)-ZWPWP)*ZQWEVAP
    IF (ZF2BP15 < 1.0_JPRB) THEN
      ZF2BP2  = ZF2BP1
      ZF2BP25 = ZF2BP15
    ELSE
      ZF2BP2  = 0.0_JPRB
      ZF2BP25 = 1.0_JPRB
    ENDIF
    IF (ZF2BP25 > RCEPSW) THEN
      ZF2B  = ZF2BP2
      ZF2B5 = ZF2BP25
    ELSE
      ZF2B  = 0.0_JPRB
      ZF2B5 = RCEPSW
    ENDIF

!           radiation stress function (proposed by Alan Betts): ZF1 

    ZSRFL  = PSRFD (JL)/250._JPRB
    ZSRFL5 = PSRFD5(JL)/250._JPRB
    ZF1LPI5 = 1.0_JPRB/(ZSRFL5+0.05_JPRB)
    ZF1LP  = 0.81_JPRB*ZF1LPI5*(1._JPRB-(1.+ZSRFL5)*ZF1LPI5)*ZSRFL
    ZF1LP5 = 0.81_JPRB*(1.+ZSRFL5)*ZF1LPI5
    IF (ZF1LP5 > 1.0_JPRB) THEN
      ZF1L5 = 1.0_JPRB/ZF1LP5
      ZF1L  = -ZF1L5*ZF1L5*ZF1LP
    ELSE
      ZF1L  = 0.0_JPRB
      ZF1L5 = 1.0_JPRB
    ENDIF
    ZF1H  = ZF1L
    ZF1H5 = ZF1L5

!           atmospheric moisture deficit stress function : F3
    ZHSTRL=RVHSTR(KTVL(JL))
    ZHSTRH=RVHSTR(KTVH(JL))

    IF (PTMLEV5(JL) > RTT) THEN
      ZDIV45 = 1.0_JPRB/(PTMLEV5(JL)-R4LES)
      Z5S  = R3LES* PTMLEV (JL)*(RTT-R4LES)*ZDIV45*ZDIV45
      Z5S5 = R3LES*(PTMLEV5(JL)-RTT)*ZDIV45
    ELSE
      ZDIV45 = 1.0_JPRB/(PTMLEV5(JL)-R4IES)
      Z5S  = R3IES* PTMLEV (JL)*(RTT-R4IES)*ZDIV45*ZDIV45
      Z5S5 = R3IES*(PTMLEV5(JL)-RTT)*ZDIV45
    ENDIF
    Z6S5 = EXP(Z5S5)
    Z6S  = Z6S5*Z5S
    ZDIV55 = 1.0_JPRB/PAPHMS5(JL)
    ZQSAIR  =  R2ES*(Z6S *PAPHMS5(JL)-Z6S5*PAPHMS (JL))*ZDIV55*ZDIV55
    ZQSAIR5 = (R2ES*Z6S5)*ZDIV55
    ZCOR5 = 1.0_JPRB/(1.0_JPRB-RETV*ZQSAIR5)
    ZCOR  = (RETV*ZQSAIR)*ZCOR5*ZCOR5
    ZQSAIR  = ZQSAIR5*ZCOR+ZCOR5*ZQSAIR
    ZQSAIR5 = ZQSAIR5*ZCOR5
    ZF3L5 = EXP(-ZHSTRL*(ZQSAIR5-PQMLEV5(JL)))
    ZF3L  = ZF3L5*(-ZHSTRL*(ZQSAIR-PQMLEV(JL)))
    ZF3H5 = EXP(-ZHSTRH*(ZQSAIR5-PQMLEV5(JL)))
    ZF3H  = ZF3H5*(-ZHSTRH*(ZQSAIR-PQMLEV(JL)))
    IF (ZF3L5 > 1.0_JPRB) THEN
      ZF3L  = 0.0_JPRB
      ZF3L5 = 1.0_JPRB
    ENDIF
    IF (ZF3L5 < ZEPSF3) THEN
      ZF3L  = 0.0_JPRB
      ZF3L5 = ZEPSF3
    ENDIF
    IF (ZF3H5 > 1.0_JPRB) THEN
      ZF3H  = 0.0_JPRB
      ZF3H5 = 1.0_JPRB
    ENDIF
    IF (ZF3H5 < ZEPSF3) THEN
      ZF3H  = 0.0_JPRB
      ZF3H5 = ZEPSF3
    ENDIF
    ZWETL = ZLAIL*ZF1L5*ZF2L5*ZF3L+ZLAIL*ZF1L5*ZF3L5*ZF2L &
     &    + ZLAIL*ZF2L5*ZF3L5*ZF1L
    ZWETL5 = ZLAIL*ZF1L5*ZF2L5*ZF3L5
    ZWETLI5 = 1.0_JPRB/ZWETL5
    PWETL (JL) = -ZRSMINL*ZWETLI5*ZWETLI5*ZWETL
    PWETL5(JL) = ZRSMINL*ZWETLI5
    ZWETH = ZLAIH*ZF1H5*ZF2H5*ZF3H+ZLAIH*ZF1H5*ZF3H5*ZF2H &
     &    + ZLAIH*ZF2H5*ZF3H5*ZF1H
    ZWETH5 = ZLAIH*ZF1H5*ZF2H5*ZF3H5
    ZWETHI5 = 1.0_JPRB/ZWETH5
    PWETH (JL) = -ZRSMINH*ZWETHI5*ZWETHI5*ZWETH
    PWETH5(JL) = ZRSMINH*ZWETHI5
    PWETHS (JL) = PWETH (JL)
    PWETHS5(JL) = PWETH5(JL)
    ZF2BI5 = 1.0_JPRB/ZF2B5
    PWETB (JL) = -ZRSMINB*ZF2BI5*ZF2BI5*ZF2B
    PWETB5(JL) = ZRSMINB*ZF2BI5
  ENDDO
ENDIF

IF (KTILE == 4) THEN
  DO JL=KIDIA,KFDIA
    IF (PQMLEV5(JL) > PQS5(JL)) THEN
      PWETL (JL) = 0.0_JPRB
      PWETL5(JL) = 0.0_JPRB
    ENDIF
  ENDDO
ELSEIF (KTILE == 6) THEN
  DO JL=KIDIA,KFDIA
    IF (PQMLEV5(JL) > PQS5(JL)) THEN
      PWETH (JL) = 0.0_JPRB
      PWETH5(JL) = 0.0_JPRB
    ENDIF
  ENDDO
ELSEIF (KTILE == 7) THEN
  DO JL=KIDIA,KFDIA
    IF (PQMLEV5(JL) > PQS5(JL)) THEN
      PWETHS (JL) = 0.0_JPRB
      PWETHS5(JL) = 0.0_JPRB
    ENDIF
  ENDDO
ELSEIF (KTILE == 8) THEN
  DO JL=KIDIA,KFDIA
    IF (PQMLEV5(JL) > PQS5(JL)) THEN
      PWETB (JL) = 0.0_JPRB
      PWETB5(JL) = 0.0_JPRB
    ENDIF
  ENDDO
ENDIF

!*         2.4   APPARENT SURFACE HUMIDITY

IF (KTILE  ==  1.OR. KTILE  ==  2.OR. KTILE  ==  3.OR. KTILE  ==  5) THEN
  DO JL=KIDIA,KFDIA
    PQSAM (JL) = PQS (JL)
    PQSAM5(JL) = PQS5(JL)
  ENDDO
ELSEIF (KTILE  ==  8) THEN
  DO JL=KIDIA,KFDIA
    ZDIV65 = 1.0_JPRB/(PWETB5(JL)+PRAQ5(JL))
    PQSAM (JL) = PQS(JL)+(PQMLEV5(JL)-PQS5(JL))*ZDIV65*PWETB(JL) &
     & +PWETB5(JL)*ZDIV65*(PQMLEV(JL)-PQS(JL)) &
     & -(PQMLEV5(JL)-PQS5(JL))*PWETB5(JL)*ZDIV65*ZDIV65 &
     & *(PWETB(JL)+PRAQ(JL))
    PQSAM5(JL) = PQS5(JL)+(PQMLEV5(JL)-PQS5(JL))*PWETB5(JL)*ZDIV65
  ENDDO
ELSEIF (KTILE  ==  4) THEN
  DO JL=KIDIA,KFDIA
    ZDIV75 = 1.0_JPRB/(PWETL5(JL)+PRAQ5(JL))
    PQSAM (JL) = PQS(JL)+(PQMLEV5(JL)-PQS5(JL))*ZDIV75*PWETL(JL) &
     & +PWETL5(JL)*ZDIV75*(PQMLEV(JL)-PQS(JL)) &
     & -(PQMLEV5(JL)-PQS5(JL))*PWETL5(JL)*ZDIV75*ZDIV75 &
     & *(PWETL(JL)+PRAQ(JL))
    PQSAM5(JL) = PQS5(JL)+(PQMLEV5(JL)-PQS5(JL))*PWETL5(JL)*ZDIV75
  ENDDO
ELSEIF (KTILE == 6) THEN ! I.E. HIGH VEGETATION, SNOW FREE
  DO JL=KIDIA,KFDIA
    ZDIV85 = 1.0_JPRB/(PWETH5(JL)+PRAQ5(JL))
    PQSAM (JL) = PQS(JL)+(PQMLEV5(JL)-PQS5(JL))*ZDIV85*PWETH(JL) &
     & +PWETH5(JL)*ZDIV85*(PQMLEV(JL)-PQS(JL)) &
     & -(PQMLEV5(JL)-PQS5(JL))*PWETH5(JL)*ZDIV85*ZDIV85 &
     & *(PWETH(JL)+PRAQ(JL))
    PQSAM5(JL) = PQS5(JL)+(PQMLEV5(JL)-PQS5(JL))*PWETH5(JL)*ZDIV85
  ENDDO
ELSE ! I.E. HIGH VEGETATION WITH SNOW (7)
  DO JL=KIDIA,KFDIA
    ZDIV95 = 1.0_JPRB/(PWETHS5(JL)+PRAQ5(JL))
    PQSAM (JL) = PQS(JL)+(PQMLEV5(JL)-PQS5(JL))*ZDIV95*PWETHS(JL) &
     & +PWETHS5(JL)*ZDIV95*(PQMLEV(JL)-PQS(JL)) &
     & -(PQMLEV5(JL)-PQS5(JL))*PWETHS5(JL)*ZDIV95*ZDIV95 &
     & *(PWETHS(JL)+PRAQ(JL))
    PQSAM5(JL) = PQS5(JL)+(PQMLEV5(JL)-PQS5(JL))*PWETHS5(JL)*ZDIV95
  ENDDO
ENDIF

!*         2.5   DRY STATIC ENERGY AT THE SURFACE

DO JL=KIDIA,KFDIA
  PCPTS (JL) = RCPD*(1.0_JPRB+RVTMP2*PQSAM5(JL))*PTSKM1M(JL) &
   & + RCPD*RVTMP2*PTSKM1M5(JL)*PQSAM(JL)
  PCPTS5(JL) = PTSKM1M5(JL)*RCPD*(1.0_JPRB+RVTMP2*PQSAM5(JL))
ENDDO

IF (LHOOK) CALL DR_HOOK('VSURFSTL_MOD:VSURFSTL',1,ZHOOK_HANDLE)
END SUBROUTINE VSURFSTL
END MODULE VSURFSTL_MOD
