var/external/bufr/nevn.f

   1       FUNCTION NEVN(NODE,LUN,INV1,INV2,I1,I2,I3,USR)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    NEVN
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2003-11-04
   7 C
   8 C ABSTRACT: THIS FUNCTION LOOKS FOR ALL STACKED DATA EVENTS FOR A
   9 C   SPECIFIED DATA VALUE AND LEVEL WITHIN THE PORTION OF THE CURRENT
  10 C   SUBSET BUFFER BOUNDED BY THE INDICES INV1 AND INV2.  ALL SUCH
  11 C   EVENTS ARE ACCUMULATED AND RETURNED TO THE CALLING PROGRAM WITHIN
  12 C   ARRAY USR.  THE VALUE OF THE FUNCTION ITSELF IS THE TOTAL NUMBER
  13 C   OF EVENTS FOUND.
  14 C
  15 C PROGRAM HISTORY LOG:
  16 C 2003-11-04  J. WOOLLEN -- ORIGINAL AUTHOR (WAS IN VERIFICATION
  17 C                           VERSION)
  18 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  19 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  20 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  21 C                           TERMINATES ABNORMALLY
  22 C 2009-03-31  J. WOOLLEN -- ADDED ADDITIONAL DOCUMENTATION
  23 C
  24 C USAGE:    NEVN (NODE, LUN, INV1, INV2, I1, I2, I3, USR)
  25 C   INPUT ARGUMENT LIST:
  26 C     NODE     - INTEGER: JUMP/LINK TABLE INDEX OF NODE TO RETURN
  27 C                STACKED VALUES FOR
  28 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  29 C     INV1     - INTEGER: STARTING INDEX OF THE PORTION OF THE SUBSET
  30 C                BUFFER IN WHICH TO LOOK FOR STACK VALUES
  31 C     INV2     - INTEGER: ENDING INDEX OF THE PORTION OF THE SUBSET
  32 C                BUFFER IN WHICH TO LOOK FOR STACK VALUES
  33 C     I1       - INTEGER: LENGTH OF FIRST DIMENSION OF USR
  34 C     I2       - INTEGER: LENGTH OF SECOND DIMENSION OF USR
  35 C     I3       - INTEGER: LENGTH OF THIRD DIMENSION OF USR
  36 C
  37 C   OUTPUT ARGUMENT LIST:
  38 C     USR      - REAL*8:(I1,I2,I3) STARTING ADDRESS OF DATA VALUES READ
  39 C                FROM DATA SUBSET, EVENTS ARE RETURNED IN THE THIRD
  40 C                DIMENSION FOR A PARTICULAR DATA VALUE AND LEVEL IN THE
  41 C                FIRST AND SECOND DIMENSIONS
  42 C     NEVN     - INTEGER: NUMBER OF EVENTS IN STACK (MUST BE LESS THAN
  43 C                OR EQUAL TO I3)
  44 C
  45 C REMARKS:
  46 C    IMPORTANT: THIS ROUTINE SHOULD ONLY BE CALLED BY ROUTINE UFBIN3,
  47 C               WHICH, ITSELF, IS CALLED ONLY BY VERIFICATION
  48 C               APPLICATION PROGRAM GRIDTOBS, WHERE IT WAS PREVIOUSLY
  49 C               AN IN-LINE SUBROUTINE.  IN GENERAL, NEVN DOES NOT WORK
  50 C               PROPERLY IN OTHER APPLICATION PROGRAMS AT THIS TIME.
  51 C
  52 C    THIS ROUTINE CALLS:        BORT     INVWIN   LSTJPB
  53 C    THIS ROUTINE IS CALLED BY: UFBIN3
  54 C                               Should NOT be called by any
  55 C                               application programs!!!
  56 C
  57 C ATTRIBUTES:
  58 C   LANGUAGE: FORTRAN 77
  59 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  60 C
  61 C$$$
  62
  63       INCLUDE 'bufrlib.prm'
  64
  65       COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
  66
  67       CHARACTER*128 BORT_STR
  68       DIMENSION     USR(I1,I2,I3)
  69       REAL*8        VAL,USR
  70
  71 C----------------------------------------------------------------------
  72 C----------------------------------------------------------------------
  73
  74       NEVN = 0
  75
  76 C  FIND THE ENCLOSING EVENT STACK DESCRIPTOR
  77 C  -----------------------------------------
  78
  79       NDRS = LSTJPB(NODE,LUN,'DRS')
  80       IF(NDRS.LE.0) GOTO 100
  81
  82       INVN = INVWIN(NDRS,LUN,INV1,INV2)
  83       IF(INVN.EQ.0) GOTO 900
  84
  85       NEVN = VAL(INVN,LUN)
  86       IF(NEVN.GT.I3) GOTO 901
  87
  88 C  SEARCH EACH STACK LEVEL FOR THE REQUESTED NODE AND COPY THE VALUE
  89 C  -----------------------------------------------------------------
  90
  91       N2 = INVN + 1
  92
  93       DO L=1,NEVN
  94         N1 = N2
  95         N2 = N2 + VAL(N1,LUN)
  96         DO N=N1,N2
  97         IF(INV(N,LUN).EQ.NODE) USR(1,1,L) = VAL(N,LUN)
  98         ENDDO
  99       ENDDO
 100
 101 C  EXITS
 102 C  -----
 103
 104 100   RETURN
 105 900   CALL BORT('BUFRLIB: NEVN - CAN''T FIND THE EVENT STACK!!!!!!')
 106 901   WRITE(BORT_STR,'("BUFRLIB: NEVN - THE NO. OF EVENTS FOR THE '//
 107      . 'REQUESTED STACK (",I3,") EXCEEDS THE VALUE OF THE 3RD DIM. OF'//
 108      . ' THE USR ARRAY (",I3,")")') NEVN,I3
 109       CALL BORT(BORT_STR)
 110       END