10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-03 20:54:00 +01:00

Fixed last merge (#217)

* Fixes #211

* Removed debug print

* Revert input coordinates

* Fix MPI
This commit is contained in:
Anthony Scemama 2017-12-19 13:48:21 +01:00 committed by GitHub
parent eac2c81f98
commit 7ebc2ac896
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 307 additions and 513 deletions

View File

@ -1,118 +1,56 @@
1 H Hydrogen 0 X Dummy 0.000000
2 He Helium 1 H Hydrogen 1.007900
3 Li Lithium 2 He Helium 4.002600
4 Be Beryllium 3 Li Lithium 6.941000
5 B Boron 4 Be Beryllium 9.012180
6 C Carbon 5 B Boron 10.810000
7 N Nitrogen 6 C Carbon 12.011000
8 O Oxygen 7 N Nitrogen 14.006700
9 F Fluorine 8 O Oxygen 15.999400
10 Ne Neon 9 F Fluorine 18.998403
11 Na Sodium 10 Ne Neon 20.179000
12 Mg Magnesium 11 Na Sodium 22.989770
13 Al Aluminum 12 Mg Magnesium 24.305000
14 Si Silicon 13 Al Aluminum 26.981540
15 P Phosphorus 14 Si Silicon 28.085500
16 S Sulfur 15 P Phosphorus 30.973760
17 Cl Chlorine 16 S Sulfur 32.060000
18 Ar Argon 17 Cl Chlorine 35.453000
19 K Potassium 18 Ar Argon 39.948000
20 Ca Calcium 19 K Potassium 39.098300
21 Sc Scandium 20 Ca Calcium 40.080000
22 Ti Titanium 21 Sc Scandium 44.955900
23 V Vanadium 22 Ti Titanium 47.900000
24 Cr Chromium 23 V Vanadium 50.941500
25 Mn Manganese 24 Cr Chromium 51.996000
26 Fe Iron 25 Mn Manganese 54.938000
27 Co Cobalt 26 Fe Iron 55.933200
28 Ni Nickel 27 Co Cobalt 58.933200
29 Cu Copper 28 Ni Nickel 58.700000
30 Zn Zinc 29 Cu Copper 63.546000
31 Ga Gallium 30 Zn Zinc 65.380000
32 Ge Germanium 31 Ga Gallium 69.720000
33 As Arsenic 32 Ge Germanium 72.590000
34 Se Selenium 33 As Arsenic 74.921600
35 Br Bromine 34 Se Selenium 78.960000
36 Kr Krypton 35 Br Bromine 79.904000
37 Rb Rubidium 36 Kr Krypton 83.800000
38 Sr Strontium 37 Rb Rubidium 85.467800
39 Y Yttrium 38 Sr Strontium 87.620000
40 Zr Zirconium 39 Y Yttrium 88.905840
41 Nb Niobium 40 Zr Zirconium 91.224000
42 Mo Molybdenum 41 Nb Niobium 92.906370
43 Tc Technetium 42 Mo Molybdenum 95.950000
44 Ru Ruthenium 43 Tc Technetium 98.000000
45 Rh Rhodium 44 Ru Ruthenium 101.070000
46 Pd Palladium 45 Rh Rhodium 102.905500
47 Ag Silver 46 Pd Palladium 106.420000
48 Cd Cadmium 47 Ag Silver 107.868200
49 In Indium 48 Cd Cadmium 112.414000
50 Sn Tin 49 In Indium 114.818000
51 Sb Antimony 50 Sn Tin 118.710000
52 Te Tellurium 51 Sb Antimony 121.760000
53 I Iodine 52 Te Tellurium 127.600000
54 Xe Xenon 53 I Iodine 126.904470
55 Cs Cesium 54 Xe Xenon 131.293000
56 Ba Barium 78 Pt Platinum 195.084000
57 La Lanthanum
58 Ce Cerium
59 Pr Praseodymium
60 Nd Neodymium
61 Pm Promethium
62 Sm Samarium
63 Eu Europium
64 Gd Gadolinium
65 Tb Terbium
66 Dy Dysprosium
67 Ho Holmium
68 Er Erbium
69 Tm Thulium
70 Yb Ytterbium
71 Lu Lutetium
72 Hf Hafnium
73 Ta Tantalum
74 W Tungsten
75 Re Rhenium
76 Os Osmium
77 Ir Iridium
78 Pt Platinum
79 Au Gold
80 Hg Mercury
81 Tl Thallium
82 Pb Lead
83 Bi Bismuth
84 Po Polonium
85 At Astatine
86 Rn Radon
87 Fr Francium
88 Ra Radium
89 Ac Actinium
90 Th Thorium
91 Pa Protactinium
92 U Uranium
93 Np Neptunium
94 Pu Plutonium
95 Am Americium
96 Cm Curium
97 Bk Berkelium
98 Cf Californium
99 Es Einsteinium
100 Fm Fermium
101 Md Mendelevium
102 No Nobelium
103 Lr Lawrencium
104 Rf Rutherfordium
105 Db Dubnium
106 Sg Seaborgium
107 Bh Bohrium
108 Hs Hassium
109 Mt Meitnerium
110 Ds Darmstadtium
111 Rg Roentgenium
112 Cn Copernicium
113 Uut Ununtrium
114 Fl Flerovium
115 Uup Ununpentium
116 Lv Livermorium
117 Uus Ununseptium
118 Uuo Ununoctium

View File

@ -499,3 +499,4 @@ let mass x =
result x result x
|> Positive_float.of_float |> Positive_float.of_float

View File

@ -17,7 +17,7 @@ MLLFILES=$(wildcard *.mll)
MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml Input_auto_generated.ml qp_edit.ml MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml Input_auto_generated.ml qp_edit.ml
MLIFILES=$(wildcard *.mli) git MLIFILES=$(wildcard *.mli) git
ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml)) ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml))
ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml)) qp_edit.native ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml)) qp_edit.native element_create_db.byte
.PHONY: executables default remake_executables .PHONY: executables default remake_executables
@ -37,8 +37,9 @@ tests: $(ALL_TESTS)
executables: $(QP_ROOT)/data/executables executables: $(QP_ROOT)/data/executables
$(QP_ROOT)/data/executables: remake_executables $(QP_ROOT)/data/executables: remake_executables element_create_db.byte Qptypes.ml
$(QP_ROOT)/scripts/module/create_executables_list.sh $(QP_ROOT)/scripts/module/create_executables_list.sh
$(QP_ROOT)/ocaml/element_create_db.byte
external_libs: external_libs:
opam install cryptokit core opam install cryptokit core

