Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : MODULE embed_types
9 : USE atomic_kind_list_types, ONLY: atomic_kind_list_create,&
10 : atomic_kind_list_release,&
11 : atomic_kind_list_type
12 : USE atomic_kind_types, ONLY: atomic_kind_type
13 : USE cell_types, ONLY: cell_release,&
14 : cell_retain,&
15 : cell_type
16 : USE cp_fm_types, ONLY: cp_fm_type
17 : USE cp_log_handling, ONLY: cp_logger_p_type,&
18 : cp_logger_release
19 : USE cp_result_types, ONLY: cp_result_type
20 : USE cp_subsys_types, ONLY: cp_subsys_get,&
21 : cp_subsys_release,&
22 : cp_subsys_set,&
23 : cp_subsys_type
24 : USE distribution_1d_types, ONLY: distribution_1d_type
25 : USE input_section_types, ONLY: section_vals_release,&
26 : section_vals_retain,&
27 : section_vals_type
28 : USE kinds, ONLY: dp
29 : USE lri_environment_types, ONLY: lri_kind_type
30 : USE message_passing, ONLY: mp_para_env_p_type,&
31 : mp_para_env_release,&
32 : mp_para_env_type
33 : USE molecule_kind_list_types, ONLY: molecule_kind_list_create,&
34 : molecule_kind_list_release,&
35 : molecule_kind_list_type
36 : USE molecule_kind_types, ONLY: molecule_kind_type
37 : USE molecule_list_types, ONLY: molecule_list_create,&
38 : molecule_list_release,&
39 : molecule_list_type
40 : USE molecule_types, ONLY: molecule_type
41 : USE particle_list_types, ONLY: particle_list_create,&
42 : particle_list_release,&
43 : particle_list_type
44 : USE particle_types, ONLY: particle_type
45 : USE pw_types, ONLY: pw_r3d_rs_type
46 : #include "./base/base_uses.f90"
47 :
48 : IMPLICIT NONE
49 : PRIVATE
50 : PUBLIC :: opt_embed_pot_type, opt_dmfet_pot_type, embed_env_type
51 :
52 : ! *** Public subroutines ***
53 :
54 : PUBLIC :: get_embed_env, &
55 : set_embed_env, &
56 : embed_env_create, &
57 : embed_env_release
58 :
59 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
60 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'embed_types'
61 :
62 : ! **************************************************************************************************
63 : !> \brief Type containing main data for embedding potential optimization
64 : !> \author Vladimir Rybkin
65 : ! **************************************************************************************************
66 :
67 : TYPE opt_embed_pot_type
68 : TYPE(cp_fm_type), POINTER :: embed_pot_coef => NULL(), embed_pot_grad => NULL(), &
69 : prev_step => NULL(), step => NULL(), embed_pot_hess => NULL(), &
70 : prev_embed_pot_coef => NULL(), prev_embed_pot_grad => NULL(), &
71 : prev_embed_pot_hess => NULL(), kinetic_mat => NULL()
72 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: w_func, max_diff, int_diff, int_diff_square, &
73 : max_grid_step, max_subsys_dens_diff
74 : INTEGER :: n_iter = -1, i_iter = -1, dimen_aux = -1, &
75 : last_accepted = -1, dimen_var_aux = -1
76 : REAL(KIND=dp) :: lambda = 0.0_dp, allowed_decrease = 0.0_dp, &
77 : max_trad = 0.0_dp, min_trad = 0.0_dp, &
78 : grad_norm = 0.0_dp, vw_cutoff = 0.0_dp, &
79 : vw_smooth_cutoff_range = 0.0_dp, eta = 0.0_dp
80 : TYPE(pw_r3d_rs_type), POINTER :: const_pot => NULL(), prev_embed_pot => NULL(), &
81 : prev_spin_embed_pot => NULL(), pot_diff => NULL()
82 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: prev_grid_grad => NULL(), prev_grid_pot => NULL(), &
83 : prev_subsys_dens => NULL(), v_w => NULL()
84 : REAL(KIND=dp) :: reg_term = 0.0_dp, trust_rad = 0.0_dp, &
85 : conv_max = 0.0_dp, conv_int = 0.0_dp, &
86 : conv_max_spin = 0.0_dp, conv_int_spin = 0.0_dp, step_len = 0.0_dp
87 : LOGICAL :: accept_step = .FALSE., newton_step = .FALSE., &
88 : level_shift = .FALSE., steep_desc = .FALSE., &
89 : add_const_pot = .FALSE., converged = .FALSE., read_embed_pot = .FALSE., &
90 : read_embed_pot_cube = .FALSE., change_spin = .FALSE., &
91 : open_shell_embed = .FALSE., &
92 : grid_opt = .FALSE., leeuwen = .FALSE., fab = .FALSE., &
93 : coulomb_guess = .FALSE., fermi_amaldi = .FALSE., &
94 : diff_guess = .FALSE.
95 : INTEGER, ALLOCATABLE, DIMENSION(:) :: all_nspins
96 : TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri => NULL() ! Needed to store integrals
97 :
98 : END TYPE opt_embed_pot_type
99 :
100 : ! **************************************************************************************************
101 : !> \brief Type containing main data for matrix embedding potential optimization
102 : !> \author Vladimir Rybkin
103 : ! **************************************************************************************************
104 :
105 : TYPE opt_dmfet_pot_type
106 : TYPE(cp_fm_type), POINTER :: dmfet_pot => NULL(), dm_1 => NULL(), dm_2 => NULL(), &
107 : dm_total => NULL(), dm_diff => NULL(), &
108 : dmfet_pot_beta => NULL(), dm_total_beta => NULL(), &
109 : dm_diff_beta => NULL(), dm_subsys => NULL(), dm_subsys_beta => NULL()
110 : REAL(KIND=dp) :: trust_rad = 0.0_dp, conv_max = 0.0_dp, &
111 : conv_int = 0.0_dp, conv_max_beta = 0.0_dp, &
112 : conv_int_beta = 0.0_dp
113 : LOGICAL :: accept_step = .FALSE., converged = .FALSE., &
114 : read_dmfet_pot = .FALSE., &
115 : change_spin = .FALSE., open_shell_embed = .FALSE.
116 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: w_func, max_diff, int_diff
117 : INTEGER :: n_iter = -1, i_iter = -1, last_accepted = -1
118 : INTEGER, ALLOCATABLE, DIMENSION(:) :: all_nspins
119 :
120 : END TYPE opt_dmfet_pot_type
121 :
122 : ! **************************************************************************************************
123 : !> \brief Embedding environment type
124 : !> \author Vladimir Rybkin
125 : ! **************************************************************************************************
126 :
127 : TYPE embed_env_type
128 : TYPE(cell_type), POINTER :: cell_ref => NULL()
129 : TYPE(mp_para_env_type), POINTER :: para_env => NULL()
130 : TYPE(cp_subsys_type), POINTER :: subsys => NULL()
131 : TYPE(section_vals_type), POINTER :: input => NULL()
132 : REAL(KIND=dp), DIMENSION(:), POINTER :: energies => NULL()
133 : ! Parallelization of multiple force_eval
134 : INTEGER :: ngroups = -1
135 : INTEGER, DIMENSION(:), POINTER :: group_distribution => NULL()
136 : TYPE(mp_para_env_p_type), DIMENSION(:), POINTER :: sub_para_env => NULL()
137 : TYPE(cp_logger_p_type), DIMENSION(:), POINTER :: sub_logger => NULL()
138 : ! Densities from sunbsystem
139 : REAL(KIND=dp) :: pot_energy = 0.0_dp
140 : END TYPE embed_env_type
141 :
142 : CONTAINS
143 :
144 : ! **************************************************************************************************
145 : !> \brief Get the embed environment.
146 : !> \param embed_env ...
147 : !> \param atomic_kind_set ...
148 : !> \param particle_set ...
149 : !> \param local_particles ...
150 : !> \param local_molecules ...
151 : !> \param molecule_kind_set ...
152 : !> \param molecule_set ...
153 : !> \param cell ...
154 : !> \param cell_ref ...
155 : !> \param para_env ...
156 : !> \param sub_para_env ...
157 : !> \param subsys ...
158 : !> \param input ...
159 : !> \param results ...
160 : !> \param pot_energy ...
161 : ! **************************************************************************************************
162 338 : SUBROUTINE get_embed_env(embed_env, atomic_kind_set, particle_set, &
163 : local_particles, local_molecules, molecule_kind_set, &
164 : molecule_set, cell, cell_ref, &
165 : para_env, sub_para_env, subsys, &
166 : input, results, pot_energy)
167 :
168 : TYPE(embed_env_type), INTENT(IN) :: embed_env
169 : TYPE(atomic_kind_type), OPTIONAL, POINTER :: atomic_kind_set(:)
170 : TYPE(particle_type), OPTIONAL, POINTER :: particle_set(:)
171 : TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles, local_molecules
172 : TYPE(molecule_kind_type), OPTIONAL, POINTER :: molecule_kind_set(:)
173 : TYPE(molecule_type), OPTIONAL, POINTER :: molecule_set(:)
174 : TYPE(cell_type), OPTIONAL, POINTER :: cell, cell_ref
175 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
176 : TYPE(mp_para_env_p_type), DIMENSION(:), OPTIONAL, &
177 : POINTER :: sub_para_env
178 : TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
179 : TYPE(section_vals_type), OPTIONAL, POINTER :: input
180 : TYPE(cp_result_type), OPTIONAL, POINTER :: results
181 : REAL(KIND=dp), OPTIONAL :: pot_energy
182 :
183 : TYPE(atomic_kind_list_type), POINTER :: atomic_kinds
184 : TYPE(molecule_kind_list_type), POINTER :: molecule_kinds
185 : TYPE(molecule_list_type), POINTER :: molecules
186 : TYPE(particle_list_type), POINTER :: particles
187 :
188 338 : NULLIFY (atomic_kinds, particles, molecules, molecule_kinds)
189 338 : CPASSERT(ASSOCIATED(embed_env%subsys))
190 :
191 338 : IF (PRESENT(input)) input => embed_env%input
192 338 : IF (PRESENT(cell_ref)) cell_ref => embed_env%cell_ref
193 338 : IF (PRESENT(para_env)) para_env => embed_env%para_env
194 338 : IF (PRESENT(sub_para_env)) sub_para_env => embed_env%sub_para_env
195 338 : IF (PRESENT(subsys)) subsys => embed_env%subsys
196 : CALL cp_subsys_get(embed_env%subsys, &
197 : atomic_kinds=atomic_kinds, &
198 : local_molecules=local_molecules, &
199 : local_particles=local_particles, &
200 : particles=particles, &
201 : molecule_kinds=molecule_kinds, &
202 : molecules=molecules, &
203 : results=results, &
204 338 : cell=cell)
205 338 : IF (PRESENT(atomic_kind_set)) atomic_kind_set => atomic_kinds%els
206 338 : IF (PRESENT(particle_set)) particle_set => particles%els
207 338 : IF (PRESENT(molecule_kind_set)) molecule_kind_set => molecule_kinds%els
208 338 : IF (PRESENT(molecule_set)) molecule_set => molecules%els
209 338 : IF (PRESENT(pot_energy)) pot_energy = embed_env%pot_energy
210 :
211 338 : END SUBROUTINE get_embed_env
212 :
213 : ! **************************************************************************************************
214 : !> \brief ...
215 : !> \param embed_env ...
216 : !> \param atomic_kind_set ...
217 : !> \param particle_set ...
218 : !> \param local_particles ...
219 : !> \param local_molecules ...
220 : !> \param molecule_kind_set ...
221 : !> \param molecule_set ...
222 : !> \param cell_ref ...
223 : !> \param subsys ...
224 : !> \param input ...
225 : !> \param sub_para_env ...
226 : ! **************************************************************************************************
227 72 : SUBROUTINE set_embed_env(embed_env, atomic_kind_set, particle_set, &
228 : local_particles, local_molecules, molecule_kind_set, &
229 : molecule_set, cell_ref, subsys, &
230 : input, sub_para_env)
231 :
232 : TYPE(embed_env_type), INTENT(INOUT) :: embed_env
233 : TYPE(atomic_kind_type), OPTIONAL, POINTER :: atomic_kind_set(:)
234 : TYPE(particle_type), OPTIONAL, POINTER :: particle_set(:)
235 : TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles, local_molecules
236 : TYPE(molecule_kind_type), OPTIONAL, POINTER :: molecule_kind_set(:)
237 : TYPE(molecule_type), OPTIONAL, POINTER :: molecule_set(:)
238 : TYPE(cell_type), OPTIONAL, POINTER :: cell_ref
239 : TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
240 : TYPE(section_vals_type), OPTIONAL, POINTER :: input
241 : TYPE(mp_para_env_p_type), DIMENSION(:), OPTIONAL, &
242 : POINTER :: sub_para_env
243 :
244 : TYPE(atomic_kind_list_type), POINTER :: atomic_kinds
245 : TYPE(molecule_kind_list_type), POINTER :: molecule_kinds
246 : TYPE(molecule_list_type), POINTER :: molecules
247 : TYPE(particle_list_type), POINTER :: particles
248 :
249 72 : IF (PRESENT(cell_ref)) THEN
250 24 : CALL cell_retain(cell_ref)
251 24 : CALL cell_release(embed_env%cell_ref)
252 24 : embed_env%cell_ref => cell_ref
253 : END IF
254 72 : IF (PRESENT(input)) THEN
255 24 : CALL section_vals_retain(input)
256 24 : CALL section_vals_release(embed_env%input)
257 24 : embed_env%input => input
258 : END IF
259 72 : IF (PRESENT(subsys)) THEN
260 24 : IF (ASSOCIATED(embed_env%subsys)) THEN
261 0 : IF (.NOT. ASSOCIATED(embed_env%subsys, subsys)) THEN
262 0 : CALL cp_subsys_release(embed_env%subsys)
263 : END IF
264 : END IF
265 24 : embed_env%subsys => subsys
266 : END IF
267 72 : IF (PRESENT(sub_para_env)) THEN
268 0 : embed_env%sub_para_env => sub_para_env
269 : END IF
270 72 : IF (PRESENT(atomic_kind_set)) THEN
271 : CALL atomic_kind_list_create(atomic_kinds, &
272 0 : els_ptr=atomic_kind_set)
273 : CALL cp_subsys_set(embed_env%subsys, &
274 0 : atomic_kinds=atomic_kinds)
275 0 : CALL atomic_kind_list_release(atomic_kinds)
276 : END IF
277 72 : IF (PRESENT(particle_set)) THEN
278 : CALL particle_list_create(particles, &
279 0 : els_ptr=particle_set)
280 : CALL cp_subsys_set(embed_env%subsys, &
281 0 : particles=particles)
282 0 : CALL particle_list_release(particles)
283 : END IF
284 72 : IF (PRESENT(local_particles)) THEN
285 : CALL cp_subsys_set(embed_env%subsys, &
286 24 : local_particles=local_particles)
287 : END IF
288 72 : IF (PRESENT(local_molecules)) THEN
289 : CALL cp_subsys_set(embed_env%subsys, &
290 24 : local_molecules=local_molecules)
291 : END IF
292 72 : IF (PRESENT(molecule_kind_set)) THEN
293 0 : CALL molecule_kind_list_create(molecule_kinds, els_ptr=molecule_kind_set)
294 0 : CALL cp_subsys_set(embed_env%subsys, molecule_kinds=molecule_kinds)
295 0 : CALL molecule_kind_list_release(molecule_kinds)
296 : END IF
297 72 : IF (PRESENT(molecule_set)) THEN
298 0 : CALL molecule_list_create(molecules, els_ptr=molecule_set)
299 0 : CALL cp_subsys_set(embed_env%subsys, molecules=molecules)
300 0 : CALL molecule_list_release(molecules)
301 : END IF
302 :
303 72 : END SUBROUTINE set_embed_env
304 :
305 : ! **************************************************************************************************
306 : !> \brief ...
307 : !> \param embed_env ...
308 : !> \param para_env the parallel environment for the qs_env
309 : !> \author Vladimir Rybkin 02.2018
310 : ! **************************************************************************************************
311 24 : SUBROUTINE embed_env_create(embed_env, para_env)
312 : TYPE(embed_env_type), INTENT(OUT) :: embed_env
313 : TYPE(mp_para_env_type), INTENT(IN), TARGET :: para_env
314 :
315 24 : embed_env%para_env => para_env
316 24 : CALL embed_env%para_env%retain()
317 :
318 24 : END SUBROUTINE embed_env_create
319 :
320 : ! **************************************************************************************************
321 : !> \brief ...
322 : !> \param embed_env ...
323 : !> \author Vladimir Rybkin 02.2018
324 : ! **************************************************************************************************
325 24 : SUBROUTINE embed_env_release(embed_env)
326 : TYPE(embed_env_type), INTENT(INOUT) :: embed_env
327 :
328 : INTEGER :: i, ngroups
329 :
330 24 : ngroups = embed_env%ngroups
331 48 : DO i = 1, ngroups
332 48 : IF (ASSOCIATED(embed_env%sub_para_env(i)%para_env)) THEN
333 24 : CALL cp_logger_release(embed_env%sub_logger(i)%p)
334 24 : CALL mp_para_env_release(embed_env%sub_para_env(i)%para_env)
335 : END IF
336 : END DO
337 24 : DEALLOCATE (embed_env%sub_para_env)
338 24 : DEALLOCATE (embed_env%sub_logger)
339 24 : DEALLOCATE (embed_env%energies)
340 24 : CALL cell_release(embed_env%cell_ref)
341 24 : CALL mp_para_env_release(embed_env%para_env)
342 24 : CALL cp_subsys_release(embed_env%subsys)
343 24 : CALL section_vals_release(embed_env%input)
344 24 : IF (ASSOCIATED(embed_env%group_distribution)) THEN
345 24 : DEALLOCATE (embed_env%group_distribution)
346 : END IF
347 :
348 24 : END SUBROUTINE embed_env_release
349 :
350 0 : END MODULE embed_types
351 :
|
