SUBROUTINE CPEULDYNAD(CDCONF,&
 & KST,KPROF,PDT,&
 & PGFL,&
 & PRCORI,PGM,PRATATH,PRATATX,PSDVBC,PKENE,PEVEL,PVVEL,PSGRTL,PSGRTM,&
 & PRES0,PRDELP,PKAP,&
 & PGFLT1,PGMVT1,PGMVT1S,PGMV,PGMVS,&
 & PB2,&
 & PGMV5,PGFL5,PSDVBC5,PEVEL5,PVVEL5,PRES5,PRDELP5,PKAP5)

!**** *CPEULDYNAD* - adjoint dynamic grid point calculations for Eulerian model.

!     Purpose.
!     --------
!     Adjoint Dynamic computations in grid-point space for Eulerian model.

!     The following options present in the direct code are not yet coded in AD:
!     - LRUBC=T and NDPSFI=1.
!     - LNHDYN=T.
!     - LPC_FULL=T.
!     - LVERTFE=T.

!**   Interface.
!     ----------
!        *CALL* *CPEULDYNAD(...)

!        Explicit arguments :
!        --------------------

!        INPUT:
!          CDCONF  - "stepo" configuration for grid-point calculations.
!          KST     - first element of work.
!          KPROF   - depth of work.
!          PDT     - SL2TL or first timestep: timestep; otherwise 2*timestep.

!        INPUT/OUTPUT OTHER THAN "...5" VARIABLES (corresponding to
!        INPUT variables in the TL code) + INPUT geometrical variables:
!          PGFL    - GFL variables at t and t-dt. 
!          PRCORI  - Coriolis parameter 2.OMEGA .
!          PGM     - mapping factor.
!          PRATATH - curvature term Cy = dm/dy (used when plane).
!          PRATATX - curvature term Cx = dm/dx (used when plane).
!          PSDVBC  - vertical integral of divergence which appears in the RHS
!                    on continuity equation, including the "lrubc" and
!                    "delta m=1" contribution of (ETADOT DP/DETA).
!          PKENE   - cinetic energy.
!          PEVEL   - ETADOT dP/dETA at t.
!          PVVEL   - omega/P a t.
!          PSGRTL  - zonal component of the pressure force
!                    (grad(phi)+RT grad(p)).
!          PSGRTM  - meridian component of the pressure force.
!          PRES0   - pressure on an interlayer at t.
!          PRDELP  - 1/(pressure depth of layers) at t.
!          PKAP    - R/CP at t.

!        INPUT or INOUT (corresponding to INOUT variables in the TL code):
!          PGFLT1  - t+dt term for the GFL variables equations.
!          PGMVT1  - GMV variables at t+dt.
!          PGMVT1S - GMVS variables at t+dt.
!          PGMV    - GMV variables at t and t-dt.
!          PGMVS   - GMVS variables at t and t-dt.

!        INPUT/OUTPUT (corresponding to OUTPUT variables in the TL code):
!          PB2     - "SLBUF2" buffer.

!        INPUT "...5" VARIABLES:
!          PGMV5   - GMV variables (trajectory).
!          PGFL5   - GFL variables (trajectory).
!          PSDVBC5 - vertical integral of divergence which appears in the RHS
!                    on continuity equation, including the "lrubc" and
!                    "delta m=1" contribution of (ETADOT DP/DETA).
!          PEVEL5  - ETADOT dP/dETA (trajectory).
!          PVVEL5  - omega/P a t (trajectory).
!          PRES5   - pressure on an interlayer (trajectory).
!          PRDELP5 - 1/(pressure depth of layers) (trajectory).
!          PKAP5   - R/CP (trajectory).

