SUBROUTINE GBYTE(IN,IOUT,ISKIP,NBYTE) 170,1
character*1 in(*)
integer iout(*)
CALL GBYTES
(IN,IOUT,ISKIP,NBYTE,0,1)
RETURN
END
SUBROUTINE SBYTE(OUT,IN,ISKIP,NBYTE) 85,1
character*1 out(*)
integer in(*)
CALL SBYTES
(OUT,IN,ISKIP,NBYTE,0,1)
RETURN
END
SUBROUTINE GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N) 15
C Get bytes - unpack bits: Extract arbitrary size values from a
C packed bit string, right justifying each value in the unpacked
C array.
C IN = character*1 array input
C IOUT = 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 v1.1
C
character*1 in(*)
integer iout(*)
integer ones(8), tbit, bitcnt
save ones
data ones/1,3,7,15,31,63,127,255/
c nbit is the start position of the field in bits
nbit = iskip
do i = 1, n
bitcnt = nbyte
index=nbit/8+1
ibit=mod(nbit,8)
nbit = nbit + nbyte + nskip
c first byte
tbit = min(bitcnt,8-ibit)
itmp = iand(mova2i(in(index)),ones(8-ibit))
if (tbit.ne.8-ibit) itmp = ishft(itmp,tbit-8+ibit)
index = index + 1
bitcnt = bitcnt - tbit
c now transfer whole bytes
do while (bitcnt.ge.8)
itmp = ior(ishft(itmp,8),mova2i(in(index)))
bitcnt = bitcnt - 8
index = index + 1
enddo
c get data from last byte
if (bitcnt.gt.0) then
itmp = ior(ishft(itmp,bitcnt),iand(ishft(mova2i(in(index)),
1 -(8-bitcnt)),ones(bitcnt)))
endif
iout(i) = itmp
enddo
RETURN
END
SUBROUTINE SBYTES(OUT,IN,ISKIP,NBYTE,NSKIP,N) 15
C Store bytes - pack bits: Put arbitrary size values into a
C packed bit string, taking the low order bits from each value
C in the unpacked array.
C IOUT = packed array output
C IN = unpacked array input
C ISKIP = initial number of bits to skip
C NBYTE = number of bits to pack
C NSKIP = additional number of bits to skip on each iteration
C N = number of iterations
C v1.1
C
character*1 out(*)
integer in(N), bitcnt, ones(8), tbit
save ones
data ones/ 1, 3, 7, 15, 31, 63,127,255/
c number bits from zero to ...
c nbit is the last bit of the field to be filled
nbit = iskip + nbyte - 1
do i = 1, n
itmp = in(i)
bitcnt = nbyte
index=nbit/8+1
ibit=mod(nbit,8)
nbit = nbit + nbyte + nskip
c make byte aligned
if (ibit.ne.7) then
tbit = min(bitcnt,ibit+1)
imask = ishft(ones(tbit),7-ibit)
itmp2 = iand(ishft(itmp,7-ibit),imask)
itmp3 = iand(mova2i(out(index)), 255-imask)
out(index) = char(ior(itmp2,itmp3))
bitcnt = bitcnt - tbit
itmp = ishft(itmp, -tbit)
index = index - 1
endif
c now byte aligned
c do by bytes
do while (bitcnt.ge.8)
out(index) = char(iand(itmp,255))
itmp = ishft(itmp,-8)
bitcnt = bitcnt - 8
index = index - 1
enddo
c do last byte
if (bitcnt.gt.0) then
itmp2 = iand(itmp,ones(bitcnt))
itmp3 = iand(mova2i(out(index)), 255-ones(bitcnt))
out(index) = char(ior(itmp2,itmp3))
endif
enddo
return
end