137 lines
4.2 KiB
Fortran
137 lines
4.2 KiB
Fortran
SUBROUTINE GBYTEC(IN,IOUT,ISKIP,NBYTE)
|
|
character*1 in(*)
|
|
integer 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_char.f,v $
|
|
. $', '
|
|
.$Id: gbytes_char.f,v 1.1 2006/05/03 13:43:58 gsood Exp $
|
|
. $' /
|
|
C ===================================================================
|
|
C
|
|
CALL GBYTESC(IN,IOUT,ISKIP,NBYTE,0,1)
|
|
RETURN
|
|
END
|
|
|
|
SUBROUTINE SBYTEC(OUT,IN,ISKIP,NBYTE)
|
|
character*1 out(*)
|
|
integer in(*)
|
|
CALL SBYTESC(OUT,IN,ISKIP,NBYTE,0,1)
|
|
RETURN
|
|
END
|
|
|
|
SUBROUTINE GBYTESC(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.
|
|
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 SBYTESC(OUT,IN,ISKIP,NBYTE,NSKIP,N)
|
|
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
|