gbyte.f

Go to the documentation of this file.

C> @file
C> @brief This is the fortran version of gbyte.
C> @author Dr. Robert C. Gammill @date 1972-05-DD
 
C> This is the fortran version of gbyte
C>
C> Program history log:
C> - Russell E. Jones 1991-03-DD
C> Changes for SiliconGraphics IRIS-4D/25
C> SiliconGraphics 3.3 FORTRAN 77.
C>
C> To unpack a byte into a target word. The unpacked byte is right-justified
C> in the target word, and the remainder of the word is zero-filled.
C>
C> @param[in] IPACKD The word or array containing the byte to be unpacked.
C>
C> @param[out] IUNPKD The word which will contain the unpacked byte.
C>
C> @param[in] NOFF The number of bits to skip, left to right, in IPACKD
C> in order to locate the byte to be unpacked.
C>
C> @param[in] NBITS Number of bits in the byte to be unpacked. Maximum of
C> 64 bits on 64 bit machine, 32 bits on 32 bit machine.
C>
C> @author Dr. Robert C. Gammill @date 1972-05-DD
      SUBROUTINE gbyte(IPACKD,IUNPKD,NOFF,NBITS)
      INTEGER    IPACKD(*)
      INTEGER    IUNPKD
      INTEGER    MASKS(64)
C
      SAVE
C
      DATA ifirst/1/
      IF(ifirst.EQ.1) THEN
         CALL w3fi01(lw)
         nbitsw = 8 * lw
         jshift = -1 * nint(alog(float(nbitsw)) / alog(2.0))
         masks(1) = 1
         DO i=2,nbitsw-1
            masks(i) = 2 * masks(i-1) + 1
         ENDDO
         masks(nbitsw) = -1
         ifirst = 0
      ENDIF
C
C NBITS MUST BE LESS THAN OR EQUAL TO NBITSW
C
      icon   = nbitsw - nbits
      IF (icon.LT.0) RETURN
      mask   = masks(nbits)
C
C INDEX TELLS HOW MANY WORDS INTO THE ARRAY 'IPACKD' THE NEXT BYTE
C APPEARS.
C
      index  = ishft(noff,jshift)
C
C II TELLS HOW MANY BITS THE BYTE IS FROM THE LEFT SIDE OF THE WORD.
C
      ii     = mod(noff,nbitsw)
C
C MOVER SPECIFIES HOW FAR TO THE RIGHT NBITS MUST BE MOVED IN ORDER
C
C    TO BE RIGHT ADJUSTED.
C
      mover = icon - ii
C
      IF (mover.GT.0) THEN
        iunpkd  = iand(ishft(ipackd(index+1),-mover),mask)
C
C THE BYTE IS SPLIT ACROSS A WORD BREAK.
C
      ELSE IF (mover.LT.0) THEN
        movel = - mover
        mover = nbitsw - movel
        iunpkd  = iand(ior(ishft(ipackd(index+1),movel),
     &          ishft(ipackd(index+2),-mover)),mask)
C
C THE BYTE IS ALREADY RIGHT ADJUSTED.
C
      ELSE
        iunpkd  = iand(ipackd(index+1),mask)
      ENDIF
C
      RETURN
      END