make bms location in index a 64-bit int

src/g2getgb2.F90

@@ -864,6 +864,7 @@ subroutine getgb2r2(lugb, idxver, cindex, gfld, iret)
   integer, intent(out) :: iret
 
   integer :: lskip, skip6, skip7
+  integer (kind = 8) :: skip68
   character(len=1):: csize(4)
   character(len=1), allocatable :: ctemp(:)
   real, pointer, dimension(:) :: newfld
@@ -874,7 +875,7 @@ subroutine getgb2r2(lugb, idxver, cindex, gfld, iret)
   parameter(IXBMS1 = 24, IXBMS2 = 44)
   ! Bytes to skip in (version 1 and 2) index record to get to data section.
   integer :: IXDS1, IXDS2
-  parameter(IXDS1 = 28, IXDS2 = 48)
+  parameter(IXDS1 = 28, IXDS2 = 52)
   integer :: INT1_BITS, INT2_BITS, INT4_BITS, INT8_BITS
   parameter(INT1_BITS = 8, INT2_BITS = 16, INT4_BITS = 32, INT8_BITS = 64)
 
@@ -940,8 +941,10 @@ end subroutine g2_gbytec81
   ! Read the offset to section 6, the BMS section.
   if (idxver .eq. 1) then
      call g2_gbytec1(cindex, skip6, IXBMS1 * INT1_BITS, INT4_BITS)
+     skip68 = skip6
   else
-     call g2_gbytec1(cindex, skip6, IXBMS2 * INT1_BITS, INT4_BITS)
+     call g2_gbytec81(cindex, skip68, IXBMS2 * INT1_BITS, INT8_BITS)
+     skip6 = int(skip68, kind(4))
   endif
 
   ! Read the offset to section 7, the data section.
@@ -1154,11 +1157,11 @@ subroutine getgb2rp2(lugb, idxver, cindex, extract, gribm, leng8, iret)
   parameter(IXBMS1 = 24, IXBMS2 = 44)
   ! Bytes to skip in (version 1 and 2) index record to get to data section.
   integer :: IXDS1, IXDS2
-  parameter(IXDS1 = 28, IXDS2 = 48)
+  parameter(IXDS1 = 28, IXDS2 = 52)
   integer :: INT1_BITS, INT2_BITS, INT4_BITS, INT8_BITS
   parameter(INT1_BITS = 8, INT2_BITS = 16, INT4_BITS = 32, INT8_BITS = 64)
   integer :: mypos, inc = 0
-  integer (kind = 8) :: lread8, iskip8, len2_8, len7_8, len6_8
+  integer (kind = 8) :: lread8, iskip8, len2_8, len7_8, len6_8, iskp68
 
   interface
      subroutine g2_sbytec81(out, sin, iskip, nbits)
@@ -1199,13 +1202,13 @@ end subroutine g2_gbytec81
         iskp2_8 = iskp2
         mypos = mypos + 32 * INT1_BITS ! skip ahead in the cindex
      else
-        inc = 20
+        inc = 24
         call g2_gbytec81(cindex, iskip8, mypos, INT8_BITS)    ! bytes to skip in file
         mypos = mypos + INT8_BITS
         iskip = int(iskip8, kind(4))
         call g2_gbytec81(cindex, iskp2_8, mypos, INT8_BITS)    ! bytes to skip for section 2
         mypos = mypos + INT8_BITS
-        mypos = mypos + 44 * INT1_BITS ! skip ahead in the cindex
+        mypos = mypos + 48 * INT1_BITS ! skip ahead in the cindex
      endif
 #ifdef LOGGING
      write(g2_log_msg, *) 'iskip8', iskip8, 'iskip', iskip, 'mypos/8', mypos/8
@@ -1223,7 +1226,7 @@ end subroutine g2_gbytec81
         len2 = 0
      endif
 #ifdef LOGGING
-     write(g2_log_msg, *) 'iskip8 ', iskip8, ' iskp2_8 ', iskp2_8, 'len2', len2
+     write(g2_log_msg, *) 'iskip8 ', iskip8, ' iskp2_8 ', iskp2_8, 'len2', len2, 'mypos/8', mypos/8
      call g2_log(2)
 #endif
 
@@ -1250,13 +1253,22 @@ end subroutine g2_gbytec81
         if (idxver .eq. 1) then
            call g2_gbytec1(cindex, iskp6, IXBMS1 * INT1_BITS, INT4_BITS)    
         else
-           call g2_gbytec1(cindex, iskp6, IXBMS2 * INT1_BITS, INT4_BITS)
+           call g2_gbytec81(cindex, iskp68, IXBMS2 * INT1_BITS, INT8_BITS)
+           iskp6 = int(iskp68, kind(4))
         endif
