sbyte.f

Go to the documentation of this file.

C> @file
C> @brief This is the fortran 32 bit version of sbyte().
C> @author Robert Gammill @date 1972-07
 
C> @param[out] IOUT
C> @param[in] IN Unpacked array input
C> @param[in] ISKIP Initial number of bits to skip
C> @param[in] NBYTE Number of bits to pack
C>
C> @author Robert Gammill @date 1972-07
      SUBROUTINE sbyte(IOUT,IN,ISKIP,NBYTE)
      INTEGER    IN
      INTEGER    IOUT(*)
      INTEGER    MASKS(32)
C
      SAVE
C
      DATA  nbitsw/32/
C
C     DATA  MASKS /Z'00000001',Z'00000003',Z'00000007',Z'0000000F',
C    &             Z'0000001F',Z'0000003F',Z'0000007F',Z'000000FF',
C    &             Z'000001FF',Z'000003FF',Z'000007FF',Z'00000FFF',
C    &             Z'00001FFF',Z'00003FFF',Z'00007FFF',Z'0000FFFF',
C    &             Z'0001FFFF',Z'0003FFFF',Z'0007FFFF',Z'000FFFFF',
C    &             Z'001FFFFF',Z'003FFFFF',Z'007FFFFF',Z'00FFFFFF',
C    &             Z'01FFFFFF',Z'03FFFFFF',Z'07FFFFFF',Z'0FFFFFFF',
C    &             Z'1FFFFFFF',Z'3FFFFFFF',Z'7FFFFFFF',Z'FFFFFFFF'/
C
C     MASK TABLE PUT IN DECIMAL SO IT WILL COMPILE ON AN 32 BIT
C     COMPUTER
C
      DATA  masks / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047,
     & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287,
     & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431,
     & 67108863, 134217727, 268435455, 536870911, 1073741823,
     & 2147483647, -1/
C
C NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW
C
        icon  = nbitsw - nbyte
        IF (icon.LT.0) RETURN
        mask  = masks(nbyte)
C
C INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED.
C
        index = ishft(iskip,-5)
C
C II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT.
C
        ii    = mod(iskip,nbitsw)
C
        j     = iand(mask,in)
        movel = icon - ii
C
C BYTE IS TO BE STORED IN MIDDLE OF WORD.  SHIFT LEFT.
C
        IF (movel.GT.0) THEN
          msk           = ishft(mask,movel)
          iout(index+1) = ior(iand(not(msk),iout(index+1)),
     &    ishft(j,movel))
C
C THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK.
C
        ELSE IF (movel.LT.0) THEN
          msk           = masks(nbyte+movel)
          iout(index+1) = ior(iand(not(msk),iout(index+1)),
     &    ishft(j,movel))
          itemp         = iand(masks(nbitsw+movel),iout(index+2))
          iout(index+2) = ior(itemp,ishft(j,nbitsw+movel))
C
C BYTE IS TO BE STORED RIGHT-ADJUSTED.
C
        ELSE
          iout(index+1) = ior(iand(not(mask),iout(index+1)),j)
        ENDIF
C
      RETURN
      END