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