program gtab
      implicit none
      integer*4 il,iw,it,j
      real*8 f(3),d(3),r(3),a(3),o(3),i(3),g,pi,po
      character*80 s80
      pi=4.0d0*datan(1.0d0)
      po=dsqrt(2.0d0*pi)
      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

       open(88,file='DOG.TAB')
       WRITE (88,501)
  501  FORMAT (/,'          FREQ.     ',
     1 '  D [D^2]     ','  R [D^-2]DO         R - CO      I[km/mol]')
       write(88,3002)

       open(19,file='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    --')then
        read(s80(16:len(s80)),*)(i(j),j=1,iw)
        do j=1,iw
         d(j)=i(j)/f(j)/po
        enddo
       endif
       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(3:10).eq.'Atom  AN')then
        do 3 j=1,iw
        WRITE (88,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(88,3002)
       write(19,3002)
       write(6,*)it,' transitions in DOG.TAB and ROA.TAB'
       CLOSE(88)
       CLOSE(19)
       goto 99
      endif
      goto 1
99    close(9)
      write(6,*)il,' lines'
      end