SUBROUTINE CPG25(CDCONF,KNUMB,KSTGLO,PB15,PB2,&
 & PRCORI,PGM,PGOMVRL,PGOMVRM,&
 & POROG,POROGL,POROGM,&
 & PUT0,PVT0,PUT0L,PVT0L,PDIVT0,PVORT0,&
 & PSPT0,PSPT0L,PSPT0M)  

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

USE YOMDIM   , ONLY : NPROMA
USE YOMCT0   , ONLY : LTWOTL
USE YOMCT3   , ONLY : NSTEP
USE YOMDYN   , ONLY : TDT      ,LELTRA
USE YOMSC2   , ONLY : NFLDSLB15 ,NFLDSLB2
USE YOMTRSL  , ONLY : NTRSLTYPE
USE PTRSLB15  , ONLY : MSLB1U95 ,MSLB1V95 ,MSLB1SP95,&
 & MSLB1U05 ,MSLB1V05 ,MSLB1SP05,MSLB1UR05,MSLB1VR05  
USE PTRSLB2  , ONLY : MSLB2U15 ,MSLB2V15 ,MSLB2USI5,&
 & MSLB2VSI5,MSLB2URL5,MSLB2VRL5  

!**** *CPG25* - Grid point calculations - 2-D model.

!     Purpose.
!     --------
!           Grid point calculations in dynamics - 2-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* *CPG25(...)

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

!        CDCONF    : configuration of work                       (I)
!        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)
!        PRCORI    : Coriolis parameter                          (I)
!        PGM       : Mapping factor                              (I)
!        PGOMVRL   : Zonal component of 2*Omega vectorial r      (I)
!        PGOMVRM   : Meridian component of 2*Omega vectorial r   (I)
!        POROG     : Orography                                   (I)
!        POROGL    : Zonal component of orography derivative     (I/O)
!        POROGM    : Meridian component of orography derivative  (I/O)
!        PUT0      : zonal wind time t                           (I/O)
!        PVT0      : meridian wind time t                        (I/O)
!        PUT0L     : zonal derivative of zonal wind time t       (I/O)
!        PVT0L     : zonal derivative of meridian wind time t    (I/O)
!        PDIVT0    : divergence  time t                          (I/O)
!        PVORT0    : vorticity  time t                           (I/O)
!        PSPT0     : equivalent height time t                    (I)
!        PSPT0L    : zonal derivative of PSPT0                   (I/O)
!        PSPT0M    : meridian derivative of PSPT0                (I/O)

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

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

!     Externals.
!     ----------
!        Calls RDSLTRAJ to get stored trajectory information.
!        Calls LACDYNSHW if SL scheme.
!        Is called by SCAN2MSM (if SM) or SCAN2M (if DM).

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

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

