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