NCEPLIBS-bufr  11.7.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> | Date | Programmer | Comments |
36 C> | -----|------------|----------|
37 C> | 1994-01-06 | J. Woollen | Original author |
38 C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine "ABORT" with call to new internal routine bort() |
39 C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to 32 |
40 C> | 2000-09-19 | J. Woollen | Added call to new routine rdcmps() allowing subsets to also be decoded from compressed BUFR messages; maximum length increased from 10,000 to 20,000 bytes |
41 C> | 2002-05-14 | J. Woollen | Corrected error relating to certain foreign file types; removed old Cray compiler directives |
42 C> | 2003-11-04 | S. Bender | Added remarks and routine interdependencies |
43 C> | 2003-11-04 | D. Keyser | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally |
44 C> | 2004-08-09 | J. Ator | Maximum message length increased from 20,000 to 50,000 bytes |
45 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
46 C>
47  SUBROUTINE readsb(LUNIT,IRET)
48 
49  USE moda_msgcwd
50  USE moda_unptyp
51  USE moda_bitbuf
52  USE moda_bitmaps
53 
54  CHARACTER*128 bort_str
55 
56 C-----------------------------------------------------------------------
57 C-----------------------------------------------------------------------
58 
59  iret = 0
60 
61 C CHECK THE FILE STATUS
62 C ---------------------
63 
64  CALL status(lunit,lun,il,im)
65  IF(il.EQ.0) goto 900
66  IF(il.GT.0) goto 901
67  IF(im.EQ.0) THEN
68  iret = -1
69  goto 100
70  ENDIF
71 
72 C SEE IF THERE IS ANOTHER SUBSET IN THE MESSAGE
73 C ---------------------------------------------
74 
75  IF(nsub(lun).EQ.msub(lun)) THEN
76  iret = -1
77  goto 100
78  ELSE
79  nsub(lun) = nsub(lun) + 1
80  ENDIF
81 
82 C READ THE NEXT SUBSET AND RESET THE POINTERS
83 C -------------------------------------------
84 
85  nbtm = 0
86  lstnod = 0
87  lstnodct = 0
88  linbtm = .false.
89 
90  IF(msgunp(lun).EQ.0) THEN
91  ibit = mbyt(lun)*8
92  CALL upb(nbyt,16,mbay(1,lun),ibit)
93  CALL rdtree(lun,ier)
94  IF(ier.NE.0) THEN
95  iret = -1
96  goto 100
97  ENDIF
98  mbyt(lun) = mbyt(lun) + nbyt
99  ELSEIF(msgunp(lun).EQ.1) THEN
100 c .... message with "standard" Section 3
101  ibit = mbyt(lun)
102  CALL rdtree(lun,ier)
103  IF(ier.NE.0) THEN
104  iret = -1
105  goto 100
106  ENDIF
107  mbyt(lun) = ibit
108  ELSEIF(msgunp(lun).EQ.2) THEN
109 c .... compressed message
110  CALL rdcmps(lun)
111  ELSE
112  goto 902
113  ENDIF
114 
115 C EXITS
116 C -----
117 
118 100 RETURN
119 900 CALL bort('BUFRLIB: READSB - INPUT BUFR FILE IS CLOSED, IT MUST'//
120  . ' BE OPEN FOR INPUT')
121 901 CALL bort('BUFRLIB: READSB - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
122  . ', IT MUST BE OPEN FOR INPUT')
123 902 WRITE(bort_str,'("BUFRLIB: READSB - MESSAGE UNPACK TYPE",I3,"IS'//
124  . ' NOT RECOGNIZED")') msgunp
125  CALL bort(bort_str)
126  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:55
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:22
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:47