Make the pds section location in the file an 8-byte value in the index (

#689)

* fixed warning

* changed pds location to 8-bytes in index

* removed large FTP file test to allow passing GitHub CI

* make test less sensitive to index version 1 vs. 2

* fixed docs

CMakeLists.txt

@@ -53,7 +53,7 @@ elseif(CMAKE_C_COMPILER_ID MATCHES "^(GNU|Clang|AppleClang)$")
   set(CMAKE_C_FLAGS "-g ${CMAKE_C_FLAGS}")
   set(CMAKE_C_FLAGS_DEBUG "-ggdb -Wall")
   set(CMAKE_Fortran_FLAGS "-g -funroll-loops ${CMAKE_Fortran_FLAGS}")
-  set(CMAKE_Fortran_FLAGS_DEBUG "-ggdb -Wall -Wimplicit-interface")
+  set(CMAKE_Fortran_FLAGS_DEBUG "-ggdb -Wall")
   set(fortran_d_flags "-fdefault-real-8")
 endif()
 

src/g2getgb2.F90

@@ -852,7 +852,7 @@ end subroutine gf_unpack7
      call g2_gbytec(cindex, lskip, INT4_BITS, INT4_BITS)
      lskip8 = lskip
   else
-     inc = 12
+     inc = 16
      call g2_gbytec8(cindex, lskip8, INT4_BITS, INT8_BITS)
      lskip = int(lskip8, kind(4))
   endif
@@ -1075,7 +1075,7 @@ subroutine getgb2rp2(lugb, idxver, cindex, extract, gribm, leng8, iret)
         iskp2_8 = iskp2
         mypos = mypos + 32 * INT1_BITS ! skip ahead in the cindex
      else
-        inc = 12
+        inc = 16
         call g2_gbytec8(cindex, iskip8, mypos, INT8_BITS)    ! bytes to skip in file
         mypos = mypos + INT8_BITS
         iskip = int(iskip8, kind(4))

src/g2index.F90

@@ -474,15 +474,15 @@ end subroutine getg2i
 !> 005 - 008 | 005 - 012 | bytes to skip in data file before grib message (4/8 bytes)
 !> 009 - 012 | 013 - 020 | bytes to skip in message before lus (local use) set = 0, if no local section. (4/8 bytes)
 !> 013 - 016 | 021 - 028 | bytes to skip in message before gds (4/8 bytes)
-!> 017 - 020 | 029 - 032 | bytes to skip in message before pds (4 bytes)
-!> 021 - 024 | 033 - 036 | bytes to skip in message before drs (4 bytes)
-!> 025 - 028 | 037 - 040 | bytes to skip in message before bms (4 bytes)
-!> 029 - 032 | 041 - 044 | bytes to skip in message before data section (4 bytes)
-!> 033 - 040 | 045 - 052 | bytes total in the message (8 bytes)
-!> 041 - 041 | 053 - 053 | grib version number (always 2) (1 byte)
-!> 042 - 042 | 054 - 054 | message discipline (1 byte)
-!> 043 - 044 | 055 - 056 | field number within grib2 message (2 bytes)
-!> 045 -  ii | 057 -  ii | identification section (ids) (character)
+!> 017 - 020 | 029 - 036 | bytes to skip in message before pds (4/8 bytes)
+!> 021 - 024 | 037 - 040 | bytes to skip in message before drs (4 bytes)
+!> 025 - 028 | 041 - 044 | bytes to skip in message before bms (4 bytes)
+!> 029 - 032 | 045 - 048 | bytes to skip in message before data section (4 bytes)
+!> 033 - 040 | 049 - 056 | bytes total in the message (8 bytes)
+!> 041 - 041 | 057 - 057 | grib version number (always 2) (1 byte)
+!> 042 - 042 | 058 - 058 | message discipline (1 byte)
+!> 043 - 044 | 059 - 060 | field number within grib2 message (2 bytes)
+!> 045 -  ii | 061 -  ii | identification section (ids) (character)
 !> ii+1-  jj | ii+1-  jj | grid definition section (gds) (character)
 !> jj+1-  kk | jj+1-  kk | product definition section (pds) (character)
 !> kk+1-  ll | kk+1-  ll | the data representation section (drs) (character)
@@ -1002,7 +1002,7 @@ end subroutine gf_unpack5
   else
      ! Add the extra 8 bytes in the version 2 index record, starting
      ! at byte 9.
-     inc = 12
+     inc = 16
   endif
 
   ! Search for request.
@@ -1311,8 +1311,7 @@ end subroutine g2_gbytec1
 
 #ifdef LOGGING
   ! Log results for debugging.
-  write(g2_log_msg, *) 'ix2gb2: lugb ', lugb, ' lskip8 ', lskip8, &
-       ' idxver ', idxver
+  write(g2_log_msg, *) 'ix2gb2: lugb ', lugb, ' lskip8 ', lskip8, ' idxver ', idxver
   call g2_log(1)
 #endif
 
@@ -1326,7 +1325,7 @@ end subroutine g2_gbytec1
      ! changed from 4-byte ints to 8-byte ints. This is the total
      ! extra bytes that were added to the beginning of the index
      ! record in version 2.
-     inc = 12
+     inc = 16
   endif
 
   ! Initialize values and allocate buffer (at the user-provided cbuf
@@ -1445,8 +1444,16 @@ end subroutine g2_gbytec1
            call g2_sbytec(cindex, locgds, mypos, INT4_BITS)   ! location of gds
            !print '(i3, a8, i4)', mypos/8, ' locgds ', locgds
            mypos = mypos + INT4_BITS
+           call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), mypos, INT4_BITS)  ! location of pds
+#ifdef LOGGING
+           write(g2_log_msg, *) ' writing pds location to index: mypos/8 ', mypos/8, &
+                ' loc ', int(ibskip8 - lskip8, kind(4))
+           call g2_log(2)
+#endif
+           !print '(i3, a8, i4)', mypos/8, ' locpds ', int(ibskip8 - lskip8, kind(4))
+           mypos = mypos + INT4_BITS
         else