+#ifdef LOGGING
+     write(g2_log_msg, *) 'getgb2rp2: iskp6', iskp6
+     call g2_log(2)
+#endif
 
         ! Read the length of the bitmap section from the data file. (lu, byts to
         ! skip, bytes to read, bytes read, buffer for output)
         call bareadl(lugb, iskip8 + iskp6, 4_8, lread8, ctemp)
         call g2_gbytec1(ctemp, len6, 0, INT4_BITS)      ! length of section 6
+#ifdef LOGGING
+        write(g2_log_msg, *) 'getgb2rp2: len6', len6
+        call g2_log(2)
+#endif
      endif
 
      !  Read the location of section 7 from the index.
@@ -1265,6 +1277,10 @@ end subroutine g2_gbytec81
      else
         call g2_gbytec1(cindex, iskp7, IXDS2 * INT1_BITS, INT4_BITS)    ! bytes to skip for section 7
      endif
+#ifdef LOGGING
+     write(g2_log_msg, *) 'getgb2rp2: iskp7', iskp7
+     call g2_log(2)
+#endif
 
      ! Read in the length of section 7 from the data file.
      call bareadl(lugb, iskip8 + iskp7, 4_8, lread8, ctemp)
@@ -1358,7 +1374,7 @@ end subroutine g2_gbytec81
      else
         call g2_gbytec81(cindex, iskip8, mypos, INT8_BITS)    ! bytes to skip in file
         mypos = mypos + INT8_BITS
-        mypos = mypos + 4 * INT8_BITS + 2 * INT4_BITS
+        mypos = mypos + 5 * INT8_BITS + 1 * INT4_BITS
      endif
 
      ! Get the length of the GRIB2 message from the index.

src/g2index.F90

@@ -1006,9 +1006,9 @@ end subroutine gf_unpack5
   if (idxver .eq. 1) then
      inc = 0
   else
-     ! Add the extra 8 bytes in the version 2 index record, starting
+     ! Add the extra 24 bytes in the version 2 index record, starting
      ! at byte 9.
-     inc = 20
+     inc = 24
   endif
 
   ! Search for request.
@@ -1267,8 +1267,8 @@ subroutine ix2gb2(lugb, lskip8, idxver, lgrib8, cbuf, numfld, mlen, iret)
 
   character cver, cdisc
   character(len = 4) :: ctemp
-  integer (kind = 8) :: loclus8, locgds8
-  integer locgds, locbms, loclus
+  integer (kind = 8) :: loclus8, locgds8, locbms8
+  integer locgds, loclus, locbms
   integer :: indbmp, numsec, newsize, g2_mova2i, mbuf, lindex
   integer :: lskip
   integer :: ilndrs, ilnpds, istat
@@ -1291,14 +1291,14 @@ subroutine ix2gb2(lugb, lskip8, idxver, lgrib8, cbuf, numfld, mlen, iret)
   integer :: MXBMS
   parameter(MXBMS = 6)
   integer :: IXDS1, IXDS2
-  parameter(IXDS1 = 28, IXDS2 = 48)
+  parameter(IXDS1 = 28, IXDS2 = 52)
   ! Bytes to skip in (version 1) index record to get to section 0.  
   integer :: IXIDS
   parameter(IXIDS = 44) 
   integer :: IXSDR
   parameter(IXSDR = 20)
   ! Bytes to skip in (version 1 and 2) index record to get to bms.    
-  integer :: IXBMS1, IXBMS2, ixbms
+  integer :: IXBMS1, IXBMS2
   parameter(IXBMS1 = 24, IXBMS2 = 44)
   ! Sizes of integers in bits.
   integer :: INT1_BITS, INT2_BITS, INT4_BITS, INT8_BITS
@@ -1345,7 +1345,7 @@ end subroutine g2_sbytec1
      ! 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 = 20
