SUBROUTINE WRITTRAJM(KSTEP,KSTA,KEND,KJUMP,KFIELDS,&
 & PUT15,PVT15,PTT15,PSVD15,PE3Y5,&
 & PERR5,PEGHL5,PEGHM5,PEWW5,PVORT5,PDIVT5,&
 & PUT5L,PVT5L,PSPT15)  

!**** *WRITTRAJM* - Write out the trajectory (iteration) to work file
!                   for some nonhydrostatic fields

!     Purpose.  Write out the trajectory (iteration) to work file
!               for some nonhydrostatic fields

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

!        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. FILLB    - interface to packing routines
!     ---------- 

!     Reference.
!     ----------

!     Author.
!     -------
!        Martin Charron   CNRM/GMAP - visiteur

!     Modifications.
!     --------------
!        Original : February 1999
!        Modified :
!        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 YOMTIT   , ONLY : NLENIT15B,TRAJIT
USE YOMIOP   , ONLY : NPCKFT95 ,NEXPBT95

IMPLICIT NONE

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(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)    :: PSVD15(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PE3Y5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PERR5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEGHL5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEGHM5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEWW5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVORT5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDIVT5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUT5L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVT5L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPT15(NPROMA) 
INTEGER(KIND=JPIM) :: IBLOCKS, IJUMP, ILENB, IPCKUNIT, ISTAGPB, IWORDS, JF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "fillb.intfb.h"

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

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

!*       1.1       CALCULATE LENGTHS

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

!*       1.2       WRITE OUT BUFFER

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

!  It is assumed that TRAJIT 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('WRITTRAJM: INCONSISTENT WRITING 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 FILLB(IWORDS,PUT15 (KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PVT15 (KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PTT15 (KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PSVD15(KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PE3Y5 (KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PERR5 (KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PEGHL5(KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PEGHM5(KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PEWW5 (KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PVORT5(KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PDIVT5(KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PUT5L (KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
  CALL FILLB(IWORDS,PVT5L (KSTA,JF),TRAJIT(KSTEP,:),&
   & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  
ENDDO

CALL FILLB(IWORDS,PSPT15(KSTA),TRAJIT(KSTEP,:),&
 & ILENB,ISTAGPB,NPCKFT95,NEXPBT95)  

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

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