Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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 90 : 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 90 : INTEGER, POINTER :: wfc_to_atom_map(:)
54 : REAL(KIND=dp) :: dr(3), mydist(2), ria(3)
55 90 : 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 90 : TYPE(particle_type), POINTER :: particle_set(:)
61 :
62 90 : logger => cp_get_default_logger()
63 :
64 90 : particle_set => qs_loc_env%particle_set
65 90 : para_env => qs_loc_env%para_env
66 90 : local_molecules => qs_loc_env%local_molecules
67 90 : nstate = SIZE(center, 2)
68 270 : ALLOCATE (wfc_to_atom_map(nstate))
69 : !---------------------------------------------------------------------------
70 : !---------------------------------------------------------------------------
71 90 : nkind = SIZE(local_molecules%n_el)
72 : natom = 0
73 90 : natom_max = 0
74 230 : DO ikind = 1, nkind
75 140 : nmol = SIZE(local_molecules%list(ikind)%array)
76 303 : DO imol = 1, nmol
77 73 : i = local_molecules%list(ikind)%array(imol)
78 73 : molecule_kind => molecule_set(i)%molecule_kind
79 73 : CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
80 73 : natom_max = natom_max + natom
81 73 : IF (.NOT. ASSOCIATED(molecule_set(i)%lmi)) THEN
82 130 : ALLOCATE (molecule_set(i)%lmi(nspins))
83 70 : DO k = 1, nspins
84 70 : NULLIFY (molecule_set(i)%lmi(k)%states)
85 : END DO
86 : END IF
87 73 : molecule_set(i)%lmi(ispin)%nstates = 0
88 286 : IF (ASSOCIATED(molecule_set(i)%lmi(ispin)%states)) THEN
89 33 : DEALLOCATE (molecule_set(i)%lmi(ispin)%states)
90 : END IF
91 : END DO
92 : END DO
93 90 : natom_loc = natom_max
94 : natom = natom_max
95 :
96 90 : CALL para_env%max(natom_max)
97 :
98 270 : ALLOCATE (r(3, natom_max))
99 :
100 270 : ALLOCATE (distance(natom_max))
101 :
102 : !Zero all the stuff
103 1466 : r(:, :) = 0.0_dp
104 434 : distance(:) = 1.E10_dp
105 :
106 : !---------------------------------------------------------------------------
107 : !---------------------------------------------------------------------------
108 90 : counter = 0
109 90 : nkind = SIZE(local_molecules%n_el)
110 230 : DO ikind = 1, nkind
111 140 : nmol = SIZE(local_molecules%list(ikind)%array)
112 303 : DO imol = 1, nmol
113 73 : i = local_molecules%list(ikind)%array(imol)
114 73 : molecule_kind => molecule_set(i)%molecule_kind
115 73 : first_atom = molecule_set(i)%first_atom
116 73 : CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
117 :
118 475 : DO iatom = 1, natom
119 262 : counter = counter + 1
120 1121 : r(:, counter) = particle_set(first_atom + iatom - 1)%r(:)
121 : END DO
122 : END DO
123 : END DO
124 :
125 : !---------------------------------------------------------------------------
126 : !---------------------------------------------------------------------------
127 894 : DO istate = 1, nstate
128 5948 : distance(:) = 1.E10_dp
129 5614 : DO iatom = 1, natom_loc
130 4810 : dr(1) = r(1, iatom) - center(1, istate)
131 4810 : dr(2) = r(2, iatom) - center(2, istate)
132 4810 : dr(3) = r(3, iatom) - center(3, istate)
133 4810 : ria = pbc(dr, qs_loc_env%cell)
134 20044 : distance(iatom) = SQRT(DOT_PRODUCT(ria, ria))
135 : END DO
136 :
137 : !combine distance() from all procs
138 5948 : local_location = MAX(1, MINLOC(distance, DIM=1))
139 :
140 804 : mydist(1) = distance(local_location)
141 804 : mydist(2) = para_env%mepos
142 :
143 804 : CALL para_env%minloc(mydist)
144 :
145 894 : IF (mydist(2) == para_env%mepos) THEN
146 402 : wfc_to_atom_map(istate) = local_location
147 : ELSE
148 402 : wfc_to_atom_map(istate) = 0
149 : END IF
150 : END DO
151 : !---------------------------------------------------------------------------
152 : !---------------------------------------------------------------------------
153 90 : IF (natom_loc /= 0) THEN
154 764 : DO istate = 1, nstate
155 700 : iatom = wfc_to_atom_map(istate)
156 764 : IF (iatom /= 0) THEN
157 402 : counter = 0
158 402 : nkind = SIZE(local_molecules%n_el)
159 649 : DO ikind = 1, nkind
160 649 : nmol = SIZE(local_molecules%list(ikind)%array)
161 707 : DO imol = 1, nmol
162 460 : imol_now = local_molecules%list(ikind)%array(imol)
163 460 : molecule_kind => molecule_set(imol_now)%molecule_kind
164 460 : CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
165 460 : counter = counter + natom
166 707 : IF (counter >= iatom) EXIT
167 : END DO
168 649 : IF (counter >= iatom) EXIT
169 : END DO
170 402 : i = molecule_set(imol_now)%lmi(ispin)%nstates
171 402 : i = i + 1
172 402 : molecule_set(imol_now)%lmi(ispin)%nstates = i
173 402 : CALL reallocate(molecule_set(imol_now)%lmi(ispin)%states, 1, i)
174 402 : molecule_set(imol_now)%lmi(ispin)%states(i) = istate
175 : END IF
176 : END DO
177 : END IF
178 :
179 90 : DEALLOCATE (distance)
180 90 : DEALLOCATE (r)
181 90 : DEALLOCATE (wfc_to_atom_map)
182 :
183 90 : END SUBROUTINE wfc_to_molecule
184 : !------------------------------------------------------------------------------
185 :
186 : END MODULE qs_loc_molecules
187 :
|
