| blob | 82a21a0b94b5f0c8ddd744e9681db3026d65d8e3 |
1 subroutine gf_getfld(cgrib,lcgrib,ifldnum,unpack,expand,gfld,ierr)
2 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
3 ! . . . .
4 ! SUBPROGRAM: gf_getfld
5 ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
6 !
7 ! ABSTRACT: This subroutine returns the Grid Definition, Product Definition,
8 ! Bit-map ( if applicable ), and the unpacked data for a given data
9 ! field. All of the information returned is stored in a derived
10 ! type variable, gfld. Gfld is of type gribfield, which is defined
11 ! in module grib_mod, so users of this routine will need to include
12 ! the line "USE GRIB_MOD" in their calling routine. Each component of the
13 ! gribfield type is described in the OUTPUT ARGUMENT LIST section below.
14 !
15 ! Since there can be multiple data fields packed into a GRIB2
16 ! message, the calling routine indicates which field is being requested
17 ! with the ifldnum argument.
18 !
19 ! PROGRAM HISTORY LOG:
20 ! 2000-05-26 Gilbert
21 ! 2002-01-24 Gilbert - Changed to pass back derived type gribfield
22 ! variable through argument list, instead of
23 ! having many different arguments.
24 ! 2004-05-20 Gilbert - Added check to see if previous a bit-map is specified,
25 ! but none was found.
26 !
27 ! USAGE: CALL gf_getfld(cgrib,lcgrib,ifldnum,unpack,expand,gfld,ierr)
28 ! INPUT ARGUMENT LIST:
29 ! cgrib - Character array that contains the GRIB2 message
30 ! lcgrib - Length (in bytes) of GRIB message array cgrib.
31 ! ifldnum - Specifies which field in the GRIB2 message to return.
32 ! unpack - Logical value indicating whether to unpack bitmap/data
33 ! .true. = unpack bitmap and data values
34 ! .false. = do not unpack bitmap and data values
35 ! expand - Boolean value indicating whether the data points should be
36 ! expanded to the correspond grid, if a bit-map is present.
37 ! 1 = if possible, expand data field to grid, inserting zero
38 ! values at gridpoints that are bitmapped out.
39 ! (SEE REMARKS2)
40 ! 0 = do not expand data field, leaving it an array of
41 ! consecutive data points for each "1" in the bitmap.
42 ! This argument is ignored if unpack == 0 OR if the
43 ! returned field does not contain a bit-map.
44 !
45 ! OUTPUT ARGUMENT LIST:
46 ! gfld - derived type gribfield ( defined in module grib_mod )
47 ! ( NOTE: See Remarks Section )
48 ! gfld%version = GRIB edition number ( currently 2 )
49 ! gfld%discipline = Message Discipline ( see Code Table 0.0 )
50 ! gfld%idsect() = Contains the entries in the Identification
51 ! Section ( Section 1 )
52 ! This element is actually a pointer to an array
53 ! that holds the data.
54 ! gfld%idsect(1) = Identification of originating Centre
55 ! ( see Common Code Table C-1 )
56 ! 7 - US National Weather Service
57 ! gfld%idsect(2) = Identification of originating Sub-centre
58 ! gfld%idsect(3) = GRIB Master Tables Version Number
59 ! ( see Code Table 1.0 )
60 ! 0 - Experimental
61 ! 1 - Initial operational version number
62 ! gfld%idsect(4) = GRIB Local Tables Version Number
63 ! ( see Code Table 1.1 )
64 ! 0 - Local tables not used
65 ! 1-254 - Number of local tables version used
66 ! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
67 ! 0 - Analysis
68 ! 1 - Start of forecast
69 ! 2 - Verifying time of forecast
70 ! 3 - Observation time
71 ! gfld%idsect(6) = Year ( 4 digits )
72 ! gfld%idsect(7) = Month
73 ! gfld%idsect(8) = Day
74 ! gfld%idsect(9) = Hour
75 ! gfld%idsect(10) = Minute
76 ! gfld%idsect(11) = Second
77 ! gfld%idsect(12) = Production status of processed data
78 ! ( see Code Table 1.3 )
79 ! 0 - Operational products
80 ! 1 - Operational test products
81 ! 2 - Research products
82 ! 3 - Re-analysis products
83 ! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
84 ! 0 - Analysis products
85 ! 1 - Forecast products
86 ! 2 - Analysis and forecast products
87 ! 3 - Control forecast products
88 ! 4 - Perturbed forecast products
89 ! 5 - Control and perturbed forecast products
90 ! 6 - Processed satellite observations
91 ! 7 - Processed radar observations
92 ! gfld%idsectlen = Number of elements in gfld%idsect().
93 ! gfld%local() = Pointer to character array containing contents
94 ! of Local Section 2, if included
95 ! gfld%locallen = length of array gfld%local()
96 ! gfld%ifldnum = field number within GRIB message
97 ! gfld%griddef = Source of grid definition (see Code Table 3.0)
98 ! 0 - Specified in Code table 3.1
99 ! 1 - Predetermined grid Defined by originating centre
100 ! gfld%ngrdpts = Number of grid points in the defined grid.
101 ! gfld%numoct_opt = Number of octets needed for each
102 ! additional grid points definition.
103 ! Used to define number of
104 ! points in each row ( or column ) for
105 ! non-regular grids.
106 ! = 0, if using regular grid.
107 ! gfld%interp_opt = Interpretation of list for optional points
108 ! definition. (Code Table 3.11)
109 ! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
110 ! gfld%igdtmpl() = Contains the data values for the specified Grid
111 ! Definition Template ( NN=gfld%igdtnum ). Each
112 ! element of this integer array contains an entry (in
113 ! the order specified) of Grid Defintion Template 3.NN
114 ! This element is actually a pointer to an array
115 ! that holds the data.
116 ! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
117 ! entries in Grid Defintion Template 3.NN
118 ! ( NN=gfld%igdtnum ).
119 ! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
120 ! contains the number of grid points contained in
121 ! each row ( or column ). (part of Section 3)
122 ! This element is actually a pointer to an array
123 ! that holds the data. This pointer is nullified
124 ! if gfld%numoct_opt=0.
125 ! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
126 ! in array ideflist. i.e. number of rows ( or columns )
127 ! for which optional grid points are defined. This value
128 ! is set to zero, if gfld%numoct_opt=0.
129 ! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
130 ! gfld%ipdtmpl() = Contains the data values for the specified Product
131 ! Definition Template ( N=gfdl%ipdtnum ). Each element
132 ! of this integer array contains an entry (in the
133 ! order specified) of Product Defintion Template 4.N.
134 ! This element is actually a pointer to an array
135 ! that holds the data.
136 ! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
137 ! entries in Product Defintion Template 4.N
138 ! ( N=gfdl%ipdtnum ).
139 ! gfld%coord_list() = Real array containing floating point values
140 ! intended to document the vertical discretisation
141 ! associated to model data on hybrid coordinate
142 ! vertical levels. (part of Section 4)
143 ! This element is actually a pointer to an array
144 ! that holds the data.
145 ! gfld%num_coord = number of values in array gfld%coord_list().
146 ! gfld%ndpts = Number of data points unpacked and returned.
147 ! gfld%idrtnum = Data Representation Template Number
148 ! ( see Code Table 5.0)
149 ! gfld%idrtmpl() = Contains the data values for the specified Data
150 ! Representation Template ( N=gfld%idrtnum ). Each
151 ! element of this integer array contains an entry
152 ! (in the order specified) of Product Defintion
153 ! Template 5.N.
154 ! This element is actually a pointer to an array
155 ! that holds the data.
156 ! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
157 ! of entries in Data Representation Template 5.N
158 ! ( N=gfld%idrtnum ).
159 ! gfld%unpacked = logical value indicating whether the bitmap and
160 ! data values were unpacked. If false,
161 ! gfld%bmap and gfld%fld pointers are nullified.
162 ! gfld%expanded = Logical value indicating whether the data field
163 ! was expanded to the grid in the case where a
164 ! bit-map is present. If true, the data points in
165 ! gfld%fld match the grid points and zeros were
166 ! inserted at grid points where data was bit-mapped
167 ! out. If false, the data values in gfld%fld were
168 ! not expanded to the grid and are just a consecutive
169 ! array of data points corresponding to each value of
170 ! "1" in gfld%bmap.
171 ! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
172 ! 0 = bitmap applies and is included in Section 6.
173 ! 1-253 = Predefined bitmap applies
174 ! 254 = Previously defined bitmap applies to this field
175 ! 255 = Bit map does not apply to this product.
176 ! gfld%bmap() = Logical*1 array containing decoded bitmap,
177 ! if ibmap=0 or ibap=254. Otherwise nullified.
178 ! This element is actually a pointer to an array
179 ! that holds the data.
180 ! gfld%fld() = Array of gfld%ndpts unpacked data points.
181 ! This element is actually a pointer to an array
182 ! that holds the data.
183 ! ierr - Error return code.
184 ! 0 = no error
185 ! 1 = Beginning characters "GRIB" not found.
186 ! 2 = GRIB message is not Edition 2.
187 ! 3 = The data field request number was not positive.
188 ! 4 = End string "7777" found, but not where expected.
189 ! 6 = GRIB message did not contain the requested number of
190 ! data fields.
191 ! 7 = End string "7777" not found at end of message.
192 ! 8 = Unrecognized Section encountered.
193 ! 9 = Data Representation Template 5.NN not yet implemented.
194 ! 15 = Error unpacking Section 1.
195 ! 16 = Error unpacking Section 2.
196 ! 10 = Error unpacking Section 3.
197 ! 11 = Error unpacking Section 4.
198 ! 12 = Error unpacking Section 5.
199 ! 13 = Error unpacking Section 6.
200 ! 14 = Error unpacking Section 7.
201 ! 17 = Previous bitmap specified, but none exists.
202 !
203 ! REMARKS: Note that derived type gribfield contains pointers to many
204 ! arrays of data. The memory for these arrays is allocated
205 ! when the values in the arrays are set, to help minimize
206 ! problems with array overloading. Because of this users
207 ! are encouraged to free up this memory, when it is no longer
208 ! needed, by an explicit call to subroutine gf_free.
209 ! ( i.e. CALL GF_FREE(GFLD) )
210 !
211 ! Subroutine gb_info can be used to first determine
212 ! how many data fields exist in a given GRIB message.
213 !
214 ! REMARKS2: It may not always be possible to expand a bit-mapped data field.
215 ! If a pre-defined bit-map is used and not included in the GRIB2
216 ! message itself, this routine would not have the necessary
217 ! information to expand the data. In this case, gfld%expanded would
218 ! would be set to 0 (false), regardless of the value of input
219 ! argument expand.
220 !
221 ! ATTRIBUTES:
222 ! LANGUAGE: Fortran 90
223 ! MACHINE: IBM SP
224 !
225 !$$$
226 use grib_mod
228 character(len=1),intent(in) :: cgrib(lcgrib)
229 integer,intent(in) :: lcgrib,ifldnum
230 logical,intent(in) :: unpack,expand
231 type(gribfield),intent(out) :: gfld
232 integer,intent(out) :: ierr
233 ! integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*)
234 ! integer,intent(out) :: ipdsnum,ipdstmpl(*)
235 ! integer,intent(out) :: idrsnum,idrstmpl(*)
236 ! integer,intent(out) :: ndpts,ibmap,idefnum,numcoord
237 ! logical*1,intent(out) :: bmap(*)
238 ! real,intent(out) :: fld(*),coordlist(*)
240 character(len=4),parameter :: grib='GRIB',c7777='7777'
241 character(len=4) :: ctemp
242 real,pointer,dimension(:) :: newfld
243 integer:: listsec0(2),igds(5)
244 integer iofst,ibeg,istart
245 integer(4) :: ieee
246 logical*1,pointer,dimension(:) :: bmpsave
247 logical have3,have4,have5,have6,have7
249 interface
250 subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
251 character(len=1),intent(in) :: cgrib(lcgrib)
252 integer,intent(in) :: lcgrib
253 integer,intent(inout) :: iofst
254 integer,pointer,dimension(:) :: ids
255 integer,intent(out) :: ierr,idslen
256 end subroutine gf_unpack1
257 subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr)
258 character(len=1),intent(in) :: cgrib(lcgrib)
259 integer,intent(in) :: lcgrib
260 integer,intent(inout) :: iofst
261 integer,intent(out) :: lencsec2
262 integer,intent(out) :: ierr
263 character(len=1),pointer,dimension(:) :: csec2
264 end subroutine gf_unpack2
265 subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
266 & mapgridlen,ideflist,idefnum,ierr)
267 character(len=1),intent(in) :: cgrib(lcgrib)
268 integer,intent(in) :: lcgrib
269 integer,intent(inout) :: iofst
270 integer,pointer,dimension(:) :: igdstmpl,ideflist
271 integer,intent(out) :: igds(5)
272 integer,intent(out) :: ierr,idefnum
273 end subroutine gf_unpack3
274 subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,
275 & mappdslen,coordlist,numcoord,ierr)
276 character(len=1),intent(in) :: cgrib(lcgrib)
277 integer,intent(in) :: lcgrib
278 integer,intent(inout) :: iofst
279 real,pointer,dimension(:) :: coordlist
280 integer,pointer,dimension(:) :: ipdstmpl
281 integer,intent(out) :: ipdsnum
282 integer,intent(out) :: ierr,numcoord
283 end subroutine gf_unpack4
284 subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,
285 & idrstmpl,mapdrslen,ierr)
286 character(len=1),intent(in) :: cgrib(lcgrib)
287 integer,intent(in) :: lcgrib
288 integer,intent(inout) :: iofst
289 integer,intent(out) :: ndpts,idrsnum
290 integer,pointer,dimension(:) :: idrstmpl
291 integer,intent(out) :: ierr
292 end subroutine gf_unpack5
293 subroutine gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
294 character(len=1),intent(in) :: cgrib(lcgrib)
295 integer,intent(in) :: lcgrib,ngpts
296 integer,intent(inout) :: iofst
297 integer,intent(out) :: ibmap
298 integer,intent(out) :: ierr
299 logical*1,pointer,dimension(:) :: bmap
300 end subroutine gf_unpack6
301 subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
302 & idrsnum,idrstmpl,ndpts,fld,ierr)
303 character(len=1),intent(in) :: cgrib(lcgrib)
304 integer,intent(in) :: lcgrib,ndpts,idrsnum,igdsnum
305 integer,intent(inout) :: iofst
306 integer,pointer,dimension(:) :: idrstmpl,igdstmpl
307 integer,intent(out) :: ierr
308 real,pointer,dimension(:) :: fld
309 end subroutine gf_unpack7
310 end interface
312 have3=.false.
313 have4=.false.
314 have5=.false.
315 have6=.false.
316 have7=.false.
317 ierr=0
318 numfld=0
319 gfld%locallen=0
320 nullify(gfld%list_opt,gfld%igdtmpl,gfld%ipdtmpl)
321 nullify(gfld%coord_list,gfld%idrtmpl,gfld%bmap,gfld%fld)
322 !
323 ! Check for valid request number
324 !
325 if (ifldnum.le.0) then
326 print *,'gf_getfld: Request for field number must be positive.'
327 ierr=3
328 return
329 endif
330 !
331 ! Check for beginning of GRIB message in the first 100 bytes
332 !
333 istart=0
334 do j=1,100
335 ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
336 if (ctemp.eq.grib ) then
337 istart=j
338 exit
339 endif
340 enddo
341 if (istart.eq.0) then
342 print *,'gf_getfld: Beginning characters GRIB not found.'
343 ierr=1
344 return
345 endif
346 !
347 ! Unpack Section 0 - Indicator Section
348 !
349 iofst=8*(istart+5)
350 call g2lib_gbyte(cgrib,listsec0(1),iofst,8) ! Discipline
351 iofst=iofst+8
352 call g2lib_gbyte(cgrib,listsec0(2),iofst,8) ! GRIB edition number
353 iofst=iofst+8
354 iofst=iofst+32
355 call g2lib_gbyte(cgrib,lengrib,iofst,32) ! Length of GRIB message
356 iofst=iofst+32
357 lensec0=16
358 ipos=istart+lensec0
359 !
360 ! Currently handles only GRIB Edition 2.
361 !
362 if (listsec0(2).ne.2) then
363 print *,'gf_getfld: can only decode GRIB edition 2.'
364 ierr=2
365 return
366 endif
367 !
368 ! Loop through the remaining sections keeping track of the
369 ! length of each. Also keep the latest Grid Definition Section info.
370 ! Unpack the requested field number.
371 !
372 do
373 ! Check to see if we are at end of GRIB message
374 ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
375 if (ctemp.eq.c7777 ) then
376 ipos=ipos+4
377 ! If end of GRIB message not where expected, issue error
378 if (ipos.ne.(istart+lengrib)) then
379 print *,'gf_getfld: "7777" found, but not where expected.'
380 ierr=4
381 return
382 endif
383 exit
384 endif
385 ! Get length of Section and Section number
386 iofst=(ipos-1)*8
387 call g2lib_gbyte(cgrib,lensec,iofst,32) ! Get Length of Section
388 iofst=iofst+32
389 call g2lib_gbyte(cgrib,isecnum,iofst,8) ! Get Section number
390 iofst=iofst+8
391 !print *,' lensec= ',lensec,' secnum= ',isecnum
392 !
393 ! Check to see if section number is valid
394 !
395 if ( (isecnum.lt.1).OR.(isecnum.gt.7) ) then
396 print *,'gf_getfld: Unrecognized Section Encountered=',isecnum
397 ierr=8
398 return
399 endif
400 !
401 ! If found Section 1, decode elements in Identification Section
402 !
403 if (isecnum.eq.1) then
404 iofst=iofst-40 ! reset offset to beginning of section
405 call gf_unpack1(cgrib,lcgrib,iofst,gfld%idsect,
406 & gfld%idsectlen,jerr)
407 if (jerr.ne.0) then
408 ierr=15
409 return
410 endif
411 endif
412 !
413 ! If found Section 2, Grab local section
414 ! Save in case this is the latest one before the requested field.
415 !
416 if (isecnum.eq.2) then
417 iofst=iofst-40 ! reset offset to beginning of section
418 if (associated(gfld%local)) deallocate(gfld%local)
419 call gf_unpack2(cgrib,lcgrib,iofst,gfld%locallen,
420 & gfld%local,jerr)
421 if (jerr.ne.0) then
422 ierr=16
423 return
424 endif
425 endif
426 !
427 ! If found Section 3, unpack the GDS info using the
428 ! appropriate template. Save in case this is the latest
429 ! grid before the requested field.
430 !
431 if (isecnum.eq.3) then
432 iofst=iofst-40 ! reset offset to beginning of section
433 if (associated(gfld%igdtmpl)) deallocate(gfld%igdtmpl)
434 if (associated(gfld%list_opt)) deallocate(gfld%list_opt)
435 call gf_unpack3(cgrib,lcgrib,iofst,igds,gfld%igdtmpl,
436 & gfld%igdtlen,gfld%list_opt,gfld%num_opt,jerr)
437 if (jerr.eq.0) then
438 have3=.true.
439 gfld%griddef=igds(1)
440 gfld%ngrdpts=igds(2)
441 gfld%numoct_opt=igds(3)
442 gfld%interp_opt=igds(4)
443 gfld%igdtnum=igds(5)
444 else
445 ierr=10
446 return
447 endif
448 endif
449 !
450 ! If found Section 4, check to see if this field is the
451 ! one requested.
452 !
453 if (isecnum.eq.4) then
454 numfld=numfld+1
455 if (numfld.eq.ifldnum) then
456 gfld%discipline=listsec0(1)
457 gfld%version=listsec0(2)
458 gfld%ifldnum=ifldnum
459 gfld%unpacked=unpack
460 gfld%expanded=.false.
461 iofst=iofst-40 ! reset offset to beginning of section
462 call gf_unpack4(cgrib,lcgrib,iofst,gfld%ipdtnum,
463 & gfld%ipdtmpl,gfld%ipdtlen,gfld%coord_list,
464 & gfld%num_coord,jerr)
465 if (jerr.eq.0) then
466 have4=.true.
467 else
468 ierr=11
469 return
470 endif
471 endif
472 endif
473 !
474 ! If found Section 5, check to see if this field is the
475 ! one requested.
476 !
477 if ((isecnum.eq.5).and.(numfld.eq.ifldnum)) then
478 iofst=iofst-40 ! reset offset to beginning of section
479 call gf_unpack5(cgrib,lcgrib,iofst,gfld%ndpts,gfld%idrtnum,
480 & gfld%idrtmpl,gfld%idrtlen,jerr)
481 if (jerr.eq.0) then
482 have5=.true.
483 else
484 ierr=12
485 return
486 endif
487 endif
488 !
489 ! If found Section 6, Unpack bitmap.
490 ! Save in case this is the latest
491 ! bitmap before the requested field.
492 !
493 if (isecnum.eq.6) then
494 if (unpack) then ! unpack bitmap
495 iofst=iofst-40 ! reset offset to beginning of section
496 bmpsave=>gfld%bmap ! save pointer to previous bitmap
497 call gf_unpack6(cgrib,lcgrib,iofst,gfld%ngrdpts,gfld%ibmap,
498 & gfld%bmap,jerr)
499 if (jerr.eq.0) then
500 have6=.true.
501 if (gfld%ibmap .eq. 254) then ! use previously specified bitmap
502 if ( associated(bmpsave) ) then
503 gfld%bmap=>bmpsave
504 else
505 print *,'gf_getfld: Previous bit-map specified,',
506 & ' but none exists,'
507 ierr=17
508 return
509 endif
510 else ! get rid of it
511 if ( associated(bmpsave) ) deallocate(bmpsave)
512 endif
513 else
514 ierr=13
515 return
516 endif
517 else ! do not unpack bitmap
518 call g2lib_gbyte(cgrib,gfld%ibmap,iofst,8) ! Get BitMap Indicator
519 have6=.true.
520 endif
521 endif
522 !
523 ! If found Section 7, check to see if this field is the
524 ! one requested.
525 !
526 if ((isecnum.eq.7).and.(numfld.eq.ifldnum).and.unpack) then
527 iofst=iofst-40 ! reset offset to beginning of section
528 call gf_unpack7(cgrib,lcgrib,iofst,gfld%igdtnum,
529 & gfld%igdtmpl,gfld%idrtnum,
530 & gfld%idrtmpl,gfld%ndpts,
531 & gfld%fld,jerr)
532 if (jerr.eq.0) then
533 have7=.true.
534 ! If bitmap is used with this field, expand data field
535 ! to grid, if possible.
536 if ( gfld%ibmap .ne. 255 .AND. associated(gfld%bmap) ) then
537 if ( expand ) then
538 allocate(newfld(gfld%ngrdpts))
539 !newfld(1:gfld%ngrdpts)=0.0
540 !newfld=unpack(gfld%fld,gfld%bmap,newfld)
541 n=1
542 do j=1,gfld%ngrdpts
543 if ( gfld%bmap(j) ) then
544 newfld(j)=gfld%fld(n)
545 n=n+1
546 else
547 newfld(j)=0.0
548 endif
549 enddo
550 deallocate(gfld%fld);
551 gfld%fld=>newfld;
552 gfld%expanded=.true.
553 else
554 gfld%expanded=.false.
555 endif
556 else
557 gfld%expanded=.true.
558 endif
559 else
560 print *,'gf_getfld: return from gf_unpack7 = ',jerr
561 ierr=14
562 return
563 endif
564 endif
565 !
566 ! Check to see if we read pass the end of the GRIB
567 ! message and missed the terminator string '7777'.
568 !
569 ipos=ipos+lensec ! Update beginning of section pointer
570 if (ipos.gt.(istart+lengrib)) then
571 print *,'gf_getfld: "7777" not found at end of GRIB message.'
572 ierr=7
573 return
574 endif
575 !
576 ! If unpacking requested, return when all sections have been
577 ! processed
578 !
579 if (unpack.and.have3.and.have4.and.have5.and.have6.and.have7)
580 & return
581 !
582 ! If unpacking is not requested, return when sections
583 ! 3 through 6 have been processed
584 !
585 if ((.NOT.unpack).and.have3.and.have4.and.have5.and.have6)
586 & return
588 enddo
590 !
591 ! If exited from above loop, the end of the GRIB message was reached
592 ! before the requested field was found.
593 !
594 print *,'gf_getfld: GRIB message contained ',numlocal,
595 & ' different fields.'
596 print *,'gf_getfld: The request was for the ',ifldnum,
597 & ' field.'
598 ierr=6
600 return
601 end