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 skgb2(LUGB, ISEEK, MSEEK, LSKIP, LGRIB, I1)
Determine whether file is grib or not. 
 
subroutine grib_check(file_name, isgrib)
Determine whether file is grib or not.