ipkm.f

Go to the documentation of this file.

C> @file
C> @brief Encode an integer value within a character string.
C>
C> @author J. Woollen @date 1994-01-06
 
C> Encode an integer value within a character string.
C>
C> This subroutine encodes an integer value within a specified
C> number of bytes of a character string, up to a maximum of 8
C> bytes.
C>
C> This subroutine is the logical inverse of subroutine iupm().
C>
C> @param[in] N - integer: Value to be encoded.
C> @param[in] NBYT - integer: Number of bytes of CBAY (up to a
C> maximum of 8) within which to encode N.
C> @param[out] CBAY - character*(*): String of length NBYT bytes
C> containing encoded integer N.
C>
C> @author J. Woollen @date 1994-01-06
      RECURSIVE SUBROUTINE ipkm(CBAY,NBYT,N)
 
      USE modv_im8b
 
      COMMON /hrdwrd/ nbytw,nbitw,iord(8)
 
      CHARACTER*128 bort_str
      CHARACTER*8   cbay,cint
      equivalence(cint,int)
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
C     Check for I8 integers.
 
      IF(im8b) THEN
          im8b=.false.
 
          CALL x84(n,my_n,1)
          CALL x84(nbyt,my_nbyt,1)
          CALL ipkm(cbay,my_nbyt,my_n)
 
          im8b=.true.
          RETURN
      ENDIF
 
      IF(nbyt.GT.nbytw) GOTO 900
 
C     Note that the widths of input variable N and local variable INT
C     will both be equal to the default size of an integer (= NBYTW),
C     since they aren't specifically declared otherwise.
 
      int = irev(ishft(n,(nbytw-nbyt)*8))
      DO i=1,nbyt
          cbay(i:i) = cint(i:i)
      ENDDO
 
C  EXITS
C  -----
 
      RETURN
900   WRITE(bort_str,'("BUFRLIB: IPKM - NUMBER OF BYTES BEING PACKED '//
     . ', NBYT (",I4,"), IS > THE INTEGER WORD LENGTH ON THIS '//
     . 'MACHINE, NBYTW (",I3,")")') nbyt,nbytw
      CALL bort(bort_str)
      END