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