NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
pkc.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Encode a character string within an integer array.
3 
4 C> This subroutine encodes a character string within a specified
5 C> number of bits of an integer array, starting at the bit
6 C> immediately after a specified bit within the array.
7 C>
8 C> @author J. Woollen
9 C> @date 1994-01-06
10 C>
11 C> @param[in] CHR -- character*(*): String to be encoded
12 C> @param[in] NCHR -- integer: Number of bytes of IBAY within
13 C> which to encode CHR (i.e. the number of
14 C> characters in CHR)
15 C> @param[out] IBAY -- integer(*): Array containing encoded CHR
16 C> @param[in,out] IBIT -- integer: Bit pointer within IBAY
17 C> - On input, IBIT points to the bit within
18 C> IBAY after which to begin encoding CHR.
19 C> - On output, IBIT points to the last bit
20 C> of IBAY which contains the encoded CHR.
21 C>
22 C> @remarks
23 C> - This subroutine is the logical inverse of subroutine upc().
24 C> - On input, there is no requirement that IBIT must point to the first
25 C> bit of a byte within IBAY. Correspondingly, on output there is no
26 C> guarantee that the NCHR characters of CHR will be aligned on byte
27 C> boundaries when encoded within IBAY.
28 C>
29 C> <b>Program history log:</b>
30 C> | Date | Programmer | Comments |
31 C> | -----|------------|----------|
32 C> | 1994-01-06 | J. Woollen | Original author |
33 C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
34 C> | 2003-11-04 | J. Woollen | Modified to be endian-independent |
35 C> | 2003-11-04 | J. Ator | Added documentation |
36 C> | 2003-11-04 | S. Bender | Added remarks and routine interdependencies |
37 C> | 2003-11-04 | D. Keyser | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally; use bort2() instead of bort() |
38 C> | 2004-08-18 | J. Ator | Modified to be compatible with writlc() |
39 C>
40  SUBROUTINE pkc(CHR,NCHR,IBAY,IBIT)
41 
42  COMMON /charac/ iascii,iatoe(0:255),ietoa(0:255)
43  COMMON /hrdwrd/ nbytw,nbitw,iord(8)
44 
45  CHARACTER*(*) chr
46  CHARACTER*1 cval(8)
47  dimension ibay(*),ival(2)
48  equivalence(cval,ival)
49 
50 C----------------------------------------------------------------------
51 C----------------------------------------------------------------------
52 
53  lb = iord(nbytw)
54 
55 C LB now points to the "low-order" (i.e. least significant) byte
56 C within a machine word.
57 
58  ival(1) = 0
59  nbit = 8
60 
61  DO i=1,nchr
62  IF(i.LE.len(chr)) THEN
63  cval(lb) = chr(i:i)
64  ELSE
65  cval(lb) = ' '
66  ENDIF
67 
68 C If the machine is EBCDIC, then translate character CVAL(LB) from
69 C EBCDIC to ASCII.
70 
71  IF(iascii.EQ.0) CALL ipkm(cval(lb),1,ietoa(iupm(cval(lb),8)))
72 
73  nwd = ibit/nbitw + 1
74  nbt = mod(ibit,nbitw)
75  int = ishft(ival(1),nbitw-nbit)
76  int = ishft(int,-nbt)
77  msk = ishft( -1,nbitw-nbit)
78  msk = ishft(msk,-nbt)
79  ibay(nwd) = irev(ior(iand(irev(ibay(nwd)),not(msk)),int))
80  IF(nbt+nbit.GT.nbitw) THEN
81 
82 C This character will not fit within the current word (i.e.
83 C array member) of IBAY, because there are less than 8 bits of
84 C space left. Store as many bits as will fit within the current
85 C word and then store the remaining bits within the next word.
86 
87  int = ishft(ival(1),2*nbitw-(nbt+nbit))
88  msk = ishft( -1,2*nbitw-(nbt+nbit))
89  ibay(nwd+1) = irev(ior(iand(irev(ibay(nwd+1)),not(msk)),int))
90  ENDIF
91  ibit = ibit + nbit
92  ENDDO
93 
94 C EXITS
95 C -----
96 
97  RETURN
98  END
subroutine pkc(CHR, NCHR, IBAY, IBIT)
This subroutine encodes a character string within a specified number of bits of an integer array...
Definition: pkc.f:40
function irev(N)
THIS FUNCTION WILL, WHEN THE LOCAL MACHINE IS &quot;LITTLE- ENDIAN&quot; (I.E., USES A RIGHT TO LEFT SCHEME ...
Definition: irev.F:50
function iupm(CBAY, NBITS)
THIS FUNCTION UNPACKS AND RETURNS A BINARY INTEGER WORD CONTAINED WITHIN NBITS BITS OF A CHARACTER ST...
Definition: iupm.f:40
subroutine ipkm(CBAY, NBYT, N)
This subroutine encodes an integer value within a specified number of bytes of a character string...
Definition: ipkm.f:27