Module SETTINGS
	implicit none
	Type ATOM
		Character (LEN=2) :: ATOM_TYPE
		Real :: ATOM_POSITION(3)
	end Type ATOM
	Character(LEN=30) :: FILENAME_MOLECULE,FILENAME_OUTPUT
	integer :: NATOMS,NSYSTEMS
	Type(ATOM),dimension(:),allocatable :: MOLECULE
end Module SETTINGS

Module ANGLES
	implicit none
	Real :: RY,RZ,SINA,COSA
	real Rotation(3,3)
end Module ANGLES

subroutine MAKE_ROTATION_MATRIX()
USE ANGLES
implicit none
	rotation(1,1)=COSA
	rotation(1,2)=-RZ*SINA
	rotation(1,3)=RY*SINA
	rotation(2,1)=RZ*SINA
	rotation(2,2)=COSA+(RY*RY)*(1.0-COSA)
	rotation(2,3)=RY*RZ*(1.0-COSA)
	rotation(3,1)=-RY*SINA
	rotation(3,2)=RZ*RY*(1.0-COSA)
	rotation(3,3)=COSA+(RZ*RZ)*(1.0-COSA)
return
end      

subroutine ROTATE (vector)
USE ANGLES
implicit none
real vector(3),x,y,z
	x=vector(1)
	y=vector(2)
	z=vector(3)
	vector(1)=x*Rotation(1,1)+y*Rotation(1,2)+z*Rotation(1,3)
	vector(2)=x*Rotation(2,1)+y*Rotation(2,2)+z*Rotation(2,3)
	vector(3)=x*Rotation(3,1)+y*Rotation(3,2)+z*Rotation(3,3)
return
end

PROGRAM MOTHERPROGRAM
use SETTINGS
USE ANGLES
implicit none
integer :: n,m,allocstatus
REAL :: DIPOLE_MOMENT(3),length,VECTOR(3)
	open(UNIT=1,file='DIPOLES')
	!READ IN NUMBER OF SYSTEMS
	read(1,*) NSYSTEMS
	do n=1,NSYSTEMS,1
		read(1,*) DIPOLE_MOMENT(1),DIPOLE_MOMENT(2),DIPOLE_MOMENT(3),FILENAME_MOLECULE
		!NORMALIZE DIPOLE MOMENT, INVERT DIPOLE MOMENT
		length=-sqrt(DIPOLE_MOMENT(1)**2+DIPOLE_MOMENT(2)**2+DIPOLE_MOMENT(3)**2)
		DIPOLE_MOMENT(1)=(DIPOLE_MOMENT(1)/length)
		DIPOLE_MOMENT(2)=(DIPOLE_MOMENT(2)/length)
		DIPOLE_MOMENT(3)=(DIPOLE_MOMENT(3)/length)
		!INITIALIZE ROTATION, RX=0
		SINA=SQRT(DIPOLE_MOMENT(2)**2+DIPOLE_MOMENT(3)**2)
		RY=DIPOLE_MOMENT(3)/SINA
		RZ=-DIPOLE_MOMENT(2)/SINA
		COSA=DIPOLE_MOMENT(1)
		call MAKE_ROTATION_MATRIX
		open(UNIT=2,file=trim(FILENAME_MOLECULE))
		FILENAME_OUTPUT=trim(FILENAME_MOLECULE)//'OUT.xyz'
		open(UNIT=3,file=trim(FILENAME_OUTPUT))
		read(2,*) NATOMS
		allocate(MOLECULE(NATOMS),stat=allocstatus)
		if (allocstatus/=0) then
			write(*,*) 'SEVERE ERROR: Memory allocation not successful!'
			write(*,*) 'allocstatus MOLECULE has value: ',allocstatus
		endif
		do m=1,NATOMS,1
			read(2,*) MOLECULE(m)%ATOM_TYPE,MOLECULE(m)%ATOM_POSITION(1),MOLECULE(m)%ATOM_POSITION(2),MOLECULE(m)%ATOM_POSITION(3)
			call ROTATE(MOLECULE(m)%ATOM_POSITION)
			write(3,*)MOLECULE(m)%ATOM_TYPE,MOLECULE(m)%ATOM_POSITION(1),MOLECULE(m)%ATOM_POSITION(2),MOLECULE(m)%ATOM_POSITION(3)
		enddo
		deallocate(MOLECULE,stat=allocstatus)
		if (allocstatus/=0) then
			write(*,*) 'SEVERE ERROR: Memory deallocation not successful!'
			write(*,*) 'deallocstatus MOLECULE has value: ',allocstatus
		endif		
		close(UNIT=3)
		close(UNIT=2)
	end do
	close(UNIT=1)
stop
end