wtstat.f

Go to the documentation of this file.

C> @file
C> @brief Update the status of a system file with respect to the
C> BUFRLIB software.

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> @author J. Woollen
C> @date 1994-01-06
C>
C> @param[in]  LUNIT   -- integer: Fortran logical unit number for
C>                        BUFR file
C> @param[in]  LUN     -- integer: Internal I/O stream index associated
C>                        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
C>                              output operations
C>                              (i.e. writing/encoding BUFR),
C>                              if not already connected
C>                        - -1 = Connect LUNIT to the software for
C>                               input operations
C>                               (i.e. reading/decoding BUFR),
C>                               if not already connected
C> @param[in]  IM      -- integer: Message status update option, to
C>                        indicate whether a message is now open
C>                        within the internal arrays for LUNIT
C>                        - 0 = No
C>                        - 1 = Yes
C>
C> <p>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> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 1994-01-06 | J. Woollen | Original author |
C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to 32 |
C> | 2003-11-04 | J. Ator    | Corrected a typo in test for IM validity; added documentation |
C> | 2003-11-04 | S. Bender  | Added remarks and routine interdependencies |
C> | 2003-11-04 | D. Keyser  | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally |
C> | 2014-12-10 | J. Ator    | Use modules instead of COMMON blocks |
C>
      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