#ifdef RS6K
@PROCESS NOSTRICT
#endif
SUBROUTINE VDFEXCU(KIDIA  , KFDIA  , KLON   , KLEV   , PTMST  , PZ0MM  , &
                  &PHRLW  , PHRSW  , PUM1   , PVM1   , PTM1   , PQM1   , &
                  &PAPHM1 , PGEOM1 , PGEOH  , PCPTGZ , &
                  &PKMFL  , PKHFL  , PKQFL  , PCFM   , PCFH   , &
                  &PZINV  , PKH    , PZCLDBASE       , KPBLTYPE)
!     ------------------------------------------------------------------

!**   *VDFEXCU* - DETERMINES THE EXCHANGE COEFFICIENTS BETWEEN THE
!                 UPPER MODEL LEVELS WITH STABILITY AS A FUNCTION OF
!                 OBUKHOV-L

!     A.C.M. BELJAARS  26/03/90.  Original
!     A.C.M. BELJAARS  26/03/99   Tiling of the land surface.
!     J.HAGUE          13/01/2003 MASS Vector Functions
!     M. Ko"hler        3/12/2004 Moist Advection-Diffusion incl.
!                                 K,cloud and cloud top entrainment
!     P. Lopez         02/06/2005 Removed option for linearized
!                                 physics (now called separately)
!     M. Ko"hler        1/11/2007 reduced K diffusion above surface or mixed layer
!     M. Ko"hler        2/15/2008 added shear for K and Ri calculation

!     PURPOSE
!     -------

!     DETERMINE EXCHANGE COEFFICIENTS BETWEEN THE UPPER MODEL LEVELS

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

!     *VDFEXCU* IS CALLED BY *VDFMAIN*

!     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)
!     *PUM1*         X-VELOCITY COMPONENT AT T-1
!     *PVM1*         Y-VELOCITY COMPONENT AT T-1
!     *PTM1*         TEMPERATURE AT T-1
!     *PQM1*         SPECIFIC HUMUDITY AT T-1
!     *PAPHM1*       PRESSURE AT HALF LEVELS AT T-1
!     *PGEOM1*       GEOPOTENTIAL AT T-1
!     *PCPTGZ*       DRY STATIC ENERGY
!     *PKMFL*        KINEMATIC MOMENTUM FLUX
!     *PKHFL*        KINEMATIC HEAT FLUX
!     *PKQFL*        KINEMATIC MOISTURE FLUX
!     *PZINV*        INVERSION HEIGHT                  [M]
!     *PKH*          TURB. DIFF. COEFF. FOR HEAT ABOVE SURF. LAY.  (M2/S)

!     OUTPUT PARAMETERS (REAL):

!     *PCFM*         PROP. TO EXCH. COEFF. FOR MOMENTUM (C-STAR IN DOC.)
!     *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

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

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

USE YOMCST   , ONLY : RG       ,RD       ,RCPD     ,RETV
USE YOEVDF   , ONLY : RKAP     ,RVDIFTS  ,REPDU2
USE YOEVDFS  , ONLY : JPRITBL  ,RITBL    ,ARITBL   ,RCHBA    ,&
                    & RCHBB    ,RCHBD    ,RCHB23A  ,RCHBBCD  ,RCHBCD   ,&
                    & RCHETA   ,RCHETB   ,RCDHALF  ,RCDHPI2  ,RIMAX    ,&
                    & DRITBL   ,DRI26  
USE YOMJFH   , ONLY : N_VMASS

IMPLICIT NONE


