program ruvcd
      implicit none
      character*80 fo,s80
      character*1 ok
      integer*4 nm0,nm,n,ne,line,ndumm,i,idal
      parameter (nm0=10000)
      real*8 d(nm0,3),r(nm0,3),e(nm0),ax,ay,az,axm,aym,azm,ds(nm0),
     1rs(nm0),ev,dv,dl,rv,rl,rlo
c
      write(6,*)' Reads UV CD from g98,g03,dalton'
      write(6,*)' output and writes it in UVCD.TAB.'
      write(6,*)
      write(6,*)' Name of the output:'
      read(5,'(a)')fo
      open(2,file=fo)
      write(6,*)'Length or velocity formalism (L/V) ?'
      read(5,'(a)')ok
      if(ok.eq.'l')ok='L'
      n=0
      nm=0
      ne=0
      line=0
      idal=0
c
1     read(2,2000,end=2,err=2)s80
2000  format(a80)
      line=line+1

      if((s80(2:44).eq.'Ground to excited state Transition electric'
     1.and.ok.eq.'L').or.
     2   (s80(2:44).eq.'Ground to excited state transition velocity'
     3.and.ok.ne.'L'))then
       write(6,2000)s80
       read(2,*)
       line=line+1
3      read(2,*,end=21,err=21)ndumm,ax,ay,az
       line=line+1
       n=n+1
       if(n.gt.nm0)then
	write(6,*)' Too many transitions ',nm0
	close(2)
	stop
       endif
       if(ok.eq.'L')then
        d(n,1)=-ax
        d(n,2)=-ay
        d(n,3)=-az
       else
        d(n,1)=ax
        d(n,2)=ay
        d(n,3)=az
       endif
       goto 3
21     backspace 2
       goto 1
      endif

c
      if(s80(2:44).eq.'Ground to excited state transition magnetic'
     1)then
       write(6,2000)s80
       read(2,*)
       line=line+1
31     read(2,*,end=211,err=211)ndumm,axm,aym,azm
       line=line+1
       nm=nm+1
       r(nm,1)=axm
       r(nm,2)=aym
       r(nm,3)=azm
       if(nm.gt.nm0)then
	write(6,*)' Too many transitions ',nm0
	close(2)
	stop
       endif
       goto 31
211    backspace 2
      endif
c
      if(s80(2:15).eq.'Excited State ')then
       ne=ne+1
       write(6,2000)s80
       open(8,file='scr')
       write(8,800)s80(15:18),s80(48:54)
800    format(a4,1x,a8)
       rewind 8
       read(8,*)ndumm,e(ne)
       close(8)
      endif


C     Dalton output catching:
      if(s80(20:61).eq.'Oscillator and Scalar Rotational Strengths')then
       idal=1
       write(6,2000)s80
       do 7 i=1,8
       read(2,*)
7      line=line+1
41     read(2,*,end=212,err=212)ndumm,ndumm,ev,dv,dl,rv,rl,rlo
       line=line+1
       n=n+1
       ne=ne+1
       nm=nm+1
       if(nm.gt.nm0)then
	write(6,*)' Too many transitions ',nm0
	close(2)
	stop
       endif
       e(ne)=1.0d7/(ev*8065.54093d0)
       if(ok.eq.'L')then
        ds(ne)=dl
        rs(ne)=rl
       else
        ds(ne)=dv
        rs(ne)=rv
       endif
       goto 41
212    backspace 2
      endif
      

      goto 1
c
2     close(2)

      write(6,*)
      write(6,*)line,' lines read'
      write(6,*)n ,' electric dipoles'
      write(6,*)nm,' magnetic dipoles'
      write(6,*)ne,' electric transitions'

      if(n.eq.nm.and.n.eq.ne)then
        open(3,file='UVCD.TAB')
        write(3,3000)
3000    format(/,'freq dipole strength rotatory strength',/,80(1h-))
        do 6 i=1,n
	if(idal.eq.0)then
         ds(i)=d(i,1)*d(i,1)+d(i,2)*d(i,2)+d(i,3)*d(i,3)
         rs(i)=d(i,1)*r(i,1)+d(i,2)*r(i,2)+d(i,3)*r(i,3)
	endif
6       write(3,3001)i,e(i),ds(i),rs(i)
3001    format(i4,f10.2,2f20.10)
        write(3,3002)
3002    format(80(1h-))
        close(3)
	write(6,*)'UVCD.TAB written'
      else
        write(6,*)'inconsistent input'
      endif
       
      stop
      end