From 2dbcf807b4f1f59cef075e68e036cd75897a4283 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 23 May 2024 01:46:14 -0600 Subject: [PATCH 1/6] fixed test --- src/g2getgb2.F90 | 25 +++++- tests/test_getgb2p_2.F90 | 187 +++++++++++++++++++++++---------------- 2 files changed, 135 insertions(+), 77 deletions(-) diff --git a/src/g2getgb2.F90 b/src/g2getgb2.F90 index 5af377a9..133b19a0 100644 --- a/src/g2getgb2.F90 +++ b/src/g2getgb2.F90 @@ -1207,6 +1207,12 @@ end subroutine g2_gbytec81 mypos = mypos + INT8_BITS mypos = mypos + 44 * INT1_BITS ! skip ahead in the cindex endif +#ifdef LOGGING + write(g2_log_msg, *) 'iskip8', iskip8, 'iskip', iskip, 'mypos/8', mypos/8 + call g2_log(2) +#endif + + ! Determine length of local section (section 2). if (iskp2_8 .gt. 0) then call bareadl(lugb, iskip8 + iskp2_8, 4_8, lread8, ctemp) call g2_gbytec1(ctemp, len2, 0, INT4_BITS) ! length of section 2 @@ -1216,6 +1222,12 @@ end subroutine g2_gbytec81 else len2 = 0 endif +#ifdef LOGGING + write(g2_log_msg, *) 'iskip8 ', iskip8, ' iskp2_8 ', iskp2_8, 'len2', len2 + call g2_log(2) +#endif + + ! Find the lengths of the sections 1, 3, 4, 5, and 6. call g2_gbytec1(cindex, len1, mypos, INT4_BITS) ! length of section 1 mypos = mypos + len1 * INT1_BITS ! skip ahead in the cindex call g2_gbytec1(cindex, len3, mypos, INT4_BITS) ! length of section 3 @@ -1226,6 +1238,12 @@ end subroutine g2_gbytec81 mypos = mypos + len5 * INT1_BITS ! skip ahead in the cindex call g2_gbytec1(cindex, len6, mypos, INT4_BITS) ! length of section 6 mypos = mypos + len6 * INT1_BITS ! skip ahead in the cindex +#ifdef LOGGING + write(g2_log_msg, *) 'len1', len1, 'len3', len3, 'len4', len4, 'len5', len5, 'len6', len6 + call g2_log(2) +#endif + + ! Handle the bitmap, if present. call g2_gbytec1(cindex, ibmap, mypos, INT1_BITS) ! bitmap indicator if (ibmap .eq. 254) then ! Get the bytes to skip for section 6 from the index. @@ -1235,7 +1253,7 @@ end subroutine g2_gbytec81 call g2_gbytec1(cindex, iskp6, IXBMS2 * INT1_BITS, INT4_BITS) endif - ! Read the length of the bitmat section from the data file. (lu, byts to + ! 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 @@ -1361,5 +1379,10 @@ end subroutine g2_gbytec81 iret = 97 return endif +#ifdef LOGGING + write(g2_log_msg, *) ' read message into gribm, lread8', lread8 + call g2_log(3) +#endif + endif end subroutine getgb2rp2 diff --git a/tests/test_getgb2p_2.F90 b/tests/test_getgb2p_2.F90 index 90a1223f..546f26a0 100755 --- a/tests/test_getgb2p_2.F90 +++ b/tests/test_getgb2p_2.F90 @@ -3,119 +3,154 @@ ! lengths of each message section by verifying that the last four octets are ! '7777'. ! -! Alex Richert, May 2024 +! Alex Richert, Edward Hartnett, May, 2024 PROGRAM test_getgb2p_2 + use g2logging use grib_mod use pdstemplates use gridtemplates - integer,dimension(200) :: IDS,GDT,PDT - integer :: DSCPL,GDTN,PDTN - integer :: nrec - integer,parameter :: jrew=0 - character * 1 :: a7,b7,c7,d7 + implicit none - CHARACTER * 80 DESC,WMOHEAD - CHARACTER * 200 fileb,filei,fileo - character(len=1),pointer,dimension(:) :: gribm + integer, dimension(200) :: ids, gdt, pdt + integer :: dscpl, gdtn, pdtn + integer :: nrec + integer, parameter :: jrew = 0 + character * 1 :: a7, b7, c7, d7 - logical :: extract=.false. + character * 80 desc, wmohead + character * 200 fileb, filei, fileo + character(len = 1), pointer, dimension(:) :: gribm + + logical :: extract = .false. + integer :: idxver = 2 + integer (kind = 8) :: itot + integer :: ios, iret, iret1, j2, krew, lugb, lugi, lugo interface - SUBROUTINE GETGB2P(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT, & - EXTRACT,K,GRIBM,LENG,IRET) - INTEGER,INTENT(IN) :: LUGB,LUGI,J,JDISC,JPDTN,JGDTN - INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*) - LOGICAL,INTENT(IN) :: EXTRACT - INTEGER,INTENT(OUT) :: K,IRET - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: GRIBM - END SUBROUTINE GETGB2P + subroutine getgb2p2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + extract, idxver, k, gribm, leng8, iret) + integer, intent(in) :: lugb, lugi, j, jdisc + integer, dimension(:) :: jids(*) + integer, intent(in) :: jpdtn + integer, dimension(:) :: jpdt(*) + integer, intent(in) :: jgdtn + integer, dimension(:) :: jgdt(*) + logical, intent(in) :: extract + integer, intent(inout) :: idxver + integer, intent(out) :: k + character(len = 1), pointer, dimension(:) :: gribm + integer (kind = 8), intent(out) :: leng8 + integer, intent(out) :: iret + end subroutine getgb2p2 end interface - NAMELIST /GRIBIDS/DSCPL,IDS,GDTN,GDT,PDTN,PDT,DESC,WMOHEAD,EXTRACT + namelist /gribids/DSCPL, IDS, GDTN, GDT, PDTN, PDT, DESC, WMOHEAD, EXTRACT - lugb=11 ! Input GRIB2 File - lugi=0 ! Input GRIB2 INdex File - lugo=51 ! Output transmission file. + lugb = 11 ! Input GRIB2 File + lugi = 0 ! Input GRIB2 INdex File + lugo = 51 ! Output transmission file. - ! Read GRIB2 data and index file names from the FORT_nn - ! environment variables, and open the files. - fileb='data/rrfs.t12z.prslevfaa.f010.na3km.grib2' - filei='' + ! Read GRIB2 data and index file names from the FORT_nn + ! environment variables, and open the files. + fileb = 'data/rrfs.t12z.prslevfaa.f010.na3km.grib2' + filei = '' + + print *, 'Testing getgb2p2() on', fileb - call baopenr(lugb,fileb,iret1) + call baopenr(lugb, fileb, iret1) if (iret1 .ne. 0) then - write(6,fmt='(" Error opening GRIB file: ",A200)') fileb - write(6,fmt='(" baopenr error = ",I5)') iret1 + print *, 'error opening data file, iret1', iret1 stop 10 endif - ! Read output GRIB bulletin file name from FORTnn - ! environment variable, and open file. - fileo='test_tocgrib2.output.grib2' - call baopenw(lugo,fileo,iret1) + ! Read output GRIB bulletin file name from FORTnn + ! environment variable, and open file. + fileo = 'test_tocgrib2.output.grib2' + call baopenw(lugo, fileo, iret1) if (iret1 .ne. 0) then - write(6,fmt='(" Error opening output transmission file: ", A200)') fileo - write(6,fmt='(" baopenw error = ",I5)') iret1 + print *, 'Error opening output transmission file, iret1', iret1 stop 20 endif - ! loop through input control records. - iret=0 + ! Loop through input control records. + iret = 0 nrec = 0 - open(12, file='data/grib2.awips.rrfs.010') + open(12, file = 'data/grib2.awips.rrfs.010') foreachinputrecord: do - ! Set Namelist defaults - DSCPL=-1 ! Grib2 Discipline number - IDS=-9999 ! GRIB2 Identification Section - GDTN=-1 ! Grid Definition Template Number - GDT=-9999 ! Grid Definition Template - PDTN=-1 ! Product Definition Template Number - PDT=-9999 ! Product Definition Template - WMOHEAD='TTAAnn CCCC' - EXTRACT=.false. + ! Set Namelist defaults. + dscpl = -1 ! Grib2 Discipline number. + ids = -9999 ! GRIB2 Identification Section. + gdtn = -1 ! Grid Definition Template Number. + gdt = -9999 ! Grid Definition Template. + pdtn = -1 ! Product Definition Template Number. + pdt = -9999 ! Product Definition Template. + wmohead = 'TTAAnn CCCC' + extract = .false. - READ (12,GRIBIDS,iostat=ios) + read (12, gribids, iostat = ios) if (ios .ne. 0) then - write(6,fmt='(" Error reading PDS from input file. iostat = ",i5)') ios + if (nrec .eq. 337) then + print *, 'All input records processed!' + exit + endif + print *, 'Error reading PDS from input file. ios', ios, 'nrec', nrec + stop 500 cycle endif nrec = nrec + 1 ! Echo input record - write(6,'(A,I0)') ' Start new record no. = ',nrec - write(6,'(73A)') ' DESC=',DESC(1:73) - write(6,'(11A)') ' WMOHEAD=',WMOHEAD(1:11) - write(6,'(A,I0)') ' GRIB2 DISCIPLINE= ',DSCPL - write(6,'(A,20(1x,I0))')' Section 1=', & - (IDS(j2),j2=1,13) + write(6, '(A, I0)') ' Start new record no. = ', nrec + if (nrec .eq. 314) then + g2_log_level = 0 + endif + write(6, '(73A)') ' DESC = ', DESC(1:73) + write(6, '(11A)') ' WMOHEAD = ', WMOHEAD(1:11) + write(6, '(A, I0)') ' GRIB2 DISCIPLINE = ', DSCPL + write(6, '(A, 20(1x, I0))')' Section 1 = ', (IDS(j2), j2 = 1, 13) if (GDTN .ne. -1) then - write(6,'(A,I0,A,100(1x,I0))') ' GDT 3. ',GDTN,' =', & - (GDT(j2),j2=1,getgdtlen(GDTN)) + write(6, '(A, I0, A, 100(1x, I0))') ' GDT 3. ', GDTN, ' = ', (GDT(j2), j2 = 1, getgdtlen(GDTN)) endif if (PDTN .ne. -1) then - write(6,'(A,I0,A,100(1x,I0))') ' PDT 4. ',PDTN,' =', & - (PDT(j2),j2=1,getpdtlen(PDTN)) + write(6, '(A, I0, A, 100(1x, I0))') ' PDT 4. ', PDTN, ' = ', (PDT(j2), j2 = 1, getpdtlen(PDTN)) endif - ! Read and return packed GRIB field - CALL GETGB2P(lugb,lugi,jrew,DSCPL,IDS,PDTN,PDT, & - GDTN,GDT,extract,KREW,gribm,itot,iret) - IF (IRET.NE.0) THEN - IF (IRET.EQ.96)WRITE(6,'(A)')' GETGB2P: ERROR READING INDEX' & - //' FILE' - IF (IRET.EQ.97)WRITE(6,'(A)')' GETGB2P: ERROR READING GRIB' & - //' FILE' - IF (IRET.EQ.99)WRITE(6,'(A)')' GETGB2P: ERROR REQUEST NOT' & - //' FOUND' + ! Read and return packed GRIB field. + print *, '*** calling getgb2p2()' + call getgb2p2(lugb, lugi, jrew, dscpl, ids, pdtn, pdt, gdtn, gdt, & + extract, idxver, krew, gribm, itot, iret) + print *, '*** iret', iret + if (iret .ne. 0) then + if (iret .eq. 96) then + print *, ' test_getgb2p_2: error reading index file' + stop 505 + endif + if (iret .eq. 97) then + print *, ' test_getgb2p_2: error reading grib file' + stop 510 + endif + if (iret .eq. 99) then + print *, ' test_getgb2p_2: error request not found, nrec', nrec + write(6, '(A, I0, A, 100(1x, I0))') ' PDT 4. ', PDTN, ' = ', (PDT(j2), j2 = 1, getpdtlen(PDTN)) + ! We expect this one won't be found. + if (nrec .ne. 314) then + stop 515 + endif + endif cycle - END IF - a7=gribm(size(gribm)-3) - b7=gribm(size(gribm)-2) - c7=gribm(size(gribm)-1) - d7=gribm(size(gribm)) - if(.not.all((/a7,b7,c7,d7/).eq.'7')) stop 77 + end if + a7 = gribm(size(gribm) - 3) + b7 = gribm(size(gribm) - 2) + c7 = gribm(size(gribm) - 1) + d7 = gribm(size(gribm)) + if (.not. all((/a7, b7, c7, d7/) .eq. '7')) then + print *, 'error with section 8' + stop 77 + endif deallocate(gribm) - return enddo foreachinputrecord + print *, 'OK!' + print *, 'SUCCESS!' + END PROGRAM test_getgb2p_2 From 9df5dc4d95e7bdc89d8022f2499d662d4c25591c Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 23 May 2024 03:36:18 -0600 Subject: [PATCH 2/6] code cleanup --- src/g2index.F90 | 46 ++++++++++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 18 deletions(-) diff --git a/src/g2index.F90 b/src/g2index.F90 index 7cce6b8e..397b46b8 100644 --- a/src/g2index.F90 +++ b/src/g2index.F90 @@ -1317,6 +1317,16 @@ subroutine g2_gbytec1(in, siout, iskip, nbits) integer, intent(inout) :: siout integer, intent(in) :: iskip, nbits end subroutine g2_gbytec1 + subroutine g2_sbytec81(out, sin, iskip, nbits) + character*1, intent(inout) :: out(*) + integer (kind = 8), intent(in) :: sin + integer, intent(in) :: iskip, nbits + end subroutine g2_sbytec81 + subroutine g2_sbytec1(out, in, iskip, nbits) + character*1, intent(inout) :: out(*) + integer, intent(in) :: in + integer, intent(in) :: iskip, nbits + end subroutine g2_sbytec1 end interface #ifdef LOGGING @@ -1445,16 +1455,16 @@ end subroutine g2_gbytec1 if (idxver .eq. 1) then inc = 0 lskip = int(lskip8, kind(4)) - call g2_sbytec(cindex, lskip, mypos, INT4_BITS) ! bytes to skip + call g2_sbytec1(cindex, lskip, mypos, INT4_BITS) ! bytes to skip !print '(i3, a7, i4)', mypos/8, ' lskip ', lskip, mypos mypos = mypos + INT4_BITS - call g2_sbytec(cindex, loclus, mypos, INT4_BITS) ! location of local use + call g2_sbytec1(cindex, loclus, mypos, INT4_BITS) ! location of local use !print '(i3, a8, i4)', mypos/8, ' loclus ', loclus mypos = mypos + INT4_BITS - call g2_sbytec(cindex, locgds, mypos, INT4_BITS) ! location of gds + call g2_sbytec1(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 + call g2_sbytec1(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)) @@ -1464,16 +1474,16 @@ end subroutine g2_gbytec1 mypos = mypos + INT4_BITS else inc = 20 - call g2_sbytec8(cindex, lskip8, mypos, INT8_BITS) ! bytes to skip + call g2_sbytec81(cindex, lskip8, mypos, INT8_BITS) ! bytes to skip !print '(i3, a7, i4)', mypos/8, ' lskip ', lskip mypos = mypos + INT8_BITS - call g2_sbytec8(cindex, loclus8, mypos, INT8_BITS) ! location of local use + call g2_sbytec81(cindex, loclus8, mypos, INT8_BITS) ! location of local use !print '(i3, a8, i4)', mypos/8, ' loclus ', loclus mypos = mypos + INT8_BITS - call g2_sbytec8(cindex, locgds8, mypos, INT8_BITS) ! location of gds + call g2_sbytec81(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 + 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 endif @@ -1485,7 +1495,7 @@ end subroutine g2_gbytec1 write(g2_log_msg, *) ' writing total len to index: mypos/8 ', mypos/8, lgrib8 call g2_log(4) #endif - call g2_sbytec8(cindex, lgrib8, mypos, INT8_BITS) ! len of grib2 + call g2_sbytec81(cindex, lgrib8, mypos, INT8_BITS) ! len of grib2 !print '(i3, a8, i4)', mypos/8, ' lgrib8 ', lgrib8 mypos = mypos + INT8_BITS cindex((mypos / 8) + 1) = cver @@ -1494,7 +1504,7 @@ end subroutine g2_gbytec1 cindex((mypos / 8) + 1) = cdisc !print '(i3, a7, z2)', mypos/8, ' cdisc ', cdisc mypos = mypos + INT1_BITS - call g2_sbytec(cindex, numfld + 1, mypos, INT2_BITS) ! field num + call g2_sbytec1(cindex, numfld + 1, mypos, INT2_BITS) ! field num !print '(i3, a8, i4)', mypos/8, ' numfld ', numfld + 1 mypos = mypos + INT2_BITS @@ -1539,9 +1549,9 @@ end subroutine g2_gbytec1 #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) + call g2_sbytec1(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 + call g2_sbytec81(cindex, ibskip8 - lskip8, IXDRS2 * INT1_BITS, INT8_BITS) ! location of drs endif !print '(i3, a8, i5)', mypos/8, ' locdrs ', int(ibskip8 - lskip8, kind(4)) @@ -1568,12 +1578,12 @@ end subroutine g2_gbytec1 indbmp = g2_mova2i(cbread(6)) if (indbmp .lt. 254) then locbms = int(ibskip8 - lskip8, kind(4)) - call g2_sbytec(cindex, locbms, ixbms, INT4_BITS) ! loc. of bms + call g2_sbytec1(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, ixbms, INT4_BITS) ! loc. of bms + call g2_sbytec1(cindex, locbms, ixbms, INT4_BITS) ! loc. of bms elseif (indbmp .eq. 255) then - call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), ixbms, INT4_BITS) ! loc. of bms + call g2_sbytec1(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. @@ -1586,14 +1596,14 @@ end subroutine g2_gbytec1 ! The size of the index record is now known, so write it to ! the cindex buffer. - call g2_sbytec(cindex, lindex, 0, INT4_BITS) ! num bytes in index record + call g2_sbytec1(cindex, lindex, 0, INT4_BITS) ! num bytes in index record !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. if (idxver .eq. 1) then - call g2_sbytec(cindex, int(ibskip8 - lskip8, kind(4)), IXDS1 * INT1_BITS, INT4_BITS) + call g2_sbytec1(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) + call g2_sbytec1(cindex, int(ibskip8 - lskip8, kind(4)), IXDS2 * INT1_BITS, INT4_BITS) endif !print '(i3, a8, i5)', mypos/8, ' locdata ', int(ibskip8 - lskip8, kind(4)) From 55041a13286400a593eaa3bb967decaedf519bf7 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 23 May 2024 03:38:39 -0600 Subject: [PATCH 3/6] code cleanup --- src/g2index.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/g2index.F90 b/src/g2index.F90 index 397b46b8..9fcbb26f 100644 --- a/src/g2index.F90 +++ b/src/g2index.F90 @@ -1374,7 +1374,7 @@ end subroutine g2_sbytec1 endif ! Check GRIB version from section 0, must be 2. - if (cbread(8) .ne. char(2)) then ! not grib edition 2 + if (cbread(8) .ne. char(2)) then iret = 3 return endif @@ -1384,7 +1384,7 @@ end subroutine g2_sbytec1 cdisc = cbread(7) ! Read the length of section 1 from the file data buffer. - call g2_gbytec1(cbread, lensec1, 16 * 8, INT4_BITS) + call g2_gbytec1(cbread, lensec1, 16 * INT1_BITS, INT4_BITS) lensec1 = min(lensec1, int(ibread8, kind(lensec1))) ! Copy section 1 values into cids array. From 030d7a563bab35231b2ca7cb801163ff2e850be1 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 23 May 2024 03:45:59 -0600 Subject: [PATCH 4/6] more code cleanup --- src/g2index.F90 | 25 ++++++++----------------- 1 file changed, 8 insertions(+), 17 deletions(-) diff --git a/src/g2index.F90 b/src/g2index.F90 index 9fcbb26f..a9fbdba5 100644 --- a/src/g2index.F90 +++ b/src/g2index.F90 @@ -1268,7 +1268,7 @@ 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 locgds, loclus integer :: indbmp, numsec, newsize, g2_mova2i, mbuf, lindex integer :: lskip integer :: ilndrs, ilnpds, istat @@ -1298,7 +1298,7 @@ subroutine ix2gb2(lugb, lskip8, idxver, lgrib8, cbuf, numfld, mlen, iret) 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 @@ -1566,24 +1566,15 @@ 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)) - elseif (indbmp .eq. 254) then - call g2_sbytec1(cindex, locbms, ixbms, INT4_BITS) ! loc. of bms - elseif (indbmp .eq. 255) then - call g2_sbytec1(cindex, int(ibskip8 - lskip8, kind(4)), ixbms, INT4_BITS) ! loc. of bms + if (indbmp .lt. 254 .or. indbmp .eq. 255) then + 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_sbytec1(cindex, int(ibskip8 - lskip8, kind(4)), IXBMS2 * INT1_BITS, INT4_BITS) ! loc. of bms + endif endif ! Copy 6 bytes of the BMS from data buffer to the cindex buffer. From 05ae55c006cafff053f241630fb408b32e7b7bac Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 23 May 2024 04:42:35 -0600 Subject: [PATCH 5/6] changed bms location in index to 64-bit int --- src/g2getgb2.F90 | 34 +++++++++++++----- src/g2index.F90 | 16 ++++----- tests/g2_test_util.F90 | 11 ++++-- ..._gdaswave.t00z.wcoast.0p16.f000.grb2index2 | Bin 4342 -> 4418 bytes tests/test_create_index.F90 | 2 +- tests/test_create_index_fv3.F90 | 2 +- tests/test_create_index_gdas.F90 | 6 ++-- tests/test_create_index_seaice.F90 | 2 +- tests/test_g1.F90 | 13 ++++--- tests/test_getg2i2r.F90 | 6 ++-- tests/test_getgb2p2.F90 | 4 +-- tests/test_getidx.F90 | 15 ++++---- tests/test_ix2gb2.F90 | 7 ++-- 13 files changed, 73 insertions(+), 45 deletions(-) diff --git a/src/g2getgb2.F90 b/src/g2getgb2.F90 index 133b19a0..e4ab3474 100644 --- a/src/g2getgb2.F90 +++ b/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. diff --git a/src/g2index.F90 b/src/g2index.F90 index a9fbdba5..9969a131 100644 --- a/src/g2index.F90 +++ b/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. @@ -1291,7 +1291,7 @@ 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) @@ -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 @@ -1573,7 +1573,7 @@ end subroutine g2_sbytec1 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_sbytec1(cindex, int(ibskip8 - lskip8, kind(4)), IXBMS2 * INT1_BITS, INT4_BITS) ! loc. of bms + call g2_sbytec81(cindex, ibskip8 - lskip8, IXBMS2 * INT1_BITS, INT8_BITS) ! loc. of bms endif endif diff --git a/tests/g2_test_util.F90 b/tests/g2_test_util.F90 index e29fb3ca..9ea2bdeb 100644 --- a/tests/g2_test_util.F90 +++ b/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) diff --git a/tests/ref_gdaswave.t00z.wcoast.0p16.f000.grb2index2 b/tests/ref_gdaswave.t00z.wcoast.0p16.f000.grb2index2 index 9de0579c068906b97287a48bd1e8a90ad807a57d..2bdd57197092f48d4398742e0c05a740c305e0e4 100644 GIT binary patch delta 316 zcmeySct~l2ESHh7f`N&ZiGh{DM0ICoBU7`9xfYBMCN9%vWSDqvGv@;aFtDCBah)?CHGQbyhr5T$l3a3QlQh>#R3NXI!=kdAL)_9`|I z`w|;m>G3xZrR&(?Lf;)ALR}mn-FBQH9ci2(wiFkL?Zma21L91klF1v{RDeQq+%Vlt z%W@#Pe{q9!tm6UcxW)rwckzPQn|NVLnM0;Sl=kt#h33A72xakubjS&Sbhrs@005bA BU1R_N delta 341 zcmX@4^i6SsESI6Bf`PG>p}CdGM0ICoLkok6xfYCfCN9&Scy$Bk9R@J4o;Gov^5m_I zaDgeDAc3h&aDhuoAc0b5m;fX136MZ23tYgg3M6343KvLO0}>Erg9|MG3ljK>5IFt@ zByg1-uHw4`NMI`mOn^zv03#Z-Z{05%?K4gdfE diff --git a/tests/test_create_index.F90 b/tests/test_create_index.F90 index 4fc84f48..d0628500 100644 --- a/tests/test_create_index.F90 +++ b/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 diff --git a/tests/test_create_index_fv3.F90 b/tests/test_create_index_fv3.F90 index d909df2c..9e4d014a 100644 --- a/tests/test_create_index_fv3.F90 +++ b/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 diff --git a/tests/test_create_index_gdas.F90 b/tests/test_create_index_gdas.F90 index 263e8c1f..83411cba 100644 --- a/tests/test_create_index_gdas.F90 +++ b/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) diff --git a/tests/test_create_index_seaice.F90 b/tests/test_create_index_seaice.F90 index dc5ebdbf..6e58752b 100644 --- a/tests/test_create_index_seaice.F90 +++ b/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 diff --git a/tests/test_g1.F90 b/tests/test_g1.F90 index f82e89eb..0bed2ad0 100644 --- a/tests/test_g1.F90 +++ b/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 diff --git a/tests/test_getg2i2r.F90 b/tests/test_getg2i2r.F90 index 57e978b0..c0ca1a73 100644 --- a/tests/test_getg2i2r.F90 +++ b/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 diff --git a/tests/test_getgb2p2.F90 b/tests/test_getgb2p2.F90 index 2f470cd4..7fb0784e 100644 --- a/tests/test_getgb2p2.F90 +++ b/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 diff --git a/tests/test_getidx.F90 b/tests/test_getidx.F90 index 255f2e49..6c93a21b 100644 --- a/tests/test_getidx.F90 +++ b/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, 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 @@ -68,7 +68,7 @@ end subroutine getidx2 if (i .eq. 1) then if (nlen .ne. 137600) stop 22 else - if (nlen .ne. 151360) then + if (nlen .ne. 154112) then print *, nlen stop 23 endif @@ -79,9 +79,9 @@ end subroutine getidx2 call g2_gbytec(cbuf, index_rec_len, mypos, INT4_BITS) mypos = mypos + INT4_BITS if (i .eq. 1) then - if (index_rec_len .ne. 200) stop 30 + 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 @@ -100,6 +100,8 @@ end subroutine getidx2 mypos = mypos + INT4_BITS call g2_gbytec(cbuf, b2s_drs, mypos, INT4_BITS) mypos = mypos + INT4_BITS + call g2_gbytec(cbuf, b2s_bms, 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 @@ -117,13 +119,14 @@ end subroutine getidx2 call g2_gbytec8(cbuf, b2s_drs8, mypos, INT8_BITS) mypos = mypos + INT8_BITS b2s_drs = int(b2s_drs8, kind(4)) + call g2_gbytec8(cbuf, b2s_bms8, mypos, INT8_BITS) + mypos = mypos + INT8_BITS + b2s_bms = int(b2s_bms8, kind(4)) endif if (b2s_gds .ne. 37) stop 34 if (b2s_pds .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 diff --git a/tests/test_ix2gb2.F90 b/tests/test_ix2gb2.F90 index 4283256b..d1bc8dbc 100644 --- a/tests/test_ix2gb2.F90 +++ b/tests/test_ix2gb2.F90 @@ -103,13 +103,14 @@ end subroutine read_index if (idxver .eq. 1) then if (mlen .ne. 200) stop 11 else - if (mlen .ne. 220) then + if (mlen .ne. 224) then print *, mlen - stop 11 + stop 12 endif endif ! Break out the index record into component values. + g2_log_level = 3 call read_index(cbuf, idxver, index_rec_len, b2s_message, b2s_lus, b2s_gds, b2s_pds, b2s_drs, & b2s_bms, b2s_data, total_bytes, grib_version, discipline, field_number, sec1, lengds, gds, & lenpds, pds, lendrs, drs, bms, iret) @@ -123,7 +124,7 @@ end subroutine read_index if (idxver .eq. 1) then 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 From e6e157d428c83dc4fbf40d0ea8a87d5351b030f1 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 23 May 2024 08:14:46 -0600 Subject: [PATCH 6/6] fixeed bms problems --- src/g2index.F90 | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/src/g2index.F90 b/src/g2index.F90 index 67d28a60..c8bdae7a 100644 --- a/src/g2index.F90 +++ b/src/g2index.F90 @@ -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, 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 @@ -1569,25 +1569,26 @@ end subroutine g2_sbytec1 ! Write the location of the BMS section in the message into ! the cindex buffer. indbmp = g2_mova2i(cbread(6)) - if (indbmp .lt. 254 .or. indbmp .eq. 255) then - 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 -!======= if (indbmp .lt. 254) then if (idxver .eq. 1) then locbms = int(ibskip8 - lskip8, kind(4)) - call g2_sbytec1(cindex, locbms, ixbms, INT4_BITS) ! loc. of bms + call g2_sbytec1(cindex, locbms, IXBMS1 * INT1_BITS, INT4_BITS) ! loc. of bms else - call g2_sbytec81(cindex, ibskip8 - lskip8, ixbms, INT4_BITS) ! loc. of bms + 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 -!>>>>>>> develop + 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.