<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='GETVALNB'><A href='../../html_code/bufr/getvalnb.f.html#GETVALNB' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
REAL*8 FUNCTION GETVALNB ( LUNIT, TAGPV, NTAGPV, TAGNB, NTAGNB ) 1,1
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: GETVALNB
C PRGMMR: J. ATOR ORG: NP12 DATE: 2012-09-12
C
C ABSTRACT: THIS FUNCTION SHOULD ONLY BE CALLED WHEN A BUFR FILE IS
C OPENED FOR INPUT, AND A SUBSET DEFINITION MUST ALREADY BE IN SCOPE
C VIA A PREVIOUS CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE READSB OR
C EQUIVALENT. THE FUNCTION WILL FIRST SEARCH FOR THE (NTAGPV)th
C OCCURRENCE OF MNEMONIC TAGPV WITHIN THE OVERALL SUBSET DEFINITION,
C COUNTING FROM THE BEGINNING OF THE SUBSET. IF FOUND, IT WILL THEN
C SEARCH FORWARD (IF NTAGNB IS POSITIVE) OR BACKWARD (IF NTAGNB IS
C NEGATIVE) FROM THAT POINT WITHIN THE SUBSET FOR THE (NTAGNB)th
C OCCURRENCE OF MNEMONIC TAGNB AND RETURN THE VALUE CORRESPONDING
C TO THAT MNEMONIC.
C
C PROGRAM HISTORY LOG:
C 2012-09-12 J. ATOR -- ORIGINAL AUTHOR
C
C USAGE: CALL GETVALNB
(LUNIT, TAGPV, NTAGPV, TAGNB, NTAGNB)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
<A NAME='WILL'><A href='../../html_code/bufr/getvalnb.f.html#WILL' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
C TAGPV - CHARACTER*(*): PIVOT MNEMONIC; THE FUNCTION WILL,6
C FIRST SEARCH FOR the (NTAGPV)th OCCURRENCE OF THIS
C MNEMONIC, COUNTING FROM THE BEGINNING OF THE OVERALL
C SUBSET DEFINITION
C NTAGPV - INTEGER: ORDINAL OCCURRENCE OF TAGPV TO SEARCH FOR
C TAGNB - CHARACTER*(*): NEARBY MNEMONIC; ASSUMING TAGPV IS
C SUCCESSFULLY FOUND, THE FUNCTION WILL THEN SEARCH
C NEARBY FOR THE (NTAGNB)th OCCURRENCE OF TAGNB AND
C RETURN THE CORRESPONDING VALUE
C NTAGNB - INTEGER: ORDINAL OCCURRENCE OF TAGNB TO SEARCH FOR,
C COUNTING FROM THE LOCATION OF TAGPV WITHIN THE OVERALL
C SUBSET DEFINITION. IF TAGNB IS POSITIVE, THE FUNCTION
C WILL SEARCH IN A FORWARD DIRECTION FROM THE LOCATION OF
C TAGPV, OR IF TAGNB IS NEGATIVE IT WILL INSTEAD SEARCH
C IN A BACKWARDS DIRECTION.
C
C OUTPUT ARGUMENT LIST:
C GETVALNB - REAL*8: VALUE CORRESPONDING TO (NTAGNB)th OCCURRENCE
C OF TAGNB. IF FOR ANY REASON THIS VALUE CANNOT BE
C LOCATED, THEN THE BUFR ARCHIVE LIBRARY MISSING VALUE
C BMISS WILL BE RETURNED.
C
C REMARKS:
C THIS ROUTINE CALLS: PARSTR STATUS
C THIS ROUTINE IS CALLED BY: None
C Normally called only by application
C programs
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL),
. JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL),
. IBT(MAXJL),IRF(MAXJL),ISC(MAXJL),
. ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL),
. ISEQ(MAXJL,2),JSEQ(MAXJL)
COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
CHARACTER*10 TAG,TGS(15)
CHARACTER*3 TYP
CHARACTER*(*) TAGPV, TAGNB
REAL*8 VAL
LOGICAL GOTNODPV
DATA MAXTG /15/
C----------------------------------------------------------------------
C----------------------------------------------------------------------
GETVALNB = BMISS
C Get LUN from LUNIT.
CALL STATUS(LUNIT,LUN,IL,IM)
IF (IL.EQ.0) RETURN
IF (INODE(LUN).NE.INV(1,LUN)) RETURN
C Locate the (NTAGPV)th occurrence of TAGPV.
CALL PARSTR(TAGPV,TGS,MAXTG,NTG,' ',.TRUE.)
IF (NTG.NE.1) RETURN
GOTNODPV = .FALSE.
ITAGCT = 0
N = 1
DO WHILE ((.NOT.GOTNODPV).AND.(N.LE.NVAL(LUN)))
NOD = INV(N,LUN)
IF(TGS(1).EQ.TAG(NOD)) THEN
ITAGCT = ITAGCT + 1
IF(ITAGCT.EQ.NTAGPV) THEN
GOTNODPV = .TRUE.
ELSE
N = N+1
ENDIF
ELSE
N = N+1
ENDIF
ENDDO
IF (.NOT.GOTNODPV) RETURN
C Starting from TAGPV, search nearby for the
C +/-(NTAGNB)th occurrence of TAGNB.
CALL PARSTR(TAGNB,TGS,MAXTG,NTG,' ',.TRUE.)
IF (NTG.NE.1) RETURN
ISTEP = ISIGN(1,NTAGNB)
ITAGCT = 0
N = N+ISTEP
DO WHILE ((N.GE.1).AND.(N.LE.NVAL(LUN)))
NOD = INV(N,LUN)
IF(TGS(1).EQ.TAG(NOD)) THEN
ITAGCT = ITAGCT + 1
IF(ITAGCT.EQ.IABS(NTAGNB)) THEN
GETVALNB = VAL(N,LUN)
RETURN
ELSE
N = N+ISTEP
ENDIF
ELSE
N = N+ISTEP
ENDIF
ENDDO
RETURN
END