27 character*(*),
intent(in) :: file_name
28 integer,
parameter :: iunit=11
29 integer :: istat, iseek, mseek, lskip, lgrib, version
30 integer,
intent(out) :: isgrib
32 print*,
"- CHECK FILE TYPE OF: ", trim(file_name)
33 call baopenr (iunit, file_name, istat)
36 print*,
'- FATAL ERROR: BAD FILE OPEN. ISTAT IS ',istat
37 call w3tage(
'SNOW2MDL')
43 call skgb2(iunit, iseek, mseek, lskip, lgrib, version)
45 call baclose(iunit, istat)
49 if (isgrib == 1) print*,
"- FILE IS GRIB1" 50 if (isgrib == 2) print*,
"- FILE IS GRIB2" 53 print*,
"- FILE IS BINARY" 75 SUBROUTINE skgb2(LUGB,ISEEK,MSEEK,LSKIP,LGRIB,I1)
77 INTEGER,
INTENT( IN) :: LUGB, ISEEK, MSEEK
78 INTEGER,
INTENT(OUT) :: LSKIP, LGRIB, I1
79 INTEGER,
PARAMETER :: LSEEK=128
80 INTEGER :: K, KZ, KS, KG, KN, KM, I4, K4
91 DO WHILE(lgrib.EQ.0.AND.kn.GE.8.AND.kz.EQ.lseek)
93 CALL baread(lugb,ks,kn,kz,z)
97 DO WHILE(lgrib.EQ.0.AND.k.LT.km)
98 CALL gbytec(z,i4,(k+0)*8,4*8)
99 CALL gbytec(z,i1,(k+7)*8,1*8)
100 IF(i4.EQ.1196575042.AND.(i1.EQ.1.OR.i1.EQ.2))
THEN 102 IF (i1.EQ.1)
CALL gbytec(z,kg,(k+4)*8,3*8)
103 IF (i1.EQ.2)
CALL gbytec(z,kg,(k+12)*8,4*8)
104 CALL baread(lugb,ks+k+kg-4,4,k4,z4)
106 CALL gbytec(z4,i4,0,4*8)
107 IF(i4.EQ.926365495)
THEN 117 kn=min(lseek,iseek+mseek-ks)
139 subroutine gdt_to_gds(igdtnum, igdstmpl, igdtlen, kgds, ni, nj, res)
143 integer,
intent(in ) :: igdtnum, igdtlen, igdstmpl(igdtlen)
144 integer,
intent( out) :: kgds(200), ni, nj
147 real,
intent( out) :: res
151 if (igdtnum.eq.0)
then 153 iscale=igdstmpl(10)*igdstmpl(11)
154 if (iscale == 0) iscale = 1e6
160 kgds(4)=nint(float(igdstmpl(12))/float(iscale)*1000.)
161 kgds(5)=nint(float(igdstmpl(13))/float(iscale)*1000.)
164 if (igdstmpl(1)==2 ) kgds(6)=64
165 if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) kgds(6)=kgds(6)+128
166 if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8
168 kgds(7)=nint(float(igdstmpl(15))/float(iscale)*1000.)
169 kgds(8)=nint(float(igdstmpl(16))/float(iscale)*1000.)
170 kgds(9)=nint(float(igdstmpl(17))/float(iscale)*1000.)
171 kgds(10)=nint(float(igdstmpl(18))/float(iscale)*1000.)
174 if (btest(igdstmpl(19),7)) kgds(11) = 128
175 if (btest(igdstmpl(19),6)) kgds(11) = kgds(11) + 64
176 if (btest(igdstmpl(19),5)) kgds(11) = kgds(11) + 32
182 res = float(kgds(9)) / 1000.0 * 111.0
184 elseif (igdtnum.eq.40)
then 186 iscale=igdstmpl(10)*igdstmpl(11)
187 if (iscale==0) iscale=1e6
193 kgds(4)=nint(float(igdstmpl(12))/float(iscale)*1000.)
194 kgds(5)=nint(float(igdstmpl(13))/float(iscale)*1000.)
197 if (igdstmpl(1)==2 ) kgds(6)=64
198 if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) kgds(6)=kgds(6)+128
199 if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8
201 kgds(7)=nint(float(igdstmpl(15))/float(iscale)*1000.)
202 kgds(8)=nint(float(igdstmpl(16))/float(iscale)*1000.)
203 kgds(9)=nint(float(igdstmpl(17))/float(iscale)*1000.)
204 kgds(10)=igdstmpl(18)
207 if (btest(igdstmpl(19),7)) kgds(11) = 128
208 if (btest(igdstmpl(19),6)) kgds(11) = kgds(11) + 64
209 if (btest(igdstmpl(19),5)) kgds(11) = kgds(11) + 32
215 res = float(kgds(9)) / 1000.0 * 111.0
217 elseif (igdtnum.eq.20)
then 225 kgds(4)=nint(float(igdstmpl(10))/float(iscale)*1000.)
226 kgds(5)=nint(float(igdstmpl(11))/float(iscale)*1000.)
229 if (igdstmpl(1) >= 2 .or. igdstmpl(1) <= 5) kgds(6)=64
230 if (igdstmpl(1) == 7) kgds(6)=64
231 if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) kgds(6)=kgds(6)+128
232 if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8
234 kgds(7)=nint(float(igdstmpl(14))/float(iscale)*1000.)
235 kgds(8)=nint(float(igdstmpl(15))/float(iscale)*1000.)
236 kgds(9)=nint(float(igdstmpl(16))/float(iscale)*1000.)
239 if (btest(igdstmpl(17),1)) kgds(10) = 128
242 if (btest(igdstmpl(18),7)) kgds(11) = 128
243 if (btest(igdstmpl(18),6)) kgds(11) = kgds(11) + 64
244 if (btest(igdstmpl(18),5)) kgds(11) = kgds(11) + 32
249 res = 0.5 * float(kgds(8)+kgds(9)) / 1000.
251 elseif (igdtnum.eq.1)
then 253 if (btest(igdstmpl(19),2))
then 255 iscale=igdstmpl(10)*igdstmpl(11)
256 if (iscale == 0) iscale = 1e6
262 kgds(4)=nint(float(igdstmpl(12))/float(iscale)*1000.)
263 kgds(5)=nint(float(igdstmpl(13))/float(iscale)*1000.)
266 if (igdstmpl(1)==2 ) kgds(6)=64
267 if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) kgds(6)=kgds(6)+128
268 if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8
270 kgds(7)=nint(float(igdstmpl(20))/float(iscale)*1000.)+90000
271 kgds(8)=nint(float(igdstmpl(21))/float(iscale)*1000.)
272 kgds(9)=nint(float(igdstmpl(17))/float(iscale)*500.)
274 kgds(10)=nint(float(igdstmpl(18))/float(iscale)*1000.)
277 if (btest(igdstmpl(19),7)) kgds(11) = 128
278 if (btest(igdstmpl(19),6)) kgds(11) = kgds(11) + 64
279 if (btest(igdstmpl(19),5)) kgds(11) = kgds(11) + 32
285 res = sqrt( (float(kgds(9)) / 1000.0)**2 + &
286 (float(kgds(10)) / 1000.0)**2 )
291 iscale=igdstmpl(10)*igdstmpl(11)
292 if (iscale == 0) iscale = 1e6
298 kgds(4)=nint(float(igdstmpl(12))/float(iscale)*1000.)
299 kgds(5)=nint(float(igdstmpl(13))/float(iscale)*1000.)
302 if (igdstmpl(1)==2 ) kgds(6)=64
303 if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) kgds(6)=kgds(6)+128
304 if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8
306 kgds(7)=nint(float(igdstmpl(20))/float(iscale)*1000.)+90000
307 kgds(8)=nint(float(igdstmpl(21))/float(iscale)*1000.)
308 kgds(9)=nint(float(igdstmpl(17))/float(iscale)*1000.)
309 kgds(10)=nint(float(igdstmpl(18))/float(iscale)*1000.)
312 if (btest(igdstmpl(19),7)) kgds(11) = 128
313 if (btest(igdstmpl(19),6)) kgds(11) = kgds(11) + 64
314 if (btest(igdstmpl(19),5)) kgds(11) = kgds(11) + 32
316 kgds(12)=nint(float(igdstmpl(15))/float(iscale)*1000.)
317 kgds(13)=nint(float(igdstmpl(16))/float(iscale)*1000.)
322 res = ((float(kgds(9)) / 1000.0) + (float(kgds(10)) / 1000.0)) &
329 print*,
'- FATAL ERROR CONVERTING TO GRIB2 GDT.' 330 print*,
'- UNRECOGNIZED GRID TYPE.' 331 call w3tage(
'SNOW2MDL')
353 integer,
intent(in) :: kgds(200)
354 integer,
intent( out) :: igdstmplen
356 select case (kgds(1))
362 print*,
'- FATAL ERROR IN ROUTINE GRIB2_CHECK.' 363 print*,
'- UNRECOGNIZED GRID TYPE.' 364 call w3tage(
'SNOW2MDL')
397 subroutine init_grib2(century, year, month, day, hour, kgds, &
398 lat11, latlast, lon11, lonlast, &
399 listsec0, listsec1, igds, ipdstmpl, ipdsnum, igdstmpl, &
400 igdstmplen, idefnum, ideflist, ngrdpts)
403 integer,
intent(in ) :: century, year, month, day, hour
404 integer,
intent(in ) :: kgds(200), igdstmplen
405 integer,
intent( out) :: igds(5)
406 integer,
intent( out) :: listsec0(2)
407 integer,
intent( out) :: listsec1(13)
408 integer,
intent( out) :: ipdstmpl(15), ipdsnum
409 integer,
intent( out) :: igdstmpl(igdstmplen)
410 integer,
intent( out) :: idefnum, ideflist
411 integer,
intent( out) :: ngrdpts
413 real,
intent(in ) :: lat11, latlast, lon11, lonlast
428 if (year == 100)
then 429 listsec1(6)=century*100 + year
431 listsec1(6)=(century-1)*100 + year
444 if (kgds(1) == 4)
then 458 scale=float(igdstmpl(10)*igdstmpl(11))
460 igdstmpl(12)=nint(lat11*scale)
463 igdstmpl(13)=nint((lon11+360.)*scale)
465 igdstmpl(13)=nint(lon11*scale)
469 if (btest(kgds(6),7)) igdstmpl(14) = 48
470 if (btest(kgds(6),3)) igdstmpl(14) = igdstmpl(14) + 8
472 igdstmpl(15)= nint(latlast*scale)
474 if (lonlast < 0)
then 475 igdstmpl(16)=nint((lonlast+360.)*scale)
477 igdstmpl(16)=nint(lonlast*scale)
480 igdstmpl(17)= nint(360.0/float(kgds(2)-1)*scale)
481 igdstmpl(18)= kgds(3)/2
484 if(btest(kgds(11),7)) igdstmpl(19)=128
485 if(btest(kgds(11),6)) igdstmpl(19)=igdstmpl(19) + 64
486 if(btest(kgds(11),5)) igdstmpl(19)=igdstmpl(19) + 32
489 igds(2) = kgds(2)*kgds(3)
502 elseif (kgds(1) == 203 .or. kgds(1) == 205)
then 516 scale=float(igdstmpl(10)*igdstmpl(11))
518 igdstmpl(12)=nint(lat11*scale)
521 igdstmpl(13)=nint((lon11+360.)*scale)
523 igdstmpl(13)=nint(lon11*scale)
527 if (btest(kgds(6),7)) igdstmpl(14) = 48
528 if (btest(kgds(6),3)) igdstmpl(14) = igdstmpl(14) + 8
530 igdstmpl(15)= nint(latlast*scale)
532 if (lonlast < 0)
then 533 igdstmpl(16)=nint((lonlast+360.)*scale)
535 igdstmpl(16)=nint(lonlast*scale)
538 if (kgds(1) == 203) igdstmpl(17)= nint(float(kgds(9))*scale/500.)
541 if (kgds(1) == 205) igdstmpl(17)= nint(float(kgds(9))*scale/1000.)
543 igdstmpl(18)= nint(float(kgds(10))*scale/1000.)
546 if(btest(kgds(11),7)) igdstmpl(19)=128
547 if(btest(kgds(11),6)) igdstmpl(19)=igdstmpl(19) + 64
548 if(btest(kgds(11),5)) igdstmpl(19)=igdstmpl(19) + 32
549 if (kgds(1) == 203) igdstmpl(19)=igdstmpl(19) + 4
551 igdstmpl(20) = nint(float(kgds(7)-90000)*scale/1000.)
553 if (kgds(8) < 0)
then 554 igdstmpl(21) = nint(float(kgds(8)+360000)*scale/1000.)
556 igdstmpl(21) = nint(float(kgds(8))*scale/1000.)
562 igds(2) = kgds(2)*kgds(3)
596 ipdstmpl(15)=-2147483647
616 type(gribfield),
intent(inout) :: gfld
620 nullify(gfld%list_opt)
621 nullify(gfld%igdtmpl)
622 nullify(gfld%ipdtmpl)
623 nullify(gfld%coord_list)
624 nullify(gfld%idrtmpl)
641 type(gribfield),
intent(inout) :: gfld
643 if (
associated(gfld%idsect))
deallocate(gfld%idsect)
644 if (
associated(gfld%local))
deallocate(gfld%local)
645 if (
associated(gfld%list_opt))
deallocate(gfld%list_opt)
646 if (
associated(gfld%igdtmpl))
deallocate(gfld%igdtmpl)
647 if (
associated(gfld%ipdtmpl))
deallocate(gfld%ipdtmpl)
648 if (
associated(gfld%coord_list))
deallocate(gfld%coord_list)
649 if (
associated(gfld%idrtmpl))
deallocate(gfld%idrtmpl)
650 if (
associated(gfld%bmap))
deallocate(gfld%bmap)
651 if (
associated(gfld%fld))
deallocate(gfld%fld)
subroutine init_grib2(century, year, month, day, hour, kgds, lat11, latlast, lon11, lonlast, listsec0, listsec1, igds, ipdstmpl, ipdsnum, igdstmpl, igdstmplen, idefnum, ideflist, ngrdpts)
Initialize grib2 arrays required by the ncep g2 library according to grib1 gds information.
subroutine grib2_check(kgds, igdstmplen)
Determine length of grib2 gds template array, which is a function of the map projection.
subroutine grib2_null(gfld)
Nullify the grib2 gribfield pointers.
subroutine gdt_to_gds(igdtnum, igdstmpl, igdtlen, kgds, ni, nj, res)
Convert from the grib2 grid description template array used by the ncep grib2 library, to the grib1 grid description section array used by ncep ipolates library.
subroutine grib2_free(gfld)
Deallocate the grib2 gribfield pointers.
subroutine grib_check(file_name, isgrib)
Determine whether file is grib or not.