| blob | 4b7becdc03f6e0130f2c811fe4806dba93a42d43 |
1 C-----------------------------------------------------------------------
2 SUBROUTINE GETGB2S(CBUF,NLEN,NNUM,J,GUESS,JDISC,JIDS,JPDTN,JPDT,
3 & JGDTN,JGDT,K,GFLD,LPOS,IRET)
4 C$$$ SUBPROGRAM DOCUMENTATION BLOCK
5 C
6 C SUBPROGRAM: GETGB2S FINDS A GRIB MESSAGE
7 C PRGMMR: GILBERT ORG: W/NP11 DATE: 02-01-15
8 C
9 C ABSTRACT: FIND A GRIB MESSAGE.
10 C FIND IN THE INDEX FILE A REFERENCE TO THE GRIB FIELD REQUESTED.
11 C THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP
12 C AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
13 C PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER
14 C OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
15 C
16 C EACH INDEX RECORD HAS THE FOLLOWING FORM:
17 C BYTE 001 - 004: LENGTH OF INDEX RECORD
18 C BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
19 C BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
20 C SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
21 C BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
22 C BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
23 C BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
24 C BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
25 C BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
26 C BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
27 C BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
28 C BYTE 042 - 042: MESSAGE DISCIPLINE
29 C BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
30 C BYTE 045 - II: IDENTIFICATION SECTION (IDS)
31 C BYTE II+1- JJ: GRID DEFINITION SECTION (GDS)
32 C BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS)
33 C BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS)
34 C BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
35 C
36 C Most of the decoded information for the selected GRIB field
37 C is returned in a derived type variable, gfld.
38 C Gfld is of type gribfield, which is defined
39 C in module grib_mod, so users of this routine will need to include
40 C the line "USE GRIB_MOD" in their calling routine. Each component of the
41 C gribfield type is described in the OUTPUT ARGUMENT LIST section below.
42 C Only the unpacked bitmap and data field components are not set by this
43 C routine.
44 C
45 C PROGRAM HISTORY LOG:
46 C 95-10-31 IREDELL
47 C 2002-01-02 GILBERT MODIFIED FROM GETG1S TO WORK WITH GRIB2
48 C
49 C USAGE: CALL GETGB2S(CBUF,NLEN,NNUM,J,GUESS,JDISC,JIDS,JPDTN,JPDT,JGDTN,
50 C & JGDT,K,GFLD,LPOS,IRET)
51 C INPUT ARGUMENTS:
52 C CBUF CHARACTER*1 (NLEN) BUFFER CONTAINING INDEX DATA
53 C NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
54 C NNUM INTEGER NUMBER OF INDEX RECORDS
55 C J INTEGER NUMBER OF MESSAGES TO SKIP
56 C (=0 TO SEARCH FROM BEGINNING)
57 C GUESS A GUESS FOR THE INDEX OF THE GRIB RECORD THAT CONTAINS
58 C THE REQUESTED DATA. IF GUESS IS CORRECT, SEARCHING
59 C CAN BE SIGNFICANTLY FASTER, ESPECIALLY FOR FILES
60 C WITH MANY RECORDS. IF GUESS IS WRONG OR MISSING (<0),
61 C ALL RECORDS ARE SEARCHED
62 C JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
63 C ( IF = -1, ACCEPT ANY DISCIPLINE)
64 C ( SEE CODE TABLE 0.0 )
65 C 0 - Meteorological products
66 C 1 - Hydrological products
67 C 2 - Land surface products
68 C 3 - Space products
69 C 10 - Oceanographic products
70 C JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
71 C (=-9999 FOR WILDCARD)
72 C JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE
73 C ( SEE COMMON CODE TABLE C-1 )
74 C JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE
75 C JIDS(3) = GRIB MASTER TABLES VERSION NUMBER
76 C ( SEE CODE TABLE 1.0 )
77 C 0 - Experimental
78 C 1 - Initial operational version number
79 C JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER
80 C ( SEE CODE TABLE 1.1 )
81 C 0 - Local tables not used
82 C 1-254 - Number of local tables version used
83 C JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
84 C 0 - Analysis
85 C 1 - Start of forecast
86 C 2 - Verifying time of forecast
87 C 3 - Observation time
88 C JIDS(6) = YEAR ( 4 DIGITS )
89 C JIDS(7) = MONTH
90 C JIDS(8) = DAY
91 C JIDS(9) = HOUR
92 C JIDS(10) = MINUTE
93 C JIDS(11) = SECOND
94 C JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA
95 C ( SEE CODE TABLE 1.3 )
96 C 0 - Operational products
97 C 1 - Operational test products
98 C 2 - Research products
99 C 3 - Re-analysis products
100 C JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
101 C 0 - Analysis products
102 C 1 - Forecast products
103 C 2 - Analysis and forecast products
104 C 3 - Control forecast products
105 C 4 - Perturbed forecast products
106 C 5 - Control and perturbed forecast products
107 C 6 - Processed satellite observations
108 C 7 - Processed radar observations
109 C JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
110 C ( IF = -1, DON'T BOTHER MATCHING PDT )
111 C JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
112 C TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
113 C (=-9999 FOR WILDCARD)
114 C JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
115 C ( IF = -1, DON'T BOTHER MATCHING GDT )
116 C JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
117 C TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
118 C (=-9999 FOR WILDCARD)
119 C OUTPUT ARGUMENTS:
120 C K INTEGER MESSAGE NUMBER FOUND
121 C (CAN BE SAME AS J IN CALLING PROGRAM
122 C IN ORDER TO FACILITATE MULTIPLE SEARCHES)
123 C gfld - derived type gribfield ( defined in module grib_mod )
124 C ( NOTE: See Remarks Section )
125 C gfld%version = GRIB edition number ( currently 2 )
126 C gfld%discipline = Message Discipline ( see Code Table 0.0 )
127 C gfld%idsect() = Contains the entries in the Identification
128 C Section ( Section 1 )
129 C This element is actually a pointer to an array
130 C that holds the data.
131 C gfld%idsect(1) = Identification of originating Centre
132 C ( see Common Code Table C-1 )
133 C 7 - US National Weather Service
134 C gfld%idsect(2) = Identification of originating Sub-centre
135 C gfld%idsect(3) = GRIB Master Tables Version Number
136 C ( see Code Table 1.0 )
137 C 0 - Experimental
138 C 1 - Initial operational version number
139 C gfld%idsect(4) = GRIB Local Tables Version Number
140 C ( see Code Table 1.1 )
141 C 0 - Local tables not used
142 C 1-254 - Number of local tables version used
143 C gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
144 C 0 - Analysis
145 C 1 - Start of forecast
146 C 2 - Verifying time of forecast
147 C 3 - Observation time
148 C gfld%idsect(6) = Year ( 4 digits )
149 C gfld%idsect(7) = Month
150 C gfld%idsect(8) = Day
151 C gfld%idsect(9) = Hour
152 C gfld%idsect(10) = Minute
153 C gfld%idsect(11) = Second
154 C gfld%idsect(12) = Production status of processed data
155 C ( see Code Table 1.3 )
156 C 0 - Operational products
157 C 1 - Operational test products
158 C 2 - Research products
159 C 3 - Re-analysis products
160 C gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
161 C 0 - Analysis products
162 C 1 - Forecast products
163 C 2 - Analysis and forecast products
164 C 3 - Control forecast products
165 C 4 - Perturbed forecast products
166 C 5 - Control and perturbed forecast products
167 C 6 - Processed satellite observations
168 C 7 - Processed radar observations
169 C gfld%idsectlen = Number of elements in gfld%idsect().
170 C gfld%local() = Pointer to character array containing contents
171 C of Local Section 2, if included
172 C gfld%locallen = length of array gfld%local()
173 C gfld%ifldnum = field number within GRIB message
174 C gfld%griddef = Source of grid definition (see Code Table 3.0)
175 C 0 - Specified in Code table 3.1
176 C 1 - Predetermined grid Defined by originating centre
177 C gfld%ngrdpts = Number of grid points in the defined grid.
178 C gfld%numoct_opt = Number of octets needed for each
179 C additional grid points definition.
180 C Used to define number of
181 C points in each row ( or column ) for
182 C non-regular grids.
183 C = 0, if using regular grid.
184 C gfld%interp_opt = Interpretation of list for optional points
185 C definition. (Code Table 3.11)
186 C gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
187 C gfld%igdtmpl() = Contains the data values for the specified Grid
188 C Definition Template ( NN=gfld%igdtnum ). Each
189 C element of this integer array contains an entry (in
190 C the order specified) of Grid Defintion Template 3.NN
191 C This element is actually a pointer to an array
192 C that holds the data.
193 C gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
194 C entries in Grid Defintion Template 3.NN
195 C ( NN=gfld%igdtnum ).
196 C gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
197 C contains the number of grid points contained in
198 C each row ( or column ). (part of Section 3)
199 C This element is actually a pointer to an array
200 C that holds the data. This pointer is nullified
201 C if gfld%numoct_opt=0.
202 C gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
203 C in array ideflist. i.e. number of rows ( or columns )
204 C for which optional grid points are defined. This value
205 C is set to zero, if gfld%numoct_opt=0.
206 C gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
207 C gfld%ipdtmpl() = Contains the data values for the specified Product
208 C Definition Template ( N=gfdl%ipdtnum ). Each element
209 C of this integer array contains an entry (in the
210 C order specified) of Product Defintion Template 4.N.
211 C This element is actually a pointer to an array
212 C that holds the data.
213 C gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
214 C entries in Product Defintion Template 4.N
215 C ( N=gfdl%ipdtnum ).
216 C gfld%coord_list() = Real array containing floating point values
217 C intended to document the vertical discretisation
218 C associated to model data on hybrid coordinate
219 C vertical levels. (part of Section 4)
220 C This element is actually a pointer to an array
221 C that holds the data.
222 C gfld%num_coord = number of values in array gfld%coord_list().
223 C gfld%ndpts = Number of data points unpacked and returned.
224 C gfld%idrtnum = Data Representation Template Number
225 C ( see Code Table 5.0)
226 C gfld%idrtmpl() = Contains the data values for the specified Data
227 C Representation Template ( N=gfld%idrtnum ). Each
228 C element of this integer array contains an entry
229 C (in the order specified) of Product Defintion
230 C Template 5.N.
231 C This element is actually a pointer to an array
232 C that holds the data.
233 C gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
234 C of entries in Data Representation Template 5.N
235 C ( N=gfld%idrtnum ).
236 C gfld%unpacked = logical value indicating whether the bitmap and
237 C data values were unpacked. If false,
238 C gfld%bmap and gfld%fld pointers are nullified.
239 C NOTE: This routine sets this component to .FALSE.
240 C gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
241 C 0 = bitmap applies and is included in Section 6.
242 C 1-253 = Predefined bitmap applies
243 C 254 = Previously defined bitmap applies to this field
244 C 255 = Bit map does not apply to this product.
245 C gfld%bmap() = Logical*1 array containing decoded bitmap,
246 C if ibmap=0 or ibap=254. Otherwise nullified.
247 C This element is actually a pointer to an array
248 C that holds the data.
249 C NOTE: This component is not set by this routine.
250 C gfld%fld() = Array of gfld%ndpts unpacked data points.
251 C This element is actually a pointer to an array
252 C that holds the data.
253 C NOTE: This component is not set by this routine.
254 C LPOS STARTING POSITION OF THE FOUND INDEX RECORD WITHIN
255 C THE COMPLETE INDEX BUFFER, CBUF.
256 C = 0, IF REQUEST NOT FOUND
257 C IRET INTEGER RETURN CODE
258 C 0 ALL OK
259 C 1 REQUEST NOT FOUND
260 C
261 C REMARKS:
262 C THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
263 C
264 C Note that derived type gribfield contains pointers to many
265 C arrays of data. The memory for these arrays is allocated
266 C when the values in the arrays are set, to help minimize
267 C problems with array overloading. Because of this users
268 C are encouraged to free up this memory, when it is no longer
269 C needed, by an explicit call to subroutine gf_free.
270 C ( i.e. CALL GF_FREE(GFLD) )
271 C
272 C SUBPROGRAMS CALLED:
273 C G2LIB_GBYTE UNPACK BYTES
274 C GF_UNPACK1 UNPACK IDS
275 C GF_UNPACK4 UNPACK PDS
276 C GF_UNPACK3 UNPACK GDS
277 C
278 C ATTRIBUTES:
279 C LANGUAGE: FORTRAN 90
280 C
281 C$$$
282 USE GRIB_MOD
284 ! CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
285 CHARACTER(LEN=1),INTENT(IN) :: CBUF(NLEN)
286 INTEGER,INTENT(IN) :: NLEN,NNUM,J,JDISC,JPDTN,JGDTN
287 INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*)
288 INTEGER,INTENT(OUT) :: K,LPOS,IRET
289 TYPE(GRIBFIELD),INTENT(OUT) :: GFLD
290 INTEGER,INTENT(IN) :: GUESS
291 INTEGER :: KGDS(5)
292 LOGICAL :: MATCH1,MATCH3,MATCH4
293 INTEGER :: SKIP
294 INTEGER :: LOOPNUM
295 logical :: skip2
296 ! INTEGER,POINTER,DIMENSION(:) :: KIDS,KPDT,KGDT
297 ! INTEGER,POINTER,DIMENSION(:) :: IDEF
298 ! REAL,POINTER,DIMENSION(:) :: COORD
300 interface
301 subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
302 character(len=1),intent(in) :: cgrib(lcgrib)
303 integer,intent(in) :: lcgrib
304 integer,intent(inout) :: iofst
305 integer,pointer,dimension(:) :: ids
306 integer,intent(out) :: ierr,idslen
307 end subroutine gf_unpack1
308 subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
309 & mapgridlen,ideflist,idefnum,ierr)
310 character(len=1),intent(in) :: cgrib(lcgrib)
311 integer,intent(in) :: lcgrib
312 integer,intent(inout) :: iofst
313 integer,pointer,dimension(:) :: igdstmpl,ideflist
314 integer,intent(out) :: igds(5)
315 integer,intent(out) :: ierr,idefnum
316 end subroutine gf_unpack3
317 subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,
318 & mappdslen,coordlist,numcoord,ierr)
319 character(len=1),intent(in) :: cgrib(lcgrib)
320 integer,intent(in) :: lcgrib
321 integer,intent(inout) :: iofst
322 real,pointer,dimension(:) :: coordlist
323 integer,pointer,dimension(:) :: ipdstmpl
324 integer,intent(out) :: ipdsnum
325 integer,intent(out) :: ierr,numcoord
326 end subroutine gf_unpack4
327 subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,
328 & idrstmpl,mapdrslen,ierr)
329 character(len=1),intent(in) :: cgrib(lcgrib)
330 integer,intent(in) :: lcgrib
331 integer,intent(inout) :: iofst
332 integer,intent(out) :: ndpts,idrsnum
333 integer,pointer,dimension(:) :: idrstmpl
334 integer,intent(out) :: ierr
335 end subroutine gf_unpack5
336 end interface
338 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
339 C INITIALIZE
342 K=0
343 SKIP = J
344 LPOS=0
345 IRET=1
346 IPOS=0
347 LOOPNUM = 1
348 skip2 = .false.
349 nullify(gfld%list_opt,gfld%igdtmpl,gfld%ipdtmpl)
350 nullify(gfld%coord_list,gfld%idrtmpl,gfld%bmap,gfld%fld)
351 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
352 C SEARCH FOR REQUEST
353 DOWHILE(IRET.NE.0)
355 if (guess .gt. 0) then
356 if (loopnum .eq. 1) then
358 ! Check if we are at end of data., If so, search from beginning
359 if (k .ge. NNUM) then
360 loopnum = loopnum + 1
361 cycle
362 endif
364 ! Set first search to be the guess index.
365 SKIP = guess - 1
367 else if (loopnum .eq. 2) then
369 ! Set 2nd search to start from beginning.
370 if (.not. skip2) then
371 SKIP = J
372 K = 0
373 ipos = 0
374 skip2 = .true.
375 endif
377 endif
378 endif
380 if (k .ge. NNUM) then
381 exit
382 endif
385 K=K+1
386 CALL G2LIB_GBYTE(CBUF,INLEN,IPOS*8,4*8) ! GET LENGTH OF CURRENT
387 ! INDEX RECORD
389 IF ( K.LE.SKIP ) THEN ! SKIP THIS INDEX
390 IPOS=IPOS+INLEN
391 CYCLE
392 ELSE
393 LOOPNUM = LOOPNUM + 1
394 ENDIF
396 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
397 C CHECK IF GRIB2 DISCIPLINE IS A MATCH
398 CALL G2LIB_GBYTE(CBUF,GFLD%DISCIPLINE,(IPOS+41)*8,1*8)
399 IF ( (JDISC.NE.-1).AND.(JDISC.NE.GFLD%DISCIPLINE) ) THEN
400 IPOS=IPOS+INLEN
401 CYCLE
402 ENDIF
403 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
404 C CHECK IF IDENTIFICATION SECTION IS A MATCH
405 MATCH1=.FALSE.
406 CALL G2LIB_GBYTE(CBUF,LSEC1,(IPOS+44)*8,4*8) ! GET LENGTH OF IDS
407 IOF=0
408 CALL GF_UNPACK1(CBUF(IPOS+45),LSEC1,IOF,GFLD%IDSECT,
409 & GFLD%IDSECTLEN,ICND)
410 IF ( ICND.EQ.0 ) THEN
411 MATCH1=.TRUE.
412 DO I=1,GFLD%IDSECTLEN
413 IF ( (JIDS(I).NE.-9999).AND.
414 & (JIDS(I).NE.GFLD%IDSECT(I)) ) THEN
415 MATCH1=.FALSE.
416 EXIT
417 ENDIF
418 ENDDO
419 ENDIF
420 IF ( .NOT. MATCH1 ) THEN
421 DEALLOCATE(GFLD%IDSECT)
422 IPOS=IPOS+INLEN
423 CYCLE
424 ENDIF
425 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
426 C CHECK IF GRID DEFINITION TEMPLATE IS A MATCH
427 JPOS=IPOS+44+LSEC1
428 MATCH3=.FALSE.
429 CALL G2LIB_GBYTE(CBUF,LSEC3,JPOS*8,4*8) ! GET LENGTH OF GDS
430 IF ( JGDTN.EQ.-1 ) THEN
431 MATCH3=.TRUE.
432 ELSE
433 CALL G2LIB_GBYTE(CBUF,NUMGDT,(JPOS+12)*8,2*8) ! GET GDT TEMPLATE NO.
434 IF ( JGDTN.EQ.NUMGDT ) THEN
435 IOF=0
436 CALL GF_UNPACK3(CBUF(JPOS+1),LSEC3,IOF,KGDS,GFLD%IGDTMPL,
437 & GFLD%IGDTLEN,GFLD%LIST_OPT,GFLD%NUM_OPT,ICND)
438 IF ( ICND.EQ.0 ) THEN
439 MATCH3=.TRUE.
440 DO I=1,GFLD%IGDTLEN
441 IF ( (JGDT(I).NE.-9999).AND.
442 & (JGDT(I).NE.GFLD%IGDTMPL(I)) ) THEN
443 MATCH3=.FALSE.
444 EXIT
445 ENDIF
446 ENDDO
447 C WHERE ( JGDT(1:GFLD%IGDTLEN).NE.-9999 )
448 C & MATCH3=ALL(JGDT(1:GFLD%IGDTLEN).EQ.GFLD%IGDTMPL(1:GFLD%IGDTLEN))
449 ENDIF
450 ENDIF
451 ENDIF
452 IF ( .NOT. MATCH3 ) THEN
453 IF (ASSOCIATED(GFLD%IGDTMPL)) DEALLOCATE(GFLD%IGDTMPL)
454 IF (ASSOCIATED(GFLD%LIST_OPT)) DEALLOCATE(GFLD%LIST_OPT)
455 IPOS=IPOS+INLEN
456 CYCLE
457 ELSE
458 GFLD%GRIDDEF=KGDS(1)
459 GFLD%NGRDPTS=KGDS(2)
460 GFLD%NUMOCT_OPT=KGDS(3)
461 GFLD%INTERP_OPT=KGDS(4)
462 GFLD%IGDTNUM=KGDS(5)
463 ENDIF
464 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
465 C CHECK IF PRODUCT DEFINITION TEMPLATE IS A MATCH
466 JPOS=JPOS+LSEC3
467 MATCH4=.FALSE.
468 CALL G2LIB_GBYTE(CBUF,LSEC4,JPOS*8,4*8) ! GET LENGTH OF PDS
469 IF ( JPDTN.EQ.-1 ) THEN
470 MATCH4=.TRUE.
471 ELSE
472 CALL G2LIB_GBYTE(CBUF,NUMPDT,(JPOS+7)*8,2*8) ! GET PDT TEMPLATE NO.
473 IF ( JPDTN.EQ.NUMPDT ) THEN
474 IOF=0
475 CALL GF_UNPACK4(CBUF(JPOS+1),LSEC4,IOF,GFLD%IPDTNUM,
476 & GFLD%IPDTMPL,GFLD%IPDTLEN,
477 & GFLD%COORD_LIST,GFLD%NUM_COORD,ICND)
478 IF ( ICND.EQ.0 ) THEN
479 MATCH4=.TRUE.
480 DO I=1,GFLD%IPDTLEN
481 IF ( (JPDT(I).NE.-9999).AND.
482 & (JPDT(I).NE.GFLD%IPDTMPL(I)) ) THEN
483 MATCH4=.FALSE.
484 EXIT
485 ENDIF
486 ENDDO
487 c WHERE ( JPDT.NE.-9999)
488 c & MATCH4=ALL( JPDT(1:GFLD%IPDTLEN) .EQ. GFLD%IPDTMPL(1:GFLD%IPDTLEN) )
489 ENDIF
490 ENDIF
491 ENDIF
492 IF ( .NOT. MATCH4 ) THEN
493 IF (ASSOCIATED(GFLD%IPDTMPL)) DEALLOCATE(GFLD%IPDTMPL)
494 IF (ASSOCIATED(GFLD%COORD_LIST)) DEALLOCATE(GFLD%COORD_LIST)
495 ENDIF
496 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
497 C IF REQUEST IS FOUND
498 C SET VALUES FOR DERIVED TYPE GFLD AND RETURN
499 IF(MATCH1.AND.MATCH3.AND.MATCH4) THEN
500 LPOS=IPOS+1
501 CALL G2LIB_GBYTE(CBUF,GFLD%VERSION,(IPOS+40)*8,1*8)
502 CALL G2LIB_GBYTE(CBUF,GFLD%IFLDNUM,(IPOS+42)*8,2*8)
503 GFLD%UNPACKED=.FALSE.
504 JPOS=IPOS+44+LSEC1
505 IF ( JGDTN.EQ.-1 ) THEN ! UNPACK GDS, IF NOT DONE BEFORE
506 IOF=0
507 CALL GF_UNPACK3(CBUF(JPOS+1),LSEC3,IOF,KGDS,GFLD%IGDTMPL,
508 & GFLD%IGDTLEN,GFLD%LIST_OPT,GFLD%NUM_OPT,ICND)
509 GFLD%GRIDDEF=KGDS(1)
510 GFLD%NGRDPTS=KGDS(2)
511 GFLD%NUMOCT_OPT=KGDS(3)
512 GFLD%INTERP_OPT=KGDS(4)
513 GFLD%IGDTNUM=KGDS(5)
514 ENDIF
515 JPOS=JPOS+LSEC3
516 IF ( JPDTN.EQ.-1 ) THEN ! UNPACK PDS, IF NOT DONE BEFORE
517 IOF=0
518 CALL GF_UNPACK4(CBUF(JPOS+1),LSEC4,IOF,GFLD%IPDTNUM,
519 & GFLD%IPDTMPL,GFLD%IPDTLEN,
520 & GFLD%COORD_LIST,GFLD%NUM_COORD,ICND)
521 ENDIF
522 JPOS=JPOS+LSEC4
523 CALL G2LIB_GBYTE(CBUF,LSEC5,JPOS*8,4*8) ! GET LENGTH OF DRS
524 IOF=0
525 CALL GF_UNPACK5(CBUF(JPOS+1),LSEC5,IOF,GFLD%NDPTS,
526 & GFLD%IDRTNUM,GFLD%IDRTMPL,
527 & GFLD%IDRTLEN,ICND)
528 JPOS=JPOS+LSEC5
529 CALL G2LIB_GBYTE(CBUF,GFLD%IBMAP,(JPOS+5)*8,1*8) ! GET IBMAP
530 IRET=0
531 ELSE ! PDT DID NOT MATCH
532 IPOS=IPOS+INLEN
533 ENDIF
534 ENDDO
535 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
536 RETURN
537 END