MODULE VEVAPSAD_MOD
CONTAINS
SUBROUTINE VEVAPSAD (KIDIA,KFDIA,KLON,PTMST,PRVDIFTS,KTILE, &
 & PWLMX5, PTMLEV5 , PQMLEV5 , PAPHMS5, PTSKM1M5, PTSAM1M5, &
 & PQS5  , PCFQ5   , PWETB5  , PWETL5 , PWETH5  , PWETHS5 , &
 & PCPTS5, PCSAT5  , PCAIR5  , PCSNW5 , &
 & PTMLEV, PQMLEV  , PAPHMS  , PTSKM1M, PTSAM1M , &
 & PQS   , PCFQ    , PWETB   , PWETL  , PWETH   , PWETHS , &
 & PCPTS , PCSAT   , PCAIR   , PCSNW )

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

USE YOS_CST   ,ONLY : RG       ,RD       ,RCPD     ,RETV
USE YOS_THF   ,ONLY : RVTMP2
USE YOS_VEG   ,ONLY : RLHAERO, RLHAEROS

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

!**   *VEVAPSAD* - COMPUTE EQUIVALENT EVAPOTRANSPIRATION EFFICIENCY
!                   (Adjoint)

!     P. Viterbo   ECMWF    22/06/2005     Externalise surf

!     based on

!     J.F. MAHFOUF          E.C.M.W.F.    02/10/95

!     adapted from

!     A.C.M. BELJAARS       E.C.M.W.F.    18/01/90.

!     OBUKHOV-L UPDATE      ACMB          26/03/90.
!     (MAINLY TECHNICAL; TO MAKE CODE MORE READABLE)

!  MODIFIED:
!    M. Janiskova  ECMWF   15/02/2006  modified for tiling of land surface
!                                      (as used in non-linear VEVAP routine)

!     PURPOSE
!     -------

!     COMPUTE EQUIVALENT EVAPOTRANSPIRATION EFFICIENCY

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

!     *VEVAPSTL* IS CALLED BY *VDFMAINSTL*

!   INPUT PARAMETERS (INTEGER):

!     *KIDIA*        START POINT
!     *KFDIA*        END POINT
!     *KLON*         NUMBER OF GRID POINTS PER PACKET
!     *KTILE*        TILE INDEX

!   INPUT PARAMETERS (REAL):

!     *PTMST*        TIME STEP
!     *PRVDIFTS*     Semi-implicit factor for vertical diffusion discretization

!  Trajectory  Perturbation  Description                               Unit
!  PWLMX5      ----          Semi-implicit factor for vertical 
!                            diffusion discretization                  kg/m**2
!  PTMLEV5     PTMLEV        TEMPERATURE AT T-1, 
!                            lowest atmospheric level                  K
!  PQMLEV5     PQMLEV        PECIFIC HUMUDITY AT T-1, 
!                            lowest atmospheric level                  kg/kg
!  PAPHMS5     PAPHMS        PRESSURE AT T-1, surface                  Pa
!  PTSKM1M5    PTSKM1M       SKIN TEMPERATURE                          K
!  PTSAM1M5    PTSAM1M       SURFACE TEMPERATURE                       K

!  PQS5        PQS           SATURATION Q AT SURFACE                   kg/kg
!  PCFQ5       PCFQ          PROP. TO EXCH. COEFF. FOR MOISTURE
!                            (C-STAR IN DOC.)  (SURFACE LAYER ONLY)    ?
!  PWETB5      PWETB         BARE SOIL RESISTANCE                      ?
!  PWETL5      PWETL         STOMATAL RESISTANCE LOW VEGETATION        ?
!  PWETH5      PWETH         STOMATAL RESISTANCE HIGH VEGETATION, 
!                            SNOW FREE                                 ?
!  PWETHS5     PWETHS        STOMATAL RESISTANCE HIGH VEGETATION 
!                            WITH SNOW                                 ?

