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 qs_environment methods that use many other modules
10 : !> \par History
11 : !> 09.2002 created [fawzi]
12 : !> - local atom distribution (25.06.2003,MK)
13 : !> \author Fawzi Mohamed
14 : ! **************************************************************************************************
15 : MODULE qs_environment_methods
16 : USE atomic_kind_types, ONLY: atomic_kind_type
17 : USE cell_types, ONLY: cell_type
18 : USE cp_blacs_env, ONLY: cp_blacs_env_type
19 : USE cp_control_types, ONLY: dft_control_type
20 : USE cp_dbcsr_api, ONLY: dbcsr_distribution_type
21 : USE cp_dbcsr_operations, ONLY: cp_dbcsr_dist2d_to_dist
22 : USE distribution_2d_types, ONLY: distribution_2d_release,&
23 : distribution_2d_type
24 : USE distribution_methods, ONLY: distribute_molecules_2d
25 : USE ewald_environment_types, ONLY: ewald_environment_type
26 : USE ewald_pw_methods, ONLY: ewald_pw_grid_update
27 : USE ewald_pw_types, ONLY: ewald_pw_type
28 : USE input_constants, ONLY: do_ppl_grid
29 : USE kinds, ONLY: dp
30 : USE message_passing, ONLY: mp_para_env_type
31 : USE molecule_kind_types, ONLY: molecule_kind_type
32 : USE molecule_types, ONLY: molecule_type
33 : USE particle_types, ONLY: particle_type
34 : USE pw_env_methods, ONLY: pw_env_create,&
35 : pw_env_rebuild
36 : USE pw_env_types, ONLY: pw_env_get,&
37 : pw_env_release,&
38 : pw_env_type
39 : USE pw_pool_types, ONLY: pw_pool_type
40 : USE pw_types, ONLY: pw_c1d_gs_type,&
41 : pw_r3d_rs_type
42 : USE qs_charges_types, ONLY: qs_charges_create,&
43 : qs_charges_type
44 : USE qs_environment_types, ONLY: get_qs_env,&
45 : qs_environment_type,&
46 : set_qs_env
47 : USE qs_kind_types, ONLY: has_nlcc,&
48 : qs_kind_type
49 : USE qs_ks_types, ONLY: get_ks_env,&
50 : qs_ks_env_type,&
51 : set_ks_env
52 : USE qs_matrix_pools, ONLY: mpools_rebuild_fm_pools
53 : USE qs_outer_scf, ONLY: outer_loop_variables_count
54 : USE qs_rho0_ggrid, ONLY: rho0_s_grid_create
55 : USE qs_rho0_types, ONLY: rho0_mpole_type
56 : USE scf_control_types, ONLY: scf_control_type
57 : #include "./base/base_uses.f90"
58 :
59 : IMPLICIT NONE
60 : PRIVATE
61 :
62 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
63 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_environment_methods'
64 :
65 : PUBLIC :: qs_env_rebuild_pw_env, &
66 : qs_env_setup, &
67 : qs_env_time_update
68 : !***
69 : CONTAINS
70 :
71 : ! **************************************************************************************************
72 : !> \brief initializes various components of the qs_env, that need only
73 : !> atomic_kind_set, cell, dft_control, scf_control, c(i)%nmo,
74 : !> c(i)%nao, and particle_set to be initialized.
75 : !> The previous components of qs_env must be valid.
76 : !> Initializes pools, charges and pw_env.
77 : !> \param qs_env the qs_env to set up
78 : !> \par History
79 : !> 10.2002 created [fawzi]
80 : !> \author Fawzi Mohamed
81 : ! **************************************************************************************************
82 23010 : SUBROUTINE qs_env_setup(qs_env)
83 :
84 : TYPE(qs_environment_type), POINTER :: qs_env
85 :
86 : CHARACTER(len=*), PARAMETER :: routineN = 'qs_env_setup'
87 :
88 : INTEGER :: handle, nhistory, nvariables
89 7670 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: gradient_history, outer_scf_history, &
90 7670 : variable_history
91 7670 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
92 : TYPE(cell_type), POINTER :: cell
93 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
94 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
95 : TYPE(dft_control_type), POINTER :: dft_control
96 : TYPE(distribution_2d_type), POINTER :: distribution_2d
97 7670 : TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set
98 7670 : TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set
99 : TYPE(mp_para_env_type), POINTER :: para_env
100 7670 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
101 : TYPE(qs_charges_type), POINTER :: qs_charges
102 7670 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
103 : TYPE(qs_ks_env_type), POINTER :: ks_env
104 : TYPE(scf_control_type), POINTER :: scf_control
105 :
106 7670 : CALL timeset(routineN, handle)
107 :
108 7670 : NULLIFY (qs_kind_set, atomic_kind_set, dft_control, scf_control, qs_charges, para_env, &
109 7670 : distribution_2d, molecule_kind_set, molecule_set, particle_set, cell, &
110 7670 : ks_env, blacs_env)
111 :
112 : CALL get_qs_env(qs_env=qs_env, &
113 : qs_kind_set=qs_kind_set, &
114 : atomic_kind_set=atomic_kind_set, &
115 : dft_control=dft_control, &
116 : molecule_kind_set=molecule_kind_set, &
117 : molecule_set=molecule_set, &
118 : particle_set=particle_set, &
119 : scf_control=scf_control, &
120 : para_env=para_env, &
121 : blacs_env=blacs_env, &
122 : cell=cell, &
123 7670 : ks_env=ks_env)
124 :
125 7670 : CPASSERT(ASSOCIATED(qs_kind_set))
126 7670 : CPASSERT(ASSOCIATED(atomic_kind_set))
127 7670 : CPASSERT(ASSOCIATED(dft_control))
128 7670 : CPASSERT(ASSOCIATED(scf_control))
129 : ! allocate qs_charges
130 7670 : ALLOCATE (qs_charges)
131 7670 : CALL qs_charges_create(qs_charges, nspins=dft_control%nspins)
132 7670 : CALL set_qs_env(qs_env, qs_charges=qs_charges)
133 :
134 : ! outer scf setup
135 7670 : IF (scf_control%outer_scf%have_scf) THEN
136 1397 : nvariables = outer_loop_variables_count(scf_control)
137 1397 : nhistory = scf_control%outer_scf%extrapolation_order
138 5588 : ALLOCATE (outer_scf_history(nvariables, nhistory))
139 4191 : ALLOCATE (gradient_history(nvariables, 2))
140 6985 : gradient_history = 0.0_dp
141 2794 : ALLOCATE (variable_history(nvariables, 2))
142 6985 : variable_history = 0.0_dp
143 : CALL set_qs_env(qs_env, outer_scf_history=outer_scf_history, &
144 : gradient_history=gradient_history, &
145 1397 : variable_history=variable_history)
146 1397 : CALL set_qs_env(qs_env, outer_scf_ihistory=0)
147 : END IF
148 :
149 : ! set up pw_env
150 7670 : CALL qs_env_rebuild_pw_env(qs_env)
151 :
152 : ! rebuilds fm_pools
153 :
154 : ! XXXX should get rid of the mpools
155 7670 : IF (ASSOCIATED(qs_env%mos)) THEN
156 : CALL mpools_rebuild_fm_pools(qs_env%mpools, mos=qs_env%mos, &
157 7332 : blacs_env=blacs_env, para_env=para_env)
158 : END IF
159 :
160 : ! create 2d distribution
161 :
162 : CALL distribute_molecules_2d(cell=cell, &
163 : atomic_kind_set=atomic_kind_set, &
164 : qs_kind_set=qs_kind_set, &
165 : particle_set=particle_set, &
166 : molecule_kind_set=molecule_kind_set, &
167 : molecule_set=molecule_set, &
168 : distribution_2d=distribution_2d, &
169 : blacs_env=blacs_env, &
170 7670 : force_env_section=qs_env%input)
171 :
172 : ! and use it to create the dbcsr_dist, which should be the sole user of distribution_2d by now.
173 7670 : ALLOCATE (dbcsr_dist)
174 7670 : CALL cp_dbcsr_dist2d_to_dist(distribution_2d, dbcsr_dist)
175 7670 : CALL set_ks_env(ks_env, dbcsr_dist=dbcsr_dist)
176 :
177 : ! also keep distribution_2d in qs_env
178 7670 : CALL set_ks_env(ks_env, distribution_2d=distribution_2d)
179 7670 : CALL distribution_2d_release(distribution_2d)
180 :
181 7670 : CALL timestop(handle)
182 :
183 7670 : END SUBROUTINE qs_env_setup
184 :
185 : ! **************************************************************************************************
186 : !> \brief rebuilds the pw_env in the given qs_env, allocating it if necessary
187 : !> \param qs_env the qs_env whose pw_env has to be rebuilt
188 : !> \par History
189 : !> 10.2002 created [fawzi]
190 : !> \author Fawzi Mohamed
191 : ! **************************************************************************************************
192 42210 : SUBROUTINE qs_env_rebuild_pw_env(qs_env)
193 : TYPE(qs_environment_type), POINTER :: qs_env
194 :
195 : CHARACTER(len=*), PARAMETER :: routineN = 'qs_env_rebuild_pw_env'
196 :
197 : INTEGER :: handle
198 : LOGICAL :: nlcc
199 : TYPE(cell_type), POINTER :: cell
200 : TYPE(dft_control_type), POINTER :: dft_control
201 : TYPE(ewald_environment_type), POINTER :: ewald_env
202 : TYPE(ewald_pw_type), POINTER :: ewald_pw
203 : TYPE(pw_c1d_gs_type), POINTER :: rho_core, rho_nlcc_g
204 : TYPE(pw_env_type), POINTER :: new_pw_env
205 : TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
206 : TYPE(pw_r3d_rs_type), POINTER :: embed_pot, external_vxc, rho_nlcc, &
207 : spin_embed_pot, v_hartree_rspace, vee, &
208 : vppl, xcint_weights
209 42210 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
210 : TYPE(qs_ks_env_type), POINTER :: ks_env
211 : TYPE(rho0_mpole_type), POINTER :: rho0_mpole
212 :
213 42210 : CALL timeset(routineN, handle)
214 : ! rebuild pw_env
215 42210 : NULLIFY (dft_control, cell, ks_env, v_hartree_rspace, auxbas_pw_pool)
216 42210 : NULLIFY (rho0_mpole)
217 42210 : NULLIFY (ewald_env, ewald_pw, new_pw_env, external_vxc, rho_core, rho_nlcc, rho_nlcc_g, vee, vppl, &
218 42210 : embed_pot, spin_embed_pot, xcint_weights)
219 :
220 42210 : CALL get_qs_env(qs_env, ks_env=ks_env, pw_env=new_pw_env)
221 42210 : IF (.NOT. ASSOCIATED(new_pw_env)) THEN
222 7670 : CALL pw_env_create(new_pw_env)
223 7670 : CALL set_ks_env(ks_env, pw_env=new_pw_env)
224 7670 : CALL pw_env_release(new_pw_env)
225 : END IF
226 :
227 : CALL get_qs_env(qs_env, pw_env=new_pw_env, dft_control=dft_control, &
228 42210 : cell=cell)
229 :
230 443726 : IF (ANY(new_pw_env%cell_hmat /= cell%hmat)) THEN
231 : ! only rebuild if necessary
232 236392 : new_pw_env%cell_hmat = cell%hmat
233 9092 : CALL pw_env_rebuild(new_pw_env, qs_env=qs_env)
234 :
235 : ! reallocate rho_core
236 9092 : CALL get_qs_env(qs_env, pw_env=new_pw_env, rho_core=rho_core)
237 9092 : CPASSERT(ASSOCIATED(new_pw_env))
238 9092 : IF (dft_control%qs_control%gapw) THEN
239 1022 : IF (ASSOCIATED(rho_core)) THEN
240 0 : CALL rho_core%release()
241 0 : DEALLOCATE (rho_core)
242 : END IF
243 1022 : IF (dft_control%qs_control%gapw_control%nopaw_as_gpw) THEN
244 140 : ALLOCATE (rho_core)
245 140 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
246 140 : CALL auxbas_pw_pool%create_pw(rho_core)
247 140 : CALL set_ks_env(ks_env, rho_core=rho_core)
248 : END IF
249 1022 : CALL get_qs_env(qs_env=qs_env, rho0_mpole=rho0_mpole)
250 1022 : CALL rho0_s_grid_create(new_pw_env, rho0_mpole)
251 8070 : ELSE IF (dft_control%qs_control%semi_empirical) THEN
252 1000 : IF (dft_control%qs_control%se_control%do_ewald .OR. &
253 : dft_control%qs_control%se_control%do_ewald_gks) THEN
254 : ! rebuild Ewald environment
255 32 : CALL get_qs_env(qs_env=qs_env, ewald_env=ewald_env, ewald_pw=ewald_pw)
256 32 : CALL ewald_pw_grid_update(ewald_pw, ewald_env, cell%hmat)
257 : END IF
258 7070 : ELSE IF (dft_control%qs_control%dftb) THEN
259 434 : IF (dft_control%qs_control%dftb_control%do_ewald) THEN
260 : ! rebuild Ewald environment
261 330 : CALL get_qs_env(qs_env=qs_env, ewald_env=ewald_env, ewald_pw=ewald_pw)
262 330 : CALL ewald_pw_grid_update(ewald_pw, ewald_env, cell%hmat)
263 : END IF
264 6636 : ELSE IF (dft_control%qs_control%xtb) THEN
265 1834 : IF (dft_control%qs_control%xtb_control%do_ewald) THEN
266 : ! rebuild Ewald environment
267 754 : CALL get_qs_env(qs_env=qs_env, ewald_env=ewald_env, ewald_pw=ewald_pw)
268 754 : CALL ewald_pw_grid_update(ewald_pw, ewald_env, cell%hmat)
269 : END IF
270 : ELSE
271 4802 : IF (ASSOCIATED(rho_core)) THEN
272 356 : CALL rho_core%release()
273 356 : DEALLOCATE (rho_core)
274 : END IF
275 4802 : ALLOCATE (rho_core)
276 4802 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
277 4802 : CALL auxbas_pw_pool%create_pw(rho_core)
278 4802 : CALL set_ks_env(ks_env, rho_core=rho_core)
279 : END IF
280 :
281 : ! reallocate vppl (realspace grid of local pseudopotential
282 9092 : IF (dft_control%qs_control%do_ppl_method == do_ppl_grid) THEN
283 8 : NULLIFY (vppl)
284 8 : CALL get_qs_env(qs_env, pw_env=new_pw_env, vppl=vppl)
285 8 : IF (ASSOCIATED(vppl)) THEN
286 0 : CALL vppl%release()
287 : ELSE
288 8 : ALLOCATE (vppl)
289 : END IF
290 8 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
291 8 : CALL auxbas_pw_pool%create_pw(vppl)
292 8 : CALL set_ks_env(ks_env, vppl=vppl)
293 : END IF
294 :
295 : ! reallocate rho_nlcc
296 9092 : CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
297 9092 : nlcc = has_nlcc(qs_kind_set)
298 9092 : IF (nlcc) THEN
299 : ! the realspace version
300 16 : NULLIFY (rho_nlcc)
301 16 : CALL get_qs_env(qs_env, pw_env=new_pw_env, rho_nlcc=rho_nlcc)
302 16 : IF (ASSOCIATED(rho_nlcc)) THEN
303 0 : CALL rho_nlcc%release()
304 : ELSE
305 16 : ALLOCATE (rho_nlcc)
306 : END IF
307 16 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
308 16 : CALL auxbas_pw_pool%create_pw(rho_nlcc)
309 16 : CALL set_ks_env(ks_env, rho_nlcc=rho_nlcc)
310 : ! the g-space version
311 16 : NULLIFY (rho_nlcc_g)
312 16 : CALL get_qs_env(qs_env, pw_env=new_pw_env, rho_nlcc_g=rho_nlcc_g)
313 16 : IF (ASSOCIATED(rho_nlcc_g)) THEN
314 0 : CALL rho_nlcc_g%release()
315 : ELSE
316 16 : ALLOCATE (rho_nlcc_g)
317 : END IF
318 16 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
319 16 : CALL auxbas_pw_pool%create_pw(rho_nlcc_g)
320 16 : CALL set_ks_env(ks_env, rho_nlcc_g=rho_nlcc_g)
321 : END IF
322 :
323 : ! reallocate xcint_weights
324 9092 : IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
325 1172 : IF (dft_control%qs_control%gapw_control%accurate_xcint) THEN
326 152 : CALL set_ks_env(ks_env, exc_accint=.TRUE.)
327 152 : NULLIFY (xcint_weights)
328 152 : CALL get_qs_env(qs_env, pw_env=new_pw_env, xcint_weights=xcint_weights)
329 152 : IF (ASSOCIATED(xcint_weights)) THEN
330 0 : CALL xcint_weights%release()
331 : ELSE
332 152 : ALLOCATE (xcint_weights)
333 : END IF
334 152 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
335 152 : CALL auxbas_pw_pool%create_pw(xcint_weights)
336 152 : CALL set_ks_env(ks_env, xcint_weights=xcint_weights)
337 : END IF
338 : END IF
339 :
340 : ! reallocate vee: external electrostatic potential
341 9092 : IF (dft_control%apply_external_potential .AND. .NOT. qs_env%mimic) THEN
342 16 : NULLIFY (vee)
343 16 : CALL get_qs_env(qs_env, pw_env=new_pw_env, vee=vee)
344 16 : IF (ASSOCIATED(vee)) THEN
345 0 : CALL vee%release()
346 0 : DEALLOCATE (vee)
347 : END IF
348 16 : ALLOCATE (vee)
349 16 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
350 16 : CALL auxbas_pw_pool%create_pw(vee)
351 16 : CALL set_ks_env(ks_env, vee=vee)
352 16 : dft_control%eval_external_potential = .TRUE.
353 : END IF
354 :
355 : ! ZMP Reallocate external_vxc: external vxc potential
356 9092 : IF (dft_control%apply_external_vxc) THEN
357 0 : NULLIFY (external_vxc)
358 0 : CALL get_qs_env(qs_env, pw_env=new_pw_env, external_vxc=external_vxc)
359 0 : IF (ASSOCIATED(external_vxc)) THEN
360 0 : CALL external_vxc%release()
361 : ELSE
362 0 : ALLOCATE (external_vxc)
363 : END IF
364 0 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
365 0 : CALL auxbas_pw_pool%create_pw(external_vxc)
366 0 : CALL set_qs_env(qs_env, external_vxc=external_vxc)
367 0 : dft_control%read_external_vxc = .TRUE.
368 : END IF
369 :
370 : ! Embedding Reallocate: embed_pot
371 9092 : IF (dft_control%apply_embed_pot) THEN
372 0 : NULLIFY (embed_pot)
373 0 : CALL get_qs_env(qs_env, pw_env=new_pw_env, embed_pot=embed_pot)
374 0 : IF (ASSOCIATED(embed_pot)) THEN
375 0 : CALL embed_pot%release()
376 : ELSE
377 0 : ALLOCATE (embed_pot)
378 : END IF
379 0 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
380 0 : CALL auxbas_pw_pool%create_pw(embed_pot)
381 0 : CALL set_qs_env(qs_env, embed_pot=embed_pot)
382 :
383 0 : NULLIFY (spin_embed_pot)
384 0 : CALL get_qs_env(qs_env, pw_env=new_pw_env, spin_embed_pot=spin_embed_pot)
385 0 : IF (ASSOCIATED(spin_embed_pot)) THEN
386 0 : CALL spin_embed_pot%release()
387 0 : DEALLOCATE (spin_embed_pot)
388 : ELSE
389 0 : ALLOCATE (spin_embed_pot)
390 : END IF
391 0 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
392 0 : CALL auxbas_pw_pool%create_pw(spin_embed_pot)
393 0 : CALL set_qs_env(qs_env, spin_embed_pot=spin_embed_pot)
394 : END IF
395 :
396 9092 : CALL get_ks_env(ks_env, v_hartree_rspace=v_hartree_rspace)
397 9092 : IF (ASSOCIATED(v_hartree_rspace)) THEN
398 1422 : CALL v_hartree_rspace%release()
399 1422 : DEALLOCATE (v_hartree_rspace)
400 : END IF
401 9092 : CALL get_qs_env(qs_env, pw_env=new_pw_env)
402 9092 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
403 9092 : ALLOCATE (v_hartree_rspace)
404 9092 : CALL auxbas_pw_pool%create_pw(v_hartree_rspace)
405 9092 : CALL set_ks_env(ks_env, v_hartree_rspace=v_hartree_rspace)
406 : END IF
407 :
408 : !update the time in the poisson environment, to update time dependant constraints
409 42210 : new_pw_env%poisson_env%parameters%dbc_params%time = qs_env%sim_time
410 :
411 42210 : CALL timestop(handle)
412 :
413 42210 : END SUBROUTINE qs_env_rebuild_pw_env
414 :
415 : ! **************************************************************************************************
416 : !> \brief ...
417 : !> \param qs_env ...
418 : !> \param time ...
419 : !> \param itimes ...
420 : ! **************************************************************************************************
421 3816 : SUBROUTINE qs_env_time_update(qs_env, time, itimes)
422 : TYPE(qs_environment_type), POINTER :: qs_env
423 : REAL(KIND=dp), INTENT(IN) :: time
424 : INTEGER, INTENT(IN) :: itimes
425 :
426 : TYPE(dft_control_type), POINTER :: dft_control
427 :
428 3816 : qs_env%sim_time = time
429 3816 : qs_env%sim_step = itimes
430 :
431 3816 : CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
432 :
433 3816 : IF (dft_control%apply_external_potential) THEN
434 36 : IF (.NOT. dft_control%expot_control%static) THEN
435 0 : dft_control%eval_external_potential = .TRUE.
436 : END IF
437 : END IF
438 :
439 3816 : END SUBROUTINE qs_env_time_update
440 :
441 : END MODULE qs_environment_methods
|
