Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Calls routines to get RI integrals and calculate total energies
10 : !> \par History
11 : !> 10.2011 created [Joost VandeVondele and Mauro Del Ben]
12 : !> 07.2019 split from mp2_gpw.F [Frederick Stein]
13 : ! **************************************************************************************************
14 : MODULE mp2_gpw
15 : USE atomic_kind_types, ONLY: atomic_kind_type
16 : USE basis_set_types, ONLY: get_gto_basis_set,&
17 : gto_basis_set_p_type,&
18 : gto_basis_set_type
19 : USE cell_types, ONLY: cell_type,&
20 : get_cell
21 : USE cp_blacs_env, ONLY: BLACS_GRID_SQUARE,&
22 : cp_blacs_env_create,&
23 : cp_blacs_env_release,&
24 : cp_blacs_env_type
25 : USE cp_cfm_types, ONLY: cp_cfm_type
26 : USE cp_control_types, ONLY: dft_control_type
27 : USE cp_dbcsr_api, ONLY: &
28 : dbcsr_clear_mempools, dbcsr_copy, dbcsr_create, dbcsr_distribution_release, &
29 : dbcsr_distribution_type, dbcsr_filter, dbcsr_init_p, dbcsr_iterator_blocks_left, &
30 : dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, &
31 : dbcsr_p_type, dbcsr_release, dbcsr_type, dbcsr_type_no_symmetry, dbcsr_type_symmetric
32 : USE cp_dbcsr_contrib, ONLY: dbcsr_reserve_all_blocks
33 : USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
34 : USE cp_dbcsr_operations, ONLY: cp_dbcsr_dist2d_to_dist,&
35 : cp_dbcsr_m_by_n_from_row_template
36 : USE cp_fm_types, ONLY: cp_fm_get_info,&
37 : cp_fm_release,&
38 : cp_fm_type
39 : USE cp_log_handling, ONLY: &
40 : cp_add_default_logger, cp_get_default_logger, cp_logger_create, &
41 : cp_logger_get_default_unit_nr, cp_logger_release, cp_logger_set, cp_logger_type, &
42 : cp_rm_default_logger, cp_to_string
43 : USE dbt_api, ONLY: dbt_clear_mempools,&
44 : dbt_type
45 : USE distribution_1d_types, ONLY: distribution_1d_release,&
46 : distribution_1d_type
47 : USE distribution_2d_types, ONLY: distribution_2d_release,&
48 : distribution_2d_type
49 : USE distribution_methods, ONLY: distribute_molecules_1d,&
50 : distribute_molecules_2d
51 : USE group_dist_types, ONLY: create_group_dist,&
52 : get_group_dist,&
53 : group_dist_d1_type,&
54 : release_group_dist
55 : USE hfx_types, ONLY: block_ind_type,&
56 : hfx_compression_type
57 : USE input_constants, ONLY: &
58 : do_eri_gpw, do_eri_os, do_potential_coulomb, do_potential_id, do_potential_truncated, &
59 : eri_default, mp2_method_gpw, ri_default, ri_mp2_method_gpw, rpa_exchange_none
60 : USE input_section_types, ONLY: section_vals_val_get
61 : USE kinds, ONLY: dp
62 : USE kpoint_types, ONLY: kpoint_type
63 : USE machine, ONLY: default_output_unit,&
64 : m_flush
65 : USE message_passing, ONLY: mp_para_env_release,&
66 : mp_para_env_type
67 : USE molecule_kind_types, ONLY: molecule_kind_type
68 : USE molecule_types, ONLY: molecule_type
69 : USE mp2_cphf, ONLY: solve_z_vector_eq
70 : USE mp2_gpw_method, ONLY: mp2_gpw_compute
71 : USE mp2_integrals, ONLY: mp2_ri_gpw_compute_in
72 : USE mp2_ri_gpw, ONLY: mp2_ri_gpw_compute_en
73 : USE mp2_ri_grad, ONLY: calc_ri_mp2_nonsep
74 : USE mp2_types, ONLY: mp2_type,&
75 : three_dim_real_array
76 : USE particle_methods, ONLY: get_particle_set
77 : USE particle_types, ONLY: particle_type
78 : USE qs_environment_types, ONLY: get_qs_env,&
79 : qs_environment_type
80 : USE qs_integral_utils, ONLY: basis_set_list_setup
81 : USE qs_interactions, ONLY: init_interaction_radii
82 : USE qs_kind_types, ONLY: get_qs_kind,&
83 : qs_kind_type
84 : USE qs_ks_types, ONLY: qs_ks_env_type
85 : USE qs_mo_types, ONLY: get_mo_set,&
86 : mo_set_type
87 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type,&
88 : release_neighbor_list_sets
89 : USE qs_neighbor_lists, ONLY: atom2d_build,&
90 : atom2d_cleanup,&
91 : build_neighbor_lists,&
92 : local_atoms_type,&
93 : pair_radius_setup
94 : USE rpa_main, ONLY: rpa_ri_compute_en
95 : USE rpa_rse, ONLY: rse_energy
96 : #include "./base/base_uses.f90"
97 :
98 : IMPLICIT NONE
99 :
100 : PRIVATE
101 :
102 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mp2_gpw'
103 :
104 : PUBLIC :: mp2_gpw_main, create_mat_munu, grep_rows_in_subgroups, build_dbcsr_from_rows
105 :
106 : CONTAINS
107 :
108 : ! **************************************************************************************************
109 : !> \brief with a big bang to mp2
110 : !> \param qs_env ...
111 : !> \param mp2_env ...
112 : !> \param Emp2 ...
113 : !> \param Emp2_Cou ...
114 : !> \param Emp2_EX ...
115 : !> \param Emp2_S ...
116 : !> \param Emp2_T ...
117 : !> \param mos_mp2 ...
118 : !> \param para_env ...
119 : !> \param unit_nr ...
120 : !> \param calc_forces ...
121 : !> \param calc_ex ...
122 : !> \param do_ri_mp2 ...
123 : !> \param do_ri_rpa ...
124 : !> \param do_ri_sos_laplace_mp2 ...
125 : !> \author Mauro Del Ben and Joost VandeVondele
126 : ! **************************************************************************************************
127 718 : SUBROUTINE mp2_gpw_main(qs_env, mp2_env, Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T, &
128 718 : mos_mp2, para_env, unit_nr, calc_forces, calc_ex, do_ri_mp2, do_ri_rpa, &
129 : do_ri_sos_laplace_mp2)
130 : TYPE(qs_environment_type), POINTER :: qs_env
131 : TYPE(mp2_type) :: mp2_env
132 : REAL(KIND=dp), INTENT(OUT) :: Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T
133 : TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mos_mp2
134 : TYPE(mp_para_env_type), POINTER :: para_env
135 : INTEGER, INTENT(IN) :: unit_nr
136 : LOGICAL, INTENT(IN) :: calc_forces, calc_ex
137 : LOGICAL, INTENT(IN), OPTIONAL :: do_ri_mp2, do_ri_rpa, &
138 : do_ri_sos_laplace_mp2
139 :
140 : CHARACTER(LEN=*), PARAMETER :: routineN = 'mp2_gpw_main'
141 :
142 : INTEGER :: blacs_grid_layout, color_sub, dimen_RI, dimen_RI_red, eri_method, handle, ispin, &
143 : local_unit_nr, my_group_L_end, my_group_L_size, my_group_L_start, nmo, nspins, &
144 : potential_type, ri_metric_type
145 718 : INTEGER, ALLOCATABLE, DIMENSION(:) :: bse_lev_virt, ends_array_mc, ends_array_mc_block, &
146 718 : gw_corr_lev_occ, gw_corr_lev_virt, homo, starts_array_mc, starts_array_mc_block
147 : INTEGER, DIMENSION(3) :: periodic
148 : LOGICAL :: blacs_repeatable, do_bse, do_im_time, do_kpoints_cubic_RPA, my_do_gw, &
149 : my_do_ri_mp2, my_do_ri_rpa, my_do_ri_sos_laplace_mp2
150 : REAL(KIND=dp) :: Emp2_AB, Emp2_BB, Emp2_Cou_BB, &
151 : Emp2_EX_BB, eps_gvg_rspace_old, &
152 : eps_pgf_orb_old, eps_rho_rspace_old
153 718 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: Eigenval
154 718 : REAL(KIND=dp), DIMENSION(:), POINTER :: mo_eigenvalues
155 718 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
156 : TYPE(block_ind_type), ALLOCATABLE, &
157 718 : DIMENSION(:, :, :) :: t_3c_O_ind
158 : TYPE(cell_type), POINTER :: cell
159 : TYPE(cp_blacs_env_type), POINTER :: blacs_env_sub, blacs_env_sub_mat_munu
160 718 : TYPE(cp_cfm_type), ALLOCATABLE, DIMENSION(:) :: cfm_matrix_L_kpoints, &
161 718 : cfm_matrix_Minv_L_kpoints
162 : TYPE(cp_fm_type) :: fm_matrix_PQ
163 718 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: mo_coeff
164 718 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: fm_matrix_Minv, fm_matrix_Minv_L_gamma, &
165 718 : fm_matrix_Minv_Vtrunc_Minv
166 : TYPE(cp_fm_type), POINTER :: mo_coeff_ptr
167 : TYPE(cp_logger_type), POINTER :: logger, logger_sub
168 : TYPE(dbcsr_p_type) :: mat_munu, mat_P_global
169 718 : TYPE(dbcsr_p_type), ALLOCATABLE, DIMENSION(:) :: mo_coeff_all, mo_coeff_gw, mo_coeff_o, &
170 718 : mo_coeff_o_bse, mo_coeff_v, &
171 718 : mo_coeff_v_bse
172 718 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
173 718 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s_kp
174 5026 : TYPE(dbt_type) :: t_3c_M
175 718 : TYPE(dbt_type), ALLOCATABLE, DIMENSION(:, :) :: t_3c_O
176 : TYPE(dft_control_type), POINTER :: dft_control
177 718 : TYPE(group_dist_d1_type) :: gd_array, gd_B_all
178 : TYPE(group_dist_d1_type), ALLOCATABLE, &
179 718 : DIMENSION(:) :: gd_B_occ_bse, gd_B_virt_bse, gd_B_virtual
180 : TYPE(hfx_compression_type), ALLOCATABLE, &
181 718 : DIMENSION(:, :, :) :: t_3c_O_compressed
182 : TYPE(kpoint_type), POINTER :: kpoints, kpoints_from_DFT
183 : TYPE(mp_para_env_type), POINTER :: para_env_sub
184 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
185 718 : POINTER :: sab_orb_sub
186 718 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
187 718 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
188 : TYPE(qs_ks_env_type), POINTER :: ks_env
189 : TYPE(three_dim_real_array), ALLOCATABLE, &
190 718 : DIMENSION(:) :: BIb_C, BIb_C_bse_ab, BIb_C_bse_ij, &
191 718 : BIb_C_gw
192 :
193 718 : CALL timeset(routineN, handle)
194 :
195 : ! check if we want to do ri-mp2
196 718 : my_do_ri_mp2 = .FALSE.
197 718 : IF (PRESENT(do_ri_mp2)) my_do_ri_mp2 = do_ri_mp2
198 :
199 : ! check if we want to do ri-rpa
200 718 : my_do_ri_rpa = .FALSE.
201 718 : IF (PRESENT(do_ri_rpa)) my_do_ri_rpa = do_ri_rpa
202 :
203 : ! check if we want to do ri-sos-laplace-mp2
204 718 : my_do_ri_sos_laplace_mp2 = .FALSE.
205 718 : IF (PRESENT(do_ri_sos_laplace_mp2)) my_do_ri_sos_laplace_mp2 = do_ri_sos_laplace_mp2
206 :
207 : ! GW and SOS-MP2 cannot be used together
208 718 : IF (my_do_ri_sos_laplace_mp2) THEN
209 64 : CPASSERT(.NOT. mp2_env%ri_rpa%do_ri_g0w0)
210 : END IF
211 :
212 : ! check if we want to do imaginary time
213 718 : do_im_time = mp2_env%do_im_time
214 718 : do_bse = qs_env%mp2_env%bse%do_bse
215 718 : do_kpoints_cubic_RPA = qs_env%mp2_env%ri_rpa_im_time%do_im_time_kpoints
216 :
217 718 : IF (do_kpoints_cubic_RPA .AND. mp2_env%ri_rpa%do_ri_g0w0) THEN
218 0 : CPABORT("Full RPA k-points (DO_KPOINTS in LOW_SCALING section) not implemented with GW")
219 : END IF
220 :
221 : ! Get the number of spins
222 718 : nspins = SIZE(mos_mp2)
223 :
224 : ! ... setup needed to be able to qs_integrate in a subgroup.
225 718 : IF (do_kpoints_cubic_RPA) THEN
226 6 : CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, kpoints=kpoints_from_DFT)
227 : ELSE
228 712 : CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
229 : END IF
230 718 : CALL get_mo_set(mo_set=mos_mp2(1), nmo=nmo)
231 6626 : ALLOCATE (homo(nspins), Eigenval(nmo, nspins), mo_coeff(nspins))
232 1600 : DO ispin = 1, nspins
233 : CALL get_mo_set(mo_set=mos_mp2(ispin), &
234 : eigenvalues=mo_eigenvalues, homo=homo(ispin), &
235 882 : mo_coeff=mo_coeff_ptr)
236 882 : mo_coeff(ispin) = mo_coeff_ptr
237 19882 : Eigenval(:, ispin) = mo_eigenvalues(1:nmo)
238 : END DO
239 :
240 : ! a para_env
241 718 : color_sub = para_env%mepos/mp2_env%mp2_num_proc
242 718 : ALLOCATE (para_env_sub)
243 718 : CALL para_env_sub%from_split(para_env, color_sub)
244 :
245 : ! each of the sub groups might need to generate output
246 718 : logger => cp_get_default_logger()
247 718 : IF (para_env%is_source()) THEN
248 359 : local_unit_nr = cp_logger_get_default_unit_nr(logger, local=.FALSE.)
249 : ELSE
250 359 : local_unit_nr = default_output_unit
251 : END IF
252 :
253 : ! get stuff
254 : CALL get_qs_env(qs_env, &
255 : ks_env=ks_env, &
256 : qs_kind_set=qs_kind_set, &
257 : cell=cell, &
258 : particle_set=particle_set, &
259 : atomic_kind_set=atomic_kind_set, &
260 : dft_control=dft_control, &
261 718 : matrix_s_kp=matrix_s_kp)
262 :
263 718 : CALL get_cell(cell=cell, periodic=periodic)
264 :
265 718 : IF (do_im_time) THEN
266 144 : IF (mp2_env%ri_metric%potential_type == ri_default) THEN
267 434 : IF (SUM(periodic) == 1 .OR. SUM(periodic) == 3) THEN
268 8 : mp2_env%ri_metric%potential_type = do_potential_id
269 : ELSE
270 54 : mp2_env%ri_metric%potential_type = do_potential_truncated
271 : END IF
272 : END IF
273 :
274 : END IF
275 :
276 718 : IF (mp2_env%ri_metric%potential_type == ri_default) THEN
277 358 : mp2_env%ri_metric%potential_type = do_potential_coulomb
278 : END IF
279 :
280 718 : IF (mp2_env%eri_method == eri_default) THEN
281 1296 : IF (SUM(periodic) > 0) mp2_env%eri_method = do_eri_gpw
282 1296 : IF (SUM(periodic) == 0) mp2_env%eri_method = do_eri_os
283 1296 : IF (SUM(mp2_env%ri_rpa_im_time%kp_grid) > 0) mp2_env%eri_method = do_eri_os
284 324 : IF (mp2_env%method == mp2_method_gpw) mp2_env%eri_method = do_eri_gpw
285 324 : IF (mp2_env%method == ri_mp2_method_gpw) mp2_env%eri_method = do_eri_gpw
286 324 : IF (mp2_env%ri_rpa_im_time%do_im_time_kpoints) mp2_env%eri_method = do_eri_os
287 324 : IF (calc_forces .AND. mp2_env%eri_method == do_eri_os) mp2_env%eri_method = do_eri_gpw
288 : END IF
289 718 : eri_method = mp2_env%eri_method
290 :
291 718 : IF (unit_nr > 0 .AND. mp2_env%eri_method == do_eri_gpw) THEN
292 : WRITE (UNIT=unit_nr, FMT="(T3,A,T71,F10.1)") &
293 188 : "GPW_INFO| Density cutoff [a.u.]:", mp2_env%mp2_gpw%cutoff*0.5_dp
294 : WRITE (UNIT=unit_nr, FMT="(T3,A,T71,F10.1)") &
295 188 : "GPW_INFO| Relative density cutoff [a.u.]:", mp2_env%mp2_gpw%relative_cutoff*0.5_dp
296 188 : CALL m_flush(unit_nr)
297 : END IF
298 :
299 : ! MG: Disable logger layer for BSE, misses some key information to print cube files properly;
300 : ! the same holds for the static COHSEX MOs (DFT%PRINT%MO, DFT%PRINT%MO_CUBES)
301 718 : IF (.NOT. (mp2_env%ri_g0w0%print_local_bandgap .OR. mp2_env%bse%do_nto_analysis .OR. &
302 : mp2_env%ri_g0w0%do_static_cohsex)) THEN
303 : ! a logger
304 700 : NULLIFY (logger_sub)
305 : CALL cp_logger_create(logger_sub, para_env=para_env_sub, &
306 : default_global_unit_nr=local_unit_nr, &
307 700 : close_global_unit_on_dealloc=.FALSE.)
308 700 : CALL cp_logger_set(logger_sub, local_filename="MP2_localLog")
309 : ! set to a custom print level (we could also have a different print level for para_env%source)
310 700 : logger_sub%iter_info%print_level = mp2_env%mp2_gpw%print_level
311 700 : CALL cp_add_default_logger(logger_sub)
312 : END IF
313 :
314 : ! a blacs_env (ignore the globenv stored defaults for now)
315 718 : blacs_grid_layout = BLACS_GRID_SQUARE
316 718 : blacs_repeatable = .TRUE.
317 718 : NULLIFY (blacs_env_sub)
318 : CALL cp_blacs_env_create(blacs_env_sub, para_env_sub, &
319 : blacs_grid_layout, &
320 718 : blacs_repeatable)
321 :
322 718 : blacs_env_sub_mat_munu => blacs_env_sub
323 :
324 718 : matrix_s(1:1) => matrix_s_kp(1:1, 1)
325 :
326 718 : CALL get_eps_old(dft_control, eps_pgf_orb_old, eps_rho_rspace_old, eps_gvg_rspace_old)
327 :
328 : CALL create_mat_munu(mat_munu, qs_env, mp2_env%mp2_gpw%eps_grid, &
329 : blacs_env_sub_mat_munu, do_alloc_blocks_from_nbl=.NOT. do_im_time, sab_orb_sub=sab_orb_sub, &
330 : do_kpoints=mp2_env%ri_rpa_im_time%do_im_time_kpoints, &
331 718 : dbcsr_sym_type=dbcsr_type_symmetric)
332 :
333 : ! which RI metric we want to have
334 718 : ri_metric_type = mp2_env%ri_metric%potential_type
335 :
336 : ! which interaction potential
337 718 : potential_type = mp2_env%potential_parameter%potential_type
338 :
339 : ! check if we want to do ri-g0w0 on top of ri-rpa
340 718 : my_do_gw = mp2_env%ri_rpa%do_ri_g0w0
341 2872 : ALLOCATE (gw_corr_lev_occ(nspins), gw_corr_lev_virt(nspins), bse_lev_virt(nspins))
342 718 : gw_corr_lev_occ(1) = mp2_env%ri_g0w0%corr_mos_occ
343 718 : gw_corr_lev_virt(1) = mp2_env%ri_g0w0%corr_mos_virt
344 718 : IF (nspins == 2) THEN
345 164 : gw_corr_lev_occ(2) = mp2_env%ri_g0w0%corr_mos_occ_beta
346 164 : gw_corr_lev_virt(2) = mp2_env%ri_g0w0%corr_mos_virt_beta
347 : END IF
348 :
349 718 : IF (do_bse) THEN
350 : !Keep default behavior for occupied
351 : ! We do not implement an explicit bse_lev_occ here, because the small number of occupied levels
352 : ! does not critically influence the memory
353 : ! bse_lev_virt is per-spin (= the per-spin GW-corrected virtual count): the (ab|K) block is sized per spin
354 124 : bse_lev_virt(:) = gw_corr_lev_virt(:)
355 : END IF
356 :
357 : ! After the components are inside of the routines, we can move this line insight the branch
358 7836 : ALLOCATE (mo_coeff_o(nspins), mo_coeff_v(nspins), mo_coeff_all(nspins), mo_coeff_gw(nspins))
359 :
360 : ! Always allocate for usage in call of replicate_mat_to_subgroup
361 3918 : ALLOCATE (mo_coeff_o_bse(nspins), mo_coeff_v_bse(nspins))
362 :
363 : ! for imag. time, we do not need this
364 718 : IF (.NOT. do_im_time) THEN
365 :
366 : ! new routine: replicate a full matrix from one para_env to a smaller one
367 : ! keeping the memory usage as small as possible in this case the
368 : ! output the two part of the C matrix (virtual, occupied)
369 1280 : DO ispin = 1, nspins
370 :
371 : CALL replicate_mat_to_subgroup(para_env, para_env_sub, mo_coeff(ispin), homo(ispin), mat_munu%matrix, &
372 : mo_coeff_o(ispin)%matrix, mo_coeff_v(ispin)%matrix, &
373 : mo_coeff_all(ispin)%matrix, mo_coeff_gw(ispin)%matrix, &
374 : my_do_gw, gw_corr_lev_occ(ispin), gw_corr_lev_virt(ispin), do_bse, &
375 : bse_lev_virt(ispin), mo_coeff_o_bse(ispin)%matrix, mo_coeff_v_bse(ispin)%matrix, &
376 1280 : mp2_env%mp2_gpw%eps_filter)
377 :
378 : END DO
379 :
380 : END IF
381 :
382 : ! now we're kind of ready to go....
383 718 : Emp2_S = 0.0_dp
384 718 : Emp2_T = 0.0_dp
385 718 : IF (my_do_ri_mp2 .OR. my_do_ri_rpa .OR. my_do_ri_sos_laplace_mp2) THEN
386 : ! RI-GPW integrals (same stuff for both RPA and MP2)
387 704 : IF (nspins == 2) THEN
388 : ! open shell case (RI) here the (ia|K) integrals are computed for both the alpha and beta components
389 : CALL mp2_ri_gpw_compute_in( &
390 : BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd_array, gd_B_virtual, dimen_RI, dimen_RI_red, qs_env, &
391 : para_env, para_env_sub, color_sub, cell, particle_set, &
392 : atomic_kind_set, qs_kind_set, fm_matrix_PQ, cfm_matrix_L_kpoints, cfm_matrix_Minv_L_kpoints, &
393 : fm_matrix_Minv_L_gamma, &
394 : fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, nmo, homo, mat_munu, sab_orb_sub, &
395 : mo_coeff_o, mo_coeff_v, mo_coeff_all, mo_coeff_gw, mo_coeff_o_bse, mo_coeff_v_bse, &
396 : mp2_env%mp2_gpw%eps_filter, unit_nr, &
397 : mp2_env%mp2_memory, mp2_env%calc_PQ_cond_num, calc_forces, blacs_env_sub, my_do_gw .AND. .NOT. do_im_time, &
398 : do_bse, gd_B_all, starts_array_mc, ends_array_mc, starts_array_mc_block, ends_array_mc_block, &
399 : gw_corr_lev_occ(1), gw_corr_lev_virt(1), &
400 : bse_lev_virt, &
401 : do_im_time, do_kpoints_cubic_RPA, kpoints, &
402 : t_3c_M, t_3c_O, t_3c_O_compressed, t_3c_O_ind, &
403 : mp2_env%ri_metric, &
404 308 : gd_B_occ_bse, gd_B_virt_bse)
405 : ELSE
406 : ! closed shell case (RI)
407 : CALL mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd_array, gd_B_virtual, &
408 : dimen_RI, dimen_RI_red, qs_env, para_env, para_env_sub, &
409 : color_sub, cell, particle_set, &
410 : atomic_kind_set, qs_kind_set, fm_matrix_PQ, &
411 : cfm_matrix_L_kpoints, cfm_matrix_Minv_L_kpoints, &
412 : fm_matrix_Minv_L_gamma, &
413 : fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, nmo, homo, &
414 : mat_munu, sab_orb_sub, &
415 : mo_coeff_o, mo_coeff_v, mo_coeff_all, mo_coeff_gw, mo_coeff_o_bse, mo_coeff_v_bse, &
416 : mp2_env%mp2_gpw%eps_filter, unit_nr, &
417 : mp2_env%mp2_memory, mp2_env%calc_PQ_cond_num, calc_forces, &
418 : blacs_env_sub, my_do_gw .AND. .NOT. do_im_time, do_bse, gd_B_all, &
419 : starts_array_mc, ends_array_mc, &
420 : starts_array_mc_block, ends_array_mc_block, &
421 : gw_corr_lev_occ(1), gw_corr_lev_virt(1), &
422 : bse_lev_virt, &
423 : do_im_time, do_kpoints_cubic_RPA, kpoints, &
424 : t_3c_M, t_3c_O, t_3c_O_compressed, t_3c_O_ind, &
425 1004 : mp2_env%ri_metric, gd_B_occ_bse, gd_B_virt_bse)
426 : END IF
427 :
428 : ELSE
429 : ! Canonical MP2-GPW
430 14 : IF (nspins == 2) THEN
431 : ! alpha-alpha and alpha-beta components
432 2 : IF (unit_nr > 0) WRITE (unit_nr, *)
433 2 : IF (unit_nr > 0) WRITE (unit_nr, '(T3,A)') 'Alpha (ia|'
434 : CALL mp2_gpw_compute( &
435 : Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_sub, color_sub, &
436 : cell, particle_set, &
437 : atomic_kind_set, qs_kind_set, Eigenval, nmo, homo, mat_munu, &
438 : sab_orb_sub, mo_coeff_o, mo_coeff_v, mp2_env%mp2_gpw%eps_filter, unit_nr, &
439 2 : mp2_env%mp2_memory, calc_ex, blacs_env_sub, Emp2_AB)
440 :
441 : ! beta-beta component
442 2 : IF (unit_nr > 0) WRITE (unit_nr, *)
443 2 : IF (unit_nr > 0) WRITE (unit_nr, '(T3,A)') 'Beta (ia|'
444 : CALL mp2_gpw_compute( &
445 : Emp2_BB, Emp2_Cou_BB, Emp2_EX_BB, qs_env, para_env, para_env_sub, color_sub, cell, particle_set, &
446 : atomic_kind_set, qs_kind_set, Eigenval(:, 2:2), nmo, homo(2:2), mat_munu, &
447 : sab_orb_sub, mo_coeff_o(2:2), mo_coeff_v(2:2), mp2_env%mp2_gpw%eps_filter, unit_nr, &
448 2 : mp2_env%mp2_memory, calc_ex, blacs_env_sub)
449 :
450 : ! make order on the MP2 energy contributions
451 2 : Emp2_Cou = Emp2_Cou*0.25_dp
452 2 : Emp2_EX = Emp2_EX*0.5_dp
453 :
454 2 : Emp2_Cou_BB = Emp2_Cou_BB*0.25_dp
455 2 : Emp2_EX_BB = Emp2_EX_BB*0.5_dp
456 :
457 2 : Emp2_S = Emp2_AB
458 2 : Emp2_T = Emp2_Cou + Emp2_Cou_BB + Emp2_EX + Emp2_EX_BB
459 :
460 2 : Emp2_Cou = Emp2_Cou + Emp2_Cou_BB + Emp2_AB
461 2 : Emp2_EX = Emp2_EX + Emp2_EX_BB
462 2 : Emp2 = Emp2_EX + Emp2_Cou
463 :
464 : ELSE
465 : ! closed shell case
466 : CALL mp2_gpw_compute( &
467 : Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_sub, color_sub, cell, particle_set, &
468 : atomic_kind_set, qs_kind_set, Eigenval(:, 1:1), nmo, homo(1:1), mat_munu, &
469 : sab_orb_sub, mo_coeff_o(1:1), mo_coeff_v(1:1), mp2_env%mp2_gpw%eps_filter, unit_nr, &
470 12 : mp2_env%mp2_memory, calc_ex, blacs_env_sub)
471 : END IF
472 : END IF
473 :
474 : ! Free possibly large buffers allocated by dbcsr on the GPU,
475 : ! large hybrid dgemm/pdgemm's coming later will need the space.
476 718 : CALL dbcsr_clear_mempools()
477 718 : CALL dbt_clear_mempools()
478 :
479 718 : IF (calc_forces .AND. .NOT. do_im_time) THEN
480 : ! make a copy of mo_coeff_o and mo_coeff_v
481 1532 : ALLOCATE (mp2_env%ri_grad%mo_coeff_o(nspins), mp2_env%ri_grad%mo_coeff_v(nspins))
482 630 : DO ispin = 1, nspins
483 358 : NULLIFY (mp2_env%ri_grad%mo_coeff_o(ispin)%matrix)
484 358 : CALL dbcsr_init_p(mp2_env%ri_grad%mo_coeff_o(ispin)%matrix)
485 : CALL dbcsr_copy(mp2_env%ri_grad%mo_coeff_o(ispin)%matrix, mo_coeff_o(ispin)%matrix, &
486 358 : name="mo_coeff_o"//cp_to_string(ispin))
487 358 : NULLIFY (mp2_env%ri_grad%mo_coeff_v(ispin)%matrix)
488 358 : CALL dbcsr_init_p(mp2_env%ri_grad%mo_coeff_v(ispin)%matrix)
489 : CALL dbcsr_copy(mp2_env%ri_grad%mo_coeff_v(ispin)%matrix, mo_coeff_v(ispin)%matrix, &
490 630 : name="mo_coeff_v"//cp_to_string(ispin))
491 : END DO
492 272 : CALL get_group_dist(gd_array, color_sub, my_group_L_start, my_group_L_end, my_group_L_size)
493 : END IF
494 : ! Copy mo coeffs for RPA exchange correction
495 718 : IF (mp2_env%ri_rpa%exchange_correction /= rpa_exchange_none) THEN
496 76 : ALLOCATE (mp2_env%ri_rpa%mo_coeff_o(nspins), mp2_env%ri_rpa%mo_coeff_v(nspins))
497 26 : DO ispin = 1, nspins
498 14 : CALL dbcsr_copy(mp2_env%ri_rpa%mo_coeff_o(ispin), mo_coeff_o(ispin)%matrix, name="mo_coeff_o")
499 26 : CALL dbcsr_copy(mp2_env%ri_rpa%mo_coeff_v(ispin), mo_coeff_v(ispin)%matrix, name="mo_coeff_v")
500 : END DO
501 : END IF
502 :
503 718 : IF (.NOT. do_im_time) THEN
504 :
505 1280 : DO ispin = 1, nspins
506 706 : CALL dbcsr_release(mo_coeff_o(ispin)%matrix)
507 706 : DEALLOCATE (mo_coeff_o(ispin)%matrix)
508 706 : CALL dbcsr_release(mo_coeff_v(ispin)%matrix)
509 706 : DEALLOCATE (mo_coeff_v(ispin)%matrix)
510 1280 : IF (my_do_gw) THEN
511 112 : CALL dbcsr_release(mo_coeff_all(ispin)%matrix)
512 112 : DEALLOCATE (mo_coeff_all(ispin)%matrix)
513 : END IF
514 : END DO
515 574 : DEALLOCATE (mo_coeff_o, mo_coeff_v)
516 574 : IF (my_do_gw) DEALLOCATE (mo_coeff_all)
517 :
518 : END IF
519 718 : IF (do_bse) THEN
520 124 : DO ispin = 1, nspins
521 68 : CALL dbcsr_release(mo_coeff_o_bse(ispin)%matrix)
522 68 : CALL dbcsr_release(mo_coeff_v_bse(ispin)%matrix)
523 68 : DEALLOCATE (mo_coeff_o_bse(ispin)%matrix)
524 124 : DEALLOCATE (mo_coeff_v_bse(ispin)%matrix)
525 : END DO
526 : END IF
527 718 : DEALLOCATE (mo_coeff_o_bse, mo_coeff_v_bse)
528 :
529 : ! Release some memory for RPA exchange correction
530 718 : IF (calc_forces .AND. do_im_time .OR. &
531 : (.NOT. calc_forces .AND. mp2_env%ri_rpa%exchange_correction == rpa_exchange_none)) THEN
532 :
533 434 : CALL dbcsr_release(mat_munu%matrix)
534 434 : DEALLOCATE (mat_munu%matrix)
535 :
536 434 : CALL release_neighbor_list_sets(sab_orb_sub)
537 :
538 : END IF
539 :
540 : ! decide if to do RI-RPA or RI-MP2
541 718 : IF (my_do_ri_rpa .OR. my_do_ri_sos_laplace_mp2) THEN
542 :
543 350 : IF (do_im_time) CALL create_matrix_P(mat_P_global, qs_env, mp2_env, para_env)
544 :
545 814 : IF (.NOT. ALLOCATED(BIb_C)) ALLOCATE (BIb_C(nspins))
546 1170 : IF (.NOT. ALLOCATED(BIb_C_gw)) ALLOCATE (BIb_C_gw(nspins))
547 814 : IF (.NOT. ALLOCATED(gd_B_virtual)) ALLOCATE (gd_B_virtual(nspins))
548 :
549 : ! RI-RPA
550 : CALL rpa_ri_compute_en(qs_env, Emp2, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, &
551 : para_env, para_env_sub, color_sub, &
552 : gd_array, gd_B_virtual, gd_B_all, gd_B_occ_bse, gd_B_virt_bse, &
553 : mo_coeff, fm_matrix_PQ, cfm_matrix_L_kpoints, cfm_matrix_Minv_L_kpoints, &
554 : fm_matrix_Minv_L_gamma, &
555 : fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, kpoints, &
556 : Eigenval, nmo, homo, dimen_RI, dimen_RI_red, gw_corr_lev_occ, gw_corr_lev_virt, &
557 : bse_lev_virt, &
558 : unit_nr, my_do_ri_sos_laplace_mp2, my_do_gw, do_im_time, do_bse, matrix_s, &
559 : mat_munu, mat_P_global, t_3c_M, t_3c_O, t_3c_O_compressed, t_3c_O_ind, &
560 : starts_array_mc, ends_array_mc, &
561 350 : starts_array_mc_block, ends_array_mc_block, calc_forces)
562 :
563 350 : IF (mp2_env%ri_rpa%do_rse) THEN
564 8 : CALL rse_energy(qs_env, mp2_env, para_env, dft_control, mo_coeff, homo, Eigenval)
565 : END IF
566 :
567 350 : IF (do_im_time) THEN
568 144 : IF (ASSOCIATED(mat_P_global%matrix)) THEN
569 144 : CALL dbcsr_release(mat_P_global%matrix)
570 144 : DEALLOCATE (mat_P_global%matrix)
571 : END IF
572 :
573 144 : IF (calc_forces) CALL cp_fm_release(fm_matrix_PQ)
574 : END IF
575 :
576 : ! Release some memory for RPA exchange correction
577 350 : IF (mp2_env%ri_rpa%exchange_correction /= rpa_exchange_none) THEN
578 :
579 12 : CALL dbcsr_release(mat_munu%matrix)
580 12 : DEALLOCATE (mat_munu%matrix)
581 :
582 12 : CALL release_neighbor_list_sets(sab_orb_sub)
583 :
584 : END IF
585 :
586 : ELSE
587 368 : IF (my_do_ri_mp2) THEN
588 354 : Emp2 = 0.0_dp
589 354 : Emp2_Cou = 0.0_dp
590 354 : Emp2_EX = 0.0_dp
591 :
592 : ! RI-MP2-GPW compute energy
593 : CALL mp2_ri_gpw_compute_en( &
594 : Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T, BIb_C, mp2_env, para_env, para_env_sub, color_sub, &
595 : gd_array, gd_B_virtual, &
596 354 : Eigenval, nmo, homo, dimen_RI_red, unit_nr, calc_forces, calc_ex)
597 :
598 : END IF
599 : END IF
600 :
601 : ! if we need forces time to calculate the MP2 non-separable contribution
602 : ! and start computing the Lagrangian
603 718 : IF (calc_forces .AND. .NOT. do_im_time) THEN
604 :
605 : CALL calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, &
606 : particle_set, atomic_kind_set, qs_kind_set, &
607 : mo_coeff, dimen_RI, Eigenval, &
608 : my_group_L_start, my_group_L_end, my_group_L_size, &
609 272 : sab_orb_sub, mat_munu, blacs_env_sub)
610 :
611 630 : DO ispin = 1, nspins
612 358 : CALL dbcsr_release(mp2_env%ri_grad%mo_coeff_o(ispin)%matrix)
613 358 : DEALLOCATE (mp2_env%ri_grad%mo_coeff_o(ispin)%matrix)
614 :
615 358 : CALL dbcsr_release(mp2_env%ri_grad%mo_coeff_v(ispin)%matrix)
616 630 : DEALLOCATE (mp2_env%ri_grad%mo_coeff_v(ispin)%matrix)
617 : END DO
618 272 : DEALLOCATE (mp2_env%ri_grad%mo_coeff_o, mp2_env%ri_grad%mo_coeff_v)
619 :
620 272 : CALL dbcsr_release(mat_munu%matrix)
621 272 : DEALLOCATE (mat_munu%matrix)
622 :
623 272 : CALL release_neighbor_list_sets(sab_orb_sub)
624 :
625 : END IF
626 :
627 : !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXx
628 : ! moved from above
629 718 : IF (my_do_gw .AND. .NOT. do_im_time) THEN
630 208 : DO ispin = 1, nspins
631 112 : CALL dbcsr_release(mo_coeff_gw(ispin)%matrix)
632 208 : DEALLOCATE (mo_coeff_gw(ispin)%matrix)
633 : END DO
634 96 : DEALLOCATE (mo_coeff_gw)
635 : END IF
636 :
637 : ! re-init the radii to be able to generate pair lists with MP2-appropriate screening
638 718 : dft_control%qs_control%eps_pgf_orb = eps_pgf_orb_old
639 718 : dft_control%qs_control%eps_rho_rspace = eps_rho_rspace_old
640 718 : dft_control%qs_control%eps_gvg_rspace = eps_gvg_rspace_old
641 718 : CALL init_interaction_radii(dft_control%qs_control, qs_kind_set)
642 :
643 718 : CALL cp_blacs_env_release(blacs_env_sub)
644 :
645 718 : IF (.NOT. (mp2_env%ri_g0w0%print_local_bandgap .OR. mp2_env%bse%do_nto_analysis .OR. &
646 : mp2_env%ri_g0w0%do_static_cohsex)) THEN
647 700 : CALL cp_rm_default_logger()
648 700 : CALL cp_logger_release(logger_sub)
649 : END IF
650 :
651 718 : CALL mp_para_env_release(para_env_sub)
652 :
653 : ! finally solve the z-vector equation if forces are required
654 718 : IF (calc_forces .AND. .NOT. do_im_time) THEN
655 : CALL solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, &
656 272 : mo_coeff, homo, Eigenval, unit_nr)
657 : END IF
658 :
659 718 : DEALLOCATE (Eigenval, mo_coeff)
660 :
661 : ! buffers of the tensor operations (e.g., low-scaling RPA/GW) are not kept beyond this point
662 718 : CALL dbt_clear_mempools()
663 :
664 718 : CALL timestop(handle)
665 :
666 6018 : END SUBROUTINE mp2_gpw_main
667 :
668 : ! **************************************************************************************************
669 : !> \brief ...
670 : !> \param para_env ...
671 : !> \param para_env_sub ...
672 : !> \param mo_coeff ...
673 : !> \param homo ...
674 : !> \param mat_munu ...
675 : !> \param mo_coeff_o ...
676 : !> \param mo_coeff_v ...
677 : !> \param mo_coeff_all ...
678 : !> \param mo_coeff_gw ...
679 : !> \param my_do_gw ...
680 : !> \param gw_corr_lev_occ ...
681 : !> \param gw_corr_lev_virt ...
682 : !> \param my_do_bse ...
683 : !> \param bse_lev_virt ...
684 : !> \param mo_coeff_o_bse ...
685 : !> \param mo_coeff_v_bse ...
686 : !> \param eps_filter ...
687 : ! **************************************************************************************************
688 706 : SUBROUTINE replicate_mat_to_subgroup(para_env, para_env_sub, mo_coeff, homo, mat_munu, &
689 : mo_coeff_o, mo_coeff_v, mo_coeff_all, mo_coeff_gw, my_do_gw, &
690 : gw_corr_lev_occ, gw_corr_lev_virt, my_do_bse, &
691 : bse_lev_virt, mo_coeff_o_bse, mo_coeff_v_bse, eps_filter)
692 : TYPE(mp_para_env_type), INTENT(IN) :: para_env, para_env_sub
693 : TYPE(cp_fm_type), INTENT(IN) :: mo_coeff
694 : INTEGER, INTENT(IN) :: homo
695 : TYPE(dbcsr_type), INTENT(INOUT) :: mat_munu
696 : TYPE(dbcsr_type), POINTER :: mo_coeff_o, mo_coeff_v, mo_coeff_all, &
697 : mo_coeff_gw
698 : LOGICAL, INTENT(IN) :: my_do_gw
699 : INTEGER, INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt
700 : LOGICAL, INTENT(IN) :: my_do_bse
701 : INTEGER, INTENT(IN) :: bse_lev_virt
702 : TYPE(dbcsr_type), POINTER :: mo_coeff_o_bse, mo_coeff_v_bse
703 : REAL(KIND=dp), INTENT(IN) :: eps_filter
704 :
705 : CHARACTER(LEN=*), PARAMETER :: routineN = 'replicate_mat_to_subgroup'
706 :
707 : INTEGER :: handle
708 706 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: C
709 706 : TYPE(group_dist_d1_type) :: gd_array
710 :
711 706 : CALL timeset(routineN, handle)
712 :
713 706 : CALL grep_rows_in_subgroups(para_env, para_env_sub, mo_coeff, gd_array, C)
714 :
715 : ! create and fill mo_coeff_o, mo_coeff_v and mo_coeff_all
716 706 : ALLOCATE (mo_coeff_o)
717 : CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_o, C(:, 1:homo), &
718 706 : mat_munu, gd_array, eps_filter)
719 :
720 706 : ALLOCATE (mo_coeff_v)
721 : CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_v, C(:, homo + 1:), &
722 706 : mat_munu, gd_array, eps_filter)
723 :
724 706 : IF (my_do_gw) THEN
725 112 : ALLOCATE (mo_coeff_gw)
726 : CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_gw, C(:, homo - gw_corr_lev_occ + 1:homo + gw_corr_lev_virt), &
727 112 : mat_munu, gd_array, eps_filter)
728 :
729 : ! all levels
730 112 : ALLOCATE (mo_coeff_all)
731 : CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_all, C, &
732 112 : mat_munu, gd_array, eps_filter)
733 :
734 : END IF
735 :
736 706 : IF (my_do_bse) THEN
737 :
738 68 : ALLOCATE (mo_coeff_o_bse)
739 : CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_o_bse, C(:, 1:homo), &
740 68 : mat_munu, gd_array, eps_filter)
741 :
742 68 : ALLOCATE (mo_coeff_v_bse)
743 : CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_v_bse, C(:, homo + 1:homo + bse_lev_virt), &
744 68 : mat_munu, gd_array, eps_filter)
745 :
746 : END IF
747 706 : DEALLOCATE (C)
748 706 : CALL release_group_dist(gd_array)
749 :
750 706 : CALL timestop(handle)
751 :
752 706 : END SUBROUTINE replicate_mat_to_subgroup
753 :
754 : ! **************************************************************************************************
755 : !> \brief ...
756 : !> \param para_env ...
757 : !> \param para_env_sub ...
758 : !> \param mo_coeff ...
759 : !> \param gd_array ...
760 : !> \param C ...
761 : ! **************************************************************************************************
762 828 : SUBROUTINE grep_rows_in_subgroups(para_env, para_env_sub, mo_coeff, gd_array, C)
763 : TYPE(mp_para_env_type), INTENT(IN) :: para_env, para_env_sub
764 : TYPE(cp_fm_type), INTENT(IN) :: mo_coeff
765 : TYPE(group_dist_d1_type), INTENT(OUT) :: gd_array
766 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :), &
767 : INTENT(OUT) :: C
768 :
769 : CHARACTER(LEN=*), PARAMETER :: routineN = 'grep_rows_in_subgroups'
770 :
771 : INTEGER :: handle, i_global, iiB, j_global, jjB, max_row_col_local, my_mu_end, my_mu_size, &
772 : my_mu_start, ncol_global, ncol_local, ncol_rec, nrow_global, nrow_local, nrow_rec, &
773 : proc_receive_static, proc_send_static, proc_shift
774 828 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: local_col_row_info, rec_col_row_info
775 828 : INTEGER, DIMENSION(:), POINTER :: col_indices, col_indices_rec, &
776 828 : row_indices, row_indices_rec
777 828 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: local_C, rec_C
778 : REAL(KIND=dp), CONTIGUOUS, DIMENSION(:, :), &
779 828 : POINTER :: local_C_internal
780 :
781 828 : CALL timeset(routineN, handle)
782 :
783 : CALL cp_fm_get_info(matrix=mo_coeff, &
784 : ncol_global=ncol_global, &
785 : nrow_global=nrow_global, &
786 : nrow_local=nrow_local, &
787 : ncol_local=ncol_local, &
788 : row_indices=row_indices, &
789 : col_indices=col_indices, &
790 828 : local_data=local_C_internal)
791 :
792 828 : CALL create_group_dist(gd_array, para_env_sub%num_pe, nrow_global)
793 828 : CALL get_group_dist(gd_array, para_env_sub%mepos, my_mu_start, my_mu_end, my_mu_size)
794 :
795 : ! local storage for the C matrix
796 3312 : ALLOCATE (C(my_mu_size, ncol_global))
797 828 : C = 0.0_dp
798 :
799 3312 : ALLOCATE (local_C(nrow_local, ncol_local))
800 192697 : local_C(:, :) = local_C_internal(1:nrow_local, 1:ncol_local)
801 828 : NULLIFY (local_C_internal)
802 :
803 828 : max_row_col_local = MAX(nrow_local, ncol_local)
804 828 : CALL para_env%max(max_row_col_local)
805 :
806 3312 : ALLOCATE (local_col_row_info(0:max_row_col_local, 2))
807 828 : local_col_row_info = 0
808 : ! 0,1 nrows
809 828 : local_col_row_info(0, 1) = nrow_local
810 8373 : local_col_row_info(1:nrow_local, 1) = row_indices(1:nrow_local)
811 : ! 0,2 ncols
812 828 : local_col_row_info(0, 2) = ncol_local
813 15254 : local_col_row_info(1:ncol_local, 2) = col_indices(1:ncol_local)
814 :
815 1656 : ALLOCATE (rec_col_row_info(0:max_row_col_local, 2))
816 :
817 : ! accumulate data on C buffer starting from myself
818 8373 : DO iiB = 1, nrow_local
819 7545 : i_global = row_indices(iiB)
820 8373 : IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN
821 183793 : DO jjB = 1, ncol_local
822 176399 : j_global = col_indices(jjB)
823 183793 : C(i_global - my_mu_start + 1, j_global) = local_C(iiB, jjB)
824 : END DO
825 : END IF
826 : END DO
827 :
828 : ! start ring communication for collecting the data from the other
829 828 : proc_send_static = MODULO(para_env%mepos + 1, para_env%num_pe)
830 828 : proc_receive_static = MODULO(para_env%mepos - 1, para_env%num_pe)
831 1656 : DO proc_shift = 1, para_env%num_pe - 1
832 : ! first exchange information on the local data
833 828 : rec_col_row_info = 0
834 828 : CALL para_env%sendrecv(local_col_row_info, proc_send_static, rec_col_row_info, proc_receive_static)
835 828 : nrow_rec = rec_col_row_info(0, 1)
836 828 : ncol_rec = rec_col_row_info(0, 2)
837 :
838 2484 : ALLOCATE (row_indices_rec(nrow_rec))
839 8373 : row_indices_rec = rec_col_row_info(1:nrow_rec, 1)
840 :
841 2484 : ALLOCATE (col_indices_rec(ncol_rec))
842 15254 : col_indices_rec = rec_col_row_info(1:ncol_rec, 2)
843 :
844 3312 : ALLOCATE (rec_C(nrow_rec, ncol_rec))
845 828 : rec_C = 0.0_dp
846 :
847 : ! then send and receive the real data
848 828 : CALL para_env%sendrecv(local_C, proc_send_static, rec_C, proc_receive_static)
849 :
850 : ! accumulate the received data on C buffer
851 8373 : DO iiB = 1, nrow_rec
852 7545 : i_global = row_indices_rec(iiB)
853 8373 : IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN
854 174388 : DO jjB = 1, ncol_rec
855 167574 : j_global = col_indices_rec(jjB)
856 174388 : C(i_global - my_mu_start + 1, j_global) = rec_C(iiB, jjB)
857 : END DO
858 : END IF
859 : END DO
860 :
861 33356 : local_col_row_info(:, :) = rec_col_row_info
862 828 : DEALLOCATE (local_C)
863 2484 : ALLOCATE (local_C(nrow_rec, ncol_rec))
864 192697 : local_C(:, :) = rec_C
865 :
866 828 : DEALLOCATE (col_indices_rec)
867 828 : DEALLOCATE (row_indices_rec)
868 1656 : DEALLOCATE (rec_C)
869 : END DO
870 :
871 828 : DEALLOCATE (local_C)
872 828 : DEALLOCATE (local_col_row_info)
873 828 : DEALLOCATE (rec_col_row_info)
874 :
875 828 : CALL timestop(handle)
876 :
877 3312 : END SUBROUTINE grep_rows_in_subgroups
878 :
879 : ! **************************************************************************************************
880 : !> \brief Encapsulate the building of dbcsr_matrices mo_coeff_(v,o,all)
881 : !> \param para_env_sub ...
882 : !> \param mo_coeff_to_build ...
883 : !> \param Cread ...
884 : !> \param mat_munu ...
885 : !> \param gd_array ...
886 : !> \param eps_filter ...
887 : !> \author Jan Wilhelm, Code by Mauro Del Ben
888 : ! **************************************************************************************************
889 1894 : SUBROUTINE build_dbcsr_from_rows(para_env_sub, mo_coeff_to_build, Cread, &
890 : mat_munu, gd_array, eps_filter)
891 : TYPE(mp_para_env_type), INTENT(IN) :: para_env_sub
892 : TYPE(dbcsr_type) :: mo_coeff_to_build
893 : REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: Cread
894 : TYPE(dbcsr_type), INTENT(INOUT) :: mat_munu
895 : TYPE(group_dist_d1_type), INTENT(IN) :: gd_array
896 : REAL(KIND=dp), INTENT(IN) :: eps_filter
897 :
898 : CHARACTER(LEN=*), PARAMETER :: routineN = 'build_dbcsr_from_rows'
899 :
900 : INTEGER :: col, col_offset, col_size, handle, i, i_global, j, j_global, my_mu_end, &
901 : my_mu_start, ncol_global, proc_receive, proc_send, proc_shift, rec_mu_end, rec_mu_size, &
902 : rec_mu_start, row, row_offset, row_size
903 1894 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: rec_C
904 1894 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: data_block
905 : TYPE(dbcsr_iterator_type) :: iter
906 :
907 1894 : CALL timeset(routineN, handle)
908 :
909 1894 : ncol_global = SIZE(Cread, 2)
910 :
911 1894 : CALL get_group_dist(gd_array, para_env_sub%mepos, my_mu_start, my_mu_end)
912 :
913 : CALL cp_dbcsr_m_by_n_from_row_template(mo_coeff_to_build, template=mat_munu, n=ncol_global, &
914 1894 : sym=dbcsr_type_no_symmetry)
915 1894 : CALL dbcsr_reserve_all_blocks(mo_coeff_to_build)
916 :
917 : ! accumulate data on mo_coeff_to_build starting from myself
918 1894 : CALL dbcsr_iterator_start(iter, mo_coeff_to_build)
919 7118 : DO WHILE (dbcsr_iterator_blocks_left(iter))
920 : CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
921 : row_size=row_size, col_size=col_size, &
922 5224 : row_offset=row_offset, col_offset=col_offset)
923 49462 : DO i = 1, row_size
924 42344 : i_global = row_offset + i - 1
925 47568 : IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN
926 660315 : DO j = 1, col_size
927 618356 : j_global = col_offset + j - 1
928 660315 : data_block(i, j) = Cread(i_global - my_mu_start + 1, col_offset + j - 1)
929 : END DO
930 : END IF
931 : END DO
932 : END DO
933 1894 : CALL dbcsr_iterator_stop(iter)
934 :
935 : ! start ring communication in the subgroup for collecting the data from the other
936 : ! proc (occupied)
937 2066 : DO proc_shift = 1, para_env_sub%num_pe - 1
938 172 : proc_send = MODULO(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
939 172 : proc_receive = MODULO(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
940 :
941 172 : CALL get_group_dist(gd_array, proc_receive, rec_mu_start, rec_mu_end, rec_mu_size)
942 :
943 688 : ALLOCATE (rec_C(rec_mu_size, ncol_global))
944 172 : rec_C = 0.0_dp
945 :
946 : ! then send and receive the real data
947 11262 : CALL para_env_sub%sendrecv(Cread, proc_send, rec_C, proc_receive)
948 :
949 : ! accumulate data on mo_coeff_to_build the data received from proc_rec
950 172 : CALL dbcsr_iterator_start(iter, mo_coeff_to_build)
951 396 : DO WHILE (dbcsr_iterator_blocks_left(iter))
952 : CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
953 : row_size=row_size, col_size=col_size, &
954 224 : row_offset=row_offset, col_offset=col_offset)
955 1616 : DO i = 1, row_size
956 1220 : i_global = row_offset + i - 1
957 1444 : IF (i_global >= rec_mu_start .AND. i_global <= rec_mu_end) THEN
958 2853 : DO j = 1, col_size
959 2468 : j_global = col_offset + j - 1
960 2853 : data_block(i, j) = rec_C(i_global - rec_mu_start + 1, col_offset + j - 1)
961 : END DO
962 : END IF
963 : END DO
964 : END DO
965 172 : CALL dbcsr_iterator_stop(iter)
966 :
967 2410 : DEALLOCATE (rec_C)
968 :
969 : END DO
970 1894 : CALL dbcsr_filter(mo_coeff_to_build, eps_filter)
971 :
972 1894 : CALL timestop(handle)
973 :
974 3788 : END SUBROUTINE build_dbcsr_from_rows
975 :
976 : ! **************************************************************************************************
977 : !> \brief Encapsulate the building of dbcsr_matrix mat_munu
978 : !> \param mat_munu ...
979 : !> \param qs_env ...
980 : !> \param eps_grid ...
981 : !> \param blacs_env_sub ...
982 : !> \param do_ri_aux_basis ...
983 : !> \param do_mixed_basis ...
984 : !> \param group_size_prim ...
985 : !> \param do_alloc_blocks_from_nbl ...
986 : !> \param do_kpoints ...
987 : !> \param sab_orb_sub ...
988 : !> \param dbcsr_sym_type ...
989 : !> \param custom_row_blk_sizes ...
990 : !> \author Jan Wilhelm, code by Mauro Del Ben
991 : ! **************************************************************************************************
992 2608 : SUBROUTINE create_mat_munu(mat_munu, qs_env, eps_grid, blacs_env_sub, &
993 : do_ri_aux_basis, do_mixed_basis, group_size_prim, &
994 : do_alloc_blocks_from_nbl, do_kpoints, sab_orb_sub, dbcsr_sym_type, &
995 1304 : custom_row_blk_sizes)
996 :
997 : TYPE(dbcsr_p_type), INTENT(OUT) :: mat_munu
998 : TYPE(qs_environment_type), POINTER :: qs_env
999 : REAL(KIND=dp) :: eps_grid
1000 : TYPE(cp_blacs_env_type), POINTER :: blacs_env_sub
1001 : LOGICAL, INTENT(IN), OPTIONAL :: do_ri_aux_basis, do_mixed_basis
1002 : INTEGER, INTENT(IN), OPTIONAL :: group_size_prim
1003 : LOGICAL, INTENT(IN), OPTIONAL :: do_alloc_blocks_from_nbl, do_kpoints
1004 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1005 : OPTIONAL, POINTER :: sab_orb_sub
1006 : CHARACTER, OPTIONAL :: dbcsr_sym_type
1007 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: custom_row_blk_sizes
1008 :
1009 : CHARACTER(LEN=*), PARAMETER :: routineN = 'create_mat_munu'
1010 :
1011 : CHARACTER :: my_dbcsr_sym_type
1012 : INTEGER :: handle, ikind, natom, nkind
1013 1304 : INTEGER, DIMENSION(:), POINTER :: col_blk_sizes, row_blk_sizes
1014 : LOGICAL :: my_do_alloc_blocks_from_nbl, &
1015 : my_do_kpoints, my_do_mixed_basis, &
1016 : my_do_ri_aux_basis
1017 1304 : LOGICAL, ALLOCATABLE, DIMENSION(:) :: orb_present
1018 1304 : REAL(dp), ALLOCATABLE, DIMENSION(:) :: orb_radius
1019 1304 : REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: pair_radius
1020 : REAL(KIND=dp) :: subcells
1021 1304 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1022 : TYPE(cell_type), POINTER :: cell
1023 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist_sub
1024 : TYPE(dft_control_type), POINTER :: dft_control
1025 : TYPE(distribution_1d_type), POINTER :: local_molecules_sub, local_particles_sub
1026 : TYPE(distribution_2d_type), POINTER :: distribution_2d_sub
1027 1304 : TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: basis_set_ri_aux
1028 : TYPE(gto_basis_set_type), POINTER :: orb_basis_set
1029 1304 : TYPE(local_atoms_type), ALLOCATABLE, DIMENSION(:) :: atom2d
1030 1304 : TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set
1031 1304 : TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set
1032 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1033 1304 : POINTER :: my_sab_orb_sub
1034 1304 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1035 1304 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1036 :
1037 1304 : CALL timeset(routineN, handle)
1038 :
1039 1304 : NULLIFY (basis_set_ri_aux)
1040 :
1041 1304 : my_do_ri_aux_basis = .FALSE.
1042 1304 : IF (PRESENT(do_ri_aux_basis)) THEN
1043 478 : my_do_ri_aux_basis = do_ri_aux_basis
1044 : END IF
1045 :
1046 1304 : my_do_mixed_basis = .FALSE.
1047 1304 : IF (PRESENT(do_mixed_basis)) THEN
1048 0 : my_do_mixed_basis = do_mixed_basis
1049 : END IF
1050 :
1051 1304 : my_do_alloc_blocks_from_nbl = .FALSE.
1052 1304 : IF (PRESENT(do_alloc_blocks_from_nbl)) THEN
1053 826 : my_do_alloc_blocks_from_nbl = do_alloc_blocks_from_nbl
1054 : END IF
1055 :
1056 1304 : my_do_kpoints = .FALSE.
1057 1304 : IF (PRESENT(do_kpoints)) THEN
1058 862 : my_do_kpoints = do_kpoints
1059 : END IF
1060 :
1061 1304 : my_dbcsr_sym_type = dbcsr_type_no_symmetry
1062 1304 : IF (PRESENT(dbcsr_sym_type)) THEN
1063 826 : my_dbcsr_sym_type = dbcsr_sym_type
1064 : END IF
1065 :
1066 : CALL get_qs_env(qs_env, &
1067 : qs_kind_set=qs_kind_set, &
1068 : cell=cell, &
1069 : particle_set=particle_set, &
1070 : atomic_kind_set=atomic_kind_set, &
1071 : molecule_set=molecule_set, &
1072 : molecule_kind_set=molecule_kind_set, &
1073 1304 : dft_control=dft_control)
1074 :
1075 1304 : IF (my_do_kpoints) THEN
1076 : ! please choose EPS_PGF_ORB in QS section smaller than EPS_GRID in WFC_GPW section
1077 12 : IF (eps_grid < dft_control%qs_control%eps_pgf_orb) THEN
1078 0 : eps_grid = dft_control%qs_control%eps_pgf_orb
1079 0 : CPWARN("WFC_GPW%EPS_GRID has been set to QS%EPS_PGF_ORB")
1080 : END IF
1081 : END IF
1082 :
1083 : ! hack hack hack XXXXXXXXXXXXXXX ... to be fixed
1084 1304 : dft_control%qs_control%eps_pgf_orb = eps_grid
1085 1304 : dft_control%qs_control%eps_rho_rspace = eps_grid
1086 1304 : dft_control%qs_control%eps_gvg_rspace = eps_grid
1087 1304 : CALL init_interaction_radii(dft_control%qs_control, qs_kind_set)
1088 :
1089 : ! get a distribution_1d
1090 1304 : NULLIFY (local_particles_sub, local_molecules_sub)
1091 : CALL distribute_molecules_1d(atomic_kind_set=atomic_kind_set, &
1092 : particle_set=particle_set, &
1093 : local_particles=local_particles_sub, &
1094 : molecule_kind_set=molecule_kind_set, &
1095 : molecule_set=molecule_set, &
1096 : local_molecules=local_molecules_sub, &
1097 1304 : force_env_section=qs_env%input)
1098 :
1099 : ! get a distribution_2d
1100 1304 : NULLIFY (distribution_2d_sub)
1101 : CALL distribute_molecules_2d(cell=cell, &
1102 : atomic_kind_set=atomic_kind_set, &
1103 : qs_kind_set=qs_kind_set, &
1104 : particle_set=particle_set, &
1105 : molecule_kind_set=molecule_kind_set, &
1106 : molecule_set=molecule_set, &
1107 : distribution_2d=distribution_2d_sub, &
1108 : blacs_env=blacs_env_sub, &
1109 1304 : force_env_section=qs_env%input)
1110 :
1111 : ! Build the sub orbital-orbital overlap neighbor lists
1112 1304 : CALL section_vals_val_get(qs_env%input, "DFT%SUBCELLS", r_val=subcells)
1113 1304 : nkind = SIZE(atomic_kind_set)
1114 6122 : ALLOCATE (atom2d(nkind))
1115 :
1116 : CALL atom2d_build(atom2d, local_particles_sub, distribution_2d_sub, atomic_kind_set, &
1117 1304 : molecule_set, molecule_only=.FALSE., particle_set=particle_set)
1118 :
1119 3912 : ALLOCATE (orb_present(nkind))
1120 3912 : ALLOCATE (orb_radius(nkind))
1121 5216 : ALLOCATE (pair_radius(nkind, nkind))
1122 :
1123 3514 : DO ikind = 1, nkind
1124 2210 : CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set)
1125 3514 : IF (ASSOCIATED(orb_basis_set)) THEN
1126 2210 : orb_present(ikind) = .TRUE.
1127 2210 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, kind_radius=orb_radius(ikind))
1128 : ELSE
1129 0 : orb_present(ikind) = .FALSE.
1130 0 : orb_radius(ikind) = 0.0_dp
1131 : END IF
1132 : END DO
1133 :
1134 1304 : CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius)
1135 :
1136 1304 : IF (PRESENT(sab_orb_sub)) THEN
1137 826 : NULLIFY (sab_orb_sub)
1138 : ! for cubic RPA/GW with kpoints, we need all neighbors and not only the symmetric ones
1139 826 : IF (my_do_kpoints) THEN
1140 : CALL build_neighbor_lists(sab_orb_sub, particle_set, atom2d, cell, pair_radius, &
1141 : mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb_sub", &
1142 6 : symmetric=.FALSE.)
1143 : ELSE
1144 : CALL build_neighbor_lists(sab_orb_sub, particle_set, atom2d, cell, pair_radius, &
1145 820 : mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb_sub")
1146 : END IF
1147 : ELSE
1148 478 : NULLIFY (my_sab_orb_sub)
1149 : ! for cubic RPA/GW with kpoints, we need all neighbors and not only the symmetric ones
1150 478 : IF (my_do_kpoints) THEN
1151 : CALL build_neighbor_lists(my_sab_orb_sub, particle_set, atom2d, cell, pair_radius, &
1152 : mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb_sub", &
1153 6 : symmetric=.FALSE.)
1154 : ELSE
1155 : CALL build_neighbor_lists(my_sab_orb_sub, particle_set, atom2d, cell, pair_radius, &
1156 472 : mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb_sub")
1157 : END IF
1158 : END IF
1159 1304 : CALL atom2d_cleanup(atom2d)
1160 1304 : DEALLOCATE (atom2d)
1161 1304 : DEALLOCATE (orb_present, orb_radius, pair_radius)
1162 :
1163 : ! a dbcsr_dist
1164 1304 : ALLOCATE (dbcsr_dist_sub)
1165 1304 : CALL cp_dbcsr_dist2d_to_dist(distribution_2d_sub, dbcsr_dist_sub)
1166 :
1167 : ! build a dbcsr matrix the hard way
1168 1304 : natom = SIZE(particle_set)
1169 3912 : ALLOCATE (row_blk_sizes(natom))
1170 1304 : IF (my_do_ri_aux_basis) THEN
1171 380 : IF (PRESENT(custom_row_blk_sizes)) THEN
1172 138 : CPASSERT(SIZE(custom_row_blk_sizes) == natom)
1173 466 : row_blk_sizes(:) = custom_row_blk_sizes
1174 : ELSE
1175 906 : ALLOCATE (basis_set_ri_aux(nkind))
1176 242 : CALL basis_set_list_setup(basis_set_ri_aux, "RI_AUX", qs_kind_set)
1177 242 : CALL get_particle_set(particle_set, qs_kind_set, nsgf=row_blk_sizes, basis=basis_set_ri_aux)
1178 242 : DEALLOCATE (basis_set_ri_aux)
1179 : END IF
1180 :
1181 924 : ELSE IF (my_do_mixed_basis) THEN
1182 :
1183 0 : ALLOCATE (basis_set_ri_aux(nkind))
1184 0 : CALL basis_set_list_setup(basis_set_ri_aux, "RI_AUX", qs_kind_set)
1185 0 : CALL get_particle_set(particle_set, qs_kind_set, nsgf=row_blk_sizes, basis=basis_set_ri_aux)
1186 0 : DEALLOCATE (basis_set_ri_aux)
1187 :
1188 0 : ALLOCATE (col_blk_sizes(natom))
1189 :
1190 0 : CALL get_particle_set(particle_set, qs_kind_set, nsgf=col_blk_sizes)
1191 0 : col_blk_sizes = col_blk_sizes*group_size_prim
1192 :
1193 : ELSE
1194 924 : CALL get_particle_set(particle_set, qs_kind_set, nsgf=row_blk_sizes)
1195 : END IF
1196 :
1197 : NULLIFY (mat_munu%matrix)
1198 1304 : ALLOCATE (mat_munu%matrix)
1199 :
1200 1304 : IF (my_do_ri_aux_basis) THEN
1201 :
1202 : CALL dbcsr_create(matrix=mat_munu%matrix, &
1203 : name="(ai|munu)", &
1204 : dist=dbcsr_dist_sub, matrix_type=my_dbcsr_sym_type, &
1205 380 : row_blk_size=row_blk_sizes, col_blk_size=row_blk_sizes)
1206 :
1207 924 : ELSE IF (my_do_mixed_basis) THEN
1208 :
1209 : CALL dbcsr_create(matrix=mat_munu%matrix, &
1210 : name="(ai|munu)", &
1211 : dist=dbcsr_dist_sub, matrix_type=my_dbcsr_sym_type, &
1212 0 : row_blk_size=row_blk_sizes, col_blk_size=col_blk_sizes)
1213 :
1214 : ELSE
1215 :
1216 : CALL dbcsr_create(matrix=mat_munu%matrix, &
1217 : name="(ai|munu)", &
1218 : dist=dbcsr_dist_sub, matrix_type=my_dbcsr_sym_type, &
1219 924 : row_blk_size=row_blk_sizes, col_blk_size=row_blk_sizes)
1220 :
1221 924 : IF (my_do_alloc_blocks_from_nbl) THEN
1222 :
1223 682 : IF (PRESENT(sab_orb_sub)) THEN
1224 682 : CALL cp_dbcsr_alloc_block_from_nbl(mat_munu%matrix, sab_orb_sub)
1225 : ELSE
1226 0 : CALL cp_dbcsr_alloc_block_from_nbl(mat_munu%matrix, my_sab_orb_sub)
1227 : END IF
1228 :
1229 : END IF
1230 :
1231 : END IF
1232 :
1233 1304 : DEALLOCATE (row_blk_sizes)
1234 :
1235 1304 : IF (my_do_mixed_basis) THEN
1236 0 : DEALLOCATE (col_blk_sizes)
1237 : END IF
1238 :
1239 1304 : CALL dbcsr_distribution_release(dbcsr_dist_sub)
1240 1304 : DEALLOCATE (dbcsr_dist_sub)
1241 :
1242 1304 : CALL distribution_2d_release(distribution_2d_sub)
1243 :
1244 1304 : CALL distribution_1d_release(local_particles_sub)
1245 1304 : CALL distribution_1d_release(local_molecules_sub)
1246 :
1247 1304 : IF (.NOT. PRESENT(sab_orb_sub)) THEN
1248 478 : CALL release_neighbor_list_sets(my_sab_orb_sub)
1249 : END IF
1250 :
1251 1304 : CALL timestop(handle)
1252 :
1253 5216 : END SUBROUTINE create_mat_munu
1254 :
1255 : ! **************************************************************************************************
1256 : !> \brief ...
1257 : !> \param mat_P_global ...
1258 : !> \param qs_env ...
1259 : !> \param mp2_env ...
1260 : !> \param para_env ...
1261 : ! **************************************************************************************************
1262 144 : SUBROUTINE create_matrix_P(mat_P_global, qs_env, mp2_env, para_env)
1263 :
1264 : TYPE(dbcsr_p_type), INTENT(OUT) :: mat_P_global
1265 : TYPE(qs_environment_type), POINTER :: qs_env
1266 : TYPE(mp2_type) :: mp2_env
1267 : TYPE(mp_para_env_type), POINTER :: para_env
1268 :
1269 : CHARACTER(LEN=*), PARAMETER :: routineN = 'create_matrix_P'
1270 :
1271 : INTEGER :: blacs_grid_layout, handle
1272 : LOGICAL :: blacs_repeatable
1273 : TYPE(cp_blacs_env_type), POINTER :: blacs_env_global
1274 :
1275 144 : CALL timeset(routineN, handle)
1276 :
1277 144 : blacs_grid_layout = BLACS_GRID_SQUARE
1278 144 : blacs_repeatable = .TRUE.
1279 144 : NULLIFY (blacs_env_global)
1280 : CALL cp_blacs_env_create(blacs_env_global, para_env, &
1281 : blacs_grid_layout, &
1282 144 : blacs_repeatable)
1283 :
1284 : CALL create_mat_munu(mat_P_global, qs_env, mp2_env%mp2_gpw%eps_grid, &
1285 : blacs_env_global, do_ri_aux_basis=.TRUE., &
1286 144 : do_kpoints=mp2_env%ri_rpa_im_time%do_im_time_kpoints)
1287 :
1288 144 : CALL dbcsr_reserve_all_blocks(mat_P_global%matrix)
1289 144 : CALL cp_blacs_env_release(blacs_env_global)
1290 :
1291 144 : CALL timestop(handle)
1292 :
1293 144 : END SUBROUTINE create_matrix_P
1294 :
1295 : ! **************************************************************************************************
1296 : !> \brief ...
1297 : !> \param dft_control ...
1298 : !> \param eps_pgf_orb_old ...
1299 : !> \param eps_rho_rspace_old ...
1300 : !> \param eps_gvg_rspace_old ...
1301 : ! **************************************************************************************************
1302 718 : PURE SUBROUTINE get_eps_old(dft_control, eps_pgf_orb_old, eps_rho_rspace_old, eps_gvg_rspace_old)
1303 :
1304 : TYPE(dft_control_type), INTENT(INOUT) :: dft_control
1305 : REAL(kind=dp), INTENT(OUT) :: eps_pgf_orb_old, eps_rho_rspace_old, &
1306 : eps_gvg_rspace_old
1307 :
1308 : ! re-init the radii to be able to generate pair lists with MP2-appropriate screening
1309 718 : eps_pgf_orb_old = dft_control%qs_control%eps_pgf_orb
1310 718 : eps_rho_rspace_old = dft_control%qs_control%eps_rho_rspace
1311 718 : eps_gvg_rspace_old = dft_control%qs_control%eps_gvg_rspace
1312 :
1313 718 : END SUBROUTINE get_eps_old
1314 :
1315 : END MODULE mp2_gpw
|
