NCEPLIBS-bufr  12.0.0
ufbmem.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Connect a new file to the NCEPLIBS-bufr software,
3 C> and read the entire file contents into internal arrays.
4 C>
5 C> @author J. Woollen @date 1994-01-06
6 
7 C> This subroutine connects a new file to the NCEPLIBS-bufr software
8 C> for input operations, then reads the entire file contents into
9 C> internal arrays so that any of the individual BUFR messages can
10 C> later be accessed from memory, instead of having to read them one
11 C> at a time sequentially from the file.
12 C>
13 C> Any embedded DX BUFR tables contained within the file are also
14 C> read and processed into separate internal arrays for later use.
15 C>
16 C> Logical unit number LUNIT must already be associated with an
17 C> actual filename on the local system, typically via a Fortran "OPEN"
18 C> statement.
19 C>
20 C> When INEW = 0, the output value IUNIT will be set equal to the
21 C> input value LUNIT. Otherwise, the output value IUNIT will be set to
22 C> the value of LUNIT that was input when this subroutine was previously
23 C> called with INEW = 0, and the system file connected to LUNIT will be
24 C> closed via an internal call to subroutine closbf() before exiting
25 C> this subroutine. In either case, IUNIT can now be used to access
26 C> all BUFR messages that were read and stored by all previous calls
27 C> to this subroutine.
28 C>
29 C> @param[in] LUNIT -- integer: Fortran logical unit number for BUFR
30 C> file
31 C> @param[in] INEW -- integer: Processing option
32 C> - 0 = Initialize the internal arrays, then
33 C> read all BUFR messages from LUNIT into
34 C> internal arrays
35 C> - Otherwise, read all BUFR messages from LUNIT
36 C> and append them to the existing messages
37 C> within the internal arrays
38 C> @param[out] IRET -- integer: Number of BUFR messages that were
39 C> read from LUNIT and stored into internal arrays
40 C> @param[out] IUNIT -- integer: File status
41 C> - 0 = LUNIT was empty, so no messages were read
42 C> - Otherwise, the Fortran logical unit number to
43 C> use for later access to any of the messages
44 C> from the internal arrays
45 C>
46 C> @author J. Woollen @date 1994-01-06
47  RECURSIVE SUBROUTINE ufbmem(LUNIT,INEW,IRET,IUNIT)
48 
49  use bufrlib
50 
51  USE modv_maxmem
52  USE modv_maxmsg
53  USE modv_im8b
54 
55  USE moda_mgwa
56  USE moda_msgmem
57 
58  COMMON /quiet / iprt
59 
60  CHARACTER*128 bort_str,errstr
61 
62 C-----------------------------------------------------------------------
63 C-----------------------------------------------------------------------
64 
65 C CHECK FOR I8 INTEGERS
66 C ---------------------
67 
68  IF(im8b) THEN
69  im8b=.false.
70 
71  CALL x84(lunit,my_lunit,1)
72  CALL x84(inew,my_inew,1)
73  CALL ufbmem(my_lunit,my_inew,iret,iunit)
74  CALL x48(iret,iret,1)
75  CALL x48(iunit,iunit,1)
76 
77  im8b=.true.
78  RETURN
79  ENDIF
80 
81 C TRY TO OPEN BUFR FILE AND SET TO INITIALIZE OR CONCATENATE
82 C ----------------------------------------------------------
83 
84  CALL openbf(lunit,'IN',lunit)
85 
86  IF(inew.EQ.0) THEN
87  msgp(0) = 0
88  munit = 0
89  mlast = 0
90  ndxts = 0
91  ldxts = 0
92  ndxm = 0
93  ldxm = 0
94  ENDIF
95 
96  nmsg = msgp(0)
97  iret = 0
98  iflg = 0
99  itim = 0
100 
101 C Copy any BUFR dictionary table messages from the beginning of
102 C LUNIT into MODULE MSGMEM for possible later use. Note that
103 C such a table (if one exists) is already now in scope due to the
104 C prior call to subroutine OPENBF, which in turn would have
105 C automatically called subroutines READDX, RDBFDX and MAKESTAB
106 C for this table.
107 
108  itemp = ndxts
109  CALL status(lunit,lun,il,im)
110  CALL cewind_c(lun)
111  CALL cpdxmm(lunit)
112 
113 C If a table was indeed present at the beginning of the file,
114 C then set the flag to indicate that this table is now in scope.
115 
116  IF ((itemp+1).EQ.ndxts) ldxts = ndxts
117 
118 C TRANSFER MESSAGES FROM FILE TO MEMORY - SET MESSAGE POINTERS
119 C ------------------------------------------------------------
120 
121 1 CALL rdmsgw(lunit,mgwa,ier)
122  IF(ier.EQ.-1) GOTO 100
123  IF(ier.EQ.-2) GOTO 900
124 
125  IF(idxmsg(mgwa).EQ.1) THEN
126 
127 C New "embedded" BUFR dictionary table messages have been found in
128 C this file. Copy them into MODULE MSGMEM for later use.
129 
130  CALL backbufr_c(lun) !BACKSPACE LUNIT
131  CALL cpdxmm(lunit)
132  GOTO 1
133  ENDIF
134 
135  nmsg = nmsg+1
136  IF(nmsg .GT.maxmsg) iflg = 1
137  lmem = nmwrd(mgwa)
138  IF(lmem+mlast.GT.maxmem) iflg = 2
139 
140  IF(iflg.EQ.0) THEN
141  iret = iret+1
142  DO i=1,lmem
143  msgs(mlast+i) = mgwa(i)
144  ENDDO
145  msgp(0) = nmsg
146  msgp(nmsg) = mlast+1
147  ELSE
148  IF(itim.EQ.0) THEN
149  mlast0 = mlast
150  itim=1
151  ENDIF
152  ENDIF
153  mlast = mlast+lmem
154  GOTO 1
155 
156 C EXITS
157 C -----
158 
159 100 IF(iflg.EQ.1) THEN
160 
161 C EMERGENCY ROOM TREATMENT FOR MAXMSG ARRAY OVERFLOW
162 C --------------------------------------------------
163 
164  IF(iprt.GE.0) THEN
165  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
166  WRITE ( unit=errstr, fmt='(A,A,I8,A)' )
167  . 'BUFRLIB: UFBMEM - THE NO. OF MESSAGES REQUIRED TO STORE ',
168  . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', maxmsg,
169  . ') - INCOMPLETE READ'
170  CALL errwrt(errstr)
171  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
172  . '>>>UFBMEM STORED ', msgp(0), ' MESSAGES OUT OF ', nmsg, '<<<'
173  CALL errwrt(errstr)
174  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
175  . '>>>UFBMEM STORED ', mlast0, ' BYTES OUT OF ', mlast, '<<<'
176  CALL errwrt(errstr)
177  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
178  CALL errwrt(' ')
179  ENDIF
180  mlast=mlast0
181  ENDIF
182 
183  IF(iflg.EQ.2) THEN
184 
185 C EMERGENCY ROOM TREATMENT FOR MAXMEM ARRAY OVERFLOW
186 C --------------------------------------------------
187 
188  IF(iprt.GE.0) THEN
189  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
190  WRITE ( unit=errstr, fmt='(A,A,I8,A)' )
191  . 'BUFRLIB: UFBMEM - THE NO. OF BYTES REQUIRED TO STORE ',
192  . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', maxmem,
193  . ') - INCOMPLETE READ'
194  CALL errwrt(errstr)
195  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
196  . '>>>UFBMEM STORED ', mlast0, ' BYTES OUT OF ', mlast, '<<<'
197  CALL errwrt(errstr)
198  WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )
199  . '>>>UFBMEM STORED ', msgp(0), ' MESSAGES OUT OF ', nmsg, '<<<'
200  CALL errwrt(errstr)
201  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
202  CALL errwrt(' ')
203  ENDIF
204  mlast=mlast0
205  ENDIF
206 
207  IF(iret.EQ.0) THEN
208  CALL closbf(lunit)
209  ELSE
210  IF(munit.NE.0) CALL closbf(lunit)
211  IF(munit.EQ.0) munit = lunit
212  ENDIF
213  iunit = munit
214 
215 C EXITS
216 C -----
217 
218  RETURN
219 900 WRITE(bort_str,'("BUFRLIB: UFBMEM - ERROR READING MESSAGE '//
220  . 'NUMBER",I5," INTO MEMORY FROM UNIT",I3)') nmsg+1,lunit
221  CALL bort(bort_str)
222  END
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
recursive subroutine closbf(LUNIT)
Close the connection between logical unit LUNIT and the NCEPLIBS-bufr software.
Definition: closbf.f:24
subroutine cpdxmm(LUNIT)
This subroutine reads an entire DX BUFR table from a specified file into internal arrays.
Definition: cpdxmm.f:14
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:36
recursive function idxmsg(MESG)
Check whether a BUFR message contains DX BUFR tables information.
Definition: idxmsg.f:23
Wrap C NCEPLIBS-bufr functions so they can be called from within the Fortran part of the library.
Definition: bufrlib.F90:11
This module contains a declaration for an array used by various subroutines and functions to hold a t...
integer, dimension(:), allocatable mgwa
Temporary working copy of BUFR message.
This module contains array and variable declarations used to store the contents of one or more BUFR f...
integer, dimension(:), allocatable msgp
Pointers to the beginning of each message within msgs (up to a maximum of MAXMSG, and where array ele...
integer, dimension(:), allocatable msgs
BUFR messages read from one or more BUFR files.
integer munit
Fortran logical unit number for use in accessing contents of BUFR files within internal memory.
integer ndxm
Number of DX BUFR table messages stored within mdx (up to a maximum of MXDXM).
integer ldxm
Number of array elements filled within mdx (up to a maximum of MXDXW).
integer mlast
Number of array elements filled within msgs (up to a maximum of MAXMEM).
integer ldxts
Number of DX BUFR table that is currently in scope, depending on which BUFR message within msgs is cu...
integer ndxts
Number of DX BUFR tables represented by the messages within mdx (up to a maximum of MXDXTS).
This module declares and initializes the IM8B variable.
logical, public im8b
Status indicator to keep track of whether all future calls to BUFRLIB subroutines and functions from ...
This module declares and initializes the MAXMEM variable.
integer maxmem
Maximum number of bytes that can be used to store BUFR messages within internal memory.
This module declares and initializes the MAXMSG variable.
integer maxmsg
Maximum number of BUFR messages that can be stored within internal memory.
recursive function nmwrd(MBAY)
Given an integer array containing Section 0 from a BUFR message, this function determines the array s...
Definition: nmwrd.f:24
recursive subroutine openbf(LUNIT, IO, LUNDX)
Connects a new file to the NCEPLIBS-bufr software for input or output operations, or initializes the ...
Definition: openbf.f:124
subroutine rdmsgw(lunit, mesg, iret)
Read the next BUFR message from logical unit lunit as an array of integer words.
Definition: rdmsgw.F90:16
recursive subroutine status(LUNIT, LUN, IL, IM)
Check whether a specified Fortran logical unit number is currently connected to the NCEPLIBS-bufr sof...
Definition: status.f:36
recursive subroutine ufbmem(LUNIT, INEW, IRET, IUNIT)
This subroutine connects a new file to the NCEPLIBS-bufr software for input operations,...
Definition: ufbmem.f:48
subroutine x48(IIN4, IOUT8, NVAL)
Encode one or more 4-byte integer values as 8-byte integer values.
Definition: x48.F:19
subroutine x84(IIN8, IOUT4, NVAL)
Encode one or more 8-byte integer values as 4-byte integer values.
Definition: x84.F:19