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 qs_tddfpt2_subgroups
9 : USE admm_types, ONLY: admm_type,&
10 : get_admm_env
11 : USE atomic_kind_types, ONLY: atomic_kind_type
12 : USE basis_set_types, ONLY: get_gto_basis_set,&
13 : gto_basis_set_type
14 : USE cell_types, ONLY: cell_type
15 : USE cp_blacs_env, ONLY: cp_blacs_env_create,&
16 : cp_blacs_env_release,&
17 : cp_blacs_env_type
18 : USE cp_control_types, ONLY: dft_control_type,&
19 : qs_control_type,&
20 : tddfpt2_control_type
21 : USE cp_dbcsr_api, ONLY: dbcsr_create,&
22 : dbcsr_distribution_release,&
23 : dbcsr_distribution_type,&
24 : dbcsr_get_info,&
25 : dbcsr_release,&
26 : dbcsr_type
27 : USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
28 : USE cp_dbcsr_operations, ONLY: cp_dbcsr_dist2d_to_dist
29 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
30 : cp_fm_struct_release,&
31 : cp_fm_struct_type
32 : USE cp_fm_types, ONLY: cp_fm_copy_general,&
33 : cp_fm_create,&
34 : cp_fm_get_info,&
35 : cp_fm_release,&
36 : cp_fm_type
37 : USE distribution_1d_types, ONLY: distribution_1d_type
38 : USE distribution_2d_types, ONLY: distribution_2d_release,&
39 : distribution_2d_type
40 : USE distribution_methods, ONLY: distribute_molecules_2d
41 : USE hartree_local_methods, ONLY: init_coulomb_local
42 : USE hartree_local_types, ONLY: hartree_local_create,&
43 : hartree_local_release,&
44 : hartree_local_type
45 : USE input_constants, ONLY: tddfpt_kernel_full,&
46 : tddfpt_kernel_none,&
47 : tddfpt_kernel_stda
48 : USE input_section_types, ONLY: section_vals_type,&
49 : section_vals_val_get
50 : USE kinds, ONLY: default_string_length,&
51 : dp
52 : USE message_passing, ONLY: mp_para_env_release,&
53 : mp_para_env_type
54 : USE molecule_kind_types, ONLY: molecule_kind_type
55 : USE molecule_types, ONLY: molecule_type
56 : USE particle_types, ONLY: particle_type
57 : USE pw_env_methods, ONLY: pw_env_create,&
58 : pw_env_rebuild
59 : USE pw_env_types, ONLY: pw_env_release,&
60 : pw_env_retain,&
61 : pw_env_type
62 : USE qs_environment_types, ONLY: get_qs_env,&
63 : qs_environment_type
64 : USE qs_kind_types, ONLY: get_qs_kind,&
65 : qs_kind_type
66 : USE qs_ks_types, ONLY: qs_ks_env_type
67 : USE qs_local_rho_types, ONLY: local_rho_set_create,&
68 : local_rho_set_release,&
69 : local_rho_type
70 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type,&
71 : release_neighbor_list_sets
72 : USE qs_neighbor_lists, ONLY: atom2d_build,&
73 : atom2d_cleanup,&
74 : build_neighbor_lists,&
75 : local_atoms_type,&
76 : pair_radius_setup
77 : USE qs_rho0_ggrid, ONLY: rho0_s_grid_create
78 : USE qs_rho0_methods, ONLY: init_rho0
79 : USE qs_rho_atom_methods, ONLY: allocate_rho_atom_internals
80 : USE task_list_methods, ONLY: generate_qs_task_list
81 : USE task_list_types, ONLY: allocate_task_list,&
82 : deallocate_task_list,&
83 : task_list_type
84 : #include "./base/base_uses.f90"
85 :
86 : IMPLICIT NONE
87 :
88 : PRIVATE
89 :
90 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_subgroups'
91 : LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .TRUE.
92 :
93 : PUBLIC :: tddfpt_subgroup_env_type
94 : PUBLIC :: tddfpt_sub_env_init, tddfpt_sub_env_release
95 : PUBLIC :: tddfpt_dbcsr_create_by_dist, tddfpt_fm_replicate_across_subgroups
96 :
97 : ! **************************************************************************************************
98 : !> \brief Parallel (sub)group environment.
99 : !> \par History
100 : !> * 01.2017 created [Sergey Chulkov]
101 : ! **************************************************************************************************
102 : TYPE tddfpt_subgroup_env_type
103 : !> indicates that the global MPI communicator has been split into subgroups; if it is .FALSE.
104 : !> certain components of the structure (blacs_env, para_env, admm_A, and mos_occ)
105 : !> can still be accessed; in this case they simply point to the corresponding global variables
106 : LOGICAL :: is_split = .FALSE.
107 : !> number of parallel groups
108 : INTEGER :: ngroups = -1
109 : !> group_distribution(0:ngroups-1) : a process with rank 'i' belongs to the parallel group
110 : !> with index 'group_distribution(i)'
111 : INTEGER, DIMENSION(:), ALLOCATABLE :: group_distribution
112 : !> group-specific BLACS parallel environment
113 : TYPE(cp_blacs_env_type), POINTER :: blacs_env => NULL()
114 : !> group-specific MPI parallel environment
115 : TYPE(mp_para_env_type), POINTER :: para_env => NULL()
116 : !> occupied MOs stored in a matrix form [nao x nmo_occ(spin)] distributed across processes
117 : !> in the parallel group
118 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: mos_occ
119 : !> group-specific copy of the ADMM A matrix 'admm_type%A'
120 : TYPE(cp_fm_type), POINTER :: admm_A => NULL()
121 : !
122 : !> indicates that a set of multi-grids has been allocated; if it is .FALSE. all the components
123 : !> below point to the corresponding global variables and can be accessed
124 : LOGICAL :: is_mgrid = .FALSE.
125 : !> group-specific DBCSR distribution
126 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist => NULL()
127 : !> group-specific two-dimensional distribution of pairs of particles
128 : TYPE(distribution_2d_type), POINTER :: dist_2d => NULL()
129 : !> group-specific plane wave environment
130 : TYPE(pw_env_type), POINTER :: pw_env => NULL()
131 : !> lists of neighbours in auxiliary and primary basis sets
132 : TYPE(neighbor_list_set_p_type), &
133 : DIMENSION(:), POINTER :: sab_aux_fit => NULL(), sab_orb => NULL()
134 : !> task lists in auxiliary and primary basis sets
135 : TYPE(task_list_type), POINTER :: task_list_aux_fit => NULL(), task_list_orb => NULL()
136 : !> soft task lists in auxiliary and primary basis sets
137 : TYPE(task_list_type), POINTER :: task_list_aux_fit_soft => NULL(), task_list_orb_soft => NULL()
138 : !> GAPW local atomic grids
139 : TYPE(hartree_local_type), POINTER :: hartree_local => NULL()
140 : TYPE(local_rho_type), POINTER :: local_rho_set => NULL()
141 : TYPE(local_rho_type), POINTER :: local_rho_set_admm => NULL()
142 : END TYPE tddfpt_subgroup_env_type
143 :
144 : ! **************************************************************************************************
145 : !> \brief Structure to save global multi-grid related parameters.
146 : !> \par History
147 : !> * 09.2016 created [Sergey Chulkov]
148 : !> * 01.2017 moved from qs_tddfpt2_methods [Sergey Chulkov]
149 : ! **************************************************************************************************
150 : TYPE mgrid_saved_parameters
151 : !> create commensurate grids
152 : LOGICAL :: commensurate_mgrids = .FALSE.
153 : !> create real-space grids
154 : LOGICAL :: realspace_mgrids = .FALSE.
155 : !> do not perform load balancing
156 : LOGICAL :: skip_load_balance = .FALSE.
157 : !> cutoff value at the finest grid level
158 : REAL(KIND=dp) :: cutoff = 0.0_dp
159 : !> inverse scale factor
160 : REAL(KIND=dp) :: progression_factor = 0.0_dp
161 : !> relative cutoff
162 : REAL(KIND=dp) :: relative_cutoff = 0.0_dp
163 : !> list of explicitly given cutoff values
164 : REAL(KIND=dp), DIMENSION(:), POINTER :: e_cutoff => NULL()
165 : END TYPE mgrid_saved_parameters
166 :
167 : CONTAINS
168 :
169 : ! **************************************************************************************************
170 : !> \brief Split MPI communicator to create a set of parallel (sub)groups.
171 : !> \param sub_env parallel group environment (initialised on exit)
172 : !> \param qs_env Quickstep environment
173 : !> \param mos_occ ground state molecular orbitals in primary atomic basis set
174 : !> \param kernel Type of kernel (full/sTDA) that will be used
175 : !> \par History
176 : !> * 01.2017 (sub)group-related code has been moved here from the main subroutine tddfpt()
177 : !> [Sergey Chulkov]
178 : ! **************************************************************************************************
179 2152 : SUBROUTINE tddfpt_sub_env_init(sub_env, qs_env, mos_occ, kernel)
180 : TYPE(tddfpt_subgroup_env_type), INTENT(out) :: sub_env
181 : TYPE(qs_environment_type), POINTER :: qs_env
182 : TYPE(cp_fm_type), DIMENSION(:), INTENT(in) :: mos_occ
183 : INTEGER, INTENT(in) :: kernel
184 :
185 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_sub_env_init'
186 :
187 : INTEGER :: handle, ispin, nao, nao_aux, natom, &
188 : nmo_occ, nspins
189 : TYPE(admm_type), POINTER :: admm_env
190 1076 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
191 : TYPE(cp_blacs_env_type), POINTER :: blacs_env_global
192 : TYPE(cp_fm_struct_type), POINTER :: fm_struct
193 : TYPE(dft_control_type), POINTER :: dft_control
194 : TYPE(mgrid_saved_parameters) :: mgrid_saved
195 : TYPE(mp_para_env_type), POINTER :: para_env_global
196 : TYPE(pw_env_type), POINTER :: pw_env_global
197 : TYPE(qs_control_type), POINTER :: qs_control
198 1076 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
199 : TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
200 :
201 1076 : CALL timeset(routineN, handle)
202 :
203 1076 : nspins = SIZE(mos_occ)
204 :
205 : CALL get_qs_env(qs_env, blacs_env=blacs_env_global, dft_control=dft_control, &
206 1076 : para_env=para_env_global, pw_env=pw_env_global)
207 :
208 1076 : tddfpt_control => dft_control%tddfpt2_control
209 1076 : qs_control => dft_control%qs_control
210 :
211 : ! ++ split mpi communicator if
212 : ! a) the requested number of processors per group > 0
213 : ! (means that the split has been requested explicitly), and
214 : ! b) the number of subgroups is >= 2
215 1076 : sub_env%is_split = tddfpt_control%nprocs > 0 .AND. tddfpt_control%nprocs*2 <= para_env_global%num_pe
216 :
217 4428 : ALLOCATE (sub_env%mos_occ(nspins))
218 1076 : NULLIFY (sub_env%admm_A)
219 :
220 1076 : IF (sub_env%is_split) THEN
221 6 : ALLOCATE (sub_env%group_distribution(0:para_env_global%num_pe - 1))
222 :
223 2 : ALLOCATE (sub_env%para_env)
224 : CALL sub_env%para_env%from_split(comm=para_env_global, ngroups=sub_env%ngroups, &
225 2 : group_distribution=sub_env%group_distribution, subgroup_min_size=tddfpt_control%nprocs)
226 :
227 : ! ++ create a new parallel environment based on the given sub-communicator)
228 2 : NULLIFY (sub_env%blacs_env)
229 :
230 : ! use the default (SQUARE) BLACS grid layout and non-repeatable BLACS collective operations
231 : ! by omitting optional parameters 'blacs_grid_layout' and 'blacs_repeatable'.
232 : ! Ideally we should take these parameters from the variables globenv%blacs_grid_layout and
233 : ! globenv%blacs_repeatable, however the global environment is not available
234 : ! from the subroutine 'qs_energies_properties'.
235 2 : CALL cp_blacs_env_create(sub_env%blacs_env, sub_env%para_env)
236 :
237 2 : NULLIFY (fm_struct)
238 :
239 4 : DO ispin = 1, nspins
240 2 : CALL cp_fm_get_info(mos_occ(ispin), nrow_global=nao, ncol_global=nmo_occ)
241 2 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nmo_occ, context=sub_env%blacs_env)
242 2 : CALL cp_fm_create(sub_env%mos_occ(ispin), fm_struct)
243 2 : CALL cp_fm_struct_release(fm_struct)
244 : CALL tddfpt_fm_replicate_across_subgroups(fm_src=mos_occ(ispin), &
245 6 : fm_dest_sub=sub_env%mos_occ(ispin), sub_env=sub_env)
246 : END DO
247 :
248 2 : IF (dft_control%do_admm) THEN
249 2 : CALL get_qs_env(qs_env, admm_env=admm_env)
250 2 : CALL cp_fm_get_info(admm_env%A, nrow_global=nao_aux, ncol_global=nao)
251 2 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao_aux, ncol_global=nao, context=sub_env%blacs_env)
252 2 : ALLOCATE (sub_env%admm_A)
253 2 : CALL cp_fm_create(sub_env%admm_A, fm_struct)
254 2 : CALL cp_fm_struct_release(fm_struct)
255 2 : CALL tddfpt_fm_replicate_across_subgroups(fm_src=admm_env%A, fm_dest_sub=sub_env%admm_A, sub_env=sub_env)
256 : END IF
257 : ELSE
258 1074 : CALL para_env_global%retain()
259 1074 : sub_env%para_env => para_env_global
260 :
261 1074 : CALL blacs_env_global%retain()
262 1074 : sub_env%blacs_env => blacs_env_global
263 :
264 2272 : sub_env%mos_occ(:) = mos_occ(:)
265 :
266 1074 : IF (dft_control%do_admm) THEN
267 190 : CALL get_qs_env(qs_env, admm_env=admm_env)
268 190 : sub_env%admm_A => admm_env%A
269 : END IF
270 : END IF
271 :
272 1076 : IF (kernel == tddfpt_kernel_full) THEN
273 : ! ++ allocate a new plane wave environment
274 580 : sub_env%is_mgrid = sub_env%is_split .OR. tddfpt_control%mgrid_is_explicit
275 :
276 580 : NULLIFY (sub_env%dbcsr_dist, sub_env%dist_2d)
277 580 : NULLIFY (sub_env%sab_orb, sub_env%sab_aux_fit)
278 580 : NULLIFY (sub_env%task_list_orb, sub_env%task_list_aux_fit)
279 580 : NULLIFY (sub_env%task_list_orb_soft, sub_env%task_list_aux_fit_soft)
280 :
281 580 : IF (sub_env%is_mgrid) THEN
282 12 : IF (tddfpt_control%mgrid_is_explicit) &
283 10 : CALL init_tddfpt_mgrid(qs_control, tddfpt_control, mgrid_saved)
284 :
285 12 : NULLIFY (sub_env%pw_env)
286 :
287 12 : CALL pw_env_create(sub_env%pw_env)
288 12 : CALL pw_env_rebuild(sub_env%pw_env, qs_env, sub_env%para_env)
289 :
290 : CALL tddfpt_build_distribution_2d(distribution_2d=sub_env%dist_2d, dbcsr_dist=sub_env%dbcsr_dist, &
291 12 : blacs_env=sub_env%blacs_env, qs_env=qs_env)
292 :
293 : CALL tddfpt_build_tasklist(task_list=sub_env%task_list_orb, sab=sub_env%sab_orb, basis_type="ORB", &
294 : distribution_2d=sub_env%dist_2d, pw_env=sub_env%pw_env, qs_env=qs_env, &
295 : skip_load_balance=qs_control%skip_load_balance_distributed, &
296 12 : reorder_grid_ranks=.TRUE.)
297 :
298 12 : IF (qs_control%gapw .OR. qs_control%gapw_xc) THEN
299 : CALL tddfpt_build_tasklist(task_list=sub_env%task_list_orb_soft, sab=sub_env%sab_orb, basis_type="ORB_SOFT", &
300 : distribution_2d=sub_env%dist_2d, pw_env=sub_env%pw_env, qs_env=qs_env, &
301 : skip_load_balance=qs_control%skip_load_balance_distributed, &
302 8 : reorder_grid_ranks=.TRUE.)
303 : END IF
304 :
305 12 : IF (dft_control%do_admm) THEN
306 : CALL tddfpt_build_tasklist(task_list=sub_env%task_list_aux_fit, sab=sub_env%sab_aux_fit, &
307 : basis_type="AUX_FIT", distribution_2d=sub_env%dist_2d, &
308 : pw_env=sub_env%pw_env, qs_env=qs_env, &
309 : skip_load_balance=qs_control%skip_load_balance_distributed, &
310 8 : reorder_grid_ranks=.FALSE.)
311 8 : IF (qs_control%gapw .OR. qs_control%gapw_xc) THEN
312 : CALL tddfpt_build_tasklist(task_list=sub_env%task_list_aux_fit_soft, sab=sub_env%sab_aux_fit, &
313 : basis_type="AUX_FIT_SOFT", distribution_2d=sub_env%dist_2d, &
314 : pw_env=sub_env%pw_env, qs_env=qs_env, &
315 : skip_load_balance=qs_control%skip_load_balance_distributed, &
316 4 : reorder_grid_ranks=.FALSE.)
317 : END IF
318 : END IF
319 :
320 12 : IF (tddfpt_control%mgrid_is_explicit) &
321 10 : CALL restore_qs_mgrid(qs_control, mgrid_saved)
322 : ELSE
323 568 : CALL pw_env_retain(pw_env_global)
324 568 : sub_env%pw_env => pw_env_global
325 :
326 : CALL get_qs_env(qs_env, dbcsr_dist=sub_env%dbcsr_dist, &
327 568 : sab_orb=sub_env%sab_orb, task_list=sub_env%task_list_orb)
328 568 : IF (dft_control%do_admm) THEN
329 : CALL get_admm_env(admm_env, sab_aux_fit=sub_env%sab_aux_fit, &
330 168 : task_list_aux_fit=sub_env%task_list_aux_fit)
331 168 : IF (qs_control%gapw .OR. qs_control%gapw_xc) THEN
332 38 : sub_env%task_list_aux_fit_soft => admm_env%admm_gapw_env%task_list
333 : END IF
334 : END IF
335 568 : IF (qs_control%gapw .OR. qs_control%gapw_xc) THEN
336 194 : CALL get_qs_env(qs_env, task_list_soft=sub_env%task_list_orb_soft)
337 : END IF
338 : END IF
339 :
340 : ! GAPW initializations
341 580 : IF (dft_control%qs_control%gapw) THEN
342 : CALL get_qs_env(qs_env, &
343 : atomic_kind_set=atomic_kind_set, &
344 : natom=natom, &
345 166 : qs_kind_set=qs_kind_set)
346 :
347 166 : CALL local_rho_set_create(sub_env%local_rho_set)
348 : CALL allocate_rho_atom_internals(sub_env%local_rho_set%rho_atom_set, atomic_kind_set, &
349 166 : qs_kind_set, dft_control, sub_env%para_env)
350 :
351 : CALL init_rho0(sub_env%local_rho_set, qs_env, dft_control%qs_control%gapw_control, &
352 166 : zcore=0.0_dp)
353 166 : CALL rho0_s_grid_create(sub_env%pw_env, sub_env%local_rho_set%rho0_mpole)
354 166 : CALL hartree_local_create(sub_env%hartree_local)
355 166 : CALL init_coulomb_local(sub_env%hartree_local, natom)
356 414 : ELSEIF (dft_control%qs_control%gapw_xc) THEN
357 : CALL get_qs_env(qs_env, &
358 : atomic_kind_set=atomic_kind_set, &
359 36 : qs_kind_set=qs_kind_set)
360 36 : CALL local_rho_set_create(sub_env%local_rho_set)
361 : CALL allocate_rho_atom_internals(sub_env%local_rho_set%rho_atom_set, atomic_kind_set, &
362 36 : qs_kind_set, dft_control, sub_env%para_env)
363 : END IF
364 :
365 : ! ADMM/GAPW
366 580 : IF (dft_control%do_admm) THEN
367 176 : IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
368 42 : CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set)
369 42 : CALL local_rho_set_create(sub_env%local_rho_set_admm)
370 : CALL allocate_rho_atom_internals(sub_env%local_rho_set_admm%rho_atom_set, atomic_kind_set, &
371 : admm_env%admm_gapw_env%admm_kind_set, &
372 42 : dft_control, sub_env%para_env)
373 : END IF
374 : END IF
375 :
376 496 : ELSE IF (kernel == tddfpt_kernel_stda) THEN
377 402 : sub_env%is_mgrid = .FALSE.
378 402 : NULLIFY (sub_env%dbcsr_dist, sub_env%dist_2d)
379 402 : NULLIFY (sub_env%sab_orb, sub_env%sab_aux_fit)
380 402 : NULLIFY (sub_env%task_list_orb, sub_env%task_list_orb_soft)
381 402 : NULLIFY (sub_env%task_list_aux_fit, sub_env%task_list_aux_fit_soft)
382 402 : NULLIFY (sub_env%pw_env)
383 402 : IF (sub_env%is_split) THEN
384 0 : CPABORT('Subsys option not available')
385 : ELSE
386 402 : CALL get_qs_env(qs_env, dbcsr_dist=sub_env%dbcsr_dist, sab_orb=sub_env%sab_orb)
387 : END IF
388 94 : ELSE IF (kernel == tddfpt_kernel_none) THEN
389 94 : sub_env%is_mgrid = .FALSE.
390 94 : NULLIFY (sub_env%dbcsr_dist, sub_env%dist_2d)
391 94 : NULLIFY (sub_env%sab_orb, sub_env%sab_aux_fit)
392 94 : NULLIFY (sub_env%task_list_orb, sub_env%task_list_orb_soft)
393 94 : NULLIFY (sub_env%task_list_aux_fit, sub_env%task_list_aux_fit_soft)
394 94 : NULLIFY (sub_env%pw_env)
395 94 : IF (sub_env%is_split) THEN
396 0 : CPABORT('Subsys option not available')
397 : ELSE
398 94 : CALL get_qs_env(qs_env, dbcsr_dist=sub_env%dbcsr_dist, sab_orb=sub_env%sab_orb)
399 : END IF
400 : ELSE
401 0 : CPABORT("Unknown kernel type")
402 : END IF
403 :
404 1076 : CALL timestop(handle)
405 :
406 2152 : END SUBROUTINE tddfpt_sub_env_init
407 :
408 : ! **************************************************************************************************
409 : !> \brief Release parallel group environment
410 : !> \param sub_env parallel group environment (modified on exit)
411 : !> \par History
412 : !> * 01.2017 created [Sergey Chulkov]
413 : ! **************************************************************************************************
414 1076 : SUBROUTINE tddfpt_sub_env_release(sub_env)
415 : TYPE(tddfpt_subgroup_env_type), INTENT(inout) :: sub_env
416 :
417 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_sub_env_release'
418 :
419 : INTEGER :: handle, i
420 :
421 1076 : CALL timeset(routineN, handle)
422 :
423 1076 : IF (sub_env%is_mgrid) THEN
424 12 : IF (ASSOCIATED(sub_env%task_list_aux_fit)) &
425 8 : CALL deallocate_task_list(sub_env%task_list_aux_fit)
426 :
427 12 : IF (ASSOCIATED(sub_env%task_list_aux_fit_soft)) &
428 4 : CALL deallocate_task_list(sub_env%task_list_aux_fit_soft)
429 :
430 12 : IF (ASSOCIATED(sub_env%task_list_orb)) &
431 12 : CALL deallocate_task_list(sub_env%task_list_orb)
432 :
433 12 : IF (ASSOCIATED(sub_env%task_list_orb_soft)) &
434 8 : CALL deallocate_task_list(sub_env%task_list_orb_soft)
435 :
436 12 : CALL release_neighbor_list_sets(sub_env%sab_aux_fit)
437 12 : CALL release_neighbor_list_sets(sub_env%sab_orb)
438 :
439 12 : IF (ASSOCIATED(sub_env%dbcsr_dist)) THEN
440 12 : CALL dbcsr_distribution_release(sub_env%dbcsr_dist)
441 12 : DEALLOCATE (sub_env%dbcsr_dist)
442 : END IF
443 :
444 12 : IF (ASSOCIATED(sub_env%dist_2d)) &
445 12 : CALL distribution_2d_release(sub_env%dist_2d)
446 : END IF
447 :
448 : ! GAPW
449 1076 : IF (ASSOCIATED(sub_env%local_rho_set)) THEN
450 202 : CALL local_rho_set_release(sub_env%local_rho_set)
451 : END IF
452 1076 : IF (ASSOCIATED(sub_env%hartree_local)) THEN
453 166 : CALL hartree_local_release(sub_env%hartree_local)
454 : END IF
455 1076 : IF (ASSOCIATED(sub_env%local_rho_set_admm)) THEN
456 42 : CALL local_rho_set_release(sub_env%local_rho_set_admm)
457 : END IF
458 :
459 : ! if TDDFPT-specific plane-wave environment has not been requested,
460 : ! the pointers sub_env%dbcsr_dist, sub_env%sab_*, and sub_env%task_list_*
461 : ! point to the corresponding ground-state variables from qs_env
462 : ! and should not be deallocated
463 :
464 1076 : CALL pw_env_release(sub_env%pw_env)
465 :
466 1076 : sub_env%is_mgrid = .FALSE.
467 :
468 1076 : IF (sub_env%is_split .AND. ASSOCIATED(sub_env%admm_A)) THEN
469 2 : CALL cp_fm_release(sub_env%admm_A)
470 2 : DEALLOCATE (sub_env%admm_A)
471 : NULLIFY (sub_env%admm_A)
472 : END IF
473 :
474 1076 : IF (sub_env%is_split) THEN
475 4 : DO i = SIZE(sub_env%mos_occ), 1, -1
476 4 : CALL cp_fm_release(sub_env%mos_occ(i))
477 : END DO
478 : END IF
479 1076 : DEALLOCATE (sub_env%mos_occ)
480 :
481 1076 : CALL cp_blacs_env_release(sub_env%blacs_env)
482 1076 : CALL mp_para_env_release(sub_env%para_env)
483 :
484 1076 : IF (ALLOCATED(sub_env%group_distribution)) &
485 2 : DEALLOCATE (sub_env%group_distribution)
486 :
487 1076 : sub_env%is_split = .FALSE.
488 :
489 1076 : CALL timestop(handle)
490 :
491 1076 : END SUBROUTINE tddfpt_sub_env_release
492 :
493 : ! **************************************************************************************************
494 : !> \brief Replace the global multi-grid related parameters in qs_control by the ones given in the
495 : !> TDDFPT/MGRID subsection. The original parameters are stored into the 'mgrid_saved'
496 : !> variable.
497 : !> \param qs_control Quickstep control parameters (modified on exit)
498 : !> \param tddfpt_control TDDFPT control parameters
499 : !> \param mgrid_saved structure to hold global MGRID-related parameters (initialised on exit)
500 : !> \par History
501 : !> * 09.2016 created [Sergey Chulkov]
502 : !> * 01.2017 moved from qs_tddfpt2_methods [Sergey Chulkov]
503 : !> \note the code to build the 'e_cutoff' list was taken from the subroutine read_mgrid_section()
504 : ! **************************************************************************************************
505 10 : SUBROUTINE init_tddfpt_mgrid(qs_control, tddfpt_control, mgrid_saved)
506 : TYPE(qs_control_type), POINTER :: qs_control
507 : TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
508 : TYPE(mgrid_saved_parameters), INTENT(out) :: mgrid_saved
509 :
510 : CHARACTER(LEN=*), PARAMETER :: routineN = 'init_tddfpt_mgrid'
511 :
512 : INTEGER :: handle, igrid, ngrids
513 :
514 10 : CALL timeset(routineN, handle)
515 :
516 : ! ++ save global plane-wave grid parameters to the variable 'mgrid_saved'
517 10 : mgrid_saved%commensurate_mgrids = qs_control%commensurate_mgrids
518 10 : mgrid_saved%realspace_mgrids = qs_control%realspace_mgrids
519 10 : mgrid_saved%skip_load_balance = qs_control%skip_load_balance_distributed
520 10 : mgrid_saved%cutoff = qs_control%cutoff
521 10 : mgrid_saved%progression_factor = qs_control%progression_factor
522 10 : mgrid_saved%relative_cutoff = qs_control%relative_cutoff
523 10 : mgrid_saved%e_cutoff => qs_control%e_cutoff
524 :
525 : ! ++ set parameters from 'tddfpt_control' as default ones for all newly allocated plane-wave grids
526 10 : qs_control%commensurate_mgrids = tddfpt_control%mgrid_commensurate_mgrids
527 10 : qs_control%realspace_mgrids = tddfpt_control%mgrid_realspace_mgrids
528 10 : qs_control%skip_load_balance_distributed = tddfpt_control%mgrid_skip_load_balance
529 10 : qs_control%cutoff = tddfpt_control%mgrid_cutoff
530 10 : qs_control%progression_factor = tddfpt_control%mgrid_progression_factor
531 10 : qs_control%relative_cutoff = tddfpt_control%mgrid_relative_cutoff
532 :
533 30 : ALLOCATE (qs_control%e_cutoff(tddfpt_control%mgrid_ngrids))
534 10 : ngrids = tddfpt_control%mgrid_ngrids
535 10 : IF (ASSOCIATED(tddfpt_control%mgrid_e_cutoff)) THEN
536 : ! following read_mgrid_section() there is a magic scale factor there (0.5_dp)
537 0 : DO igrid = 1, ngrids
538 0 : qs_control%e_cutoff(igrid) = tddfpt_control%mgrid_e_cutoff(igrid)*0.5_dp
539 : END DO
540 : ! ++ round 'qs_control%cutoff' upward to the nearest sub-grid's cutoff value;
541 : ! here we take advantage of the fact that the array 'e_cutoff' has been sorted in descending order
542 0 : DO igrid = ngrids, 1, -1
543 0 : IF (qs_control%cutoff <= qs_control%e_cutoff(igrid)) THEN
544 0 : qs_control%cutoff = qs_control%e_cutoff(igrid)
545 0 : EXIT
546 : END IF
547 : END DO
548 : ! igrid == 0 if qs_control%cutoff is larger than the largest manually provided cutoff value;
549 : ! use the largest actual value
550 0 : IF (igrid <= 0) &
551 0 : qs_control%cutoff = qs_control%e_cutoff(1)
552 : ELSE
553 10 : qs_control%e_cutoff(1) = qs_control%cutoff
554 44 : DO igrid = 2, ngrids
555 44 : qs_control%e_cutoff(igrid) = qs_control%e_cutoff(igrid - 1)/qs_control%progression_factor
556 : END DO
557 : END IF
558 :
559 10 : CALL timestop(handle)
560 10 : END SUBROUTINE init_tddfpt_mgrid
561 :
562 : ! **************************************************************************************************
563 : !> \brief Restore the global multi-grid related parameters stored in the 'mgrid_saved' variable.
564 : !> \param qs_control Quickstep control parameters (modified on exit)
565 : !> \param mgrid_saved structure that holds global MGRID-related parameters
566 : !> \par History
567 : !> * 09.2016 created [Sergey Chulkov]
568 : ! **************************************************************************************************
569 10 : SUBROUTINE restore_qs_mgrid(qs_control, mgrid_saved)
570 : TYPE(qs_control_type), POINTER :: qs_control
571 : TYPE(mgrid_saved_parameters), INTENT(in) :: mgrid_saved
572 :
573 : CHARACTER(LEN=*), PARAMETER :: routineN = 'restore_qs_mgrid'
574 :
575 : INTEGER :: handle
576 :
577 10 : CALL timeset(routineN, handle)
578 :
579 10 : IF (ASSOCIATED(qs_control%e_cutoff)) &
580 10 : DEALLOCATE (qs_control%e_cutoff)
581 :
582 10 : qs_control%commensurate_mgrids = mgrid_saved%commensurate_mgrids
583 10 : qs_control%realspace_mgrids = mgrid_saved%realspace_mgrids
584 10 : qs_control%skip_load_balance_distributed = mgrid_saved%skip_load_balance
585 10 : qs_control%cutoff = mgrid_saved%cutoff
586 10 : qs_control%progression_factor = mgrid_saved%progression_factor
587 10 : qs_control%relative_cutoff = mgrid_saved%relative_cutoff
588 10 : qs_control%e_cutoff => mgrid_saved%e_cutoff
589 :
590 10 : CALL timestop(handle)
591 10 : END SUBROUTINE restore_qs_mgrid
592 :
593 : ! **************************************************************************************************
594 : !> \brief Distribute atoms across the two-dimensional grid of processors.
595 : !> \param distribution_2d new two-dimensional distribution of pairs of particles
596 : !> (allocated and initialised on exit)
597 : !> \param dbcsr_dist new DBCSR distribution (allocated and initialised on exit)
598 : !> \param blacs_env BLACS parallel environment
599 : !> \param qs_env Quickstep environment
600 : !> \par History
601 : !> * 09.2016 created [Sergey Chulkov]
602 : !> * 01.2017 moved from qs_tddfpt2_methods [Sergey Chulkov]
603 : ! **************************************************************************************************
604 24 : SUBROUTINE tddfpt_build_distribution_2d(distribution_2d, dbcsr_dist, blacs_env, qs_env)
605 : TYPE(distribution_2d_type), POINTER :: distribution_2d
606 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
607 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
608 : TYPE(qs_environment_type), POINTER :: qs_env
609 :
610 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_build_distribution_2d'
611 :
612 : INTEGER :: handle
613 12 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
614 : TYPE(cell_type), POINTER :: cell
615 12 : TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set
616 12 : TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set
617 12 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
618 12 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
619 : TYPE(section_vals_type), POINTER :: input
620 :
621 12 : CALL timeset(routineN, handle)
622 :
623 : CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, cell=cell, input=input, &
624 : molecule_kind_set=molecule_kind_set, molecule_set=molecule_set, &
625 12 : particle_set=particle_set, qs_kind_set=qs_kind_set)
626 :
627 12 : NULLIFY (distribution_2d)
628 : CALL distribute_molecules_2d(cell=cell, &
629 : atomic_kind_set=atomic_kind_set, &
630 : particle_set=particle_set, &
631 : qs_kind_set=qs_kind_set, &
632 : molecule_kind_set=molecule_kind_set, &
633 : molecule_set=molecule_set, &
634 : distribution_2d=distribution_2d, &
635 : blacs_env=blacs_env, &
636 12 : force_env_section=input)
637 :
638 12 : ALLOCATE (dbcsr_dist)
639 12 : CALL cp_dbcsr_dist2d_to_dist(distribution_2d, dbcsr_dist)
640 :
641 12 : CALL timestop(handle)
642 12 : END SUBROUTINE tddfpt_build_distribution_2d
643 :
644 : ! **************************************************************************************************
645 : !> \brief Build task and neighbour lists for the given plane wave environment and basis set.
646 : !> \param task_list new task list (allocated and initialised on exit)
647 : !> \param sab new list of neighbours (allocated and initialised on exit)
648 : !> \param basis_type type of the basis set
649 : !> \param distribution_2d two-dimensional distribution of pairs of particles
650 : !> \param pw_env plane wave environment
651 : !> \param qs_env Quickstep environment
652 : !> \param skip_load_balance do not perform load balancing
653 : !> \param reorder_grid_ranks re-optimise grid ranks and re-create the real-space grid descriptor
654 : !> as well as grids
655 : !> \par History
656 : !> * 09.2016 created [Sergey Chulkov]
657 : !> * 01.2017 moved from qs_tddfpt2_methods [Sergey Chulkov]
658 : ! **************************************************************************************************
659 32 : SUBROUTINE tddfpt_build_tasklist(task_list, sab, basis_type, distribution_2d, pw_env, qs_env, &
660 : skip_load_balance, reorder_grid_ranks)
661 : TYPE(task_list_type), POINTER :: task_list
662 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
663 : POINTER :: sab
664 : CHARACTER(len=*), INTENT(in) :: basis_type
665 : TYPE(distribution_2d_type), POINTER :: distribution_2d
666 : TYPE(pw_env_type), POINTER :: pw_env
667 : TYPE(qs_environment_type), POINTER :: qs_env
668 : LOGICAL, INTENT(in) :: skip_load_balance, reorder_grid_ranks
669 :
670 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_build_tasklist'
671 :
672 : INTEGER :: handle, ikind, nkinds
673 32 : LOGICAL, ALLOCATABLE, DIMENSION(:) :: orb_present
674 : REAL(kind=dp) :: subcells
675 32 : REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: orb_radius
676 32 : REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: pair_radius
677 32 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
678 : TYPE(cell_type), POINTER :: cell
679 : TYPE(distribution_1d_type), POINTER :: local_particles
680 : TYPE(gto_basis_set_type), POINTER :: orb_basis_set
681 32 : TYPE(local_atoms_type), ALLOCATABLE, DIMENSION(:) :: atom2d
682 32 : TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set
683 32 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
684 32 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
685 : TYPE(qs_ks_env_type), POINTER :: ks_env
686 : TYPE(section_vals_type), POINTER :: input
687 :
688 32 : CALL timeset(routineN, handle)
689 :
690 : CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, cell=cell, input=input, &
691 : ks_env=ks_env, local_particles=local_particles, molecule_set=molecule_set, &
692 32 : particle_set=particle_set, qs_kind_set=qs_kind_set)
693 :
694 32 : nkinds = SIZE(atomic_kind_set)
695 :
696 32 : IF (.NOT. (ASSOCIATED(sab))) THEN
697 108 : ALLOCATE (atom2d(nkinds))
698 : CALL atom2d_build(atom2d, local_particles, distribution_2d, atomic_kind_set, &
699 20 : molecule_set, molecule_only=.FALSE., particle_set=particle_set)
700 :
701 60 : ALLOCATE (orb_present(nkinds))
702 60 : ALLOCATE (orb_radius(nkinds))
703 80 : ALLOCATE (pair_radius(nkinds, nkinds))
704 :
705 68 : DO ikind = 1, nkinds
706 48 : CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, basis_type=basis_type)
707 68 : IF (ASSOCIATED(orb_basis_set)) THEN
708 48 : orb_present(ikind) = .TRUE.
709 48 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, kind_radius=orb_radius(ikind))
710 : ELSE
711 0 : orb_present(ikind) = .FALSE.
712 0 : orb_radius(ikind) = 0.0_dp
713 : END IF
714 : END DO
715 :
716 20 : CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius)
717 :
718 20 : NULLIFY (sab)
719 20 : CALL section_vals_val_get(input, "DFT%SUBCELLS", r_val=subcells)
720 : CALL build_neighbor_lists(sab, particle_set, atom2d, cell, pair_radius, &
721 20 : mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb")
722 :
723 20 : CALL atom2d_cleanup(atom2d)
724 40 : DEALLOCATE (atom2d, orb_present, orb_radius, pair_radius)
725 : END IF
726 :
727 32 : CALL allocate_task_list(task_list)
728 : CALL generate_qs_task_list(ks_env, task_list, &
729 : reorder_rs_grid_ranks=reorder_grid_ranks, basis_type=basis_type, &
730 : skip_load_balance_distributed=skip_load_balance, &
731 32 : pw_env_external=pw_env, sab_orb_external=sab)
732 :
733 32 : CALL timestop(handle)
734 64 : END SUBROUTINE tddfpt_build_tasklist
735 :
736 : ! **************************************************************************************************
737 : !> \brief Create a DBCSR matrix based on a template matrix, distribution object, and the list of
738 : !> neighbours.
739 : !> \param matrix matrix to create
740 : !> \param template template matrix
741 : !> \param dbcsr_dist DBCSR distribution
742 : !> \param sab list of neighbours
743 : !> \par History
744 : !> * 09.2016 created [Sergey Chulkov]
745 : !> * 01.2017 moved from qs_tddfpt2_methods [Sergey Chulkov]
746 : ! **************************************************************************************************
747 2156 : SUBROUTINE tddfpt_dbcsr_create_by_dist(matrix, template, dbcsr_dist, sab)
748 : TYPE(dbcsr_type), POINTER :: matrix, template
749 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
750 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
751 : POINTER :: sab
752 :
753 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_dbcsr_create_by_dist'
754 :
755 : CHARACTER :: matrix_type
756 : CHARACTER(len=default_string_length) :: matrix_name
757 : INTEGER :: handle
758 2156 : INTEGER, DIMENSION(:), POINTER :: col_blk_sizes, row_blk_sizes
759 :
760 2156 : CALL timeset(routineN, handle)
761 :
762 2156 : CPASSERT(ASSOCIATED(template))
763 : CALL dbcsr_get_info(template, row_blk_size=row_blk_sizes, col_blk_size=col_blk_sizes, &
764 2156 : name=matrix_name, matrix_type=matrix_type)
765 :
766 2156 : IF (ASSOCIATED(matrix)) THEN
767 1984 : CALL dbcsr_release(matrix)
768 : ELSE
769 172 : ALLOCATE (matrix)
770 : END IF
771 :
772 2156 : CALL dbcsr_create(matrix, matrix_name, dbcsr_dist, matrix_type, row_blk_sizes, col_blk_sizes)
773 2156 : CALL cp_dbcsr_alloc_block_from_nbl(matrix, sab)
774 :
775 2156 : CALL timestop(handle)
776 :
777 2156 : END SUBROUTINE tddfpt_dbcsr_create_by_dist
778 :
779 : ! **************************************************************************************************
780 : !> \brief Replicate a globally distributed matrix across all sub-groups. At the end
781 : !> every sub-group will hold a local copy of the original globally distributed matrix.
782 : !>
783 : !> |--------------------|
784 : !> fm_src | 0 1 2 3 |
785 : !> |--------------------|
786 : !> / MPI ranks \
787 : !> |/_ _\|
788 : !> |--------------------| |--------------------|
789 : !> fm_dest_subgroup0 | 0 1 | | 2 3 | fm_dest_subgroup1
790 : !> |--------------------| |--------------------|
791 : !> subgroup 0 subgroup 1
792 : !>
793 : !> \param fm_src globally distributed matrix to replicate
794 : !> \param fm_dest_sub subgroup-specific copy of the replicated matrix
795 : !> \param sub_env subgroup environment
796 : !> \par History
797 : !> * 09.2016 created [Sergey Chulkov]
798 : !> * 01.2017 moved from qs_tddfpt2_methods [Sergey Chulkov]
799 : ! **************************************************************************************************
800 4 : SUBROUTINE tddfpt_fm_replicate_across_subgroups(fm_src, fm_dest_sub, sub_env)
801 : TYPE(cp_fm_type), INTENT(IN) :: fm_src, fm_dest_sub
802 : TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
803 :
804 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_fm_replicate_across_subgroups'
805 :
806 : INTEGER :: handle, igroup, igroup_local, ncols_global_dest, ncols_global_src, ngroups, &
807 : nrows_global_dest, nrows_global_src
808 : TYPE(cp_blacs_env_type), POINTER :: blacs_env_global
809 : TYPE(cp_fm_type) :: fm_null
810 : TYPE(mp_para_env_type), POINTER :: para_env_global
811 :
812 16 : IF (sub_env%is_split) THEN
813 4 : CALL timeset(routineN, handle)
814 :
815 : CALL cp_fm_get_info(fm_src, nrow_global=nrows_global_src, ncol_global=ncols_global_src, &
816 4 : context=blacs_env_global, para_env=para_env_global)
817 4 : CALL cp_fm_get_info(fm_dest_sub, nrow_global=nrows_global_dest, ncol_global=ncols_global_dest)
818 :
819 : IF (debug_this_module) THEN
820 4 : CPASSERT(nrows_global_src == nrows_global_dest)
821 4 : CPASSERT(ncols_global_src == ncols_global_dest)
822 : END IF
823 :
824 4 : igroup_local = sub_env%group_distribution(para_env_global%mepos)
825 4 : ngroups = sub_env%ngroups
826 :
827 12 : DO igroup = 0, ngroups - 1
828 12 : IF (igroup == igroup_local) THEN
829 4 : CALL cp_fm_copy_general(fm_src, fm_dest_sub, para_env_global)
830 : ELSE
831 4 : CALL cp_fm_copy_general(fm_src, fm_null, para_env_global)
832 : END IF
833 : END DO
834 :
835 4 : CALL timestop(handle)
836 : END IF
837 4 : END SUBROUTINE tddfpt_fm_replicate_across_subgroups
838 0 : END MODULE qs_tddfpt2_subgroups
839 :
|
