SUBROUTINE RDPHTRAJM (KSTEP,KSTA,KEND,KJUMP,KFIELDS,&
 & PUT95,PVT95,PTT95,PQT95,PSP95)  

!**** *RDPHTRAJM* - Read out the trajectory at t-dt from work file

!     Purpose.  Read out the trajectory at t-dt from work file
!     --------

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

!        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)

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

!     Method.
!     -------

!     -------

!     Externals. EMPTB - interface to packing routines
!     ---------- 

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

!     Author.
!     -------
!        Jean-Francois Mahfouf  *ECMWF*

!     Modifications.
!     --------------
!        Original : 95-10-18
!        Modified :
!           95-12-05, read out the trajectory at t-dt for simplified
!                     physics of Meteo-France (M. Janiskova)
!           97-05-05, adapted for message passing
!        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 : NFLEVG   ,NPROMA
USE YOMTPHY  , ONLY : NLENGT95B,TRAJPHYS
USE YOMIOP   , ONLY : NPCKFT95 ,NEXPBT95

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

IMPLICIT NONE

! * DUMMY:
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,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVT95(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTT95(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQT95(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSP95(NPROMA) 
INTEGER(KIND=JPIM) :: IBLOCKS, IJUMP, ILENB, IPCKUNIT, ISTAGPB, IWORDS, JF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

!*       1.1       CALCULATE LENGTHS

IF (LHOOK) CALL DR_HOOK('RDPHTRAJM',0,ZHOOK_HANDLE)
IWORDS = KEND-KSTA+1

!*       1.2       WRITE OUT BUFFER

ILENB   = NLENGT95B
IJUMP=KJUMP-1
IF (NPCKFT95 == 1) THEN
  ISTAGPB = 1+IJUMP*KFIELDS
ELSE

!  It is assumed that TRAJPHYS 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('RDPHTRAJM: INCONSISTENT READING OF PACKED DATA')  
  IPCKUNIT = (NPROMA+NPCKFT95-1)/NPCKFT95
  ISTAGPB = 1+IPCKUNIT*IBLOCKS*KFIELDS
ENDIF

!        1.3      UPPER AIR 3D FIELDS

DO JF=1,NFLEVG
  CALL EMPTB(IWORDS,PUT95(KSTA,JF),TRAJPHYS(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL EMPTB(IWORDS,PVT95(KSTA,JF),TRAJPHYS(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL EMPTB(IWORDS,PTT95(KSTA,JF),TRAJPHYS(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL EMPTB(IWORDS,PQT95(KSTA,JF),TRAJPHYS(:,KSTEP),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
ENDDO

!        1.4      SURFACE 2D FIELDS

CALL EMPTB(IWORDS,PSP95(KSTA),TRAJPHYS(:,KSTEP),&
 & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  

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

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