hwrf-baseline-20120103-1354/ungrib/src/ngl/g2/gribinfo.f

   1       subroutine gribinfo(cgrib,lcgrib,listsec0,listsec1,
   2      &                    numlocal,numfields,maxvals,ierr)
   3 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 !                .      .    .                                       .
   5 ! SUBPROGRAM:    gribinfo
   6 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-25
   7 !
   8 ! ABSTRACT: This subroutine searches through a GRIB2 message and
   9 !   returns the number of Local Use Sections and number of gridded
  10 !   fields found in the message.  It also performs various checks
  11 !   to see if the message is a valid GRIB2 message.
  12 !   Last, a list of safe array dimensions is returned for use in
  13 !   allocating return arrays from routines getlocal, gettemplates, and
  14 !   getfields.  (See maxvals and REMARKS)
  15 !
  16 ! PROGRAM HISTORY LOG:
  17 ! 2000-05-25  Gilbert
  18 !
  19 ! USAGE:    CALL gribinfo(cgrib,lcgrib,listsec0,listsec1,
  20 !     &                    numlocal,numfields,ierr)
  21 !   INPUT ARGUMENT LIST:
  22 !     cgrib    - Character array that contains the GRIB2 message
  23 !     lcgrib   - Length (in bytes) of GRIB message in array cgrib.
  24 !
  25 !   OUTPUT ARGUMENT LIST:
  26 !     listsec0 - Contains information decoded from GRIB Indicator Section 0.
  27 !                Must be dimensioned >= 2.
  28 !                listsec0(1)=Discipline-GRIB Master Table Number
  29 !                            (see Code Table 0.0)
  30 !                listsec0(2)=GRIB Edition Number (currently 2)
  31 !                listsec0(3)=Length of GRIB message
  32 !     listsec1 - Contains information read from GRIB Identification Section 1.
  33 !                Must be dimensioned >= 13.
  34 !                listsec1(1)=Id of orginating centre (Common Code Table C-1)
  35 !                listsec1(2)=Id of orginating sub-centre (local table)
  36 !                listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
  37 !                listsec1(4)=GRIB Local Tables Version Number
  38 !                listsec1(5)=Significance of Reference Time (Code Table 1.1)
  39 !                listsec1(6)=Reference Time - Year (4 digits)
  40 !                listsec1(7)=Reference Time - Month
  41 !                listsec1(8)=Reference Time - Day
  42 !                listsec1(9)=Reference Time - Hour
  43 !                listsec1(10)=Reference Time - Minute
  44 !                listsec1(11)=Reference Time - Second
  45 !                listsec1(12)=Production status of data (Code Table 1.2)
  46 !                listsec1(13)=Type of processed data (Code Table 1.3)
  47 !     numlocal - The number of Local Use Sections ( Section 2 ) found in
  48 !                the GRIB message.
  49 !     numfields- The number of gridded fieldse found in the GRIB message.
  50 !     maxvals()- The maximum number of elements that could be returned
  51 !                in various arrays from this GRIB2 message. (see REMARKS)
  52 !                maxvals(1)=max length of local section 2 (for getlocal)
  53 !                maxvals(2)=max length of GDS Template (for gettemplates
  54 !                                                       and getfield)
  55 !                maxvals(3)=max length of GDS Optional list (for getfield)
  56 !                maxvals(4)=max length of PDS Template (for gettemplates
  57 !                                                       and getfield)
  58 !                maxvals(5)=max length of PDS Optional list (for getfield)
  59 !                maxvals(6)=max length of DRS Template (for gettemplates
  60 !                                                       and getfield)
  61 !                maxvals(7)=max number of gridpoints (for getfield)
  62 !     ierr     - Error return code.
  63 !                0 = no error
  64 !                1 = Beginning characters "GRIB" not found.
  65 !                2 = GRIB message is not Edition 2.
  66 !                3 = Could not find Section 1, where expected.
  67 !                4 = End string "7777" found, but not where expected.
  68 !                5 = End string "7777" not found at end of message.
  69 !
  70 ! REMARKS: Array maxvals contains the maximum possible
  71 !          number of values that will be returned in argument arrays
  72 !          for routines getlocal, gettemplates, and getfields.
  73 !          Users can use this info to determine if their arrays are
  74 !          dimensioned large enough for the data that may be returned
  75 !          from the above routines, or to dynamically allocate arrays
  76 !          with a reasonable size.
  77 !          NOTE that the actual number of values in these arrays is returned
  78 !          from the routines and will likely be less than the values
  79 !          calculated by this routine.
  80 !
  81 ! ATTRIBUTES:
  82 !   LANGUAGE: Fortran 90
  83 !   MACHINE:  IBM SP
  84 !
  85 !$$$
  86
  87       character(len=1),intent(in) :: cgrib(lcgrib)
  88       integer,intent(in) :: lcgrib
  89       integer,intent(out) :: listsec0(3),listsec1(13),maxvals(7)
  90       integer,intent(out) :: numlocal,numfields,ierr
  91
  92       character(len=4),parameter :: grib='GRIB',c7777='7777'
  93       character(len=4) :: ctemp
  94       integer,parameter :: zero=0,one=1
  95       integer,parameter :: mapsec1len=13
  96       integer,parameter ::
  97      &        mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /)
  98       integer iofst,ibeg,istart
  99
 100       ierr=0
 101       numlocal=0
 102       numfields=0
 103       maxsec2len=1
 104       maxgdstmpl=1
 105       maxdeflist=1
 106       maxpdstmpl=1
 107       maxcoordlist=1
 108       maxdrstmpl=1
 109       maxgridpts=0
 110 !
 111 !  Check for beginning of GRIB message in the first 100 bytes
 112 !
 113       istart=0
 114       do j=1,100
 115         ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
 116         if (ctemp.eq.grib ) then
 117           istart=j
 118           exit
 119         endif
 120       enddo
 121       if (istart.eq.0) then
 122         print *,'gribinfo:  Beginning characters GRIB not found.'
 123         ierr=1
 124         return
 125       endif
 126 !
 127 !  Unpack Section 0 - Indicator Section
 128 !
 129       iofst=8*(istart+5)
 130       call gbyte(cgrib,listsec0(1),iofst,8)     ! Discipline
 131       iofst=iofst+8
 132       call gbyte(cgrib,listsec0(2),iofst,8)     ! GRIB edition number
 133       iofst=iofst+8
 134       iofst=iofst+32
 135       call gbyte(cgrib,lengrib,iofst,32)        ! Length of GRIB message
 136       iofst=iofst+32
 137       listsec0(3)=lengrib
 138       lensec0=16
 139       ipos=istart+lensec0
 140 !
 141 !  Currently handles only GRIB Edition 2.
 142 !
 143       if (listsec0(2).ne.2) then
 144         print *,'gribinfo: can only decode GRIB edition 2.'
 145         ierr=2
 146         return
 147       endif
 148 !
 149 !  Unpack Section 1 - Identification Section
 150 !
 151       call gbyte(cgrib,lensec1,iofst,32)        ! Length of Section 1
 152       iofst=iofst+32
 153       call gbyte(cgrib,isecnum,iofst,8)         ! Section number ( 1 )
 154       iofst=iofst+8
 155       if (isecnum.ne.1) then
 156         print *,'gribinfo: Could not find section 1.'
 157         ierr=3
 158         return
 159       endif
 160       !
 161       !   Unpack each input value in array listsec1 into the
 162       !   the appropriate number of octets, which are specified in
 163       !   corresponding entries in array mapsec1.
 164       !
 165       do i=1,mapsec1len
 166         nbits=mapsec1(i)*8
 167         call gbyte(cgrib,listsec1(i),iofst,nbits)
 168         iofst=iofst+nbits
 169       enddo
 170       ipos=ipos+lensec1
 171 !
 172 !  Loop through the remaining sections keeping track of the
 173 !  length of each.  Also count the number of times Section 2
 174 !  and Section 4 appear.
 175 !
 176       do
 177         ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
 178         if (ctemp.eq.c7777 ) then
 179           ipos=ipos+4
 180           if (ipos.ne.(istart+lengrib)) then
 181             print *,'gribinfo: "7777" found, but not where expected.'
 182             ierr=4
 183             return
 184           endif
 185           exit
 186         endif
 187         iofst=(ipos-1)*8
 188         call gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
 189         iofst=iofst+32
 190         call gbyte(cgrib,isecnum,iofst,8)         ! Get Section number
 191         iofst=iofst+8
 192         ipos=ipos+lensec                 ! Update beginning of section pointer
 193         if (ipos.gt.(istart+lengrib)) then
 194           print *,'gribinfo: "7777"  not found at end of GRIB message.'
 195           ierr=5
 196           return
 197         endif
 198         if (isecnum.eq.2) then     ! Local Section 2
 199            !   increment counter for total number of local sections found
 200            !   and determine largest Section 2 in message
 201            numlocal=numlocal+1
 202            lenposs=lensec-5
 203            if ( lenposs.gt.maxsec2len ) maxsec2len=lenposs
 204         elseif (isecnum.eq.3) then
 205            iofst=iofst+8                      ! skip source of grid def.
 206            call gbyte(cgrib,ngdpts,iofst,32)         ! Get Num of Grid Points
 207            iofst=iofst+32
 208            call gbyte(cgrib,nbyte,iofst,8)      ! Get Num octets for opt. list
 209            iofst=iofst+8
 210            if (ngdpts.gt.maxgridpts) maxgridpts=ngdpts
 211            lenposs=lensec-14
 212            if ( lenposs.gt.maxgdstmpl ) maxgdstmpl=lenposs
 213            if (nbyte.ne.0) then
 214               lenposs=lenposs/nbyte
 215               if ( lenposs.gt.maxdeflist ) maxdeflist=lenposs
 216            endif
 217         elseif (isecnum.eq.4) then
 218           numfields=numfields+1
 219            call gbyte(cgrib,numcoord,iofst,16)      ! Get Num of Coord Values
 220            iofst=iofst+16
 221            if (numcoord.ne.0) then
 222               if (numcoord.gt.maxcoordlist) maxcoordlist=numcoord
 223            endif
 224            lenposs=lensec-9
 225            if ( lenposs.gt.maxpdstmpl ) maxpdstmpl=lenposs
 226         elseif (isecnum.eq.5) then
 227            lenposs=lensec-11
 228            if ( lenposs.gt.maxdrstmpl ) maxdrstmpl=lenposs
 229         endif
 230
 231       enddo
 232
 233       maxvals(1)=maxsec2len
 234       maxvals(2)=maxgdstmpl
 235       maxvals(3)=maxdeflist
 236       maxvals(4)=maxpdstmpl
 237       maxvals(5)=maxcoordlist
 238       maxvals(6)=maxdrstmpl
 239       maxvals(7)=maxgridpts
 240
 241       return
 242       end
 243