!OPTIONS XOPT(HSFUN)
SUBROUTINE VDFEXCUSTL (KIDIA, KFDIA, KLON, KLEV, PTMST,&
 & PZ0MM5 ,&
 & PUM15  ,PVM15  ,PTM15  ,PQM15 , &
 & PAPHM15,PGEOM15,PGEOH5 ,PCPTGZ5,&
 & PKMFL5 ,PKHFL5 ,PKQFL5 ,PZINV5,&
 & PCFM5 ,PCFH5, &
 & PZ0MM  , &
 & PUM1   ,PVM1   ,PTM1   ,PQM1 , &
 & PAPHM1 ,PGEOM1 ,PGEOH  ,PCPTGZ ,PCFM ,PCFH)  
!     ------------------------------------------------------------------

!**   *VDFEXCUSTL* - DETERMINES THE EXCHANGE COEFFICIENTS BETWEEN THE
!                    UPPER MODEL LEVELS WITH STABILITY AS A FUNCTION OF
!                    RICHARDSON NUMBER
!                    (Tangent linear)

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

!     Modified by
!     -----------
!     M. Janiskova     03/10/07  add mixed layer
!                                reduce K towards MO higher up (as in NL code)
!     M. Janiskova     19/12/07  modified wind shear for Ri computation
!     M. Janiskova     08/08/08  bug correction
!     M. Janiskova      15/09/09  perturbation of K not used above 0.1 hPa

!     PURPOSE
!     -------

!     DETERMINE EXCHANGE COEFFICIENTS BETWEEN THE UPPER MODEL LEVELS

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

!     *VDFEXCUSTL* IS CALLED BY *VDFMAINSTL*

!*      INPUT PARAMETERS (INTEGER):

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

!*      INPUT PARAMETERS (REAL):

!     *PTMST*        DOUBLE TIME STEP (SINGLE AT 1TH STEP)

!*      INPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                               Unit
!  PUM15       PUM1          X-VELOCITY COMPONENT AT T-1               m/s
!  PVM15       PVM1          Y-VELOCITY COMPONENT AT T-1               m/s
!  PTM15       PTM1          TEMPERATURE AT T-1                        K
!  PQM15       PQM1          SPECIFIC HUMUDITY AT T-1                  kg/kg
!  PAPHM15     PAPHM1        PRESSURE AT T-1                           Pa
!  PGEOM15     PGEOM1        GEOPOTENTIAL AT T-1                       m2/s2
!  PGEOH5      PGEOH         GEOPOTENTIAL AT HALF LEVELS, T-1          m2/s2
!  PCPTGZ5     PCPTGZ        DRY STATIC ENERGY                         J/kg
!  PKMFL5      ---           KINEMATIC MOMENTUM FLUX   
!  PKHFL5      ---           KINEMATIC HEAT FLUX       
!  PKQFL5      ---           KINEMATIC MOISTURE FLUX  
!  PZINV5      ---           INVERSION HEIGHT 

!*      OUTPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                               Unit
!  PCFM5       PCFM          PROP. TO EXCH. COEFF. FOR MOMENTUM 
!                                              (C-STAR IN DOC.)       
!  PCFH5       PCFH          PROP. TO EXCH. COEFF. FOR HEAT  
!                                              (C-STAR IN DOC.)       
!                            (ONLY PCFM(*,1:KLEV-1) AND
!                             PCFH(*,1:KLEV-1) ARE COMPUTED)

!     METHOD
!     ------

!     SEE DOCUMENTATION

!     THE EXCHANGE COEFFICIENTS ARE EXPRESSED ACCORDING TO 
!     LOUIS et al. (1982) PROPOSAL NEAR THE SURFACE.  HIGHER
!     UP MONIN-OBUKOV VALUES ARE USED WITH A LENGTH SCALE OF 
!     300 M (150M).
!     POSSIBILITY TO USE LOUIS et al. (1982) PROPOSAL IN STABLE
!     SITUATIONS STILL KEPT.

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

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

USE YOMCST   , ONLY : RG       ,RD       ,RCPD     ,RETV
USE YOEVDF   , ONLY : RLAM     ,RKAP     ,RVDIFTS  ,REPDU2
USE YOEVDFS  , ONLY : JPRITBL  ,RITBL    ,ARITBL   ,&
                    & RCHETA   ,RCHETB   ,RIMAX    ,&
                    & DRITBL   ,DRI26 
