NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
ufbmem.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Connect a new system file to the BUFRLIB software, and read
3 C> the entire file contents into internal arrays.
4 
5 C> This subroutine connects a new system file to the BUFRLIB software
6 C> for input operations, then reads the entire file contents into
7 C> internal arrays so that any of the individual BUFR messages can
8 C> later be accessed from memory, instead of having to read them one
9 C> at a time sequentially from the system file.
10 C>
11 C> <p>Any embedded DX BUFR tables contained within the file are also
12 C> read and processed into separate internal arrays for later use.
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 BUFR
18 C> file
19 C> @param[in] INEW - integer: Processing option
20 C> - 0 = Initialize the internal arrays, then
21 C> read all BUFR messages from LUNIT into
22 C> internal arrays
23 C> - Otherwise, read all BUFR messages from LUNIT
24 C> and append them to the existing messages
25 C> within the internal arrays
26 C> @param[out] IRET - integer: Number of BUFR messages that were
27 C> read from LUNIT and stored into internal arrays
28 C> @param[out] IUNIT - integer: File status
29 C> - 0 = LUNIT was empty, so no messages were read
30 C> - Otherwise, the Fortran logical unit number to
31 C> use for later access to any of the messages
32 C> from the internal arrays
33 C>
34 C> <p>Logical unit number LUNIT must already be associated with an
35 C> actual filename on the local system, typically via a Fortran "OPEN"
36 C> statement.
37 C>
38 C> <p>When INEW = 0, the output value IUNIT will be set equal to the
39 C> input value LUNIT. Otherwise, the output value IUNIT will be set to
40 C> the value of LUNIT that was input when this subroutine was previously
41 C> called with INEW = 0, and the system file connected to LUNIT will be
42 C> closed via an internal call to subroutine closbf() before exiting
43 C> this subroutine. In either case, IUNIT can now be used to access
44 C> all BUFR messages that were read and stored by all previous calls
45 C> to this subroutine.
46 C>
47 C> <b>Program history log:</b>
48 C> - 1994-01-06 J. Woollen -- Original author
49 C> - 1998-07-08 J. Woollen -- Replaced call to Cray library routine ABORT
50 C> with call to new internal routine bort()
51 C> - 1999-11-18 J. Woollen -- Increased MAXMEM from 4 Mb to 8 Mb
52 C> - 2000-09-19 J. Woollen -- Maximum message length increased
53 C> from 10,000 to 20,000 bytes
54 C> - 2001-08-15 D. Keyser -- Increased MAXMEM from 8 Mb to 16 Mb
55 C> - 2003-11-04 S. Bender -- Added remarks and routine interdependencies
56 C> - 2003-11-04 D. Keyser -- Unified/portable for WRF; added history
57 C> documentation; outputs more complete
58 C> diagnostic info when routine terminates
59 C> abnormally; increased MAXMSG from 50000
60 C> to 200000
61 C> - 2004-08-09 J. Ator -- Maximum message length increased
62 C> from 20,000 to 50,000 bytes
63 C> - 2004-11-15 D. Keyser -- Don't abort when there are either MAXMSG
64 C> or MAXMEM is exceeded; instead, just
65 C> store up to MAXMSG messages or MAXMEM
66 C> bytes and print a diagnostic
67 C> - 2005-11-29 J. Ator -- Use rdmsgw() and nmwrd()
68 C> - 2009-03-23 J. Ator -- Modified to handle embedded DX tables
69 C> - 2012-09-15 J. Woollen -- Modified for C/I/O/BUFR interface;
70 C> call status() to get LUN; replace Fortran
71 C> REWIND and BACKSPACE with C routines
72 C> cewind() and backbufr()
73 C> - 2014-12-10 J. Ator -- Use modules instead of COMMON blocks
74 C> - 2015-09-24 D. Stokes -- Fix missing declaration of COMMON /QUIET/
75 C>
76  SUBROUTINE ufbmem(LUNIT,INEW,IRET,IUNIT)
77 
78  USE moda_mgwa
79  USE moda_msgmem
80 
81  COMMON /quiet / iprt
82 
83  CHARACTER*128 bort_str,errstr
84 
85 C-----------------------------------------------------------------------
86 C-----------------------------------------------------------------------
87 
88 C TRY TO OPEN BUFR FILE AND SET TO INITIALIZE OR CONCATENATE
89 C ----------------------------------------------------------
90 
91  CALL openbf(lunit,'IN',lunit)
92 
93  IF(inew.EQ.0) THEN
94  msgp(0) = 0
95  munit = 0
96  mlast = 0
97  ndxts = 0
98  ldxts = 0
99  ndxm = 0
100  ldxm = 0
101  ENDIF
102 
103  nmsg = msgp(0)
104  iret = 0
105  iflg = 0
106  itim = 0
107 
108 C Copy any BUFR dictionary table messages from the beginning of
109 C LUNIT into MODULE MSGMEM for possible later use. Note that
110 C such a table (if one exists) is already now in scope due to the
111 C prior call to subroutine OPENBF, which in turn would have
112 C automatically called subroutines READDX, RDBFDX and MAKESTAB
113 C for this table.
114 
115  itemp = ndxts
116  CALL status(lunit,lun,il,im)
117  CALL cewind(lun)
118  CALL cpdxmm(lunit)
119 
120 C If a table was indeed present at the beginning of the file,
121 C then set the flag to indicate that this table is now in scope.
122 
123  IF ((itemp+1).EQ.ndxts) ldxts = ndxts
124 
125 C TRANSFER MESSAGES FROM FILE TO MEMORY - SET MESSAGE POINTERS
126 C ------------------------------------------------------------
127 
128 1 CALL rdmsgw(lunit,mgwa,ier)
129  IF(ier.EQ.-1) goto 100
130  IF(ier.EQ.-2) goto 900
131 
132  IF(idxmsg(mgwa).EQ.1) THEN
133 
134 C New "embedded" BUFR dictionary table messages have been found in
135 C this file. Copy them into MODULE MSGMEM for later use.
136 
137  CALL backbufr(lun) !BACKSPACE LUNIT
138  CALL cpdxmm(lunit)
139  goto 1
140  ENDIF
141 
142  nmsg = nmsg+1
143  IF(nmsg .GT.maxmsg) iflg = 1
144  lmem = nmwrd(mgwa)
145  IF(lmem+mlast.GT.maxmem) iflg = 2
146 
147  IF(iflg.EQ.0) THEN
148  iret = iret+1
149  DO i=1,lmem
150  msgs(mlast+i) = mgwa(i)
151  ENDDO
152  msgp(0) = nmsg
153  msgp(nmsg) = mlast+1
154  ELSE
155  IF(itim.EQ.0) THEN
156  mlast0 = mlast
157  itim=1
158  ENDIF
159  ENDIF
160  mlast = mlast+lmem
161  goto 1
162 
163 C EXITS
164 C -----
165 
166 100 IF(iflg.EQ.1) THEN
167 
168 C EMERGENCY ROOM TREATMENT FOR MAXMSG ARRAY OVERFLOW
169 C --------------------------------------------------
170 
171  IF(iprt.GE.0) THEN
172  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
173  WRITE ( unit=errstr, fmt='(A,A,I8,A)' )
174  . 'BUFRLIB: UFBMEM - THE NO. OF MESSAGES REQUIRED TO STORE ',
175  . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', maxmsg,
176  . ') - INCOMPLETE READ'
177  CALL errwrt(errstr)
178  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
179  . '>>>UFBMEM STORED ', msgp(0), ' MESSAGES OUT OF ', nmsg, '<<<'
180  CALL errwrt(errstr)
181  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
182  . '>>>UFBMEM STORED ', mlast0, ' BYTES OUT OF ', mlast, '<<<'
183  CALL errwrt(errstr)
184  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
185  CALL errwrt(' ')
186  ENDIF
187  mlast=mlast0
188  ENDIF
189 
190  IF(iflg.EQ.2) THEN
191 
192 C EMERGENCY ROOM TREATMENT FOR MAXMEM ARRAY OVERFLOW
193 C --------------------------------------------------
194 
195  IF(iprt.GE.0) THEN
196  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
197  WRITE ( unit=errstr, fmt='(A,A,I8,A)' )
198  . 'BUFRLIB: UFBMEM - THE NO. OF BYTES REQUIRED TO STORE ',
199  . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', maxmem,
200  . ') - INCOMPLETE READ'
201  CALL errwrt(errstr)
202  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
203  . '>>>UFBMEM STORED ', mlast0, ' BYTES OUT OF ', mlast, '<<<'
204  CALL errwrt(errstr)
205  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
206  . '>>>UFBMEM STORED ', msgp(0), ' MESSAGES OUT OF ', nmsg, '<<<'
207  CALL errwrt(errstr)
208  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
209  CALL errwrt(' ')
210  ENDIF
211  mlast=mlast0
212  ENDIF
213 
214  IF(iret.EQ.0) THEN
215  CALL closbf(lunit)
216  ELSE
217  IF(munit.NE.0) CALL closbf(lunit)
218  IF(munit.EQ.0) munit = lunit
219  ENDIF
220  iunit = munit
221 
222 C EXITS
223 C -----
224 
225  RETURN
226 900 WRITE(bort_str,'("BUFRLIB: UFBMEM - ERROR READING MESSAGE '//
227  . 'NUMBER",I5," INTO MEMORY FROM UNIT",I3)') nmsg+1,lunit
228  CALL bort(bort_str)
229  END
function nmwrd(MBAY)
GIVEN AN INTEGER ARRAY CONTAINING SECTION ZERO FROM A BUFR MESSAGE, THIS FUNCTION DETERMINES A COUNT ...
Definition: nmwrd.f:27
void backbufr(f77int *nfile)
This subroutine backspaces a BUFR file by one BUFR message.
Definition: cread.c:76
subroutine closbf(LUNIT)
This subroutine closes the connection between logical unit LUNIT and the BUFRLIB software.
Definition: closbf.F:36
subroutine cpdxmm(LUNIT)
This subroutine reads an entire DX BUFR table from a specified file into internal arrays...
Definition: cpdxmm.f:19
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.F:157
subroutine ufbmem(LUNIT, INEW, IRET, IUNIT)
This subroutine connects a new system file to the BUFRLIB software for input operations, then reads the entire file contents into internal arrays so that any of the individual BUFR messages can later be accessed from memory, instead of having to read them one at a time sequentially from the system file.
Definition: ufbmem.f:76
subroutine rdmsgw(LUNIT, MESG, IRET)
THIS SUBROUTINE READS THE NEXT BUFR MESSAGE FROM LOGICAL UNIT LUNIT AS AN ARRAY OF INTEGER WORDS...
Definition: rdmsgw.f:37
This module contains array and variable declarations used to store the contents of one or more BUFR f...
Definition: moda_msgmem.F:14
function idxmsg(MESG)
THIS FUNCTION DETERMINES WHETHER THE GIVEN BUFR MESSAGE IS A DX DICTIONARY MESSAGE THAT WAS CREATED B...
Definition: idxmsg.f:29
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
Definition: status.f:61
void cewind(f77int *nfile)
This subroutine rewinds a BUFR file back to its beginning.
Definition: cread.c:90
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:39
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23