From 9aa348b8810c96e12d889efd8d60e169c10c1dce Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Wed, 14 Feb 2024 17:22:34 -0700 Subject: [PATCH 1/8] clean up --- src/grb2index/grb2index.F90 | 248 ++++++++++++++++++------------------ 1 file changed, 123 insertions(+), 125 deletions(-) diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 index f4da9124..ebda6a59 100755 --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -4,7 +4,6 @@ !> This program creates an index file from a GRIB2 file. !> -!> !> @return !> - 0 successful run !> - 1 GRIB message not found @@ -12,86 +11,86 @@ !> - 8 error accessing file !> !> @author Iredell @date 1992-11-22 -PROGRAM GRB2INDEX - PARAMETER(MSK1=32000,MSK2=4000) - CHARACTER CGB*256,CGI*256 - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - CHARACTER CARG*300 - INTEGER NARG,IARGC - INTERFACE - SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM, & - NMESS,IRET) - INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET - END SUBROUTINE GETG2IR - END INTERFACE +program grb2index + parameter(msk1=32000,msk2=4000) + character cgb*256,cgi*256 + character(len=1),pointer,dimension(:) :: cbuf + character carg*300 + integer narg,iargc + interface + subroutine getg2ir(lugb,msk1,msk2,mnum,cbuf,nlen,nnum, & + nmess,iret) + integer,intent(in) :: lugb,msk1,msk2,mnum + character(len=1),pointer,dimension(:) :: cbuf + integer,intent(out) :: nlen,nnum,nmess,iret + end subroutine getg2ir + end interface - ! GET ARGUMENTS - NARG=IARGC() - IF(NARG.NE.2) THEN - CALL ERRMSG('grb2index: Incorrect usage') - CALL ERRMSG('Usage: grb2index gribfile indexfile') - CALL ERREXIT(2) - ENDIF - CALL GETARG(1,CGB) - NCGB=LEN_TRIM(CGB) - CALL BAOPENR(11,CGB(1:NCGB),IOS) - !CALL BASETO(1,1) - IF(IOS.NE.0) THEN - LCARG=LEN('grb2index: Error accessing file '//CGB(1:NCGB)) - CARG(1:LCARG)='grb2index: Error accessing file '//CGB(1:NCGB) - CALL ERRMSG(CARG(1:LCARG)) - CALL ERREXIT(8) - ENDIF - CALL GETARG(2,CGI) - NCGI=LEN_TRIM(CGI) - CALL BAOPEN(31,CGI(1:NCGI),IOS) - IF(IOS.NE.0) THEN - LCARG=LEN('grb2index: Error accessing file '//CGI(1:NCGI)) - CARG(1:LCARG)='grb2index: Error accessing file '//CGI(1:NCGI) - CALL ERRMSG(CARG(1:LCARG)) - CALL ERREXIT(8) - ENDIF + ! get arguments + narg=iargc() + if(narg.ne.2) then + call errmsg('grb2index: Incorrect usage') + call errmsg('Usage: grb2index gribfile indexfile') + call errexit(2) + endif + call getarg(1,cgb) + ncgb=len_trim(cgb) + call baopenr(11,cgb(1:ncgb),ios) + !call baseto(1,1) + if(ios.ne.0) then + lcarg=len('grb2index: Error accessing file '//cgb(1:ncgb)) + carg(1:lcarg)='grb2index: Error accessing file '//cgb(1:ncgb) + call errmsg(carg(1:lcarg)) + call errexit(8) + endif + call getarg(2,cgi) + ncgi=len_trim(cgi) + call baopen(31,cgi(1:ncgi),ios) + if(ios.ne.0) then + lcarg=len('grb2index: Error accessing file '//cgi(1:ncgi)) + carg(1:lcarg)='grb2index: Error accessing file '//cgi(1:ncgi) + call errmsg(carg(1:lcarg)) + call errexit(8) + endif - ! WRITE INDEX FILE - MNUM=0 - CALL GETG2IR(11,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRGI) - IF(IRGI.GT.1.OR.NNUM.EQ.0.OR.NLEN.EQ.0) THEN - CALL ERRMSG('grb2index: No GRIB messages detected in file ' & - //CGB(1:NCGB)) - CALL BACLOSE(11,IRET) - CALL BACLOSE(31,IRET) - CALL ERREXIT(1) - ENDIF - NUMTOT=NUMTOT+NNUM - MNUM=MNUM+NMESS - CALL WRGI1H(31,NLEN,NUMTOT,CGB(1:NCGB)) - IW=162 - CALL BAWRITE(31,IW,NLEN,KW,CBUF) - IW=IW+NLEN + ! write index file + mnum=0 + call getg2ir(11,msk1,msk2,mnum,cbuf,nlen,nnum,nmess,irgi) + if(irgi.gt.1.or.nnum.eq.0.or.nlen.eq.0) then + call errmsg('grb2index: No GRIB messages detected in file ' & + //cgb(1:ncgb)) + call baclose(11,iret) + call baclose(31,iret) + call errexit(1) + endif + numtot=numtot+nnum + mnum=mnum+nmess + call wrgi1h(31,nlen,numtot,cgb(1:ncgb)) + iw=162 + call bawrite(31,iw,nlen,kw,cbuf) + iw=iw+nlen - ! EXTEND INDEX FILE IF INDEX BUFFER LENGTH TOO LARGE TO HOLD IN MEMORY - IF(IRGI.EQ.1) THEN - DO WHILE(IRGI.EQ.1.AND.NNUM.GT.0) - IF (ASSOCIATED(CBUF)) THEN - DEALLOCATE(CBUF) - NULLIFY(CBUF) - ENDIF - CALL GETG2IR(11,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRGI) - IF(IRGI.LE.1.AND.NNUM.GT.0) THEN - NUMTOT=NUMTOT+NNUM - MNUM=MNUM+NMESS - CALL BAWRITE(31,IW,NLEN,KW,CBUF) - IW=IW+NLEN - ENDIF - ENDDO - CALL WRGI1H(31,IW,NUMTOT,CGB(1:NCGB)) - ENDIF - CALL BACLOSE(11,IRET) - CALL BACLOSE(31,IRET) + ! extend index file if index buffer length too large to hold in memory + if(irgi.eq.1) then + do while(irgi.eq.1.and.nnum.gt.0) + if (associated(cbuf)) then + deallocate(cbuf) + nullify(cbuf) + endif + call getg2ir(11,msk1,msk2,mnum,cbuf,nlen,nnum,nmess,irgi) + if(irgi.le.1.and.nnum.gt.0) then + numtot=numtot+nnum + mnum=mnum+nmess + call bawrite(31,iw,nlen,kw,cbuf) + iw=iw+nlen + endif + enddo + call wrgi1h(31,iw,numtot,cgb(1:ncgb)) + endif + call baclose(11,iret) + call baclose(31,iret) -END PROGRAM GRB2INDEX +end program grb2index !> Write index headers. !> @@ -108,54 +107,53 @@ END PROGRAM GRB2INDEX !> @param[in] cgb character name of GRIB file !> !> @author Iredell @date 93-11-22 -SUBROUTINE WRGI1H(LUGI,NLEN,NNUM,CGB) - CHARACTER CGB*(*) +subroutine wrgi1h(lugi,nlen,nnum,cgb) + character cgb*(*) #ifdef __GFORTRAN__ - CHARACTER CD8*8,CT10*10,HOSTNAME*15 - INTEGER ISTAT + character cd8*8,ct10*10,hostname*15 + integer istat #else - CHARACTER CD8*8,CT10*10,HOSTNAM*15 + character cd8*8,ct10*10,hostnam*15 #endif - CHARACTER CHEAD(2)*81 + character chead(2)*81 - ! FILL FIRST 81-BYTE HEADER - NCGB=LEN(CGB) - NCGB1=NCBASE(CGB,NCGB) - NCGB2=NCBASE(CGB,NCGB1-2) - CALL DATE_AND_TIME(CD8,CT10) - CHEAD(1)='!GFHDR!' - CHEAD(1)(9:10)=' 1' - CHEAD(1)(12:14)=' 1' - WRITE(CHEAD(1)(16:20),'(I5)') 162 - CHEAD(1)(22:31)=CD8(1:4)//'-'//CD8(5:6)//'-'//CD8(7:8) - CHEAD(1)(33:40)=CT10(1:2)//':'//CT10(3:4)//':'//CT10(5:6) - CHEAD(1)(42:47)='GB2IX1' - !CHEAD(1)(49:54)=CGB(NCGB2:NCGB1-2) - CHEAD(1)(49:54)=' ' + ! fill first 81-byte header + ncgb=len(cgb) + ncgb1=ncbase(cgb,ncgb) + ncgb2=ncbase(cgb,ncgb1-2) + call date_and_time(cd8,ct10) + chead(1)='!GFHDR!' + chead(1)(9:10)=' 1' + chead(1)(12:14)=' 1' + write(chead(1)(16:20),'(i5)') 162 + chead(1)(22:31)=cd8(1:4)//'-'//cd8(5:6)//'-'//cd8(7:8) + chead(1)(33:40)=ct10(1:2)//':'//ct10(3:4)//':'//ct10(5:6) + chead(1)(42:47)='GB2IX1' + chead(1)(49:54)=' ' #ifdef __GFORTRAN__ - ISTAT=HOSTNM(HOSTNAME) - IF(ISTAT.eq.0) THEN - CHEAD(1)(56:70)='0000' - ELSE - CHEAD(1)(56:70)='0001' - ENDIF + istat=hostnm(hostname) + if(istat.eq.0) then + chead(1)(56:70)='0000' + else + chead(1)(56:70)='0001' + endif #else - CHEAD(1)(56:70)=HOSTNAM(HOSTNAME) + chead(1)(56:70)=hostnam(hostname) #endif - CHEAD(1)(72:80)='grb2index' - CHEAD(1)(81:81)=CHAR(10) + chead(1)(72:80)='grb2index' + chead(1)(81:81)=char(10) ! FILL SECOND 81-BYTE HEADER - CHEAD(2)='IX1FORM:' - WRITE(CHEAD(2)(9:38),'(3I10)') 162,NLEN,NNUM - CHEAD(2)(41:80)=CGB(NCGB1:NCGB) - CHEAD(2)(81:81)=CHAR(10) + chead(2)='IX1FORM:' + write(chead(2)(9:38),'(3i10)') 162,nlen,nnum + chead(2)(41:80)=cgb(ncgb1:ncgb) + chead(2)(81:81)=char(10) - ! WRITE HEADERS AT BEGINNING OF INDEX FILE - CALL BAWRITE(LUGI,0,162,KW,CHEAD) + ! write headers at beginning of index file + call bawrite(lugi,0,162,kw,chead) - RETURN -END SUBROUTINE WRGI1H + return +end subroutine wrgi1h !> Locate basename of a file. !> @@ -163,20 +161,20 @@ END SUBROUTINE WRGI1H !> character string. For unix filenames, the character number returned !> marks the beginning of the basename of the file. !> -!> @param[in] c character string to search -!> @param[in] n integer length of string +!> @param c character string to search +!> @param n integer length of string !> !> @return The index of the basename within the string. !> !> @author Iredell @date 93-11-22 -FUNCTION NCBASE(C,N) - CHARACTER C*(*) +function ncbase(c,n) + character c*(*) - K=N - DO WHILE(K.GE.1.AND.C(K:K).NE.'/') - K=K-1 - ENDDO - NCBASE=K+1 + k=n + do while(k.ge.1.and.c(k:k).ne.'/') + k=k-1 + enddo + ncbase=k+1 - RETURN -END FUNCTION NCBASE + return +end function ncbase From d3ff685f63d13d2f53b31c7b5641d2f69fe77bd4 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Wed, 14 Feb 2024 17:39:08 -0700 Subject: [PATCH 2/8] clean up --- src/grb2index/CMakeLists.txt | 5 +-- src/grb2index/grb2index.F90 | 79 ++++++++++++++++++++---------------- 2 files changed, 44 insertions(+), 40 deletions(-) diff --git a/src/grb2index/CMakeLists.txt b/src/grb2index/CMakeLists.txt index 39603b94..c62f6c42 100644 --- a/src/grb2index/CMakeLists.txt +++ b/src/grb2index/CMakeLists.txt @@ -12,12 +12,9 @@ elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS_RELEASE "-O3 ${CMAKE_Fortran_FLAGS}") endif() -# This is the fortran source code. -set(fortran_src grb2index.F90) - # Build the executable. set(exe_name grb2index) -add_executable(${exe_name} ${fortran_src}) +add_executable(${exe_name} grb2index.F90) target_link_libraries(${exe_name} PRIVATE g2::g2_4 w3emc::w3emc_4 bacio::${bacio_name}) # Install the utility. diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 index ebda6a59..19a98c0f 100755 --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -12,11 +12,15 @@ !> !> @author Iredell @date 1992-11-22 program grb2index - parameter(msk1=32000,msk2=4000) - character cgb*256,cgi*256 - character(len=1),pointer,dimension(:) :: cbuf - character carg*300 - integer narg,iargc + implicit none + integer msk1, msk2 + parameter(msk1 = 32000, msk2 = 4000) + character cgb * 256, cgi * 256 + character(len = 1),pointer,dimension(:) :: cbuf + character carg * 300 + integer narg, iargc + integer ios, iret, irgi, iw, lcarg, mnum, ncgb, ncgi + integer :: numtot, nnum, nmess, nlen, kw interface subroutine getg2ir(lugb,msk1,msk2,mnum,cbuf,nlen,nnum, & nmess,iret) @@ -107,50 +111,50 @@ end program grb2index !> @param[in] cgb character name of GRIB file !> !> @author Iredell @date 93-11-22 -subroutine wrgi1h(lugi,nlen,nnum,cgb) +subroutine wrgi1h(lugi, nlen, nnum, cgb) + implicit none character cgb*(*) + character cd8*8, ct10*10, hostname*15 #ifdef __GFORTRAN__ - character cd8*8,ct10*10,hostname*15 integer istat -#else - character cd8*8,ct10*10,hostnam*15 #endif character chead(2)*81 + integer lugi, nlen, nnum, kw, ncgb, ncgb1, ncgb2, ncbase ! fill first 81-byte header - ncgb=len(cgb) - ncgb1=ncbase(cgb,ncgb) - ncgb2=ncbase(cgb,ncgb1-2) - call date_and_time(cd8,ct10) - chead(1)='!GFHDR!' - chead(1)(9:10)=' 1' - chead(1)(12:14)=' 1' + ncgb = len(cgb) + ncgb1 = ncbase(cgb, ncgb) + ncgb2 = ncbase(cgb, ncgb1 - 2) + call date_and_time(cd8, ct10) + chead(1) = '!GFHDR!' + chead(1)(9:10) = ' 1' + chead(1)(12:14) = ' 1' write(chead(1)(16:20),'(i5)') 162 - chead(1)(22:31)=cd8(1:4)//'-'//cd8(5:6)//'-'//cd8(7:8) - chead(1)(33:40)=ct10(1:2)//':'//ct10(3:4)//':'//ct10(5:6) - chead(1)(42:47)='GB2IX1' - chead(1)(49:54)=' ' + chead(1)(22:31) = cd8(1:4) // '-' // cd8(5:6) // '-' // cd8(7:8) + chead(1)(33:40) = ct10(1:2) // ':' // ct10(3:4) // ':' //ct10(5:6) + chead(1)(42:47) = 'GB2IX1' + chead(1)(49:54) = ' ' #ifdef __GFORTRAN__ istat=hostnm(hostname) - if(istat.eq.0) then - chead(1)(56:70)='0000' + if (istat .eq. 0) then + chead(1)(56:70) = '0000' else - chead(1)(56:70)='0001' + chead(1)(56:70) = '0001' endif #else - chead(1)(56:70)=hostnam(hostname) + chead(1)(56:70) = hostnam(hostname) #endif - chead(1)(72:80)='grb2index' - chead(1)(81:81)=char(10) + chead(1)(72:80) = 'grb2index' + chead(1)(81:81) = char(10) ! FILL SECOND 81-BYTE HEADER - chead(2)='IX1FORM:' - write(chead(2)(9:38),'(3i10)') 162,nlen,nnum - chead(2)(41:80)=cgb(ncgb1:ncgb) - chead(2)(81:81)=char(10) + chead(2) = 'IX1FORM:' + write(chead(2)(9:38),'(3i10)') 162, nlen, nnum + chead(2)(41:80) = cgb(ncgb1:ncgb) + chead(2)(81:81) = char(10) ! write headers at beginning of index file - call bawrite(lugi,0,162,kw,chead) + call bawrite(lugi, 0, 162, kw, chead) return end subroutine wrgi1h @@ -167,14 +171,17 @@ end subroutine wrgi1h !> @return The index of the basename within the string. !> !> @author Iredell @date 93-11-22 -function ncbase(c,n) +function ncbase(c, n) + implicit none character c*(*) + integer :: n + integer :: k, ncbase - k=n - do while(k.ge.1.and.c(k:k).ne.'/') - k=k-1 + k = n + do while (k .ge. 1 .and. c(k:k) .ne. '/') + k = k - 1 enddo - ncbase=k+1 + ncbase = k + 1 return end function ncbase From 80cb05e1e25c2aa98d794a26c7672683bd3f83ee Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Wed, 14 Feb 2024 17:43:08 -0700 Subject: [PATCH 3/8] clean up --- src/grb2index/grb2index.F90 | 76 ++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 39 deletions(-) diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 index 19a98c0f..85e2346e 100755 --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -31,68 +31,66 @@ end subroutine getg2ir end interface ! get arguments - narg=iargc() - if(narg.ne.2) then + narg = iargc() + if(narg .ne. 2) then call errmsg('grb2index: Incorrect usage') call errmsg('Usage: grb2index gribfile indexfile') call errexit(2) endif - call getarg(1,cgb) - ncgb=len_trim(cgb) - call baopenr(11,cgb(1:ncgb),ios) - !call baseto(1,1) - if(ios.ne.0) then - lcarg=len('grb2index: Error accessing file '//cgb(1:ncgb)) - carg(1:lcarg)='grb2index: Error accessing file '//cgb(1:ncgb) + call getarg(1, cgb) + ncgb = len_trim(cgb) + call baopenr(11, cgb(1:ncgb), ios) + if (ios .ne. 0) then + lcarg = len('grb2index: Error accessing file '//cgb(1:ncgb)) + carg(1:lcarg) = 'grb2index: Error accessing file '//cgb(1:ncgb) call errmsg(carg(1:lcarg)) call errexit(8) endif - call getarg(2,cgi) - ncgi=len_trim(cgi) - call baopen(31,cgi(1:ncgi),ios) - if(ios.ne.0) then - lcarg=len('grb2index: Error accessing file '//cgi(1:ncgi)) - carg(1:lcarg)='grb2index: Error accessing file '//cgi(1:ncgi) + call getarg(2, cgi) + ncgi = len_trim(cgi) + call baopen(31, cgi(1:ncgi), ios) + if (ios .ne. 0) then + lcarg = len('grb2index: Error accessing file ' // cgi(1:ncgi)) + carg(1:lcarg) = 'grb2index: Error accessing file ' // cgi(1:ncgi) call errmsg(carg(1:lcarg)) call errexit(8) endif ! write index file - mnum=0 - call getg2ir(11,msk1,msk2,mnum,cbuf,nlen,nnum,nmess,irgi) - if(irgi.gt.1.or.nnum.eq.0.or.nlen.eq.0) then - call errmsg('grb2index: No GRIB messages detected in file ' & - //cgb(1:ncgb)) - call baclose(11,iret) - call baclose(31,iret) + mnum = 0 + call getg2ir(11, msk1, msk2, mnum, cbuf, nlen, nnum, nmess, irgi) + if (irgi .gt. 1 .or. nnum .eq. 0 .or. nlen .eq. 0) then + call errmsg('grb2index: No GRIB messages detected in file ' // cgb(1:ncgb)) + call baclose(11, iret) + call baclose(31, iret) call errexit(1) endif - numtot=numtot+nnum - mnum=mnum+nmess - call wrgi1h(31,nlen,numtot,cgb(1:ncgb)) - iw=162 - call bawrite(31,iw,nlen,kw,cbuf) - iw=iw+nlen + numtot = numtot + nnum + mnum = mnum + nmess + call wrgi1h(31, nlen, numtot, cgb(1:ncgb)) + iw = 162 + call bawrite(31, iw, nlen, kw, cbuf) + iw = iw + nlen ! extend index file if index buffer length too large to hold in memory - if(irgi.eq.1) then - do while(irgi.eq.1.and.nnum.gt.0) + if (irgi .eq. 1) then + do while (irgi .eq. 1 .and. nnum .gt. 0) if (associated(cbuf)) then deallocate(cbuf) nullify(cbuf) endif - call getg2ir(11,msk1,msk2,mnum,cbuf,nlen,nnum,nmess,irgi) - if(irgi.le.1.and.nnum.gt.0) then - numtot=numtot+nnum - mnum=mnum+nmess - call bawrite(31,iw,nlen,kw,cbuf) - iw=iw+nlen + call getg2ir(11, msk1, msk2, mnum, cbuf, nlen, nnum, nmess, irgi) + if (irgi .le. 1 .and. nnum .gt. 0) then + numtot = numtot + nnum + mnum = mnum + nmess + call bawrite(31, iw, nlen, kw, cbuf) + iw = iw + nlen endif enddo - call wrgi1h(31,iw,numtot,cgb(1:ncgb)) + call wrgi1h(31, iw, numtot, cgb(1:ncgb)) endif - call baclose(11,iret) - call baclose(31,iret) + call baclose(11, iret) + call baclose(31, iret) end program grb2index From 3b4e6e35a2a90bcd30a0b72590d90aa2cdca3374 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Wed, 14 Feb 2024 17:48:02 -0700 Subject: [PATCH 4/8] more docs --- src/grb2index/docs/user_guide.md | 61 ++++++++++++++++---------------- src/grb2index/grb2index.F90 | 7 ---- 2 files changed, 31 insertions(+), 37 deletions(-) diff --git a/src/grb2index/docs/user_guide.md b/src/grb2index/docs/user_guide.md index 44dbd0b2..85c61377 100644 --- a/src/grb2index/docs/user_guide.md +++ b/src/grb2index/docs/user_guide.md @@ -21,35 +21,36 @@ the name of the output index file. # Index File Format -Version 2 of the index file format is used with GRIB2 files, and has -the following format: - The index file has two header records: -- 81-byte "Steve Lord" header with 'GB2IX1' in columns 42-47 -- 81-byte header with number of bytes to skip before index -records, total length in bytes of the index records, number of -index records, and GRIB file basename written in format -('IX1FORM:',3i10,2x,a40). - -Each following index record corresponds to a GRIB1 message and -contains the following fields. All integers are in big-endian format -in the file. - -- byte 001 - 004 length of index record -- byte 005 - 008 bytes to skip in data file before grib message -- byte 009 - 012 bytes to skip in message before lus (local use) set = 0, if no local section. -- byte 013 - 016 bytes to skip in message before gds -- byte 017 - 020 bytes to skip in message before pds -- byte 021 - 024 bytes to skip in message before drs -- byte 025 - 028 bytes to skip in message before bms -- byte 029 - 032 bytes to skip in message before data section -- byte 033 - 040 bytes total in the message -- byte 041 - 041 grib version number (currently 2) -- byte 042 - 042 message discipline -- byte 043 - 044 field number within grib2 message -- byte 045 - ii identification section (ids) -- byte ii+1- jj grid definition section (gds) -- byte jj+1- kk product definition section (pds) -- byte kk+1- ll the data representation section (drs) -- byte ll+1-ll+6 first 6 bytes of the bit map section (bms) +1. an 81-byte header with 'GB2IX1' in columns 42-47 +2. an 81-byte header with the index version number, the number of +bytes to skip before index records, total length in bytes of the +index records, number of index records, and the GRIB file basename. + +Each record in the index table contains the following fields. All +integers are in big-endian format in the file. The only difference +between index version 1 and index version 2 is the size of the +field containing the number of bytes to skip in file before +message. To accomodate files > 2 GB, this must be a 64-bit int. + +Index Version 1 | Index Version 2 | Contents +----------------|-----------------|--------- +001 - 004 | 001 - 004 | length of index record +005 - 008 | 005 - 012 | bytes to skip in data file before grib message +009 - 012 | 013 - 016 | bytes to skip in message before lus (local use) set = 0, if no local section. +013 - 016 | 017 - 020 | bytes to skip in message before gds +017 - 020 | 021 - 024 | bytes to skip in message before pds +021 - 024 | 025 - 028 | bytes to skip in message before drs +025 - 028 | 029 - 032 | bytes to skip in message before bms +029 - 032 | 033 - 036 | bytes to skip in message before data section +033 - 040 | 037 - 044 | bytes total in the message +041 - 041 | 045 - 045 | grib version number (always 2) +042 - 042 | 046 - 046 | message discipline +043 - 044 | 047 - 048 | field number within grib2 message +045 - ii | 045 - ii | identification section (ids) +ii+1- jj | ii+1- jj | grid definition section (gds) +jj+1- kk | jj+1- kk | product definition section (pds) +kk+1- ll | kk+1- ll | the data representation section (drs) +ll+1-ll+6 | ll+1-ll+6 | first 6 bytes of the bit map section (bms) + diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 index 85e2346e..4cbdd858 100755 --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -96,13 +96,6 @@ end program grb2index !> Write index headers. !> -!> ### Program History Log -!> Date | Programmer | Comments -!> -----|------------|--------- -!> 95-10-31 | Iredell | modularize system calls -!> 2005-02-25 | Gilbert | et Header bytes 49-54 to blanks. -!> 2012-08-01 | Vuong | changed hostname to hostnam -!> !> @param[in] lugi integer logical unit of output index file !> @param[in] nlen integer total length of index records !> @param[in] nnum integer number of index records From dd4f0e0c0e2055756c93f73ae5c51bc5c3cbcdab Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 15 Feb 2024 05:30:51 -0700 Subject: [PATCH 5/8] change --- src/grb2index/grb2index.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 index 4cbdd858..7f51acd0 100755 --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -2,7 +2,7 @@ !> Write a GRIB2 index file. !> @author Iredell @date 1992-11-22 -!> This program creates an index file from a GRIB2 file. +!> This program creates an index file from a GRIB2 file. !> !> @return !> - 0 successful run From bf66505bf3d985d51844acf73ef2722a1218b050 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 15 Feb 2024 05:50:30 -0700 Subject: [PATCH 6/8] fixing hostname stuff --- src/grb2index/grb2index.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 index 7f51acd0..5ec95d36 100755 --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -105,7 +105,7 @@ end program grb2index subroutine wrgi1h(lugi, nlen, nnum, cgb) implicit none character cgb*(*) - character cd8*8, ct10*10, hostname*15 + character cd8*8, ct10*10, hn*15 #ifdef __GFORTRAN__ integer istat #endif @@ -126,14 +126,14 @@ subroutine wrgi1h(lugi, nlen, nnum, cgb) chead(1)(42:47) = 'GB2IX1' chead(1)(49:54) = ' ' #ifdef __GFORTRAN__ - istat=hostnm(hostname) + istat = hostnm(hn) if (istat .eq. 0) then chead(1)(56:70) = '0000' else chead(1)(56:70) = '0001' endif #else - chead(1)(56:70) = hostnam(hostname) + chead(1)(56:70) = hostnam(hn) #endif chead(1)(72:80) = 'grb2index' chead(1)(81:81) = char(10) From 3682cfb481493e54b824e527deea4a351daa1939 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 15 Feb 2024 06:28:12 -0700 Subject: [PATCH 7/8] fixing hostname stuff --- src/grb2index/grb2index.F90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 index 5ec95d36..3abc2cbc 100755 --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -105,9 +105,11 @@ end program grb2index subroutine wrgi1h(lugi, nlen, nnum, cgb) implicit none character cgb*(*) - character cd8*8, ct10*10, hn*15 #ifdef __GFORTRAN__ - integer istat + CHARACTER CD8*8,CT10*10,HOSTNAME*15 + INTEGER ISTAT +#else + CHARACTER CD8*8,CT10*10,HOSTNAM*15 #endif character chead(2)*81 integer lugi, nlen, nnum, kw, ncgb, ncgb1, ncgb2, ncbase @@ -126,14 +128,14 @@ subroutine wrgi1h(lugi, nlen, nnum, cgb) chead(1)(42:47) = 'GB2IX1' chead(1)(49:54) = ' ' #ifdef __GFORTRAN__ - istat = hostnm(hn) - if (istat .eq. 0) then - chead(1)(56:70) = '0000' - else - chead(1)(56:70) = '0001' - endif + ISTAT=HOSTNM(HOSTNAME) + IF(ISTAT.eq.0) THEN + CHEAD(1)(56:70)='0000' + ELSE + CHEAD(1)(56:70)='0001' + ENDIF #else - chead(1)(56:70) = hostnam(hn) + CHEAD(1)(56:70)=HOSTNAM(HOSTNAME) #endif chead(1)(72:80) = 'grb2index' chead(1)(81:81) = char(10) From 8b83080ca7b5db778f46387679a5459da4997cfe Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Thu, 15 Feb 2024 07:15:35 -0700 Subject: [PATCH 8/8] fixed up file --- src/grb2index/grb2index.F90 | 146 +++++++++++++++++++----------------- 1 file changed, 76 insertions(+), 70 deletions(-) diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 index 3abc2cbc..ec6b3c60 100755 --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -2,7 +2,7 @@ !> Write a GRIB2 index file. !> @author Iredell @date 1992-11-22 -!> This program creates an index file from a GRIB2 file. +!> This program creates an index file from a GRIB2 file. !> !> @return !> - 0 successful run @@ -13,14 +13,16 @@ !> @author Iredell @date 1992-11-22 program grb2index implicit none - integer msk1, msk2 - parameter(msk1 = 32000, msk2 = 4000) - character cgb * 256, cgi * 256 - character(len = 1),pointer,dimension(:) :: cbuf - character carg * 300 - integer narg, iargc - integer ios, iret, irgi, iw, lcarg, mnum, ncgb, ncgi - integer :: numtot, nnum, nmess, nlen, kw + + integer :: msk1, msk2 + parameter(msk1=32000,msk2=4000) + character cgb*256,cgi*256 + character(len=1),pointer,dimension(:) :: cbuf + character carg*300 + integer narg,iargc + integer :: numtot, nnum, nlen, ncgi, mnum, lcarg, kw + integer :: ios, iret, irgi, iw, ncgb, nmess + interface subroutine getg2ir(lugb,msk1,msk2,mnum,cbuf,nlen,nnum, & nmess,iret) @@ -31,66 +33,68 @@ end subroutine getg2ir end interface ! get arguments - narg = iargc() - if(narg .ne. 2) then + narg=iargc() + if(narg.ne.2) then call errmsg('grb2index: Incorrect usage') call errmsg('Usage: grb2index gribfile indexfile') call errexit(2) endif - call getarg(1, cgb) - ncgb = len_trim(cgb) - call baopenr(11, cgb(1:ncgb), ios) - if (ios .ne. 0) then - lcarg = len('grb2index: Error accessing file '//cgb(1:ncgb)) - carg(1:lcarg) = 'grb2index: Error accessing file '//cgb(1:ncgb) + call getarg(1,cgb) + ncgb=len_trim(cgb) + call baopenr(11,cgb(1:ncgb),ios) + !call baseto(1,1) + if(ios.ne.0) then + lcarg=len('grb2index: Error accessing file '//cgb(1:ncgb)) + carg(1:lcarg)='grb2index: Error accessing file '//cgb(1:ncgb) call errmsg(carg(1:lcarg)) call errexit(8) endif - call getarg(2, cgi) - ncgi = len_trim(cgi) - call baopen(31, cgi(1:ncgi), ios) - if (ios .ne. 0) then - lcarg = len('grb2index: Error accessing file ' // cgi(1:ncgi)) - carg(1:lcarg) = 'grb2index: Error accessing file ' // cgi(1:ncgi) + call getarg(2,cgi) + ncgi=len_trim(cgi) + call baopen(31,cgi(1:ncgi),ios) + if(ios.ne.0) then + lcarg=len('grb2index: Error accessing file '//cgi(1:ncgi)) + carg(1:lcarg)='grb2index: Error accessing file '//cgi(1:ncgi) call errmsg(carg(1:lcarg)) call errexit(8) endif ! write index file - mnum = 0 - call getg2ir(11, msk1, msk2, mnum, cbuf, nlen, nnum, nmess, irgi) - if (irgi .gt. 1 .or. nnum .eq. 0 .or. nlen .eq. 0) then - call errmsg('grb2index: No GRIB messages detected in file ' // cgb(1:ncgb)) - call baclose(11, iret) - call baclose(31, iret) + mnum=0 + call getg2ir(11,msk1,msk2,mnum,cbuf,nlen,nnum,nmess,irgi) + if(irgi.gt.1.or.nnum.eq.0.or.nlen.eq.0) then + call errmsg('grb2index: No GRIB messages detected in file ' & + //cgb(1:ncgb)) + call baclose(11,iret) + call baclose(31,iret) call errexit(1) endif - numtot = numtot + nnum - mnum = mnum + nmess - call wrgi1h(31, nlen, numtot, cgb(1:ncgb)) - iw = 162 - call bawrite(31, iw, nlen, kw, cbuf) - iw = iw + nlen + numtot=numtot+nnum + mnum=mnum+nmess + call wrgi1h(31,nlen,numtot,cgb(1:ncgb)) + iw=162 + call bawrite(31,iw,nlen,kw,cbuf) + iw=iw+nlen ! extend index file if index buffer length too large to hold in memory - if (irgi .eq. 1) then - do while (irgi .eq. 1 .and. nnum .gt. 0) + if(irgi.eq.1) then + do while(irgi.eq.1.and.nnum.gt.0) if (associated(cbuf)) then deallocate(cbuf) nullify(cbuf) endif - call getg2ir(11, msk1, msk2, mnum, cbuf, nlen, nnum, nmess, irgi) - if (irgi .le. 1 .and. nnum .gt. 0) then - numtot = numtot + nnum - mnum = mnum + nmess - call bawrite(31, iw, nlen, kw, cbuf) - iw = iw + nlen + call getg2ir(11,msk1,msk2,mnum,cbuf,nlen,nnum,nmess,irgi) + if(irgi.le.1.and.nnum.gt.0) then + numtot=numtot+nnum + mnum=mnum+nmess + call bawrite(31,iw,nlen,kw,cbuf) + iw=iw+nlen endif enddo - call wrgi1h(31, iw, numtot, cgb(1:ncgb)) + call wrgi1h(31,iw,numtot,cgb(1:ncgb)) endif - call baclose(11, iret) - call baclose(31, iret) + call baclose(11,iret) + call baclose(31,iret) end program grb2index @@ -104,50 +108,53 @@ end program grb2index !> @author Iredell @date 93-11-22 subroutine wrgi1h(lugi, nlen, nnum, cgb) implicit none + + integer :: lugi, nlen, nnum character cgb*(*) + character cd8*8, ct10*10, hostname*15 #ifdef __GFORTRAN__ - CHARACTER CD8*8,CT10*10,HOSTNAME*15 - INTEGER ISTAT + integer istat #else - CHARACTER CD8*8,CT10*10,HOSTNAM*15 + character hostnam*15 + integer hostnm #endif character chead(2)*81 - integer lugi, nlen, nnum, kw, ncgb, ncgb1, ncgb2, ncbase + integer :: kw, ncgb, ncgb1, ncgb2, ncbase ! fill first 81-byte header ncgb = len(cgb) - ncgb1 = ncbase(cgb, ncgb) - ncgb2 = ncbase(cgb, ncgb1 - 2) - call date_and_time(cd8, ct10) + ncgb1 = ncbase(cgb,ncgb) + ncgb2 = ncbase(cgb,ncgb1-2) + call date_and_time(cd8,ct10) chead(1) = '!GFHDR!' chead(1)(9:10) = ' 1' chead(1)(12:14) = ' 1' write(chead(1)(16:20),'(i5)') 162 chead(1)(22:31) = cd8(1:4) // '-' // cd8(5:6) // '-' // cd8(7:8) - chead(1)(33:40) = ct10(1:2) // ':' // ct10(3:4) // ':' //ct10(5:6) - chead(1)(42:47) = 'GB2IX1' + chead(1)(33:40) = ct10(1:2) // ':' // ct10(3:4) // ':' // ct10(5:6) + chead(1)(42:47) = 'gb2ix1' chead(1)(49:54) = ' ' #ifdef __GFORTRAN__ - ISTAT=HOSTNM(HOSTNAME) - IF(ISTAT.eq.0) THEN - CHEAD(1)(56:70)='0000' - ELSE - CHEAD(1)(56:70)='0001' - ENDIF + istat = hostnm(hostname) + if(istat.eq.0) then + chead(1)(56:70) = '0000' + else + chead(1)(56:70) = '0001' + endif #else - CHEAD(1)(56:70)=HOSTNAM(HOSTNAME) + chead(1)(56:70) = hostnam(hostname) #endif chead(1)(72:80) = 'grb2index' chead(1)(81:81) = char(10) - ! FILL SECOND 81-BYTE HEADER + ! fill second 81-byte header chead(2) = 'IX1FORM:' - write(chead(2)(9:38),'(3i10)') 162, nlen, nnum + write(chead(2)(9:38),'(3i10)') 162,nlen,nnum chead(2)(41:80) = cgb(ncgb1:ncgb) chead(2)(81:81) = char(10) ! write headers at beginning of index file - call bawrite(lugi, 0, 162, kw, chead) + call bawrite(lugi,0,162,kw,chead) return end subroutine wrgi1h @@ -158,17 +165,17 @@ end subroutine wrgi1h !> character string. For unix filenames, the character number returned !> marks the beginning of the basename of the file. !> -!> @param c character string to search -!> @param n integer length of string +!> @param[in] c character string to search +!> @param[in] n integer length of string !> !> @return The index of the basename within the string. !> !> @author Iredell @date 93-11-22 -function ncbase(c, n) +integer function ncbase(c,n) implicit none character c*(*) integer :: n - integer :: k, ncbase + integer :: k k = n do while (k .ge. 1 .and. c(k:k) .ne. '/') @@ -176,5 +183,4 @@ function ncbase(c, n) enddo ncbase = k + 1 - return end function ncbase