#ifdef RS6K
@PROCESS NOCHECK
#endif
SUBROUTINE CPGLAG(CDCONF,&
 & KNUMB,KSTGLO,KNUMBE,&
 & PGMV,PGMVS,&
 & PGM,POROG,POROGL,POROGM,&
 & PB2,PGFLT1,&
 & PGMVT1,&
 & PGMVT1S,&
 & PGFL)

USE PARKIND1 , ONLY : JPIM     ,JPRB
USE PTRSLB2  , ONLY : MSLB2Y1  ,MSLB2USI ,MSLB2VSI ,MSLB2TSI ,MSLB2PDSI, &
 &                    MSLB2VDSI,MSLB2SPSI
USE YOMCT0   , ONLY : LSLAG    ,LPC_OLD  ,LPC_FULL ,LNHDYN   ,LTWOTL
USE YOMCT2   , ONLY : NSTOP2
USE YOMCT3   , ONLY : NSTEP
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA   
USE YOMDYNA  , ONLY : NVDVAR   ,ND4SYS
USE YOMDYN   , ONLY : TSTEP    ,TDT      ,NSITER   ,NCURRENT_ITER
USE YOMGEM   , ONLY : RSTRET
USE YOMHOOK  , ONLY : LHOOK    ,DR_HOOK
USE YOMSC2   , ONLY : NFLDSLB2
USE YOMGMV   , ONLY : YT9      ,YT0      ,YT1      ,NDIMGMV  ,NDIMGMVS
USE YOM_YGFL , ONLY : YGFL     ,YQ, YL, YI, YR, YS, YG

!**** *CPGLAG* - Grid point calculations - lagged part.

!     Purpose.
!     --------
!           Grid point calculations lagged part.

!**   Interface.
!     ----------
!        *CALL* *CPGLAG*

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

!        CDCONF        : configuration of work
!        KNUMB         : number of elements of arrays for which computations
!                        are performed (used in message passing version)
!        KSTGLO        : global offset (used in message passing version)
!        KNUMBE        : number of elements of arrays for which buffer
!                        write/read
!                        are performed (used in message passing version)
!        PGMV          : "t-dt" and "t" GMV upper air variables.
!        PGMVS         : "t-dt" and "t" GMV surface variables.
!        PGM           : mapping factor.
!        POROG         : surface orography.
!        POROGL,POROGM : grad'(surface orography).
!        PB2           : "SLB2" second buffer.
!        PGFLT1        : "t+dt" GFL variables.
!        PGMVT1        : "t+dt" GMV upper air variables.
!        PGMVT1S       : "t+dt" GMV surface variables.
!        PGFL          : "t-dt" and "t" GFL variables.

!        Implicit arguments :
!        --------------------

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

!     Externals.
!     ----------
!        Called by GP_MODEL.

!     Reference.
!     ----------
!        ARPEGE documentation vol 2 ch 1 and vol 3 ch 6

!     Author.
!     -------
!        Mats Hamrud  *ECMWF*

