NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
readsb.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Read the next data subset from a BUFR message.
3 
4 C> This subroutine reads the next data subset from a BUFR
5 C> message into internal arrays.
6 C>
7 C> @author J. Woollen
8 C> @date 1994-01-06
9 C>
10 C> @param[in] LUNIT - integer: Fortran logical unit number for BUFR file
11 C> @param[out] IRET - integer: return code
12 C> - 0 = new BUFR data subset was successfully
13 C> read into internal arrays
14 C> - -1 = there are no more BUFR data subsets in
15 C> the BUFR message
16 C>
17 C> <p>Logical unit LUNIT should have already been opened for
18 C> input operations via a previous call to subroutine openbf(), and a
19 C> BUFR message should have already been read into internal arrays via
20 C> a previous call to one of the
21 C> [message-reading subroutines](@ref hierarchy).
22 C>
23 C> <p>Whenever this subroutine returns with IRET = 0, this indicates
24 C> that a new BUFR data subset (i.e. report) was successfully read into
25 C> internal arrays within the BUFRLIB software, and from where it can
26 C> then be easily manipulated or further parsed via calls to any of the
27 C> [values-reading subroutines](@ref hierarchy).
28 C> Otherwise, if the subroutine returns with IRET = -1, then this
29 C> indicates that there are no more data subsets available within the
30 C> current message, and therefore that a new call needs to be made to
31 C> one of the [message-reading subroutines](@ref hierarchy) in order
32 C> to read in the next message from logical unit LUNIT.
33 C>
34 C> <b>Program history log:</b>
35 C> - 1994-01-06 J. Woollen -- Original author
36 C> - 1998-07-08 J. Woollen -- Replaced call to Cray library routine
37 C> "ABORT" with call to new internal BUFRLIB
38 C> routine "BORT"
39 C> - 1999-11-18 J. Woollen -- The number of BUFR files which can be
40 C> opened at one time increased from 10 to 32
41 C> (necessary in order to process multiple
42 C> BUFR files under the MPI)
43 C> - 2000-09-19 J. Woollen -- Added call to new routine rdcmps() allowing
44 C> subsets to also be decoded from compressed
45 C> BUFR messages; maximum length increased
46 C> from 10,000 to 20,000 bytes
47 C> - 2002-05-14 J. Woollen -- Corrected error relating to certain
48 C> foreign file types; removed old Cray
49 C> compiler directives
50 C> - 2003-11-04 S. Bender -- Added remarks and routine interdependencies
51 C> - 2003-11-04 D. Keyser -- Unified/portable for WRF; added history
52 C> documentation; outputs more complete
53 C> diagnostic info when routine terminates
54 C> abnormally
55 C> - 2004-08-09 J. Ator -- Maximum message length increased from
56 C> 20,000 to 50,000 bytes
57 C> - 2014-12-10 J. Ator -- Use modules instead of COMMON blocks
58 C>
59  SUBROUTINE readsb(LUNIT,IRET)
60 
61  USE moda_msgcwd
62  USE moda_unptyp
63  USE moda_bitbuf
64  USE moda_bitmaps
65 
66  CHARACTER*128 bort_str
67 
68 C-----------------------------------------------------------------------
69 C-----------------------------------------------------------------------
70 
71  iret = 0
72 
73 C CHECK THE FILE STATUS
74 C ---------------------
75 
76  CALL status(lunit,lun,il,im)
77  IF(il.EQ.0) goto 900
78  IF(il.GT.0) goto 901
79  IF(im.EQ.0) THEN
80  iret = -1
81  goto 100
82  ENDIF
83 
84 C SEE IF THERE IS ANOTHER SUBSET IN THE MESSAGE
85 C ---------------------------------------------
86 
87  IF(nsub(lun).EQ.msub(lun)) THEN
88  iret = -1
89  goto 100
90  ELSE
91  nsub(lun) = nsub(lun) + 1
92  ENDIF
93 
94 C READ THE NEXT SUBSET AND RESET THE POINTERS
95 C -------------------------------------------
96 
97  nbtm = 0
98  lstnod = 0
99  lstnodct = 0
100  linbtm = .false.
101 
102  IF(msgunp(lun).EQ.0) THEN
103  ibit = mbyt(lun)*8
104  CALL upb(nbyt,16,mbay(1,lun),ibit)
105  CALL rdtree(lun,ier)
106  IF(ier.NE.0) THEN
107  iret = -1
108  goto 100
109  ENDIF
110  mbyt(lun) = mbyt(lun) + nbyt
111  ELSEIF(msgunp(lun).EQ.1) THEN
112 c .... message with "standard" Section 3
113  ibit = mbyt(lun)
114  CALL rdtree(lun,ier)
115  IF(ier.NE.0) THEN
116  iret = -1
117  goto 100
118  ENDIF
119  mbyt(lun) = ibit
120  ELSEIF(msgunp(lun).EQ.2) THEN
121 c .... compressed message
122  CALL rdcmps(lun)
123  ELSE
124  goto 902
125  ENDIF
126 
127 C EXITS
128 C -----
129 
130 100 RETURN
131 900 CALL bort('BUFRLIB: READSB - INPUT BUFR FILE IS CLOSED, IT MUST'//
132  . ' BE OPEN FOR INPUT')
133 901 CALL bort('BUFRLIB: READSB - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
134  . ', IT MUST BE OPEN FOR INPUT')
135 902 WRITE(bort_str,'("BUFRLIB: READSB - MESSAGE UNPACK TYPE",I3,"IS'//
136  . ' NOT RECOGNIZED")') msgunp
137  CALL bort(bort_str)
138  END
subroutine upb(NVAL, NBITS, IBAY, IBIT)
THIS SUBROUTINE UNPACKS AND RETURNS A BINARY INTEGER CONTAINED WITHIN NBITS BITS OF IBAY...
Definition: upb.f:49
This module contains array and variable declarations used to store bitmaps internally within a data s...
Definition: moda_bitmaps.F:13
subroutine rdtree(LUN, IRET)
THIS SUBROUTINE UNPACKS THE NEXT SUBSET FROM THE INTERNAL UNCOMPRESSED MESSAGE BUFFER (ARRAY MBAY IN ...
Definition: rdtree.f:57
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
subroutine rdcmps(LUN)
THIS SUBROUTINE UNCOMPRESSES AND UNPACKS THE NEXT SUBSET FROM THE INTERNAL COMPRESSED MESSAGE BUFFER ...
Definition: rdcmps.f:45
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23
This module contains array and variable declarations used to store BUFR messages internally for multi...
Definition: moda_bitbuf.F:10
subroutine readsb(LUNIT, IRET)
This subroutine reads the next data subset from a BUFR message into internal arrays.
Definition: readsb.f:59