c ===================================================================== c pgm: ungrib2 (iupr,iud,ibug,nd5,ipack,mfld,fld,L3264B,ier) ccc pgm: ungrib2 (iupr,igout,iud,ibug, ccc kyr,kmo,kda,khr,kmn, nyr,nmo,nda,nhr,nmn, ccc iocent,senof,mptver,lptver,lwcol,ncol,lsrow,nrow, ccc iresfl,rlav,rlov,iscan,iparm,modlid,nturef,itunit, ccc ntufc,ipkflg,inbmap,refval,ibinf,idecf,iwidth, ccc ibmap, mfld,fld, ichd,pid,cct,wmo,jerr) c c in: iupr .... unit number of terminal c in: igout .... unit number of GRIB encoded binary output file c in: iud .... unit number for debug output c in: ibug .... debug control c c computation time c in: kyr .... year (4 digits) c in: kmo .... month (1 to 12) c in: kda .... day (1 to 31) c in: khr .... hour (0 to 23) c in: kmn .... minute (0 to 59) c c now time c in: nyr .... year (4 digits) c in: nmo .... month c in: nda .... day c in: nhr .... hour c in: nmn .... minute c c GRIB stuff: c in: iocent .... identification of originating center (Table 0) c in: senof .... sending office (ABRFC, etc.) c in: mptver .... master table version number c in: lptver .... local table version number c in: lwcol .... local west most HRAP column c in: ncol .... number of HRAP columns c in: lsrow .... local south most HRAP row c in: nrow .... number of HRAP rows c c in: iresfl .... resolution and component flag (Table 7) c in: rlav .... latitude where Dx and Dy are specified c in: rlov .... orientation of the grid c in: iscan .... scanning mode flag (Table 8) c in: iparm .... indicator of parameters and units (Table 2) c in: modlid .... model identification (Table A) c in: nturef .... number of time units from reference time (P1) c in: itunit .... forecast time units (Table 4) c c in: ntufc .... number of time units to forecast (P2) c in: ipkflg .... packing (0 - simple, 1 - second order, c 2 - 2nd order spatial differencing) c in: inbmap .... bit map indicator (0 - bit map in section 6, c >0 - no bit map) c in: refvel .... reference value c in: ibinf .... binary scale factor c in: idecf .... decimal scale factor (power of 10) c in: iwidth .... field width of data c in: ibmap .... bitmap array c c in: mfld .... number of words in array fld c in: fld .... real array containing gridded values c c comms info: c in: ichd .... comms header control c in: pid .... communications identifier for product c in: cct .... comms circuits c in: wmo .... World Meteorological Oranization identifier c c out: jerr .... status code c ===================================================================== subroutine ungrib2 (iupr,iud,ibug,nd5,ipack,mfld,fld,L3264B,ier) ccc subroutine ungrib2 (iupr,igout,iud,ibug, ccc 1 kyr,kmo,kda,khr,kmn, nyr,nmo,nda,nhr,nmn, ccc 2 iocent,senof,mptver,lptver,lwcol,ncol,lsrow,nrow, ccc 3 iresfl,rlav,rlov,iscan,iparm,modlid,nturef,itunit, ccc 4 ntufc,ipkflg,inbmap,refval,ibinf,idecf,iwidth, ccc 5 ibmap, mfld,fld, ichd,pid,cct,wmo,jerr) c....................................................................... c This routine calls the GRIB2 unpacker routine, and outputs unpacked c data from GRIB2. c c....................................................................... c Initially written by c Tim Sweeney, HRL May 1999 c c....................................................................... c character*1 ipack(*) character*4 blnk,senof,pid(3),cct,wmo(2) c real is0(16),is1(30),is2(1),is3(50),is4(20),is5(50), * is6(250000),is7(250000) real fld(*) c dimension ibmap(250000) C C ================================= RCS keyword statements ========== CHARACTER*68 RCSKW1,RCSKW2 DATA RCSKW1,RCSKW2 / ' .$Source: /fs/hseb/ob72/wfo_rfc/precip_proc/source/gribit/src/RCS/ungrib2.f,v $ . $', ' .$Id: ungrib2.f,v 1.1 2006/05/03 13:43:59 gsood Exp $ . $' / C =================================================================== C data blnk/ ' ' / c c call prbug ('ungrib2',1,1,ibug) c ns1 = 30 ns2 = 1 ns3 = 50 ns4 = 20 ns5 = 50 ns6 = 1 ns7 = 250000 c ccc if (ibug.gt.0) write (iud,*) nyr,nmo,nda,nhr,nmn c jerr = 0 c C *********************************************************************** C *************** DEBUG - CALL UNPACKER...PRINT OUT INFO **************** C *********************************************************************** write (IUD,20) 20 format (// 10X,'UNPACKER OUTPUT - GRIB2' //) C call unpk_grib2(iupr,fld,nrow,ncol,is0,is1,ns1,is2,ns2,is3,ns3, + is4,ns4,is5,ns5,is7,ns7,ipack,nd5,xmissx,xmissp, + xmisss,new,minpk,ioctet,L3264B,end,ier) write (iud,30) ier 30 FORMAT (1X,'ERROR RETURN FLAG =',I4) C C *********************************************************************** write (iud,40) 40 format (/ ' SECTION 0 - INDICATOR SECTION' /) c C *********************************************************************** write (iud,50) is0(1),is0(7),is0(8) 50 format (' is0(1) name ',a4 /, + ' is0(7) discipline, master table number ',i4 /, + ' (1 - hydrological products)',/ + ' is0(8) GRIB edition number ',i4 /) c C *********************************************************************** write (iud,60) 60 format (/ ' SECTION 1 - IDENTIFICATION SECTION' /) c iocent = is1(6) mptver = is1(10) lptver = is1(11) kyr = is1(12) kmo = is1(14) kda = is1(15) khr = is1(16) kmn = is1(17) ksc = is1(18) c write (iud,70) ns1,is1(5),iocent,is1(8),mptver,lptver,kyr,kmo, + kda,khr,kmn, is1(19),is1(20) 70 format (' ns1 length of section ',i4 /, + 'is1(5) number of section ',f4.0 /, + 'iocent originating center ',i4 /, + 'is1(8) sending office ',f4.0 /, + 'mptver master tables version number ',i4 /, + 'lptver local tables version number ',i4 /, + 'kyr computation year ',i4 /, + 'kmo computation month ',i4 /, + 'kda computation day ',i4 /, + 'khr computation hour ',i4 /, + 'kmn computation minute ',i4,//, + 'is1(19) production status ',f4.0 /, + 'is1(20) type of processed data (1=fcst) ',f4.0 /) c C *********************************************************************** write (iud,80) 80 FORMAT (/ ' SECTION 3 - GRID DEFINITION SECTION' /) c c write (iud,7310) (is3(i),i=1,ns3) c 7310 format ( 5(1x,5(i8,2x) /) ) c rlat = is3(16)/1000000. rlon = -is3(20)/1000000. illgd = 1 npair = 1 call cvllgd(rlon,rlat,npair,x,y,illgd,istat) lwcol = int(x + 0.05) lsrow = int(y + 0.05) lncol = is3(8) lnrow = is3(12) iresfl = is3(24) rlav = is3(25)/1000000. rlov = is3(29)/1000000. dx = is3(33)/100000. dy = is3(37)/100000. iscan = is3(42) c write (iud,90) ns3,is3(5),is3(6),lncol,lnrow,rlat,rlon, + iresfl,rlav,rlov,dx,dy,is3(41),iscan 90 format (' ns3 length of section ',i4 /, + 'is3(5) number of section ',f4.0 /, + 'is3(6) grid definition template ',f4.0 /, + 'lwcol local west column ',i5 /, + 'lsrow local south row ',i5 /, + 'lncol local number of columns ',i5 /, + 'lnrow local number of rows ',i5 /, + 'rlat latitude of first grid point ',f10.6 /, + 'rlon longitude of first grid point ',f10.6 /, + 'iresfl resolution & component flag ',i4 /, + 'rlav lat for Dx & Dy ',f10.6 /, + 'rlov orientation of grid ',f10.6 /, + 'dx x-direction grid length ',f10.4 /, + 'dy y-direction grid length ',f10.4 /, + 'is3(41) projection center flag ',f4.0 /, + 'iscan scanning mode ',i4 /) c C *********************************************************************** write (iud,100) 100 FORMAT (/ ' SECTION 4 - PRODUCT DEFINITION SECTION' /) c write (iud,110) (is4(i),i=1,ns4) 110 format ( 5(1x,5(i8,2x) /) ) c iparm = is4(9) modlid = is4(11) nturef = is4(12) itunit = is4(15) ntufc = is4(16) c write (iud,120) is4(1),is4(5),is4(6),is4(8),iparm,modlid,nturef, + is4(14),itunit,ntufc,is4(18),is4(19) 120 format (' ns4 length of section 4 ',i4 /, + ' is4(5) number of section ',f4.0 /, + ' is4(6) product def template number ',f4.0 /, + ' is4(8) product discipline 1 ',f4.0 /, + ' iparm parameter number ',i4 /, + ' modlid fcst generating process id ',i4 /, + ' nturef hours after reference time ',i4 /, + ' is4(14) minutes after ref time ',f4.0 /, + ' itunit indicator of unit of time ',i4 /, + ' ntufc fcst time in units ',i4 /, + ' is4(18) indicator type & unit of level ',f4.0 /, + ' is4(19) vertical coordinte value of level',f4.0 /) c C *********************************************************************** write (iud,130) 130 format (/ ' SECTION 5 - DATA REPRESENTATION SECTION' /) ipkflg = is5(6) inbmap = is5(7) refval = is5(8) ibinf = is5(12) idecf = is5(13) iwidth = is5(14) write (iud,140) ns5,is4(5),ipkflg,inbmap,refval,ibinf,idecf,iwidth 140 format (' ns5 length of section 5 ',i4 /, + ' is4(5) number of section ',f4.0 /, + ' ipkflg data representation template num ',i4 /, + ' inbmap bit map indicator ',i4 /, + ' refval reference value ',f8.2 /, + ' ibinf binary scale factor ',f8.3 /, + ' idecf decimal scale factor ',f5.2 /, + ' iwidth field width for data ',f5.0 //) c C *********************************************************************** if (inbmap.gt.0) goto 200 write (iud,150) 150 FORMAT (/ ' SECTION 6 - BIT-MAP SECTION' /) c write (iud,160) is6(1),is6(5) 160 format (' is6(1) length of section 6 ',f4.0 /, + ' is6(5) number of section ',f4.0 //) c j = is6(1) - 5 write (iud,170) j 170 format ( 2x,i7,' ELEMENTS (north row first)' ) do 190 krow=lnrow,1,-1 is = (krow - 1)*lncol + 6 ie = is + lncol - 1 write (iud,180) (is6(j),j=is,ie) 180 format (1X,100I1) 190 CONTINUE c C *********************************************************************** 200 write (iud,210) 210 format (/ ' SECTION 7 - BINARY DATA SECTION' /) c write (iud,220) is7(1),is7(5) 220 format (' is7(1) length of section 7 ',i4 /, + ' is7(5) number of section ',f4.0 //, + ' north row first' /) c c insert units label if (iparm.eq.191) then write (iud,230) 230 format (5x,'Total precip in kg/m2 (mm)') else if (iparm.eq.225) then write (iud,240) 240 format (5x,'1-hour flash flood guidance in kg/m2 (mm)') else if (iparm.eq.226) then write (iud,250) 250 format (5x,'3-hour flash flood guidance in kg/m2 (mm)') else if (iparm.eq.227) then write (iud,260) 260 format (5x,'6-hour flash flood guidance in kg/m2 (mm)') else if (iparm.eq.228) then write (iud,270) 270 format (5x,'12-hour flash flood guidance in kg/m2 (mm)') else if (iparm.eq.229) then write (iud,280) 280 format (5x,'24-hour flash flood guidance in kg/m2 (mm)') else if (iparm.eq.235) then write (iud,290) 290 format (5x,'Multisensor precipitation in kg/m2 x 100 ', + '(mm x 100)' ) endif c j = is7(1) - 5 do 310 krow=lnrow,1,-1 is = (krow - 1)*lncol + 6 ie = is + lncol - 1 write (iud,300) (is7(j),j=is,ie) 300 format (10(1x,f7.2)) 310 continue c 320 return c end