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 23913 : 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 7971 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: gradient_history, outer_scf_history, &
90 7971 : variable_history
91 7971 : 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 7971 : TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set
98 7971 : TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set
99 : TYPE(mp_para_env_type), POINTER :: para_env
100 7971 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
101 : TYPE(qs_charges_type), POINTER :: qs_charges
102 7971 : 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 7971 : CALL timeset(routineN, handle)
107 :
108 7971 : NULLIFY (qs_kind_set, atomic_kind_set, dft_control, scf_control, qs_charges, para_env, &
109 7971 : distribution_2d, molecule_kind_set, molecule_set, particle_set, cell, &
110 7971 : 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 7971 : ks_env=ks_env)
124 :
125 7971 : CPASSERT(ASSOCIATED(qs_kind_set))
126 7971 : CPASSERT(ASSOCIATED(atomic_kind_set))
127 7971 : CPASSERT(ASSOCIATED(dft_control))
128 7971 : CPASSERT(ASSOCIATED(scf_control))
129 : ! allocate qs_charges
130 7971 : ALLOCATE (qs_charges)
131 7971 : CALL qs_charges_create(qs_charges, nspins=dft_control%nspins)
132 7971 : CALL set_qs_env(qs_env, qs_charges=qs_charges)
133 :
134 : ! outer scf setup
135 7971 : IF (scf_control%outer_scf%have_scf) THEN
136 1401 : nvariables = outer_loop_variables_count(scf_control)
137 1401 : nhistory = scf_control%outer_scf%extrapolation_order
138 5604 : ALLOCATE (outer_scf_history(nvariables, nhistory))
139 4203 : ALLOCATE (gradient_history(nvariables, 2))
140 7005 : gradient_history = 0.0_dp
141 2802 : ALLOCATE (variable_history(nvariables, 2))
142 7005 : variable_history = 0.0_dp
143 : CALL set_qs_env(qs_env, outer_scf_history=outer_scf_history, &
144 : gradient_history=gradient_history, &
145 1401 : variable_history=variable_history)
146 1401 : CALL set_qs_env(qs_env, outer_scf_ihistory=0)
147 : END IF
148 :
149 : ! set up pw_env
150 7971 : CALL qs_env_rebuild_pw_env(qs_env)
151 :
152 : ! rebuilds fm_pools
153 :
154 : ! XXXX should get rid of the mpools
155 7971 : IF (ASSOCIATED(qs_env%mos)) THEN
156 : CALL mpools_rebuild_fm_pools(qs_env%mpools, mos=qs_env%mos, &
157 7601 : 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 7971 : 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 7971 : ALLOCATE (dbcsr_dist)
174 7971 : CALL cp_dbcsr_dist2d_to_dist(distribution_2d, dbcsr_dist)
175 7971 : CALL set_ks_env(ks_env, dbcsr_dist=dbcsr_dist)
176 :
177 : ! also keep distribution_2d in qs_env
178 7971 : CALL set_ks_env(ks_env, distribution_2d=distribution_2d)
179 7971 : CALL distribution_2d_release(distribution_2d)
180 :
181 7971 : CALL timestop(handle)
182 :
183 7971 : 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 44155 : 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 44155 : 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 44155 : CALL timeset(routineN, handle)
214 : ! rebuild pw_env
215 44155 : NULLIFY (dft_control, cell, ks_env, v_hartree_rspace, auxbas_pw_pool)
216 44155 : NULLIFY (rho0_mpole)
217 44155 : NULLIFY (ewald_env, ewald_pw, new_pw_env, external_vxc, rho_core, rho_nlcc, rho_nlcc_g, vee, vppl, &
218 44155 : embed_pot, spin_embed_pot, xcint_weights)
219 :
220 44155 : CALL get_qs_env(qs_env, ks_env=ks_env, pw_env=new_pw_env)
221 44155 : IF (.NOT. ASSOCIATED(new_pw_env)) THEN
222 7971 : CALL pw_env_create(new_pw_env)
223 7971 : CALL set_ks_env(ks_env, pw_env=new_pw_env)
224 7971 : 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 44155 : cell=cell)
229 :
230 462015 : IF (ANY(new_pw_env%cell_hmat /= cell%hmat)) THEN
231 : ! only rebuild if necessary
232 255294 : new_pw_env%cell_hmat = cell%hmat
233 9819 : CALL pw_env_rebuild(new_pw_env, qs_env=qs_env)
234 :
235 : ! reallocate rho_core
236 9819 : CALL get_qs_env(qs_env, pw_env=new_pw_env, rho_core=rho_core)
237 9819 : CPASSERT(ASSOCIATED(new_pw_env))
238 9819 : IF (dft_control%qs_control%gapw) THEN
239 1170 : IF (ASSOCIATED(rho_core)) THEN
240 0 : CALL rho_core%release()
241 0 : DEALLOCATE (rho_core)
242 : END IF
243 1170 : IF (dft_control%qs_control%gapw_control%nopaw_as_gpw) THEN
244 144 : ALLOCATE (rho_core)
245 144 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
246 144 : CALL auxbas_pw_pool%create_pw(rho_core)
247 144 : CALL set_ks_env(ks_env, rho_core=rho_core)
248 : END IF
249 1170 : CALL get_qs_env(qs_env=qs_env, rho0_mpole=rho0_mpole)
250 1170 : CALL rho0_s_grid_create(new_pw_env, rho0_mpole)
251 8649 : 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 7649 : ELSE IF (dft_control%qs_control%dftb) THEN
259 670 : IF (dft_control%qs_control%dftb_control%do_ewald) THEN
260 : ! rebuild Ewald environment
261 558 : CALL get_qs_env(qs_env=qs_env, ewald_env=ewald_env, ewald_pw=ewald_pw)
262 558 : CALL ewald_pw_grid_update(ewald_pw, ewald_env, cell%hmat)
263 : END IF
264 6979 : ELSE IF (dft_control%qs_control%xtb .AND. &
265 : (.NOT. dft_control%qs_control%xtb_control%do_tblite)) THEN
266 1589 : IF (dft_control%qs_control%xtb_control%do_ewald) THEN
267 : ! rebuild Ewald environment
268 822 : CALL get_qs_env(qs_env=qs_env, ewald_env=ewald_env, ewald_pw=ewald_pw)
269 822 : CALL ewald_pw_grid_update(ewald_pw, ewald_env, cell%hmat)
270 : END IF
271 : ELSE
272 5390 : IF (ASSOCIATED(rho_core)) THEN
273 712 : CALL rho_core%release()
274 712 : DEALLOCATE (rho_core)
275 : END IF
276 5390 : ALLOCATE (rho_core)
277 5390 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
278 5390 : CALL auxbas_pw_pool%create_pw(rho_core)
279 5390 : CALL set_ks_env(ks_env, rho_core=rho_core)
280 : END IF
281 :
282 : ! reallocate vppl (realspace grid of local pseudopotential
283 9819 : IF (dft_control%qs_control%do_ppl_method == do_ppl_grid) THEN
284 8 : NULLIFY (vppl)
285 8 : CALL get_qs_env(qs_env, pw_env=new_pw_env, vppl=vppl)
286 8 : IF (ASSOCIATED(vppl)) THEN
287 0 : CALL vppl%release()
288 : ELSE
289 8 : ALLOCATE (vppl)
290 : END IF
291 8 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
292 8 : CALL auxbas_pw_pool%create_pw(vppl)
293 8 : CALL set_ks_env(ks_env, vppl=vppl)
294 : END IF
295 :
296 : ! reallocate rho_nlcc
297 9819 : CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
298 9819 : nlcc = has_nlcc(qs_kind_set)
299 9819 : IF (nlcc) THEN
300 : ! the realspace version
301 18 : NULLIFY (rho_nlcc)
302 18 : CALL get_qs_env(qs_env, pw_env=new_pw_env, rho_nlcc=rho_nlcc)
303 18 : IF (ASSOCIATED(rho_nlcc)) THEN
304 0 : CALL rho_nlcc%release()
305 : ELSE
306 18 : ALLOCATE (rho_nlcc)
307 : END IF
308 18 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
309 18 : CALL auxbas_pw_pool%create_pw(rho_nlcc)
310 18 : CALL set_ks_env(ks_env, rho_nlcc=rho_nlcc)
311 : ! the g-space version
312 18 : NULLIFY (rho_nlcc_g)
313 18 : CALL get_qs_env(qs_env, pw_env=new_pw_env, rho_nlcc_g=rho_nlcc_g)
314 18 : IF (ASSOCIATED(rho_nlcc_g)) THEN
315 0 : CALL rho_nlcc_g%release()
316 : ELSE
317 18 : ALLOCATE (rho_nlcc_g)
318 : END IF
319 18 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
320 18 : CALL auxbas_pw_pool%create_pw(rho_nlcc_g)
321 18 : CALL set_ks_env(ks_env, rho_nlcc_g=rho_nlcc_g)
322 : END IF
323 :
324 : ! reallocate xcint_weights
325 9819 : IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
326 1362 : IF (dft_control%qs_control%gapw_control%accurate_xcint) THEN
327 336 : CALL set_ks_env(ks_env, exc_accint=.TRUE.)
328 336 : NULLIFY (xcint_weights)
329 336 : CALL get_qs_env(qs_env, pw_env=new_pw_env, xcint_weights=xcint_weights)
330 336 : IF (ASSOCIATED(xcint_weights)) THEN
331 94 : CALL xcint_weights%release()
332 : ELSE
333 242 : ALLOCATE (xcint_weights)
334 : END IF
335 336 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
336 336 : CALL auxbas_pw_pool%create_pw(xcint_weights)
337 336 : CALL set_ks_env(ks_env, xcint_weights=xcint_weights)
338 : END IF
339 : END IF
340 :
341 : ! reallocate vee: external electrostatic potential
342 9819 : IF (dft_control%apply_external_potential .AND. .NOT. qs_env%mimic) THEN
343 16 : NULLIFY (vee)
344 16 : CALL get_qs_env(qs_env, pw_env=new_pw_env, vee=vee)
345 16 : IF (ASSOCIATED(vee)) THEN
346 0 : CALL vee%release()
347 0 : DEALLOCATE (vee)
348 : END IF
349 16 : ALLOCATE (vee)
350 16 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
351 16 : CALL auxbas_pw_pool%create_pw(vee)
352 16 : CALL set_ks_env(ks_env, vee=vee)
353 16 : dft_control%eval_external_potential = .TRUE.
354 : END IF
355 :
356 : ! ZMP Reallocate external_vxc: external vxc potential
357 9819 : IF (dft_control%apply_external_vxc) THEN
358 0 : NULLIFY (external_vxc)
359 0 : CALL get_qs_env(qs_env, pw_env=new_pw_env, external_vxc=external_vxc)
360 0 : IF (ASSOCIATED(external_vxc)) THEN
361 0 : CALL external_vxc%release()
362 : ELSE
363 0 : ALLOCATE (external_vxc)
364 : END IF
365 0 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
366 0 : CALL auxbas_pw_pool%create_pw(external_vxc)
367 0 : CALL set_qs_env(qs_env, external_vxc=external_vxc)
368 0 : dft_control%read_external_vxc = .TRUE.
369 : END IF
370 :
371 : ! Embedding Reallocate: embed_pot
372 9819 : IF (dft_control%apply_embed_pot) THEN
373 0 : NULLIFY (embed_pot)
374 0 : CALL get_qs_env(qs_env, pw_env=new_pw_env, embed_pot=embed_pot)
375 0 : IF (ASSOCIATED(embed_pot)) THEN
376 0 : CALL embed_pot%release()
377 : ELSE
378 0 : ALLOCATE (embed_pot)
379 : END IF
380 0 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
381 0 : CALL auxbas_pw_pool%create_pw(embed_pot)
382 0 : CALL set_qs_env(qs_env, embed_pot=embed_pot)
383 :
384 0 : NULLIFY (spin_embed_pot)
385 0 : CALL get_qs_env(qs_env, pw_env=new_pw_env, spin_embed_pot=spin_embed_pot)
386 0 : IF (ASSOCIATED(spin_embed_pot)) THEN
387 0 : CALL spin_embed_pot%release()
388 0 : DEALLOCATE (spin_embed_pot)
389 : ELSE
390 0 : ALLOCATE (spin_embed_pot)
391 : END IF
392 0 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
393 0 : CALL auxbas_pw_pool%create_pw(spin_embed_pot)
394 0 : CALL set_qs_env(qs_env, spin_embed_pot=spin_embed_pot)
395 : END IF
396 :
397 9819 : CALL get_ks_env(ks_env, v_hartree_rspace=v_hartree_rspace)
398 9819 : IF (ASSOCIATED(v_hartree_rspace)) THEN
399 1848 : CALL v_hartree_rspace%release()
400 1848 : DEALLOCATE (v_hartree_rspace)
401 : END IF
402 9819 : CALL get_qs_env(qs_env, pw_env=new_pw_env)
403 9819 : CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool)
404 9819 : ALLOCATE (v_hartree_rspace)
405 9819 : CALL auxbas_pw_pool%create_pw(v_hartree_rspace)
406 9819 : CALL set_ks_env(ks_env, v_hartree_rspace=v_hartree_rspace)
407 : END IF
408 :
409 : !update the time in the poisson environment, to update time dependant constraints
410 44155 : new_pw_env%poisson_env%parameters%dbc_params%time = qs_env%sim_time
411 :
412 44155 : CALL timestop(handle)
413 :
414 44155 : END SUBROUTINE qs_env_rebuild_pw_env
415 :
416 : ! **************************************************************************************************
417 : !> \brief ...
418 : !> \param qs_env ...
419 : !> \param time ...
420 : !> \param itimes ...
421 : ! **************************************************************************************************
422 3878 : SUBROUTINE qs_env_time_update(qs_env, time, itimes)
423 : TYPE(qs_environment_type), POINTER :: qs_env
424 : REAL(KIND=dp), INTENT(IN) :: time
425 : INTEGER, INTENT(IN) :: itimes
426 :
427 : TYPE(dft_control_type), POINTER :: dft_control
428 :
429 3878 : qs_env%sim_time = time
430 3878 : qs_env%sim_step = itimes
431 :
432 3878 : CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
433 :
434 3878 : IF (dft_control%apply_external_potential) THEN
435 36 : IF (.NOT. dft_control%expot_control%static) THEN
436 0 : dft_control%eval_external_potential = .TRUE.
437 : END IF
438 : END IF
439 :
440 3878 : END SUBROUTINE qs_env_time_update
441 :
442 : END MODULE qs_environment_methods
|
