change DRS location in index to 8-byte value

src/g2getgb2.F90

@@ -852,7 +852,7 @@ end subroutine gf_unpack7
      call g2_gbytec(cindex, lskip, INT4_BITS, INT4_BITS)
      lskip8 = lskip
   else
-     inc = 16
+     inc = 20
      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 = 16
+        inc = 20
         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

@@ -104,7 +104,7 @@ subroutine g2_write_index_headers(lugi, nlen, nnum, idxver, filename)
 
   integer, intent(in) :: lugi, nlen, nnum, idxver
   character, intent(in) :: filename*(*)
-  
+
   character cd8*8, ct10*10, hostname*15
 #ifdef __GFORTRAN__
   integer istat
@@ -270,7 +270,7 @@ subroutine getidx2(lugb, lugi, idxver, cindex, nlen, nnum, iret)
   integer, intent(inout) :: idxver
   character(len = 1), pointer, dimension(:) :: cindex
   integer, intent(out) :: nlen, nnum, iret
-  
+
   integer, parameter :: maxidx = 10000
   integer (kind = 8), parameter :: msk1 = 32000_8, msk2 = 4000_8
   integer :: lux
@@ -428,7 +428,7 @@ end subroutine getidx2
 !> @author Mark Iredell, Ed Hartnett @date 2000-05-26
 subroutine getg2i(lugi, cbuf, nlen, nnum, iret)
   implicit none
-  
+
   integer, intent(in) :: lugi
   character(len=1), pointer, dimension(:) :: cbuf
   integer, intent(out) :: nlen, nnum, iret
@@ -449,7 +449,7 @@ end subroutine getg2i2
   if (idxver .eq. 2) iret = 5
 
 end subroutine getg2i
-  
+
 !> Read a version 1 or 2 index file and return its contents.
 !>
 !> The index file may be generated by the grb2index utility of the
@@ -475,13 +475,13 @@ end subroutine getg2i
 !> 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 - 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)
+!> 021 - 024 | 037 - 044 | bytes to skip in message before drs (4/8 bytes)
+!> 025 - 028 | 045 - 048 | bytes to skip in message before bms (4 bytes)
+!> 029 - 032 | 049 - 052 | bytes to skip in message before data section (4 bytes)
+!> 033 - 040 | 053 - 060 | bytes total in the message (8 bytes)
+!> 041 - 041 | 061 - 061 | grib version number (always 2) (1 byte)
+!> 042 - 042 | 062 - 062 | message discipline (1 byte)
+!> 043 - 044 | 063 - 064 | 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)
@@ -511,11 +511,11 @@ end subroutine getg2i
 subroutine getg2i2(lugi, cbuf, idxver, nlen, nnum, iret)
   use g2logging
   implicit none
-  
+
   integer, intent(in) :: lugi
   character(len=1), pointer, dimension(:) :: cbuf
   integer, intent(out) :: idxver, nlen, nnum, iret
-  
+
   character chead*162
   integer :: ios, istat, lbuf, lhead, nskp
 
@@ -588,7 +588,7 @@ subroutine getg2ir(lugb, msk1, msk2, mnum, cbuf, nlen, nnum, nmess, iret)
   integer, intent(out) :: nlen, nnum, nmess, iret
 
   integer (kind = 8) :: msk1_8, msk2_8
-  
+
   interface
      subroutine getg2i2r(lugb, msk1, msk2, mnum, idxver, cbuf, &
           nlen, nnum, nmess, iret)
@@ -604,7 +604,7 @@ end subroutine getg2i2r
   msk2_8 = msk2
   call getg2i2r(lugb, msk1_8, msk2_8, mnum, 1, cbuf, nlen, nnum, nmess, iret)
 end subroutine getg2ir
-     
+
 !> Generate a version 1 or 2 index record for each message in a GRIB2
 !> file.
 !>