! Modifications
! -------------
!   Original : 92-02-01
!   D. Giard : 92-05-22  adaptation of NNMI to semi-lag. scheme
!   D.Dent   : 92-06-25  Remove event logic
!   D. Giard : 92-10-30  CDCONF='M' for total tendencies (NNMI)
!   D. Giard : 92-11-26  accumulation of diab. tend. for lagged physics
!   D. Giard : 92-12-23  correction of CDCONF='M' (time-step)
!   K. Yessad: 18/12/1992. Non interpolating vertical semi-lag scheme.
!   M. Hamrud: 93-02-15 "post-physics" moved to POSTPHY
!   D. Giard : 93-04-08  time-step for dynamical tendencies
!   D. Giard : 93-05-17  LLADNMI
!   D. Giard : 93-05-24  ACUMTND2 --> CPACTND2
!   M. Deque : 93-05-27 subgrid surface temperature and fluxes
!   M. Hamrud/P. Viterbo :93-10-05 New ECMFW surface scheme
!   Modified 93-12-14 by K. YESSAD: interpolations at medium point for
!                                   semi-lagrangian temperature equation.
!   Modified 93-12-21 by C. Temperton: interpolations at medium point for
!                                   semi-lagrangian moisture equation.
!   M.Hamrud : 94-01-31 Memory savings (pass some local arrays to
!                       LAPINE for use as work space)
!   Modified 94-03-23 by M. Hortal: interpolations at medium point for
!                                   semi-lagrangian momentum equations.
!   M. Deque : 94-09-05 Aerosols and thermal roughness
!   C. Temperton: 94-05-12 : Spectral RT option
!   Modified 94-06-20 by M.Hamrud : upper air grid-point file
!   Modified 93-11-10 by R. EL Khatib (Non hydrostatic variables)
!   Modified 94-10-17 by M. Tolstykh: CUD-5 interpolation
!   Modified 95-01-18 by M.Hamrud (cleaning and splitting)
!   Modified 95-02-06 by C. Temperton: two-time-level scheme
!   Modified 95-06-06 by D. Giard : time-step for semi-lag. tendencies
!   Modified 95-10-18 by J.F. Mahfouf : storage of the trajectory t-dt
!   Modified 95-08-25 by T. Stockdale: accumulation of fluxes for coupling
!   Modified OCT 1995 by K. YESSAD:
!     - Update dummy arguments of LAPINE for accurate 2TL SL scheme.
!   Modified 96-02-20 by MPP Group  : Adapted for Message Passing
!   Modified 96-03 by A. Untch : grid-point prognostic ozone (EC)
!   Modified 96-06-01 by M. Janousek and R. Bubnova: SL non-hydrostatic
!   Modified 96-05-29 by D. Giard : CDCONF='X' for initial fluxes
!   Modified 97-05-29 by M. Deque : Frozen FMR                   
!   Modified 97-06-13 by J. Bidlot : add wave specific fields
!   Modified 98-01-08 by E. Holm : Included ozone in Eulerian model
!   Modified 98-05-27 by E. Holm : Reorder ozone in calls to LAPINE and CALLPAR
!   Modified 98-07-31 by K. YESSAD: cleaning
!   Modified 98-09-01 by N. Wedi: split physics in semi-lagrangian mode
!   Modified 98-10-21 by Z. Bencetic Klaic: control on NTOZ1D
!     - removal of options requiring an anterior point in the 2TLSL
!   Modified 98-12-04 by K. YESSAD: option 'lradvtoro'.
!   Modified 99-03-26 by J. Teixeira: Surface tiling
!   Modified 99-03-31 by P. SMOLIKOVA: option LRDAORG (double averaging).
!   Modified 99-09-21 by D.SALMOND : 'On demand' Semi-Lagrangian Comms
!   Modified 00-02-11 by C. Temperton: added KVSEP
!   Modified 00-03-06 by A.Beljaars:
!     - PP of TTRC,TSRC,STRC,SSRC,ES,SMLT,10FG,LSFP
!   Modified 00-05-15 by C.Jakob: New surface DDH
!   Modified 00-06-15 by C. Temperton: NVSEP -> NVSEPC,NVSEPL.
!   Modified 00-10-03 by C.Fischer: interface of PB2 in NHS iter step
!   Modified 01-08-30 by K. YESSAD: pruning and some other cleanings.
!   Modified 01-08-07 by R. El Khatib - Pruning options
!   03-2002 J.Vivoda PC schemes for NH dynamics (LPC_XXXX keys)
!   Modified 02-09-30 by P. Smolikova - variable d4 in NH
!   Modified 03-07-17 by C. Fischer - psvd1aux goes into pgmvt1(yt1%msvdaux)
!   01-Oct-2003 M. Hamrud  CY28 Cleaning
!   09-Jun-2004 J. Masek   NH cleaning (LPC_NOTR, LFULLIMP)
!   01-Jul-2004 K. Yessad  Make clearer the tests for PC scheme.
!   N. Wedi and K. Yessad (Nov 2007): ND4SYS to improve NH model stability.
!   K. Yessad (Dec 2008): remove dummy CDLOCK + cleanings
!------------------------------------------------------------------------------

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMBE 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMV(NPROMA,NFLEVG,NDIMGMV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVS(NPROMA,NDIMGMVS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROGL(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB2(NPROMA,NFLDSLB2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFLT1(NPROMA,NFLEVG,YGFL%NDIM1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVT1(NPROMA,NFLEVG,YT1%NDIM) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVT1S(NPROMA,YT1%NDIMS) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGFL(NPROMA,NFLEVG,YGFL%NDIM) 

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

INTEGER(KIND=JPIM) :: IEND, IENDC, IST, ISTC, JLEV, JROF

LOGICAL :: LLADNMI
LOGICAL :: LLLSTEP
LOGICAL :: LLSTR

REAL(KIND=JPRB) :: ZDT,ZEPS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

REAL(KIND=JPRB),ALLOCATABLE :: ZOROGL_SR(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZOROGM_SR(:)

REAL(KIND=JPRB) :: ZGMVNHXT1B(NPROMA,NFLEVG)

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

#include "estrcpl.intfb.h"
#include "gnhx.intfb.h"
#include "gpendtr.intfb.h"
#include "gptf1.intfb.h"

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

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

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

!*       1.    Interface to global arrays.
!              ---------------------------

!*       1.1   INITIAL COMPUTATIONS

ZEPS=100.0_JPRB*TINY(1.0_JPRB)
LLSTR=(ABS(RSTRET-1.0_JPRB)>ZEPS)

! Adiabatic NNMI iteration
LLADNMI = CDCONF == 'E' .OR. CDCONF == 'F'
IF (LLADNMI) THEN
  ZDT = TSTEP
ELSE
  ZDT= TDT
ENDIF

IF(NSTEP < NSTOP2 .AND. .NOT. LLADNMI) THEN
  LLLSTEP=.FALSE.
ELSE
  LLLSTEP=.TRUE.
ENDIF

IST   = 1
IEND  = KNUMB
ISTC  = 1
IENDC = KNUMBE

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

!*    3.    ADD d4 EQN NON ADVECTIVE TENDENCIES OF 'NHX'
!           --------------------------------------------

IF (LNHDYN .AND. LSLAG .AND. NVDVAR==4 .AND. ND4SYS==2 .AND. &
 & NCURRENT_ITER==NSITER) THEN

  ALLOCATE(ZOROGL_SR(NPROMA))
  ALLOCATE(ZOROGM_SR(NPROMA))

  ZOROGL_SR(IST:IEND)=PGM(IST:IEND)*POROGL(IST:IEND)
  ZOROGM_SR(IST:IEND)=PGM(IST:IEND)*POROGM(IST:IEND)

  ! * Compute a diagnostic value of NHX(t+dt) via GNHX.
  CALL GNHX( &
   ! --- INPUT -------------------------------------------------
   & NPROMA,IST,IEND,POROG,ZOROGL_SR,ZOROGM_SR, &
   & PGMVT1S(1,YT1%MSP),PGMVS(1,YT0%MSPL),PGMVS(1,YT0%MSPM), &
   & PGMVT1(1,1,YT1%MT),PGMV(1,1,YT0%MTL),PGMV(1,1,YT0%MTM), &
   & PGFLT1(1,1,YQ%MP1),PGFL(1,1,YQ%MPL),PGFL(1,1,YQ%MPM), &
   & PGFLT1(1,1,YL%MP1),PGFL(1,1,YL%MPL),PGFL(1,1,YL%MPM), &
   & PGFLT1(1,1,YI%MP1),PGFL(1,1,YI%MPL),PGFL(1,1,YI%MPM), &
   & PGFLT1(1,1,YR%MP1),PGFLT1(1,1,YS%MP1),PGFLT1(1,1,YG%MP1), &
   & PGMVT1(1,1,YT1%MU),PGMVT1(1,1,YT1%MV),PGMVT1(1,1,YT1%MSPD), &
   & PGMV(1,1,YT0%MSPDL),PGMV(1,1,YT0%MSPDM), &
   ! --- OUTPUT ------------------------------------------------
   & ZGMVNHXT1B)

  DEALLOCATE(ZOROGL_SR)
  DEALLOCATE(ZOROGM_SR)

  ! * Add non advective tendencies of NHX to the RHS of NHX and d4 eqns.
  PGMVT1(IST:IEND,1:NFLEVG,YT1%MNHX) = ZGMVNHXT1B(IST:IEND,1:NFLEVG)
  IF (LTWOTL) THEN
    IF( NSITER == 0 ) THEN
      PGMVT1(IST:IEND,1:NFLEVG,YT1%MSVD)=PGMVT1(IST:IEND,1:NFLEVG,YT1%MSVD) + &
       & ZGMVNHXT1B(IST:IEND,1:NFLEVG) - PGMV(IST:IEND,1:NFLEVG,YT0%MNHX)
    ELSE
      PGMVT1(IST:IEND,1:NFLEVG,YT1%MSVD)=PGMVT1(IST:IEND,1:NFLEVG,YT1%MSVD) + &
       & ZGMVNHXT1B(IST:IEND,1:NFLEVG) - PGMV(IST:IEND,1:NFLEVG,YT9%MNHX)
    ENDIF
  ELSE
    PGMVT1(IST:IEND,1:NFLEVG,YT1%MSVD) = PGMVT1(IST:IEND,1:NFLEVG,YT1%MSVD) + &
     & ZGMVNHXT1B(IST:IEND,1:NFLEVG) - PGMV(IST:IEND,1:NFLEVG,YT9%MNHX)
  ENDIF

ENDIF

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

!*    4.    TIME FILTER (PART 1).
!           ---------------------

IF ((.NOT.LLADNMI).AND.(NCURRENT_ITER == 0)) THEN
  CALL GPTF1(IST,IEND,LLLSTEP,PGMV,PGMVS,PGFL)  
ENDIF

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

!*       5.   FINISH
!             ------

!*       5.1  TRANSFER FROM BUFFER TO T+DT ARRAYS (USUAL CASE)

IF ((NCURRENT_ITER == 0).OR.(NCURRENT_ITER > 0 .AND. LPC_FULL)) THEN

  CALL GPENDTR(IST,IEND,LLADNMI,ZDT,&
   & PGFLT1,&
   & PGMV(1,1,YT0%MU) ,PGMV(1,1,YT0%MV)  ,PGMV(1,1,YT0%MT),&
   & PGMVS(1,YT0%MSP),&
   & PB2(1,MSLB2USI) ,PB2(1,MSLB2VSI) ,PB2(1,MSLB2TSI),&
   & PB2(1,MSLB2SPSI),PB2(1,MSLB2PDSI),PB2(1,MSLB2VDSI),&
   & PGMVT1(1,1,YT1%MU),PGMVT1(1,1,YT1%MV),PGMVT1(1,1,YT1%MT),&
   & PGMVT1(1,1,YT1%MSPD),PGMVT1(1,1,YT1%MSVD),&
   & PGMVT1S(1,YT1%MSP),PGFL)

ENDIF

!*       5.2   WRITE OUT NON-HYDROSTATIC STRANGER Y

IF ((NCURRENT_ITER == 0 .AND. LPC_OLD).AND.LSLAG) THEN
  CALL ESTRCPL(IST,IEND,ISTC,IENDC,KSTGLO,PB2(1,MSLB2Y1))
ENDIF

!*       5.3  DIVIDE U AND V BY MAP FACTOR

IF(LLSTR) THEN
  DO JLEV=1,NFLEVG
    DO JROF=IST,IEND
      PGMVT1(JROF,JLEV,YT1%MU) = PGMVT1(JROF,JLEV,YT1%MU)/PGM(JROF)
      PGMVT1(JROF,JLEV,YT1%MV) = PGMVT1(JROF,JLEV,YT1%MV)/PGM(JROF)
    ENDDO
  ENDDO
ENDIF

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

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