NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
pkb.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Encode an integer value within an integer array.
3 
4 C> This subroutine encodes an integer value 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] NVAL -- integer: Value to be encoded
12 C> @param[in] NBITS -- integer: Number of bits of IBAY within
13 C> which to encode NVAL
14 C> @param[out] IBAY -- integer(*): Array containing encoded NVAL
15 C> @param[in,out] IBIT -- integer: Bit pointer within IBAY
16 C> - On input, IBIT points to the bit within
17 C> IBAY after which to begin encoding NVAL.
18 C> - On output, IBIT points to the last bit
19 C> of IBAY which contains the encoded NVAL.
20 C>
21 C> @remarks
22 C> - This subroutine is the logical inverse of subroutine upb().
23 C> - This subroutine will not work properly if NBITS is greater than
24 C> the number of bits in an integer, as determined via
25 C> an internal call to subroutine wrdlen(). In such cases,
26 C> the user should switch to a compiled version of the BUFRLIB
27 C> software which has a larger integer size.
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> | 2003-11-04 | J. Ator | Added documentation |
34 C> | 2003-11-04 | S. Bender | Added remarks and routine interdependencies |
35 C> | 2003-11-04 | D. Keyser | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally |
36 C> | 2014-12-03 | J. Ator | Call bort() if NBITS > NBITW |
37 C>
38  SUBROUTINE pkb(NVAL,NBITS,IBAY,IBIT)
39 
40  COMMON /hrdwrd/ nbytw,nbitw,iord(8)
41 
42  dimension ibay(*)
43 
44  CHARACTER*156 bort_str
45 
46 C----------------------------------------------------------------------
47 C----------------------------------------------------------------------
48 
49  IF(nbits.GT.nbitw) goto 900
50 
51  nwd = ibit/nbitw + 1
52  nbt = mod(ibit,nbitw)
53  ival = nval
54  IF(ishft(ival,-nbits).GT.0) ival = -1
55  int = ishft(ival,nbitw-nbits)
56  int = ishft(int,-nbt)
57  msk = ishft( -1,nbitw-nbits)
58  msk = ishft(msk,-nbt)
59  ibay(nwd) = irev(ior(iand(irev(ibay(nwd)),not(msk)),int))
60  IF(nbt+nbits.GT.nbitw) THEN
61 
62 C There are less than NBITS bits remaining within the current
63 C word (i.e. array member) of IBAY, so store as many bits as
64 C will fit within the current word and then store the remaining
65 C bits within the next word.
66 
67  int = ishft(ival,2*nbitw-(nbt+nbits))
68  msk = ishft( -1,2*nbitw-(nbt+nbits))
69  ibay(nwd+1) = irev(ior(iand(irev(ibay(nwd+1)),not(msk)),int))
70  ENDIF
71 
72  ibit = ibit + nbits
73 
74  RETURN
75 900 WRITE(bort_str,'("BUFRLIB: PKB - NUMBER OF BITS BEING PACKED '//
76  . ', NBITS (",I4,"), IS > THE INTEGER WORD LENGTH ON THIS '//
77  . 'MACHINE, NBITW (",I3,")")')
78  . nbits,nbitw
79  CALL bort(bort_str)
80  END
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
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
subroutine pkb(NVAL, NBITS, IBAY, IBIT)
This subroutine encodes an integer value within a specified number of bits of an integer array...
Definition: pkb.f:38