@@ -648,7 +648,7 @@ subroutine getg2i2r(lugb, msk1, msk2, mnum, idxver, cbuf, nlen, nnum, nmess, ire
   integer, intent(in) :: mnum, idxver
   character(len = 1), pointer, dimension(:) :: cbuf
   integer, intent(out) :: nlen, nnum, nmess, iret
-  
+
   character(len = 1), pointer, dimension(:) :: cbuftmp
   integer :: nbytes, newsize, next, numfld, m, mbuf
   integer (kind = 8) :: iseek, lskip, lgrib
@@ -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 = 16
+     inc = 20
   endif
 
   ! Search for request.
@@ -1258,7 +1258,7 @@ subroutine ix2gb2(lugb, lskip8, idxver, lgrib8, cbuf, numfld, mlen, iret)
   integer (kind = 8), intent(in) :: lgrib8
   character(len = 1), pointer, intent(inout), dimension(:) :: cbuf
   integer, intent(out)  :: numfld, mlen, iret
-  
+
   character cver, cdisc
   character(len = 4) :: ctemp
   integer (kind = 8) :: loclus8, locgds8
@@ -1284,19 +1284,23 @@ subroutine ix2gb2(lugb, lskip8, idxver, lgrib8, cbuf, numfld, mlen, iret)
   ! Number of bytes of the BMS section put into index record.
   integer :: MXBMS
   parameter(MXBMS = 6)
-  integer :: IXDS
+  integer :: IXDS1, IXDS2
+  parameter(IXDS1 = 28, IXDS2 = 48)
   ! Bytes to skip in (version 1) index record to get to section 0.  
   integer :: IXIDS
   parameter(IXIDS = 44) 
   integer :: IXSDR
-  parameter(IXSDR = 20, IXDS = 28)
-  ! Bytes to skip in (version 1) index record to get to bms.    
-  integer :: IXBMS
-  parameter(IXBMS = 24)
+  parameter(IXSDR = 20)
+  ! Bytes to skip in (version 1 and 2) index record to get to bms.    
+  integer :: IXBMS1, IXBMS2, ixbms
+  parameter(IXBMS1 = 24, IXBMS2 = 44)
   ! Sizes of integers in bits.
   integer :: INT1_BITS, INT2_BITS, INT4_BITS, INT8_BITS
   parameter(INT1_BITS = 8, INT2_BITS = 16, INT4_BITS = 32, INT8_BITS = 64)
-
+  ! Location of bytes to drs field in index version 1 and 2.
+  integer :: IXDRS1, IXDRS2
+  parameter(IXDRS1 = 20, IXDRS2 = 36)
+
   ! Buffers.
   character cbread(LINMAX), cindex(LINMAX)
   character cids(LINMAX), cgds(LINMAX)
@@ -1325,7 +1329,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 = 16
+     inc = 20
   endif
 
   ! Initialize values and allocate buffer (at the user-provided cbuf
@@ -1453,7 +1457,7 @@ end subroutine g2_gbytec1
            !print '(i3, a8, i4)', mypos/8, ' locpds ', int(ibskip8 - lskip8, kind(4))
            mypos = mypos + INT4_BITS
         else
-           inc = 16
+           inc = 20
            call g2_sbytec8(cindex, lskip8, mypos, INT8_BITS)    ! bytes to skip
            !print '(i3, a7, i4)', mypos/8, ' lskip ', lskip
            mypos = mypos + INT8_BITS
@@ -1465,17 +1469,16 @@ end subroutine g2_gbytec1
            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
+           mypos = mypos + INT8_BITS + INT4_BITS
         endif
 
         ! These ints are the same size in index version 1 and 2. The
         ! mypos variable contains the proper offset, which is
         mypos = mypos + INT4_BITS * 3 ! skip ahead in cbuf
+#ifdef LOGGING
+           write(g2_log_msg, *) ' writing total len to index: mypos/8 ', mypos/8, lgrib8
+           call g2_log(2)
+#endif
         call g2_sbytec8(cindex, lgrib8, mypos, INT8_BITS)    ! len of grib2
         !print '(i3, a8, i4)', mypos/8, ' lgrib8 ', lgrib8
         mypos = mypos + INT8_BITS
@@ -1516,12 +1519,26 @@ end subroutine g2_gbytec1
         endif
         !print *, 'pds:', lindex, lindex + ilnpds
         lindex = lindex + ilnpds
+        mypos = mypos + ilnpds
+#ifdef LOGGING
+        write(g2_log_msg, *) ' after writing pds location to index: mypos/8 ', mypos/8
+        call g2_log(3)
+#endif
      elseif (numsec .eq. 5) then
         ! Write the byte offset to the DRS section into the cindex buffer.
-        mypos = (IXSDR + inc) * INT1_BITS
-        call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), mypos, INT4_BITS)  ! location of drs
+        !mypos = (IXSDR + inc) * INT1_BITS
+#ifdef LOGGING
+        write(g2_log_msg, *) ' before writing drs to index: ibskip8 - lskip8 ', ibskip8 - lskip8, IXDRS2
+        call g2_log(3)
+#endif
+        ! Write the bytes to skip to the drs section into the index record.
+        if (idxver .eq. 1) then
+           call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), IXDRS1 * INT1_BITS, INT4_BITS)
+        else
+           call g2_sbytec8(cindex, ibskip8 - lskip8, IXDRS2 * INT1_BITS, INT8_BITS)  ! location of drs
+        endif
         !print '(i3, a8, i5)', mypos/8, ' locdrs ', int(ibskip8 - lskip8, kind(4))
