gb_info.F90

Go to the documentation of this file.

 
 
subroutine gb_info(cgrib, lcgrib, listsec0, listsec1, &
     numfields, numlocal, maxlocal, ierr)
  implicit none
 
  character(len = 1), intent(in) :: cgrib(lcgrib)
  integer, intent(in) :: lcgrib
  integer, intent(out) :: listsec0(3), listsec1(13)
  integer, intent(out) :: numlocal, numfields, maxlocal, ierr
 
  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
  integer :: nbits, lensec1, lensec0, lensec, lenposs, lengrib, j
  integer :: i, ipos, isecnum
 
  ierr = 0
  numlocal = 0
  numfields = 0
  maxlocal = 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 *, 'gb_info:  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 *, 'gb_info: 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 *, 'gb_info: 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 to see if they are valid.
  ! 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 *, 'gb_info: "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 *, 'gb_info: "7777"  not found at end of GRIB message.'
        ierr = 5
        return
     endif
     if (isecnum .ge. 2 .AND. isecnum .le. 7) then
        if (isecnum .eq. 2) then     ! Local Section 2
           ! Increment counter for total number of local sections found.
           numlocal = numlocal + 1
           lenposs = lensec - 5
           if (lenposs .gt. maxlocal) maxlocal = lenposs
        elseif (isecnum .eq. 4) then
           ! Increment counter for total number of fields found.
           numfields = numfields + 1
        endif
     else
        print *, 'gb_info: Invalid section number found in GRIB message: ', isecnum
        ierr = 6
        return
     endif
  enddo
 
end subroutine gb_info