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 Shared RI-RS polarizability and self-energy assembly.
10 : ! **************************************************************************************************
11 : MODULE gw_ri_rs_chi_sigma_kernels
12 : USE cp_dbcsr_api, ONLY: dbcsr_create,&
13 : dbcsr_distribution_type,&
14 : dbcsr_filter,&
15 : dbcsr_p_type,&
16 : dbcsr_release,&
17 : dbcsr_scale,&
18 : dbcsr_type,&
19 : dbcsr_type_no_symmetry
20 : USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
21 : copy_fm_to_dbcsr
22 : USE cp_fm_types, ONLY: cp_fm_create,&
23 : cp_fm_release,&
24 : cp_fm_type
25 : USE gw_tensor_large_cell_Gamma, ONLY: delete_unnecessary_files
26 : USE gw_utils, ONLY: G_occ_vir
27 : USE kinds, ONLY: dp
28 : USE machine, ONLY: m_flush,&
29 : m_walltime
30 : USE post_scf_bandstructure_types, ONLY: post_scf_bandstructure_type
31 : USE qs_environment_types, ONLY: qs_environment_type
32 : USE ri_rs_matrices, ONLY: build_ri_rs_bare_aux_interaction,&
33 : contract_grid_panels,&
34 : print_matrix_occupation,&
35 : release_dbcsr_topology_and_matrices,&
36 : resolve_grid_panels,&
37 : setup_square_topology
38 : #include "./base/base_uses.f90"
39 :
40 : IMPLICIT NONE
41 : PRIVATE
42 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'gw_ri_rs_chi_sigma_kernels'
43 : PUBLIC :: get_mat_chi_Gamma_tau, compute_Sigma_x, compute_Sigma_c
44 : CONTAINS
45 :
46 : ! **************************************************************************************************
47 : !> \brief Computes χ_PQ(iτ) from the occupied and virtual Green's functions.
48 : !> \param bs_env ...
49 : !> \param mat_chi_Gamma_tau Response matrices χ_PQ(iτ) to be computed
50 : !> \param cutoff grid-centroid distance cutoff; zero disables geometric truncation
51 : ! **************************************************************************************************
52 40 : SUBROUTINE get_mat_chi_Gamma_tau(bs_env, mat_chi_Gamma_tau, cutoff)
53 :
54 : TYPE(post_scf_bandstructure_type), POINTER :: bs_env
55 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mat_chi_Gamma_tau
56 : REAL(KIND=dp), INTENT(IN) :: cutoff
57 :
58 : CHARACTER(LEN=*), PARAMETER :: routineN = 'get_mat_chi_Gamma_tau'
59 :
60 : INTEGER :: handle, i_t, ispin, n_panels
61 40 : INTEGER, ALLOCATABLE, DIMENSION(:) :: pan_first, pan_last
62 : REAL(KIND=dp) :: first_grid_occ, t1, tau
63 80 : TYPE(dbcsr_type) :: matrix_G_occ_ao(1), matrix_G_vir_ao
64 :
65 40 : CALL timeset(routineN, handle)
66 :
67 : ! Panel boundaries for the grid-streaming contraction.
68 : ! The panels are identical for χ, Σ^x and Σ^c, so the count is reported once here for all three stages.
69 :
70 : CALL resolve_grid_panels(bs_env%ri_rs, bs_env%para_env, bs_env%dbcsr_msg_elem_limit, &
71 40 : pan_first, pan_last, cutoff)
72 :
73 40 : n_panels = SIZE(pan_first)
74 40 : IF (bs_env%unit_nr > 0) THEN
75 : WRITE (bs_env%unit_nr, '(T2,A,T74,I9)') &
76 20 : 'Number of batches for χ, Σ matrices', n_panels
77 20 : WRITE (bs_env%unit_nr, '(A)') ' '
78 20 : CALL m_flush(bs_env%unit_nr)
79 : END IF
80 :
81 : ! =========================================================================
82 : ! IMAGINARY TIME LOOP
83 : ! χ_PQ(iτ) = Σ_s g_s · Z^T ( (ϕ G^occ_s ϕ^T) ∘ (ϕ G^vir_s ϕ^T) ) Z
84 : ! (g_s = spin degeneracy)
85 : ! =========================================================================
86 590 : DO i_t = 1, bs_env%num_time_freq_points
87 550 : t1 = m_walltime()
88 550 : tau = bs_env%time_frequency_grid%imaginary_time(i_t)
89 :
90 1180 : DO ispin = 1, bs_env%n_spin
91 :
92 : ! AO-space Green's functions G^occ_µν, G^vir_µν (dense AO x AO, small)
93 : CALL build_G_ao(bs_env, tau, ispin, .TRUE., .FALSE., &
94 630 : bs_env%ri_rs%mat_phi_mu_l, matrix_G_occ_ao(1))
95 : CALL build_G_ao(bs_env, tau, ispin, .FALSE., .TRUE., &
96 630 : bs_env%ri_rs%mat_phi_mu_l, matrix_G_vir_ao)
97 :
98 : ! χ_PQ += g_s · Z^T ( (ϕ G^occ ϕ^T) ∘ (ϕ G^vir ϕ^T) ) Z
99 630 : IF (i_t == 1) THEN
100 : CALL contract_grid_panels(L_A=bs_env%ri_rs%mat_phi_mu_l, M_A=matrix_G_occ_ao, &
101 : L_B=bs_env%ri_rs%mat_phi_mu_l, M_B=matrix_G_vir_ao, &
102 : L_out=bs_env%ri_rs%mat_Z_lP, mat_out=mat_chi_Gamma_tau(i_t:i_t), &
103 : scale=bs_env%spin_degeneracy, eps=bs_env%eps_filter, &
104 : para_env=bs_env%para_env, &
105 : pan_first=pan_first, pan_last=pan_last, &
106 : lb_eq_la=.TRUE., lout_eq_la=.FALSE., &
107 : zero_out=(ispin == 1), &
108 : centroids=bs_env%ri_rs%chunk_centroids, &
109 46 : cutoff=cutoff, grid_occupation=first_grid_occ)
110 : ELSE
111 : CALL contract_grid_panels(L_A=bs_env%ri_rs%mat_phi_mu_l, M_A=matrix_G_occ_ao, &
112 : L_B=bs_env%ri_rs%mat_phi_mu_l, M_B=matrix_G_vir_ao, &
113 : L_out=bs_env%ri_rs%mat_Z_lP, mat_out=mat_chi_Gamma_tau(i_t:i_t), &
114 : scale=bs_env%spin_degeneracy, eps=bs_env%eps_filter, &
115 : para_env=bs_env%para_env, &
116 : pan_first=pan_first, pan_last=pan_last, &
117 : lb_eq_la=.TRUE., lout_eq_la=.FALSE., &
118 : zero_out=(ispin == 1), &
119 : centroids=bs_env%ri_rs%chunk_centroids, &
120 584 : cutoff=cutoff)
121 : END IF
122 :
123 630 : CALL dbcsr_release(matrix_G_occ_ao(1))
124 1180 : CALL dbcsr_release(matrix_G_vir_ao)
125 :
126 : END DO ! ispin
127 :
128 : ! Sparsity reports
129 550 : IF (i_t == 1) THEN
130 : CALL print_matrix_occupation(bs_env%ri_rs%mat_Z_lP, 'Z_lP', bs_env%para_env, bs_env%unit_nr, &
131 40 : bs_env%dbcsr_msg_elem_limit)
132 40 : IF (bs_env%unit_nr > 0) THEN
133 : WRITE (bs_env%unit_nr, '(T2,A,T73,F7.2,A)') &
134 20 : 'Percentage of non-zero matrix elements in G_ll'', χ_ll'', W_ll''', &
135 40 : first_grid_occ*100.0_dp, ' %'
136 20 : CALL m_flush(bs_env%unit_nr)
137 : END IF
138 : CALL print_matrix_occupation(mat_chi_Gamma_tau(i_t)%matrix, 'χ_PQ', &
139 : bs_env%para_env, bs_env%unit_nr, bs_env%dbcsr_msg_elem_limit, &
140 40 : suffix=' for time point 1')
141 40 : IF (bs_env%unit_nr > 0) WRITE (bs_env%unit_nr, '(A)') ' '
142 : END IF
143 :
144 590 : IF (bs_env%unit_nr > 0) THEN
145 : WRITE (bs_env%unit_nr, '(T2,A,I13,A,I3,A,F7.1,A)') &
146 275 : 'Computed χ(iτ,k=0) for time point', i_t, ' /', bs_env%num_time_freq_points, &
147 550 : ', Execution time', m_walltime() - t1, ' s'
148 : END IF
149 :
150 : END DO ! i_t
151 :
152 40 : IF (bs_env%unit_nr > 0) WRITE (bs_env%unit_nr, '(A)') ' '
153 :
154 40 : CALL timestop(handle)
155 :
156 80 : END SUBROUTINE get_mat_chi_Gamma_tau
157 :
158 : ! **************************************************************************************************
159 : !> \brief Computes the exact-exchange part of the GW self-energy:
160 : !> D_μν = Σ_n^occ C_μn C_νn (density matrix = G^occ at τ=0)
161 : !> V^tr_PQ = M^-1 (P|Q)_trunc M^-1 (truncated Coulomb, RI basis)
162 : !> Σ^x_λσ(k=0) = -Σ_ll' ϕ_λ(r_l) [ (ϕ D ϕ^T)_ll' ∘ (Z V^tr Z^T)_ll' ] ϕ_σ(r_l')
163 : !> \param bs_env ...
164 : !> \param qs_env ...
165 : !> \param fm_Sigma_x_Gamma ...
166 : !> \param cutoff grid-centroid distance cutoff; zero disables geometric truncation
167 : ! **************************************************************************************************
168 40 : SUBROUTINE compute_Sigma_x(bs_env, qs_env, fm_Sigma_x_Gamma, cutoff)
169 :
170 : TYPE(post_scf_bandstructure_type), POINTER :: bs_env
171 : TYPE(qs_environment_type), POINTER :: qs_env
172 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: fm_Sigma_x_Gamma
173 : REAL(KIND=dp), INTENT(IN) :: cutoff
174 :
175 : CHARACTER(LEN=*), PARAMETER :: routineN = 'compute_Sigma_x'
176 :
177 : INTEGER :: handle, ispin
178 40 : INTEGER, ALLOCATABLE, DIMENSION(:) :: pan_first, pan_last
179 : REAL(KIND=dp) :: t1
180 80 : TYPE(dbcsr_p_type) :: mat_Sigma_x_Gamma(1)
181 80 : TYPE(dbcsr_type) :: matrix_D_ao(1), matrix_V_aux
182 : TYPE(dbcsr_type), TARGET :: matrix_Sigma_x
183 :
184 40 : CALL timeset(routineN, handle)
185 :
186 40 : t1 = m_walltime()
187 :
188 166 : ALLOCATE (fm_Sigma_x_Gamma(bs_env%n_spin))
189 86 : DO ispin = 1, bs_env%n_spin
190 86 : CALL cp_fm_create(fm_Sigma_x_Gamma(ispin), bs_env%fm_s_Gamma%matrix_struct)
191 : END DO
192 :
193 40 : mat_Sigma_x_Gamma(1)%matrix => matrix_Sigma_x
194 40 : CALL dbcsr_create(matrix_Sigma_x, template=bs_env%mat_ao_ao%matrix)
195 :
196 : CALL resolve_grid_panels(bs_env%ri_rs, bs_env%para_env, bs_env%dbcsr_msg_elem_limit, &
197 40 : pan_first, pan_last, cutoff)
198 :
199 : ! =========================================================================
200 : ! 1. COMPUTE V^tr_PQ (RI x RI)
201 : ! =========================================================================
202 : CALL build_ri_rs_bare_aux_interaction(qs_env, bs_env%fm_Minv_Gamma, bs_env%trunc_coulomb, &
203 40 : bs_env%auto_ri, bs_env%ri_rs%mat_Z_lP, matrix_V_aux)
204 40 : CALL dbcsr_filter(matrix_V_aux, bs_env%eps_filter)
205 :
206 : ! =========================================================================
207 : ! 2. SPIN LOOP FOR EXACT EXCHANGE
208 : ! Σ^x_λσ = -Σ_ll' ϕ_λ(r_l) ( D_ll' V^tr_ll' ) ϕ_σ(r_l')
209 : ! = -ϕ^T ( (ϕ D ϕ^T) ∘ (Z V^tr Z^T) ) ϕ
210 : ! =========================================================================
211 86 : DO ispin = 1, bs_env%n_spin
212 :
213 : ! AO-space density matrix D_µν = G^occ at τ = 0
214 : CALL build_G_ao(bs_env, 0.0_dp, ispin, .TRUE., .FALSE., &
215 46 : bs_env%ri_rs%mat_phi_mu_l, matrix_D_ao(1))
216 :
217 : CALL contract_grid_panels(L_A=bs_env%ri_rs%mat_phi_mu_l, M_A=matrix_D_ao, &
218 : L_B=bs_env%ri_rs%mat_Z_lP, M_B=matrix_V_aux, &
219 : L_out=bs_env%ri_rs%mat_phi_mu_l, mat_out=mat_Sigma_x_Gamma, &
220 : scale=1.0_dp, eps=bs_env%eps_filter, &
221 : para_env=bs_env%para_env, &
222 : pan_first=pan_first, pan_last=pan_last, &
223 : lb_eq_la=.FALSE., lout_eq_la=.TRUE., zero_out=.TRUE., &
224 : centroids=bs_env%ri_rs%chunk_centroids, &
225 46 : cutoff=cutoff)
226 46 : CALL dbcsr_scale(matrix_Sigma_x, -1.0_dp)
227 :
228 46 : CALL dbcsr_release(matrix_D_ao(1))
229 :
230 : ! Data I/O and Export to CP2K Full Matrices
231 86 : CALL copy_dbcsr_to_fm(matrix_Sigma_x, fm_Sigma_x_Gamma(ispin))
232 :
233 : END DO ! ispin
234 :
235 40 : IF (bs_env%unit_nr > 0) THEN
236 : WRITE (bs_env%unit_nr, '(T2,A,T58,A,F7.1,A)') &
237 20 : 'Computed Σ^x(k=0),', ' Execution time', m_walltime() - t1, ' s'
238 20 : WRITE (bs_env%unit_nr, '(A)') ' '
239 : END IF
240 :
241 : ! =========================================================================
242 : ! 3. CLEANUP
243 : ! =========================================================================
244 40 : CALL dbcsr_release(matrix_V_aux)
245 40 : CALL dbcsr_release(matrix_Sigma_x)
246 :
247 40 : CALL timestop(handle)
248 :
249 120 : END SUBROUTINE compute_Sigma_x
250 :
251 : ! **************************************************************************************************
252 : !> \brief Computes the correlation part of the GW self-energy on the imaginary-time grid:
253 : !> Σ^c_λσ(iτ<0) = -Σ_ll' ϕ_λ(r_l) [ (ϕ G^occ ϕ^T)_ll' ∘ (Z W^MIC Z^T)_ll' ] ϕ_σ(r_l')
254 : !> Σ^c_λσ(iτ>0) = +Σ_ll' ϕ_λ(r_l) [ (ϕ G^vir ϕ^T)_ll' ∘ (Z W^MIC Z^T)_ll' ] ϕ_σ(r_l')
255 : !> \param bs_env ...
256 : !> \param fm_W_time ...
257 : !> \param fm_Sigma_c_Gamma_time ...
258 : !> \param cutoff grid-centroid distance cutoff; zero disables geometric truncation
259 : !> \param keep_w_and_files keep W and scratch files for another Sigma_c evaluation
260 : ! **************************************************************************************************
261 54 : SUBROUTINE compute_Sigma_c(bs_env, fm_W_time, fm_Sigma_c_Gamma_time, cutoff, keep_w_and_files)
262 :
263 : TYPE(post_scf_bandstructure_type), POINTER :: bs_env
264 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: fm_W_time
265 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :, :) :: fm_Sigma_c_Gamma_time
266 : REAL(KIND=dp), INTENT(IN) :: cutoff
267 : LOGICAL, INTENT(IN), OPTIONAL :: keep_w_and_files
268 :
269 : CHARACTER(LEN=*), PARAMETER :: routineN = 'compute_Sigma_c'
270 :
271 : CHARACTER(LEN=32) :: sigma_label
272 : INTEGER :: handle, i_sector, i_t, ispin
273 54 : INTEGER, ALLOCATABLE, DIMENSION(:) :: pan_first, pan_last
274 54 : INTEGER, DIMENSION(:), POINTER :: blk_aux, dist_row_aux
275 : LOGICAL :: retain_work
276 : REAL(KIND=dp) :: t1, tau
277 : TYPE(dbcsr_distribution_type) :: dist_aux_aux
278 162 : TYPE(dbcsr_p_type) :: mat_Sigma_tau(2)
279 162 : TYPE(dbcsr_type) :: matrix_G_ao(2), matrix_W_aux
280 162 : TYPE(dbcsr_type), TARGET :: matrix_Sigma_tau(2)
281 :
282 54 : CALL timeset(routineN, handle)
283 :
284 54 : retain_work = .FALSE.
285 54 : IF (PRESENT(keep_w_and_files)) retain_work = keep_w_and_files
286 :
287 : ! =========================================================================
288 : ! 1. SETUP AUXILIARY TOPOLOGY AND PRE-ALLOCATE OUTPUT ARRAYS
289 : ! =========================================================================
290 54 : CALL setup_square_topology(bs_env%ri_rs%mat_Z_lP, 'COL', dist_aux_aux, blk_aux, dist_row_aux)
291 :
292 : CALL resolve_grid_panels(bs_env%ri_rs, bs_env%para_env, bs_env%dbcsr_msg_elem_limit, &
293 54 : pan_first, pan_last, cutoff)
294 :
295 : ! Only the final FM time array persists; DBCSR outputs are streamed one time/spin at a time.
296 2074 : ALLOCATE (fm_Sigma_c_Gamma_time(bs_env%num_time_freq_points, 2, bs_env%n_spin))
297 162 : DO i_sector = 1, 2
298 162 : mat_Sigma_tau(i_sector)%matrix => matrix_Sigma_tau(i_sector)
299 : END DO
300 :
301 : ! =========================================================================
302 : ! 2. IMAGINARY TIME LOOP
303 : ! Σ^c_neg_λσ(iτ) = -ϕ^T ( (ϕ G^occ ϕ^T) ∘ (Z W^MIC Z^T) ) ϕ
304 : ! Σ^c_pos_λσ(iτ) = ϕ^T ( (ϕ G^vir ϕ^T) ∘ (Z W^MIC Z^T) ) ϕ
305 : ! =========================================================================
306 744 : DO i_t = 1, bs_env%num_time_freq_points
307 690 : tau = bs_env%time_frequency_grid%imaginary_time(i_t)
308 :
309 : CALL dbcsr_create(matrix_W_aux, "W_aux", dist_aux_aux, dbcsr_type_no_symmetry, &
310 690 : blk_aux, blk_aux)
311 690 : CALL copy_fm_to_dbcsr(fm_W_time(i_t), matrix_W_aux, keep_sparsity=.FALSE.)
312 690 : CALL dbcsr_filter(matrix_W_aux, bs_env%eps_filter)
313 :
314 1520 : DO ispin = 1, bs_env%n_spin
315 830 : t1 = m_walltime()
316 :
317 : ! AO-space Green's functions G^occ_µν, G^vir_µν (dense AO x AO, small)
318 : CALL build_G_ao(bs_env, tau, ispin, .TRUE., .FALSE., &
319 830 : bs_env%ri_rs%mat_phi_mu_l, matrix_G_ao(1))
320 : CALL build_G_ao(bs_env, tau, ispin, .FALSE., .TRUE., &
321 830 : bs_env%ri_rs%mat_phi_mu_l, matrix_G_ao(2))
322 :
323 2490 : DO i_sector = 1, 2
324 2490 : CALL dbcsr_create(matrix_Sigma_tau(i_sector), template=bs_env%mat_ao_ao%matrix)
325 : END DO
326 :
327 : ! Σ^c_neg and Σ^c_pos in a single panel loop: W_pan = Z_panel × W × Z^T built once
328 : CALL contract_grid_panels(L_A=bs_env%ri_rs%mat_phi_mu_l, M_A=matrix_G_ao, &
329 : L_B=bs_env%ri_rs%mat_Z_lP, M_B=matrix_W_aux, &
330 : L_out=bs_env%ri_rs%mat_phi_mu_l, &
331 : mat_out=mat_Sigma_tau, &
332 : scale=1.0_dp, eps=bs_env%eps_filter, para_env=bs_env%para_env, &
333 : pan_first=pan_first, pan_last=pan_last, &
334 : lb_eq_la=.FALSE., lout_eq_la=.TRUE., zero_out=.TRUE., &
335 830 : centroids=bs_env%ri_rs%chunk_centroids, cutoff=cutoff)
336 830 : CALL dbcsr_scale(matrix_Sigma_tau(1), -1.0_dp)
337 :
338 : ! FM time sector 1 is positive, sector 2 is negative.
339 2490 : DO i_sector = 1, 2
340 1660 : CALL dbcsr_release(matrix_G_ao(i_sector))
341 : CALL cp_fm_create(fm_Sigma_c_Gamma_time(i_t, 3 - i_sector, ispin), &
342 1660 : bs_env%fm_s_Gamma%matrix_struct)
343 : CALL copy_dbcsr_to_fm(matrix_Sigma_tau(i_sector), &
344 2490 : fm_Sigma_c_Gamma_time(i_t, 3 - i_sector, ispin))
345 : END DO
346 :
347 : ! Report the first-time outputs before releasing the current DBCSR pair.
348 830 : IF (i_t == 1) THEN
349 66 : sigma_label = 'Σ^c'
350 66 : IF (bs_env%n_spin == 2 .AND. ispin == 1) sigma_label = 'Σ^c_α'
351 66 : IF (bs_env%n_spin == 2 .AND. ispin == 2) sigma_label = 'Σ^c_β'
352 : CALL print_matrix_occupation(matrix_Sigma_tau(2), &
353 : TRIM(sigma_label)//'(iτ)', bs_env%para_env, bs_env%unit_nr, &
354 66 : bs_env%dbcsr_msg_elem_limit, suffix=' for time point 1')
355 : CALL print_matrix_occupation(matrix_Sigma_tau(1), &
356 : TRIM(sigma_label)//'(-iτ)', bs_env%para_env, bs_env%unit_nr, &
357 66 : bs_env%dbcsr_msg_elem_limit, suffix=' for time point 1')
358 : END IF
359 2490 : DO i_sector = 1, 2
360 2490 : CALL dbcsr_release(matrix_Sigma_tau(i_sector))
361 : END DO
362 :
363 1520 : IF (bs_env%unit_nr > 0) THEN
364 : WRITE (bs_env%unit_nr, '(T2,A,I15,A,I3,A,F7.1,A)') &
365 415 : 'Computed Σ^c(iτ) for time point', i_t, ' /', bs_env%num_time_freq_points, &
366 830 : ', Execution time', m_walltime() - t1, ' s'
367 : END IF
368 :
369 : END DO ! ispin
370 :
371 744 : CALL dbcsr_release(matrix_W_aux)
372 :
373 : END DO ! i_t
374 :
375 : ! The DBCSR topology is local to this contraction.
376 54 : CALL release_dbcsr_topology_and_matrices(dist=dist_aux_aux, mapped_dist=dist_row_aux)
377 :
378 : ! The non-periodic evGW0 path keeps these across Sigma_c evaluations.
379 54 : IF (.NOT. retain_work) THEN
380 0 : CALL cp_fm_release(fm_W_time)
381 0 : CALL delete_unnecessary_files(bs_env)
382 : END IF
383 :
384 54 : CALL timestop(handle)
385 :
386 216 : END SUBROUTINE compute_Sigma_c
387 :
388 : ! **************************************************************************************************
389 : !> \brief Builds the AO-space Green's function operator G^occ/vir_µν (AO x AO DBCSR)
390 : !> \param bs_env ...
391 : !> \param tau ...
392 : !> \param ispin ...
393 : !> \param occ ...
394 : !> \param vir ...
395 : !> \param template ...
396 : !> \param matrix_G_ao ...
397 : ! **************************************************************************************************
398 5932 : SUBROUTINE build_G_ao(bs_env, tau, ispin, occ, vir, template, matrix_G_ao)
399 :
400 : TYPE(post_scf_bandstructure_type), POINTER :: bs_env
401 : REAL(KIND=dp), INTENT(IN) :: tau
402 : INTEGER, INTENT(IN) :: ispin
403 : LOGICAL, INTENT(IN) :: occ, vir
404 : TYPE(dbcsr_type), INTENT(INOUT) :: template
405 : TYPE(dbcsr_type), INTENT(OUT) :: matrix_G_ao
406 :
407 : CHARACTER(LEN=*), PARAMETER :: routineN = 'build_G_ao'
408 :
409 : INTEGER :: handle
410 2966 : INTEGER, DIMENSION(:), POINTER :: blk_ao, dist_row_ao
411 : TYPE(cp_fm_type), POINTER :: fm_G
412 : TYPE(dbcsr_distribution_type) :: dist_ao_ao
413 :
414 2966 : CALL timeset(routineN, handle)
415 :
416 2966 : IF (occ) THEN
417 1506 : fm_G => bs_env%fm_Gocc
418 : ELSE
419 1460 : fm_G => bs_env%fm_Gvir
420 : END IF
421 :
422 2966 : CALL G_occ_vir(bs_env, tau, fm_G, ispin, occ=occ, vir=vir)
423 :
424 2966 : CALL setup_square_topology(template, 'COL', dist_ao_ao, blk_ao, dist_row_ao)
425 : CALL dbcsr_create(matrix_G_ao, name="G_ao", dist=dist_ao_ao, &
426 : matrix_type=dbcsr_type_no_symmetry, &
427 2966 : row_blk_size=blk_ao, col_blk_size=blk_ao)
428 :
429 2966 : CALL copy_fm_to_dbcsr(fm_G, matrix_G_ao, keep_sparsity=.FALSE.)
430 2966 : CALL dbcsr_filter(matrix_G_ao, bs_env%eps_filter)
431 :
432 : ! release only the topology; keep matrix_G_ao for the caller
433 2966 : CALL release_dbcsr_topology_and_matrices(dist=dist_ao_ao, mapped_dist=dist_row_ao)
434 :
435 2966 : CALL timestop(handle)
436 :
437 2966 : END SUBROUTINE build_G_ao
438 :
439 : END MODULE gw_ri_rs_chi_sigma_kernels
|