-        
+
         ! Read the DRS section directly into the cindex buffer.
         ilndrs = lensec
         ilndrs8 = ilndrs
@@ -1532,19 +1549,25 @@ end subroutine g2_gbytec1
         endif
         !print *, 'drs:', lindex, lindex + ilndrs
         lindex = lindex + ilndrs
-     elseif (numsec .eq. 6) then    
+     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))
-        mypos = (IXBMS + inc) * INT1_BITS           
         if (indbmp .lt. 254) then
            locbms = int(ibskip8 - lskip8, kind(4))
-           call g2_sbytec(cindex, locbms, mypos, INT4_BITS)  ! loc. of bms
+           call g2_sbytec(cindex, locbms, ixbms, INT4_BITS)  ! loc. of bms
            !print '(i3, a8, i5)', mypos/8, ' locbms ', int(ibskip8 - lskip8, kind(4))           
         elseif (indbmp .eq. 254) then
-           call g2_sbytec(cindex, locbms, mypos, INT4_BITS)  ! loc. of bms
+           call g2_sbytec(cindex, locbms, ixbms, INT4_BITS)  ! loc. of bms
         elseif (indbmp .eq. 255) then
-           call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), mypos, INT4_BITS)  ! loc. of bms
+           call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), ixbms, INT4_BITS)  ! loc. of bms
         endif
 
         ! Copy 6 bytes of the BMS from data buffer to the cindex buffer.
@@ -1561,8 +1584,12 @@ end subroutine g2_gbytec1
         !print '(i3, a8, i5)', 0, ' lindex ', lindex
      elseif (numsec .eq. 7) then                 ! found data section
         ! Write the offset to the data section in the cindex buffer.
-        mypos = (IXDS + inc) * INT1_BITS           
-        call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), mypos, INT4_BITS)   ! loc. of data sec.
+        if (idxver .eq. 1) then
+           call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), IXDS1 * INT1_BITS, INT4_BITS)
+        else
+           call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), IXDS2 * INT1_BITS, INT4_BITS)
+        endif
+
         !print '(i3, a8, i5)', mypos/8, ' locdata ', int(ibskip8 - lskip8, kind(4))
 
         ! Increment the field count.

tests/g2_test_util.F90

@@ -201,8 +201,12 @@ end subroutine g2_gbytec81
      call g2_gbytec1(cbuf, b2s_pds, mypos, INT4_BITS)
      mypos = mypos + INT4_BITS
      b2s_pds8 = b2s_pds
+     print *, 'before reading drs loc, mypos/8', mypos/8
+     call g2_gbytec1(cbuf, b2s_drs, mypos, INT4_BITS)
+     mypos = mypos + INT4_BITS
+     b2s_drs8 = b2s_drs
   else
-     inc = 16
+     inc = 20
      call g2_gbytec81(cbuf, b2s_message8, 8 * 4, INT8_BITS)
      mypos = mypos + INT8_BITS
      call g2_gbytec81(cbuf, b2s_lus8, 8 * 12, INT8_BITS)
@@ -211,10 +215,10 @@ end subroutine g2_gbytec81
      mypos = mypos + INT8_BITS
      call g2_gbytec81(cbuf, b2s_pds8, mypos, INT8_BITS)
      mypos = mypos + INT8_BITS
+     print *, 'before reading drs loc, mypos/8', mypos/8
+     call g2_gbytec81(cbuf, b2s_drs8, mypos, INT8_BITS)
+     mypos = mypos + INT8_BITS  
   endif
-  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

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. 4104) stop 81
+        if (nlen .ne. 4180) 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. 272694) then
+  if (nlen .ne. 277018) 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. 484) then
+        if (nlen .ne. 492) then
            print *, nlen
            stop 80
         endif

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. 216) then
+        if (nlen .ne. 220) then
            print *, nlen
            stop 81
         endif