mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-22 12:23:48 +01:00
Added symmetry detection
This commit is contained in:
parent
af229e7028
commit
816e70a683
1
plugins/Symmetry/NEEDED_CHILDREN_MODULES
Normal file
1
plugins/Symmetry/NEEDED_CHILDREN_MODULES
Normal file
@ -0,0 +1 @@
|
|||||||
|
Bitmask Nuclei Determinants
|
||||||
12
plugins/Symmetry/README.rst
Normal file
12
plugins/Symmetry/README.rst
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
========
|
||||||
|
Symmetry
|
||||||
|
========
|
||||||
|
|
||||||
|
Needed Modules
|
||||||
|
==============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
||||||
|
Documentation
|
||||||
|
=============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
||||||
30
plugins/Symmetry/Symmetry.main.irp.f
Normal file
30
plugins/Symmetry/Symmetry.main.irp.f
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
program Symmetry
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! TODO
|
||||||
|
END_DOC
|
||||||
|
integer :: n_sym_points, i, j
|
||||||
|
double precision, allocatable :: tmp(:,:), sym_points(:,:)
|
||||||
|
character*8 :: sym
|
||||||
|
n_sym_points = 3
|
||||||
|
|
||||||
|
print *, 'Molecule is linear:', molecule_is_linear
|
||||||
|
print *, 'Has center of inversion:', molecule_has_center_of_inversion
|
||||||
|
print *, 'Symmetry rotation axis:', sym_rotation_axis(:)
|
||||||
|
call find_symmetry(sym)
|
||||||
|
print *, 'Group:'//sym
|
||||||
|
return
|
||||||
|
allocate(tmp(n_sym_points,n_det), sym_points(3,n_sym_points))
|
||||||
|
|
||||||
|
call generate_sym_coord(n_sym_points,sym_points)
|
||||||
|
call compute_sym_det_values(sym_points,n_sym_points,tmp)
|
||||||
|
do i=1,mo_tot_num
|
||||||
|
print *, i, real(tmp(1:3,i))
|
||||||
|
enddo
|
||||||
|
sym_points(1,:) = -sym_points(1,:)
|
||||||
|
call compute_sym_det_values(sym_points,n_sym_points,tmp)
|
||||||
|
do i=1,n_det
|
||||||
|
print *, i, real(tmp(1:3,i))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
113
plugins/Symmetry/aos.irp.f
Normal file
113
plugins/Symmetry/aos.irp.f
Normal file
@ -0,0 +1,113 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, sym_box, (3,2) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Opposite points of the box containing the molecule
|
||||||
|
END_DOC
|
||||||
|
integer :: i,xyz
|
||||||
|
sym_box(:,:) = 0.d0
|
||||||
|
do xyz=1,3
|
||||||
|
do i=1,nucl_num
|
||||||
|
sym_box(xyz,1) = min(sym_box(xyz,1), nucl_coord(i,xyz))
|
||||||
|
sym_box(xyz,2) = max(sym_box(xyz,2), nucl_coord(i,xyz))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
sym_box(:,1) = sym_box(:,1) - 2.d0
|
||||||
|
sym_box(:,2) = sym_box(:,2) + 2.d0
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine generate_sym_coord(n_sym_points,result)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: n_sym_points
|
||||||
|
double precision, intent(out) :: result(3,n_sym_points)
|
||||||
|
BEGIN_DOC
|
||||||
|
! xyz coordinates of points to check the symmetry, drawn uniformly in the molecular box.
|
||||||
|
END_DOC
|
||||||
|
integer :: i, xyz
|
||||||
|
|
||||||
|
call random_number(result)
|
||||||
|
do xyz=1,3
|
||||||
|
result(xyz,:) = sym_box(xyz,1) + result(xyz,:) * (sym_box(xyz,2)-sym_box(xyz,1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine compute_sym_ao_values(sym_points, n_sym_points, result)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Values of the AO symmetry functions
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: n_sym_points
|
||||||
|
double precision, intent(in) :: sym_points(3,n_sym_points)
|
||||||
|
double precision, intent(out) :: result(n_sym_points, ao_num)
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: x, y, z
|
||||||
|
result (:,:) = 0.d0
|
||||||
|
do j=1,ao_num
|
||||||
|
do i=1,n_sym_points
|
||||||
|
x = sym_points(1,i) - nucl_coord_transp(1,ao_nucl(j))
|
||||||
|
y = sym_points(2,i) - nucl_coord_transp(2,ao_nucl(j))
|
||||||
|
z = sym_points(3,i) - nucl_coord_transp(3,ao_nucl(j))
|
||||||
|
x = x**ao_power(j,1)
|
||||||
|
y = y**ao_power(j,2)
|
||||||
|
z = z**ao_power(j,3)
|
||||||
|
result(i,j) = x*y*z*exp(-(x*x+y*y+z*z))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine compute_sym_mo_values(sym_points, n_sym_points, result)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Values of the MO symmetry functions
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: n_sym_points
|
||||||
|
double precision, intent(in) :: sym_points(3,n_sym_points)
|
||||||
|
double precision, intent(out) :: result(n_sym_points, mo_tot_num)
|
||||||
|
|
||||||
|
double precision, allocatable :: tmp(:,:)
|
||||||
|
allocate(tmp(n_sym_points,ao_num))
|
||||||
|
call compute_sym_ao_values(sym_points,n_sym_points,tmp)
|
||||||
|
call dgemm('N','N',n_sym_points,mo_tot_num,ao_num, &
|
||||||
|
1.d0, tmp,size(tmp,1), mo_coef, size(mo_coef,1), &
|
||||||
|
0.d0, result,size(result,1))
|
||||||
|
deallocate(tmp)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine compute_sym_det_values(sym_points, n_sym_points, result)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Values of the determinant symmetry functions
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: n_sym_points
|
||||||
|
double precision, intent(in) :: sym_points(3,n_sym_points)
|
||||||
|
double precision, intent(out) :: result(n_sym_points, N_det)
|
||||||
|
|
||||||
|
integer :: list(N_int*bit_kind_size,2)
|
||||||
|
integer :: n_elements(2)
|
||||||
|
|
||||||
|
integer :: i, j, imo
|
||||||
|
|
||||||
|
double precision, allocatable :: tmp(:,:)
|
||||||
|
|
||||||
|
allocate(tmp(n_sym_points,mo_tot_num))
|
||||||
|
call compute_sym_mo_values(sym_points, n_sym_points, tmp)
|
||||||
|
|
||||||
|
result = 1.d0
|
||||||
|
do i=1,N_det
|
||||||
|
call bitstring_to_list_ab(psi_det(1,1,i), list, n_elements, N_int)
|
||||||
|
do j=1,n_elements(1)
|
||||||
|
imo = list(j,1)
|
||||||
|
result(:,i) *= tmp(:,imo)
|
||||||
|
enddo
|
||||||
|
do j=1,n_elements(2)
|
||||||
|
imo = list(j,2)
|
||||||
|
result(:,i) *= tmp(:,imo)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(tmp)
|
||||||
|
end
|
||||||
318
plugins/Symmetry/find_sym.irp.f
Normal file
318
plugins/Symmetry/find_sym.irp.f
Normal file
@ -0,0 +1,318 @@
|
|||||||
|
BEGIN_PROVIDER [ logical, molecule_is_linear ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! True if the molecule is linear
|
||||||
|
END_DOC
|
||||||
|
molecule_is_linear = (minval(inertia_tensor_eigenvalues) < 1.d-5)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ logical, molecule_has_center_of_inversion ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! If true, there is a center of inversion in the WF
|
||||||
|
END_DOC
|
||||||
|
molecule_has_center_of_inversion = .True.
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: point(3)
|
||||||
|
logical :: found
|
||||||
|
double precision, external :: u_dot_u
|
||||||
|
do i=1,nucl_num
|
||||||
|
found = .False.
|
||||||
|
do j=1,nucl_num
|
||||||
|
if (nucl_charge(i) /= nucl_charge(j)) cycle
|
||||||
|
point(:) = nucl_coord_transp(:,i) + nucl_coord_transp(:,j)
|
||||||
|
if (u_dot_u(point,3) < 1.d-5) then
|
||||||
|
found = .True.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (.not.found) then
|
||||||
|
molecule_has_center_of_inversion = .False.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, sym_rotation_axis, (3) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Order of the rotation axis
|
||||||
|
END_DOC
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: point(3), point2(3)
|
||||||
|
logical :: found
|
||||||
|
double precision, external :: u_dot_u
|
||||||
|
integer :: iorder, iaxis
|
||||||
|
double precision :: theta, sin_t, cos_t
|
||||||
|
do iaxis=1,3
|
||||||
|
do iorder=12,2,-1
|
||||||
|
sym_rotation_axis(iaxis) = iorder
|
||||||
|
theta = 2.d0*pi/dble(iorder)
|
||||||
|
sin_t = dsin(theta)
|
||||||
|
cos_t = dcos(theta)
|
||||||
|
do i=1,nucl_num
|
||||||
|
found = .False.
|
||||||
|
if (iaxis==1) then
|
||||||
|
point(1) = nucl_coord_transp(1,i)
|
||||||
|
point(2) = nucl_coord_transp(2,i)*cos_t - nucl_coord_transp(3,i)*sin_t
|
||||||
|
point(3) = nucl_coord_transp(2,i)*sin_t + nucl_coord_transp(3,i)*cos_t
|
||||||
|
else if (iaxis==2) then
|
||||||
|
point(1) = nucl_coord_transp(1,i)*cos_t - nucl_coord_transp(3,i)*sin_t
|
||||||
|
point(2) = nucl_coord_transp(2,i)
|
||||||
|
point(3) = nucl_coord_transp(1,i)*sin_t + nucl_coord_transp(3,i)*cos_t
|
||||||
|
endif
|
||||||
|
if (iaxis==3) then
|
||||||
|
point(1) = nucl_coord_transp(1,i)*cos_t - nucl_coord_transp(2,i)*sin_t
|
||||||
|
point(2) = nucl_coord_transp(1,i)*sin_t + nucl_coord_transp(2,i)*cos_t
|
||||||
|
point(3) = nucl_coord_transp(3,i)
|
||||||
|
endif
|
||||||
|
do j=1,nucl_num
|
||||||
|
if (nucl_charge(i) /= nucl_charge(j)) cycle
|
||||||
|
point2(:) = nucl_coord_transp(:,j) - point(:)
|
||||||
|
if (u_dot_u(point2,3) < 1.d-5) then
|
||||||
|
found = .True.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (.not.found) then
|
||||||
|
sym_rotation_axis(iaxis) = 1
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (sym_rotation_axis(iaxis) /= 1) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, molecule_principal_axis ]
|
||||||
|
&BEGIN_PROVIDER [ integer, molecule_secondary_axis ]
|
||||||
|
&BEGIN_PROVIDER [ integer, molecule_ternary_axis ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Which axis is the Z axis
|
||||||
|
END_DOC
|
||||||
|
molecule_principal_axis = maxloc(sym_rotation_axis,1)
|
||||||
|
if (molecule_principal_axis == 1) then
|
||||||
|
if (sym_rotation_axis(2) >= sym_rotation_axis(3)) then
|
||||||
|
molecule_secondary_axis = 2
|
||||||
|
molecule_ternary_axis = 3
|
||||||
|
else
|
||||||
|
molecule_secondary_axis = 3
|
||||||
|
molecule_ternary_axis = 2
|
||||||
|
endif
|
||||||
|
else if (molecule_principal_axis == 2) then
|
||||||
|
if (sym_rotation_axis(1) >= sym_rotation_axis(3)) then
|
||||||
|
molecule_secondary_axis = 1
|
||||||
|
molecule_ternary_axis = 3
|
||||||
|
else
|
||||||
|
molecule_secondary_axis = 3
|
||||||
|
molecule_ternary_axis = 1
|
||||||
|
endif
|
||||||
|
else if (molecule_principal_axis == 3) then
|
||||||
|
if (sym_rotation_axis(1) >= sym_rotation_axis(2)) then
|
||||||
|
molecule_secondary_axis = 1
|
||||||
|
molecule_ternary_axis = 2
|
||||||
|
else
|
||||||
|
molecule_secondary_axis = 2
|
||||||
|
molecule_ternary_axis = 1
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ logical, molecule_has_secondary_c2_rotation ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! If true, the molecule has a C2 rotation perpendicular to the main axis
|
||||||
|
END_DOC
|
||||||
|
if (molecule_principal_axis == 1) then
|
||||||
|
molecule_has_secondary_c2_rotation = (sym_rotation_axis(2)==2) .or. (sym_rotation_axis(3)==2)
|
||||||
|
else if (molecule_principal_axis == 2) then
|
||||||
|
molecule_has_secondary_c2_rotation = (sym_rotation_axis(1)==2) .or. (sym_rotation_axis(3)==2)
|
||||||
|
else if (molecule_principal_axis == 3) then
|
||||||
|
molecule_has_secondary_c2_rotation = (sym_rotation_axis(1)==2) .or. (sym_rotation_axis(2)==2)
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ logical, molecule_has_improper_rotation ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Order of the rotation axis
|
||||||
|
END_DOC
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: point(3), point2(3)
|
||||||
|
logical :: found
|
||||||
|
double precision, external :: u_dot_u
|
||||||
|
integer :: iorder, iaxis
|
||||||
|
double precision :: theta, sin_t, cos_t
|
||||||
|
iaxis=molecule_principal_axis
|
||||||
|
iorder = 2*sym_rotation_axis(iaxis)
|
||||||
|
molecule_has_improper_rotation = .True.
|
||||||
|
theta = 2.d0*pi/dble(iorder)
|
||||||
|
sin_t = dsin(theta)
|
||||||
|
cos_t = dcos(theta)
|
||||||
|
do i=1,nucl_num
|
||||||
|
found = .False.
|
||||||
|
if (iaxis==1) then
|
||||||
|
point(1) = -nucl_coord_transp(1,i)
|
||||||
|
point(2) = nucl_coord_transp(2,i)*cos_t - nucl_coord_transp(3,i)*sin_t
|
||||||
|
point(3) = nucl_coord_transp(2,i)*sin_t + nucl_coord_transp(3,i)*cos_t
|
||||||
|
else if (iaxis==2) then
|
||||||
|
point(1) = nucl_coord_transp(1,i)*cos_t - nucl_coord_transp(3,i)*sin_t
|
||||||
|
point(2) = -nucl_coord_transp(2,i)
|
||||||
|
point(3) = nucl_coord_transp(1,i)*sin_t + nucl_coord_transp(3,i)*cos_t
|
||||||
|
endif
|
||||||
|
if (iaxis==3) then
|
||||||
|
point(1) = nucl_coord_transp(1,i)*cos_t - nucl_coord_transp(2,i)*sin_t
|
||||||
|
point(2) = nucl_coord_transp(1,i)*sin_t + nucl_coord_transp(2,i)*cos_t
|
||||||
|
point(3) = -nucl_coord_transp(3,i)
|
||||||
|
endif
|
||||||
|
do j=1,nucl_num
|
||||||
|
if (nucl_charge(i) /= nucl_charge(j)) cycle
|
||||||
|
point2(:) = nucl_coord_transp(:,j) - point(:)
|
||||||
|
if (u_dot_u(point2,3) < 1.d-5) then
|
||||||
|
found = .True.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (.not.found) then
|
||||||
|
molecule_has_improper_rotation = .False.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ logical, molecule_has_center_of_inversion ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! If true, there is a center of inversion in the WF
|
||||||
|
END_DOC
|
||||||
|
molecule_has_center_of_inversion = .True.
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: point(3)
|
||||||
|
logical :: found
|
||||||
|
double precision, external :: u_dot_u
|
||||||
|
do i=1,nucl_num
|
||||||
|
found = .False.
|
||||||
|
do j=1,nucl_num
|
||||||
|
if (nucl_charge(i) /= nucl_charge(j)) cycle
|
||||||
|
point(:) = nucl_coord_transp(:,i) + nucl_coord_transp(:,j)
|
||||||
|
if (u_dot_u(point,3) < 1.d-5) then
|
||||||
|
found = .True.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (.not.found) then
|
||||||
|
molecule_has_center_of_inversion = .False.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ logical, molecule_has_sigma_plane, (3) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! If true, there is a symmetry plane perpendicular to the main axis
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: point(3), point2(3)
|
||||||
|
logical :: found
|
||||||
|
double precision, external :: u_dot_u
|
||||||
|
integer :: iaxis
|
||||||
|
do iaxis=1,3
|
||||||
|
molecule_has_sigma_plane(iaxis) = .True.
|
||||||
|
do i=1,nucl_num
|
||||||
|
found = .False.
|
||||||
|
point(:) = nucl_coord_transp(:,i)
|
||||||
|
point(iaxis) = -point(iaxis)
|
||||||
|
do j=1,nucl_num
|
||||||
|
if (nucl_charge(i) /= nucl_charge(j)) cycle
|
||||||
|
point2(:) = nucl_coord_transp(:,j) - point(:)
|
||||||
|
if (u_dot_u(point2,3) < 1.d-5) then
|
||||||
|
found = .True.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (.not.found) then
|
||||||
|
molecule_has_sigma_plane(iaxis) = .False.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine find_symmetry(result)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Finds the point group of the molecule
|
||||||
|
END_DOC
|
||||||
|
character*16 :: result
|
||||||
|
character*2, save :: i_to_a(24) = (/ '1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11', '12',&
|
||||||
|
'13', '14', '15', '16', '17', '18', '19', '20', '21', '22', '23', '24' /)
|
||||||
|
result = 'C1'
|
||||||
|
if (molecule_is_linear) then
|
||||||
|
if (molecule_has_center_of_inversion) then
|
||||||
|
result = 'D*h'
|
||||||
|
else
|
||||||
|
result = 'C*v'
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
if (maxval(sym_rotation_axis) == 1) then
|
||||||
|
if (molecule_has_sigma_plane(1).or.molecule_has_sigma_plane(2).or.&
|
||||||
|
molecule_has_sigma_plane(3) ) then
|
||||||
|
result = 'Cs'
|
||||||
|
else
|
||||||
|
if (molecule_has_center_of_inversion) then
|
||||||
|
result = 'Ci'
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
if (molecule_has_secondary_c2_rotation) then
|
||||||
|
if (molecule_has_sigma_plane(molecule_principal_axis)) then
|
||||||
|
result = 'D'//trim(i_to_a(sym_rotation_axis(molecule_principal_axis)))//'h'
|
||||||
|
else
|
||||||
|
if (molecule_has_sigma_plane(molecule_secondary_axis)) then
|
||||||
|
result = 'D'//trim(i_to_a(sym_rotation_axis(molecule_principal_axis)))//'d'
|
||||||
|
else
|
||||||
|
if (molecule_has_sigma_plane(molecule_ternary_axis)) then
|
||||||
|
result = 'D'//trim(i_to_a(sym_rotation_axis(molecule_principal_axis)))//'d'
|
||||||
|
else
|
||||||
|
result = 'D'//trim(i_to_a(sym_rotation_axis(molecule_principal_axis)))
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
if (molecule_has_sigma_plane(molecule_principal_axis)) then
|
||||||
|
result = 'C'//trim(i_to_a(sym_rotation_axis(molecule_principal_axis)))//'h'
|
||||||
|
else
|
||||||
|
if (molecule_has_sigma_plane(molecule_secondary_axis)) then
|
||||||
|
result = 'C'//trim(i_to_a(sym_rotation_axis(molecule_principal_axis)))//'v'
|
||||||
|
else
|
||||||
|
if (molecule_has_sigma_plane(molecule_ternary_axis)) then
|
||||||
|
result = 'C'//trim(i_to_a(sym_rotation_axis(molecule_principal_axis)))//'v'
|
||||||
|
else
|
||||||
|
if (molecule_has_improper_rotation) then
|
||||||
|
result = 'S'//trim(i_to_a(2*sym_rotation_axis(molecule_principal_axis)))
|
||||||
|
else
|
||||||
|
result = 'C'//trim(i_to_a(sym_rotation_axis(molecule_principal_axis)))
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
end
|
||||||
32
src/Nuclei/inertia.irp.f
Normal file
32
src/Nuclei/inertia.irp.f
Normal file
@ -0,0 +1,32 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, inertia_tensor, (3,3) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Inertia tensor
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k
|
||||||
|
inertia_tensor = 0.d0
|
||||||
|
do k=1,nucl_num
|
||||||
|
inertia_tensor(1,1) += mass(int(nucl_charge(k))) * ((nucl_coord_input(k,2)-center_of_mass(2))**2 + (nucl_coord_input(k,3)-center_of_mass(3))**2)
|
||||||
|
inertia_tensor(2,2) += mass(int(nucl_charge(k))) * ((nucl_coord_input(k,1)-center_of_mass(1))**2 + (nucl_coord_input(k,3)-center_of_mass(3))**2)
|
||||||
|
inertia_tensor(3,3) += mass(int(nucl_charge(k))) * ((nucl_coord_input(k,1)-center_of_mass(1))**2 + (nucl_coord_input(k,2)-center_of_mass(2))**2)
|
||||||
|
inertia_tensor(1,2) -= mass(int(nucl_charge(k))) * ((nucl_coord_input(k,1)-center_of_mass(1)) * (nucl_coord_input(k,2)-center_of_mass(2)) )
|
||||||
|
inertia_tensor(1,3) -= mass(int(nucl_charge(k))) * ((nucl_coord_input(k,1)-center_of_mass(1)) * (nucl_coord_input(k,3)-center_of_mass(3)) )
|
||||||
|
inertia_tensor(2,3) -= mass(int(nucl_charge(k))) * ((nucl_coord_input(k,2)-center_of_mass(2)) * (nucl_coord_input(k,3)-center_of_mass(3)) )
|
||||||
|
enddo
|
||||||
|
inertia_tensor(2,1) = inertia_tensor(1,2)
|
||||||
|
inertia_tensor(3,1) = inertia_tensor(1,3)
|
||||||
|
inertia_tensor(3,2) = inertia_tensor(2,3)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, inertia_tensor_eigenvectors, (3,3) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, inertia_tensor_eigenvalues , (3) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Eigenvectors/eigenvalues of the inertia_tensor. Used to find normal orientation.
|
||||||
|
END_DOC
|
||||||
|
integer :: k
|
||||||
|
call lapack_diagd(inertia_tensor_eigenvalues,inertia_tensor_eigenvectors,inertia_tensor,3,3)
|
||||||
|
print *, 'Rotational constants (GHZ):'
|
||||||
|
print *, (1805.65468542d0/inertia_tensor_eigenvalues(k), k=3,1,-1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
@ -1,4 +1,4 @@
|
|||||||
BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
|
BEGIN_PROVIDER [ double precision, nucl_coord_input, (nucl_num,3) ]
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -8,7 +8,7 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
|
|||||||
|
|
||||||
if (mpi_master) then
|
if (mpi_master) then
|
||||||
double precision, allocatable :: buffer(:,:)
|
double precision, allocatable :: buffer(:,:)
|
||||||
nucl_coord = 0.d0
|
nucl_coord_input = 0.d0
|
||||||
allocate (buffer(nucl_num,3))
|
allocate (buffer(nucl_num,3))
|
||||||
buffer = 0.d0
|
buffer = 0.d0
|
||||||
logical :: has
|
logical :: has
|
||||||
@ -22,7 +22,7 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
|
|||||||
|
|
||||||
do i=1,3
|
do i=1,3
|
||||||
do j=1,nucl_num
|
do j=1,nucl_num
|
||||||
nucl_coord(j,i) = buffer(j,i)
|
nucl_coord_input(j,i) = buffer(j,i)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
deallocate(buffer)
|
deallocate(buffer)
|
||||||
@ -31,6 +31,65 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
|
|||||||
character*(64), parameter :: ft= '(A16, 4(1X,A12 ))'
|
character*(64), parameter :: ft= '(A16, 4(1X,A12 ))'
|
||||||
double precision, parameter :: a0= 0.529177249d0
|
double precision, parameter :: a0= 0.529177249d0
|
||||||
|
|
||||||
|
call write_time(output_Nuclei)
|
||||||
|
write(output_Nuclei,'(A)') ''
|
||||||
|
write(output_Nuclei,'(A)') 'Input Nuclear Coordinates (Angstroms)'
|
||||||
|
write(output_Nuclei,'(A)') '====================================='
|
||||||
|
write(output_Nuclei,'(A)') ''
|
||||||
|
write(output_Nuclei,ft) &
|
||||||
|
'================','============','============','============','============'
|
||||||
|
write(output_Nuclei,*) &
|
||||||
|
' Atom Charge X Y Z '
|
||||||
|
write(output_Nuclei,ft) &
|
||||||
|
'================','============','============','============','============'
|
||||||
|
do i=1,nucl_num
|
||||||
|
write(output_Nuclei,f) nucl_label(i), nucl_charge(i), &
|
||||||
|
nucl_coord_input(i,1)*a0, &
|
||||||
|
nucl_coord_input(i,2)*a0, &
|
||||||
|
nucl_coord_input(i,3)*a0
|
||||||
|
enddo
|
||||||
|
write(output_Nuclei,ft) &
|
||||||
|
'================','============','============','============','============'
|
||||||
|
write(output_Nuclei,'(A)') ''
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
IRP_IF MPI
|
||||||
|
include 'mpif.h'
|
||||||
|
integer :: ierr
|
||||||
|
call MPI_BCAST( nucl_coord_input, 3*nucl_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read nucl_coord_input with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Nuclear coordinates in standard orientation
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
integer :: i
|
||||||
|
do i=1,nucl_num
|
||||||
|
nucl_coord(i,1) = (nucl_coord_input(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,1) + &
|
||||||
|
(nucl_coord_input(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,1) + &
|
||||||
|
(nucl_coord_input(i,3) - center_of_mass(3))*inertia_tensor_eigenvectors(3,1)
|
||||||
|
nucl_coord(i,2) = (nucl_coord_input(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,2) + &
|
||||||
|
(nucl_coord_input(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,2) + &
|
||||||
|
(nucl_coord_input(i,3) - center_of_mass(3))*inertia_tensor_eigenvectors(3,2)
|
||||||
|
nucl_coord(i,3) = (nucl_coord_input(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,3) + &
|
||||||
|
(nucl_coord_input(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,3) + &
|
||||||
|
(nucl_coord_input(i,3) - center_of_mass(3))*inertia_tensor_eigenvectors(3,3)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
character*(64), parameter :: f = '(A16, 4(1X,F12.6))'
|
||||||
|
character*(64), parameter :: ft= '(A16, 4(1X,A12 ))'
|
||||||
|
double precision, parameter :: a0= 0.529177249d0
|
||||||
|
|
||||||
call write_time(output_Nuclei)
|
call write_time(output_Nuclei)
|
||||||
write(output_Nuclei,'(A)') ''
|
write(output_Nuclei,'(A)') ''
|
||||||
write(output_Nuclei,'(A)') 'Nuclear Coordinates (Angstroms)'
|
write(output_Nuclei,'(A)') 'Nuclear Coordinates (Angstroms)'
|
||||||
@ -285,3 +344,87 @@ BEGIN_PROVIDER [ character*(128), element_name, (78)]
|
|||||||
element_name(78) = 'Pt'
|
element_name(78) = 'Pt'
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mass, (0:110) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Atomic masses
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
mass( 0 ) = 0.
|
||||||
|
mass( 1 ) = 1.0079
|
||||||
|
mass( 2 ) = 4.00260
|
||||||
|
mass( 3 ) = 6.941
|
||||||
|
mass( 4 ) = 9.01218
|
||||||
|
mass( 5 ) = 10.81
|
||||||
|
mass( 6 ) = 12.011
|
||||||
|
mass( 7 ) = 14.0067
|
||||||
|
mass( 8 ) = 15.9994
|
||||||
|
mass( 9 ) = 18.998403
|
||||||
|
mass( 10 ) = 20.179
|
||||||
|
mass( 11 ) = 22.98977
|
||||||
|
mass( 12 ) = 24.305
|
||||||
|
mass( 13 ) = 26.98154
|
||||||
|
mass( 14 ) = 28.0855
|
||||||
|
mass( 15 ) = 30.97376
|
||||||
|
mass( 16 ) = 32.06
|
||||||
|
mass( 17 ) = 35.453
|
||||||
|
mass( 18 ) = 39.948
|
||||||
|
mass( 19 ) = 39.0983
|
||||||
|
mass( 20 ) = 40.08
|
||||||
|
mass( 21 ) = 44.9559
|
||||||
|
mass( 22 ) = 47.90
|
||||||
|
mass( 23 ) = 50.9415
|
||||||
|
mass( 24 ) = 51.996
|
||||||
|
mass( 25 ) = 54.9380
|
||||||
|
mass( 26 ) = 55.9332
|
||||||
|
mass( 27 ) = 58.9332
|
||||||
|
mass( 28 ) = 58.70
|
||||||
|
mass( 29 ) = 63.546
|
||||||
|
mass( 30 ) = 65.38
|
||||||
|
mass( 31 ) = 69.72
|
||||||
|
mass( 32 ) = 72.59
|
||||||
|
mass( 33 ) = 74.9216
|
||||||
|
mass( 34 ) = 78.96
|
||||||
|
mass( 35 ) = 79.904
|
||||||
|
mass( 36 ) = 83.80
|
||||||
|
mass( 37 ) = 85.4678
|
||||||
|
mass( 38 ) = 87.62
|
||||||
|
mass( 39 ) = 88.90584
|
||||||
|
mass( 40 ) = 91.224
|
||||||
|
mass( 41 ) = 92.90637
|
||||||
|
mass( 42 ) = 95.95
|
||||||
|
mass( 43 ) = 98.
|
||||||
|
mass( 44 ) = 101.07
|
||||||
|
mass( 45 ) = 102.90550
|
||||||
|
mass( 46 ) = 106.42
|
||||||
|
mass( 47 ) = 107.8682
|
||||||
|
mass( 48 ) = 112.414
|
||||||
|
mass( 49 ) = 114.818
|
||||||
|
mass( 50 ) = 118.710
|
||||||
|
mass( 51 ) = 121.760
|
||||||
|
mass( 52 ) = 127.60
|
||||||
|
mass( 53 ) = 126.90447
|
||||||
|
mass( 54 ) = 131.293
|
||||||
|
mass( 78 ) = 195.084
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, center_of_mass, (3) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Center of mass of the molecule
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: s
|
||||||
|
center_of_mass(:) = 0.d0
|
||||||
|
s = 0.d0
|
||||||
|
do i=1,nucl_num
|
||||||
|
do j=1,3
|
||||||
|
center_of_mass(j) += nucl_coord_input(i,j)* mass(int(nucl_charge(i)))
|
||||||
|
enddo
|
||||||
|
s += mass(int(nucl_charge(i)))
|
||||||
|
enddo
|
||||||
|
s = 1.d0/s
|
||||||
|
center_of_mass(:) = center_of_mass(:)*s
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user