NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
readerme.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Read a BUFR message from a memory array.
3 
4 C> This subroutine is similar to subroutine readmg(), except that it
5 C> reads a BUFR message from an array already in memory, whereas
6 C> readmg() reads a BUFR message from a file on the local system.
7 C>
8 C> @authors J. Woollen
9 C> @authors J. Ator
10 C> @date 1995-06-28
11 C>
12 C> @param[in] MESG -- integer(*): BUFR message
13 C> @param[in] LUNIT -- integer: Fortran logical unit number for
14 C> BUFR file
15 C> @param[out] SUBSET -- character*8: Table A mnemonic for type of BUFR
16 C> message that was read
17 C> (see [DX BUFR Tables](@ref dfbftab)
18 C> for further information about Table A mnemonics)
19 C> @param[out] JDATE -- integer: Date-time stored within Section 1 of
20 C> BUFR message that was read, in format of either
21 C> YYMMDDHH or YYYYMMDDHH, depending on the most
22 C> recent call to subroutine datelen()
23 C> @param[out] IRET -- integer: return code
24 C> - 0 = MESG was successfully read
25 C> - 11 = MESG contained a DX BUFR table message
26 C> - -1 = MESG contained an unrecognized
27 C> Table A message type
28 C>
29 C> <p>This subroutine looks and behaves a lot like subroutine readmg()
30 C> except that here we have one additional input argument MESG which
31 C> contains the BUFR message to be read by the BUFRLIB software.
32 C> As such, this subroutine can be used in any context in which readmg()
33 C> might otherwise be used, and from that point on, the application
34 C> program can proceed with a call to one of the
35 C> [subset-reading subroutines](@ref hierarchy) (and then,
36 C> subsequently, to any of the
37 C> [values-reading subroutines](@ref hierarchy)), just
38 C> like if readmg() had been called instead.
39 C>
40 C> <p>When using this subroutine, it's still necessary for the
41 C> application program to have previously called subroutine openbf() in
42 C> order to associate a DX BUFR tables file with the messages that are
43 C> being input via MESG, and it's still also necessary to pass in the
44 C> relevant LUNIT value as a call argument, even though in this case
45 C> the subroutine will not actually try to read from the associated
46 C> Fortran logical unit.
47 C>
48 C> <p>If MESG contains a DX BUFR table message, the subroutine will
49 C> store the contents internally and use them to process any
50 C> future BUFR messages associated with LUNIT. In this case, the
51 C> subroutine will return with IRET = 11, and any number of
52 C> DX BUFR table messages passed in via consecutive calls to this
53 C> subroutine will accumulate internally and be treated as a single DX
54 C> BUFR table, up until a call is made where MESG no longer contains a
55 C> DX BUFR table message.
56 C>
57 C> <b>Program history log:</b>
58 C> | Date | Programmer | Comments |
59 C> | -----|------------|----------|
60 C> | 1995-06-28 | J. Woollen | Original author |
61 C> | 1997-07-29 | J. Woollen | Modified to process GOES soundings from NESDIS |
62 C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine "ABORT" with call to new internal routine bort(); modified to make Y2K compliant; improved machine portability |
63 C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to 32; increased the maximum number of possible descriptors in a subset from 1000 to 3000 |
64 C> | 2000-09-19 | J. Woollen | Removed logic that had been replicated in this and other read routines and consolidated it into a new routine cktaba(); maximum message length increased from 10,000 to 20,000 bytes |
65 C> | 2003-11-04 | S. Bender | Added remarks and routine interdependencies |
66 C> | 2003-11-04 | D. Keyser | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally |
67 C> | 2004-08-18 | J. Ator | Modified 'BUFR' string test for portability to EBCDIC machines; maximum message length increased from 20,000 to 50,000 bytes |
68 C> | 2005-11-29 | J. Ator | Use ichkstr() |
69 C> | 2009-03-23 | D. Keyser | Call bort() in case of MBAY overflow |
70 C> | 2009-03-23 | J. Ator | Add logic to allow Section 3 decoding; add logic to process dictionary messages |
71 C> | 2012-06-07 | J. Ator | Don't respond to DX table messages if Section 3 decoding is being used |
72 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
73 C>
74  SUBROUTINE readerme(MESG,LUNIT,SUBSET,JDATE,IRET)
75 
76  USE moda_sc3bfr
77  USE moda_idrdm
78  USE moda_bitbuf
79 
80  COMMON /hrdwrd/ nbytw,nbitw,iord(8)
81  COMMON /quiet/ iprt
82 
83  CHARACTER*128 bort_str,errstr
84  CHARACTER*8 subset,sec0
85  CHARACTER*1 cec0(8)
86 
87  dimension mesg(*),iec0(2)
88 
89  LOGICAL endtbl
90 
91  equivalence(sec0,iec0,cec0)
92 
93 C-----------------------------------------------------------------------
94 C-----------------------------------------------------------------------
95 
96  iret = 0
97 
98 C CHECK THE FILE STATUS
99 C ---------------------
100 
101  CALL status(lunit,lun,il,im)
102  IF(il.EQ.0) goto 900
103  IF(il.GT.0) goto 901
104  CALL wtstat(lunit,lun,il, 1)
105 
106 C COPY THE INPUT MESSAGE INTO THE INTERNAL MESSAGE BUFFER
107 C -------------------------------------------------------
108 
109  iec0(1) = mesg(1)
110  iec0(2) = mesg(2)
111  lnmsg = lmsg(sec0)
112  IF(lnmsg*nbytw.GT.mxmsgl) goto 902
113  DO i=1,lnmsg
114  mbay(i,lun) = mesg(i)
115  ENDDO
116 
117 C Confirm that the first 4 bytes of SEC0 contain 'BUFR' encoded in
118 C CCITT IA5 (i.e. ASCII).
119 
120  IF(ichkstr('BUFR',cec0,4).NE.0) goto 903
121 
122 C PARSE THE MESSAGE SECTION CONTENTS
123 C ----------------------------------
124 
125  IF(isc3(lun).NE.0) CALL reads3(lun)
126 
127  CALL cktaba(lun,subset,jdate,iret)
128 
129  IF(isc3(lun).NE.0) RETURN
130 
131 C CHECK FOR A DX DICTIONARY MESSAGE
132 C ---------------------------------
133 
134 C A new DX dictionary table can be passed in as a consecutive set of
135 C DX dictionary messages. Each message should be passed in one at a
136 C time, via input argument MESG during consecutive calls to this
137 C subroutine, and will be processed as a single dictionary table up
138 C until the next message is passed in which either contains no data
139 C subsets or else is a non-DX dictionary message.
140 
141  endtbl = .false.
142 
143  IF(idxmsg(mbay(1,lun)).EQ.1) THEN
144 
145 C This is a DX dictionary message that was generated by the
146 C BUFRLIB archive library software.
147 
148  IF(iupbs3(mbay(1,lun),'NSUB').EQ.0) THEN
149 
150 C But it doesn't contain any actual dictionary information, so
151 C assume we've reached the end of the dictionary table.
152 
153  IF(idrdm(lun).GT.0) THEN
154  endtbl = .true.
155  ENDIF
156  ELSE
157  IF(idrdm(lun).EQ.0) THEN
158 
159 C This is the first DX dictionary message that is part of a
160 C new dictionary table.
161 
162  CALL dxinit(lun,0)
163  ENDIF
164  idrdm(lun) = idrdm(lun) + 1
165  CALL stbfdx(lun,mbay(1,lun))
166  ENDIF
167  ELSE IF(idrdm(lun).GT.0) THEN
168 
169 C This is the first non-DX dictionary message received following a
170 C string of DX dictionary messages, so assume we've reached the
171 C end of the dictionary table.
172 
173  endtbl = .true.
174  ENDIF
175 
176  IF(endtbl) THEN
177  IF ( iprt .GE. 2 ) THEN
178  CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
179  WRITE ( unit=errstr, fmt='(A,I3,A)' )
180  . 'BUFRLIB: READERME - STORED NEW DX TABLE CONSISTING OF (',
181  . idrdm(lun), ') MESSAGES;'
182  CALL errwrt(errstr)
183  errstr = 'WILL APPLY THIS TABLE TO ALL SUBSEQUENT DATA '//
184  . 'MESSAGES UNTIL NEXT DX TABLE IS PASSED IN'
185  CALL errwrt(errstr)
186  CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
187  CALL errwrt(' ')
188  ENDIF
189  idrdm(lun) = 0
190  CALL makestab
191  ENDIF
192 
193 C EXITS
194 C -----
195 
196  RETURN
197 900 CALL bort('BUFRLIB: READERME - INPUT BUFR FILE IS CLOSED, IT '//
198  . 'MUST BE OPEN FOR INPUT')
199 901 CALL bort('BUFRLIB: READERME - INPUT BUFR FILE IS OPEN FOR '//
200  . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
201 902 WRITE(bort_str,'("BUFRLIB: READERME - INPUT BUFR MESSAGE LENGTH",
202  . 1X,I6," BYTES) IS LARGER THAN LIMIT OF ",I6," BYTES")')
203  . lnmsg*nbytw,mxmsgl
204  CALL bort(bort_str)
205 903 CALL bort('BUFRLIB: READERME - FIRST 4 BYTES READ FROM RECORD'//
206  . ' NOT "BUFR", DOES NOT CONTAIN BUFR DATA')
207  END
function iupbs3(MBAY, S3MNEM)
This function returns a specified value from within Section 3 of a BUFR message.
Definition: iupbs3.f:34
function lmsg(SEC0)
GIVEN A CHARACTER STRING CONTAINING SECTION ZERO FROM A BUFR MESSAGE, THIS FUNCTION DETERMINES A COUN...
Definition: lmsg.f:31
subroutine cktaba(LUN, SUBSET, JDATE, IRET)
THIS SUBROUTINE PARSES THE TABLE A MNEMONIC AND THE DATE OUT OF SECTION 1 OF A BUFR MESSAGE PREVIOUSL...
Definition: cktaba.f:75
function ichkstr(STR, CHR, N)
THIS FUNCTION COMPARES A SPECIFIED NUMBER OF CHARACTERS FROM AN INPUT CHARACTER ARRAY AGAINST THE SAM...
Definition: ichkstr.f:32
subroutine reads3(LUN)
THIS SUBROUTINE READS THE SECTION 3 DESCRIPTORS FROM THE BUFR MESSAGE IN MBAY(1,LUN).
Definition: reads3.f:30
subroutine dxinit(LUN, IOI)
THIS SUBROUTINE INITIALIZES THE INTERNAL ARRAYS (IN MODULE TABABD) HOLDING THE DICTIONARY TABLE...
Definition: dxinit.f:40
subroutine readerme(MESG, LUNIT, SUBSET, JDATE, IRET)
This subroutine is similar to subroutine readmg(), except that it reads a BUFR message from an array ...
Definition: readerme.f:74
function idxmsg(MESG)
This function determines whether a given BUFR message contains DX BUFR tables information that was ge...
Definition: idxmsg.f:23
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 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 makestab
THIS SUBROUTINE CONSTRUCTS AN INTERNAL JUMP/LINK TABLE WITHIN MODULE TABLES, USING THE INFORMATION WI...
Definition: makestab.f:74
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 stbfdx(LUN, MESG)
THIS SUBROUTINE COPIES A BUFR TABLE (DICTIONARY) MESSAGE FROM THE INPUT ARRAY MESG INTO THE INTERNAL ...
Definition: stbfdx.f:28
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
This module contains array and variable declarations used to store BUFR messages internally for multi...
Definition: moda_bitbuf.F:10