iupm.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS FUNCTION UNPACKS AND RETURNS A BINARY INTEGER WORD
C>   CONTAINED WITHIN NBITS BITS OF A CHARACTER STRING CBAY, STARTING
C>   WITH THE FIRST BIT OF THE FIRST BYTE OF CBAY.
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C>                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C>                           ROUTINE "BORT"
C> 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
C> 2003-11-04  J. WOOLLEN -- BIG-ENDIAN/LITTLE-ENDIAN INDEPENDENT (WAS
C>                           IN DECODER VERSION)
C> 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C>                           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
C>
C> USAGE:    IUPM (CBAY, NBITS)
C>   INPUT ARGUMENT LIST:
C>     CBAY     - CHARACTER*8: CHARACTER STRING CONTAINING PACKED
C>                INTEGER
C>     NBITS    - INTEGER: NUMBER OF BITS WITHIN CBAY TO BE UNPACKED
C>
C>   OUTPUT ARGUMENT LIST:
C>     IUPM     - INTEGER: UNPACKED INTEGER WORD
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        BORT     IREV
C>    THIS ROUTINE IS CALLED BY: CHRTRNA  CRBMG    DXMINI   ICBFMS
C>                               PKC      PKTDD    UPC      UPTDD
C>                               WRDLEN   WRDXTB
C>                               Normally not called by any application
C>                               programs.
C>
      FUNCTION iupm(CBAY,NBITS)



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

      CHARACTER*128 bort_str
      CHARACTER*8   cbay
      CHARACTER*8   cint
      dimension     int(2)
      equivalence(cint,int)

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

      IF(nbits.GT.nbitw) goto 900
      cint = cbay
      int(1) = irev(int(1))
      iupm = ishft(int(1),nbits-nbitw)

C  EXITS
C  -----

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