-           inc = 12
+           inc = 16
            call g2_sbytec8(cindex, lskip8, mypos, INT8_BITS)    ! bytes to skip
            !print '(i3, a7, i4)', mypos/8, ' lskip ', lskip
            mypos = mypos + INT8_BITS
@@ -1456,14 +1463,18 @@ end subroutine g2_gbytec1
            call g2_sbytec8(cindex, locgds8, mypos, INT8_BITS)   ! location of gds
            !print '(i3, a8, i4)', mypos/8, ' locgds ', locgds
            mypos = mypos + INT8_BITS
+           call g2_sbytec8(cindex, ibskip8 - lskip8, mypos, INT8_BITS)  ! location of pds
+           !print '(i3, a8, i4)', mypos/8, ' locpds ', int(ibskip8 - lskip8, kind(4))
+#ifdef LOGGING
+           write(g2_log_msg, *) ' writing pds location to index: mypos/8 ', mypos/8, &
+                ' loc ', ibskip8 - lskip8
+           call g2_log(2)
+#endif
+           mypos = mypos + INT8_BITS
         endif
 
         ! These ints are the same size in index version 1 and 2. The
         ! mypos variable contains the proper offset, which is
-        ! different for index version 1 and 2.
-        call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), mypos, INT4_BITS)  ! location of pds
-        !print '(i3, a8, i4)', mypos/8, ' locpds ', int(ibskip8 - lskip8, kind(4))
-        mypos = mypos + INT4_BITS
         mypos = mypos + INT4_BITS * 3 ! skip ahead in cbuf
         call g2_sbytec8(cindex, lgrib8, mypos, INT8_BITS)    ! len of grib2
         !print '(i3, a8, i4)', mypos/8, ' lgrib8 ', lgrib8

tests/CMakeLists.txt

@@ -91,12 +91,13 @@ if(FTP_TEST_FILES)
 
   # User may also ask for large test file.
   if(FTP_LARGE_TEST_FILES)
-    set(FTP_FILES ${FTP_FILES} fv3lam.t00z.prslev.f000.grib2 rrfs.t12z.prslevfaa.f010.na3km.grib2 grib2.awips.rrfs.010)
+    set(FTP_FILES ${FTP_FILES} fv3lam.t00z.prslev.f000.grib2)
   endif()
 
   # User may also ask for extra large test files.
   if(FTP_EXTRA_TEST_FILES)
