status.f

Go to the documentation of this file.

C> @file
C> @brief Check whether a system file is connected to the BUFRLIB
C> software.
 
C> This subroutine checks whether a specified Fortran logical unit
C> number is currently connected to the BUFRLIB software.
C>
C> <p>If the unit number is already connected, then the subroutine
C> returns information about the associated file.  Otherwise, it
C> returns the next available internal I/O stream index that could
C> be used to connect the associated file to the software via a
C> subsequent call to subroutine wtstat().
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[out]  LUN    -- integer: Internal I/O stream index associated
C>                        with LUNIT
C>                        - 0 = LUNIT is not already connected to the
C>                              software, <b>and</b> there is no
C>                              remaining internal space available
C>                              that could be used to connect it
C> @param[out]  IL     -- integer: File status
C>                        - 0 = LUNIT is not already connected to the
C>                              software, but LUN contains a new
C>                              internal I/O stream index that could
C>                              be used to connect it via a subsequent
C>                              call to subroutine wtstat()
C>                        - 1 = LUNIT is already connected to the
C>                              software for output operations
C>                              (i.e. writing/encoding BUFR)
C>                        - -1 = LUNIT is already connected to the
C>                               software for input operations
C>                               (i.e. reading/decoding BUFR)
C> @param[out]  IM     -- integer: Message status, indicating whether
C>                        there is already a message open within
C>                        internal arrays for LUNIT
C>                        - 0 = No
C>                        - 1 = Yes
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 1994-01-06 | J. Woollen | Original author |
C> | 1996-12-11 | J. Woollen | Fixed a long standing bug which occurs in unusual situations, very low impact |
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    | 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 status(LUNIT,LUN,IL,IM)
 
      USE modv_nfiles
 
      USE moda_stbfr
 
      CHARACTER*128 BORT_STR
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
      IF(lunit.LE.0 .OR. lunit.GT.99) GOTO 900
 
C  CLEAR THE STATUS INDICATORS
C  ---------------------------
 
      lun = 0
      il  = 0
      im  = 0
 
C  SEE IF UNIT IS ALREADY CONNECTED TO BUFR ARCHIVE LIBRARY SOFTWARE
C  -----------------------------------------------------------------
 
      DO i=1,nfiles
      IF(abs(iolun(i)).EQ.lunit) lun = i
      ENDDO
 
C  IF NOT, TRY TO DEFINE IT SO AS TO CONNECT IT TO BUFR ARCHIVE LIBRARY
C  SOFTWARE
C  --------------------------------------------------------------------
 
      IF(lun.EQ.0) THEN
         DO i=1,nfiles
         IF(iolun(i).EQ.0) THEN
 
C  File space is available, return with LUN > 0, IL and IM remain 0
C  ----------------------------------------------------------------
 
            lun = i
            GOTO 100
         ENDIF
         ENDDO
 
C  File space is NOT available, return with LUN, IL and IM all 0
C  -------------------------------------------------------------
 
         GOTO 100
      ENDIF
 
C  IF THE UNIT WAS ALREADY CONNECTED TO THE BUFR ARCHIVE LIBRARY
C   SOFTWARE PRIOR TO THIS CALL, RETURN STATUSES
C  -------------------------------------------------------------
 
      il = sign(1,iolun(lun))
      im = iomsg(lun)
 
C  EXITS
C  ----
 
100   RETURN
900   WRITE(bort_str,'("BUFRLIB: STATUS - INPUT UNIT NUMBER (",I3,") '//
     . 'OUTSIDE LEGAL RANGE OF 1-99")') lunit
      CALL bort(bort_str)
      END