sbyte_mf.F

Go to the documentation of this file.

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