NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
mesgbc.f
Go to the documentation of this file.
1 C> @file
2 C> @author KEYSER @date 2003-11-04
3 
4 C> THIS SUBROUTINE EXAMINES A BUFR MESSAGE AND RETURNS BOTH
5 C> THE MESSAGE TYPE FROM SECTION 1 AND A MESSAGE COMPRESSION INDICATOR
6 C> UNPACKED FROM SECTION 3. IT OBTAINS THE BUFR MESSAGE VIA TWO
7 C> DIFFERENT METHODS, BASED UPON THE SIGN OF LUNIN.
8 C> IF LUNIN IS GREATER THAN ZERO, THIS SUBROUTINE READS AND EXAMINES
9 C> SECTION 1 OF MESSAGES IN A BUFR FILE IN SEQUENCE UNTIL IT FINDS THE
10 C> FIRST MESSAGE THAT ACTUALLY CONTAINS REPORT DATA {I.E., BEYOND THE
11 C> BUFR TABLE (DICTIONARY) MESSAGES AT THE TOP AND, FOR DUMP FILES,
12 C> BEYOND THE TWO DUMMY MESSAGES CONTAINING THE CENTER TIME AND THE
13 C> DUMP TIME}. IT THEN RETURNS THE MESSAGE TYPE AND COMPRESSION
14 C> INDICATOR FOR THIS FIRST DATA MESSAGE. IN THIS CASE, THE BUFR FILE
15 C> SHOULD NOT BE OPENED VIA BUFR ARCHIVE LIBRARY SUBROUTINE OPENBF
16 C> PRIOR TO CALLING THIS SUBROUTINE. HOWEVER, THE BUFR FILE MUST BE
17 C> CONNECTED TO UNIT ABS(LUNIN). WHEN USED THIS WAY, THIS SUBROUTINE
18 C> IS IDENTICAL TO BUFR ARCHIVE LIBRARY SUBROUTINE MESGBF EXCEPT MESGBF
19 C> DOES NOT RETURN ANY INFORMATION ABOUT COMPRESSION AND MESGBF READS
20 C> UNTIL IT FINDS THE FIRST NON-DICTIONARY MESSAGE REGARDLESS OF
21 C> WHETHER OR NOT IT CONTAINS ANY REPORTS (I.E., IT WOULD STOP AT THE
22 C> DUMMY MESSAGE CONTAINING THE CENTER TIME FOR DUMP FILES).
23 C> THE SECOND METHOD IN WHICH THIS SUBROUTINE CAN BE USED OCCURS
24 C> WHEN LUNIN IS PASSED IN WITH A VALUE LESS THAN ZERO. IN THIS CASE,
25 C> IT SIMPLY RETURNS THE MESSAGE TYPE AND COMPRESSION INDICATOR FOR THE
26 C> BUFR MESSAGE CURRENTLY STORED IN THE INTERNAL MESSAGE BUFFER (ARRAY
27 C> MBAY IN MODULE BITBUF). IN THIS CASE, THE BUFR FILE
28 C> CONNECTED TO ABS(LUNIN) MUST HAVE BEEN PREVIOUSLY OPENED FOR INPUT
29 C> OPERATIONS BY BUFR ARCHIVE LIBRARY SUBROUTINE OPENBF, AND THE BUFR
30 C> MESSAGE MUST HAVE BEEN READ INTO MEMORY BY BUFR ARCHIVE LIBRARY
31 C> ROUTINE READMG OR EQUIVALENT.
32 C>
33 C> PROGRAM HISTORY LOG:
34 C> 2003-11-04 D. KEYSER -- ORIGINAL AUTHOR
35 C> 2004-06-29 D. KEYSER -- ADDED NEW OPTION TO RETURN MESSAGE TYPE AND
36 C> COMPRESSION INDICATOR FOR BUFR MESSAGE
37 C> CURRENTLY STORED IN MEMORY (TRIGGERED BY
38 C> INPUT ARGUMENT LUNIN LESS THAN ZERO)
39 C> 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
40 C> 20,000 TO 50,000 BYTES
41 C> 2005-11-29 J. ATOR -- USE IUPBS01, GETLENS AND RDMSGW
42 C> 2009-03-23 J. ATOR -- USE IUPBS3 AND IDXMSG
43 C> 2012-09-15 J. WOOLLEN -- CONVERT TO C LANGUAGE I/O INTERFACE
44 C> ADD OPENBF AND CLOSBF FOR THE CASE
45 C> WHEN LUNIN GT 0
46 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
47 C>
48 C> USAGE: CALL MESGBC (LUNIN, MESGTYP, ICOMP)
49 C> INPUT ARGUMENT LIST:
50 C> LUNIN - INTEGER: ABSOLUTE VALUE IS FORTRAN LOGICAL UNIT NUMBER
51 C> FOR BUFR FILE
52 C> - IF LUNIN IS GREATER THAN ZERO, THIS SUBROUTINE
53 C> READS THROUGH ALL BUFR MESSAGES FROM BEGINNING OF
54 C> FILE UNTIL IT FINDS THE FIRST MESSAGE CONTAINING
55 C> REPORT DATA
56 C> - IF LUNIN IS LESS THAN ZERO, THIS SUBROUTINE
57 C> OPERATES ON THE BUFR MESSAGE CURRENTLY STORED IN
58 C> MEMORY
59 C>
60 C> OUTPUT ARGUMENT LIST:
61 C> MESGTYP - INTEGER: BUFR MESSAGE TYPE FOR EITHER THE FIRST
62 C> MESSAGE IN FILE CONTAINING REPORT DATA (IF LUNIN > 0),
63 C> OR FOR THE MESSAGE CURRENTLY IN MEMORY (IF LUNIN < 0)
64 C> -256 = for LUNIN > 0 case only: no messages read
65 C> or error reading file
66 C> < 0 = for LUNIN > 0 case only: none of the
67 C> messages read contain reports; this is the
68 C> negative of the message type the last
69 C> message read (i.e., -11 indicates the BUFR
70 C> file contains only BUFR table messages)
71 C> ICOMP - INTEGER: BUFR MESSAGE COMPRESSION SWITCH:
72 C> -3 = for LUNIN > 0 case only: BUFR file does not
73 C> exist
74 C> -2 = for LUNIN > 0 case only: BUFR file does not
75 C> contain any report messages
76 C> -1 = for LUNIN > 0 case only: cannot determine
77 C> if first BUFR message containing report
78 C> data is compressed due to error reading
79 C> file
80 C> 0 = BUFR message (either first containing
81 C> report data if LUNIN > 0, or that currently
82 C> in memory if LUNIN < 0) is NOT compressed
83 C> 1 = BUFR message (either first containing
84 C> report data if LUNIN > 0, or that currently
85 C> in memory if LUNIN < 0) IS compressed
86 C>
87 C> INPUT FILES:
88 C> UNIT ABS(LUNIN) - BUFR FILE
89 C>
90 C> REMARKS:
91 C> THIS ROUTINE CALLS: CLOSBF IDXMSG IUPBS01 IUPBS3
92 C> OPENBF RDMSGW STATUS
93 C> THIS ROUTINE IS CALLED BY: COPYSB UFBTAB
94 C> Also called by application programs.
95 C>
96  SUBROUTINE mesgbc(LUNIN,MESGTYP,ICOMP)
97 
98  USE moda_bitbuf
99  USE moda_mgwa
100 
101 C-----------------------------------------------------------------------
102 C-----------------------------------------------------------------------
103 
104  lunit = abs(lunin)
105 
106 C DETERMINE METHOD OF OPERATION BASED ON SIGN OF LUNIN
107 C LUNIN > 0 - REWIND AND LOOK FOR FIRST DATA MESSAGE (ITYPE = 0)
108 C LUNIN < 0 - LOOK AT MESSAGE CURRENLY IN MEMORY (ITYPE = 1)
109 C ---------------------------------------------------------------
110 
111  itype = 0
112  IF(lunit.NE.lunin) itype = 1
113 
114  icomp = -1
115  mesgtyp = -256
116 
117  IF(itype.EQ.0) THEN
118 
119  irec = 0
120 
121 C CALL OPENBF SINCE FILE IS NOT OPEN TO THE C INTERFACE YET
122 C ---------------------------------------------------------
123 
124  CALL openbf(lunit,'INX',lunit)
125 
126 C READ PAST ANY BUFR TABLES AND RETURN THE FIRST MESSAGE TYPE FOUND
127 C -----------------------------------------------------------------
128 
129 1 CALL rdmsgw(lunit,mgwa,ier)
130  IF(ier.EQ.-1) goto 900
131  IF(ier.EQ.-2) goto 901
132 
133  irec = irec + 1
134 
135  mesgtyp = iupbs01(mgwa,'MTYP')
136 
137  IF((idxmsg(mgwa).EQ.1).OR.(iupbs3(mgwa,'NSUB').EQ.0)) goto 1
138 
139  ELSE
140 
141 C RETURN MESSAGE TYPE FOR MESSAGE CURRENTLY STORED IN MEMORY
142 C ----------------------------------------------------------
143 
144  CALL status(lunit,lun,il,im)
145 
146  DO i=1,12
147  mgwa(i) = mbay(i,lun)
148  ENDDO
149 
150  mesgtyp = iupbs01(mgwa,'MTYP')
151 
152  END IF
153 
154 C SET THE COMPRESSION SWITCH
155 C --------------------------
156 
157  icomp = iupbs3(mgwa,'ICMP')
158 
159  goto 100
160 
161 C CAN ONLY GET TO STATEMENTS 900 OR 901 WHEN ITYPE = 0
162 C ----------------------------------------------------
163 
164 900 IF(irec.EQ.0) THEN
165  mesgtyp = -256
166  icomp = -3
167  ELSE
168  IF(mesgtyp.GE.0) mesgtyp = -mesgtyp
169  icomp = -2
170  ENDIF
171  goto 100
172 
173 901 mesgtyp = -256
174  icomp = -1
175 
176 C EXIT
177 C ----
178 
179 100 IF(itype.EQ.0) CALL closbf(lunit)
180  RETURN
181  END
function iupbs3(MBAY, S3MNEM)
This function returns a specified value from within Section 3 of a BUFR message.
Definition: iupbs3.f:34
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
subroutine mesgbc(LUNIN, MESGTYP, ICOMP)
THIS SUBROUTINE EXAMINES A BUFR MESSAGE AND RETURNS BOTH THE MESSAGE TYPE FROM SECTION 1 AND A MESSAG...
Definition: mesgbc.f:96
function idxmsg(MESG)
This function determines whether a given BUFR message contains DX BUFR tables information that was ge...
Definition: idxmsg.f:23
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 openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:138
This module contains array and variable declarations used to store BUFR messages internally for multi...
Definition: moda_bitbuf.F:10
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