NCEPLIBS-bufr  12.0.1
pkc.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Encode a character string within an integer array.
3 C>
4 C> @author J. Woollen @date 1994-01-06
5 
6 C> Encode a character string within an integer array.
7 C>
8 C> This subroutine encodes a character string within a specified
9 C> number of bytes of an integer array, starting at the bit
10 C> immediately after a specified bit within the array.
11 C>
12 C> @remarks
13 C> - This subroutine is the logical inverse of subroutine upc().
14 C> - On input, there is no requirement that IBIT must point to the first
15 C> bit of a byte within IBAY. Correspondingly, on output there is no
16 C> guarantee that the NCHR characters of CHR will be aligned on byte
17 C> boundaries when encoded within IBAY.
18 C>
19 C> @param[in] CHR - character*(*): String to be encoded.
20 C> @param[in] NCHR - integer: Number of bytes of IBAY within
21 C> which to encode CHR (i.e. the number of characters in CHR).
22 C> @param[out] IBAY - integer(*): Array containing encoded CHR.
23 C> @param[in,out] IBIT - integer: Bit pointer within IBAY
24 C> - On input, IBIT points to the bit within IBAY after which
25 C> to begin encoding CHR.
26 C> - On output, IBIT points to the last bit of IBAY which
27 C> contains the encoded CHR.
28 C>
29 C> @author J. Woollen @date 1994-01-06
30  SUBROUTINE pkc(CHR,NCHR,IBAY,IBIT)
31 
32  COMMON /hrdwrd/ nbytw,nbitw,iord(8)
33 
34  CHARACTER*(*) CHR
35  CHARACTER*1 CVAL(8)
36  dimension ibay(*),ival(2)
37  equivalence(cval,ival)
38 
39 C----------------------------------------------------------------------
40 C----------------------------------------------------------------------
41 
42  lb = iord(nbytw)
43 
44 C LB now points to the "low-order" (i.e. least significant) byte
45 C within a machine word.
46 
47  ival(1) = 0
48  nbit = 8
49 
50  DO i=1,nchr
51  IF(i.LE.len(chr)) THEN
52  cval(lb) = chr(i:i)
53  ELSE
54  cval(lb) = ' '
55  ENDIF
56 
57  nwd = ibit/nbitw + 1
58  nbt = mod(ibit,nbitw)
59  int = ishft(ival(1),nbitw-nbit)
60  int = ishft(int,-nbt)
61  msk = ishft( -1,nbitw-nbit)
62  msk = ishft(msk,-nbt)
63  ibay(nwd) = irev(ior(iand(irev(ibay(nwd)),not(msk)),int))
64  IF(nbt+nbit.GT.nbitw) THEN
65 
66 C This character will not fit within the current word (i.e.
67 C array member) of IBAY, because there are less than 8 bits of
68 C space left. Store as many bits as will fit within the current
69 C word and then store the remaining bits within the next word.
70 
71  int = ishft(ival(1),2*nbitw-(nbt+nbit))
72  msk = ishft( -1,2*nbitw-(nbt+nbit))
73  ibay(nwd+1) = irev(ior(iand(irev(ibay(nwd+1)),not(msk)),int))
74  ENDIF
75  ibit = ibit + nbit
76  ENDDO
77 
78 C EXITS
79 C -----
80 
81  RETURN
82  END
function irev(N)
This function will, when the local machine is "little-endian" (i.e., when it uses a right to left sch...
Definition: irev.F:33
subroutine pkc(CHR, NCHR, IBAY, IBIT)
Encode a character string within an integer array.
Definition: pkc.f:31