var/external/bufr/upbb.f

   1       SUBROUTINE UPBB(NVAL,NBITS,IBIT,IBAY)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UPBB
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE UNPACKS AND RETURNS A BINARY INTEGER
   9 C   CONTAINED WITHIN NBITS BITS OF IBAY, STARTING WITH BIT (IBIT+1).
  10 C   THIS IS SIMILAR TO BUFR ARCHIVE LIBRARY SUBROUTINE UPB, EXCEPT IN
  11 C   UPBB IBIT IS NOT UPDATED UPON OUTPUT (AND THE ORDER OF ARGUMENTS IS
  12 C   DIFFERENT).
  13 C
  14 C PROGRAM HISTORY LOG:
  15 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  16 C 1998-10-27  J. WOOLLEN -- MODIFIED TO CORRECT PROBLEMS CAUSED BY IN-
  17 C                           LINING CODE WITH FPP DIRECTIVES
  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  -- ADDED CHECK FOR NBITS EQUAL TO ZERO;
  23 C                           MODIFIED LOGIC TO MAKE IT CONSISTENT WITH
  24 C                           LOGIC IN UPB; UNIFIED/PORTABLE FOR WRF;
  25 C                           ADDED DOCUMENTATION (INCLUDING HISTORY)
  26 C
  27 C USAGE:    CALL UPBB (NVAL, NBITS, IBIT, IBAY)
  28 C   INPUT ARGUMENT LIST:
  29 C     NBITS    - INTEGER: NUMBER OF BITS OF IBAY WITHIN WHICH TO UNPACK
  30 C                NVAL
  31 C     IBIT     - INTEGER: BIT POINTER WITHIN IBAY TO START UNPACKING
  32 C                FROM
  33 C     IBAY     - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING PACKED
  34 C                NVAL
  35 C
  36 C   OUTPUT ARGUMENT LIST:
  37 C     NVAL     - INTEGER: UNPACKED INTEGER
  38 C
  39 C REMARKS:
  40 C    THIS ROUTINE CALLS:        IREV
  41 C    THIS ROUTINE IS CALLED BY: RCSTPL   RDTREE   UFBGET   UFBTAB
  42 C                               UFBTAM   UPB      WRITLC
  43 C                               Normally not called by any application
  44 C                               programs.
  45 C
  46 C ATTRIBUTES:
  47 C   LANGUAGE: FORTRAN 77
  48 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  49 C
  50 C$$$
  51
  52       COMMON /HRDWRD/ NBYTW,NBITW,IORD(8)
  53
  54       DIMENSION IBAY(*)
  55
  56 C----------------------------------------------------------------------
  57 C----------------------------------------------------------------------
  58
  59 C  IF NBITS=0, THEN JUST SET NVAL=0 AND RETURN
  60 C  -------------------------------------------
  61
  62       IF(NBITS.EQ.0)THEN
  63         NVAL=0
  64         GOTO 100
  65       ENDIF
  66
  67       NWD = IBIT/NBITW + 1
  68       NBT = MOD(IBIT,NBITW)
  69       INT = ISHFT(IREV(IBAY(NWD)),NBT)
  70       INT = ISHFT(INT,NBITS-NBITW)
  71       LBT = NBT+NBITS
  72       IF(LBT.GT.NBITW) THEN
  73          JNT = IREV(IBAY(NWD+1))
  74          INT = IOR(INT,ISHFT(JNT,LBT-2*NBITW))
  75       ENDIF
  76       NVAL = INT
  77
  78 C  EXIT
  79 C  ----
  80
  81 100   RETURN
  82       END