ufbrp.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 1994-01-06
 
C> This subroutine writes or reads specified data 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 ufbrep()
C> which will internally call this subroutine.
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 1994-01-06
      SUBROUTINE ufbrp(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  FIND FIRST NON-ZERO NODE IN STRING
C  ----------------------------------
 
      DO nz=1,nnod
      IF(nods(nz).GT.0) GOTO 1
      ENDDO
      GOTO 100
 
C  FRAME A SECTION OF THE BUFFER - RETURN WHEN NO FRAME
C  ----------------------------------------------------
 
1     IF(ins1+1.GT.nval(lun)) GOTO 100
      IF(io.EQ.1 .AND. iret.EQ.i2) GOTO 100
      ins1 = invtag(nods(nz),lun,ins1+1,nval(lun))
      IF(ins1.EQ.0) GOTO 100
 
      ins2 = invtag(nods(nz),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
         DO i=1,nnod
         IF(nods(i).GT.0) THEN
            invn = invtag(nods(i),lun,ins1,ins2)
            IF(invn.GT.0) usr(i,iret) = val(invn,lun)
         ENDIF
         ENDDO
      ENDIF
 
C  WRITE USER VALUES
C  -----------------
 
      IF(io.EQ.1 .AND. iret.LE.i2) THEN
         DO i=1,nnod
         IF(nods(i).GT.0) THEN
            invn = invtag(nods(i),lun,ins1,ins2)
            IF(invn.GT.0) val(invn,lun) = usr(i,iret)
         ENDIF
         ENDDO
      ENDIF
 
C  GO FOR NEXT FRAME
C  -----------------
 
      GOTO 1
 
C  EXIT
C  ----
 
100   RETURN
      END