/home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/grib_mf/gbytes_mf.F

Go to the documentation of this file.

      SUBROUTINE GBYTES_MF(KS,KD,KSKIP1,KBSIZ,KSKIP2,KBYTES)
      USE PARKIND1, ONLY : JPRB
      USE YOMHOOK , ONLY : LHOOK, DR_HOOK
C
C KS CONTAINS A BIT STRING OF INDEFINITE LENGTH. GBYTES WILL
C EXTRACT KBYTES BITSTRINGS, KBSIZ BITS LONG, AND STORE THEM
C RIGHT JUSTIFIED 0 FILL, INTO SUCCESSIVE WORDS OF KD. THE
C SUCCESSIVE BITSTRINGS START AT BIT POSITIONS
C     KSKIP1+1+(IBYTE-1)*(KBSIZ+KSKIP2)
C IN THE BIT STRING S. I.E. SKIP KSKIP1 BITS AT THE START,
C AND KSKIP2 BITS BETWEEN THE EXTRACTED STRINGS.
C BIT ISKP+1 IN A STRING IS FOUND IN WORD IS=1+ISKIP/INBPW IN KS,
C WHERE INBPW IS THE NUMBER OF BITS PER WORD. THE STARTING BIT
C IS FOUND BY SKIPPING MOD(ISKP,INBPW) BITS IN THAT WORD.
C KWOFF IS AN OPTIONAL 7TH PARAMETER, WHICH DEFAULTS TO 0
C IF PRESENT KWOFF BITS ARE TOTALLY IGNORED AT THE START OF A WORD
C THUS IF A PACKED CYBER BIT STRING IS TRANSFERRED TO THE
C CRAY, WITH EACH 60 BIT CYBER WORD PLACED AT THE RIGHT END OF
C A 64 BIT CRAY WORD, A BYTE SEQUENCE WHICH WAS ORIGINALLY
C LOCATED WITH START POINTS IN ARITHMETIC PROGRESSION ON THE
C CYBER, WILL NO LONGER HAVE THIS PROPERTY ON THE CRAY. BY
C USING THE ROUTINE WITH KWOFF=4, THE ELEMENTS OF THE BYTE
C SEQUENCE CAN BE EXTRACTED ON THE CRAY, USING THE SAME SKIPS
C AS WERE USED ON THE CYBER.
C
C*    Author: ?????, ECMWF, 198x.
C*
C*    Modified by Mats HAMRUD, ECMWF, 1988, to have a constant number
C*    number af arguments , as within the GRIB package calls,
C*    and to make some cleanings.
C*
C*    Modifications by Jean CLOCHARD, French DMN, January 1990,
C*    essentially to get a vectorising code on CRAY (no recurrences),
C*    and to make some cleanings.
C
#include "precision.h"
C
      INTEGER KSKIP1, KBSIZ, KSKIP2, KBYTES
C
      INTEGER (KIND=JPDBLE) KS(*), KD(KBYTES)
C
      INTEGER INBPW, ISTEP, JBYTE, ID, ISKIP, ISH1, ISH2, IS, IAUXIL
C
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      IF (LHOOK) CALL DR_HOOK('GBYTES_MF',0,ZHOOK_HANDLE)
      INBPW=64
      ISTEP = KSKIP2+KBSIZ
C
      DO 75 JBYTE = 1 , KBYTES
C
C WITH THE STARTING WORD AND BIT POSITION DETERMINED, THE
C DESIRED EXTRACTION CAN BE DONE BY
C***     CALL GBYTE(KS(IS),KD(JBYTE),ISKIP,KBSIZ)
C BUT SINCE THE CODE IS SHORT IT IS INSERTED IN-LINE.
C
      IAUXIL=KSKIP1+(JBYTE-1)*ISTEP
      IS=1+IAUXIL/INBPW
      ISKIP=IAUXIL-(IS-1)*INBPW
      ISH1=ISKIP+KBSIZ
C
      IF(ISH1.LE.INBPW) THEN
C*
C BYTE COMES FROM 1 WORD OF KS
C
         KD(JBYTE) = IBITS (KS(IS),INBPW-ISH1,KBSIZ)
      ELSE
         ISH2 =ISH1-INBPW
C*
C BYTE COMES FROM 2 WORDS OF KS.
C
         KD(JBYTE) = IOR ( ISHFT ( IBITS (KS(IS),0,INBPW-ISKIP), ISH2 )
     1                    ,
     2                     IBITS (KS(IS+1),INBPW-ISH2,ISH2)
     3                   )
      ENDIF
C
   75 CONTINUE
C
      IF (LHOOK) CALL DR_HOOK('GBYTES_MF',1,ZHOOK_HANDLE)
      END