changes

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.
 !>