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