gbyte_mf.F

Go to the documentation of this file.

      SUBROUTINE gbyte_mf(KSOURC,KDEST,KOFSET,KBYTSZ)
      USE parkind1, ONLY : jprb
      USE yomhook , ONLY : lhook, dr_hook
      USE lfi_precision
!*****
!*
!*    FUNCTION: GET A SINGLE BIT FIELD FROM KSOURC INTO KDEST
!*
!*    INPUT   : KSOURC(1)= WORD CONTAINING START OF BIT FIELD
!*              KDEST    = TARGET WORD
!*              KOFSET   = OFFSET IN BITS FOR START OF THE FIELD
!*              KBYTSZ   = LENGTH OF FIELD IN BITS
!*
!*    OUTPUT  : KSOURC,KOFSET,KBYTSZ UNCHANGED
!*              KDEST CONTAINS FIELD RIGHT JUSTIFIED
!*
!*    AUTHOR  : M.MIQUEU   08/1981 (REWRITTEN FROM J.MARTELLET'S)
!*
!*****
!
      IMPLICIT NONE
!
      INTEGER (KIND=JPLIKM) :: KOFSET
      INTEGER (KIND=JPLIKM) :: KBYTSZ
      INTEGER (KIND=JPLIKB) :: KDEST
!
      INTEGER (KIND=JPLIKB) :: KSOURC (2)
!
      INTEGER (KIND=JPLIKM) :: INBPW, ISH1
!
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      IF (lhook) CALL dr_hook('GBYTE_MF',0,zhook_handle)
      inbpw=64
      ish1=kofset+kbytsz-inbpw
!
      IF(ish1.LE.0) THEN
!
!
!     BYTES DO NOT SPAN WORDS
!
!
        ish1=-ish1
!
!
        kdest=ibits(ksourc(1),ish1,kbytsz)
!
      ELSE
!
!     BYTE SPANS WORDS
!
!
        kdest=ior(                                                     &
     &              ishft(                                             &
     &                      ibits(ksourc(1),0,inbpw-kofset)            &
     &                     , ish1 )                                     &
     &             ,                                                    &
     &              ibits(ksourc(2),inbpw-ish1,ish1)                   &
     &            )
!
!
!
      ENDIF
!
      IF (lhook) CALL dr_hook('GBYTE_MF',1,zhook_handle)
      ENDSUBROUTINE gbyte_mf