ungrib build
[WPS.git] / ungrib / src / ngl / g2 / getgb2.f
blob847911e1b33032512609af8bf8b75c242a97b676
1 C-----------------------------------------------------------------------
2 SUBROUTINE GETGB2(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
3 & UNPACK,K,GFLD,IRET)
4 C$$$ SUBPROGRAM DOCUMENTATION BLOCK
6 C SUBPROGRAM: GETGB2 FINDS AND UNPACKS A GRIB MESSAGE
7 C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01
9 C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE.
10 C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF)
11 C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE.
12 C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED.
13 C THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP
14 C AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
15 C PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER
16 C OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
17 C IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE
18 C GRIB FILE AND UNPACKED. ITS NUMBER IS RETURNED ALONG WITH
19 C THE ASSOCIATED UNPACKED PARAMETERS. THE BITMAP (IF ANY),
20 C AND THE DATA VALUES ARE UNPACKED ONLY IF ARGUMENT "UNPACK" IS SET TO
21 C TRUE. IF THE GRIB FIELD IS NOT FOUND, THEN THE
22 C RETURN CODE WILL BE NONZERO.
24 C The decoded information for the selected GRIB field
25 C is returned in a derived type variable, gfld.
26 C Gfld is of type gribfield, which is defined
27 C in module grib_mod, so users of this routine will need to include
28 C the line "USE GRIB_MOD" in their calling routine. Each component of the
29 C gribfield type is described in the OUTPUT ARGUMENT LIST section below.
31 C PROGRAM HISTORY LOG:
32 C 94-04-01 IREDELL
33 C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS
34 C AND ALLOWED FOR UNSPECIFIED INDEX FILE
35 C 2002-01-11 GILBERT MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2
36 C 2015-11-10 VUONG MODIFIED DOC BLOCK FOR gfld%ngrdpts and gfld%ndpts
38 C USAGE: CALL GETGB2(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
39 C & UNPACK,K,GFLD,IRET)
40 C INPUT ARGUMENTS:
41 C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
42 C FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING
43 C THIS ROUTINE.
44 C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
45 C IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE
46 C CALLING THIS ROUTINE.
47 C >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T
48 C ALREADY EXIST.
49 C =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX
50 C DOESN"T ALREADY EXIST.
51 C <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI).
52 C =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB.
53 C J INTEGER NUMBER OF FIELDS TO SKIP
54 C (=0 TO SEARCH FROM BEGINNING)
55 C JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
56 C ( IF = -1, ACCEPT ANY DISCIPLINE)
57 C ( SEE CODE TABLE 0.0 )
58 C 0 - Meteorological products
59 C 1 - Hydrological products
60 C 2 - Land surface products
61 C 3 - Space products
62 C 10 - Oceanographic products
63 C JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
64 C (=-9999 FOR WILDCARD)
65 C JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE
66 C ( SEE COMMON CODE TABLE C-1 )
67 C JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE
68 C JIDS(3) = GRIB MASTER TABLES VERSION NUMBER
69 C ( SEE CODE TABLE 1.0 )
70 C 0 - Experimental
71 C 1 - Initial operational version number
72 C JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER
73 C ( SEE CODE TABLE 1.1 )
74 C 0 - Local tables not used
75 C 1-254 - Number of local tables version used
76 C JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
77 C 0 - Analysis
78 C 1 - Start of forecast
79 C 2 - Verifying time of forecast
80 C 3 - Observation time
81 C JIDS(6) = YEAR ( 4 DIGITS )
82 C JIDS(7) = MONTH
83 C JIDS(8) = DAY
84 C JIDS(9) = HOUR
85 C JIDS(10) = MINUTE
86 C JIDS(11) = SECOND
87 C JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA
88 C ( SEE CODE TABLE 1.3 )
89 C 0 - Operational products
90 C 1 - Operational test products
91 C 2 - Research products
92 C 3 - Re-analysis products
93 C JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
94 C 0 - Analysis products
95 C 1 - Forecast products
96 C 2 - Analysis and forecast products
97 C 3 - Control forecast products
98 C 4 - Perturbed forecast products
99 C 5 - Control and perturbed forecast products
100 C 6 - Processed satellite observations
101 C 7 - Processed radar observations
102 C JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
103 C ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY )
104 C JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
105 C TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
106 C (=-9999 FOR WILDCARD)
107 C JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
108 C ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY )
109 C JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
110 C TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
111 C (=-9999 FOR WILDCARD)
112 C UNPACK LOGICAL VALUE INDICATING WHETHER TO UNPACK BITMAP/DATA
113 C .TRUE. = UNPACK BITMAP AND DATA VALUES
114 C .FALSE. = DO NOT UNPACK BITMAP AND DATA VALUES
116 C OUTPUT ARGUMENTS:
117 C K INTEGER FIELD NUMBER UNPACKED
118 C gfld - derived type gribfield ( defined in module grib_mod )
119 C ( NOTE: See Remarks Section )
120 C gfld%version = GRIB edition number ( currently 2 )
121 C gfld%discipline = Message Discipline ( see Code Table 0.0 )
122 C gfld%idsect() = Contains the entries in the Identification
123 C Section ( Section 1 )
124 C This element is actually a pointer to an array
125 C that holds the data.
126 C gfld%idsect(1) = Identification of originating Centre
127 C ( see Common Code Table C-1 )
128 C 7 - US National Weather Service
129 C gfld%idsect(2) = Identification of originating Sub-centre
130 C gfld%idsect(3) = GRIB Master Tables Version Number
131 C ( see Code Table 1.0 )
132 C 0 - Experimental
133 C 1 - Initial operational version number
134 C gfld%idsect(4) = GRIB Local Tables Version Number
135 C ( see Code Table 1.1 )
136 C 0 - Local tables not used
137 C 1-254 - Number of local tables version used
138 C gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
139 C 0 - Analysis
140 C 1 - Start of forecast
141 C 2 - Verifying time of forecast
142 C 3 - Observation time
143 C gfld%idsect(6) = Year ( 4 digits )
144 C gfld%idsect(7) = Month
145 C gfld%idsect(8) = Day
146 C gfld%idsect(9) = Hour
147 C gfld%idsect(10) = Minute
148 C gfld%idsect(11) = Second
149 C gfld%idsect(12) = Production status of processed data
150 C ( see Code Table 1.3 )
151 C 0 - Operational products
152 C 1 - Operational test products
153 C 2 - Research products
154 C 3 - Re-analysis products
155 C gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
156 C 0 - Analysis products
157 C 1 - Forecast products
158 C 2 - Analysis and forecast products
159 C 3 - Control forecast products
160 C 4 - Perturbed forecast products
161 C 5 - Control and perturbed forecast products
162 C 6 - Processed satellite observations
163 C 7 - Processed radar observations
164 C gfld%idsectlen = Number of elements in gfld%idsect().
165 C gfld%local() = Pointer to character array containing contents
166 C of Local Section 2, if included
167 C gfld%locallen = length of array gfld%local()
168 C gfld%ifldnum = field number within GRIB message
169 C gfld%griddef = Source of grid definition (see Code Table 3.0)
170 C 0 - Specified in Code table 3.1
171 C 1 - Predetermined grid Defined by originating centre
172 C gfld%ngrdpts = Number of grid points in the defined grid.
173 C Note that the number of actual data values returned from
174 C getgb2 (in gfld%ndpts) may be less than this value if a
175 C logical bitmap is in use with grid points that are being masked out.
176 C gfld%numoct_opt = Number of octets needed for each
177 C additional grid points definition.
178 C Used to define number of
179 C points in each row ( or column ) for
180 C non-regular grids.
181 C = 0, if using regular grid.
182 C gfld%interp_opt = Interpretation of list for optional points
183 C definition. (Code Table 3.11)
184 C gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
185 C gfld%igdtmpl() = Contains the data values for the specified Grid
186 C Definition Template ( NN=gfld%igdtnum ). Each
187 C element of this integer array contains an entry (in
188 C the order specified) of Grid Defintion Template 3.NN
189 C This element is actually a pointer to an array
190 C that holds the data.
191 C gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
192 C entries in Grid Defintion Template 3.NN
193 C ( NN=gfld%igdtnum ).
194 C gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
195 C contains the number of grid points contained in
196 C each row ( or column ). (part of Section 3)
197 C This element is actually a pointer to an array
198 C that holds the data. This pointer is nullified
199 C if gfld%numoct_opt=0.
200 C gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
201 C in array ideflist. i.e. number of rows ( or columns )
202 C for which optional grid points are defined. This value
203 C is set to zero, if gfld%numoct_opt=0.
204 C gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
205 C gfld%ipdtmpl() = Contains the data values for the specified Product
206 C Definition Template ( N=gfdl%ipdtnum ). Each element
207 C of this integer array contains an entry (in the
208 C order specified) of Product Defintion Template 4.N.
209 C This element is actually a pointer to an array
210 C that holds the data.
211 C gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
212 C entries in Product Defintion Template 4.N
213 C ( N=gfdl%ipdtnum ).
214 C gfld%coord_list() = Real array containing floating point values
215 C intended to document the vertical discretisation
216 C associated to model data on hybrid coordinate
217 C vertical levels. (part of Section 4)
218 C This element is actually a pointer to an array
219 C that holds the data.
220 C gfld%num_coord = number of values in array gfld%coord_list().
221 C gfld%ndpts = Number of data points unpacked and returned.
222 C Note that this number may be different from the value of
223 C gfld%ngrdpts if a logical bitmap is in use with grid points
224 C that are being masked out.
225 C gfld%idrtnum = Data Representation Template Number
226 C ( see Code Table 5.0)
227 C gfld%idrtmpl() = Contains the data values for the specified Data
228 C Representation Template ( N=gfld%idrtnum ). Each
229 C element of this integer array contains an entry
230 C (in the order specified) of Product Defintion
231 C Template 5.N.
232 C This element is actually a pointer to an array
233 C that holds the data.
234 C gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
235 C of entries in Data Representation Template 5.N
236 C ( N=gfld%idrtnum ).
237 C gfld%unpacked = logical value indicating whether the bitmap and
238 C data values were unpacked. If false,
239 C gfld%bmap and gfld%fld pointers are nullified.
240 C gfld%expanded = Logical value indicating whether the data field
241 C was expanded to the grid in the case where a
242 C bit-map is present. If true, the data points in
243 C gfld%fld match the grid points and zeros were
244 C inserted at grid points where data was bit-mapped
245 C out. If false, the data values in gfld%fld were
246 C not expanded to the grid and are just a consecutive
247 C array of data points corresponding to each value of
248 C "1" in gfld%bmap.
249 C gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
250 C 0 = bitmap applies and is included in Section 6.
251 C 1-253 = Predefined bitmap applies
252 C 254 = Previously defined bitmap applies to this field
253 C 255 = Bit map does not apply to this product.
254 C gfld%bmap() = Logical*1 array containing decoded bitmap,
255 C if ibmap=0 or ibap=254. Otherwise nullified.
256 C This element is actually a pointer to an array
257 C that holds the data.
258 C gfld%fld() = Array of gfld%ndpts unpacked data points.
259 C This element is actually a pointer to an array
260 C that holds the data.
261 C IRET INTEGER RETURN CODE
262 C 0 ALL OK
263 C 96 ERROR READING INDEX
264 C 97 ERROR READING GRIB FILE
265 C 99 REQUEST NOT FOUND
266 C OTHER GF_GETFLD GRIB2 UNPACKER RETURN CODE
268 C SUBPROGRAMS CALLED:
269 C GETIDX GET INDEX
270 C GETGB2S SEARCH INDEX RECORDS
271 C GETGB2R READ AND UNPACK GRIB RECORD
272 C GF_FREE FREES MEMORY USED BY GFLD ( SEE REMARKS )
274 C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED.
275 C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
277 C Note that derived type gribfield contains pointers to many
278 C arrays of data. The memory for these arrays is allocated
279 C when the values in the arrays are set, to help minimize
280 C problems with array overloading. Because of this users
281 C are encouraged to free up this memory, when it is no longer
282 C needed, by an explicit call to subroutine gf_free.
283 C ( i.e. CALL GF_FREE(GFLD) )
285 C ATTRIBUTES:
286 C LANGUAGE: FORTRAN 90
288 C$$$
289 USE GRIB_MOD
291 INTEGER,INTENT(IN) :: LUGB,LUGI,J,JDISC,JPDTN,JGDTN
292 INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*)
293 LOGICAL,INTENT(IN) :: UNPACK
294 INTEGER,INTENT(OUT) :: K,IRET
295 TYPE(GRIBFIELD),INTENT(OUT) :: GFLD
297 CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
299 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
300 C DECLARE INTERFACES (REQUIRED FOR CBUF POINTER)
301 INTERFACE
302 SUBROUTINE GETIDX(LUGB,LUGI,CBUF,NLEN,NNUM,IRGI)
303 CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
304 INTEGER,INTENT(IN) :: LUGB,LUGI
305 INTEGER,INTENT(OUT) :: NLEN,NNUM,IRGI
306 END SUBROUTINE GETIDX
307 END INTERFACE
308 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
309 C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED
310 IRGI=0
311 CALL GETIDX(LUGB,LUGI,CBUF,NLEN,NNUM,IRGI)
312 IF(IRGI.GT.1) THEN
313 IRET=96
314 RETURN
315 ENDIF
316 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
317 C SEARCH INDEX BUFFER
318 CALL GETGB2S(CBUF,NLEN,NNUM,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
319 & JK,GFLD,LPOS,IRGS)
320 IF(IRGS.NE.0) THEN
321 IRET=99
322 CALL GF_FREE(GFLD)
323 RETURN
324 ENDIF
325 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
326 C READ LOCAL USE SECTION, IF AVAILABLE
327 CALL GETGB2L(LUGB,CBUF(LPOS),GFLD,IRET)
328 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
329 C READ AND UNPACK GRIB RECORD
330 IF (UNPACK) THEN
331 ! NUMFLD=GFLD%IFLDNUM
332 ! CALL GF_FREE(GFLD)
333 CALL GETGB2R(LUGB,CBUF(LPOS),GFLD,IRET)
334 ENDIF
335 K=JK
336 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
337 RETURN