SUBROUTINE FILLB(KWRDS,PIN,PBUF,KBLEN,KSTA,KPACK,KEXPB)

!**** *FILLB  *  - Pack or just copy into buffer

!     Purpose.
!     --------
!           Pack or just copy from array into user supplied buffer .
!           Update buffer pointer.

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

!        Explicit arguments : KWRDS   - number of words to unpack (copy)
!        -------------------- PIN     - array containing unpacked data
!                             PBUF    - buffer containing (packed) data
!                             KBLEN   - length of PBUF
!                             KSTA    - start adress in buffer,
!                                       updated by routine
!                             KPACK   - packing factor (1 to 4)
!                             KEXPB   - number of bits for exponent in
!                                       packed data

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

!     Method.
!     -------
!        See documentation

!     Externals.  PACK21 - packs data packed 2 to 1 (Cray routine)
!     ----------  PACK31 - packs data packed 3 to 1 (Cray routine)
!                 PACK41 - packs data packed 4 to 1 (Cray routine)

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

!     Author.
!     -------
!        Mats Hamrud  *ECMWF*

!     Modifications.
!     --------------
!        Original : 93-01-01
!        Modification : 93-06-01 M.Hamrud (comments added)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KWRDS 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIN(KWRDS) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBUF(:) 
INTEGER(KIND=JPIM)               :: KBLEN ! Argument NOT used
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPACK 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEXPB 
! === END OF INTERFACE BLOCK ===

INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*       1.    PACK DATA.
!              ----------

!*       1.1   NO PACKING (PACKING FACTOR 1)
IF (LHOOK) CALL DR_HOOK('FILLB',0,ZHOOK_HANDLE)
IF(KPACK == 1) THEN
  DO J=1,KWRDS
    PBUF(KSTA+J-1)=PIN(J)
  ENDDO
  KSTA=KSTA+KWRDS

!*       1.2   PACKING 2 TO 1
ELSEIF(KPACK == 2) THEN
  CALL PACK21(KWRDS,PIN,PBUF(KSTA),KEXPB,1)
  KSTA=KSTA+(KWRDS+1)/2

ENDIF

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

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

