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
      USE lfi_precision
!
! KS CONTAINS A BIT STRING OF INDEFINITE LENGTH. GBYTES WILL
! EXTRACT KBYTES BITSTRINGS, KBSIZ BITS LONG, AND STORE THEM
! RIGHT JUSTIFIED 0 FILL, INTO SUCCESSIVE WORDS OF KD. THE
! SUCCESSIVE BITSTRINGS START AT BIT POSITIONS
!     KSKIP1+1+(IBYTE-1)*(KBSIZ+KSKIP2)
! IN THE BIT STRING S. I.E. SKIP KSKIP1 BITS AT THE START,
! AND KSKIP2 BITS BETWEEN THE EXTRACTED STRINGS.
! BIT ISKP+1 IN A STRING IS FOUND IN WORD IS=1+ISKIP/INBPW IN KS,
! WHERE INBPW IS THE NUMBER OF BITS PER WORD. THE STARTING BIT
! IS FOUND BY SKIPPING MOD(ISKP,INBPW) BITS IN THAT WORD.
! KWOFF IS AN OPTIONAL 7TH PARAMETER, WHICH DEFAULTS TO 0
! IF PRESENT KWOFF BITS ARE TOTALLY IGNORED AT THE START OF A WORD
! THUS IF A PACKED CYBER BIT STRING IS TRANSFERRED TO THE
! CRAY, WITH EACH 60 BIT CYBER WORD PLACED AT THE RIGHT END OF
! A 64 BIT CRAY WORD, A BYTE SEQUENCE WHICH WAS ORIGINALLY
! LOCATED WITH START POINTS IN ARITHMETIC PROGRESSION ON THE
! CYBER, WILL NO LONGER HAVE THIS PROPERTY ON THE CRAY. BY
! USING THE ROUTINE WITH KWOFF=4, THE ELEMENTS OF THE BYTE
! SEQUENCE CAN BE EXTRACTED ON THE CRAY, USING THE SAME SKIPS
! AS WERE USED ON THE CYBER.
!
!*    Author: ?????, ECMWF, 198x.
!*
!*    Modified by Mats HAMRUD, ECMWF, 1988, to have a constant number
!*    number af arguments , as within the GRIB package calls,
!*    and to make some cleanings.
!*
!*    Modifications by Jean CLOCHARD, French DMN, January 1990,
!*    essentially to get a vectorising code on CRAY (no recurrences),
!*    and to make some cleanings.
!
      IMPLICIT NONE
!
      INTEGER (KIND=JPLIKM) :: KSKIP1
      INTEGER (KIND=JPLIKM) :: KBSIZ
      INTEGER (KIND=JPLIKM) :: KSKIP2
      INTEGER (KIND=JPLIKM) :: KBYTES
!
      INTEGER (KIND=JPLIKB) :: KS(*)
      INTEGER (KIND=JPLIKB) :: KD(kbytes)
!
      INTEGER (KIND=JPLIKM) :: INBPW, ISTEP, JBYTE, ID
      INTEGER (KIND=JPLIKM) :: ISKIP, ISH1, ISH2, IS, IAUXIL
!
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      IF (lhook) CALL dr_hook('GBYTES_MF',0,zhook_handle)
      inbpw=64
      istep = kskip2+kbsiz
!
      DO 75 jbyte = 1 , kbytes
!
! WITH THE STARTING WORD AND BIT POSITION DETERMINED, THE
! DESIRED EXTRACTION CAN BE DONE BY
!***     CALL GBYTE(KS(IS),KD(JBYTE),ISKIP,KBSIZ)
! BUT SINCE THE CODE IS SHORT IT IS INSERTED IN-LINE.
!
      iauxil=kskip1+(jbyte-1)*istep
      is=1+iauxil/inbpw
      iskip=iauxil-(is-1)*inbpw
      ish1=iskip+kbsiz
!
      IF(ish1.LE.inbpw) THEN
!*
! BYTE COMES FROM 1 WORD OF KS
!
         kd(jbyte) = ibits(ks(is),inbpw-ish1,kbsiz)
      ELSE
         ish2 =ish1-inbpw
!*
! BYTE COMES FROM 2 WORDS OF KS.
!
         kd(jbyte) = ior( ishft( ibits(ks(is),0,inbpw-iskip), ish2 ) &
     &                    ,                                             &
     &                     ibits(ks(is+1),inbpw-ish2,ish2)             &
     &                   )
      ENDIF
!
   75 CONTINUE
!
      IF (lhook) CALL dr_hook('GBYTES_MF',1,zhook_handle)
      ENDSUBROUTINE gbytes_mf