View File

@ -0,0 +1,27 @@
open Core
open Qptypes
open Element
let () =
let indices =
Array.init 78 (fun i -> i)
in
Out_channel.with_file (Qpackage.root ^ "/data/list_element.txt")
~f:(fun out_channel ->
Array.init 110 ~f:(fun i ->
let element =
try
Some (of_charge (Charge.of_int i))
with
| _ -> None
in
match element with
| None -> ""
| Some x -> Printf.sprintf "%3d %3s %s %f\n"
i (to_string x) (to_long_string x) (Positive_float.to_float @@ mass x )
)
|> Array.to_list
|> String.concat ~sep:""
|> Out_channel.output_string out_channel
)

View File

@ -1,7 +1,6 @@
program save_for_qmc program save_for_qmc
integer :: iunit integer :: iunit
integer, external :: get_unit_and_open
logical :: exists logical :: exists
double precision :: e_ref double precision :: e_ref

View File

@ -11,8 +11,8 @@ program Symmetry
print *, 'Has S2n improper rotation: ', molecule_has_improper_rotation print *, 'Has S2n improper rotation: ', molecule_has_improper_rotation
print *, 'Symmetry rotation axis: ', sym_rotation_axis(:) print *, 'Symmetry rotation axis: ', sym_rotation_axis(:)
print *, 'Group: '//point_group print *, 'Group: '//point_group
print *, 'Symmetry irreps', sym_irrep(1:n_irrep) print *, 'Symmetry irreps : ', sym_irrep(1:n_irrep)
print *, 'Symmetry operations', sym_operation(1:n_irrep) print *, 'Symmetry operations : ', sym_operation(1:n_irrep)
print *, 'Character table' print *, 'Character table'
do i=1,n_irrep do i=1,n_irrep
print *, character_table(i,:) print *, character_table(i,:)

