ufbrw.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 values to or from
C> 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 part of a delayed-replication
C> sequence, or for which there is no replication at all.
C>
C> This subroutine should never be directly called by an application
C> program; instead, an application program should directly call ufbint()
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> - -1 none of the mnemonics in the string passed to ufbint() were found
C> in the data subset template
C>
C> @author J. Woollen @date 1994-01-06
      SUBROUTINE ufbrw(LUN,USR,I1,I2,IO,IRET)
 
      USE modv_bmiss
      USE moda_usrint
      USE moda_tables
 
      COMMON /usrstr/ nnod,ncon,nods(20),nodc(10),ivls(10),kons(10)
      COMMON /quiet / iprt
 
      CHARACTER*128 ERRSTR
      real*8       usr(i1,i2)
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
      iret = 0
 
C  LOOP OVER COND WINDOWS
C  ----------------------
 
      inc1 = 1
      inc2 = 1
 
1     CALL conwin(lun,inc1,inc2)
      IF(nnod.EQ.0) THEN
         iret = i2
         GOTO 100
      ELSEIF(inc1.EQ.0) THEN
         GOTO 100
      ELSE
         DO i=1,nnod
         IF(nods(i).GT.0) THEN
            ins2 = inc1
            CALL getwin(nods(i),lun,ins1,ins2)
            IF(ins1.EQ.0) GOTO 100
            GOTO 2
         ENDIF
         ENDDO
         iret = -1
         GOTO 100
      ENDIF
 
C  LOOP OVER STORE NODES
C  ---------------------
 
2     iret = iret+1
 
      IF(iprt.GE.2)  THEN
      CALL errwrt('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
         WRITE ( unit=errstr, fmt='(5(A,I7))' )
     .      'BUFRLIB: UFBRW - IRET:INS1:INS2:INC1:INC2 = ',
     .      iret, ':', ins1, ':', ins2, ':', inc1, ':', inc2
         CALL errwrt(errstr)
         kk = ins1
         DO WHILE ( ( ins2 - kk ) .GE. 5 )
            WRITE ( unit=errstr, fmt='(5A10)' )
     .         (tag(inv(i,lun)),i=kk,kk+4)
            CALL errwrt(errstr)
            kk = kk+5
         ENDDO
         WRITE ( unit=errstr, fmt='(5A10)' )
     .      (tag(inv(i,lun)),i=kk,ins2)
         CALL errwrt(errstr)
      CALL errwrt('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
      CALL errwrt(' ')
      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
            IF(ibfms(usr(i,iret)).EQ.0) THEN
               invn = invwin(nods(i),lun,ins1,ins2)
               IF(invn.EQ.0) THEN
                  CALL drstpl(nods(i),lun,ins1,ins2,invn)
                  IF(invn.EQ.0) THEN
                     iret = 0
                     GOTO 100
                  ENDIF
                  CALL newwin(lun,inc1,inc2)
                  val(invn,lun) = usr(i,iret)
               ELSEIF(lstjpb(nods(i),lun,'RPS').EQ.0) THEN
                  val(invn,lun) = usr(i,iret)
               ELSEIF(ibfms(val(invn,lun)).NE.0) THEN
                  val(invn,lun) = usr(i,iret)
               ELSE
                  CALL drstpl(nods(i),lun,ins1,ins2,invn)
                  IF(invn.EQ.0) THEN
                     iret = 0
                     GOTO 100
                  ENDIF
                  CALL newwin(lun,inc1,inc2)
                  val(invn,lun) = usr(i,iret)
               ENDIF
            ENDIF
         ENDIF
         ENDDO
      ENDIF
 
C  READ USER VALUES
C  ----------------
 
      IF(io.EQ.0 .AND. iret.LE.i2) THEN
         DO i=1,nnod
         usr(i,iret) = bmiss
         IF(nods(i).GT.0) THEN
            invn = invwin(nods(i),lun,ins1,ins2)
            IF(invn.GT.0) usr(i,iret) = val(invn,lun)
         ENDIF
         ENDDO
      ENDIF
 
C  DECIDE WHAT TO DO NEXT
C  ----------------------
 
      IF(io.EQ.1.AND.iret.EQ.i2) GOTO 100
      CALL nxtwin(lun,ins1,ins2)
      IF(ins1.GT.0 .AND. ins1.LT.inc2) GOTO 2
      IF(ncon.GT.0) GOTO 1
 
C  EXIT
C  ----
 
100   RETURN
      END