(git:936074a)
Loading...
Searching...
No Matches
rpa_gw.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Routines for GW, continuous development [Jan Wilhelm]
10!> \par History
11!> 03.2019 created [Frederick Stein]
12!> 12.2022 added periodic GW routines [Jan Wilhelm]
13! **************************************************************************************************
14MODULE rpa_gw
15 USE ai_overlap, ONLY: overlap
16 USE atomic_kind_types, ONLY: atomic_kind_type
17 USE basis_set_types, ONLY: gto_basis_set_p_type,&
18 gto_basis_set_type
19 USE cell_types, ONLY: cell_type,&
20 get_cell
21 USE core_ppnl, ONLY: build_core_ppnl
22 USE cp_cfm_basic_linalg, ONLY: cp_cfm_scale,&
23 cp_cfm_scale_and_add,&
24 cp_cfm_scale_and_add_fm,&
25 cp_cfm_transpose
26 USE cp_cfm_diag, ONLY: cp_cfm_geeig_canon
27 USE cp_cfm_types, ONLY: cp_cfm_create,&
28 cp_cfm_get_info,&
29 cp_cfm_release,&
30 cp_cfm_set_all,&
31 cp_cfm_to_fm,&
32 cp_cfm_type,&
33 cp_fm_to_cfm
34 USE cp_control_types, ONLY: dft_control_type
35 USE cp_dbcsr_api, ONLY: &
36 dbcsr_copy, dbcsr_create, dbcsr_desymmetrize, dbcsr_filter, dbcsr_get_info, dbcsr_init_p, &
37 dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, dbcsr_iterator_start, &
38 dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, dbcsr_p_type, dbcsr_release, &
39 dbcsr_release_p, dbcsr_scale, dbcsr_set, dbcsr_type, dbcsr_type_antisymmetric, &
40 dbcsr_type_no_symmetry
41 USE cp_dbcsr_contrib, ONLY: dbcsr_add_on_diag
42 USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
43 USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
44 copy_fm_to_dbcsr,&
45 dbcsr_allocate_matrix_set,&
46 dbcsr_deallocate_matrix_set
47 USE cp_files, ONLY: close_file,&
48 open_file
49 USE cp_fm_basic_linalg, ONLY: cp_fm_scale_and_add,&
50 cp_fm_uplo_to_full
51 USE cp_fm_cholesky, ONLY: cp_fm_cholesky_decompose,&
52 cp_fm_cholesky_invert
53 USE cp_fm_diag, ONLY: cp_fm_syevd
54 USE cp_fm_struct, ONLY: cp_fm_struct_create,&
55 cp_fm_struct_release,&
56 cp_fm_struct_type
57 USE cp_fm_types, ONLY: &
58 cp_fm_copy_general, cp_fm_create, cp_fm_get_diag, cp_fm_get_info, cp_fm_release, &
59 cp_fm_set_all, cp_fm_to_fm, cp_fm_to_fm_submat, cp_fm_type
60 USE cp_log_handling, ONLY: cp_get_default_logger,&
61 cp_logger_get_default_unit_nr,&
62 cp_logger_type
63 USE cp_output_handling, ONLY: cp_print_key_finished_output,&
64 cp_print_key_unit_nr
65 USE cp_realspace_grid_cube, ONLY: cp_pw_to_cube
66 USE dbt_api, ONLY: &
67 dbt_batched_contract_finalize, dbt_batched_contract_init, dbt_clear, dbt_contract, &
68 dbt_copy, dbt_copy_matrix_to_tensor, dbt_copy_tensor_to_matrix, dbt_create, dbt_destroy, &
69 dbt_get_block, dbt_get_info, dbt_iterator_blocks_left, dbt_iterator_next_block, &
70 dbt_iterator_start, dbt_iterator_stop, dbt_iterator_type, dbt_nblks_total, &
71 dbt_pgrid_create, dbt_pgrid_destroy, dbt_pgrid_type, dbt_type
72 USE hfx_types, ONLY: block_ind_type,&
73 dealloc_containers,&
74 hfx_compression_type
75 USE input_constants, ONLY: gw_pade_approx,&
76 gw_two_pole_model,&
77 ri_rpa_g0w0_crossing_bisection,&
78 ri_rpa_g0w0_crossing_newton,&
79 ri_rpa_g0w0_crossing_z_shot,&
80 soc_none
81 USE input_section_types, ONLY: section_vals_get_subs_vals,&
82 section_vals_type
83 USE kinds, ONLY: default_path_length,&
84 dp
85 USE kpoint_methods, ONLY: kpoint_density_matrices,&
86 kpoint_density_transform,&
87 kpoint_init_cell_index
88 USE kpoint_types, ONLY: get_kpoint_info,&
89 kpoint_create,&
90 kpoint_release,&
91 kpoint_sym_create,&
92 kpoint_type
93 USE machine, ONLY: m_walltime
94 USE mathconstants, ONLY: fourpi,&
95 gaussi,&
96 pi,&
97 twopi,&
98 z_one,&
99 z_zero
100 USE message_passing, ONLY: mp_para_env_type
101 USE mp2_types, ONLY: mp2_type,&
102 one_dim_real_array,&
103 two_dim_int_array
104 USE parallel_gemm_api, ONLY: parallel_gemm
105 USE particle_list_types, ONLY: particle_list_type
106 USE particle_types, ONLY: particle_type
107 USE physcon, ONLY: evolt
108 USE pw_env_types, ONLY: pw_env_get,&
109 pw_env_type
110 USE pw_methods, ONLY: pw_axpy,&
111 pw_copy,&
112 pw_scale,&
113 pw_zero
114 USE pw_pool_types, ONLY: pw_pool_type
115 USE pw_types, ONLY: pw_c1d_gs_type,&
116 pw_r3d_rs_type
117 USE qs_band_structure, ONLY: calculate_kp_orbitals
118 USE qs_collocate_density, ONLY: calculate_rho_elec
119 USE qs_environment_types, ONLY: get_qs_env,&
120 qs_env_release,&
121 qs_environment_type
122 USE qs_force_types, ONLY: qs_force_type
123 USE qs_gamma2kp, ONLY: create_kp_from_gamma
124 USE qs_integral_utils, ONLY: basis_set_list_setup
125 USE qs_kind_types, ONLY: get_qs_kind,&
126 qs_kind_type
127 USE qs_ks_types, ONLY: qs_ks_env_type
128 USE qs_mo_types, ONLY: get_mo_set
129 USE qs_moments, ONLY: build_berry_moment_matrix
130 USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type,&
131 release_neighbor_list_sets
132 USE qs_neighbor_lists, ONLY: setup_neighbor_list
133 USE qs_overlap, ONLY: build_overlap_matrix_simple
134 USE qs_scf_types, ONLY: qs_scf_env_type
135 USE qs_subsys_types, ONLY: qs_subsys_get,&
136 qs_subsys_type
137 USE qs_tensors, ONLY: decompress_tensor
138 USE qs_tensors_types, ONLY: create_2c_tensor
139 USE rpa_gw_ic, ONLY: apply_ic_corr
140 USE rpa_gw_im_time_util, ONLY: get_tensor_3c_overl_int_gw
141 USE rpa_gw_kpoints_util, ONLY: get_mat_cell_t_from_mat_gamma,&
142 mat_kp_from_mat_gamma,&
143 real_space_to_kpoint_transform_rpa
144 USE rpa_im_time, ONLY: compute_periodic_dm
145 USE scf_control_types, ONLY: scf_control_type
146 USE util, ONLY: sort
147 USE virial_types, ONLY: virial_type
148#include "./base/base_uses.f90"
149
150 IMPLICIT NONE
151
152 PRIVATE
153
154 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rpa_gw'
155
156 PUBLIC :: allocate_matrices_gw_im_time, allocate_matrices_gw, compute_gw_self_energy, compute_qp_energies, &
157 deallocate_matrices_gw_im_time, deallocate_matrices_gw, compute_minus_vxc_kpoints, trafo_to_mo_and_kpoints, &
158 get_fermi_level_offset, compute_w_cubic_gw, continuation_pade
159
160CONTAINS
161
162! **************************************************************************************************
163!> \brief ...
164!> \param gw_corr_lev_occ ...
165!> \param gw_corr_lev_virt ...
166!> \param homo ...
167!> \param nmo ...
168!> \param num_integ_points ...
169!> \param unit_nr ...
170!> \param RI_blk_sizes ...
171!> \param do_ic_model ...
172!> \param para_env ...
173!> \param fm_mat_W ...
174!> \param fm_mat_Q ...
175!> \param mo_coeff ...
176!> \param t_3c_overl_int_ao_mo ...
177!> \param t_3c_O_mo_compressed ...
178!> \param t_3c_O_mo_ind ...
179!> \param t_3c_overl_int_gw_RI ...
180!> \param t_3c_overl_int_gw_AO ...
181!> \param starts_array_mc ...
182!> \param ends_array_mc ...
183!> \param t_3c_overl_nnP_ic ...
184!> \param t_3c_overl_nnP_ic_reflected ...
185!> \param matrix_s ...
186!> \param mat_W ...
187!> \param t_3c_overl_int ...
188!> \param t_3c_O_compressed ...
189!> \param t_3c_O_ind ...
190!> \param qs_env ...
191! **************************************************************************************************
192 SUBROUTINE allocate_matrices_gw_im_time(gw_corr_lev_occ, gw_corr_lev_virt, homo, nmo, &
193 num_integ_points, unit_nr, &
194 RI_blk_sizes, do_ic_model, &
195 para_env, fm_mat_W, fm_mat_Q, &
196 mo_coeff, &
197 t_3c_overl_int_ao_mo, t_3c_O_mo_compressed, t_3c_O_mo_ind, &
198 t_3c_overl_int_gw_RI, t_3c_overl_int_gw_AO, &
199 starts_array_mc, ends_array_mc, &
200 t_3c_overl_nnP_ic, t_3c_overl_nnP_ic_reflected, &
201 matrix_s, mat_W, t_3c_overl_int, &
202 t_3c_O_compressed, t_3c_O_ind, &
203 qs_env)
204
205 INTEGER, DIMENSION(:), INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt, homo
206 INTEGER, INTENT(IN) :: nmo, num_integ_points, unit_nr
207 INTEGER, DIMENSION(:), POINTER :: ri_blk_sizes
208 LOGICAL, INTENT(IN) :: do_ic_model
209 TYPE(mp_para_env_type), POINTER :: para_env
210 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
211 INTENT(OUT) :: fm_mat_w
212 TYPE(cp_fm_type), INTENT(IN) :: fm_mat_q
213 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: mo_coeff
214 TYPE(dbt_type) :: t_3c_overl_int_ao_mo
215 TYPE(hfx_compression_type), ALLOCATABLE, &
216 DIMENSION(:) :: t_3c_o_mo_compressed
217 TYPE(two_dim_int_array), ALLOCATABLE, &
218 DIMENSION(:), INTENT(OUT) :: t_3c_o_mo_ind
219 TYPE(dbt_type), ALLOCATABLE, DIMENSION(:), &
220 INTENT(INOUT) :: t_3c_overl_int_gw_ri, &
221 t_3c_overl_int_gw_ao
222 INTEGER, DIMENSION(:), INTENT(IN) :: starts_array_mc, ends_array_mc
223 TYPE(dbt_type), ALLOCATABLE, DIMENSION(:), &
224 INTENT(INOUT) :: t_3c_overl_nnp_ic, &
225 t_3c_overl_nnp_ic_reflected
226 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
227 TYPE(dbcsr_type), POINTER :: mat_w
228 TYPE(dbt_type), DIMENSION(:, :) :: t_3c_overl_int
229 TYPE(hfx_compression_type), DIMENSION(:, :, :) :: t_3c_o_compressed
230 TYPE(block_ind_type), DIMENSION(:, :, :) :: t_3c_o_ind
231 TYPE(qs_environment_type), POINTER :: qs_env
232
233 CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_matrices_gw_im_time'
234
235 INTEGER :: handle, jquad, nspins
236 LOGICAL :: my_open_shell
237 TYPE(dbt_type) :: t_3c_overl_int_ao_mo_beta
238
239 CALL timeset(routinen, handle)
240
241 nspins = SIZE(homo)
242 my_open_shell = (nspins == 2)
243
244 ALLOCATE (t_3c_o_mo_ind(nspins), t_3c_overl_int_gw_ao(nspins), t_3c_overl_int_gw_ri(nspins), &
245 t_3c_overl_nnp_ic(nspins), t_3c_overl_nnp_ic_reflected(nspins), t_3c_o_mo_compressed(nspins))
246 CALL get_tensor_3c_overl_int_gw(t_3c_overl_int, &
247 t_3c_o_compressed, t_3c_o_ind, &
248 t_3c_overl_int_ao_mo, t_3c_o_mo_compressed(1), t_3c_o_mo_ind(1)%array, &
249 t_3c_overl_int_gw_ri(1), t_3c_overl_int_gw_ao(1), &
250 starts_array_mc, ends_array_mc, &
251 mo_coeff(1), matrix_s, &
252 gw_corr_lev_occ(1), gw_corr_lev_virt(1), homo(1), nmo, &
253 para_env, &
254 do_ic_model, &
255 t_3c_overl_nnp_ic(1), t_3c_overl_nnp_ic_reflected(1), &
256 qs_env, unit_nr, do_alpha=.true.)
257
258 IF (my_open_shell) THEN
259
260 CALL get_tensor_3c_overl_int_gw(t_3c_overl_int, &
261 t_3c_o_compressed, t_3c_o_ind, &
262 t_3c_overl_int_ao_mo_beta, t_3c_o_mo_compressed(2), t_3c_o_mo_ind(2)%array, &
263 t_3c_overl_int_gw_ri(2), t_3c_overl_int_gw_ao(2), &
264 starts_array_mc, ends_array_mc, &
265 mo_coeff(2), matrix_s, &
266 gw_corr_lev_occ(2), gw_corr_lev_virt(2), homo(2), nmo, &
267 para_env, &
268 do_ic_model, &
269 t_3c_overl_nnp_ic(2), t_3c_overl_nnp_ic_reflected(2), &
270 qs_env, unit_nr, do_alpha=.false.)
271
272 IF (.NOT. qs_env%mp2_env%ri_g0w0%do_kpoints_Sigma) THEN
273 CALL dbt_destroy(t_3c_overl_int_ao_mo_beta)
274 END IF
275
276 END IF
277
278 ALLOCATE (fm_mat_w(num_integ_points))
279
280 DO jquad = 1, num_integ_points
281
282 CALL cp_fm_create(fm_mat_w(jquad), fm_mat_q%matrix_struct, set_zero=.true.)
283 CALL cp_fm_to_fm(fm_mat_q, fm_mat_w(jquad))
284 CALL cp_fm_set_all(fm_mat_w(jquad), 0.0_dp)
285
286 END DO
287
288 NULLIFY (mat_w)
289 CALL dbcsr_init_p(mat_w)
290 CALL dbcsr_create(matrix=mat_w, &
291 template=matrix_s(1)%matrix, &
292 matrix_type=dbcsr_type_no_symmetry, &
293 row_blk_size=ri_blk_sizes, &
294 col_blk_size=ri_blk_sizes)
295
296 CALL timestop(handle)
297
298 END SUBROUTINE allocate_matrices_gw_im_time
299
300! **************************************************************************************************
301!> \brief ...
302!> \param vec_Sigma_c_gw ...
303!> \param color_rpa_group ...
304!> \param dimen_nm_gw ...
305!> \param gw_corr_lev_occ ...
306!> \param gw_corr_lev_virt ...
307!> \param homo ...
308!> \param nmo ...
309!> \param num_integ_group ...
310!> \param num_integ_points ...
311!> \param unit_nr ...
312!> \param gw_corr_lev_tot ...
313!> \param num_fit_points ...
314!> \param omega_max_fit ...
315!> \param do_minimax_quad ...
316!> \param do_periodic ...
317!> \param do_ri_Sigma_x ...
318!> \param my_do_gw ...
319!> \param first_cycle_periodic_correction ...
320!> \param a_scaling ...
321!> \param Eigenval ...
322!> \param tj ...
323!> \param vec_omega_fit_gw ...
324!> \param vec_Sigma_x_gw ...
325!> \param delta_corr ...
326!> \param Eigenval_last ...
327!> \param Eigenval_scf ...
328!> \param vec_W_gw ...
329!> \param fm_mat_S_gw ...
330!> \param fm_mat_S_gw_work ...
331!> \param para_env ...
332!> \param mp2_env ...
333!> \param kpoints ...
334!> \param nkp ...
335!> \param nkp_self_energy ...
336!> \param do_kpoints_cubic_RPA ...
337!> \param do_kpoints_from_Gamma ...
338! **************************************************************************************************
339 SUBROUTINE allocate_matrices_gw(vec_Sigma_c_gw, color_rpa_group, dimen_nm_gw, &
340 gw_corr_lev_occ, gw_corr_lev_virt, homo, &
341 nmo, num_integ_group, num_integ_points, unit_nr, &
342 gw_corr_lev_tot, num_fit_points, omega_max_fit, &
343 do_minimax_quad, do_periodic, do_ri_Sigma_x, my_do_gw, &
344 first_cycle_periodic_correction, &
345 a_scaling, Eigenval, tj, vec_omega_fit_gw, vec_Sigma_x_gw, &
346 delta_corr, Eigenval_last, Eigenval_scf, vec_W_gw, &
347 fm_mat_S_gw, fm_mat_S_gw_work, &
348 para_env, mp2_env, kpoints, nkp, nkp_self_energy, &
349 do_kpoints_cubic_RPA, do_kpoints_from_Gamma)
350
351 COMPLEX(KIND=dp), ALLOCATABLE, &
352 DIMENSION(:, :, :, :), INTENT(OUT) :: vec_sigma_c_gw
353 INTEGER, INTENT(IN) :: color_rpa_group, dimen_nm_gw
354 INTEGER, DIMENSION(:), INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt, homo
355 INTEGER, INTENT(IN) :: nmo, num_integ_group, num_integ_points, &
356 unit_nr
357 INTEGER, INTENT(INOUT) :: gw_corr_lev_tot, num_fit_points
358 REAL(kind=dp) :: omega_max_fit
359 LOGICAL, INTENT(IN) :: do_minimax_quad, do_periodic, &
360 do_ri_sigma_x, my_do_gw
361 LOGICAL, INTENT(OUT) :: first_cycle_periodic_correction
362 REAL(kind=dp), INTENT(IN) :: a_scaling
363 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
364 INTENT(INOUT) :: eigenval
365 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
366 INTENT(IN) :: tj
367 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
368 INTENT(OUT) :: vec_omega_fit_gw
369 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
370 INTENT(OUT) :: vec_sigma_x_gw
371 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
372 INTENT(INOUT) :: delta_corr
373 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
374 INTENT(OUT) :: eigenval_last, eigenval_scf
375 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), &
376 INTENT(OUT) :: vec_w_gw
377 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_mat_s_gw
378 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
379 INTENT(INOUT) :: fm_mat_s_gw_work
380 TYPE(mp_para_env_type), POINTER :: para_env
381 TYPE(mp2_type) :: mp2_env
382 TYPE(kpoint_type), POINTER :: kpoints
383 INTEGER, INTENT(OUT) :: nkp, nkp_self_energy
384 LOGICAL, INTENT(IN) :: do_kpoints_cubic_rpa, &
385 do_kpoints_from_gamma
386
387 CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_matrices_gw'
388
389 INTEGER :: handle, iquad, ispin, jquad, nspins
390 LOGICAL :: my_open_shell
391 REAL(kind=dp) :: omega
392 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: vec_omega_gw
393
394 CALL timeset(routinen, handle)
395
396 nspins = SIZE(eigenval, 3)
397 my_open_shell = (nspins == 2)
398
399 gw_corr_lev_tot = gw_corr_lev_occ(1) + gw_corr_lev_virt(1)
400
401 ! fill the omega_frequency vector
402 ALLOCATE (vec_omega_gw(num_integ_points))
403 vec_omega_gw = 0.0_dp
404
405 DO jquad = 1, num_integ_points
406 IF (do_minimax_quad) THEN
407 omega = tj(jquad)
408 ELSE
409 omega = a_scaling/tan(tj(jquad))
410 END IF
411 vec_omega_gw(jquad) = omega
412 END DO
413
414 ! determine number of fit points in the interval [0,w_max] for virt, or [-w_max,0] for occ
415 num_fit_points = 0
416
417 DO jquad = 1, num_integ_points
418 IF (vec_omega_gw(jquad) < omega_max_fit) THEN
419 num_fit_points = num_fit_points + 1
420 END IF
421 END DO
422
423 IF (mp2_env%ri_g0w0%analytic_continuation == gw_pade_approx) THEN
424 IF (mp2_env%ri_g0w0%nparam_pade > num_fit_points) THEN
425 IF (unit_nr > 0) WRITE (unit=unit_nr, fmt="(T3,A)") &
426 "Pade approximation: more parameters than data points. Reset # of parameters."
427 mp2_env%ri_g0w0%nparam_pade = num_fit_points
428 IF (unit_nr > 0) WRITE (unit=unit_nr, fmt="(T3,A,T74,I7)") &
429 "Number of pade parameters:", mp2_env%ri_g0w0%nparam_pade
430 END IF
431 END IF
432
433 ! create new arrays containing omega values at which we calculate vec_Sigma_c_gw
434 ALLOCATE (vec_omega_fit_gw(num_fit_points))
435
436 ! fill the omega vector with frequencies, where we calculate the self-energy
437 iquad = 0
438 DO jquad = 1, num_integ_points
439 IF (vec_omega_gw(jquad) < omega_max_fit) THEN
440 iquad = iquad + 1
441 vec_omega_fit_gw(iquad) = vec_omega_gw(jquad)
442 END IF
443 END DO
444
445 DEALLOCATE (vec_omega_gw)
446
447 IF (do_kpoints_cubic_rpa) THEN
448 CALL get_kpoint_info(kpoints, nkp=nkp)
449 IF (mp2_env%ri_g0w0%do_gamma_only_sigma) THEN
450 nkp_self_energy = 1
451 ELSE
452 nkp_self_energy = nkp
453 END IF
454 ELSE IF (do_kpoints_from_gamma) THEN
455 CALL get_kpoint_info(kpoints, nkp=nkp)
456 IF (mp2_env%ri_g0w0%do_kpoints_Sigma) THEN
457 nkp_self_energy = mp2_env%ri_g0w0%nkp_self_energy
458 ELSE
459 nkp_self_energy = 1
460 END IF
461 ELSE
462 nkp = 1
463 nkp_self_energy = 1
464 END IF
465 ALLOCATE (vec_sigma_c_gw(gw_corr_lev_tot, num_fit_points, nkp_self_energy, nspins))
466 vec_sigma_c_gw = z_zero
467
468 ALLOCATE (eigenval_scf(nmo, nkp_self_energy, nspins))
469 eigenval_scf(:, :, :) = eigenval(:, :, :)
470
471 ALLOCATE (eigenval_last(nmo, nkp_self_energy, nspins))
472 eigenval_last(:, :, :) = eigenval(:, :, :)
473
474 IF (do_periodic) THEN
475
476 ALLOCATE (delta_corr(1 + homo(1) - gw_corr_lev_occ(1):homo(1) + gw_corr_lev_virt(1)))
477 delta_corr(:) = 0.0_dp
478
479 first_cycle_periodic_correction = .true.
480
481 END IF
482
483 ALLOCATE (vec_sigma_x_gw(nmo, nkp_self_energy, nspins))
484 vec_sigma_x_gw = 0.0_dp
485
486 IF (my_do_gw) THEN
487
488 ! minimax grids not implemented for O(N^4) GW
489 cpassert(.NOT. do_minimax_quad)
490
491 ! create temporary matrix to store B*([1+Q(iw')]^-1-1), has the same size as B
492 ALLOCATE (fm_mat_s_gw_work(nspins))
493 DO ispin = 1, nspins
494 CALL cp_fm_create(fm_mat_s_gw_work(ispin), fm_mat_s_gw(ispin)%matrix_struct)
495 CALL cp_fm_set_all(matrix=fm_mat_s_gw_work(ispin), alpha=0.0_dp)
496 END DO
497
498 ALLOCATE (vec_w_gw(dimen_nm_gw, nspins))
499 vec_w_gw = 0.0_dp
500
501 ! in case we do RI for Sigma_x, we calculate Sigma_x right here
502 IF (do_ri_sigma_x) THEN
503
504 CALL get_vec_sigma_x(vec_sigma_x_gw(:, :, 1), nmo, fm_mat_s_gw(1), para_env, num_integ_group, color_rpa_group, &
505 homo(1), gw_corr_lev_occ(1), mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 1, 1))
506
507 IF (my_open_shell) THEN
508 CALL get_vec_sigma_x(vec_sigma_x_gw(:, :, 2), nmo, fm_mat_s_gw(2), para_env, num_integ_group, &
509 color_rpa_group, homo(2), gw_corr_lev_occ(2), &
510 mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 2, 1))
511 END IF
512
513 END IF
514
515 END IF
516
517 CALL timestop(handle)
518
519 END SUBROUTINE allocate_matrices_gw
520
521! **************************************************************************************************
522!> \brief ...
523!> \param vec_Sigma_x_gw ...
524!> \param nmo ...
525!> \param fm_mat_S_gw ...
526!> \param para_env ...
527!> \param num_integ_group ...
528!> \param color_rpa_group ...
529!> \param homo ...
530!> \param gw_corr_lev_occ ...
531!> \param vec_Sigma_x_minus_vxc_gw11 ...
532! **************************************************************************************************
533 SUBROUTINE get_vec_sigma_x(vec_Sigma_x_gw, nmo, fm_mat_S_gw, para_env, num_integ_group, color_rpa_group, homo, &
534 gw_corr_lev_occ, vec_Sigma_x_minus_vxc_gw11)
535
536 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: vec_sigma_x_gw
537 INTEGER, INTENT(IN) :: nmo
538 TYPE(cp_fm_type), INTENT(IN) :: fm_mat_s_gw
539 TYPE(mp_para_env_type), POINTER :: para_env
540 INTEGER, INTENT(IN) :: num_integ_group, color_rpa_group, homo, &
541 gw_corr_lev_occ
542 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: vec_sigma_x_minus_vxc_gw11
543
544 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_vec_sigma_x'
545
546 INTEGER :: handle, iib, m_global, n_global, &
547 ncol_local, nm_global, nrow_local
548 INTEGER, DIMENSION(:), POINTER :: col_indices
549
550 CALL timeset(routinen, handle)
551
552 CALL cp_fm_get_info(matrix=fm_mat_s_gw, &
553 nrow_local=nrow_local, &
554 ncol_local=ncol_local, &
555 col_indices=col_indices)
556
557 CALL para_env%sync()
558
559 ! loop over (nm) index
560 DO iib = 1, ncol_local
561
562 ! this is needed for correct values within parallelization
563 IF (modulo(1, num_integ_group) /= color_rpa_group) cycle
564
565 nm_global = col_indices(iib)
566
567 ! transform the index nm to n and m, formulae copied from Mauro's code
568 n_global = max(1, nm_global - 1)/nmo + 1
569 m_global = nm_global - (n_global - 1)*nmo
570 n_global = n_global + homo - gw_corr_lev_occ
571
572 IF (m_global <= homo) THEN
573
574 ! Sigma_x_n = -sum_m^occ sum_P (B_(nm)^P)^2
575 vec_sigma_x_gw(n_global, 1) = &
576 vec_sigma_x_gw(n_global, 1) - &
577 dot_product(fm_mat_s_gw%local_data(:, iib), fm_mat_s_gw%local_data(:, iib))
578
579 END IF
580
581 END DO
582
583 CALL para_env%sync()
584
585 CALL para_env%sum(vec_sigma_x_gw)
586
587 vec_sigma_x_minus_vxc_gw11(:) = &
588 vec_sigma_x_minus_vxc_gw11(:) + &
589 vec_sigma_x_gw(:, 1)
590
591 CALL timestop(handle)
592
593 END SUBROUTINE get_vec_sigma_x
594
595! **************************************************************************************************
596!> \brief ...
597!> \param fm_mat_S_gw_work ...
598!> \param vec_W_gw ...
599!> \param vec_Sigma_c_gw ...
600!> \param vec_omega_fit_gw ...
601!> \param vec_Sigma_x_minus_vxc_gw ...
602!> \param Eigenval_last ...
603!> \param Eigenval_scf ...
604!> \param do_periodic ...
605!> \param matrix_berry_re_mo_mo ...
606!> \param matrix_berry_im_mo_mo ...
607!> \param kpoints ...
608!> \param vec_Sigma_x_gw ...
609!> \param my_do_gw ...
610! **************************************************************************************************
611 SUBROUTINE deallocate_matrices_gw(fm_mat_S_gw_work, vec_W_gw, vec_Sigma_c_gw, vec_omega_fit_gw, &
612 vec_Sigma_x_minus_vxc_gw, Eigenval_last, &
613 Eigenval_scf, do_periodic, matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, kpoints, &
614 vec_Sigma_x_gw, my_do_gw)
615
616 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
617 INTENT(INOUT) :: fm_mat_s_gw_work
618 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), &
619 INTENT(INOUT) :: vec_w_gw
620 COMPLEX(KIND=dp), ALLOCATABLE, &
621 DIMENSION(:, :, :, :), INTENT(INOUT) :: vec_sigma_c_gw
622 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
623 INTENT(INOUT) :: vec_omega_fit_gw
624 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
625 INTENT(INOUT) :: vec_sigma_x_minus_vxc_gw, eigenval_last, &
626 eigenval_scf
627 LOGICAL, INTENT(IN) :: do_periodic
628 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_berry_re_mo_mo, &
629 matrix_berry_im_mo_mo
630 TYPE(kpoint_type), POINTER :: kpoints
631 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
632 INTENT(INOUT) :: vec_sigma_x_gw
633 LOGICAL, INTENT(IN) :: my_do_gw
634
635 CHARACTER(LEN=*), PARAMETER :: routinen = 'deallocate_matrices_gw'
636
637 INTEGER :: handle, nspins
638 LOGICAL :: my_open_shell
639
640 CALL timeset(routinen, handle)
641
642 nspins = SIZE(eigenval_last, 3)
643 my_open_shell = (nspins == 2)
644
645 IF (my_do_gw) THEN
646 CALL cp_fm_release(fm_mat_s_gw_work)
647 DEALLOCATE (vec_sigma_x_minus_vxc_gw)
648 DEALLOCATE (vec_w_gw)
649 END IF
650
651 DEALLOCATE (vec_sigma_c_gw)
652 DEALLOCATE (vec_sigma_x_gw)
653 DEALLOCATE (vec_omega_fit_gw)
654 DEALLOCATE (eigenval_last)
655 DEALLOCATE (eigenval_scf)
656
657 IF (do_periodic) THEN
658 CALL dbcsr_deallocate_matrix_set(matrix_berry_re_mo_mo)
659 CALL dbcsr_deallocate_matrix_set(matrix_berry_im_mo_mo)
660 CALL kpoint_release(kpoints)
661 END IF
662
663 CALL timestop(handle)
664
665 END SUBROUTINE deallocate_matrices_gw
666
667! **************************************************************************************************
668!> \brief ...
669!> \param weights_cos_tf_w_to_t ...
670!> \param weights_sin_tf_t_to_w ...
671!> \param do_ic_model ...
672!> \param do_kpoints_cubic_RPA ...
673!> \param fm_mat_W ...
674!> \param t_3c_overl_int_ao_mo ...
675!> \param t_3c_O_mo_compressed ...
676!> \param t_3c_O_mo_ind ...
677!> \param t_3c_overl_int_gw_RI ...
678!> \param t_3c_overl_int_gw_AO ...
679!> \param t_3c_overl_nnP_ic ...
680!> \param t_3c_overl_nnP_ic_reflected ...
681!> \param mat_W ...
682!> \param qs_env ...
683! **************************************************************************************************
684 SUBROUTINE deallocate_matrices_gw_im_time(weights_cos_tf_w_to_t, weights_sin_tf_t_to_w, do_ic_model, do_kpoints_cubic_RPA, &
685 fm_mat_W, &
686 t_3c_overl_int_ao_mo, t_3c_O_mo_compressed, t_3c_O_mo_ind, &
687 t_3c_overl_int_gw_RI, t_3c_overl_int_gw_AO, &
688 t_3c_overl_nnP_ic, t_3c_overl_nnP_ic_reflected, mat_W, &
689 qs_env)
690
691 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), &
692 INTENT(INOUT) :: weights_cos_tf_w_to_t, &
693 weights_sin_tf_t_to_w
694 LOGICAL, INTENT(IN) :: do_ic_model, do_kpoints_cubic_rpa
695 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
696 INTENT(INOUT) :: fm_mat_w
697 TYPE(dbt_type), INTENT(INOUT) :: t_3c_overl_int_ao_mo
698 TYPE(hfx_compression_type), ALLOCATABLE, &
699 DIMENSION(:) :: t_3c_o_mo_compressed
700 TYPE(two_dim_int_array), ALLOCATABLE, DIMENSION(:) :: t_3c_o_mo_ind
701 TYPE(dbt_type), ALLOCATABLE, DIMENSION(:), &
702 INTENT(INOUT) :: t_3c_overl_int_gw_ri, &
703 t_3c_overl_int_gw_ao, &
704 t_3c_overl_nnp_ic, &
705 t_3c_overl_nnp_ic_reflected
706 TYPE(dbcsr_type), POINTER :: mat_w
707 TYPE(qs_environment_type), POINTER :: qs_env
708
709 CHARACTER(LEN=*), PARAMETER :: routinen = 'deallocate_matrices_gw_im_time'
710
711 INTEGER :: handle, ispin, nspins, unused
712 LOGICAL :: my_open_shell
713
714 CALL timeset(routinen, handle)
715
716 nspins = SIZE(t_3c_overl_int_gw_ri)
717 my_open_shell = (nspins == 2)
718
719 IF (ALLOCATED(weights_cos_tf_w_to_t)) DEALLOCATE (weights_cos_tf_w_to_t)
720 IF (ALLOCATED(weights_sin_tf_t_to_w)) DEALLOCATE (weights_sin_tf_t_to_w)
721
722 IF (.NOT. do_kpoints_cubic_rpa) THEN
723 CALL cp_fm_release(fm_mat_w)
724 CALL dbcsr_release_p(mat_w)
725 END IF
726
727 DO ispin = 1, nspins
728 CALL dbt_destroy(t_3c_overl_int_gw_ri(ispin))
729 CALL dbt_destroy(t_3c_overl_int_gw_ao(ispin))
730 END DO
731 DEALLOCATE (t_3c_overl_int_gw_ao, t_3c_overl_int_gw_ri)
732 IF (do_ic_model) THEN
733 DO ispin = 1, nspins
734 CALL dbt_destroy(t_3c_overl_nnp_ic(ispin))
735 CALL dbt_destroy(t_3c_overl_nnp_ic_reflected(ispin))
736 END DO
737 DEALLOCATE (t_3c_overl_nnp_ic, t_3c_overl_nnp_ic_reflected)
738 END IF
739
740 IF (.NOT. qs_env%mp2_env%ri_g0w0%do_kpoints_Sigma) THEN
741 DO ispin = 1, nspins
742 DEALLOCATE (t_3c_o_mo_ind(ispin)%array)
743 CALL dealloc_containers(t_3c_o_mo_compressed(ispin), unused)
744 END DO
745 DEALLOCATE (t_3c_o_mo_ind, t_3c_o_mo_compressed)
746
747 CALL dbt_destroy(t_3c_overl_int_ao_mo)
748 END IF
749
750 IF (qs_env%mp2_env%ri_g0w0%do_kpoints_Sigma) THEN
751 DO ispin = 1, nspins
752 CALL dbcsr_release(qs_env%mp2_env%ri_g0w0%matrix_sigma_x_minus_vxc(ispin)%matrix)
753 DEALLOCATE (qs_env%mp2_env%ri_g0w0%matrix_sigma_x_minus_vxc(ispin)%matrix)
754
755 CALL dbcsr_release(qs_env%mp2_env%ri_g0w0%matrix_ks(ispin)%matrix)
756 DEALLOCATE (qs_env%mp2_env%ri_g0w0%matrix_ks(ispin)%matrix)
757 END DO
758 DEALLOCATE (qs_env%mp2_env%ri_g0w0%matrix_sigma_x_minus_vxc)
759 DEALLOCATE (qs_env%mp2_env%ri_g0w0%matrix_ks)
760 END IF
761
762 CALL timestop(handle)
763
764 END SUBROUTINE deallocate_matrices_gw_im_time
765
766! **************************************************************************************************
767!> \brief ...
768!> \param vec_Sigma_c_gw ...
769!> \param dimen_nm_gw ...
770!> \param dimen_RI ...
771!> \param gw_corr_lev_occ ...
772!> \param gw_corr_lev_virt ...
773!> \param homo ...
774!> \param jquad ...
775!> \param nmo ...
776!> \param num_fit_points ...
777!> \param do_im_time ...
778!> \param do_periodic ...
779!> \param first_cycle_periodic_correction ...
780!> \param fermi_level_offset ...
781!> \param omega ...
782!> \param Eigenval ...
783!> \param delta_corr ...
784!> \param vec_omega_fit_gw ...
785!> \param vec_W_gw ...
786!> \param wj ...
787!> \param fm_mat_Q ...
788!> \param fm_mat_R_gw ...
789!> \param fm_mat_S_gw ...
790!> \param fm_mat_S_gw_work ...
791!> \param mo_coeff ...
792!> \param para_env ...
793!> \param para_env_RPA ...
794!> \param matrix_berry_im_mo_mo ...
795!> \param matrix_berry_re_mo_mo ...
796!> \param kpoints ...
797!> \param qs_env ...
798!> \param mp2_env ...
799! **************************************************************************************************
800 SUBROUTINE compute_gw_self_energy(vec_Sigma_c_gw, dimen_nm_gw, dimen_RI, gw_corr_lev_occ, &
801 gw_corr_lev_virt, homo, jquad, nmo, num_fit_points, &
802 do_im_time, do_periodic, &
803 first_cycle_periodic_correction, fermi_level_offset, &
804 omega, Eigenval, delta_corr, vec_omega_fit_gw, vec_W_gw, wj, &
805 fm_mat_Q, fm_mat_R_gw, fm_mat_S_gw, &
806 fm_mat_S_gw_work, mo_coeff, para_env, &
807 para_env_RPA, matrix_berry_im_mo_mo, matrix_berry_re_mo_mo, &
808 kpoints, qs_env, mp2_env)
809
810 COMPLEX(KIND=dp), ALLOCATABLE, &
811 DIMENSION(:, :, :, :), INTENT(INOUT) :: vec_sigma_c_gw
812 INTEGER, INTENT(IN) :: dimen_nm_gw, dimen_ri
813 INTEGER, DIMENSION(:), INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt, homo
814 INTEGER, INTENT(IN) :: jquad, nmo, num_fit_points
815 LOGICAL, INTENT(IN) :: do_im_time, do_periodic
816 LOGICAL, INTENT(INOUT) :: first_cycle_periodic_correction
817 REAL(kind=dp), INTENT(INOUT) :: fermi_level_offset, omega
818 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: eigenval
819 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
820 INTENT(INOUT) :: delta_corr
821 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
822 INTENT(IN) :: vec_omega_fit_gw
823 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), &
824 INTENT(INOUT) :: vec_w_gw
825 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
826 INTENT(IN) :: wj
827 TYPE(cp_fm_type), INTENT(IN) :: fm_mat_q, fm_mat_r_gw
828 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_mat_s_gw, fm_mat_s_gw_work
829 TYPE(cp_fm_type), INTENT(IN) :: mo_coeff
830 TYPE(mp_para_env_type), POINTER :: para_env, para_env_rpa
831 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_berry_im_mo_mo, &
832 matrix_berry_re_mo_mo
833 TYPE(kpoint_type), POINTER :: kpoints
834 TYPE(qs_environment_type), POINTER :: qs_env
835 TYPE(mp2_type) :: mp2_env
836
837 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_GW_self_energy'
838
839 INTEGER :: handle, i_global, iib, ispin, j_global, &
840 jjb, ncol_local, nrow_local, nspins
841 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
842
843 CALL timeset(routinen, handle)
844
845 nspins = SIZE(fm_mat_s_gw)
846
847 CALL cp_fm_get_info(matrix=fm_mat_q, &
848 nrow_local=nrow_local, &
849 ncol_local=ncol_local, &
850 row_indices=row_indices, &
851 col_indices=col_indices)
852
853 IF (.NOT. do_im_time) THEN
854 ! calculate [1+Q(iw')]^-1
855 CALL cp_fm_cholesky_invert(fm_mat_q)
856 ! symmetrize the result, fm_mat_R_gw is only temporary work matrix
857 CALL cp_fm_uplo_to_full(fm_mat_q, fm_mat_r_gw)
858
859 ! periodic correction for GW (paper Phys. Rev. B 95, 235123 (2017))
860 IF (do_periodic) THEN
861 CALL calc_periodic_correction(delta_corr, qs_env, para_env, para_env_rpa, &
862 mp2_env%ri_g0w0%kp_grid, homo(1), nmo, gw_corr_lev_occ(1), &
863 gw_corr_lev_virt(1), omega, mo_coeff, eigenval(:, 1), &
864 matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, &
865 first_cycle_periodic_correction, kpoints, &
866 mp2_env%ri_g0w0%do_mo_coeff_gamma, &
867 mp2_env%ri_g0w0%num_kp_grids, mp2_env%ri_g0w0%eps_kpoint, &
868 mp2_env%ri_g0w0%do_extra_kpoints, &
869 mp2_env%ri_g0w0%do_aux_bas_gw, mp2_env%ri_g0w0%frac_aux_mos)
870 END IF
871
872 CALL para_env%sync()
873
874 ! subtract 1 from the diagonal to get rid of exchange self-energy
875!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(jjB,iiB,i_global,j_global) &
876!$OMP SHARED(ncol_local,nrow_local,col_indices,row_indices,fm_mat_Q,dimen_RI)
877 DO jjb = 1, ncol_local
878 j_global = col_indices(jjb)
879 DO iib = 1, nrow_local
880 i_global = row_indices(iib)
881 IF (j_global == i_global .AND. i_global <= dimen_ri) THEN
882 fm_mat_q%local_data(iib, jjb) = fm_mat_q%local_data(iib, jjb) - 1.0_dp
883 END IF
884 END DO
885 END DO
886
887 CALL para_env%sync()
888
889 DO ispin = 1, nspins
890 CALL compute_gw_self_energy_deep(vec_sigma_c_gw(:, :, :, ispin), dimen_nm_gw, dimen_ri, &
891 gw_corr_lev_occ(ispin), gw_corr_lev_virt(ispin), &
892 homo(ispin), jquad, nmo, &
893 num_fit_points, do_periodic, fermi_level_offset, omega, &
894 eigenval(:, ispin), delta_corr, &
895 vec_omega_fit_gw, vec_w_gw(:, ispin), wj, fm_mat_q, &
896 fm_mat_s_gw(ispin), fm_mat_s_gw_work(ispin))
897 END DO
898
899 END IF ! GW
900
901 CALL timestop(handle)
902
903 END SUBROUTINE compute_gw_self_energy
904
905! **************************************************************************************************
906!> \brief ...
907!> \param fermi_level_offset ...
908!> \param fermi_level_offset_input ...
909!> \param Eigenval ...
910!> \param homo ...
911! **************************************************************************************************
912 SUBROUTINE get_fermi_level_offset(fermi_level_offset, fermi_level_offset_input, Eigenval, homo)
913
914 REAL(kind=dp), INTENT(INOUT) :: fermi_level_offset
915 REAL(kind=dp), INTENT(IN) :: fermi_level_offset_input
916 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: eigenval
917 INTEGER, DIMENSION(:), INTENT(IN) :: homo
918
919 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_fermi_level_offset'
920
921 INTEGER :: handle, ispin, nspins
922
923 CALL timeset(routinen, handle)
924
925 nspins = SIZE(eigenval, 2)
926
927 ! Fermi level offset should have a maximum such that the Fermi level of occupied orbitals
928 ! is always closer to occupied orbitals than to virtual orbitals and vice versa
929 ! that means, the Fermi level offset is at most as big as half the bandgap
930 fermi_level_offset = fermi_level_offset_input
931 DO ispin = 1, nspins
932 fermi_level_offset = min(fermi_level_offset, (eigenval(homo(ispin) + 1, ispin) - eigenval(homo(ispin), ispin))*0.5_dp)
933 END DO
934
935 CALL timestop(handle)
936
937 END SUBROUTINE get_fermi_level_offset
938
939! **************************************************************************************************
940!> \brief ...
941!> \param fm_mat_W ...
942!> \param fm_mat_Q ...
943!> \param fm_mat_work ...
944!> \param dimen_RI ...
945!> \param fm_mat_L ...
946!> \param num_integ_points ...
947!> \param tj ...
948!> \param tau_tj ...
949!> \param weights_cos_tf_w_to_t ...
950!> \param jquad ...
951!> \param omega ...
952! **************************************************************************************************
953 SUBROUTINE compute_w_cubic_gw(fm_mat_W, fm_mat_Q, fm_mat_work, dimen_RI, fm_mat_L, num_integ_points, &
954 tj, tau_tj, weights_cos_tf_w_to_t, jquad, omega)
955 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_mat_w
956 TYPE(cp_fm_type), INTENT(IN) :: fm_mat_q, fm_mat_work
957 INTEGER, INTENT(IN) :: dimen_ri
958 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: fm_mat_l
959 INTEGER, INTENT(IN) :: num_integ_points
960 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
961 INTENT(IN) :: tj, tau_tj
962 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), &
963 INTENT(IN) :: weights_cos_tf_w_to_t
964 INTEGER, INTENT(IN) :: jquad
965 REAL(kind=dp), INTENT(INOUT) :: omega
966
967 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_W_cubic_GW'
968
969 INTEGER :: handle, i_global, iib, iquad, j_global, &
970 jjb, ncol_local, nrow_local
971 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
972 REAL(kind=dp) :: tau, weight
973
974 CALL timeset(routinen, handle)
975
976 CALL cp_fm_get_info(matrix=fm_mat_q, &
977 nrow_local=nrow_local, &
978 ncol_local=ncol_local, &
979 row_indices=row_indices, &
980 col_indices=col_indices)
981 ! calculate [1+Q(iw')]^-1
982 CALL cp_fm_cholesky_invert(fm_mat_q)
983
984 ! symmetrize the result
985 CALL cp_fm_uplo_to_full(fm_mat_q, fm_mat_work)
986
987 ! subtract 1 from the diagonal to get rid of exchange self-energy
988!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(jjB,iiB,i_global,j_global) &
989!$OMP SHARED(ncol_local,nrow_local,col_indices,row_indices,fm_mat_Q,dimen_RI)
990 DO jjb = 1, ncol_local
991 j_global = col_indices(jjb)
992 DO iib = 1, nrow_local
993 i_global = row_indices(iib)
994 IF (j_global == i_global .AND. i_global <= dimen_ri) THEN
995 fm_mat_q%local_data(iib, jjb) = fm_mat_q%local_data(iib, jjb) - 1.0_dp
996 END IF
997 END DO
998 END DO
999
1000 ! multiply with L from the left and the right to get the screened Coulomb interaction
1001 CALL parallel_gemm('T', 'N', dimen_ri, dimen_ri, dimen_ri, 1.0_dp, fm_mat_l(1, 1), fm_mat_q, &
1002 0.0_dp, fm_mat_work)
1003
1004 CALL parallel_gemm('N', 'N', dimen_ri, dimen_ri, dimen_ri, 1.0_dp, fm_mat_work, fm_mat_l(1, 1), &
1005 0.0_dp, fm_mat_q)
1006
1007 ! Fourier transform from w to t
1008 DO iquad = 1, num_integ_points
1009
1010 omega = tj(jquad)
1011 tau = tau_tj(iquad)
1012 weight = weights_cos_tf_w_to_t(iquad, jquad)*cos(tau*omega)
1013
1014 IF (jquad == 1) THEN
1015
1016 CALL cp_fm_set_all(matrix=fm_mat_w(iquad), alpha=0.0_dp)
1017
1018 END IF
1019
1020 CALL cp_fm_scale_and_add(alpha=1.0_dp, matrix_a=fm_mat_w(iquad), beta=weight, matrix_b=fm_mat_q)
1021
1022 END DO
1023
1024 CALL timestop(handle)
1025 END SUBROUTINE compute_w_cubic_gw
1026
1027! **************************************************************************************************
1028!> \brief ...
1029!> \param vec_Sigma_c_gw ...
1030!> \param dimen_nm_gw ...
1031!> \param dimen_RI ...
1032!> \param gw_corr_lev_occ ...
1033!> \param gw_corr_lev_virt ...
1034!> \param homo ...
1035!> \param jquad ...
1036!> \param nmo ...
1037!> \param num_fit_points ...
1038!> \param do_periodic ...
1039!> \param fermi_level_offset ...
1040!> \param omega ...
1041!> \param Eigenval ...
1042!> \param delta_corr ...
1043!> \param vec_omega_fit_gw ...
1044!> \param vec_W_gw ...
1045!> \param wj ...
1046!> \param fm_mat_Q ...
1047!> \param fm_mat_S_gw ...
1048!> \param fm_mat_S_gw_work ...
1049! **************************************************************************************************
1050 SUBROUTINE compute_gw_self_energy_deep(vec_Sigma_c_gw, dimen_nm_gw, dimen_RI, &
1051 gw_corr_lev_occ, gw_corr_lev_virt, &
1052 homo, jquad, nmo, num_fit_points, &
1053 do_periodic, fermi_level_offset, omega, Eigenval, &
1054 delta_corr, vec_omega_fit_gw, vec_W_gw, &
1055 wj, fm_mat_Q, fm_mat_S_gw, fm_mat_S_gw_work)
1056
1057 COMPLEX(KIND=dp), DIMENSION(:, :, :), &
1058 INTENT(INOUT) :: vec_sigma_c_gw
1059 INTEGER, INTENT(IN) :: dimen_nm_gw, dimen_ri, gw_corr_lev_occ, &
1060 gw_corr_lev_virt, homo, jquad, nmo, &
1061 num_fit_points
1062 LOGICAL, INTENT(IN) :: do_periodic
1063 REAL(kind=dp), INTENT(IN) :: fermi_level_offset
1064 REAL(kind=dp), INTENT(INOUT) :: omega
1065 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: eigenval
1066 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: delta_corr, vec_omega_fit_gw
1067 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: vec_w_gw
1068 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: wj
1069 TYPE(cp_fm_type), INTENT(IN) :: fm_mat_q, fm_mat_s_gw, fm_mat_s_gw_work
1070
1071 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_GW_self_energy_deep'
1072
1073 INTEGER :: handle, iib, iquad, m_global, n_global, &
1074 ncol_local, nm_global
1075 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
1076 REAL(kind=dp) :: delta_corr_nn, e_fermi, omega_i, &
1077 sign_occ_virt
1078
1079 CALL timeset(routinen, handle)
1080
1081 ! S_work_(nm)Q = B_(nm)P * ([1+Q]^-1-1)_PQ
1082 CALL parallel_gemm(transa="N", transb="N", m=dimen_ri, n=dimen_nm_gw, k=dimen_ri, alpha=1.0_dp, &
1083 matrix_a=fm_mat_q, matrix_b=fm_mat_s_gw, beta=0.0_dp, &
1084 matrix_c=fm_mat_s_gw_work)
1085
1086 CALL cp_fm_get_info(matrix=fm_mat_s_gw, &
1087 ncol_local=ncol_local, &
1088 row_indices=row_indices, &
1089 col_indices=col_indices)
1090
1091 ! vector W_(nm) = S_work_(nm)Q * [B_(nm)Q]^T
1092
1093 vec_w_gw = 0.0_dp
1094
1095 DO iib = 1, ncol_local
1096 nm_global = col_indices(iib)
1097 vec_w_gw(nm_global) = vec_w_gw(nm_global) + &
1098 dot_product(fm_mat_s_gw_work%local_data(:, iib), fm_mat_s_gw%local_data(:, iib))
1099
1100 ! transform the index nm of vec_W_gw back to n and m, formulae copied from Mauro's code
1101 n_global = max(1, nm_global - 1)/nmo + 1
1102 m_global = nm_global - (n_global - 1)*nmo
1103 n_global = n_global + homo - gw_corr_lev_occ
1104
1105 ! compute self-energy for imaginary frequencies
1106 DO iquad = 1, num_fit_points
1107
1108 ! for occ orbitals, we compute the self-energy for negative frequencies
1109 IF (n_global <= homo) THEN
1110 sign_occ_virt = -1.0_dp
1111 ELSE
1112 sign_occ_virt = 1.0_dp
1113 END IF
1114
1115 omega_i = vec_omega_fit_gw(iquad)*sign_occ_virt
1116
1117 ! set the Fermi energy for occ orbitals slightly above the HOMO and
1118 ! for virt orbitals slightly below the LUMO
1119 IF (n_global <= homo) THEN
1120 e_fermi = maxval(eigenval(homo - gw_corr_lev_occ + 1:homo)) + fermi_level_offset
1121 ELSE
1122 e_fermi = minval(eigenval(homo + 1:homo + gw_corr_lev_virt)) - fermi_level_offset
1123 END IF
1124
1125 ! add here the periodic correction
1126 IF (do_periodic .AND. row_indices(1) == 1 .AND. n_global == m_global) THEN
1127 delta_corr_nn = delta_corr(n_global)
1128 ELSE
1129 delta_corr_nn = 0.0_dp
1130 END IF
1131
1132 ! update the self-energy (use that vec_W_gw(iw) is symmetric), divide the integration
1133 ! weight by 2, because the integration is from -infty to +infty and not just 0 to +infty
1134 ! as for RPA, also we need for virtual orbitals a complex conjugate
1135 vec_sigma_c_gw(n_global - homo + gw_corr_lev_occ, iquad, 1) = &
1136 vec_sigma_c_gw(n_global - homo + gw_corr_lev_occ, iquad, 1) - &
1137 0.5_dp/pi*wj(jquad)/2.0_dp*(vec_w_gw(nm_global) + delta_corr_nn)* &
1138 (1.0_dp/(gaussi*(omega + omega_i) + e_fermi - eigenval(m_global)) + &
1139 1.0_dp/(gaussi*(-omega + omega_i) + e_fermi - eigenval(m_global)))
1140 END DO
1141
1142 END DO
1143
1144 CALL timestop(handle)
1145
1146 END SUBROUTINE compute_gw_self_energy_deep
1147
1148! **************************************************************************************************
1149!> \brief ...
1150!> \param vec_Sigma_c_gw ...
1151!> \param count_ev_sc_GW ...
1152!> \param gw_corr_lev_occ ...
1153!> \param gw_corr_lev_tot ...
1154!> \param gw_corr_lev_virt ...
1155!> \param homo ...
1156!> \param nmo ...
1157!> \param num_fit_points ...
1158!> \param num_integ_points ...
1159!> \param unit_nr ...
1160!> \param do_apply_ic_corr_to_gw ...
1161!> \param do_im_time ...
1162!> \param do_periodic ...
1163!> \param do_ri_Sigma_x ...
1164!> \param first_cycle_periodic_correction ...
1165!> \param e_fermi ...
1166!> \param eps_filter ...
1167!> \param fermi_level_offset ...
1168!> \param delta_corr ...
1169!> \param Eigenval ...
1170!> \param Eigenval_last ...
1171!> \param Eigenval_scf ...
1172!> \param iter_sc_GW0 ...
1173!> \param exit_ev_gw ...
1174!> \param tau_tj ...
1175!> \param tj ...
1176!> \param vec_omega_fit_gw ...
1177!> \param vec_Sigma_x_gw ...
1178!> \param ic_corr_list ...
1179!> \param weights_cos_tf_t_to_w ...
1180!> \param weights_sin_tf_t_to_w ...
1181!> \param fm_mo_coeff_occ_scaled ...
1182!> \param fm_mo_coeff_virt_scaled ...
1183!> \param fm_mo_coeff_occ ...
1184!> \param fm_mo_coeff_virt ...
1185!> \param fm_scaled_dm_occ_tau ...
1186!> \param fm_scaled_dm_virt_tau ...
1187!> \param mo_coeff ...
1188!> \param fm_mat_W ...
1189!> \param para_env ...
1190!> \param para_env_RPA ...
1191!> \param mat_dm ...
1192!> \param mat_MinvVMinv ...
1193!> \param t_3c_O ...
1194!> \param t_3c_M ...
1195!> \param t_3c_overl_int_ao_mo ...
1196!> \param t_3c_O_compressed ...
1197!> \param t_3c_O_mo_compressed ...
1198!> \param t_3c_O_ind ...
1199!> \param t_3c_O_mo_ind ...
1200!> \param t_3c_overl_int_gw_RI ...
1201!> \param t_3c_overl_int_gw_AO ...
1202!> \param matrix_berry_im_mo_mo ...
1203!> \param matrix_berry_re_mo_mo ...
1204!> \param mat_W ...
1205!> \param matrix_s ...
1206!> \param kpoints ...
1207!> \param mp2_env ...
1208!> \param qs_env ...
1209!> \param nkp_self_energy ...
1210!> \param do_kpoints_cubic_RPA ...
1211!> \param starts_array_mc ...
1212!> \param ends_array_mc ...
1213! **************************************************************************************************
1214 SUBROUTINE compute_qp_energies(vec_Sigma_c_gw, count_ev_sc_GW, gw_corr_lev_occ, &
1215 gw_corr_lev_tot, gw_corr_lev_virt, homo, &
1216 nmo, num_fit_points, num_integ_points, &
1217 unit_nr, do_apply_ic_corr_to_gw, do_im_time, &
1218 do_periodic, do_ri_Sigma_x, &
1219 first_cycle_periodic_correction, e_fermi, eps_filter, &
1220 fermi_level_offset, delta_corr, Eigenval, &
1221 Eigenval_last, Eigenval_scf, iter_sc_GW0, exit_ev_gw, tau_tj, tj, &
1222 vec_omega_fit_gw, vec_Sigma_x_gw, ic_corr_list, &
1223 weights_cos_tf_t_to_w, weights_sin_tf_t_to_w, &
1224 fm_mo_coeff_occ_scaled, fm_mo_coeff_virt_scaled, fm_mo_coeff_occ, &
1225 fm_mo_coeff_virt, fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau, &
1226 mo_coeff, fm_mat_W, para_env, para_env_RPA, mat_dm, mat_MinvVMinv, &
1227 t_3c_O, t_3c_M, t_3c_overl_int_ao_mo, &
1228 t_3c_O_compressed, t_3c_O_mo_compressed, &
1229 t_3c_O_ind, t_3c_O_mo_ind, &
1230 t_3c_overl_int_gw_RI, t_3c_overl_int_gw_AO, matrix_berry_im_mo_mo, &
1231 matrix_berry_re_mo_mo, mat_W, matrix_s, &
1232 kpoints, mp2_env, qs_env, nkp_self_energy, do_kpoints_cubic_RPA, &
1233 starts_array_mc, ends_array_mc)
1234
1235 COMPLEX(KIND=dp), DIMENSION(:, :, :, :), &
1236 INTENT(OUT) :: vec_sigma_c_gw
1237 INTEGER, INTENT(IN) :: count_ev_sc_gw
1238 INTEGER, DIMENSION(:), INTENT(IN) :: gw_corr_lev_occ
1239 INTEGER, INTENT(IN) :: gw_corr_lev_tot
1240 INTEGER, DIMENSION(:), INTENT(IN) :: gw_corr_lev_virt, homo
1241 INTEGER, INTENT(IN) :: nmo, num_fit_points, num_integ_points, &
1242 unit_nr
1243 LOGICAL, INTENT(IN) :: do_apply_ic_corr_to_gw, do_im_time, &
1244 do_periodic, do_ri_sigma_x
1245 LOGICAL, INTENT(INOUT) :: first_cycle_periodic_correction
1246 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: e_fermi
1247 REAL(kind=dp), INTENT(IN) :: eps_filter, fermi_level_offset
1248 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
1249 INTENT(INOUT) :: delta_corr
1250 REAL(kind=dp), DIMENSION(:, :, :), INTENT(INOUT) :: eigenval
1251 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
1252 INTENT(INOUT) :: eigenval_last, eigenval_scf
1253 INTEGER, INTENT(IN) :: iter_sc_gw0
1254 LOGICAL, INTENT(INOUT) :: exit_ev_gw
1255 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
1256 INTENT(INOUT) :: tau_tj, tj, vec_omega_fit_gw
1257 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
1258 INTENT(INOUT) :: vec_sigma_x_gw
1259 TYPE(one_dim_real_array), DIMENSION(2), INTENT(IN) :: ic_corr_list
1260 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), &
1261 INTENT(IN) :: weights_cos_tf_t_to_w, &
1262 weights_sin_tf_t_to_w
1263 TYPE(cp_fm_type), INTENT(IN) :: fm_mo_coeff_occ_scaled, &
1264 fm_mo_coeff_virt_scaled
1265 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_mo_coeff_occ, fm_mo_coeff_virt
1266 TYPE(cp_fm_type), INTENT(IN) :: fm_scaled_dm_occ_tau, &
1267 fm_scaled_dm_virt_tau, mo_coeff
1268 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
1269 INTENT(IN) :: fm_mat_w
1270 TYPE(mp_para_env_type), POINTER :: para_env, para_env_rpa
1271 TYPE(dbcsr_p_type), INTENT(IN) :: mat_dm, mat_minvvminv
1272 TYPE(dbt_type), ALLOCATABLE, DIMENSION(:, :) :: t_3c_o
1273 TYPE(dbt_type) :: t_3c_m, t_3c_overl_int_ao_mo
1274 TYPE(hfx_compression_type), ALLOCATABLE, &
1275 DIMENSION(:, :, :), INTENT(INOUT) :: t_3c_o_compressed
1276 TYPE(hfx_compression_type), DIMENSION(:) :: t_3c_o_mo_compressed
1277 TYPE(block_ind_type), ALLOCATABLE, &
1278 DIMENSION(:, :, :), INTENT(INOUT) :: t_3c_o_ind
1279 TYPE(two_dim_int_array), DIMENSION(:) :: t_3c_o_mo_ind
1280 TYPE(dbt_type), DIMENSION(:) :: t_3c_overl_int_gw_ri, &
1281 t_3c_overl_int_gw_ao
1282 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_berry_im_mo_mo, &
1283 matrix_berry_re_mo_mo
1284 TYPE(dbcsr_type), POINTER :: mat_w
1285 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
1286 TYPE(kpoint_type), POINTER :: kpoints
1287 TYPE(mp2_type) :: mp2_env
1288 TYPE(qs_environment_type), POINTER :: qs_env
1289 INTEGER, INTENT(IN) :: nkp_self_energy
1290 LOGICAL, INTENT(IN) :: do_kpoints_cubic_rpa
1291 INTEGER, DIMENSION(:), INTENT(IN) :: starts_array_mc, ends_array_mc
1292
1293 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_QP_energies'
1294
1295 INTEGER :: count_ev_sc_gw_print, count_sc_gw0, count_sc_gw0_print, crossing_search, handle, &
1296 idos, ikp, ispin, iunit, n_level_gw, ndos, nspins, num_points_corr, num_poles
1297 LOGICAL :: do_kpoints_sigma, my_open_shell
1298 REAL(kind=dp) :: dos_lower_bound, dos_precision, dos_upper_bound, e_cbm_gw, e_cbm_gw_beta, &
1299 e_cbm_scf, e_cbm_scf_beta, e_vbm_gw, e_vbm_gw_beta, e_vbm_scf, e_vbm_scf_beta, stop_crit
1300 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: vec_gw_dos
1301 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: m_value, vec_gw_energ, z_value
1302 TYPE(cp_logger_type), POINTER :: logger
1303 TYPE(kpoint_type), POINTER :: kpoints_sigma
1304
1305 CALL timeset(routinen, handle)
1306
1307 nspins = SIZE(homo)
1308 my_open_shell = (nspins == 2)
1309
1310 do_kpoints_sigma = mp2_env%ri_g0w0%do_kpoints_Sigma
1311
1312 DO count_sc_gw0 = 1, iter_sc_gw0
1313
1314 ! postprocessing for cubic scaling GW calculation
1315 IF (do_im_time .AND. .NOT. do_kpoints_cubic_rpa .AND. .NOT. do_kpoints_sigma) THEN
1316 num_points_corr = mp2_env%ri_g0w0%num_omega_points
1317
1318 DO ispin = 1, nspins
1319 CALL compute_self_energy_cubic_gw(num_integ_points, nmo, tau_tj, tj, &
1320 matrix_s, fm_mo_coeff_occ(ispin), &
1321 fm_mo_coeff_virt(ispin), fm_mo_coeff_occ_scaled, &
1322 fm_mo_coeff_virt_scaled, fm_scaled_dm_occ_tau, &
1323 fm_scaled_dm_virt_tau, eigenval(:, 1, ispin), eps_filter, &
1324 e_fermi(ispin), fm_mat_w, &
1325 gw_corr_lev_tot, gw_corr_lev_occ(ispin), gw_corr_lev_virt(ispin), homo(ispin), &
1326 count_ev_sc_gw, count_sc_gw0, &
1327 t_3c_overl_int_ao_mo, t_3c_o_mo_compressed(ispin), &
1328 t_3c_o_mo_ind(ispin)%array, &
1329 t_3c_overl_int_gw_ri(ispin), t_3c_overl_int_gw_ao(ispin), &
1330 mat_w, mat_minvvminv, mat_dm, &
1331 weights_cos_tf_t_to_w, weights_sin_tf_t_to_w, vec_sigma_c_gw(:, :, :, ispin), &
1332 do_periodic, num_points_corr, delta_corr, qs_env, para_env, para_env_rpa, &
1333 mp2_env, matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, &
1334 first_cycle_periodic_correction, kpoints, num_fit_points, mo_coeff, &
1335 do_ri_sigma_x, vec_sigma_x_gw(:, :, ispin), unit_nr, ispin)
1336 END DO
1337
1338 END IF
1339
1340 IF (do_kpoints_sigma) THEN
1341 CALL compute_self_energy_cubic_gw_kpoints(num_integ_points, tau_tj, tj, &
1342 matrix_s, eigenval(:, :, :), e_fermi, fm_mat_w, &
1343 gw_corr_lev_tot, gw_corr_lev_occ, gw_corr_lev_virt, homo, &
1344 count_ev_sc_gw, count_sc_gw0, &
1345 t_3c_o, t_3c_m, t_3c_o_compressed, t_3c_o_ind, &
1346 mat_w, mat_minvvminv, &
1347 weights_cos_tf_t_to_w, weights_sin_tf_t_to_w, vec_sigma_c_gw(:, :, :, :), &
1348 qs_env, para_env, &
1349 mp2_env, num_fit_points, mo_coeff, &
1350 do_ri_sigma_x, vec_sigma_x_gw(:, :, :), unit_nr, nspins, &
1351 starts_array_mc, ends_array_mc, eps_filter)
1352
1353 END IF
1354
1355 IF (do_periodic .AND. mp2_env%ri_g0w0%do_average_deg_levels) THEN
1356
1357 DO ispin = 1, nspins
1358 CALL average_degenerate_levels(vec_sigma_c_gw(:, :, :, ispin), &
1359 eigenval(1 + homo(ispin) - gw_corr_lev_occ(ispin): &
1360 homo(ispin) + gw_corr_lev_virt(ispin), 1, ispin), &
1361 mp2_env%ri_g0w0%eps_eigenval)
1362 END DO
1363 END IF
1364
1365 IF (.NOT. do_im_time) THEN
1366 CALL para_env%sum(vec_sigma_c_gw)
1367 END IF
1368
1369 CALL para_env%sync()
1370
1371 stop_crit = 1.0e-7
1372 num_poles = mp2_env%ri_g0w0%num_poles
1373 crossing_search = mp2_env%ri_g0w0%crossing_search
1374
1375 ! arrays storing the correlation self-energy, stat. error and z-shot value
1376 ALLOCATE (vec_gw_energ(gw_corr_lev_tot, nkp_self_energy, nspins))
1377 vec_gw_energ = 0.0_dp
1378 ALLOCATE (z_value(gw_corr_lev_tot, nkp_self_energy, nspins))
1379 z_value = 0.0_dp
1380 ALLOCATE (m_value(gw_corr_lev_tot, nkp_self_energy, nspins))
1381 m_value = 0.0_dp
1382 e_vbm_gw = -1.0e3
1383 e_cbm_gw = 1.0e3
1384 e_vbm_scf = -1.0e3
1385 e_cbm_scf = 1.0e3
1386 e_vbm_gw_beta = -1.0e3
1387 e_cbm_gw_beta = 1.0e3
1388 e_vbm_scf_beta = -1.0e3
1389 e_cbm_scf_beta = 1.0e3
1390
1391 ndos = 0
1392 dos_precision = mp2_env%ri_g0w0%dos_prec
1393 dos_upper_bound = mp2_env%ri_g0w0%dos_upper
1394 dos_lower_bound = mp2_env%ri_g0w0%dos_lower
1395
1396 IF (dos_lower_bound >= dos_upper_bound) THEN
1397 CALL cp_abort(__location__, "Invalid settings for GW_DOS calculation!")
1398 END IF
1399
1400 IF (dos_precision /= 0) THEN
1401 ndos = int((dos_upper_bound - dos_lower_bound)/dos_precision)
1402 ALLOCATE (vec_gw_dos(ndos))
1403 vec_gw_dos = 0.0_dp
1404 END IF
1405
1406 ! for the normal code for molecules or Gamma only: nkp = 1
1407 DO ikp = 1, nkp_self_energy
1408
1409 kpoints_sigma => qs_env%mp2_env%ri_rpa_im_time%kpoints_Sigma
1410
1411 ! fit the self-energy on imaginary frequency axis and evaluate the fit on the MO energy of the SCF
1412 DO n_level_gw = 1, gw_corr_lev_tot
1413 ! processes perform different fits
1414 IF (modulo(n_level_gw, para_env%num_pe) /= para_env%mepos) cycle
1415
1416 SELECT CASE (mp2_env%ri_g0w0%analytic_continuation)
1417 CASE (gw_two_pole_model)
1418 CALL fit_and_continuation_2pole(vec_gw_energ(:, ikp, 1), vec_omega_fit_gw, &
1419 z_value(:, ikp, 1), m_value(:, ikp, 1), vec_sigma_c_gw(:, :, ikp, 1), &
1420 mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 1, ikp), &
1421 eigenval(:, ikp, 1), eigenval_scf(:, ikp, 1), n_level_gw, &
1422 gw_corr_lev_occ(1), gw_corr_lev_virt(1), num_poles, &
1423 num_fit_points, crossing_search, homo(1), stop_crit, &
1424 fermi_level_offset, do_im_time)
1425
1426 CASE (gw_pade_approx)
1427 CALL continuation_pade(vec_gw_energ(:, ikp, 1), vec_omega_fit_gw, &
1428 z_value(:, ikp, 1), m_value(:, ikp, 1), vec_sigma_c_gw(:, :, ikp, 1), &
1429 mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 1, ikp), &
1430 eigenval(:, ikp, 1), eigenval_scf(:, ikp, 1), &
1431 mp2_env%ri_g0w0%do_hedin_shift, n_level_gw, &
1432 gw_corr_lev_occ(1), gw_corr_lev_virt(1), mp2_env%ri_g0w0%nparam_pade, &
1433 num_fit_points, crossing_search, homo(1), fermi_level_offset, &
1434 do_im_time, mp2_env%ri_g0w0%print_self_energy, count_ev_sc_gw, &
1435 vec_gw_dos, dos_lower_bound, dos_precision, ndos, &
1436 mp2_env%ri_g0w0%min_level_self_energy, &
1437 mp2_env%ri_g0w0%max_level_self_energy, mp2_env%ri_g0w0%dos_eta, &
1438 mp2_env%ri_g0w0%dos_min, mp2_env%ri_g0w0%dos_max)
1439 CASE DEFAULT
1440 cpabort("Only two-model and Pade approximation are implemented.")
1441 END SELECT
1442
1443 IF (my_open_shell) THEN
1444 SELECT CASE (mp2_env%ri_g0w0%analytic_continuation)
1445 CASE (gw_two_pole_model)
1446 CALL fit_and_continuation_2pole( &
1447 vec_gw_energ(:, ikp, 2), vec_omega_fit_gw, &
1448 z_value(:, ikp, 2), m_value(:, ikp, 2), vec_sigma_c_gw(:, :, ikp, 2), &
1449 mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 2, ikp), &
1450 eigenval(:, ikp, 2), eigenval_scf(:, ikp, 2), n_level_gw, &
1451 gw_corr_lev_occ(2), gw_corr_lev_virt(2), num_poles, &
1452 num_fit_points, crossing_search, homo(2), stop_crit, &
1453 fermi_level_offset, do_im_time)
1454 CASE (gw_pade_approx)
1455 CALL continuation_pade(vec_gw_energ(:, ikp, 2), vec_omega_fit_gw, &
1456 z_value(:, ikp, 2), m_value(:, ikp, 2), vec_sigma_c_gw(:, :, ikp, 2), &
1457 mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 2, ikp), &
1458 eigenval(:, ikp, 2), eigenval_scf(:, ikp, 2), &
1459 mp2_env%ri_g0w0%do_hedin_shift, n_level_gw, &
1460 gw_corr_lev_occ(2), gw_corr_lev_virt(2), mp2_env%ri_g0w0%nparam_pade, &
1461 num_fit_points, crossing_search, homo(2), &
1462 fermi_level_offset, do_im_time, &
1463 mp2_env%ri_g0w0%print_self_energy, count_ev_sc_gw, &
1464 vec_gw_dos, dos_lower_bound, dos_precision, ndos, &
1465 mp2_env%ri_g0w0%min_level_self_energy, &
1466 mp2_env%ri_g0w0%max_level_self_energy, mp2_env%ri_g0w0%dos_eta, &
1467 mp2_env%ri_g0w0%dos_min, mp2_env%ri_g0w0%dos_max)
1468 CASE DEFAULT
1469 cpabort("Only two-pole model and Pade approximation are implemented.")
1470 END SELECT
1471
1472 END IF
1473
1474 END DO ! n_level_gw
1475
1476 CALL para_env%sum(vec_gw_energ)
1477 CALL para_env%sum(z_value)
1478 CALL para_env%sum(m_value)
1479
1480 IF (dos_precision /= 0.0_dp) THEN
1481 CALL para_env%sum(vec_gw_dos)
1482 END IF
1483
1484 CALL check_nan(vec_gw_energ, 0.0_dp)
1485 CALL check_nan(z_value, 1.0_dp)
1486 CALL check_nan(m_value, 0.0_dp)
1487
1488 IF (do_im_time .OR. mp2_env%ri_g0w0%iter_sc_GW0 == 1) THEN
1489 count_ev_sc_gw_print = count_ev_sc_gw
1490 count_sc_gw0_print = count_sc_gw0
1491 ELSE
1492 count_ev_sc_gw_print = count_sc_gw0
1493 count_sc_gw0_print = count_ev_sc_gw
1494 END IF
1495
1496 ! print the quasiparticle energies and update Eigenval in case you do eigenvalue self-consistent GW
1497 IF (my_open_shell) THEN
1498
1499 CALL print_and_update_for_ev_sc( &
1500 vec_gw_energ(:, ikp, 1), &
1501 z_value(:, ikp, 1), m_value(:, ikp, 1), mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 1, ikp), &
1502 eigenval(:, ikp, 1), eigenval_last(:, ikp, 1), eigenval_scf(:, ikp, 1), &
1503 gw_corr_lev_occ(1), gw_corr_lev_virt(1), gw_corr_lev_tot, &
1504 crossing_search, homo(1), unit_nr, count_ev_sc_gw_print, count_sc_gw0_print, &
1505 ikp, nkp_self_energy, kpoints_sigma, 1, e_vbm_gw, e_cbm_gw, e_vbm_scf, e_cbm_scf)
1506
1507 CALL print_and_update_for_ev_sc( &
1508 vec_gw_energ(:, ikp, 2), &
1509 z_value(:, ikp, 2), m_value(:, ikp, 2), mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 2, ikp), &
1510 eigenval(:, ikp, 2), eigenval_last(:, ikp, 2), eigenval_scf(:, ikp, 2), &
1511 gw_corr_lev_occ(2), gw_corr_lev_virt(2), gw_corr_lev_tot, &
1512 crossing_search, homo(2), unit_nr, count_ev_sc_gw_print, count_sc_gw0_print, &
1513 ikp, nkp_self_energy, kpoints_sigma, 2, e_vbm_gw_beta, e_cbm_gw_beta, e_vbm_scf_beta, e_cbm_scf_beta)
1514
1515 IF (do_apply_ic_corr_to_gw .AND. count_ev_sc_gw == 1) THEN
1516
1517 CALL apply_ic_corr(eigenval(:, ikp, 1), eigenval_scf(:, ikp, 1), ic_corr_list(1)%array, &
1518 gw_corr_lev_occ(1), gw_corr_lev_virt(1), gw_corr_lev_tot, &
1519 homo(1), nmo, unit_nr, do_alpha=.true.)
1520
1521 CALL apply_ic_corr(eigenval(:, ikp, 2), eigenval_scf(:, ikp, 2), ic_corr_list(2)%array, &
1522 gw_corr_lev_occ(2), gw_corr_lev_virt(2), gw_corr_lev_tot, &
1523 homo(2), nmo, unit_nr, do_beta=.true.)
1524
1525 END IF
1526
1527 ELSE
1528
1529 CALL print_and_update_for_ev_sc( &
1530 vec_gw_energ(:, ikp, 1), &
1531 z_value(:, ikp, 1), m_value(:, ikp, 1), mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 1, ikp), &
1532 eigenval(:, ikp, 1), eigenval_last(:, ikp, 1), eigenval_scf(:, ikp, 1), &
1533 gw_corr_lev_occ(1), gw_corr_lev_virt(1), gw_corr_lev_tot, &
1534 crossing_search, homo(1), unit_nr, count_ev_sc_gw_print, count_sc_gw0_print, &
1535 ikp, nkp_self_energy, kpoints_sigma, 0, e_vbm_gw, e_cbm_gw, e_vbm_scf, e_cbm_scf)
1536
1537 IF (do_apply_ic_corr_to_gw .AND. count_ev_sc_gw == 1) THEN
1538
1539 CALL apply_ic_corr(eigenval(:, ikp, 1), eigenval_scf(:, ikp, 1), ic_corr_list(1)%array, &
1540 gw_corr_lev_occ(1), gw_corr_lev_virt(1), gw_corr_lev_tot, &
1541 homo(1), nmo, unit_nr)
1542
1543 END IF
1544
1545 END IF
1546
1547 END DO ! ikp
1548
1549 IF (nkp_self_energy > 1 .AND. unit_nr > 0) THEN
1550
1551 CALL print_gaps(e_vbm_scf, e_cbm_scf, e_vbm_scf_beta, e_cbm_scf_beta, &
1552 e_vbm_gw, e_cbm_gw, e_vbm_gw_beta, e_cbm_gw_beta, my_open_shell, unit_nr)
1553
1554 END IF
1555
1556 ! Decide whether to add spin-orbit splitting of bands, spin-orbit coupling strength comes from
1557 ! Hartwigsen parametrization (1999) of GTH pseudopotentials
1558 IF (mp2_env%ri_g0w0%soc_type /= soc_none) THEN
1559 CALL calculate_and_print_soc(qs_env, eigenval_scf, eigenval_scf, gw_corr_lev_occ, gw_corr_lev_virt, &
1560 homo, unit_nr, do_soc_gw=.false., do_soc_scf=.true.)
1561 CALL calculate_and_print_soc(qs_env, eigenval, eigenval_scf, gw_corr_lev_occ, gw_corr_lev_virt, &
1562 homo, unit_nr, do_soc_gw=.true., do_soc_scf=.false.)
1563 END IF
1564
1565 logger => cp_get_default_logger()
1566 IF (logger%para_env%is_source()) THEN
1567 iunit = cp_logger_get_default_unit_nr()
1568 ELSE
1569 iunit = -1
1570 END IF
1571
1572 IF (dos_precision /= 0.0_dp) THEN
1573 IF (iunit > 0) THEN
1574 CALL open_file('spectral.dat', unit_number=iunit, file_status="UNKNOWN", file_action="WRITE")
1575 DO idos = 1, ndos
1576 ! 1/pi
1577 ! [1/Hartree] -> [1/evolt]
1578 WRITE (iunit, '(E17.10, E17.10)') (dos_lower_bound + real(idos - 1, kind=dp)*dos_precision)*evolt, &
1579 vec_gw_dos(idos)/evolt/pi
1580 END DO
1581 CALL close_file(iunit)
1582 END IF
1583 DEALLOCATE (vec_gw_dos)
1584 END IF
1585
1586 DEALLOCATE (z_value)
1587 DEALLOCATE (m_value)
1588 DEALLOCATE (vec_gw_energ)
1589
1590 exit_ev_gw = .false.
1591
1592 ! if HOMO-LUMO gap differs by less than mp2_env%ri_g0w0%eps_sc_iter, exit ev sc GW loop
1593 IF (abs(eigenval(homo(1), 1, 1) - eigenval_last(homo(1), 1, 1) - &
1594 eigenval(homo(1) + 1, 1, 1) + eigenval_last(homo(1) + 1, 1, 1)) &
1595 < mp2_env%ri_g0w0%eps_iter) THEN
1596 IF (count_sc_gw0 == 1) exit_ev_gw = .true.
1597 EXIT
1598 END IF
1599
1600 DO ispin = 1, nspins
1601 CALL shift_unshifted_levels(eigenval(:, 1, ispin), eigenval_last(:, 1, ispin), gw_corr_lev_occ(ispin), &
1602 gw_corr_lev_virt(ispin), homo(ispin), nmo)
1603 END DO
1604
1605 IF (do_im_time .AND. do_kpoints_sigma .AND. mp2_env%ri_g0w0%print_local_bandgap) THEN
1606 CALL print_local_bandgap(qs_env, eigenval, gw_corr_lev_occ(1), gw_corr_lev_virt(1), homo(1), "GW")
1607 CALL print_local_bandgap(qs_env, eigenval_scf, gw_corr_lev_occ(1), gw_corr_lev_virt(1), homo(1), "DFT")
1608 END IF
1609
1610 ! in case of N^4 scaling GW, the scGW0 cycle is the eigenvalue sc cycle
1611 IF (.NOT. do_im_time) EXIT
1612
1613 END DO ! scGW0
1614
1615 CALL timestop(handle)
1616
1617 END SUBROUTINE compute_qp_energies
1618
1619! **************************************************************************************************
1620!> \brief ...
1621!> \param qs_env ...
1622!> \param Eigenval ...
1623!> \param Eigenval_scf ...
1624!> \param gw_corr_lev_occ ...
1625!> \param gw_corr_lev_virt ...
1626!> \param homo ...
1627!> \param unit_nr ...
1628!> \param do_soc_gw ...
1629!> \param do_soc_scf ...
1630! **************************************************************************************************
1631 SUBROUTINE calculate_and_print_soc(qs_env, Eigenval, Eigenval_scf, gw_corr_lev_occ, gw_corr_lev_virt, &
1632 homo, unit_nr, do_soc_gw, do_soc_scf)
1633 TYPE(qs_environment_type), POINTER :: qs_env
1634 REAL(kind=dp), DIMENSION(:, :, :) :: eigenval, eigenval_scf
1635 INTEGER, DIMENSION(:), INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt, homo
1636 INTEGER :: unit_nr
1637 LOGICAL :: do_soc_gw, do_soc_scf
1638
1639 CHARACTER(LEN=*), PARAMETER :: routinen = 'calculate_and_print_soc'
1640
1641 INTEGER :: handle, i_dim, i_glob, i_row, ikp, j_col, j_glob, n_level_gw, nao, ncol_local, &
1642 nder, nkind, nkp_self_energy, nrow_local, periodic(3), size_real_space
1643 INTEGER, ALLOCATABLE, DIMENSION(:) :: index0
1644 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
1645 LOGICAL :: calculate_forces, use_virial
1646 REAL(kind=dp) :: avg_occ_qp_shift, avg_virt_qp_shift, e_cbm_gw_soc, e_gap_gw_soc, e_homo, &
1647 e_homo_gw_soc, e_i, e_j, e_lumo, e_lumo_gw_soc, e_vbm_gw_soc, e_window, eps_ppnl
1648 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues_without_soc_sorted
1649 REAL(kind=dp), DIMENSION(:), POINTER :: eigenvalues
1650 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1651 TYPE(cell_type), POINTER :: cell
1652 TYPE(cp_cfm_type) :: cfm_mat_h_double, cfm_mat_h_ks, &
1653 cfm_mat_s_double, cfm_mat_work_double, &
1654 cfm_mo_coeff, cfm_mo_coeff_double
1655 TYPE(cp_fm_type), POINTER :: imos, rmos
1656 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, matrix_s_desymm
1657 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: mat_vsoc_l_nosymm, mat_vsoc_lx_kp, &
1658 mat_vsoc_ly_kp, mat_vsoc_lz_kp, &
1659 matrix_dummy, matrix_l, &
1660 matrix_pot_dummy
1661 TYPE(dft_control_type), POINTER :: dft_control
1662 TYPE(kpoint_type), POINTER :: kpoints_sigma
1663 TYPE(mp_para_env_type), POINTER :: para_env
1664 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1665 POINTER :: sab_orb, sap_ppnl
1666 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1667 TYPE(qs_force_type), DIMENSION(:), POINTER :: force
1668 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1669 TYPE(scf_control_type), POINTER :: scf_control
1670 TYPE(virial_type), POINTER :: virial
1671
1672 CALL timeset(routinen, handle)
1673
1674 cpassert(do_soc_gw .NEQV. do_soc_scf)
1675
1676 CALL get_qs_env(qs_env=qs_env, &
1677 matrix_s=matrix_s, &
1678 para_env=para_env, &
1679 qs_kind_set=qs_kind_set, &
1680 sab_orb=sab_orb, &
1681 atomic_kind_set=atomic_kind_set, &
1682 particle_set=particle_set, &
1683 sap_ppnl=sap_ppnl, &
1684 dft_control=dft_control, &
1685 cell=cell, &
1686 nkind=nkind, &
1687 scf_control=scf_control)
1688
1689 calculate_forces = .false.
1690 use_virial = .false.
1691 nder = 0
1692 eps_ppnl = dft_control%qs_control%eps_ppnl
1693
1694 CALL get_cell(cell=cell, periodic=periodic)
1695
1696 size_real_space = 3**(periodic(1) + periodic(2) + periodic(3))
1697
1698 NULLIFY (matrix_l)
1699 CALL dbcsr_allocate_matrix_set(matrix_l, 3, 1)
1700 DO i_dim = 1, 3
1701 ALLOCATE (matrix_l(i_dim, 1)%matrix)
1702 CALL dbcsr_create(matrix_l(i_dim, 1)%matrix, template=matrix_s(1)%matrix, &
1703 matrix_type=dbcsr_type_antisymmetric)
1704 CALL cp_dbcsr_alloc_block_from_nbl(matrix_l(i_dim, 1)%matrix, sab_orb)
1705 CALL dbcsr_set(matrix_l(i_dim, 1)%matrix, 0.0_dp)
1706 END DO
1707
1708 NULLIFY (matrix_pot_dummy)
1709 CALL dbcsr_allocate_matrix_set(matrix_pot_dummy, 1, 1)
1710 ALLOCATE (matrix_pot_dummy(1, 1)%matrix)
1711 CALL dbcsr_create(matrix_pot_dummy(1, 1)%matrix, template=matrix_s(1)%matrix)
1712 CALL cp_dbcsr_alloc_block_from_nbl(matrix_pot_dummy(1, 1)%matrix, sab_orb)
1713 CALL dbcsr_set(matrix_pot_dummy(1, 1)%matrix, 0.0_dp)
1714
1715 CALL build_core_ppnl(matrix_pot_dummy, matrix_dummy, force, virial, calculate_forces, use_virial, nder, &
1716 qs_kind_set, atomic_kind_set, particle_set, sab_orb, sap_ppnl, eps_ppnl, &
1717 nimages=1, basis_type="ORB", matrix_l=matrix_l)
1718
1719 CALL alloc_mat_set_2d(mat_vsoc_l_nosymm, 3, size_real_space, matrix_s(1)%matrix, explicitly_no_symmetry=.true.)
1720 DO i_dim = 1, 3
1721 CALL dbcsr_desymmetrize(matrix_l(i_dim, 1)%matrix, mat_vsoc_l_nosymm(i_dim, 1)%matrix)
1722 END DO
1723
1724 kpoints_sigma => qs_env%mp2_env%ri_rpa_im_time%kpoints_Sigma
1725
1726 CALL mat_kp_from_mat_gamma(qs_env, mat_vsoc_lx_kp, mat_vsoc_l_nosymm(1, 1)%matrix, kpoints_sigma, 1, .false.)
1727 CALL mat_kp_from_mat_gamma(qs_env, mat_vsoc_ly_kp, mat_vsoc_l_nosymm(2, 1)%matrix, kpoints_sigma, 1, .false.)
1728 CALL mat_kp_from_mat_gamma(qs_env, mat_vsoc_lz_kp, mat_vsoc_l_nosymm(3, 1)%matrix, kpoints_sigma, 1, .false.)
1729
1730 nkp_self_energy = kpoints_sigma%nkp
1731
1732 CALL get_mo_set(kpoints_sigma%kp_env(1)%kpoint_env%mos(1, 1), mo_coeff=rmos)
1733
1734 CALL create_cfm_double_row_col_size(rmos, cfm_mat_h_double)
1735 CALL create_cfm_double_row_col_size(rmos, cfm_mat_s_double)
1736 CALL create_cfm_double_row_col_size(rmos, cfm_mo_coeff_double)
1737 CALL create_cfm_double_row_col_size(rmos, cfm_mat_work_double)
1738
1739 CALL cp_cfm_set_all(cfm_mo_coeff_double, z_zero)
1740
1741 CALL cp_cfm_create(cfm_mo_coeff, rmos%matrix_struct)
1742 CALL cp_cfm_create(cfm_mat_h_ks, rmos%matrix_struct)
1743
1744 CALL cp_fm_get_info(matrix=rmos, nrow_global=nao)
1745
1746 NULLIFY (matrix_s_desymm)
1747 CALL dbcsr_allocate_matrix_set(matrix_s_desymm, 1)
1748 ALLOCATE (matrix_s_desymm(1)%matrix)
1749 CALL dbcsr_create(matrix=matrix_s_desymm(1)%matrix, template=matrix_s(1)%matrix, &
1750 matrix_type=dbcsr_type_no_symmetry)
1751 CALL dbcsr_desymmetrize(matrix_s(1)%matrix, matrix_s_desymm(1)%matrix)
1752
1753 ALLOCATE (eigenvalues(2*nao))
1754 eigenvalues = 0.0_dp
1755 ALLOCATE (eigenvalues_without_soc_sorted(2*nao))
1756
1757 e_window = qs_env%mp2_env%ri_g0w0%soc_energy_window
1758 IF (unit_nr > 0) THEN
1759 WRITE (unit_nr, '(T3,A)') ' '
1760 WRITE (unit_nr, '(T3,A)') '------------------------------------------------------------------------------'
1761 WRITE (unit_nr, '(T3,A)') ' '
1762 WRITE (unit_nr, '(T3,A,F42.1)') 'GW_SOC_INFO | SOC energy window (eV)', e_window*evolt
1763 END IF
1764
1765 e_vbm_gw_soc = -1000.0_dp
1766 e_cbm_gw_soc = 1000.0_dp
1767
1768 DO ikp = 1, nkp_self_energy
1769
1770 CALL get_mo_set(kpoints_sigma%kp_env(ikp)%kpoint_env%mos(1, 1), mo_coeff=rmos)
1771 CALL get_mo_set(kpoints_sigma%kp_env(ikp)%kpoint_env%mos(2, 1), mo_coeff=imos)
1772 CALL cp_fm_to_cfm(rmos, imos, cfm_mo_coeff)
1773
1774 ! ispin = 1
1775 avg_occ_qp_shift = sum(eigenval(homo(1) - gw_corr_lev_occ(1) + 1:homo(1), ikp, 1) - &
1776 eigenval_scf(homo(1) - gw_corr_lev_occ(1) + 1:homo(1), ikp, 1))/gw_corr_lev_occ(1)
1777 avg_virt_qp_shift = sum(eigenval(homo(1):homo(1) + gw_corr_lev_virt(1), ikp, 1) - &
1778 eigenval_scf(homo(1):homo(1) + gw_corr_lev_virt(1), ikp, 1))/gw_corr_lev_virt(1)
1779
1780 IF (gw_corr_lev_occ(1) < homo(1)) THEN
1781 eigenval(1:homo(1) - gw_corr_lev_occ(1), ikp, 1) = eigenval_scf(1:homo(1) - gw_corr_lev_occ(1), ikp, 1) &
1782 + avg_occ_qp_shift
1783 END IF
1784 IF (gw_corr_lev_virt(1) < nao - homo(1) + 1) THEN
1785 eigenval(homo(1) + gw_corr_lev_virt(1) + 1:nao, ikp, 1) = eigenval_scf(homo(1) + gw_corr_lev_virt(1) + 1:nao, ikp, 1) &
1786 + avg_virt_qp_shift
1787 END IF
1788
1789 CALL cp_cfm_set_all(cfm_mat_h_double, z_zero)
1790 CALL add_dbcsr_submatrix(cfm_mat_h_double, mat_vsoc_lx_kp(ikp, 1:2), cfm_mat_h_ks, nao + 1, 1, z_one, .true.)
1791 CALL add_dbcsr_submatrix(cfm_mat_h_double, mat_vsoc_ly_kp(ikp, 1:2), cfm_mat_h_ks, nao + 1, 1, gaussi, .true.)
1792 CALL add_dbcsr_submatrix(cfm_mat_h_double, mat_vsoc_lz_kp(ikp, 1:2), cfm_mat_h_ks, 1, 1, z_one, .false.)
1793 CALL add_dbcsr_submatrix(cfm_mat_h_double, mat_vsoc_lz_kp(ikp, 1:2), cfm_mat_h_ks, nao + 1, nao + 1, -z_one, .false.)
1794
1795 ! trafo to MO basis
1796 cfm_mo_coeff_double%local_data = z_zero
1797 CALL add_cfm_submatrix(cfm_mo_coeff_double, cfm_mo_coeff, 1, 1)
1798 CALL add_cfm_submatrix(cfm_mo_coeff_double, cfm_mo_coeff, nao + 1, nao + 1)
1799
1800 CALL cp_cfm_get_info(matrix=cfm_mat_h_double, &
1801 nrow_local=nrow_local, &
1802 ncol_local=ncol_local, &
1803 row_indices=row_indices, &
1804 col_indices=col_indices)
1805
1806 CALL parallel_gemm(transa="N", transb="N", m=2*nao, n=2*nao, k=2*nao, alpha=z_one, &
1807 matrix_a=cfm_mat_h_double, matrix_b=cfm_mo_coeff_double, beta=z_zero, &
1808 matrix_c=cfm_mat_work_double)
1809
1810 CALL parallel_gemm(transa="C", transb="N", m=2*nao, n=2*nao, k=2*nao, alpha=z_one, &
1811 matrix_a=cfm_mo_coeff_double, matrix_b=cfm_mat_work_double, beta=z_zero, &
1812 matrix_c=cfm_mat_h_double)
1813
1814 CALL cp_cfm_get_info(matrix=cfm_mat_h_double, &
1815 nrow_local=nrow_local, &
1816 ncol_local=ncol_local, &
1817 row_indices=row_indices, &
1818 col_indices=col_indices)
1819
1820 CALL cp_cfm_set_all(cfm_mat_s_double, z_zero)
1821
1822 e_homo = eigenval(homo(1), ikp, 1)
1823 e_lumo = eigenval(homo(1) + 1, ikp, 1)
1824
1825 CALL para_env%sync()
1826
1827 DO i_row = 1, nrow_local
1828 DO j_col = 1, ncol_local
1829 i_glob = row_indices(i_row)
1830 j_glob = col_indices(j_col)
1831 IF (i_glob <= nao) THEN
1832 e_i = eigenval(i_glob, ikp, 1)
1833 ELSE
1834 e_i = eigenval(i_glob - nao, ikp, 1)
1835 END IF
1836 IF (j_glob <= nao) THEN
1837 e_j = eigenval(j_glob, ikp, 1)
1838 ELSE
1839 e_j = eigenval(j_glob - nao, ikp, 1)
1840 END IF
1841
1842 ! add eigenvalues to diagonal entries
1843 IF (i_glob == j_glob) THEN
1844 cfm_mat_h_double%local_data(i_row, j_col) = cfm_mat_h_double%local_data(i_row, j_col) + e_i*z_one
1845 cfm_mat_s_double%local_data(i_row, j_col) = z_one
1846 ELSE
1847 IF (e_i < e_homo - 0.5_dp*e_window .OR. e_i > e_lumo + 0.5_dp*e_window .OR. &
1848 e_j < e_homo - 0.5_dp*e_window .OR. e_j > e_lumo + 0.5_dp*e_window) THEN
1849 cfm_mat_h_double%local_data(i_row, j_col) = z_zero
1850 END IF
1851 END IF
1852
1853 END DO
1854 END DO
1855
1856 CALL para_env%sync()
1857
1858 eigenvalues = 0.0_dp
1859 CALL cp_cfm_geeig_canon(cfm_mat_h_double, cfm_mat_s_double, cfm_mo_coeff_double, eigenvalues, &
1860 cfm_mat_work_double, scf_control%eps_eigval)
1861
1862 eigenvalues_without_soc_sorted(1:nao) = eigenval(:, ikp, 1)
1863 eigenvalues_without_soc_sorted(nao + 1:2*nao) = eigenval(:, ikp, 1)
1864 ALLOCATE (index0(2*nao))
1865 CALL sort(eigenvalues_without_soc_sorted, 2*nao, index0)
1866 DEALLOCATE (index0)
1867
1868 e_homo_gw_soc = maxval(eigenvalues(2*homo(1) - 2*gw_corr_lev_occ(1) + 1:2*homo(1)))
1869 e_lumo_gw_soc = minval(eigenvalues(2*homo(1) + 1:2*homo(1) + 2*gw_corr_lev_virt(1)))
1870 e_gap_gw_soc = e_lumo_gw_soc - e_homo_gw_soc
1871 IF (e_homo_gw_soc > e_vbm_gw_soc) e_vbm_gw_soc = e_homo_gw_soc
1872 IF (e_lumo_gw_soc < e_cbm_gw_soc) e_cbm_gw_soc = e_lumo_gw_soc
1873
1874 IF (unit_nr > 0) THEN
1875 WRITE (unit_nr, '(T3,A)') ' '
1876 WRITE (unit_nr, '(T3,A7,I3,A3,I3,A8,3F7.3,A12,3F7.3)') 'Kpoint ', ikp, ' /', nkp_self_energy, &
1877 ' xkp =', kpoints_sigma%xkp(1, ikp), kpoints_sigma%xkp(2, ikp), kpoints_sigma%xkp(3, ikp), &
1878 ' and xkp =', -kpoints_sigma%xkp(1, ikp), -kpoints_sigma%xkp(2, ikp), -kpoints_sigma%xkp(3, ikp)
1879 WRITE (unit_nr, '(T3,A)') ' '
1880 IF (do_soc_gw) THEN
1881 WRITE (unit_nr, '(T3,A)') ' '
1882 WRITE (unit_nr, '(T3,A,F13.4)') 'GW_SOC_INFO | Average GW shift of occupied levels compared to SCF', &
1883 avg_occ_qp_shift*evolt
1884 WRITE (unit_nr, '(T3,A,F11.4)') 'GW_SOC_INFO | Average GW shift of unoccupied levels compared to SCF', &
1885 avg_virt_qp_shift*evolt
1886 WRITE (unit_nr, '(T3,A)') ' '
1887 WRITE (unit_nr, '(T3,2A)') 'Molecular orbital E_GW with SOC (eV) E_GW without SOC (eV) SOC shift (eV)'
1888 ELSE
1889 WRITE (unit_nr, '(T3,2A)') 'Molecular orbital E_SCF with SOC (eV) E_SCF without SOC (eV) SOC shift (eV)'
1890 END IF
1891
1892 DO n_level_gw = 2*(homo(1) - gw_corr_lev_occ(1)) + 1, 2*homo(1)
1893 WRITE (unit_nr, '(T3,I4,A,3F21.4)') n_level_gw, ' ( occ ) ', eigenvalues(n_level_gw)*evolt, &
1894 eigenvalues_without_soc_sorted(n_level_gw)*evolt, &
1895 (eigenvalues(n_level_gw) - eigenvalues_without_soc_sorted(n_level_gw))*evolt
1896 END DO
1897 DO n_level_gw = 2*homo(1) + 1, 2*(homo(1) + gw_corr_lev_virt(1))
1898 WRITE (unit_nr, '(T3,I4,A,3F21.4)') n_level_gw, ' ( vir ) ', eigenvalues(n_level_gw)*evolt, &
1899 eigenvalues_without_soc_sorted(n_level_gw)*evolt, &
1900 (eigenvalues(n_level_gw) - eigenvalues_without_soc_sorted(n_level_gw))*evolt
1901 END DO
1902 WRITE (unit_nr, '(T3,A)') ' '
1903 IF (do_soc_gw) THEN
1904 WRITE (unit_nr, '(T3,A,F38.4)') 'GW+SOC direct gap at current kpoint (eV)', e_gap_gw_soc*evolt
1905 ELSE
1906 WRITE (unit_nr, '(T3,A,F37.4)') 'SCF+SOC direct gap at current kpoint (eV)', e_gap_gw_soc*evolt
1907 END IF
1908 WRITE (unit_nr, '(T3,A)') ' '
1909 WRITE (unit_nr, '(T3,A)') '------------------------------------------------------------------------------'
1910 END IF
1911
1912 END DO
1913
1914 IF (unit_nr > 0) THEN
1915 WRITE (unit_nr, '(T3,A)') ' '
1916 IF (do_soc_gw) THEN
1917 WRITE (unit_nr, '(T3,A,F46.4)') 'GW+SOC valence band maximum (eV)', e_vbm_gw_soc*evolt
1918 WRITE (unit_nr, '(T3,A,F43.4)') 'GW+SOC conduction band minimum (eV)', e_cbm_gw_soc*evolt
1919 WRITE (unit_nr, '(T3,A,F59.4)') 'GW+SOC bandgap (eV)', (e_cbm_gw_soc - e_vbm_gw_soc)*evolt
1920 ELSE
1921 WRITE (unit_nr, '(T3,A,F45.4)') 'SCF+SOC valence band maximum (eV)', e_vbm_gw_soc*evolt
1922 WRITE (unit_nr, '(T3,A,F42.4)') 'SCF+SOC conduction band minimum (eV)', e_cbm_gw_soc*evolt
1923 WRITE (unit_nr, '(T3,A,F58.4)') 'SCF+SOC bandgap (eV)', (e_cbm_gw_soc - e_vbm_gw_soc)*evolt
1924 END IF
1925 END IF
1926
1927 CALL dbcsr_deallocate_matrix_set(matrix_l)
1928 CALL dbcsr_deallocate_matrix_set(mat_vsoc_l_nosymm)
1929 CALL dbcsr_deallocate_matrix_set(matrix_pot_dummy)
1930 CALL dbcsr_deallocate_matrix_set(mat_vsoc_lx_kp)
1931 CALL dbcsr_deallocate_matrix_set(mat_vsoc_ly_kp)
1932 CALL dbcsr_deallocate_matrix_set(mat_vsoc_lz_kp)
1933 CALL dbcsr_deallocate_matrix_set(matrix_s_desymm)
1934
1935 CALL cp_cfm_release(cfm_mat_h_double)
1936 CALL cp_cfm_release(cfm_mat_s_double)
1937 CALL cp_cfm_release(cfm_mo_coeff_double)
1938 CALL cp_cfm_release(cfm_mo_coeff)
1939 CALL cp_cfm_release(cfm_mat_h_ks)
1940 CALL cp_cfm_release(cfm_mat_work_double)
1941 DEALLOCATE (eigenvalues)
1942
1943 CALL timestop(handle)
1944
1945 END SUBROUTINE calculate_and_print_soc
1946
1947! **************************************************************************************************
1948!> \brief ...
1949!> \param cfm_mat_target ...
1950!> \param mat_source ...
1951!> \param cfm_source_template ...
1952!> \param nstart_row ...
1953!> \param nstart_col ...
1954!> \param factor ...
1955!> \param add_also_herm_conj ...
1956! **************************************************************************************************
1957 SUBROUTINE add_dbcsr_submatrix(cfm_mat_target, mat_source, cfm_source_template, &
1958 nstart_row, nstart_col, factor, add_also_herm_conj)
1959 TYPE(cp_cfm_type) :: cfm_mat_target
1960 TYPE(dbcsr_p_type), DIMENSION(:) :: mat_source
1961 TYPE(cp_cfm_type) :: cfm_source_template
1962 INTEGER :: nstart_row, nstart_col
1963 COMPLEX(KIND=dp) :: factor
1964 LOGICAL :: add_also_herm_conj
1965
1966 CHARACTER(LEN=*), PARAMETER :: routinen = 'add_dbcsr_submatrix'
1967
1968 INTEGER :: handle, nao
1969 TYPE(cp_cfm_type) :: cfm_mat_work_double, &
1970 cfm_mat_work_double_2
1971 TYPE(cp_fm_type) :: fm_mat_work_double_im, &
1972 fm_mat_work_double_re, fm_mat_work_im, &
1973 fm_mat_work_re
1974
1975 CALL timeset(routinen, handle)
1976
1977 CALL cp_fm_create(fm_mat_work_double_re, cfm_mat_target%matrix_struct)
1978 CALL cp_fm_create(fm_mat_work_double_im, cfm_mat_target%matrix_struct)
1979 CALL cp_fm_set_all(fm_mat_work_double_re, 0.0_dp)
1980 CALL cp_fm_set_all(fm_mat_work_double_im, 0.0_dp)
1981
1982 CALL cp_cfm_create(cfm_mat_work_double, cfm_mat_target%matrix_struct)
1983 CALL cp_cfm_create(cfm_mat_work_double_2, cfm_mat_target%matrix_struct)
1984 CALL cp_cfm_set_all(cfm_mat_work_double, z_zero)
1985 CALL cp_cfm_set_all(cfm_mat_work_double_2, z_zero)
1986
1987 CALL cp_fm_create(fm_mat_work_re, cfm_source_template%matrix_struct)
1988 CALL cp_fm_create(fm_mat_work_im, cfm_source_template%matrix_struct)
1989
1990 CALL copy_dbcsr_to_fm(mat_source(1)%matrix, fm_mat_work_re)
1991 CALL copy_dbcsr_to_fm(mat_source(2)%matrix, fm_mat_work_im)
1992
1993 CALL cp_cfm_get_info(cfm_source_template, nrow_global=nao)
1994
1995 CALL cp_fm_to_fm_submat(msource=fm_mat_work_re, mtarget=fm_mat_work_double_re, &
1996 nrow=nao, ncol=nao, &
1997 s_firstrow=1, s_firstcol=1, &
1998 t_firstrow=nstart_row, t_firstcol=nstart_col)
1999
2000 CALL cp_fm_to_fm_submat(msource=fm_mat_work_im, mtarget=fm_mat_work_double_im, &
2001 nrow=nao, ncol=nao, &
2002 s_firstrow=1, s_firstcol=1, &
2003 t_firstrow=nstart_row, t_firstcol=nstart_col)
2004
2005 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_work_double, z_one, fm_mat_work_double_re)
2006 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_work_double, gaussi, fm_mat_work_double_im)
2007
2008 CALL cp_cfm_scale(factor, cfm_mat_work_double)
2009
2010 CALL cp_cfm_scale_and_add(z_one, cfm_mat_target, z_one, cfm_mat_work_double)
2011
2012 IF (add_also_herm_conj) THEN
2013 CALL cp_cfm_transpose(cfm_mat_work_double, 'C', cfm_mat_work_double_2)
2014 CALL cp_cfm_scale_and_add(z_one, cfm_mat_target, z_one, cfm_mat_work_double_2)
2015 END IF
2016
2017 CALL cp_fm_release(fm_mat_work_double_re)
2018 CALL cp_fm_release(fm_mat_work_double_im)
2019 CALL cp_cfm_release(cfm_mat_work_double)
2020 CALL cp_cfm_release(cfm_mat_work_double_2)
2021 CALL cp_fm_release(fm_mat_work_re)
2022 CALL cp_fm_release(fm_mat_work_im)
2023
2024 CALL timestop(handle)
2025
2026 END SUBROUTINE add_dbcsr_submatrix
2027
2028! **************************************************************************************************
2029!> \brief ...
2030!> \param cfm_mat_target ...
2031!> \param cfm_mat_source ...
2032!> \param nstart_row ...
2033!> \param nstart_col ...
2034! **************************************************************************************************
2035 SUBROUTINE add_cfm_submatrix(cfm_mat_target, cfm_mat_source, nstart_row, nstart_col)
2036
2037 TYPE(cp_cfm_type) :: cfm_mat_target, cfm_mat_source
2038 INTEGER :: nstart_row, nstart_col
2039
2040 CHARACTER(LEN=*), PARAMETER :: routinen = 'add_cfm_submatrix'
2041
2042 INTEGER :: handle, nao
2043 TYPE(cp_fm_type) :: fm_mat_work_double_im, &
2044 fm_mat_work_double_re, fm_mat_work_im, &
2045 fm_mat_work_re
2046
2047 CALL timeset(routinen, handle)
2048
2049 CALL cp_fm_create(fm_mat_work_double_re, cfm_mat_target%matrix_struct)
2050 CALL cp_fm_create(fm_mat_work_double_im, cfm_mat_target%matrix_struct)
2051 CALL cp_fm_set_all(fm_mat_work_double_re, 0.0_dp)
2052 CALL cp_fm_set_all(fm_mat_work_double_im, 0.0_dp)
2053
2054 CALL cp_fm_create(fm_mat_work_re, cfm_mat_source%matrix_struct)
2055 CALL cp_fm_create(fm_mat_work_im, cfm_mat_source%matrix_struct)
2056 CALL cp_cfm_to_fm(cfm_mat_source, fm_mat_work_re, fm_mat_work_im)
2057
2058 CALL cp_cfm_get_info(cfm_mat_source, nrow_global=nao)
2059
2060 CALL cp_fm_to_fm_submat(msource=fm_mat_work_re, mtarget=fm_mat_work_double_re, &
2061 nrow=nao, ncol=nao, &
2062 s_firstrow=1, s_firstcol=1, &
2063 t_firstrow=nstart_row, t_firstcol=nstart_col)
2064
2065 CALL cp_fm_to_fm_submat(msource=fm_mat_work_im, mtarget=fm_mat_work_double_im, &
2066 nrow=nao, ncol=nao, &
2067 s_firstrow=1, s_firstcol=1, &
2068 t_firstrow=nstart_row, t_firstcol=nstart_col)
2069
2070 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_target, z_one, fm_mat_work_double_re)
2071 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_target, gaussi, fm_mat_work_double_im)
2072
2073 CALL cp_fm_release(fm_mat_work_double_re)
2074 CALL cp_fm_release(fm_mat_work_double_im)
2075 CALL cp_fm_release(fm_mat_work_re)
2076 CALL cp_fm_release(fm_mat_work_im)
2077
2078 CALL timestop(handle)
2079
2080 END SUBROUTINE add_cfm_submatrix
2081
2082! **************************************************************************************************
2083!> \brief ...
2084!> \param fm_orig ...
2085!> \param cfm_double ...
2086! **************************************************************************************************
2087 SUBROUTINE create_cfm_double_row_col_size(fm_orig, cfm_double)
2088 TYPE(cp_fm_type) :: fm_orig
2089 TYPE(cp_cfm_type) :: cfm_double
2090
2091 CHARACTER(LEN=*), PARAMETER :: routinen = 'create_cfm_double_row_col_size'
2092
2093 INTEGER :: handle, ncol_global_orig, &
2094 nrow_global_orig
2095 TYPE(cp_fm_struct_type), POINTER :: fm_struct_double
2096
2097 CALL timeset(routinen, handle)
2098
2099 CALL cp_fm_get_info(matrix=fm_orig, nrow_global=nrow_global_orig, ncol_global=ncol_global_orig)
2100
2101 CALL cp_fm_struct_create(fm_struct_double, &
2102 nrow_global=2*nrow_global_orig, &
2103 ncol_global=2*ncol_global_orig, &
2104 template_fmstruct=fm_orig%matrix_struct)
2105
2106 CALL cp_cfm_create(cfm_double, fm_struct_double)
2107
2108 CALL cp_fm_struct_release(fm_struct_double)
2109
2110 CALL timestop(handle)
2111
2112 END SUBROUTINE create_cfm_double_row_col_size
2113
2114! **************************************************************************************************
2115!> \brief ...
2116!> \param E_VBM_SCF ...
2117!> \param E_CBM_SCF ...
2118!> \param E_VBM_SCF_beta ...
2119!> \param E_CBM_SCF_beta ...
2120!> \param E_VBM_GW ...
2121!> \param E_CBM_GW ...
2122!> \param E_VBM_GW_beta ...
2123!> \param E_CBM_GW_beta ...
2124!> \param my_open_shell ...
2125!> \param unit_nr ...
2126! **************************************************************************************************
2127 SUBROUTINE print_gaps(E_VBM_SCF, E_CBM_SCF, E_VBM_SCF_beta, E_CBM_SCF_beta, &
2128 E_VBM_GW, E_CBM_GW, E_VBM_GW_beta, E_CBM_GW_beta, my_open_shell, unit_nr)
2129
2130 REAL(kind=dp) :: e_vbm_scf, e_cbm_scf, e_vbm_scf_beta, &
2131 e_cbm_scf_beta, e_vbm_gw, e_cbm_gw, &
2132 e_vbm_gw_beta, e_cbm_gw_beta
2133 LOGICAL :: my_open_shell
2134 INTEGER :: unit_nr
2135
2136 IF (my_open_shell) THEN
2137 WRITE (unit_nr, '(T3,A)') ' '
2138 WRITE (unit_nr, '(T3,A,F43.4)') 'Alpha SCF valence band maximum (eV)', e_vbm_scf*evolt
2139 WRITE (unit_nr, '(T3,A,F40.4)') 'Alpha SCF conduction band minimum (eV)', e_cbm_scf*evolt
2140 WRITE (unit_nr, '(T3,A,F56.4)') 'Alpha SCF bandgap (eV)', (e_cbm_scf - e_vbm_scf)*evolt
2141 WRITE (unit_nr, '(T3,A)') ' '
2142 WRITE (unit_nr, '(T3,A,F44.4)') 'Beta SCF valence band maximum (eV)', e_vbm_scf_beta*evolt
2143 WRITE (unit_nr, '(T3,A,F41.4)') 'Beta SCF conduction band minimum (eV)', e_cbm_scf_beta*evolt
2144 WRITE (unit_nr, '(T3,A,F57.4)') 'Beta SCF bandgap (eV)', (e_cbm_scf_beta - e_vbm_scf_beta)*evolt
2145 WRITE (unit_nr, '(T3,A)') ' '
2146 WRITE (unit_nr, '(T3,A,F44.4)') 'Alpha GW valence band maximum (eV)', e_vbm_gw*evolt
2147 WRITE (unit_nr, '(T3,A,F41.4)') 'Alpha GW conduction band minimum (eV)', e_cbm_gw*evolt
2148 WRITE (unit_nr, '(T3,A,F57.4)') 'Alpha GW bandgap (eV)', (e_cbm_gw - e_vbm_gw)*evolt
2149 WRITE (unit_nr, '(T3,A)') ' '
2150 WRITE (unit_nr, '(T3,A,F45.4)') 'Beta GW valence band maximum (eV)', e_vbm_gw_beta*evolt
2151 WRITE (unit_nr, '(T3,A,F42.4)') 'Beta GW conduction band minimum (eV)', e_cbm_gw_beta*evolt
2152 WRITE (unit_nr, '(T3,A,F58.4)') 'Beta GW bandgap (eV)', (e_cbm_gw_beta - e_vbm_gw_beta)*evolt
2153 ELSE
2154 WRITE (unit_nr, '(T3,A)') ' '
2155 WRITE (unit_nr, '(T3,A,F49.4)') 'SCF valence band maximum (eV)', e_vbm_scf*evolt
2156 WRITE (unit_nr, '(T3,A,F46.4)') 'SCF conduction band minimum (eV)', e_cbm_scf*evolt
2157 WRITE (unit_nr, '(T3,A,F62.4)') 'SCF bandgap (eV)', (e_cbm_scf - e_vbm_scf)*evolt
2158 WRITE (unit_nr, '(T3,A)') ' '
2159 WRITE (unit_nr, '(T3,A,F50.4)') 'GW valence band maximum (eV)', e_vbm_gw*evolt
2160 WRITE (unit_nr, '(T3,A,F47.4)') 'GW conduction band minimum (eV)', e_cbm_gw*evolt
2161 WRITE (unit_nr, '(T3,A,F63.4)') 'GW bandgap (eV)', (e_cbm_gw - e_vbm_gw)*evolt
2162 END IF
2163
2164 END SUBROUTINE print_gaps
2165
2166! **************************************************************************************************
2167!> \brief ...
2168!> \param array ...
2169!> \param real_value ...
2170! **************************************************************************************************
2171 SUBROUTINE check_nan(array, real_value)
2172 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
2173 INTENT(INOUT) :: array
2174 REAL(kind=dp), INTENT(IN) :: real_value
2175
2176 CHARACTER(LEN=*), PARAMETER :: routinen = 'check_NaN'
2177
2178 INTEGER :: handle, i, j, k
2179
2180 CALL timeset(routinen, handle)
2181
2182 DO i = 1, SIZE(array, 1)
2183 DO j = 1, SIZE(array, 2)
2184 DO k = 1, SIZE(array, 3)
2185
2186 ! check for NaN
2187 IF (array(i, j, k) /= array(i, j, k)) array(i, j, k) = real_value
2188
2189 END DO
2190 END DO
2191 END DO
2192
2193 CALL timestop(handle)
2194
2195 END SUBROUTINE check_nan
2196
2197! **************************************************************************************************
2198!> \brief ...
2199!> \param qs_env ...
2200!> \param Eigenval ...
2201!> \param gw_corr_lev_occ ...
2202!> \param gw_corr_lev_virt ...
2203!> \param homo ...
2204!> \param dft_gw_char ...
2205! **************************************************************************************************
2206 SUBROUTINE print_local_bandgap(qs_env, Eigenval, gw_corr_lev_occ, gw_corr_lev_virt, homo, dft_gw_char)
2207 TYPE(qs_environment_type), POINTER :: qs_env
2208 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: eigenval
2209 INTEGER :: gw_corr_lev_occ, gw_corr_lev_virt, homo
2210 CHARACTER(len=*) :: dft_gw_char
2211
2212 CHARACTER(LEN=*), PARAMETER :: routinen = 'print_local_bandgap'
2213
2214 INTEGER :: handle, i_e
2215 TYPE(pw_c1d_gs_type) :: rho_g_dummy
2216 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
2217 TYPE(pw_r3d_rs_type) :: e_cbm_rspace, e_gap_rspace, e_vbm_rspace
2218 TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: ldos
2219
2220 CALL timeset(routinen, handle)
2221
2222 CALL create_real_space_grids(e_gap_rspace, e_vbm_rspace, e_cbm_rspace, rho_g_dummy, ldos, auxbas_pw_pool, qs_env)
2223
2224 CALL calculate_e_gap_rspace(e_gap_rspace, e_vbm_rspace, e_cbm_rspace, rho_g_dummy, &
2225 ldos, qs_env, eigenval, gw_corr_lev_occ, gw_corr_lev_virt, homo, dft_gw_char)
2226
2227 CALL auxbas_pw_pool%give_back_pw(e_gap_rspace)
2228 CALL auxbas_pw_pool%give_back_pw(e_vbm_rspace)
2229 CALL auxbas_pw_pool%give_back_pw(e_cbm_rspace)
2230 CALL auxbas_pw_pool%give_back_pw(rho_g_dummy)
2231 DO i_e = 1, SIZE(ldos)
2232 CALL auxbas_pw_pool%give_back_pw(ldos(i_e))
2233 END DO
2234 DEALLOCATE (ldos)
2235
2236 CALL timestop(handle)
2237
2238 END SUBROUTINE print_local_bandgap
2239
2240! **************************************************************************************************
2241!> \brief ...
2242!> \param E_gap_rspace ...
2243!> \param E_VBM_rspace ...
2244!> \param E_CBM_rspace ...
2245!> \param rho_g_dummy ...
2246!> \param LDOS ...
2247!> \param qs_env ...
2248!> \param Eigenval ...
2249!> \param gw_corr_lev_occ ...
2250!> \param gw_corr_lev_virt ...
2251!> \param homo ...
2252!> \param dft_gw_char ...
2253! **************************************************************************************************
2254 SUBROUTINE calculate_e_gap_rspace(E_gap_rspace, E_VBM_rspace, E_CBM_rspace, rho_g_dummy, &
2255 LDOS, qs_env, Eigenval, gw_corr_lev_occ, gw_corr_lev_virt, homo, dft_gw_char)
2256 TYPE(pw_r3d_rs_type) :: e_gap_rspace, e_vbm_rspace, e_cbm_rspace
2257 TYPE(pw_c1d_gs_type) :: rho_g_dummy
2258 TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: ldos
2259 TYPE(qs_environment_type), POINTER :: qs_env
2260 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: eigenval
2261 INTEGER :: gw_corr_lev_occ, gw_corr_lev_virt, homo
2262 CHARACTER(len=*) :: dft_gw_char
2263
2264 CHARACTER(LEN=*), PARAMETER :: routinen = 'calculate_E_gap_rspace'
2265
2266 INTEGER :: handle, i_e, i_img, i_spin, i_x, i_y, i_z, ikp, imo, n_e, n_e_occ, n_x_end, &
2267 n_x_start, n_y_end, n_y_start, n_z_end, n_z_start, nimg, nkp, nkp_self_energy
2268 REAL(kind=dp) :: avg_ldos_occ, avg_ldos_virt, d_e, e_cbm, &
2269 e_cbm_at_k, e_diff, e_vbm, e_vbm_at_k
2270 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: e_array
2271 REAL(kind=dp), DIMENSION(:), POINTER :: occupation
2272 TYPE(cp_fm_struct_type), POINTER :: matrix_struct
2273 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: fm_work
2274 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, rho_ao
2275 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_weighted
2276 TYPE(dft_control_type), POINTER :: dft_control
2277 TYPE(kpoint_type), POINTER :: kpoints_sigma
2278 TYPE(mp2_type), POINTER :: mp2_env
2279 TYPE(mp_para_env_type), POINTER :: para_env
2280 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
2281 POINTER :: sab_orb
2282 TYPE(particle_list_type), POINTER :: particles
2283 TYPE(qs_ks_env_type), POINTER :: ks_env
2284 TYPE(qs_scf_env_type), POINTER :: scf_env
2285 TYPE(qs_subsys_type), POINTER :: subsys
2286 TYPE(section_vals_type), POINTER :: gw_section
2287
2288 CALL timeset(routinen, handle)
2289
2290 CALL get_qs_env(qs_env=qs_env, para_env=para_env, mp2_env=mp2_env, ks_env=ks_env, matrix_s=matrix_s, &
2291 scf_env=scf_env, sab_orb=sab_orb, dft_control=dft_control, subsys=subsys)
2292
2293 ! compute valence band maximum (VBM) and conduction band minimum (CBM)
2294 nkp = SIZE(eigenval, 2)
2295 e_vbm = -1.0e3_dp
2296 e_cbm = 1.0e3_dp
2297
2298 DO ikp = 1, nkp
2299
2300 e_vbm_at_k = maxval(eigenval(homo - gw_corr_lev_occ + 1:homo, ikp, 1))
2301 IF (e_vbm_at_k > e_vbm) e_vbm = e_vbm_at_k
2302
2303 e_cbm_at_k = minval(eigenval(homo + 1:homo + gw_corr_lev_virt, ikp, 1))
2304 IF (e_cbm_at_k < e_cbm) e_cbm = e_cbm_at_k
2305
2306 END DO
2307
2308 d_e = mp2_env%ri_g0w0%energy_spacing_print_loc_bandgap
2309
2310 n_e = int(mp2_env%ri_g0w0%energy_window_print_loc_bandgap/d_e)
2311
2312 n_e_occ = n_e/2
2313 ALLOCATE (e_array(n_e))
2314 DO i_e = 1, n_e_occ
2315 e_array(i_e) = e_vbm - real(n_e_occ - i_e, kind=dp)*d_e
2316 END DO
2317 DO i_e = n_e_occ + 1, n_e
2318 e_array(i_e) = e_cbm + real(i_e - n_e_occ - 1, kind=dp)*d_e
2319 END DO
2320
2321 kpoints_sigma => qs_env%mp2_env%ri_rpa_im_time%kpoints_Sigma
2322
2323 nkp_self_energy = kpoints_sigma%nkp
2324 cpassert(nkp == nkp_self_energy)
2325
2326 kpoints_sigma%sab_nl => sab_orb
2327
2328 DEALLOCATE (kpoints_sigma%cell_to_index)
2329 NULLIFY (kpoints_sigma%cell_to_index)
2330 CALL kpoint_init_cell_index(kpoints_sigma, sab_orb, para_env, dft_control)
2331
2332 nimg = maxval(kpoints_sigma%cell_to_index)
2333
2334 NULLIFY (rho_ao_weighted)
2335 CALL dbcsr_allocate_matrix_set(rho_ao_weighted, 2, nimg)
2336
2337 DO i_spin = 1, 2
2338 DO i_img = 1, nimg
2339 ALLOCATE (rho_ao_weighted(i_spin, i_img)%matrix)
2340 CALL dbcsr_create(matrix=rho_ao_weighted(i_spin, i_img)%matrix, template=matrix_s(1)%matrix)
2341 CALL cp_dbcsr_alloc_block_from_nbl(rho_ao_weighted(i_spin, i_img)%matrix, sab_orb)
2342 CALL dbcsr_set(rho_ao_weighted(i_spin, i_img)%matrix, 0.0_dp)
2343 END DO
2344 END DO
2345
2346 ALLOCATE (fm_work(nimg))
2347 matrix_struct => kpoints_sigma%kp_env(1)%kpoint_env%mos(1, 1)%mo_coeff%matrix_struct
2348 DO i_img = 1, nimg
2349 CALL cp_fm_create(fm_work(i_img), matrix_struct)
2350 END DO
2351
2352 DO i_e = 1, n_e
2353
2354 ! occupation = weight factor for computing LDOS
2355 DO ikp = 1, nkp
2356 CALL get_mo_set(kpoints_sigma%kp_env(ikp)%kpoint_env%mos(1, 1), &
2357 occupation_numbers=occupation)
2358
2359 occupation(:) = 0.0_dp
2360 DO imo = homo - gw_corr_lev_occ + 1, homo + gw_corr_lev_virt
2361 e_diff = e_array(i_e) - eigenval(imo, ikp, 1)
2362 occupation(imo) = exp(-(e_diff/d_e)**2)
2363 END DO
2364
2365 END DO
2366
2367 CALL get_mo_set(kpoints_sigma%kp_env(1)%kpoint_env%mos(1, 1), &
2368 occupation_numbers=occupation)
2369
2370 ! density matrices
2371 CALL kpoint_density_matrices(kpoints_sigma)
2372
2373 ! density matrices in real space
2374 CALL kpoint_density_transform(kpoints_sigma, rho_ao_weighted, .false., &
2375 matrix_s(1)%matrix, sab_orb, fm_work)
2376
2377 rho_ao => rho_ao_weighted(1, :)
2378
2379 CALL calculate_rho_elec(matrix_p_kp=rho_ao, &
2380 rho=ldos(i_e), &
2381 rho_gspace=rho_g_dummy, &
2382 ks_env=ks_env)
2383
2384 DO i_spin = 1, 2
2385 DO i_img = 1, nimg
2386 CALL dbcsr_set(rho_ao_weighted(i_spin, i_img)%matrix, 0.0_dp)
2387 END DO
2388 END DO
2389
2390 END DO
2391
2392 n_x_start = lbound(ldos(1)%array, 1)
2393 n_x_end = ubound(ldos(1)%array, 1)
2394 n_y_start = lbound(ldos(1)%array, 2)
2395 n_y_end = ubound(ldos(1)%array, 2)
2396 n_z_start = lbound(ldos(1)%array, 3)
2397 n_z_end = ubound(ldos(1)%array, 3)
2398
2399 CALL pw_zero(e_vbm_rspace)
2400 CALL pw_zero(e_cbm_rspace)
2401
2402 DO i_x = n_x_start, n_x_end
2403 DO i_y = n_y_start, n_y_end
2404 DO i_z = n_z_start, n_z_end
2405 ! compute average occ and virt LDOS
2406 avg_ldos_occ = 0.0_dp
2407 DO i_e = 1, n_e_occ
2408 avg_ldos_occ = avg_ldos_occ + ldos(i_e)%array(i_x, i_y, i_z)
2409 END DO
2410 avg_ldos_occ = avg_ldos_occ/real(n_e_occ, kind=dp)
2411
2412 avg_ldos_virt = 0.0_dp
2413 DO i_e = n_e_occ + 1, n_e
2414 avg_ldos_virt = avg_ldos_virt + ldos(i_e)%array(i_x, i_y, i_z)
2415 END DO
2416 avg_ldos_virt = avg_ldos_virt/real(n_e - n_e_occ, kind=dp)
2417
2418 ! compute local valence band maximum (VBM)
2419 DO i_e = n_e_occ, 1, -1
2420 IF (ldos(i_e)%array(i_x, i_y, i_z) > mp2_env%ri_g0w0%ldos_thresh_print_loc_bandgap*avg_ldos_occ) THEN
2421 e_vbm_rspace%array(i_x, i_y, i_z) = e_array(i_e)
2422 EXIT
2423 END IF
2424 END DO
2425
2426 ! compute local valence band maximum (VBM)
2427 DO i_e = n_e_occ + 1, n_e
2428 IF (ldos(i_e)%array(i_x, i_y, i_z) > mp2_env%ri_g0w0%ldos_thresh_print_loc_bandgap*avg_ldos_virt) THEN
2429 e_cbm_rspace%array(i_x, i_y, i_z) = e_array(i_e)
2430 EXIT
2431 END IF
2432 END DO
2433
2434 END DO
2435 END DO
2436 END DO
2437
2438 CALL pw_scale(e_vbm_rspace, evolt)
2439 CALL pw_scale(e_cbm_rspace, evolt)
2440
2441 CALL pw_copy(e_cbm_rspace, e_gap_rspace)
2442 CALL pw_axpy(e_vbm_rspace, e_gap_rspace, -1.0_dp)
2443
2444 gw_section => section_vals_get_subs_vals(qs_env%input, "DFT%XC%WF_CORRELATION%RI_RPA%GW")
2445 CALL qs_subsys_get(subsys, particles=particles)
2446
2447 CALL print_file(e_gap_rspace, dft_gw_char//"_Gap_in_eV", gw_section, particles, mp2_env)
2448 CALL print_file(e_vbm_rspace, dft_gw_char//"_VBM_in_eV", gw_section, particles, mp2_env)
2449 CALL print_file(e_cbm_rspace, dft_gw_char//"_CBM_in_eV", gw_section, particles, mp2_env)
2450 CALL print_file(ldos(n_e_occ), dft_gw_char//"_LDOS_VBM_in_eV", gw_section, particles, mp2_env)
2451 CALL print_file(ldos(n_e_occ + 1), dft_gw_char//"_LDOS_CBM_in_eV", gw_section, particles, mp2_env)
2452
2453 CALL dbcsr_deallocate_matrix_set(rho_ao_weighted)
2454
2455 CALL cp_fm_release(fm_work)
2456
2457 DEALLOCATE (e_array)
2458
2459 NULLIFY (kpoints_sigma%sab_nl)
2460
2461 CALL timestop(handle)
2462
2463 END SUBROUTINE calculate_e_gap_rspace
2464
2465! **************************************************************************************************
2466!> \brief ...
2467!> \param pw_print ...
2468!> \param middle_name ...
2469!> \param gw_section ...
2470!> \param particles ...
2471!> \param mp2_env ...
2472! **************************************************************************************************
2473 SUBROUTINE print_file(pw_print, middle_name, gw_section, particles, mp2_env)
2474 TYPE(pw_r3d_rs_type) :: pw_print
2475 CHARACTER(len=*) :: middle_name
2476 TYPE(section_vals_type), POINTER :: gw_section
2477 TYPE(particle_list_type), POINTER :: particles
2478 TYPE(mp2_type), POINTER :: mp2_env
2479
2480 CHARACTER(LEN=*), PARAMETER :: routinen = 'print_file'
2481
2482 INTEGER :: handle, unit_nr_cube
2483 LOGICAL :: mpi_io
2484 TYPE(cp_logger_type), POINTER :: logger
2485
2486 CALL timeset(routinen, handle)
2487
2488 NULLIFY (logger)
2489 logger => cp_get_default_logger()
2490 mpi_io = .true.
2491 unit_nr_cube = cp_print_key_unit_nr(logger, gw_section, "PRINT%LOCAL_BANDGAP", extension=".cube", &
2492 middle_name=middle_name, file_form="FORMATTED", mpi_io=mpi_io)
2493 CALL cp_pw_to_cube(pw_print, unit_nr_cube, middle_name, particles=particles, &
2494 stride=mp2_env%ri_g0w0%stride_loc_bandgap, mpi_io=mpi_io)
2495 CALL cp_print_key_finished_output(unit_nr_cube, logger, gw_section, &
2496 "PRINT%LOCAL_BANDGAP", mpi_io=mpi_io)
2497
2498 CALL timestop(handle)
2499
2500 END SUBROUTINE print_file
2501
2502! **************************************************************************************************
2503!> \brief ...
2504!> \param E_gap_rspace ...
2505!> \param E_VBM_rspace ...
2506!> \param E_CBM_rspace ...
2507!> \param rho_g_dummy ...
2508!> \param LDOS ...
2509!> \param auxbas_pw_pool ...
2510!> \param qs_env ...
2511! **************************************************************************************************
2512 SUBROUTINE create_real_space_grids(E_gap_rspace, E_VBM_rspace, E_CBM_rspace, rho_g_dummy, LDOS, auxbas_pw_pool, qs_env)
2513 TYPE(pw_r3d_rs_type) :: e_gap_rspace, e_vbm_rspace, e_cbm_rspace
2514 TYPE(pw_c1d_gs_type) :: rho_g_dummy
2515 TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: ldos
2516 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
2517 TYPE(qs_environment_type), POINTER :: qs_env
2518
2519 CHARACTER(LEN=*), PARAMETER :: routinen = 'create_real_space_grids'
2520
2521 INTEGER :: handle, i_e, n_e
2522 TYPE(mp2_type), POINTER :: mp2_env
2523 TYPE(pw_env_type), POINTER :: pw_env
2524
2525 CALL timeset(routinen, handle)
2526
2527 CALL get_qs_env(qs_env=qs_env, mp2_env=mp2_env, pw_env=pw_env)
2528
2529 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
2530
2531 CALL auxbas_pw_pool%create_pw(e_gap_rspace)
2532 CALL auxbas_pw_pool%create_pw(e_vbm_rspace)
2533 CALL auxbas_pw_pool%create_pw(e_cbm_rspace)
2534 CALL auxbas_pw_pool%create_pw(rho_g_dummy)
2535
2536 n_e = int(mp2_env%ri_g0w0%energy_window_print_loc_bandgap/ &
2537 mp2_env%ri_g0w0%energy_spacing_print_loc_bandgap)
2538
2539 ALLOCATE (ldos(n_e))
2540
2541 DO i_e = 1, n_e
2542 CALL auxbas_pw_pool%create_pw(ldos(i_e))
2543 END DO
2544
2545 CALL timestop(handle)
2546
2547 END SUBROUTINE create_real_space_grids
2548
2549! **************************************************************************************************
2550!> \brief ...
2551!> \param delta_corr ...
2552!> \param qs_env ...
2553!> \param para_env ...
2554!> \param para_env_RPA ...
2555!> \param kp_grid ...
2556!> \param homo ...
2557!> \param nmo ...
2558!> \param gw_corr_lev_occ ...
2559!> \param gw_corr_lev_virt ...
2560!> \param omega ...
2561!> \param fm_mo_coeff ...
2562!> \param Eigenval ...
2563!> \param matrix_berry_re_mo_mo ...
2564!> \param matrix_berry_im_mo_mo ...
2565!> \param first_cycle_periodic_correction ...
2566!> \param kpoints ...
2567!> \param do_mo_coeff_Gamma_only ...
2568!> \param num_kp_grids ...
2569!> \param eps_kpoint ...
2570!> \param do_extra_kpoints ...
2571!> \param do_aux_bas ...
2572!> \param frac_aux_mos ...
2573! **************************************************************************************************
2574 SUBROUTINE calc_periodic_correction(delta_corr, qs_env, para_env, para_env_RPA, kp_grid, homo, nmo, &
2575 gw_corr_lev_occ, gw_corr_lev_virt, omega, fm_mo_coeff, Eigenval, &
2576 matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, &
2577 first_cycle_periodic_correction, kpoints, do_mo_coeff_Gamma_only, &
2578 num_kp_grids, eps_kpoint, do_extra_kpoints, do_aux_bas, frac_aux_mos)
2579
2580 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
2581 INTENT(INOUT) :: delta_corr
2582 TYPE(qs_environment_type), POINTER :: qs_env
2583 TYPE(mp_para_env_type), POINTER :: para_env, para_env_rpa
2584 INTEGER, DIMENSION(:), POINTER :: kp_grid
2585 INTEGER, INTENT(IN) :: homo, nmo, gw_corr_lev_occ, &
2586 gw_corr_lev_virt
2587 REAL(kind=dp), INTENT(IN) :: omega
2588 TYPE(cp_fm_type), INTENT(IN) :: fm_mo_coeff
2589 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: eigenval
2590 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_berry_re_mo_mo, &
2591 matrix_berry_im_mo_mo
2592 LOGICAL, INTENT(INOUT) :: first_cycle_periodic_correction
2593 TYPE(kpoint_type), POINTER :: kpoints
2594 LOGICAL, INTENT(IN) :: do_mo_coeff_gamma_only
2595 INTEGER, INTENT(IN) :: num_kp_grids
2596 REAL(kind=dp), INTENT(IN) :: eps_kpoint
2597 LOGICAL, INTENT(IN) :: do_extra_kpoints, do_aux_bas
2598 REAL(kind=dp), INTENT(IN) :: frac_aux_mos
2599
2600 CHARACTER(LEN=*), PARAMETER :: routinen = 'calc_periodic_correction'
2601
2602 INTEGER :: handle
2603 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: eps_head, eps_inv_head
2604 REAL(kind=dp), DIMENSION(3, 3) :: h_inv
2605
2606 CALL timeset(routinen, handle)
2607
2608 IF (first_cycle_periodic_correction) THEN
2609
2610 CALL get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, nmo, do_mo_coeff_gamma_only, &
2611 do_extra_kpoints)
2612
2613 CALL get_berry_phase(qs_env, kpoints, matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, fm_mo_coeff, &
2614 para_env, do_mo_coeff_gamma_only, homo, nmo, gw_corr_lev_virt, eps_kpoint, do_aux_bas, &
2615 frac_aux_mos)
2616
2617 END IF
2618
2619 CALL compute_eps_head_berry(eps_head, kpoints, matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, para_env_rpa, &
2620 qs_env, homo, eigenval, omega)
2621
2622 CALL compute_eps_inv_head(eps_inv_head, eps_head, kpoints)
2623
2624 CALL kpoint_sum_for_eps_inv_head_berry(delta_corr, eps_inv_head, kpoints, qs_env, &
2625 matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, &
2626 homo, gw_corr_lev_occ, gw_corr_lev_virt, para_env_rpa, &
2627 do_extra_kpoints)
2628
2629 DEALLOCATE (eps_head, eps_inv_head)
2630
2631 first_cycle_periodic_correction = .false.
2632
2633 CALL timestop(handle)
2634
2635 END SUBROUTINE calc_periodic_correction
2636
2637! **************************************************************************************************
2638!> \brief ...
2639!> \param eps_head ...
2640!> \param kpoints ...
2641!> \param matrix_berry_re_mo_mo ...
2642!> \param matrix_berry_im_mo_mo ...
2643!> \param para_env_RPA ...
2644!> \param qs_env ...
2645!> \param homo ...
2646!> \param Eigenval ...
2647!> \param omega ...
2648! **************************************************************************************************
2649 SUBROUTINE compute_eps_head_berry(eps_head, kpoints, matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, para_env_RPA, &
2650 qs_env, homo, Eigenval, omega)
2651
2652 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
2653 INTENT(OUT) :: eps_head
2654 TYPE(kpoint_type), POINTER :: kpoints
2655 TYPE(dbcsr_p_type), DIMENSION(:), INTENT(IN) :: matrix_berry_re_mo_mo, &
2656 matrix_berry_im_mo_mo
2657 TYPE(mp_para_env_type), INTENT(IN) :: para_env_rpa
2658 TYPE(qs_environment_type), POINTER :: qs_env
2659 INTEGER, INTENT(IN) :: homo
2660 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: eigenval
2661 REAL(kind=dp), INTENT(IN) :: omega
2662
2663 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_eps_head_Berry'
2664
2665 INTEGER :: col, col_end_in_block, col_offset, col_size, handle, i_col, i_row, ikp, nkp, nmo, &
2666 row, row_offset, row_size, row_start_in_block
2667 REAL(kind=dp) :: abs_k_square, cell_volume, &
2668 correct_kpoint(3), cos_square, &
2669 eigen_diff, relative_kpoint(3), &
2670 sin_square
2671 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: p_head
2672 REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
2673 TYPE(cell_type), POINTER :: cell
2674 TYPE(dbcsr_iterator_type) :: iter
2675
2676 CALL timeset(routinen, handle)
2677
2678 CALL get_qs_env(qs_env=qs_env, cell=cell)
2679 CALL get_cell(cell=cell, deth=cell_volume)
2680
2681 NULLIFY (data_block)
2682
2683 nkp = kpoints%nkp
2684
2685 nmo = SIZE(eigenval)
2686
2687 ALLOCATE (p_head(nkp))
2688 p_head(:) = 0.0_dp
2689
2690 ALLOCATE (eps_head(nkp))
2691 eps_head(:) = 0.0_dp
2692
2693 DO ikp = 1, nkp
2694
2695 relative_kpoint(1:3) = matmul(cell%hmat, kpoints%xkp(1:3, ikp))
2696
2697 correct_kpoint(1:3) = twopi*kpoints%xkp(1:3, ikp)
2698
2699 abs_k_square = (correct_kpoint(1))**2 + (correct_kpoint(2))**2 + (correct_kpoint(3))**2
2700
2701 ! real part of the Berry phase
2702 CALL dbcsr_iterator_start(iter, matrix_berry_re_mo_mo(ikp)%matrix)
2703 DO WHILE (dbcsr_iterator_blocks_left(iter))
2704
2705 CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
2706 row_size=row_size, col_size=col_size, &
2707 row_offset=row_offset, col_offset=col_offset)
2708
2709 IF (row_offset + row_size <= homo .OR. col_offset > homo) cycle
2710
2711 IF (row_offset <= homo) THEN
2712 row_start_in_block = homo - row_offset + 2
2713 ELSE
2714 row_start_in_block = 1
2715 END IF
2716
2717 IF (col_offset + col_size - 1 > homo) THEN
2718 col_end_in_block = homo - col_offset + 1
2719 ELSE
2720 col_end_in_block = col_size
2721 END IF
2722
2723 DO i_row = row_start_in_block, min(row_size, nmo - row_offset + 1)
2724
2725 DO i_col = 1, min(col_end_in_block, nmo - col_offset + 1)
2726
2727 eigen_diff = eigenval(i_col + col_offset - 1) - eigenval(i_row + row_offset - 1)
2728
2729 cos_square = (data_block(i_row, i_col))**2
2730
2731 p_head(ikp) = p_head(ikp) + 2.0_dp*eigen_diff/(omega**2 + eigen_diff**2)*cos_square/abs_k_square
2732
2733 END DO
2734
2735 END DO
2736
2737 END DO
2738
2739 CALL dbcsr_iterator_stop(iter)
2740
2741 ! imaginary part of the Berry phase
2742 CALL dbcsr_iterator_start(iter, matrix_berry_im_mo_mo(ikp)%matrix)
2743 DO WHILE (dbcsr_iterator_blocks_left(iter))
2744
2745 CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
2746 row_size=row_size, col_size=col_size, &
2747 row_offset=row_offset, col_offset=col_offset)
2748
2749 IF (row_offset + row_size <= homo .OR. col_offset > homo) cycle
2750
2751 IF (row_offset <= homo) THEN
2752 row_start_in_block = homo - row_offset + 2
2753 ELSE
2754 row_start_in_block = 1
2755 END IF
2756
2757 IF (col_offset + col_size - 1 > homo) THEN
2758 col_end_in_block = homo - col_offset + 1
2759 ELSE
2760 col_end_in_block = col_size
2761 END IF
2762
2763 DO i_row = row_start_in_block, min(row_size, nmo - row_offset + 1)
2764
2765 DO i_col = 1, min(col_end_in_block, nmo - col_offset + 1)
2766
2767 eigen_diff = eigenval(i_col + col_offset - 1) - eigenval(i_row + row_offset - 1)
2768
2769 sin_square = (data_block(i_row, i_col))**2
2770
2771 p_head(ikp) = p_head(ikp) + 2.0_dp*eigen_diff/(omega**2 + eigen_diff**2)*sin_square/abs_k_square
2772
2773 END DO
2774
2775 END DO
2776
2777 END DO
2778
2779 CALL dbcsr_iterator_stop(iter)
2780
2781 END DO
2782
2783 CALL para_env_rpa%sum(p_head)
2784
2785 ! normalize eps_head
2786 ! 2.0_dp due to closed shell
2787 eps_head(:) = 1.0_dp - 2.0_dp*p_head(:)/cell_volume*fourpi
2788
2789 DEALLOCATE (p_head)
2790
2791 CALL timestop(handle)
2792
2793 END SUBROUTINE compute_eps_head_berry
2794
2795! **************************************************************************************************
2796!> \brief ...
2797!> \param qs_env ...
2798!> \param kpoints ...
2799!> \param matrix_berry_re_mo_mo ...
2800!> \param matrix_berry_im_mo_mo ...
2801!> \param fm_mo_coeff ...
2802!> \param para_env ...
2803!> \param do_mo_coeff_Gamma_only ...
2804!> \param homo ...
2805!> \param nmo ...
2806!> \param gw_corr_lev_virt ...
2807!> \param eps_kpoint ...
2808!> \param do_aux_bas ...
2809!> \param frac_aux_mos ...
2810! **************************************************************************************************
2811 SUBROUTINE get_berry_phase(qs_env, kpoints, matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, fm_mo_coeff, para_env, &
2812 do_mo_coeff_Gamma_only, homo, nmo, gw_corr_lev_virt, eps_kpoint, do_aux_bas, &
2813 frac_aux_mos)
2814 TYPE(qs_environment_type), POINTER :: qs_env
2815 TYPE(kpoint_type), POINTER :: kpoints
2816 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_berry_re_mo_mo, &
2817 matrix_berry_im_mo_mo
2818 TYPE(cp_fm_type), INTENT(IN) :: fm_mo_coeff
2819 TYPE(mp_para_env_type), POINTER :: para_env
2820 LOGICAL, INTENT(IN) :: do_mo_coeff_gamma_only
2821 INTEGER, INTENT(IN) :: homo, nmo, gw_corr_lev_virt
2822 REAL(kind=dp), INTENT(IN) :: eps_kpoint
2823 LOGICAL, INTENT(IN) :: do_aux_bas
2824 REAL(kind=dp), INTENT(IN) :: frac_aux_mos
2825
2826 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_berry_phase'
2827
2828 INTEGER :: col_index, handle, i_col_local, ikind, &
2829 ikp, nao_aux, ncol_local, nkind, nkp, &
2830 nmo_for_aux_bas
2831 INTEGER, DIMENSION(:), POINTER :: col_indices
2832 REAL(dp) :: abs_kpoint, correct_kpoint(3), &
2833 scale_kpoint
2834 REAL(kind=dp), DIMENSION(:), POINTER :: evals_p, evals_p_sqrt_inv
2835 TYPE(cell_type), POINTER :: cell
2836 TYPE(cp_fm_struct_type), POINTER :: fm_struct_aux_aux
2837 TYPE(cp_fm_type) :: fm_mat_eigv_p, fm_mat_p, fm_mat_p_sqrt_inv, fm_mat_s_aux_aux_inv, &
2838 fm_mat_scaled_eigv_p, fm_mat_work_aux_aux
2839 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, matrix_s_aux_aux, &
2840 matrix_s_aux_orb
2841 TYPE(dbcsr_type), POINTER :: cosmat, cosmat_desymm, mat_mo_coeff_aux, mat_mo_coeff_aux_2, &
2842 mat_mo_coeff_gamma_all, mat_mo_coeff_gamma_occ_and_gw, mat_mo_coeff_im, mat_mo_coeff_re, &
2843 mat_work_aux_orb, mat_work_aux_orb_2, matrix_p, matrix_p_sqrt, matrix_p_sqrt_inv, &
2844 matrix_s_inv_aux_aux, sinmat, sinmat_desymm, tmp
2845 TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: gw_aux_basis_set_list, orb_basis_set_list
2846 TYPE(gto_basis_set_type), POINTER :: basis_set_gw_aux
2847 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
2848 POINTER :: sab_orb, sab_orb_mic, sgwgw_list, &
2849 sgworb_list
2850 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
2851 TYPE(qs_kind_type), POINTER :: qs_kind
2852 TYPE(qs_ks_env_type), POINTER :: ks_env
2853
2854 CALL timeset(routinen, handle)
2855
2856 nkp = kpoints%nkp
2857
2858 NULLIFY (matrix_berry_re_mo_mo, matrix_s, cell, matrix_berry_im_mo_mo, sinmat, cosmat, tmp, &
2859 cosmat_desymm, sinmat_desymm, qs_kind_set, orb_basis_set_list, sab_orb_mic)
2860
2861 CALL get_qs_env(qs_env=qs_env, &
2862 cell=cell, &
2863 matrix_s=matrix_s, &
2864 qs_kind_set=qs_kind_set, &
2865 nkind=nkind, &
2866 ks_env=ks_env, &
2867 sab_orb=sab_orb)
2868
2869 ALLOCATE (orb_basis_set_list(nkind))
2870 CALL basis_set_list_setup(orb_basis_set_list, "ORB", qs_kind_set)
2871
2872 CALL setup_neighbor_list(sab_orb_mic, orb_basis_set_list, qs_env=qs_env, mic=.false.)
2873
2874 ! create dbcsr matrix of mo_coeff for multiplcation
2875 NULLIFY (mat_mo_coeff_re)
2876 CALL dbcsr_init_p(mat_mo_coeff_re)
2877 CALL dbcsr_create(matrix=mat_mo_coeff_re, &
2878 template=matrix_s(1)%matrix, &
2879 matrix_type=dbcsr_type_no_symmetry)
2880
2881 NULLIFY (mat_mo_coeff_im)
2882 CALL dbcsr_init_p(mat_mo_coeff_im)
2883 CALL dbcsr_create(matrix=mat_mo_coeff_im, &
2884 template=matrix_s(1)%matrix, &
2885 matrix_type=dbcsr_type_no_symmetry)
2886
2887 NULLIFY (mat_mo_coeff_gamma_all)
2888 CALL dbcsr_init_p(mat_mo_coeff_gamma_all)
2889 CALL dbcsr_create(matrix=mat_mo_coeff_gamma_all, &
2890 template=matrix_s(1)%matrix, &
2891 matrix_type=dbcsr_type_no_symmetry)
2892
2893 CALL copy_fm_to_dbcsr(fm_mo_coeff, mat_mo_coeff_gamma_all, keep_sparsity=.false.)
2894
2895 NULLIFY (mat_mo_coeff_gamma_occ_and_gw)
2896 CALL dbcsr_init_p(mat_mo_coeff_gamma_occ_and_gw)
2897 CALL dbcsr_create(matrix=mat_mo_coeff_gamma_occ_and_gw, &
2898 template=matrix_s(1)%matrix, &
2899 matrix_type=dbcsr_type_no_symmetry)
2900
2901 CALL copy_fm_to_dbcsr(fm_mo_coeff, mat_mo_coeff_gamma_occ_and_gw, keep_sparsity=.false.)
2902
2903 IF (.NOT. do_aux_bas) THEN
2904
2905 ! allocate intermediate matrices
2906 CALL dbcsr_init_p(cosmat)
2907 CALL dbcsr_init_p(sinmat)
2908 CALL dbcsr_init_p(tmp)
2909 CALL dbcsr_init_p(cosmat_desymm)
2910 CALL dbcsr_init_p(sinmat_desymm)
2911 CALL dbcsr_create(matrix=cosmat, template=matrix_s(1)%matrix)
2912 CALL dbcsr_create(matrix=sinmat, template=matrix_s(1)%matrix)
2913 CALL dbcsr_create(matrix=tmp, &
2914 template=matrix_s(1)%matrix, &
2915 matrix_type=dbcsr_type_no_symmetry)
2916 CALL dbcsr_create(matrix=cosmat_desymm, &
2917 template=matrix_s(1)%matrix, &
2918 matrix_type=dbcsr_type_no_symmetry)
2919 CALL dbcsr_create(matrix=sinmat_desymm, &
2920 template=matrix_s(1)%matrix, &
2921 matrix_type=dbcsr_type_no_symmetry)
2922 CALL dbcsr_copy(cosmat, matrix_s(1)%matrix)
2923 CALL dbcsr_copy(sinmat, matrix_s(1)%matrix)
2924 CALL dbcsr_set(cosmat, 0.0_dp)
2925 CALL dbcsr_set(sinmat, 0.0_dp)
2926
2927 CALL dbcsr_allocate_matrix_set(matrix_berry_re_mo_mo, nkp)
2928 CALL dbcsr_allocate_matrix_set(matrix_berry_im_mo_mo, nkp)
2929
2930 ELSE
2931
2932 NULLIFY (gw_aux_basis_set_list)
2933 ALLOCATE (gw_aux_basis_set_list(nkind))
2934
2935 DO ikind = 1, nkind
2936
2937 NULLIFY (gw_aux_basis_set_list(ikind)%gto_basis_set)
2938
2939 NULLIFY (basis_set_gw_aux)
2940
2941 qs_kind => qs_kind_set(ikind)
2942 CALL get_qs_kind(qs_kind=qs_kind, basis_set=basis_set_gw_aux, basis_type="AUX_GW")
2943 cpassert(ASSOCIATED(basis_set_gw_aux))
2944
2945 basis_set_gw_aux%kind_radius = orb_basis_set_list(ikind)%gto_basis_set%kind_radius
2946
2947 gw_aux_basis_set_list(ikind)%gto_basis_set => basis_set_gw_aux
2948
2949 END DO
2950
2951 ! neighbor lists
2952 NULLIFY (sgwgw_list, sgworb_list)
2953 CALL setup_neighbor_list(sgwgw_list, gw_aux_basis_set_list, qs_env=qs_env)
2954 CALL setup_neighbor_list(sgworb_list, gw_aux_basis_set_list, orb_basis_set_list, qs_env=qs_env)
2955
2956 NULLIFY (matrix_s_aux_aux, matrix_s_aux_orb)
2957
2958 ! build overlap matrix in gw aux basis and the mixed gw aux basis-orb basis
2959 CALL build_overlap_matrix_simple(ks_env, matrix_s_aux_aux, &
2960 gw_aux_basis_set_list, gw_aux_basis_set_list, sgwgw_list)
2961
2962 CALL build_overlap_matrix_simple(ks_env, matrix_s_aux_orb, &
2963 gw_aux_basis_set_list, orb_basis_set_list, sgworb_list)
2964
2965 CALL dbcsr_get_info(matrix_s_aux_aux(1)%matrix, nfullrows_total=nao_aux)
2966
2967 nmo_for_aux_bas = floor(frac_aux_mos*real(nao_aux, kind=dp))
2968
2969 CALL cp_fm_struct_create(fm_struct_aux_aux, &
2970 context=fm_mo_coeff%matrix_struct%context, &
2971 nrow_global=nao_aux, &
2972 ncol_global=nao_aux, &
2973 para_env=para_env)
2974
2975 NULLIFY (mat_work_aux_orb)
2976 CALL dbcsr_init_p(mat_work_aux_orb)
2977 CALL dbcsr_create(matrix=mat_work_aux_orb, &
2978 template=matrix_s_aux_orb(1)%matrix, &
2979 matrix_type=dbcsr_type_no_symmetry)
2980
2981 NULLIFY (mat_work_aux_orb_2)
2982 CALL dbcsr_init_p(mat_work_aux_orb_2)
2983 CALL dbcsr_create(matrix=mat_work_aux_orb_2, &
2984 template=matrix_s_aux_orb(1)%matrix, &
2985 matrix_type=dbcsr_type_no_symmetry)
2986
2987 NULLIFY (mat_mo_coeff_aux)
2988 CALL dbcsr_init_p(mat_mo_coeff_aux)
2989 CALL dbcsr_create(matrix=mat_mo_coeff_aux, &
2990 template=matrix_s_aux_orb(1)%matrix, &
2991 matrix_type=dbcsr_type_no_symmetry)
2992
2993 NULLIFY (mat_mo_coeff_aux_2)
2994 CALL dbcsr_init_p(mat_mo_coeff_aux_2)
2995 CALL dbcsr_create(matrix=mat_mo_coeff_aux_2, &
2996 template=matrix_s_aux_orb(1)%matrix, &
2997 matrix_type=dbcsr_type_no_symmetry)
2998
2999 NULLIFY (matrix_s_inv_aux_aux)
3000 CALL dbcsr_init_p(matrix_s_inv_aux_aux)
3001 CALL dbcsr_create(matrix=matrix_s_inv_aux_aux, &
3002 template=matrix_s_aux_aux(1)%matrix, &
3003 matrix_type=dbcsr_type_no_symmetry)
3004
3005 NULLIFY (matrix_p)
3006 CALL dbcsr_init_p(matrix_p)
3007 CALL dbcsr_create(matrix=matrix_p, &
3008 template=matrix_s(1)%matrix, &
3009 matrix_type=dbcsr_type_no_symmetry)
3010
3011 NULLIFY (matrix_p_sqrt)
3012 CALL dbcsr_init_p(matrix_p_sqrt)
3013 CALL dbcsr_create(matrix=matrix_p_sqrt, &
3014 template=matrix_s(1)%matrix, &
3015 matrix_type=dbcsr_type_no_symmetry)
3016
3017 NULLIFY (matrix_p_sqrt_inv)
3018 CALL dbcsr_init_p(matrix_p_sqrt_inv)
3019 CALL dbcsr_create(matrix=matrix_p_sqrt_inv, &
3020 template=matrix_s(1)%matrix, &
3021 matrix_type=dbcsr_type_no_symmetry)
3022
3023 CALL cp_fm_create(fm_mat_s_aux_aux_inv, fm_struct_aux_aux, name="inverse overlap mat")
3024 CALL cp_fm_create(fm_mat_work_aux_aux, fm_struct_aux_aux, name="work mat")
3025 CALL cp_fm_create(fm_mat_p, fm_mo_coeff%matrix_struct)
3026 CALL cp_fm_create(fm_mat_eigv_p, fm_mo_coeff%matrix_struct)
3027 CALL cp_fm_create(fm_mat_scaled_eigv_p, fm_mo_coeff%matrix_struct)
3028 CALL cp_fm_create(fm_mat_p_sqrt_inv, fm_mo_coeff%matrix_struct)
3029
3030 NULLIFY (evals_p)
3031 ALLOCATE (evals_p(nmo))
3032
3033 NULLIFY (evals_p_sqrt_inv)
3034 ALLOCATE (evals_p_sqrt_inv(nmo))
3035
3036 CALL copy_dbcsr_to_fm(matrix_s_aux_aux(1)%matrix, fm_mat_s_aux_aux_inv)
3037 ! Calculate S_inverse
3038 CALL cp_fm_cholesky_decompose(fm_mat_s_aux_aux_inv)
3039 CALL cp_fm_cholesky_invert(fm_mat_s_aux_aux_inv)
3040 ! Symmetrize the guy
3041 CALL cp_fm_uplo_to_full(fm_mat_s_aux_aux_inv, fm_mat_work_aux_aux)
3042
3043 CALL copy_fm_to_dbcsr(fm_mat_s_aux_aux_inv, matrix_s_inv_aux_aux, keep_sparsity=.false.)
3044
3045 CALL dbcsr_multiply('N', 'N', 1.0_dp, matrix_s_inv_aux_aux, matrix_s_aux_orb(1)%matrix, 0.0_dp, mat_work_aux_orb, &
3046 filter_eps=1.0e-15_dp)
3047
3048 CALL dbcsr_multiply('N', 'N', 1.0_dp, mat_work_aux_orb, mat_mo_coeff_gamma_all, 0.0_dp, mat_mo_coeff_aux_2, &
3049 last_column=nmo_for_aux_bas, filter_eps=1.0e-15_dp)
3050
3051 CALL dbcsr_multiply('N', 'N', 1.0_dp, matrix_s_aux_aux(1)%matrix, mat_mo_coeff_aux_2, 0.0_dp, mat_work_aux_orb, &
3052 filter_eps=1.0e-15_dp)
3053
3054 CALL dbcsr_multiply('T', 'N', 1.0_dp, mat_mo_coeff_aux_2, mat_work_aux_orb, 0.0_dp, matrix_p, &
3055 filter_eps=1.0e-15_dp)
3056
3057 CALL copy_dbcsr_to_fm(matrix_p, fm_mat_p)
3058
3059 CALL cp_fm_syevd(fm_mat_p, fm_mat_eigv_p, evals_p)
3060
3061 ! only invert the eigenvalues which correspond to the MOs used in the aux. basis
3062 evals_p_sqrt_inv(1:nmo - nmo_for_aux_bas) = 0.0_dp
3063 evals_p_sqrt_inv(nmo - nmo_for_aux_bas + 1:nmo) = 1.0_dp/sqrt(evals_p(nmo - nmo_for_aux_bas + 1:nmo))
3064
3065 CALL cp_fm_to_fm(fm_mat_eigv_p, fm_mat_scaled_eigv_p)
3066
3067 CALL cp_fm_get_info(matrix=fm_mat_scaled_eigv_p, &
3068 ncol_local=ncol_local, &
3069 col_indices=col_indices)
3070
3071 CALL para_env%sync()
3072
3073 ! multiply eigenvectors with inverse sqrt of eigenvalues
3074 DO i_col_local = 1, ncol_local
3075
3076 col_index = col_indices(i_col_local)
3077
3078 fm_mat_scaled_eigv_p%local_data(:, i_col_local) = &
3079 fm_mat_scaled_eigv_p%local_data(:, i_col_local)*evals_p_sqrt_inv(col_index)
3080
3081 END DO
3082
3083 CALL para_env%sync()
3084
3085 CALL parallel_gemm(transa="N", transb="T", m=nmo, n=nmo, k=nmo, alpha=1.0_dp, &
3086 matrix_a=fm_mat_eigv_p, matrix_b=fm_mat_scaled_eigv_p, beta=0.0_dp, &
3087 matrix_c=fm_mat_p_sqrt_inv)
3088
3089 CALL copy_fm_to_dbcsr(fm_mat_p_sqrt_inv, matrix_p_sqrt_inv, keep_sparsity=.false.)
3090
3091 CALL dbcsr_multiply('N', 'N', 1.0_dp, mat_mo_coeff_aux_2, matrix_p_sqrt_inv, 0.0_dp, mat_mo_coeff_aux, &
3092 filter_eps=1.0e-15_dp)
3093
3094 ! allocate intermediate matrices
3095 CALL dbcsr_init_p(cosmat)
3096 CALL dbcsr_init_p(sinmat)
3097 CALL dbcsr_init_p(tmp)
3098 CALL dbcsr_init_p(cosmat_desymm)
3099 CALL dbcsr_init_p(sinmat_desymm)
3100 CALL dbcsr_create(matrix=cosmat, template=matrix_s_aux_aux(1)%matrix)
3101 CALL dbcsr_create(matrix=sinmat, template=matrix_s_aux_aux(1)%matrix)
3102 CALL dbcsr_create(matrix=tmp, &
3103 template=matrix_s_aux_orb(1)%matrix, &
3104 matrix_type=dbcsr_type_no_symmetry)
3105 CALL dbcsr_create(matrix=cosmat_desymm, &
3106 template=matrix_s_aux_aux(1)%matrix, &
3107 matrix_type=dbcsr_type_no_symmetry)
3108 CALL dbcsr_create(matrix=sinmat_desymm, &
3109 template=matrix_s_aux_aux(1)%matrix, &
3110 matrix_type=dbcsr_type_no_symmetry)
3111 CALL dbcsr_copy(cosmat, matrix_s_aux_aux(1)%matrix)
3112 CALL dbcsr_copy(sinmat, matrix_s_aux_aux(1)%matrix)
3113 CALL dbcsr_set(cosmat, 0.0_dp)
3114 CALL dbcsr_set(sinmat, 0.0_dp)
3115
3116 CALL dbcsr_allocate_matrix_set(matrix_berry_re_mo_mo, nkp)
3117 CALL dbcsr_allocate_matrix_set(matrix_berry_im_mo_mo, nkp)
3118
3119 ! allocate the new MO coefficients in the aux basis
3120 CALL dbcsr_release_p(mat_mo_coeff_gamma_all)
3121 CALL dbcsr_release_p(mat_mo_coeff_gamma_occ_and_gw)
3122
3123 NULLIFY (mat_mo_coeff_gamma_all)
3124 CALL dbcsr_init_p(mat_mo_coeff_gamma_all)
3125 CALL dbcsr_create(matrix=mat_mo_coeff_gamma_all, &
3126 template=matrix_s_aux_orb(1)%matrix, &
3127 matrix_type=dbcsr_type_no_symmetry)
3128
3129 CALL dbcsr_copy(mat_mo_coeff_gamma_all, mat_mo_coeff_aux)
3130
3131 NULLIFY (mat_mo_coeff_gamma_occ_and_gw)
3132 CALL dbcsr_init_p(mat_mo_coeff_gamma_occ_and_gw)
3133 CALL dbcsr_create(matrix=mat_mo_coeff_gamma_occ_and_gw, &
3134 template=matrix_s_aux_orb(1)%matrix, &
3135 matrix_type=dbcsr_type_no_symmetry)
3136
3137 CALL dbcsr_copy(mat_mo_coeff_gamma_occ_and_gw, mat_mo_coeff_aux)
3138
3139 DEALLOCATE (evals_p, evals_p_sqrt_inv)
3140
3141 END IF
3142
3143 CALL remove_unnecessary_blocks(mat_mo_coeff_gamma_occ_and_gw, homo, gw_corr_lev_virt)
3144
3145 DO ikp = 1, nkp
3146
3147 ALLOCATE (matrix_berry_re_mo_mo(ikp)%matrix)
3148 CALL dbcsr_init_p(matrix_berry_re_mo_mo(ikp)%matrix)
3149 CALL dbcsr_create(matrix_berry_re_mo_mo(ikp)%matrix, &
3150 template=matrix_s(1)%matrix, &
3151 matrix_type=dbcsr_type_no_symmetry)
3152 CALL dbcsr_desymmetrize(matrix_s(1)%matrix, matrix_berry_re_mo_mo(ikp)%matrix)
3153 CALL dbcsr_set(matrix_berry_re_mo_mo(ikp)%matrix, 0.0_dp)
3154
3155 ALLOCATE (matrix_berry_im_mo_mo(ikp)%matrix)
3156 CALL dbcsr_init_p(matrix_berry_im_mo_mo(ikp)%matrix)
3157 CALL dbcsr_create(matrix_berry_im_mo_mo(ikp)%matrix, &
3158 template=matrix_s(1)%matrix, &
3159 matrix_type=dbcsr_type_no_symmetry)
3160 CALL dbcsr_desymmetrize(matrix_s(1)%matrix, matrix_berry_im_mo_mo(ikp)%matrix)
3161 CALL dbcsr_set(matrix_berry_im_mo_mo(ikp)%matrix, 0.0_dp)
3162
3163 correct_kpoint(1:3) = -twopi*kpoints%xkp(1:3, ikp)
3164
3165 abs_kpoint = sqrt(correct_kpoint(1)**2 + correct_kpoint(2)**2 + correct_kpoint(3)**2)
3166
3167 IF (abs_kpoint < eps_kpoint) THEN
3168
3169 scale_kpoint = eps_kpoint/abs_kpoint
3170 correct_kpoint(:) = correct_kpoint(:)*scale_kpoint
3171
3172 END IF
3173
3174 ! get the Berry phase
3175 IF (do_aux_bas) THEN
3176 CALL build_berry_moment_matrix(qs_env, cosmat, sinmat, correct_kpoint, sab_orb_external=sab_orb_mic, &
3177 basis_type="AUX_GW")
3178 ELSE
3179 CALL build_berry_moment_matrix(qs_env, cosmat, sinmat, correct_kpoint, sab_orb_external=sab_orb_mic, &
3180 basis_type="ORB")
3181 END IF
3182
3183 IF (do_mo_coeff_gamma_only) THEN
3184
3185 CALL dbcsr_desymmetrize(cosmat, cosmat_desymm)
3186
3187 CALL dbcsr_multiply('N', 'N', 1.0_dp, cosmat_desymm, mat_mo_coeff_gamma_occ_and_gw, 0.0_dp, tmp, &
3188 filter_eps=1.0e-15_dp)
3189
3190 CALL dbcsr_multiply('T', 'N', 1.0_dp, mat_mo_coeff_gamma_all, tmp, 0.0_dp, &
3191 matrix_berry_re_mo_mo(ikp)%matrix, filter_eps=1.0e-15_dp)
3192
3193 CALL dbcsr_desymmetrize(sinmat, sinmat_desymm)
3194
3195 CALL dbcsr_multiply('N', 'N', 1.0_dp, sinmat_desymm, mat_mo_coeff_gamma_occ_and_gw, 0.0_dp, tmp, &
3196 filter_eps=1.0e-15_dp)
3197
3198 CALL dbcsr_multiply('T', 'N', 1.0_dp, mat_mo_coeff_gamma_all, tmp, 0.0_dp, &
3199 matrix_berry_im_mo_mo(ikp)%matrix, filter_eps=1.0e-15_dp)
3200
3201 ELSE
3202
3203 ! get mo coeff at the ikp
3204 CALL copy_fm_to_dbcsr(kpoints%kp_env(ikp)%kpoint_env%mos(1, 1)%mo_coeff, &
3205 mat_mo_coeff_re, keep_sparsity=.false.)
3206
3207 CALL copy_fm_to_dbcsr(kpoints%kp_env(ikp)%kpoint_env%mos(2, 1)%mo_coeff, &
3208 mat_mo_coeff_im, keep_sparsity=.false.)
3209
3210 CALL dbcsr_desymmetrize(cosmat, cosmat_desymm)
3211
3212 CALL dbcsr_desymmetrize(sinmat, sinmat_desymm)
3213
3214 ! I.
3215 CALL dbcsr_multiply('N', 'N', 1.0_dp, cosmat_desymm, mat_mo_coeff_re, 0.0_dp, tmp)
3216
3217 ! I.1
3218 CALL dbcsr_multiply('T', 'N', 1.0_dp, mat_mo_coeff_gamma_all, tmp, 0.0_dp, &
3219 matrix_berry_re_mo_mo(ikp)%matrix)
3220
3221 ! II.
3222 CALL dbcsr_multiply('N', 'N', 1.0_dp, sinmat_desymm, mat_mo_coeff_re, 0.0_dp, tmp)
3223
3224 ! II.5
3225 CALL dbcsr_multiply('T', 'N', 1.0_dp, mat_mo_coeff_gamma_all, tmp, 0.0_dp, &
3226 matrix_berry_im_mo_mo(ikp)%matrix)
3227
3228 ! III.
3229 CALL dbcsr_multiply('N', 'N', 1.0_dp, cosmat_desymm, mat_mo_coeff_im, 0.0_dp, tmp)
3230
3231 ! III.7
3232 CALL dbcsr_multiply('T', 'N', 1.0_dp, mat_mo_coeff_gamma_all, tmp, 1.0_dp, &
3233 matrix_berry_im_mo_mo(ikp)%matrix)
3234
3235 ! IV.
3236 CALL dbcsr_multiply('N', 'N', 1.0_dp, sinmat_desymm, mat_mo_coeff_im, 0.0_dp, tmp)
3237
3238 ! IV.3
3239 CALL dbcsr_multiply('T', 'N', -1.0_dp, mat_mo_coeff_gamma_all, tmp, 1.0_dp, &
3240 matrix_berry_re_mo_mo(ikp)%matrix)
3241
3242 END IF
3243
3244 IF (abs_kpoint < eps_kpoint) THEN
3245
3246 CALL dbcsr_scale(matrix_berry_im_mo_mo(ikp)%matrix, 1.0_dp/scale_kpoint)
3247 CALL dbcsr_set(matrix_berry_re_mo_mo(ikp)%matrix, 0.0_dp)
3248 CALL dbcsr_add_on_diag(matrix_berry_re_mo_mo(ikp)%matrix, 1.0_dp)
3249
3250 END IF
3251
3252 END DO
3253
3254 CALL dbcsr_release_p(cosmat)
3255 CALL dbcsr_release_p(sinmat)
3256 CALL dbcsr_release_p(mat_mo_coeff_re)
3257 CALL dbcsr_release_p(mat_mo_coeff_im)
3258 CALL dbcsr_release_p(mat_mo_coeff_gamma_all)
3259 CALL dbcsr_release_p(mat_mo_coeff_gamma_occ_and_gw)
3260 CALL dbcsr_release_p(tmp)
3261 CALL dbcsr_release_p(cosmat_desymm)
3262 CALL dbcsr_release_p(sinmat_desymm)
3263 DEALLOCATE (orb_basis_set_list)
3264
3265 CALL release_neighbor_list_sets(sab_orb_mic)
3266
3267 IF (do_aux_bas) THEN
3268
3269 DEALLOCATE (gw_aux_basis_set_list)
3270 CALL dbcsr_deallocate_matrix_set(matrix_s_aux_aux)
3271 CALL dbcsr_deallocate_matrix_set(matrix_s_aux_orb)
3272 CALL dbcsr_release_p(mat_work_aux_orb)
3273 CALL dbcsr_release_p(mat_work_aux_orb_2)
3274 CALL dbcsr_release_p(mat_mo_coeff_aux)
3275 CALL dbcsr_release_p(mat_mo_coeff_aux_2)
3276 CALL dbcsr_release_p(matrix_s_inv_aux_aux)
3277 CALL dbcsr_release_p(matrix_p)
3278 CALL dbcsr_release_p(matrix_p_sqrt)
3279 CALL dbcsr_release_p(matrix_p_sqrt_inv)
3280
3281 CALL cp_fm_struct_release(fm_struct_aux_aux)
3282
3283 CALL cp_fm_release(fm_mat_s_aux_aux_inv)
3284 CALL cp_fm_release(fm_mat_work_aux_aux)
3285 CALL cp_fm_release(fm_mat_p)
3286 CALL cp_fm_release(fm_mat_eigv_p)
3287 CALL cp_fm_release(fm_mat_scaled_eigv_p)
3288 CALL cp_fm_release(fm_mat_p_sqrt_inv)
3289
3290 ! Deallocate the neighbor list structure
3291 CALL release_neighbor_list_sets(sgwgw_list)
3292 CALL release_neighbor_list_sets(sgworb_list)
3293
3294 END IF
3295
3296 CALL timestop(handle)
3297
3298 END SUBROUTINE get_berry_phase
3299
3300! **************************************************************************************************
3301!> \brief ...
3302!> \param mat_mo_coeff_Gamma_occ_and_GW ...
3303!> \param homo ...
3304!> \param gw_corr_lev_virt ...
3305! **************************************************************************************************
3306 SUBROUTINE remove_unnecessary_blocks(mat_mo_coeff_Gamma_occ_and_GW, homo, gw_corr_lev_virt)
3307
3308 TYPE(dbcsr_type), POINTER :: mat_mo_coeff_gamma_occ_and_gw
3309 INTEGER, INTENT(IN) :: homo, gw_corr_lev_virt
3310
3311 INTEGER :: col, col_offset, row
3312 REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
3313 TYPE(dbcsr_iterator_type) :: iter
3314
3315 CALL dbcsr_iterator_start(iter, mat_mo_coeff_gamma_occ_and_gw)
3316
3317 DO WHILE (dbcsr_iterator_blocks_left(iter))
3318
3319 CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
3320 col_offset=col_offset)
3321
3322 IF (col_offset > homo + gw_corr_lev_virt) THEN
3323
3324 data_block = 0.0_dp
3325
3326 END IF
3327
3328 END DO
3329
3330 CALL dbcsr_iterator_stop(iter)
3331
3332 CALL dbcsr_filter(mat_mo_coeff_gamma_occ_and_gw, 1.0e-15_dp)
3333
3334 END SUBROUTINE remove_unnecessary_blocks
3335
3336! **************************************************************************************************
3337!> \brief ...
3338!> \param delta_corr ...
3339!> \param eps_inv_head ...
3340!> \param kpoints ...
3341!> \param qs_env ...
3342!> \param matrix_berry_re_mo_mo ...
3343!> \param matrix_berry_im_mo_mo ...
3344!> \param homo ...
3345!> \param gw_corr_lev_occ ...
3346!> \param gw_corr_lev_virt ...
3347!> \param para_env_RPA ...
3348!> \param do_extra_kpoints ...
3349! **************************************************************************************************
3350 SUBROUTINE kpoint_sum_for_eps_inv_head_berry(delta_corr, eps_inv_head, kpoints, qs_env, matrix_berry_re_mo_mo, &
3351 matrix_berry_im_mo_mo, homo, gw_corr_lev_occ, gw_corr_lev_virt, &
3352 para_env_RPA, do_extra_kpoints)
3353
3354 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
3355 INTENT(INOUT) :: delta_corr
3356 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: eps_inv_head
3357 TYPE(kpoint_type), POINTER :: kpoints
3358 TYPE(qs_environment_type), POINTER :: qs_env
3359 TYPE(dbcsr_p_type), DIMENSION(:), INTENT(IN) :: matrix_berry_re_mo_mo, &
3360 matrix_berry_im_mo_mo
3361 INTEGER, INTENT(IN) :: homo, gw_corr_lev_occ, gw_corr_lev_virt
3362 TYPE(mp_para_env_type), INTENT(IN), OPTIONAL :: para_env_rpa
3363 LOGICAL, INTENT(IN) :: do_extra_kpoints
3364
3365 INTEGER :: col, col_offset, col_size, i_col, i_row, &
3366 ikp, m_level, n_level_gw, nkp, row, &
3367 row_offset, row_size
3368 REAL(kind=dp) :: abs_k_square, cell_volume, &
3369 check_int_one_over_ksq, contribution, &
3370 weight
3371 REAL(kind=dp), DIMENSION(3) :: correct_kpoint
3372 REAL(kind=dp), DIMENSION(:), POINTER :: delta_corr_extra
3373 REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
3374 TYPE(cell_type), POINTER :: cell
3375 TYPE(dbcsr_iterator_type) :: iter, iter_new
3376
3377 CALL get_qs_env(qs_env=qs_env, cell=cell)
3378
3379 CALL get_cell(cell=cell, deth=cell_volume)
3380
3381 nkp = kpoints%nkp
3382
3383 delta_corr = 0.0_dp
3384
3385 IF (do_extra_kpoints) THEN
3386 NULLIFY (delta_corr_extra)
3387 ALLOCATE (delta_corr_extra(1 + homo - gw_corr_lev_occ:homo + gw_corr_lev_virt))
3388 delta_corr_extra = 0.0_dp
3389 END IF
3390
3391 check_int_one_over_ksq = 0.0_dp
3392
3393 DO ikp = 1, nkp
3394
3395 weight = kpoints%wkp(ikp)
3396
3397 correct_kpoint(1:3) = twopi*kpoints%xkp(1:3, ikp)
3398
3399 abs_k_square = (correct_kpoint(1))**2 + (correct_kpoint(2))**2 + (correct_kpoint(3))**2
3400
3401 ! cos part of the Berry phase
3402 CALL dbcsr_iterator_start(iter, matrix_berry_re_mo_mo(ikp)%matrix)
3403 DO WHILE (dbcsr_iterator_blocks_left(iter))
3404
3405 CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
3406 row_size=row_size, col_size=col_size, &
3407 row_offset=row_offset, col_offset=col_offset)
3408
3409 DO i_col = 1, col_size
3410
3411 DO n_level_gw = 1 + homo - gw_corr_lev_occ, homo + gw_corr_lev_virt
3412
3413 IF (n_level_gw == i_col + col_offset - 1) THEN
3414
3415 DO i_row = 1, row_size
3416
3417 contribution = weight*(eps_inv_head(ikp) - 1.0_dp)/abs_k_square*(data_block(i_row, i_col))**2
3418
3419 m_level = i_row + row_offset - 1
3420
3421 ! we only compute the correction for n=m
3422 IF (m_level /= n_level_gw) cycle
3423
3424 IF (.NOT. do_extra_kpoints) THEN
3425
3426 delta_corr(n_level_gw) = delta_corr(n_level_gw) + contribution
3427
3428 ELSE
3429
3430 IF (ikp <= nkp*8/9) THEN
3431
3432 delta_corr(n_level_gw) = delta_corr(n_level_gw) + contribution
3433
3434 ELSE
3435
3436 delta_corr_extra(n_level_gw) = delta_corr_extra(n_level_gw) + contribution
3437
3438 END IF
3439
3440 END IF
3441
3442 END DO
3443
3444 END IF
3445
3446 END DO
3447
3448 END DO
3449
3450 END DO
3451
3452 CALL dbcsr_iterator_stop(iter)
3453
3454 ! the same for the im. part of the Berry phase
3455 CALL dbcsr_iterator_start(iter_new, matrix_berry_im_mo_mo(ikp)%matrix)
3456 DO WHILE (dbcsr_iterator_blocks_left(iter_new))
3457
3458 CALL dbcsr_iterator_next_block(iter_new, row, col, data_block, &
3459 row_size=row_size, col_size=col_size, &
3460 row_offset=row_offset, col_offset=col_offset)
3461
3462 DO i_col = 1, col_size
3463
3464 DO n_level_gw = 1 + homo - gw_corr_lev_occ, homo + gw_corr_lev_virt
3465
3466 IF (n_level_gw == i_col + col_offset - 1) THEN
3467
3468 DO i_row = 1, row_size
3469
3470 m_level = i_row + row_offset - 1
3471
3472 contribution = weight*(eps_inv_head(ikp) - 1.0_dp)/abs_k_square*(data_block(i_row, i_col))**2
3473
3474 ! we only compute the correction for n=m
3475 IF (m_level /= n_level_gw) cycle
3476
3477 IF (.NOT. do_extra_kpoints) THEN
3478
3479 delta_corr(n_level_gw) = delta_corr(n_level_gw) + contribution
3480
3481 ELSE
3482
3483 IF (ikp <= nkp*8/9) THEN
3484
3485 delta_corr(n_level_gw) = delta_corr(n_level_gw) + contribution
3486
3487 ELSE
3488
3489 delta_corr_extra(n_level_gw) = delta_corr_extra(n_level_gw) + contribution
3490
3491 END IF
3492
3493 END IF
3494
3495 END DO
3496
3497 END IF
3498
3499 END DO
3500
3501 END DO
3502
3503 END DO
3504
3505 CALL dbcsr_iterator_stop(iter_new)
3506
3507 check_int_one_over_ksq = check_int_one_over_ksq + weight/abs_k_square
3508
3509 END DO
3510
3511 ! normalize by the cell volume
3512 delta_corr = delta_corr/cell_volume*fourpi
3513
3514 check_int_one_over_ksq = check_int_one_over_ksq/cell_volume
3515
3516 CALL para_env_rpa%sum(delta_corr)
3517
3518 IF (do_extra_kpoints) THEN
3519
3520 delta_corr_extra = delta_corr_extra/cell_volume*fourpi
3521
3522 CALL para_env_rpa%sum(delta_corr_extra)
3523
3524 delta_corr(:) = delta_corr(:) + (delta_corr(:) - delta_corr_extra(:))
3525
3526 DEALLOCATE (delta_corr_extra)
3527
3528 END IF
3529
3530 END SUBROUTINE kpoint_sum_for_eps_inv_head_berry
3531
3532! **************************************************************************************************
3533!> \brief ...
3534!> \param eps_inv_head ...
3535!> \param eps_head ...
3536!> \param kpoints ...
3537! **************************************************************************************************
3538 SUBROUTINE compute_eps_inv_head(eps_inv_head, eps_head, kpoints)
3539 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
3540 INTENT(OUT) :: eps_inv_head
3541 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: eps_head
3542 TYPE(kpoint_type), POINTER :: kpoints
3543
3544 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_eps_inv_head'
3545
3546 INTEGER :: handle, ikp, nkp
3547
3548 CALL timeset(routinen, handle)
3549
3550 nkp = kpoints%nkp
3551
3552 ALLOCATE (eps_inv_head(nkp))
3553
3554 DO ikp = 1, nkp
3555
3556 eps_inv_head(ikp) = 1.0_dp/eps_head(ikp)
3557
3558 END DO
3559
3560 CALL timestop(handle)
3561
3562 END SUBROUTINE compute_eps_inv_head
3563
3564! **************************************************************************************************
3565!> \brief ...
3566!> \param qs_env ...
3567!> \param kpoints ...
3568!> \param kp_grid ...
3569!> \param num_kp_grids ...
3570!> \param para_env ...
3571!> \param h_inv ...
3572!> \param nmo ...
3573!> \param do_mo_coeff_Gamma_only ...
3574!> \param do_extra_kpoints ...
3575! **************************************************************************************************
3576 SUBROUTINE get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, nmo, &
3577 do_mo_coeff_Gamma_only, do_extra_kpoints)
3578 TYPE(qs_environment_type), POINTER :: qs_env
3579 TYPE(kpoint_type), POINTER :: kpoints
3580 INTEGER, DIMENSION(:), POINTER :: kp_grid
3581 INTEGER, INTENT(IN) :: num_kp_grids
3582 TYPE(mp_para_env_type), INTENT(IN) :: para_env
3583 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT) :: h_inv
3584 INTEGER, INTENT(IN) :: nmo
3585 LOGICAL, INTENT(IN) :: do_mo_coeff_gamma_only, do_extra_kpoints
3586
3587 INTEGER :: end_kp, i, i_grid_level, ix, iy, iz, &
3588 nkp_inner_grid, nkp_outer_grid, &
3589 npoints, start_kp
3590 INTEGER, DIMENSION(3) :: outer_kp_grid
3591 REAL(kind=dp) :: kpoint_weight_left, single_weight
3592 REAL(kind=dp), DIMENSION(3) :: kpt_latt, reducing_factor
3593 TYPE(cell_type), POINTER :: cell
3594 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
3595
3596 NULLIFY (kpoints, cell, particle_set)
3597
3598 ! check whether kp_grid includes the Gamma point. If so, abort.
3599 cpassert(mod(kp_grid(1)*kp_grid(2)*kp_grid(3), 2) == 0)
3600 IF (do_extra_kpoints) THEN
3601 cpassert(do_mo_coeff_gamma_only)
3602 END IF
3603
3604 IF (do_mo_coeff_gamma_only) THEN
3605
3606 outer_kp_grid(1) = kp_grid(1) - 1
3607 outer_kp_grid(2) = kp_grid(2) - 1
3608 outer_kp_grid(3) = kp_grid(3) - 1
3609
3610 CALL get_qs_env(qs_env=qs_env, cell=cell, particle_set=particle_set)
3611
3612 CALL get_cell(cell, h_inv=h_inv)
3613
3614 CALL kpoint_create(kpoints)
3615
3616 kpoints%kp_scheme = "GENERAL"
3617 kpoints%symmetry = .false.
3618 kpoints%verbose = .false.
3619 kpoints%full_grid = .false.
3620 kpoints%use_real_wfn = .false.
3621 kpoints%eps_geo = 1.e-6_dp
3622 npoints = kp_grid(1)*kp_grid(2)*kp_grid(3)/2 + &
3623 (num_kp_grids - 1)*((outer_kp_grid(1) + 1)/2*outer_kp_grid(2)*outer_kp_grid(3) - 1)
3624
3625 IF (do_extra_kpoints) THEN
3626
3627 cpassert(num_kp_grids == 1)
3628 cpassert(mod(kp_grid(1), 4) == 0)
3629 cpassert(mod(kp_grid(2), 4) == 0)
3630 cpassert(mod(kp_grid(3), 4) == 0)
3631
3632 END IF
3633
3634 IF (do_extra_kpoints) THEN
3635
3636 npoints = kp_grid(1)*kp_grid(2)*kp_grid(3)/2 + kp_grid(1)*kp_grid(2)*kp_grid(3)/2/8
3637
3638 END IF
3639
3640 kpoints%full_grid = .true.
3641 kpoints%nkp = npoints
3642 ALLOCATE (kpoints%xkp(3, npoints), kpoints%wkp(npoints))
3643 kpoints%xkp = 0.0_dp
3644 kpoints%wkp = 0.0_dp
3645
3646 nkp_outer_grid = outer_kp_grid(1)*outer_kp_grid(2)*outer_kp_grid(3)
3647 nkp_inner_grid = kp_grid(1)*kp_grid(2)*kp_grid(3)
3648
3649 i = 0
3650 reducing_factor(:) = 1.0_dp
3651 kpoint_weight_left = 1.0_dp
3652
3653 ! the outer grids
3654 DO i_grid_level = 1, num_kp_grids - 1
3655
3656 single_weight = kpoint_weight_left/real(nkp_outer_grid, kind=dp)
3657
3658 start_kp = i + 1
3659
3660 DO ix = 1, outer_kp_grid(1)
3661 DO iy = 1, outer_kp_grid(2)
3662 DO iz = 1, outer_kp_grid(3)
3663
3664 ! exclude Gamma
3665 IF (2*ix - outer_kp_grid(1) - 1 == 0 .AND. 2*iy - outer_kp_grid(2) - 1 == 0 .AND. &
3666 2*iz - outer_kp_grid(3) - 1 == 0) cycle
3667
3668 ! use time reversal symmetry k<->-k
3669 IF (2*ix - outer_kp_grid(1) - 1 < 0) cycle
3670
3671 i = i + 1
3672 kpt_latt(1) = real(2*ix - outer_kp_grid(1) - 1, kind=dp)/(2._dp*real(outer_kp_grid(1), kind=dp)) &
3673 *reducing_factor(1)
3674 kpt_latt(2) = real(2*iy - outer_kp_grid(2) - 1, kind=dp)/(2._dp*real(outer_kp_grid(2), kind=dp)) &
3675 *reducing_factor(2)
3676 kpt_latt(3) = real(2*iz - outer_kp_grid(3) - 1, kind=dp)/(2._dp*real(outer_kp_grid(3), kind=dp)) &
3677 *reducing_factor(3)
3678 kpoints%xkp(1:3, i) = matmul(transpose(h_inv), kpt_latt(:))
3679
3680 IF (2*ix - outer_kp_grid(1) - 1 == 0) THEN
3681 kpoints%wkp(i) = single_weight
3682 ELSE
3683 kpoints%wkp(i) = 2._dp*single_weight
3684 END IF
3685
3686 END DO
3687 END DO
3688 END DO
3689
3690 end_kp = i
3691
3692 kpoint_weight_left = kpoint_weight_left - sum(kpoints%wkp(start_kp:end_kp))
3693
3694 reducing_factor(1) = reducing_factor(1)/real(outer_kp_grid(1), kind=dp)
3695 reducing_factor(2) = reducing_factor(2)/real(outer_kp_grid(2), kind=dp)
3696 reducing_factor(3) = reducing_factor(3)/real(outer_kp_grid(3), kind=dp)
3697
3698 END DO
3699
3700 single_weight = kpoint_weight_left/real(nkp_inner_grid, kind=dp)
3701
3702 ! the inner grid
3703 DO ix = 1, kp_grid(1)
3704 DO iy = 1, kp_grid(2)
3705 DO iz = 1, kp_grid(3)
3706
3707 ! use time reversal symmetry k<->-k
3708 IF (2*ix - kp_grid(1) - 1 < 0) cycle
3709
3710 i = i + 1
3711 kpt_latt(1) = real(2*ix - kp_grid(1) - 1, kind=dp)/(2._dp*real(kp_grid(1), kind=dp))*reducing_factor(1)
3712 kpt_latt(2) = real(2*iy - kp_grid(2) - 1, kind=dp)/(2._dp*real(kp_grid(2), kind=dp))*reducing_factor(2)
3713 kpt_latt(3) = real(2*iz - kp_grid(3) - 1, kind=dp)/(2._dp*real(kp_grid(3), kind=dp))*reducing_factor(3)
3714
3715 kpoints%xkp(1:3, i) = matmul(transpose(h_inv), kpt_latt(:))
3716
3717 kpoints%wkp(i) = 2._dp*single_weight
3718
3719 END DO
3720 END DO
3721 END DO
3722
3723 IF (do_extra_kpoints) THEN
3724
3725 single_weight = kpoint_weight_left/real(kp_grid(1)*kp_grid(2)*kp_grid(3)/8, kind=dp)
3726
3727 DO ix = 1, kp_grid(1)/2
3728 DO iy = 1, kp_grid(2)/2
3729 DO iz = 1, kp_grid(3)/2
3730
3731 ! use time reversal symmetry k<->-k
3732 IF (2*ix - kp_grid(1)/2 - 1 < 0) cycle
3733
3734 i = i + 1
3735 kpt_latt(1) = real(2*ix - kp_grid(1)/2 - 1, kind=dp)/(real(kp_grid(1), kind=dp))
3736 kpt_latt(2) = real(2*iy - kp_grid(2)/2 - 1, kind=dp)/(real(kp_grid(2), kind=dp))
3737 kpt_latt(3) = real(2*iz - kp_grid(3)/2 - 1, kind=dp)/(real(kp_grid(3), kind=dp))
3738
3739 kpoints%xkp(1:3, i) = matmul(transpose(h_inv), kpt_latt(:))
3740
3741 kpoints%wkp(i) = 2._dp*single_weight
3742
3743 END DO
3744 END DO
3745 END DO
3746
3747 END IF
3748
3749 ! default: no symmetry settings
3750 ALLOCATE (kpoints%kp_sym(kpoints%nkp))
3751 DO i = 1, kpoints%nkp
3752 NULLIFY (kpoints%kp_sym(i)%kpoint_sym)
3753 CALL kpoint_sym_create(kpoints%kp_sym(i)%kpoint_sym)
3754 END DO
3755
3756 ELSE
3757
3758 block
3759 TYPE(qs_environment_type), POINTER :: qs_env_kp_gamma_only
3760 CALL create_kp_from_gamma(qs_env, qs_env_kp_gamma_only)
3761
3762 CALL get_qs_env(qs_env=qs_env, cell=cell, particle_set=particle_set)
3763
3764 CALL calculate_kp_orbitals(qs_env_kp_gamma_only, kpoints, "MONKHORST-PACK", nadd=nmo, mp_grid=kp_grid(1:3), &
3765 group_size_ext=para_env%num_pe)
3766
3767 CALL qs_env_release(qs_env_kp_gamma_only)
3768 DEALLOCATE (qs_env_kp_gamma_only)
3769 END block
3770
3771 END IF
3772
3773 END SUBROUTINE get_kpoints
3774
3775! **************************************************************************************************
3776!> \brief ...
3777!> \param vec_Sigma_c_gw ...
3778!> \param Eigenval_DFT ...
3779!> \param eps_eigenval ...
3780! **************************************************************************************************
3781 PURE SUBROUTINE average_degenerate_levels(vec_Sigma_c_gw, Eigenval_DFT, eps_eigenval)
3782 COMPLEX(KIND=dp), DIMENSION(:, :, :), &
3783 INTENT(INOUT) :: vec_sigma_c_gw
3784 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: eigenval_dft
3785 REAL(kind=dp), INTENT(IN) :: eps_eigenval
3786
3787 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: avg_self_energy
3788 INTEGER :: degeneracy, first_degenerate_level, i_deg_level, i_level_gw, j_deg_level, jquad, &
3789 num_deg_levels, num_integ_points, num_levels_gw
3790 INTEGER, ALLOCATABLE, DIMENSION(:) :: list_degenerate_levels
3791
3792 num_levels_gw = SIZE(vec_sigma_c_gw, 1)
3793
3794 ALLOCATE (list_degenerate_levels(num_levels_gw))
3795 list_degenerate_levels = 1
3796
3797 num_integ_points = SIZE(vec_sigma_c_gw, 2)
3798
3799 ALLOCATE (avg_self_energy(num_integ_points))
3800
3801 DO i_level_gw = 2, num_levels_gw
3802
3803 IF (abs(eigenval_dft(i_level_gw) - eigenval_dft(i_level_gw - 1)) < eps_eigenval) THEN
3804
3805 list_degenerate_levels(i_level_gw) = list_degenerate_levels(i_level_gw - 1)
3806
3807 ELSE
3808
3809 list_degenerate_levels(i_level_gw) = list_degenerate_levels(i_level_gw - 1) + 1
3810
3811 END IF
3812
3813 END DO
3814
3815 num_deg_levels = list_degenerate_levels(num_levels_gw)
3816
3817 DO i_deg_level = 1, num_deg_levels
3818
3819 degeneracy = 0
3820
3821 DO i_level_gw = 1, num_levels_gw
3822
3823 IF (degeneracy == 0 .AND. i_deg_level == list_degenerate_levels(i_level_gw)) THEN
3824
3825 first_degenerate_level = i_level_gw
3826
3827 END IF
3828
3829 IF (i_deg_level == list_degenerate_levels(i_level_gw)) THEN
3830
3831 degeneracy = degeneracy + 1
3832
3833 END IF
3834
3835 END DO
3836
3837 DO jquad = 1, num_integ_points
3838
3839 avg_self_energy(jquad) = sum(vec_sigma_c_gw(first_degenerate_level:first_degenerate_level + degeneracy - 1, jquad, 1)) &
3840 /real(degeneracy, kind=dp)
3841
3842 END DO
3843
3844 DO j_deg_level = 0, degeneracy - 1
3845
3846 vec_sigma_c_gw(first_degenerate_level + j_deg_level, :, 1) = avg_self_energy(:)
3847
3848 END DO
3849
3850 END DO
3851
3852 END SUBROUTINE average_degenerate_levels
3853
3854! **************************************************************************************************
3855!> \brief ...
3856!> \param vec_gw_energ ...
3857!> \param vec_omega_fit_gw ...
3858!> \param z_value ...
3859!> \param m_value ...
3860!> \param vec_Sigma_c_gw ...
3861!> \param vec_Sigma_x_minus_vxc_gw ...
3862!> \param Eigenval ...
3863!> \param Eigenval_scf ...
3864!> \param n_level_gw ...
3865!> \param gw_corr_lev_occ ...
3866!> \param gw_corr_lev_vir ...
3867!> \param num_poles ...
3868!> \param num_fit_points ...
3869!> \param crossing_search ...
3870!> \param homo ...
3871!> \param stop_crit ...
3872!> \param fermi_level_offset ...
3873!> \param do_gw_im_time ...
3874! **************************************************************************************************
3875 SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_omega_fit_gw, &
3876 z_value, m_value, vec_Sigma_c_gw, vec_Sigma_x_minus_vxc_gw, &
3877 Eigenval, Eigenval_scf, n_level_gw, &
3878 gw_corr_lev_occ, gw_corr_lev_vir, num_poles, &
3879 num_fit_points, crossing_search, homo, stop_crit, &
3880 fermi_level_offset, do_gw_im_time)
3881
3882 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: vec_gw_energ, vec_omega_fit_gw, z_value, &
3883 m_value
3884 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(IN) :: vec_sigma_c_gw
3885 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: vec_sigma_x_minus_vxc_gw, eigenval, &
3886 eigenval_scf
3887 INTEGER, INTENT(IN) :: n_level_gw, gw_corr_lev_occ, &
3888 gw_corr_lev_vir, num_poles, &
3889 num_fit_points, crossing_search, homo
3890 REAL(kind=dp), INTENT(IN) :: stop_crit, fermi_level_offset
3891 LOGICAL, INTENT(IN) :: do_gw_im_time
3892
3893 CHARACTER(LEN=*), PARAMETER :: routinen = 'fit_and_continuation_2pole'
3894
3895 COMPLEX(KIND=dp) :: func_val, rho1
3896 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: dlambda, dlambda_2, lambda, &
3897 lambda_without_offset, vec_b_gw, &
3898 vec_b_gw_copy
3899 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: mat_a_gw, mat_b_gw
3900 INTEGER :: handle4, ierr, iii, iiter, info, &
3901 integ_range, jjj, jquad, kkk, &
3902 max_iter_fit, n_level_gw_ref, num_var, &
3903 xpos
3904 INTEGER, ALLOCATABLE, DIMENSION(:) :: ipiv
3905 LOGICAL :: could_exit
3906 REAL(kind=dp) :: chi2, chi2_old, delta, deriv_val_real, e_fermi, gw_energ, ldown, &
3907 level_energ_gw, lup, range_step, scalparam, sign_occ_virt, stat_error
3908 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: lambda_im, lambda_re, stat_errors, &
3909 vec_n_gw, vec_omega_fit_gw_sign
3910 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: mat_n_gw
3911
3912 max_iter_fit = 10000
3913
3914 num_var = 2*num_poles + 1
3915 ALLOCATE (lambda(num_var))
3916 lambda = z_zero
3917 ALLOCATE (lambda_without_offset(num_var))
3918 lambda_without_offset = z_zero
3919 ALLOCATE (lambda_re(num_var))
3920 lambda_re = 0.0_dp
3921 ALLOCATE (lambda_im(num_var))
3922 lambda_im = 0.0_dp
3923
3924 ALLOCATE (vec_omega_fit_gw_sign(num_fit_points))
3925
3926 IF (n_level_gw <= gw_corr_lev_occ) THEN
3927 sign_occ_virt = -1.0_dp
3928 ELSE
3929 sign_occ_virt = 1.0_dp
3930 END IF
3931
3932 n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ
3933
3934 DO jquad = 1, num_fit_points
3935 vec_omega_fit_gw_sign(jquad) = abs(vec_omega_fit_gw(jquad))*sign_occ_virt
3936 END DO
3937
3938 ! initial guess
3939 range_step = (vec_omega_fit_gw_sign(num_fit_points) - vec_omega_fit_gw_sign(1))/(num_poles - 1)
3940 DO iii = 1, num_poles
3941 lambda_im(2*iii + 1) = vec_omega_fit_gw_sign(1) + (iii - 1)*range_step
3942 END DO
3943 range_step = (vec_omega_fit_gw_sign(num_fit_points) - vec_omega_fit_gw_sign(1))/num_poles
3944 DO iii = 1, num_poles
3945 lambda_re(2*iii + 1) = abs(vec_omega_fit_gw_sign(1) + (iii - 0.5_dp)*range_step)
3946 END DO
3947
3948 DO iii = 1, num_var
3949 lambda(iii) = lambda_re(iii) + gaussi*lambda_im(iii)
3950 END DO
3951
3952 CALL calc_chi2(chi2_old, lambda, vec_sigma_c_gw, vec_omega_fit_gw_sign, num_poles, &
3953 num_fit_points, n_level_gw)
3954
3955 ALLOCATE (mat_a_gw(num_poles + 1, num_poles + 1))
3956 ALLOCATE (vec_b_gw(num_poles + 1))
3957 ALLOCATE (ipiv(num_poles + 1))
3958 mat_a_gw = z_zero
3959 vec_b_gw = 0.0_dp
3960
3961 mat_a_gw(1:num_poles + 1, 1) = z_one
3962 integ_range = num_fit_points/num_poles
3963 DO kkk = 1, num_poles + 1
3964 xpos = (kkk - 1)*integ_range + 1
3965 xpos = min(xpos, num_fit_points)
3966 ! calculate coefficient at this point
3967 DO iii = 1, num_poles
3968 jjj = iii*2
3969 func_val = z_one/(gaussi*vec_omega_fit_gw_sign(xpos) - &
3970 cmplx(lambda_re(jjj + 1), lambda_im(jjj + 1), kind=dp))
3971 mat_a_gw(kkk, iii + 1) = func_val
3972 END DO
3973 vec_b_gw(kkk) = vec_sigma_c_gw(n_level_gw, xpos)
3974 END DO
3975
3976 ! Solve system of linear equations
3977 CALL zgetrf(num_poles + 1, num_poles + 1, mat_a_gw, num_poles + 1, ipiv, info)
3978
3979 CALL zgetrs('N', num_poles + 1, 1, mat_a_gw, num_poles + 1, ipiv, vec_b_gw, num_poles + 1, info)
3980
3981 lambda_re(1) = real(vec_b_gw(1))
3982 lambda_im(1) = aimag(vec_b_gw(1))
3983 DO iii = 1, num_poles
3984 jjj = iii*2
3985 lambda_re(jjj) = real(vec_b_gw(iii + 1))
3986 lambda_im(jjj) = aimag(vec_b_gw(iii + 1))
3987 END DO
3988
3989 DEALLOCATE (mat_a_gw)
3990 DEALLOCATE (vec_b_gw)
3991 DEALLOCATE (ipiv)
3992
3993 ALLOCATE (mat_a_gw(num_var*2, num_var*2))
3994 ALLOCATE (mat_b_gw(num_fit_points, num_var*2))
3995 ALLOCATE (dlambda(num_fit_points))
3996 ALLOCATE (dlambda_2(num_fit_points))
3997 ALLOCATE (vec_b_gw(num_var*2))
3998 ALLOCATE (vec_b_gw_copy(num_var*2))
3999 ALLOCATE (ipiv(num_var*2))
4000
4001 scalparam = 0.01_dp
4002 ldown = 1.5_dp
4003 lup = 10.0_dp
4004 could_exit = .false.
4005
4006 ! iteration loop for fitting
4007 DO iiter = 1, max_iter_fit
4008
4009 CALL timeset(routinen//"_fit_loop_1", handle4)
4010
4011 ! calc delta lambda
4012 DO iii = 1, num_var
4013 lambda(iii) = lambda_re(iii) + gaussi*lambda_im(iii)
4014 END DO
4015 dlambda = z_zero
4016
4017 DO kkk = 1, num_fit_points
4018 func_val = lambda(1)
4019 DO iii = 1, num_poles
4020 jjj = iii*2
4021 func_val = func_val + lambda(jjj)/(vec_omega_fit_gw_sign(kkk)*gaussi - lambda(jjj + 1))
4022 END DO
4023 dlambda(kkk) = vec_sigma_c_gw(n_level_gw, kkk) - func_val
4024 END DO
4025 rho1 = sum(dlambda*dlambda)
4026
4027 ! fill matrix
4028 mat_b_gw = z_zero
4029 DO iii = 1, num_fit_points
4030 mat_b_gw(iii, 1) = 1.0_dp
4031 mat_b_gw(iii, num_var + 1) = gaussi
4032 END DO
4033 DO iii = 1, num_poles
4034 jjj = iii*2
4035 DO kkk = 1, num_fit_points
4036 mat_b_gw(kkk, jjj) = 1.0_dp/(gaussi*vec_omega_fit_gw_sign(kkk) - lambda(jjj + 1))
4037 mat_b_gw(kkk, jjj + num_var) = gaussi/(gaussi*vec_omega_fit_gw_sign(kkk) - lambda(jjj + 1))
4038 mat_b_gw(kkk, jjj + 1) = lambda(jjj)/(gaussi*vec_omega_fit_gw_sign(kkk) - lambda(jjj + 1))**2
4039 mat_b_gw(kkk, jjj + 1 + num_var) = (-lambda_im(jjj) + gaussi*lambda_re(jjj))/ &
4040 (gaussi*vec_omega_fit_gw_sign(kkk) - lambda(jjj + 1))**2
4041 END DO
4042 END DO
4043
4044 CALL timestop(handle4)
4045
4046 CALL timeset(routinen//"_fit_matmul_1", handle4)
4047
4048 CALL zgemm('C', 'N', num_var*2, num_var*2, num_fit_points, z_one, mat_b_gw, num_fit_points, mat_b_gw, num_fit_points, &
4049 z_zero, mat_a_gw, num_var*2)
4050 CALL timestop(handle4)
4051
4052 CALL timeset(routinen//"_fit_zgemv_1", handle4)
4053 CALL zgemv('C', num_fit_points, num_var*2, z_one, mat_b_gw, num_fit_points, dlambda, 1, &
4054 z_zero, vec_b_gw, 1)
4055
4056 CALL timestop(handle4)
4057
4058 ! scale diagonal elements of a_mat
4059 DO iii = 1, num_var*2
4060 mat_a_gw(iii, iii) = mat_a_gw(iii, iii) + scalparam*mat_a_gw(iii, iii)
4061 END DO
4062
4063 ! solve linear system
4064 ierr = 0
4065 ipiv = 0
4066
4067 CALL timeset(routinen//"_fit_lin_eq_2", handle4)
4068
4069 CALL zgetrf(2*num_var, 2*num_var, mat_a_gw, 2*num_var, ipiv, info)
4070
4071 CALL zgetrs('N', 2*num_var, 1, mat_a_gw, 2*num_var, ipiv, vec_b_gw, 2*num_var, info)
4072
4073 CALL timestop(handle4)
4074
4075 DO iii = 1, num_var
4076 lambda(iii) = lambda_re(iii) + gaussi*lambda_im(iii) + vec_b_gw(iii) + vec_b_gw(iii + num_var)
4077 END DO
4078
4079 ! calculate chi2
4080 CALL calc_chi2(chi2, lambda, vec_sigma_c_gw, vec_omega_fit_gw_sign, num_poles, &
4081 num_fit_points, n_level_gw)
4082
4083 ! if the fit is already super accurate, exit. otherwise maybe issues when dividing by 0
4084 IF (chi2 < 1.0e-30_dp) EXIT
4085
4086 IF (chi2 < chi2_old) THEN
4087 scalparam = max(scalparam/ldown, 1e-12_dp)
4088 DO iii = 1, num_var
4089 lambda_re(iii) = lambda_re(iii) + real(vec_b_gw(iii) + vec_b_gw(iii + num_var))
4090 lambda_im(iii) = lambda_im(iii) + aimag(vec_b_gw(iii) + vec_b_gw(iii + num_var))
4091 END DO
4092 IF (chi2_old/chi2 - 1.0_dp < stop_crit) could_exit = .true.
4093 chi2_old = chi2
4094 ELSE
4095 scalparam = scalparam*lup
4096 END IF
4097 IF (scalparam > 100.0_dp .AND. could_exit) EXIT
4098
4099 IF (scalparam > 1e+10_dp) scalparam = 1e-4_dp
4100
4101 END DO
4102
4103 IF (.NOT. do_gw_im_time) THEN
4104
4105 ! change a_0 [Lambda(1)], so that Sigma(i0) = Fit(i0)
4106 ! do not do this for imaginary time since we do not have many fit points and the fit should be perfect
4107 func_val = lambda(1)
4108 DO iii = 1, num_poles
4109 jjj = iii*2
4110 ! calculate value of the fit function
4111 func_val = func_val + lambda(jjj)/(-lambda(jjj + 1))
4112 END DO
4113
4114 lambda_re(1) = lambda_re(1) - real(func_val) + real(vec_sigma_c_gw(n_level_gw, num_fit_points))
4115 lambda_im(1) = lambda_im(1) - aimag(func_val) + aimag(vec_sigma_c_gw(n_level_gw, num_fit_points))
4116
4117 END IF
4118
4119 lambda_without_offset(:) = lambda(:)
4120
4121 DO iii = 1, num_var
4122 lambda(iii) = cmplx(lambda_re(iii), lambda_im(iii), kind=dp)
4123 END DO
4124
4125 IF (do_gw_im_time) THEN
4126 ! for cubic-scaling GW, we have one Green's function for occ and virt states with the Fermi level
4127 ! in the middle of homo and lumo
4128 e_fermi = 0.5_dp*(eigenval(homo) + eigenval(homo + 1))
4129 ELSE
4130 ! in case of O(N^4) GW, we have the Fermi level differently for occ and virt states, see
4131 ! Fig. 1 in JCTC 12, 3623-3635 (2016)
4132 IF (n_level_gw <= gw_corr_lev_occ) THEN
4133 e_fermi = maxval(eigenval(homo - gw_corr_lev_occ + 1:homo)) + fermi_level_offset
4134 ELSE
4135 e_fermi = minval(eigenval(homo + 1:homo + gw_corr_lev_vir)) - fermi_level_offset
4136 END IF
4137 END IF
4138
4139 ! either Z-shot or Newton/bisection crossing search for evaluating Sigma_c
4140 IF (crossing_search == ri_rpa_g0w0_crossing_z_shot .OR. &
4141 crossing_search == ri_rpa_g0w0_crossing_newton) THEN
4142
4143 ! calculate Sigma_c_fit(e_n) and Z
4144 func_val = lambda(1)
4145 z_value(n_level_gw) = 1.0_dp
4146 DO iii = 1, num_poles
4147 jjj = iii*2
4148 z_value(n_level_gw) = z_value(n_level_gw) + real(lambda(jjj)/ &
4149 (eigenval(n_level_gw_ref) - e_fermi - lambda(jjj + 1))**2)
4150 func_val = func_val + lambda(jjj)/(eigenval(n_level_gw_ref) - e_fermi - lambda(jjj + 1))
4151 END DO
4152 ! m is the slope of the correl self-energy
4153 m_value(n_level_gw) = 1.0_dp - z_value(n_level_gw)
4154 z_value(n_level_gw) = 1.0_dp/z_value(n_level_gw)
4155 gw_energ = real(func_val)
4156 vec_gw_energ(n_level_gw) = gw_energ
4157
4158 ! in case one wants to do Newton-Raphson on top of the Z-shot
4159 IF (crossing_search == ri_rpa_g0w0_crossing_newton) THEN
4160
4161 level_energ_gw = (eigenval_scf(n_level_gw_ref) - &
4162 m_value(n_level_gw)*eigenval(n_level_gw_ref) + &
4163 vec_gw_energ(n_level_gw) + &
4164 vec_sigma_x_minus_vxc_gw(n_level_gw_ref))* &
4165 z_value(n_level_gw)
4166
4167 ! Newton-Raphson iteration
4168 DO kkk = 1, 1000
4169
4170 ! calculate the value of the fit function for level_energ_GW
4171 func_val = lambda(1)
4172 z_value(n_level_gw) = 1.0_dp
4173 DO iii = 1, num_poles
4174 jjj = iii*2
4175 func_val = func_val + lambda(jjj)/(level_energ_gw - e_fermi - lambda(jjj + 1))
4176 END DO
4177
4178 ! calculate the derivative of the fit function for level_energ_GW
4179 deriv_val_real = -1.0_dp
4180 DO iii = 1, num_poles
4181 jjj = iii*2
4182 deriv_val_real = deriv_val_real + real(lambda(jjj))/((abs(level_energ_gw - e_fermi - lambda(jjj + 1)))**2) &
4183 - (real(lambda(jjj))*(level_energ_gw - e_fermi) - real(lambda(jjj)*conjg(lambda(jjj + 1))))* &
4184 2.0_dp*(level_energ_gw - e_fermi - real(lambda(jjj + 1)))/ &
4185 ((abs(level_energ_gw - e_fermi - lambda(jjj + 1)))**2)
4186
4187 END DO
4188
4189 delta = (eigenval_scf(n_level_gw_ref) + vec_sigma_x_minus_vxc_gw(n_level_gw_ref) + real(func_val) - level_energ_gw)/ &
4190 deriv_val_real
4191
4192 level_energ_gw = level_energ_gw - delta
4193
4194 IF (abs(delta) < 1.0e-08) EXIT
4195
4196 END DO
4197
4198 ! update the GW-energy by Newton-Raphson and set the Z-value to 1
4199
4200 vec_gw_energ(n_level_gw) = real(func_val)
4201 z_value(n_level_gw) = 1.0_dp
4202 m_value(n_level_gw) = 0.0_dp
4203
4204 END IF ! Newton-Raphson on top of Z-shot
4205
4206 ELSE
4207 cpabort("Only NONE, ZSHOT and NEWTON implemented for 2-pole model")
4208 END IF ! decision crossing search none, Z-shot
4209
4210 ! --------------------------------------------
4211 ! | calculate statistical error due to fitting |
4212 ! --------------------------------------------
4213
4214 ! estimate the statistical error of the calculated Sigma_c(i*omega)
4215 ! by sqrt(chi2/n), where n is the number of fit points
4216
4217 CALL calc_chi2(chi2, lambda_without_offset, vec_sigma_c_gw, vec_omega_fit_gw_sign, num_poles, &
4218 num_fit_points, n_level_gw)
4219
4220 ! Estimate the statistical error of every fit point
4221 stat_error = sqrt(chi2/num_fit_points)
4222
4223 ! allocate N array containing the second derivatives of chi^2
4224 ALLOCATE (vec_n_gw(num_var*2))
4225 vec_n_gw = 0.0_dp
4226
4227 ALLOCATE (mat_n_gw(num_var*2, num_var*2))
4228 mat_n_gw = 0.0_dp
4229
4230 DO iii = 1, num_var*2
4231 CALL calc_mat_n(vec_n_gw(iii), lambda_without_offset, vec_sigma_c_gw, vec_omega_fit_gw_sign, &
4232 iii, iii, num_poles, num_fit_points, n_level_gw, 0.001_dp)
4233 END DO
4234
4235 DO iii = 1, num_var*2
4236 DO jjj = 1, num_var*2
4237 CALL calc_mat_n(mat_n_gw(iii, jjj), lambda_without_offset, vec_sigma_c_gw, vec_omega_fit_gw_sign, &
4238 iii, jjj, num_poles, num_fit_points, n_level_gw, 0.001_dp)
4239 END DO
4240 END DO
4241
4242 CALL dgetrf(2*num_var, 2*num_var, mat_n_gw, 2*num_var, ipiv, info)
4243
4244 ! vec_b_gw is only working array
4245 CALL dgetri(2*num_var, mat_n_gw, 2*num_var, ipiv, vec_b_gw, 2*num_var, info)
4246
4247 ALLOCATE (stat_errors(2*num_var))
4248 stat_errors = 0.0_dp
4249
4250 DO iii = 1, 2*num_var
4251 stat_errors(iii) = sqrt(abs(mat_n_gw(iii, iii)))*stat_error
4252 END DO
4253
4254 DEALLOCATE (mat_n_gw)
4255 DEALLOCATE (vec_n_gw)
4256 DEALLOCATE (mat_a_gw)
4257 DEALLOCATE (mat_b_gw)
4258 DEALLOCATE (stat_errors)
4259 DEALLOCATE (dlambda)
4260 DEALLOCATE (dlambda_2)
4261 DEALLOCATE (vec_b_gw)
4262 DEALLOCATE (vec_b_gw_copy)
4263 DEALLOCATE (ipiv)
4264 DEALLOCATE (vec_omega_fit_gw_sign)
4265 DEALLOCATE (lambda)
4266 DEALLOCATE (lambda_without_offset)
4267 DEALLOCATE (lambda_re)
4268 DEALLOCATE (lambda_im)
4269
4270 END SUBROUTINE fit_and_continuation_2pole
4271
4272! **************************************************************************************************
4273!> \brief perform analytic continuation with pade approximation
4274!> \param vec_gw_energ real Sigma_c
4275!> \param vec_omega_fit_gw frequency points for Sigma_c(iomega)
4276!> \param z_value 1/(1-dev)
4277!> \param m_value derivative of real Sigma_c
4278!> \param vec_Sigma_c_gw complex Sigma_c(iomega)
4279!> \param vec_Sigma_x_minus_vxc_gw ...
4280!> \param Eigenval quasiparticle energy during ev self-consistent GW
4281!> \param Eigenval_scf KS/HF eigenvalue
4282!> \param do_hedin_shift ...
4283!> \param n_level_gw ...
4284!> \param gw_corr_lev_occ ...
4285!> \param gw_corr_lev_vir ...
4286!> \param nparam_pade number of pade parameters
4287!> \param num_fit_points number of fit points for Sigma_c(iomega)
4288!> \param crossing_search type ofr cross search to find quasiparticle energies
4289!> \param homo ...
4290!> \param fermi_level_offset ...
4291!> \param do_gw_im_time ...
4292!> \param print_self_energy ...
4293!> \param count_ev_sc_GW ...
4294!> \param vec_gw_dos ...
4295!> \param dos_lower_bound ...
4296!> \param dos_precision ...
4297!> \param ndos ...
4298!> \param min_level_self_energy ...
4299!> \param max_level_self_energy ...
4300!> \param dos_eta ...
4301!> \param dos_min ...
4302!> \param dos_max ...
4303!> \param e_fermi_ext ...
4304! **************************************************************************************************
4305 SUBROUTINE continuation_pade(vec_gw_energ, vec_omega_fit_gw, &
4306 z_value, m_value, vec_Sigma_c_gw, vec_Sigma_x_minus_vxc_gw, &
4307 Eigenval, Eigenval_scf, do_hedin_shift, n_level_gw, &
4308 gw_corr_lev_occ, gw_corr_lev_vir, &
4309 nparam_pade, num_fit_points, crossing_search, homo, &
4310 fermi_level_offset, do_gw_im_time, print_self_energy, count_ev_sc_GW, &
4311 vec_gw_dos, dos_lower_bound, dos_precision, ndos, &
4312 min_level_self_energy, max_level_self_energy, &
4313 dos_eta, dos_min, dos_max, e_fermi_ext)
4314
4315 ! Optional arguments for spectral function
4316 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: vec_gw_energ
4317 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: vec_omega_fit_gw
4318 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: z_value, m_value
4319 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(IN) :: vec_sigma_c_gw
4320 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: vec_sigma_x_minus_vxc_gw, eigenval, &
4321 eigenval_scf
4322 LOGICAL, INTENT(IN) :: do_hedin_shift
4323 INTEGER, INTENT(IN) :: n_level_gw, gw_corr_lev_occ, &
4324 gw_corr_lev_vir, nparam_pade, &
4325 num_fit_points, crossing_search, homo
4326 REAL(kind=dp), INTENT(IN) :: fermi_level_offset
4327 LOGICAL, INTENT(IN) :: do_gw_im_time, print_self_energy
4328 INTEGER, INTENT(IN) :: count_ev_sc_gw
4329 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), OPTIONAL :: vec_gw_dos
4330 REAL(kind=dp), OPTIONAL :: dos_lower_bound, dos_precision
4331 INTEGER, INTENT(IN), OPTIONAL :: ndos, min_level_self_energy, &
4332 max_level_self_energy
4333 REAL(kind=dp), OPTIONAL :: dos_eta
4334 INTEGER, INTENT(IN), OPTIONAL :: dos_min, dos_max
4335 REAL(kind=dp), OPTIONAL :: e_fermi_ext
4336
4337 CHARACTER(LEN=*), PARAMETER :: routinen = 'continuation_pade'
4338
4339 CHARACTER(LEN=5) :: string_level
4340 CHARACTER(len=default_path_length) :: filename
4341 COMPLEX(KIND=dp) :: sigma_c_pade, sigma_c_pade_im_freq
4342 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: coeff_pade, omega_points_pade, &
4343 sigma_c_gw_reorder
4344 INTEGER :: handle, i_omega, idos, iunit, jquad, &
4345 n_level_gw_ref, num_omega
4346 REAL(kind=dp) :: e_fermi, energy_val, hedin_shift, &
4347 level_energ_gw_start, omega, &
4348 omega_dos, omega_dos_pade_eval, &
4349 sign_occ_virt
4350 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: vec_omega_fit_gw_sign, &
4351 vec_omega_fit_gw_sign_reorder, &
4352 vec_sigma_imag, vec_sigma_real
4353 TYPE(cp_logger_type), POINTER :: logger
4354
4355 CALL timeset(routinen, handle)
4356
4357 ALLOCATE (vec_omega_fit_gw_sign(num_fit_points))
4358
4359 IF (n_level_gw <= gw_corr_lev_occ) THEN
4360 sign_occ_virt = -1.0_dp
4361 ELSE
4362 sign_occ_virt = 1.0_dp
4363 END IF
4364
4365 DO jquad = 1, num_fit_points
4366 vec_omega_fit_gw_sign(jquad) = abs(vec_omega_fit_gw(jquad))*sign_occ_virt
4367 END DO
4368
4369 IF (do_gw_im_time) THEN
4370 ! for cubic-scaling GW, we have one Green's function for occ and virt states
4371 ! with the Fermi level in the middle of homo and lumo
4372 e_fermi = 0.5_dp*(eigenval(homo) + eigenval(homo + 1))
4373 ELSE
4374 ! in case of O(N^4) GW, we have the Fermi level differently for occ and virt states, see
4375 ! Fig. 1 in JCTC 12, 3623-3635 (2016)
4376 IF (n_level_gw <= gw_corr_lev_occ) THEN
4377 e_fermi = maxval(eigenval(homo - gw_corr_lev_occ + 1:homo)) + fermi_level_offset
4378 ELSE
4379 e_fermi = minval(eigenval(homo + 1:homo + gw_corr_lev_vir)) - fermi_level_offset
4380 END IF
4381 END IF
4382
4383 IF (PRESENT(e_fermi_ext)) e_fermi = e_fermi_ext
4384
4385 n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ
4386
4387 !*** reorder, such that omega=i*0 is first entry
4388 ALLOCATE (sigma_c_gw_reorder(num_fit_points))
4389 ALLOCATE (vec_omega_fit_gw_sign_reorder(num_fit_points))
4390 ! for cubic scaling GW fit points are ordered differently than in N^4 GW
4391 IF (do_gw_im_time) THEN
4392 DO jquad = 1, num_fit_points
4393 sigma_c_gw_reorder(jquad) = vec_sigma_c_gw(n_level_gw, jquad)
4394 vec_omega_fit_gw_sign_reorder(jquad) = vec_omega_fit_gw_sign(jquad)
4395 END DO
4396 ELSE
4397 DO jquad = 1, num_fit_points
4398 sigma_c_gw_reorder(jquad) = vec_sigma_c_gw(n_level_gw, num_fit_points - jquad + 1)
4399 vec_omega_fit_gw_sign_reorder(jquad) = vec_omega_fit_gw_sign(num_fit_points - jquad + 1)
4400 END DO
4401 END IF
4402
4403 !*** evaluate parameters for pade approximation
4404 ALLOCATE (coeff_pade(nparam_pade))
4405 ALLOCATE (omega_points_pade(nparam_pade))
4406 coeff_pade = 0.0_dp
4407 CALL get_pade_parameters(sigma_c_gw_reorder, vec_omega_fit_gw_sign_reorder, &
4408 num_fit_points, nparam_pade, omega_points_pade, coeff_pade)
4409
4410 !*** calculate start_value for iterative cross-searching methods
4411 IF ((crossing_search == ri_rpa_g0w0_crossing_bisection) .OR. &
4412 (crossing_search == ri_rpa_g0w0_crossing_newton)) THEN
4413 energy_val = eigenval(n_level_gw_ref) - e_fermi
4414 CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, &
4415 coeff_pade, sigma_c_pade)
4416 CALL get_z_and_m_value_pade(energy_val, nparam_pade, omega_points_pade, &
4417 coeff_pade, z_value(n_level_gw), m_value(n_level_gw))
4418 level_energ_gw_start = (eigenval_scf(n_level_gw_ref) - &
4419 m_value(n_level_gw)*eigenval(n_level_gw_ref) + &
4420 REAL(sigma_c_pade) + &
4421 vec_sigma_x_minus_vxc_gw(n_level_gw_ref))* &
4422 z_value(n_level_gw)
4423
4424 ! calculate Hedin shift; the last line is for evGW0 and evGW
4425 hedin_shift = 0.0_dp
4426 IF (do_hedin_shift) hedin_shift = real(sigma_c_pade) + &
4427 vec_sigma_x_minus_vxc_gw(n_level_gw_ref) &
4428 - eigenval(n_level_gw_ref) + eigenval_scf(n_level_gw_ref)
4429 END IF
4430
4431 IF (PRESENT(min_level_self_energy) .AND. PRESENT(max_level_self_energy)) THEN
4432 IF (n_level_gw_ref >= min_level_self_energy .AND. &
4433 n_level_gw_ref <= max_level_self_energy) THEN
4434 ALLOCATE (vec_sigma_real(ndos))
4435 ALLOCATE (vec_sigma_imag(ndos))
4436 WRITE (string_level, "(I4)") n_level_gw_ref
4437 string_level = adjustl(string_level)
4438 END IF
4439 END IF
4440
4441 !*** Calculate spectral function
4442 !*** 1 \‾‾ |Im 𝚺ₘ(ω)|+η
4443 !*** A(ω) = --- | ---------------------------------------------------
4444 !*** π /__ [ω - eₘ^DFT - (Re 𝚺ₘ(ω) - vₘ^xc)]² + (|Im 𝚺ₘ(ω)|+η)²
4445
4446 IF (PRESENT(ndos)) THEN
4447 IF (ndos /= 0) THEN
4448 ! Hedin shift not implemented
4449 cpassert(.NOT. do_hedin_shift)
4450 logger => cp_get_default_logger()
4451 IF (logger%para_env%is_source()) THEN
4452 iunit = cp_logger_get_default_unit_nr()
4453 ELSE
4454 iunit = -1
4455 END IF
4456 DO idos = 1, ndos
4457 omega_dos = dos_lower_bound + real(idos - 1, kind=dp)*dos_precision
4458 omega_dos_pade_eval = omega_dos - e_fermi
4459 CALL evaluate_pade_function(omega_dos_pade_eval, nparam_pade, omega_points_pade, &
4460 coeff_pade, sigma_c_pade)
4461
4462 IF (n_level_gw_ref >= min_level_self_energy .AND. &
4463 n_level_gw_ref <= max_level_self_energy .AND. iunit > 0) THEN
4464
4465 vec_sigma_real(idos) = (real(sigma_c_pade))
4466 vec_sigma_imag(idos) = (aimag(sigma_c_pade))
4467
4468 END IF
4469
4470 IF (n_level_gw_ref >= dos_min .AND. &
4471 (n_level_gw_ref <= dos_max .OR. dos_max == 0)) THEN
4472 vec_gw_dos(idos) = vec_gw_dos(idos) + &
4473 (abs(aimag(sigma_c_pade)) + dos_eta) &
4474 /( &
4475 (omega_dos - eigenval_scf(n_level_gw_ref) - &
4476 (real(sigma_c_pade) + vec_sigma_x_minus_vxc_gw(n_level_gw_ref)) &
4477 )**2 &
4478 + (abs(aimag(sigma_c_pade)) + dos_eta)**2 &
4479 )
4480 END IF
4481
4482 END DO
4483 END IF
4484 END IF
4485
4486 IF (PRESENT(min_level_self_energy) .AND. PRESENT(max_level_self_energy)) THEN
4487 logger => cp_get_default_logger()
4488 IF (logger%para_env%is_source()) THEN
4489 iunit = cp_logger_get_default_unit_nr()
4490 ELSE
4491 iunit = -1
4492 END IF
4493 IF (n_level_gw_ref >= min_level_self_energy .AND. &
4494 n_level_gw_ref <= max_level_self_energy .AND. iunit > 0) THEN
4495
4496 CALL open_file('self_energy_re_'//trim(string_level)//'.dat', unit_number=iunit, &
4497 file_status="UNKNOWN", file_action="WRITE")
4498 DO idos = 1, ndos
4499 omega_dos = dos_lower_bound + real(idos - 1, kind=dp)*dos_precision
4500 WRITE (iunit, '(F17.10, F17.10)') omega_dos*evolt, vec_sigma_real(idos)*evolt
4501 END DO
4502
4503 CALL close_file(iunit)
4504
4505 CALL open_file('self_energy_im_'//trim(string_level)//'.dat', unit_number=iunit, &
4506 file_status="UNKNOWN", file_action="WRITE")
4507 DO idos = 1, ndos
4508 omega_dos = dos_lower_bound + real(idos - 1, kind=dp)*dos_precision
4509 WRITE (iunit, '(F17.10, F17.10)') omega_dos*evolt, vec_sigma_imag(idos)*evolt
4510 END DO
4511
4512 CALL close_file(iunit)
4513
4514 DEALLOCATE (vec_sigma_real)
4515 DEALLOCATE (vec_sigma_imag)
4516 END IF
4517 END IF
4518
4519 !*** perform crossing search
4520 SELECT CASE (crossing_search)
4521 CASE (ri_rpa_g0w0_crossing_z_shot)
4522 ! Hedin shift not implemented
4523 cpassert(.NOT. do_hedin_shift)
4524 energy_val = eigenval(n_level_gw_ref) - e_fermi
4525 CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, &
4526 coeff_pade, sigma_c_pade)
4527 vec_gw_energ(n_level_gw) = real(sigma_c_pade)
4528
4529 CALL get_z_and_m_value_pade(energy_val, nparam_pade, omega_points_pade, &
4530 coeff_pade, z_value(n_level_gw), m_value(n_level_gw))
4531
4532 CASE (ri_rpa_g0w0_crossing_bisection)
4533 CALL get_sigma_c_bisection_pade(vec_gw_energ(n_level_gw), eigenval_scf(n_level_gw_ref), &
4534 vec_sigma_x_minus_vxc_gw(n_level_gw_ref), e_fermi, &
4535 nparam_pade, omega_points_pade, coeff_pade, &
4536 level_energ_gw_start, hedin_shift)
4537 z_value(n_level_gw) = 1.0_dp
4538 m_value(n_level_gw) = 0.0_dp
4539
4540 CASE (ri_rpa_g0w0_crossing_newton)
4541 CALL get_sigma_c_newton_pade(vec_gw_energ(n_level_gw), eigenval_scf(n_level_gw_ref), &
4542 vec_sigma_x_minus_vxc_gw(n_level_gw_ref), e_fermi, &
4543 nparam_pade, omega_points_pade, coeff_pade, &
4544 level_energ_gw_start, hedin_shift)
4545 z_value(n_level_gw) = 1.0_dp
4546 m_value(n_level_gw) = 0.0_dp
4547
4548 CASE DEFAULT
4549 cpabort("Only Z_SHOT, NEWTON, and BISECTION crossing search implemented.")
4550 END SELECT
4551
4552 IF (print_self_energy) THEN
4553
4554 IF (count_ev_sc_gw == 1) THEN
4555
4556 IF (n_level_gw_ref < 10) THEN
4557 WRITE (filename, "(A26,I1)") "G0W0_self_energy_level_000", n_level_gw_ref
4558 ELSE IF (n_level_gw_ref < 100) THEN
4559 WRITE (filename, "(A25,I2)") "G0W0_self_energy_level_00", n_level_gw_ref
4560 ELSE IF (n_level_gw_ref < 1000) THEN
4561 WRITE (filename, "(A24,I3)") "G0W0_self_energy_level_0", n_level_gw_ref
4562 ELSE
4563 WRITE (filename, "(A23,I4)") "G0W0_self_energy_level_", n_level_gw_ref
4564 END IF
4565
4566 ELSE
4567
4568 IF (n_level_gw_ref < 10) THEN
4569 WRITE (filename, "(A11,I1,A22,I1)") "evGW_cycle_", count_ev_sc_gw, &
4570 "_self_energy_level_000", n_level_gw_ref
4571 ELSE IF (n_level_gw_ref < 100) THEN
4572 WRITE (filename, "(A11,I1,A21,I2)") "evGW_cycle_", count_ev_sc_gw, &
4573 "_self_energy_level_00", n_level_gw_ref
4574 ELSE IF (n_level_gw_ref < 1000) THEN
4575 WRITE (filename, "(A11,I1,A20,I3)") "evGW_cycle_", count_ev_sc_gw, &
4576 "_self_energy_level_0", n_level_gw_ref
4577 ELSE
4578 WRITE (filename, "(A11,I1,A19,I4)") "evGW_cycle_", count_ev_sc_gw, &
4579 "_self_energy_level_", n_level_gw_ref
4580 END IF
4581
4582 END IF
4583
4584 logger => cp_get_default_logger()
4585 IF (logger%para_env%is_source()) THEN
4586 iunit = cp_logger_get_default_unit_nr()
4587 ELSE
4588 iunit = -1
4589 END IF
4590 CALL open_file(trim(filename), unit_number=iunit, file_status="UNKNOWN", file_action="WRITE")
4591
4592 num_omega = 10000
4593
4594 WRITE (iunit, "(2A42)") " omega (eV) Sigma(omega) (eV) ", &
4595 " omega - e_n^DFT - Sigma_n^x - v_n^xc (eV)"
4596
4597 DO i_omega = 0, num_omega
4598
4599 omega = -50.0_dp/evolt + real(i_omega, kind=dp)/real(num_omega, kind=dp)*100.0_dp/evolt
4600
4601 CALL evaluate_pade_function(omega - e_fermi, nparam_pade, omega_points_pade, &
4602 coeff_pade, sigma_c_pade)
4603
4604 WRITE (iunit, "(F12.2,2F17.5)") omega*evolt, real(sigma_c_pade)*evolt, &
4605 (omega - eigenval_scf(n_level_gw_ref) - vec_sigma_x_minus_vxc_gw(n_level_gw_ref))*evolt
4606
4607 END DO
4608
4609 WRITE (iunit, "(A51,A39)") " w (eV) Re(Sigma(i*w)) (eV) Im(Sigma(i*w)) (eV) ", &
4610 " Re(Fit(i*w)) (eV) Im(Fit(iw)) (eV)"
4611
4612 DO jquad = 1, num_fit_points
4613
4614 CALL evaluate_pade_function(vec_omega_fit_gw_sign_reorder(jquad), &
4615 nparam_pade, omega_points_pade, &
4616 coeff_pade, sigma_c_pade_im_freq, do_imag_freq=.true.)
4617
4618 WRITE (iunit, "(F12.2,4F17.5)") vec_omega_fit_gw_sign_reorder(jquad)*evolt, &
4619 REAL(sigma_c_gw_reorder(jquad)*evolt), &
4620 aimag(sigma_c_gw_reorder(jquad)*evolt), &
4621 REAL(sigma_c_pade_im_freq*evolt), &
4622 aimag(sigma_c_pade_im_freq*evolt)
4623
4624 END DO
4625
4626 CALL close_file(iunit)
4627
4628 END IF
4629
4630 DEALLOCATE (vec_omega_fit_gw_sign)
4631 DEALLOCATE (sigma_c_gw_reorder)
4632 DEALLOCATE (vec_omega_fit_gw_sign_reorder)
4633 DEALLOCATE (coeff_pade, omega_points_pade)
4634
4635 CALL timestop(handle)
4636
4637 END SUBROUTINE continuation_pade
4638
4639! **************************************************************************************************
4640!> \brief calculate pade parameter recursively as in Eq. (A2) in J. Low Temp. Phys., Vol. 29,
4641!> 1977, pp. 179
4642!> \param y f(x), here: Sigma_c(iomega)
4643!> \param x the frequency points omega
4644!> \param num_fit_points ...
4645!> \param nparam number of pade parameters
4646!> \param xpoints set of points used in pade approximation, selection of x
4647!> \param coeff pade coefficients
4648! **************************************************************************************************
4649 PURE SUBROUTINE get_pade_parameters(y, x, num_fit_points, nparam, xpoints, coeff)
4650
4651 COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN) :: y
4652 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: x
4653 INTEGER, INTENT(IN) :: num_fit_points, nparam
4654 COMPLEX(KIND=dp), DIMENSION(:), INTENT(INOUT) :: xpoints, coeff
4655
4656 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: ypoints
4657 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: g_mat
4658 INTEGER :: idat, iparam, nstep
4659
4660 nstep = int(num_fit_points/(nparam - 1))
4661
4662 ALLOCATE (ypoints(nparam))
4663 !omega=i0 is in element x(1)
4664 idat = 1
4665 DO iparam = 1, nparam - 1
4666 xpoints(iparam) = gaussi*x(idat)
4667 ypoints(iparam) = y(idat)
4668 idat = idat + nstep
4669 END DO
4670 xpoints(nparam) = gaussi*x(num_fit_points)
4671 ypoints(nparam) = y(num_fit_points)
4672
4673 !*** generate parameters recursively
4674
4675 ALLOCATE (g_mat(nparam, nparam))
4676 g_mat(:, 1) = ypoints(:)
4677 DO iparam = 2, nparam
4678 DO idat = iparam, nparam
4679 g_mat(idat, iparam) = (g_mat(iparam - 1, iparam - 1) - g_mat(idat, iparam - 1))/ &
4680 ((xpoints(idat) - xpoints(iparam - 1))*g_mat(idat, iparam - 1))
4681 END DO
4682 END DO
4683
4684 DO iparam = 1, nparam
4685 coeff(iparam) = g_mat(iparam, iparam)
4686 END DO
4687
4688 DEALLOCATE (ypoints)
4689 DEALLOCATE (g_mat)
4690
4691 END SUBROUTINE get_pade_parameters
4692
4693! **************************************************************************************************
4694!> \brief evaluate pade function for a real value x_val
4695!> \param x_val real value
4696!> \param nparam number of pade parameters
4697!> \param xpoints selection of points of the original complex function, i.e. here of Sigma_c(iomega)
4698!> \param coeff pade coefficients
4699!> \param func_val function value
4700!> \param do_imag_freq ...
4701! **************************************************************************************************
4702 PURE SUBROUTINE evaluate_pade_function(x_val, nparam, xpoints, coeff, func_val, do_imag_freq)
4703
4704 REAL(kind=dp), INTENT(IN) :: x_val
4705 INTEGER, INTENT(IN) :: nparam
4706 COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN) :: xpoints, coeff
4707 COMPLEX(KIND=dp), INTENT(OUT) :: func_val
4708 LOGICAL, INTENT(IN), OPTIONAL :: do_imag_freq
4709
4710 INTEGER :: iparam
4711 LOGICAL :: my_do_imag_freq
4712
4713 my_do_imag_freq = .false.
4714 IF (PRESENT(do_imag_freq)) my_do_imag_freq = do_imag_freq
4715
4716 func_val = z_one
4717 DO iparam = nparam, 2, -1
4718 IF (my_do_imag_freq) THEN
4719 func_val = z_one + coeff(iparam)*(gaussi*x_val - xpoints(iparam - 1))/func_val
4720 ELSE
4721 func_val = z_one + coeff(iparam)*(x_val*z_one - xpoints(iparam - 1))/func_val
4722 END IF
4723 END DO
4724
4725 func_val = coeff(1)/func_val
4726
4727 END SUBROUTINE evaluate_pade_function
4728
4729! **************************************************************************************************
4730!> \brief get the z-value and the m-value (derivative) of the pade function
4731!> \param x_val real value
4732!> \param nparam number of pade parameters
4733!> \param xpoints selection of points of the original complex function, i.e. here of Sigma_c(iomega)
4734!> \param coeff pade coefficients
4735!> \param z_value 1/(1-dev)
4736!> \param m_value derivative
4737! **************************************************************************************************
4738 PURE SUBROUTINE get_z_and_m_value_pade(x_val, nparam, xpoints, coeff, z_value, m_value)
4739
4740 REAL(kind=dp), INTENT(IN) :: x_val
4741 INTEGER, INTENT(IN) :: nparam
4742 COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN) :: xpoints, coeff
4743 REAL(kind=dp), INTENT(OUT), OPTIONAL :: z_value, m_value
4744
4745 COMPLEX(KIND=dp) :: denominator, dev_denominator, &
4746 dev_numerator, dev_val, func_val, &
4747 numerator
4748 INTEGER :: iparam
4749
4750 func_val = z_one
4751 dev_val = z_zero
4752 DO iparam = nparam, 2, -1
4753 numerator = coeff(iparam)*(x_val*z_one - xpoints(iparam - 1))
4754 dev_numerator = coeff(iparam)*z_one
4755 denominator = func_val
4756 dev_denominator = dev_val
4757 dev_val = dev_numerator/denominator - (numerator*dev_denominator)/(denominator**2)
4758 func_val = z_one + coeff(iparam)*(x_val*z_one - xpoints(iparam - 1))/func_val
4759 END DO
4760
4761 dev_val = -1.0_dp*coeff(1)/(func_val**2)*dev_val
4762 func_val = coeff(1)/func_val
4763
4764 IF (PRESENT(z_value)) THEN
4765 z_value = 1.0_dp - real(dev_val)
4766 z_value = 1.0_dp/z_value
4767 END IF
4768 IF (PRESENT(m_value)) m_value = real(dev_val)
4769
4770 END SUBROUTINE get_z_and_m_value_pade
4771
4772! **************************************************************************************************
4773!> \brief crossing search using the bisection method to find the quasiparticle energy
4774!> \param gw_energ real Sigma_c
4775!> \param Eigenval_scf Eigenvalue from the SCF
4776!> \param Sigma_x_minus_vxc_gw ...
4777!> \param e_fermi fermi level
4778!> \param nparam_pade number of pade parameters
4779!> \param omega_points_pade selection of frequency points of Sigma_c(iomega)
4780!> \param coeff_pade pade coefficients
4781!> \param start_val start value for the quasiparticle iteration
4782!> \param hedin_shift ...
4783! **************************************************************************************************
4784 SUBROUTINE get_sigma_c_bisection_pade(gw_energ, Eigenval_scf, Sigma_x_minus_vxc_gw, e_fermi, &
4785 nparam_pade, omega_points_pade, coeff_pade, start_val, &
4786 hedin_shift)
4787
4788 REAL(kind=dp), INTENT(OUT) :: gw_energ
4789 REAL(kind=dp), INTENT(IN) :: eigenval_scf, sigma_x_minus_vxc_gw, &
4790 e_fermi
4791 INTEGER, INTENT(IN) :: nparam_pade
4792 COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN) :: omega_points_pade, coeff_pade
4793 REAL(kind=dp), INTENT(IN) :: start_val, hedin_shift
4794
4795 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_sigma_c_bisection_pade'
4796
4797 COMPLEX(KIND=dp) :: sigma_c
4798 INTEGER :: handle, icount
4799 REAL(kind=dp) :: delta, energy_val, qp_energy, &
4800 qp_energy_old, threshold
4801
4802 CALL timeset(routinen, handle)
4803
4804 threshold = 1.0e-7_dp
4805
4806 qp_energy = start_val
4807 qp_energy_old = start_val
4808 delta = 1.0e-3_dp
4809
4810 icount = 0
4811 DO WHILE (abs(delta) > threshold)
4812 icount = icount + 1
4813 qp_energy = qp_energy_old + 0.5_dp*delta
4814 qp_energy_old = qp_energy
4815 energy_val = qp_energy - e_fermi - hedin_shift
4816 CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, &
4817 coeff_pade, sigma_c)
4818 qp_energy = eigenval_scf + real(sigma_c) + sigma_x_minus_vxc_gw
4819 delta = qp_energy - qp_energy_old
4820 ! Self-consistent quasi-particle solution has not been found
4821 IF (icount > 500) EXIT
4822 END DO
4823
4824 gw_energ = real(sigma_c)
4825
4826 CALL timestop(handle)
4827
4828 END SUBROUTINE get_sigma_c_bisection_pade
4829
4830! **************************************************************************************************
4831!> \brief crossing search using the Newton method to find the quasiparticle energy
4832!> \param gw_energ real Sigma_c
4833!> \param Eigenval_scf Eigenvalue from the SCF
4834!> \param Sigma_x_minus_vxc_gw ...
4835!> \param e_fermi fermi level
4836!> \param nparam_pade number of pade parameters
4837!> \param omega_points_pade selection of frequency points of Sigma_c(iomega)
4838!> \param coeff_pade pade coefficients
4839!> \param start_val start value for the quasiparticle iteration
4840!> \param hedin_shift ...
4841! **************************************************************************************************
4842 SUBROUTINE get_sigma_c_newton_pade(gw_energ, Eigenval_scf, Sigma_x_minus_vxc_gw, e_fermi, &
4843 nparam_pade, omega_points_pade, coeff_pade, start_val, &
4844 hedin_shift)
4845
4846 REAL(kind=dp), INTENT(OUT) :: gw_energ
4847 REAL(kind=dp), INTENT(IN) :: eigenval_scf, sigma_x_minus_vxc_gw, &
4848 e_fermi
4849 INTEGER, INTENT(IN) :: nparam_pade
4850 COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN) :: omega_points_pade, coeff_pade
4851 REAL(kind=dp), INTENT(IN) :: start_val, hedin_shift
4852
4853 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_sigma_c_newton_pade'
4854
4855 COMPLEX(KIND=dp) :: sigma_c
4856 INTEGER :: handle, icount
4857 REAL(kind=dp) :: delta, energy_val, m_value, qp_energy, &
4858 qp_energy_old, threshold
4859
4860 CALL timeset(routinen, handle)
4861
4862 threshold = 1.0e-7_dp
4863
4864 qp_energy = start_val
4865 qp_energy_old = start_val
4866 delta = 1.0e-3_dp
4867
4868 icount = 0
4869 DO WHILE (abs(delta) > threshold)
4870 icount = icount + 1
4871 energy_val = qp_energy - e_fermi - hedin_shift
4872 CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, &
4873 coeff_pade, sigma_c)
4874 !get m_value --> derivative of function
4875 CALL get_z_and_m_value_pade(energy_val, nparam_pade, omega_points_pade, &
4876 coeff_pade, m_value=m_value)
4877 qp_energy_old = qp_energy
4878 qp_energy = qp_energy - (eigenval_scf + sigma_x_minus_vxc_gw + real(sigma_c) - qp_energy)/ &
4879 (m_value - 1.0_dp)
4880 delta = qp_energy - qp_energy_old
4881 ! Self-consistent quasi-particle solution has not been found
4882 IF (icount > 500) EXIT
4883 END DO
4884
4885 gw_energ = real(sigma_c)
4886
4887 CALL timestop(handle)
4888
4889 END SUBROUTINE get_sigma_c_newton_pade
4890
4891! **************************************************************************************************
4892!> \brief Prints the GW stuff to the output and optinally to an external file.
4893!> Also updates the eigenvalues for eigenvalue-self-consistent GW
4894!> \param vec_gw_energ ...
4895!> \param z_value ...
4896!> \param m_value ...
4897!> \param vec_Sigma_x_minus_vxc_gw ...
4898!> \param Eigenval ...
4899!> \param Eigenval_last ...
4900!> \param Eigenval_scf ...
4901!> \param gw_corr_lev_occ ...
4902!> \param gw_corr_lev_virt ...
4903!> \param gw_corr_lev_tot ...
4904!> \param crossing_search ...
4905!> \param homo ...
4906!> \param unit_nr ...
4907!> \param count_ev_sc_GW ...
4908!> \param count_sc_GW0 ...
4909!> \param ikp ...
4910!> \param nkp_self_energy ...
4911!> \param kpoints ...
4912!> \param ispin requested spin-state (1 for alpha, 2 for beta, else closed-shell)
4913!> \param E_VBM_GW ...
4914!> \param E_CBM_GW ...
4915!> \param E_VBM_SCF ...
4916!> \param E_CBM_SCF ...
4917! **************************************************************************************************
4918 SUBROUTINE print_and_update_for_ev_sc(vec_gw_energ, &
4919 z_value, m_value, vec_Sigma_x_minus_vxc_gw, Eigenval, &
4920 Eigenval_last, Eigenval_scf, &
4921 gw_corr_lev_occ, gw_corr_lev_virt, gw_corr_lev_tot, &
4922 crossing_search, homo, unit_nr, count_ev_sc_GW, count_sc_GW0, &
4923 ikp, nkp_self_energy, kpoints, ispin, E_VBM_GW, E_CBM_GW, &
4924 E_VBM_SCF, E_CBM_SCF)
4925
4926 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: vec_gw_energ, z_value, m_value
4927 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: vec_sigma_x_minus_vxc_gw, eigenval, &
4928 eigenval_last, eigenval_scf
4929 INTEGER, INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt, gw_corr_lev_tot, crossing_search, &
4930 homo, unit_nr, count_ev_sc_gw, count_sc_gw0, ikp, nkp_self_energy
4931 TYPE(kpoint_type), INTENT(IN), POINTER :: kpoints
4932 INTEGER, INTENT(IN) :: ispin
4933 REAL(kind=dp), INTENT(INOUT), OPTIONAL :: e_vbm_gw, e_cbm_gw, e_vbm_scf, e_cbm_scf
4934
4935 CHARACTER(LEN=*), PARAMETER :: routinen = 'print_and_update_for_ev_sc'
4936
4937 CHARACTER(4) :: occ_virt
4938 INTEGER :: handle, n_level_gw, n_level_gw_ref
4939 LOGICAL :: do_alpha, do_beta, do_closed_shell, &
4940 do_kpoints, is_energy_okay
4941 REAL(kind=dp) :: e_gap_gw, e_homo_gw, e_homo_scf, &
4942 e_lumo_gw, e_lumo_scf, new_energy
4943
4944 CALL timeset(routinen, handle)
4945
4946 do_alpha = (ispin == 1)
4947 do_beta = (ispin == 2)
4948 do_closed_shell = .NOT. (do_alpha .OR. do_beta)
4949 do_kpoints = (nkp_self_energy > 1)
4950
4951 eigenval_last(:) = eigenval(:)
4952
4953 IF (unit_nr > 0) THEN
4954
4955 IF (count_ev_sc_gw == 1 .AND. count_sc_gw0 == 1 .AND. ikp == 1) THEN
4956
4957 WRITE (unit_nr, *) ' '
4958
4959 IF (do_alpha .OR. do_closed_shell) THEN
4960 WRITE (unit_nr, *) ' '
4961 WRITE (unit_nr, '(T3,A)') '******************************************************************************'
4962 WRITE (unit_nr, '(T3,A)') '** **'
4963 WRITE (unit_nr, '(T3,A)') '** GW QUASIPARTICLE ENERGIES **'
4964 WRITE (unit_nr, '(T3,A)') '** **'
4965 WRITE (unit_nr, '(T3,A)') '******************************************************************************'
4966 WRITE (unit_nr, '(T3,A)') ' '
4967 WRITE (unit_nr, '(T3,A)') ' '
4968 WRITE (unit_nr, '(T3,A)') 'The GW quasiparticle energies are calculated according to: '
4969
4970 IF (crossing_search == ri_rpa_g0w0_crossing_z_shot) THEN
4971 WRITE (unit_nr, '(T3,A)') 'E_GW = E_SCF + Z * ( Sigc(E_SCF) + Sigx - vxc )'
4972 ELSE
4973 WRITE (unit_nr, '(T3,A)') ' '
4974 WRITE (unit_nr, '(T3,A)') ' E_GW = E_SCF + Sigc(E_GW) + Sigx - vxc '
4975 WRITE (unit_nr, '(T3,A)') ' '
4976 WRITE (unit_nr, '(T3,A)') 'Upper equation is solved self-consistently for E_GW, see Eq. (12) in J. Phys.'
4977 WRITE (unit_nr, '(T3,A)') 'Chem. Lett. 9, 306 (2018), doi: 10.1021/acs.jpclett.7b02740'
4978 END IF
4979 WRITE (unit_nr, *) ' '
4980 WRITE (unit_nr, *) ' '
4981 WRITE (unit_nr, '(T3,A)') '------------'
4982 WRITE (unit_nr, '(T3,A)') 'G0W0 results'
4983 WRITE (unit_nr, '(T3,A)') '------------'
4984
4985 END IF
4986
4987 IF (.NOT. do_kpoints) THEN
4988 IF (do_alpha) THEN
4989 WRITE (unit_nr, *) ' '
4990 WRITE (unit_nr, '(T3,A)') '---------------------------------------'
4991 WRITE (unit_nr, '(T3,A)') 'GW quasiparticle energies of alpha spins'
4992 WRITE (unit_nr, '(T3,A)') '----------------------------------------'
4993 ELSE IF (do_beta) THEN
4994 WRITE (unit_nr, *) ' '
4995 WRITE (unit_nr, '(T3,A)') '---------------------------------------'
4996 WRITE (unit_nr, '(T3,A)') 'GW quasiparticle energies of beta spins'
4997 WRITE (unit_nr, '(T3,A)') '---------------------------------------'
4998 END IF
4999 END IF
5000
5001 END IF
5002
5003 IF (count_ev_sc_gw > 1) THEN
5004 WRITE (unit_nr, *) ' '
5005 WRITE (unit_nr, '(T3,A)') '---------------------------------------'
5006 WRITE (unit_nr, '(T3,A,I4)') 'Eigenvalue-selfconsistency cycle: ', count_ev_sc_gw
5007 WRITE (unit_nr, '(T3,A)') '---------------------------------------'
5008 END IF
5009
5010 IF (count_sc_gw0 > 1) THEN
5011 WRITE (unit_nr, '(T3,A)') '----------------------------------'
5012 WRITE (unit_nr, '(T3,A,I4)') 'scGW0 selfconsistency cycle: ', count_sc_gw0
5013 WRITE (unit_nr, '(T3,A)') '----------------------------------'
5014 END IF
5015
5016 IF (do_kpoints) THEN
5017 WRITE (unit_nr, *) ' '
5018 WRITE (unit_nr, '(T3,A7,I3,A3,I3,A8,3F7.3,A12,3F7.3)') 'Kpoint ', ikp, ' /', nkp_self_energy, &
5019 ' xkp =', kpoints%xkp(1, ikp), kpoints%xkp(2, ikp), kpoints%xkp(3, ikp), &
5020 ' and xkp =', -kpoints%xkp(1, ikp), -kpoints%xkp(2, ikp), -kpoints%xkp(3, ikp)
5021 WRITE (unit_nr, '(T3,A72)') '(Relative Brillouin zone size: [-0.5, 0.5] x [-0.5, 0.5] x [-0.5, 0.5])'
5022 WRITE (unit_nr, *) ' '
5023 IF (do_alpha) THEN
5024 WRITE (unit_nr, '(T3,A)') 'GW quasiparticle energies of alpha spins:'
5025 ELSE IF (do_beta) THEN
5026 WRITE (unit_nr, '(T3,A)') 'GW quasiparticle energies of beta spins:'
5027 END IF
5028 END IF
5029
5030 END IF
5031
5032 DO n_level_gw = 1, gw_corr_lev_tot
5033
5034 n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ
5035
5036 new_energy = (eigenval_scf(n_level_gw_ref) - &
5037 m_value(n_level_gw)*eigenval(n_level_gw_ref) + &
5038 vec_gw_energ(n_level_gw) + &
5039 vec_sigma_x_minus_vxc_gw(n_level_gw_ref))* &
5040 z_value(n_level_gw)
5041
5042 is_energy_okay = .true.
5043
5044 IF (n_level_gw_ref > homo .AND. new_energy < eigenval(homo)) THEN
5045 is_energy_okay = .false.
5046 END IF
5047
5048 IF (is_energy_okay) THEN
5049 eigenval(n_level_gw_ref) = new_energy
5050 END IF
5051
5052 END DO
5053
5054 IF (unit_nr > 0) THEN
5055 WRITE (unit_nr, '(T3,A)') ' '
5056 IF (crossing_search == ri_rpa_g0w0_crossing_z_shot) THEN
5057 WRITE (unit_nr, '(T13,2A)') 'MO E_SCF (eV) Sigc (eV) Sigx-vxc (eV) Z E_GW (eV)'
5058 ELSE
5059 WRITE (unit_nr, '(T3,2A)') 'Molecular orbital E_SCF (eV) Sigc (eV) Sigx-vxc (eV) E_GW (eV)'
5060 END IF
5061 END IF
5062
5063 DO n_level_gw = 1, gw_corr_lev_tot
5064 n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ
5065 IF (n_level_gw <= gw_corr_lev_occ) THEN
5066 occ_virt = 'occ'
5067 ELSE
5068 occ_virt = 'vir'
5069 END IF
5070
5071 IF (unit_nr > 0) THEN
5072 IF (crossing_search == ri_rpa_g0w0_crossing_z_shot) THEN
5073 WRITE (unit_nr, '(T3,I4,3A,5F13.4)') &
5074 n_level_gw_ref, ' ( ', occ_virt, ') ', &
5075 eigenval_last(n_level_gw_ref)*evolt, &
5076 vec_gw_energ(n_level_gw)*evolt, &
5077 vec_sigma_x_minus_vxc_gw(n_level_gw_ref)*evolt, &
5078 z_value(n_level_gw), &
5079 eigenval(n_level_gw_ref)*evolt
5080 ELSE
5081 WRITE (unit_nr, '(T3,I4,3A,4F16.4)') &
5082 n_level_gw_ref, ' ( ', occ_virt, ') ', &
5083 eigenval_last(n_level_gw_ref)*evolt, &
5084 vec_gw_energ(n_level_gw)*evolt, &
5085 vec_sigma_x_minus_vxc_gw(n_level_gw_ref)*evolt, &
5086 eigenval(n_level_gw_ref)*evolt
5087 END IF
5088 END IF
5089 END DO
5090
5091 e_homo_scf = maxval(eigenval_last(homo - gw_corr_lev_occ + 1:homo))
5092 e_lumo_scf = minval(eigenval_last(homo + 1:homo + gw_corr_lev_virt))
5093
5094 e_homo_gw = maxval(eigenval(homo - gw_corr_lev_occ + 1:homo))
5095 e_lumo_gw = minval(eigenval(homo + 1:homo + gw_corr_lev_virt))
5096 e_gap_gw = e_lumo_gw - e_homo_gw
5097
5098 IF (PRESENT(e_vbm_scf) .AND. PRESENT(e_cbm_scf) .AND. &
5099 PRESENT(e_vbm_gw) .AND. PRESENT(e_cbm_gw)) THEN
5100 IF (e_homo_scf > e_vbm_scf) e_vbm_scf = e_homo_scf
5101 IF (e_lumo_scf < e_cbm_scf) e_cbm_scf = e_lumo_scf
5102 IF (e_homo_gw > e_vbm_gw) e_vbm_gw = e_homo_gw
5103 IF (e_lumo_gw < e_cbm_gw) e_cbm_gw = e_lumo_gw
5104 END IF
5105
5106 IF (unit_nr > 0) THEN
5107
5108 IF (do_kpoints) THEN
5109 IF (do_closed_shell) THEN
5110 WRITE (unit_nr, '(T3,A)') ' '
5111 WRITE (unit_nr, '(T3,A,F42.4)') 'GW direct gap at current kpoint (eV)', e_gap_gw*evolt
5112 ELSE IF (do_alpha) THEN
5113 WRITE (unit_nr, '(T3,A)') ' '
5114 WRITE (unit_nr, '(T3,A,F36.4)') 'Alpha GW direct gap at current kpoint (eV)', &
5115 e_gap_gw*evolt
5116 ELSE IF (do_beta) THEN
5117 WRITE (unit_nr, '(T3,A)') ' '
5118 WRITE (unit_nr, '(T3,A,F37.4)') 'Beta GW direct gap at current kpoint (eV)', &
5119 e_gap_gw*evolt
5120 END IF
5121 ELSE
5122 IF (do_closed_shell) THEN
5123 WRITE (unit_nr, '(T3,A)') ' '
5124 IF (count_ev_sc_gw > 1) THEN
5125 WRITE (unit_nr, '(T3,A,I3,A,F39.4)') 'HOMO-LUMO gap in evGW iteration', &
5126 count_ev_sc_gw, ' (eV)', e_gap_gw*evolt
5127 ELSE IF (count_sc_gw0 > 1) THEN
5128 WRITE (unit_nr, '(T3,A,I3,A,F38.4)') 'HOMO-LUMO gap in evGW0 iteration', &
5129 count_sc_gw0, ' (eV)', e_gap_gw*evolt
5130 ELSE
5131 WRITE (unit_nr, '(T3,A,F55.4)') 'G0W0 HOMO-LUMO gap (eV)', e_gap_gw*evolt
5132 END IF
5133 ELSE IF (do_alpha) THEN
5134 WRITE (unit_nr, '(T3,A)') ' '
5135 WRITE (unit_nr, '(T3,A,F51.4)') 'Alpha GW HOMO-LUMO gap (eV)', e_gap_gw*evolt
5136 ELSE IF (do_beta) THEN
5137 WRITE (unit_nr, '(T3,A)') ' '
5138 WRITE (unit_nr, '(T3,A,F52.4)') 'Beta GW HOMO-LUMO gap (eV)', e_gap_gw*evolt
5139 END IF
5140 END IF
5141 END IF
5142
5143 IF (unit_nr > 0) THEN
5144 WRITE (unit_nr, *) ' '
5145 WRITE (unit_nr, '(T3,A)') '------------------------------------------------------------------------------'
5146 END IF
5147
5148 CALL timestop(handle)
5149
5150 END SUBROUTINE print_and_update_for_ev_sc
5151
5152! **************************************************************************************************
5153!> \brief ...
5154!> \param Eigenval ...
5155!> \param Eigenval_last ...
5156!> \param gw_corr_lev_occ ...
5157!> \param gw_corr_lev_virt ...
5158!> \param homo ...
5159!> \param nmo ...
5160! **************************************************************************************************
5161 PURE SUBROUTINE shift_unshifted_levels(Eigenval, Eigenval_last, gw_corr_lev_occ, gw_corr_lev_virt, &
5162 homo, nmo)
5163
5164 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: eigenval, eigenval_last
5165 INTEGER, INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt, homo, &
5166 nmo
5167
5168 INTEGER :: n_level_gw, n_level_gw_ref
5169 REAL(kind=dp) :: eigen_diff
5170
5171 ! for eigenvalue self-consistent GW, all eigenvalues have to be corrected
5172 ! 1) the occupied; check if there are occupied MOs not being corrected by GW
5173 IF (gw_corr_lev_occ < homo .AND. gw_corr_lev_occ > 0) THEN
5174
5175 ! calculate average GW correction for occupied orbitals
5176 eigen_diff = 0.0_dp
5177
5178 DO n_level_gw = 1, gw_corr_lev_occ
5179 n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ
5180 eigen_diff = eigen_diff + eigenval(n_level_gw_ref) - eigenval_last(n_level_gw_ref)
5181 END DO
5182 eigen_diff = eigen_diff/gw_corr_lev_occ
5183
5184 ! correct the eigenvalues of the occupied orbitals which have not been corrected by GW
5185 DO n_level_gw = 1, homo - gw_corr_lev_occ
5186 eigenval(n_level_gw) = eigenval(n_level_gw) + eigen_diff
5187 END DO
5188
5189 END IF
5190
5191 ! 2) the virtual: check if there are virtual orbitals not being corrected by GW
5192 IF (gw_corr_lev_virt < nmo - homo .AND. gw_corr_lev_virt > 0) THEN
5193
5194 ! calculate average GW correction for virtual orbitals
5195 eigen_diff = 0.0_dp
5196 DO n_level_gw = 1, gw_corr_lev_virt
5197 n_level_gw_ref = n_level_gw + homo
5198 eigen_diff = eigen_diff + eigenval(n_level_gw_ref) - eigenval_last(n_level_gw_ref)
5199 END DO
5200 eigen_diff = eigen_diff/gw_corr_lev_virt
5201
5202 ! correct the eigenvalues of the virtual orbitals which have not been corrected by GW
5203 DO n_level_gw = homo + gw_corr_lev_virt + 1, nmo
5204 eigenval(n_level_gw) = eigenval(n_level_gw) + eigen_diff
5205 END DO
5206
5207 END IF
5208
5209 END SUBROUTINE shift_unshifted_levels
5210
5211! **************************************************************************************************
5212!> \brief Calculate the matrix mat_N_gw containing the second derivatives
5213!> with respect to the fitting parameters. The second derivatives are
5214!> calculated numerically by finite differences.
5215!> \param N_ij matrix element
5216!> \param Lambda fitting parameters
5217!> \param Sigma_c ...
5218!> \param vec_omega_fit_gw ...
5219!> \param i ...
5220!> \param j ...
5221!> \param num_poles ...
5222!> \param num_fit_points ...
5223!> \param n_level_gw ...
5224!> \param h ...
5225! **************************************************************************************************
5226 SUBROUTINE calc_mat_n(N_ij, Lambda, Sigma_c, vec_omega_fit_gw, i, j, &
5227 num_poles, num_fit_points, n_level_gw, h)
5228 REAL(kind=dp), INTENT(OUT) :: n_ij
5229 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:), &
5230 INTENT(IN) :: lambda
5231 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(IN) :: sigma_c
5232 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
5233 INTENT(IN) :: vec_omega_fit_gw
5234 INTEGER, INTENT(IN) :: i, j, num_poles, num_fit_points, &
5235 n_level_gw
5236 REAL(kind=dp), INTENT(IN) :: h
5237
5238 CHARACTER(LEN=*), PARAMETER :: routinen = 'calc_mat_N'
5239
5240 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: lambda_tmp
5241 INTEGER :: handle, num_var
5242 REAL(kind=dp) :: chi2, chi2_sum
5243
5244 CALL timeset(routinen, handle)
5245
5246 num_var = 2*num_poles + 1
5247 ALLOCATE (lambda_tmp(num_var))
5248 lambda_tmp = z_zero
5249 chi2_sum = 0.0_dp
5250
5251 !test
5252 lambda_tmp(:) = lambda(:)
5253 CALL calc_chi2(chi2, lambda_tmp, sigma_c, vec_omega_fit_gw, num_poles, &
5254 num_fit_points, n_level_gw)
5255
5256 ! Fitting parameters with offset h
5257 lambda_tmp(:) = lambda(:)
5258 IF (modulo(i, 2) == 0) THEN
5259 lambda_tmp(i/2) = lambda_tmp(i/2) + h*z_one
5260 ELSE
5261 lambda_tmp((i + 1)/2) = lambda_tmp((i + 1)/2) + h*gaussi
5262 END IF
5263 IF (modulo(j, 2) == 0) THEN
5264 lambda_tmp(j/2) = lambda_tmp(j/2) + h*z_one
5265 ELSE
5266 lambda_tmp((j + 1)/2) = lambda_tmp((j + 1)/2) + h*gaussi
5267 END IF
5268 CALL calc_chi2(chi2, lambda_tmp, sigma_c, vec_omega_fit_gw, num_poles, &
5269 num_fit_points, n_level_gw)
5270 chi2_sum = chi2_sum + chi2
5271
5272 IF (modulo(i, 2) == 0) THEN
5273 lambda_tmp(i/2) = lambda_tmp(i/2) - 2.0_dp*h*z_one
5274 ELSE
5275 lambda_tmp((i + 1)/2) = lambda_tmp((i + 1)/2) - 2.0_dp*h*gaussi
5276 END IF
5277 CALL calc_chi2(chi2, lambda_tmp, sigma_c, vec_omega_fit_gw, num_poles, &
5278 num_fit_points, n_level_gw)
5279 chi2_sum = chi2_sum - chi2
5280
5281 IF (modulo(j, 2) == 0) THEN
5282 lambda_tmp(j/2) = lambda_tmp(j/2) - 2.0_dp*h*z_one
5283 ELSE
5284 lambda_tmp((j + 1)/2) = lambda_tmp((j + 1)/2) - 2.0_dp*h*gaussi
5285 END IF
5286 CALL calc_chi2(chi2, lambda_tmp, sigma_c, vec_omega_fit_gw, num_poles, &
5287 num_fit_points, n_level_gw)
5288 chi2_sum = chi2_sum + chi2
5289
5290 IF (modulo(i, 2) == 0) THEN
5291 lambda_tmp(i/2) = lambda_tmp(i/2) + 2.0_dp*h*z_one
5292 ELSE
5293 lambda_tmp((i + 1)/2) = lambda_tmp((i + 1)/2) + 2.0_dp*h*gaussi
5294 END IF
5295 CALL calc_chi2(chi2, lambda_tmp, sigma_c, vec_omega_fit_gw, num_poles, &
5296 num_fit_points, n_level_gw)
5297 chi2_sum = chi2_sum - chi2
5298
5299 ! Second derivative with symmetric difference quotient
5300 n_ij = 1.0_dp/2.0_dp*chi2_sum/(4.0_dp*h*h)
5301
5302 DEALLOCATE (lambda_tmp)
5303
5304 CALL timestop(handle)
5305
5306 END SUBROUTINE calc_mat_n
5307
5308! **************************************************************************************************
5309!> \brief Calculate chi2
5310!> \param chi2 ...
5311!> \param Lambda fitting parameters
5312!> \param Sigma_c ...
5313!> \param vec_omega_fit_gw ...
5314!> \param num_poles ...
5315!> \param num_fit_points ...
5316!> \param n_level_gw ...
5317! **************************************************************************************************
5318 PURE SUBROUTINE calc_chi2(chi2, Lambda, Sigma_c, vec_omega_fit_gw, num_poles, &
5319 num_fit_points, n_level_gw)
5320 REAL(kind=dp), INTENT(OUT) :: chi2
5321 COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN) :: lambda
5322 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(IN) :: sigma_c
5323 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: vec_omega_fit_gw
5324 INTEGER, INTENT(IN) :: num_poles, num_fit_points, n_level_gw
5325
5326 COMPLEX(KIND=dp) :: func_val
5327 INTEGER :: iii, jjj, kkk
5328
5329 chi2 = 0.0_dp
5330 DO kkk = 1, num_fit_points
5331 func_val = lambda(1)
5332 DO iii = 1, num_poles
5333 jjj = iii*2
5334 ! calculate value of the fit function
5335 func_val = func_val + lambda(jjj)/(gaussi*vec_omega_fit_gw(kkk) - lambda(jjj + 1))
5336 END DO
5337 chi2 = chi2 + (abs(sigma_c(n_level_gw, kkk) - func_val))**2
5338 END DO
5339
5340 END SUBROUTINE calc_chi2
5341
5342! **************************************************************************************************
5343!> \brief ...
5344!> \param num_integ_points ...
5345!> \param nmo ...
5346!> \param tau_tj ...
5347!> \param tj ...
5348!> \param matrix_s ...
5349!> \param fm_mo_coeff_occ ...
5350!> \param fm_mo_coeff_virt ...
5351!> \param fm_mo_coeff_occ_scaled ...
5352!> \param fm_mo_coeff_virt_scaled ...
5353!> \param fm_scaled_dm_occ_tau ...
5354!> \param fm_scaled_dm_virt_tau ...
5355!> \param Eigenval ...
5356!> \param eps_filter ...
5357!> \param e_fermi ...
5358!> \param fm_mat_W ...
5359!> \param gw_corr_lev_tot ...
5360!> \param gw_corr_lev_occ ...
5361!> \param gw_corr_lev_virt ...
5362!> \param homo ...
5363!> \param count_ev_sc_GW ...
5364!> \param count_sc_GW0 ...
5365!> \param t_3c_overl_int_ao_mo ...
5366!> \param t_3c_O_mo_compressed ...
5367!> \param t_3c_O_mo_ind ...
5368!> \param t_3c_overl_int_gw_RI ...
5369!> \param t_3c_overl_int_gw_AO ...
5370!> \param mat_W ...
5371!> \param mat_MinvVMinv ...
5372!> \param mat_dm ...
5373!> \param weights_cos_tf_t_to_w ...
5374!> \param weights_sin_tf_t_to_w ...
5375!> \param vec_Sigma_c_gw ...
5376!> \param do_periodic ...
5377!> \param num_points_corr ...
5378!> \param delta_corr ...
5379!> \param qs_env ...
5380!> \param para_env ...
5381!> \param para_env_RPA ...
5382!> \param mp2_env ...
5383!> \param matrix_berry_re_mo_mo ...
5384!> \param matrix_berry_im_mo_mo ...
5385!> \param first_cycle_periodic_correction ...
5386!> \param kpoints ...
5387!> \param num_fit_points ...
5388!> \param fm_mo_coeff ...
5389!> \param do_ri_Sigma_x ...
5390!> \param vec_Sigma_x_gw ...
5391!> \param unit_nr ...
5392!> \param ispin ...
5393! **************************************************************************************************
5394 SUBROUTINE compute_self_energy_cubic_gw(num_integ_points, nmo, tau_tj, tj, &
5395 matrix_s, fm_mo_coeff_occ, fm_mo_coeff_virt, fm_mo_coeff_occ_scaled, &
5396 fm_mo_coeff_virt_scaled, fm_scaled_dm_occ_tau, &
5397 fm_scaled_dm_virt_tau, Eigenval, eps_filter, &
5398 e_fermi, fm_mat_W, &
5399 gw_corr_lev_tot, gw_corr_lev_occ, gw_corr_lev_virt, homo, &
5400 count_ev_sc_GW, count_sc_GW0, &
5401 t_3c_overl_int_ao_mo, t_3c_O_mo_compressed, t_3c_O_mo_ind, &
5402 t_3c_overl_int_gw_RI, t_3c_overl_int_gw_AO, &
5403 mat_W, mat_MinvVMinv, mat_dm, &
5404 weights_cos_tf_t_to_w, weights_sin_tf_t_to_w, vec_Sigma_c_gw, &
5405 do_periodic, num_points_corr, delta_corr, qs_env, para_env, para_env_RPA, &
5406 mp2_env, matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, &
5407 first_cycle_periodic_correction, kpoints, num_fit_points, fm_mo_coeff, &
5408 do_ri_Sigma_x, vec_Sigma_x_gw, unit_nr, ispin)
5409 INTEGER, INTENT(IN) :: num_integ_points, nmo
5410 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
5411 INTENT(IN) :: tau_tj, tj
5412 TYPE(dbcsr_p_type), DIMENSION(:), INTENT(IN) :: matrix_s
5413 TYPE(cp_fm_type), INTENT(IN) :: fm_mo_coeff_occ, fm_mo_coeff_virt, fm_mo_coeff_occ_scaled, &
5414 fm_mo_coeff_virt_scaled, fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau
5415 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: eigenval
5416 REAL(kind=dp), INTENT(IN) :: eps_filter
5417 REAL(kind=dp), INTENT(INOUT) :: e_fermi
5418 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_mat_w
5419 INTEGER, INTENT(IN) :: gw_corr_lev_tot, gw_corr_lev_occ, &
5420 gw_corr_lev_virt, homo, &
5421 count_ev_sc_gw, count_sc_gw0
5422 TYPE(dbt_type) :: t_3c_overl_int_ao_mo
5423 TYPE(hfx_compression_type) :: t_3c_o_mo_compressed
5424 INTEGER, DIMENSION(:, :) :: t_3c_o_mo_ind
5425 TYPE(dbt_type) :: t_3c_overl_int_gw_ri, &
5426 t_3c_overl_int_gw_ao
5427 TYPE(dbcsr_type), INTENT(INOUT), TARGET :: mat_w
5428 TYPE(dbcsr_p_type) :: mat_minvvminv, mat_dm
5429 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: weights_cos_tf_t_to_w, &
5430 weights_sin_tf_t_to_w
5431 COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(OUT) :: vec_sigma_c_gw
5432 LOGICAL, INTENT(IN) :: do_periodic
5433 INTEGER, INTENT(IN) :: num_points_corr
5434 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
5435 INTENT(INOUT) :: delta_corr
5436 TYPE(qs_environment_type), POINTER :: qs_env
5437 TYPE(mp_para_env_type), POINTER :: para_env, para_env_rpa
5438 TYPE(mp2_type), INTENT(INOUT) :: mp2_env
5439 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_berry_re_mo_mo, &
5440 matrix_berry_im_mo_mo
5441 LOGICAL, INTENT(INOUT) :: first_cycle_periodic_correction
5442 TYPE(kpoint_type), POINTER :: kpoints
5443 INTEGER, INTENT(IN) :: num_fit_points
5444 TYPE(cp_fm_type), INTENT(IN) :: fm_mo_coeff
5445 LOGICAL, INTENT(IN) :: do_ri_sigma_x
5446 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: vec_sigma_x_gw
5447 INTEGER, INTENT(IN) :: unit_nr, ispin
5448
5449 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_self_energy_cubic_gw'
5450
5451 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: delta_corr_omega
5452 INTEGER :: gw_lev_end, gw_lev_start, handle, handle3, i, iblk_mo, iquad, jquad, mo_end, &
5453 mo_start, n_level_gw, n_level_gw_ref, nblk_mo, unit_nr_prv
5454 INTEGER, ALLOCATABLE, DIMENSION(:) :: batch_range_mo, dist1, dist2, mo_bsizes, &
5455 mo_offsets, sizes_ao, sizes_ri
5456 INTEGER, DIMENSION(2) :: mo_bounds, pdims_2d
5457 LOGICAL :: memory_info
5458 REAL(kind=dp) :: ext_scaling, omega, omega_i, omega_sign, &
5459 sign_occ_virt, t_i_clenshaw, tau, &
5460 weight_cos, weight_i, weight_sin
5461 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: vec_sigma_c_gw_cos_omega, &
5462 vec_sigma_c_gw_cos_tau, vec_sigma_c_gw_neg_tau, vec_sigma_c_gw_pos_tau, &
5463 vec_sigma_c_gw_sin_omega, vec_sigma_c_gw_sin_tau
5464 TYPE(dbcsr_type), TARGET :: mat_greens_fct_occ, mat_greens_fct_virt
5465 TYPE(dbt_pgrid_type) :: pgrid_2d
5466 TYPE(dbt_type) :: t_3c_ctr_ao, t_3c_ctr_ri, t_ao_tmp, &
5467 t_dm, t_greens_fct_occ, &
5468 t_greens_fct_virt, t_ri_tmp, &
5469 t_sinvvsinv, t_w
5470
5471 CALL timeset(routinen, handle)
5472
5473 CALL decompress_tensor(t_3c_overl_int_ao_mo, t_3c_o_mo_ind, t_3c_o_mo_compressed, &
5474 mp2_env%ri_rpa_im_time%eps_compress)
5475
5476 CALL dbt_copy(t_3c_overl_int_ao_mo, t_3c_overl_int_gw_ri)
5477 CALL dbt_copy(t_3c_overl_int_ao_mo, t_3c_overl_int_gw_ao, order=[2, 1, 3], move_data=.true.)
5478
5479 memory_info = mp2_env%ri_rpa_im_time%memory_info
5480 IF (memory_info) THEN
5481 unit_nr_prv = unit_nr
5482 ELSE
5483 unit_nr_prv = 0
5484 END IF
5485
5486 mo_start = homo - gw_corr_lev_occ + 1
5487 mo_end = homo + gw_corr_lev_virt
5488 cpassert(mo_end - mo_start + 1 == gw_corr_lev_tot)
5489
5490 vec_sigma_c_gw = z_zero
5491 ALLOCATE (vec_sigma_c_gw_pos_tau(gw_corr_lev_tot, num_integ_points))
5492 vec_sigma_c_gw_pos_tau = 0.0_dp
5493 ALLOCATE (vec_sigma_c_gw_neg_tau(gw_corr_lev_tot, num_integ_points))
5494 vec_sigma_c_gw_neg_tau = 0.0_dp
5495 ALLOCATE (vec_sigma_c_gw_cos_tau(gw_corr_lev_tot, num_integ_points))
5496 vec_sigma_c_gw_cos_tau = 0.0_dp
5497 ALLOCATE (vec_sigma_c_gw_sin_tau(gw_corr_lev_tot, num_integ_points))
5498 vec_sigma_c_gw_sin_tau = 0.0_dp
5499
5500 ALLOCATE (vec_sigma_c_gw_cos_omega(gw_corr_lev_tot, num_integ_points))
5501 vec_sigma_c_gw_cos_omega = 0.0_dp
5502 ALLOCATE (vec_sigma_c_gw_sin_omega(gw_corr_lev_tot, num_integ_points))
5503 vec_sigma_c_gw_sin_omega = 0.0_dp
5504
5505 ALLOCATE (delta_corr_omega(1 + homo - gw_corr_lev_occ:homo + gw_corr_lev_virt, num_integ_points))
5506 delta_corr_omega(:, :) = z_zero
5507
5508 CALL dbcsr_create(matrix=mat_greens_fct_occ, &
5509 template=matrix_s(1)%matrix, &
5510 matrix_type=dbcsr_type_no_symmetry)
5511
5512 CALL dbcsr_create(matrix=mat_greens_fct_virt, &
5513 template=matrix_s(1)%matrix, &
5514 matrix_type=dbcsr_type_no_symmetry)
5515
5516 e_fermi = 0.5_dp*(eigenval(homo) + eigenval(homo + 1))
5517
5518 nblk_mo = dbt_nblks_total(t_3c_overl_int_gw_ao, 3)
5519 ALLOCATE (mo_offsets(nblk_mo))
5520 ALLOCATE (mo_bsizes(nblk_mo))
5521 ALLOCATE (batch_range_mo(nblk_mo - 1))
5522 CALL dbt_get_info(t_3c_overl_int_gw_ao, blk_offset_3=mo_offsets, blk_size_3=mo_bsizes)
5523
5524 pdims_2d = 0
5525 CALL dbt_pgrid_create(para_env, pdims_2d, pgrid_2d)
5526 ALLOCATE (sizes_ri(dbt_nblks_total(t_3c_overl_int_gw_ri, 1)))
5527 CALL dbt_get_info(t_3c_overl_int_gw_ri, blk_size_1=sizes_ri)
5528
5529 CALL create_2c_tensor(t_w, dist1, dist2, pgrid_2d, sizes_ri, sizes_ri, name="(RI|RI)")
5530
5531 DEALLOCATE (dist1, dist2)
5532
5533 CALL dbt_create(mat_w, t_ri_tmp, name="(RI|RI)")
5534
5535 CALL dbt_create(t_3c_overl_int_gw_ri, t_3c_ctr_ri)
5536 CALL dbt_create(t_3c_overl_int_gw_ao, t_3c_ctr_ao)
5537
5538 ALLOCATE (sizes_ao(dbt_nblks_total(t_3c_overl_int_gw_ao, 1)))
5539 CALL dbt_get_info(t_3c_overl_int_gw_ao, blk_size_1=sizes_ao)
5540 CALL create_2c_tensor(t_greens_fct_occ, dist1, dist2, pgrid_2d, sizes_ao, sizes_ao, name="(AO|AO)")
5541 DEALLOCATE (dist1, dist2)
5542 CALL create_2c_tensor(t_greens_fct_virt, dist1, dist2, pgrid_2d, sizes_ao, sizes_ao, name="(AO|AO)")
5543 DEALLOCATE (dist1, dist2)
5544
5545 DO jquad = 1, num_integ_points
5546
5547 CALL compute_greens_function_time(mat_greens_fct_occ, mat_greens_fct_virt, &
5548 fm_mo_coeff_occ, fm_mo_coeff_virt, &
5549 fm_mo_coeff_occ_scaled, fm_mo_coeff_virt_scaled, &
5550 fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau, eigenval, &
5551 nmo, eps_filter, e_fermi, tau_tj(jquad), para_env)
5552
5553 CALL dbcsr_set(mat_w, 0.0_dp)
5554 CALL copy_fm_to_dbcsr(fm_mat_w(jquad), mat_w, keep_sparsity=.false.)
5555
5556 IF (jquad == 1) CALL dbt_create(mat_greens_fct_occ, t_ao_tmp, name="(AO|AO)")
5557
5558 CALL dbt_copy_matrix_to_tensor(mat_w, t_ri_tmp)
5559 CALL dbt_copy(t_ri_tmp, t_w)
5560 CALL dbt_copy_matrix_to_tensor(mat_greens_fct_occ, t_ao_tmp)
5561 CALL dbt_copy(t_ao_tmp, t_greens_fct_occ)
5562 CALL dbt_copy_matrix_to_tensor(mat_greens_fct_virt, t_ao_tmp)
5563 CALL dbt_copy(t_ao_tmp, t_greens_fct_virt)
5564
5565 batch_range_mo(:) = [(i, i=2, nblk_mo)]
5566 CALL dbt_batched_contract_init(t_3c_overl_int_gw_ao, batch_range_3=batch_range_mo)
5567 CALL dbt_batched_contract_init(t_3c_overl_int_gw_ri, batch_range_3=batch_range_mo)
5568 CALL dbt_batched_contract_init(t_3c_ctr_ao, batch_range_3=batch_range_mo)
5569 CALL dbt_batched_contract_init(t_3c_ctr_ri, batch_range_3=batch_range_mo)
5570 CALL dbt_batched_contract_init(t_w)
5571 CALL dbt_batched_contract_init(t_greens_fct_occ)
5572 CALL dbt_batched_contract_init(t_greens_fct_virt)
5573
5574 ! in iteration over MO blocks skip first and last block because they correspond to the MO s
5575 ! outside of the GW range of required MOs
5576 DO iblk_mo = 2, nblk_mo - 1
5577 mo_bounds = [mo_offsets(iblk_mo), mo_offsets(iblk_mo) + mo_bsizes(iblk_mo) - 1]
5578 CALL contract_cubic_gw(t_3c_overl_int_gw_ao, t_3c_overl_int_gw_ri, &
5579 t_greens_fct_occ, t_w, [1.0_dp, -1.0_dp], &
5580 mo_bounds, unit_nr_prv, &
5581 t_3c_ctr_ri, t_3c_ctr_ao, calculate_ctr_ri=.true.)
5582 CALL trace_sigma_gw(t_3c_ctr_ao, t_3c_ctr_ri, vec_sigma_c_gw_neg_tau(:, jquad), mo_start, mo_bounds, para_env)
5583
5584 CALL contract_cubic_gw(t_3c_overl_int_gw_ao, t_3c_overl_int_gw_ri, &
5585 t_greens_fct_virt, t_w, [1.0_dp, 1.0_dp], &
5586 mo_bounds, unit_nr_prv, &
5587 t_3c_ctr_ri, t_3c_ctr_ao, calculate_ctr_ri=.false.)
5588
5589 CALL trace_sigma_gw(t_3c_ctr_ao, t_3c_ctr_ri, vec_sigma_c_gw_pos_tau(:, jquad), mo_start, mo_bounds, para_env)
5590 END DO
5591 CALL dbt_batched_contract_finalize(t_3c_overl_int_gw_ao)
5592 CALL dbt_batched_contract_finalize(t_3c_overl_int_gw_ri)
5593 CALL dbt_batched_contract_finalize(t_3c_ctr_ao)
5594 CALL dbt_batched_contract_finalize(t_3c_ctr_ri)
5595 CALL dbt_batched_contract_finalize(t_w)
5596 CALL dbt_batched_contract_finalize(t_greens_fct_occ)
5597 CALL dbt_batched_contract_finalize(t_greens_fct_virt)
5598
5599 CALL dbt_clear(t_3c_ctr_ao)
5600 CALL dbt_clear(t_3c_ctr_ri)
5601
5602 vec_sigma_c_gw_cos_tau(:, jquad) = 0.5_dp*(vec_sigma_c_gw_pos_tau(:, jquad) + &
5603 vec_sigma_c_gw_neg_tau(:, jquad))
5604
5605 vec_sigma_c_gw_sin_tau(:, jquad) = 0.5_dp*(vec_sigma_c_gw_pos_tau(:, jquad) - &
5606 vec_sigma_c_gw_neg_tau(:, jquad))
5607
5608 END DO ! jquad (tau)
5609 CALL dbt_destroy(t_w)
5610
5611 CALL dbt_destroy(t_greens_fct_occ)
5612 CALL dbt_destroy(t_greens_fct_virt)
5613
5614 ! Fourier transform from time to frequency
5615 DO jquad = 1, num_fit_points
5616
5617 DO iquad = 1, num_integ_points
5618
5619 omega = tj(jquad)
5620 tau = tau_tj(iquad)
5621 weight_cos = weights_cos_tf_t_to_w(jquad, iquad)*cos(omega*tau)
5622 weight_sin = weights_sin_tf_t_to_w(jquad, iquad)*sin(omega*tau)
5623
5624 vec_sigma_c_gw_cos_omega(:, jquad) = vec_sigma_c_gw_cos_omega(:, jquad) + &
5625 weight_cos*vec_sigma_c_gw_cos_tau(:, iquad)
5626
5627 vec_sigma_c_gw_sin_omega(:, jquad) = vec_sigma_c_gw_sin_omega(:, jquad) + &
5628 weight_sin*vec_sigma_c_gw_sin_tau(:, iquad)
5629
5630 END DO
5631
5632 END DO
5633
5634 ! for occupied levels, we need the correlation self-energy for negative omega. Therefore, weight_sin
5635 ! should be computed with -omega, which results in an additional minus for vec_Sigma_c_gw_sin_omega:
5636 vec_sigma_c_gw_sin_omega(1:gw_corr_lev_occ, :) = -vec_sigma_c_gw_sin_omega(1:gw_corr_lev_occ, :)
5637
5638 vec_sigma_c_gw(:, 1:num_fit_points, 1) = vec_sigma_c_gw_cos_omega(:, 1:num_fit_points) + &
5639 gaussi*vec_sigma_c_gw_sin_omega(:, 1:num_fit_points)
5640
5641 CALL dbcsr_release(mat_greens_fct_occ)
5642 CALL dbcsr_release(mat_greens_fct_virt)
5643
5644 IF (do_ri_sigma_x .AND. count_ev_sc_gw == 1 .AND. count_sc_gw0 == 1) THEN
5645
5646 CALL timeset(routinen//"_RI_HFX_operation_1", handle3)
5647
5648 ! get density matrix
5649 CALL parallel_gemm(transa="N", transb="T", m=nmo, n=nmo, k=nmo, alpha=1.0_dp, &
5650 matrix_a=fm_mo_coeff_occ, matrix_b=fm_mo_coeff_occ, beta=0.0_dp, &
5651 matrix_c=fm_scaled_dm_occ_tau)
5652
5653 CALL timestop(handle3)
5654
5655 CALL timeset(routinen//"_RI_HFX_operation_2", handle3)
5656
5657 CALL copy_fm_to_dbcsr(fm_scaled_dm_occ_tau, &
5658 mat_dm%matrix, &
5659 keep_sparsity=.false.)
5660
5661 CALL timestop(handle3)
5662
5663 CALL create_2c_tensor(t_dm, dist1, dist2, pgrid_2d, sizes_ao, sizes_ao, name="(AO|AO)")
5664 DEALLOCATE (dist1, dist2)
5665
5666 CALL dbt_copy_matrix_to_tensor(mat_dm%matrix, t_ao_tmp)
5667 CALL dbt_copy(t_ao_tmp, t_dm)
5668
5669 CALL create_2c_tensor(t_sinvvsinv, dist1, dist2, pgrid_2d, sizes_ri, sizes_ri, name="(RI|RI)")
5670 DEALLOCATE (dist1, dist2)
5671
5672 CALL dbt_copy_matrix_to_tensor(mat_minvvminv%matrix, t_ri_tmp)
5673 CALL dbt_copy(t_ri_tmp, t_sinvvsinv)
5674
5675 CALL dbt_batched_contract_init(t_3c_overl_int_gw_ao, batch_range_3=batch_range_mo)
5676 CALL dbt_batched_contract_init(t_3c_overl_int_gw_ri, batch_range_3=batch_range_mo)
5677 CALL dbt_batched_contract_init(t_3c_ctr_ri, batch_range_3=batch_range_mo)
5678 CALL dbt_batched_contract_init(t_3c_ctr_ao, batch_range_3=batch_range_mo)
5679 CALL dbt_batched_contract_init(t_dm)
5680 CALL dbt_batched_contract_init(t_sinvvsinv)
5681
5682 DO iblk_mo = 2, nblk_mo - 1
5683 mo_bounds = [mo_offsets(iblk_mo), mo_offsets(iblk_mo) + mo_bsizes(iblk_mo) - 1]
5684
5685 CALL contract_cubic_gw(t_3c_overl_int_gw_ao, t_3c_overl_int_gw_ri, &
5686 t_dm, t_sinvvsinv, [1.0_dp, -1.0_dp], &
5687 mo_bounds, unit_nr_prv, &
5688 t_3c_ctr_ri, t_3c_ctr_ao, calculate_ctr_ri=.true.)
5689
5690 CALL trace_sigma_gw(t_3c_ctr_ao, t_3c_ctr_ri, vec_sigma_x_gw(mo_start:mo_end, 1), mo_start, mo_bounds, para_env)
5691 END DO
5692 CALL dbt_batched_contract_finalize(t_3c_overl_int_gw_ao)
5693 CALL dbt_batched_contract_finalize(t_3c_overl_int_gw_ri)
5694 CALL dbt_batched_contract_finalize(t_dm)
5695 CALL dbt_batched_contract_finalize(t_sinvvsinv)
5696 CALL dbt_batched_contract_finalize(t_3c_ctr_ri)
5697 CALL dbt_batched_contract_finalize(t_3c_ctr_ao)
5698
5699 CALL dbt_destroy(t_dm)
5700 CALL dbt_destroy(t_sinvvsinv)
5701
5702 mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, ispin, 1) = &
5703 mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, ispin, 1) + &
5704 vec_sigma_x_gw(:, 1)
5705
5706 END IF
5707
5708 CALL dbt_pgrid_destroy(pgrid_2d)
5709
5710 CALL dbt_destroy(t_3c_ctr_ri)
5711 CALL dbt_destroy(t_3c_ctr_ao)
5712 CALL dbt_destroy(t_ao_tmp)
5713 CALL dbt_destroy(t_ri_tmp)
5714
5715 ! compute and add the periodic correction
5716 IF (do_periodic) THEN
5717
5718 ext_scaling = 0.2_dp
5719
5720 ! loop over omega' (integration)
5721 DO iquad = 1, num_points_corr
5722
5723 ! use the Clenshaw-grid
5724 t_i_clenshaw = iquad*pi/(2.0_dp*num_points_corr)
5725 omega_i = ext_scaling/tan(t_i_clenshaw)
5726
5727 IF (iquad < num_points_corr) THEN
5728 weight_i = ext_scaling*pi/(num_points_corr*sin(t_i_clenshaw)**2)
5729 ELSE
5730 weight_i = ext_scaling*pi/(2.0_dp*num_points_corr*sin(t_i_clenshaw)**2)
5731 END IF
5732
5733 CALL calc_periodic_correction(delta_corr, qs_env, para_env, para_env_rpa, &
5734 mp2_env%ri_g0w0%kp_grid, homo, nmo, gw_corr_lev_occ, &
5735 gw_corr_lev_virt, omega_i, fm_mo_coeff, eigenval, &
5736 matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, &
5737 first_cycle_periodic_correction, kpoints, &
5738 mp2_env%ri_g0w0%do_mo_coeff_gamma, &
5739 mp2_env%ri_g0w0%num_kp_grids, mp2_env%ri_g0w0%eps_kpoint, &
5740 mp2_env%ri_g0w0%do_extra_kpoints, &
5741 mp2_env%ri_g0w0%do_aux_bas_gw, mp2_env%ri_g0w0%frac_aux_mos)
5742
5743 DO n_level_gw = 1, gw_corr_lev_tot
5744
5745 n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ
5746
5747 IF (n_level_gw <= gw_corr_lev_occ) THEN
5748 sign_occ_virt = -1.0_dp
5749 ELSE
5750 sign_occ_virt = 1.0_dp
5751 END IF
5752
5753 DO jquad = 1, num_integ_points
5754
5755 omega_sign = tj(jquad)*sign_occ_virt
5756
5757 delta_corr_omega(n_level_gw_ref, jquad) = &
5758 delta_corr_omega(n_level_gw_ref, jquad) - &
5759 0.5_dp/pi*weight_i/2.0_dp*delta_corr(n_level_gw_ref)* &
5760 (1.0_dp/(gaussi*(omega_i + omega_sign) + e_fermi - eigenval(n_level_gw_ref)) + &
5761 1.0_dp/(gaussi*(-omega_i + omega_sign) + e_fermi - eigenval(n_level_gw_ref)))
5762
5763 END DO
5764
5765 END DO
5766
5767 END DO
5768
5769 gw_lev_start = 1 + homo - gw_corr_lev_occ
5770 gw_lev_end = homo + gw_corr_lev_virt
5771
5772 ! add the periodic correction
5773 vec_sigma_c_gw(1:gw_corr_lev_tot, :, 1) = vec_sigma_c_gw(1:gw_corr_lev_tot, :, 1) + &
5774 delta_corr_omega(gw_lev_start:gw_lev_end, 1:num_fit_points)
5775
5776 END IF
5777
5778 DEALLOCATE (vec_sigma_c_gw_pos_tau)
5779 DEALLOCATE (vec_sigma_c_gw_neg_tau)
5780 DEALLOCATE (vec_sigma_c_gw_cos_tau)
5781 DEALLOCATE (vec_sigma_c_gw_sin_tau)
5782 DEALLOCATE (vec_sigma_c_gw_cos_omega)
5783 DEALLOCATE (vec_sigma_c_gw_sin_omega)
5784 DEALLOCATE (delta_corr_omega)
5785
5786 CALL timestop(handle)
5787
5788 END SUBROUTINE compute_self_energy_cubic_gw
5789
5790! **************************************************************************************************
5791!> \brief ...
5792!> \param num_integ_points ...
5793!> \param tau_tj ...
5794!> \param tj ...
5795!> \param matrix_s ...
5796!> \param Eigenval ...
5797!> \param e_fermi ...
5798!> \param fm_mat_W ...
5799!> \param gw_corr_lev_tot ...
5800!> \param gw_corr_lev_occ ...
5801!> \param gw_corr_lev_virt ...
5802!> \param homo ...
5803!> \param count_ev_sc_GW ...
5804!> \param count_sc_GW0 ...
5805!> \param t_3c_O ...
5806!> \param t_3c_M ...
5807!> \param t_3c_O_compressed ...
5808!> \param t_3c_O_ind ...
5809!> \param mat_W ...
5810!> \param mat_MinvVMinv ...
5811!> \param weights_cos_tf_t_to_w ...
5812!> \param weights_sin_tf_t_to_w ...
5813!> \param vec_Sigma_c_gw ...
5814!> \param qs_env ...
5815!> \param para_env ...
5816!> \param mp2_env ...
5817!> \param num_fit_points ...
5818!> \param fm_mo_coeff ...
5819!> \param do_ri_Sigma_x ...
5820!> \param vec_Sigma_x_gw ...
5821!> \param unit_nr ...
5822!> \param nspins ...
5823!> \param starts_array_mc ...
5824!> \param ends_array_mc ...
5825!> \param eps_filter ...
5826! **************************************************************************************************
5827 SUBROUTINE compute_self_energy_cubic_gw_kpoints(num_integ_points, tau_tj, tj, &
5828 matrix_s, Eigenval, e_fermi, fm_mat_W, &
5829 gw_corr_lev_tot, gw_corr_lev_occ, gw_corr_lev_virt, homo, &
5830 count_ev_sc_GW, count_sc_GW0, &
5831 t_3c_O, t_3c_M, t_3c_O_compressed, t_3c_O_ind, &
5832 mat_W, mat_MinvVMinv, &
5833 weights_cos_tf_t_to_w, weights_sin_tf_t_to_w, vec_Sigma_c_gw, &
5834 qs_env, para_env, &
5835 mp2_env, num_fit_points, fm_mo_coeff, &
5836 do_ri_Sigma_x, vec_Sigma_x_gw, unit_nr, nspins, &
5837 starts_array_mc, ends_array_mc, eps_filter)
5838
5839 INTEGER, INTENT(IN) :: num_integ_points
5840 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
5841 INTENT(IN) :: tau_tj, tj
5842 TYPE(dbcsr_p_type), DIMENSION(:), INTENT(IN) :: matrix_s
5843 REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: eigenval
5844 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: e_fermi
5845 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_mat_w
5846 INTEGER, INTENT(IN) :: gw_corr_lev_tot
5847 INTEGER, DIMENSION(:), INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt, homo
5848 INTEGER, INTENT(IN) :: count_ev_sc_gw, count_sc_gw0
5849 TYPE(dbt_type), ALLOCATABLE, DIMENSION(:, :) :: t_3c_o
5850 TYPE(dbt_type) :: t_3c_m
5851 TYPE(hfx_compression_type), ALLOCATABLE, &
5852 DIMENSION(:, :, :) :: t_3c_o_compressed
5853 TYPE(block_ind_type), ALLOCATABLE, &
5854 DIMENSION(:, :, :), INTENT(INOUT) :: t_3c_o_ind
5855 TYPE(dbcsr_type), INTENT(INOUT), TARGET :: mat_w
5856 TYPE(dbcsr_p_type) :: mat_minvvminv
5857 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: weights_cos_tf_t_to_w, &
5858 weights_sin_tf_t_to_w
5859 COMPLEX(KIND=dp), DIMENSION(:, :, :, :), &
5860 INTENT(OUT) :: vec_sigma_c_gw
5861 TYPE(qs_environment_type), POINTER :: qs_env
5862 TYPE(mp_para_env_type), POINTER :: para_env
5863 TYPE(mp2_type), INTENT(INOUT) :: mp2_env
5864 INTEGER, INTENT(IN) :: num_fit_points
5865 TYPE(cp_fm_type), INTENT(IN) :: fm_mo_coeff
5866 LOGICAL, INTENT(IN) :: do_ri_sigma_x
5867 REAL(kind=dp), DIMENSION(:, :, :), INTENT(INOUT) :: vec_sigma_x_gw
5868 INTEGER, INTENT(IN) :: unit_nr, nspins
5869 INTEGER, DIMENSION(:), INTENT(IN) :: starts_array_mc, ends_array_mc
5870 REAL(kind=dp), INTENT(IN) :: eps_filter
5871
5872 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_self_energy_cubic_gw_kpoints'
5873
5874 INTEGER :: cut_memory, handle, handle2, i_mem, &
5875 iquad, ispin, j_mem, jquad, &
5876 nkp_self_energy, num_points, &
5877 unit_nr_prv
5878 INTEGER, ALLOCATABLE, DIMENSION(:) :: dist1, dist2, sizes_ao, sizes_ri
5879 INTEGER, DIMENSION(2) :: mo_end, mo_start, pdims_2d
5880 INTEGER, DIMENSION(2, 1) :: bounds_ri_i
5881 INTEGER, DIMENSION(2, 2) :: bounds_ao_ao_j
5882 INTEGER, DIMENSION(3) :: dims_3c
5883 LOGICAL :: memory_info
5884 REAL(kind=dp) :: omega, t1, t2, tau, weight_cos, &
5885 weight_sin
5886 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :, :) :: vec_sigma_c_gw_cos_omega, &
5887 vec_sigma_c_gw_cos_tau, vec_sigma_c_gw_neg_tau, vec_sigma_c_gw_pos_tau, &
5888 vec_sigma_c_gw_sin_omega, vec_sigma_c_gw_sin_tau
5889 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: mat_p_greens_fct_occ, &
5890 mat_p_greens_fct_virt
5891 TYPE(dbcsr_type), TARGET :: mat_greens_fct_occ, mat_greens_fct_virt, mat_mo_coeff, &
5892 mat_self_energy_ao_ao_neg_tau, mat_self_energy_ao_ao_pos_tau
5893 TYPE(dbt_pgrid_type) :: pgrid_2d
5894 TYPE(dbt_type) :: t_3c_m_w_tmp, t_3c_o_all, t_3c_o_w, &
5895 t_ao_tmp, t_greens_fct_occ, &
5896 t_greens_fct_virt, t_ri_tmp, t_w
5897
5898 CALL timeset(routinen, handle)
5899
5900 memory_info = mp2_env%ri_rpa_im_time%memory_info
5901 IF (memory_info) THEN
5902 unit_nr_prv = unit_nr
5903 ELSE
5904 unit_nr_prv = 0
5905 END IF
5906
5907 cut_memory = mp2_env%ri_rpa_im_time%cut_memory
5908
5909 DO ispin = 1, nspins
5910 mo_start(ispin) = homo(ispin) - gw_corr_lev_occ(ispin) + 1
5911 mo_end(ispin) = homo(ispin) + gw_corr_lev_virt(ispin)
5912 cpassert(mo_end(ispin) - mo_start(ispin) + 1 == gw_corr_lev_tot)
5913 END DO
5914
5915 nkp_self_energy = mp2_env%ri_g0w0%nkp_self_energy
5916
5917 vec_sigma_c_gw = z_zero
5918 ALLOCATE (vec_sigma_c_gw_pos_tau(gw_corr_lev_tot, num_integ_points, nkp_self_energy, nspins))
5919 vec_sigma_c_gw_pos_tau = 0.0_dp
5920 ALLOCATE (vec_sigma_c_gw_neg_tau(gw_corr_lev_tot, num_integ_points, nkp_self_energy, nspins))
5921 vec_sigma_c_gw_neg_tau = 0.0_dp
5922 ALLOCATE (vec_sigma_c_gw_cos_tau(gw_corr_lev_tot, num_integ_points, nkp_self_energy, nspins))
5923 vec_sigma_c_gw_cos_tau = 0.0_dp
5924 ALLOCATE (vec_sigma_c_gw_sin_tau(gw_corr_lev_tot, num_integ_points, nkp_self_energy, nspins))
5925 vec_sigma_c_gw_sin_tau = 0.0_dp
5926
5927 ALLOCATE (vec_sigma_c_gw_cos_omega(gw_corr_lev_tot, num_integ_points, nkp_self_energy, nspins))
5928 vec_sigma_c_gw_cos_omega = 0.0_dp
5929 ALLOCATE (vec_sigma_c_gw_sin_omega(gw_corr_lev_tot, num_integ_points, nkp_self_energy, nspins))
5930 vec_sigma_c_gw_sin_omega = 0.0_dp
5931
5932 CALL dbcsr_create(matrix=mat_greens_fct_occ, &
5933 template=matrix_s(1)%matrix, &
5934 matrix_type=dbcsr_type_no_symmetry)
5935
5936 CALL dbcsr_create(matrix=mat_greens_fct_virt, &
5937 template=matrix_s(1)%matrix, &
5938 matrix_type=dbcsr_type_no_symmetry)
5939
5940 CALL dbcsr_create(matrix=mat_self_energy_ao_ao_neg_tau, &
5941 template=matrix_s(1)%matrix, &
5942 matrix_type=dbcsr_type_no_symmetry)
5943
5944 CALL dbcsr_create(matrix=mat_self_energy_ao_ao_pos_tau, &
5945 template=matrix_s(1)%matrix, &
5946 matrix_type=dbcsr_type_no_symmetry)
5947
5948 CALL dbcsr_create(matrix=mat_mo_coeff, &
5949 template=matrix_s(1)%matrix, &
5950 matrix_type=dbcsr_type_no_symmetry)
5951
5952 CALL copy_fm_to_dbcsr(fm_mo_coeff, mat_mo_coeff, keep_sparsity=.false.)
5953
5954 DO ispin = 1, nspins
5955 e_fermi(ispin) = 0.5_dp*(maxval(eigenval(homo, :, ispin)) + minval(eigenval(homo + 1, :, ispin)))
5956 END DO
5957
5958 pdims_2d = 0
5959 CALL dbt_pgrid_create(para_env, pdims_2d, pgrid_2d)
5960 ALLOCATE (sizes_ri(dbt_nblks_total(t_3c_o(1, 1), 1)))
5961 CALL dbt_get_info(t_3c_o(1, 1), blk_size_1=sizes_ri)
5962
5963 CALL create_2c_tensor(t_w, dist1, dist2, pgrid_2d, sizes_ri, sizes_ri, name="(RI|RI)")
5964 DEALLOCATE (dist1, dist2)
5965
5966 CALL dbt_create(mat_w, t_ri_tmp, name="(RI|RI)")
5967
5968 ALLOCATE (sizes_ao(dbt_nblks_total(t_3c_o(1, 1), 2)))
5969 CALL dbt_get_info(t_3c_o(1, 1), blk_size_2=sizes_ao)
5970 CALL create_2c_tensor(t_greens_fct_occ, dist1, dist2, pgrid_2d, sizes_ao, sizes_ao, name="(AO|AO)")
5971
5972 DEALLOCATE (dist1, dist2)
5973 CALL create_2c_tensor(t_greens_fct_virt, dist1, dist2, pgrid_2d, sizes_ao, sizes_ao, name="(AO|AO)")
5974 DEALLOCATE (dist1, dist2)
5975
5976 CALL dbt_get_info(t_3c_m, nfull_total=dims_3c)
5977
5978 CALL dbt_create(t_3c_o(1, 1), t_3c_o_all, name="O (RI AO | AO)")
5979
5980 ! get full 3c tensor
5981 DO i_mem = 1, cut_memory
5982 CALL decompress_tensor(t_3c_o(1, 1), &
5983 t_3c_o_ind(1, 1, i_mem)%ind, &
5984 t_3c_o_compressed(1, 1, i_mem), &
5985 mp2_env%ri_rpa_im_time%eps_compress)
5986 CALL dbt_copy(t_3c_o(1, 1), t_3c_o_all, summation=.true., move_data=.true.)
5987 END DO
5988
5989 CALL dbt_create(t_3c_m, t_3c_m_w_tmp, name="M W (RI | AO AO)")
5990 CALL dbt_create(t_3c_o(1, 1), t_3c_o_w, name="M W (RI AO | AO)")
5991
5992 CALL dbt_create(mat_greens_fct_occ, t_ao_tmp, name="(AO|AO)")
5993
5994 IF (count_ev_sc_gw == 1 .AND. count_sc_gw0 == 1 .AND. do_ri_sigma_x) THEN
5995 num_points = num_integ_points + 1
5996 ELSE
5997 num_points = num_integ_points
5998 END IF
5999
6000 DO jquad = 1, num_points
6001
6002 t1 = m_walltime()
6003
6004 IF (jquad <= num_integ_points) THEN
6005 tau = tau_tj(jquad)
6006
6007 IF (unit_nr > 0) WRITE (unit_nr, '(/T3,A,1X,I3)') &
6008 'GW_INFO| Computing self-energy time point', jquad
6009 ELSE
6010 tau = 0.0_dp
6011
6012 IF (unit_nr > 0) WRITE (unit_nr, '(/T3,A,1X,I3)') &
6013 'GW_INFO| Computing exchange self-energy'
6014 END IF
6015
6016 IF (jquad <= num_integ_points) THEN
6017 CALL dbcsr_set(mat_w, 0.0_dp)
6018 CALL copy_fm_to_dbcsr(fm_mat_w(jquad), mat_w, keep_sparsity=.false.)
6019 CALL dbt_copy_matrix_to_tensor(mat_w, t_ri_tmp)
6020 ELSE
6021 CALL dbt_copy_matrix_to_tensor(mat_minvvminv%matrix, t_ri_tmp)
6022 END IF
6023
6024 CALL dbt_copy(t_ri_tmp, t_w)
6025
6026 DO ispin = 1, nspins
6027
6028 CALL compute_periodic_dm(mat_p_greens_fct_occ, qs_env, &
6029 ispin, num_points, jquad, e_fermi(ispin), tau, &
6030 remove_occ=.false., remove_virt=.true., &
6031 alloc_dm=(jquad == 1 .AND. ispin == 1))
6032
6033 CALL compute_periodic_dm(mat_p_greens_fct_virt, qs_env, &
6034 ispin, num_points, jquad, e_fermi(ispin), tau, &
6035 remove_occ=.true., remove_virt=.false., &
6036 alloc_dm=(jquad == 1 .AND. ispin == 1))
6037
6038 CALL dbcsr_set(mat_greens_fct_occ, 0.0_dp)
6039 CALL dbcsr_copy(mat_greens_fct_occ, mat_p_greens_fct_occ(jquad, 1)%matrix)
6040
6041 CALL dbcsr_set(mat_greens_fct_virt, 0.0_dp)
6042 CALL dbcsr_copy(mat_greens_fct_virt, mat_p_greens_fct_virt(jquad, 1)%matrix)
6043
6044 CALL dbt_copy_matrix_to_tensor(mat_greens_fct_occ, t_ao_tmp)
6045 CALL dbt_copy(t_ao_tmp, t_greens_fct_occ)
6046
6047 CALL dbt_copy_matrix_to_tensor(mat_greens_fct_virt, t_ao_tmp)
6048 CALL dbt_copy(t_ao_tmp, t_greens_fct_virt)
6049
6050 CALL dbcsr_set(mat_self_energy_ao_ao_neg_tau, 0.0_dp)
6051 CALL dbcsr_set(mat_self_energy_ao_ao_pos_tau, 0.0_dp)
6052
6053 CALL dbt_copy(t_3c_o_all, t_3c_m)
6054
6055 CALL dbt_batched_contract_init(t_3c_o_w)
6056 ! CALL dbt_batched_contract_init(t_3c_O_G)
6057 ! CALL dbt_batched_contract_init(t_self_energy)
6058
6059 DO i_mem = 1, cut_memory ! memory cut for RI index
6060
6061 ! CALL dbt_batched_contract_init(t_W)
6062 ! CALL dbt_batched_contract_init(t_3c_M)
6063 ! CALL dbt_batched_contract_init(t_3c_M_W_tmp)
6064
6065 bounds_ri_i(:, 1) = [qs_env%mp2_env%ri_rpa_im_time%starts_array_mc_RI(i_mem), &
6066 qs_env%mp2_env%ri_rpa_im_time%ends_array_mc_RI(i_mem)]
6067
6068 DO j_mem = 1, cut_memory ! memory cut for ao index
6069
6070 bounds_ao_ao_j(:, 1) = [starts_array_mc(j_mem), ends_array_mc(j_mem)]
6071 bounds_ao_ao_j(:, 2) = [1, dims_3c(3)]
6072
6073 CALL timeset("tensor_operation_3c_W", handle2)
6074
6075 CALL dbt_contract(1.0_dp, t_w, t_3c_m, 0.0_dp, &
6076 t_3c_m_w_tmp, &
6077 contract_1=[2], notcontract_1=[1], &
6078 contract_2=[1], notcontract_2=[2, 3], &
6079 map_1=[1], map_2=[2, 3], &
6080 bounds_2=bounds_ri_i, &
6081 bounds_3=bounds_ao_ao_j, &
6082 filter_eps=eps_filter, &
6083 unit_nr=unit_nr_prv)
6084
6085 CALL dbt_copy(t_3c_m_w_tmp, t_3c_o_w, order=[1, 2, 3], move_data=.true.)
6086
6087 CALL timestop(handle2)
6088
6089 CALL contract_to_self_energy(t_3c_o_all, t_greens_fct_occ, t_3c_o_w, &
6090 mat_self_energy_ao_ao_neg_tau, &
6091 bounds_ao_ao_j, bounds_ri_i, unit_nr_prv, &
6092 eps_filter, do_occ=.true., do_virt=.false.)
6093
6094 CALL contract_to_self_energy(t_3c_o_all, t_greens_fct_virt, t_3c_o_w, &
6095 mat_self_energy_ao_ao_pos_tau, &
6096 bounds_ao_ao_j, bounds_ri_i, unit_nr_prv, &
6097 eps_filter, do_occ=.false., do_virt=.true.)
6098
6099 END DO ! j_mem
6100
6101 ! CALL dbt_batched_contract_finalize(t_W)
6102 ! CALL dbt_batched_contract_finalize(t_3c_M)
6103 ! CALL dbt_batched_contract_finalize(t_3c_M_W_tmp)
6104
6105 END DO ! i_mem
6106
6107 CALL dbt_batched_contract_finalize(t_3c_o_w)
6108 ! CALL dbt_batched_contract_finalize(t_3c_O_G)
6109 ! CALL dbt_batched_contract_finalize(t_self_energy)
6110
6111 IF (jquad <= num_integ_points) THEN
6112
6113 CALL trafo_to_mo_and_kpoints(qs_env, mat_self_energy_ao_ao_neg_tau, vec_sigma_c_gw_neg_tau(:, jquad, :, ispin), &
6114 homo(ispin), gw_corr_lev_occ(ispin), gw_corr_lev_virt(ispin), ispin)
6115
6116 CALL trafo_to_mo_and_kpoints(qs_env, mat_self_energy_ao_ao_pos_tau, vec_sigma_c_gw_pos_tau(:, jquad, :, ispin), &
6117 homo(ispin), gw_corr_lev_occ(ispin), gw_corr_lev_virt(ispin), ispin)
6118
6119 vec_sigma_c_gw_cos_tau(:, jquad, :, ispin) = 0.5_dp*(vec_sigma_c_gw_pos_tau(:, jquad, :, ispin) + &
6120 vec_sigma_c_gw_neg_tau(:, jquad, :, ispin))
6121
6122 vec_sigma_c_gw_sin_tau(:, jquad, :, ispin) = 0.5_dp*(vec_sigma_c_gw_pos_tau(:, jquad, :, ispin) - &
6123 vec_sigma_c_gw_neg_tau(:, jquad, :, ispin))
6124 ELSE
6125
6126 CALL trafo_to_mo_and_kpoints(qs_env, mat_self_energy_ao_ao_neg_tau, &
6127 vec_sigma_x_gw(mo_start(ispin):mo_end(ispin), :, ispin), &
6128 homo(ispin), gw_corr_lev_occ(ispin), gw_corr_lev_virt(ispin), ispin)
6129
6130 END IF
6131
6132 END DO ! spins
6133
6134 t2 = m_walltime()
6135
6136 IF (unit_nr > 0) WRITE (unit_nr, '(T6,A,T56,F25.1)') 'Execution time (s):', t2 - t1
6137
6138 END DO ! jquad (tau)
6139
6140 IF (count_ev_sc_gw == 1 .AND. count_sc_gw0 == 1) THEN
6141
6142 CALL compute_minus_vxc_kpoints(qs_env)
6143
6144 IF (do_ri_sigma_x) THEN
6145 DO ispin = 1, nspins
6146 mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, ispin, :) = mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, ispin, :) + &
6147 vec_sigma_x_gw(:, :, ispin)
6148 END DO
6149 END IF
6150
6151 END IF
6152
6153 ! Fourier transform from time to frequency
6154 DO jquad = 1, num_fit_points
6155
6156 DO iquad = 1, num_integ_points
6157
6158 omega = tj(jquad)
6159 tau = tau_tj(iquad)
6160 weight_cos = weights_cos_tf_t_to_w(jquad, iquad)*cos(omega*tau)
6161 weight_sin = weights_sin_tf_t_to_w(jquad, iquad)*sin(omega*tau)
6162
6163 vec_sigma_c_gw_cos_omega(:, jquad, :, :) = vec_sigma_c_gw_cos_omega(:, jquad, :, :) + &
6164 weight_cos*vec_sigma_c_gw_cos_tau(:, iquad, :, :)
6165
6166 vec_sigma_c_gw_sin_omega(:, jquad, :, :) = vec_sigma_c_gw_sin_omega(:, jquad, :, :) + &
6167 weight_sin*vec_sigma_c_gw_sin_tau(:, iquad, :, :)
6168
6169 END DO
6170
6171 END DO
6172
6173 ! for occupied levels, we need the correlation self-energy for negative omega. Therefore, weight_sin
6174 ! should be computed with -omega, which results in an additional minus for vec_Sigma_c_gw_sin_omega:
6175 DO ispin = 1, nspins
6176 vec_sigma_c_gw_sin_omega(1:gw_corr_lev_occ(ispin), :, :, ispin) = &
6177 -vec_sigma_c_gw_sin_omega(1:gw_corr_lev_occ(ispin), :, :, ispin)
6178 END DO
6179
6180 vec_sigma_c_gw(:, 1:num_fit_points, :, :) = vec_sigma_c_gw_cos_omega(:, 1:num_fit_points, :, :) + &
6181 gaussi*vec_sigma_c_gw_sin_omega(:, 1:num_fit_points, :, :)
6182
6183 CALL dbt_pgrid_destroy(pgrid_2d)
6184
6185 CALL dbcsr_release(mat_greens_fct_occ)
6186 CALL dbcsr_release(mat_greens_fct_virt)
6187 CALL dbcsr_release(mat_self_energy_ao_ao_neg_tau)
6188 CALL dbcsr_release(mat_self_energy_ao_ao_pos_tau)
6189 CALL dbcsr_release(mat_mo_coeff)
6190
6191 CALL dbcsr_deallocate_matrix_set(mat_p_greens_fct_occ)
6192 CALL dbcsr_deallocate_matrix_set(mat_p_greens_fct_virt)
6193
6194 CALL dbt_destroy(t_w)
6195 CALL dbt_destroy(t_ri_tmp)
6196 CALL dbt_destroy(t_greens_fct_occ)
6197 CALL dbt_destroy(t_greens_fct_virt)
6198 CALL dbt_destroy(t_ao_tmp)
6199 CALL dbt_destroy(t_3c_o_all)
6200 CALL dbt_destroy(t_3c_m_w_tmp)
6201 CALL dbt_destroy(t_3c_o_w)
6202
6203 DEALLOCATE (vec_sigma_c_gw_pos_tau)
6204 DEALLOCATE (vec_sigma_c_gw_neg_tau)
6205 DEALLOCATE (vec_sigma_c_gw_cos_tau)
6206 DEALLOCATE (vec_sigma_c_gw_sin_tau)
6207 DEALLOCATE (vec_sigma_c_gw_cos_omega)
6208 DEALLOCATE (vec_sigma_c_gw_sin_omega)
6209
6210 CALL timestop(handle)
6211
6212 END SUBROUTINE compute_self_energy_cubic_gw_kpoints
6213
6214! **************************************************************************************************
6215!> \brief ...
6216!> \param qs_env ...
6217! **************************************************************************************************
6218 SUBROUTINE compute_minus_vxc_kpoints(qs_env)
6219 TYPE(qs_environment_type), POINTER :: qs_env
6220
6221 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_minus_vxc_kpoints'
6222
6223 INTEGER :: handle, ikp, ispin, nkp_self_energy, &
6224 nmo, nspins
6225 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: diag_sigma_x_minus_vxc_mo_mo
6226 TYPE(cp_cfm_type) :: cfm_mo_coeff, ks_mat_ao_ao, &
6227 ks_mat_no_xc_ao_ao, vxc_ao_ao, &
6228 vxc_ao_mo, vxc_mo_mo
6229 TYPE(cp_fm_struct_type), POINTER :: matrix_struct
6230 TYPE(cp_fm_type) :: fm_dummy, fm_sigma_x_minus_vxc_mo_mo, &
6231 fm_tmp_im, fm_tmp_re
6232 TYPE(dft_control_type), POINTER :: dft_control
6233 TYPE(kpoint_type), POINTER :: kpoints_sigma, kpoints_sigma_no_xc
6234 TYPE(mp_para_env_type), POINTER :: para_env
6235
6236 CALL timeset(routinen, handle)
6237
6238 CALL get_qs_env(qs_env, para_env=para_env, dft_control=dft_control)
6239
6240 kpoints_sigma => qs_env%mp2_env%ri_rpa_im_time%kpoints_Sigma
6241
6242 kpoints_sigma_no_xc => qs_env%mp2_env%ri_rpa_im_time%kpoints_Sigma_no_xc
6243
6244 nkp_self_energy = kpoints_sigma%nkp
6245
6246 nspins = dft_control%nspins
6247
6248 matrix_struct => kpoints_sigma%kp_env(1)%kpoint_env%wmat(1, 1)%matrix_struct
6249
6250 CALL cp_cfm_create(ks_mat_ao_ao, matrix_struct)
6251 CALL cp_cfm_create(ks_mat_no_xc_ao_ao, matrix_struct)
6252 CALL cp_cfm_create(vxc_ao_ao, matrix_struct)
6253 CALL cp_cfm_create(vxc_ao_mo, matrix_struct)
6254 CALL cp_cfm_create(vxc_mo_mo, matrix_struct)
6255 CALL cp_cfm_create(cfm_mo_coeff, matrix_struct)
6256 CALL cp_fm_create(fm_sigma_x_minus_vxc_mo_mo, matrix_struct)
6257 CALL cp_fm_create(fm_tmp_re, matrix_struct)
6258 CALL cp_fm_create(fm_tmp_im, matrix_struct)
6259
6260 CALL cp_cfm_get_info(cfm_mo_coeff, nrow_global=nmo)
6261 ALLOCATE (diag_sigma_x_minus_vxc_mo_mo(nmo))
6262
6263 DEALLOCATE (qs_env%mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw)
6264
6265 ALLOCATE (qs_env%mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(nmo, 2, nkp_self_energy))
6266
6267 DO ikp = 1, nkp_self_energy
6268
6269 DO ispin = 1, nspins
6270
6271 associate(mos => kpoints_sigma%kp_env(ikp)%kpoint_env%mos)
6272 IF (ASSOCIATED(mos(1, ispin)%mo_coeff)) THEN
6273 CALL cp_fm_copy_general(mos(1, ispin)%mo_coeff, fm_tmp_re, para_env)
6274 ELSE
6275 CALL cp_fm_copy_general(fm_dummy, fm_tmp_re, para_env)
6276 END IF
6277 IF (ASSOCIATED(mos(2, ispin)%mo_coeff)) THEN
6278 CALL cp_fm_copy_general(mos(2, ispin)%mo_coeff, fm_tmp_im, para_env)
6279 ELSE
6280 CALL cp_fm_copy_general(fm_dummy, fm_tmp_im, para_env)
6281 END IF
6282 END associate
6283
6284 CALL cp_fm_to_cfm(fm_tmp_re, fm_tmp_im, cfm_mo_coeff)
6285
6286 CALL cp_fm_to_cfm(kpoints_sigma%kp_env(ikp)%kpoint_env%wmat(1, ispin), &
6287 kpoints_sigma%kp_env(ikp)%kpoint_env%wmat(2, ispin), ks_mat_ao_ao)
6288 associate(wmat => kpoints_sigma_no_xc%kp_env(ikp)%kpoint_env%wmat)
6289 IF (ASSOCIATED(wmat(1, ispin)%matrix_struct)) THEN
6290 CALL cp_fm_copy_general(wmat(1, ispin), fm_tmp_re, para_env)
6291 ELSE
6292 CALL cp_fm_copy_general(fm_dummy, fm_tmp_re, para_env)
6293 END IF
6294 IF (ASSOCIATED(wmat(2, ispin)%matrix_struct)) THEN
6295 CALL cp_fm_copy_general(wmat(2, ispin), fm_tmp_im, para_env)
6296 ELSE
6297 CALL cp_fm_copy_general(fm_dummy, fm_tmp_im, para_env)
6298 END IF
6299 END associate
6300
6301 CALL cp_fm_to_cfm(fm_tmp_re, fm_tmp_im, vxc_ao_ao)
6302
6303 CALL parallel_gemm('N', 'N', nmo, nmo, nmo, z_one, vxc_ao_ao, cfm_mo_coeff, z_zero, vxc_ao_mo)
6304 CALL parallel_gemm('C', 'N', nmo, nmo, nmo, z_one, cfm_mo_coeff, vxc_ao_mo, z_zero, vxc_mo_mo)
6305
6306 CALL cp_cfm_to_fm(vxc_mo_mo, fm_sigma_x_minus_vxc_mo_mo)
6307
6308 CALL cp_fm_get_diag(fm_sigma_x_minus_vxc_mo_mo, diag_sigma_x_minus_vxc_mo_mo)
6309
6310 qs_env%mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, ispin, ikp) = diag_sigma_x_minus_vxc_mo_mo(:)
6311
6312 END DO
6313
6314 END DO
6315
6316 CALL cp_cfm_release(ks_mat_ao_ao)
6317 CALL cp_cfm_release(ks_mat_no_xc_ao_ao)
6318 CALL cp_cfm_release(vxc_ao_ao)
6319 CALL cp_cfm_release(vxc_ao_mo)
6320 CALL cp_cfm_release(vxc_mo_mo)
6321 CALL cp_cfm_release(cfm_mo_coeff)
6322 CALL cp_fm_release(fm_sigma_x_minus_vxc_mo_mo)
6323 CALL cp_fm_release(fm_tmp_re)
6324 CALL cp_fm_release(fm_tmp_im)
6325
6326 DEALLOCATE (diag_sigma_x_minus_vxc_mo_mo)
6327
6328 CALL timestop(handle)
6329
6330 END SUBROUTINE compute_minus_vxc_kpoints
6331
6332! **************************************************************************************************
6333!> \brief ...
6334!> \param qs_env ...
6335!> \param mat_self_energy_ao_ao ...
6336!> \param vec_Sigma ...
6337!> \param homo ...
6338!> \param gw_corr_lev_occ ...
6339!> \param gw_corr_lev_virt ...
6340!> \param ispin ...
6341! **************************************************************************************************
6342 SUBROUTINE trafo_to_mo_and_kpoints(qs_env, mat_self_energy_ao_ao, vec_Sigma, &
6343 homo, gw_corr_lev_occ, gw_corr_lev_virt, ispin)
6344 TYPE(qs_environment_type), POINTER :: qs_env
6345 TYPE(dbcsr_type), TARGET :: mat_self_energy_ao_ao
6346 REAL(kind=dp), DIMENSION(:, :) :: vec_sigma
6347 INTEGER :: homo, gw_corr_lev_occ, gw_corr_lev_virt, &
6348 ispin
6349
6350 CHARACTER(LEN=*), PARAMETER :: routinen = 'trafo_to_mo_and_kpoints'
6351
6352 INTEGER :: handle, ikp, nkp_self_energy, nmo, &
6353 periodic(3), size_real_space
6354 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: diag_self_energy
6355 TYPE(cell_type), POINTER :: cell
6356 TYPE(cp_cfm_type) :: cfm_mo_coeff, cfm_self_energy_ao_ao, &
6357 cfm_self_energy_ao_mo, &
6358 cfm_self_energy_mo_mo
6359 TYPE(cp_fm_struct_type), POINTER :: matrix_struct
6360 TYPE(cp_fm_type) :: fm_self_energy_mo_mo
6361 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mat_self_energy_ao_ao_kp_im, &
6362 mat_self_energy_ao_ao_kp_re, mat_self_energy_ao_ao_real_space
6363 TYPE(kpoint_type), POINTER :: kpoints_sigma
6364 TYPE(mp_para_env_type), POINTER :: para_env
6365
6366 CALL timeset(routinen, handle)
6367
6368 CALL get_qs_env(qs_env, cell=cell, para_env=para_env)
6369 CALL get_cell(cell=cell, periodic=periodic)
6370
6371 size_real_space = 3**(periodic(1) + periodic(2) + periodic(3))
6372
6373 CALL alloc_mat_set(mat_self_energy_ao_ao_real_space, size_real_space, mat_self_energy_ao_ao)
6374
6375 CALL dbcsr_copy(mat_self_energy_ao_ao_real_space(1)%matrix, mat_self_energy_ao_ao)
6376
6377 kpoints_sigma => qs_env%mp2_env%ri_rpa_im_time%kpoints_Sigma
6378
6379 CALL get_mat_cell_t_from_mat_gamma(mat_self_energy_ao_ao_real_space, qs_env, kpoints_sigma, 0, 0)
6380
6381 nkp_self_energy = kpoints_sigma%nkp
6382
6383 CALL alloc_mat_set(mat_self_energy_ao_ao_kp_re, nkp_self_energy, mat_self_energy_ao_ao)
6384 CALL alloc_mat_set(mat_self_energy_ao_ao_kp_im, nkp_self_energy, mat_self_energy_ao_ao)
6385
6386 CALL real_space_to_kpoint_transform_rpa(mat_self_energy_ao_ao_kp_re, mat_self_energy_ao_ao_kp_im, &
6387 mat_self_energy_ao_ao_real_space, kpoints_sigma, 1.0e-50_dp)
6388
6389 CALL dbcsr_get_info(mat_self_energy_ao_ao, nfullrows_total=nmo)
6390 ALLOCATE (diag_self_energy(nmo))
6391
6392 matrix_struct => kpoints_sigma%kp_env(1)%kpoint_env%mos(1, 1)%mo_coeff%matrix_struct
6393
6394 CALL cp_cfm_create(cfm_self_energy_ao_ao, matrix_struct)
6395 CALL cp_cfm_create(cfm_self_energy_ao_mo, matrix_struct)
6396 CALL cp_cfm_create(cfm_self_energy_mo_mo, matrix_struct)
6397 CALL cp_cfm_set_all(cfm_self_energy_ao_ao, z_zero)
6398 CALL cp_cfm_set_all(cfm_self_energy_ao_mo, z_zero)
6399 CALL cp_cfm_set_all(cfm_self_energy_mo_mo, z_zero)
6400
6401 CALL cp_fm_create(fm_self_energy_mo_mo, matrix_struct)
6402 CALL cp_cfm_create(cfm_mo_coeff, matrix_struct)
6403
6404 DO ikp = 1, nkp_self_energy
6405
6406 CALL dbcsr_to_cfm(mat_self_energy_ao_ao_kp_re(ikp)%matrix, &
6407 mat_self_energy_ao_ao_kp_im(ikp)%matrix, cfm_self_energy_ao_ao)
6408
6409 CALL cp_fm_to_cfm(kpoints_sigma%kp_env(ikp)%kpoint_env%mos(1, ispin)%mo_coeff, &
6410 kpoints_sigma%kp_env(ikp)%kpoint_env%mos(2, ispin)%mo_coeff, cfm_mo_coeff)
6411
6412 CALL parallel_gemm('N', 'N', nmo, nmo, nmo, z_one, cfm_self_energy_ao_ao, cfm_mo_coeff, &
6413 z_zero, cfm_self_energy_ao_mo)
6414
6415 CALL parallel_gemm('C', 'N', nmo, nmo, nmo, z_one, cfm_mo_coeff, cfm_self_energy_ao_mo, &
6416 z_zero, cfm_self_energy_mo_mo)
6417
6418 CALL cp_cfm_to_fm(cfm_self_energy_mo_mo, fm_self_energy_mo_mo)
6419
6420 CALL cp_fm_get_diag(fm_self_energy_mo_mo, diag_self_energy)
6421
6422 vec_sigma(:, ikp) = diag_self_energy(homo - gw_corr_lev_occ + 1:homo + gw_corr_lev_virt)
6423
6424 END DO
6425
6426 CALL dbcsr_deallocate_matrix_set(mat_self_energy_ao_ao_real_space)
6427 CALL dbcsr_deallocate_matrix_set(mat_self_energy_ao_ao_kp_re)
6428 CALL dbcsr_deallocate_matrix_set(mat_self_energy_ao_ao_kp_im)
6429
6430 CALL cp_cfm_release(cfm_self_energy_ao_ao)
6431 CALL cp_cfm_release(cfm_self_energy_ao_mo)
6432 CALL cp_cfm_release(cfm_self_energy_mo_mo)
6433 CALL cp_cfm_release(cfm_mo_coeff)
6434 CALL cp_fm_release(fm_self_energy_mo_mo)
6435
6436 DEALLOCATE (diag_self_energy)
6437
6438 CALL timestop(handle)
6439
6440 END SUBROUTINE trafo_to_mo_and_kpoints
6441
6442! **************************************************************************************************
6443!> \brief ...
6444!> \param dbcsr_re ...
6445!> \param dbcsr_im ...
6446!> \param cfm_mat ...
6447! **************************************************************************************************
6448 SUBROUTINE dbcsr_to_cfm(dbcsr_re, dbcsr_im, cfm_mat)
6449
6450 TYPE(dbcsr_type), POINTER :: dbcsr_re, dbcsr_im
6451 TYPE(cp_cfm_type), INTENT(IN) :: cfm_mat
6452
6453 CHARACTER(LEN=*), PARAMETER :: routinen = 'dbcsr_to_cfm'
6454
6455 INTEGER :: handle
6456 TYPE(cp_fm_type) :: fm_mat_im, fm_mat_re
6457
6458 CALL timeset(routinen, handle)
6459
6460 CALL cp_fm_create(fm_mat_re, cfm_mat%matrix_struct)
6461 CALL cp_fm_create(fm_mat_im, cfm_mat%matrix_struct)
6462 CALL cp_fm_set_all(fm_mat_re, 0.0_dp)
6463 CALL cp_fm_set_all(fm_mat_im, 0.0_dp)
6464
6465 CALL copy_dbcsr_to_fm(dbcsr_re, fm_mat_re)
6466 CALL copy_dbcsr_to_fm(dbcsr_im, fm_mat_im)
6467
6468 CALL cp_fm_to_cfm(fm_mat_re, fm_mat_im, cfm_mat)
6469
6470 CALL cp_fm_release(fm_mat_re)
6471 CALL cp_fm_release(fm_mat_im)
6472
6473 CALL timestop(handle)
6474
6475 END SUBROUTINE dbcsr_to_cfm
6476
6477! **************************************************************************************************
6478!> \brief ...
6479!> \param mat_set ...
6480!> \param mat_size ...
6481!> \param template ...
6482!> \param explicitly_no_symmetry ...
6483! **************************************************************************************************
6484 SUBROUTINE alloc_mat_set(mat_set, mat_size, template, explicitly_no_symmetry)
6485 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mat_set
6486 INTEGER, INTENT(IN) :: mat_size
6487 TYPE(dbcsr_type), TARGET :: template
6488 LOGICAL, OPTIONAL :: explicitly_no_symmetry
6489
6490 CHARACTER(LEN=*), PARAMETER :: routinen = 'alloc_mat_set'
6491
6492 INTEGER :: handle, i_size
6493 LOGICAL :: my_explicitly_no_symmetry
6494
6495 CALL timeset(routinen, handle)
6496
6497 my_explicitly_no_symmetry = .false.
6498 IF (PRESENT(explicitly_no_symmetry)) my_explicitly_no_symmetry = explicitly_no_symmetry
6499
6500 NULLIFY (mat_set)
6501 CALL dbcsr_allocate_matrix_set(mat_set, mat_size)
6502 DO i_size = 1, mat_size
6503 ALLOCATE (mat_set(i_size)%matrix)
6504 IF (my_explicitly_no_symmetry) THEN
6505 CALL dbcsr_create(matrix=mat_set(i_size)%matrix, template=template, &
6506 matrix_type=dbcsr_type_no_symmetry)
6507 ELSE
6508 CALL dbcsr_create(matrix=mat_set(i_size)%matrix, template=template)
6509 END IF
6510 CALL dbcsr_copy(mat_set(i_size)%matrix, template)
6511 CALL dbcsr_set(mat_set(i_size)%matrix, 0.0_dp)
6512 END DO
6513
6514 CALL timestop(handle)
6515
6516 END SUBROUTINE alloc_mat_set
6517
6518! **************************************************************************************************
6519!> \brief ...
6520!> \param mat_set ...
6521!> \param mat_size_1 ...
6522!> \param mat_size_2 ...
6523!> \param template ...
6524!> \param explicitly_no_symmetry ...
6525! **************************************************************************************************
6526 SUBROUTINE alloc_mat_set_2d(mat_set, mat_size_1, mat_size_2, template, explicitly_no_symmetry)
6527 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: mat_set
6528 INTEGER, INTENT(IN) :: mat_size_1, mat_size_2
6529 TYPE(dbcsr_type), TARGET :: template
6530 LOGICAL, OPTIONAL :: explicitly_no_symmetry
6531
6532 CHARACTER(LEN=*), PARAMETER :: routinen = 'alloc_mat_set_2d'
6533
6534 INTEGER :: handle, i_size, j_size
6535 LOGICAL :: my_explicitly_no_symmetry
6536
6537 CALL timeset(routinen, handle)
6538
6539 my_explicitly_no_symmetry = .false.
6540 IF (PRESENT(explicitly_no_symmetry)) my_explicitly_no_symmetry = explicitly_no_symmetry
6541
6542 NULLIFY (mat_set)
6543 CALL dbcsr_allocate_matrix_set(mat_set, mat_size_1, mat_size_2)
6544 DO i_size = 1, mat_size_1
6545 DO j_size = 1, mat_size_2
6546 ALLOCATE (mat_set(i_size, j_size)%matrix)
6547 IF (my_explicitly_no_symmetry) THEN
6548 CALL dbcsr_create(matrix=mat_set(i_size, j_size)%matrix, template=template, &
6549 matrix_type=dbcsr_type_no_symmetry)
6550 ELSE
6551 CALL dbcsr_create(matrix=mat_set(i_size, j_size)%matrix, template=template)
6552 END IF
6553 CALL dbcsr_copy(mat_set(i_size, j_size)%matrix, template)
6554 CALL dbcsr_set(mat_set(i_size, j_size)%matrix, 0.0_dp)
6555 END DO
6556 END DO
6557
6558 CALL timestop(handle)
6559
6560 END SUBROUTINE alloc_mat_set_2d
6561
6562! **************************************************************************************************
6563!> \brief ...
6564!> \param t_3c_O_all ...
6565!> \param t_greens_fct ...
6566!> \param t_3c_O_W ...
6567!> \param mat_self_energy_ao_ao ...
6568!> \param bounds_ao_ao_j ...
6569!> \param bounds_RI_i ...
6570!> \param unit_nr ...
6571!> \param eps_filter ...
6572!> \param do_occ ...
6573!> \param do_virt ...
6574! **************************************************************************************************
6575 SUBROUTINE contract_to_self_energy(t_3c_O_all, t_greens_fct, t_3c_O_W, &
6576 mat_self_energy_ao_ao, bounds_ao_ao_j, bounds_RI_i, &
6577 unit_nr, eps_filter, do_occ, do_virt)
6578
6579 TYPE(dbt_type) :: t_3c_o_all, t_greens_fct, t_3c_o_w
6580 TYPE(dbcsr_type), TARGET :: mat_self_energy_ao_ao
6581 INTEGER, DIMENSION(2, 2) :: bounds_ao_ao_j
6582 INTEGER, DIMENSION(2, 1) :: bounds_ri_i
6583 INTEGER :: unit_nr
6584 REAL(kind=dp) :: eps_filter
6585 LOGICAL :: do_occ, do_virt
6586
6587 CHARACTER(LEN=*), PARAMETER :: routinen = 'contract_to_self_energy'
6588
6589 INTEGER :: handle
6590 INTEGER, DIMENSION(2, 1) :: bounds_ao_j
6591 INTEGER, DIMENSION(2, 2) :: bounds_ao_all_ri_i, bounds_ri_i_ao_j
6592 REAL(kind=dp) :: sign_self_energy
6593 TYPE(dbt_type) :: t_3c_o_g, t_3c_o_g_tmp, t_self_energy, &
6594 t_self_energy_tmp
6595
6596 CALL timeset(routinen, handle)
6597
6598 cpassert(do_occ .EQV. (.NOT. do_virt))
6599
6600 CALL dbt_create(t_3c_o_all, t_3c_o_g, name="M occ (RI AO | AO)")
6601 CALL dbt_create(t_3c_o_all, t_3c_o_g_tmp, name="M occ (RI AO | AO)")
6602 CALL dbt_create(t_greens_fct, t_self_energy, name="(AO|AO)")
6603 CALL dbt_create(mat_self_energy_ao_ao, t_self_energy_tmp)
6604
6605 bounds_ao_j(:, 1) = bounds_ao_ao_j(:, 1)
6606 bounds_ao_all_ri_i(:, 1) = bounds_ri_i(:, 1)
6607 bounds_ao_all_ri_i(:, 2) = bounds_ao_ao_j(:, 2)
6608
6609 CALL dbt_contract(1.0_dp, t_greens_fct, t_3c_o_all, 0.0_dp, &
6610 t_3c_o_g_tmp, &
6611 contract_1=[2], notcontract_1=[1], &
6612 contract_2=[3], notcontract_2=[1, 2], &
6613 map_1=[3], map_2=[1, 2], &
6614 bounds_2=bounds_ao_j, &
6615 bounds_3=bounds_ao_all_ri_i, &
6616 filter_eps=eps_filter, &
6617 unit_nr=unit_nr)
6618
6619 CALL dbt_copy(t_3c_o_g_tmp, t_3c_o_g, order=[1, 3, 2], move_data=.true.)
6620
6621 IF (do_occ) sign_self_energy = -1.0_dp
6622 IF (do_virt) sign_self_energy = 1.0_dp
6623
6624 bounds_ri_i_ao_j(:, 1) = bounds_ri_i(:, 1)
6625 bounds_ri_i_ao_j(:, 2) = bounds_ao_ao_j(:, 1)
6626
6627 CALL dbt_contract(sign_self_energy, t_3c_o_w, t_3c_o_g, 0.0_dp, &
6628 t_self_energy, &
6629 contract_1=[1, 2], notcontract_1=[3], &
6630 contract_2=[1, 2], notcontract_2=[3], &
6631 map_1=[1], map_2=[2], &
6632 bounds_1=bounds_ri_i_ao_j, &
6633 filter_eps=eps_filter, &
6634 unit_nr=unit_nr)
6635
6636 CALL dbt_copy(t_self_energy, t_self_energy_tmp)
6637 CALL dbt_clear(t_self_energy)
6638
6639 CALL dbt_copy_tensor_to_matrix(t_self_energy_tmp, mat_self_energy_ao_ao, summation=.true.)
6640
6641 CALL dbt_destroy(t_3c_o_g)
6642 CALL dbt_destroy(t_3c_o_g_tmp)
6643 CALL dbt_destroy(t_self_energy)
6644 CALL dbt_destroy(t_self_energy_tmp)
6645
6646 CALL timestop(handle)
6647
6648 END SUBROUTINE contract_to_self_energy
6649
6650! **************************************************************************************************
6651!> \brief ...
6652!> \param t_3c_overl_int_gw_AO ...
6653!> \param t_3c_overl_int_gw_RI ...
6654!> \param t_AO ...
6655!> \param t_RI ...
6656!> \param prefac ...
6657!> \param mo_bounds ...
6658!> \param unit_nr ...
6659!> \param t_3c_ctr_RI ...
6660!> \param t_3c_ctr_AO ...
6661!> \param calculate_ctr_RI ...
6662! **************************************************************************************************
6663 SUBROUTINE contract_cubic_gw(t_3c_overl_int_gw_AO, t_3c_overl_int_gw_RI, &
6664 t_AO, t_RI, prefac, &
6665 mo_bounds, unit_nr, &
6666 t_3c_ctr_RI, t_3c_ctr_AO, calculate_ctr_RI)
6667 TYPE(dbt_type), INTENT(INOUT) :: t_3c_overl_int_gw_ao, &
6668 t_3c_overl_int_gw_ri, t_ao, t_ri
6669 REAL(dp), DIMENSION(2), INTENT(IN) :: prefac
6670 INTEGER, DIMENSION(2), INTENT(IN) :: mo_bounds
6671 INTEGER, INTENT(IN) :: unit_nr
6672 TYPE(dbt_type), INTENT(INOUT) :: t_3c_ctr_ri, t_3c_ctr_ao
6673 LOGICAL, INTENT(IN) :: calculate_ctr_ri
6674
6675 CHARACTER(LEN=*), PARAMETER :: routinen = 'contract_cubic_gw'
6676
6677 INTEGER :: handle
6678 INTEGER, DIMENSION(2, 2) :: ctr_bounds_mo
6679 INTEGER, DIMENSION(3) :: bounds_3c
6680
6681 CALL timeset(routinen, handle)
6682
6683 IF (calculate_ctr_ri) THEN
6684 CALL dbt_get_info(t_3c_overl_int_gw_ri, nfull_total=bounds_3c)
6685 ctr_bounds_mo(:, 1) = [1, bounds_3c(2)]
6686 ctr_bounds_mo(:, 2) = mo_bounds
6687
6688 CALL dbt_contract(prefac(1), t_ri, t_3c_overl_int_gw_ri, 0.0_dp, &
6689 t_3c_ctr_ri, &
6690 contract_1=[2], notcontract_1=[1], &
6691 contract_2=[1], notcontract_2=[2, 3], &
6692 map_1=[1], map_2=[2, 3], &
6693 bounds_3=ctr_bounds_mo, &
6694 unit_nr=unit_nr)
6695
6696 END IF
6697
6698 CALL dbt_get_info(t_3c_overl_int_gw_ao, nfull_total=bounds_3c)
6699 ctr_bounds_mo(:, 1) = [1, bounds_3c(2)]
6700 ctr_bounds_mo(:, 2) = mo_bounds
6701
6702 CALL dbt_contract(prefac(2), t_ao, t_3c_overl_int_gw_ao, 0.0_dp, &
6703 t_3c_ctr_ao, &
6704 contract_1=[2], notcontract_1=[1], &
6705 contract_2=[1], notcontract_2=[2, 3], &
6706 map_1=[1], map_2=[2, 3], &
6707 bounds_3=ctr_bounds_mo, &
6708 unit_nr=unit_nr)
6709
6710 CALL timestop(handle)
6711
6712 END SUBROUTINE contract_cubic_gw
6713
6714! **************************************************************************************************
6715!> \brief ...
6716!> \param t3c_1 ...
6717!> \param t3c_2 ...
6718!> \param vec_sigma ...
6719!> \param mo_offset ...
6720!> \param mo_bounds ...
6721!> \param para_env ...
6722! **************************************************************************************************
6723 SUBROUTINE trace_sigma_gw(t3c_1, t3c_2, vec_sigma, mo_offset, mo_bounds, para_env)
6724 TYPE(dbt_type), INTENT(INOUT) :: t3c_1, t3c_2
6725 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: vec_sigma
6726 INTEGER, INTENT(IN) :: mo_offset
6727 INTEGER, DIMENSION(2), INTENT(IN) :: mo_bounds
6728 TYPE(mp_para_env_type), INTENT(IN) :: para_env
6729
6730 CHARACTER(LEN=*), PARAMETER :: routinen = 'trace_sigma_gw'
6731
6732 INTEGER :: handle, n, n_end, n_end_block, n_start, &
6733 n_start_block
6734 INTEGER, DIMENSION(1) :: trace_shape
6735 INTEGER, DIMENSION(2) :: mo_bounds_off
6736 INTEGER, DIMENSION(3) :: boff, bsize, ind
6737 LOGICAL :: found
6738 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: block_1, block_2
6739 REAL(kind=dp), &
6740 DIMENSION(mo_bounds(2)-mo_bounds(1)+1) :: vec_sigma_prv
6741 TYPE(dbt_iterator_type) :: iter
6742 TYPE(dbt_type) :: t3c_1_redist
6743
6744 CALL timeset(routinen, handle)
6745
6746 CALL dbt_create(t3c_2, t3c_1_redist)
6747 CALL dbt_copy(t3c_1, t3c_1_redist, order=[2, 1, 3], move_data=.true.)
6748
6749 vec_sigma_prv = 0.0_dp
6750
6751!$OMP PARALLEL DEFAULT(NONE) REDUCTION(+:vec_Sigma_prv) &
6752!$OMP SHARED(t3c_1_redist,t3c_2,mo_bounds) &
6753!$OMP PRIVATE(iter,ind,bsize,boff,block_1,block_2,found) &
6754!$OMP PRIVATE(n_start_block,n_start,n_end_block,n_end,trace_shape)
6755 CALL dbt_iterator_start(iter, t3c_1_redist)
6756 DO WHILE (dbt_iterator_blocks_left(iter))
6757 CALL dbt_iterator_next_block(iter, ind, blk_size=bsize, blk_offset=boff)
6758 CALL dbt_get_block(t3c_1_redist, ind, block_1, found)
6759 cpassert(found)
6760 CALL dbt_get_block(t3c_2, ind, block_2, found)
6761 IF (.NOT. found) cycle
6762
6763 IF (boff(3) < mo_bounds(1)) THEN
6764 n_start_block = mo_bounds(1) - boff(3) + 1
6765 n_start = 1
6766 ELSE
6767 n_start_block = 1
6768 n_start = boff(3) - mo_bounds(1) + 1
6769 END IF
6770
6771 IF (boff(3) + bsize(3) - 1 > mo_bounds(2)) THEN
6772 n_end_block = mo_bounds(2) - boff(3) + 1
6773 n_end = mo_bounds(2) - mo_bounds(1) + 1
6774 ELSE
6775 n_end_block = bsize(3)
6776 n_end = boff(3) + bsize(3) - mo_bounds(1)
6777 END IF
6778
6779 trace_shape(1) = SIZE(block_1, 1)*SIZE(block_1, 2)
6780 vec_sigma_prv(n_start:n_end) = &
6781 vec_sigma_prv(n_start:n_end) + &
6782 [(dot_product(reshape(block_1(:, :, n), trace_shape), &
6783 reshape(block_2(:, :, n), trace_shape)), &
6784 n=n_start_block, n_end_block)]
6785 DEALLOCATE (block_1, block_2)
6786 END DO
6787 CALL dbt_iterator_stop(iter)
6788!$OMP END PARALLEL
6789
6790 CALL dbt_destroy(t3c_1_redist)
6791
6792 CALL para_env%sum(vec_sigma_prv)
6793
6794 mo_bounds_off = mo_bounds - mo_offset + 1
6795 vec_sigma(mo_bounds_off(1):mo_bounds_off(2)) = &
6796 vec_sigma(mo_bounds_off(1):mo_bounds_off(2)) + vec_sigma_prv
6797
6798 CALL timestop(handle)
6799 END SUBROUTINE trace_sigma_gw
6800
6801! **************************************************************************************************
6802!> \brief ...
6803!> \param mat_greens_fct_occ ...
6804!> \param mat_greens_fct_virt ...
6805!> \param fm_mo_coeff_occ ...
6806!> \param fm_mo_coeff_virt ...
6807!> \param fm_mo_coeff_occ_scaled ...
6808!> \param fm_mo_coeff_virt_scaled ...
6809!> \param fm_scaled_dm_occ_tau ...
6810!> \param fm_scaled_dm_virt_tau ...
6811!> \param Eigenval ...
6812!> \param nmo ...
6813!> \param eps_filter ...
6814!> \param e_fermi ...
6815!> \param tau ...
6816!> \param para_env ...
6817! **************************************************************************************************
6818 SUBROUTINE compute_greens_function_time(mat_greens_fct_occ, mat_greens_fct_virt, fm_mo_coeff_occ, fm_mo_coeff_virt, &
6819 fm_mo_coeff_occ_scaled, fm_mo_coeff_virt_scaled, &
6820 fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau, Eigenval, nmo, &
6821 eps_filter, e_fermi, tau, para_env)
6822
6823 TYPE(dbcsr_type), INTENT(INOUT) :: mat_greens_fct_occ, mat_greens_fct_virt
6824 TYPE(cp_fm_type), INTENT(IN) :: fm_mo_coeff_occ, fm_mo_coeff_virt, fm_mo_coeff_occ_scaled, &
6825 fm_mo_coeff_virt_scaled, fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau
6826 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: eigenval
6827 INTEGER, INTENT(IN) :: nmo
6828 REAL(kind=dp), INTENT(IN) :: eps_filter, e_fermi, tau
6829 TYPE(mp_para_env_type), INTENT(IN) :: para_env
6830
6831 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_Greens_function_time'
6832
6833 INTEGER :: handle, i_global, iib, jjb, ncol_local, &
6834 nrow_local
6835 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
6836 REAL(kind=dp) :: stabilize_exp
6837
6838 CALL timeset(routinen, handle)
6839
6840 CALL para_env%sync()
6841
6842 ! get info of fm_mo_coeff_occ
6843 CALL cp_fm_get_info(matrix=fm_mo_coeff_occ, &
6844 nrow_local=nrow_local, &
6845 ncol_local=ncol_local, &
6846 row_indices=row_indices, &
6847 col_indices=col_indices)
6848
6849 ! Multiply the occupied and the virtual MO coefficients with the factor exp((-e_i-e_F)*tau/2).
6850 ! Then, we simply get the sum over all occ states and virt. states by a simple matrix-matrix
6851 ! multiplication.
6852
6853 stabilize_exp = 70.0_dp
6854
6855 ! first, the occ
6856 DO jjb = 1, nrow_local
6857 DO iib = 1, ncol_local
6858 i_global = col_indices(iib)
6859
6860 IF (abs(tau*0.5_dp*(eigenval(i_global) - e_fermi)) < stabilize_exp) THEN
6861 fm_mo_coeff_occ_scaled%local_data(jjb, iib) = &
6862 fm_mo_coeff_occ%local_data(jjb, iib)*exp(tau*0.5_dp*(eigenval(i_global) - e_fermi))
6863 ELSE
6864 fm_mo_coeff_occ_scaled%local_data(jjb, iib) = 0.0_dp
6865 END IF
6866
6867 END DO
6868 END DO
6869
6870 ! the same for virt
6871 DO jjb = 1, nrow_local
6872 DO iib = 1, ncol_local
6873 i_global = col_indices(iib)
6874
6875 IF (abs(tau*0.5_dp*(eigenval(i_global) - e_fermi)) < stabilize_exp) THEN
6876 fm_mo_coeff_virt_scaled%local_data(jjb, iib) = &
6877 fm_mo_coeff_virt%local_data(jjb, iib)*exp(-tau*0.5_dp*(eigenval(i_global) - e_fermi))
6878 ELSE
6879 fm_mo_coeff_virt_scaled%local_data(jjb, iib) = 0.0_dp
6880 END IF
6881
6882 END DO
6883 END DO
6884
6885 CALL para_env%sync()
6886
6887 CALL parallel_gemm(transa="N", transb="T", m=nmo, n=nmo, k=nmo, alpha=1.0_dp, &
6888 matrix_a=fm_mo_coeff_occ_scaled, matrix_b=fm_mo_coeff_occ_scaled, beta=0.0_dp, &
6889 matrix_c=fm_scaled_dm_occ_tau)
6890
6891 CALL parallel_gemm(transa="N", transb="T", m=nmo, n=nmo, k=nmo, alpha=1.0_dp, &
6892 matrix_a=fm_mo_coeff_virt_scaled, matrix_b=fm_mo_coeff_virt_scaled, beta=0.0_dp, &
6893 matrix_c=fm_scaled_dm_virt_tau)
6894
6895 CALL dbcsr_set(mat_greens_fct_occ, 0.0_dp)
6896
6897 CALL copy_fm_to_dbcsr(fm_scaled_dm_occ_tau, &
6898 mat_greens_fct_occ, &
6899 keep_sparsity=.false.)
6900
6901 CALL dbcsr_filter(mat_greens_fct_occ, eps_filter)
6902
6903 CALL dbcsr_set(mat_greens_fct_virt, 0.0_dp)
6904
6905 CALL copy_fm_to_dbcsr(fm_scaled_dm_virt_tau, &
6906 mat_greens_fct_virt, &
6907 keep_sparsity=.false.)
6908
6909 CALL dbcsr_filter(mat_greens_fct_virt, eps_filter)
6910
6911 CALL timestop(handle)
6912
6913 END SUBROUTINE compute_greens_function_time
6914
6915END MODULE rpa_gw
6916
modulo
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Definition grid_common.h:120
cp_cfm_basic_linalg::cp_cfm_scale
Definition cp_cfm_basic_linalg.F:60
cp_dbcsr_api::dbcsr_create
Definition cp_dbcsr_api.F:194
cp_dbcsr_operations::dbcsr_allocate_matrix_set
Definition cp_dbcsr_operations.F:77
cp_dbcsr_operations::dbcsr_deallocate_matrix_set
Definition cp_dbcsr_operations.F:85
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:88
cp_fm_types::cp_fm_to_fm
Definition cp_fm_types.F:83
parallel_gemm_api::parallel_gemm
Definition parallel_gemm_api.F:39
pw_methods::pw_axpy
Definition pw_methods.F:165
pw_methods::pw_copy
Definition pw_methods.F:146
pw_methods::pw_scale
Definition pw_methods.F:94
pw_methods::pw_zero
Definition pw_methods.F:83
ai_overlap
Calculation of the overlap integrals over Cartesian Gaussian-type functions.
Definition ai_overlap.F:18
ai_overlap::overlap
subroutine, public overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, lb_max_set, lb_min_set, npgfb, rpgfb, zetb, rab, dab, sab, da_max_set, return_derivatives, s, lds, sdab, pab, force_a)
Purpose: Calculation of the two-center overlap integrals [a|b] over Cartesian Gaussian-type functions...
Definition ai_overlap.F:74
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
basis_set_types
Definition basis_set_types.F:15
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
cell_types::get_cell
subroutine, public get_cell(cell, alpha, beta, gamma, deth, orthorhombic, abc, periodic, h, h_inv, symmetry_id, tag)
Get informations about a simulation cell.
Definition cell_types.F:200
core_ppnl
Calculation of the non-local pseudopotential contribution to the core Hamiltonian <a|V(non-local)|b> ...
Definition core_ppnl.F:15
core_ppnl::build_core_ppnl
subroutine, public build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, use_virial, nder, qs_kind_set, atomic_kind_set, particle_set, sab_orb, sap_ppnl, eps_ppnl, nimages, cell_to_index, basis_type, deltar, matrix_l, atcore)
...
Definition core_ppnl.F:90
cp_cfm_basic_linalg
Basic linear algebra operations for complex full matrices.
Definition cp_cfm_basic_linalg.F:16
cp_cfm_basic_linalg::cp_cfm_scale_and_add
subroutine, public cp_cfm_scale_and_add(alpha, matrix_a, beta, matrix_b)
Scale and add two BLACS matrices (a = alpha*a + beta*b).
Definition cp_cfm_basic_linalg.F:240
cp_cfm_basic_linalg::cp_cfm_transpose
subroutine, public cp_cfm_transpose(matrix, trans, matrixt)
Transposes a BLACS distributed complex matrix.
Definition cp_cfm_basic_linalg.F:1112
cp_cfm_basic_linalg::cp_cfm_scale_and_add_fm
subroutine, public cp_cfm_scale_and_add_fm(alpha, matrix_a, beta, matrix_b)
Scale and add two BLACS matrices (a = alpha*a + beta*b). where b is a real matrix (adapted from cp_cf...
Definition cp_cfm_basic_linalg.F:351
cp_cfm_diag
used for collecting diagonalization schemes available for cp_cfm_type
Definition cp_cfm_diag.F:14
cp_cfm_diag::cp_cfm_geeig_canon
subroutine, public cp_cfm_geeig_canon(amatrix, bmatrix, eigenvectors, eigenvalues, work, epseig)
General Eigenvalue Problem AX = BXE Use canonical orthogonalization.
Definition cp_cfm_diag.F:257
cp_cfm_types
Represents a complex full matrix distributed on many processors.
Definition cp_cfm_types.F:12
cp_cfm_types::cp_cfm_release
subroutine, public cp_cfm_release(matrix)
Releases a full matrix.
Definition cp_cfm_types.F:160
cp_cfm_types::cp_fm_to_cfm
subroutine, public cp_fm_to_cfm(msourcer, msourcei, mtarget)
Construct a complex full matrix by taking its real and imaginary parts from two separate real-value f...
Definition cp_cfm_types.F:818
cp_cfm_types::cp_cfm_get_info
subroutine, public cp_cfm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, matrix_struct, para_env)
Returns information about a full matrix.
Definition cp_cfm_types.F:608
cp_cfm_types::cp_cfm_set_all
subroutine, public cp_cfm_set_all(matrix, alpha, beta)
Set all elements of the full matrix to alpha. Besides, set all diagonal matrix elements to beta (if g...
Definition cp_cfm_types.F:180
cp_cfm_types::cp_cfm_to_fm
subroutine, public cp_cfm_to_fm(msource, mtargetr, mtargeti)
Copy real and imaginary parts of a complex full matrix into separate real-value full matrices.
Definition cp_cfm_types.F:766
cp_cfm_types::cp_cfm_create
subroutine, public cp_cfm_create(matrix, matrix_struct, name, set_zero)
Creates a new full matrix with the given structure.
Definition cp_cfm_types.F:122
cp_control_types
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Definition cp_control_types.F:12
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_api::dbcsr_release_p
subroutine, public dbcsr_release_p(matrix)
...
Definition cp_dbcsr_api.F:222
cp_dbcsr_api::dbcsr_scale
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
Definition cp_dbcsr_api.F:1178
cp_dbcsr_api::dbcsr_iterator_next_block
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset)
...
Definition cp_dbcsr_api.F:969
cp_dbcsr_api::dbcsr_iterator_blocks_left
logical function, public dbcsr_iterator_blocks_left(iterator)
...
Definition cp_dbcsr_api.F:943
cp_dbcsr_api::dbcsr_iterator_stop
subroutine, public dbcsr_iterator_stop(iterator)
...
Definition cp_dbcsr_api.F:1040
cp_dbcsr_api::dbcsr_desymmetrize
subroutine, public dbcsr_desymmetrize(matrix_a, matrix_b)
...
Definition cp_dbcsr_api.F:524
cp_dbcsr_api::dbcsr_copy
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
Definition cp_dbcsr_api.F:370
cp_dbcsr_api::dbcsr_multiply
subroutine, public dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, matrix_c, first_row, last_row, first_column, last_column, first_k, last_k, retain_sparsity, filter_eps, flop)
...
Definition cp_dbcsr_api.F:1086
cp_dbcsr_api::dbcsr_get_info
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
Definition cp_dbcsr_api.F:807
cp_dbcsr_api::dbcsr_init_p
subroutine, public dbcsr_init_p(matrix)
...
Definition cp_dbcsr_api.F:207
cp_dbcsr_api::dbcsr_filter
subroutine, public dbcsr_filter(matrix, eps)
...
Definition cp_dbcsr_api.F:657
cp_dbcsr_api::dbcsr_iterator_start
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
Definition cp_dbcsr_api.F:1002
cp_dbcsr_api::dbcsr_set
subroutine, public dbcsr_set(matrix, alpha)
...
Definition cp_dbcsr_api.F:1194
cp_dbcsr_api::dbcsr_release
subroutine, public dbcsr_release(matrix)
...
Definition cp_dbcsr_api.F:1132
cp_dbcsr_contrib
Definition cp_dbcsr_contrib.F:8
cp_dbcsr_contrib::dbcsr_add_on_diag
subroutine, public dbcsr_add_on_diag(matrix, alpha)
Adds the given scalar to the diagonal of the matrix. Reserves any missing diagonal blocks.
Definition cp_dbcsr_contrib.F:331
cp_dbcsr_cp2k_link
Routines that link DBCSR and CP2K concepts together.
Definition cp_dbcsr_cp2k_link.F:14
cp_dbcsr_cp2k_link::cp_dbcsr_alloc_block_from_nbl
subroutine, public cp_dbcsr_alloc_block_from_nbl(matrix, sab_orb, desymmetrize)
allocate the blocks of a dbcsr based on the neighbor list
Definition cp_dbcsr_cp2k_link.F:445
cp_dbcsr_operations
DBCSR operations in CP2K.
Definition cp_dbcsr_operations.F:18
cp_dbcsr_operations::copy_dbcsr_to_fm
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
Definition cp_dbcsr_operations.F:214
cp_dbcsr_operations::copy_fm_to_dbcsr
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Definition cp_dbcsr_operations.F:111
cp_files
Utility routines to open and close files. Tracking of preconnections.
Definition cp_files.F:16
cp_files::open_file
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
Definition cp_files.F:311
cp_files::close_file
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Definition cp_files.F:122
cp_fm_basic_linalg
Basic linear algebra operations for full matrices.
Definition cp_fm_basic_linalg.F:14
cp_fm_basic_linalg::cp_fm_scale_and_add
subroutine, public cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b)
calc A <- alpha*A + beta*B optimized for alpha == 1.0 (just add beta*B) and beta == 0....
Definition cp_fm_basic_linalg.F:167
cp_fm_basic_linalg::cp_fm_uplo_to_full
subroutine, public cp_fm_uplo_to_full(matrix, work, uplo)
given a triangular matrix according to uplo, computes the corresponding full matrix
Definition cp_fm_basic_linalg.F:1801
cp_fm_cholesky
various cholesky decomposition related routines
Definition cp_fm_cholesky.F:14
cp_fm_cholesky::cp_fm_cholesky_invert
subroutine, public cp_fm_cholesky_invert(matrix, n, info_out)
used to replace the cholesky decomposition by the inverse
Definition cp_fm_cholesky.F:142
cp_fm_cholesky::cp_fm_cholesky_decompose
subroutine, public cp_fm_cholesky_decompose(matrix, n, info_out)
used to replace a symmetric positive def. matrix M with its cholesky decomposition U: M = U^T * U,...
Definition cp_fm_cholesky.F:63
cp_fm_diag
used for collecting some of the diagonalization schemes available for cp_fm_type. cp_fm_power also mo...
Definition cp_fm_diag.F:17
cp_fm_diag::cp_fm_syevd
subroutine, public cp_fm_syevd(matrix, eigenvectors, eigenvalues, info)
Computes all eigenvalues and vectors of a real symmetric matrix significantly faster than syevx,...
Definition cp_fm_diag.F:443
cp_fm_struct
represent the structure of a full matrix
Definition cp_fm_struct.F:14
cp_fm_struct::cp_fm_struct_create
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
Definition cp_fm_struct.F:132
cp_fm_struct::cp_fm_struct_release
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
Definition cp_fm_struct.F:351
cp_fm_types
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
cp_fm_types::cp_fm_copy_general
subroutine, public cp_fm_copy_general(source, destination, para_env)
General copy of a fm matrix to another fm matrix. Uses non-blocking MPI rather than ScaLAPACK.
Definition cp_fm_types.F:1592
cp_fm_types::cp_fm_get_diag
subroutine, public cp_fm_get_diag(matrix, diag)
returns the diagonal elements of a fm
Definition cp_fm_types.F:568
cp_fm_types::cp_fm_create
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp, set_zero)
creates a new full matrix with the given structure
Definition cp_fm_types.F:166
cp_fm_types::cp_fm_get_info
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
Definition cp_fm_types.F:1064
cp_fm_types::cp_fm_to_fm_submat
subroutine, public cp_fm_to_fm_submat(msource, mtarget, nrow, ncol, s_firstrow, s_firstcol, t_firstrow, t_firstcol)
copy just a part ot the matrix
Definition cp_fm_types.F:1527
cp_fm_types::cp_fm_set_all
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
Definition cp_fm_types.F:533
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_unit_nr
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
Definition cp_log_handling.F:567
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
cp_output_handling
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
Definition cp_output_handling.F:25
cp_output_handling::cp_print_key_unit_nr
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
Definition cp_output_handling.F:853
cp_output_handling::cp_print_key_finished_output
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
Definition cp_output_handling.F:1063
cp_realspace_grid_cube
A wrapper around pw_to_cube() which accepts particle_list_type.
Definition cp_realspace_grid_cube.F:12
cp_realspace_grid_cube::cp_pw_to_cube
subroutine, public cp_pw_to_cube(pw, unit_nr, title, particles, zeff, stride, zero_tails, silent, mpi_io)
...
Definition cp_realspace_grid_cube.F:46
dbt_api
This is the start of a dbt_api, all publically needed functions are exported here....
Definition dbt_api.F:17
hfx_types
Types and set/get functions for HFX.
Definition hfx_types.F:15
hfx_types::dealloc_containers
subroutine, public dealloc_containers(data, memory_usage)
...
Definition hfx_types.F:2878
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:17
input_constants::gw_pade_approx
integer, parameter, public gw_pade_approx
Definition input_constants.F:1084
input_constants::ri_rpa_g0w0_crossing_bisection
integer, parameter, public ri_rpa_g0w0_crossing_bisection
Definition input_constants.F:1084
input_constants::ri_rpa_g0w0_crossing_z_shot
integer, parameter, public ri_rpa_g0w0_crossing_z_shot
Definition input_constants.F:1084
input_constants::gw_two_pole_model
integer, parameter, public gw_two_pole_model
Definition input_constants.F:1084
input_constants::ri_rpa_g0w0_crossing_newton
integer, parameter, public ri_rpa_g0w0_crossing_newton
Definition input_constants.F:1084
input_constants::soc_none
integer, parameter, public soc_none
Definition input_constants.F:1084
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition input_section_types.F:15
input_section_types::section_vals_get_subs_vals
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
Definition input_section_types.F:731
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_path_length
integer, parameter, public default_path_length
Definition kinds.F:58
kpoint_methods
Routines needed for kpoint calculation.
Definition kpoint_methods.F:15
kpoint_methods::kpoint_density_transform
subroutine, public kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwork, for_aux_fit, pmat_ext)
generate real space density matrices in DBCSR format
Definition kpoint_methods.F:1253
kpoint_methods::kpoint_init_cell_index
subroutine, public kpoint_init_cell_index(kpoint, sab_nl, para_env, dft_control)
Generates the mapping of cell indices and linear RS index CELL (0,0,0) is always mapped to index 1.
Definition kpoint_methods.F:679
kpoint_methods::kpoint_density_matrices
subroutine, public kpoint_density_matrices(kpoint, energy_weighted, for_aux_fit)
Calculate kpoint density matrices (rho(k), owned by kpoint groups)
Definition kpoint_methods.F:1129
kpoint_types
Types and basic routines needed for a kpoint calculation.
Definition kpoint_types.F:15
kpoint_types::kpoint_sym_create
subroutine, public kpoint_sym_create(kp_sym)
Create a single kpoint symmetry environment.
Definition kpoint_types.F:801
kpoint_types::kpoint_release
subroutine, public kpoint_release(kpoint)
Release a kpoint environment, deallocate all data.
Definition kpoint_types.F:252
kpoint_types::kpoint_create
subroutine, public kpoint_create(kpoint)
Create a kpoint environment.
Definition kpoint_types.F:206
kpoint_types::get_kpoint_info
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym)
Retrieve information from a kpoint environment.
Definition kpoint_types.F:365
machine
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
machine::m_walltime
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition machine.F:153
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::pi
real(kind=dp), parameter, public pi
Definition mathconstants.F:110
mathconstants::z_one
complex(kind=dp), parameter, public z_one
Definition mathconstants.F:143
mathconstants::gaussi
complex(kind=dp), parameter, public gaussi
Definition mathconstants.F:142
mathconstants::fourpi
real(kind=dp), parameter, public fourpi
Definition mathconstants.F:113
mathconstants::twopi
real(kind=dp), parameter, public twopi
Definition mathconstants.F:112
mathconstants::z_zero
complex(kind=dp), parameter, public z_zero
Definition mathconstants.F:143
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
mp2_types
Types needed for MP2 calculations.
Definition mp2_types.F:14
parallel_gemm_api
basic linear algebra operations for full matrixes
Definition parallel_gemm_api.F:14
particle_list_types
represent a simple array based list of the given type
Definition particle_list_types.F:15
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
physcon
Definition of physical constants:
Definition physcon.F:68
physcon::evolt
real(kind=dp), parameter, public evolt
Definition physcon.F:183
pw_env_types
container for various plainwaves related things
Definition pw_env_types.F:14
pw_env_types::pw_env_get
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
Definition pw_env_types.F:113
pw_methods
Definition pw_methods.F:25
pw_pool_types
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Definition pw_pool_types.F:24
pw_types
Definition pw_types.F:24
qs_band_structure
Calculation of band structures.
Definition qs_band_structure.F:14
qs_band_structure::calculate_kp_orbitals
subroutine, public calculate_kp_orbitals(qs_env, kpoint, scheme, nadd, mp_grid, kpgeneral, group_size_ext)
diagonalize KS matrices at a set of kpoints
Definition qs_band_structure.F:303
qs_collocate_density
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
Definition qs_collocate_density.F:38
qs_collocate_density::calculate_rho_elec
subroutine, public calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, ks_env, soft_valid, compute_tau, compute_grad, basis_type, der_type, idir, task_list_external, pw_env_external)
computes the density corresponding to a given density matrix on the grid
Definition qs_collocate_density.F:1715
qs_environment_types
Definition qs_environment_types.F:14
qs_environment_types::get_qs_env
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Definition qs_environment_types.F:526
qs_environment_types::qs_env_release
subroutine, public qs_env_release(qs_env)
releases the given qs_env (see doc/ReferenceCounting.html)
Definition qs_environment_types.F:1444
qs_force_types
Definition qs_force_types.F:13
qs_gamma2kp
Initialize a qs_env for kpoint calculations starting from a gamma point qs_env.
Definition qs_gamma2kp.F:14
qs_gamma2kp::create_kp_from_gamma
subroutine, public create_kp_from_gamma(qs_env, qs_env_kp, with_xc_terms)
...
Definition qs_gamma2kp.F:63
qs_integral_utils
Some utility functions for the calculation of integrals.
Definition qs_integral_utils.F:14
qs_integral_utils::basis_set_list_setup
subroutine, public basis_set_list_setup(basis_set_list, basis_type, qs_kind_set)
Set up an easy accessible list of the basis sets for all kinds.
Definition qs_integral_utils.F:149
qs_kind_types
Define the quickstep kind type and their sub types.
Definition qs_kind_types.F:23
qs_kind_types::get_qs_kind
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, monovalent, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
Definition qs_kind_types.F:468
qs_ks_types
Definition qs_ks_types.F:15
qs_mo_types
Definition and initialisation of the mo data type.
Definition qs_mo_types.F:22
qs_mo_types::get_mo_set
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
Definition qs_mo_types.F:399
qs_moments
Calculates the moment integrals <a|r^m|b> and <a|r x d/dr|b>
Definition qs_moments.F:14
qs_moments::build_berry_moment_matrix
subroutine, public build_berry_moment_matrix(qs_env, cosmat, sinmat, kvec, sab_orb_external, basis_type)
...
Definition qs_moments.F:1338
qs_neighbor_list_types
Define the neighbor list data types and the corresponding functionality.
Definition qs_neighbor_list_types.F:17
qs_neighbor_list_types::release_neighbor_list_sets
subroutine, public release_neighbor_list_sets(nlists)
releases an array of neighbor_list_sets
Definition qs_neighbor_list_types.F:1095
qs_neighbor_lists
Generate the atomic neighbor lists.
Definition qs_neighbor_lists.F:19
qs_neighbor_lists::setup_neighbor_list
subroutine, public setup_neighbor_list(ab_list, basis_set_a, basis_set_b, qs_env, mic, symmetric, molecular, operator_type)
Build a neighborlist.
Definition qs_neighbor_lists.F:1505
qs_overlap
Calculation of overlap matrix, its derivatives and forces.
Definition qs_overlap.F:19
qs_overlap::build_overlap_matrix_simple
subroutine, public build_overlap_matrix_simple(ks_env, matrix_s, basis_set_list_a, basis_set_list_b, sab_nl)
Calculation of the overlap matrix over Cartesian Gaussian functions.
Definition qs_overlap.F:558
qs_scf_types
module that contains the definitions of the scf types
Definition qs_scf_types.F:14
qs_subsys_types
types that represent a quickstep subsys
Definition qs_subsys_types.F:12
qs_subsys_types::qs_subsys_get
subroutine, public qs_subsys_get(subsys, atomic_kinds, atomic_kind_set, particles, particle_set, local_particles, molecules, molecule_set, molecule_kinds, molecule_kind_set, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, natom, nparticle, ncore, nshell, nkind, atprop, virial, results, cell, cell_ref, use_ref_cell, energy, force, qs_kind_set, cp_subsys, nelectron_total, nelectron_spin)
...
Definition qs_subsys_types.F:134
qs_tensors_types
Utility methods to build 3-center integral tensors of various types.
Definition qs_tensors_types.F:12
qs_tensors_types::create_2c_tensor
subroutine, public create_2c_tensor(t2c, dist_1, dist_2, pgrid, sizes_1, sizes_2, order, name)
...
Definition qs_tensors_types.F:382
qs_tensors
Utility methods to build 3-center integral tensors of various types.
Definition qs_tensors.F:11
qs_tensors::decompress_tensor
subroutine, public decompress_tensor(tensor, blk_indices, compressed, eps)
...
Definition qs_tensors.F:3533
rpa_gw_ic
Routines to calculate image charge corrections.
Definition rpa_gw_ic.F:13
rpa_gw_ic::apply_ic_corr
subroutine, public apply_ic_corr(eigenval, eigenval_scf, ic_corr_list, gw_corr_lev_occ, gw_corr_lev_virt, gw_corr_lev_tot, homo, nmo, unit_nr, do_alpha, do_beta)
...
Definition rpa_gw_ic.F:304
rpa_gw_im_time_util
Utility routines for GW with imaginary time.
Definition rpa_gw_im_time_util.F:13
rpa_gw_im_time_util::get_tensor_3c_overl_int_gw
subroutine, public get_tensor_3c_overl_int_gw(t_3c_overl_int, t_3c_o_compressed, t_3c_o_ind, t_3c_overl_int_ao_mo, t_3c_o_mo_compressed, t_3c_o_mo_ind, t_3c_overl_int_gw_ri, t_3c_overl_int_gw_ao, starts_array_mc, ends_array_mc, mo_coeff, matrix_s, gw_corr_lev_occ, gw_corr_lev_virt, homo, nmo, para_env, do_ic_model, t_3c_overl_nnp_ic, t_3c_overl_nnp_ic_reflected, qs_env, unit_nr, do_alpha)
...
Definition rpa_gw_im_time_util.F:112
rpa_gw_kpoints_util
Routines treating GW and RPA calculations with kpoints.
Definition rpa_gw_kpoints_util.F:13
rpa_gw_kpoints_util::get_mat_cell_t_from_mat_gamma
subroutine, public get_mat_cell_t_from_mat_gamma(mat_p_omega, qs_env, kpoints, jquad, unit_nr)
...
Definition rpa_gw_kpoints_util.F:694
rpa_gw_kpoints_util::real_space_to_kpoint_transform_rpa
subroutine, public real_space_to_kpoint_transform_rpa(real_mat_kp, imag_mat_kp, mat_real_space, kpoints, eps_filter_im_time, real_mat_real_space)
...
Definition rpa_gw_kpoints_util.F:848
rpa_gw_kpoints_util::mat_kp_from_mat_gamma
subroutine, public mat_kp_from_mat_gamma(qs_env, mat_kp, mat_gamma, kpoints, ispin, real_mat_real_space)
...
Definition rpa_gw_kpoints_util.F:1696
rpa_gw
Routines for GW, continuous development [Jan Wilhelm].
Definition rpa_gw.F:14
rpa_gw::deallocate_matrices_gw
subroutine, public deallocate_matrices_gw(fm_mat_s_gw_work, vec_w_gw, vec_sigma_c_gw, vec_omega_fit_gw, vec_sigma_x_minus_vxc_gw, eigenval_last, eigenval_scf, do_periodic, matrix_berry_re_mo_mo, matrix_berry_im_mo_mo, kpoints, vec_sigma_x_gw, my_do_gw)
...
Definition rpa_gw.F:615
rpa_gw::allocate_matrices_gw
subroutine, public allocate_matrices_gw(vec_sigma_c_gw, color_rpa_group, dimen_nm_gw, gw_corr_lev_occ, gw_corr_lev_virt, homo, nmo, num_integ_group, num_integ_points, unit_nr, gw_corr_lev_tot, num_fit_points, omega_max_fit, do_minimax_quad, do_periodic, do_ri_sigma_x, my_do_gw, first_cycle_periodic_correction, a_scaling, eigenval, tj, vec_omega_fit_gw, vec_sigma_x_gw, delta_corr, eigenval_last, eigenval_scf, vec_w_gw, fm_mat_s_gw, fm_mat_s_gw_work, para_env, mp2_env, kpoints, nkp, nkp_self_energy, do_kpoints_cubic_rpa, do_kpoints_from_gamma)
...
Definition rpa_gw.F:350
rpa_gw::compute_gw_self_energy
subroutine, public compute_gw_self_energy(vec_sigma_c_gw, dimen_nm_gw, dimen_ri, gw_corr_lev_occ, gw_corr_lev_virt, homo, jquad, nmo, num_fit_points, do_im_time, do_periodic, first_cycle_periodic_correction, fermi_level_offset, omega, eigenval, delta_corr, vec_omega_fit_gw, vec_w_gw, wj, fm_mat_q, fm_mat_r_gw, fm_mat_s_gw, fm_mat_s_gw_work, mo_coeff, para_env, para_env_rpa, matrix_berry_im_mo_mo, matrix_berry_re_mo_mo, kpoints, qs_env, mp2_env)
...
Definition rpa_gw.F:809
rpa_gw::get_fermi_level_offset
subroutine, public get_fermi_level_offset(fermi_level_offset, fermi_level_offset_input, eigenval, homo)
...
Definition rpa_gw.F:913
rpa_gw::trafo_to_mo_and_kpoints
subroutine, public trafo_to_mo_and_kpoints(qs_env, mat_self_energy_ao_ao, vec_sigma, homo, gw_corr_lev_occ, gw_corr_lev_virt, ispin)
...
Definition rpa_gw.F:6344
rpa_gw::allocate_matrices_gw_im_time
subroutine, public allocate_matrices_gw_im_time(gw_corr_lev_occ, gw_corr_lev_virt, homo, nmo, num_integ_points, unit_nr, ri_blk_sizes, do_ic_model, para_env, fm_mat_w, fm_mat_q, mo_coeff, t_3c_overl_int_ao_mo, t_3c_o_mo_compressed, t_3c_o_mo_ind, t_3c_overl_int_gw_ri, t_3c_overl_int_gw_ao, starts_array_mc, ends_array_mc, t_3c_overl_nnp_ic, t_3c_overl_nnp_ic_reflected, matrix_s, mat_w, t_3c_overl_int, t_3c_o_compressed, t_3c_o_ind, qs_env)
...
Definition rpa_gw.F:204
rpa_gw::deallocate_matrices_gw_im_time
subroutine, public deallocate_matrices_gw_im_time(weights_cos_tf_w_to_t, weights_sin_tf_t_to_w, do_ic_model, do_kpoints_cubic_rpa, fm_mat_w, t_3c_overl_int_ao_mo, t_3c_o_mo_compressed, t_3c_o_mo_ind, t_3c_overl_int_gw_ri, t_3c_overl_int_gw_ao, t_3c_overl_nnp_ic, t_3c_overl_nnp_ic_reflected, mat_w, qs_env)
...
Definition rpa_gw.F:690
rpa_gw::compute_minus_vxc_kpoints
subroutine, public compute_minus_vxc_kpoints(qs_env)
...
Definition rpa_gw.F:6219
rpa_gw::compute_qp_energies
subroutine, public compute_qp_energies(vec_sigma_c_gw, count_ev_sc_gw, gw_corr_lev_occ, gw_corr_lev_tot, gw_corr_lev_virt, homo, nmo, num_fit_points, num_integ_points, unit_nr, do_apply_ic_corr_to_gw, do_im_time, do_periodic, do_ri_sigma_x, first_cycle_periodic_correction, e_fermi, eps_filter, fermi_level_offset, delta_corr, eigenval, eigenval_last, eigenval_scf, iter_sc_gw0, exit_ev_gw, tau_tj, tj, vec_omega_fit_gw, vec_sigma_x_gw, ic_corr_list, weights_cos_tf_t_to_w, weights_sin_tf_t_to_w, fm_mo_coeff_occ_scaled, fm_mo_coeff_virt_scaled, fm_mo_coeff_occ, fm_mo_coeff_virt, fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau, mo_coeff, fm_mat_w, para_env, para_env_rpa, mat_dm, mat_minvvminv, t_3c_o, t_3c_m, t_3c_overl_int_ao_mo, t_3c_o_compressed, t_3c_o_mo_compressed, t_3c_o_ind, t_3c_o_mo_ind, t_3c_overl_int_gw_ri, t_3c_overl_int_gw_ao, matrix_berry_im_mo_mo, matrix_berry_re_mo_mo, mat_w, matrix_s, kpoints, mp2_env, qs_env, nkp_self_energy, do_kpoints_cubic_rpa, starts_array_mc, ends_array_mc)
...
Definition rpa_gw.F:1234
rpa_gw::compute_w_cubic_gw
subroutine, public compute_w_cubic_gw(fm_mat_w, fm_mat_q, fm_mat_work, dimen_ri, fm_mat_l, num_integ_points, tj, tau_tj, weights_cos_tf_w_to_t, jquad, omega)
...
Definition rpa_gw.F:955
rpa_gw::continuation_pade
subroutine, public continuation_pade(vec_gw_energ, vec_omega_fit_gw, z_value, m_value, vec_sigma_c_gw, vec_sigma_x_minus_vxc_gw, eigenval, eigenval_scf, do_hedin_shift, n_level_gw, gw_corr_lev_occ, gw_corr_lev_vir, nparam_pade, num_fit_points, crossing_search, homo, fermi_level_offset, do_gw_im_time, print_self_energy, count_ev_sc_gw, vec_gw_dos, dos_lower_bound, dos_precision, ndos, min_level_self_energy, max_level_self_energy, dos_eta, dos_min, dos_max, e_fermi_ext)
perform analytic continuation with pade approximation
Definition rpa_gw.F:4314
rpa_im_time
Routines for low-scaling RPA/GW with imaginary time.
Definition rpa_im_time.F:13
rpa_im_time::compute_periodic_dm
subroutine, public compute_periodic_dm(mat_dm_global, qs_env, ispin, num_integ_points, jquad, e_fermi, tau, remove_occ, remove_virt, alloc_dm)
...
Definition rpa_im_time.F:1131
scf_control_types
parameters that control an scf iteration
Definition scf_control_types.F:17
util
All kind of helpful little routines.
Definition util.F:14
virial_types
Definition virial_types.F:13
atomic_kind_types::atomic_kind_type
Provides all information about an atomic kind.
Definition atomic_kind_types.F:45
basis_set_types::gto_basis_set_p_type
Definition basis_set_types.F:94
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
cp_cfm_types::cp_cfm_type
Represent a complex full matrix.
Definition cp_cfm_types.F:68
cp_control_types::dft_control_type
Definition cp_control_types.F:624
cp_dbcsr_api::dbcsr_iterator_type
Definition cp_dbcsr_api.F:188
cp_dbcsr_api::dbcsr_p_type
Definition cp_dbcsr_api.F:172
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:176
cp_fm_struct::cp_fm_struct_type
keeps the information about the structure of a full matrix
Definition cp_fm_struct.F:82
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:114
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
hfx_types::block_ind_type
Definition hfx_types.F:368
hfx_types::hfx_compression_type
Definition hfx_types.F:352
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:127
kpoint_types::kpoint_type
Contains information about kpoints.
Definition kpoint_types.F:150
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:721
mp2_types::mp2_type
Definition mp2_types.F:345
mp2_types::one_dim_real_array
Definition mp2_types.F:79
mp2_types::two_dim_int_array
Definition mp2_types.F:75
particle_list_types::particle_list_type
represent a list of objects
Definition particle_list_types.F:46
particle_types::particle_type
Definition particle_types.F:35
pw_env_types::pw_env_type
contained for different pw related things
Definition pw_env_types.F:70
pw_pool_types::pw_pool_type
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Definition pw_pool_types.F:83
pw_types::pw_c1d_gs_type
Definition pw_types.F:127
pw_types::pw_r3d_rs_type
Definition pw_types.F:62
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:220
qs_force_types::qs_force_type
Definition qs_force_types.F:28
qs_kind_types::qs_kind_type
Provides all information about a quickstep kind.
Definition qs_kind_types.F:177
qs_ks_types::qs_ks_env_type
calculation environment to calculate the ks matrix, holds all the needed vars. assumes that the core ...
Definition qs_ks_types.F:137
qs_neighbor_list_types::neighbor_list_set_p_type
Definition qs_neighbor_list_types.F:67
qs_scf_types::qs_scf_env_type
Definition qs_scf_types.F:97
qs_subsys_types::qs_subsys_type
Definition qs_subsys_types.F:56
scf_control_types::scf_control_type
Definition scf_control_types.F:124
virial_types::virial_type
Definition virial_types.F:26