var/external/bufr/invcon.f

   1       FUNCTION INVCON(NC,LUN,INV1,INV2)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    INVCON
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS FUNCTION SEARCHES A "WINDOW" (SEE BELOW REMARKS) FOR AN
   9 C   ELEMENT IDENTIFIED IN THE USER STRING AS A CONDITIONAL NODE (I.E. AN
  10 C   ELEMENT WHICH MUST MEET A CONDITION IN ORDER TO BE READ FROM OR WRITTEN TO
  11 C   A DATA SUBSET).  IF A CONDITIONAL ELEMENT IS FOUND AND IT CONFORMS TO THE
  12 C   CONDITION, THEN THE INDEX OF THE ELEMENT WITHIN THE WINDOW IS RETURNED.
  13 C   OTHERWISE A VALUE OF ZERO IS RETURNED.
  14 C
  15 C PROGRAM HISTORY LOG:
  16 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  17 C 1998-07-08  J. WOOLLEN -- IMPROVED MACHINE PORTABILITY
  18 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  19 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  20 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  21 C                           BUFR FILES UNDER THE MPI)
  22 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  23 C                           INTERDEPENDENCIES
  24 C 2003-11-04  D. KEYSER  -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
  25 C                           INCREASED FROM 15000 TO 16000 (WAS IN
  26 C                           VERIFICATION VERSION); UNIFIED/PORTABLE FOR
  27 C                           WRF; ADDED DOCUMENTATION (INCLUDING
  28 C                           HISTORY) (INCOMPLETE);  OUTPUTS MORE
  29 C                           COMPLETE DIAGNOSTIC INFO WHEN UNUSUAL
  30 C                           THINGS HAPPEN
  31 C 2009-04-21  J. ATOR    -- USE ERRWRT
  32 C 2010-04-27  J. WOOLLEN -- ADD DOCUMENTATION
  33 C
  34 C USAGE:    INVCON (NC, LUN, INV1, INV2)
  35 C   INPUT ARGUMENT LIST:
  36 C     NC       - INTEGER: CONDITION CODE:
  37 C                  1 = '=' (EQUAL)
  38 C                  2 = '!' (NOT EQUAL)
  39 C                  3 = '<' (LESS THAN)
  40 C                  4 = '>' (GREATER THAN)
  41 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  42 C     INV1     - INTEGER: FIRST INDEX OF WINDOW TO SEARCH
  43 C     INV2     - INTEGER: LAST INDEX OF WINDOW TO SEARCH
  44 C
  45 C   OUTPUT ARGUMENT LIST:
  46 C     INVCON   - INTEGER: INDEX WITHIN WINDOW OF CONDITIONAL NODE CONFORMING
  47 C                TO SPECIFIED CONDITION
  48 C                  0 = NONE FOUND
  49 C
  50 C REMARKS:
  51 C
  52 C    SEE THE DOCBLOCK IN BUFR ARCHIVE LIBRARY SUBROUTINE GETWIN FOR AN
  53 C    EXPLANATION OF "WINDOWS" WITHIN THE CONTEXT OF A BUFR DATA SUBSET.
  54 C
  55 C    THIS ROUTINE CALLS:        ERRWRT
  56 C    THIS ROUTINE IS CALLED BY: CONWIN
  57 C                               Normally not called by any application
  58 C                               programs.
  59 C
  60 C ATTRIBUTES:
  61 C   LANGUAGE: FORTRAN 77
  62 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  63 C
  64 C$$$
  65
  66       INCLUDE 'bufrlib.prm'
  67
  68       COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
  69       COMMON /USRSTR/ NNOD,NCON,NODS(20),NODC(10),IVLS(10),KONS(10)
  70       COMMON /QUIET / IPRT
  71
  72       REAL*8 VAL
  73
  74 C----------------------------------------------------------------------
  75 C----------------------------------------------------------------------
  76
  77 C  CHECK THE INVENTORY INTERVAL
  78 C  ----------------------------
  79
  80       IF(INV1.LE.0 .OR. INV1.GT.NVAL(LUN)) GOTO 99
  81       IF(INV2.LE.0 .OR. INV2.GT.NVAL(LUN)) GOTO 99
  82
  83 C  FIND AN OCCURANCE OF NODE IN THE WINDOW MEETING THIS CONDITION
  84 C  --------------------------------------------------------------
  85
  86       DO INVCON=INV1,INV2
  87       IF(INV(INVCON,LUN).EQ.NODC(NC)) THEN
  88          IF(KONS(NC).EQ.1 .AND. VAL(INVCON,LUN).EQ.IVLS(NC)) GOTO 100
  89          IF(KONS(NC).EQ.2 .AND. VAL(INVCON,LUN).NE.IVLS(NC)) GOTO 100
  90          IF(KONS(NC).EQ.3 .AND. VAL(INVCON,LUN).LT.IVLS(NC)) GOTO 100
  91          IF(KONS(NC).EQ.4 .AND. VAL(INVCON,LUN).GT.IVLS(NC)) GOTO 100
  92       ENDIF
  93       ENDDO
  94
  95 99    INVCON = 0
  96       IF(IPRT.GE.2) THEN
  97       CALL ERRWRT('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
  98       CALL ERRWRT('BUFRLIB: INVCON - RETURNING WITH A VALUE OF 0')
  99       CALL ERRWRT('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
 100       CALL ERRWRT(' ')
 101       ENDIF
 102
 103 C  EXIT
 104 C  ----
 105
 106 100   RETURN
 107       END