NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
wtstat.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Update the status of a system file with respect to the
3 C> BUFRLIB software.
4 
5 C> This subroutine can be used to connect or disconnect a specified
6 C> Fortran logical unit number to/from the BUFRLIB software, and it
7 C> can also be used to set or reset the internal message status
8 C> associated with that logical unit number.
9 C>
10 C> @author J. Woollen
11 C> @date 1994-01-06
12 C>
13 C> @param[in] LUNIT -- integer: Fortran logical unit number for
14 C> BUFR file
15 C> @param[in] LUN -- integer: Internal I/O stream index associated
16 C> with LUNIT
17 C> @param[in] IL -- integer: File status update option
18 C> - 0 = Disconnect LUNIT from the software
19 C> - 1 = Connect LUNIT to the software for
20 C> output operations
21 C> (i.e. writing/encoding BUFR),
22 C> if not already connected
23 C> - -1 = Connect LUNIT to the software for
24 C> input operations
25 C> (i.e. reading/decoding BUFR),
26 C> if not already connected
27 C> @param[in] IM -- integer: Message status update option, to
28 C> indicate whether a message is now open
29 C> within the internal arrays for LUNIT
30 C> - 0 = No
31 C> - 1 = Yes
32 C>
33 C> <p>Before this subroutine is called to connect any LUNIT to the
34 C> software, a previous call should have been made to subroutine
35 C> status() to confirm that internal space is available to connect
36 C> the associated file, as well as to obtain an LUN value to use
37 C> in connecting it. Once a file is connected, the corresponding
38 C> LUNIT and LUN values remain linked to each other for as
39 C> long as the file is connected to the software.
40 C>
41 C> <b>Program history log:</b>
42 C> | Date | Programmer | Comments |
43 C> | -----|------------|----------|
44 C> | 1994-01-06 | J. Woollen | Original author |
45 C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
46 C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to 32 |
47 C> | 2003-11-04 | J. Ator | Corrected a typo in test for IM validity; added documentation |
48 C> | 2003-11-04 | S. Bender | Added remarks and routine interdependencies |
49 C> | 2003-11-04 | D. Keyser | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally |
50 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
51 C>
52  SUBROUTINE wtstat(LUNIT,LUN,IL,IM)
53 
54  USE moda_stbfr
55 
56  CHARACTER*128 bort_str
57 
58 C-----------------------------------------------------------------------
59 C-----------------------------------------------------------------------
60 
61 C CHECK ON THE ARGUMENTS
62 C ----------------------
63 
64  IF(lunit.LE.0) goto 900
65  IF(lun .LE.0) goto 901
66  IF(il.LT.-1 .OR. il.GT.1) goto 902
67  IF(im.LT. 0 .OR. im.GT.1) goto 903
68 
69 C CHECK ON LUNIT-LUN COMBINATION
70 C ------------------------------
71 
72  IF(abs(iolun(lun)).NE.lunit) THEN
73  IF(iolun(lun).NE.0) goto 905
74  ENDIF
75 
76 C RESET THE FILE STATUSES
77 C -----------------------
78 
79  IF(il.NE.0) THEN
80  iolun(lun) = sign(lunit,il)
81  iomsg(lun) = im
82  ELSE
83  iolun(lun) = 0
84  iomsg(lun) = 0
85  ENDIF
86 
87 C EXITS
88 C -----
89 
90  RETURN
91 900 WRITE(bort_str,'("BUFRLIB: WTSTAT - INVALID UNIT NUMBER PASSED '//
92  . ' INTO FIRST ARGUMENT (INPUT) (=",I3,")")') lunit
93  CALL bort(bort_str)
94 901 WRITE(bort_str,'("BUFRLIB: WTSTAT - INVALID I/O STREAM INDEX '//
95  . 'PASSED INTO SECOND ARGUMENT (INPUT) (=",I3,")")') lun
96  CALL bort(bort_str)
97 902 WRITE(bort_str,'("BUFRLIB: WTSTAT - INVALID LOGICAL UNIT STATUS'//
98  . ' INDICATOR PASSED INTO THIRD ARGUMENT (INPUT) (=",I4,")")') il
99  CALL bort(bort_str)
100 903 WRITE(bort_str,'("BUFRLIB: WTSTAT - INVALID BUFR MESSAGE STATUS'//
101  . ' INDICATOR PASSED INTO FOURTH ARGUMENT (INPUT) (=",I4,")")') im
102  CALL bort(bort_str)
103 905 WRITE(bort_str,'("BUFRLIB: WTSTAT - ATTEMPTING TO REDEFINE '//
104  . 'EXISTING FILE UNIT (LOGICAL UNIT NUMBER ",I3,")")') iolun(lun)
105  CALL bort(bort_str)
106  END
subroutine wtstat(LUNIT, LUN, IL, IM)
This subroutine can be used to connect or disconnect a specified Fortran logical unit number to/from ...
Definition: wtstat.f:52
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22