SUBROUTINE RDSLTRAJ2 (KSTEP,KSTA,KEND,KJUMP,KFIELDS,&
 & PUT95,PVT95,PSPNLT95,PUL95,PVL95,&
 & PSPL95,PUL05,PVL05,PSPL05,&
 & PURL05,PVRL05,PURL5,PVRL5,PUSI5,PVSI5,&
 & PUT15,PVT15)   

!**** *RDSLTRAJ2* - Read in the trajectory at t-dt from work file
!                   (shallow-water version)

!     Purpose.  Read in the trajectory at t-dt from work file
!     (For use in tangent-linear and adjoint of semi-Lagrangian)

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

!        Explicit arguments :  KSTEP   - time step            (input)
!        --------------------  KSTA    - start adress         (input)
!                              KEND    - end adress           (input)
!                              KJUMP   - offset into gp array (input)
!                              KFIELDS - number of fields     (input)
!                              PUT95 to PVT15: the trajectory read (output)

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

!     Method.
!     -------

!     Externals. EMPTB    - interface to packing routines
!     ---------- MIOREAD  - write routine from MIO package

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

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

!     Modifications.
!     --------------
!        Original : 99-01-21
!        Modified by C. Temperton 99-06-17 (SL buffers for L2TLFF)
!        Modified by C. Temperton 99-08-20 (RDSLTRAJ -> RDSLTRAJ2)
!        Modified by C. Temperton 00-07-10 Allow NPCKSLTRAJ=2
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NPROMA
USE YOMTRSL  , ONLY : NLENGTSLB,TRAJSL   ,NTRSLTYPE, NPCKSLTRAJ

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

IMPLICIT NONE

! * INPUT:
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTEP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
INTEGER(KIND=JPIM),INTENT(IN)    :: KJUMP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELDS 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUT95(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVT95(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSPNLT95(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUL95(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVL95(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSPL95(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUL05(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVL05(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSPL05(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PURL05(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVRL05(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PURL5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVRL5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUSI5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVSI5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUT15(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVT15(NPROMA) 
! * OUTPUT:
INTEGER(KIND=JPIM) :: IBLOCKS, IJUMP, ILENB, IPCKUNIT, ISTAGPB, IWORDS
INTEGER(KIND=JPIM) :: I_NEXPBTSL ! ??? not DOCTOR, should be in YOMIOP or renamed ???
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "emptb.intfb.h"

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

!     Dirty!! - should be in YOMIOP?
IF (LHOOK) CALL DR_HOOK('RDSLTRAJ2',0,ZHOOK_HANDLE)
I_NEXPBTSL=6

!*       1.    READ IN GRIDPOINT ARRAY.
!              ------------------------

!*       1.1       CALCULATE LENGTHS

IWORDS = KEND-KSTA+1

!*       1.2       WRITE OUT BUFFER

ILENB   = NLENGTSLB
IJUMP=KJUMP-1
IF (NPCKSLTRAJ == 1) THEN
  ISTAGPB = 1+IJUMP*KFIELDS
ELSE

!  It is assumed that TRAJSL data always is read/written in
!  NPROMA chunks (except for the last potentially smaller chunk).
!  Restrictions are necessary because reading/writing of packed
!  data has to start on a word boundary.

  IBLOCKS=IJUMP/NPROMA
  IF (IBLOCKS*NPROMA /= IJUMP)&
   & CALL ABOR1('RDSLTRAJ: INCONSISTENT WRITING OF PACKED DATA')  
  IPCKUNIT = (NPROMA+NPCKSLTRAJ-1)/NPCKSLTRAJ
  ISTAGPB = 1+IPCKUNIT*IBLOCKS*KFIELDS
ENDIF

!        1.3      UPPER AIR 3D FIELDS

IF (NTRSLTYPE == 1) THEN
  CALL EMPTB(IWORDS,PUT95(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PVT95(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PSPNLT95(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
ELSEIF (NTRSLTYPE == 2) THEN
  CALL EMPTB(IWORDS,PUL95(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PVL95(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PSPL95(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PUL05(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PVL05(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PSPL05(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PURL05(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PVRL05(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PURL5(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PVRL5(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PUSI5(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PVSI5(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PUT15(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
  CALL EMPTB(IWORDS,PVT15(KSTA),TRAJSL(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKSLTRAJ,I_NEXPBTSL)  
ENDIF

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

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

