NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
status.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Check whether a system file is connected to the BUFRLIB
3 C> software.
4 
5 C> This subroutine checks whether a specified Fortran logical unit
6 C> number is currently connected to the BUFRLIB software.
7 C>
8 C> <p>If the unit number is already connected, then the subroutine
9 C> returns information about the associated file. Otherwise, it
10 C> returns the next available internal I/O stream index that could
11 C> be used to connect the associated file to the software via a
12 C> subsequent call to subroutine wtstat().
13 C>
14 C> @author J. Woollen
15 C> @date 1994-01-06
16 C>
17 C> @param[in] LUNIT -- integer: Fortran logical unit number for
18 C> BUFR file
19 C> @param[out] LUN -- integer: Internal I/O stream index associated
20 C> with LUNIT
21 C> - 0 = LUNIT is not already connected to the
22 C> software, <b>and</b> there is no
23 C> remaining internal space available
24 C> that could be used to connect it
25 C> @param[out] IL -- integer: File status
26 C> - 0 = LUNIT is not already connected to the
27 C> software, but LUN contains a new
28 C> internal I/O stream index that could
29 C> be used to connect it via a subsequent
30 C> call to subroutine wtstat()
31 C> - 1 = LUNIT is already connected to the
32 C> software for output operations
33 C> (i.e. writing/encoding BUFR)
34 C> - -1 = LUNIT is already connected to the
35 C> software for input operations
36 C> (i.e. reading/decoding BUFR)
37 C> @param[out] IM -- integer: Message status, indicating whether
38 C> there is already a message open within
39 C> internal arrays for LUNIT
40 C> - 0 = No
41 C> - 1 = Yes
42 C>
43 C> <b>Program history log:</b>
44 C> | Date | Programmer | Comments |
45 C> | -----|------------|----------|
46 C> | 1994-01-06 | J. Woollen | Original author |
47 C> | 1996-12-11 | J. Woollen | Fixed a long standing bug which occurs in unusual situations, very low impact |
48 C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
49 C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to 32 |
50 C> | 2003-11-04 | J. Ator | Added documentation |
51 C> | 2003-11-04 | S. Bender | Added remarks and routine interdependencies |
52 C> | 2003-11-04 | D. Keyser | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally |
53 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
54 C>
55  SUBROUTINE status(LUNIT,LUN,IL,IM)
56 
57  USE moda_stbfr
58 
59  CHARACTER*128 bort_str
60 
61 C-----------------------------------------------------------------------
62 C-----------------------------------------------------------------------
63 
64  IF(lunit.LE.0 .OR. lunit.GT.99) goto 900
65 
66 C CLEAR THE STATUS INDICATORS
67 C ---------------------------
68 
69  lun = 0
70  il = 0
71  im = 0
72 
73 C SEE IF UNIT IS ALREADY CONNECTED TO BUFR ARCHIVE LIBRARY SOFTWARE
74 C -----------------------------------------------------------------
75 
76  DO i=1,nfiles
77  IF(abs(iolun(i)).EQ.lunit) lun = i
78  ENDDO
79 
80 C IF NOT, TRY TO DEFINE IT SO AS TO CONNECT IT TO BUFR ARCHIVE LIBRARY
81 C SOFTWARE
82 C --------------------------------------------------------------------
83 
84  IF(lun.EQ.0) THEN
85  DO i=1,nfiles
86  IF(iolun(i).EQ.0) THEN
87 
88 C File space is available, return with LUN > 0, IL and IM remain 0
89 C ----------------------------------------------------------------
90 
91  lun = i
92  goto 100
93  ENDIF
94  ENDDO
95 
96 C File space is NOT available, return with LUN, IL and IM all 0
97 C -------------------------------------------------------------
98 
99  goto 100
100  ENDIF
101 
102 C IF THE UNIT WAS ALREADY CONNECTED TO THE BUFR ARCHIVE LIBRARY
103 C SOFTWARE PRIOR TO THIS CALL, RETURN STATUSES
104 C -------------------------------------------------------------
105 
106  il = sign(1,iolun(lun))
107  im = iomsg(lun)
108 
109 C EXITS
110 C ----
111 
112 100 RETURN
113 900 WRITE(bort_str,'("BUFRLIB: STATUS - INPUT UNIT NUMBER (",I3,") '//
114  . 'OUTSIDE LEGAL RANGE OF 1-99")') lunit
115  CALL bort(bort_str)
116  END
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
Definition: status.f:55
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22