var/external/bufr/iupm.f

   1       FUNCTION IUPM(CBAY,NBITS)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    IUPM
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS FUNCTION UNPACKS AND RETURNS A BINARY INTEGER WORD
   9 C   CONTAINED WITHIN NBITS BITS OF A CHARACTER STRING CBAY, STARTING
  10 C   WITH THE FIRST BIT OF THE FIRST BYTE OF CBAY.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  14 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  15 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  16 C                           ROUTINE "BORT"
  17 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  18 C 2003-11-04  J. WOOLLEN -- BIG-ENDIAN/LITTLE-ENDIAN INDEPENDENT (WAS
  19 C                           IN DECODER VERSION)
  20 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  21 C                           INTERDEPENDENCIES
  22 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  23 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  24 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  25 C                           ABNORMALLY
  26 C
  27 C USAGE:    IUPM (CBAY, NBITS)
  28 C   INPUT ARGUMENT LIST:
  29 C     CBAY     - CHARACTER*8: CHARACTER STRING CONTAINING PACKED
  30 C                INTEGER
  31 C     NBITS    - INTEGER: NUMBER OF BITS WITHIN CBAY TO BE UNPACKED
  32 C
  33 C   OUTPUT ARGUMENT LIST:
  34 C     IUPM     - INTEGER: UNPACKED INTEGER WORD
  35 C
  36 C REMARKS:
  37 C    THIS ROUTINE CALLS:        BORT     IREV
  38 C    THIS ROUTINE IS CALLED BY: CHRTRNA  CRBMG    DXMINI   ICBFMS
  39 C                               PKC      PKTDD    STBFDX   UPC
  40 C                               UPTDD    WRDLEN   WRDXTB
  41 C                               Normally not called by any application
  42 C                               programs.
  43 C
  44 C ATTRIBUTES:
  45 C   LANGUAGE: FORTRAN 77
  46 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  47 C
  48 C$$$
  49
  50       COMMON /HRDWRD/ NBYTW,NBITW,IORD(8)
  51
  52       CHARACTER*128 BORT_STR
  53       CHARACTER*8   CBAY
  54       CHARACTER*8   CINT
  55       DIMENSION     INT(2)
  56       EQUIVALENCE   (CINT,INT)
  57
  58 C----------------------------------------------------------------------
  59 C----------------------------------------------------------------------
  60
  61       IF(NBITS.GT.NBITW) GOTO 900
  62       CINT = CBAY
  63       INT(1) = IREV(INT(1))
  64       IUPM = ISHFT(INT(1),NBITS-NBITW)
  65
  66 C  EXITS
  67 C  -----
  68
  69       RETURN
  70 900   WRITE(BORT_STR,'("BUFRLIB: IUPM - NUMBER OF BITS BEING UNPACKED'//
  71      . ', NBITS (",I4,"), IS > THE INTEGER WORD LENGTH ON THIS '//
  72      . 'MACHINE, NBITW (",I3,")")') NBITS,NBITW
  73       CALL BORT(BORT_STR)
  74       END