wtstat.f

Go to the documentation of this file.

C> @file
C> @brief Update file status in library internals.
C>
C> @author J. Woollen @date 1994-01-06
 
C> Update file status in library internals.
C>
C> This subroutine can be used to connect or disconnect a specified
C> Fortran logical unit number to/from the BUFRLIB software, and it
C> can also be used to set or reset the internal message status
C> associated with that logical unit number.
C>
C> @note Before this subroutine is called to connect any LUNIT to the
C> software, a previous call should have been made to subroutine
C> status() to confirm that internal space is available to connect
C> the associated file, as well as to obtain an LUN value to use
C> in connecting it. Once a file is connected, the corresponding
C> LUNIT and LUN values remain linked to each other for as
C> long as the file is connected to the software.
C>
C> @param[in] LUNIT - integer: Fortran logical unit number for BUFR file
C> @param[in] LUN - integer: Internal I/O stream index associated with LUNIT
C> @param[in] IL - integer: File status update option
C>  - 0 Disconnect LUNIT from the software
C>  - 1 Connect LUNIT to the software for output operations
C>      (i.e. writing/encoding BUFR), if not already connected
C>  - -1 Connect LUNIT to the software for input operations
C>      (i.e. reading/decoding BUFR), if not already connected
C> @param[in] IM - integer: Message status update option, indicating
C> whether a message is currently open within the internal arrays for LUNIT
C>  - 0 No
C>  - 1 Yes
C>
C> @author J. Woollen @date 1994-01-06
 
      SUBROUTINE wtstat(LUNIT,LUN,IL,IM)
 
      USE moda_stbfr
 
      CHARACTER*128 BORT_STR
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK ON THE ARGUMENTS
C  ----------------------
 
      IF(lunit.LE.0)            GOTO 900
      IF(lun  .LE.0)            GOTO 901
      IF(il.LT.-1 .OR. il.GT.1) GOTO 902
      IF(im.LT. 0 .OR. im.GT.1) GOTO 903
 
C  CHECK ON LUNIT-LUN COMBINATION
C  ------------------------------
 
      IF(abs(iolun(lun)).NE.lunit) THEN
         IF(iolun(lun).NE.0) GOTO 905
      ENDIF
 
C  RESET THE FILE STATUSES
C  -----------------------
 
      IF(il.NE.0) THEN
         iolun(lun) = sign(lunit,il)
         iomsg(lun) = im
      ELSE
         iolun(lun) = 0
         iomsg(lun) = 0
      ENDIF
 
C  EXITS
C  -----
 
      RETURN
900   WRITE(bort_str,'("BUFRLIB: WTSTAT - INVALID UNIT NUMBER PASSED '//
     . ' INTO FIRST ARGUMENT (INPUT) (=",I3,")")') lunit
      CALL bort(bort_str)
901   WRITE(bort_str,'("BUFRLIB: WTSTAT - INVALID I/O STREAM INDEX '//
     . 'PASSED INTO SECOND ARGUMENT (INPUT) (=",I3,")")') lun
      CALL bort(bort_str)
902   WRITE(bort_str,'("BUFRLIB: WTSTAT - INVALID LOGICAL UNIT STATUS'//
     . ' INDICATOR PASSED INTO THIRD ARGUMENT (INPUT) (=",I4,")")') il
      CALL bort(bort_str)
903   WRITE(bort_str,'("BUFRLIB: WTSTAT - INVALID BUFR MESSAGE STATUS'//
     . ' INDICATOR PASSED INTO FOURTH ARGUMENT (INPUT) (=",I4,")")') im
      CALL bort(bort_str)
905   WRITE(bort_str,'("BUFRLIB: WTSTAT - ATTEMPTING TO REDEFINE '//
     . 'EXISTING FILE UNIT (LOGICAL UNIT NUMBER ",I3,")")') iolun(lun)
      CALL bort(bort_str)
      END