NCEPLIBS-bufr  12.0.0
iupbs01.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Read a data value from Section 0 or Section 1 of a BUFR
3 C> message.
4 C>
5 C> @author J. Ator @date 2005-11-29
6 
7 C> Read a data value from Section 0 or Section 1 of a BUFR message.
8 C>
9 C> This function returns a specified value from within Section 0 or
10 C> Section 1 of a BUFR message.
11 C>
12 C> It will work on any BUFR message encoded using BUFR
13 C> edition 2, 3, or 4. It is similar to function iupvs01(), except
14 C> that it operates on a BUFR message passed in via a memory array,
15 C> whereas iupvs01() operates on the BUFR message that was read into
16 C> internal arrays via the most recent call to any of the other
17 C> [message-reading subroutines](@ref hierarchy) for a specified
18 C> Fortran logical unit.
19 C>
20 C> @remarks
21 C> - The start of the BUFR message (i.e. the string 'BUFR') must be
22 C> aligned on the first 4 bytes of MBAY.
23 C> - Values corresponding to S01MNEM = 'GSES' can only be read from
24 C> BUFR messages encoded using BUFR edition 3 or 4.
25 C> - Values corresponding to S01MNEM = 'YCEN' or 'CENT' can only be
26 C> read from BUFR messages encoded using BUFR edition 2 or 3.
27 C> - When reading from BUFR messages encoded using BUFR edition 2
28 C> or 3, values corresponding to S01MNEM = 'YEAR' will be
29 C> calculated internally using the values for 'YCEN' and 'CENT',
30 C> or inferred using a windowing technique
31 C> - Values corresponding to S01MNEM = 'SECO' or 'MSBTI' can only
32 C> be read from BUFR messages encoded using BUFR edition 4.
33 C>
34 C> @param[in] MBAY - integer(*): BUFR message.
35 C> @param[in] S01MNEM - character*(*): Value to be read from
36 C> Section 0 or Section 1 of MBAY.
37 C> - 'LENM' = Length (in bytes) of BUFR message
38 C> - 'LEN0' = Length (in bytes) of Section 0
39 C> - 'LEN1' = Length (in bytes) of Section 1
40 C> - 'BEN' = BUFR edition number
41 C> - 'BMT' = BUFR master table
42 C> - 'OGCE' = Originating center
43 C> - 'GSES' = Originating subcenter
44 C> - 'USN' = Update sequence number
45 C> - 'ISC2' = Flag indicating absence/presence of (optional) Section 2
46 C> in BUFR message:
47 C> - 0 = Section 2 absent
48 C> - 1 = Section 2 present
49 C> - 'MTYP' = Data category
50 C> - 'MSBTI' = Data subcategory (international)
51 C> - 'MSBT' = Data subcategory (local)
52 C> - 'MTV' = Version number of master table
53 C> - 'MTVL' = Version number of local tables
54 C> - 'YCEN' = Year of century (1-100)
55 C> - 'CENT' = Century (e.g., 20 for years 1901-2000, 21 for years 2001-2100)
56 C> - 'YEAR' = Year (4-digit)
57 C> - 'MNTH' = Month
58 C> - 'DAYS' = Day
59 C> - 'HOUR' = Hour
60 C> - 'MINU' = Minute
61 C> - 'SECO' = Second
62 C> @returns iupbs01 - integer: Value corresponding to S01MNEM:
63 C> - -1 = S01MNEM was invalid for the edition of BUFR
64 C> message in MBAY, or some other error occurred
65 C>
66 C> @author J. Ator @date 2005-11-29
67 
68  RECURSIVE FUNCTION iupbs01(MBAY,S01MNEM) RESULT(IRET)
69 
70  USE modv_im8b
71 
72  dimension mbay(*)
73 
74  CHARACTER*(*) s01mnem
75 
76  LOGICAL ok4cent
77 
78 C-----------------------------------------------------------------------
79 C This statement function checks whether its input value contains
80 C a valid century value.
81 
82  ok4cent(ival) = ((ival.GE.19).AND.(ival.LE.21))
83 C-----------------------------------------------------------------------
84 
85 C Check for I8 integers.
86 
87  IF(im8b) THEN
88  im8b=.false.
89 
90  iret = iupbs01(mbay,s01mnem)
91 
92  im8b=.true.
93  RETURN
94  ENDIF
95 
96 C Call subroutine WRDLEN to initialize some important information
97 C about the local machine, just in case subroutine OPENBF hasn't
98 C been called yet.
99 
100  CALL wrdlen
101 
102 C Handle some simple requests that do not depend on the BUFR
103 C edition number.
104 
105  IF(s01mnem.EQ.'LENM') THEN
106  iret = iupb(mbay,5,24)
107  RETURN
108  ENDIF
109 
110  len0 = 8
111  IF(s01mnem.EQ.'LEN0') THEN
112  iret = len0
113  RETURN
114  ENDIF
115 
116 C Get the BUFR edition number.
117 
118  iben = iupb(mbay,8,8)
119  IF(s01mnem.EQ.'BEN') THEN
120  iret = iben
121  RETURN
122  ENDIF
123 
124 C Use the BUFR edition number to handle any other requests.
125 
126  CALL gets1loc(s01mnem,iben,isbyt,iwid,iretgs)
127  IF(iretgs.EQ.0) THEN
128  iret = iupb(mbay,len0+isbyt,iwid)
129  IF(s01mnem.EQ.'CENT') THEN
130 
131 C Test whether the returned value was a valid
132 C century value.
133 
134  IF(.NOT.ok4cent(iret)) iret = -1
135  ENDIF
136  ELSE IF( (s01mnem.EQ.'YEAR') .AND. (iben.LT.4) ) THEN
137 
138 C Calculate the 4-digit year.
139 
140  iyoc = iupb(mbay,21,8)
141  icen = iupb(mbay,26,8)
142 
143 C Does ICEN contain a valid century value?
144 
145  IF(ok4cent(icen)) THEN
146 
147 C YES, so use it to calculate the 4-digit year. Note that,
148 C by international convention, the year 2000 was the 100th
149 C year of the 20th century, and the year 2001 was the 1st
150 C year of the 21st century
151 
152  iret = (icen-1)*100 + iyoc
153  ELSE
154 
155 C NO, so use a windowing technique to determine the
156 C 4-digit year from the year of the century.
157 
158  iret = i4dy(mod(iyoc,100)*1000000)/10**6
159  ENDIF
160  ELSE
161  iret = -1
162  ENDIF
163 
164  RETURN
165  END
recursive subroutine gets1loc(S1MNEM, IBEN, ISBYT, IWID, IRET)
This subroutine returns the location of a specified value within Section 1 of a BUFR message.
Definition: gets1loc.f:57
recursive function i4dy(IDATE)
This function converts a date-time with a 2-digit year (YYMMDDHH) to a date-time with a 4-digit year ...
Definition: i4dy.f:24
recursive function iupb(MBAY, NBYT, NBIT)
Decode an integer value from an integer array.
Definition: iupb.f:21
recursive function iupbs01(MBAY, S01MNEM)
Read a data value from Section 0 or Section 1 of a BUFR message.
Definition: iupbs01.f:69
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 ...
subroutine wrdlen
Determine important information about the local machine.
Definition: wrdlen.F:25