NCEPLIBS-bufr  12.0.0
rdmems.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Read a specified data subset from a BUFR message.
3 C>
4 C> @author J. Woollen @date 1994-01-06
5 
6 C> This subroutine reads a specified data subset from the BUFR message
7 C> that was most recently read via a call to subroutine rdmemm() or
8 C> readmm().
9 C>
10 C> Whenever this subroutine returns with IRET = 0, this indicates
11 C> that a new BUFR data subset (i.e. report) was successfully read into
12 C> internal arrays within the BUFRLIB software, and from where it can
13 C> now be easily manipulated or further parsed via calls to any of the
14 C> [values-reading subroutines](@ref hierarchy) using the Fortran
15 C> logical unit number IUNIT that was returned from the most recent
16 C> call to subroutine ufbmem().
17 C>
18 C> @param[in] ISUB - integer: Number of data subset to be
19 C> read from BUFR message, counting from the beginning of the message.
20 C> @param[out] IRET - integer: return code
21 C> - 0 = requested data subset was successfully read.
22 C> - -1 = requested subset number could not be found in the message.
23 C>
24 C> @author J. Woollen @date 1994-01-06
25  RECURSIVE SUBROUTINE rdmems(ISUB,IRET)
26 
27  USE moda_msgcwd
28  USE moda_unptyp
29  USE moda_bitbuf
30  USE moda_msgmem
31  USE modv_im8b
32 
33  CHARACTER*128 bort_str,errstr
34 
35  COMMON /quiet / iprt
36 
37 C-----------------------------------------------------------------------
38 C-----------------------------------------------------------------------
39 
40 C CHECK FOR I8 INTEGERS
41 C ---------------------
42 
43  IF(im8b) THEN
44  im8b=.false.
45 
46  CALL x84(isub,my_isub,1)
47  CALL rdmems(my_isub,iret)
48  CALL x48(iret,iret,1)
49 
50  im8b=.true.
51  RETURN
52  ENDIF
53 
54 C CHECK THE MESSAGE REQUEST AND FILE STATUS
55 C -----------------------------------------
56 
57  CALL status(munit,lun,il,im)
58  IF(il.EQ.0) GOTO 900
59  IF(il.GT.0) GOTO 901
60  IF(im.EQ.0) GOTO 902
61  IF(nsub(lun).NE.0) GOTO 903
62 
63  IF(isub.GT.msub(lun)) THEN
64  IF(iprt.GE.0) THEN
65  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
66  WRITE ( unit=errstr, fmt='(A,I5,A,A,I5,A)' )
67  . 'BUFRLIB: RDMEMS - REQ. SUBSET #', isub, ' (= 1st INPUT ',
68  . 'ARG.) > # OF SUBSETS IN MEMORY MESSAGE (', msub(lun), ')'
69  CALL errwrt(errstr)
70  CALL errwrt('RETURN WITH IRET = -1')
71  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
72  CALL errwrt(' ')
73  ENDIF
74  iret = -1
75  GOTO 100
76  ENDIF
77 
78  mbym = mbyt(lun)
79  nbyt = 0
80 
81 C POSITION TO SUBSET NUMBER ISUB IN MEMORY MESSAGE
82 C ------------------------------------------------
83 
84  IF(msgunp(lun).EQ.0) THEN
85  nsub(lun) = isub-1
86  DO i=1,isub-1
87  mbyt(lun) = mbyt(lun) + iupb(mbay(1,lun),mbyt(lun)+1,16)
88  ENDDO
89  ELSEIF(msgunp(lun).EQ.1) THEN
90 c .... message with "standard" Section 3
91  DO i=1,isub-1
92  CALL readsb(munit,iret)
93  ENDDO
94  ELSEIF(msgunp(lun).EQ.2) THEN
95 c .... compressed message
96  nsub(lun) = isub-1
97  ENDIF
98 
99 C NOW READ SUBSET NUMBER ISUB FROM MEMORY MESSAGE
100 C -----------------------------------------------
101 
102  CALL readsb(munit,iret)
103 c .... This should have already been accounted for with stmt. 902 or
104 c IRET = -1 above
105  IF(iret.NE.0) GOTO 904
106 
107 C RESET SUBSET POINTER BACK TO ZERO (BEGINNING OF MESSAGE) AND RETURN
108 C -------------------------------------------------------------------
109 
110  mbyt(lun) = mbym
111  nsub(lun) = 0
112 
113 C EXITS
114 C -----
115 
116 100 RETURN
117 900 CALL bort('BUFRLIB: RDMEMS - INPUT BUFR FILE IS CLOSED, IT '//
118  . 'MUST BE OPEN FOR INPUT')
119 901 CALL bort('BUFRLIB: RDMEMS - INPUT BUFR FILE IS OPEN FOR '//
120  . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
121 902 CALL bort('BUFRLIB: RDMEMS - A MEMORY MESSAGE MUST BE OPEN IN '//
122  . 'INPUT BUFR FILE, NONE ARE')
123 903 WRITE(bort_str,'("BUFRLIB: RDMEMS - UPON ENTRY, SUBSET POINTER '//
124  . 'IN MEMORY MESSAGE IS NOT AT BEGINNING (",I3," SUBSETS HAVE '//
125  . 'BEEN READ, SHOULD BE 0)")') nsub(lun)
126  CALL bort(bort_str)
127 904 CALL bort('BUFRLIB: RDMEMS - CALL TO ROUTINE READSB RETURNED '//
128  . 'WITH IRET = -1 (EITHER MEMORY MESSAGE NOT OPEN OR ALL '//
129  . 'SUBSETS IN MESSAGE READ')
130  END
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
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 iupb(MBAY, NBYT, NBIT)
Decode an integer value from an integer array.
Definition: iupb.f:21
This module contains array and variable declarations used to store BUFR messages internally for multi...
integer, dimension(:,:), allocatable mbay
Current BUFR message for each internal I/O stream.
integer, dimension(:), allocatable mbyt
Length (in bytes) of current BUFR message for each internal I/O stream.
This module contains declarations for arrays used to store information about the current BUFR message...
integer, dimension(:), allocatable msub
Total number of data subsets in message.
integer, dimension(:), allocatable nsub
Current subset pointer within message.
This module contains array and variable declarations used to store the contents of one or more BUFR f...
integer munit
Fortran logical unit number for use in accessing contents of BUFR files within internal memory.
This module contains an array declaration used to store, for each I/O stream index from which a BUFR ...
integer, dimension(:), allocatable msgunp
Flag indicating how to unpack data subsets from BUFR message:
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 ...
recursive subroutine rdmems(ISUB, IRET)
This subroutine reads a specified data subset from the BUFR message that was most recently read via a...
Definition: rdmems.f:26
recursive subroutine readsb(LUNIT, IRET)
Read the next data subset from a BUFR message.
Definition: readsb.f:33
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
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