pkc.f

Go to the documentation of this file.

C> @file
C> @brief Encode a character string within an integer array.
C>
C> @author J. Woollen @date 1994-01-06
 
C> Encode a character string within an integer array.
C>
C> This subroutine encodes a character string within a specified
C> number of bytes of an integer array, starting at the bit
C> immediately after a specified bit within the array.
C>
C> @remarks
C> - This subroutine is the logical inverse of subroutine upc().
C> - On input, there is no requirement that IBIT must point to the first
C>   bit of a byte within IBAY.  Correspondingly, on output there is no
C>   guarantee that the NCHR characters of CHR will be aligned on byte
C>   boundaries when encoded within IBAY.
C>
C> @param[in] CHR - character*(*): String to be encoded.
C> @param[in] NCHR - integer: Number of bytes of IBAY within
C> which to encode CHR (i.e. the number of characters in CHR).
C> @param[out] IBAY - integer(*): Array containing encoded CHR.
C> @param[in,out] IBIT - integer: Bit pointer within IBAY
C>  - On input, IBIT points to the bit within IBAY after which
C> to begin encoding CHR.
C>  - On output, IBIT points to the last bit of IBAY which
C> contains the encoded CHR.
C>
C> @author J. Woollen @date 1994-01-06
      SUBROUTINE pkc(CHR,NCHR,IBAY,IBIT)
 
      COMMON /hrdwrd/ nbytw,nbitw,iord(8)
 
      CHARACTER*(*) CHR
      CHARACTER*1   CVAL(8)
      dimension     ibay(*),ival(2)
      equivalence(cval,ival)
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
      lb = iord(nbytw)
 
C     LB now points to the "low-order" (i.e. least significant) byte
C     within a machine word.
 
      ival(1) = 0
      nbit = 8
 
      DO i=1,nchr
      IF(i.LE.len(chr)) THEN
         cval(lb) = chr(i:i)
      ELSE
         cval(lb) = ' '
      ENDIF
 
      nwd  = ibit/nbitw + 1
      nbt  = mod(ibit,nbitw)
      int = ishft(ival(1),nbitw-nbit)
      int = ishft(int,-nbt)
      msk = ishft(  -1,nbitw-nbit)
      msk = ishft(msk,-nbt)
      ibay(nwd) = irev(ior(iand(irev(ibay(nwd)),not(msk)),int))
      IF(nbt+nbit.GT.nbitw) THEN
 
C        This character will not fit within the current word (i.e.
C        array member) of IBAY, because there are less than 8 bits of
C        space left.  Store as many bits as will fit within the current
C        word and then store the remaining bits within the next word.
 
         int = ishft(ival(1),2*nbitw-(nbt+nbit))
         msk = ishft(  -1,2*nbitw-(nbt+nbit))
         ibay(nwd+1) = irev(ior(iand(irev(ibay(nwd+1)),not(msk)),int))
      ENDIF
      ibit = ibit + nbit
      ENDDO
 
C  EXITS
C  -----
 
      RETURN
      END