NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
ufbmex.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>This subroutine is similar to subroutine ufbmem(), except that
12 C> after reading in all of the messages, it then sorts them according
13 C> to their message types and returns a corresponding list of these
14 C> types. Furthermore, it does not process any embedded DX BUFR
15 C> tables contained within the system file, since these tables are no
16 C> longer relevant once the messages have been sorted and re-ordered
17 C> from their original positions in the file. Instead, this
18 C> subroutine provides an additional call argument LUNDX to allow
19 C> for specification of the necessary DX BUFR table information
20 C> associated with the messages in the file.
21 C>
22 C> @author J. Woollen
23 C> @date 2012-01-26
24 C>
25 C> @param[in] LUNIT -- integer: Fortran logical unit number for BUFR
26 C> file
27 C> @param[in] LUNDX -- integer: Fortran logical unit number
28 C> containing DX BUFR table information
29 C> associated with BUFR messages in LUNIT
30 C> @param[in] INEW -- integer: Processing option
31 C> - 0 = Initialize the internal arrays, then
32 C> read all BUFR messages from LUNIT into
33 C> internal arrays
34 C> - Otherwise, read all BUFR messages from LUNIT
35 C> and append them to the existing messages
36 C> within the internal arrays
37 C> @param[out] IRET -- integer: Number of BUFR messages that were
38 C> read from LUNIT and stored into internal arrays
39 C> @param[out] MESG -- integer(*): Types of BUFR messages that were
40 C> read from LUNIT and stored into internal arrays
41 C>
42 C> <p>Logical unit numbers LUNIT and LUNDX must already be associated
43 C> with actual filenames on the local system, typically via a Fortran
44 C> "OPEN" statement.
45 C>
46 C> <b>Program history log:</b>
47 C> | Date | Programmer | Comments |
48 C> | -----|------------|----------|
49 C> | 2012-01-26 | J. Woollen | Original author |
50 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
51 C> | 2015-09-24 | D. Stokes | Fix missing declaration of COMMON /QUIET/ |
52 C>
53  SUBROUTINE ufbmex(LUNIT,LUNDX,INEW,IRET,MESG)
54 
55  USE moda_mgwa
56  USE moda_msgmem
57 
58  COMMON /quiet / iprt
59 
60  CHARACTER*128 bort_str,errstr
61 
62  INTEGER mesg(*)
63 
64 C-----------------------------------------------------------------------
65 C-----------------------------------------------------------------------
66 
67 C TRY TO OPEN BUFR FILE AND SET TO INITIALIZE OR CONCATENATE
68 C ----------------------------------------------------------
69 
70  CALL openbf(lunit,'IN',lundx)
71 
72  IF(inew.EQ.0) THEN
73  msgp(0) = 0
74  munit = 0
75  mlast = 0
76  ndxts = 0
77  ldxts = 0
78  ndxm = 0
79  ldxm = 0
80  ENDIF
81 
82  nmsg = msgp(0)
83  iret = 0
84  iflg = 0
85  itim = 0
86 
87 C SET SOME FLAGS SO THAT SUBSEQUENT CALLS TO THE MESSAGE READING
88 C ROUTINES WILL KNOW THERE IS A BUFR TABLE IN SCOPE.
89 
90  ndxts = 1
91  ldxts = 1
92  ipmsgs(1) = 1
93 
94 C TRANSFER MESSAGES FROM FILE TO MEMORY - SET MESSAGE POINTERS
95 C ------------------------------------------------------------
96 
97 1 CALL rdmsgw(lunit,mgwa,ier)
98  IF(ier.EQ.-1) goto 100
99  IF(ier.EQ.-2) goto 900
100 
101  nmsg = nmsg+1
102  mesg(nmsg) = iupbs01(mgwa,'MTYP')
103  IF(nmsg .GT.maxmsg) iflg = 1
104  lmem = nmwrd(mgwa)
105  IF(lmem+mlast.GT.maxmem) iflg = 2
106 
107  IF(iflg.EQ.0) THEN
108  iret = iret+1
109  DO i=1,lmem
110  msgs(mlast+i) = mgwa(i)
111  ENDDO
112  msgp(0) = nmsg
113  msgp(nmsg) = mlast+1
114  ELSE
115  IF(itim.EQ.0) THEN
116  mlast0 = mlast
117  itim=1
118  ENDIF
119  ENDIF
120  mlast = mlast+lmem
121  goto 1
122 
123 C EXITS
124 C -----
125 
126 100 IF(iflg.EQ.1) THEN
127 
128 C EMERGENCY ROOM TREATMENT FOR MAXMSG ARRAY OVERFLOW
129 C --------------------------------------------------
130 
131  IF(iprt.GE.0) THEN
132  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
133  WRITE ( unit=errstr, fmt='(A,A,I8,A)' )
134  . 'BUFRLIB: UFBMEX - THE NO. OF MESSAGES REQUIRED TO STORE ',
135  . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', maxmsg,
136  . ') - INCOMPLETE READ'
137  CALL errwrt(errstr)
138  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
139  . '>>>UFBMEX STORED ', msgp(0), ' MESSAGES OUT OF ', nmsg, '<<<'
140  CALL errwrt(errstr)
141  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
142  . '>>>UFBMEX STORED ', mlast0, ' BYTES OUT OF ', mlast, '<<<'
143  CALL errwrt(errstr)
144  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
145  CALL errwrt(' ')
146  ENDIF
147  mlast=mlast0
148  ENDIF
149 
150  IF(iflg.EQ.2) THEN
151 
152 C EMERGENCY ROOM TREATMENT FOR MAXMEM ARRAY OVERFLOW
153 C --------------------------------------------------
154 
155  IF(iprt.GE.0) THEN
156  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
157  WRITE ( unit=errstr, fmt='(A,A,I8,A)' )
158  . 'BUFRLIB: UFBMEX - THE NO. OF BYTES REQUIRED TO STORE ',
159  . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', maxmem,
160  . ') - INCOMPLETE READ'
161  CALL errwrt(errstr)
162  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
163  . '>>>UFBMEX STORED ', mlast0, ' BYTES OUT OF ', mlast, '<<<'
164  CALL errwrt(errstr)
165  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
166  . '>>>UFBMEX STORED ', msgp(0), ' MESSAGES OUT OF ', nmsg, '<<<'
167  CALL errwrt(errstr)
168  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
169  CALL errwrt(' ')
170  ENDIF
171  mlast=mlast0
172  ENDIF
173 
174  IF(iret.EQ.0) THEN
175  CALL closbf(lunit)
176  ELSE
177  IF(munit.NE.0) CALL closbf(lunit)
178  IF(munit.EQ.0) munit = lunit
179  ENDIF
180  iunit = munit
181 
182 C EXITS
183 C -----
184 
185  RETURN
186 900 WRITE(bort_str,'("BUFRLIB: UFBMEX - ERROR READING MESSAGE '//
187  . 'NUMBER",I5," INTO MEMORY FROM UNIT",I3)') nmsg+1,lunit
188  CALL bort(bort_str)
189  END
subroutine ufbmex(LUNIT, LUNDX, INEW, IRET, MESG)
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: ufbmex.f:53
function nmwrd(MBAY)
GIVEN AN INTEGER ARRAY CONTAINING SECTION ZERO FROM A BUFR MESSAGE, THIS FUNCTION DETERMINES A COUNT ...
Definition: nmwrd.f:27
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
subroutine closbf(LUNIT)
This subroutine closes the connection between logical unit LUNIT and the BUFRLIB software.
Definition: closbf.f:34
This module contains array and variable declarations used to store the contents of one or more BUFR f...
Definition: moda_msgmem.F:14
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:138
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:41
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
function iupbs01(MBAY, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
Definition: iupbs01.f:73