View File

@ -7,8 +7,8 @@ BEGIN_PROVIDER [ double precision, sym_box, (3,2) ]
sym_box(:,:) = 0.d0 sym_box(:,:) = 0.d0
do xyz=1,3 do xyz=1,3
do i=1,nucl_num do i=1,nucl_num
sym_box(xyz,1) = min(sym_box(xyz,1), nucl_coord(i,xyz)) sym_box(xyz,1) = min(sym_box(xyz,1), nucl_coord_sym(i,xyz))
sym_box(xyz,2) = max(sym_box(xyz,2), nucl_coord(i,xyz)) sym_box(xyz,2) = max(sym_box(xyz,2), nucl_coord_sym(i,xyz))
enddo enddo
enddo enddo
sym_box(:,1) = sym_box(:,1) - 2.d0 sym_box(:,1) = sym_box(:,1) - 2.d0
@ -42,24 +42,28 @@ subroutine compute_sym_ao_values(sym_points, n_sym_points, result)
double precision, intent(out) :: result(n_sym_points, ao_num) double precision, intent(out) :: result(n_sym_points, ao_num)
integer :: i, j integer :: i, j
double precision :: x, y, z double precision :: x, y, z
double precision :: x2, y2, z2
result (:,:) = 0.d0 result (:,:) = 0.d0
do j=1,ao_num do j=1,ao_num
do i=1,n_sym_points do i=1,n_sym_points
x = sym_points(1,i) - nucl_coord_transp(1,ao_nucl(j)) x = sym_points(1,i) - nucl_coord_sym_transp(1,ao_nucl(j))
y = sym_points(2,i) - nucl_coord_transp(2,ao_nucl(j)) y = sym_points(2,i) - nucl_coord_sym_transp(2,ao_nucl(j))
z = sym_points(3,i) - nucl_coord_transp(3,ao_nucl(j)) z = sym_points(3,i) - nucl_coord_sym_transp(3,ao_nucl(j))
x = x**ao_power(j,1) x2 = x*sym_molecule_rotation_inv(1,1) + y*sym_molecule_rotation_inv(2,1) + z*sym_molecule_rotation_inv(3,1)
y = y**ao_power(j,2) y2 = x*sym_molecule_rotation_inv(1,2) + y*sym_molecule_rotation_inv(2,2) + z*sym_molecule_rotation_inv(3,2)
z = z**ao_power(j,3) z2 = x*sym_molecule_rotation_inv(1,3) + y*sym_molecule_rotation_inv(2,3) + z*sym_molecule_rotation_inv(3,3)
! result(i,j) = x*y*z*exp(-(x*x+y*y+z*z)) x = x2**ao_power(j,1)
result(i,j) = x*y*z y = y2**ao_power(j,2)
if (result(i,j) > 0.d0) then z = z2**ao_power(j,3)
result(i,j) = 1.d0 result(i,j) = x*y*z*exp(-(x*x+y*y+z*z))
else if (result(i,j) < 0.d0) then ! result(i,j) = x*y*z
result(i,j) = -1.d0 ! if (result(i,j) > 0.d0) then
else ! result(i,j) = 1.d0
result(i,j) = 0.d0 ! else if (result(i,j) < 0.d0) then
endif ! result(i,j) = -1.d0
! else
! result(i,j) = 0.d0
! endif
enddo enddo
enddo enddo

