program seedcmode
      implicit none
      integer*4 N,I,ix,im,NQ,M,MI,MJ,ia,is,J
      real*8 umax,ux,uy,uz,u
      real*8,allocatable::UA(:,:),E(:),C(:,:),X(:,:)
      character*8 s8
      
      write(6,*)'Visualization of DC transition dipoles'

      open(26,file='DIPOLES.TXT',status='old')
      read(26,*)N
      allocate(UA(N,3),X(N,3),E(N),C(N,N))
      do 1 I=1,N
1     read(26,*)UA(I,1),(UA(I,ix),ix=1,3),(X(I,ix),ix=1,3)
      close(26)
      write(6,*)'DIPOLES.TXT read'

      
      OPEN(26,FILE='EIGEN.VEC',status='old')
      read(26,*)
      NQ=N
      M=8
      MI=-7
207   MI=MI+8
      MJ=M-7
      IF(M.GT.NQ)M=NQ
      read(26,*)
      read(26,*)(E(I),I=MJ,M)
      DO 206 J=1,NQ
206   read(26,*)C(J,MJ),(C(J,I),I=MJ,M)
      IF (M.LT.NQ)THEN
       M=M+8
       GOTO 207
      ENDIF
      CLOSE(26)
      write(6,*)'EIGEN.VEC read'

99    write(6,*)'Which mode?'
      read(5,*)im
      if(im.ne.0)then
       write(s8,800)im
800    format(i8)
       do 2 is=1,len(s8)
2      if(s8(is:is).ne.' ')goto 3
3      umax=0.0d0
       do 4 i=1,N
       ux=C(i,im)*UA(i,1)
       uy=C(i,im)*UA(i,2)
       uz=C(i,im)*UA(i,3)
       u=dsqrt(ux**2+uy**2+uz**2)
4      if(u.gt.umax)umax=u
       open(9,file=s8(is:len(s8))//'.x')
       write(9,90)im,E(im),2*N
90     format(' mode ',i6,f12.2,' cm-1',/,i6)
       ia=0
       do 5 i=1,N
       ia=ia+1
       write(9,91)6,(X(I,ix),ix=1,3),ia+1
91     format(i4,3f12.4,i5,' 0 0 0 0 0 0 0.0')
       ia=ia+1
5      write(9,91)8,(X(I,ix)+1.5d0*C(i,im)*UA(i,ix)/umax,ix=1,3),ia-1
       close(9)
       goto 99
      endif

      end