#ifdef RS6K
@PROCESS NOCHECK
#endif
SUBROUTINE CPG5(KNUMB,KSTGLO,PB15,PB2)

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

USE YOMDIM   , ONLY : NPROMA   ,NFLEVG   ,NFLSA
USE YOMDYNA  , ONLY : LSLHD    ,LSLHD_STATIC
USE YOMSC2   , ONLY : NFLDSLB15 ,NFLDSLB2
USE YOMCT0   , ONLY : LSLAG
USE YOMCT3   , ONLY : NSTEP
USE YOMTRSL  , ONLY : NTRSLTYPE
USE PTRSLB15  , ONLY : MSLB1U95 ,MSLB1V95 ,MSLB1SP95,&
 & MSLB1U05 ,MSLB1V05 ,MSLB1UR05,MSLB1VR05,&
 & MSLB1T95 ,MSLB1GFL95 ,MSLB1C95 ,MSLB1T05 ,&
 & MSLB1C05 ,MSLB1WR05  
USE PTRSLB2  , ONLY : MSLB2U15 ,MSLB2V15 ,MSLB2T15 ,MSLB2Q15 ,&
 & MSLB2URL5,MSLB2VRL5,MSLB2WRL5,MSLB2KAPPA5  
USE TRAJ_SEMILAG_MOD, ONLY : GET_TRAJ_SLAG

!**** *CPG5* - Grid point calculations - 3-D model.

!     Purpose.
!     --------
!           Grid point calculations in dynamics - 3-D MODEL.
!     ****  Either repeats some trajectory calculations for
!     ****  the adjoint of the semi-Lagrangian scheme - or
!     ****  reads them back from additional trajectory storage.

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

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

!        KNUMB     : number of elements of arrays for which          
!                    computations are performed (MP version)     (I)
!        KSTGLO    : global offset (MP version)                  (I)
!        PB15      : SL buffer for quantities to be interpolated (O)
!        PB2       : Buffer for t+dt quantities                  (O)

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

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

!     Externals.
!     ----------
!        Calls RDSLTRAJ to get stored trajectory information.
!        Calls LACDYN if SL scheme.
!        Is called by SCAN2MAD

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

!     Author.
!     -------
!        Clive Temperton *ECMWF* (after CPG25)

!     Modifications.
!     --------------
!        Original : 99-10-19
!        C.Temperton: 00-02-08: MSLB1C0 included for SL TL/AD
!         (for improved vectorization in the "update loop" in LARCINAD)
!        C.Temperton: 01-01-29: Call to RDSLTRAJ (for case LSPRT=.T.)
!        Y.Tremolet: 01-03-29: New module for trajectory
!        K. YESSAD 04-JAN-2002: pruning (rm obsolete NVLAG=1, PCL05, PX05)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K.YESSAD (Jan 2004): adapt code to any value of NFLSA.
!        K. Yessad (Dec 2008): remove useless dummy arguments
!        F. Vana  13-Jan-2009: KAPPA5 for TL/AD of SLHD
!     ------------------------------------------------------------------

IMPLICIT NONE

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

INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PB15(NPROMA,NFLDSLB15) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PB2(NPROMA,NFLDSLB2) 

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

INTEGER(KIND=JPIM) :: IST, IEND, JLEV, IBLK
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"

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

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

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

!       * Preliminary fill buffers with zero.

IST =1
IEND=KNUMB

!cdir collapse
PB15(:,:)=0.0_JPRB
!cdir collapse
PB2(:,:)=0.0_JPRB

IF (NTRSLTYPE == 1) THEN

  CALL ABOR1(' CPG5 - NTRSLTYPE=1 NOT CODED YET FOR 3-D MODEL')

ELSEIF (NTRSLTYPE == 2) THEN

  IBLK=(KSTGLO-1)/NPROMA+1
  CALL GET_TRAJ_SLAG(PB15(1,MSLB1U95+1-NFLSA) , PB15(1,MSLB1V95+1-NFLSA) ,&
   & PB15(1,MSLB1T95+1-NFLSA) , PB15(1,MSLB1GFL95) ,&
   & PB15(1,MSLB1C95+1-NFLSA) ,&
   & PB15(1,MSLB1U05+1-NFLSA) , PB15(1,MSLB1V05+1-NFLSA) ,&
   & PB15(1,MSLB1T05+1-NFLSA) , &
   & PB2 (1,MSLB2U15)   , PB2(1,MSLB2V15)   ,&
   & PB2 (1,MSLB2T15)   , PB2(1,MSLB2Q15)   ,&
   & PB15(1,MSLB1UR05+1-NFLSA), PB15(1,MSLB1VR05+1-NFLSA),&
   & PB15(1,MSLB1WR05+1-NFLSA), PB2(1,MSLB2URL5)  ,&
   & PB2 (1,MSLB2VRL5)  , PB2(1,MSLB2WRL5)  , PB2(1,MSLB2KAPPA5),&
   & PB15(1,MSLB1SP95)  , &
   & NSTEP,IBLK,IST,IEND)  

  IF (LSLAG) THEN
    ! Copy SP95 to C05 (multiple copies):
    DO JLEV=1,NFLEVG
      PB15(IST:IEND,MSLB1C05-NFLSA+JLEV)=PB15(IST:IEND,MSLB1SP95)
    ENDDO
  ENDIF

  IF (LSLHD.AND.LSLHD_STATIC) THEN
    ! In case of static SLHD (= two different standard SL interpolations)
    ! KAPPA becomes trivial. Hence no need to save it from NL model.
    ! Instead it is restored here.
    DO JLEV=1,NFLEVG
      PB2(IST:IEND,MSLB2KAPPA5+JLEV-1)=1._JPRB
    ENDDO
  ENDIF

ENDIF

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

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