diff --git a/src/grb2index/grb2index.F90 b/src/grb2index/grb2index.F90 old mode 100755 new mode 100644 index ec6b3c60..bfbbeabf --- a/src/grb2index/grb2index.F90 +++ b/src/grb2index/grb2index.F90 @@ -13,151 +13,63 @@ !> @author Iredell @date 1992-11-22 program grb2index implicit none - - integer :: msk1, msk2 - parameter(msk1=32000,msk2=4000) + integer narg, iargc 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 - + integer :: idxver = 1 + integer :: lugb = 11, lugi = 12 + integer :: ncgb, ncgb1 + integer :: iret, ios, ncbase + 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 + subroutine g2_create_index(lugb, lugi, idxver, filename, iret) + implicit none + integer, intent(in) :: lugb, lugi, idxver + character*(*) :: filename + integer, intent(out) :: iret + end subroutine g2_create_index 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 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) + call exit(2) endif + call getarg(1, cgb) + call getarg(2, cgi) - ! 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) + ! Open binary GRIB2 file for input. + call baopenr(lugb, trim(cgb), ios) + if (ios .ne. 0) then + print *, 'grb2index: Error accessing file ', trim(cgb) + call exit(8) 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)) + ! Open index file for output. + call baopenw(lugi, trim(cgi), ios) + if (ios .ne. 0) then + print *, 'grb2index: Error accessing file ', trim(cgi) + call exit(1) endif - call baclose(11,iret) - call baclose(31,iret) - -end program grb2index -!> Write index headers. -!> -!> @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 -!> @param[in] cgb character name of GRIB file -!> -!> @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__ - integer istat -#else - character hostnam*15 - integer hostnm -#endif - character chead(2)*81 - integer :: kw, ncgb, ncgb1, ncgb2, ncbase - - ! fill first 81-byte header + ! Locate base name of file. 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 -#else - chead(1)(56:70) = hostnam(hostname) -#endif - 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) + ! Create the index file and write it to lugi. + call g2_create_index(lugb, lugi, idxver, cgb(ncgb1:ncgb), iret) + if (iret .ne. 0) then + call exit(1) + endif - ! write headers at beginning of index file - call bawrite(lugi,0,162,kw,chead) + ! Close our files. + call baclose(lugb,iret) + if (iret .ne. 0) stop iret + call baclose(lugi,iret) + if (iret .ne. 0) stop iret - return -end subroutine wrgi1h +end program grb2index !> Locate basename of a file. !>