program r468
      integer*4 ln,ln0
      character*80 s80,filename
c
      write(6,60000)
60000 format('This programs rewrites g98 output for',/,
     1       'anharmonic calculations in a more compact form')
      write(6,*)'Filename:'
      read(5,'(a)')filename
      open(2,file=filename)
      open(3,file='G.XXX')
      ln=0
      ln0=0
      nar=0
      nzm=0
      ncl=0
1     read(2,80,end=999,err=999)s80
80    format(a80)
      ln0=ln0+1
      i1=0
      i2=0
      do 2 i=1,80
      if(s80(i:i).eq.'#')i1=i1+1
2     if(s80(i:i).eq.'\\')i2=i2+1
c
c     if start of archive is struck, write the archive:
      if(i2.gt.1)then
       nar=nar+1
       call wl(s80,ln)
4      read(2,80)s80
       ln0=ln0+1
       call wl(s80,ln)
       if(s80(2:8).ne.'Job cpu')goto4
       goto 1
      endif
c
c     command line:
      if(i1.gt.0)then
       call wl(s80,ln)
       ncl=ncl+1
      endif
c
c     geometry:
      if(s80(26:46).eq.'Z-Matrix orientation:'.or.
     1   s80(19:39).eq.'Z-Matrix orientation:')then
       nzm=nzm+1
       call wl(s80,ln)
       do i=1,4
        read(2,80)s80
        ln0=ln0+1
        call wl(s80,ln)
       enddo
3      read(2,80)s80
       ln0=ln0+1
       call wl(s80,ln)
       if(s80(2:3).ne.'--')goto3
      endif
c
      goto 1 
999   close(2)
      close(3)
      write(6,6777)ln ,ln0,nar,nzm,ncl
6777  format(I10,' lines of ',I10,' written to G.XXX',/,
     1' Number of archives  :',I5,/,
     1' Number of geometries:',I5,/,
     1' Number of jobs      :',I5)
      write(6,*)'last line:'
      write(6,80)s80
      stop
      end

      subroutine wl(s80,ln)
      integer*4 ln
      character*80 s80
      do 1 i=80,1,-1
1     if(s80(i:i).ne.' ')goto 2
2     write(3,801)(s80(j:j),j=1,i)
801   format(80A1)
      ln=ln+1
      return
      end