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.