var/external/bufr/getvalnb.f

   1         REAL*8 FUNCTION GETVALNB ( LUNIT, TAGPV, NTAGPV, TAGNB, NTAGNB )
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    GETVALNB
   6 C   PRGMMR: J. ATOR          ORG: NP12       DATE: 2012-09-12
   7 C
   8 C ABSTRACT:  THIS FUNCTION SHOULD ONLY BE CALLED WHEN A BUFR FILE IS
   9 C   OPENED FOR INPUT, AND A SUBSET DEFINITION MUST ALREADY BE IN SCOPE
  10 C   VIA A PREVIOUS CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE READSB OR
  11 C   EQUIVALENT.  THE FUNCTION WILL FIRST SEARCH FOR THE (NTAGPV)th
  12 C   OCCURRENCE OF MNEMONIC TAGPV WITHIN THE OVERALL SUBSET DEFINITION,
  13 C   COUNTING FROM THE BEGINNING OF THE SUBSET.  IF FOUND, IT WILL THEN
  14 C   SEARCH FORWARD (IF NTAGNB IS POSITIVE) OR BACKWARD (IF NTAGNB IS
  15 C   NEGATIVE) FROM THAT POINT WITHIN THE SUBSET FOR THE (NTAGNB)th
  16 C   OCCURRENCE OF MNEMONIC TAGNB AND RETURN THE VALUE CORRESPONDING
  17 C   TO THAT MNEMONIC.
  18 C
  19 C PROGRAM HISTORY LOG:
  20 C 2012-09-12  J. ATOR    -- ORIGINAL AUTHOR
  21 C
  22 C USAGE:    CALL GETVALNB (LUNIT, TAGPV, NTAGPV, TAGNB, NTAGNB)
  23 C   INPUT ARGUMENT LIST:
  24 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  25 C     TAGPV    - CHARACTER*(*): PIVOT MNEMONIC; THE FUNCTION WILL
  26 C                FIRST SEARCH FOR the (NTAGPV)th OCCURRENCE OF THIS
  27 C                MNEMONIC, COUNTING FROM THE BEGINNING OF THE OVERALL
  28 C                SUBSET DEFINITION
  29 C     NTAGPV   - INTEGER: ORDINAL OCCURRENCE OF TAGPV TO SEARCH FOR
  30 C     TAGNB    - CHARACTER*(*): NEARBY MNEMONIC; ASSUMING TAGPV IS
  31 C                SUCCESSFULLY FOUND, THE FUNCTION WILL THEN SEARCH
  32 C                NEARBY FOR THE (NTAGNB)th OCCURRENCE OF TAGNB AND
  33 C                RETURN THE CORRESPONDING VALUE
  34 C     NTAGNB   - INTEGER: ORDINAL OCCURRENCE OF TAGNB TO SEARCH FOR,
  35 C                COUNTING FROM THE LOCATION OF TAGPV WITHIN THE OVERALL
  36 C                SUBSET DEFINITION.  IF TAGNB IS POSITIVE, THE FUNCTION
  37 C                WILL SEARCH IN A FORWARD DIRECTION FROM THE LOCATION OF
  38 C                TAGPV, OR IF TAGNB IS NEGATIVE IT WILL INSTEAD SEARCH
  39 C                IN A BACKWARDS DIRECTION.
  40 C
  41 C   OUTPUT ARGUMENT LIST:
  42 C     GETVALNB - REAL*8: VALUE CORRESPONDING TO (NTAGNB)th OCCURRENCE
  43 C                OF TAGNB.  IF FOR ANY REASON THIS VALUE CANNOT BE
  44 C                LOCATED, THEN THE BUFR ARCHIVE LIBRARY MISSING VALUE
  45 C                BMISS WILL BE RETURNED.
  46 C
  47 C REMARKS:
  48 C    THIS ROUTINE CALLS:        PARSTR   STATUS
  49 C    THIS ROUTINE IS CALLED BY: None
  50 C                               Normally called only by application
  51 C                               programs
  52 C
  53 C ATTRIBUTES:
  54 C   LANGUAGE: FORTRAN 77
  55 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  56 C
  57 C$$$
  58
  59         INCLUDE 'bufrlib.prm'
  60
  61         COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  62      .                  INODE(NFILES),IDATE(NFILES)
  63         COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL),
  64      .                  JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL),
  65      .                  IBT(MAXJL),IRF(MAXJL),ISC(MAXJL),
  66      .                  ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL),
  67      .                  ISEQ(MAXJL,2),JSEQ(MAXJL)
  68         COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
  69
  70         CHARACTER*10  TAG,TGS(15)
  71         CHARACTER*3   TYP
  72
  73         CHARACTER*(*) TAGPV, TAGNB
  74
  75         REAL*8 VAL
  76
  77         LOGICAL GOTNODPV
  78
  79         DATA MAXTG  /15/
  80
  81 C----------------------------------------------------------------------
  82 C----------------------------------------------------------------------
  83
  84         GETVALNB = BMISS
  85
  86 C       Get LUN from LUNIT.
  87
  88         CALL STATUS(LUNIT,LUN,IL,IM)
  89         IF (IL.EQ.0) RETURN
  90         IF (INODE(LUN).NE.INV(1,LUN)) RETURN
  91
  92 C       Locate the (NTAGPV)th occurrence of TAGPV.
  93
  94         CALL PARSTR(TAGPV,TGS,MAXTG,NTG,' ',.TRUE.)
  95         IF (NTG.NE.1) RETURN
  96
  97         GOTNODPV = .FALSE.
  98         ITAGCT = 0
  99         N = 1
 100         DO WHILE ((.NOT.GOTNODPV).AND.(N.LE.NVAL(LUN)))
 101             NOD = INV(N,LUN)
 102             IF(TGS(1).EQ.TAG(NOD)) THEN
 103                 ITAGCT = ITAGCT + 1
 104                 IF(ITAGCT.EQ.NTAGPV) THEN
 105                     GOTNODPV = .TRUE.
 106                 ELSE
 107                     N = N+1
 108                 ENDIF
 109             ELSE
 110                 N = N+1
 111             ENDIF
 112         ENDDO
 113         IF (.NOT.GOTNODPV) RETURN
 114
 115 C       Starting from TAGPV, search nearby for the
 116 C       +/-(NTAGNB)th occurrence of TAGNB.
 117
 118         CALL PARSTR(TAGNB,TGS,MAXTG,NTG,' ',.TRUE.)
 119         IF (NTG.NE.1) RETURN
 120
 121         ISTEP = ISIGN(1,NTAGNB)
 122         ITAGCT = 0
 123         N = N+ISTEP
 124         DO WHILE ((N.GE.1).AND.(N.LE.NVAL(LUN)))
 125             NOD = INV(N,LUN)
 126             IF(TGS(1).EQ.TAG(NOD)) THEN
 127                 ITAGCT = ITAGCT + 1
 128                 IF(ITAGCT.EQ.IABS(NTAGNB)) THEN
 129                     GETVALNB = VAL(N,LUN)
 130                     RETURN
 131                 ELSE
 132                     N = N+ISTEP
 133                 ENDIF
 134             ELSE
 135                 N = N+ISTEP
 136             ENDIF
 137         ENDDO
 138
 139         RETURN
 140         END