sbytes.f

Go to the documentation of this file.

C> @file
C> @brief This is the fortran versions of sbytes().
C> @author Robert C. Gammill @date 1972-07
C>
C> @param IOUT
C> @param IN = unpacked array input
C> @param ISKIP = initial number of bits to skip
C> @param NBYTE = number of bits to pack
C> @param NSKIP = additional number of bits to skip on each iteration
C> @param N = number of iterations
C>
C> @author Robert C. Gammill @date 1972-07
      SUBROUTINE sbytes(IOUT,IN,ISKIP,NBYTE,NSKIP,N)
C
C
C             Changes for SiliconGraphics IRIS-4D/25
C             SiliconGraphics 3.3 FORTRAN 77
C             March 1991  RUSSELL E. JONES
C             NATIONAL WEATHER SERVICE
C
      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     MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 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
C ISTEP IS THE DISTANCE IN BITS FROM ONE BYTE POSITION TO THE NEXT.
C
      istep  = nbyte + nskip
C
C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT.
C
      iwords = istep / nbitsw
C
C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS.
C
      ibits  = mod(istep,nbitsw)
C
      DO 10 i = 1,n
        j     = iand(mask,in(i))
        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
        ii    = ii + ibits
        index = index + iwords
        IF (ii.GE.nbitsw) THEN
          ii    = ii - nbitsw
          index = index + 1
        ENDIF
C
10    CONTINUE
C
      RETURN
      END