gribinfo.F90

Go to the documentation of this file.

 
 
subroutine gribinfo(cgrib, lcgrib, listsec0, listsec1,  &
     numlocal, numfields, maxvals, ierr)
  implicit none
 
  character(len = 1), intent(in) :: cgrib(lcgrib)
  integer, intent(in) :: lcgrib
  integer, intent(out) :: listsec0(3), listsec1(13), maxvals(7)
  integer, intent(out) :: numlocal, numfields, ierr
 
  integer :: i, ipos, isecnum, j, lengrib, lenposs, lensec, lensec0, lensec1
  integer :: maxcoordlist, maxdeflist, maxdrstmpl, maxgridpts, maxpdstmpl, maxgdstmpl
  integer :: maxsec2len, nbits, nbyte, ngdpts, numcoord
  character(len = 4), parameter :: grib = 'GRIB', c7777 = '7777'
  character(len = 4) :: ctemp
  integer, parameter :: zero = 0, one = 1
  integer, parameter :: mapsec1len = 13
  integer, parameter :: mapsec1(mapsec1len) = (/ 2, 2, 1, 1, 1, 2, 1, 1, &
       1, 1, 1, 1, 1 /)
  integer iofst, istart
 
  ierr = 0
  numlocal = 0
  numfields = 0
  maxsec2len = 1
  maxgdstmpl = 1
  maxdeflist = 1
  maxpdstmpl = 1
  maxcoordlist = 1
  maxdrstmpl = 1
  maxgridpts = 0
 
  !     Check for beginning of GRIB message in the first 100 bytes
  istart = 0
  do j = 1, 100
     ctemp = cgrib(j) // cgrib(j + 1) // cgrib(j + 2) // cgrib(j + 3)
     if (ctemp .eq. grib) then
        istart = j
        exit
     endif
  enddo
  if (istart .eq. 0) then
     print *, 'gribinfo:  Beginning characters GRIB not found.'
     ierr = 1
     return
  endif
 
  ! Unpack Section 0 - Indicator Section.
  iofst = 8 * (istart + 5)
  call g2_gbytec(cgrib, listsec0(1), iofst, 8) ! Discipline
  iofst = iofst + 8
  call g2_gbytec(cgrib, listsec0(2), iofst, 8) ! GRIB edition number
  iofst = iofst + 8
  iofst = iofst + 32
  call g2_gbytec(cgrib, lengrib, iofst, 32) ! Length of GRIB message
  iofst = iofst + 32
  listsec0(3) = lengrib
  lensec0 = 16
  ipos = istart + lensec0
 
  ! Currently handles only GRIB Edition 2.
  if (listsec0(2) .ne. 2) then
     print *, 'gribinfo: can only decode GRIB edition 2.'
     ierr = 2
     return
  endif
 
  ! Unpack Section 1 - Identification Section.
  call g2_gbytec(cgrib, lensec1, iofst, 32) ! Length of Section 1
  iofst = iofst + 32
  call g2_gbytec(cgrib, isecnum, iofst, 8) ! Section number (1)
  iofst = iofst + 8
  if (isecnum .ne. 1) then
     print *, 'gribinfo: Could not find section 1.'
     ierr = 3
     return
  endif
 
  ! Unpack each input value in array listsec1 into the the appropriate
  ! number of octets, which are specified in corresponding entries in
  ! array mapsec1.
  do i = 1, mapsec1len
     nbits = mapsec1(i) * 8
     call g2_gbytec(cgrib, listsec1(i), iofst, nbits)
     iofst = iofst + nbits
  enddo
  ipos = ipos + lensec1
 
  ! Loop through the remaining sections keeping track of the length of
  ! each. Also count the number of times Section 2 and Section 4
  ! appear.
  do
     ctemp = cgrib(ipos) // cgrib(ipos + 1) // cgrib(ipos + 2) // &
          cgrib(ipos + 3)
     if (ctemp .eq. c7777) then
        ipos = ipos + 4
        if (ipos .ne. (istart + lengrib)) then
           print *, 'gribinfo: "7777" found, but not where expected.'
           ierr = 4
           return
        endif
        exit
     endif
     iofst = (ipos - 1) * 8
     call g2_gbytec(cgrib, lensec, iofst, 32) ! Get Length of Section
     iofst = iofst + 32
     call g2_gbytec(cgrib, isecnum, iofst, 8) ! Get Section number
     iofst = iofst + 8
     ipos = ipos + lensec      ! Update beginning of section pointer
     if (ipos .gt. (istart + lengrib)) then
        print *, 'gribinfo: "7777"  not found at end of GRIB message.'
        ierr = 5
        return
     endif
     if (isecnum .eq. 2) then ! Local Section 2
        ! Increment counter for total number of local sections found
        ! and determine largest Section 2 in message.
        numlocal = numlocal + 1
        lenposs = lensec-5
        if (lenposs .gt. maxsec2len) maxsec2len = lenposs
     elseif (isecnum .eq. 3) then
        iofst = iofst + 8     ! skip source of grid def.
        call g2_gbytec(cgrib, ngdpts, iofst, 32) ! Get Num of Grid Points
        iofst = iofst + 32
        call g2_gbytec(cgrib, nbyte, iofst, 8) ! Get Num octets for opt. list
        iofst = iofst + 8
        if (ngdpts .gt. maxgridpts) maxgridpts = ngdpts
        lenposs = lensec - 14
        if (lenposs .gt. maxgdstmpl) maxgdstmpl = lenposs
        if (nbyte .ne. 0) then
           lenposs = lenposs / nbyte
           if (lenposs .gt. maxdeflist) maxdeflist = lenposs
        endif
     elseif (isecnum .eq. 4) then
        numfields = numfields + 1
        call g2_gbytec(cgrib, numcoord, iofst, 16) ! Get Num of Coord Values
        iofst = iofst + 16
        if (numcoord .ne. 0) then
           if (numcoord .gt. maxcoordlist) maxcoordlist = numcoord
        endif
        lenposs = lensec - 9
        if (lenposs.gt.maxpdstmpl) maxpdstmpl = lenposs
     elseif (isecnum .eq. 5) then
        lenposs = lensec-11
        if (lenposs .gt. maxdrstmpl) maxdrstmpl = lenposs
     endif
  enddo
 
  maxvals(1) = maxsec2len
  maxvals(2) = maxgdstmpl
  maxvals(3) = maxdeflist
  maxvals(4) = maxpdstmpl
  maxvals(5) = maxcoordlist
  maxvals(6) = maxdrstmpl
  maxvals(7) = maxgridpts
end subroutine gribinfo