View File

@ -20,7 +20,7 @@ BEGIN_PROVIDER [ logical, molecule_has_center_of_inversion ]
found = .False. found = .False.
do j=1,nucl_num do j=1,nucl_num
if (nucl_charge(i) /= nucl_charge(j)) cycle if (nucl_charge(i) /= nucl_charge(j)) cycle
point(:) = nucl_coord_transp(:,i) + nucl_coord_transp(:,j) point(:) = nucl_coord_sym_transp(:,i) + nucl_coord_sym_transp(:,j)
if (u_dot_u(point,3) < 1.d-5) then if (u_dot_u(point,3) < 1.d-5) then
found = .True. found = .True.
exit exit
@ -52,10 +52,10 @@ BEGIN_PROVIDER [ integer, sym_rotation_axis, (3) ]
sym_rotation_axis(iaxis) = iorder sym_rotation_axis(iaxis) = iorder
do i=1,nucl_num do i=1,nucl_num
found = .False. found = .False.
call sym_apply_rotation(dble(iorder),iaxis,nucl_coord_transp(1,i),point) call sym_apply_rotation(dble(iorder),iaxis,nucl_coord_sym_transp(1,i),point)
do j=1,nucl_num do j=1,nucl_num
if (nucl_charge(i) /= nucl_charge(j)) cycle if (nucl_charge(i) /= nucl_charge(j)) cycle
point2(:) = nucl_coord_transp(:,j) - point(:) point2(:) = nucl_coord_sym_transp(:,j) - point(:)
if (u_dot_u(point2,3) < 1.d-5) then if (u_dot_u(point2,3) < 1.d-5) then
found = .True. found = .True.
exit exit
@ -148,10 +148,10 @@ BEGIN_PROVIDER [ logical, molecule_has_improper_rotation ]
molecule_has_improper_rotation = .True. molecule_has_improper_rotation = .True.
do i=1,nucl_num do i=1,nucl_num
found = .False. found = .False.
call sym_apply_improper_rotation(dble(iorder),iaxis,nucl_coord_transp(1,i),point) call sym_apply_improper_rotation(dble(iorder),iaxis,nucl_coord_sym_transp(1,i),point)
do j=1,nucl_num do j=1,nucl_num
if (nucl_charge(i) /= nucl_charge(j)) cycle if (nucl_charge(i) /= nucl_charge(j)) cycle
point2(:) = nucl_coord_transp(:,j) - point(:) point2(:) = nucl_coord_sym_transp(:,j) - point(:)
if (u_dot_u(point2,3) < 1.d-5) then if (u_dot_u(point2,3) < 1.d-5) then
found = .True. found = .True.
exit exit
@ -179,7 +179,7 @@ BEGIN_PROVIDER [ logical, molecule_has_center_of_inversion ]
found = .False. found = .False.
do j=1,nucl_num do j=1,nucl_num
if (nucl_charge(i) /= nucl_charge(j)) cycle if (nucl_charge(i) /= nucl_charge(j)) cycle
point(:) = nucl_coord_transp(:,i) + nucl_coord_transp(:,j) point(:) = nucl_coord_sym_transp(:,i) + nucl_coord_sym_transp(:,j)
if (u_dot_u(point,3) < 1.d-5) then if (u_dot_u(point,3) < 1.d-5) then
found = .True. found = .True.
exit exit
@ -208,11 +208,11 @@ BEGIN_PROVIDER [ logical, molecule_has_sigma_plane, (3) ]
molecule_has_sigma_plane(iaxis) = .True. molecule_has_sigma_plane(iaxis) = .True.
do i=1,nucl_num do i=1,nucl_num
found = .False. found = .False.
point(:) = nucl_coord_transp(:,i) point(:) = nucl_coord_sym_transp(:,i)
point(iaxis) = -point(iaxis) point(iaxis) = -point(iaxis)
do j=1,nucl_num do j=1,nucl_num
if (nucl_charge(i) /= nucl_charge(j)) cycle if (nucl_charge(i) /= nucl_charge(j)) cycle
point2(:) = nucl_coord_transp(:,j) - point(:) point2(:) = nucl_coord_sym_transp(:,j) - point(:)
if (u_dot_u(point2,3) < 1.d-5) then if (u_dot_u(point2,3) < 1.d-5) then
found = .True. found = .True.
exit exit
@ -366,7 +366,7 @@ BEGIN_PROVIDER [ integer, mo_sym, (mo_tot_num) ]
integer :: iangle, n_sym_points integer :: iangle, n_sym_points
double precision :: angle double precision :: angle
integer :: iop, imo, ipoint, l, i integer :: iop, imo, ipoint, l, i
double precision :: sym_operations_on_mos(n_irrep) double precision :: sym_operations_on_mos(mo_tot_num)
logical :: possible_irrep(n_irrep,mo_tot_num) logical :: possible_irrep(n_irrep,mo_tot_num)
n_sym_points = 10000 n_sym_points = 10000
@ -443,6 +443,7 @@ BEGIN_PROVIDER [ integer, mo_sym, (mo_tot_num) ]
sym_operations_on_mos(imo) += x sym_operations_on_mos(imo) += x
enddo enddo
sym_operations_on_mos(imo) *= 1.d0/n_sym_points sym_operations_on_mos(imo) *= 1.d0/n_sym_points
print *, iop, imo, sym_operations_on_mos(imo)
if (dabs(sym_operations_on_mos(imo)-1.d0) < 1.d-2) then if (dabs(sym_operations_on_mos(imo)-1.d0) < 1.d-2) then
sym_operations_on_mos(imo)=1.d0 sym_operations_on_mos(imo)=1.d0
else if (dabs(sym_operations_on_mos(imo)+1.d0) < 1.d-2) then else if (dabs(sym_operations_on_mos(imo)+1.d0) < 1.d-2) then

