program rotdipole
c     supporting one-purpose program for comparemo output rewriting
      parameter (maxdip=30)
      character*3 a3
      character*149 s149
      character*15 s15
      character*80 s80
      dimension A(3,3)
      dimension ub(maxdip,3),ub2(maxdip,3)
      dimension ib(maxdip),ib2(maxdip)

      do i=1,maxdip
       ib(i)=0
       ib2(i)=0
      enddo

      open(9,file='STRUCT.LST')
1     read(9,903,end=999,err=999)a3
      write(6,903)a3
903   format(a3)

      open(91,file=a3//'.con')
2     read(91,904)s15
904   format(a15)
      if(s15.eq.' Transformation')then
       write(6,904)s15
       read(91,905)A
       write(6,905)A
905    format(3(3F10.4,/))
       goto 3
      else
       goto 2
      endif
3     close(91)

      
      open(92,file=a3//'.lst')
      open(93,file=a3//'.new.lst')
4     read(92,920,end=555,err=555)s149
920   format(a149)
      if(s149(21:28).eq.'no match')then
       write(93,925)s149(1:28)
925    format(a28)
      else
       read(s149(114:149),*)x,y,z
       read(s149(1:2),*)it
       ux=A(1,1)*x+A(1,2)*y+A(1,3)*z
       uy=A(2,1)*x+A(2,2)*y+A(2,3)*z
       uz=A(3,1)*x+A(3,2)*y+A(3,3)*z
c
c     try to maintain the phase for plotting:
      if(it.gt.maxdip)then
       write(6,*)' too many dipoles'
       stop
      endif
      sign=1.0
      if(ib2(it).eq.0)then
       ib2(it)=1
       ub2(it,1)=ux
       ub2(it,2)=uy
       ub2(it,3)=uz
      else
       sp=ux*ub2(it,1)+uy*ub2(it,2)+uz*ub2(it,3)
       if(sp.lt.0.0)sign=-1.0
      endif
       write(6,*)it,sign

       write(93,921)s149(1:113),ux*sign,uy*sign,uz*sign,it
921    format(a113,3f12.6,i4,'t')
      endif
      goto 4
555   close(92)
      close(93)

      open(92,file=a3//'d.lst')
      open(93,file=a3//'d.new.lst')
      read(92,800)s80
800   format(a80)
      write(93,800)s80
      read(92,800)s80
      write(93,800)s80
5     read(92,*,end=556,err=556)it,x,y,z
      ux=A(1,1)*x+A(1,2)*y+A(1,3)*z
      uy=A(2,1)*x+A(2,2)*y+A(2,3)*z
      uz=A(3,1)*x+A(3,2)*y+A(3,3)*z
c
c     try to maintain the phase for plotting:
      if(it.gt.maxdip)then
       write(6,*)' too many dipoles'
       stop
      endif
      sign=1.0
      if(ib(it).eq.0)then
       ib(it)=1
       ub(it,1)=ux
       ub(it,2)=uy
       ub(it,3)=uz
      else
       sp=ux*ub(it,1)+uy*ub(it,2)+uz*ub(it,3)
       if(sp.lt.0.0)sign=-1.0
      endif

      write(93,807)it,ux*sign,uy*sign,uz*sign
807   format(i10,3x,3f12.4)
      goto 5
556   close(92)
      close(93)

      goto 1
999   close(9)
      end