!   OUTPUT PARAMETERS (REAL):

!  Trajectory  Perturbation  Description                               Unit
!  PCPTS5      PCPTS         DRY STATIC ENRGY AT SURFACE               J/kg
!  PCSAT5      PCSAT         MULTIPLICATION FACTOR FOR QS AT SURFACE
!                            FOR SURFACE FLUX COMPUTATION
!  PCAIR5      PCAIR         MULTIPLICATION FACTOR FOR Q AT LOWEST 
!                            MODEL LEVEL FOR SURFACE FLUX COMPUTATION
!  PCSNW5      PCSNW         MULTIPLICATION FACTOR FOR MOISTURE FLUX
!                            COMPUTATION FROM SNOW THROUGH CANOPY (TILE 7)

!     METHOD
!     ------

!     SEE DOCUMENTATION

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
INTEGER(KIND=JPIM),INTENT(IN)    :: KTILE 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTMST 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRVDIFTS
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWLMX5(:)
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)    :: PTSAM1M5(:)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFQ5(:)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWETB5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWETL5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWETH5(:) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWETHS5(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCPTS5(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCSAT5(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCAIR5(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCSNW5(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTMLEV(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQMLEV(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHMS(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSKM1M(:)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSAM1M(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQS(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFQ(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETB(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETL(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETH(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWETHS(:)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTS(:)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCSAT(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCAIR(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCSNW(:)
INTEGER(KIND=JPIM) :: JL

REAL(KIND=JPRB) :: ZRAS(KLON)
REAL(KIND=JPRB) :: ZEP5(KLON), ZEMAX5(KLON), ZCAIR5(KLON), ZCONS5(KLON)
REAL(KIND=JPRB) :: ZZWET5(KLON), ZZWETS5(KLON), Z1S5(KLON), ZDIV15(KLON)
REAL(KIND=JPRB) :: ZDIV25(KLON), ZDIV35(KLON), ZDIV45(KLON), ZDIV55(KLON)

REAL(KIND=JPRB) :: ZCONS12, ZCONS16
REAL(KIND=JPRB) :: ZCONS, ZZWET, ZZWETS, ZEP, ZCAIR, Z1S

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF (LHOOK) CALL DR_HOOK('VEVAPSAD_MOD:VEVAPSAD',0,ZHOOK_HANDLE)
ZCONS12 = (PRVDIFTS*PTMST*RG)/RD
ZCONS16 = 1./(RG*PTMST*PRVDIFTS)

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

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

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

!          2.    COMPUTE EQUIVALENT EFFICIENCY FOR EVAPORATION
!                ------- ---------- ---------- --- -----------

PCSAT5(KIDIA:KFDIA) = 1.0_JPRB
PCAIR5(KIDIA:KFDIA) = 1.0_JPRB

!      interception reservoir

IF(KTILE == 3)THEN
  DO JL=KIDIA,KFDIA
    ZEP5(JL) = ZCONS16*PCFQ5(JL)*(PQMLEV5(JL)-PQS5(JL))
    ZEMAX5(JL) = -PWLMX5(JL)/PTMST
    IF (ZEP5(JL) < 0.0_JPRB .AND. ZEMAX5(JL) < 0.0_JPRB &
     & .AND. ZEP5(JL) < ZEMAX5(JL)) THEN
      ZDIV15(JL) = 1.0_JPRB/ZEP5(JL)
      ZCAIR5(JL) = ZEMAX5(JL)*ZDIV15(JL)
      IF (ZCAIR5(JL) < 1.0_JPRB) THEN
        PCAIR5(JL) = ZCAIR5(JL)
      ELSE
        PCAIR5(JL) = 1.0_JPRB
      ENDIF
      PCSAT5(JL) = PCAIR5(JL)
    ENDIF
  ENDDO
ENDIF

!      LOW VEGETATION

IF (KTILE  ==  4) THEN
  DO JL=KIDIA,KFDIA
    IF (PQMLEV5(JL)  <=  PQS5(JL)) THEN
      ZDIV25(JL) = 1.0_JPRB/(PTMLEV5(JL)*(1.0_JPRB+RETV*PQMLEV5(JL)))  
      ZCONS5(JL) = ZCONS12*PAPHMS5(JL)*ZDIV25(JL)
      ZDIV35(JL) = 1.0_JPRB/ZCONS5(JL)
      ZZWET5(JL) = PWETL5(JL)*ZDIV35(JL)
      PCSAT5(JL) = 1.0_JPRB/(1.0_JPRB+PCFQ5(JL)*ZZWET5(JL))
      PCAIR5(JL) = PCSAT5(JL)
    ENDIF
  ENDDO
ENDIF

!      HIGH VEGETATION (NO SNOW)

IF (KTILE  ==  6) THEN
  DO JL=KIDIA,KFDIA
    IF (PQMLEV5(JL)  <=  PQS5(JL)) THEN
      ZDIV25(JL) = 1.0_JPRB/(PTMLEV5(JL)*(1.0_JPRB+RETV*PQMLEV5(JL)))  
      ZCONS5(JL) = ZCONS12*PAPHMS5(JL)*ZDIV25(JL)
      ZDIV35(JL) = 1.0_JPRB/ZCONS5(JL)
      ZZWET5(JL) = PWETH5(JL)*ZDIV35(JL)
      PCSAT5(JL) = 1.0_JPRB/(1.0_JPRB+PCFQ5(JL)*ZZWET5(JL))
      PCAIR5(JL) = PCSAT5(JL)
    ENDIF
  ENDDO
ENDIF

!      HIGH VEGETATION (WITH UNDERLYING SNOW)

IF (KTILE == 7) THEN
  PCSNW5(KIDIA:KFDIA) = 0.0_JPRB
  DO JL=KIDIA,KFDIA
    IF (PQMLEV5(JL) <= PQS5(JL)) THEN
      IF(PTSKM1M5(JL) > PTSAM1M5(JL)) THEN
        ZRAS(JL)=1200._JPRB/RLHAEROS  
      ELSE
        ZRAS(JL)=1200._JPRB/RLHAERO  
      ENDIF
      ZDIV25(JL) = 1.0_JPRB/(PTMLEV5(JL)*(1.0_JPRB+RETV*PQMLEV5(JL)))  
      ZCONS5(JL) = ZCONS12*PAPHMS5(JL)*ZDIV25(JL)
      ZDIV35(JL) = 1.0_JPRB/ZCONS5(JL)
      ZZWET5(JL) = PWETHS5(JL)*ZDIV35(JL)
      ZZWETS5(JL) = ZRAS(JL)*ZDIV35(JL)
      ZDIV45(JL) = 1.0_JPRB &
       & /(ZZWETS5(JL)+ZZWET5(JL)*PCFQ5(JL)*ZZWETS5(JL)+ZZWET5(JL))
      PCSAT5(JL) = ZZWETS5(JL)*ZDIV45(JL)
      PCAIR5(JL) = PCSAT5(JL)
      IF (PWETHS5(JL) > 1.0_JPRB) THEN
        ZDIV55(JL) = 1.0_JPRB &
         & /(ZZWET5(JL)+ZZWETS5(JL)*PCFQ5(JL)*ZZWET5(JL)+ZZWETS5(JL))
        PCSNW5(JL) = ZZWET5(JL)*ZDIV55(JL)
      ENDIF
    ENDIF
  ENDDO
ENDIF

!      BARE SOIL

IF (KTILE  ==  8) THEN
  DO JL=KIDIA,KFDIA
    IF (PQMLEV5(JL)  <=  PQS5(JL)) THEN
      ZDIV25(JL) = 1.0_JPRB/(PTMLEV5(JL)*(1.0_JPRB+RETV*PQMLEV5(JL)))
      ZCONS5(JL) = ZCONS12*PAPHMS5(JL)*ZDIV25(JL)
      ZDIV35(JL) = 1.0_JPRB/ZCONS5(JL)
      ZZWET5(JL) = PWETB5(JL)*ZDIV35(JL)
      PCSAT5(JL) = 1.0_JPRB/(1.0_JPRB+PCFQ5(JL)*ZZWET5(JL))
      PCAIR5(JL) = PCSAT5(JL)
    ENDIF
  ENDDO
ENDIF

DO JL=KIDIA,KFDIA
  Z1S5(JL) = RCPD*PTSKM1M5(JL)
  PCPTS5(JL) = Z1S5(JL)*(1.0_JPRB+RVTMP2*(PCSAT5(JL)*PQS5(JL) &
   & + (1.0_JPRB-PCAIR5(JL))*PQMLEV5(JL)))  
ENDDO

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

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

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

DO JL=KIDIA,KFDIA
  Z1S = 0.0_JPRB
  Z1S = Z1S+(1.0_JPRB+RVTMP2*(PCSAT5(JL)*PQS5(JL) &
   & + (1.0_JPRB-PCAIR5(JL))*PQMLEV5(JL)))*PCPTS(JL)
  PCSAT(JL) = PCSAT(JL)+Z1S5(JL)*RVTMP2*PQS5(JL)*PCPTS(JL)
  PQS(JL) = PQS(JL)+Z1S5(JL)*RVTMP2*PCSAT5(JL)*PCPTS(JL)
  PQMLEV(JL) = PQMLEV(JL)+Z1S5(JL)*RVTMP2*(1.0_JPRB-PCAIR5(JL))*PCPTS(JL)
  PCAIR(JL) = PCAIR(JL)-Z1S5(JL)*RVTMP2*PQMLEV5(JL)*PCPTS(JL)
  PCPTS(JL) = 0.0_JPRB
  PTSKM1M(JL) = PTSKM1M(JL)+RCPD*Z1S
ENDDO

!      BARE SOIL

IF (KTILE  ==  8) THEN
  DO JL=KIDIA,KFDIA
    ZCONS = 0.0_JPRB
    ZZWET = 0.0_JPRB
    IF (PQMLEV5(JL) <= PQS5(JL)) THEN 
      PCSAT(JL) = PCSAT(JL)+PCAIR(JL)
      PCAIR(JL) = 0.0_JPRB
      ZZWET = ZZWET-PCSAT5(JL)*PCSAT5(JL)*PCFQ5(JL)*PCSAT(JL)
      PCFQ(JL) = PCFQ(JL)-PCSAT5(JL)*PCSAT5(JL)*ZZWET5(JL)*PCSAT(JL)
      PCSAT(JL) = 0.0_JPRB
      PWETB(JL) = PWETB(JL)+ZDIV35(JL)*ZZWET
      ZCONS = ZCONS-PWETB5(JL)*ZDIV35(JL)*ZDIV35(JL)*ZZWET

      PAPHMS(JL) = PAPHMS(JL)+ZCONS12*ZDIV25(JL)*ZCONS
      PQMLEV(JL) = PQMLEV(JL)-ZCONS12*PAPHMS5(JL)*ZDIV25(JL)*ZDIV25(JL) &
       & *RETV*PTMLEV5(JL)*ZCONS
      PTMLEV(JL) = PTMLEV(JL)-ZCONS12*PAPHMS5(JL)*ZDIV25(JL)*ZDIV25(JL) &
       & *(1.0_JPRB+RETV*PQMLEV5(JL))*ZCONS
    ENDIF
  ENDDO
ENDIF

!      HIGH VEGETATION (WITH UNDERLYING SNOW)

IF (KTILE == 7) THEN
  DO JL=KIDIA,KFDIA
    ZCONS  = 0.0_JPRB
    ZZWET  = 0.0_JPRB
    ZZWETS = 0.0_JPRB
    IF (PQMLEV5(JL) <= PQS5(JL)) THEN
      IF (PWETHS5(JL) > 1.0_JPRB) THEN
        ZZWET = ZZWET+ZDIV55(JL)*ZDIV55(JL)*ZZWETS5(JL)*PCSNW(JL)
        PCFQ(JL) = PCFQ(JL)-ZDIV55(JL)*ZDIV55(JL)*ZZWET5(JL) &
         & *ZZWETS5(JL)*ZZWET5(JL)*PCSNW(JL)
        ZZWETS = ZZWETS-ZDIV55(JL)*ZDIV55(JL)*ZZWET5(JL) &
         & *(PCFQ5(JL)*ZZWET5(JL)+1.0_JPRB)*PCSNW(JL)
        PCSNW(JL) = 0.0_JPRB
      ENDIF
      PCSAT(JL) = PCSAT(JL)+PCAIR(JL)
      PCAIR(JL) = 0.0_JPRB
      ZZWETS = ZZWETS+ZDIV45(JL)*ZDIV45(JL)*ZZWET5(JL)*PCSAT(JL)
      PCFQ(JL) = PCFQ(JL)-ZDIV45(JL)*ZDIV45(JL)*ZZWETS5(JL) &
       & *ZZWET5(JL)*ZZWETS5(JL)*PCSAT(JL)
      ZZWET = ZZWET-ZDIV45(JL)*ZDIV45(JL)*ZZWETS5(JL) &
       & *(PCFQ5(JL)*ZZWETS5(JL)+1.0_JPRB)*PCSAT(JL)
      PCSAT(JL) = 0.0_JPRB
      ZCONS = ZCONS-ZRAS(JL)*ZDIV35(JL)*ZDIV35(JL)*ZZWETS
      PWETHS(JL) = PWETHS(JL)+ZDIV35(JL)*ZZWET
      ZCONS = ZCONS-ZDIV35(JL)*ZDIV35(JL)*PWETHS5(JL)*ZZWET

      PAPHMS(JL) = PAPHMS(JL)+ZCONS12*ZDIV25(JL)*ZCONS
      PQMLEV(JL) = PQMLEV(JL)-ZCONS12*PAPHMS5(JL)*ZDIV25(JL)*ZDIV25(JL) &
       & *RETV*PTMLEV5(JL)*ZCONS
      PTMLEV(JL) = PTMLEV(JL)-ZCONS12*PAPHMS5(JL)*ZDIV25(JL)*ZDIV25(JL) &
       & *(1.0_JPRB+RETV*PQMLEV5(JL))*ZCONS
    ENDIF
  ENDDO
  PCSNW (KIDIA:KFDIA) = 0.0_JPRB
ENDIF

!      HIGH VEGETATION (NO SNOW)

IF (KTILE  ==  6) THEN
  DO JL=KIDIA,KFDIA
    ZCONS = 0.0_JPRB
    ZZWET = 0.0_JPRB
    IF (PQMLEV5(JL)  <=  PQS5(JL)) THEN
      PCSAT(JL) = PCSAT(JL)+PCAIR(JL)
      PCAIR(JL) = 0.0_JPRB
      ZZWET = ZZWET-PCSAT5(JL)*PCSAT5(JL)*PCFQ5(JL)*PCSAT(JL)
      PCFQ(JL) = PCFQ(JL)-PCSAT5(JL)*PCSAT5(JL)*ZZWET5(JL)*PCSAT(JL)
      PCSAT(JL) = 0.0_JPRB
      PWETH(JL) = PWETH(JL)+ZDIV35(JL)*ZZWET
      ZCONS = ZCONS-ZDIV35(JL)*ZDIV35(JL)*PWETH5(JL)*ZZWET

      PAPHMS(JL) = PAPHMS(JL)+ZCONS12*ZDIV25(JL)*ZCONS
      PQMLEV(JL) = PQMLEV(JL)-ZCONS12*PAPHMS5(JL)*ZDIV25(JL)*ZDIV25(JL) &
       & *RETV*PTMLEV5(JL)*ZCONS
      PTMLEV(JL) = PTMLEV(JL)-ZCONS12*PAPHMS5(JL)*ZDIV25(JL)*ZDIV25(JL) &
       & *(1.0_JPRB+RETV*PQMLEV5(JL))*ZCONS
    ENDIF
  ENDDO
ENDIF

IF (KTILE  ==  4) THEN
  DO JL=KIDIA,KFDIA
    ZCONS = 0.0_JPRB
    ZZWET = 0.0_JPRB
    IF (PQMLEV5(JL)  <=  PQS5(JL)) THEN
      PCSAT(JL) = PCSAT(JL)+PCAIR(JL)
      PCAIR(JL) = 0.0_JPRB
      ZZWET = ZZWET-PCSAT5(JL)*PCSAT5(JL)*PCFQ5(JL)*PCSAT(JL)
      PCFQ(JL) = PCFQ(JL)-PCSAT5(JL)*PCSAT5(JL)*ZZWET5(JL)*PCSAT(JL)
      PCSAT(JL) = 0.0_JPRB
      PWETL(JL) = PWETL(JL)+ZDIV35(JL)*ZZWET
      ZCONS = ZCONS-ZDIV35(JL)*ZDIV35(JL)*PWETL5(JL)*ZZWET

      PAPHMS(JL) = PAPHMS(JL)+ZCONS12*ZDIV25(JL)*ZCONS
      PQMLEV(JL) = PQMLEV(JL)-ZCONS12*PAPHMS5(JL)*ZDIV25(JL)*ZDIV25(JL) &
       & *RETV*PTMLEV5(JL)*ZCONS
      PTMLEV(JL) = PTMLEV(JL)-ZCONS12*PAPHMS5(JL)*ZDIV25(JL)*ZDIV25(JL) &
       & *(1.0_JPRB+RETV*PQMLEV5(JL))*ZCONS
    ENDIF
  ENDDO
ENDIF

!      interception reservoir

IF(KTILE == 3)THEN
  DO JL=KIDIA,KFDIA
    ZEP   = 0.0_JPRB
    ZCAIR = 0.0_JPRB
    IF (ZEP5(JL) < 0.0_JPRB .AND. ZEMAX5(JL) < 0.0_JPRB &
     & .AND. ZEP5(JL) < ZEMAX5(JL)) THEN
      PCAIR(JL) = PCAIR(JL)+PCSAT(JL)
      PCSAT(JL) = 0.0_JPRB
      IF (ZCAIR5(JL) < 1.0_JPRB) THEN
        ZCAIR = ZCAIR+PCAIR(JL)
      ENDIF
      PCAIR(JL) = 0.0_JPRB
      ZEP = ZEP-ZEMAX5(JL)*ZDIV15(JL)*ZDIV15(JL)*ZCAIR
    ENDIF
    PCFQ(JL) = PCFQ(JL)+ZCONS16*(PQMLEV5(JL)-PQS5(JL))*ZEP
    PQMLEV(JL) = PQMLEV(JL)+ZCONS16*PCFQ5(JL)*ZEP
    PQS(JL) = PQS(JL)-ZCONS16*PCFQ5(JL)*ZEP
  ENDDO
ENDIF
      
PCAIR (KIDIA:KFDIA) = 0.0_JPRB
PCSAT (KIDIA:KFDIA) = 0.0_JPRB

IF (LHOOK) CALL DR_HOOK('VEVAPSAD_MOD:VEVAPSAD',1,ZHOOK_HANDLE)
END SUBROUTINE VEVAPSAD
END MODULE VEVAPSAD_MOD
