program gtabn
      implicit none
      integer*4 il,iw,it,j,itab,is
      real*8 f(3),d(3),r(3),a(3),o(3),i(3),g
      character*80 s80
      character*10 s10
      itab=0
      g=1.0d-4
      call getarg(1,s80)
      il=0
      open(9,file=s80)
1     read(9,90,end=99,err=99)s80
      il=il+1
90    format(a80)
      if(s80(2:21).eq.'Harmonic frequencies')then
       it=0
       itab=itab+1

       write(s10,100)itab
 100   format(i10)
       do 4 is=1,len(s10)
4      if(s10(is:is).ne.' ')goto 5
5      open(18,file=s10(is:len(s10))//'.DOG.TAB')
       WRITE (18,501)
  501  FORMAT (/,'          FREQ.     ',
     1 '  D [D^2]     ','  R [D^-2]DO         R - CO      I[km/mol]')
       write(18,3002)

       open(19,file=s10(is:len(s10))//'.ROA.TAB')
       WRITE (19,3304)
3304   FORMAT(
     1 'MODE   FREQ    Ramx (180)  Ramy    Ramtot   CID90',
     2 '     CID-X   CID180  DEP   ROA180 RamanDCPI',/,
     3 '       cm-1       A^4/AMU                    x10^4',
     4 '     x10^4     x10^4      A^5/AMUx1e4 au.10^4')
       write(19,3002)
3002   FORMAT(80(1H-))

2      read(9,90,end=99,err=99)s80
       il=il+1
       if(s80(2:15).eq.'Frequencies --')then
        iw=0
        read(s80(16:27      ),*,err=88,end=88)f(1)
        iw=iw+1
        read(s80(28:50      ),*,err=88,end=88)f(2)
        iw=iw+1
        read(s80(51:len(s80)),*,err=88,end=88)f(3)
        iw=iw+1
        it=it+iw
       endif
88     if(s80(2:15).eq.'IR Inten    --')
     1 read(s80(16:len(s80)),*)(i(j),j=1,iw)
       if(s80(2:15).eq.'Dip. str.   --')
     1 read(s80(16:len(s80)),*)(d(j),j=1,iw)
       if(s80(2:15).eq.'Rot. str.   --')
     1 read(s80(16:len(s80)),*)(r(j),j=1,iw)
       if(s80(2:15).eq.'Raman1 Fr= 1--')
     1 read(s80(16:len(s80)),*)(a(j),j=1,iw)
       if(s80(2:15).eq.'ROA1   Fr= 1--')
     1 read(s80(16:len(s80)),*)(o(j),j=1,iw)
       if(s80(2:10).eq.' Atom  AN')then
        do 3 j=1,iw
        WRITE (18,523)it-iw+j,f(j),d(j)*g,r(j)*g*g,r(j)*g*g,i(j)
523     FORMAT(I5,f16.7,4G15.6)
3       WRITE (19,524)it-iw+j,f(j),a(j),o(j)
524     format(I5,f9.2,' 0.0 0.0 ',g12.4,' 0.0 0.0 0.0 0.0',g12.4)
        if(iw.lt.3)goto 77
       endif
       if(s80(2:20).eq.'- Thermochemistry -')goto 77
       goto 2
77     write(18,3002)
       write(19,3002)
       CLOSE(18)
       CLOSE(19)
       write(6,*)it,' transitions in '//
     1 s10(is:len(s10))//'.DOG.TAB and '//s10(is:len(s10))//'.ROA.TAB'
      endif
      goto 1
99    close(9)
      write(6,*)il,' lines'
      end