1 SUBROUTINE G2LIB_GBYTE(IN,IOUT,ISKIP,NBYTE)
4 CALL G2LIB_GBYTES(IN,IOUT,ISKIP,NBYTE,0,1)
8 SUBROUTINE G2LIB_SBYTE(OUT,IN,ISKIP,NBYTE)
11 CALL G2LIB_SBYTES(OUT,IN,ISKIP,NBYTE,0,1)
15 SUBROUTINE G2LIB_GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N)
16 C Get bytes - unpack bits: Extract arbitrary size values from a
17 C packed bit string, right justifying each value in the unpacked
19 C IN = character*1 array input
20 C IOUT = unpacked array output
21 C ISKIP = initial number of bits to skip
22 C NBYTE = number of bits to take
23 C NSKIP = additional number of bits to skip on each iteration
24 C N = number of iterations
29 integer ones(8), tbit, bitcnt
31 data ones/1,3,7,15,31,63,127,255/
33 c nbit is the start position of the field in bits
39 nbit = nbit + nbyte + nskip
42 tbit = min(bitcnt,8-ibit)
43 itmp = iand(mova2i(in(index)),ones(8-ibit))
44 if (tbit.ne.8-ibit) itmp = ishft(itmp,tbit-8+ibit)
46 bitcnt = bitcnt - tbit
48 c now transfer whole bytes
49 do while (bitcnt.ge.8)
50 itmp = ior(ishft(itmp,8),mova2i(in(index)))
55 c get data from last byte
57 itmp = ior(ishft(itmp,bitcnt),iand(ishft(mova2i(in(index)),
58 1 -(8-bitcnt)),ones(bitcnt)))
67 SUBROUTINE G2LIB_SBYTES(OUT,IN,ISKIP,NBYTE,NSKIP,N)
68 C Store bytes - pack bits: Put arbitrary size values into a
69 C packed bit string, taking the low order bits from each value
70 C in the unpacked array.
71 C IOUT = packed array output
72 C IN = unpacked array input
73 C ISKIP = initial number of bits to skip
74 C NBYTE = number of bits to pack
75 C NSKIP = additional number of bits to skip on each iteration
76 C N = number of iterations
80 integer in(N), bitcnt, ones(8), tbit
82 data ones/ 1, 3, 7, 15, 31, 63,127,255/
84 c number bits from zero to ...
85 c nbit is the last bit of the field to be filled
87 nbit = iskip + nbyte - 1
93 nbit = nbit + nbyte + nskip
97 tbit = min(bitcnt,ibit+1)
98 imask = ishft(ones(tbit),7-ibit)
99 itmp2 = iand(ishft(itmp,7-ibit),imask)
100 itmp3 = iand(mova2i(out(index)), 255-imask)
101 out(index) = char(ior(itmp2,itmp3))
102 bitcnt = bitcnt - tbit
103 itmp = ishft(itmp, -tbit)
110 do while (bitcnt.ge.8)
111 out(index) = char(iand(itmp,255))
112 itmp = ishft(itmp,-8)
119 if (bitcnt.gt.0) then
120 itmp2 = iand(itmp,ones(bitcnt))
121 itmp3 = iand(mova2i(out(index)), 255-ones(bitcnt))
122 out(index) = char(ior(itmp2,itmp3))