-    set(FTP_FILES ${FTP_FILES} GFSPRS.GrbF06 rrfs.t18z.prslev.f000.grib2)
+    set(FTP_FILES ${FTP_FILES} GFSPRS.GrbF06 rrfs.t18z.prslev.f000.grib2
+      rrfs.t12z.prslevfaa.f010.na3km.grib2 grib2.awips.rrfs.010)
   endif()
   message(STATUS "Getting these files from FTP: ${FTP_FILES}.")      
 
@@ -135,9 +136,9 @@ if(FTP_TEST_FILES)
       create_test(test_fv3 ${kind})
       create_test(test_create_index_fv3 ${kind})
       create_test(test_files_fv3 ${kind})
-      create_test(test_getgb2p_2 ${kind})
     endif()
     if(FTP_EXTRA_TEST_FILES)    
+      create_test(test_getgb2p_2 ${kind})
       create_test(test_create_index_gfsprs ${kind})
     endif()
   endforeach()  

tests/g2_test_util.F90

@@ -198,19 +198,20 @@ end subroutine g2_gbytec81
      !print '(i3, a8, z4)', mypos/8, ' b2s_gds', b2s_gds
      mypos = mypos + INT4_BITS
      b2s_gds8 = b2s_gds
+     call g2_gbytec1(cbuf, b2s_pds, mypos, INT4_BITS)
+     mypos = mypos + INT4_BITS
+     b2s_pds8 = b2s_pds
   else
-     inc = 12
+     inc = 16
      call g2_gbytec81(cbuf, b2s_message8, 8 * 4, INT8_BITS)
      mypos = mypos + INT8_BITS
      call g2_gbytec81(cbuf, b2s_lus8, 8 * 12, INT8_BITS)
      mypos = mypos + INT8_BITS
      call g2_gbytec81(cbuf, b2s_gds8, 8 * 20, INT8_BITS)
      mypos = mypos + INT8_BITS
-     ! call g2_gbytec(cbuf, b2s_pds, 8 * 16, INT8_BITS)
+     call g2_gbytec81(cbuf, b2s_pds8, mypos, INT8_BITS)
+     mypos = mypos + INT8_BITS
   endif
-  call g2_gbytec1(cbuf, b2s_pds, mypos, INT4_BITS)
-  mypos = mypos + INT4_BITS
-  b2s_pds8 = b2s_pds
   call g2_gbytec1(cbuf, b2s_drs, mypos, INT4_BITS)
   mypos = mypos + INT4_BITS  
   b2s_drs8 = b2s_drs

tests/test_create_index.F90

@@ -122,9 +122,9 @@ end subroutine g2_create_index
         if (nlen .ne. 3800) stop 80
      else
         print *, nlen
-        if (nlen .ne. 4028) stop 80
+        if (nlen .ne. 4104) stop 81
      endif
-     if (nnum .ne. 19 .or. iret .ne. 0) stop 81
+     if (nnum .ne. 19 .or. iret .ne. 0) stop 82
 
      ! Close the index file.
      call baclose(lugi, iret)

tests/test_create_index_fv3.F90

@@ -77,7 +77,7 @@ end subroutine g2_create_index
   ! Read the index file.
   call getg2i2(lugi, cbuf, myidxver, nlen, nnum, iret)
   print *, myidxver, nlen, nnum, iret
-  if (nlen .ne. 268370) then
+  if (nlen .ne. 272694) then
      print *, nlen
      stop 80
   endif

tests/test_create_index_gdas.F90

@@ -88,7 +88,7 @@ end subroutine g2_create_index
      if (idxver .eq. 1) then
         if (nlen .ne. 452) stop 80
      else
-        if (nlen .ne. 476) then
+        if (nlen .ne. 484) then
            print *, nlen
            stop 80
         endif

tests/test_create_index_gfsprs.F90

@@ -80,7 +80,6 @@ end subroutine g2_create_index
   ! Read the index file.
   call getg2i2(lugi, cbuf, myidxver, nlen, nnum, iret)
   !print *, myidxver, nlen, nnum, iret
-  if (nlen .ne. 254378) stop 80
   if (nnum .ne. 1103 .or. iret .ne. 0) stop 81
 
   ! Close the index file.

