ipkm.f

Go to the documentation of this file.

C> @file
C> @brief Encode an integer value within a character string.
 
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> @author J. Woollen
C> @date 1994-01-06
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> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 1994-01-06 | J. Woollen | Original author |
C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
C> | 2003-11-04 | J. Woollen | Modified to be endian-independent |
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 documentation; outputs more complete diagnostic info when routine terminates abnormally |
C>
      SUBROUTINE ipkm(CBAY,NBYT,N)
 
      COMMON /hrdwrd/ nbytw,nbitw,iord(8)
 
      CHARACTER*128 BORT_STR
      CHARACTER*8   CBAY,CINT
      equivalence(cint,int)
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
      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