rewnbf.f

Go to the documentation of this file.

C> @file
C> @brief Store or restore parameters associated with a BUFR file.
C>
C> @author Woollen @date 2003-11-04
 
C> This subroutine, depending on the value of ISR, will
C> either:
C> - store the current parameters associated with a BUFR file
C> connected to LUNIT (read/write pointers, etc.), set the file status
C> to read, then rewind the BUFR file and position it such that the
C> next BUFR message read will be the first message in the file
C> containing actual subsets with data; or
C> - restore the BUFR file connected to LUNIT to the parameters
C> it had prior to the previous call, and using the information that
C> was saved previously
C>
C> This allows information to be extracted from a particular subset in
C> a BUFR file which is in the midst of being read from or written to
C> by an application program.  Note that, for any given BUFR file, a call
C> to this subroutine with ISR = 0 must precede a call to this same
C> subroutine with ISR = 1.  An application program might first
C> call this subroutine with ISR = 0, then call either BUFR archive
C> library subroutine rdmgsb() or ufbinx() to get info from a subset, then
C> call this routine again with ISR = 1 to restore the pointers in the
C> BUFR file to their original location.  For example, this subroutine is
C> called internally by BUFR archive library subroutine ufbtab() whenever
C> the BUFR file it is acting upon is already open for input or output.
C>
C> @param[in] LUNIT - integer: fortran logical unit number for BUFR file.
C> @param[in] ISR - integer: switch:
C> - 0 store current parameters associated with BUFR file, set file status to read, and rewind
C> file such that next message read is first message containing subset data
C> - 1 restore BUFR file with parameters saved from the previous call to this routine with
C> ISR = 0
C>
C> @author Woollen @date 2003-11-04
      SUBROUTINE rewnbf(LUNIT,ISR)
 
      use bufrlib
 
      USE moda_msgcwd
      USE moda_bitbuf
      USE moda_bufrsr
 
      CHARACTER*128 BORT_STR
 
      CHARACTER*8   SUBSET
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  TRY TO TRAP BAD CALL PROBLEMS
C  -----------------------------
 
      IF(isr.EQ.0) THEN
         CALL status(lunit,lun,il,im)
         IF(jsr(lun).NE.0)  GOTO 900
         IF(il.EQ.0) GOTO 901
      ELSEIF(isr.EQ.1) THEN
         lun = junn
         IF(jsr(junn).NE.1)  GOTO 902
      ELSE
         GOTO 903
      ENDIF
 
C  STORE FILE PARAMETERS AND SET FOR READING
C  -----------------------------------------
 
      IF(isr.EQ.0) THEN
         junn = lun
         jill = il
         jimm = im
         jbit = ibit
         jbyt = mbyt(lun)
         jmsg = nmsg(lun)
         jsub = nsub(lun)
         ksub = msub(lun)
         jnod = inode(lun)
         jdat = idate(lun)
         DO i=1,jbyt
         jbay(i) = mbay(i,lun)
         ENDDO
         CALL wtstat(lunit,lun,-1,0)
      ENDIF
 
C  REWIND THE FILE
C  ---------------
 
      CALL cewind_c(lun)
 
C  RESTORE FILE PARAMETERS AND POSITION IT TO WHERE IT WAS SAVED
C  -------------------------------------------------------------
 
      IF(isr.EQ.1) THEN
         lun        = junn
         il         = jill
         im         = jimm
         ibit       = jbit
         mbyt(lun)  = jbyt
         nmsg(lun)  = jmsg
         nsub(lun)  = jsub
         msub(lun)  = ksub
         inode(lun) = jnod
         idate(lun) = i4dy(jdat)
         DO i=1,jbyt
           mbay(i,lun) = jbay(i)
         ENDDO
         DO imsg=1,jmsg
           CALL readmg(lunit,subset,kdate,ier)
           IF(ier.LT.0) GOTO 905
         ENDDO
         CALL wtstat(lunit,lun,il,im)
      ENDIF
 
      jsr(lun) = mod(jsr(lun)+1,2)
 
C  EXITS
C  -----
 
      RETURN
900   WRITE(bort_str,'("BUFRLIB: REWNBF - ATTEMPING TO SAVE '//
     . 'PARAMETERS FOR FILE FOR WHICH THEY HAVE ALREADY BEEN SAVED '//
     . '(AND NOT YET RESTORED) (UNIT",I3,")")') lunit
      CALL bort(bort_str)
901   WRITE(bort_str,'("BUFRLIB: REWNBF - ATTEMPING TO SAVE '//
     . 'PARAMETERS FOR BUFR FILE WHICH IS NOT OPENED FOR EITHER INPUT'//
     . ' OR OUTPUT) (UNIT",I3,")")') lunit
      CALL bort(bort_str)
902   WRITE(bort_str,'("BUFRLIB: REWNBF - ATTEMPING TO RESTORE '//
     . 'PARAMETERS TO BUFR FILE WHICH WERE NEVER SAVED (UNIT",I3,")")')
     . lunit
      CALL bort(bort_str)
903   WRITE(bort_str,'("BUFRLIB: REWNBF - SAVE/RESTORE SWITCH (INPUT '//
     . 'ARGUMENT ISR) IS NOT ZERO OR ONE (HERE =",I4,") (UNIT",I3,")")')
     . isr,lunit
      CALL bort(bort_str)
905   WRITE(bort_str,'("BUFRLIB: REWNBF - HIT END OF FILE BEFORE '//
     . 'REPOSITIONING BUFR FILE IN UNIT",I3," TO ORIGINAL MESSAGE '//
     . 'NO.",I5)') lunit,jmsg
      CALL bort(bort_str)
      END