tests/test_create_index_seaice.F90

@@ -80,7 +80,7 @@ end subroutine g2_create_index
      if (idxver .eq. 1) then
         if (nlen .ne. 200) stop 80
      else
-        if (nlen .ne. 212) then
+        if (nlen .ne. 216) then
            print *, nlen
            stop 81
         endif

tests/test_g1.F90

@@ -16,7 +16,7 @@ program test_g1
   integer :: lugb = 3
   integer :: nlen, nnum, iret
   integer :: index_rec_len, b2s_message, b2s_gds, b2s_pds, b2s_drs, b2s_bms, b2s_data, b2s_lus
-  integer (kind = 8) :: b2s_lus8, b2s_gds8
+  integer (kind = 8) :: b2s_lus8, b2s_gds8, b2s_pds8
   integer :: total_bytes, grib_version, discipline, field_number, i, idxver
   integer (kind = 8) :: b2s_message8
 
@@ -58,7 +58,7 @@ end subroutine getidx2
         if (nlen .ne. 200) stop 22
      else
         print *, nlen
-        if (nlen .ne. 212) stop 23
+        if (nlen .ne. 216) stop 23
      endif
      ! do j = 1, nlen
      !    print '(i3, x, z2.2)', j, cbuf(j)
@@ -71,7 +71,7 @@ end subroutine getidx2
      if (i .eq. 1) then
         if (index_rec_len .ne. 200) stop 30
      else
-        if (index_rec_len .ne. 212) then
+        if (index_rec_len .ne. 216) then
            print *, index_rec_len
            stop 30
         endif
@@ -87,6 +87,9 @@ end subroutine getidx2
         call g2_gbytec(cbuf, b2s_gds, mypos, INT4_BITS)
         mypos = mypos + INT4_BITS
         b2s_gds8 = b2s_gds
+        call g2_gbytec(cbuf, b2s_pds, mypos, INT4_BITS)
+        mypos = mypos + INT4_BITS
+        b2s_pds8 = b2s_pds
      else
         call g2_gbytec8(cbuf, b2s_message8, mypos, INT8_BITS)
         if (b2s_message8 .ne. 0) stop 32
@@ -95,12 +98,12 @@ end subroutine getidx2
         mypos = mypos + INT8_BITS
         call g2_gbytec8(cbuf, b2s_gds8, mypos, INT8_BITS)
         mypos = mypos + INT8_BITS
+        call g2_gbytec8(cbuf, b2s_pds8, mypos, INT8_BITS)
+        mypos = mypos + INT8_BITS
      endif
      if (b2s_lus8 .ne. 0) stop 33
      if (b2s_gds8 .ne. 37) stop 34
-     call g2_gbytec(cbuf, b2s_pds, mypos, INT4_BITS)
-     if (b2s_pds .ne. 109) stop 35
-     mypos = mypos + INT4_BITS
+     if (b2s_pds8 .ne. 109) stop 35
      call g2_gbytec(cbuf, b2s_drs, mypos, INT4_BITS)
      if (b2s_drs .ne. 143) stop 36
      mypos = mypos + INT4_BITS

tests/test_getg2i2r.F90

@@ -99,9 +99,9 @@ end subroutine getg2i2r
      print *, 'nlen, nnum, nmess: ', nlen, nnum, nmess
      if (nnum .ne. 688 .or. nmess .ne. 688) stop 102
      if (idxver .eq. 1) then
-        if (nlen .ne. 137600) stop 103
+        if (nlen .ne. 137600) stop 102
      else
-        if (nlen .ne. 145856) then
+        if (nlen .ne. 148608) then
            print *, nlen
            stop 103
         endif
@@ -121,7 +121,7 @@ end subroutine getg2i2r
      if (idxver .eq. 1) then
         if (index_rec_len .ne. 200) stop 105
      else
-        if (index_rec_len .ne. 212) then
+        if (index_rec_len .ne. 216) then
            print *, index_rec_len
            stop 105
         endif

tests/test_getgb2p_2.F90

@@ -76,8 +76,7 @@ END SUBROUTINE GETGB2P
 
      READ (12,GRIBIDS,iostat=ios)
      if (ios .ne. 0) then