USE YOEPHLI  , ONLY : RLPCC    ,RLPMIXL  ,RLPBETA
USE YOPHNC   , ONLY : LEKPERT

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 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTMST 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ0MM5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM15(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOH5(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTGZ5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKMFL5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKHFL5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKQFL5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZINV5(KLON)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFM5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFH5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ0MM(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOH(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTGZ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFH(KLON,KLEV) 

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

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

REAL(KIND=JPRB) ::    ZRI5(KLON),ZDU15(KLON),ZDU25(KLON),ZMGEOM5(KLON)
REAL(KIND=JPRB) ::    ZUST5(KLON),ZDTV5(KLON),ZDTVR5(KLON),ZKHVFL5(KLON)
REAL(KIND=JPRB) ::    ZL5(KLON),ZLI5(KLON),ZPHIM5(KLON),ZPHIH5(KLON)
REAL(KIND=JPRB) ::    ZRI (KLON),ZDU1 (KLON),ZDU2 (KLON),ZMGEOM (KLON)
REAL(KIND=JPRB) ::    ZDTV(KLON),ZDTVR(KLON),ZPHIM(KLON),ZPHIH(KLON)

REAL(KIND=JPRB) :: Z1S5, Z2S5, Z3S5, Z4S5, Z5S5, Z6S5, &
 &                 ZDRORO5, ZETA5, ZA5, ZB5, ZIFMOM5, ZIFMOH5, &
 &                 ZDUDZ5, ZDUDZ15, ZDUDZ25, &
 &                 ZZH5, ZSCF5, ZIFLTGM5, ZIFLTGH5, &
 &                 ZBM5, ZBH5, ZCM5, ZCH5, Z2GEOMF5, ZLIM5, ZLIM25, &
 &                 ZALH25, ZALM25, ZCFNC5, ZZI5, ZZI25, &
 &                 ZZ5, ZDH5, ZDL5, ZPHIKH5, ZPHIKM5, ZPHIKHI5, ZPHIKMI5,&
 &                 ZDHZZ5, ZWTVENTR5, ZKH5, ZCFHNEW5, ZCFNC15
REAL(KIND=JPRB) :: ZSQRT15, ZSQRT25, ZSQRT35, ZSQRT45, ZSQRT55, ZSQRT65
REAL(KIND=JPRB) :: ZPAP5

REAL(KIND=JPRB) :: Z1S, Z2S, Z3S, Z4S, Z5S, Z6S, &
 &                 ZDRORO, ZETA, ZA, ZB, ZIFMOM, ZIFMOH, &
 &                 ZDUDZ, ZDUDZ1, ZDUDZ2, &
 &                 ZZH, ZSCF, ZIFLTGM, ZIFLTGH, &
 &                 ZBM, ZBH, ZCM, ZCH, Z2GEOMF, ZLIM, ZLIM2, &
 &                 ZALH2, ZALM2, ZCFNC, ZZI, ZZI2, &
 &                 ZZ, ZDH, ZDL, ZPHIKH, ZPHIKM, ZPHIKHI, ZPHIKMI, &
 &                 ZDHZZ, ZKH, ZCFHNEW, ZCFNC1

REAL(KIND=JPRB) :: ZENTRSFC, ZCB, ZCD, ZEPS, ZLENMO, ZX2, ZRIMIN
REAL(KIND=JPRB) :: ZCONS2, ZCONS3, ZCONS23, ZCONS8, ZCONS9, &
 &                 ZCONS10, ZCONS11, ZCONS13, ZCC, ZRG, &
 &                 ZUMBETA, ZCONSHG, ZHLM, ZHLM2, ZREPUST
REAL(KIND=JPRB) :: ZAAA , ZCCC , ZDDD , ZAAA1, ZCCC1, ZDDD1
REAL(KIND=JPRB) :: ZAAA2, ZCCC2, ZDDD2
REAL(KIND=JPRB) :: ZZW5(KLON)

LOGICAL :: LLMONOB

REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "surf_inq.h"
END INTERFACE

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

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

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

! logical switch for using either Monin-Obuchov (true) or Louis (false)
! for stable conditions

LLMONOB = .TRUE.
!LLMONOB = .FALSE.

! different constants

ZENTRSFC  = 0.2_JPRB       ! factor for surface based top entrainment 
ZCD       = 1.0_JPRB
ZCB       = 5.0_JPRB
ZEPS      = 1.E-10_JPRB
!or ZLENMO    = 150.0_JPRB
ZLENMO    = 300.0_JPRB
ZRIMIN    = 1.E-3_JPRB

ZCONS2    = (0.5_JPRB*RKAP)/RG
ZCONS3    = 1.0_JPRB/RLAM
ZCONS23   = ZCONS2*ZCONS3

ZCC       = RLPCC
ZCONS8    = 2.0_JPRB*ZCB
ZCONS9    = 3._JPRB*ZCB
ZCONS10   = (RVDIFTS*PTMST*RG**2)/(0.5_JPRB*RD)
ZCONS11   = (3._JPRB*ZCB*ZCC)/SQRT(27._JPRB)
ZUMBETA   = 1.0_JPRB - RLPBETA
ZCONSHG   = 2.0_JPRB*RG
ZHLM      = ZCONSHG*RLPMIXL
ZHLM2     = ZHLM*ZHLM

CALL SURF_INQ(PREPUST=ZREPUST)

! optimization
ZRG       = 1.0_JPRB/RG
ZCONS13   = 1.0_JPRB/3._JPRB

!     CONSTANTS FOR REGULARIZATION

ZAAA=10.0_JPRB
ZCCC=0.0416277_JPRB
ZAAA1=30.0_JPRB
ZCCC1=0.031838_JPRB
ZAAA2=5.0_JPRB
ZCCC2=0.075871_JPRB
!ZAAA3=20.0_JPRB
!ZCCC3=0.0588705_JPRB

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

IF (LEKPERT) THEN
  DO JL = KIDIA, KFDIA
    ZZW5(JL)=SQRT(PUM15(JL,KLEV)**2+PVM15(JL,KLEV)**2)
  ENDDO
ENDIF

!*         2.     PREPARE SCALING COEFFICIENTS FOR MIXED LAYER
!                 --------------------------------------------

DO JL=KIDIA,KFDIA
  ZUST5 (JL)=MAX(SQRT(PKMFL5(JL)),ZREPUST)
  ZKHVFL5(JL)=PKHFL5(JL)+RETV*PTM15(JL,KLEV)*PKQFL5(JL)
  IF (ZKHVFL5(JL)  <  0.0_JPRB) THEN
    ZL5 (JL) = ZUST5(JL)**3*PTM15(JL,KLEV)/(RKAP*RG*(ZKHVFL5(JL)-ZEPS))
    ZLI5(JL) = 1.0_JPRB/ZL5(JL) 
  ENDIF
ENDDO

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

!        3. VERTICAL LOOP
!           -------- ----

!***  
DO JK = KLEV-1, 1, -1
!***

  DO JL = KIDIA, KFDIA
    PCFM (JL,JK) = 0.0_JPRB
    PCFM5(JL,JK) = 0.0_JPRB
    PCFH (JL,JK) = 0.0_JPRB
    PCFH5(JL,JK) = 0.0_JPRB
  ENDDO

  DO JL = KIDIA, KFDIA

!*          COMPUTE RI-NUMBER

    ZMGEOM (JL) = PGEOM1 (JL,JK)-PGEOM1 (JL,JK+1)
    ZMGEOM5(JL) = PGEOM15(JL,JK)-PGEOM15(JL,JK+1)

    Z1S  = 2.0_JPRB*((PUM1 (JL,JK)-PUM1 (JL,JK+1))*&
     & (PUM15(JL,JK)-PUM15(JL,JK+1))+&
     & (PVM1 (JL,JK)-PVM1 (JL,JK+1))*&
     & (PVM15(JL,JK)-PVM15(JL,JK+1)))  
    Z1S5 = (PUM15(JL,JK)-PUM15(JL,JK+1))**2+(PVM15(JL,JK)-PVM15(JL,JK+1))**2
    IF (REPDU2 >= Z1S5) THEN
      ZDU1 (JL) = 0.0_JPRB
      ZDU15(JL) = REPDU2
    ELSE
      ZDU1 (JL) = Z1S
      ZDU15(JL) = Z1S5
    ENDIF
    ZSQRT15 = SQRT(ZDU15(JL))
    ZDUDZ1  = 0.5_JPRB*RG*ZDU1(JL)/(ZSQRT15*ZMGEOM5(JL)) &
     & -RG*ZSQRT15*ZMGEOM(JL)/ZMGEOM5(JL)**2
    ZDUDZ15 = ZSQRT15/ZMGEOM5(JL)*RG              !shear

!     shear factor: f=27.2 * (1-p/ps) * exp(-10*(1-p/ps))
!                   f=0 at p/ps=0 and 1
!                   max(f)=1.0 at p/ps=0.9

    ZDUDZ2  = ZDUDZ1
    ZDUDZ25 = ZDUDZ15 + 0.005_JPRB  &
     & * 27.2_JPRB*(1.0_JPRB - PAPHM15(JL,JK)/PAPHM15(JL,KLEV)) &
     & * EXP(-10.0_JPRB*(1.0_JPRB - PAPHM15(JL,JK)/PAPHM15(JL,KLEV)))
    ZDU2 (JL) = 2.0_JPRB*(ZDUDZ25*ZMGEOM5(JL)*ZRG**2) &
     & *(ZDUDZ25*ZMGEOM(JL)+ZMGEOM5(JL)*ZDUDZ2)
    ZDU25(JL) = (ZDUDZ25*ZMGEOM5(JL)*ZRG) **2

    ZDRORO  = 2.0_JPRB*(&
     & (2.0_JPRB*PCPTGZ5(JL,JK+1)-PGEOM15(JL,JK)-&
     & PGEOM15(JL,JK+1))*PCPTGZ(JL,JK  )/&
     & (PCPTGZ5(JL,JK)+PCPTGZ5(JL,JK+1)-PGEOM15(JL,JK)-&
     & PGEOM15(JL,JK+1))**2 -                          &
     & (2.0_JPRB*PCPTGZ5(JL,JK  )-PGEOM15(JL,JK)-&
     & PGEOM15(JL,JK+1))*PCPTGZ(JL,JK+1)/&
     & (PCPTGZ5(JL,JK)+PCPTGZ5(JL,JK+1)-PGEOM15(JL,JK)-&
     & PGEOM15(JL,JK+1))**2 +&
     & (PGEOM1 (JL,JK)+PGEOM1 (JL,JK+1))*&
     & (PCPTGZ5(JL,JK)-PCPTGZ5(JL,JK+1))/ &
     & (PCPTGZ5(JL,JK)+PCPTGZ5(JL,JK+1)-PGEOM15(JL,JK)-&
     & PGEOM15(JL,JK+1))**2 ) +&
     & RETV*(PQM1 (JL,JK)-PQM1 (JL,JK+1))   
    ZDRORO5 = 2.0_JPRB*(PCPTGZ5(JL,JK)-PCPTGZ5(JL,JK+1))/&
     & (PCPTGZ5(JL,JK)+PCPTGZ5(JL,JK+1)-PGEOM15(JL,JK)-&
     & PGEOM15(JL,JK+1))+&
     & RETV*(PQM15(JL,JK)-PQM15(JL,JK+1))  
    ZDTV(JL) = (1.0_JPRB+0.5_JPRB*RETV*(PQM15(JL,JK)-PQM15(JL,JK+1))) &
     & *PCPTGZ(JL,JK) &
     & +(0.5_JPRB*RETV*(PQM15(JL,JK)-PQM15(JL,JK+1))-1.0_JPRB) &
     & *PCPTGZ(JL,JK+1) &
     & +0.5_JPRB*RETV*(PCPTGZ5(JL,JK)+PCPTGZ5(JL,JK+1)) &
     & *(PQM1(JL,JK)-PQM1(JL,JK+1))
    ZDTV5(JL)= PCPTGZ5(JL,JK)-PCPTGZ5(JL,JK+1) &
     & + RETV * 0.5_JPRB * (PQM15(JL,JK)-PQM15(JL,JK+1))&
     & * (PCPTGZ5(JL,JK)+PCPTGZ5(JL,JK+1))
    ZDTVR (JL) = -RCPD*ZDTV(JL)/ZDTV5(JL)**2
    ZDTVR5(JL) = RCPD/ZDTV5(JL) 
! for regularization
    ZDTVR (JL) = 0.0_JPRB

    ZRI (JL) = ZMGEOM (JL)*ZDRORO5/ZDU25(JL) +&
     & ZMGEOM5(JL)*ZDRORO /ZDU25(JL) -&
     & ZMGEOM5(JL)*ZDRORO5*ZDU2 (JL)/ZDU25(JL)**2  
    ZRI5(JL) = ZMGEOM5(JL)*ZDRORO5/ZDU25(JL)
  ENDDO

  DO JL = KIDIA, KFDIA

!           COMPUTE STABILITY FUNCTIONS

    IF (ZRI5(JL) > 0.0_JPRB .AND. LLMONOB) THEN

      IRIB=INT(ZRI5(JL)*(1.0_JPRB/DRITBL))+1
      IF (IRIB  >=  JPRITBL) THEN
!           LINEAR EXTENSION OF LOOK-UP TABLE
        ZETA  = RITBL(JPRITBL)*(ZRI (JL)*(1.0_JPRB/RIMAX))
        ZETA5 = RITBL(JPRITBL)*(ZRI5(JL)*(1.0_JPRB/RIMAX))
      ELSE
        ZX2 = IRIB*DRITBL
        ZA  = -ZRI(JL)*(1.0_JPRB/DRITBL)
        ZA5 = (ZX2-ZRI5(JL))*(1.0_JPRB/DRITBL)
        ZB  = -ZA
        ZB5 = 1.0_JPRB-ZA5
        ZETA  = ZA*RITBL(IRIB) + ZB*RITBL(IRIB+1)&
         & +( (3.0_JPRB*ZA5**2*ZA-ZA)*ARITBL(IRIB)&
         & +( 3.0_JPRB*ZB5**2*ZB-ZB)*ARITBL(IRIB+1) )*DRI26
        ZETA5 = ZA5*RITBL(IRIB) + ZB5*RITBL(IRIB+1)&
         & +( (ZA5**3-ZA5)*ARITBL(IRIB)&
         & +(  ZB5**3-ZB5)*ARITBL(IRIB+1) )*DRI26
      ENDIF

!           STABLE PHI-FUNCTIONS

      ZPHIM (JL) = RCHETA*ZETA
      ZPHIM5(JL) = 1.0_JPRB+RCHETA*ZETA5
!err      ZPHIH (JL) = 2.0_JPRB*RCHETB*ZETA*(1.0_JPRB+RCHETB*ZETA5)**2
      ZPHIH (JL) = 2.0_JPRB*RCHETB*ZETA*(1.0_JPRB+RCHETB*ZETA5)
      ZPHIH5(JL) =  (1.0_JPRB+RCHETB*ZETA5)**2
    ENDIF

  ENDDO

  DO JL = KIDIA, KFDIA

    IF (ZRI5(JL) > 0.0_JPRB) THEN  ! statically stable

      IF (LLMONOB) THEN  ! Monin-Obuchov 

!           COMMON FACTORS FOR STABLE AND UNSTABLE
!           new K: K,LTG scales with l=kappa*z 
!                  K,MO  scales with l=150m above surface layer

        ZIFMOM  = -2.0_JPRB*ZPHIM(JL)/(ZPHIM5(JL)**3)
        ZIFMOM5 = 1.0_JPRB / (ZPHIM5(JL)**2)                 !F(MO),M
        ZIFMOH5 = 1.0_JPRB / (ZPHIM5(JL)*ZPHIH5(JL))         !F(MO),H
        ZIFMOH  = (-ZPHIM5(JL)*ZPHIH(JL)-ZPHIH5(JL)*ZPHIM(JL)) &
         & *ZIFMOH5*ZIFMOH5
        ZSQRT25 = SQRT(ZDU25(JL))
        ZDUDZ  = 0.5_JPRB*RG*ZDU2(JL)/(ZSQRT25*ZMGEOM5(JL)) &
         & -RG*ZSQRT25*ZMGEOM(JL)/ZMGEOM5(JL)**2
        ZDUDZ5 = ZSQRT25/ZMGEOM5(JL)*RG              !shear

        ZZH  = 0.5_JPRB*ZRG*(PGEOM1 (JL,JK)+PGEOM1 (JL,JK+1))+PZ0MM(JL)
        ZZH5 = 0.5_JPRB*ZRG*(PGEOM15(JL,JK)+PGEOM15(JL,JK+1))+PZ0MM5(JL)
        ZSCF5 = SQRT(1.0_JPRB+ZCD*ZRI5(JL))
        ZSCF  = ZCD*ZRI(JL)/(2.0_JPRB*ZSCF5)
        ZIFLTGM = 2.0_JPRB*ZCB*(ZRI5(JL)*ZSCF-ZSCF5*ZRI(JL)) &
         & /(ZSCF5+2.0_JPRB*ZCB*ZRI5(JL))**2
!        ZIFLTGM5 = 1.0_JPRB/(1.0_JPRB+2.0_JPRB*ZCB*ZRI5(JL)/ZSCF5) !F(LTG),M
        ZIFLTGM5 = ZSCF5/(ZSCF5+2.0_JPRB*ZCB*ZRI5(JL))              !F(LTG),M
        ZIFLTGH5 = 1.0_JPRB/(1.0_JPRB+2.0_JPRB*ZCB*ZRI5(JL)*ZSCF5)  !F(LTG),H
        ZIFLTGH = -2.0_JPRB*ZCB*(ZRI5(JL)*ZSCF+ZSCF5*ZRI(JL)) &
         & *ZIFLTGH5*ZIFLTGH5

        ZSQRT35 = SQRT(ZIFLTGM5)
        ZBM  = RKAP*ZSQRT35*ZZH+0.5_JPRB*RKAP*ZZH5*ZIFLTGM/ZSQRT35
        ZBM5 = RKAP*ZZH5*ZSQRT35
        ZSQRT45 = SQRT(ZIFLTGH5)
        ZBH  = RKAP*ZSQRT45*ZZH+0.5_JPRB*RKAP*ZZH5*ZIFLTGH/ZSQRT45
        ZBH5 = RKAP*ZZH5*ZSQRT45

        ZSQRT55 = SQRT(ZIFMOM5)
        ZCM  = 0.5_JPRB*ZLENMO*ZIFMOM/ZSQRT55
        ZCM5 = ZLENMO*ZSQRT55
        ZSQRT65 = SQRT(ZIFMOH5)
        ZCH  = 0.5_JPRB*ZLENMO*ZIFMOH/ZSQRT65
        ZCH5 = ZLENMO*ZSQRT65

        PCFM(JL,JK)  = ZDUDZ*(ZBM5*ZCM5/(ZBM5+ZCM5))**2 &
         & +2.0_JPRB*ZDUDZ5*ZBM5*ZCM5*(ZCM*ZBM5**2+ZBM*ZCM5**2) &
         & /(ZBM5+ZCM5)**3
        PCFM5(JL,JK) = ZDUDZ5*(ZBM5*ZCM5/(ZBM5+ZCM5))**2
        PCFH (JL,JK) = ZDUDZ*(ZBH5*ZCH5/(ZBH5+ZCH5))**2 &
         & +2.0_JPRB*ZDUDZ5*ZBH5*ZCH5*(ZCH*ZBH5**2+ZBH*ZCH5**2) &
         & /(ZBH5+ZCH5)**3
        PCFH5(JL,JK) = ZDUDZ5*(ZBH5*ZCH5/(ZBH5+ZCH5))**2

      ELSE  ! Louis
        Z2GEOMF  =PGEOM1 (JL,JK)+PGEOM1 (JL,JK+1)+ZCONSHG*PZ0MM (JL)
        Z2GEOMF5 =PGEOM15(JL,JK)+PGEOM15(JL,JK+1)+ZCONSHG*PZ0MM5(JL)
        ZLIM  = -    2.0_JPRB*ZUMBETA*     Z2GEOMF *Z2GEOMF5 /ZHLM2/&
         & (1.0_JPRB+(Z2GEOMF5*Z2GEOMF5)/ZHLM2)**2  
        ZLIM5 = RLPBETA+ZUMBETA/(1.0_JPRB+(Z2GEOMF5*Z2GEOMF5)/ZHLM2)
        ZLIM2  = 2.0_JPRB*ZLIM *ZLIM5
        ZLIM25 =    ZLIM5*ZLIM5
        ZALM2  =&
         & ZLIM2 *((ZCONS2*Z2GEOMF5)/(1.0_JPRB+ZCONS23*Z2GEOMF5))**2+&
         & 2.0_JPRB*ZLIM25*ZCONS2*ZCONS2*Z2GEOMF*Z2GEOMF5/&
         & (1.0_JPRB+ZCONS23*Z2GEOMF5)**3  
        ZALM25 =ZLIM25*((ZCONS2*Z2GEOMF5)/(1.0_JPRB+ZCONS23*Z2GEOMF5))**2
        ZALH2  = ZALM2
        ZALH25 = ZALM25

        ZSQRT25 = SQRT(ZDU25(JL))
        ZCFNC  = 0.5_JPRB*RG*ZDU2(JL)/(ZSQRT25*ZMGEOM5(JL)) &
         & -RG*ZSQRT25*ZMGEOM(JL)/ZMGEOM5(JL)**2
        ZCFNC5 = RG*ZSQRT25/ZMGEOM5(JL)
        ZSCF5 = SQRT(1.0_JPRB+ZCD*ZRI5(JL))
        ZSCF  = ZCD*ZRI(JL)/(2.0_JPRB*ZSCF5)

!           DIMENSIONLESS COEFFICIENTS MULTIPLIED BY PRESSURE
!           THICKNESSES FOR MOMENTUM AND HEAT EXCHANGE.

        PCFM (JL,JK) = (ZCFNC *ZALM25 +ZCFNC5*ZALM2)/&
         & (1.0_JPRB+ZCONS8*ZRI5(JL)/ZSCF5) -&
         & (ZCFNC5*ZALM25)*(ZCONS8*ZRI(JL)/ZSCF5)/&
         & (1.0_JPRB+ZCONS8*ZRI5(JL)/ZSCF5)**2 +&
         & (ZCFNC5*ZALM25)*ZCONS8*ZRI5(JL)*ZSCF/&
         & (ZSCF5+ZCONS8*ZRI5(JL))**2
        PCFM5(JL,JK) = (ZCFNC5*ZALM25)/(1.0_JPRB+ZCONS8*ZRI5(JL)/ZSCF5)
        PCFH (JL,JK) = (ZCFNC *ZALH25 +ZCFNC5*ZALH2)/&
         & (1.0_JPRB+ZCONS9*ZRI5(JL)*ZSCF5) -&
         & (ZCFNC5*ZALH25)*(ZCONS9*ZRI (JL)*ZSCF5)/&
         & (1.0_JPRB+ZCONS9*ZRI5(JL)*ZSCF5)**2 -&
         & (ZCFNC5*ZALH25)*(ZCONS9*ZRI5(JL)*ZSCF )/&
         & (1.0_JPRB+ZCONS9*ZRI5(JL)*ZSCF5)**2
        PCFH5(JL,JK) = (ZCFNC5*ZALH25)/(1.0_JPRB+ZCONS9*ZRI5(JL)*ZSCF5)
      ENDIF

    ELSE  ! statically unstable

!           COMMON FACTORS FOR STABLE AND UNSTABLE

      Z2GEOMF  =PGEOM1 (JL,JK)+PGEOM1 (JL,JK+1)+ZCONSHG*PZ0MM (JL)
      Z2GEOMF5 =PGEOM15(JL,JK)+PGEOM15(JL,JK+1)+ZCONSHG*PZ0MM5(JL)
      ZLIM  = -    2.0_JPRB*ZUMBETA*     Z2GEOMF *Z2GEOMF5 /ZHLM2/&
       & (1.0_JPRB+(Z2GEOMF5*Z2GEOMF5)/ZHLM2)**2
      ZLIM5 = RLPBETA+ZUMBETA/(1.0_JPRB+(Z2GEOMF5*Z2GEOMF5)/ZHLM2)
      ZLIM2  = 2.0_JPRB*ZLIM *ZLIM5
      ZLIM25 =    ZLIM5*ZLIM5
      ZALM2  =&
       & ZLIM2 *((ZCONS2*Z2GEOMF5)/(1.0_JPRB+ZCONS23*Z2GEOMF5))**2+&
       & 2.0_JPRB*ZLIM25*ZCONS2*ZCONS2*Z2GEOMF*Z2GEOMF5/&
       & (1.0_JPRB+ZCONS23*Z2GEOMF5)**3
      ZALM25 =ZLIM25*((ZCONS2*Z2GEOMF5)/(1.0_JPRB+ZCONS23*Z2GEOMF5))**2
      ZALH2  = ZALM2
      ZALH25 = ZALM25

      ZSQRT25 = SQRT(ZDU25(JL))
      ZCFNC  = 0.5_JPRB*RG*ZDU2(JL)/(ZSQRT25*ZMGEOM5(JL)) &
       & -RG*ZSQRT25*ZMGEOM(JL)/ZMGEOM5(JL)**2
      ZCFNC5 = RG*ZSQRT25/ZMGEOM5(JL)

!           DIMENSIONLESS COEFFICIENTS MULTIPLIED BY PRESSURE
!           THICKNESSES FOR MOMENTUM AND HEAT EXCHANGE.

      ZZI  = -ZCONSHG*Z2GEOMF/Z2GEOMF5**2
      ZZI5 =  ZCONSHG/Z2GEOMF5
      ZZI2  = 2.0_JPRB*ZZI *ZZI5
      ZZI25 =    ZZI5*ZZI5
      Z2S  = -ZRI(JL)/(2.0_JPRB*SQRT(MAX(-ZRI5(JL),ZRIMIN)))
      Z2S5 = SQRT(-ZRI5(JL))
      Z3S  = ZCONS11*ZALM2 *ZZI25 +ZCONS11*ZALM25*ZZI2
      Z3S5 = ZCONS11*ZALM25*ZZI25
      Z4S  = ZCONS11*ZALH2 *ZZI25 +ZCONS11*ZALH25*ZZI2
      Z4S5 = ZCONS11*ZALH25*ZZI25
      Z5S  = ZCFNC *ZALM25 + ZCFNC5*ZALM2
      Z5S5 = ZCFNC5*ZALM25
      PCFM (JL,JK) = Z5S *(1.0_JPRB-(ZCONS8*ZRI5(JL))/&
       & (1.0_JPRB+Z3S5*Z2S5)) -&
       & Z5S5*ZCONS8*ZRI (JL)/(1.0_JPRB+Z3S5*Z2S5) +&
       & Z5S5*ZCONS8*ZRI5(JL)*&
       & (Z3S *Z2S5 + Z3S5*Z2S)/(1.0_JPRB+Z3S5*Z2S5)**2
      PCFM5(JL,JK) = Z5S5*(1.0_JPRB-(ZCONS8*ZRI5(JL))/(1.0_JPRB+Z3S5*Z2S5))
      Z6S  = ZCFNC *ZALH25 + ZCFNC5*ZALH2
      Z6S5 = ZCFNC5*ZALH25
      PCFH (JL,JK) = Z6S *(1.0_JPRB-(ZCONS9*ZRI5(JL))/&
       & (1.0_JPRB+Z4S5*Z2S5)) -&
       & Z6S5*ZCONS9*ZRI (JL)/(1.0_JPRB+Z4S5*Z2S5) +&
       & Z6S5*ZCONS9*ZRI5(JL)*&
       & (Z4S *Z2S5 + Z4S5*Z2S)/(1.0_JPRB+Z4S5*Z2S5)**2
      PCFH5(JL,JK) = Z6S5*(1.0_JPRB-(ZCONS9*ZRI5(JL))/(1.0_JPRB+Z4S5*Z2S5))

    ENDIF

!           ADD MIXED LAYER PARAMETRIZATION (SURF. AND OUTER LAYER)

    IF (PGEOH5(JL,JK-1)*ZRG <= PZINV5(JL) ) THEN  ! up to level below entr.lev.
      ZZ   = PGEOH (JL,JK)*ZRG
      ZZ5  = PGEOH5(JL,JK)*ZRG
      ZDH  = ZZ/PZINV5(JL)
      ZDH5 = ZZ5/PZINV5(JL)
      ZDL  = ZZ*ZLI5(JL)
      ZDL5 = ZZ5*ZLI5(JL)
      ZPHIKH  = 39._JPRB*ZCONS13*ZDL &
       & *(1.0_JPRB-39._JPRB*ZDL5)**(-ZCONS13-1.0_JPRB)
      ZPHIKH5 = (1.0_JPRB-39._JPRB*ZDL5)**(-ZCONS13)
      ZPHIKM  = 15._JPRB*ZCONS13*ZDL &
       & *(1.0_JPRB-15._JPRB*ZDL5)**(-ZCONS13-1.0_JPRB)
      ZPHIKM5 = (1.0_JPRB-15._JPRB*ZDL5)**(-ZCONS13)

!           K,surface

      ZDHZZ  = ZUST5(JL)*(ZZ*(1.0_JPRB-ZDH5)**2 & 
       & -2.0_JPRB*ZZ5*(1.0_JPRB-ZDH5)*ZDH)
      ZDHZZ5 = ZUST5(JL) * ZZ5 * (1.0_JPRB-ZDH5)**2
      ZPHIKHI  = -RKAP*ZPHIKH/ZPHIKH5**2
      ZPHIKHI5 = RKAP / ZPHIKH5
      PCFH (JL,JK) = ZPHIKHI5*ZDHZZ+ZDHZZ5*ZPHIKHI
      PCFH5(JL,JK) = ZPHIKHI5 * ZDHZZ5
      ZPHIKMI  = -RKAP*ZPHIKM/ZPHIKM5**2
      ZPHIKMI5 = RKAP / ZPHIKM5
      PCFM (JL,JK) = ZPHIKMI5*ZDHZZ+ZDHZZ5*ZPHIKMI
      PCFM5(JL,JK) = ZPHIKMI5 * ZDHZZ5
    ENDIF

!           ADD ENTRAINMENT
!           entrainment velocity * T,v jump due to sfc flux

    IF (PGEOH5(JL,JK)*ZRG<=PZINV5(JL).AND.PZINV5(JL)<PGEOH5(JL,JK-1)*ZRG) THEN
      ZWTVENTR5 = - ZENTRSFC * ZKHVFL5(JL)              !sfc flux
      ZWTVENTR5 = MAX(0.0_JPRB,ZWTVENTR5)

      ZKH  = ZWTVENTR5*ZRG*ZMGEOM5(JL)*ZDTVR(JL) &
       & + ZWTVENTR5*ZRG*ZDTVR5(JL)*ZMGEOM(JL)
      ZKH5 = ZWTVENTR5 * ZRG * ZMGEOM5(JL) * ZDTVR5(JL)
      IF (ZKH5 < 0.0_JPRB) THEN
        ZCFHNEW  = 0.0_JPRB
        ZCFHNEW5 = 0.0_JPRB
      ELSE
        ZCFHNEW  = ZKH
        ZCFHNEW5 = ZKH5
      ENDIF
      IF (ZCFHNEW5 > PCFH5(JL,JK)) THEN !protection against K=0
        PCFH (JL,JK) = ZCFHNEW
        PCFH5(JL,JK) = ZCFHNEW5
      ENDIF
      IF (0.75_JPRB*ZCFHNEW5 > PCFM5(JL,JK)) THEN
        PCFM (JL,JK) = 0.75_JPRB*ZCFHNEW
        PCFM5(JL,JK) = 0.75_JPRB*ZCFHNEW5
      ENDIF
    ENDIF

!           SCALE DIFFUSION COEFFICIENTS FOR USE IN VDFDIFH/M

    ZCFNC1  = (ZCONS10*PAPHM1 (JL,JK))/(ZMGEOM5(JL) &
     & *(PTM15(JL,JK)*(1.0_JPRB+RETV*PQM15(JL,JK))+PTM15(JL,JK+1) &
     & *(1.0_JPRB+RETV*PQM15(JL,JK+1)))) &
     & -(ZCONS10*PAPHM15(JL,JK))*ZMGEOM(JL)/(ZMGEOM5(JL)**2 &
     & *(PTM15(JL,JK)*(1.0_JPRB+RETV*PQM15(JL,JK))+PTM15(JL,JK+1) &
     & *(1.0_JPRB+RETV*PQM15(JL,JK+1)))) &
     & -(ZCONS10*PAPHM15(JL,JK))*PTM1 (JL,JK) &
     & *(1.0_JPRB+RETV*PQM15(JL,JK))/(ZMGEOM5(JL) &
     & *(PTM15(JL,JK)*(1.0_JPRB+RETV*PQM15(JL,JK))+PTM15(JL,JK+1) &
     & *(1.0_JPRB+RETV*PQM15(JL,JK+1)))**2) &
     & -(ZCONS10*PAPHM15(JL,JK))*PTM1 (JL,JK+1) &
     & *(1.0_JPRB+RETV*PQM15(JL,JK+1))/(ZMGEOM5(JL) &
     & *(PTM15(JL,JK)*(1.0_JPRB+RETV*PQM15(JL,JK))+PTM15(JL,JK+1) &
     & *(1.0_JPRB+RETV*PQM15(JL,JK+1)))**2) &
     & -(ZCONS10*PAPHM15(JL,JK))*RETV*PQM1 (JL,JK+1) &
     & *PTM15(JL,JK+1)/(ZMGEOM5(JL)&
     & *(PTM15(JL,JK)*(1.0_JPRB+RETV*PQM15(JL,JK))+PTM15(JL,JK+1) &
     & *(1.0_JPRB+RETV*PQM15(JL,JK+1)))**2) &
     & -(ZCONS10*PAPHM15(JL,JK))*RETV*PQM1 (JL,JK) &
     & *PTM15(JL,JK)/(ZMGEOM5(JL) &
     & *(PTM15(JL,JK)*(1.0_JPRB+RETV*PQM15(JL,JK))+PTM15(JL,JK+1) &
     & *(1.0_JPRB+RETV*PQM15(JL,JK+1)))**2)
    ZCFNC15 =(ZCONS10*PAPHM15(JL,JK))/(ZMGEOM5(JL) &
     & *(PTM15(JL,JK)*(1.0_JPRB+RETV*PQM15(JL,JK)) &
     & + PTM15(JL,JK+1)*(1.0_JPRB+RETV*PQM15(JL,JK+1))))
    PCFH (JL,JK) = PCFH5(JL,JK)*ZCFNC1+ZCFNC15*PCFH(JL,JK)
    PCFH5(JL,JK) = PCFH5(JL,JK) * ZCFNC15
    PCFM (JL,JK) = PCFM5(JL,JK)*ZCFNC1+ZCFNC15*PCFM(JL,JK)
    PCFM5(JL,JK) = PCFM5(JL,JK) * ZCFNC15 

    IF (.NOT.LEKPERT) THEN
      PCFM (JL,JK) = 0.0_JPRB
      PCFH (JL,JK) = 0.0_JPRB
    ELSE
      ZDDD  = MAX(ZAAA*EXP(-(ZCCC*ZRI5(JL))**2),1.0_JPRB)
      ZDDD  = 1.0_JPRB/ZDDD
      ZDDD1 = MAX(ZAAA1*EXP(-(ZCCC1*ZRI5(JL))**2),1.0_JPRB)
      ZDDD1 = 1.0_JPRB/ZDDD1

      IF (PTM15(JL,KLEV) < 253.15_JPRB) THEN
        PCFM(JL,JK) = PCFM(JL,JK)*ZDDD
        PCFH(JL,JK) = PCFH(JL,JK)*ZDDD1

      ELSE
        IF (PGEOM15(JL,JK) < 30000.0_JPRB) THEN
          PCFM(JL,JK) = PCFM(JL,JK)*ZDDD

          IF (ZZW5(JL) < 1.0_JPRB) THEN
            PCFH(JL,JK) = 0.0_JPRB
          ELSE
            PCFH(JL,JK) = PCFH(JL,JK)*ZDDD1
          ENDIF
!or        ELSEIF (PAPHM15(JL,JK) > 15000.0_JPRB) THEN
!or2        ELSEIF (PAPHM15(JL,JK) > 10000.0_JPRB) THEN
        ELSE
          ZDDD2 = MAX(ZAAA2*EXP(-(ZCCC2*ZRI5(JL))**2),1.0_JPRB)
          ZDDD2 = 1.0_JPRB/ZDDD2

          PCFM(JL,JK) = PCFM(JL,JK)*ZDDD2
!or          PCFH(JL,JK) = PCFH(JL,JK)*ZDDD

          PCFH(JL,JK) = PCFH(JL,JK)*ZDDD1

        ENDIF
      ENDIF

! perturbation of exchange coefficients not used above 0.1 hPa
! (to avoid negative temperature increments when T in trajectory
! is already too low)
      ZPAP5 = 0.5_JPRB*(PAPHM15(JL,JK) + PAPHM15(JL,JK-1))
      IF (ZPAP5 < 10.0_JPRB) THEN
        PCFM(JL,JK) = 0.0_JPRB
        PCFH(JL,JK) = 0.0_JPRB
      ENDIF

    ENDIF

  ENDDO

!***  
ENDDO
!***

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