!*         0.1    GLOBAL VARIABLES

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)    :: PZ0MM(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHRLW(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHRSW(KLON,KLEV) 
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(IN)    :: PKMFL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKHFL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKQFL(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZINV(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PKH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZCLDBASE(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPBLTYPE(KLON) 

!*         0.2    LOCAL VARIABLES

REAL(KIND=JPRB) ::    ZRI(KLON),ZMGEOM(KLON),ZUST(KLON),&
                    & ZDTV(KLON),ZKHVFL(KLON),ZL(KLON),ZPHIM(KLON),&
                    & ZPHIH(KLON)  
REAL(KIND=JPRB) ::    ZDU2(KLON+N_VMASS)

INTEGER(KIND=JPIM) :: IRIB, JK, JL, JLEN
INTEGER(KIND=JPIM) :: ITEMP(KFDIA-KIDIA+1), INDX(KFDIA-KIDIA+1), JJ, JJJ
REAL(KIND=JPRB) ::    ZENTRSFC, ZENTRRAD, ZKLEN, ZKLEN2, &
                    & ZA, ZB, ZCB, ZCD, ZCFNC1, ZCONS13, ZRG, &
                    & ZDH, ZDL, ZDRORO, ZEPS, ZETA, &
                    & ZPHIKH, ZPHIKM, ZSCF, &
                    & ZX2, ZZ, ZWTVENTR, ZKH, ZCFHNEW, &
                    & ZML, ZBASE, ZVSC, ZKCLD, ZDRADFLX(KLON), &
                    & ZREPUST
REAL(KIND=JPRB) ::    ZZH, ZIFLTGM, ZIFLTGH, ZIFMOM, ZIFMOH, ZDUDZ(KLON)
REAL(KIND=JPRB) ::    ZALFA, ZIFM, ZIFH, ZKLENMO 


REAL(KIND=JPRB) ::    ZTMP2(KFDIA-KIDIA+1)
REAL(KIND=JPRB) ::    ZTMP4(KFDIA-KIDIA+1)
REAL(KIND=JPRB) ::    ZTMP5(KFDIA-KIDIA+1)
REAL(KIND=JPRB) ::    ZHOOK_HANDLE

INTERFACE
#include "surf_inq.h"
END INTERFACE

#include "fcvdfs.h"


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

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

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

ZENTRSFC  = 0.2_JPRB       ! factor for surface based top entrainment 
ZENTRRAD  = 0.2_JPRB       ! factor for radiative based top entrainment 
ZCD       = 1.0_JPRB
ZCB       = 5.0_JPRB
ZEPS      = 1.E-10_JPRB
ZKLEN     = 150.0_JPRB     ! asymptotic K length scale troposphere
ZKLENMO   = 150.0_JPRB     ! transition length scale LTG to MO

CALL SURF_INQ(PREPUST=ZREPUST)

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

IF(N_VMASS > 0) THEN
  JLEN=KFDIA-KIDIA+1
ENDIF


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

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

DO JL=KIDIA,KFDIA
  ZUST  (JL)=MAX(SQRT(PKMFL(JL)),ZREPUST)
  ZKHVFL(JL)=PKHFL(JL)+RETV*PTM1(JL,KLEV)*PKQFL(JL)
  IF (ZKHVFL(JL)  <  0.0_JPRB) THEN
    ZL(JL)  = ZUST (JL)**3*PTM1(JL,KLEV)/(RKAP*RG*(ZKHVFL(JL)-ZEPS))
  ENDIF
ENDDO

!          Calculate PBL cloud top radiative flux jump [Km/s] (cooling)
!          for top-driven K and entrainment velocity formulations.

JJJ = 0
DO JL=KIDIA,KFDIA
  IF(KPBLTYPE(JL)==2) THEN
     JJJ=JJJ+1
     INDX(JJJ)=JL
  ENDIF
ENDDO


ZDRADFLX(:) = 0.0_JPRB
!DO JK=KLEV-1,1,-1
 DO JK=1,KLEV-1
! DO JL=KIDIA,KFDIA
!   IF ( KPBLTYPE(JL) == 2 ) THEN
  DO JJ=1,JJJ
    JL=INDX(JJ)
      IF ( PGEOH(JL,JK)*ZRG <= PZINV(JL) .AND. PZINV(JL) < PGEOH(JL,JK-1)*ZRG ) THEN
!       ZDRADFLX(JL) = -  PHRLW(JL,JK+1)                 * (PGEOH(JL,JK)-PGEOH(JL,JK+1))*ZRG
        ZDRADFLX(JL) = - (PHRLW(JL,JK+1)+PHRSW(JL,JK+1)) * (PGEOH(JL,JK)-PGEOH(JL,JK+1))*ZRG
!         ... add solar heating 2nd cld level
        IF ( PZCLDBASE(JL) < PGEOH(JL,JK+1)*ZRG .AND. JK < KLEV-1 ) THEN 
          ZDRADFLX(JL) = ZDRADFLX(JL) - PHRSW(JL,JK+2)   * (PGEOH(JL,JK+1)-PGEOH(JL,JK+2))*ZRG
        ENDIF
        ZDRADFLX(JL) = MAX( ZDRADFLX(JL), 0.0_JPRB )    !safety against rad. heating cases
      ENDIF
!   ENDIF
  ENDDO
ENDDO


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

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

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

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

  IF(N_VMASS <= 0) THEN   ! efficiency of exponentials

!          COMPUTE RI-NUMBER

    DO JL=KIDIA,KFDIA
      ZMGEOM(JL)=PGEOM1(JL,JK)-PGEOM1(JL,JK+1)
      ZDU2(JL)=MAX(REPDU2,(PUM1(JL,JK)-PUM1(JL,JK+1))**2&
                       & +(PVM1(JL,JK)-PVM1(JL,JK+1))**2)
      ZDUDZ(JL)= SQRT(ZDU2(JL)) /ZMGEOM(JL)*RG

!     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

      ZDUDZ(JL)= ZDUDZ(JL) + 0.005_JPRB  &
       & * 27.2_JPRB*(1.0_JPRB - PAPHM1(JL,JK)/PAPHM1(JL,KLEV)) &
       & * EXP(-10.0_JPRB*(1.0_JPRB - PAPHM1(JL,JK)/PAPHM1(JL,KLEV)))
      ZDU2(JL) = ( ZDUDZ(JL) *ZMGEOM(JL)/RG ) **2

      ZDRORO= 2.0_JPRB * (PCPTGZ(JL,JK)-PCPTGZ(JL,JK+1))&
       & / ( PCPTGZ(JL,JK)+PCPTGZ(JL,JK+1)&
       &   - PGEOM1(JL,JK)-PGEOM1(JL,JK+1))&
       & + RETV*(PQM1(JL,JK)-PQM1(JL,JK+1))
      ZDTV(JL)=( (PCPTGZ(JL,JK)-PCPTGZ(JL,JK+1))&
       & + RETV*0.5_JPRB * (PQM1(JL,JK)-PQM1(JL,JK+1))&
       & * (PCPTGZ(JL,JK)+PCPTGZ(JL,JK+1)) ) * (1.0_JPRB/RCPD)  
      ZRI(JL)=ZMGEOM(JL)*ZDRORO/ZDU2(JL)
    ENDDO

  ELSE

    DO JL=KIDIA,KFDIA
      ZMGEOM(JL)=PGEOM1(JL,JK)-PGEOM1(JL,JK+1)
      ZDU2(JL)=MAX(REPDU2,(PUM1(JL,JK)-PUM1(JL,JK+1))**2&
                       & +(PVM1(JL,JK)-PVM1(JL,JK+1))**2)
      ZDUDZ(JL)= SQRT(ZDU2(JL)) /ZMGEOM(JL)*RG

      ZDUDZ(JL)= ZDUDZ(JL) + 0.005_JPRB  &
       & * 27.2_JPRB*(1.0_JPRB - PAPHM1(JL,JK)/PAPHM1(JL,KLEV)) &
       & * EXP(-10.0_JPRB*(1.0_JPRB - PAPHM1(JL,JK)/PAPHM1(JL,KLEV)))
      ZDU2(JL) = ( ZDUDZ(JL) *ZMGEOM(JL)/RG ) **2

      ZTMP2(JL-KIDIA+1)= PCPTGZ(JL,JK)+PCPTGZ(JL,JK+1)&
                      & -PGEOM1(JL,JK)-PGEOM1(JL,JK+1)
      ZDTV(JL)=( (PCPTGZ(JL,JK)-PCPTGZ(JL,JK+1))&
       & +RETV*0.5_JPRB* (PQM1(JL,JK)-PQM1(JL,JK+1))&
       & *(PCPTGZ(JL,JK)+PCPTGZ(JL,JK+1)) ) * (1.0_JPRB/RCPD)
    ENDDO

    CALL VREC(ZTMP4,ZDU2(KIDIA),JLEN)
    CALL VREC(ZTMP5,ZTMP2,JLEN)

    DO JL=KIDIA,KFDIA
      ZDRORO= 2.0_JPRB * (PCPTGZ(JL,JK)-PCPTGZ(JL,JK+1))&
       & *ZTMP5(JL-KIDIA+1)&
       & +RETV*(PQM1(JL,JK)-PQM1(JL,JK+1))  
      ZRI(JL)=ZMGEOM(JL)*ZDRORO*ZTMP4(JL-KIDIA+1)
    ENDDO

  ENDIF

  DO JL=KIDIA,KFDIA
   ITEMP(JL)=INT(ZRI(JL)*(1.0_JPRB/DRITBL))
  ENDDO

  DO JL=KIDIA,KFDIA

!          COMPUTE STABILITY FUNCTIONS

    IF (ZRI(JL) > 0.0_JPRB) THEN

!          INTERPOLATE ETA WITH SPLINES FOR POSITIVE RICHARDSON
!          NUMBERS

!     IRIB=INT(ZRI(JL)*(1.0_JPRB/DRITBL))+1
      IRIB=ITEMP(JL)+1
      IF (IRIB  >=  JPRITBL) THEN

!          LINEAR EXTENSION OF LOOK-UP TABLE

        ZETA = RITBL(JPRITBL)*(ZRI(JL)*(1.0_JPRB/RIMAX))
      ELSE
        ZX2  = IRIB*DRITBL
        ZA   = (ZX2-ZRI(JL))*(1.0_JPRB/DRITBL)
        ZB   = 1.0_JPRB-ZA
        ZETA = ZA*RITBL(IRIB) + ZB*RITBL(IRIB+1)&
         & +( (ZA**3-ZA)*ARITBL(IRIB)&
         & +(  ZB**3-ZB)*ARITBL(IRIB+1) )*DRI26  
      ENDIF

!          STABLE PHI-FUNCTIONS

      ZPHIM(JL) = PHIMS(ZETA)
      ZPHIH(JL) = PHIHS(ZETA)
    ELSE

!          UNSTABLE SITUATIONS

      ZETA  = ZRI(JL)
      ZPHIM(JL) = PHIMU(ZETA)
      ZPHIH(JL) = PHIHU(ZETA)
    ENDIF
  ENDDO

  DO JL = KIDIA, KFDIA

!          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  = 1.0_JPRB / (ZPHIM(JL)**2)                              !F(MO),M
    ZIFMOH  = 1.0_JPRB / (ZPHIM(JL)*ZPHIH(JL))                       !F(MO),H

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

    ZZH     = 0.5_JPRB * ZRG * (PGEOM1(JL,JK)+PGEOM1(JL,JK+1)) + PZ0MM(JL)
    ZKLEN2  = RKAP * ZZH * ZKLEN / ( RKAP * ZZH + ZKLEN )

!          statically stable

    IF ( ZRI(JL) > 0.0_JPRB ) THEN
      ZSCF    = SQRT(1.0_JPRB+ZCD*ZRI(JL))
      ZIFLTGM = 1.0_JPRB / (1.0_JPRB + 2.0_JPRB *ZCB * ZRI(JL)/ZSCF) !F(LTG),M
      ZIFLTGH = 1.0_JPRB / (1.0_JPRB + 2.0_JPRB *ZCB * ZRI(JL)*ZSCF) !F(LTG),H

      ZALFA   = EXP(-ZZH/ZKLENMO)
      ZIFM    = ZALFA * ZIFLTGM  + (1-ZALFA) *  ZIFMOM !linear interpolation MO and LTG 
      ZIFH    = ZALFA * ZIFLTGH  + (1-ZALFA) *  ZIFMOH 

      PCFM(JL,JK) = ZDUDZ(JL) * ZKLEN2**2 * ZIFM
      PCFH(JL,JK) = ZDUDZ(JL) * ZKLEN2**2 * ZIFH

!          statically unstable

    ELSE
      PCFM(JL,JK) = ZDUDZ(JL) * ZKLEN2**2 * ZIFMOM
      PCFH(JL,JK) = ZDUDZ(JL) * ZKLEN2**2 * ZIFMOH
    ENDIF

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

    IF (PGEOH(JL,JK-1)*ZRG <= PZINV(JL) ) THEN  ! up to level below entr. level

      ZZ     = PGEOH(JL,JK)*ZRG
      ZDH    = ZZ/PZINV(JL)
      ZDL    = ZZ/ZL(JL)
      ZETA   = ZZ/ZL(JL)
      ZPHIKH = (1-39._JPRB*ZDL)**(-ZCONS13)
      ZPHIKM = (1-15._JPRB*ZDL)**(-ZCONS13)

!          K,surface

      PCFH(JL,JK) = RKAP / ZPHIKH * ZUST(JL) * ZZ * (1.0_JPRB-ZDH)**2
      PCFM(JL,JK) = RKAP / ZPHIKM * ZUST(JL) * ZZ * (1.0_JPRB-ZDH)**2

!          add cloud-top driven K (Lock et al. 2000, MWR p3187f, equ. 5)
!          (using simplified radiative velocity scale as in Lock, 1998, equ. 12
!          and ignore buoyancy reversal velocity scale)
!          apply K-cloud throughout full PBL (only for stratocumulus)

      ZML   = PZINV(JL)                               ! mixing depth
      ZBASE = 0.0_JPRB                                ! mixing base

      IF ( KPBLTYPE(JL) == 2  .AND.  ZZ >= ZBASE  .AND.  ZZ <= PZINV(JL) ) THEN  
        ZVSC  = ( RG / PTM1(JL,JK) * ZML * ZDRADFLX(JL) ) ** ZCONS13 
        ZKCLD = 0.85_JPRB * RKAP * ZVSC &
            & * (ZZ-ZBASE) ** 2 / ZML &
            & * ( 1 - (ZZ-ZBASE) / ZML ) ** 0.5_JPRB  
        PCFH(JL,JK) = PCFH(JL,JK) + ZKCLD
        PCFM(JL,JK) = PCFM(JL,JK) + ZKCLD * 0.75_JPRB

      ENDIF

    ENDIF

!          ADD ENTRAINMENT
!          entrainment velocity * T,v jump due to lw-radiative cooling & sfc flux
!          (Lock & MacVean, 1999, equ. 11)

    IF ( PGEOH(JL,JK)*ZRG <= PZINV(JL)  .AND.  PZINV(JL) < PGEOH(JL,JK-1)*ZRG ) THEN
      IF ( KPBLTYPE(JL) == 3 ) THEN                     !no entrainment below cumulus
        ZWTVENTR = 0.0_JPRB
      ELSE
        ZWTVENTR = - ZENTRSFC * ZKHVFL(JL)              !sfc flux (little impact)
        IF ( KPBLTYPE(JL) == 2 ) THEN
          ZWTVENTR = ZWTVENTR + ZENTRRAD * ZDRADFLX(JL) !radiation flux jump
        ENDIF
      ENDIF
      ZWTVENTR = MAX(0.0_JPRB,ZWTVENTR)

      ZKH     = ZWTVENTR * ZMGEOM(JL) / ( RG * ZDTV(JL) )
      ZKH     = MAX(0.0_JPRB,ZKH)
      ZCFHNEW = ZKH

      PCFH(JL,JK) = MAX(PCFH(JL,JK),ZCFHNEW)            !protection against K=0
      PCFM(JL,JK) = MAX(PCFM(JL,JK),ZCFHNEW * 0.75_JPRB)

    ENDIF

!          LIMIT K TO 1000000 M2/S FOR SAFETY

    PCFH(JL,JK) = MIN( PCFH(JL,JK), 1000000.0_JPRB )
    PCFM(JL,JK) = MIN( PCFM(JL,JK), 1000000.0_JPRB )

!          DIFFUSION COEFFICIENT FOR HEAT FOR POSTPROCESSING ONLY IN (M2/S)

    PKH(JL,JK) = PCFH(JL,JK)

!          SCALE DIFFUSION COEFFICIENTS FOR USE IN VDFDIFH/M

    ZCFNC1 = RVDIFTS*PTMST*RG**2 * PAPHM1(JL,JK)&
         & /( 0.5_JPRB*RD * ZMGEOM(JL)&
         &    *( PTM1(JL,JK  )*(1.0_JPRB+RETV*PQM1(JL,JK  ))&
         &    +  PTM1(JL,JK+1)*(1.0_JPRB+RETV*PQM1(JL,JK+1)))) 
    PCFH(JL,JK) = PCFH(JL,JK) * ZCFNC1
    PCFM(JL,JK) = PCFM(JL,JK) * ZCFNC1

  ENDDO

!***
ENDDO
!***

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