!     Modifications.
!     --------------
!        Original : 98-12-22
!        Modified 99-01-22 by C.Temperton: stored semi-Lag. trajectory
!        Modified 99-01-26 by C.Temperton: NTRSLTYPE=2
!        Modified 99-03-15 by C.Temperton: bugfixes for LMESSP=.T.
!        Modified 99-06-22 by C.Temperton: add L2TLFF option
!        Modified 99-08-16 by C.Temperton: removed redundant RKROMA
!        Modified 99-08-20 by C.Temperton: RDSLTRAJ -> RDSLTRAJ2
!        Modified 99-11-19 by C.Temperton: bugfix, NSLB2 -> KSLB2
!        Modified 02-11-14 by K. YESSAD  : cleanings.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K. Yessad Nov 2008: rationalisation of dummy argument interfaces
!     ------------------------------------------------------------------

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB15(NPROMA,NFLDSLB15) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB2(NPROMA,NFLDSLB2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRCORI(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGOMVRL(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGOMVRM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: POROGL(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: POROGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUT0(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVT0(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUT0L(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVT0L(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIVT0(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVORT0(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPT0(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPT0L(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPT0M(NPROMA) 

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

! * time 9:
REAL(KIND=JPRB) :: ZDIVT9  (NPROMA)
REAL(KIND=JPRB) :: ZUT9    (NPROMA)
REAL(KIND=JPRB) :: ZVT9    (NPROMA)
REAL(KIND=JPRB) :: ZSPT9   (NPROMA)
REAL(KIND=JPRB) :: ZSPT9L  (NPROMA)
REAL(KIND=JPRB) :: ZSPT9M  (NPROMA)
REAL(KIND=JPRB) :: ZSPNLT9 (NPROMA)
! * other:
REAL(KIND=JPRB) :: ZDUM(NPROMA)

INTEGER(KIND=JPIM) :: IEND, IST

LOGICAL :: LLFSTEP, LLREAD

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

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

#include "abor1.intfb.h"
#include "lacdynshw.intfb.h"
#include "rdsltraj2.intfb.h"

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

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

IF    (CDCONF == 'A')THEN
  ZDT=TDT
ELSEIF(CDCONF == 'E')THEN
  ZDT=1.0_JPRB
ELSEIF(CDCONF == 'B')THEN
  ZDT=0.0_JPRB
ELSE
  CALL ABOR1(' CPG25 - UNKNOWN CONFIGURATION ')
ENDIF

IF(NSTEP > 0) THEN
  LLFSTEP=.FALSE.
ELSE
  LLFSTEP=.TRUE.
ENDIF

IST =1
IEND=KNUMB

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

!*       2.    INTERFACE TO GLOBAL ARRAYS.
!              ---------------------------

!       * Preliminary fill buffers with zero.

PB15(IST:IEND,:)=0.0_JPRB
PB2(IST:IEND,:)=0.0_JPRB

IF (NTRSLTYPE <= 1) THEN

!*       2.1   CASE NTRSLTYPE <=1.

!*         2.1.1   GET t-dt VARIABLES.

  LLREAD=.NOT.LLFSTEP

  IF(LLREAD) THEN
    CALL RDSLTRAJ2(NSTEP,IST,IEND,KSTGLO,3,ZUT9,ZVT9,ZSPNLT9,&
     & ZDUM,ZDUM,ZDUM,ZDUM,ZDUM,ZDUM,ZDUM,ZDUM,ZDUM,ZDUM,ZDUM,ZDUM,    &
     & ZDUM,ZDUM)  
  ENDIF

!*         2.1.3   MAP FACTOR

  PUT0  (IST:IEND)=PUT0  (IST:IEND)* PGM(IST:IEND)
  PVT0  (IST:IEND)=PVT0  (IST:IEND)* PGM(IST:IEND)
  PUT0L (IST:IEND)=PUT0L (IST:IEND)*(PGM(IST:IEND)**2)
  PVT0L (IST:IEND)=PVT0L (IST:IEND)*(PGM(IST:IEND)**2)
  PDIVT0(IST:IEND)=PDIVT0(IST:IEND)*(PGM(IST:IEND)**2)
  PVORT0(IST:IEND)=PVORT0(IST:IEND)*(PGM(IST:IEND)**2)
  PSPT0L(IST:IEND)=PSPT0L(IST:IEND)* PGM(IST:IEND)
  PSPT0M(IST:IEND)=PSPT0M(IST:IEND)* PGM(IST:IEND)
  IF (LLREAD.AND..NOT.LELTRA) THEN
    ZUT9  (IST:IEND)=ZUT9  (IST:IEND)* PGM(IST:IEND)
    ZVT9  (IST:IEND)=ZVT9  (IST:IEND)* PGM(IST:IEND)
  ENDIF
  IF (.NOT.LTWOTL) THEN
    ZDIVT9(IST:IEND)=ZDIVT9(IST:IEND)*(PGM(IST:IEND)**2)
    ZSPT9L(IST:IEND)=ZSPT9L(IST:IEND)* PGM(IST:IEND)
    ZSPT9M(IST:IEND)=ZSPT9M(IST:IEND)* PGM(IST:IEND)
  ENDIF
  POROGL(IST:IEND)=POROGL(IST:IEND)* PGM(IST:IEND)
  POROGM(IST:IEND)=POROGM(IST:IEND)* PGM(IST:IEND)

!*         2.1.4   SHALLOW WATER MODEL: SEMI-LAGRANGIAN SCHEME.

!     * Fill buffers.

  ZDUM(1:NPROMA)=0.0_JPRB
  CALL LACDYNSHW(CDCONF,NPROMA,IST,IEND,ZDT,&
   & ZUT9,ZVT9,ZSPT9,ZDIVT9,ZSPT9L,ZSPT9M,&
   & PUT0,PVT0,PSPT0,PDIVT0,PSPT0L,PSPT0M,&
   & PGM,PRCORI,PGOMVRL,PGOMVRM,POROG,POROGL,POROGM,&
   & ZSPNLT9,&
   & PB15(1,MSLB1U95),PB15(1,MSLB1V95),&
   & PB15(1,MSLB1SP95),PB15(1,MSLB1U05),&
   & PB15(1,MSLB1V05),PB15(1,MSLB1SP05),&
   & PB2(1,MSLB2U15),PB2(1,MSLB2V15), ZDUM,&
   & PB15(1,MSLB1UR05),PB15(1,MSLB1VR05),&
   & PB2(1,MSLB2USI5),PB2(1,MSLB2VSI5),&
   & PB2(1,MSLB2URL5),PB2(1,MSLB2VRL5))  

ELSEIF (NTRSLTYPE == 2) THEN

!*       2.2   CASE NTRSLTYPE =2.

  CALL RDSLTRAJ2(NSTEP,IST,IEND,KSTGLO,14,ZDUM,ZDUM,ZDUM,&
   & PB15(1,MSLB1U95),PB15(1,MSLB1V95),&
   & PB15(1,MSLB1SP95),PB15(1,MSLB1U05),&
   & PB15(1,MSLB1V05),PB15(1,MSLB1SP05),&
   & PB15(1,MSLB1UR05),PB15(1,MSLB1VR05),&
   & PB2(1,MSLB2URL5),PB2(1,MSLB2VRL5),&
   & PB2(1,MSLB2USI5),PB2(1,MSLB2VSI5),&
   & PB2(1,MSLB2U15),PB2(1,MSLB2V15) )  

ENDIF

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

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