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