ufbsp.f

Go to the documentation of this file.

C> @file
C> @brief Read/write one or more data values from/to a data subset.
C>
C> @author J. Woollen @date 1999-11-18
 
C> This subroutine writes or reads specified values to or
C> from the current BUFR data subset within internal arrays, with the
C> direction of the data transfer determined by the context of IO.
C> The data values correspond to internal arrays representing parsed
C> strings of mnemonics which are either part of a fixed (i.e. non-delayed)
C> replication sequence, or for mnememonics which are replicated by being
C> directly listed more than once within an overall subset definition.
C>
C> This subroutine should never be directly called by an application
C> program; instead, an application program should directly call ufbstp()
C> which will internally call this subroutine.
C>
C> This subroutine is similar to subroutine ufbrp(), but it is designed
C> for different use cases.  For a more detailed explanation of how
C> subroutine ufbstp() differs from subroutine ufbrep(), and therefore
C> how this subroutine differs from subroutine ufbrp(), see the
C> discussion in [DX BUFR Tables](@ref ufbsubs).
C>
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C> @param[inout] USR - real*8(*,*): Data 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] IO - integer: status indicator for BUFR file associated
C> with LUN:
C> - 0 input file
C> - 1 output file
C> @param[out] IRET - integer: number of "levels" of data values read
C> from or written to data subset
C>
C> @author J. Woollen @date 1999-11-18
      SUBROUTINE ufbsp(LUN,USR,I1,I2,IO,IRET)
 
      USE moda_usrint
 
      COMMON /usrstr/ nnod,ncon,nods(20),nodc(10),ivls(10),kons(10)
 
      real*8  usr(i1,i2)
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
      iret = 0
      ins1 = 0
      ins2 = 0
 
C  FRAME A SECTION OF THE BUFFER - RETURN WHEN NO FRAME
C  ----------------------------------------------------
 
1     IF(ins1+1.GT.nval(lun)) GOTO 100
      ins1 = invtag(nods(1),lun,ins1+1,nval(lun))
      IF(ins1.EQ.0) GOTO 100
 
      ins2 = invtag(nods(1),lun,ins1+1,nval(lun))
      IF(ins2.EQ.0) ins2 = nval(lun)
      iret = iret+1
 
C  READ USER VALUES
C  ----------------
 
      IF(io.EQ.0 .AND. iret.LE.i2) THEN
         invm = ins1
         DO i=1,nnod
         IF(nods(i).GT.0) THEN
            invn = invtag(nods(i),lun,invm,ins2)
            IF(invn.GT.0) usr(i,iret) = val(invn,lun)
            invm = max(invn,invm)
         ENDIF
         ENDDO
      ENDIF
 
C  WRITE USER VALUES
C  -----------------
 
      IF(io.EQ.1 .AND. iret.LE.i2) THEN
         invm = ins1
         DO i=1,nnod
         IF(nods(i).GT.0) THEN
            invn = invtag(nods(i),lun,invm,ins2)
            IF(invn.GT.0) val(invn,lun) = usr(i,iret)
            invm = max(invn,invm)
         ENDIF
         ENDDO
      ENDIF
 
C  GO FOR NEXT FRAME
C  -----------------
 
      GOTO 1
 
C  EXIT
C  ----
 
100   RETURN
      END