121 lines
5.5 KiB
Fortran
121 lines
5.5 KiB
Fortran
SUBROUTINE GBYTE (IN,IOUT,ISKIP,NBYTE)
|
|
integer in(*), iout(*)
|
|
C
|
|
C ================================= RCS keyword statements ==========
|
|
CHARACTER*68 RCSKW1,RCSKW2
|
|
DATA RCSKW1,RCSKW2 / '
|
|
.$Source: /fs/hseb/ob72/wfo_rfc/precip_proc/source/gribit/src/RCS/gbytes.f,v $
|
|
. $', '
|
|
.$Id: gbytes.f,v 1.1 2006/05/03 13:43:58 gsood Exp $
|
|
. $' /
|
|
C ===================================================================
|
|
C
|
|
CALL GBYTES (IN,IOUT,ISKIP,NBYTE,0,1)
|
|
RETURN
|
|
END
|
|
|
|
SUBROUTINE GBYTES (IN,IOUT,ISKIP,NBYTE,NSKIP,N)
|
|
C Get bytes - unpack bits: Extract arbitrary size values from a
|
|
C packed bit string, right justifying each value in the unpacked
|
|
C array.
|
|
DIMENSION IN(*), IOUT(*)
|
|
C IN = packed array input
|
|
C IO = unpacked array output
|
|
C ISKIP = initial number of bits to skip
|
|
C NBYTE = number of bits to take
|
|
C NSKIP = additional number of bits to skip on each iteration
|
|
C N = number of iterations
|
|
C************************************** MACHINE SPECIFIC CHANGES START HERE
|
|
C Machine dependent information required:
|
|
C LMWD = Number of bits in a word on this machine
|
|
C MASKS = Set of word masks where the first element has only the
|
|
C right most bit set to 1, the second has the two, ...
|
|
C LEFTSH = Shift left bits in word M to the by N bits
|
|
C RGHTSH = Shift right
|
|
C OR = Logical OR (add) on this machine.
|
|
C AND = Logical AND (multiply) on this machine
|
|
C This is for Sun UNIX Fortran, DEC Alpha, and RS6000
|
|
PARAMETER (LMWD=32)
|
|
DIMENSION MASKS(LMWD)
|
|
SAVE MASKS
|
|
DATA MASKS /'1'X,'3'X,'7'X,'F'X, '1F'X,'3F'X,'7F'X,'FF'X,
|
|
+'1FF'X,'3FF'X,'7FF'X,'FFF'X, '1FFF'X,'3FFF'X,'7FFF'X,'FFFF'X,
|
|
+'1FFFF'X, '3FFFF'X, '7FFFF'X, 'FFFFF'X,
|
|
+'1FFFFF'X, '3FFFFF'X, '7FFFFF'X, 'FFFFFF'X,
|
|
+'1FFFFFF'X, '3FFFFFF'X, '7FFFFFF'X, 'FFFFFFF'X,
|
|
+'1FFFFFFF'X, '3FFFFFFF'X, '7FFFFFFF'X, 'FFFFFFFF'X/
|
|
C +'1FFFFFFFF'X, '3FFFFFFFF'X, '7FFFFFFFF'X, 'FFFFFFFFF'X,
|
|
C +'1FFFFFFFFF'X, '3FFFFFFFFF'X, '7FFFFFFFFF'X, 'FFFFFFFFFF'X,
|
|
C +'1FFFFFFFFFF'X, '3FFFFFFFFFF'X, '7FFFFFFFFFF'X, 'FFFFFFFFFFF'X,
|
|
C +'1FFFFFFFFFFF'X,'3FFFFFFFFFFF'X,'7FFFFFFFFFFF'X,'FFFFFFFFFFFF'X,
|
|
C +'1FFFFFFFFFFFF'X, '3FFFFFFFFFFFF'X, '7FFFFFFFFFFFF'X,
|
|
C + 'FFFFFFFFFFFFF'X,
|
|
C +'1FFFFFFFFFFFFF'X, '3FFFFFFFFFFFFF'X, '7FFFFFFFFFFFFF'X,
|
|
C 'FFFFFFFFFFFFFF'X,
|
|
C +'1FFFFFFFFFFFFFF'X, '3FFFFFFFFFFFFFF'X, '7FFFFFFFFFFFFFF'X,
|
|
C 'FFFFFFFFFFFFFFF'X,
|
|
C +'1FFFFFFFFFFFFFFF'X,'3FFFFFFFFFFFFFFF'X,'7FFFFFFFFFFFFFFF'X,
|
|
C 'FFFFFFFFFFFFFFFF'X/
|
|
C IBM PC using Microsoft Fortran uses different syntax:
|
|
C DATA MASKS/16#1,16#3,16#7,16#F,16#1F,16#3F,16#7F,16#FF,
|
|
C + 16#1FF,16#3FF,16#7FF,16#FFF,16#1FFF,16#3FFF,16#7FFF,16#FFFF,
|
|
C + 16#1FFFF,16#3FFFF,16#7FFFF,16#FFFFF,16#1FFFFF,16#3FFFFF,
|
|
C + 16#7FFFFF,16#FFFFFF,16#1FFFFFF,16#3FFFFFF,16#7FFFFFF,16#FFFFFFF,
|
|
C + 16#1FFFFFFF,16#3FFFFFFF,16#7FFFFFFF,16#FFFFFFFF/
|
|
INTEGER RGHTSH, OR, AND
|
|
LEFTSH(M,N) = ISHFT(M,N)
|
|
RGHTSH(M,N) = ISHFT(M,-N)
|
|
C OR(M,N) = M.OR.N
|
|
C AND(M,N) = M.AND.N
|
|
C OR(M,N) = IOR(M,N)
|
|
C AND(M,N) = IAND(M,N)
|
|
C************************************** MACHINE SPECIFIC CHANGES END HERE
|
|
C History: written by Robert C. Gammill, jul 1972.
|
|
|
|
|
|
C NBYTE must be less than or equal to LMWD
|
|
ICON = LMWD-NBYTE
|
|
IF (ICON.LT.0) RETURN
|
|
MASK = MASKS (NBYTE)
|
|
C INDEX = number of words into IN before the next "byte" appears
|
|
C II = number of bits the "byte" is from the left side of the word
|
|
C ISTEP = number of bits from the start of one "byte" to the next
|
|
C IWORDS = number of words to skip from one "byte" to the next
|
|
C IBITS = number of bits to skip after skipping IWORDS
|
|
C MOVER = number of bits to the right, a byte must be moved to be
|
|
C right adjusted
|
|
INDEX = ISKIP/LMWD
|
|
II = MOD (ISKIP,LMWD)
|
|
ISTEP = NBYTE+NSKIP
|
|
IWORDS= ISTEP/LMWD
|
|
IBITS = MOD (ISTEP,LMWD)
|
|
|
|
DO 6 I=1,N
|
|
MOVER = ICON-II
|
|
IF (MOVER) 2,3,4
|
|
|
|
C The "byte" is split across a word break.
|
|
2 MOVEL = -MOVER
|
|
MOVER = LMWD-MOVEL
|
|
NP1 = LEFTSH (IN(INDEX+1),MOVEL)
|
|
NP2 = RGHTSH (IN(INDEX+2),MOVER)
|
|
IOUT(I) = AND (OR (NP1,NP2) , MASK)
|
|
GO TO 5
|
|
|
|
C The "byte" is already right adjusted.
|
|
3 IOUT(I) = AND (IN (INDEX+1) , MASK)
|
|
GO TO 5
|
|
|
|
C Right adjust the "byte".
|
|
4 IOUT(I) = AND (RGHTSH (IN (INDEX+1),MOVER) , MASK)
|
|
|
|
5 II = II+IBITS
|
|
INDEX = INDEX+IWORDS
|
|
IF (II .LT. LMWD) GO TO 6
|
|
II = II-LMWD
|
|
INDEX = INDEX+1
|
|
6 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|