+     inc = 24
   endif
 
   ! Initialize values and allocate buffer (at the user-provided cbuf
@@ -1473,7 +1473,7 @@ end subroutine g2_sbytec1
            !print '(i3, a8, i4)', mypos/8, ' locpds ', int(ibskip8 - lskip8, kind(4))
            mypos = mypos + INT4_BITS
         else
-           inc = 20
+           inc = 24
            call g2_sbytec81(cindex, lskip8, mypos, INT8_BITS)    ! bytes to skip
            !print '(i3, a7, i4)', mypos/8, ' lskip ', lskip
            mypos = mypos + INT8_BITS
@@ -1485,7 +1485,7 @@ end subroutine g2_sbytec1
            mypos = mypos + INT8_BITS
            call g2_sbytec81(cindex, ibskip8 - lskip8, mypos, INT8_BITS)  ! location of pds
            !print '(i3, a8, i4)', mypos/8, ' locpds ', int(ibskip8 - lskip8, kind(4))
-           mypos = mypos + INT8_BITS + INT4_BITS
+           mypos = mypos + INT8_BITS + INT8_BITS
         endif
 
         ! These ints are the same size in index version 1 and 2. The
@@ -1495,7 +1495,7 @@ end subroutine g2_sbytec1
            write(g2_log_msg, *) ' writing total len to index: mypos/8 ', mypos/8, lgrib8
            call g2_log(4)
 #endif
-        call g2_sbytec81(cindex, lgrib8, mypos, INT8_BITS)    ! len of grib2
+        call g2_sbytec81(cindex, lgrib8, mypos, INT8_BITS)    ! length of grib2
         !print '(i3, a8, i4)', mypos/8, ' lgrib8 ', lgrib8
         mypos = mypos + INT8_BITS
         cindex((mypos / 8) + 1) = cver
@@ -1566,24 +1566,29 @@ end subroutine g2_sbytec1
         !print *, 'drs:', lindex, lindex + ilndrs
         lindex = lindex + ilndrs
      elseif (numsec .eq. 6) then
-        ! Based on the index version, determine where the BMS offset
-        ! is in the index record.
-        if (idxver .eq. 1) then
-           ixbms = IXBMS1 * INT1_BITS
-        else
-           ixbms = IXBMS2 * INT1_BITS
-        endif
         ! Write the location of the BMS section in the message into
         ! the cindex buffer.
         indbmp = g2_mova2i(cbread(6))
         if (indbmp .lt. 254) then
-           locbms = int(ibskip8 - lskip8, kind(4))
-           call g2_sbytec1(cindex, locbms, ixbms, INT4_BITS)  ! loc. of bms
-           !print '(i3, a8, i5)', mypos/8, ' locbms ', int(ibskip8 - lskip8, kind(4))           
+           if (idxver .eq. 1) then
+              locbms = int(ibskip8 - lskip8, kind(4))
+              call g2_sbytec1(cindex, locbms, IXBMS1 * INT1_BITS, INT4_BITS)  ! loc. of bms
+           else
+              locbms8 = ibskip8 - lskip8
+              call g2_sbytec81(cindex, locbms8, IXBMS2 * INT1_BITS, INT8_BITS)  ! loc. of bms
+           endif
         elseif (indbmp .eq. 254) then
-           call g2_sbytec1(cindex, locbms, ixbms, INT4_BITS)  ! loc. of bms
+           if (idxver .eq. 1) then
+              call g2_sbytec1(cindex, locbms, IXBMS1 * INT1_BITS, INT4_BITS)  ! loc. of bms
+           else
+              call g2_sbytec81(cindex, locbms8, IXBMS2 * INT1_BITS, INT8_BITS)  ! loc. of bms
+           endif
         elseif (indbmp .eq. 255) then
-           call g2_sbytec1(cindex, int(ibskip8 - lskip8, kind(4)), ixbms, INT4_BITS)  ! loc. of bms
+           if (idxver .eq. 1) then
+              call g2_sbytec1(cindex, int(ibskip8 - lskip8, kind(4)), IXBMS1 * INT1_BITS, INT4_BITS)  ! loc. of bms
+           else
+              call g2_sbytec81(cindex, ibskip8 - lskip8, IXBMS2 * INT1_BITS, INT8_BITS)  ! loc. of bms
+           endif
         endif
 
         ! Copy 6 bytes of the BMS from data buffer to the cindex buffer.

tests/g2_test_util.F90

@@ -205,6 +205,9 @@ end subroutine g2_gbytec81
      call g2_gbytec1(cbuf, b2s_drs, mypos, INT4_BITS)
      mypos = mypos + INT4_BITS
      b2s_drs8 = b2s_drs
+     call g2_gbytec1(cbuf, b2s_bms, mypos, INT4_BITS)
+     mypos = mypos + INT4_BITS  
+     b2s_bms8 = b2s_bms
   else
      inc = 20
      call g2_gbytec81(cbuf, b2s_message8, 8 * 4, INT8_BITS)
@@ -218,15 +221,17 @@ end subroutine g2_gbytec81
      print *, 'before reading drs loc, mypos/8', mypos/8
      call g2_gbytec81(cbuf, b2s_drs8, mypos, INT8_BITS)
      mypos = mypos + INT8_BITS  
+     call g2_gbytec81(cbuf, b2s_bms8, mypos, INT8_BITS)
+     mypos = mypos + INT8_BITS  
   endif
-  call g2_gbytec1(cbuf, b2s_bms, mypos, INT4_BITS)
-  mypos = mypos + INT4_BITS  
-  b2s_bms8 = b2s_bms
   call g2_gbytec1(cbuf, b2s_data, mypos, INT4_BITS)
   mypos = mypos + INT4_BITS  
   b2s_data8 = b2s_data
+
+  print *, 'before reading total_bytes8 loc, mypos/8', mypos/8
   call g2_gbytec81(cbuf, total_bytes8, mypos, INT8_BITS)
   mypos = mypos + INT8_BITS
+  print *, 'total_bytes8', total_bytes8
   call g2_gbytec1(cbuf, grib_version, mypos, INT1_BITS)
   mypos = mypos + INT1_BITS  
   call g2_gbytec1(cbuf, discipline, mypos, INT1_BITS)

tests/test_create_index.F90

@@ -122,7 +122,7 @@ end subroutine g2_create_index
         if (nlen .ne. 3800) stop 80
      else
         print *, nlen
-        if (nlen .ne. 4180) stop 81
+        if (nlen .ne. 4256) stop 81
      endif
      if (nnum .ne. 19 .or. iret .ne. 0) stop 82
 

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. 277018) then
+  if (nlen .ne. 281342) then
      print *, nlen
      stop 80
   endif

