Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Set of routines handling the localization for molecular properties
10 : ! **************************************************************************************************
11 : MODULE qs_loc_molecules
12 : USE cell_types, ONLY: pbc
13 : USE cp_log_handling, ONLY: cp_get_default_logger,&
14 : cp_logger_type
15 : USE distribution_1d_types, ONLY: distribution_1d_type
16 : USE kinds, ONLY: dp
17 : USE memory_utilities, ONLY: reallocate
18 : USE message_passing, ONLY: mp_para_env_type
19 : USE molecule_kind_types, ONLY: get_molecule_kind,&
20 : molecule_kind_type
21 : USE molecule_types, ONLY: molecule_type
22 : USE particle_types, ONLY: particle_type
23 : USE qs_loc_types, ONLY: qs_loc_env_type
24 : #include "./base/base_uses.f90"
25 :
26 : IMPLICIT NONE
27 :
28 : PRIVATE
29 :
30 : ! *** Public ***
31 : PUBLIC :: wfc_to_molecule
32 :
33 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_loc_molecules'
34 :
35 : CONTAINS
36 :
37 : ! **************************************************************************************************
38 : !> \brief maps wfc's to molecules and also prints molecular dipoles
39 : !> \param qs_loc_env ...
40 : !> \param center ...
41 : !> \param molecule_set ...
42 : !> \param ispin ...
43 : !> \param nspins ...
44 : ! **************************************************************************************************
45 42 : SUBROUTINE wfc_to_molecule(qs_loc_env, center, molecule_set, ispin, nspins)
46 : TYPE(qs_loc_env_type), INTENT(IN) :: qs_loc_env
47 : REAL(KIND=dp), INTENT(IN) :: center(:, :)
48 : TYPE(molecule_type), POINTER :: molecule_set(:)
49 : INTEGER, INTENT(IN) :: ispin, nspins
50 :
51 : INTEGER :: counter, first_atom, i, iatom, ikind, imol, imol_now, istate, k, local_location, &
52 : natom, natom_loc, natom_max, nkind, nmol, nstate
53 42 : INTEGER, POINTER :: wfc_to_atom_map(:)
54 : REAL(KIND=dp) :: dr(3), mydist(2), ria(3)
55 42 : REAL(KIND=dp), POINTER :: distance(:), r(:, :)
56 : TYPE(cp_logger_type), POINTER :: logger
57 : TYPE(distribution_1d_type), POINTER :: local_molecules
58 : TYPE(molecule_kind_type), POINTER :: molecule_kind
59 : TYPE(mp_para_env_type), POINTER :: para_env
60 42 : TYPE(particle_type), POINTER :: particle_set(:)
61 :
62 42 : logger => cp_get_default_logger()
63 :
64 42 : particle_set => qs_loc_env%particle_set
65 42 : para_env => qs_loc_env%para_env
66 42 : local_molecules => qs_loc_env%local_molecules
67 42 : nstate = SIZE(center, 2)
68 126 : ALLOCATE (wfc_to_atom_map(nstate))
69 : !---------------------------------------------------------------------------
70 : !---------------------------------------------------------------------------
71 42 : nkind = SIZE(local_molecules%n_el)
72 : natom = 0
73 42 : natom_max = 0
74 110 : DO ikind = 1, nkind
75 68 : nmol = SIZE(local_molecules%list(ikind)%array)
76 147 : DO imol = 1, nmol
77 37 : i = local_molecules%list(ikind)%array(imol)
78 37 : molecule_kind => molecule_set(i)%molecule_kind
79 37 : CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
80 37 : natom_max = natom_max + natom
81 37 : IF (.NOT. ASSOCIATED(molecule_set(i)%lmi)) THEN
82 91 : ALLOCATE (molecule_set(i)%lmi(nspins))
83 49 : DO k = 1, nspins
84 49 : NULLIFY (molecule_set(i)%lmi(k)%states)
85 : END DO
86 : END IF
87 37 : molecule_set(i)%lmi(ispin)%nstates = 0
88 142 : IF (ASSOCIATED(molecule_set(i)%lmi(ispin)%states)) THEN
89 9 : DEALLOCATE (molecule_set(i)%lmi(ispin)%states)
90 : END IF
91 : END DO
92 : END DO
93 42 : natom_loc = natom_max
94 42 : natom = natom_max
95 :
96 42 : CALL para_env%max(natom_max)
97 :
98 126 : ALLOCATE (r(3, natom_max))
99 :
100 126 : ALLOCATE (distance(natom_max))
101 :
102 : !Zero all the stuff
103 530 : r(:, :) = 0.0_dp
104 164 : distance(:) = 1.E10_dp
105 :
106 : !---------------------------------------------------------------------------
107 : !---------------------------------------------------------------------------
108 42 : counter = 0
109 42 : nkind = SIZE(local_molecules%n_el)
110 110 : DO ikind = 1, nkind
111 68 : nmol = SIZE(local_molecules%list(ikind)%array)
112 147 : DO imol = 1, nmol
113 37 : i = local_molecules%list(ikind)%array(imol)
114 37 : molecule_kind => molecule_set(i)%molecule_kind
115 37 : first_atom = molecule_set(i)%first_atom
116 37 : CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
117 :
118 199 : DO iatom = 1, natom
119 94 : counter = counter + 1
120 413 : r(:, counter) = particle_set(first_atom + iatom - 1)%r(:)
121 : END DO
122 : END DO
123 : END DO
124 :
125 : !---------------------------------------------------------------------------
126 : !---------------------------------------------------------------------------
127 294 : DO istate = 1, nstate
128 1004 : distance(:) = 1.E10_dp
129 886 : DO iatom = 1, natom_loc
130 634 : dr(1) = r(1, iatom) - center(1, istate)
131 634 : dr(2) = r(2, iatom) - center(2, istate)
132 634 : dr(3) = r(3, iatom) - center(3, istate)
133 634 : ria = pbc(dr, qs_loc_env%cell)
134 2788 : distance(iatom) = SQRT(DOT_PRODUCT(ria, ria))
135 : END DO
136 :
137 : !combine distance() from all procs
138 1004 : local_location = MAX(1, MINLOC(distance, DIM=1))
139 :
140 252 : mydist(1) = distance(local_location)
141 252 : mydist(2) = para_env%mepos
142 :
143 252 : CALL para_env%minloc(mydist)
144 :
145 294 : IF (mydist(2) == para_env%mepos) THEN
146 126 : wfc_to_atom_map(istate) = local_location
147 : ELSE
148 126 : wfc_to_atom_map(istate) = 0
149 : END IF
150 : END DO
151 : !---------------------------------------------------------------------------
152 : !---------------------------------------------------------------------------
153 42 : IF (natom_loc /= 0) THEN
154 254 : DO istate = 1, nstate
155 220 : iatom = wfc_to_atom_map(istate)
156 254 : IF (iatom /= 0) THEN
157 126 : counter = 0
158 126 : nkind = SIZE(local_molecules%n_el)
159 163 : DO ikind = 1, nkind
160 163 : nmol = SIZE(local_molecules%list(ikind)%array)
161 166 : DO imol = 1, nmol
162 129 : imol_now = local_molecules%list(ikind)%array(imol)
163 129 : molecule_kind => molecule_set(imol_now)%molecule_kind
164 129 : CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
165 129 : counter = counter + natom
166 166 : IF (counter >= iatom) EXIT
167 : END DO
168 163 : IF (counter >= iatom) EXIT
169 : END DO
170 126 : i = molecule_set(imol_now)%lmi(ispin)%nstates
171 126 : i = i + 1
172 126 : molecule_set(imol_now)%lmi(ispin)%nstates = i
173 126 : CALL reallocate(molecule_set(imol_now)%lmi(ispin)%states, 1, i)
174 126 : molecule_set(imol_now)%lmi(ispin)%states(i) = istate
175 : END IF
176 : END DO
177 : END IF
178 :
179 42 : DEALLOCATE (distance)
180 42 : DEALLOCATE (r)
181 42 : DEALLOCATE (wfc_to_atom_map)
182 :
183 42 : END SUBROUTINE wfc_to_molecule
184 : !------------------------------------------------------------------------------
185 :
186 : END MODULE qs_loc_molecules
187 :
|