View File

@ -0,0 +1,92 @@
BEGIN_PROVIDER [ double precision, nucl_coord_sym, (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_sym(i,1) = (nucl_coord(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,1) + &
(nucl_coord(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,1) + &
(nucl_coord(i,3) - center_of_mass(3))*inertia_tensor_eigenvectors(3,1)
nucl_coord_sym(i,2) = (nucl_coord(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,2) + &
(nucl_coord(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,2) + &
(nucl_coord(i,3) - center_of_mass(3))*inertia_tensor_eigenvectors(3,2)
nucl_coord_sym(i,3) = (nucl_coord(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,3) + &
(nucl_coord(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,3) + &
(nucl_coord(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)
write(output_Nuclei,'(A)') ''
write(output_Nuclei,'(A)') 'Nuclear Coordinates in standard orientation (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_sym(i,1)*a0, &
nucl_coord_sym(i,2)*a0, &
nucl_coord_sym(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_sym, 3*nucl_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read nucl_coord_sym with MPI'
endif
IRP_ENDIF
END_PROVIDER
BEGIN_PROVIDER [ double precision, nucl_coord_sym_transp, (3,nucl_num) ]
implicit none
BEGIN_DOC
! Transposed array of nucl_coord
END_DOC
integer :: i, k
nucl_coord_sym_transp = 0.d0
do i=1,nucl_num
nucl_coord_sym_transp(1,i) = nucl_coord_sym(i,1)
nucl_coord_sym_transp(2,i) = nucl_coord_sym(i,2)
nucl_coord_sym_transp(3,i) = nucl_coord_sym(i,3)
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, sym_molecule_rotation, (3,3) ]
implicit none
BEGIN_DOC
! Rotation of the molecule to go from input orientation to standard orientation
END_DOC
call find_rotation(nucl_coord, size(nucl_coord,1), nucl_coord_sym, 3, sym_molecule_rotation, 3)
END_PROVIDER
BEGIN_PROVIDER [ double precision, sym_molecule_rotation_inv, (3,3) ]
implicit none
BEGIN_DOC
! Rotation of the molecule to go from standard orientation to input orientation
END_DOC
call find_rotation(nucl_coord_sym, size(nucl_coord_sym,1), nucl_coord, 3, sym_molecule_rotation_inv, 3)
END_PROVIDER

View File

@ -1,119 +1,15 @@
name_to_elec = {"X": 0, #!/usr/bin/env python
"H": 1,
"He": 2, import os
"Li": 3,
"Be": 4, QP_ROOT=os.environ["QP_ROOT"]
"B": 5,
"C": 6, name_to_elec = {}
"N": 7, with open(QP_ROOT+"/data/list_element.txt","r") as f:
"O": 8, data = f.readlines()
"F": 9, for line in data:
"Ne": 10, b = line.split()
"Na": 11, name_to_elec[b[1]] = int(b[0])
"Mg": 12,
"Al": 13, if __name__ == '__main__':
"Si": 14, print name_to_elec
"P": 15,
"S": 16,
"Cl": 17,
"Ar": 18,
"K": 19,
"Ca": 20,
"Sc": 21,
"Ti": 22,
"V": 23,
"Cr": 24,
"Mn": 25,
"Fe": 26,
"Co": 27,
"Ni": 28,
"Cu": 29,
"Zn": 30,
"Ga": 31,
"Ge": 32,
"As": 33,
"Se": 34,
"Br": 35,
"Kr": 36,
"Rb": 37,
"Sr": 38,
"Y": 39,
"Zr": 40,
"Nb": 41,
"Mo": 42,
"Tc": 43,
"Ru": 44,
"Rh": 45,
"Pd": 46,
"Ag": 47,
"Cd": 48,
"In": 49,
"Sn": 50,
"Sb": 51,
"Te": 52,
"I": 53,
"Xe": 54,
"Cs": 55,
"Ba": 56,
"La": 57,
"Ce": 58,
"Pr": 59,
"Nd": 60,
"Pm": 61,
"Sm": 62,
"Eu": 63,
"Gd": 64,
"Tb": 65,
"Dy": 66,
"Ho": 67,
"Er": 68,
"Tm": 69,
"Yb": 70,
"Lu": 71,
"Hf": 72,
"Ta": 73,
"W": 74,
"Re": 75,
"Os": 76,
"Ir": 77,
"Pt": 78,
"Au": 79,
"Hg": 80,
"Tl": 81,
"Pb": 82,
"Bi": 83,
"Po": 84,
"At": 85,
"Rn": 86,
"Fr": 87,
"Ra": 88,
"Ac": 89,
"Th": 90,
"Pa": 91,
"U": 92,
"Np": 93,
"Pu": 94,
"Am": 95,
"Cm": 96,
"Bk": 97,
"Cf": 98,
"Es": 99,
"Fm": 100,
"Md": 101,
"No": 102,
"Lr": 103,
"Rf": 104,
"Db": 105,
"Sg": 106,
"Bh": 107,
"Hs": 108,
"Mt": 109,
"Ds": 110,
"Rg": 111,
"Cn": 112,
"Uut": 113,
"Fl": 114,
"Uup": 115,
"Lv": 116,
"Uus": 117,
"Uuo": 118}

View File

@ -6,12 +6,12 @@ BEGIN_PROVIDER [ double precision, inertia_tensor, (3,3) ]
integer :: i,j,k integer :: i,j,k
inertia_tensor = 0.d0 inertia_tensor = 0.d0
do k=1,nucl_num 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(1,1) += element_mass(int(nucl_charge(k))) * ((nucl_coord(k,2)-center_of_mass(2))**2 + (nucl_coord(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(2,2) += element_mass(int(nucl_charge(k))) * ((nucl_coord(k,1)-center_of_mass(1))**2 + (nucl_coord(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(3,3) += element_mass(int(nucl_charge(k))) * ((nucl_coord(k,1)-center_of_mass(1))**2 + (nucl_coord(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,2) -= element_mass(int(nucl_charge(k))) * ((nucl_coord(k,1)-center_of_mass(1)) * (nucl_coord(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(1,3) -= element_mass(int(nucl_charge(k))) * ((nucl_coord(k,1)-center_of_mass(1)) * (nucl_coord(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)) ) inertia_tensor(2,3) -= element_mass(int(nucl_charge(k))) * ((nucl_coord(k,2)-center_of_mass(2)) * (nucl_coord(k,3)-center_of_mass(3)) )
enddo enddo
inertia_tensor(2,1) = inertia_tensor(1,2) inertia_tensor(2,1) = inertia_tensor(1,2)
inertia_tensor(3,1) = inertia_tensor(1,3) inertia_tensor(3,1) = inertia_tensor(1,3)
@ -27,6 +27,6 @@ END_PROVIDER
integer :: k integer :: k
call lapack_diagd(inertia_tensor_eigenvalues,inertia_tensor_eigenvectors,inertia_tensor,3,3) call lapack_diagd(inertia_tensor_eigenvalues,inertia_tensor_eigenvectors,inertia_tensor,3,3)
print *, 'Rotational constants (GHZ):' print *, 'Rotational constants (GHZ):'
print *, (1805.65468542d0/inertia_tensor_eigenvalues(k), k=3,1,-1) print *, (1805.65468542d0/(inertia_tensor_eigenvalues(k)+1.d-32), k=3,1,-1)
END_PROVIDER END_PROVIDER

View File

@ -1,4 +1,4 @@
BEGIN_PROVIDER [ double precision, nucl_coord_input, (nucl_num,3) ] BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -8,7 +8,7 @@ BEGIN_PROVIDER [ double precision, nucl_coord_input, (nucl_num,3) ]
if (mpi_master) then if (mpi_master) then
double precision, allocatable :: buffer(:,:) double precision, allocatable :: buffer(:,:)
nucl_coord_input = 0.d0 nucl_coord = 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_input, (nucl_num,3) ]
do i=1,3 do i=1,3
do j=1,nucl_num do j=1,nucl_num
nucl_coord_input(j,i) = buffer(j,i) nucl_coord(j,i) = buffer(j,i)
enddo enddo
enddo enddo
deallocate(buffer) deallocate(buffer)
@ -31,65 +31,6 @@ BEGIN_PROVIDER [ double precision, nucl_coord_input, (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)'
@ -258,155 +199,49 @@ BEGIN_PROVIDER [ double precision, nuclear_repulsion ]
call ezfio_set_nuclei_nuclear_repulsion(nuclear_repulsion) call ezfio_set_nuclei_nuclear_repulsion(nuclear_repulsion)
endif endif
endif endif
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ character*(128), element_name, (78)] BEGIN_PROVIDER [ character*(4), element_name, (0:128)]
&BEGIN_PROVIDER [ double precision, element_mass, (0:128) ]
BEGIN_DOC BEGIN_DOC
! Array of the name of element, sorted by nuclear charge (integer) ! Array of the name of element, sorted by nuclear charge (integer)
END_DOC END_DOC
element_name(1) = 'H' integer :: iunit
element_name(2) = 'He' integer, external :: getUnitAndOpen
element_name(3) = 'Li' character*(128) :: filename
element_name(4) = 'Be' if (mpi_master) then
element_name(5) = 'B' call getenv('QP_ROOT',filename)
element_name(6) = 'C' filename = trim(filename)//'/data/list_element.txt'
element_name(7) = 'N' iunit = getUnitAndOpen(filename,'r')
element_name(8) = 'O' element_mass(:) = 0.d0
element_name(9) = 'F' do i=0,128
element_name(10) = 'Ne' write(element_name(i),'(I4)') i
element_name(11) = 'Na' enddo
element_name(12) = 'Mg' character*(80) :: buffer, dummy
element_name(13) = 'Al' do
element_name(14) = 'Si' read(iunit,'(A80)',end=10) buffer
element_name(15) = 'P' read(buffer,*) i ! First read i
element_name(16) = 'S' read(buffer,*) i, element_name(i), dummy, element_mass(i)
element_name(17) = 'Cl' enddo
element_name(18) = 'Ar' 10 continue
element_name(19) = 'K' close(10)
element_name(20) = 'Ca' endif
element_name(21) = 'Sc'
element_name(22) = 'Ti'
element_name(23) = 'V'
element_name(24) = 'Cr'
element_name(25) = 'Mn'
element_name(26) = 'Fe'
element_name(27) = 'Co'
element_name(28) = 'Ni'
element_name(29) = 'Cu'
element_name(30) = 'Zn'
element_name(31) = 'Ga'
element_name(32) = 'Ge'
element_name(33) = 'As'
element_name(34) = 'Se'
element_name(35) = 'Br'
element_name(36) = 'Kr'
element_name(37) = 'Rb'
element_name(38) = 'Sr'
element_name(39) = 'Y'
element_name(40) = 'Zr'
element_name(41) = 'Nb'
element_name(42) = 'Mo'
element_name(43) = 'Tc'
element_name(44) = 'Ru'
element_name(45) = 'Rh'
element_name(46) = 'Pd'
element_name(47) = 'Ag'
element_name(48) = 'Cd'
element_name(49) = 'In'
element_name(50) = 'Sn'
element_name(51) = 'Sb'
element_name(52) = 'Te'
element_name(53) = 'I'
element_name(54) = 'Xe'
element_name(55) = 'Cs'
element_name(56) = 'Ba'
element_name(57) = 'La'
element_name(58) = 'Ce'
element_name(59) = 'Pr'
element_name(60) = 'Nd'
element_name(61) = 'Pm'
element_name(62) = 'Sm'
element_name(63) = 'Eu'
element_name(64) = 'Gd'
element_name(65) = 'Tb'
element_name(66) = 'Dy'
element_name(67) = 'Ho'
element_name(68) = 'Er'
element_name(69) = 'Tm'
element_name(70) = 'Yb'
element_name(71) = 'Lu'
element_name(72) = 'Hf'
element_name(73) = 'Ta'
element_name(74) = 'W'
element_name(75) = 'Re'
element_name(76) = 'Os'
element_name(77) = 'Ir'
element_name(78) = 'Pt'
END_PROVIDER IRP_IF MPI
include 'mpif.h'
integer :: ierr
call MPI_BCAST( element_name, size(element_name)*4, MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read element_name with MPI'
endif
call MPI_BCAST( element_mass, size(element_mass), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read element_name with MPI'
endif
IRP_ENDIF
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 END_PROVIDER
BEGIN_PROVIDER [ double precision, center_of_mass, (3) ] BEGIN_PROVIDER [ double precision, center_of_mass, (3) ]
@ -420,9 +255,9 @@ BEGIN_PROVIDER [ double precision, center_of_mass, (3) ]
s = 0.d0 s = 0.d0
do i=1,nucl_num do i=1,nucl_num
do j=1,3 do j=1,3
center_of_mass(j) += nucl_coord_input(i,j)* mass(int(nucl_charge(i))) center_of_mass(j) += nucl_coord(i,j)* element_mass(int(nucl_charge(i)))
enddo enddo
s += mass(int(nucl_charge(i))) s += element_mass(int(nucl_charge(i)))
enddo enddo
s = 1.d0/s s = 1.d0/s
center_of_mass(:) = center_of_mass(:)*s center_of_mass(:) = center_of_mass(:)*s