SUBROUTINE CPG_END_TL( &
 !---------------------------------------------------------------------
 ! - INPUT .
 & KST,KEND,KSTC,KENDC,KSTGLO, &
 & PGM, &
 & PD3Y0,PRRED0,PGPHL,PGPHM,PWW0, &
 !---------------------------------------------------------------------
 ! - INPUT/OUTPUT .
 & PGFL,PGPPC,PGMV,PGMVS)

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

USE PTRGPPC  , ONLY : MGPPCO_Y ,MGPPCO_GL,MGPPCO_GM,MGPPCO_RR,MGPPCO_WW
USE YOMGPPCB  , ONLY : GPPCBUF
USE YOMCT0   , ONLY : LSLAG    ,LPC_OLD
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA   ,NPROMNH  ,NFGPPC
USE YOMDYN   , ONLY : NCURRENT_ITER
USE YOMGEM   , ONLY : RSTRET
USE YOM_YGFL , ONLY : YGFL
USE YOMGMV

!**** *CPG_END_TL* - Grid point calculations: end of non lagged part, TL code.

!     Purpose.
!     --------
!           Grid point calculations: end of non lagged part, TL code.
!           Note that this routine looks like a subset of CPG_END:
!           - part 3 is quasi-identical to part 3 of CPG_END.
!           - part 5 is a subset of the part 5 of CPG_END.

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

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

!     INPUT:
!     ------
!        KST       : first element of work.
!        KEND      : last element of work.
!        KSTC,KENDC: the same as KST,KEND but including zone C for ALADIN.
!        KSTGLO    : global offset.
!        PGM       : mapping factor.
!        PD3Y0     : term 'Y' at t.
!        PRRED0    : reduced gas constant by (1.+Prond) in NH at t.
!        PGPHL     : semi-reduced zonal component of "gz" gradient
!                    on interlayers.
!        PGPHM     : semi-reduced meridian component of "gz" gradient
!                    on interlayers.
!        PWW0      : weights to compute (U,V) on interlayers.

!     INPUT/OUTPUT:
!     -------------
!        PGFL      : GFL variables at time t-dt and t.
!        PGPPC     : buffer containing some fields used in the PC schemes.
!        PGMV      : upper air GMV variables at time t and t-dt.
!        PGMVS     : surface GMV variables at time t and t-dt.

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

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

!     Externals.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        K. Yessad, after CPGTL (old part 4 of CPGTL)

! Modifications
! -------------
!   Original     : 12 Jul 2004.
!   17-Apr-2007 S.Ivatek-S: Over dimensioning of PGPNH to NFGPNH+1, boundary
!                           checking problem if NFGPNH=0 bf
!   N. Wedi and K. Yessad (Jan 2008): different dev for NH model and PC scheme
!   K. Yessad (Dec 2008): remove dummy CDLOCK
! End Modifications
!------------------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KST
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTC
INTEGER(KIND=JPIM),INTENT(IN)    :: KENDC
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PD3Y0(NPROMNH,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRRED0(NPROMNH,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGPHL(NPROMA,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGPHM(NPROMA,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWW0(NPROMNH,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGFL(NPROMA,NFLEVG,YGFL%NDIM)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGPPC(NPROMA,NFGPPC+1)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMV(NPROMA,NFLEVG,NDIMGMV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVS(NPROMA,NDIMGMVS)

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

LOGICAL :: LLSTR

INTEGER(KIND=JPIM) :: IFLAG, JLEV, JROF

REAL(KIND=JPRB) :: ZDUM(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZEPS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "gpmpfc.intfb.h"
#include "gpmpfc_gmvs.intfb.h"
#include "sc2wrg.intfb.h"

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

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

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

!*    1.    PRELIMINARY INITIALISATIONS.
!           ----------------------------

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

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

!*    3.    DIVIDE BY MAPPING FACTOR.
!           -------------------------

IF(LLSTR) THEN

  IFLAG=1

  CALL GPMPFC(&
   ! --- INPUT ---------------------------------------------------------
   & KST,KEND,IFLAG,PGM,&
   ! --- INPUT/OUTPUT --------------------------------------------------
   & PGMV(1,1,YT0%MU),PGMV(1,1,YT0%MV),PGMV(1,1,YT0%MDIV),&
   & PGMV(1,1,YT0%MTL),PGMV(1,1,YT0%MTM),&
   & PGMV(1,1,YT0%MSPDL),PGMV(1,1,YT0%MSPDM),&
   & PGMV(1,1,YT0%MSVDL),PGMV(1,1,YT0%MSVDM),&
   & ZDUM,ZDUM,&
   & PGMV(1,1,YT9%MU),PGMV(1,1,YT9%MV),PGMV(1,1,YT9%MDIV),&
   & PGMV(1,1,YT9%MTL),PGMV(1,1,YT9%MTM),&
   & PGMV(1,1,YT9%MSPDL),PGMV(1,1,YT9%MSPDM),&
   & PGMV(1,1,YT9%MSVDL),PGMV(1,1,YT9%MSVDM),&
   & PGMV(1,1,YT0%MUL),PGMV(1,1,YT0%MVL),PGMV(1,1,YT0%MVOR),&
   & PGMV(1,1,YT9%MUL),PGMV(1,1,YT9%MVL),PGMV(1,1,YT9%MVOR),&
   & PGFL)

  CALL GPMPFC_GMVS(&
   ! --- INPUT ---------------------------------------------------------
   & KST,KEND,IFLAG,PGM,&
   ! --- INPUT/OUTPUT --------------------------------------------------
   & PGMVS(1,YT0%MSPL),PGMVS(1,YT0%MSPM),&
   & PGMVS(1,YT9%MSPL),PGMVS(1,YT9%MSPM))

ENDIF

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

!     5.    "WRITE" TO WORK FILES.
!           ----------------------

!*  Save the intermediate "strangers" for the corrective NHS
!   iteration, if needed.

IF(NCURRENT_ITER == 0 .AND. LPC_OLD) THEN
  IF(.NOT.LSLAG)THEN
    DO JLEV=1, NFLEVG
      DO JROF=KST,KEND
        PGPPC(JROF,MGPPCO_Y+JLEV-1)=PD3Y0(JROF,JLEV)
      ENDDO
    ENDDO
  ENDIF
  DO JLEV=1, NFLEVG
    DO JROF=KST,KEND
      PGPPC(JROF,MGPPCO_RR+JLEV-1)=PRRED0(JROF,JLEV  )
      PGPPC(JROF,MGPPCO_GL+JLEV-1)=PGPHL (JROF,JLEV-1)
      PGPPC(JROF,MGPPCO_GM+JLEV-1)=PGPHM (JROF,JLEV-1)
      PGPPC(JROF,MGPPCO_WW+JLEV-1)=PWW0  (JROF,JLEV  )
    ENDDO
  ENDDO
  CALL SC2WRG(GPPCBUF,KSTGLO,KSTC,KENDC,PGPPC(1:NPROMA,1:NFGPPC))
ENDIF

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

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