SUBROUTINE WRPHTRSF (KSTEP,KSTA,KEND,KJUMP,KFIELDS,PQS,PTS,PSNS)

!**** *WRPHTRSF* - Write out the trajectory for surface arrays 
!                  to work file

!     Purpose.  Write out the trajectory for surface arrays 
!               to work file

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

!        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)
!                              PQS,PTS,PSNS: trajectory to be written
!                                        on a buffer          (input)

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

!     Method.
!     -------

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

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

!     Author.
!     -------
!        M. Janiskova

!     Modifications.
!     --------------
!        Original : 95-12-05
!        Modified :
!           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 : NPROMA
USE YOMTPHY  , ONLY : NLENGTS5B,TRAJPHSF
USE YOMIOP   , ONLY : NPCKFTS5 ,NEXPBTS5

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

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(IN)    :: PQS(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSNS(NPROMA) 
INTEGER(KIND=JPIM) :: ILENB, ISTAGPB, IWORDS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fillb.intfb.h"

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

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

!*       1.1       CALCULATE LENGTHS

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

!*       1.2       WRITE OUT BUFFER

ISTAGPB = 1+(KJUMP-1)*KFIELDS
ILENB   = NLENGTS5B

!         1.3       SURFACE 2D FIELDS

CALL FILLB(IWORDS,PQS(KSTA),TRAJPHSF(:,KSTEP),&
 & ILENB,ISTAGPB,NPCKFTS5,NEXPBTS5)  
CALL FILLB(IWORDS,PTS(KSTA),TRAJPHSF(:,KSTEP),&
 & ILENB,ISTAGPB,NPCKFTS5,NEXPBTS5)  
CALL FILLB(IWORDS,PSNS(KSTA),TRAJPHSF(:,KSTEP),&
 & ILENB,ISTAGPB,NPCKFTS5,NEXPBTS5)  

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

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

