MODULE TRAJ_SEMILAG_MOD

!     Purpose.
!     --------
!       Manage semi-lagrangian trajectory

!     Author.
!     -------
!        Y. Tremolet *ECMWF*

!     Modifications.
!     --------------
!        Original : 28-03-02
!        Modified by C. Temperton 02-01-08 Case LSPRT=.TRUE.
!        K. YESSAD 04-JAN-2002: pruning (rm obsolete NVLAG=1, PCL05, PX05)
!        Modified by C. Temperton 02-04-24 : allow TSTEP=0 (for testing).
!        Modified by C. Temperton 03-04-08 : bugfix for case LSPRT=.TRUE.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K. YESSAD (Jan 2004): correct dimension of PGFLL95.
!        Y.Tremolet    18-Mar-2004 Add lprttraj option for diagnostics
!        F. Vana    13-Jan-2009 : LSLHD = .T.
!     ------------------------------------------------------------------

USE PARKIND1 , ONLY: JPIM     ,JPRB
USE YOMHOOK  , ONLY: LHOOK,   DR_HOOK
USE YOMLUN   , ONLY: NULOUT
USE YOMDIM   , ONLY: NFLSA    ,NFLEN    ,NFLEVG, NPROMA, NGPBLKS
USE YOMDYN   , ONLY: TSTEP , LADVF  , L2TLFF
USE YOMDYNA  , ONLY: LSLHD    ,LSLHD_STATIC
USE YOMTRSL  , ONLY: NTRSLTYPE
USE YOMCT0 , ONLY : LSLAG, LIFSTRAJ , LSPRT
USE YOMTRAJ, ONLY: TRAJ_SLAG, NTRAJSL3D, NTRAJSL2D, NTRAJSL, &
 & NSTEPTRAJ, MSTEPTRAJW, MSTEPTRAJR, LPRTTRAJ  
USE YOM_YGFL , ONLY: YGFL, YGFLC

IMPLICIT NONE

PRIVATE
PUBLIC ALLOCATE_TRAJ_SLAG, DEALLOCATE_TRAJ_SLAG, &
 & STORE_TRAJ_SLAG, GET_TRAJ_SLAG  

#include "abor1.intfb.h"

!-----------------------------------------------------------------------
CONTAINS
!-----------------------------------------------------------------------

SUBROUTINE ALLOCATE_TRAJ_SLAG

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRAJ_SEMILAG_MOD:ALLOCATE_TRAJ_SLAG',0,ZHOOK_HANDLE)
IF (NTRSLTYPE==2) THEN ! Other types handled by Clive's code
  NTRAJSL3D = 0
  NTRAJSL2D = 0
  IF (LSLAG) THEN
    NTRAJSL3D = 13+YGFL%NUMFLDS
    NTRAJSL2D = 1
    IF (LADVF.AND.L2TLFF) NTRAJSL3D = NTRAJSL3D+2
    IF (LSLHD.AND.(.NOT.LSLHD_STATIC)) NTRAJSL3D = NTRAJSL3D+1
  ENDIF
  IF (LSPRT) NTRAJSL3D = NTRAJSL3D+2
  NTRAJSL = NTRAJSL3D*NFLEVG+NTRAJSL2D

  IF (LIFSTRAJ) THEN
    CALL ABOR1('Cannot interpolate SL trajectory')
  ELSE
    ALLOCATE(TRAJ_SLAG(NPROMA,NTRAJSL,NGPBLKS,nsteptraj))
  ENDIF

  WRITE(NULOUT,9)'TRAJ_SLAG ',SIZE(TRAJ_SLAG),SHAPE(TRAJ_SLAG)
  9 FORMAT(1X,'GREPTRAJ ARRAY ',A10,' ALLOCATED ',8I8)
ENDIF

IF (LHOOK) CALL DR_HOOK('TRAJ_SEMILAG_MOD:ALLOCATE_TRAJ_SLAG',1,ZHOOK_HANDLE)
END SUBROUTINE ALLOCATE_TRAJ_SLAG

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

SUBROUTINE DEALLOCATE_TRAJ_SLAG

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRAJ_SEMILAG_MOD:DEALLOCATE_TRAJ_SLAG',0,ZHOOK_HANDLE)
IF (ALLOCATED(TRAJ_SLAG)) DEALLOCATE(TRAJ_SLAG)

IF (LHOOK) CALL DR_HOOK('TRAJ_SEMILAG_MOD:DEALLOCATE_TRAJ_SLAG',1,ZHOOK_HANDLE)
END SUBROUTINE DEALLOCATE_TRAJ_SLAG

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