tests/test_create_index_gdas.F90

@@ -88,12 +88,12 @@ end subroutine g2_create_index
      if (idxver .eq. 1) then
         if (nlen .ne. 452) stop 80
      else
-        if (nlen .ne. 492) then
+        if (nlen .ne. 500) then
            print *, nlen
-           stop 80
+           stop 82
         endif
      endif
-     if (nnum .ne. 2 .or. iret .ne. 0) stop 81
+     if (nnum .ne. 2 .or. iret .ne. 0) stop 85
 
      ! Close the index file.
      call baclose(lugi, iret)

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. 220) then
+        if (nlen .ne. 224) 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, b2s_pds8, b2s_drs8
+  integer (kind = 8) :: b2s_lus8, b2s_gds8, b2s_pds8, b2s_drs8, b2s_bms8
   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. 220) stop 23
+        if (nlen .ne. 224) 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 29
      else
-        if (index_rec_len .ne. 220) then
+        if (index_rec_len .ne. 224) then
            print *, index_rec_len
            stop 30
         endif
@@ -93,6 +93,9 @@ end subroutine getidx2
         call g2_gbytec(cbuf, b2s_drs, mypos, INT4_BITS)
         mypos = mypos + INT4_BITS
         b2s_drs8 = b2s_drs
+        call g2_gbytec(cbuf, b2s_bms, mypos, INT4_BITS)
+        mypos = mypos + INT4_BITS
+        b2s_bms8 = b2s_bms
      else
         call g2_gbytec8(cbuf, b2s_message8, mypos, INT8_BITS)
         if (b2s_message8 .ne. 0) stop 32
@@ -105,14 +108,14 @@ end subroutine getidx2
         mypos = mypos + INT8_BITS
         call g2_gbytec8(cbuf, b2s_drs8, mypos, INT8_BITS)
         mypos = mypos + INT8_BITS
+        call g2_gbytec81(cbuf, b2s_bms8, mypos, INT8_BITS)
+        mypos = mypos + INT8_BITS
      endif
      if (b2s_lus8 .ne. 0) stop 33
      if (b2s_gds8 .ne. 37) stop 34
      if (b2s_pds8 .ne. 109) stop 35
      if (b2s_drs .ne. 143) stop 36
-     call g2_gbytec(cbuf, b2s_bms, mypos, INT4_BITS)
      if (b2s_bms .ne. 166) stop 37
-     mypos = mypos + INT4_BITS
      call g2_gbytec(cbuf, b2s_data, mypos, INT4_BITS)
      if (b2s_data .ne. 4721) stop 38
      mypos = mypos + INT4_BITS

tests/test_getg2i2r.F90

@@ -101,7 +101,7 @@ end subroutine getg2i2r
      if (idxver .eq. 1) then
         if (nlen .ne. 137600) stop 102
      else
-        if (nlen .ne. 151360) then
+        if (nlen .ne. 154112) then
            print *, nlen
            stop 103
         endif
@@ -119,9 +119,9 @@ end subroutine getg2i2r
      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. 220) then
+        if (index_rec_len .ne. 224) then
            print *, index_rec_len
            stop 105
         endif

tests/test_getgb2p2.F90

@@ -5,7 +5,7 @@
 ! Edward Hartnett 10/21/24
 program test_getgb2p2
   use bacio_module
-  !use g2logging
+  use g2logging
   implicit none
 
   integer :: lugi
@@ -64,7 +64,7 @@ end subroutine getgb2p2
      call baopenr(lugb, "data/WW3_Regional_US_West_Coast_20220718_0000.grib2", iret)
      if (iret .ne. 0) stop 100
 
-     !g2_log_level = 3
+     g2_log_level = 3
      extract = .true.
      idxver = test_idx
      print *, 'Try getgb2p2() with extract true, idxver:', idxver