better testing for gb_info() (#490)

* better testing for gb_info()

* fixing memory problem in test code

* documentation improvements

* more testing of gribinfo()

* more testing

src/gb_info.f

@@ -1,12 +1,13 @@
 !> @file
-!> @brief This subroutine searches the number of gridded fields and
-!> the number of Local Use Sections through a GRIB2 message.
+!> @brief Find the number of gridded fields and
+!> Local Use Sections in a GRIB2 message.
 !> @author Stephen Gilbert @date 2000-05-25
 
-!> This subroutine searches through a GRIB2 message and returns the
-!> number of gridded fields found in the message and the number (and
-!> maximum size) of Local Use Sections. Also various checks are
-!> performed to see if the message is a valid GRIB2 message.
+!> Find the number of gridded fields and Local Use Sections in a GRIB2
+!> message. Also various checks are performed to see if the message is a
+!> valid GRIB2 message.
+!>
+!> This function is similar to gribinfo(), but returns less information.
 !>
 !> @param[in] cgrib Character array that contains the GRIB2 message.
 !> @param[in] lcgrib Length (in bytes) of GRIB message in array
@@ -147,7 +148,7 @@ subroutine gb_info(cgrib,lcgrib,listsec0,listsec1,
           exit
         endif
         iofst=(ipos-1)*8
-        call g2_gbytec(cgrib,lensec,iofst,32)        ! Get Length of Section
+        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

src/getpoly.f

@@ -1,9 +1,9 @@
 !> @file
-!> @brief This subroutine returns the J, K, and M pentagonal
+!> @brief Return the J, K, and M pentagonal
 !> resolution parameters specified in a GRIB2 Grid Definition Section.
 !> @author Stephen Gilbert @date 2002-12-11
 
-!> This subroutine returns the J, K, and M pentagonal resolution
+!> Return the J, K, and M pentagonal resolution
 !> parameters specified in a GRIB2 Grid Definition Section used
 !> spherical harmonic coefficients using GDT 5.50 through 5.53.
 !>

src/gribinfo.F90

@@ -1,10 +1,10 @@
 !> @file
 !> @brief Find the number of Local Use Sections and gridded fields in
-!> a GRIB2 message.
+!> a GRIB2 message, and the maximum sizes of template arrays.
 !> @author Stephen Gilbert @date 2000-05-25
 
-!> Search through a GRIB2 message and return the number of Local Use
-!> Sections and number of gridded fields found in the message.
+!> Find the number of Local Use Sections and gridded fields in
+!> a GRIB2 message, and the maximum sizes of template arrays.
 !>
 !> This subroutine also performs various checks to see if the message
 !> is a valid GRIB2 message. Also, a list of safe array dimensions is
@@ -18,6 +18,8 @@
 !> be returned from the above routines, or to dynamically allocate
 !> arrays with a reasonable size.
 !>
+!> This function is similar to gb_info(), but returns more information.
+!>
 !> @note The actual number of values in these arrays will likely be
 !> less than the values calculated by this routine.
 !>

tests/CMakeLists.txt

@@ -142,6 +142,7 @@ foreach(kind ${kinds})
   create_test(test_pngpack ${kind})
   create_test(test_jpcpack ${kind})
   create_test(test_files ${kind})
+  create_test(test_gb_info ${kind})
 
   # This test depends on gdt2gds(), which is not present if the GRIB1
   # library is not also included in the build.

tests/test_g2_encode.F90

@@ -234,6 +234,7 @@ program test_g2_encode
   call gb_info(msg, msg_len, listsec0_in, listsec1_in, &
        numfields, numlocal, maxlocal, ierr)
   if (ierr .ne. 0) stop 10
+
   ! I don't understand why listsec0_in(1) is 216 instead of 0...
   ! print *, listsec0(1), listsec0_in(1)
   if (listsec0(2) .ne. listsec0_in(2)) stop 11

tests/test_gb_info.F90

@@ -0,0 +1,152 @@
+! This program tests the gb_info() subroutine of the NCEPLIBS-g2
+! project. 
+!
+! Ed Hartnett 7/17/23
+program test_gb_info
+  implicit none
+
+  ! Length of our message.
+  integer, parameter :: lcgrib = 191
+  integer, parameter :: lcgrib2 = 195
+  integer :: numfields, maxlocal, numlocal, maxvals(7)
+
+  ! Section 0 and 1.
+  integer, parameter :: sec1_len = 13
+  integer :: listsec0(3), listsec1(sec1_len)
+  integer :: expected_listsec1(sec1_len) = (/ 7, 4, 2, 24, 0, 2021, 11, 13, 15, 59, 59, 1, 0/)
+
+  ! This is a GRIB2 message.
+  character :: cgrib(lcgrib2) = (/  char( 71), char( 82),&
+       & char( 73), char( 66), char(  0), char(  0), char(  0),&
+       & char(  2), char(  0), char(  0), char(  0), char(  0),&
+       & char(  0), char(  0), char(  0), char(191), char(  0),&
+       & char(  0), char(  0), char( 21), char(  1), char(  0),&
+       & char(  7), char(  0), char(  4), char(  2), char( 24),&
+       & char(  0), char(  7), char(229), char( 11), char( 13),&
+       & char( 15), char( 59), char( 59), char(  1), char(  0),&
+       & char(  0), char(  0), char(  0), char(  8), char(  2),&
+       & char(  1), char(  2), char(  3), char(  0), char(  0),&
+       & char(  0), char( 72), char(  3), char(  0), char(  0),&
+       & char(  0), char(  0), char(  4), char(  0), char(  0),&
+       & char(  0), char(  0), char(  0), char(  1), char(  0),&
+       & char(  0), char(  0), char(  1), char(  1), char(  0),&
+       & char(  0), char(  0), char(  1), char(  1), char(  0),&
+       & char(  0), char(  0), char(  1), char(  0), char(  0),&
+       & char(  0), char(  2), char(  0), char(  0), char(  0),&
+       & char(  2), char(  0), char(  0), char(  0), char(  0),&
+       & char(  0), char(  0), char(  0), char(  0), char(  0),&
+       & char(  0), char(  0), char( 45), char(  0), char(  0),&
+       & char(  0), char( 91), char(  0), char(  0), char(  0),&
+       & char(  0), char( 55), char(  0), char(  0), char(  0),&
+       & char(101), char(  0), char(  0), char(  0), char(  5),&
+       & char(  0), char(  0), char(  0), char(  5), char(  0),&
+       & char(  0), char(  0), char(  0), char( 34), char(  4),&
+       & char(  0), char(  0), char(  0), char(  0), char(  0),&
+       & char(  0), char(  0), char(  0), char(  0), char(  0),&
+       & char( 12), char( 59), char(  0), char(  0), char(  0),&
+       & char(  0), char(  0), char(  1), char(  1), char(  0),&
+       & char(  0), char(  0), char(  1), char(  2), char(  1),&
+       & char(  0), char(  0), char(  0), char(  1), char(  0),&
+       & char(  0), char(  0), char( 21), char(  5), char(  0),&
+       & char(  0), char(  0), char(  4), char(  0), char(  0),&
+       & char( 65), char( 48), char(  0), char(  0), char(  0),&
+       & char(  1), char(  0), char(  1), char(  8), char(  0),&
+       & char(  0), char(  0), char(  0), char(  6), char(  6),&
+       & char(255), char(  0), char(  0), char(  0), char(  9),&
+       & char(  7), char(  0), char(  1), char(  1), char(  2),&
+       & char( 55), char( 55), char( 55), char( 55), &
+       & char(  0), char(  0), char(  0), char(  0) /)
+
+  character :: old_val, ov2, ov3, ov4
+  integer :: ierr, i
+
+  print *, 'Testing gb_info(), explect and ignore error messages.'
+
+  ! Change the first byte of the message, then try gb_info() - will
+  ! not work.
+  old_val = cgrib(1)
+  cgrib(1) = char(0)
+  call gb_info(cgrib, lcgrib, listsec0, listsec1, numfields, numlocal, maxlocal, ierr)
+  if (ierr .ne. 1) stop 1
+  cgrib(1) = old_val  
+
+  ! Change the GRIB version number, then try gb_info() - will
+  ! not work.
+  old_val = cgrib(8)
+  cgrib(8) = char(0)
+  call gb_info(cgrib, lcgrib, listsec0, listsec1, numfields, numlocal, maxlocal, ierr)
+  if (ierr .ne. 2) stop 2
+  cgrib(8) = old_val  
+
+  ! Change number of section 1, then try gb_info() - will
+  ! not work.
+  old_val = cgrib(21)
+  cgrib(21) = char(0)
+  call gb_info(cgrib, lcgrib, listsec0, listsec1, numfields, numlocal, maxlocal, ierr)
+  if (ierr .ne. 3) stop 3
+  cgrib(21) = old_val  
+
+  ! End message too soon, then try gb_info() - will
+  ! not work.
+  old_val = cgrib(38)
+  ov2 = cgrib(39)
+  ov3 = cgrib(40)
+  ov4 = cgrib(41)
+  cgrib(38) = char(55)
+  cgrib(39) = char(55)
+  cgrib(40) = char(55)
+  cgrib(41) = char(55)
+  call gb_info(cgrib, lcgrib, listsec0, listsec1, numfields, numlocal, maxlocal, ierr)
+  if (ierr .ne. 4) stop 4
+  cgrib(38) = old_val  
+  cgrib(39) = ov2
+  cgrib(40) = ov3
+  cgrib(41) = ov4
+
+  ! Change end of message, then try gb_info() - will
+  ! not work.
+  old_val = cgrib(190)
+  cgrib(190) = char(0)
+  call gb_info(cgrib, lcgrib, listsec0, listsec1, numfields, numlocal, maxlocal, ierr)
+  if (ierr .ne. 5) stop 5
+  cgrib(190) = old_val  
+
+  ! Change a section number, then try gb_info() - will
+  ! not work.
+  old_val = cgrib(42)
+  cgrib(42) = char(0)
+  call gb_info(cgrib, lcgrib, listsec0, listsec1, numfields, numlocal, maxlocal, ierr)
+  if (ierr .ne. 6) stop 6
+  cgrib(42) = old_val  
+
+  ! This will work.
+  call gb_info(cgrib, lcgrib, listsec0, listsec1, numfields, numlocal, maxlocal, ierr)
+  if (ierr .ne. 0) stop 10
+  if (numfields .ne. 1 .or. numlocal .ne. 1 .or. maxlocal .ne. 3) stop 11
+  if (listsec0(1) .ne. 0 .or. listsec0(2) .ne. 2 .or. listsec0(3) .ne. 191) stop 12
+  do i = 1, sec1_len
+     if (listsec1(i) .ne. expected_listsec1(i)) stop 13
+  end do
+
+  ! Test gribinfo() as well. This won't work because we change number of section 1.
+  old_val = cgrib(21)
+  cgrib(21) = char(0)
+  call gribinfo(cgrib, lcgrib, listsec0, listsec1, numlocal, numfields, maxvals, ierr)
+  if (ierr .ne. 3) stop 25
+  cgrib(21) = old_val  
+
+  ! Test gribinfo() as well.
+  call gribinfo(cgrib, lcgrib, listsec0, listsec1, numlocal, numfields, maxvals, ierr)
+  if (ierr .ne. 0) stop 20
+  if (numfields .ne. 1 .or. numlocal .ne. 1) stop 21
+  if (maxvals(1) .ne. 3 .or. maxvals(2) .ne. 58 .or. maxvals(3) .ne. 1 .or. maxvals(4) .ne. 25 &
+       .or. maxvals(5) .ne. 1 .or. maxvals(6) .ne. 10 .or. maxvals(7) .ne. 4) stop 22
+  if (listsec0(1) .ne. 0 .or. listsec0(2) .ne. 2 .or. listsec0(3) .ne. 191) stop 12
+  do i = 1, sec1_len
+     if (listsec1(i) .ne. expected_listsec1(i)) stop 13
+  end do
+
+  print *, 'OK!'
+  print *, 'SUCCESS!'
+
+end program test_gb_info