(git:936074a)
Loading...
Searching...
No Matches
gw_utils.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief
10!> \author Jan Wilhelm
11!> \date 07.2023
12! **************************************************************************************************
18 USE bibliography, ONLY: graml2024,&
19 cite_reference
20 USE cell_types, ONLY: cell_type,&
21 pbc,&
26 USE cp_cfm_types, ONLY: cp_cfm_create,&
32 USE cp_dbcsr_api, ONLY: &
34 dbcsr_release, dbcsr_set, dbcsr_type, dbcsr_type_no_symmetry, dbcsr_type_symmetric
40 USE cp_files, ONLY: close_file,&
46 USE cp_fm_types, ONLY: cp_fm_create,&
54 USE dbt_api, ONLY: &
55 dbt_clear, dbt_create, dbt_destroy, dbt_filter, dbt_iterator_blocks_left, &
56 dbt_iterator_next_block, dbt_iterator_start, dbt_iterator_stop, dbt_iterator_type, &
57 dbt_mp_environ_pgrid, dbt_pgrid_create, dbt_pgrid_destroy, dbt_pgrid_type, dbt_type
72 USE kinds, ONLY: default_path_length,&
74 dp,&
75 int_8
78 USE kpoint_types, ONLY: get_kpoint_info,&
84 USE machine, ONLY: m_memory,&
86 USE mathconstants, ONLY: gaussi,&
87 z_one,&
88 z_zero
89 USE mathlib, ONLY: diag_complex,&
90 gcd
91 USE message_passing, ONLY: mp_cart_type,&
97 USE mp2_gpw, ONLY: create_mat_munu
105 USE physcon, ONLY: angstrom,&
106 evolt
115 USE qs_kind_types, ONLY: get_qs_kind,&
120 USE qs_tensors, ONLY: build_2c_integrals,&
131 USE rpa_gw, ONLY: continuation_pade
132#include "base/base_uses.f90"
133
134 IMPLICIT NONE
135
136 PRIVATE
137
141
142 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'gw_utils'
143
144CONTAINS
145
146! **************************************************************************************************
147!> \brief ...
148!> \param qs_env ...
149!> \param bs_env ...
150!> \param bs_sec ...
151! **************************************************************************************************
152 SUBROUTINE create_and_init_bs_env_for_gw(qs_env, bs_env, bs_sec)
153 TYPE(qs_environment_type), POINTER :: qs_env
154 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
155 TYPE(section_vals_type), POINTER :: bs_sec
156
157 CHARACTER(LEN=*), PARAMETER :: routinen = 'create_and_init_bs_env_for_gw'
158
159 INTEGER :: handle
160
161 CALL timeset(routinen, handle)
162
163 CALL cite_reference(graml2024)
164
165 CALL read_gw_input_parameters(bs_env, bs_sec)
166
167 CALL print_header_and_input_parameters(bs_env)
168
169 CALL setup_ao_and_ri_basis_set(qs_env, bs_env)
170
171 CALL get_ri_basis_and_basis_function_indices(qs_env, bs_env)
172
173 CALL set_heuristic_parameters(bs_env, qs_env)
174
176
177 CALL setup_kpoints_chi_eps_w(bs_env, bs_env%kpoints_chi_eps_W)
178
179 IF (bs_env%small_cell_full_kp_or_large_cell_Gamma == small_cell_full_kp) THEN
180 CALL setup_cells_3c(qs_env, bs_env)
181 END IF
182
183 CALL set_parallelization_parameters(qs_env, bs_env)
184
185 CALL allocate_matrices(qs_env, bs_env)
186
187 CALL compute_v_xc(qs_env, bs_env)
188
189 CALL create_tensors(qs_env, bs_env)
190
191 SELECT CASE (bs_env%small_cell_full_kp_or_large_cell_Gamma)
192 CASE (large_cell_gamma)
193
194 CALL allocate_gw_eigenvalues(bs_env)
195
196 CALL check_sparsity_3c(qs_env, bs_env)
197
198 CALL set_sparsity_parallelization_parameters(bs_env)
199
200 CALL check_for_restart_files(qs_env, bs_env)
201
202 CASE (small_cell_full_kp)
203
204 CALL compute_3c_integrals(qs_env, bs_env)
205
206 CALL setup_cells_delta_r(bs_env)
207
208 CALL setup_parallelization_delta_r(bs_env)
209
210 CALL allocate_matrices_small_cell_full_kp(qs_env, bs_env)
211
212 CALL trafo_v_xc_r_to_kp(qs_env, bs_env)
213
214 CALL heuristic_ri_regularization(qs_env, bs_env)
215
216 END SELECT
217
218 CALL setup_time_and_frequency_minimax_grid(bs_env)
219
220 ! free memory in qs_env; only if one is not calculating the LDOS because
221 ! we need real-space grid operations in pw_env, task_list for the LDOS
222 ! Recommendation in case of memory issues: first perform GW calculation without calculating
223 ! LDOS (to safe memor). Then, use GW restart files
224 ! in a subsequent calculation to calculate the LDOS
225 ! Marek : TODO - boolean that does not interfere with RTP init but sets this to correct value
226 IF (.NOT. bs_env%do_ldos .AND. .false.) THEN
227 CALL qs_env_part_release(qs_env)
228 END IF
229
230 CALL timestop(handle)
231
232 END SUBROUTINE create_and_init_bs_env_for_gw
233
234! **************************************************************************************************
235!> \brief ...
236!> \param bs_env ...
237! **************************************************************************************************
238 SUBROUTINE de_init_bs_env(bs_env)
239 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
240
241 CHARACTER(LEN=*), PARAMETER :: routinen = 'de_init_bs_env'
242
243 INTEGER :: handle
244
245 CALL timeset(routinen, handle)
246 ! deallocate quantities here which:
247 ! 1. cannot be deallocated in bs_env_release due to circular dependencies
248 ! 2. consume a lot of memory and should not be kept until the quantity is
249 ! deallocated in bs_env_release
250
251 IF (ASSOCIATED(bs_env%nl_3c%ij_list) .AND. (bs_env%rtp_method == rtp_method_bse)) THEN
252 IF (bs_env%unit_nr > 0) WRITE (bs_env%unit_nr, *) "Retaining nl_3c for RTBSE"
253 ELSE
254 CALL neighbor_list_3c_destroy(bs_env%nl_3c)
255 END IF
256
258
259 CALL timestop(handle)
260
261 END SUBROUTINE de_init_bs_env
262
263! **************************************************************************************************
264!> \brief ...
265!> \param bs_env ...
266!> \param bs_sec ...
267! **************************************************************************************************
268 SUBROUTINE read_gw_input_parameters(bs_env, bs_sec)
269 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
270 TYPE(section_vals_type), POINTER :: bs_sec
271
272 CHARACTER(LEN=*), PARAMETER :: routinen = 'read_gw_input_parameters'
273
274 INTEGER :: handle
275 TYPE(section_vals_type), POINTER :: gw_sec
276
277 CALL timeset(routinen, handle)
278
279 NULLIFY (gw_sec)
280 gw_sec => section_vals_get_subs_vals(bs_sec, "GW")
281
282 CALL section_vals_val_get(gw_sec, "NUM_TIME_FREQ_POINTS", i_val=bs_env%num_time_freq_points)
283 CALL section_vals_val_get(gw_sec, "EPS_FILTER", r_val=bs_env%eps_filter)
284 CALL section_vals_val_get(gw_sec, "REGULARIZATION_RI", r_val=bs_env%input_regularization_RI)
285 CALL section_vals_val_get(gw_sec, "REGULARIZATION_MINIMAX", r_val=bs_env%input_regularization_minimax)
286 CALL section_vals_val_get(gw_sec, "CUTOFF_RADIUS_RI", r_val=bs_env%ri_metric%cutoff_radius)
287 CALL section_vals_val_get(gw_sec, "MEMORY_PER_PROC", r_val=bs_env%input_memory_per_proc_GB)
288 CALL section_vals_val_get(gw_sec, "APPROX_KP_EXTRAPOL", l_val=bs_env%approx_kp_extrapol)
289 CALL section_vals_val_get(gw_sec, "SIZE_LATTICE_SUM", i_val=bs_env%size_lattice_sum_V)
290 CALL section_vals_val_get(gw_sec, "KPOINTS_W", i_vals=bs_env%nkp_grid_chi_eps_W_input)
291 CALL section_vals_val_get(gw_sec, "HEDIN_SHIFT", l_val=bs_env%do_hedin_shift)
292 CALL section_vals_val_get(gw_sec, "FREQ_MAX_FIT", r_val=bs_env%freq_max_fit)
293
294 CALL timestop(handle)
295
296 END SUBROUTINE read_gw_input_parameters
297
298! **************************************************************************************************
299!> \brief ...
300!> \param qs_env ...
301!> \param bs_env ...
302! **************************************************************************************************
303 SUBROUTINE setup_ao_and_ri_basis_set(qs_env, bs_env)
304 TYPE(qs_environment_type), POINTER :: qs_env
305 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
306
307 CHARACTER(LEN=*), PARAMETER :: routinen = 'setup_AO_and_RI_basis_set'
308
309 INTEGER :: handle, natom, nkind
310 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
311 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
312
313 CALL timeset(routinen, handle)
314
315 CALL get_qs_env(qs_env, &
316 qs_kind_set=qs_kind_set, &
317 particle_set=particle_set, &
318 natom=natom, nkind=nkind)
319
320 ! set up basis
321 ALLOCATE (bs_env%sizes_RI(natom), bs_env%sizes_AO(natom))
322 ALLOCATE (bs_env%basis_set_RI(nkind), bs_env%basis_set_AO(nkind))
323
324 CALL basis_set_list_setup(bs_env%basis_set_RI, "RI_AUX", qs_kind_set)
325 CALL basis_set_list_setup(bs_env%basis_set_AO, "ORB", qs_kind_set)
326
327 CALL get_particle_set(particle_set, qs_kind_set, nsgf=bs_env%sizes_RI, &
328 basis=bs_env%basis_set_RI)
329 CALL get_particle_set(particle_set, qs_kind_set, nsgf=bs_env%sizes_AO, &
330 basis=bs_env%basis_set_AO)
331
332 CALL timestop(handle)
333
334 END SUBROUTINE setup_ao_and_ri_basis_set
335
336! **************************************************************************************************
337!> \brief ...
338!> \param qs_env ...
339!> \param bs_env ...
340! **************************************************************************************************
341 SUBROUTINE get_ri_basis_and_basis_function_indices(qs_env, bs_env)
342 TYPE(qs_environment_type), POINTER :: qs_env
343 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
344
345 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_RI_basis_and_basis_function_indices'
346
347 INTEGER :: handle, i_ri, iatom, ikind, iset, &
348 max_ao_bf_per_atom, n_ao_test, n_atom, &
349 n_kind, n_ri, nset, nsgf, u
350 INTEGER, ALLOCATABLE, DIMENSION(:) :: kind_of
351 INTEGER, DIMENSION(:), POINTER :: l_max, l_min, nsgf_set
352 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
353 TYPE(gto_basis_set_type), POINTER :: basis_set_a
354 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
355
356 CALL timeset(routinen, handle)
357
358 ! determine RI basis set size
359 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set)
360
361 n_kind = SIZE(qs_kind_set)
362 n_atom = bs_env%n_atom
363
364 CALL get_atomic_kind_set(atomic_kind_set, kind_of=kind_of)
365
366 DO ikind = 1, n_kind
367 CALL get_qs_kind(qs_kind=qs_kind_set(ikind), basis_set=basis_set_a, &
368 basis_type="RI_AUX")
369 IF (.NOT. ASSOCIATED(basis_set_a)) THEN
370 CALL cp_abort(__location__, &
371 "At least one RI_AUX basis set was not explicitly invoked in &KIND-section.")
372 END IF
373 END DO
374
375 ALLOCATE (bs_env%i_RI_start_from_atom(n_atom))
376 ALLOCATE (bs_env%i_RI_end_from_atom(n_atom))
377 ALLOCATE (bs_env%i_ao_start_from_atom(n_atom))
378 ALLOCATE (bs_env%i_ao_end_from_atom(n_atom))
379
380 n_ri = 0
381 DO iatom = 1, n_atom
382 bs_env%i_RI_start_from_atom(iatom) = n_ri + 1
383 ikind = kind_of(iatom)
384 CALL get_qs_kind(qs_kind=qs_kind_set(ikind), nsgf=nsgf, basis_type="RI_AUX")
385 n_ri = n_ri + nsgf
386 bs_env%i_RI_end_from_atom(iatom) = n_ri
387 END DO
388 bs_env%n_RI = n_ri
389
390 max_ao_bf_per_atom = 0
391 n_ao_test = 0
392 DO iatom = 1, n_atom
393 bs_env%i_ao_start_from_atom(iatom) = n_ao_test + 1
394 ikind = kind_of(iatom)
395 CALL get_qs_kind(qs_kind=qs_kind_set(ikind), nsgf=nsgf, basis_type="ORB")
396 n_ao_test = n_ao_test + nsgf
397 bs_env%i_ao_end_from_atom(iatom) = n_ao_test
398 max_ao_bf_per_atom = max(max_ao_bf_per_atom, nsgf)
399 END DO
400 cpassert(n_ao_test == bs_env%n_ao)
401 bs_env%max_AO_bf_per_atom = max_ao_bf_per_atom
402
403 ALLOCATE (bs_env%l_RI(n_ri))
404 i_ri = 0
405 DO iatom = 1, n_atom
406 ikind = kind_of(iatom)
407
408 nset = bs_env%basis_set_RI(ikind)%gto_basis_set%nset
409 l_max => bs_env%basis_set_RI(ikind)%gto_basis_set%lmax
410 l_min => bs_env%basis_set_RI(ikind)%gto_basis_set%lmin
411 nsgf_set => bs_env%basis_set_RI(ikind)%gto_basis_set%nsgf_set
412
413 DO iset = 1, nset
414 cpassert(l_max(iset) == l_min(iset))
415 bs_env%l_RI(i_ri + 1:i_ri + nsgf_set(iset)) = l_max(iset)
416 i_ri = i_ri + nsgf_set(iset)
417 END DO
418
419 END DO
420 cpassert(i_ri == n_ri)
421
422 u = bs_env%unit_nr
423
424 IF (u > 0) THEN
425 WRITE (u, fmt="(T2,A)") " "
426 WRITE (u, fmt="(T2,2A,T75,I8)") "Number of auxiliary Gaussian basis functions ", &
427 χε"for , , W", n_ri
428 END IF
429
430 CALL timestop(handle)
431
432 END SUBROUTINE get_ri_basis_and_basis_function_indices
433
434! **************************************************************************************************
435!> \brief ...
436!> \param bs_env ...
437!> \param kpoints ...
438! **************************************************************************************************
439 SUBROUTINE setup_kpoints_chi_eps_w(bs_env, kpoints)
440
441 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
442 TYPE(kpoint_type), POINTER :: kpoints
443
444 CHARACTER(LEN=*), PARAMETER :: routinen = 'setup_kpoints_chi_eps_W'
445
446 INTEGER :: handle, i_dim, n_dim, nkp, nkp_extra, &
447 nkp_orig, u
448 INTEGER, DIMENSION(3) :: nkp_grid, nkp_grid_extra, periodic
449 REAL(kind=dp) :: exp_s_p, n_dim_inv
450
451 CALL timeset(routinen, handle)
452
453 ! routine adapted from mp2_integrals.F
454 NULLIFY (kpoints)
455 CALL kpoint_create(kpoints)
456
457 kpoints%kp_scheme = "GENERAL"
458
459 periodic(1:3) = bs_env%periodic(1:3)
460
461 cpassert(SIZE(bs_env%nkp_grid_chi_eps_W_input) == 3)
462
463 IF (bs_env%nkp_grid_chi_eps_W_input(1) > 0 .AND. &
464 bs_env%nkp_grid_chi_eps_W_input(2) > 0 .AND. &
465 bs_env%nkp_grid_chi_eps_W_input(3) > 0) THEN
466 ! 1. k-point mesh for χ, ε, W from input
467 DO i_dim = 1, 3
468 SELECT CASE (periodic(i_dim))
469 CASE (0)
470 nkp_grid(i_dim) = 1
471 nkp_grid_extra(i_dim) = 1
472 CASE (1)
473 nkp_grid(i_dim) = bs_env%nkp_grid_chi_eps_W_input(i_dim)
474 nkp_grid_extra(i_dim) = nkp_grid(i_dim)*2
475 CASE DEFAULT
476 cpabort("Error in periodicity.")
477 END SELECT
478 END DO
479
480 ELSE IF (bs_env%nkp_grid_chi_eps_W_input(1) == -1 .AND. &
481 bs_env%nkp_grid_chi_eps_W_input(2) == -1 .AND. &
482 bs_env%nkp_grid_chi_eps_W_input(3) == -1) THEN
483 ! 2. automatic k-point mesh for χ, ε, W
484
485 DO i_dim = 1, 3
486
487 cpassert(periodic(i_dim) == 0 .OR. periodic(i_dim) == 1)
488
489 SELECT CASE (periodic(i_dim))
490 CASE (0)
491 nkp_grid(i_dim) = 1
492 nkp_grid_extra(i_dim) = 1
493 CASE (1)
494 SELECT CASE (bs_env%small_cell_full_kp_or_large_cell_Gamma)
495 CASE (large_cell_gamma)
496 nkp_grid(i_dim) = 4
497 nkp_grid_extra(i_dim) = 6
498 CASE (small_cell_full_kp)
499 nkp_grid(i_dim) = bs_env%kpoints_scf_desymm%nkp_grid(i_dim)*4
500 nkp_grid_extra(i_dim) = bs_env%kpoints_scf_desymm%nkp_grid(i_dim)*8
501 END SELECT
502 CASE DEFAULT
503 cpabort("Error in periodicity.")
504 END SELECT
505
506 END DO
507
508 ELSE
509
510 cpabort("An error occured when setting up the k-mesh for W.")
511
512 END IF
513
514 nkp_orig = max(nkp_grid(1)*nkp_grid(2)*nkp_grid(3)/2, 1)
515
516 nkp_extra = nkp_grid_extra(1)*nkp_grid_extra(2)*nkp_grid_extra(3)/2
517
518 nkp = nkp_orig + nkp_extra
519
520 kpoints%nkp_grid(1:3) = nkp_grid(1:3)
521 kpoints%nkp = nkp
522
523 bs_env%nkp_grid_chi_eps_W_orig(1:3) = nkp_grid(1:3)
524 bs_env%nkp_grid_chi_eps_W_extra(1:3) = nkp_grid_extra(1:3)
525 bs_env%nkp_chi_eps_W_orig = nkp_orig
526 bs_env%nkp_chi_eps_W_extra = nkp_extra
527 bs_env%nkp_chi_eps_W_orig_plus_extra = nkp
528
529 ALLOCATE (kpoints%xkp(3, nkp), kpoints%wkp(nkp))
530 ALLOCATE (bs_env%wkp_no_extra(nkp), bs_env%wkp_s_p(nkp))
531
532 CALL compute_xkp(kpoints%xkp, 1, nkp_orig, nkp_grid)
533 CALL compute_xkp(kpoints%xkp, nkp_orig + 1, nkp, nkp_grid_extra)
534
535 n_dim = sum(periodic)
536 IF (n_dim == 0) THEN
537 ! molecules
538 kpoints%wkp(1) = 1.0_dp
539 bs_env%wkp_s_p(1) = 1.0_dp
540 bs_env%wkp_no_extra(1) = 1.0_dp
541 ELSE
542
543 n_dim_inv = 1.0_dp/real(n_dim, kind=dp)
544
545 ! k-point weights are chosen to automatically extrapolate the k-point mesh
546 CALL compute_wkp(kpoints%wkp(1:nkp_orig), nkp_orig, nkp_extra, n_dim_inv)
547 CALL compute_wkp(kpoints%wkp(nkp_orig + 1:nkp), nkp_extra, nkp_orig, n_dim_inv)
548
549 bs_env%wkp_no_extra(1:nkp_orig) = 0.0_dp
550 bs_env%wkp_no_extra(nkp_orig + 1:nkp) = 1.0_dp/real(nkp_extra, kind=dp)
551
552 IF (n_dim == 3) THEN
553 ! W_PQ(k) for an s-function P and a p-function Q diverges as 1/k at k=0
554 ! (instead of 1/k^2 for P and Q both being s-functions).
555 exp_s_p = 2.0_dp*n_dim_inv
556 CALL compute_wkp(bs_env%wkp_s_p(1:nkp_orig), nkp_orig, nkp_extra, exp_s_p)
557 CALL compute_wkp(bs_env%wkp_s_p(nkp_orig + 1:nkp), nkp_extra, nkp_orig, exp_s_p)
558 ELSE
559 bs_env%wkp_s_p(1:nkp) = bs_env%wkp_no_extra(1:nkp)
560 END IF
561
562 END IF
563
564 IF (bs_env%approx_kp_extrapol) THEN
565 bs_env%wkp_orig = 1.0_dp/real(nkp_orig, kind=dp)
566 END IF
567
568 ! heuristic parameter: how many k-points for χ, ε, and W are used simultaneously
569 ! (less simultaneous k-points: less memory, but more computational effort because of
570 ! recomputation of V(k))
571 bs_env%nkp_chi_eps_W_batch = 4
572
573 bs_env%num_chi_eps_W_batches = (bs_env%nkp_chi_eps_W_orig_plus_extra - 1)/ &
574 bs_env%nkp_chi_eps_W_batch + 1
575
576 u = bs_env%unit_nr
577
578 IF (u > 0) THEN
579 WRITE (u, fmt="(T2,A)") " "
580 WRITE (u, fmt="(T2,1A,T71,3I4)") χε"K-point mesh 1 for , , W", nkp_grid(1:3)
581 WRITE (u, fmt="(T2,2A,T71,3I4)") χε"K-point mesh 2 for , , W ", &
582 "(for k-point extrapolation of W)", nkp_grid_extra(1:3)
583 WRITE (u, fmt="(T2,A,T80,L)") "Approximate the k-point extrapolation", &
584 bs_env%approx_kp_extrapol
585 END IF
586
587 CALL timestop(handle)
588
589 END SUBROUTINE setup_kpoints_chi_eps_w
590
591! **************************************************************************************************
592!> \brief ...
593!> \param kpoints ...
594!> \param qs_env ...
595! **************************************************************************************************
596 SUBROUTINE kpoint_init_cell_index_simple(kpoints, qs_env)
597
598 TYPE(kpoint_type), POINTER :: kpoints
599 TYPE(qs_environment_type), POINTER :: qs_env
600
601 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_init_cell_index_simple'
602
603 INTEGER :: handle
604 TYPE(dft_control_type), POINTER :: dft_control
605 TYPE(mp_para_env_type), POINTER :: para_env
606 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
607 POINTER :: sab_orb
608
609 CALL timeset(routinen, handle)
610
611 NULLIFY (dft_control, para_env, sab_orb)
612 CALL get_qs_env(qs_env=qs_env, para_env=para_env, dft_control=dft_control, sab_orb=sab_orb)
613 CALL kpoint_init_cell_index(kpoints, sab_orb, para_env, dft_control)
614
615 CALL timestop(handle)
616
617 END SUBROUTINE kpoint_init_cell_index_simple
618
619! **************************************************************************************************
620!> \brief ...
621!> \param xkp ...
622!> \param ikp_start ...
623!> \param ikp_end ...
624!> \param grid ...
625! **************************************************************************************************
626 SUBROUTINE compute_xkp(xkp, ikp_start, ikp_end, grid)
627
628 REAL(kind=dp), DIMENSION(:, :), POINTER :: xkp
629 INTEGER :: ikp_start, ikp_end
630 INTEGER, DIMENSION(3) :: grid
631
632 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_xkp'
633
634 INTEGER :: handle, i, ix, iy, iz
635
636 CALL timeset(routinen, handle)
637
638 i = ikp_start
639 DO ix = 1, grid(1)
640 DO iy = 1, grid(2)
641 DO iz = 1, grid(3)
642
643 IF (i > ikp_end) cycle
644
645 xkp(1, i) = real(2*ix - grid(1) - 1, kind=dp)/(2._dp*real(grid(1), kind=dp))
646 xkp(2, i) = real(2*iy - grid(2) - 1, kind=dp)/(2._dp*real(grid(2), kind=dp))
647 xkp(3, i) = real(2*iz - grid(3) - 1, kind=dp)/(2._dp*real(grid(3), kind=dp))
648 i = i + 1
649
650 END DO
651 END DO
652 END DO
653
654 CALL timestop(handle)
655
656 END SUBROUTINE compute_xkp
657
658! **************************************************************************************************
659!> \brief ...
660!> \param wkp ...
661!> \param nkp_1 ...
662!> \param nkp_2 ...
663!> \param exponent ...
664! **************************************************************************************************
665 SUBROUTINE compute_wkp(wkp, nkp_1, nkp_2, exponent)
666 REAL(kind=dp), DIMENSION(:) :: wkp
667 INTEGER :: nkp_1, nkp_2
668 REAL(kind=dp) :: exponent
669
670 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_wkp'
671
672 INTEGER :: handle
673 REAL(kind=dp) :: nkp_ratio
674
675 CALL timeset(routinen, handle)
676
677 nkp_ratio = real(nkp_2, kind=dp)/real(nkp_1, kind=dp)
678
679 wkp(:) = 1.0_dp/real(nkp_1, kind=dp)/(1.0_dp - nkp_ratio**exponent)
680
681 CALL timestop(handle)
682
683 END SUBROUTINE compute_wkp
684
685! **************************************************************************************************
686!> \brief ...
687!> \param qs_env ...
688!> \param bs_env ...
689! **************************************************************************************************
690 SUBROUTINE allocate_matrices(qs_env, bs_env)
691 TYPE(qs_environment_type), POINTER :: qs_env
692 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
693
694 CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_matrices'
695
696 INTEGER :: handle, i_t
697 TYPE(cp_blacs_env_type), POINTER :: blacs_env, blacs_env_tensor
698 TYPE(cp_fm_struct_type), POINTER :: fm_struct, fm_struct_ri_global
699 TYPE(mp_para_env_type), POINTER :: para_env
700
701 CALL timeset(routinen, handle)
702
703 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
704
705 fm_struct => bs_env%fm_ks_Gamma(1)%matrix_struct
706
707 CALL cp_fm_create(bs_env%fm_Gocc, fm_struct)
708 CALL cp_fm_create(bs_env%fm_Gvir, fm_struct)
709
710 NULLIFY (fm_struct_ri_global)
711 CALL cp_fm_struct_create(fm_struct_ri_global, context=blacs_env, nrow_global=bs_env%n_RI, &
712 ncol_global=bs_env%n_RI, para_env=para_env)
713 CALL cp_fm_create(bs_env%fm_RI_RI, fm_struct_ri_global)
714 CALL cp_fm_create(bs_env%fm_chi_Gamma_freq, fm_struct_ri_global)
715 CALL cp_fm_create(bs_env%fm_W_MIC_freq, fm_struct_ri_global)
716 IF (bs_env%approx_kp_extrapol) THEN
717 CALL cp_fm_create(bs_env%fm_W_MIC_freq_1_extra, fm_struct_ri_global)
718 CALL cp_fm_create(bs_env%fm_W_MIC_freq_1_no_extra, fm_struct_ri_global)
719 CALL cp_fm_set_all(bs_env%fm_W_MIC_freq_1_extra, 0.0_dp)
720 CALL cp_fm_set_all(bs_env%fm_W_MIC_freq_1_no_extra, 0.0_dp)
721 END IF
722 CALL cp_fm_struct_release(fm_struct_ri_global)
723
724 ! create blacs_env for subgroups of tensor operations
725 NULLIFY (blacs_env_tensor)
726 CALL cp_blacs_env_create(blacs_env=blacs_env_tensor, para_env=bs_env%para_env_tensor)
727
728 ! allocate dbcsr matrices in the tensor subgroup; actually, one only needs a small
729 ! subset of blocks in the tensor subgroup, however, all atomic blocks are allocated.
730 ! One might think of creating a dbcsr matrix with only the blocks that are needed
731 ! in the tensor subgroup
732 CALL create_mat_munu(bs_env%mat_ao_ao_tensor, qs_env, bs_env%eps_atom_grid_2d_mat, &
733 blacs_env_tensor, do_ri_aux_basis=.false.)
734
735 CALL create_mat_munu(bs_env%mat_RI_RI_tensor, qs_env, bs_env%eps_atom_grid_2d_mat, &
736 blacs_env_tensor, do_ri_aux_basis=.true.)
737
738 CALL create_mat_munu(bs_env%mat_RI_RI, qs_env, bs_env%eps_atom_grid_2d_mat, &
739 blacs_env, do_ri_aux_basis=.true.)
740
741 CALL cp_blacs_env_release(blacs_env_tensor)
742
743 NULLIFY (bs_env%mat_chi_Gamma_tau)
744 CALL dbcsr_allocate_matrix_set(bs_env%mat_chi_Gamma_tau, bs_env%num_time_freq_points)
745
746 DO i_t = 1, bs_env%num_time_freq_points
747 ALLOCATE (bs_env%mat_chi_Gamma_tau(i_t)%matrix)
748 CALL dbcsr_create(bs_env%mat_chi_Gamma_tau(i_t)%matrix, template=bs_env%mat_RI_RI%matrix)
749 END DO
750
751 CALL timestop(handle)
752
753 END SUBROUTINE allocate_matrices
754
755! **************************************************************************************************
756!> \brief ...
757!> \param bs_env ...
758! **************************************************************************************************
759 SUBROUTINE allocate_gw_eigenvalues(bs_env)
760 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
761
762 CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_GW_eigenvalues'
763
764 INTEGER :: handle
765
766 CALL timeset(routinen, handle)
767
768 ALLOCATE (bs_env%eigenval_G0W0(bs_env%n_ao, bs_env%nkp_bs_and_DOS, bs_env%n_spin))
769 ALLOCATE (bs_env%eigenval_HF(bs_env%n_ao, bs_env%nkp_bs_and_DOS, bs_env%n_spin))
770
771 CALL timestop(handle)
772
773 END SUBROUTINE allocate_gw_eigenvalues
774
775! **************************************************************************************************
776!> \brief ...
777!> \param qs_env ...
778!> \param bs_env ...
779! **************************************************************************************************
780 SUBROUTINE create_tensors(qs_env, bs_env)
781 TYPE(qs_environment_type), POINTER :: qs_env
782 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
783
784 CHARACTER(LEN=*), PARAMETER :: routinen = 'create_tensors'
785
786 INTEGER :: handle
787
788 CALL timeset(routinen, handle)
789
790 CALL init_interaction_radii(bs_env)
791
792 ! split blocks does not improve load balancing/efficienfy for tensor contraction, so we go
793 ! with the standard atomic blocks
794 CALL create_3c_t(bs_env%t_RI_AO__AO, bs_env%para_env_tensor, "(RI AO | AO)", [1, 2], [3], &
795 bs_env%sizes_RI, bs_env%sizes_AO, &
796 create_nl_3c=.true., nl_3c=bs_env%nl_3c, qs_env=qs_env)
797 CALL create_3c_t(bs_env%t_RI__AO_AO, bs_env%para_env_tensor, "(RI | AO AO)", [1], [2, 3], &
798 bs_env%sizes_RI, bs_env%sizes_AO)
799
800 CALL create_2c_t(bs_env, bs_env%sizes_RI, bs_env%sizes_AO)
801
802 CALL timestop(handle)
803
804 END SUBROUTINE create_tensors
805
806! **************************************************************************************************
807!> \brief ...
808!> \param qs_env ...
809!> \param bs_env ...
810! **************************************************************************************************
811 SUBROUTINE check_sparsity_3c(qs_env, bs_env)
812 TYPE(qs_environment_type), POINTER :: qs_env
813 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
814
815 CHARACTER(LEN=*), PARAMETER :: routinen = 'check_sparsity_3c'
816
817 INTEGER :: handle, n_atom_step, ri_atom
818 INTEGER(int_8) :: mem, non_zero_elements_sum, nze
819 REAL(dp) :: max_dist_ao_atoms, occ, occupation_sum
820 REAL(kind=dp) :: t1, t2
821 TYPE(dbt_type) :: t_3c_global
822 TYPE(dbt_type), ALLOCATABLE, DIMENSION(:, :) :: t_3c_global_array
823 TYPE(neighbor_list_3c_type) :: nl_3c_global
824
825 CALL timeset(routinen, handle)
826
827 ! check the sparsity of 3c integral tensor (µν|P); calculate maximum distance between
828 ! AO atoms µ, ν where at least a single integral (µν|P) is larger than the filter threshold
829 CALL create_3c_t(t_3c_global, bs_env%para_env, "(RI AO | AO)", [1, 2], [3], &
830 bs_env%sizes_RI, bs_env%sizes_AO, &
831 create_nl_3c=.true., nl_3c=nl_3c_global, qs_env=qs_env)
832
833 CALL m_memory(mem)
834 CALL bs_env%para_env%max(mem)
835
836 ALLOCATE (t_3c_global_array(1, 1))
837 CALL dbt_create(t_3c_global, t_3c_global_array(1, 1))
838
839 CALL bs_env%para_env%sync()
840 t1 = m_walltime()
841
842 occupation_sum = 0.0_dp
843 non_zero_elements_sum = 0
844 max_dist_ao_atoms = 0.0_dp
845 n_atom_step = int(sqrt(real(bs_env%n_atom, kind=dp)))
846 ! do not compute full 3c integrals at once because it may cause out of memory
847 DO ri_atom = 1, bs_env%n_atom, n_atom_step
848
849 CALL build_3c_integrals(t_3c_global_array, &
850 bs_env%eps_filter, &
851 qs_env, &
852 nl_3c_global, &
853 int_eps=bs_env%eps_filter, &
854 basis_i=bs_env%basis_set_RI, &
855 basis_j=bs_env%basis_set_AO, &
856 basis_k=bs_env%basis_set_AO, &
857 bounds_i=[ri_atom, min(ri_atom + n_atom_step - 1, bs_env%n_atom)], &
858 potential_parameter=bs_env%ri_metric, &
859 desymmetrize=.false.)
860
861 CALL dbt_filter(t_3c_global_array(1, 1), bs_env%eps_filter)
862
863 CALL bs_env%para_env%sync()
864
865 CALL get_tensor_occupancy(t_3c_global_array(1, 1), nze, occ)
866 non_zero_elements_sum = non_zero_elements_sum + nze
867 occupation_sum = occupation_sum + occ
868
869 CALL get_max_dist_ao_atoms(t_3c_global_array(1, 1), max_dist_ao_atoms, qs_env)
870
871 CALL dbt_clear(t_3c_global_array(1, 1))
872
873 END DO
874
875 t2 = m_walltime()
876
877 bs_env%occupation_3c_int = occupation_sum
878 bs_env%max_dist_AO_atoms = max_dist_ao_atoms
879
880 CALL dbt_destroy(t_3c_global)
881 CALL dbt_destroy(t_3c_global_array(1, 1))
882 DEALLOCATE (t_3c_global_array)
883
884 CALL neighbor_list_3c_destroy(nl_3c_global)
885
886 IF (bs_env%unit_nr > 0) THEN
887 WRITE (bs_env%unit_nr, '(T2,A)') ''
888 WRITE (bs_env%unit_nr, '(T2,A,F27.1,A)') &
889 µν'Computed 3-center integrals (|P), execution time', t2 - t1, ' s'
890 WRITE (bs_env%unit_nr, '(T2,A,F48.3,A)') µν'Percentage of non-zero (|P)', &
891 occupation_sum*100, ' %'
892 WRITE (bs_env%unit_nr, '(T2,A,F33.1,A)') µνµν'Max. distance between , in non-zero (|P)', &
893 max_dist_ao_atoms*angstrom, ' A'
894 WRITE (bs_env%unit_nr, '(T2,2A,I20,A)') 'Required memory if storing all 3-center ', &
895 µν'integrals (|P)', int(real(non_zero_elements_sum, kind=dp)*8.0e-9_dp), ' GB'
896 END IF
897
898 CALL timestop(handle)
899
900 END SUBROUTINE check_sparsity_3c
901
902! **************************************************************************************************
903!> \brief ...
904!> \param bs_env ...
905!> \param sizes_RI ...
906!> \param sizes_AO ...
907! **************************************************************************************************
908 SUBROUTINE create_2c_t(bs_env, sizes_RI, sizes_AO)
909 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
910 INTEGER, ALLOCATABLE, DIMENSION(:) :: sizes_ri, sizes_ao
911
912 CHARACTER(LEN=*), PARAMETER :: routinen = 'create_2c_t'
913
914 INTEGER :: handle
915 INTEGER, ALLOCATABLE, DIMENSION(:) :: dist_1, dist_2
916 INTEGER, DIMENSION(2) :: pdims_2d
917 TYPE(dbt_pgrid_type) :: pgrid_2d
918
919 CALL timeset(routinen, handle)
920
921 ! inspired from rpa_im_time.F / hfx_types.F
922
923 pdims_2d = 0
924 CALL dbt_pgrid_create(bs_env%para_env_tensor, pdims_2d, pgrid_2d)
925
926 CALL create_2c_tensor(bs_env%t_G, dist_1, dist_2, pgrid_2d, sizes_ao, sizes_ao, &
927 name="(AO | AO)")
928 DEALLOCATE (dist_1, dist_2)
929 CALL create_2c_tensor(bs_env%t_chi, dist_1, dist_2, pgrid_2d, sizes_ri, sizes_ri, &
930 name="(RI | RI)")
931 DEALLOCATE (dist_1, dist_2)
932 CALL create_2c_tensor(bs_env%t_W, dist_1, dist_2, pgrid_2d, sizes_ri, sizes_ri, &
933 name="(RI | RI)")
934 DEALLOCATE (dist_1, dist_2)
935 CALL dbt_pgrid_destroy(pgrid_2d)
936
937 CALL timestop(handle)
938
939 END SUBROUTINE create_2c_t
940
941! **************************************************************************************************
942!> \brief ...
943!> \param tensor ...
944!> \param para_env ...
945!> \param tensor_name ...
946!> \param map1 ...
947!> \param map2 ...
948!> \param sizes_RI ...
949!> \param sizes_AO ...
950!> \param create_nl_3c ...
951!> \param nl_3c ...
952!> \param qs_env ...
953! **************************************************************************************************
954 SUBROUTINE create_3c_t(tensor, para_env, tensor_name, map1, map2, sizes_RI, sizes_AO, &
955 create_nl_3c, nl_3c, qs_env)
956 TYPE(dbt_type) :: tensor
957 TYPE(mp_para_env_type), POINTER :: para_env
958 CHARACTER(LEN=12) :: tensor_name
959 INTEGER, DIMENSION(:) :: map1, map2
960 INTEGER, ALLOCATABLE, DIMENSION(:) :: sizes_ri, sizes_ao
961 LOGICAL, OPTIONAL :: create_nl_3c
962 TYPE(neighbor_list_3c_type), OPTIONAL :: nl_3c
963 TYPE(qs_environment_type), OPTIONAL, POINTER :: qs_env
964
965 CHARACTER(LEN=*), PARAMETER :: routinen = 'create_3c_t'
966
967 INTEGER :: handle, nkind
968 INTEGER, ALLOCATABLE, DIMENSION(:) :: dist_ao_1, dist_ao_2, dist_ri
969 INTEGER, DIMENSION(3) :: pcoord, pdims, pdims_3d
970 LOGICAL :: my_create_nl_3c
971 TYPE(dbt_pgrid_type) :: pgrid_3d
972 TYPE(distribution_3d_type) :: dist_3d
973 TYPE(mp_cart_type) :: mp_comm_t3c_2
974 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
975
976 CALL timeset(routinen, handle)
977
978 pdims_3d = 0
979 CALL dbt_pgrid_create(para_env, pdims_3d, pgrid_3d)
980 CALL create_3c_tensor(tensor, dist_ri, dist_ao_1, dist_ao_2, &
981 pgrid_3d, sizes_ri, sizes_ao, sizes_ao, &
982 map1=map1, map2=map2, name=tensor_name)
983
984 IF (PRESENT(create_nl_3c)) THEN
985 my_create_nl_3c = create_nl_3c
986 ELSE
987 my_create_nl_3c = .false.
988 END IF
989
990 IF (my_create_nl_3c) THEN
991 CALL get_qs_env(qs_env, nkind=nkind, particle_set=particle_set)
992 CALL dbt_mp_environ_pgrid(pgrid_3d, pdims, pcoord)
993 CALL mp_comm_t3c_2%create(pgrid_3d%mp_comm_2d, 3, pdims)
994 CALL distribution_3d_create(dist_3d, dist_ri, dist_ao_1, dist_ao_2, &
995 nkind, particle_set, mp_comm_t3c_2, own_comm=.true.)
996
997 CALL build_3c_neighbor_lists(nl_3c, &
998 qs_env%bs_env%basis_set_RI, &
999 qs_env%bs_env%basis_set_AO, &
1000 qs_env%bs_env%basis_set_AO, &
1001 dist_3d, qs_env%bs_env%ri_metric, &
1002 "GW_3c_nl", qs_env, own_dist=.true.)
1003 END IF
1004
1005 DEALLOCATE (dist_ri, dist_ao_1, dist_ao_2)
1006 CALL dbt_pgrid_destroy(pgrid_3d)
1007
1008 CALL timestop(handle)
1009
1010 END SUBROUTINE create_3c_t
1011
1012! **************************************************************************************************
1013!> \brief ...
1014!> \param bs_env ...
1015! **************************************************************************************************
1016 SUBROUTINE init_interaction_radii(bs_env)
1017 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1018
1019 CHARACTER(LEN=*), PARAMETER :: routinen = 'init_interaction_radii'
1020
1021 INTEGER :: handle, ibasis
1022 TYPE(gto_basis_set_type), POINTER :: orb_basis, ri_basis
1023
1024 CALL timeset(routinen, handle)
1025
1026 DO ibasis = 1, SIZE(bs_env%basis_set_AO)
1027
1028 orb_basis => bs_env%basis_set_AO(ibasis)%gto_basis_set
1029 CALL init_interaction_radii_orb_basis(orb_basis, bs_env%eps_filter)
1030
1031 ri_basis => bs_env%basis_set_RI(ibasis)%gto_basis_set
1032 CALL init_interaction_radii_orb_basis(ri_basis, bs_env%eps_filter)
1033
1034 END DO
1035
1036 CALL timestop(handle)
1037
1038 END SUBROUTINE init_interaction_radii
1039
1040! **************************************************************************************************
1041!> \brief ...
1042!> \param t_3c_int ...
1043!> \param max_dist_AO_atoms ...
1044!> \param qs_env ...
1045! **************************************************************************************************
1046 SUBROUTINE get_max_dist_ao_atoms(t_3c_int, max_dist_AO_atoms, qs_env)
1047 TYPE(dbt_type) :: t_3c_int
1048 REAL(kind=dp) :: max_dist_ao_atoms
1049 TYPE(qs_environment_type), POINTER :: qs_env
1050
1051 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_max_dist_AO_atoms'
1052
1053 INTEGER :: atom_1, atom_2, handle, num_cells
1054 INTEGER, DIMENSION(3) :: atom_ind
1055 INTEGER, DIMENSION(:, :), POINTER :: index_to_cell
1056 REAL(kind=dp) :: abs_rab
1057 REAL(kind=dp), DIMENSION(3) :: rab
1058 TYPE(cell_type), POINTER :: cell
1059 TYPE(dbt_iterator_type) :: iter
1060 TYPE(mp_para_env_type), POINTER :: para_env
1061 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1062
1063 CALL timeset(routinen, handle)
1064
1065 NULLIFY (cell, particle_set, para_env)
1066 CALL get_qs_env(qs_env, cell=cell, particle_set=particle_set, para_env=para_env)
1067
1068!$OMP PARALLEL DEFAULT(NONE) &
1069!$OMP SHARED(t_3c_int, max_dist_AO_atoms, num_cells, index_to_cell, particle_set, cell) &
1070!$OMP PRIVATE(iter,atom_ind,rab, abs_rab, atom_1, atom_2)
1071 CALL dbt_iterator_start(iter, t_3c_int)
1072 DO WHILE (dbt_iterator_blocks_left(iter))
1073 CALL dbt_iterator_next_block(iter, atom_ind)
1074
1075 atom_1 = atom_ind(2)
1076 atom_2 = atom_ind(3)
1077
1078 rab = pbc(particle_set(atom_1)%r(1:3), particle_set(atom_2)%r(1:3), cell)
1079
1080 abs_rab = sqrt(rab(1)**2 + rab(2)**2 + rab(3)**2)
1081
1082 max_dist_ao_atoms = max(max_dist_ao_atoms, abs_rab)
1083
1084 END DO
1085 CALL dbt_iterator_stop(iter)
1086!$OMP END PARALLEL
1087
1088 CALL para_env%max(max_dist_ao_atoms)
1089
1090 CALL timestop(handle)
1091
1092 END SUBROUTINE get_max_dist_ao_atoms
1093
1094! **************************************************************************************************
1095!> \brief ...
1096!> \param bs_env ...
1097! **************************************************************************************************
1098 SUBROUTINE set_sparsity_parallelization_parameters(bs_env)
1099 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1100
1101 CHARACTER(LEN=*), PARAMETER :: routinen = 'set_sparsity_parallelization_parameters'
1102
1103 INTEGER :: handle, i_ivl, il_ivl, j_ivl, n_atom_per_il_ivl, n_atom_per_ivl, n_intervals_i, &
1104 n_intervals_inner_loop_atoms, n_intervals_j, u
1105 INTEGER(KIND=int_8) :: input_memory_per_proc
1106
1107 CALL timeset(routinen, handle)
1108
1109 ! heuristic parameter to prevent out of memory
1110 bs_env%safety_factor_memory = 0.10_dp
1111
1112 input_memory_per_proc = int(bs_env%input_memory_per_proc_GB*1.0e9_dp, kind=int_8)
1113
1114 ! choose atomic range for λ ("i_atom"), ν ("j_atom") in
1115 ! M_λνP(iτ) = sum_µ (µν|P) G^occ_µλ(i|τ|,k=0)
1116 ! N_νλQ(iτ) = sum_σ (σλ|Q) G^vir_σν(i|τ|,k=0)
1117 ! such that M and N fit into the memory
1118 n_atom_per_ivl = int(sqrt(bs_env%safety_factor_memory*input_memory_per_proc &
1119 *bs_env%group_size_tensor/24/bs_env%n_RI &
1120 /sqrt(bs_env%occupation_3c_int)))/bs_env%max_AO_bf_per_atom
1121
1122 n_intervals_i = (bs_env%n_atom_i - 1)/n_atom_per_ivl + 1
1123 n_intervals_j = (bs_env%n_atom_j - 1)/n_atom_per_ivl + 1
1124
1125 bs_env%n_atom_per_interval_ij = n_atom_per_ivl
1126 bs_env%n_intervals_i = n_intervals_i
1127 bs_env%n_intervals_j = n_intervals_j
1128
1129 ALLOCATE (bs_env%i_atom_intervals(2, n_intervals_i))
1130 ALLOCATE (bs_env%j_atom_intervals(2, n_intervals_j))
1131
1132 DO i_ivl = 1, n_intervals_i
1133 bs_env%i_atom_intervals(1, i_ivl) = (i_ivl - 1)*n_atom_per_ivl + bs_env%atoms_i(1)
1134 bs_env%i_atom_intervals(2, i_ivl) = min(i_ivl*n_atom_per_ivl + bs_env%atoms_i(1) - 1, &
1135 bs_env%atoms_i(2))
1136 END DO
1137
1138 DO j_ivl = 1, n_intervals_j
1139 bs_env%j_atom_intervals(1, j_ivl) = (j_ivl - 1)*n_atom_per_ivl + bs_env%atoms_j(1)
1140 bs_env%j_atom_intervals(2, j_ivl) = min(j_ivl*n_atom_per_ivl + bs_env%atoms_j(1) - 1, &
1141 bs_env%atoms_j(2))
1142 END DO
1143
1144 ALLOCATE (bs_env%skip_Sigma_occ(n_intervals_i, n_intervals_j))
1145 ALLOCATE (bs_env%skip_Sigma_vir(n_intervals_i, n_intervals_j))
1146 bs_env%skip_Sigma_occ(:, :) = .false.
1147 bs_env%skip_Sigma_vir(:, :) = .false.
1148
1149 ! choose atomic range for µ and σ ("inner loop (IL) atom") in
1150 ! M_λνP(iτ) = sum_µ (µν|P) G^occ_µλ(i|τ|,k=0)
1151 ! N_νλQ(iτ) = sum_σ (σλ|Q) G^vir_σν(i|τ|,k=0)
1152 n_atom_per_il_ivl = min(int(bs_env%safety_factor_memory*input_memory_per_proc &
1153 *bs_env%group_size_tensor/n_atom_per_ivl &
1154 /bs_env%max_AO_bf_per_atom &
1155 /bs_env%n_RI/8/sqrt(bs_env%occupation_3c_int) &
1156 /bs_env%max_AO_bf_per_atom), bs_env%n_atom)
1157
1158 n_intervals_inner_loop_atoms = (bs_env%n_atom - 1)/n_atom_per_il_ivl + 1
1159
1160 bs_env%n_atom_per_IL_interval = n_atom_per_il_ivl
1161 bs_env%n_intervals_inner_loop_atoms = n_intervals_inner_loop_atoms
1162
1163 ALLOCATE (bs_env%inner_loop_atom_intervals(2, n_intervals_inner_loop_atoms))
1164 DO il_ivl = 1, n_intervals_inner_loop_atoms
1165 bs_env%inner_loop_atom_intervals(1, il_ivl) = (il_ivl - 1)*n_atom_per_il_ivl + 1
1166 bs_env%inner_loop_atom_intervals(2, il_ivl) = min(il_ivl*n_atom_per_il_ivl, bs_env%n_atom)
1167 END DO
1168
1169 u = bs_env%unit_nr
1170 IF (u > 0) THEN
1171 WRITE (u, '(T2,A)') ''
1172 WRITE (u, '(T2,A,I33)') λντνλτ'Number of i and j atoms in M_P(), N_Q():', n_atom_per_ivl
1173 WRITE (u, '(T2,A,I18)') µλνµµνµλ'Number of inner loop atoms for in M_P = sum_ (|P) G_', &
1174 n_atom_per_il_ivl
1175 END IF
1176
1177 CALL timestop(handle)
1178
1179 END SUBROUTINE set_sparsity_parallelization_parameters
1180
1181! **************************************************************************************************
1182!> \brief ...
1183!> \param qs_env ...
1184!> \param bs_env ...
1185! **************************************************************************************************
1186 SUBROUTINE check_for_restart_files(qs_env, bs_env)
1187 TYPE(qs_environment_type), POINTER :: qs_env
1188 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1189
1190 CHARACTER(LEN=*), PARAMETER :: routinen = 'check_for_restart_files'
1191
1192 CHARACTER(LEN=9) :: frmt
1193 CHARACTER(len=default_path_length) :: project_name
1194 CHARACTER(len=default_string_length) :: f_chi, f_s_n, f_s_p, f_s_x, f_w_t, prefix
1195 INTEGER :: handle, i_spin, i_t_or_w, ind, n_spin, &
1196 num_time_freq_points
1197 LOGICAL :: chi_exists, sigma_neg_time_exists, &
1198 sigma_pos_time_exists, &
1199 sigma_x_spin_exists, w_time_exists
1200 TYPE(cp_logger_type), POINTER :: logger
1201 TYPE(section_vals_type), POINTER :: input, print_key
1202
1203 CALL timeset(routinen, handle)
1204
1205 num_time_freq_points = bs_env%num_time_freq_points
1206 n_spin = bs_env%n_spin
1207
1208 ALLOCATE (bs_env%read_chi(num_time_freq_points))
1209 ALLOCATE (bs_env%calc_chi(num_time_freq_points))
1210 ALLOCATE (bs_env%Sigma_c_exists(num_time_freq_points, n_spin))
1211
1212 CALL get_qs_env(qs_env, input=input)
1213
1214 logger => cp_get_default_logger()
1215 print_key => section_vals_get_subs_vals(input, 'PROPERTIES%BANDSTRUCTURE%GW%PRINT%RESTART')
1216 project_name = cp_print_key_generate_filename(logger, print_key, extension="", &
1217 my_local=.false.)
1218 WRITE (prefix, '(2A)') trim(project_name), "-RESTART_"
1219 bs_env%prefix = prefix
1220
1221 bs_env%all_W_exist = .true.
1222
1223 DO i_t_or_w = 1, num_time_freq_points
1224
1225 IF (i_t_or_w < 10) THEN
1226 WRITE (frmt, '(A)') '(3A,I1,A)'
1227 WRITE (f_chi, frmt) trim(prefix), bs_env%chi_name, "_0", i_t_or_w, ".matrix"
1228 WRITE (f_w_t, frmt) trim(prefix), bs_env%W_time_name, "_0", i_t_or_w, ".matrix"
1229 ELSE IF (i_t_or_w < 100) THEN
1230 WRITE (frmt, '(A)') '(3A,I2,A)'
1231 WRITE (f_chi, frmt) trim(prefix), bs_env%chi_name, "_", i_t_or_w, ".matrix"
1232 WRITE (f_w_t, frmt) trim(prefix), bs_env%W_time_name, "_", i_t_or_w, ".matrix"
1233 ELSE
1234 cpabort('Please implement more than 99 time/frequency points.')
1235 END IF
1236
1237 INQUIRE (file=trim(f_chi), exist=chi_exists)
1238 INQUIRE (file=trim(f_w_t), exist=w_time_exists)
1239
1240 bs_env%read_chi(i_t_or_w) = chi_exists
1241 bs_env%calc_chi(i_t_or_w) = .NOT. chi_exists
1242
1243 bs_env%all_W_exist = bs_env%all_W_exist .AND. w_time_exists
1244
1245 ! the self-energy is spin-dependent
1246 DO i_spin = 1, n_spin
1247
1248 ind = i_t_or_w + (i_spin - 1)*num_time_freq_points
1249
1250 IF (ind < 10) THEN
1251 WRITE (frmt, '(A)') '(3A,I1,A)'
1252 WRITE (f_s_p, frmt) trim(prefix), bs_env%Sigma_p_name, "_0", ind, ".matrix"
1253 WRITE (f_s_n, frmt) trim(prefix), bs_env%Sigma_n_name, "_0", ind, ".matrix"
1254 ELSE IF (i_t_or_w < 100) THEN
1255 WRITE (frmt, '(A)') '(3A,I2,A)'
1256 WRITE (f_s_p, frmt) trim(prefix), bs_env%Sigma_p_name, "_", ind, ".matrix"
1257 WRITE (f_s_n, frmt) trim(prefix), bs_env%Sigma_n_name, "_", ind, ".matrix"
1258 END IF
1259
1260 INQUIRE (file=trim(f_s_p), exist=sigma_pos_time_exists)
1261 INQUIRE (file=trim(f_s_n), exist=sigma_neg_time_exists)
1262
1263 bs_env%Sigma_c_exists(i_t_or_w, i_spin) = sigma_pos_time_exists .AND. &
1264 sigma_neg_time_exists
1265
1266 END DO
1267
1268 END DO
1269
1270 ! Marek : In the RTBSE run, check also for zero frequency W
1271 IF (bs_env%rtp_method == rtp_method_bse) THEN
1272 WRITE (f_w_t, '(3A,I1,A)') trim(prefix), "W_freq_rtp", "_0", 0, ".matrix"
1273 INQUIRE (file=trim(f_w_t), exist=w_time_exists)
1274 bs_env%all_W_exist = bs_env%all_W_exist .AND. w_time_exists
1275 END IF
1276
1277 IF (bs_env%all_W_exist) THEN
1278 bs_env%read_chi(:) = .false.
1279 bs_env%calc_chi(:) = .false.
1280 END IF
1281
1282 bs_env%Sigma_x_exists = .true.
1283 DO i_spin = 1, n_spin
1284 WRITE (f_s_x, '(3A,I1,A)') trim(prefix), bs_env%Sigma_x_name, "_0", i_spin, ".matrix"
1285 INQUIRE (file=trim(f_s_x), exist=sigma_x_spin_exists)
1286 bs_env%Sigma_x_exists = bs_env%Sigma_x_exists .AND. sigma_x_spin_exists
1287 END DO
1288
1289 ! If any restart files are read, check if the SCF converged in 1 step.
1290 ! This is important because a re-iterated SCF can lead to spurious GW results
1291 IF (any(bs_env%read_chi(:)) &
1292 .OR. any(bs_env%Sigma_c_exists) &
1293 .OR. bs_env%all_W_exist &
1294 .OR. bs_env%Sigma_x_exists &
1295 ) THEN
1296
1297 IF (qs_env%scf_env%iter_count /= 1) THEN
1298 CALL cp_warn(__location__, "SCF needed more than 1 step, "// &
1299 "which might lead to spurious GW results when using GW restart files. ")
1300 END IF
1301 END IF
1302
1303 CALL timestop(handle)
1304
1305 END SUBROUTINE check_for_restart_files
1306
1307! **************************************************************************************************
1308!> \brief ...
1309!> \param qs_env ...
1310!> \param bs_env ...
1311! **************************************************************************************************
1312 SUBROUTINE set_parallelization_parameters(qs_env, bs_env)
1313 TYPE(qs_environment_type), POINTER :: qs_env
1314 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1315
1316 CHARACTER(LEN=*), PARAMETER :: routinen = 'set_parallelization_parameters'
1317
1318 INTEGER :: color_sub, dummy_1, dummy_2, handle, &
1319 num_pe, num_t_groups, u
1320 INTEGER(KIND=int_8) :: mem
1321 TYPE(mp_para_env_type), POINTER :: para_env
1322
1323 CALL timeset(routinen, handle)
1324
1325 CALL get_qs_env(qs_env, para_env=para_env)
1326
1327 num_pe = para_env%num_pe
1328 ! if not already set, use all processors for the group (for large-cell GW, performance
1329 ! seems to be best for a single group with all MPI processes per group)
1330 IF (bs_env%group_size_tensor < 0 .OR. bs_env%group_size_tensor > num_pe) &
1331 bs_env%group_size_tensor = num_pe
1332
1333 ! group_size_tensor must divide num_pe without rest; otherwise everything will be complicated
1334 IF (modulo(num_pe, bs_env%group_size_tensor) /= 0) THEN
1335 CALL find_good_group_size(num_pe, bs_env%group_size_tensor)
1336 END IF
1337
1338 ! para_env_tensor for tensor subgroups
1339 color_sub = para_env%mepos/bs_env%group_size_tensor
1340 bs_env%tensor_group_color = color_sub
1341
1342 ALLOCATE (bs_env%para_env_tensor)
1343 CALL bs_env%para_env_tensor%from_split(para_env, color_sub)
1344
1345 num_t_groups = para_env%num_pe/bs_env%group_size_tensor
1346 bs_env%num_tensor_groups = num_t_groups
1347
1348 CALL get_i_j_atoms(bs_env%atoms_i, bs_env%atoms_j, bs_env%n_atom_i, bs_env%n_atom_j, &
1349 color_sub, bs_env)
1350
1351 ALLOCATE (bs_env%atoms_i_t_group(2, num_t_groups))
1352 ALLOCATE (bs_env%atoms_j_t_group(2, num_t_groups))
1353 DO color_sub = 0, num_t_groups - 1
1354 CALL get_i_j_atoms(bs_env%atoms_i_t_group(1:2, color_sub + 1), &
1355 bs_env%atoms_j_t_group(1:2, color_sub + 1), &
1356 dummy_1, dummy_2, color_sub, bs_env)
1357 END DO
1358
1359 CALL m_memory(mem)
1360 CALL bs_env%para_env%max(mem)
1361
1362 u = bs_env%unit_nr
1363 IF (u > 0) THEN
1364 WRITE (u, '(T2,A,I47)') 'Group size for tensor operations', bs_env%group_size_tensor
1365 IF (bs_env%group_size_tensor > 1 .AND. bs_env%n_atom < 5) THEN
1366 WRITE (u, '(T2,A)') 'The requested group size is > 1 which can lead to bad performance.'
1367 WRITE (u, '(T2,A)') 'Using more memory per MPI process might improve performance.'
1368 WRITE (u, '(T2,A)') '(Also increase MEMORY_PER_PROC when using more memory per process.)'
1369 END IF
1370 END IF
1371
1372 CALL timestop(handle)
1373
1374 END SUBROUTINE set_parallelization_parameters
1375
1376! **************************************************************************************************
1377!> \brief ...
1378!> \param num_pe ...
1379!> \param group_size ...
1380! **************************************************************************************************
1381 SUBROUTINE find_good_group_size(num_pe, group_size)
1382
1383 INTEGER :: num_pe, group_size
1384
1385 CHARACTER(LEN=*), PARAMETER :: routinen = 'find_good_group_size'
1386
1387 INTEGER :: group_size_minus, group_size_orig, &
1388 group_size_plus, handle, i_diff
1389
1390 CALL timeset(routinen, handle)
1391
1392 group_size_orig = group_size
1393
1394 DO i_diff = 1, num_pe
1395
1396 group_size_minus = group_size - i_diff
1397
1398 IF (modulo(num_pe, group_size_minus) == 0 .AND. group_size_minus > 0) THEN
1399 group_size = group_size_minus
1400 EXIT
1401 END IF
1402
1403 group_size_plus = group_size + i_diff
1404
1405 IF (modulo(num_pe, group_size_plus) == 0 .AND. group_size_plus <= num_pe) THEN
1406 group_size = group_size_plus
1407 EXIT
1408 END IF
1409
1410 END DO
1411
1412 IF (group_size_orig == group_size) cpabort("Group size error")
1413
1414 CALL timestop(handle)
1415
1416 END SUBROUTINE find_good_group_size
1417
1418! **************************************************************************************************
1419!> \brief ...
1420!> \param atoms_i ...
1421!> \param atoms_j ...
1422!> \param n_atom_i ...
1423!> \param n_atom_j ...
1424!> \param color_sub ...
1425!> \param bs_env ...
1426! **************************************************************************************************
1427 SUBROUTINE get_i_j_atoms(atoms_i, atoms_j, n_atom_i, n_atom_j, color_sub, bs_env)
1428
1429 INTEGER, DIMENSION(2) :: atoms_i, atoms_j
1430 INTEGER :: n_atom_i, n_atom_j, color_sub
1431 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1432
1433 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_i_j_atoms'
1434
1435 INTEGER :: handle, i_atoms_per_group, i_group, &
1436 ipcol, ipcol_loop, iprow, iprow_loop, &
1437 j_atoms_per_group, npcol, nprow
1438
1439 CALL timeset(routinen, handle)
1440
1441 ! create a square mesh of tensor groups for iatom and jatom; code from blacs_env_create
1442 CALL square_mesh(nprow, npcol, bs_env%num_tensor_groups)
1443
1444 i_group = 0
1445 DO ipcol_loop = 0, npcol - 1
1446 DO iprow_loop = 0, nprow - 1
1447 IF (i_group == color_sub) THEN
1448 iprow = iprow_loop
1449 ipcol = ipcol_loop
1450 END IF
1451 i_group = i_group + 1
1452 END DO
1453 END DO
1454
1455 IF (modulo(bs_env%n_atom, nprow) == 0) THEN
1456 i_atoms_per_group = bs_env%n_atom/nprow
1457 ELSE
1458 i_atoms_per_group = bs_env%n_atom/nprow + 1
1459 END IF
1460
1461 IF (modulo(bs_env%n_atom, npcol) == 0) THEN
1462 j_atoms_per_group = bs_env%n_atom/npcol
1463 ELSE
1464 j_atoms_per_group = bs_env%n_atom/npcol + 1
1465 END IF
1466
1467 atoms_i(1) = iprow*i_atoms_per_group + 1
1468 atoms_i(2) = min((iprow + 1)*i_atoms_per_group, bs_env%n_atom)
1469 n_atom_i = atoms_i(2) - atoms_i(1) + 1
1470
1471 atoms_j(1) = ipcol*j_atoms_per_group + 1
1472 atoms_j(2) = min((ipcol + 1)*j_atoms_per_group, bs_env%n_atom)
1473 n_atom_j = atoms_j(2) - atoms_j(1) + 1
1474
1475 CALL timestop(handle)
1476
1477 END SUBROUTINE get_i_j_atoms
1478
1479! **************************************************************************************************
1480!> \brief ...
1481!> \param nprow ...
1482!> \param npcol ...
1483!> \param nproc ...
1484! **************************************************************************************************
1485 SUBROUTINE square_mesh(nprow, npcol, nproc)
1486 INTEGER :: nprow, npcol, nproc
1487
1488 CHARACTER(LEN=*), PARAMETER :: routinen = 'square_mesh'
1489
1490 INTEGER :: gcd_max, handle, ipe, jpe
1491
1492 CALL timeset(routinen, handle)
1493
1494 gcd_max = -1
1495 DO ipe = 1, ceiling(sqrt(real(nproc, dp)))
1496 jpe = nproc/ipe
1497 IF (ipe*jpe /= nproc) cycle
1498 IF (gcd(ipe, jpe) >= gcd_max) THEN
1499 nprow = ipe
1500 npcol = jpe
1501 gcd_max = gcd(ipe, jpe)
1502 END IF
1503 END DO
1504
1505 CALL timestop(handle)
1506
1507 END SUBROUTINE square_mesh
1508
1509! **************************************************************************************************
1510!> \brief ...
1511!> \param bs_env ...
1512!> \param qs_env ...
1513! **************************************************************************************************
1514 SUBROUTINE set_heuristic_parameters(bs_env, qs_env)
1515 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1516 TYPE(qs_environment_type), OPTIONAL, POINTER :: qs_env
1517
1518 CHARACTER(LEN=*), PARAMETER :: routinen = 'set_heuristic_parameters'
1519
1520 INTEGER :: handle, u
1521 LOGICAL :: do_bvk_cell
1522
1523 CALL timeset(routinen, handle)
1524
1525 ! for generating numerically stable minimax Fourier integration weights
1526 bs_env%num_points_per_magnitude = 200
1527
1528 IF (bs_env%input_regularization_minimax > -1.0e-12_dp) THEN
1529 bs_env%regularization_minimax = bs_env%input_regularization_minimax
1530 ELSE
1531 ! for periodic systems and for 20 minimax points, we use a regularized minimax mesh
1532 ! (from experience: regularized minimax meshes converges faster for periodic systems
1533 ! and for 20 pts)
1534 IF (sum(bs_env%periodic) /= 0 .OR. bs_env%num_time_freq_points >= 20) THEN
1535 bs_env%regularization_minimax = 1.0e-6_dp
1536 ELSE
1537 bs_env%regularization_minimax = 0.0_dp
1538 END IF
1539 END IF
1540
1541 bs_env%stabilize_exp = 70.0_dp
1542 bs_env%eps_atom_grid_2d_mat = 1.0e-50_dp
1543
1544 ! use a 16-parameter Padé fit
1545 bs_env%nparam_pade = 16
1546
1547 ! resolution of the identity with the truncated Coulomb metric, cutoff radius 3 Angström
1548 bs_env%ri_metric%potential_type = do_potential_truncated
1549 bs_env%ri_metric%omega = 0.0_dp
1550 ! cutoff radius is specified in the input
1551 bs_env%ri_metric%filename = "t_c_g.dat"
1552
1553 bs_env%eps_eigval_mat_RI = 0.0_dp
1554
1555 IF (bs_env%input_regularization_RI > -1.0e-12_dp) THEN
1556 bs_env%regularization_RI = bs_env%input_regularization_RI
1557 ELSE
1558 ! default case:
1559
1560 ! 1. for periodic systems, we use the regularized resolution of the identity per default
1561 bs_env%regularization_RI = 1.0e-2_dp
1562
1563 ! 2. for molecules, no regularization is necessary
1564 IF (sum(bs_env%periodic) == 0) bs_env%regularization_RI = 0.0_dp
1565
1566 END IF
1567
1568 ! truncated Coulomb operator for exchange self-energy
1569 ! (see details in Guidon, VandeVondele, Hutter, JCTC 5, 3010 (2009) and references therein)
1570 do_bvk_cell = bs_env%small_cell_full_kp_or_large_cell_Gamma == small_cell_full_kp
1571 CALL trunc_coulomb_for_exchange(qs_env, bs_env%trunc_coulomb, &
1572 rel_cutoff_trunc_coulomb_ri_x=0.5_dp, &
1573 cell_grid=bs_env%cell_grid_scf_desymm, &
1574 do_bvk_cell=do_bvk_cell)
1575
1576 ! for small-cell GW, we need more cells than normally used by the filter bs_env%eps_filter
1577 ! (in particular for computing the self-energy because of higher number of cells needed)
1578 bs_env%heuristic_filter_factor = 1.0e-4
1579
1580 u = bs_env%unit_nr
1581 IF (u > 0) THEN
1582 WRITE (u, fmt="(T2,2A,F21.1,A)") "Cutoff radius for the truncated Coulomb ", &
1583 Σ"operator in ^x:", bs_env%trunc_coulomb%cutoff_radius*angstrom, Å" "
1584 WRITE (u, fmt="(T2,2A,F15.1,A)") "Cutoff radius for the truncated Coulomb ", &
1585 "operator in RI metric:", bs_env%ri_metric%cutoff_radius*angstrom, Å" "
1586 WRITE (u, fmt="(T2,A,ES48.1)") "Regularization parameter of RI ", bs_env%regularization_RI
1587 WRITE (u, fmt="(T2,A,ES38.1)") "Regularization parameter of minimax grids", &
1588 bs_env%regularization_minimax
1589 WRITE (u, fmt="(T2,A,I53)") "Lattice sum size for V(k):", bs_env%size_lattice_sum_V
1590 END IF
1591
1592 CALL timestop(handle)
1593
1594 END SUBROUTINE set_heuristic_parameters
1595
1596! **************************************************************************************************
1597!> \brief ...
1598!> \param bs_env ...
1599! **************************************************************************************************
1600 SUBROUTINE print_header_and_input_parameters(bs_env)
1601
1602 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1603
1604 CHARACTER(LEN=*), PARAMETER :: routinen = 'print_header_and_input_parameters'
1605
1606 INTEGER :: handle, u
1607
1608 CALL timeset(routinen, handle)
1609
1610 u = bs_env%unit_nr
1611
1612 IF (u > 0) THEN
1613 WRITE (u, '(T2,A)') ' '
1614 WRITE (u, '(T2,A)') repeat('-', 79)
1615 WRITE (u, '(T2,A,A78)') '-', '-'
1616 WRITE (u, '(T2,A,A46,A32)') '-', 'GW CALCULATION', '-'
1617 WRITE (u, '(T2,A,A78)') '-', '-'
1618 WRITE (u, '(T2,A)') repeat('-', 79)
1619 WRITE (u, '(T2,A)') ' '
1620 WRITE (u, '(T2,A,I45)') 'Input: Number of time/freq. points', bs_env%num_time_freq_points
1621 WRITE (u, "(T2,A,F44.1,A)") ωΣω'Input: _max for fitting (i) (eV)', bs_env%freq_max_fit*evolt
1622 WRITE (u, '(T2,A,ES27.1)') 'Input: Filter threshold for sparse tensor operations', &
1623 bs_env%eps_filter
1624 WRITE (u, "(T2,A,L55)") 'Input: Apply Hedin shift', bs_env%do_hedin_shift
1625 END IF
1626
1627 CALL timestop(handle)
1628
1629 END SUBROUTINE print_header_and_input_parameters
1630
1631! **************************************************************************************************
1632!> \brief ...
1633!> \param qs_env ...
1634!> \param bs_env ...
1635! **************************************************************************************************
1636 SUBROUTINE compute_v_xc(qs_env, bs_env)
1637 TYPE(qs_environment_type), POINTER :: qs_env
1638 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1639
1640 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_V_xc'
1641
1642 INTEGER :: handle, img, ispin, myfun, nimages
1643 LOGICAL :: hf_present
1644 REAL(kind=dp) :: energy_ex, energy_exc, energy_total, &
1645 myfraction
1646 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mat_ks_without_v_xc
1647 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks_kp
1648 TYPE(dft_control_type), POINTER :: dft_control
1649 TYPE(qs_energy_type), POINTER :: energy
1650 TYPE(section_vals_type), POINTER :: hf_section, input, xc_section
1651
1652 CALL timeset(routinen, handle)
1653
1654 CALL get_qs_env(qs_env, input=input, energy=energy, dft_control=dft_control)
1655
1656 ! previously, dft_control%nimages set to # neighbor cells, revert for Γ-only KS matrix
1657 nimages = dft_control%nimages
1658 dft_control%nimages = bs_env%nimages_scf
1659
1660 ! we need to reset XC functional, therefore, get XC input
1661 xc_section => section_vals_get_subs_vals(input, "DFT%XC")
1662 CALL section_vals_val_get(xc_section, "XC_FUNCTIONAL%_SECTION_PARAMETERS_", i_val=myfun)
1663 CALL section_vals_val_set(xc_section, "XC_FUNCTIONAL%_SECTION_PARAMETERS_", i_val=xc_none)
1664 ! IF (ASSOCIATED(section_vals_get_subs_vals(xc_section, "HF", can_return_null=.TRUE.))) THEN
1665 hf_section => section_vals_get_subs_vals(input, "DFT%XC%HF", can_return_null=.true.)
1666 hf_present = .false.
1667 IF (ASSOCIATED(hf_section)) THEN
1668 CALL section_vals_get(hf_section, explicit=hf_present)
1669 END IF
1670 IF (hf_present) THEN
1671 ! Special case for handling hfx
1672 CALL section_vals_val_get(xc_section, "HF%FRACTION", r_val=myfraction)
1673 CALL section_vals_val_set(xc_section, "HF%FRACTION", r_val=0.0_dp)
1674 END IF
1675
1676 ! save the energy before the energy gets updated
1677 energy_total = energy%total
1678 energy_exc = energy%exc
1679 energy_ex = energy%ex
1680
1681 SELECT CASE (bs_env%small_cell_full_kp_or_large_cell_Gamma)
1682 CASE (large_cell_gamma)
1683
1684 NULLIFY (mat_ks_without_v_xc)
1685 CALL dbcsr_allocate_matrix_set(mat_ks_without_v_xc, bs_env%n_spin)
1686
1687 DO ispin = 1, bs_env%n_spin
1688 ALLOCATE (mat_ks_without_v_xc(ispin)%matrix)
1689 IF (hf_present) THEN
1690 CALL dbcsr_create(mat_ks_without_v_xc(ispin)%matrix, template=bs_env%mat_ao_ao%matrix, &
1691 matrix_type=dbcsr_type_symmetric)
1692 ELSE
1693 CALL dbcsr_create(mat_ks_without_v_xc(ispin)%matrix, template=bs_env%mat_ao_ao%matrix)
1694 END IF
1695 END DO
1696
1697 ! calculate KS-matrix without XC
1698 CALL qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces=.false., just_energy=.false., &
1699 ext_ks_matrix=mat_ks_without_v_xc)
1700
1701 DO ispin = 1, bs_env%n_spin
1702 ! transfer dbcsr matrix to fm
1703 CALL cp_fm_create(bs_env%fm_V_xc_Gamma(ispin), bs_env%fm_s_Gamma%matrix_struct)
1704 CALL copy_dbcsr_to_fm(mat_ks_without_v_xc(ispin)%matrix, bs_env%fm_V_xc_Gamma(ispin))
1705
1706 ! v_xc = h_ks - h_ks(v_xc = 0)
1707 CALL cp_fm_scale_and_add(alpha=-1.0_dp, matrix_a=bs_env%fm_V_xc_Gamma(ispin), &
1708 beta=1.0_dp, matrix_b=bs_env%fm_ks_Gamma(ispin))
1709 END DO
1710
1711 CALL dbcsr_deallocate_matrix_set(mat_ks_without_v_xc)
1712
1713 CASE (small_cell_full_kp)
1714
1715 ! calculate KS-matrix without XC
1716 CALL qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces=.false., just_energy=.false.)
1717 CALL get_qs_env(qs_env=qs_env, matrix_ks_kp=matrix_ks_kp)
1718
1719 ALLOCATE (bs_env%fm_V_xc_R(dft_control%nimages, bs_env%n_spin))
1720 DO ispin = 1, bs_env%n_spin
1721 DO img = 1, dft_control%nimages
1722 ! safe fm_V_xc_R in fm_matrix because saving in dbcsr matrix caused trouble...
1723 CALL copy_dbcsr_to_fm(matrix_ks_kp(ispin, img)%matrix, bs_env%fm_work_mo(1))
1724 CALL cp_fm_create(bs_env%fm_V_xc_R(img, ispin), bs_env%fm_work_mo(1)%matrix_struct, &
1725 set_zero=.true.)
1726 ! store h_ks(v_xc = 0) in fm_V_xc_R
1727 CALL cp_fm_scale_and_add(alpha=1.0_dp, matrix_a=bs_env%fm_V_xc_R(img, ispin), &
1728 beta=1.0_dp, matrix_b=bs_env%fm_work_mo(1))
1729 END DO
1730 END DO
1731
1732 END SELECT
1733
1734 ! set back the energy
1735 energy%total = energy_total
1736 energy%exc = energy_exc
1737 energy%ex = energy_ex
1738
1739 ! set back nimages
1740 dft_control%nimages = nimages
1741
1742 ! set the DFT functional and HF fraction back
1743 CALL section_vals_val_set(xc_section, "XC_FUNCTIONAL%_SECTION_PARAMETERS_", &
1744 i_val=myfun)
1745 IF (hf_present) THEN
1746 CALL section_vals_val_set(xc_section, "HF%FRACTION", &
1747 r_val=myfraction)
1748 END IF
1749
1750 IF (bs_env%small_cell_full_kp_or_large_cell_Gamma == small_cell_full_kp) THEN
1751 ! calculate KS-matrix again with XC
1752 CALL qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces=.false., just_energy=.false.)
1753 DO ispin = 1, bs_env%n_spin
1754 DO img = 1, dft_control%nimages
1755 ! store h_ks in fm_work_mo
1756 CALL copy_dbcsr_to_fm(matrix_ks_kp(ispin, img)%matrix, bs_env%fm_work_mo(1))
1757 ! v_xc = h_ks - h_ks(v_xc = 0)
1758 CALL cp_fm_scale_and_add(alpha=-1.0_dp, matrix_a=bs_env%fm_V_xc_R(img, ispin), &
1759 beta=1.0_dp, matrix_b=bs_env%fm_work_mo(1))
1760 END DO
1761 END DO
1762 END IF
1763
1764 CALL timestop(handle)
1765
1766 END SUBROUTINE compute_v_xc
1767
1768! **************************************************************************************************
1769!> \brief ...
1770!> \param bs_env ...
1771! **************************************************************************************************
1772 SUBROUTINE setup_time_and_frequency_minimax_grid(bs_env)
1773 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1774
1775 CHARACTER(LEN=*), PARAMETER :: routinen = 'setup_time_and_frequency_minimax_grid'
1776
1777 INTEGER :: handle, homo, i_w, ierr, ispin, j_w, &
1778 n_mo, num_time_freq_points, u
1779 REAL(kind=dp) :: e_max, e_max_ispin, e_min, e_min_ispin, &
1780 e_range, max_error_min
1781 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: points_and_weights
1782
1783 CALL timeset(routinen, handle)
1784
1785 n_mo = bs_env%n_ao
1786 num_time_freq_points = bs_env%num_time_freq_points
1787
1788 ALLOCATE (bs_env%imag_freq_points(num_time_freq_points))
1789 ALLOCATE (bs_env%imag_time_points(num_time_freq_points))
1790 ALLOCATE (bs_env%imag_time_weights_freq_zero(num_time_freq_points))
1791 ALLOCATE (bs_env%weights_cos_t_to_w(num_time_freq_points, num_time_freq_points))
1792 ALLOCATE (bs_env%weights_cos_w_to_t(num_time_freq_points, num_time_freq_points))
1793 ALLOCATE (bs_env%weights_sin_t_to_w(num_time_freq_points, num_time_freq_points))
1794
1795 ! minimum and maximum difference between eigenvalues of unoccupied and an occupied MOs
1796 e_min = 1000.0_dp
1797 e_max = -1000.0_dp
1798 DO ispin = 1, bs_env%n_spin
1799 homo = bs_env%n_occ(ispin)
1800 SELECT CASE (bs_env%small_cell_full_kp_or_large_cell_Gamma)
1801 CASE (large_cell_gamma)
1802 e_min_ispin = bs_env%eigenval_scf_Gamma(homo + 1, ispin) - &
1803 bs_env%eigenval_scf_Gamma(homo, ispin)
1804 e_max_ispin = bs_env%eigenval_scf_Gamma(n_mo, ispin) - &
1805 bs_env%eigenval_scf_Gamma(1, ispin)
1806 CASE (small_cell_full_kp)
1807 e_min_ispin = minval(bs_env%eigenval_scf(homo + 1, :, ispin)) - &
1808 maxval(bs_env%eigenval_scf(homo, :, ispin))
1809 e_max_ispin = maxval(bs_env%eigenval_scf(n_mo, :, ispin)) - &
1810 minval(bs_env%eigenval_scf(1, :, ispin))
1811 END SELECT
1812 e_min = min(e_min, e_min_ispin)
1813 e_max = max(e_max, e_max_ispin)
1814 END DO
1815
1816 e_range = e_max/e_min
1817
1818 ALLOCATE (points_and_weights(2*num_time_freq_points))
1819
1820 ! frequency points
1821 IF (num_time_freq_points <= 20) THEN
1822 CALL get_rpa_minimax_coeff(num_time_freq_points, e_range, points_and_weights, ierr, .false.)
1823 ELSE
1824 CALL get_rpa_minimax_coeff_larger_grid(num_time_freq_points, e_range, points_and_weights)
1825 END IF
1826
1827 ! one needs to scale the minimax grids, see Azizi, Wilhelm, Golze, Panades-Barrueta,
1828 ! Giantomassi, Rinke, Draxl, Gonze et al., 2 publications
1829 bs_env%imag_freq_points(:) = points_and_weights(1:num_time_freq_points)*e_min
1830
1831 ! determine number of fit points in the interval [0,ω_max] for virt, or [-ω_max,0] for occ
1832 bs_env%num_freq_points_fit = 0
1833 DO i_w = 1, num_time_freq_points
1834 IF (bs_env%imag_freq_points(i_w) < bs_env%freq_max_fit) THEN
1835 bs_env%num_freq_points_fit = bs_env%num_freq_points_fit + 1
1836 END IF
1837 END DO
1838
1839 ! iω values for the analytic continuation Σ^c_n(iω,k) -> Σ^c_n(ϵ,k)
1840 ALLOCATE (bs_env%imag_freq_points_fit(bs_env%num_freq_points_fit))
1841 j_w = 0
1842 DO i_w = 1, num_time_freq_points
1843 IF (bs_env%imag_freq_points(i_w) < bs_env%freq_max_fit) THEN
1844 j_w = j_w + 1
1845 bs_env%imag_freq_points_fit(j_w) = bs_env%imag_freq_points(i_w)
1846 END IF
1847 END DO
1848
1849 ! reset the number of Padé parameters if smaller than the number of
1850 ! imaginary-frequency points for the fit
1851 IF (bs_env%num_freq_points_fit < bs_env%nparam_pade) THEN
1852 bs_env%nparam_pade = bs_env%num_freq_points_fit
1853 END IF
1854
1855 ! time points
1856 IF (num_time_freq_points <= 20) THEN
1857 CALL get_exp_minimax_coeff(num_time_freq_points, e_range, points_and_weights)
1858 ELSE
1859 CALL get_exp_minimax_coeff_gw(num_time_freq_points, e_range, points_and_weights)
1860 END IF
1861
1862 bs_env%imag_time_points(:) = points_and_weights(1:num_time_freq_points)/(2.0_dp*e_min)
1863 bs_env%imag_time_weights_freq_zero(:) = points_and_weights(num_time_freq_points + 1:)/(e_min)
1864
1865 DEALLOCATE (points_and_weights)
1866
1867 u = bs_env%unit_nr
1868 IF (u > 0) THEN
1869 WRITE (u, '(T2,A)') ''
1870 WRITE (u, '(T2,A,F55.2)') 'SCF direct band gap (eV)', e_min*evolt
1871 WRITE (u, '(T2,A,F53.2)') 'Max. SCF eigval diff. (eV)', e_max*evolt
1872 WRITE (u, '(T2,A,F55.2)') 'E-Range for minimax grid', e_range
1873 WRITE (u, '(T2,A,I27)') é'Number of Pad parameters for analytic continuation:', &
1874 bs_env%nparam_pade
1875 WRITE (u, '(T2,A)') ''
1876 END IF
1877
1878 ! in minimax grids, Fourier transforms t -> w and w -> t are split using
1879 ! e^(iwt) = cos(wt) + i sin(wt); we thus calculate weights for trafos with a cos and
1880 ! sine prefactor; details in Azizi, Wilhelm, Golze, Giantomassi, Panades-Barrueta,
1881 ! Rinke, Draxl, Gonze et al., 2 publications
1882
1883 ! cosine transform weights imaginary time to imaginary frequency
1884 CALL get_l_sq_wghts_cos_tf_t_to_w(num_time_freq_points, &
1885 bs_env%imag_time_points, &
1886 bs_env%weights_cos_t_to_w, &
1887 bs_env%imag_freq_points, &
1888 e_min, e_max, max_error_min, &
1889 bs_env%num_points_per_magnitude, &
1890 bs_env%regularization_minimax)
1891
1892 ! cosine transform weights imaginary frequency to imaginary time
1893 CALL get_l_sq_wghts_cos_tf_w_to_t(num_time_freq_points, &
1894 bs_env%imag_time_points, &
1895 bs_env%weights_cos_w_to_t, &
1896 bs_env%imag_freq_points, &
1897 e_min, e_max, max_error_min, &
1898 bs_env%num_points_per_magnitude, &
1899 bs_env%regularization_minimax)
1900
1901 ! sine transform weights imaginary time to imaginary frequency
1902 CALL get_l_sq_wghts_sin_tf_t_to_w(num_time_freq_points, &
1903 bs_env%imag_time_points, &
1904 bs_env%weights_sin_t_to_w, &
1905 bs_env%imag_freq_points, &
1906 e_min, e_max, max_error_min, &
1907 bs_env%num_points_per_magnitude, &
1908 bs_env%regularization_minimax)
1909
1910 CALL timestop(handle)
1911
1912 END SUBROUTINE setup_time_and_frequency_minimax_grid
1913
1914! **************************************************************************************************
1915!> \brief ...
1916!> \param qs_env ...
1917!> \param bs_env ...
1918! **************************************************************************************************
1919 SUBROUTINE setup_cells_3c(qs_env, bs_env)
1920
1921 TYPE(qs_environment_type), POINTER :: qs_env
1922 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
1923
1924 CHARACTER(LEN=*), PARAMETER :: routinen = 'setup_cells_3c'
1925
1926 INTEGER :: atom_i, atom_j, atom_k, block_count, handle, i, i_cell_x, i_cell_x_max, &
1927 i_cell_x_min, i_size, ikind, img, j, j_cell, j_cell_max, j_cell_y, j_cell_y_max, &
1928 j_cell_y_min, j_size, k_cell, k_cell_max, k_cell_z, k_cell_z_max, k_cell_z_min, k_size, &
1929 nimage_pairs_3c, nimages_3c, nimages_3c_max, nkind, u
1930 INTEGER(KIND=int_8) :: mem_occ_per_proc
1931 INTEGER, ALLOCATABLE, DIMENSION(:) :: kind_of, n_other_3c_images_max
1932 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: index_to_cell_3c_max, nblocks_3c_max
1933 INTEGER, DIMENSION(3) :: cell_index, n_max
1934 REAL(kind=dp) :: avail_mem_per_proc_gb, cell_dist, cell_radius_3c, dij, dik, djk, eps, &
1935 exp_min_ao, exp_min_ri, frobenius_norm, mem_3c_gb, mem_occ_per_proc_gb, radius_ao, &
1936 radius_ao_product, radius_ri
1937 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: exp_ao_kind, exp_ri_kind, &
1938 radius_ao_kind, &
1939 radius_ao_product_kind, radius_ri_kind
1940 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: int_3c
1941 REAL(kind=dp), DIMENSION(3) :: rij, rik, rjk, vec_cell_j, vec_cell_k
1942 REAL(kind=dp), DIMENSION(:, :), POINTER :: exp_ao, exp_ri
1943 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1944 TYPE(cell_type), POINTER :: cell
1945 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1946
1947 CALL timeset(routinen, handle)
1948
1949 CALL get_qs_env(qs_env, nkind=nkind, atomic_kind_set=atomic_kind_set, particle_set=particle_set, cell=cell)
1950
1951 ALLOCATE (exp_ao_kind(nkind), exp_ri_kind(nkind), radius_ao_kind(nkind), &
1952 radius_ao_product_kind(nkind), radius_ri_kind(nkind))
1953
1954 exp_min_ri = 10.0_dp
1955 exp_min_ao = 10.0_dp
1956 exp_ri_kind = 10.0_dp
1957 exp_ao_kind = 10.0_dp
1958
1959 eps = bs_env%eps_filter*bs_env%heuristic_filter_factor
1960
1961 DO ikind = 1, nkind
1962
1963 CALL get_gto_basis_set(bs_env%basis_set_RI(ikind)%gto_basis_set, zet=exp_ri)
1964 CALL get_gto_basis_set(bs_env%basis_set_ao(ikind)%gto_basis_set, zet=exp_ao)
1965
1966 ! we need to remove all exponents lower than a lower bound, e.g. 1E-3, because
1967 ! for contracted basis sets, there might be exponents = 0 in zet
1968 DO i = 1, SIZE(exp_ri, 1)
1969 DO j = 1, SIZE(exp_ri, 2)
1970 IF (exp_ri(i, j) < exp_min_ri .AND. exp_ri(i, j) > 1e-3_dp) exp_min_ri = exp_ri(i, j)
1971 IF (exp_ri(i, j) < exp_ri_kind(ikind) .AND. exp_ri(i, j) > 1e-3_dp) &
1972 exp_ri_kind(ikind) = exp_ri(i, j)
1973 END DO
1974 END DO
1975 DO i = 1, SIZE(exp_ao, 1)
1976 DO j = 1, SIZE(exp_ao, 2)
1977 IF (exp_ao(i, j) < exp_min_ao .AND. exp_ao(i, j) > 1e-3_dp) exp_min_ao = exp_ao(i, j)
1978 IF (exp_ao(i, j) < exp_ao_kind(ikind) .AND. exp_ao(i, j) > 1e-3_dp) &
1979 exp_ao_kind(ikind) = exp_ao(i, j)
1980 END DO
1981 END DO
1982 radius_ao_kind(ikind) = sqrt(-log(eps)/exp_ao_kind(ikind))
1983 radius_ao_product_kind(ikind) = sqrt(-log(eps)/(2.0_dp*exp_ao_kind(ikind)))
1984 radius_ri_kind(ikind) = sqrt(-log(eps)/exp_ri_kind(ikind))
1985 END DO
1986
1987 radius_ao = sqrt(-log(eps)/exp_min_ao)
1988 radius_ao_product = sqrt(-log(eps)/(2.0_dp*exp_min_ao))
1989 radius_ri = sqrt(-log(eps)/exp_min_ri)
1990
1991 CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, kind_of=kind_of)
1992
1993 ! For a 3c integral (μR υS | P0) we have that cell R and cell S need to be within radius_3c
1994 cell_radius_3c = radius_ao_product + radius_ri + bs_env%ri_metric%cutoff_radius
1995
1996 n_max(1:3) = bs_env%periodic(1:3)*30
1997
1998 nimages_3c_max = 0
1999
2000 i_cell_x_min = 0
2001 i_cell_x_max = 0
2002 j_cell_y_min = 0
2003 j_cell_y_max = 0
2004 k_cell_z_min = 0
2005 k_cell_z_max = 0
2006
2007 DO i_cell_x = -n_max(1), n_max(1)
2008 DO j_cell_y = -n_max(2), n_max(2)
2009 DO k_cell_z = -n_max(3), n_max(3)
2010
2011 cell_index(1:3) = [i_cell_x, j_cell_y, k_cell_z]
2012
2013 CALL get_cell_dist(cell_index, bs_env%hmat, cell_dist)
2014
2015 IF (cell_dist < cell_radius_3c) THEN
2016 nimages_3c_max = nimages_3c_max + 1
2017 i_cell_x_min = min(i_cell_x_min, i_cell_x)
2018 i_cell_x_max = max(i_cell_x_max, i_cell_x)
2019 j_cell_y_min = min(j_cell_y_min, j_cell_y)
2020 j_cell_y_max = max(j_cell_y_max, j_cell_y)
2021 k_cell_z_min = min(k_cell_z_min, k_cell_z)
2022 k_cell_z_max = max(k_cell_z_max, k_cell_z)
2023 END IF
2024
2025 END DO
2026 END DO
2027 END DO
2028
2029 ! get index_to_cell_3c_max for the maximum possible cell range;
2030 ! compute 3c integrals later in this routine and check really which cell is needed
2031 ALLOCATE (index_to_cell_3c_max(3, nimages_3c_max))
2032
2033 img = 0
2034 DO i_cell_x = -n_max(1), n_max(1)
2035 DO j_cell_y = -n_max(2), n_max(2)
2036 DO k_cell_z = -n_max(3), n_max(3)
2037
2038 cell_index(1:3) = [i_cell_x, j_cell_y, k_cell_z]
2039
2040 CALL get_cell_dist(cell_index, bs_env%hmat, cell_dist)
2041
2042 IF (cell_dist < cell_radius_3c) THEN
2043 img = img + 1
2044 index_to_cell_3c_max(1:3, img) = cell_index(1:3)
2045 END IF
2046
2047 END DO
2048 END DO
2049 END DO
2050
2051 ! get pairs of R and S which have non-zero 3c integral (μR υS | P0)
2052 ALLOCATE (nblocks_3c_max(nimages_3c_max, nimages_3c_max))
2053 nblocks_3c_max(:, :) = 0
2054
2055 block_count = 0
2056 DO j_cell = 1, nimages_3c_max
2057 DO k_cell = 1, nimages_3c_max
2058
2059 DO atom_j = 1, bs_env%n_atom
2060 DO atom_k = 1, bs_env%n_atom
2061 DO atom_i = 1, bs_env%n_atom
2062
2063 block_count = block_count + 1
2064 IF (modulo(block_count, bs_env%para_env%num_pe) /= bs_env%para_env%mepos) cycle
2065
2066 CALL scaled_to_real(vec_cell_j, real(index_to_cell_3c_max(1:3, j_cell), kind=dp), cell)
2067 CALL scaled_to_real(vec_cell_k, real(index_to_cell_3c_max(1:3, k_cell), kind=dp), cell)
2068
2069 rij = pbc(particle_set(atom_j)%r(:), cell) - pbc(particle_set(atom_i)%r(:), cell) + vec_cell_j(:)
2070 rjk = pbc(particle_set(atom_k)%r(:), cell) - pbc(particle_set(atom_j)%r(:), cell) &
2071 + vec_cell_k(:) - vec_cell_j(:)
2072 rik(:) = rij(:) + rjk(:)
2073 dij = norm2(rij)
2074 dik = norm2(rik)
2075 djk = norm2(rjk)
2076 IF (djk > radius_ao_kind(kind_of(atom_j)) + radius_ao_kind(kind_of(atom_k))) cycle
2077 IF (dij > radius_ao_kind(kind_of(atom_j)) + radius_ri_kind(kind_of(atom_i)) &
2078 + bs_env%ri_metric%cutoff_radius) cycle
2079 IF (dik > radius_ri_kind(kind_of(atom_i)) + radius_ao_kind(kind_of(atom_k)) &
2080 + bs_env%ri_metric%cutoff_radius) cycle
2081
2082 j_size = bs_env%i_ao_end_from_atom(atom_j) - bs_env%i_ao_start_from_atom(atom_j) + 1
2083 k_size = bs_env%i_ao_end_from_atom(atom_k) - bs_env%i_ao_start_from_atom(atom_k) + 1
2084 i_size = bs_env%i_RI_end_from_atom(atom_i) - bs_env%i_RI_start_from_atom(atom_i) + 1
2085
2086 ALLOCATE (int_3c(j_size, k_size, i_size))
2087
2088 ! compute 3-c int. ( μ(atom j) R , ν (atom k) S | P (atom i) 0 )
2089 ! ("|": truncated Coulomb operator), inside build_3c_integrals: (j k | i)
2090 CALL build_3c_integral_block(int_3c, qs_env, bs_env%ri_metric, &
2091 basis_j=bs_env%basis_set_AO, &
2092 basis_k=bs_env%basis_set_AO, &
2093 basis_i=bs_env%basis_set_RI, &
2094 cell_j=index_to_cell_3c_max(1:3, j_cell), &
2095 cell_k=index_to_cell_3c_max(1:3, k_cell), &
2096 atom_k=atom_k, atom_j=atom_j, atom_i=atom_i)
2097
2098 frobenius_norm = sqrt(sum(int_3c(:, :, :)**2))
2099
2100 DEALLOCATE (int_3c)
2101
2102 ! we use a higher threshold here to safe memory when storing the 3c integrals
2103 ! in every tensor group
2104 IF (frobenius_norm > eps) THEN
2105 nblocks_3c_max(j_cell, k_cell) = nblocks_3c_max(j_cell, k_cell) + 1
2106 END IF
2107
2108 END DO
2109 END DO
2110 END DO
2111
2112 END DO
2113 END DO
2114
2115 CALL bs_env%para_env%sum(nblocks_3c_max)
2116
2117 ALLOCATE (n_other_3c_images_max(nimages_3c_max))
2118 n_other_3c_images_max(:) = 0
2119
2120 nimages_3c = 0
2121 nimage_pairs_3c = 0
2122
2123 DO j_cell = 1, nimages_3c_max
2124 DO k_cell = 1, nimages_3c_max
2125 IF (nblocks_3c_max(j_cell, k_cell) > 0) THEN
2126 n_other_3c_images_max(j_cell) = n_other_3c_images_max(j_cell) + 1
2127 nimage_pairs_3c = nimage_pairs_3c + 1
2128 END IF
2129 END DO
2130
2131 IF (n_other_3c_images_max(j_cell) > 0) nimages_3c = nimages_3c + 1
2132
2133 END DO
2134
2135 bs_env%nimages_3c = nimages_3c
2136 ALLOCATE (bs_env%index_to_cell_3c(3, nimages_3c))
2137 ALLOCATE (bs_env%cell_to_index_3c(i_cell_x_min:i_cell_x_max, &
2138 j_cell_y_min:j_cell_y_max, &
2139 k_cell_z_min:k_cell_z_max))
2140 bs_env%cell_to_index_3c(:, :, :) = -1
2141
2142 ALLOCATE (bs_env%nblocks_3c(nimages_3c, nimages_3c))
2143 bs_env%nblocks_3c(nimages_3c, nimages_3c) = 0
2144
2145 j_cell = 0
2146 DO j_cell_max = 1, nimages_3c_max
2147 IF (n_other_3c_images_max(j_cell_max) == 0) cycle
2148 j_cell = j_cell + 1
2149 cell_index(1:3) = index_to_cell_3c_max(1:3, j_cell_max)
2150 bs_env%index_to_cell_3c(1:3, j_cell) = cell_index(1:3)
2151 bs_env%cell_to_index_3c(cell_index(1), cell_index(2), cell_index(3)) = j_cell
2152
2153 k_cell = 0
2154 DO k_cell_max = 1, nimages_3c_max
2155 IF (n_other_3c_images_max(k_cell_max) == 0) cycle
2156 k_cell = k_cell + 1
2157
2158 bs_env%nblocks_3c(j_cell, k_cell) = nblocks_3c_max(j_cell_max, k_cell_max)
2159 END DO
2160
2161 END DO
2162
2163 ! we use: 8*10^-9 GB / double precision number
2164 mem_3c_gb = real(bs_env%n_RI, kind=dp)*real(bs_env%n_ao, kind=dp)**2 &
2165 *real(nimage_pairs_3c, kind=dp)*8e-9_dp
2166
2167 CALL m_memory(mem_occ_per_proc)
2168 CALL bs_env%para_env%max(mem_occ_per_proc)
2169
2170 mem_occ_per_proc_gb = real(mem_occ_per_proc, kind=dp)/1.0e9_dp
2171
2172 ! number of processors per group that entirely stores the 3c integrals and does tensor ops
2173 avail_mem_per_proc_gb = bs_env%input_memory_per_proc_GB - mem_occ_per_proc_gb
2174
2175 ! careful: downconvering real to integer, 1.9 -> 1; thus add 1.0 for upconversion, 1.9 -> 2
2176 bs_env%group_size_tensor = max(int(mem_3c_gb/avail_mem_per_proc_gb + 1.0_dp), 1)
2177
2178 u = bs_env%unit_nr
2179
2180 IF (u > 0) THEN
2181 WRITE (u, fmt="(T2,A,F52.1,A)") "Radius of atomic orbitals", radius_ao*angstrom, Å" "
2182 WRITE (u, fmt="(T2,A,F55.1,A)") "Radius of RI functions", radius_ri*angstrom, Å" "
2183 WRITE (u, fmt="(T2,A,I47)") "Number of cells for 3c integrals", nimages_3c
2184 WRITE (u, fmt="(T2,A,I42)") "Number of cell pairs for 3c integrals", nimage_pairs_3c
2185 WRITE (u, '(T2,A)') ''
2186 WRITE (u, '(T2,A,F37.1,A)') 'Input: Available memory per MPI process', &
2187 bs_env%input_memory_per_proc_GB, ' GB'
2188 WRITE (u, '(T2,A,F35.1,A)') 'Used memory per MPI process before GW run', &
2189 mem_occ_per_proc_gb, ' GB'
2190 WRITE (u, '(T2,A,F44.1,A)') 'Memory of three-center integrals', mem_3c_gb, ' GB'
2191 END IF
2192
2193 CALL timestop(handle)
2194
2195 END SUBROUTINE setup_cells_3c
2196
2197! **************************************************************************************************
2198!> \brief ...
2199!> \param index_to_cell_1 ...
2200!> \param index_to_cell_2 ...
2201!> \param nimages_1 ...
2202!> \param nimages_2 ...
2203!> \param index_to_cell ...
2204!> \param cell_to_index ...
2205!> \param nimages ...
2206! **************************************************************************************************
2207 SUBROUTINE sum_two_r_grids(index_to_cell_1, index_to_cell_2, nimages_1, nimages_2, &
2208 index_to_cell, cell_to_index, nimages)
2209
2210 INTEGER, DIMENSION(:, :) :: index_to_cell_1, index_to_cell_2
2211 INTEGER :: nimages_1, nimages_2
2212 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: index_to_cell
2213 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
2214 INTEGER :: nimages
2215
2216 CHARACTER(LEN=*), PARAMETER :: routinen = 'sum_two_R_grids'
2217
2218 INTEGER :: handle, i_dim, img_1, img_2, nimages_max
2219 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: index_to_cell_tmp
2220 INTEGER, DIMENSION(3) :: cell_1, cell_2, r, r_max, r_min
2221
2222 CALL timeset(routinen, handle)
2223
2224 DO i_dim = 1, 3
2225 r_min(i_dim) = minval(index_to_cell_1(i_dim, :)) + minval(index_to_cell_2(i_dim, :))
2226 r_max(i_dim) = maxval(index_to_cell_1(i_dim, :)) + maxval(index_to_cell_2(i_dim, :))
2227 END DO
2228
2229 nimages_max = (r_max(1) - r_min(1) + 1)*(r_max(2) - r_min(2) + 1)*(r_max(3) - r_min(3) + 1)
2230
2231 ALLOCATE (index_to_cell_tmp(3, nimages_max))
2232 index_to_cell_tmp(:, :) = -1
2233
2234 ALLOCATE (cell_to_index(r_min(1):r_max(1), r_min(2):r_max(2), r_min(3):r_max(3)))
2235 cell_to_index(:, :, :) = -1
2236
2237 nimages = 0
2238
2239 DO img_1 = 1, nimages_1
2240
2241 DO img_2 = 1, nimages_2
2242
2243 cell_1(1:3) = index_to_cell_1(1:3, img_1)
2244 cell_2(1:3) = index_to_cell_2(1:3, img_2)
2245
2246 r(1:3) = cell_1(1:3) + cell_2(1:3)
2247
2248 ! check whether we have found a new cell
2249 IF (cell_to_index(r(1), r(2), r(3)) == -1) THEN
2250
2251 nimages = nimages + 1
2252 cell_to_index(r(1), r(2), r(3)) = nimages
2253 index_to_cell_tmp(1:3, nimages) = r(1:3)
2254
2255 END IF
2256
2257 END DO
2258
2259 END DO
2260
2261 ALLOCATE (index_to_cell(3, nimages))
2262 index_to_cell(:, :) = index_to_cell_tmp(1:3, 1:nimages)
2263
2264 CALL timestop(handle)
2265
2266 END SUBROUTINE sum_two_r_grids
2267
2268! **************************************************************************************************
2269!> \brief ...
2270!> \param qs_env ...
2271!> \param bs_env ...
2272! **************************************************************************************************
2273 SUBROUTINE compute_3c_integrals(qs_env, bs_env)
2274
2275 TYPE(qs_environment_type), POINTER :: qs_env
2276 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2277
2278 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_3c_integrals'
2279
2280 INTEGER :: handle, j_cell, k_cell, nimages_3c
2281
2282 CALL timeset(routinen, handle)
2283
2284 nimages_3c = bs_env%nimages_3c
2285 ALLOCATE (bs_env%t_3c_int(nimages_3c, nimages_3c))
2286 DO j_cell = 1, nimages_3c
2287 DO k_cell = 1, nimages_3c
2288 CALL dbt_create(bs_env%t_RI_AO__AO, bs_env%t_3c_int(j_cell, k_cell))
2289 END DO
2290 END DO
2291
2292 CALL build_3c_integrals(bs_env%t_3c_int, &
2293 bs_env%eps_filter, &
2294 qs_env, &
2295 bs_env%nl_3c, &
2296 int_eps=bs_env%eps_filter*0.05_dp, &
2297 basis_i=bs_env%basis_set_RI, &
2298 basis_j=bs_env%basis_set_AO, &
2299 basis_k=bs_env%basis_set_AO, &
2300 potential_parameter=bs_env%ri_metric, &
2301 desymmetrize=.false., do_kpoints=.true., cell_sym=.true., &
2302 cell_to_index_ext=bs_env%cell_to_index_3c)
2303
2304 CALL bs_env%para_env%sync()
2305
2306 CALL timestop(handle)
2307
2308 END SUBROUTINE compute_3c_integrals
2309
2310! **************************************************************************************************
2311!> \brief ...
2312!> \param cell_index ...
2313!> \param hmat ...
2314!> \param cell_dist ...
2315! **************************************************************************************************
2316 SUBROUTINE get_cell_dist(cell_index, hmat, cell_dist)
2317
2318 INTEGER, DIMENSION(3) :: cell_index
2319 REAL(kind=dp) :: hmat(3, 3), cell_dist
2320
2321 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_cell_dist'
2322
2323 INTEGER :: handle, i_dim
2324 INTEGER, DIMENSION(3) :: cell_index_adj
2325 REAL(kind=dp) :: cell_dist_3(3)
2326
2327 CALL timeset(routinen, handle)
2328
2329 ! the distance of cells needs to be taken to adjacent neighbors, not
2330 ! between the center of the cells. We thus need to rescale the cell index
2331 DO i_dim = 1, 3
2332 IF (cell_index(i_dim) > 0) cell_index_adj(i_dim) = cell_index(i_dim) - 1
2333 IF (cell_index(i_dim) < 0) cell_index_adj(i_dim) = cell_index(i_dim) + 1
2334 IF (cell_index(i_dim) == 0) cell_index_adj(i_dim) = cell_index(i_dim)
2335 END DO
2336
2337 cell_dist_3(1:3) = matmul(hmat, real(cell_index_adj, kind=dp))
2338
2339 cell_dist = sqrt(abs(sum(cell_dist_3(1:3)**2)))
2340
2341 CALL timestop(handle)
2342
2343 END SUBROUTINE get_cell_dist
2344
2345! **************************************************************************************************
2346!> \brief ...
2347!> \param qs_env ...
2348!> \param bs_env ...
2349!> \param kpoints ...
2350!> \param do_print ...
2351! **************************************************************************************************
2352 SUBROUTINE setup_kpoints_scf_desymm(qs_env, bs_env, kpoints, do_print)
2353 TYPE(qs_environment_type), POINTER :: qs_env
2354 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2355 TYPE(kpoint_type), POINTER :: kpoints
2356
2357 CHARACTER(LEN=*), PARAMETER :: routinen = 'setup_kpoints_scf_desymm'
2358
2359 INTEGER :: handle, i_cell_x, i_dim, img, j_cell_y, &
2360 k_cell_z, nimages, nkp, u
2361 INTEGER, DIMENSION(3) :: cell_grid, cixd, nkp_grid
2362 TYPE(kpoint_type), POINTER :: kpoints_scf
2363
2364 LOGICAL:: do_print
2365
2366 CALL timeset(routinen, handle)
2367
2368 NULLIFY (kpoints)
2369 CALL kpoint_create(kpoints)
2370
2371 CALL get_qs_env(qs_env=qs_env, kpoints=kpoints_scf)
2372
2373 nkp_grid(1:3) = kpoints_scf%nkp_grid(1:3)
2374 nkp = nkp_grid(1)*nkp_grid(2)*nkp_grid(3)
2375
2376 ! we need in periodic directions at least 2 k-points in the SCF
2377 DO i_dim = 1, 3
2378 IF (bs_env%periodic(i_dim) == 1) THEN
2379 cpassert(nkp_grid(i_dim) > 1)
2380 END IF
2381 END DO
2382
2383 kpoints%kp_scheme = "GENERAL"
2384 kpoints%nkp_grid(1:3) = nkp_grid(1:3)
2385 kpoints%nkp = nkp
2386 bs_env%nkp_scf_desymm = nkp
2387
2388 ALLOCATE (kpoints%xkp(1:3, nkp))
2389 CALL compute_xkp(kpoints%xkp, 1, nkp, nkp_grid)
2390
2391 ALLOCATE (kpoints%wkp(nkp))
2392 kpoints%wkp(:) = 1.0_dp/real(nkp, kind=dp)
2393
2394 ! for example 4x3x6 kpoint grid -> 3x3x5 cell grid because we need the same number of
2395 ! neighbor cells on both sides of the unit cell
2396 cell_grid(1:3) = nkp_grid(1:3) - modulo(nkp_grid(1:3) + 1, 2)
2397 ! cell index: for example for x: from -n_x/2 to +n_x/2, n_x: number of cells in x direction
2398 cixd(1:3) = cell_grid(1:3)/2
2399
2400 nimages = cell_grid(1)*cell_grid(2)*cell_grid(3)
2401
2402 bs_env%nimages_scf_desymm = nimages
2403
2404 ALLOCATE (kpoints%cell_to_index(-cixd(1):cixd(1), -cixd(2):cixd(2), -cixd(3):cixd(3)))
2405 ALLOCATE (kpoints%index_to_cell(3, nimages))
2406
2407 img = 0
2408 DO i_cell_x = -cixd(1), cixd(1)
2409 DO j_cell_y = -cixd(2), cixd(2)
2410 DO k_cell_z = -cixd(3), cixd(3)
2411 img = img + 1
2412 kpoints%cell_to_index(i_cell_x, j_cell_y, k_cell_z) = img
2413 kpoints%index_to_cell(1:3, img) = [i_cell_x, j_cell_y, k_cell_z]
2414 END DO
2415 END DO
2416 END DO
2417
2418 u = bs_env%unit_nr
2419 IF (u > 0 .AND. do_print) THEN
2420 WRITE (u, fmt="(T2,A,I49)") χΣ"Number of cells for G, , W, ", nimages
2421 END IF
2422
2423 CALL timestop(handle)
2424
2425 END SUBROUTINE setup_kpoints_scf_desymm
2426
2427! **************************************************************************************************
2428!> \brief ...
2429!> \param bs_env ...
2430! **************************************************************************************************
2431 SUBROUTINE setup_cells_delta_r(bs_env)
2432
2433 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2434
2435 CHARACTER(LEN=*), PARAMETER :: routinen = 'setup_cells_Delta_R'
2436
2437 INTEGER :: handle
2438
2439 CALL timeset(routinen, handle)
2440
2441 ! cell sums batch wise for fixed ΔR = S_1 - R_1; for example:
2442 ! Σ_λσ^R = sum_PR1νS1 M^G_λ0,νS1,PR1 M^W_σR,νS1,PR1
2443
2444 CALL sum_two_r_grids(bs_env%index_to_cell_3c, &
2445 bs_env%index_to_cell_3c, &
2446 bs_env%nimages_3c, bs_env%nimages_3c, &
2447 bs_env%index_to_cell_Delta_R, &
2448 bs_env%cell_to_index_Delta_R, &
2449 bs_env%nimages_Delta_R)
2450
2451 IF (bs_env%unit_nr > 0) THEN
2452 WRITE (bs_env%unit_nr, fmt="(T2,A,I61)") Δ"Number of cells R", bs_env%nimages_Delta_R
2453 END IF
2454
2455 CALL timestop(handle)
2456
2457 END SUBROUTINE setup_cells_delta_r
2458
2459! **************************************************************************************************
2460!> \brief ...
2461!> \param bs_env ...
2462! **************************************************************************************************
2463 SUBROUTINE setup_parallelization_delta_r(bs_env)
2464
2465 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2466
2467 CHARACTER(LEN=*), PARAMETER :: routinen = 'setup_parallelization_Delta_R'
2468
2469 INTEGER :: handle, i_cell_delta_r, i_task_local, &
2470 n_tasks_local
2471 INTEGER, ALLOCATABLE, DIMENSION(:) :: i_cell_delta_r_group, &
2472 n_tensor_ops_delta_r
2473
2474 CALL timeset(routinen, handle)
2475
2476 CALL compute_n_tensor_ops_delta_r(bs_env, n_tensor_ops_delta_r)
2477
2478 CALL compute_delta_r_dist(bs_env, n_tensor_ops_delta_r, i_cell_delta_r_group, n_tasks_local)
2479
2480 bs_env%n_tasks_Delta_R_local = n_tasks_local
2481
2482 ALLOCATE (bs_env%task_Delta_R(n_tasks_local))
2483
2484 i_task_local = 0
2485 DO i_cell_delta_r = 1, bs_env%nimages_Delta_R
2486
2487 IF (i_cell_delta_r_group(i_cell_delta_r) /= bs_env%tensor_group_color) cycle
2488
2489 i_task_local = i_task_local + 1
2490
2491 bs_env%task_Delta_R(i_task_local) = i_cell_delta_r
2492
2493 END DO
2494
2495 ALLOCATE (bs_env%skip_DR_chi(n_tasks_local))
2496 bs_env%skip_DR_chi(:) = .false.
2497 ALLOCATE (bs_env%skip_DR_Sigma(n_tasks_local))
2498 bs_env%skip_DR_Sigma(:) = .false.
2499
2500 CALL allocate_skip_3xr(bs_env%skip_DR_R12_S_Goccx3c_chi, bs_env)
2501 CALL allocate_skip_3xr(bs_env%skip_DR_R12_S_Gvirx3c_chi, bs_env)
2502 CALL allocate_skip_3xr(bs_env%skip_DR_R_R2_MxM_chi, bs_env)
2503
2504 CALL allocate_skip_3xr(bs_env%skip_DR_R1_S2_Gx3c_Sigma, bs_env)
2505 CALL allocate_skip_3xr(bs_env%skip_DR_R1_R_MxM_Sigma, bs_env)
2506
2507 CALL timestop(handle)
2508
2509 END SUBROUTINE setup_parallelization_delta_r
2510
2511! **************************************************************************************************
2512!> \brief ...
2513!> \param skip ...
2514!> \param bs_env ...
2515! **************************************************************************************************
2516 SUBROUTINE allocate_skip_3xr(skip, bs_env)
2517 LOGICAL, ALLOCATABLE, DIMENSION(:, :, :) :: skip
2518 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2519
2520 CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_skip_3xR'
2521
2522 INTEGER :: handle
2523
2524 CALL timeset(routinen, handle)
2525
2526 ALLOCATE (skip(bs_env%n_tasks_Delta_R_local, bs_env%nimages_3c, bs_env%nimages_scf_desymm))
2527 skip(:, :, :) = .false.
2528
2529 CALL timestop(handle)
2530
2531 END SUBROUTINE allocate_skip_3xr
2532
2533! **************************************************************************************************
2534!> \brief ...
2535!> \param bs_env ...
2536!> \param n_tensor_ops_Delta_R ...
2537!> \param i_cell_Delta_R_group ...
2538!> \param n_tasks_local ...
2539! **************************************************************************************************
2540 SUBROUTINE compute_delta_r_dist(bs_env, n_tensor_ops_Delta_R, i_cell_Delta_R_group, n_tasks_local)
2541 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2542 INTEGER, ALLOCATABLE, DIMENSION(:) :: n_tensor_ops_delta_r, &
2543 i_cell_delta_r_group
2544 INTEGER :: n_tasks_local
2545
2546 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_Delta_R_dist'
2547
2548 INTEGER :: handle, i_delta_r_max_op, i_group_min, &
2549 nimages_delta_r, u
2550 INTEGER, ALLOCATABLE, DIMENSION(:) :: n_tensor_ops_delta_r_in_group
2551
2552 CALL timeset(routinen, handle)
2553
2554 nimages_delta_r = bs_env%nimages_Delta_R
2555
2556 u = bs_env%unit_nr
2557
2558 IF (u > 0 .AND. nimages_delta_r < bs_env%num_tensor_groups) THEN
2559 WRITE (u, fmt="(T2,A,I5,A,I5,A)") "There are only ", nimages_delta_r, &
2560 " tasks to work on but there are ", bs_env%num_tensor_groups, " groups."
2561 WRITE (u, fmt="(T2,A)") "Please reduce the number of MPI processes."
2562 WRITE (u, '(T2,A)') ''
2563 END IF
2564
2565 ALLOCATE (n_tensor_ops_delta_r_in_group(bs_env%num_tensor_groups))
2566 n_tensor_ops_delta_r_in_group(:) = 0
2567 ALLOCATE (i_cell_delta_r_group(nimages_delta_r))
2568 i_cell_delta_r_group(:) = -1
2569
2570 n_tasks_local = 0
2571
2572 DO WHILE (any(n_tensor_ops_delta_r(:) /= 0))
2573
2574 ! get largest element of n_tensor_ops_Delta_R
2575 i_delta_r_max_op = maxloc(n_tensor_ops_delta_r, 1)
2576
2577 ! distribute i_Delta_R_max_op to tensor group which has currently the smallest load
2578 i_group_min = minloc(n_tensor_ops_delta_r_in_group, 1)
2579
2580 ! the tensor groups are 0-index based; but i_group_min is 1-index based
2581 i_cell_delta_r_group(i_delta_r_max_op) = i_group_min - 1
2582 n_tensor_ops_delta_r_in_group(i_group_min) = n_tensor_ops_delta_r_in_group(i_group_min) + &
2583 n_tensor_ops_delta_r(i_delta_r_max_op)
2584
2585 ! remove i_Delta_R_max_op from n_tensor_ops_Delta_R
2586 n_tensor_ops_delta_r(i_delta_r_max_op) = 0
2587
2588 IF (bs_env%tensor_group_color == i_group_min - 1) n_tasks_local = n_tasks_local + 1
2589
2590 END DO
2591
2592 CALL timestop(handle)
2593
2594 END SUBROUTINE compute_delta_r_dist
2595
2596! **************************************************************************************************
2597!> \brief ...
2598!> \param bs_env ...
2599!> \param n_tensor_ops_Delta_R ...
2600! **************************************************************************************************
2601 SUBROUTINE compute_n_tensor_ops_delta_r(bs_env, n_tensor_ops_Delta_R)
2602 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2603 INTEGER, ALLOCATABLE, DIMENSION(:) :: n_tensor_ops_delta_r
2604
2605 CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_n_tensor_ops_Delta_R'
2606
2607 INTEGER :: handle, i_cell_delta_r, i_cell_r, i_cell_r1, i_cell_r1_minus_r, i_cell_r2, &
2608 i_cell_r2_m_r1, i_cell_s1, i_cell_s1_m_r1_p_r2, i_cell_s1_minus_r, i_cell_s2, &
2609 nimages_delta_r
2610 INTEGER, DIMENSION(3) :: cell_dr, cell_m_r1, cell_r, cell_r1, cell_r1_minus_r, cell_r2, &
2611 cell_r2_m_r1, cell_s1, cell_s1_m_r2_p_r1, cell_s1_minus_r, cell_s1_p_s2_m_r1, cell_s2
2612 LOGICAL :: cell_found
2613
2614 CALL timeset(routinen, handle)
2615
2616 nimages_delta_r = bs_env%nimages_Delta_R
2617
2618 ALLOCATE (n_tensor_ops_delta_r(nimages_delta_r))
2619 n_tensor_ops_delta_r(:) = 0
2620
2621 ! compute number of tensor operations for specific Delta_R
2622 DO i_cell_delta_r = 1, nimages_delta_r
2623
2624 IF (modulo(i_cell_delta_r, bs_env%num_tensor_groups) /= bs_env%tensor_group_color) cycle
2625
2626 DO i_cell_r1 = 1, bs_env%nimages_3c
2627
2628 cell_r1(1:3) = bs_env%index_to_cell_3c(1:3, i_cell_r1)
2629 cell_dr(1:3) = bs_env%index_to_cell_Delta_R(1:3, i_cell_delta_r)
2630
2631 ! S_1 = R_1 + ΔR (from ΔR = S_1 - R_1)
2632 CALL add_r(cell_r1, cell_dr, bs_env%index_to_cell_3c, cell_s1, &
2633 cell_found, bs_env%cell_to_index_3c, i_cell_s1)
2634 IF (.NOT. cell_found) cycle
2635
2636 DO i_cell_r2 = 1, bs_env%nimages_scf_desymm
2637
2638 cell_r2(1:3) = bs_env%kpoints_scf_desymm%index_to_cell(1:3, i_cell_r2)
2639
2640 ! R_2 - R_1
2641 CALL add_r(cell_r2, -cell_r1, bs_env%index_to_cell_3c, cell_r2_m_r1, &
2642 cell_found, bs_env%cell_to_index_3c, i_cell_r2_m_r1)
2643 IF (.NOT. cell_found) cycle
2644
2645 ! S_1 - R_1 + R_2
2646 CALL add_r(cell_s1, cell_r2_m_r1, bs_env%index_to_cell_3c, cell_s1_m_r2_p_r1, &
2647 cell_found, bs_env%cell_to_index_3c, i_cell_s1_m_r1_p_r2)
2648 IF (.NOT. cell_found) cycle
2649
2650 n_tensor_ops_delta_r(i_cell_delta_r) = n_tensor_ops_delta_r(i_cell_delta_r) + 1
2651
2652 END DO ! i_cell_R2
2653
2654 DO i_cell_s2 = 1, bs_env%nimages_scf_desymm
2655
2656 cell_s2(1:3) = bs_env%kpoints_scf_desymm%index_to_cell(1:3, i_cell_s2)
2657 cell_m_r1(1:3) = -cell_r1(1:3)
2658 cell_s1_p_s2_m_r1(1:3) = cell_s1(1:3) + cell_s2(1:3) - cell_r1(1:3)
2659
2660 CALL is_cell_in_index_to_cell(cell_m_r1, bs_env%index_to_cell_3c, cell_found)
2661 IF (.NOT. cell_found) cycle
2662
2663 CALL is_cell_in_index_to_cell(cell_s1_p_s2_m_r1, bs_env%index_to_cell_3c, cell_found)
2664 IF (.NOT. cell_found) cycle
2665
2666 END DO ! i_cell_S2
2667
2668 DO i_cell_r = 1, bs_env%nimages_scf_desymm
2669
2670 cell_r = bs_env%kpoints_scf_desymm%index_to_cell(1:3, i_cell_r)
2671
2672 ! R_1 - R
2673 CALL add_r(cell_r1, -cell_r, bs_env%index_to_cell_3c, cell_r1_minus_r, &
2674 cell_found, bs_env%cell_to_index_3c, i_cell_r1_minus_r)
2675 IF (.NOT. cell_found) cycle
2676
2677 ! S_1 - R
2678 CALL add_r(cell_s1, -cell_r, bs_env%index_to_cell_3c, cell_s1_minus_r, &
2679 cell_found, bs_env%cell_to_index_3c, i_cell_s1_minus_r)
2680 IF (.NOT. cell_found) cycle
2681
2682 END DO ! i_cell_R
2683
2684 END DO ! i_cell_R1
2685
2686 END DO ! i_cell_Delta_R
2687
2688 CALL bs_env%para_env%sum(n_tensor_ops_delta_r)
2689
2690 CALL timestop(handle)
2691
2692 END SUBROUTINE compute_n_tensor_ops_delta_r
2693
2694! **************************************************************************************************
2695!> \brief ...
2696!> \param cell_1 ...
2697!> \param cell_2 ...
2698!> \param index_to_cell ...
2699!> \param cell_1_plus_2 ...
2700!> \param cell_found ...
2701!> \param cell_to_index ...
2702!> \param i_cell_1_plus_2 ...
2703! **************************************************************************************************
2704 SUBROUTINE add_r(cell_1, cell_2, index_to_cell, cell_1_plus_2, cell_found, &
2705 cell_to_index, i_cell_1_plus_2)
2706
2707 INTEGER, DIMENSION(3) :: cell_1, cell_2
2708 INTEGER, DIMENSION(:, :) :: index_to_cell
2709 INTEGER, DIMENSION(3) :: cell_1_plus_2
2710 LOGICAL :: cell_found
2711 INTEGER, DIMENSION(:, :, :), INTENT(IN), &
2712 OPTIONAL, POINTER :: cell_to_index
2713 INTEGER, INTENT(OUT), OPTIONAL :: i_cell_1_plus_2
2714
2715 CHARACTER(LEN=*), PARAMETER :: routinen = 'add_R'
2716
2717 INTEGER :: handle
2718
2719 CALL timeset(routinen, handle)
2720
2721 cell_1_plus_2(1:3) = cell_1(1:3) + cell_2(1:3)
2722
2723 CALL is_cell_in_index_to_cell(cell_1_plus_2, index_to_cell, cell_found)
2724
2725 IF (PRESENT(i_cell_1_plus_2)) THEN
2726 IF (cell_found) THEN
2727 cpassert(PRESENT(cell_to_index))
2728 i_cell_1_plus_2 = cell_to_index(cell_1_plus_2(1), cell_1_plus_2(2), cell_1_plus_2(3))
2729 ELSE
2730 i_cell_1_plus_2 = -1000
2731 END IF
2732 END IF
2733
2734 CALL timestop(handle)
2735
2736 END SUBROUTINE add_r
2737
2738! **************************************************************************************************
2739!> \brief ...
2740!> \param cell ...
2741!> \param index_to_cell ...
2742!> \param cell_found ...
2743! **************************************************************************************************
2744 SUBROUTINE is_cell_in_index_to_cell(cell, index_to_cell, cell_found)
2745 INTEGER, DIMENSION(3) :: cell
2746 INTEGER, DIMENSION(:, :) :: index_to_cell
2747 LOGICAL :: cell_found
2748
2749 CHARACTER(LEN=*), PARAMETER :: routinen = 'is_cell_in_index_to_cell'
2750
2751 INTEGER :: handle, i_cell, nimg
2752 INTEGER, DIMENSION(3) :: cell_i
2753
2754 CALL timeset(routinen, handle)
2755
2756 nimg = SIZE(index_to_cell, 2)
2757
2758 cell_found = .false.
2759
2760 DO i_cell = 1, nimg
2761
2762 cell_i(1:3) = index_to_cell(1:3, i_cell)
2763
2764 IF (cell_i(1) == cell(1) .AND. cell_i(2) == cell(2) .AND. cell_i(3) == cell(3)) THEN
2765 cell_found = .true.
2766 END IF
2767
2768 END DO
2769
2770 CALL timestop(handle)
2771
2772 END SUBROUTINE is_cell_in_index_to_cell
2773
2774! **************************************************************************************************
2775!> \brief ...
2776!> \param qs_env ...
2777!> \param bs_env ...
2778! **************************************************************************************************
2779 SUBROUTINE allocate_matrices_small_cell_full_kp(qs_env, bs_env)
2780 TYPE(qs_environment_type), POINTER :: qs_env
2781 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2782
2783 CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_matrices_small_cell_full_kp'
2784
2785 INTEGER :: handle, i_spin, i_t, img, n_spin, &
2786 nimages_scf, num_time_freq_points
2787 TYPE(cp_blacs_env_type), POINTER :: blacs_env
2788 TYPE(mp_para_env_type), POINTER :: para_env
2789
2790 CALL timeset(routinen, handle)
2791
2792 nimages_scf = bs_env%nimages_scf_desymm
2793 num_time_freq_points = bs_env%num_time_freq_points
2794 n_spin = bs_env%n_spin
2795
2796 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
2797
2798 ALLOCATE (bs_env%fm_G_S(nimages_scf))
2799 ALLOCATE (bs_env%fm_Sigma_x_R(nimages_scf))
2800 ALLOCATE (bs_env%fm_chi_R_t(nimages_scf, num_time_freq_points))
2801 ALLOCATE (bs_env%fm_MWM_R_t(nimages_scf, num_time_freq_points))
2802 ALLOCATE (bs_env%fm_Sigma_c_R_neg_tau(nimages_scf, num_time_freq_points, n_spin))
2803 ALLOCATE (bs_env%fm_Sigma_c_R_pos_tau(nimages_scf, num_time_freq_points, n_spin))
2804 DO img = 1, nimages_scf
2805 CALL cp_fm_create(bs_env%fm_G_S(img), bs_env%fm_work_mo(1)%matrix_struct)
2806 CALL cp_fm_create(bs_env%fm_Sigma_x_R(img), bs_env%fm_work_mo(1)%matrix_struct)
2807 DO i_t = 1, num_time_freq_points
2808 CALL cp_fm_create(bs_env%fm_chi_R_t(img, i_t), bs_env%fm_RI_RI%matrix_struct)
2809 CALL cp_fm_create(bs_env%fm_MWM_R_t(img, i_t), bs_env%fm_RI_RI%matrix_struct)
2810 CALL cp_fm_set_all(bs_env%fm_MWM_R_t(img, i_t), 0.0_dp)
2811 DO i_spin = 1, n_spin
2812 CALL cp_fm_create(bs_env%fm_Sigma_c_R_neg_tau(img, i_t, i_spin), &
2813 bs_env%fm_work_mo(1)%matrix_struct)
2814 CALL cp_fm_create(bs_env%fm_Sigma_c_R_pos_tau(img, i_t, i_spin), &
2815 bs_env%fm_work_mo(1)%matrix_struct)
2816 CALL cp_fm_set_all(bs_env%fm_Sigma_c_R_neg_tau(img, i_t, i_spin), 0.0_dp)
2817 CALL cp_fm_set_all(bs_env%fm_Sigma_c_R_pos_tau(img, i_t, i_spin), 0.0_dp)
2818 END DO
2819 END DO
2820 END DO
2821
2822 CALL timestop(handle)
2823
2824 END SUBROUTINE allocate_matrices_small_cell_full_kp
2825
2826! **************************************************************************************************
2827!> \brief ...
2828!> \param qs_env ...
2829!> \param bs_env ...
2830! **************************************************************************************************
2831 SUBROUTINE trafo_v_xc_r_to_kp(qs_env, bs_env)
2832 TYPE(qs_environment_type), POINTER :: qs_env
2833 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2834
2835 CHARACTER(LEN=*), PARAMETER :: routinen = 'trafo_V_xc_R_to_kp'
2836
2837 INTEGER :: handle, ikp, img, ispin, n_ao
2838 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index_scf
2839 TYPE(cp_cfm_type) :: cfm_mo_coeff, cfm_tmp, cfm_v_xc
2840 TYPE(cp_fm_type) :: fm_v_xc_re
2841 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks
2842 TYPE(kpoint_type), POINTER :: kpoints_scf
2843 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
2844 POINTER :: sab_nl
2845
2846 CALL timeset(routinen, handle)
2847
2848 n_ao = bs_env%n_ao
2849
2850 CALL get_qs_env(qs_env, matrix_ks_kp=matrix_ks, kpoints=kpoints_scf)
2851
2852 NULLIFY (sab_nl)
2853 CALL get_kpoint_info(kpoints_scf, sab_nl=sab_nl, cell_to_index=cell_to_index_scf)
2854
2855 CALL cp_cfm_create(cfm_v_xc, bs_env%cfm_work_mo%matrix_struct)
2856 CALL cp_cfm_create(cfm_mo_coeff, bs_env%cfm_work_mo%matrix_struct)
2857 CALL cp_cfm_create(cfm_tmp, bs_env%cfm_work_mo%matrix_struct)
2858 CALL cp_fm_create(fm_v_xc_re, bs_env%cfm_work_mo%matrix_struct)
2859
2860 DO img = 1, bs_env%nimages_scf
2861 DO ispin = 1, bs_env%n_spin
2862 ! JW kind of hack because the format of matrix_ks remains dubious...
2863 CALL dbcsr_set(matrix_ks(ispin, img)%matrix, 0.0_dp)
2864 CALL copy_fm_to_dbcsr(bs_env%fm_V_xc_R(img, ispin), matrix_ks(ispin, img)%matrix)
2865 END DO
2866 END DO
2867
2868 ALLOCATE (bs_env%v_xc_n(n_ao, bs_env%nkp_bs_and_DOS, bs_env%n_spin))
2869
2870 DO ispin = 1, bs_env%n_spin
2871 DO ikp = 1, bs_env%nkp_bs_and_DOS
2872
2873 ! v^xc^R -> v^xc(k) (matrix_ks stores v^xc^R, see SUBROUTINE compute_V_xc)
2874 CALL rsmat_to_kp(matrix_ks, ispin, bs_env%kpoints_DOS%xkp(1:3, ikp), &
2875 cell_to_index_scf, sab_nl, bs_env, cfm_v_xc)
2876
2877 ! get C_µn(k)
2878 CALL cp_cfm_to_cfm(bs_env%cfm_mo_coeff_kp(ikp, ispin), cfm_mo_coeff)
2879
2880 ! v^xc_nm(k_i) = sum_µν C^*_µn(k_i) v^xc_µν(k_i) C_νn(k_i)
2881 CALL parallel_gemm('N', 'N', n_ao, n_ao, n_ao, z_one, cfm_v_xc, cfm_mo_coeff, &
2882 z_zero, cfm_tmp)
2883 CALL parallel_gemm('C', 'N', n_ao, n_ao, n_ao, z_one, cfm_mo_coeff, cfm_tmp, &
2884 z_zero, cfm_v_xc)
2885
2886 ! get v^xc_nn(k_i) which is a real quantity as v^xc is Hermitian
2887 CALL cp_cfm_to_fm(cfm_v_xc, fm_v_xc_re)
2888 CALL cp_fm_get_diag(fm_v_xc_re, bs_env%v_xc_n(:, ikp, ispin))
2889
2890 END DO
2891
2892 END DO
2893
2894 ! just rebuild the overwritten KS matrix again
2895 CALL qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces=.false., just_energy=.false.)
2896
2897 CALL cp_cfm_release(cfm_v_xc)
2898 CALL cp_cfm_release(cfm_mo_coeff)
2899 CALL cp_cfm_release(cfm_tmp)
2900 CALL cp_fm_release(fm_v_xc_re)
2901
2902 CALL timestop(handle)
2903
2904 END SUBROUTINE trafo_v_xc_r_to_kp
2905
2906! **************************************************************************************************
2907!> \brief ...
2908!> \param qs_env ...
2909!> \param bs_env ...
2910! **************************************************************************************************
2911 SUBROUTINE heuristic_ri_regularization(qs_env, bs_env)
2912 TYPE(qs_environment_type), POINTER :: qs_env
2913 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2914
2915 CHARACTER(LEN=*), PARAMETER :: routinen = 'heuristic_RI_regularization'
2916
2917 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: m
2918 INTEGER :: handle, ikp, ikp_local, n_ri, nkp, &
2919 nkp_local, u
2920 REAL(kind=dp) :: cond_nr, cond_nr_max, max_ev, &
2921 max_ev_ikp, min_ev, min_ev_ikp
2922 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: m_r
2923
2924 CALL timeset(routinen, handle)
2925
2926 ! compute M^R_PQ = <phi_P,0|V^tr(rc)|phi_Q,R> for RI metric
2927 CALL get_v_tr_r(m_r, bs_env%ri_metric, 0.0_dp, bs_env, qs_env)
2928
2929 nkp = bs_env%nkp_chi_eps_W_orig_plus_extra
2930 n_ri = bs_env%n_RI
2931
2932 nkp_local = 0
2933 DO ikp = 1, nkp
2934 ! trivial parallelization over k-points
2935 IF (modulo(ikp, bs_env%para_env%num_pe) /= bs_env%para_env%mepos) cycle
2936 nkp_local = nkp_local + 1
2937 END DO
2938
2939 ALLOCATE (m(n_ri, n_ri, nkp_local))
2940
2941 ikp_local = 0
2942 cond_nr_max = 0.0_dp
2943 min_ev = 1000.0_dp
2944 max_ev = -1000.0_dp
2945
2946 DO ikp = 1, nkp
2947
2948 ! trivial parallelization
2949 IF (modulo(ikp, bs_env%para_env%num_pe) /= bs_env%para_env%mepos) cycle
2950
2951 ikp_local = ikp_local + 1
2952
2953 ! M(k) = sum_R e^ikR M^R
2954 CALL rs_to_kp(m_r, m(:, :, ikp_local), &
2955 bs_env%kpoints_scf_desymm%index_to_cell, &
2956 bs_env%kpoints_chi_eps_W%xkp(1:3, ikp))
2957
2958 ! compute condition number of M_PQ(k)
2959 CALL power(m(:, :, ikp_local), 1.0_dp, 0.0_dp, cond_nr, min_ev_ikp, max_ev_ikp)
2960
2961 IF (cond_nr > cond_nr_max) cond_nr_max = cond_nr
2962 IF (max_ev_ikp > max_ev) max_ev = max_ev_ikp
2963 IF (min_ev_ikp < min_ev) min_ev = min_ev_ikp
2964
2965 END DO ! ikp
2966
2967 CALL bs_env%para_env%max(cond_nr_max)
2968
2969 u = bs_env%unit_nr
2970 IF (u > 0) THEN
2971 WRITE (u, fmt="(T2,A,ES34.1)") "Min. abs. eigenvalue of RI metric matrix M(k)", min_ev
2972 WRITE (u, fmt="(T2,A,ES34.1)") "Max. abs. eigenvalue of RI metric matrix M(k)", max_ev
2973 WRITE (u, fmt="(T2,A,ES50.1)") "Max. condition number of M(k)", cond_nr_max
2974 END IF
2975
2976 CALL timestop(handle)
2977
2978 END SUBROUTINE heuristic_ri_regularization
2979
2980! **************************************************************************************************
2981!> \brief ...
2982!> \param V_tr_R ...
2983!> \param pot_type ...
2984!> \param regularization_RI ...
2985!> \param bs_env ...
2986!> \param qs_env ...
2987! **************************************************************************************************
2988 SUBROUTINE get_v_tr_r(V_tr_R, pot_type, regularization_RI, bs_env, qs_env)
2989 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: v_tr_r
2990 TYPE(libint_potential_type) :: pot_type
2991 REAL(kind=dp) :: regularization_ri
2992 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
2993 TYPE(qs_environment_type), POINTER :: qs_env
2994
2995 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_V_tr_R'
2996
2997 INTEGER :: handle, img, nimages_scf_desymm
2998 INTEGER, ALLOCATABLE, DIMENSION(:) :: sizes_ri
2999 INTEGER, DIMENSION(:), POINTER :: col_bsize, row_bsize
3000 TYPE(cp_blacs_env_type), POINTER :: blacs_env
3001 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: fm_v_tr_r
3002 TYPE(dbcsr_distribution_type) :: dbcsr_dist
3003 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: mat_v_tr_r
3004 TYPE(distribution_2d_type), POINTER :: dist_2d
3005 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
3006 POINTER :: sab_ri
3007 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
3008 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
3009
3010 CALL timeset(routinen, handle)
3011
3012 NULLIFY (sab_ri, dist_2d)
3013
3014 CALL get_qs_env(qs_env=qs_env, &
3015 blacs_env=blacs_env, &
3016 distribution_2d=dist_2d, &
3017 qs_kind_set=qs_kind_set, &
3018 particle_set=particle_set)
3019
3020 ALLOCATE (sizes_ri(bs_env%n_atom))
3021 CALL get_particle_set(particle_set, qs_kind_set, nsgf=sizes_ri, basis=bs_env%basis_set_RI)
3022 CALL build_2c_neighbor_lists(sab_ri, bs_env%basis_set_RI, bs_env%basis_set_RI, &
3023 pot_type, "2c_nl_RI", qs_env, sym_ij=.false., &
3024 dist_2d=dist_2d)
3025 CALL cp_dbcsr_dist2d_to_dist(dist_2d, dbcsr_dist)
3026 ALLOCATE (row_bsize(SIZE(sizes_ri)))
3027 ALLOCATE (col_bsize(SIZE(sizes_ri)))
3028 row_bsize(:) = sizes_ri
3029 col_bsize(:) = sizes_ri
3030
3031 nimages_scf_desymm = bs_env%nimages_scf_desymm
3032 ALLOCATE (mat_v_tr_r(nimages_scf_desymm))
3033 CALL dbcsr_create(mat_v_tr_r(1), "(RI|RI)", dbcsr_dist, dbcsr_type_no_symmetry, &
3034 row_bsize, col_bsize)
3035 DEALLOCATE (row_bsize, col_bsize)
3036
3037 DO img = 2, nimages_scf_desymm
3038 CALL dbcsr_create(mat_v_tr_r(img), template=mat_v_tr_r(1))
3039 END DO
3040
3041 CALL build_2c_integrals(mat_v_tr_r, 0.0_dp, qs_env, sab_ri, bs_env%basis_set_RI, &
3042 bs_env%basis_set_RI, pot_type, do_kpoints=.true., &
3043 ext_kpoints=bs_env%kpoints_scf_desymm, &
3044 regularization_ri=regularization_ri)
3045
3046 ALLOCATE (fm_v_tr_r(nimages_scf_desymm))
3047 DO img = 1, nimages_scf_desymm
3048 CALL cp_fm_create(fm_v_tr_r(img), bs_env%fm_RI_RI%matrix_struct)
3049 CALL copy_dbcsr_to_fm(mat_v_tr_r(img), fm_v_tr_r(img))
3050 CALL dbcsr_release(mat_v_tr_r(img))
3051 END DO
3052
3053 IF (.NOT. ALLOCATED(v_tr_r)) THEN
3054 ALLOCATE (v_tr_r(bs_env%n_RI, bs_env%n_RI, nimages_scf_desymm))
3055 END IF
3056
3057 CALL fm_to_local_array(fm_v_tr_r, v_tr_r)
3058
3059 CALL cp_fm_release(fm_v_tr_r)
3060 CALL dbcsr_distribution_release(dbcsr_dist)
3061 CALL release_neighbor_list_sets(sab_ri)
3062
3063 CALL timestop(handle)
3064
3065 END SUBROUTINE get_v_tr_r
3066
3067! **************************************************************************************************
3068!> \brief ...
3069!> \param matrix ...
3070!> \param exponent ...
3071!> \param eps ...
3072!> \param cond_nr ...
3073!> \param min_ev ...
3074!> \param max_ev ...
3075! **************************************************************************************************
3076 SUBROUTINE power(matrix, exponent, eps, cond_nr, min_ev, max_ev)
3077 COMPLEX(KIND=dp), DIMENSION(:, :) :: matrix
3078 REAL(kind=dp) :: exponent, eps
3079 REAL(kind=dp), OPTIONAL :: cond_nr, min_ev, max_ev
3080
3081 CHARACTER(len=*), PARAMETER :: routinen = 'power'
3082
3083 COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: eigenvectors
3084 INTEGER :: handle, i, n
3085 REAL(kind=dp) :: pos_eval
3086 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues
3087
3088 CALL timeset(routinen, handle)
3089
3090 ! make matrix perfectly Hermitian
3091 matrix(:, :) = 0.5_dp*(matrix(:, :) + conjg(transpose(matrix(:, :))))
3092
3093 n = SIZE(matrix, 1)
3094 ALLOCATE (eigenvalues(n), eigenvectors(n, n))
3095 CALL diag_complex(matrix, eigenvectors, eigenvalues)
3096
3097 IF (PRESENT(cond_nr)) cond_nr = maxval(abs(eigenvalues))/minval(abs(eigenvalues))
3098 IF (PRESENT(min_ev)) min_ev = minval(abs(eigenvalues))
3099 IF (PRESENT(max_ev)) max_ev = maxval(abs(eigenvalues))
3100
3101 DO i = 1, n
3102 IF (eps < eigenvalues(i)) THEN
3103 pos_eval = (eigenvalues(i))**(0.5_dp*exponent)
3104 ELSE
3105 pos_eval = 0.0_dp
3106 END IF
3107 eigenvectors(:, i) = eigenvectors(:, i)*pos_eval
3108 END DO
3109
3110 CALL zgemm("N", "C", n, n, n, z_one, eigenvectors, n, eigenvectors, n, z_zero, matrix, n)
3111
3112 DEALLOCATE (eigenvalues, eigenvectors)
3113
3114 CALL timestop(handle)
3115
3116 END SUBROUTINE power
3117
3118! **************************************************************************************************
3119!> \brief ...
3120!> \param bs_env ...
3121!> \param Sigma_c_n_time ...
3122!> \param Sigma_c_n_freq ...
3123!> \param ispin ...
3124! **************************************************************************************************
3125 SUBROUTINE time_to_freq(bs_env, Sigma_c_n_time, Sigma_c_n_freq, ispin)
3126 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
3127 REAL(kind=dp), DIMENSION(:, :, :) :: sigma_c_n_time, sigma_c_n_freq
3128 INTEGER :: ispin
3129
3130 CHARACTER(LEN=*), PARAMETER :: routinen = 'time_to_freq'
3131
3132 INTEGER :: handle, i_t, j_w, n_occ
3133 REAL(kind=dp) :: freq_j, time_i, w_cos_ij, w_sin_ij
3134 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: sigma_c_n_cos_time, sigma_c_n_sin_time
3135
3136 CALL timeset(routinen, handle)
3137
3138 ALLOCATE (sigma_c_n_cos_time(bs_env%n_ao, bs_env%num_time_freq_points))
3139 ALLOCATE (sigma_c_n_sin_time(bs_env%n_ao, bs_env%num_time_freq_points))
3140
3141 sigma_c_n_cos_time(:, :) = 0.5_dp*(sigma_c_n_time(:, :, 1) + sigma_c_n_time(:, :, 2))
3142 sigma_c_n_sin_time(:, :) = 0.5_dp*(sigma_c_n_time(:, :, 1) - sigma_c_n_time(:, :, 2))
3143
3144 sigma_c_n_freq(:, :, :) = 0.0_dp
3145
3146 DO i_t = 1, bs_env%num_time_freq_points
3147
3148 DO j_w = 1, bs_env%num_time_freq_points
3149
3150 freq_j = bs_env%imag_freq_points(j_w)
3151 time_i = bs_env%imag_time_points(i_t)
3152 ! integration weights for cosine and sine transform
3153 w_cos_ij = bs_env%weights_cos_t_to_w(j_w, i_t)*cos(freq_j*time_i)
3154 w_sin_ij = bs_env%weights_sin_t_to_w(j_w, i_t)*sin(freq_j*time_i)
3155
3156 ! 1. Re(Σ^c_nn(k_i,iω)) from cosine transform
3157 sigma_c_n_freq(:, j_w, 1) = sigma_c_n_freq(:, j_w, 1) + &
3158 w_cos_ij*sigma_c_n_cos_time(:, i_t)
3159
3160 ! 2. Im(Σ^c_nn(k_i,iω)) from sine transform
3161 sigma_c_n_freq(:, j_w, 2) = sigma_c_n_freq(:, j_w, 2) + &
3162 w_sin_ij*sigma_c_n_sin_time(:, i_t)
3163
3164 END DO
3165
3166 END DO
3167
3168 ! for occupied levels, we need the correlation self-energy for negative omega.
3169 ! Therefore, weight_sin should be computed with -omega, which results in an
3170 ! additional minus for the imaginary part:
3171 n_occ = bs_env%n_occ(ispin)
3172 sigma_c_n_freq(1:n_occ, :, 2) = -sigma_c_n_freq(1:n_occ, :, 2)
3173
3174 CALL timestop(handle)
3175
3176 END SUBROUTINE time_to_freq
3177
3178! **************************************************************************************************
3179!> \brief ...
3180!> \param bs_env ...
3181!> \param Sigma_c_ikp_n_freq ...
3182!> \param Sigma_x_ikp_n ...
3183!> \param V_xc_ikp_n ...
3184!> \param eigenval_scf ...
3185!> \param ikp ...
3186!> \param ispin ...
3187! **************************************************************************************************
3188 SUBROUTINE analyt_conti_and_print(bs_env, Sigma_c_ikp_n_freq, Sigma_x_ikp_n, V_xc_ikp_n, &
3189 eigenval_scf, ikp, ispin)
3190
3191 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
3192 REAL(kind=dp), DIMENSION(:, :, :) :: sigma_c_ikp_n_freq
3193 REAL(kind=dp), DIMENSION(:) :: sigma_x_ikp_n, v_xc_ikp_n, eigenval_scf
3194 INTEGER :: ikp, ispin
3195
3196 CHARACTER(LEN=*), PARAMETER :: routinen = 'analyt_conti_and_print'
3197
3198 CHARACTER(len=3) :: occ_vir
3199 CHARACTER(len=default_string_length) :: fname
3200 INTEGER :: handle, i_mo, ikp_for_print, iunit, &
3201 n_mo, nkp
3202 LOGICAL :: is_bandstruc_kpoint, print_dos_kpoints, &
3203 print_ikp
3204 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: dummy, sigma_c_ikp_n_qp
3205
3206 CALL timeset(routinen, handle)
3207
3208 n_mo = bs_env%n_ao
3209 ALLOCATE (dummy(n_mo), sigma_c_ikp_n_qp(n_mo))
3210 sigma_c_ikp_n_qp(:) = 0.0_dp
3211
3212 DO i_mo = 1, n_mo
3213
3214 ! parallelization
3215 IF (modulo(i_mo, bs_env%para_env%num_pe) /= bs_env%para_env%mepos) cycle
3216
3217 CALL continuation_pade(sigma_c_ikp_n_qp, &
3218 bs_env%imag_freq_points_fit, dummy, dummy, &
3219 sigma_c_ikp_n_freq(:, 1:bs_env%num_freq_points_fit, 1)*z_one + &
3220 sigma_c_ikp_n_freq(:, 1:bs_env%num_freq_points_fit, 2)*gaussi, &
3221 sigma_x_ikp_n(:) - v_xc_ikp_n(:), &
3222 eigenval_scf(:), eigenval_scf(:), &
3223 bs_env%do_hedin_shift, &
3224 i_mo, bs_env%n_occ(ispin), bs_env%n_vir(ispin), &
3225 bs_env%nparam_pade, bs_env%num_freq_points_fit, &
3226 ri_rpa_g0w0_crossing_newton, bs_env%n_occ(ispin), &
3227 0.0_dp, .true., .false., 1, e_fermi_ext=bs_env%e_fermi(ispin))
3228 END DO
3229
3230 CALL bs_env%para_env%sum(sigma_c_ikp_n_qp)
3231
3232 CALL correct_obvious_fitting_fails(sigma_c_ikp_n_qp, ispin, bs_env)
3233
3234 bs_env%eigenval_G0W0(:, ikp, ispin) = eigenval_scf(:) + &
3235 sigma_c_ikp_n_qp(:) + &
3236 sigma_x_ikp_n(:) - &
3237 v_xc_ikp_n(:)
3238
3239 bs_env%eigenval_HF(:, ikp, ispin) = eigenval_scf(:) + sigma_x_ikp_n(:) - v_xc_ikp_n(:)
3240
3241 ! only print eigenvalues of DOS k-points in case no bandstructure path has been given
3242 print_dos_kpoints = (bs_env%nkp_only_bs <= 0)
3243 ! in kpoints_DOS, the last nkp_only_bs are bandstructure k-points
3244 is_bandstruc_kpoint = (ikp > bs_env%nkp_only_DOS)
3245 print_ikp = print_dos_kpoints .OR. is_bandstruc_kpoint
3246
3247 IF (bs_env%para_env%is_source() .AND. print_ikp) THEN
3248
3249 IF (print_dos_kpoints) THEN
3250 nkp = bs_env%nkp_only_DOS
3251 ikp_for_print = ikp
3252 ELSE
3253 nkp = bs_env%nkp_only_bs
3254 ikp_for_print = ikp - bs_env%nkp_only_DOS
3255 END IF
3256
3257 fname = "bandstructure_SCF_and_G0W0"
3258
3259 IF (ikp_for_print == 1) THEN
3260 CALL open_file(trim(fname), unit_number=iunit, file_status="REPLACE", &
3261 file_action="WRITE")
3262 ELSE
3263 CALL open_file(trim(fname), unit_number=iunit, file_status="OLD", &
3264 file_action="WRITE", file_position="APPEND")
3265 END IF
3266
3267 WRITE (iunit, "(A)") " "
3268 WRITE (iunit, "(A10,I7,A25,3F10.4)") "kpoint: ", ikp_for_print, "coordinate: ", &
3269 bs_env%kpoints_DOS%xkp(:, ikp)
3270 WRITE (iunit, "(A)") " "
3271 WRITE (iunit, "(A5,A12,3A17,A16,A18)") "n", "k", ϵ"_nk^DFT (eV)", Σ"^c_nk (eV)", &
3272 Σ"^x_nk (eV)", "v_nk^xc (eV)", ϵ"_nk^G0W0 (eV)"
3273 WRITE (iunit, "(A)") " "
3274
3275 DO i_mo = 1, n_mo
3276 IF (i_mo <= bs_env%n_occ(ispin)) occ_vir = 'occ'
3277 IF (i_mo > bs_env%n_occ(ispin)) occ_vir = 'vir'
3278 WRITE (iunit, "(I5,3A,I5,4F16.3,F17.3)") i_mo, ' (', occ_vir, ') ', ikp_for_print, &
3279 eigenval_scf(i_mo)*evolt, &
3280 sigma_c_ikp_n_qp(i_mo)*evolt, &
3281 sigma_x_ikp_n(i_mo)*evolt, &
3282 v_xc_ikp_n(i_mo)*evolt, &
3283 bs_env%eigenval_G0W0(i_mo, ikp, ispin)*evolt
3284 END DO
3285
3286 WRITE (iunit, "(A)") " "
3287
3288 CALL close_file(iunit)
3289
3290 END IF
3291
3292 CALL timestop(handle)
3293
3294 END SUBROUTINE analyt_conti_and_print
3295
3296! **************************************************************************************************
3297!> \brief ...
3298!> \param Sigma_c_ikp_n_qp ...
3299!> \param ispin ...
3300!> \param bs_env ...
3301! **************************************************************************************************
3302 SUBROUTINE correct_obvious_fitting_fails(Sigma_c_ikp_n_qp, ispin, bs_env)
3303 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: sigma_c_ikp_n_qp
3304 INTEGER :: ispin
3305 TYPE(post_scf_bandstructure_type), POINTER :: bs_env
3306
3307 CHARACTER(LEN=*), PARAMETER :: routinen = 'correct_obvious_fitting_fails'
3308
3309 INTEGER :: handle, homo, i_mo, j_mo, &
3310 n_levels_scissor, n_mo
3311 LOGICAL :: is_occ, is_vir
3312 REAL(kind=dp) :: sum_sigma_c
3313
3314 CALL timeset(routinen, handle)
3315
3316 n_mo = bs_env%n_ao
3317 homo = bs_env%n_occ(ispin)
3318
3319 DO i_mo = 1, n_mo
3320
3321 ! if |𝚺^c| > 13 eV, we use a scissors shift
3322 IF (abs(sigma_c_ikp_n_qp(i_mo)) > 13.0_dp/evolt) THEN
3323
3324 is_occ = (i_mo <= homo)
3325 is_vir = (i_mo > homo)
3326
3327 n_levels_scissor = 0
3328 sum_sigma_c = 0.0_dp
3329
3330 ! compute scissor
3331 DO j_mo = 1, n_mo
3332
3333 ! only compute scissor from other GW levels close in energy
3334 IF (is_occ .AND. j_mo > homo) cycle
3335 IF (is_vir .AND. j_mo <= homo) cycle
3336 IF (abs(i_mo - j_mo) > 10) cycle
3337 IF (i_mo == j_mo) cycle
3338
3339 n_levels_scissor = n_levels_scissor + 1
3340 sum_sigma_c = sum_sigma_c + sigma_c_ikp_n_qp(j_mo)
3341
3342 END DO
3343
3344 ! overwrite the self-energy with scissor shift
3345 sigma_c_ikp_n_qp(i_mo) = sum_sigma_c/real(n_levels_scissor, kind=dp)
3346
3347 END IF
3348
3349 END DO ! i_mo
3350
3351 CALL timestop(handle)
3352
3353 END SUBROUTINE correct_obvious_fitting_fails
3354
3355END MODULE gw_utils
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
struct tensor_ tensor
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, natom, nshell, fist_potential_present, shell_present, shell_adiabatic, shell_check_distance, damping_present)
Get attributes of an atomic kind set.
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum)
...
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public graml2024
Handles all functions related to the CELL.
Definition cell_types.F:15
subroutine, public scaled_to_real(r, s, cell)
Transform scaled cell coordinates real coordinates. r=h*s.
Definition cell_types.F:521
methods related to the blacs parallel environment
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
subroutine, public cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
allocates and initializes a type that represent a blacs context
Represents a complex full matrix distributed on many processors.
subroutine, public cp_cfm_release(matrix)
Releases a full matrix.
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.
subroutine, public cp_cfm_create(matrix, matrix_struct, name, set_zero)
Creates a new full matrix with the given structure.
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_distribution_release(dist)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_release(matrix)
...
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_dist2d_to_dist(dist2d, dist)
Creates a DBCSR distribution from a distribution_2d.
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Utility routines to open and close files. Tracking of preconnections.
Definition cp_files.F:16
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
Definition cp_files.F:311
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Definition cp_files.F:122
Basic linear algebra operations for full matrices.
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....
represent the structure of a full matrix
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
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
subroutine, public cp_fm_get_diag(matrix, diag)
returns the diagonal elements of a fm
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp, set_zero)
creates a new full matrix with the given structure
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
various routines to log and control the output. The idea is that decisions about where to log should ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
character(len=default_path_length) function, public cp_print_key_generate_filename(logger, print_key, middle_name, extension, my_local)
Utility function that returns a unit number to write the print key. Might open a file with a unique f...
This is the start of a dbt_api, all publically needed functions are exported here....
Definition dbt_api.F:17
stores a mapping of 2D info (e.g. matrix) on a 2D processor distribution (i.e. blacs grid) where cpus...
subroutine, public fm_to_local_array(fm_s, array_s, weight, add)
...
Utility method to build 3-center integrals for small cell GW.
subroutine, public build_3c_integral_block(int_3c, qs_env, potential_parameter, basis_j, basis_k, basis_i, cell_j, cell_k, cell_i, atom_j, atom_k, atom_i, j_bf_start_from_atom, k_bf_start_from_atom, i_bf_start_from_atom)
...
subroutine, public get_v_tr_r(v_tr_r, pot_type, regularization_ri, bs_env, qs_env)
...
Definition gw_utils.F:2989
subroutine, public time_to_freq(bs_env, sigma_c_n_time, sigma_c_n_freq, ispin)
...
Definition gw_utils.F:3126
subroutine, public de_init_bs_env(bs_env)
...
Definition gw_utils.F:239
subroutine, public compute_xkp(xkp, ikp_start, ikp_end, grid)
...
Definition gw_utils.F:627
subroutine, public analyt_conti_and_print(bs_env, sigma_c_ikp_n_freq, sigma_x_ikp_n, v_xc_ikp_n, eigenval_scf, ikp, ispin)
...
Definition gw_utils.F:3190
subroutine, public create_and_init_bs_env_for_gw(qs_env, bs_env, bs_sec)
...
Definition gw_utils.F:153
subroutine, public add_r(cell_1, cell_2, index_to_cell, cell_1_plus_2, cell_found, cell_to_index, i_cell_1_plus_2)
...
Definition gw_utils.F:2706
subroutine, public kpoint_init_cell_index_simple(kpoints, qs_env)
...
Definition gw_utils.F:597
subroutine, public get_i_j_atoms(atoms_i, atoms_j, n_atom_i, n_atom_j, color_sub, bs_env)
...
Definition gw_utils.F:1428
subroutine, public power(matrix, exponent, eps, cond_nr, min_ev, max_ev)
...
Definition gw_utils.F:3077
subroutine, public is_cell_in_index_to_cell(cell, index_to_cell, cell_found)
...
Definition gw_utils.F:2745
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public do_potential_truncated
integer, parameter, public rtp_method_bse
integer, parameter, public small_cell_full_kp
integer, parameter, public large_cell_gamma
integer, parameter, public xc_none
integer, parameter, public ri_rpa_g0w0_crossing_newton
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr)
sets the requested value
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
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public int_8
Definition kinds.F:54
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
integer, parameter, public default_path_length
Definition kinds.F:58
Implements transformations from k-space to R-space for Fortran array matrices.
subroutine, public rs_to_kp(rs_real, ks_complex, index_to_cell, xkp, deriv_direction, hmat)
Integrate RS matrices (stored as Fortran array) into a kpoint matrix at given kp.
Routines needed for kpoint calculation.
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.
Types and basic routines needed for a kpoint calculation.
subroutine, public kpoint_create(kpoint)
Create a kpoint environment.
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.
2- and 3-center electron repulsion integral routines based on libint2 Currently available operators: ...
Interface to the Libint-Library or a c++ wrapper.
subroutine, public cp_libint_static_cleanup()
subroutine, public cp_libint_static_init()
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
subroutine, public m_memory(mem)
Returns the total amount of memory [bytes] in use, if known, zero otherwise.
Definition machine.F:456
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition machine.F:153
Definition of mathematical constants and functions.
complex(kind=dp), parameter, public z_one
complex(kind=dp), parameter, public gaussi
complex(kind=dp), parameter, public z_zero
Collection of simple mathematical functions and subroutines.
Definition mathlib.F:15
subroutine, public diag_complex(matrix, eigenvectors, eigenvalues)
Diagonalizes a local complex Hermitian matrix using LAPACK. Based on cp_cfm_heevd.
Definition mathlib.F:1750
elemental integer function, public gcd(a, b)
computes the greatest common divisor of two number
Definition mathlib.F:1287
Interface to the message passing library MPI.
Routines to calculate the minimax coefficients in order to approximate 1/x as a sum over exponential ...
subroutine, public get_exp_minimax_coeff_gw(k, e_range, aw)
...
Routines to calculate the minimax coefficients in order to approximate 1/x as a sum over exponential ...
Definition minimax_exp.F:29
subroutine, public get_exp_minimax_coeff(k, rc, aw, mm_error, which_coeffs)
Get best minimax approximation for given input parameters. Automatically chooses the most exact set o...
Routines to calculate the minimax coefficients for approximating 1/x as 1/x ~ 1/pi SUM_{i}^{K} w_i x^...
Definition minimax_rpa.F:14
subroutine, public get_rpa_minimax_coeff_larger_grid(k, e_range, aw)
...
subroutine, public get_rpa_minimax_coeff(k, e_range, aw, ierr, print_warning)
The a_i and w_i coefficient are stored in aw such that the first 1:K elements correspond to a_i and t...
Definition minimax_rpa.F:41
Calls routines to get RI integrals and calculate total energies.
Definition mp2_gpw.F:14
subroutine, public create_mat_munu(mat_munu, qs_env, eps_grid, blacs_env_sub, do_ri_aux_basis, do_mixed_basis, group_size_prim, do_alloc_blocks_from_nbl, do_kpoints, sab_orb_sub, dbcsr_sym_type)
Encapsulate the building of dbcsr_matrix mat_munu.
Definition mp2_gpw.F:989
Routines to calculate frequency and time grids (integration points and weights) for correlation metho...
Definition mp2_grids.F:14
subroutine, public get_l_sq_wghts_cos_tf_w_to_t(num_integ_points, tau_tj, weights_cos_tf_w_to_t, omega_tj, e_min, e_max, max_error, num_points_per_magnitude, regularization)
...
Definition mp2_grids.F:1225
subroutine, public get_l_sq_wghts_cos_tf_t_to_w(num_integ_points, tau_tj, weights_cos_tf_t_to_w, omega_tj, e_min, e_max, max_error, num_points_per_magnitude, regularization)
Calculate integration weights for the tau grid (in dependency of the omega node)
Definition mp2_grids.F:726
subroutine, public get_l_sq_wghts_sin_tf_t_to_w(num_integ_points, tau_tj, weights_sin_tf_t_to_w, omega_tj, e_min, e_max, max_error, num_points_per_magnitude, regularization)
Calculate integration weights for the tau grid (in dependency of the omega node)
Definition mp2_grids.F:862
Framework for 2c-integrals for RI.
Definition mp2_ri_2c.F:14
subroutine, public trunc_coulomb_for_exchange(qs_env, trunc_coulomb, rel_cutoff_trunc_coulomb_ri_x, cell_grid, do_bvk_cell)
...
Definition mp2_ri_2c.F:1601
basic linear algebra operations for full matrixes
Define methods related to particle_type.
subroutine, public get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf, nmao, basis)
Get the components of a particle set.
Define the data structure for the particle information.
Definition of physical constants:
Definition physcon.F:68
real(kind=dp), parameter, public evolt
Definition physcon.F:183
real(kind=dp), parameter, public angstrom
Definition physcon.F:144
subroutine, public rsmat_to_kp(mat_rs, ispin, xkp, cell_to_index_scf, sab_nl, bs_env, cfm_kp, imag_rs_mat)
...
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
subroutine, public qs_env_part_release(qs_env)
releases part of the given qs_env in order to save memory
Some utility functions for the calculation of integrals.
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.
Calculate the interaction radii for the operator matrix calculation.
subroutine, public init_interaction_radii_orb_basis(orb_basis_set, eps_pgf_orb, eps_pgf_short)
...
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, monovalent, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
routines that build the Kohn-Sham matrix (i.e calculate the coulomb and xc parts
subroutine, public qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, print_active, ext_ks_matrix, ext_xc_section)
routine where the real calculations are made: the KS matrix is calculated
Define the neighbor list data types and the corresponding functionality.
subroutine, public release_neighbor_list_sets(nlists)
releases an array of neighbor_list_sets
Utility methods to build 3-center integral tensors of various types.
subroutine, public distribution_3d_create(dist_3d, dist1, dist2, dist3, nkind, particle_set, mp_comm_3d, own_comm)
Create a 3d distribution.
subroutine, public create_2c_tensor(t2c, dist_1, dist_2, pgrid, sizes_1, sizes_2, order, name)
...
subroutine, public create_3c_tensor(t3c, dist_1, dist_2, dist_3, pgrid, sizes_1, sizes_2, sizes_3, map1, map2, name)
...
Utility methods to build 3-center integral tensors of various types.
Definition qs_tensors.F:11
subroutine, public build_2c_integrals(t2c, filter_eps, qs_env, nl_2c, basis_i, basis_j, potential_parameter, do_kpoints, do_hfx_kpoints, ext_kpoints, regularization_ri)
...
subroutine, public build_2c_neighbor_lists(ij_list, basis_i, basis_j, potential_parameter, name, qs_env, sym_ij, molecular, dist_2d, pot_to_rad)
Build 2-center neighborlists adapted to different operators This mainly wraps build_neighbor_lists fo...
Definition qs_tensors.F:144
subroutine, public build_3c_integrals(t3c, filter_eps, qs_env, nl_3c, basis_i, basis_j, basis_k, potential_parameter, int_eps, op_pos, do_kpoints, do_hfx_kpoints, desymmetrize, cell_sym, bounds_i, bounds_j, bounds_k, ri_range, img_to_ri_cell, cell_to_index_ext)
Build 3-center integral tensor.
subroutine, public neighbor_list_3c_destroy(ijk_list)
Destroy 3c neighborlist.
Definition qs_tensors.F:381
subroutine, public get_tensor_occupancy(tensor, nze, occ)
...
subroutine, public build_3c_neighbor_lists(ijk_list, basis_i, basis_j, basis_k, dist_3d, potential_parameter, name, qs_env, sym_ij, sym_jk, sym_ik, molecular, op_pos, own_dist)
Build a 3-center neighbor list.
Definition qs_tensors.F:280
Routines for GW, continuous development [Jan Wilhelm].
Definition rpa_gw.F:14
subroutine, public continuation_pade(vec_gw_energ, vec_omega_fit_gw, z_value, m_value, vec_sigma_c_gw, vec_sigma_x_minus_vxc_gw, eigenval, eigenval_scf, do_hedin_shift, n_level_gw, gw_corr_lev_occ, gw_corr_lev_vir, nparam_pade, num_fit_points, crossing_search, homo, fermi_level_offset, do_gw_im_time, print_self_energy, count_ev_sc_gw, vec_gw_dos, dos_lower_bound, dos_precision, ndos, min_level_self_energy, max_level_self_energy, dos_eta, dos_min, dos_max, e_fermi_ext)
perform analytic continuation with pade approximation
Definition rpa_gw.F:4314
Provides all information about an atomic kind.
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Represent a complex full matrix.
keeps the information about the structure of a full matrix
represent a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
distributes pairs on a 2d grid of processors
Contains information about kpoints.
stores all the informations relevant to an mpi environment
Provides all information about a quickstep kind.