pkb.f

Go to the documentation of this file.

C> @file
C> @brief Encode an integer value within an integer array.

C> This subroutine encodes an integer value within a specified
C> number of bits of an integer array, starting at the bit
C> immediately after a specified bit within the array.
C>
C> @author J. Woollen
C> @date 1994-01-06
C>
C> @param[in] NVAL     - integer: Value to be encoded
C> @param[in] NBITS    - integer: Number of bits of IBAY within
C>                       which to encode NVAL
C> @param[out] IBAY    - integer(*): Array containing encoded NVAL
C> @param[in,out] IBIT - integer: Bit pointer within IBAY
C>                       - On input, IBIT points to the bit within
C>                         IBAY after which to begin encoding NVAL.
C>                       - On output, IBIT points to the last bit
C>                         of IBAY which contains the encoded NVAL.
C>
C> @remarks
C> - This subroutine is the logical inverse of subroutine upb().
C> - This subroutine will not work properly if NBITS is greater than
C>   the number of bits in an integer, as determined via
C>   an internal call to subroutine wrdlen().  In such cases,
C>   the user should switch to a compiled version of the BUFRLIB
C>   software which has a larger integer size.
C>
C> <b>Program history log:</b>
C> - 1994-01-06  J. Woollen -- Original author
C> - 2003-11-04  J. Ator    -- Added documentation
C> - 2003-11-04  S. Bender  -- Added remarks and routine interdependencies
C> - 2003-11-04  D. Keyser  -- Unified/portable for WRF; added history
C>                             documentation; outputs more complete
C>                             diagnostic info when routine terminates
C>                             abnormally, unusual things happen or for
C>                             informational purposes
C> - 2014-12-03  J. Ator    -- Call bort() if NBITS > NBITW
C>
      SUBROUTINE pkb(NVAL,NBITS,IBAY,IBIT)

      COMMON /hrdwrd/ nbytw,nbitw,iord(8)

      dimension ibay(*)

      CHARACTER*156 bort_str

C----------------------------------------------------------------------
C----------------------------------------------------------------------

      IF(nbits.GT.nbitw) goto 900

      nwd  = ibit/nbitw + 1
      nbt  = mod(ibit,nbitw)
      ival = nval
      IF(ishft(ival,-nbits).GT.0) ival = -1
      int = ishft(ival,nbitw-nbits)
      int = ishft(int,-nbt)
      msk = ishft(  -1,nbitw-nbits)
      msk = ishft(msk,-nbt)
      ibay(nwd) = irev(ior(iand(irev(ibay(nwd)),not(msk)),int))
      IF(nbt+nbits.GT.nbitw) THEN

C        There are less than NBITS bits remaining within the current
C        word (i.e. array member) of IBAY, so store as many bits as
C        will fit within the current word and then store the remaining
C        bits within the next word.

         int = ishft(ival,2*nbitw-(nbt+nbits))
         msk = ishft(  -1,2*nbitw-(nbt+nbits))
         ibay(nwd+1) = irev(ior(iand(irev(ibay(nwd+1)),not(msk)),int))
      ENDIF

      ibit = ibit + nbits

      RETURN
900   WRITE(bort_str,'("BUFRLIB: PKB - NUMBER OF BITS BEING PACKED '//
     . ', NBITS (",I4,"), IS > THE INTEGER WORD LENGTH ON THIS '//
     . 'MACHINE, NBITW (",I3,")")')
     . nbits,nbitw
      CALL bort(bort_str)
      END