nevn.f

Go to the documentation of this file.

C> @file
C> @brief Search for stacked data events within a specified portion
C> of the current data subset.
C>
C> @author J. Woollen @date 2003-11-04
 
C> This function looks for all stacked data events for a
C> specified data value and level within the portion of the current
C> subset buffer bounded by the indices INV1 and INV2.  All such
C> events are accumulated and returned to the calling program within
C> array USR.  The value of the function itself is the total number
C> of events found.
C>
C> @param[in] NODE - integer: jump/link table index of node for which
C>                   to return stacked values
C> @param[in] LUN  - integer: I/O stream index into internal memory arrays
C> @param[in] INV1 - integer: Starting index of the portion of the subset
C>                   buffer in which to look for stack values
C> @param[in] INV2 - integer: ending index of the portion of the subset
C>                   buffer in which to look for stack values
C> @param[in] I1   - integer: Length of first dimension of USR
C> @param[in] I2   - integer: Length of second dimension of USR
C> @param[in] I3   - integer: Length of third dimension of USR
C> @param[out] USR - real*8(*,*,*): Starting address of data values read
C>                   from data subset; events are returned in the third
C>                   dimension for a particular data value and level in the
C>                   first and second dimensions
C> @returns NEVN   - integer: Number of events in stack (must be less than
C>                   or equal to I3)
C>
C> @note: This routine should only be called by routine ufbin3(),
C> which itself is called only by verification
C> application program gridtobs, where it was previously
C> an in-line subroutine.  In general, nevn() does not work
C> properly in other application programs at this time.
C>
C> @author J. Woollen @date 2003-11-04
      FUNCTION nevn(NODE,LUN,INV1,INV2,I1,I2,I3,USR)
 
      USE moda_usrint
 
      CHARACTER*128 bort_str
      dimension     usr(i1,i2,i3)
      real*8        usr
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
      nevn = 0
 
C  FIND THE ENCLOSING EVENT STACK DESCRIPTOR
C  -----------------------------------------
 
      ndrs = lstjpb(node,lun,'DRS')
      IF(ndrs.LE.0) GOTO 100
 
      invn = invwin(ndrs,lun,inv1,inv2)
      IF(invn.EQ.0) GOTO 900
 
      nevn = nint(val(invn,lun))
      IF(nevn.GT.i3) GOTO 901
 
C  SEARCH EACH STACK LEVEL FOR THE REQUESTED NODE AND COPY THE VALUE
C  -----------------------------------------------------------------
 
      n2 = invn + 1
 
      DO l=1,nevn
        n1 = n2
        n2 = n2 + nint(val(n1,lun))
        DO n=n1,n2
        IF(inv(n,lun).EQ.node) usr(1,1,l) = val(n,lun)
        ENDDO
      ENDDO
 
C  EXITS
C  -----
 
100   RETURN
900   CALL bort('BUFRLIB: NEVN - CAN''T FIND THE EVENT STACK!!!!!!')
901   WRITE(bort_str,'("BUFRLIB: NEVN - THE NO. OF EVENTS FOR THE '//
     . 'REQUESTED STACK (",I3,") EXCEEDS THE VALUE OF THE 3RD DIM. OF'//
     . ' THE USR ARRAY (",I3,")")') nevn,i3
      CALL bort(bort_str)
      END