!        Implicit arguments : none.
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!     Reference.
!     ----------
!        ARPEGE documentation

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!   -- name = CPDYNAD --
!   Original : 90-03-22
!   Modified : 91-11-01 F Rabier (U V formulation)
!   Modified : 92-07-08 V. Ducrocq (introduction of a new curvature term
!    in the U equation and KGL1,KGL2 PRATATX in the call)
!   Modified : MARCH 1994 by K. YESSAD: semi-implicit scheme with
!              not reduced divergence.
!   Modified : 96-02-20 L. Isaksen (Adapted for Message Passing)
!   Modified : 98-01-08 E. Holm (Ozone included)
!   Modified 99-09-17 by C. Temperton : add LIMPF option
!   Modified 99-11-15 by K. YESSAD:
!    - replace "psdiv" by "psdvbc" already containing the "lrubc"
!      and "delta m=1" contribution for term (ETADOT DP/DETA).
!    - some cleaning (comments, put dummy arguments in a more logical way,
!      remove useless dummy arguments).
!   Modified 01-01-18 by C. Temperton : add LSPRT option
!   R. El Khatib : 01-08-07 Pruning options
!   M.Hamrud      01-Oct-2003 CY28 Cleaning
!   -- name = CPEULDYNAD --
!   K.Yessad     : 20-03-2006: update according to the direct code
!     routine CPEULDYN and rename it into CPEULDYNAD.
!   M.Jidane 09-04-2006 : Compute R with q variables under key
!   N. Wedi and K. Yessad (Jan 2008): different dev for NH model and PC scheme
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVG  ,NPROMA
USE YOMSC2   , ONLY : NFLDSLB2
USE YOMCT0   , ONLY : LRFRIC  ,LSPRT   ,LRUBC    ,LNHDYN   ,LPC_FULL
USE YOMCVER  , ONLY : LVERTFE
USE YOMDYN   , ONLY : BETADT  ,RKRF    ,LIMPF    ,LSIDG    ,LDRY_ECMWF
USE YOMGEM   , ONLY : RSTRET
USE YOMCST   , ONLY : RD       ,RV      ,RETV
USE YOMPHY   , ONLY : NDPSFI
USE YOM_YGFL , ONLY : YGFL    ,YGFLC    ,YQ
USE YOMGMV   , ONLY : NDIMGMV,NDIMGMVS,YT0,YT9,YT5,YT1
USE PTRSLB2  , ONLY : MSLB2USI ,MSLB2VSI ,MSLB2TSI ,MSLB2SPSI

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

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDT 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGFL(NPROMA,NFLEVG,YGFL%NDIM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRCORI(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRATATH(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRATATX(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSDVBC(NPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PKENE(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PEVEL(NPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVVEL(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSGRTL(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSGRTM(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRES0(NPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRDELP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PKAP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFLT1(NPROMA,NFLEVG,YGFL%NDIM1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVT1(NPROMA,NFLEVG,YT1%NDIM)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGMVT1S(NPROMA,YT1%NDIMS)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMV(NPROMA,NFLEVG,NDIMGMV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVS(NPROMA,NDIMGMVS)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB2(NPROMA,NFLDSLB2)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGMV5(NPROMA,NFLEVG,YT5%NDIM)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFL5(NPROMA,NFLEVG,YGFL%NDIM5) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSDVBC5(NPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEVEL5(NPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVVEL5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRES5(NPROMA,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRDELP5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKAP5(NPROMA,NFLEVG) 

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

REAL(KIND=JPRB) :: ZR0   (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZR5   (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSID  (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSIDL (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSIDM (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSISP (NPROMA       )
REAL(KIND=JPRB) :: ZSISPL(NPROMA       )
REAL(KIND=JPRB) :: ZSISPM(NPROMA       )
REAL(KIND=JPRB) :: ZSIT  (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSITL (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSITM (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZTT0L (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZTT0M (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZTT5L (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZTT5M (NPROMA,NFLEVG)

REAL(KIND=JPRB) :: ZFM, ZBDT, ZED, ZED5

INTEGER(KIND=JPIM) :: IPROFS, JLEV, JROF,JGFL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "sigamad.intfb.h"
#include "sitnuad.intfb.h"

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CPEULDYNAD',0,ZHOOK_HANDLE)
!     ------------------------------------------------------------------

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

IF (NDPSFI == 1) THEN
  CALL ABOR1(' CPEULDYNAD: NDPSFI=1 not yet coded in EUL AD model')
ENDIF
IF (LRUBC) THEN
  CALL ABOR1(' CPEULDYNAD: LRUBC=T not yet coded in EUL AD model')
ENDIF
IF (LNHDYN) THEN
  CALL ABOR1(' CPEULDYNAD: LNHDYN=T not yet coded in EUL AD model')
ENDIF
IF (LPC_FULL) THEN
  CALL ABOR1(' CPEULDYNAD: LPC_FULL=T not yet coded in EUL AD model')
ENDIF
IF (LVERTFE) THEN
  CALL ABOR1(' CPEULDYNAD: LVERTFE=T not yet coded in EUL AD model')
ENDIF

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

!*       1.    INTERMEDIATE QUANTITIES FOR EQUATIONS RHS
!              -----------------------------------------

! ky: not fully consistent with the direct code but consistent with the
!     cy33 version of cpeuldyntl.F90 + cpeuldynad.F90.
ZFM = 0.5_JPRB

! dimension for calls to SI routines
IPROFS=KPROF-KST+1

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

!*       7+8.  Non linear tendency at time "t" and temporal advance.
!              -----------------------------------------------------

PSDVBC(KST:KPROF,NFLEVG)=PSDVBC(KST:KPROF,NFLEVG)&
 & -PDT/PRES5(KST:KPROF,NFLEVG)*PGMVT1S(KST:KPROF,YT1%MSP)  
PRES0(KST:KPROF,NFLEVG)=PRES0(KST:KPROF,NFLEVG)&
 & +PDT*PSDVBC5(KST:KPROF,NFLEVG)&
 & /(PRES5(KST:KPROF,NFLEVG)*PRES5(KST:KPROF,NFLEVG))*PGMVT1S(KST:KPROF,YT1%MSP)  

! * Rayleigh friction:
IF(LRFRIC) THEN
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU) &
       & -PDT*RKRF(JLEV)*PGMVT1(JROF,JLEV,YT1%MU)
    ENDDO
  ENDDO
ENDIF

DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF

    PKAP(JROF,JLEV)=PKAP(JROF,JLEV)&
     & +PDT*PGMV5(JROF,JLEV,YT5%MT)*PVVEL5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MT)  
    PGMV(JROF,JLEV,YT0%MT)=PGMV(JROF,JLEV,YT0%MT)&
     & +PDT*PKAP5(JROF,JLEV)*PVVEL5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MT)  
    PVVEL(JROF,JLEV)=PVVEL(JROF,JLEV)&
     & +PDT*PKAP5(JROF,JLEV)*PGMV5(JROF,JLEV,YT5%MT)*PGMVT1(JROF,JLEV,YT1%MT)  
    PGMVT1(JROF,JLEV,YT1%MT)=PGMVT1(JROF,JLEV,YT1%MT)

    PSGRTM(JROF,JLEV)=PSGRTM(JROF,JLEV)-PDT*PGMVT1(JROF,JLEV,YT1%MV)
    PGMVT1(JROF,JLEV,YT1%MV)=PGMVT1(JROF,JLEV,YT1%MV)
    PSGRTL(JROF,JLEV)=PSGRTL(JROF,JLEV)-PDT*PGMVT1(JROF,JLEV,YT1%MU)
    PGMVT1(JROF,JLEV,YT1%MU)=PGMVT1(JROF,JLEV,YT1%MU)

  ENDDO
ENDDO

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

!*       6.    SEMI-IMPLICIT FOR PC SCHEME ONLY.
!              ---------------------------------

!nyc IF (LPC_FULL) THEN
!nyc   Not yet coded!
!nyc ENDIF

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

!*       5.    SEMI-IMPLICIT CORRECTION.
!              -------------------------

ZBDT=0.0_JPRB
IF(CDCONF == 'A')THEN
  ZBDT=BETADT
ELSEIF(CDCONF == 'E'.OR.CDCONF == 'F') THEN
  ZBDT=0.0_JPRB
ENDIF

!        5.0     Set to zero

DO JLEV=1,NFLEVG
  DO JROF=1,KPROF
    ZR0  (JROF,JLEV)=0.0_JPRB
    ZSID (JROF,JLEV)=0.0_JPRB
    ZSITL(JROF,JLEV)=0.0_JPRB
    ZSITM(JROF,JLEV)=0.0_JPRB
    ZTT0L(JROF,JLEV)=0.0_JPRB
    ZTT0M(JROF,JLEV)=0.0_JPRB
  ENDDO
ENDDO

DO JROF=1,KPROF
  ZSISPL(JROF)=0.0_JPRB
  ZSISPM(JROF)=0.0_JPRB
ENDDO

!        5.0b    Trajectory code to compute ZR5, ZTT5L, ZTT5M.
!                (matching with code computed in part 3.0 of CPEULDYNTL). 
!                k.y.: has to be put later in a new routine CPEULDYN5
!                      called at the beginning of CPEULDYNTL and CPEULDYNAD.

IF (LSPRT) THEN
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      ZR5(JROF,JLEV)=RD+(RV-RD)*PGFL5(JROF,JLEV,YQ%MP5)
    ENDDO
    IF (YQ%LCDERS) THEN
      DO JROF=KST,KPROF
        ZTT5L(JROF,JLEV)=RD* &
         & (PGMV5(JROF,JLEV,YT5%MTL)-RETV*PGMV5(JROF,JLEV,YT5%MT)&
         & *PGFL5(JROF,JLEV,YQ%MP5L))/ZR5(JROF,JLEV)  
        ZTT5M(JROF,JLEV)=RD* &
         & (PGMV5(JROF,JLEV,YT5%MTM)-RETV*PGMV5(JROF,JLEV,YT5%MT)&
         & *PGFL5(JROF,JLEV,YQ%MP5M))/ZR5(JROF,JLEV)  
      ENDDO
    ELSE
      DO JROF=KST,KPROF
        ZTT5L(JROF,JLEV)=RD*PGMV5(JROF,JLEV,YT5%MTL)/ZR5(JROF,JLEV)
        ZTT5M(JROF,JLEV)=RD*PGMV5(JROF,JLEV,YT5%MTM)/ZR5(JROF,JLEV)
      ENDDO
    ENDIF
  ENDDO
ELSE
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      ZTT5L(JROF,JLEV)=PGMV5(JROF,JLEV,YT5%MTL)
      ZTT5M(JROF,JLEV)=PGMV5(JROF,JLEV,YT5%MTM)
    ENDDO
  ENDDO
ENDIF

!        5.3     Fill P[X]SIC arrays

DO JROF=KST,KPROF
  ZSISP (JROF)=0.0_JPRB
  ZSISP(JROF)=ZSISP(JROF)-ZBDT*PDT*ZFM*PB2(JROF,MSLB2SPSI)
  PB2(JROF,MSLB2SPSI)=0.0_JPRB
ENDDO

DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    ZSIT (JROF,JLEV)=0.0_JPRB
    ZSIT (JROF,JLEV)= ZSIT (JROF,JLEV)-ZBDT*PDT*ZFM*PB2(JROF,MSLB2TSI-1+JLEV)
    PB2(JROF,MSLB2TSI-1+JLEV)= 0.0_JPRB
    ZSIDM(JROF,JLEV)=0.0_JPRB
    ZSIDM(JROF,JLEV)= ZSIDM(JROF,JLEV)-ZBDT*PDT*ZFM*PB2(JROF,MSLB2VSI-1+JLEV)
    PB2(JROF,MSLB2VSI-1+JLEV)= 0.0_JPRB
    ZSIDL(JROF,JLEV)=0.0_JPRB
    ZSIDL(JROF,JLEV)= ZSIDL(JROF,JLEV)-ZBDT*PDT*ZFM*PB2(JROF,MSLB2USI-1+JLEV)
    PB2(JROF,MSLB2USI-1+JLEV)= 0.0_JPRB
  ENDDO
ENDDO

!        5.2     Do SI calculations
!                This should match what is in LASSIEAD/LANHSIAD

! * For "spectral RT" option, adjust semi-implicit term in
!   T-equation to compensate for later multiplication by R/Rd

IF (LSPRT) THEN
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      ZSIT(JROF,JLEV)=RD*ZSIT(JROF,JLEV)/ZR5(JROF,JLEV)
    ENDDO
  ENDDO
ENDIF

IF (LIMPF) THEN
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU) &
       & -2.0_JPRB*PRCORI(JROF)*ZSIDM(JROF,JLEV)
      PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV) &
       & +2.0_JPRB*PRCORI(JROF)*ZSIDL(JROF,JLEV)
      PGMV(JROF,JLEV,YT9%MU)=PGMV(JROF,JLEV,YT9%MU) &
       & +PRCORI(JROF)*ZSIDM(JROF,JLEV)
      PGMV(JROF,JLEV,YT9%MV)=PGMV(JROF,JLEV,YT9%MV) &
       & -PRCORI(JROF)*ZSIDL(JROF,JLEV)
    ENDDO
  ENDDO
ENDIF

CALL SIGAMAD(NPROMA,1,ZSIDM(KST,1),ZSITM(KST,1),ZSISPM(KST),IPROFS)
CALL SIGAMAD(NPROMA,1,ZSIDL(KST,1),ZSITL(KST,1),ZSISPL(KST),IPROFS)
CALL SITNUAD(NPROMA,1,ZSID(KST,1),ZSIT(KST,1),ZSISP(KST),IPROFS)

!        5.1     Prepare input arrays for SI calculations

! * GMVS variables:
DO JROF=KST,KPROF
  PGMVS(JROF,YT9%MSPM)=PGMVS(JROF,YT9%MSPM)+ZSISPM(JROF)
  PGMVS(JROF,YT0%MSPM)=PGMVS(JROF,YT0%MSPM)-2.0_JPRB*ZSISPM(JROF)
  ZSISPM(JROF)=0.0_JPRB
  PGMVS(JROF,YT9%MSPL)=PGMVS(JROF,YT9%MSPL)+ZSISPL(JROF)
  PGMVS(JROF,YT0%MSPL)=PGMVS(JROF,YT0%MSPL)-2.0_JPRB*ZSISPL(JROF)
  ZSISPL(JROF)=0.0_JPRB
ENDDO

! * GMV variables:

DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    PGMV(JROF,JLEV,YT9%MTM)=PGMV(JROF,JLEV,YT9%MTM)+ZSITM(JROF,JLEV)
    PGMV(JROF,JLEV,YT0%MTM)=PGMV(JROF,JLEV,YT0%MTM)-2.0_JPRB*ZSITM(JROF,JLEV)
    PGMV(JROF,JLEV,YT9%MTL)=PGMV(JROF,JLEV,YT9%MTL)+ZSITL(JROF,JLEV)
    PGMV(JROF,JLEV,YT0%MTL)=PGMV(JROF,JLEV,YT0%MTL)-2.0_JPRB*ZSITL(JROF,JLEV)
  ENDDO
  IF (LSIDG) THEN
    DO JROF=KST,KPROF
      PGMV(JROF,JLEV,YT9%MDIV)=PGMV(JROF,JLEV,YT9%MDIV)+ZSID(JROF,JLEV)
      PGMV(JROF,JLEV,YT0%MDIV)=PGMV(JROF,JLEV,YT0%MDIV)-2.0_JPRB*ZSID(JROF,JLEV)
    ENDDO
  ELSE
    DO JROF=KST,KPROF
      PGMV(JROF,JLEV,YT9%MDIV)=PGMV(JROF,JLEV,YT9%MDIV)&
       & +RSTRET*RSTRET/(PGM(JROF)*PGM(JROF))*ZSID(JROF,JLEV)  
      PGMV(JROF,JLEV,YT0%MDIV)=PGMV(JROF,JLEV,YT0%MDIV)&
       & -2.0_JPRB*RSTRET*RSTRET/(PGM(JROF)*PGM(JROF))*ZSID(JROF,JLEV)  
    ENDDO
  ENDIF
ENDDO

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

!*       4.    HORIZONTAL ADVECTION.
!              ---------------------

! * T,V,U,GFL:

DO JGFL=1,YGFL%NUMFLDS
  IF(YGFLC(JGFL)%LCDERS .AND. YGFLC(JGFL)%LADV) THEN
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        PGFL(JROF,JLEV,YGFLC(JGFL)%MPL)=PGFL(JROF,JLEV,YGFLC(JGFL)%MPL)&
         & -PDT*PGMV5(JROF,JLEV,YT5%MU)*PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)  
        PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU)-PDT* &
         & PGFL5(JROF,JLEV,YGFLC(JGFL)%MP5L)*PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)  
        PGFL(JROF,JLEV,YGFLC(JGFL)%MPM)=PGFL(JROF,JLEV,YGFLC(JGFL)%MPM)&
         & -PDT*PGMV5(JROF,JLEV,YT5%MV)*PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)  
        PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV)-PDT* &
         & PGFL5(JROF,JLEV,YGFLC(JGFL)%MP5M)*PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)  
      ENDDO
    ENDDO
  ENDIF
ENDDO

DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF

    ZTT0L(JROF,JLEV)=ZTT0L(JROF,JLEV) &
     & -PDT*PGMV5(JROF,JLEV,YT5%MU)*PGMVT1(JROF,JLEV,YT1%MT)
    PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU) &
     & -PDT*ZTT5L(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MT)
    ZTT0M(JROF,JLEV)=ZTT0M(JROF,JLEV) &
     & -PDT*PGMV5(JROF,JLEV,YT5%MV)*PGMVT1(JROF,JLEV,YT1%MT)
    PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV) &
     & -PDT*ZTT5M(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MT)

    PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV) &
     & -PDT*PGMV5(JROF,JLEV,YT5%MDIV)*PGMVT1(JROF,JLEV,YT1%MV)
    PGMV(JROF,JLEV,YT0%MDIV)=PGMV(JROF,JLEV,YT0%MDIV)&
     & -PDT*PGMV5(JROF,JLEV,YT5%MV)*PGMVT1(JROF,JLEV,YT1%MV)  
    PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU) &
     & -PDT*PRCORI(JROF)*PGMVT1(JROF,JLEV,YT1%MV)
    PGMV(JROF,JLEV,YT0%MVL)=PGMV(JROF,JLEV,YT0%MVL)&
     & -PDT*PGMV5(JROF,JLEV,YT5%MU)*PGMVT1(JROF,JLEV,YT1%MV)  
    PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU) &
     & -PDT*PGMV5(JROF,JLEV,YT5%MVL)*PGMVT1(JROF,JLEV,YT1%MV)
    PGMV(JROF,JLEV,YT0%MUL)=PGMV(JROF,JLEV,YT0%MUL)&
     & +PDT*PGMV5(JROF,JLEV,YT5%MV)*PGMVT1(JROF,JLEV,YT1%MV)  
    PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV) &
     & +PDT*PGMV5(JROF,JLEV,YT5%MUL)*PGMVT1(JROF,JLEV,YT1%MV)
    PKENE(JROF,JLEV)=PKENE(JROF,JLEV)&
     & -PDT*PRATATH(JROF)*PGMVT1(JROF,JLEV,YT1%MV)&
     & +PDT*PRATATX(JROF)*PGMVT1(JROF,JLEV,YT1%MU)  

    PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV)&
     & +PDT*(PGMV5(JROF,JLEV,YT5%MVOR)+PRCORI(JROF))*PGMVT1(JROF,JLEV,YT1%MU)  
    PGMV(JROF,JLEV,YT0%MVOR)=PGMV(JROF,JLEV,YT0%MVOR)&
     & +PDT*PGMV5(JROF,JLEV,YT5%MV)*PGMVT1(JROF,JLEV,YT1%MU)  
    PGMV(JROF,JLEV,YT0%MVL)=PGMV(JROF,JLEV,YT0%MVL)&
     & -PDT*PGMV5(JROF,JLEV,YT5%MV)*PGMVT1(JROF,JLEV,YT1%MU)  
    PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV)&
     & -PDT*PGMV5(JROF,JLEV,YT5%MVL)*PGMVT1(JROF,JLEV,YT1%MU)  
    PGMV(JROF,JLEV,YT0%MUL)=PGMV(JROF,JLEV,YT0%MUL)&
     & -PDT*PGMV5(JROF,JLEV,YT5%MU)*PGMVT1(JROF,JLEV,YT1%MU)  
    PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU)&
     & -PDT*PGMV5(JROF,JLEV,YT5%MUL)*PGMVT1(JROF,JLEV,YT1%MU)  

  ENDDO
ENDDO

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

!*       3.    CASE "LSPRT".
!              -------------

! *  Convert gradients of 'TV' to gradients of T if necessary.
!    If no gradient of Q approximate (for EUL NMI - still needed??)

IF (LSPRT) THEN
  DO JLEV=1,NFLEVG
    IF (YQ%LCDERS) THEN
      IF (.NOT. LDRY_ECMWF) THEN
        DO JROF=KST,KPROF
          ZR0(JROF,JLEV)=ZR0(JROF,JLEV)-RD*(PGMV5(JROF,JLEV,YT5%MTL)-RETV*&
           & PGMV5(JROF,JLEV,YT5%MT)*PGFL5(JROF,JLEV,YQ%MP5L))*ZTT0L(JROF,JLEV)&
           & /(ZR5(JROF,JLEV)*ZR5(JROF,JLEV))
          ZR0(JROF,JLEV)=ZR0(JROF,JLEV)-RD*(PGMV5(JROF,JLEV,YT5%MTM)-RETV*&
           & PGMV5(JROF,JLEV,YT5%MT)*PGFL5(JROF,JLEV,YQ%MP5M))*ZTT0M(JROF,JLEV)&
           & /(ZR5(JROF,JLEV)*ZR5(JROF,JLEV))
        ENDDO
      ENDIF
      DO JROF=KST,KPROF
        PGMV(JROF,JLEV,YT0%MTL)=PGMV(JROF,JLEV,YT0%MTL) &
         & +RD*ZTT0L(JROF,JLEV)/ZR5(JROF,JLEV)
        PGFL(JROF,JLEV,YQ%MPL)=PGFL(JROF,JLEV,YQ%MPL)&
         & -RD*RETV*PGMV5(JROF,JLEV,YT5%MT)*ZTT0L(JROF,JLEV)/ZR5(JROF,JLEV)  
        PGMV(JROF,JLEV,YT0%MT)=PGMV(JROF,JLEV,YT0%MT) &
         & -RD*RETV*PGFL5(JROF,JLEV,YQ%MP5L)&
         & *ZTT0L(JROF,JLEV)/ZR5(JROF,JLEV)  
        PGMV(JROF,JLEV,YT0%MTM)=PGMV(JROF,JLEV,YT0%MTM) &
         & +RD*ZTT0M(JROF,JLEV)/ZR5(JROF,JLEV)
        PGFL(JROF,JLEV,YQ%MPM)=PGFL(JROF,JLEV,YQ%MPM)&
         & -RD*RETV*PGMV5(JROF,JLEV,YT5%MT)*ZTT0M(JROF,JLEV)/ZR5(JROF,JLEV)  
        PGMV(JROF,JLEV,YT0%MT)=PGMV(JROF,JLEV,YT0%MT) &
         & -RD*RETV*PGFL5(JROF,JLEV,YQ%MP5M)&
         & *ZTT0M(JROF,JLEV)/ZR5(JROF,JLEV)  
      ENDDO
    ELSE
      IF (.NOT. LDRY_ECMWF) THEN
        DO JROF=KST,KPROF
          ZR0(JROF,JLEV)=ZR0(JROF,JLEV)-RD*PGMV5(JROF,JLEV,YT5%MTL)&
           & *ZTT0L(JROF,JLEV)/(ZR5(JROF,JLEV)*ZR5(JROF,JLEV))
          ZR0(JROF,JLEV)=ZR0(JROF,JLEV)-RD*PGMV5(JROF,JLEV,YT5%MTM)&
           & *ZTT0M(JROF,JLEV)/(ZR5(JROF,JLEV)*ZR5(JROF,JLEV))
        ENDDO
      ENDIF
      DO JROF=KST,KPROF
        PGMV(JROF,JLEV,YT0%MTL)=PGMV(JROF,JLEV,YT0%MTL) &
         & +RD*ZTT0L(JROF,JLEV)/ZR5(JROF,JLEV)
        PGMV(JROF,JLEV,YT0%MTM)=PGMV(JROF,JLEV,YT0%MTM) &
         & +RD*ZTT0M(JROF,JLEV)/ZR5(JROF,JLEV)
      ENDDO
    ENDIF
  ENDDO
  IF (.NOT. LDRY_ECMWF) THEN
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        PGFL(JROF,JLEV,YQ%MP)=PGFL(JROF,JLEV,YQ%MP)+(RV-RD)*ZR0(JROF,JLEV)
      ENDDO
    ENDDO
  ENDIF
ELSE
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      PGMV(JROF,JLEV,YT0%MTL)=PGMV(JROF,JLEV,YT0%MTL)+ZTT0L(JROF,JLEV)
      PGMV(JROF,JLEV,YT0%MTM)=PGMV(JROF,JLEV,YT0%MTM)+ZTT0M(JROF,JLEV)
    ENDDO
  ENDDO
ENDIF

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

!*       2.    VERTICAL ADVECTION.
!              -------------------

! * GFL,T,V,U:
!   Bottom layer.
!   The vertical advection at bottom level is not yet modified when NDPSI=1,
!   since Physics outputs are needed.

! * GFL,T,V,U:
!   Layers 1 to nflevg-1.

DO JGFL=1,YGFL%NUMFLDS
  IF(YGFLC(JGFL)%LADV) THEN
    DO JLEV=NFLEVG-1,1,-1
      DO JROF=KST,KPROF
        ZED5=PDT*0.5_JPRB*PEVEL5(JROF,JLEV)
        ZED=0.0_JPRB

        PGFL(JROF,JLEV,YGFLC(JGFL)%MP)=PGFL(JROF,JLEV,YGFLC(JGFL)%MP)&
         & +ZED5*PRDELP5(JROF,JLEV+1)*PGFLT1(JROF,JLEV+1,YGFLC(JGFL)%MP1)  
        PGFL(JROF,JLEV+1,YGFLC(JGFL)%MP)=PGFL(JROF,JLEV+1,YGFLC(JGFL)%MP)&
         & -ZED5*PRDELP5(JROF,JLEV+1)*PGFLT1(JROF,JLEV+1,YGFLC(JGFL)%MP1)  
        ZED=ZED+( &
         & PGFL5(JROF,JLEV,YGFLC(JGFL)%MP5)-PGFL5(JROF,JLEV+1,YGFLC(JGFL)%MP5)&
         & )*PRDELP5(JROF,JLEV+1)*PGFLT1(JROF,JLEV+1,YGFLC(JGFL)%MP1)  
        PRDELP(JROF,JLEV+1)=PRDELP(JROF,JLEV+1)+(&
         & PGFL5(JROF,JLEV,YGFLC(JGFL)%MP5)-PGFL5(JROF,JLEV+1,YGFLC(JGFL)%MP5)&
         & )*ZED5*PGFLT1(JROF,JLEV+1,YGFLC(JGFL)%MP1)  

        PGFL(JROF,JLEV,YGFLC(JGFL)%MP)=PGFL(JROF,JLEV,YGFLC(JGFL)%MP)&
         & +ZED5*PRDELP5(JROF,JLEV)*PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)  
        PGFL(JROF,JLEV+1,YGFLC(JGFL)%MP)=PGFL(JROF,JLEV+1,YGFLC(JGFL)%MP)&
         & -ZED5*PRDELP5(JROF,JLEV)*PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)  
        ZED=ZED+( &
         & PGFL5(JROF,JLEV,YGFLC(JGFL)%MP5)-PGFL5(JROF,JLEV+1,YGFLC(JGFL)%MP5)&
         & )*PRDELP5(JROF,JLEV)*PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)  
        PRDELP(JROF,JLEV)=PRDELP(JROF,JLEV)+(&
         & PGFL5(JROF,JLEV,YGFLC(JGFL)%MP5)-PGFL5(JROF,JLEV+1,YGFLC(JGFL)%MP5)&
         & )*ZED5*PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)  

        PEVEL(JROF,JLEV)=PEVEL(JROF,JLEV)+PDT*0.5_JPRB*ZED

      ENDDO
    ENDDO
  ENDIF
ENDDO

DO JLEV=NFLEVG-1,1,-1
  DO JROF=KST,KPROF
    ZED5=PDT*0.5_JPRB*PEVEL5(JROF,JLEV)
    ZED=0.0_JPRB

    PGMV(JROF,JLEV,YT0%MT)=PGMV(JROF,JLEV,YT0%MT)&
     & +ZED5*PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MT)  
    PGMV(JROF,JLEV+1,YT0%MT)=PGMV(JROF,JLEV+1,YT0%MT)&
     & -ZED5*PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MT)  
    ZED=ZED+(PGMV5(JROF,JLEV,YT5%MT)-PGMV5(JROF,JLEV+1,YT5%MT))&
     & *PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MT)  
    PRDELP(JROF,JLEV+1)=PRDELP(JROF,JLEV+1)&
     & +(PGMV5(JROF,JLEV,YT5%MT)-PGMV5(JROF,JLEV+1,YT5%MT))&
     & *ZED5*PGMVT1(JROF,JLEV+1,YT1%MT)  

    PGMV(JROF,JLEV,YT0%MT)=PGMV(JROF,JLEV,YT0%MT)&
     & +ZED5*PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MT)  
    PGMV(JROF,JLEV+1,YT0%MT)=PGMV(JROF,JLEV+1,YT0%MT)&
     & -ZED5*PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MT)  
    ZED=ZED+(PGMV5(JROF,JLEV,YT5%MT)-PGMV5(JROF,JLEV+1,YT5%MT))&
     & *PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MT)  
    PRDELP(JROF,JLEV)=PRDELP(JROF,JLEV)&
     & +(PGMV5(JROF,JLEV,YT5%MT)-PGMV5(JROF,JLEV+1,YT5%MT))&
     & *ZED5*PGMVT1(JROF,JLEV,YT1%MT)  

    PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV)&
     & +ZED5*PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MV)  
    PGMV(JROF,JLEV+1,YT0%MV)=PGMV(JROF,JLEV+1,YT0%MV)&
     & -ZED5*PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MV)  
    ZED=ZED+(PGMV5(JROF,JLEV,YT5%MV)-PGMV5(JROF,JLEV+1,YT5%MV))&
     & *PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MV)  
    PRDELP(JROF,JLEV+1)=PRDELP(JROF,JLEV+1)&
     & +(PGMV5(JROF,JLEV,YT5%MV)-PGMV5(JROF,JLEV+1,YT5%MV))&
     & *ZED5*PGMVT1(JROF,JLEV+1,YT1%MV)  

    PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV)&
     & +ZED5*PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MV)  
    PGMV(JROF,JLEV+1,YT0%MV)=PGMV(JROF,JLEV+1,YT0%MV)&
     & -ZED5*PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MV)  
    ZED=ZED+(PGMV5(JROF,JLEV,YT5%MV)-PGMV5(JROF,JLEV+1,YT5%MV))&
     & *PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MV)  
    PRDELP(JROF,JLEV)=PRDELP(JROF,JLEV)&
     & +(PGMV5(JROF,JLEV,YT5%MV)-PGMV5(JROF,JLEV+1,YT5%MV))&
     & *ZED5*PGMVT1(JROF,JLEV,YT1%MV)  

    PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU)&
     & +ZED5*PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MU)  
    PGMV(JROF,JLEV+1,YT0%MU)=PGMV(JROF,JLEV+1,YT0%MU)&
     & -ZED5*PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MU)  
    ZED=ZED+(PGMV5(JROF,JLEV,YT5%MU)-PGMV5(JROF,JLEV+1,YT5%MU))&
     & *PRDELP5(JROF,JLEV+1)*PGMVT1(JROF,JLEV+1,YT1%MU)  
    PRDELP(JROF,JLEV+1)=PRDELP(JROF,JLEV+1)&
     & +(PGMV5(JROF,JLEV,YT5%MU)-PGMV5(JROF,JLEV+1,YT5%MU))&
     & *ZED5*PGMVT1(JROF,JLEV+1,YT1%MU)  

    PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU)&
     & +ZED5*PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MU)  
    PGMV(JROF,JLEV+1,YT0%MU)=PGMV(JROF,JLEV+1,YT0%MU)&
     & -ZED5*PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MU)  
    ZED=ZED+(PGMV5(JROF,JLEV,YT5%MU)-PGMV5(JROF,JLEV+1,YT5%MU))&
     & *PRDELP5(JROF,JLEV)*PGMVT1(JROF,JLEV,YT1%MU)  
    PRDELP(JROF,JLEV)=PRDELP(JROF,JLEV)&
     & +(PGMV5(JROF,JLEV,YT5%MU)-PGMV5(JROF,JLEV+1,YT5%MU))&
     & *ZED5*PGMVT1(JROF,JLEV,YT1%MU)  

    PEVEL(JROF,JLEV)=PEVEL(JROF,JLEV)+PDT*0.5_JPRB*ZED

  ENDDO
ENDDO

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

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

