status.f

Go to the documentation of this file.

C> @file
C> @brief Check whether a file is connected to the NCEPLIBS-bufr software.
C>
C> @author J. Woollen @date 1994-01-06
 
C> Check whether a specified Fortran logical unit
C> number is currently connected to the NCEPLIBS-bufr software.
C>
C> If the unit number is already connected, then the subroutine
C> returns information about the associated file.  Otherwise, it
C> returns the next available file ID that could
C> be used to connect the associated file to the software via a
C> subsequent call to subroutine wtstat().
C>
C> @param[in] LUNIT - integer: Fortran logical unit number for
C> BUFR file.
C> @param[out] LUN  - integer: File ID associated with LUNIT.
C> - 0 = LUNIT is not already connected to the software, <b>and</b>
C> there is no remaining internal space available that could be used
C> to connect it.
C> @param[out] IL - integer: File status:
C> - 0 = LUNIT is not already connected to the software, but LUN
C> contains a file ID that could be used to connect it via a subsequent
C> call to subroutine wtstat().
C> - 1 = LUNIT is already connected to the software for output
C> operations (i.e. writing/encoding BUFR).
C> - -1 = LUNIT is already connected to the software for input
C> operations (i.e. reading/decoding BUFR).
C> @param[out] IM  - integer: Message status, indicating whether
C> there is already a message open within internal arrays for LUNIT.
C> - 0 = No
C> - 1 = Yes
C>
C> @author J. Woollen @date 1994-01-06
      RECURSIVE SUBROUTINE status(LUNIT,LUN,IL,IM)
 
      USE modv_nfiles
      USE modv_im8b
 
      USE moda_stbfr
 
      CHARACTER*128 bort_str, errstr
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunit,my_lunit,1)
         CALL status(my_lunit,lun,il,im)
         CALL x48(lun,lun,1)
         CALL x48(il,il,1)
         CALL x48(im,im,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
      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  -----------------------------------------------------------------
 
      IF ( .NOT. ALLOCATED(iolun) ) THEN
        CALL errwrt('++++++++++++++++++++WARNING++++++++++++++++++++++')
        errstr = 'BUFRLIB: STATUS WAS CALLED WITHOUT HAVING ' //
     .           'PREVIOUSLY CALLED OPENBF'
        CALL errwrt(errstr)
        CALL errwrt('++++++++++++++++++++WARNING++++++++++++++++++++++')
        RETURN
      ENDIF
 
      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