<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='UPFTBV'><A href='../../html_code/bufr/upftbv.f.html#UPFTBV' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE UPFTBV(LUNIT,NEMO,VAL,MXIB,IBIT,NIB) 2,7
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: UPFTBV
C PRGMMR: JATOR ORG: NP12 DATE: 2005-11-29
C
C ABSTRACT: GIVEN A MNEMONIC OF TYPE "FLAG TABLE" ALONG WITH ITS
C CORRESPONDING VALUE, THIS SUBROUTINE DETERMINES THE BIT SETTINGS
C EQUIVALANT TO THAT VALUE. NOTE THAT THIS SUBROUTINE IS THE
C LOGICAL INVERSE OF BUFRLIB SUBROUTINE PKFTBV.
C
C PROGRAM HISTORY LOG:
C 2005-11-29 J. ATOR -- ORIGINAL VERSION
C
C USAGE: UPFTBV (LUNIT,NEMO,VAL,MXIB,IBIT,NIB)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C NEMO - CHARACTER*(*): MNEMONIC OF TYPE "FLAG TABLE"
C VAL - REAL*8: VALUE CORRESPONDING TO NEMO
C MXIB - INTEGER: DIMENSIONED SIZE OF IBIT IN CALLING PROGRAM
C
C OUTPUT ARGUMENT LIST:
C IBIT - INTEGER(*): BIT NUMBERS WHICH WERE SET TO "ON"
C (I.E. SET TO "1") IN VAL
C NIB - INTEGER: NUMBER OF BIT NUMBERS RETURNED IN IBIT
C
C REMARKS:
C THIS ROUTINE CALLS: BORT NEMTAB STATUS VALX
C THIS ROUTINE IS CALLED BY: UFBDMP UFDUMP
C Also called by application programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
. MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
. IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
. TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
. TABD(MAXTBD,NFILES)
REAL*8 VAL,R8VAL,R82I
INTEGER IBIT (*)
CHARACTER*(*) NEMO
CHARACTER*600 TABD
CHARACTER*128 TABB
CHARACTER*128 TABA
CHARACTER*128 BORT_STR
CHARACTER*1 TAB
C----------------------------------------------------------------------
C----------------------------------------------------------------------
C Perform some sanity checks.
CALL STATUS
(LUNIT,LUN,IL,IM)
IF(IL.EQ.0) GOTO 900
CALL NEMTAB(LUN,NEMO,IDN,TAB,N)
IF(N.EQ.0) GOTO 901
IF(TABB(N,LUN)(71:74).NE.'FLAG') GOTO 902
C Figure out which bits are set.
NIB = 0
R8VAL = VAL
NBITS = VALX(TABB(N,LUN)(110:112))
DO I=(NBITS-1),0,-1
R82I = (2.)**I
IF(ABS(R8VAL-R82I).LT.(0.005)) THEN
NIB = NIB + 1
IF(NIB.GT.MXIB) GOTO 903
IBIT(NIB) = NBITS-I
RETURN
ELSEIF(R82I.LT.R8VAL) THEN
NIB = NIB + 1
IF(NIB.GT.MXIB) GOTO 903
IBIT(NIB) = NBITS-I
R8VAL = R8VAL - R82I
ENDIF
ENDDO
RETURN
900 CALL BORT('BUFRLIB: UPFTBV - INPUT BUFR FILE IS CLOSED, IT '//
. 'MUST BE OPEN FOR INPUT')
901 WRITE(BORT_STR,'("BUFRLIB: UPFTBV - MNEMONIC ",A,'//
. '" NOT FOUND IN TABLE B")') NEMO
CALL BORT(BORT_STR)
902 WRITE(BORT_STR,'("BUFRLIB: UPFTBV - MNEMONIC ",A,'//
. '" IS NOT A FLAG TABLE")') NEMO
CALL BORT(BORT_STR)
903 CALL BORT('BUFRLIB: UPFTBV - IBIT ARRAY OVERFLOW')
END