SUBROUTINE STORE_TRAJ_SLAG(PUL95,PVL95,PTL95,PGFLL95,PCL95, &
 & PUL05,PVL05,PTL05,PUT15,PVT15, &
 & PTT15,PQT15,PURL05,PVRL05, &
 & PWRL05,PURL5,PVRL5,PWRL5,PKAPPA5,PX95, &
 & KSTEP,KBLK,KSTA,KEND)  

INTEGER(KIND=JPIM),INTENT(IN) :: KBLK,KSTEP,KSTA,KEND
REAL(KIND=JPRB),INTENT(IN) :: PUL95 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PVL95 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PTL95 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PGFLL95 (NPROMA,NFLSA:NFLEN,YGFL%NUMFLDS)
REAL(KIND=JPRB),INTENT(IN) :: PCL95 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PUL05 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PVL05 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PTL05 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PUT15 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PVT15 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PTT15 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PQT15 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PURL05(NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PVRL05(NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PWRL05(NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PURL5 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PVRL5 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PWRL5 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PKAPPA5 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(IN) :: PX95  (NPROMA)

INTEGER(KIND=JPIM) :: jj,jf,istep,jgfl,ipoi
INTEGER(KIND=JPIM), SAVE :: IISTEP
REAL(KIND=JPRB) :: ZTSTEP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
DATA IISTEP/-99/

IF (LHOOK) CALL DR_HOOK('TRAJ_SEMILAG_MOD:STORE_TRAJ_SLAG',0,ZHOOK_HANDLE)
IF (LIFSTRAJ) CALL ABOR1('Cannot interpolate SL trajectory')

istep=MSTEPTRAJW(kstep)
IF (TSTEP == 0.0_JPRB) THEN
  ZTSTEP=1.0_JPRB
ELSE
  ZTSTEP=TSTEP
ENDIF

IF (istep>0) THEN
  jj=0

  IF (LSLAG) THEN
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PUL95 (ksta:kend,jf)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PVL95 (ksta:kend,jf)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PTL95 (ksta:kend,jf)
    ENDDO
    DO JGFL=1,YGFL%NUMFLDS
      IF(YGFLC(JGFL)%LADV) THEN
        DO jf=1,NFLEVG
          ipoi=jj+(YGFLC(JGFL)%MP-1)*NFLEVG+jf
          TRAJ_SLAG(ksta:kend,ipoi,kblk,istep)=&
           & PGFLL95 (ksta:kend,jf,YGFLC(JGFL)%MP_SL1)
        ENDDO
      ENDIF
    ENDDO
    jj=jj+YGFL%NUMFLDS*NFLEVG
! Some fields are tendencies which include a TSTEP factor which may
! be different when fields will be read in.
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PCL95 (ksta:kend,jf)/ZTSTEP
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PUL05 (ksta:kend,jf)/ZTSTEP
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PVL05 (ksta:kend,jf)/ZTSTEP
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PTL05 (ksta:kend,jf)/ZTSTEP
    ENDDO
    IF (LADVF.AND.L2TLFF) THEN
      DO jf=1,NFLEVG
        jj=jj+1
        TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PUT15 (ksta:kend,jf)
      ENDDO
      DO jf=1,NFLEVG
        jj=jj+1
        TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PVT15 (ksta:kend,jf)
      ENDDO
    ENDIF
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PURL05(ksta:kend,jf)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PVRL05(ksta:kend,jf)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PWRL05(ksta:kend,jf)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PURL5 (ksta:kend,jf)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PVRL5 (ksta:kend,jf)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PWRL5 (ksta:kend,jf)
    ENDDO
    IF (LSLHD.AND.(.NOT.LSLHD_STATIC)) THEN
      DO jf=1,NFLEVG
        jj=jj+1
        TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PKAPPA5 (ksta:kend,jf)
      ENDDO
    ENDIF
    jj=jj+1
    TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PX95  (ksta:kend)
  ENDIF
  IF (LSPRT) THEN
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PTT15 (ksta:kend,jf)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      TRAJ_SLAG(ksta:kend,jj,kblk,istep)=PQT15 (ksta:kend,jf)
    ENDDO
  ENDIF

!$OMP MASTER
  IF (LPRTTRAJ.AND.IISTEP/=ISTEP) THEN
    WRITE(NULOUT,*)'GREPTRAJ STORE_TRAJ_SLAG istep=',istep
    IISTEP=ISTEP
  ENDIF
!$OMP END MASTER
ENDIF

IF (LHOOK) CALL DR_HOOK('TRAJ_SEMILAG_MOD:STORE_TRAJ_SLAG',1,ZHOOK_HANDLE)
END SUBROUTINE STORE_TRAJ_SLAG

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

SUBROUTINE GET_TRAJ_SLAG(PUL95,PVL95,PTL95,PGFLL95,PCL95, &
 & PUL05,PVL05,PTL05,PUT15,PVT15, &
 & PTT15,PQT15,PURL05,PVRL05, &
 & PWRL05,PURL5,PVRL5,PWRL5,PKAPPA5,PX95, &
 & KSTEP,KBLK,KSTA,KEND)  

INTEGER(KIND=JPIM),INTENT(IN) :: KBLK,KSTEP,KSTA,KEND
REAL(KIND=JPRB),INTENT(OUT) :: PUL95 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PVL95 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PTL95 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PGFLL95 (NPROMA,NFLSA:NFLEN,YGFL%NUMFLDS)
REAL(KIND=JPRB),INTENT(OUT) :: PCL95 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PUL05 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PVL05 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PTL05 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PUT15 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PVT15 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PTT15 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PQT15 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PURL05(NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PVRL05(NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PWRL05(NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PURL5 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PVRL5 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PWRL5 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PKAPPA5 (NPROMA,NFLEVG)
REAL(KIND=JPRB),INTENT(OUT) :: PX95  (NPROMA)
INTEGER(KIND=JPIM) :: jj,jf,istep,jgfl,ipoi
REAL(KIND=JPRB) :: ZTSTEP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('TRAJ_SEMILAG_MOD:GET_TRAJ_SLAG',0,ZHOOK_HANDLE)
istep=MSTEPTRAJR(kstep)
IF (TSTEP == 0.0_JPRB) THEN
  ZTSTEP=1.0_JPRB
ELSE
  ZTSTEP=TSTEP
ENDIF

jj=0

IF (LSLAG) THEN
  DO jf=1,NFLEVG
    jj=jj+1
    PUL95 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PVL95 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PTL95 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO JGFL=1,YGFL%NUMFLDS
    IF(YGFLC(JGFL)%LADV) THEN
      DO jf=1,NFLEVG
        ipoi=jj+(YGFLC(JGFL)%MP-1)*NFLEVG+jf
        PGFLL95 (ksta:kend,jf,YGFLC(JGFL)%MP_SL1)=&
         & TRAJ_SLAG(ksta:kend,ipoi,kblk,istep)
      ENDDO
    ENDIF
  ENDDO
  jj=jj+YGFL%NUMFLDS*NFLEVG

! Some fields are tendencies which include a TSTEP factor which may
! have been different when fields were written.
  DO jf=1,NFLEVG
    jj=jj+1
    PCL95 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)*ZTSTEP
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PUL05 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)*ZTSTEP
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PVL05 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)*ZTSTEP
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PTL05 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)*ZTSTEP
  ENDDO
  IF (LADVF.AND.L2TLFF) THEN
    DO jf=1,NFLEVG
      jj=jj+1
      PUT15 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
    ENDDO
    DO jf=1,NFLEVG
      jj=jj+1
      PVT15 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
    ENDDO
  ENDIF
  DO jf=1,NFLEVG
    jj=jj+1
    PURL05(ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PVRL05(ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PWRL05(ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PURL5 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PVRL5 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PWRL5 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  IF (LSLHD.AND.(.NOT.LSLHD_STATIC)) THEN
    DO jf=1,NFLEVG
      jj=jj+1
      PKAPPA5 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
    ENDDO
  ENDIF
  jj=jj+1
  PX95  (ksta:kend)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
ENDIF
IF (LSPRT) THEN
  DO jf=1,NFLEVG
    jj=jj+1
    PTT15 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
  DO jf=1,NFLEVG
    jj=jj+1
    PQT15 (ksta:kend,jf)=TRAJ_SLAG(ksta:kend,jj,kblk,istep)
  ENDDO
ENDIF

IF (LPRTTRAJ) WRITE(NULOUT,*)'GREPTRAJ GET_TRAJ_SLAG istep=',istep

IF (LHOOK) CALL DR_HOOK('TRAJ_SEMILAG_MOD:GET_TRAJ_SLAG',1,ZHOOK_HANDLE)
END SUBROUTINE GET_TRAJ_SLAG

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

END MODULE TRAJ_SEMILAG_MOD