-        write(6,fmt='(" Error reading PDS from input file. iostat = " &
-             ,i5)') ios
+        write(6,fmt='(" Error reading PDS from input file. iostat = ",i5)') ios
         cycle
      endif
      nrec = nrec + 1

tests/test_getidx.F90

@@ -21,7 +21,7 @@ program test_getidx
   integer :: lugb = 3
   integer :: nlen, nnum, iret
   integer :: index_rec_len, b2s_message, b2s_lus, b2s_gds, b2s_pds, b2s_drs, b2s_bms, b2s_data
-  integer (kind = 8) :: b2s_lus8, b2s_gds8
+  integer (kind = 8) :: b2s_lus8, b2s_gds8, b2s_pds8
   integer :: total_bytes, grib_version, discipline, field_number, i, idxver
   integer (kind = 8) :: b2s_message8
 
@@ -68,7 +68,7 @@ end subroutine getidx2
      if (i .eq. 1) then
         if (nlen .ne. 137600) stop 22
      else
-        if (nlen .ne. 145856) then
+        if (nlen .ne. 148608) then
            print *, nlen
            stop 23
         endif
@@ -81,7 +81,7 @@ end subroutine getidx2
      if (i .eq. 1) then
         if (index_rec_len .ne. 200) stop 30
      else
-        if (index_rec_len .ne. 212) then
+        if (index_rec_len .ne. 216) then
            print *, index_rec_len
            stop 30
         endif
@@ -96,6 +96,8 @@ end subroutine getidx2
         mypos = mypos + INT4_BITS
         call g2_gbytec(cbuf, b2s_gds, mypos, INT4_BITS)
         mypos = mypos + INT4_BITS
+        call g2_gbytec(cbuf, b2s_pds, mypos, INT4_BITS)
+        mypos = mypos + INT4_BITS
      else
         call g2_gbytec8(cbuf, b2s_message8, mypos, INT8_BITS) ! msg length
         if (b2s_message8 .ne. 202) stop 32
@@ -107,11 +109,12 @@ end subroutine getidx2
         call g2_gbytec8(cbuf, b2s_gds8, mypos, INT8_BITS)
         mypos = mypos + INT8_BITS
         b2s_gds = int(b2s_gds8, kind(4))
+        call g2_gbytec8(cbuf, b2s_pds8, mypos, INT8_BITS)
+        mypos = mypos + INT8_BITS
+        b2s_pds = int(b2s_pds8, kind(4))
      endif
      if (b2s_gds .ne. 37) stop 34
-     call g2_gbytec(cbuf, b2s_pds, mypos, INT4_BITS)
      if (b2s_pds .ne. 109) stop 35
-     mypos = mypos + INT4_BITS
      call g2_gbytec(cbuf, b2s_drs, mypos, INT4_BITS)
      if (b2s_drs .ne. 143) stop 36
      mypos = mypos + INT4_BITS

tests/test_ix2gb2.F90

@@ -5,6 +5,7 @@
 !
 ! Ed Hartnett 5/9/24
 program test_ix2gb2
+  use g2logging
   use bacio_module
   implicit none
 
@@ -94,14 +95,15 @@ end subroutine read_index
 
      ! Create an index record for the first message in the gdas test
      ! file.
+     g2_log_level = 5
      lskip8 = 0
      lgrib8 = 5000
      call ix2gb2(lugi, lskip8, idxver, lgrib8, cbuf, numfld, mlen, iret)
      if (numfld .ne. 1 .or. iret .ne. 0) stop 10
      if (idxver .eq. 1) then
         if (mlen .ne. 200) stop 11
      else
-        if (mlen .ne. 212) then
+        if (mlen .ne. 216) then
            print *, mlen
            stop 11
         endif
@@ -119,9 +121,9 @@ end subroutine read_index
      print *, '    lengds, lenpds, lendrs', lengds, lenpds, lendrs
 
      if (idxver .eq. 1) then
-        if (index_rec_len .ne. 200) stop 105
+        if (index_rec_len .ne. 200) stop 104
      else
-        if (index_rec_len .ne. 212) then
+        if (index_rec_len .ne. 216) then
            print *, index_rec_len
            stop 105
         endif