58 dbt_clear, dbt_create, dbt_destroy, dbt_filter, dbt_iterator_blocks_left, &
59 dbt_iterator_next_block, dbt_iterator_start, dbt_iterator_stop, dbt_iterator_type, &
60 dbt_mp_environ_pgrid, dbt_pgrid_create, dbt_pgrid_destroy, dbt_pgrid_type, dbt_type
135#include "base/base_uses.f90"
146 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'gw_utils'
161 CHARACTER(LEN=*),
PARAMETER :: routinen =
'create_and_init_bs_env_for_gw'
165 CALL timeset(routinen, handle)
169 CALL get_parameters_from_qs_env(qs_env, bs_env)
171 CALL read_gw_input_parameters(bs_env, bs_sec)
173 CALL print_header_and_input_parameters(bs_env)
175 CALL setup_ao_and_ri_basis_set(qs_env, bs_env)
177 CALL set_heuristic_parameters(bs_env, qs_env)
182 CALL get_ri_basis(qs_env, bs_env)
184 CALL compute_v_xc(qs_env, bs_env)
186 CALL init_interaction_radii(bs_env)
191 IF (.NOT. bs_env%do_gw_ri_rs .OR. &
194 CALL create_tensors(qs_env, bs_env)
199 SELECT CASE (bs_env%gw_implementation)
202 IF (.NOT. bs_env%do_gw_ri_rs)
THEN
203 CALL check_sparsity_3c(qs_env, bs_env)
205 CALL set_sparsity_parallelization_parameters(bs_env)
208 CALL check_for_restart_files(qs_env, bs_env)
212 CALL compute_3c_integrals(qs_env, bs_env)
214 CALL setup_cells_delta_r(bs_env)
216 CALL setup_parallelization_delta_r(bs_env)
218 CALL allocate_matrices_small_cell_full_kp_tensor(qs_env, bs_env)
220 CALL trafo_v_xc_r_to_kp(qs_env, bs_env)
222 CALL heuristic_ri_regularization(qs_env, bs_env)
226 CALL setup_time_and_frequency_minimax_grid(bs_env)
235 IF (.NOT. bs_env%do_ldos .AND. &
241 CALL timestop(handle)
250 SUBROUTINE get_parameters_from_qs_env(qs_env, bs_env)
256 NULLIFY (input, rtbse_sec)
257 CALL get_qs_env(qs_env, atomic_kind_set=bs_env%ri_rs%atomic_kind_set, &
258 cell=bs_env%ri_rs%cell, particle_set=bs_env%ri_rs%particle_set, input=input)
261 END SUBROUTINE get_parameters_from_qs_env
268 SUBROUTINE read_gw_input_parameters(bs_env, bs_sec)
272 CHARACTER(LEN=*),
PARAMETER :: routinen =
'read_gw_input_parameters'
279 CALL timeset(routinen, handle)
281 NULLIFY (auto_ri_sec, evgw0_sec, grid_opt_sec, gw_sec, ri_rs_sec)
291 CALL section_vals_val_get(gw_sec,
"REGULARIZATION_MINIMAX", r_val=bs_env%input_regularization_minimax)
299 CALL read_rirs_input(bs_env%ri_rs, ri_rs_sec)
300 CALL read_rirs_grid_opt(bs_env%ri_rs, grid_opt_sec)
301 CALL read_evgw0_input(bs_env%ri_rs, evgw0_sec, do_evgw0)
302 CALL read_auto_ri_input(bs_env%auto_ri, auto_ri_sec)
303 CALL check_gw_input(bs_env, do_evgw0)
305 CALL timestop(handle)
307 END SUBROUTINE read_gw_input_parameters
314 SUBROUTINE read_rirs_input(ri_rs, ri_rs_sec)
318 CHARACTER(LEN=*),
PARAMETER :: routinen =
'read_rirs_input'
322 CALL timeset(routinen, handle)
329 CALL section_vals_val_get(ri_rs_sec,
"N_PROCS_PER_ATOM_Z_LP", i_val=ri_rs%n_procs_per_atom_z_lp)
335 CALL timestop(handle)
337 END SUBROUTINE read_rirs_input
344 SUBROUTINE read_rirs_grid_opt(ri_rs, grid_opt_sec)
345 TYPE(
ri_rs_env),
INTENT(INOUT),
TARGET :: ri_rs
348 CHARACTER(LEN=*),
PARAMETER :: routinen =
'read_rirs_grid_opt'
353 CALL timeset(routinen, handle)
356 IF (.NOT. ri_rs%grid_opt%enabled)
THEN
357 CALL timestop(handle)
362 grid_opt => ri_rs%grid_opt
364 CALL section_vals_val_get(grid_opt_sec,
"CUTOFF_ATOMIC_CLUSTER", r_val=grid_opt%cutoff_atomic_cluster)
367 IF (grid_opt%rs_ao_ratio <= 0.0_dp) cpabort(
"RS_AO_RATIO must be positive")
368 CALL timestop(handle)
370 END SUBROUTINE read_rirs_grid_opt
378 SUBROUTINE read_evgw0_input(ri_rs, evgw0_sec, do_evgw0)
381 LOGICAL,
INTENT(OUT) :: do_evgw0
383 CHARACTER(LEN=*),
PARAMETER :: routinen =
'read_evgw0_input'
387 CALL timeset(routinen, handle)
393 CALL timestop(handle)
395 END SUBROUTINE read_evgw0_input
402 SUBROUTINE read_auto_ri_input(auto_ri, auto_ri_sec)
406 CHARACTER(LEN=*),
PARAMETER :: routinen =
'read_auto_ri_input'
410 CALL timeset(routinen, handle)
413 IF (.NOT. auto_ri%enabled)
THEN
414 CALL timestop(handle)
419 CALL section_vals_val_get(auto_ri_sec,
"OCC_EMPTY_FRONTIER_ORBITAL_WINDOW", r_val=auto_ri%occ_energy_window)
421 IF (.NOT. (auto_ri%ri_ao_ratio > 0.0_dp)) cpabort(
"AUTO_RI%RI_AO_RATIO must be positive")
422 IF (.NOT. (auto_ri%occ_energy_window >= 0.0_dp))
THEN
423 cpabort(
"AUTO_RI%OCC_EMPTY_FRONTIER_ORBITAL_WINDOW must be nonnegative")
425 IF (.NOT. (auto_ri%neighbor_radius > 0.0_dp)) cpabort(
"AUTO_RI%NEIGHBOR_RADIUS must be positive")
427 CALL timestop(handle)
429 END SUBROUTINE read_auto_ri_input
436 SUBROUTINE check_gw_input(bs_env, do_evgw0)
438 LOGICAL,
INTENT(IN) :: do_evgw0
440 CHARACTER(LEN=*),
PARAMETER :: routinen =
'check_gw_input'
444 CALL timeset(routinen, handle)
447 cpassert(.NOT. bs_env%ri_rs%grid_opt%enabled .OR. bs_env%do_gw_ri_rs)
448 IF (bs_env%ri_rs%grid_opt%enabled)
THEN
449 IF (bs_env%ri_rs%grid_opt%max_iter < 1)
THEN
450 cpabort(
"GRID_OPTIMIZATION%MAX_ITER must be positive")
452 IF (bs_env%ri_rs%grid_opt%cutoff_atomic_cluster <= 0.0_dp)
THEN
453 cpabort(
"GRID_OPTIMIZATION%CUTOFF_ATOMIC_CLUSTER must be positive")
455 IF (bs_env%ri_rs%tikhonov < 0.0_dp)
THEN
456 cpabort(
"RI_RS%TIKHONOV must not be negative")
458 IF (bs_env%do_periodic)
THEN
459 cpabort(
"GRID_OPTIMIZATION currently supports nonperiodic local environments only")
464 cpassert(.NOT. do_evgw0 .OR. bs_env%do_gw_ri_rs)
465 IF (bs_env%auto_ri%enabled)
THEN
467 cpassert(bs_env%do_gw_ri_rs)
469 cpassert(.NOT. bs_env%do_periodic)
471 cpassert(bs_env%ri_rs%cutoff_radius_g_w <= 0.0_dp)
474 bs_env%gw_flavour =
g0w0
476 bs_env%gw_flavour =
evgw0
477 CALL cp_warn(__location__, &
478 "evGW0 in the RI-RS GW code is experimental. The quasiparticle energies "// &
479 "of the previous cycle are fed back into the Green's function, so the "// &
480 "error of the analytic continuation propagates and accumulates over the "// &
481 "cycles instead of affecting one state only, as it does in G0W0. In "// &
482 "tests on small molecules the resulting deviation stayed below 100 meV, "// &
483 "but this has not been established in general. Use at your own risk and "// &
484 "check the convergence of the reported states.")
487 CALL resolve_memory_per_proc(bs_env)
489 CALL timestop(handle)
491 END SUBROUTINE check_gw_input
501 SUBROUTINE resolve_memory_per_proc(bs_env)
504 CHARACTER(LEN=*),
PARAMETER :: routinen =
'resolve_memory_per_proc'
505 REAL(kind=
dp),
PARAMETER :: detected_memory_fraction = 0.8_dp, &
506 fallback_memory_per_proc_gb = 2.0_dp
509 REAL(kind=
dp) :: mem_free_per_proc_gb, mem_occ_per_proc_gb
511 CALL timeset(routinen, handle)
513 bs_env%auto_memory_per_proc = bs_env%input_memory_per_proc_GB <= 0.0_dp
515 IF (bs_env%auto_memory_per_proc)
THEN
521 bs_env%input_memory_per_proc_GB = detected_memory_fraction*mem_free_per_proc_gb &
522 + mem_occ_per_proc_gb
525 IF (mem_free_per_proc_gb <= 0.0_dp)
THEN
526 bs_env%auto_memory_per_proc = .false.
527 bs_env%input_memory_per_proc_GB = fallback_memory_per_proc_gb
528 CALL cp_warn(__location__, &
529 "Could not detect the available memory per MPI process. Falling back "// &
530 "to MEMORY_PER_PROC = 2 GB. Set MEMORY_PER_PROC in the GW section "// &
531 "explicitly for good performance.")
534 ELSE IF (bs_env%do_gw_ri_rs)
THEN
536 CALL cp_warn(__location__, &
537 "MEMORY_PER_PROC is set, but it is not used by the RI-RS GW code, which "// &
538 "detects the available memory per MPI process automatically. The keyword "// &
543 CALL timestop(handle)
545 END SUBROUTINE resolve_memory_per_proc
551 SUBROUTINE print_header_and_input_parameters(bs_env)
555 CHARACTER(LEN=*),
PARAMETER :: routinen =
'print_header_and_input_parameters'
559 CALL timeset(routinen, handle)
564 WRITE (u,
'(T2,A)')
' '
565 WRITE (u,
'(T2,A)') repeat(
'-', 79)
566 WRITE (u,
'(T2,A,A78)')
'-',
'-'
567 WRITE (u,
'(T2,A,A46,A32)')
'-',
'GW CALCULATION',
'-'
568 WRITE (u,
'(T2,A,A78)')
'-',
'-'
569 WRITE (u,
'(T2,A)') repeat(
'-', 79)
570 WRITE (u,
'(T2,A)')
' '
571 WRITE (u,
'(T2,A,I45)')
'Input: Number of time/freq. points', bs_env%num_time_freq_points
572 WRITE (u,
"(T2,A,F44.1,A)")
'Input: ω_max for fitting Σ(iω) (eV)', bs_env%freq_max_fit*
evolt
573 WRITE (u,
'(T2,A,ES27.1)')
'Input: Filter threshold for sparse tensor operations', &
575 WRITE (u,
"(T2,A,L55)")
'Input: Apply Hedin shift', bs_env%do_hedin_shift
576 IF (bs_env%auto_memory_per_proc)
THEN
577 WRITE (u,
'(T2,A,F34.1,A)')
'Detected: Available memory per MPI process', &
578 bs_env%input_memory_per_proc_GB,
' GB'
580 WRITE (u,
'(T2,A,F37.1,A)')
'Input: Available memory per MPI process', &
581 bs_env%input_memory_per_proc_GB,
' GB'
583 IF (bs_env%do_gw_ri_rs)
CALL print_gw_rirs_input(bs_env)
586 CALL timestop(handle)
588 END SUBROUTINE print_header_and_input_parameters
594 SUBROUTINE print_gw_rirs_input(bs_env)
597 CHARACTER(LEN=*),
PARAMETER :: routinen =
'print_gw_rirs_input'
599 INTEGER :: handle, unit_nr
601 CALL timeset(routinen, handle)
603 unit_nr = bs_env%unit_nr
605 WRITE (unit_nr,
'(A)')
' '
606 WRITE (unit_nr,
'(T2,A,ES43.2)')
'Input: RI-RS Tikhonov regularization', &
607 bs_env%ri_rs%tikhonov
608 CALL print_cutoff_radius_input(unit_nr,
'RI-RS integration sphere cutoff', &
609 bs_env%ri_rs%cutoff_radius_ri_rs)
610 CALL print_cutoff_radius_input(unit_nr,
'AO grid hard cutoff radius', &
611 bs_env%ri_rs%cutoff_radius_ri_ao)
612 WRITE (unit_nr,
'(T2,A,I40)')
'Input: MPI ranks per atom in Z_lP solve', &
613 bs_env%ri_rs%n_procs_per_atom_z_lp
614 WRITE (unit_nr,
'(T2,A,L43)')
'Input: Keep sparsity in χ/G/W panels', &
615 bs_env%ri_rs%keep_sparsity_rirs
616 CALL print_cutoff_radius_input(unit_nr,
'G/W panel truncation radius', &
617 bs_env%ri_rs%cutoff_radius_v_w)
618 CALL print_cutoff_radius_input(unit_nr,
'G/W operator truncation radius', &
619 bs_env%ri_rs%cutoff_radius_g_w)
620 WRITE (unit_nr,
'(T2,A,A62)')
'Input: GW flavour', trim(
gw_flavour_label(bs_env))
622 IF (bs_env%ri_rs%grid_opt%enabled)
THEN
623 WRITE (unit_nr,
'(A)')
' '
624 WRITE (unit_nr,
'(T2,A,T80,L1)') &
625 'Input: RI-RS grid optimization activated', .true.
626 WRITE (unit_nr,
'(T2,A,T69,F12.1)') &
627 'Input: RS points per AO function', bs_env%ri_rs%grid_opt%rs_ao_ratio
628 WRITE (unit_nr,
'(T2,A,T73,F6.1,A)') &
629 'Input: Cutoff radius for atomic clusters', &
630 bs_env%ri_rs%grid_opt%cutoff_atomic_cluster*
angstrom,
' Å'
631 WRITE (unit_nr,
'(T2,A,T75,I6)') &
632 'Input: Maximum grid optimization iterations', &
633 bs_env%ri_rs%grid_opt%max_iter
636 IF (bs_env%auto_ri%enabled)
THEN
637 WRITE (unit_nr,
'(A)')
' '
638 WRITE (unit_nr,
'(T2,A,T80,L1)') &
639 'Input: AUTO_RI basis optimization activated:', .true.
640 WRITE (unit_nr,
'(T2,A,T69,F12.1)') &
641 'Input: AUTO_RI number of RI functions per AO function:', bs_env%auto_ri%ri_ao_ratio
642 WRITE (unit_nr,
'(T2,A,T74,F4.1,A)') &
643 'Input: AUTO_RI frontier orbital window:', bs_env%auto_ri%occ_energy_window*
evolt,
' eV'
644 WRITE (unit_nr,
'(T2,A,T75,F4.1,A)') &
645 'Input: AUTO_RI neighbor radius:', bs_env%auto_ri%neighbor_radius*
angstrom,
' Å'
648 IF (bs_env%gw_flavour ==
evgw0)
THEN
649 WRITE (unit_nr,
'(T2,A,I42)')
'Input: Maximum number of evGW0 cycles', &
650 bs_env%ri_rs%evgw0_iter
651 WRITE (unit_nr,
'(T2,A,F42.5,A)')
'Input: evGW0 convergence threshold', &
652 bs_env%ri_rs%evgw0_eps_iter*
evolt,
' eV'
654 WRITE (unit_nr,
'(A)')
' '
656 CALL timestop(handle)
658 END SUBROUTINE print_gw_rirs_input
666 SUBROUTINE print_cutoff_radius_input(unit_nr, label, cutoff_radius)
667 INTEGER,
INTENT(IN) :: unit_nr
668 CHARACTER(LEN=*),
INTENT(IN) :: label
669 REAL(kind=
dp),
INTENT(IN) :: cutoff_radius
671 CHARACTER(LEN=*),
PARAMETER :: routinen =
'print_cutoff_radius_input'
675 CALL timeset(routinen, handle)
677 IF (cutoff_radius > 0.0_dp)
THEN
678 WRITE (unit_nr,
'(T2,2A,T73,F6.2,A)') &
679 'Input: ', trim(label), cutoff_radius*
angstrom,
' Å'
682 CALL timestop(handle)
684 END SUBROUTINE print_cutoff_radius_input
691 SUBROUTINE setup_ao_and_ri_basis_set(qs_env, bs_env)
695 CHARACTER(LEN=*),
PARAMETER :: routinen =
'setup_AO_and_RI_basis_set'
697 INTEGER :: handle, natom, nkind
699 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
701 CALL timeset(routinen, handle)
704 qs_kind_set=qs_kind_set, &
705 particle_set=particle_set, &
706 natom=natom, nkind=nkind)
709 ALLOCATE (bs_env%sizes_RI(natom), bs_env%sizes_AO(natom))
710 ALLOCATE (bs_env%basis_set_RI(nkind), bs_env%basis_set_AO(nkind))
716 basis=bs_env%basis_set_RI)
718 basis=bs_env%basis_set_AO)
720 CALL timestop(handle)
722 END SUBROUTINE setup_ao_and_ri_basis_set
729 SUBROUTINE set_heuristic_parameters(bs_env, qs_env)
733 CHARACTER(LEN=*),
PARAMETER :: routinen =
'set_heuristic_parameters'
736 LOGICAL :: do_bvk_cell
738 CALL timeset(routinen, handle)
741 bs_env%num_points_per_magnitude = 200
743 IF (bs_env%input_regularization_minimax > -1.0e-12_dp)
THEN
744 bs_env%regularization_minimax = bs_env%input_regularization_minimax
749 IF (bs_env%do_periodic .OR. bs_env%num_time_freq_points >= 20)
THEN
750 bs_env%regularization_minimax = 1.0e-6_dp
752 bs_env%regularization_minimax = 0.0_dp
756 bs_env%stabilize_exp = 70.0_dp
757 bs_env%eps_atom_grid_2d_mat = 1.0e-50_dp
760 bs_env%nparam_pade = 16
764 bs_env%ri_metric%omega = 0.0_dp
766 bs_env%ri_metric%filename =
"t_c_g.dat"
768 bs_env%eps_eigval_mat_RI = 0.0_dp
770 IF (bs_env%input_regularization_RI > -1.0e-12_dp)
THEN
771 bs_env%regularization_RI = bs_env%input_regularization_RI
776 bs_env%regularization_RI = 1.0e-2_dp
779 IF (.NOT. bs_env%do_periodic) bs_env%regularization_RI = 0.0_dp
785 IF (bs_env%do_periodic)
THEN
788 rel_cutoff_trunc_coulomb_ri_x=0.5_dp, &
789 cell_grid=bs_env%cell_grid_scf_desymm, &
790 do_bvk_cell=do_bvk_cell)
793 bs_env%trunc_coulomb%cutoff_radius = -1.0_dp
794 bs_env%trunc_coulomb%omega = 0.0_dp
795 bs_env%trunc_coulomb%filename =
""
800 bs_env%heuristic_filter_factor = 1.0e-4_dp
804 IF (bs_env%do_periodic)
THEN
805 WRITE (u, fmt=
"(T2,2A,F21.1,A)")
"Cutoff radius for the truncated Coulomb ", &
806 "operator in Σ^x:", bs_env%trunc_coulomb%cutoff_radius*
angstrom,
" Å"
808 WRITE (u, fmt=
"(T2,2A,F15.1,A)")
"Cutoff radius for the truncated Coulomb ", &
809 "operator in RI metric:", bs_env%ri_metric%cutoff_radius*
angstrom,
" Å"
810 WRITE (u, fmt=
"(T2,A,ES48.1)")
"Regularization parameter of RI ", bs_env%regularization_RI
811 WRITE (u, fmt=
"(T2,A,ES38.1)")
"Regularization parameter of minimax grids", &
812 bs_env%regularization_minimax
813 IF (bs_env%do_periodic)
THEN
814 WRITE (u, fmt=
"(T2,A,I53)")
"Lattice sum size for V(k):", bs_env%size_lattice_sum_V
818 CALL timestop(handle)
820 END SUBROUTINE set_heuristic_parameters
827 SUBROUTINE get_ri_basis(qs_env, bs_env)
831 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_RI_basis'
835 CALL timeset(routinen, handle)
837 CALL set_ao_ri_basis_function_indices(qs_env, bs_env)
838 CALL setup_kpoints_chi_eps_w(bs_env, bs_env%kpoints_chi_eps_W)
840 CALL setup_cells_3c(qs_env, bs_env)
842 CALL set_parallelization_parameters(qs_env, bs_env)
843 CALL allocate_matrices(qs_env, bs_env)
845 CALL compute_minv_gamma(qs_env, bs_env)
848 CALL timestop(handle)
850 END SUBROUTINE get_ri_basis
857 SUBROUTINE set_ao_ri_basis_function_indices(qs_env, bs_env)
861 CHARACTER(LEN=*),
PARAMETER :: routinen =
'set_AO_RI_basis_function_indices'
863 INTEGER :: handle, i_ri, iatom, ikind, iset, &
864 max_ao_bf_per_atom, n_ao_test, n_atom, &
865 n_kind, n_ri, nset, nsgf, u
866 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: kind_of
867 INTEGER,
DIMENSION(:),
POINTER :: l_max, l_min, nsgf_set
870 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
872 CALL timeset(routinen, handle)
875 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set)
877 n_kind =
SIZE(qs_kind_set)
878 n_atom = bs_env%n_atom
883 CALL get_qs_kind(qs_kind_set(ikind), basis_set=basis, basis_type=
"RI_AUX")
884 cpassert(
ASSOCIATED(basis))
887 ALLOCATE (bs_env%i_RI_start_from_atom(n_atom))
888 ALLOCATE (bs_env%i_RI_end_from_atom(n_atom))
889 ALLOCATE (bs_env%i_ao_start_from_atom(n_atom))
890 ALLOCATE (bs_env%i_ao_end_from_atom(n_atom))
894 bs_env%i_RI_start_from_atom(iatom) = n_ri + 1
895 n_ri = n_ri + bs_env%sizes_RI(iatom)
896 bs_env%i_RI_end_from_atom(iatom) = n_ri
900 max_ao_bf_per_atom = 0
903 bs_env%i_ao_start_from_atom(iatom) = n_ao_test + 1
904 ikind = kind_of(iatom)
905 CALL get_qs_kind(qs_kind=qs_kind_set(ikind), nsgf=nsgf, basis_type=
"ORB")
906 n_ao_test = n_ao_test + nsgf
907 bs_env%i_ao_end_from_atom(iatom) = n_ao_test
908 max_ao_bf_per_atom = max(max_ao_bf_per_atom, nsgf)
910 cpassert(n_ao_test == bs_env%n_ao)
911 bs_env%max_AO_bf_per_atom = max_ao_bf_per_atom
914 ALLOCATE (bs_env%l_RI(n_ri), source=-1)
915 IF (bs_env%auto_ri%enabled)
THEN
916 cpassert(bs_env%auto_ri%ready)
920 ikind = kind_of(iatom)
921 nset = bs_env%basis_set_RI(ikind)%gto_basis_set%nset
922 l_max => bs_env%basis_set_RI(ikind)%gto_basis_set%lmax
923 l_min => bs_env%basis_set_RI(ikind)%gto_basis_set%lmin
924 nsgf_set => bs_env%basis_set_RI(ikind)%gto_basis_set%nsgf_set
926 cpassert(l_max(iset) == l_min(iset))
927 bs_env%l_RI(i_ri + 1:i_ri + nsgf_set(iset)) = l_max(iset)
928 i_ri = i_ri + nsgf_set(iset)
931 cpassert(i_ri == n_ri)
933 WRITE (u, fmt=
"(T2,A)")
" "
934 WRITE (u, fmt=
"(T2,2A,T75,I8)")
"Number of auxiliary Gaussian basis functions ", &
939 CALL timestop(handle)
941 END SUBROUTINE set_ao_ri_basis_function_indices
948 SUBROUTINE setup_kpoints_chi_eps_w(bs_env, kpoints_chi_eps_W)
953 CHARACTER(LEN=*),
PARAMETER :: routinen =
'setup_kpoints_chi_eps_W'
955 INTEGER :: handle, i_dim, n_dim, nkp, nkp_extra, &
957 INTEGER,
DIMENSION(3) :: nkp_grid, nkp_grid_extra, periodic
958 REAL(kind=
dp) :: exp_s_p, n_dim_inv
960 CALL timeset(routinen, handle)
963 NULLIFY (kpoints_chi_eps_w)
966 kpoints_chi_eps_w%kp_scheme =
"GENERAL"
968 periodic(1:3) = bs_env%periodic(1:3)
970 cpassert(
SIZE(bs_env%nkp_grid_chi_eps_W_input) == 3)
972 IF (bs_env%nkp_grid_chi_eps_W_input(1) > 0 .AND. &
973 bs_env%nkp_grid_chi_eps_W_input(2) > 0 .AND. &
974 bs_env%nkp_grid_chi_eps_W_input(3) > 0)
THEN
979 SELECT CASE (periodic(i_dim))
982 nkp_grid_extra(i_dim) = 1
984 nkp_grid(i_dim) = bs_env%nkp_grid_chi_eps_W_input(i_dim)
985 nkp_grid_extra(i_dim) = nkp_grid(i_dim)*2
987 cpabort(
"Error in periodicity.")
991 ELSE IF (bs_env%nkp_grid_chi_eps_W_input(1) == -1 .AND. &
992 bs_env%nkp_grid_chi_eps_W_input(2) == -1 .AND. &
993 bs_env%nkp_grid_chi_eps_W_input(3) == -1)
THEN
999 cpassert(periodic(i_dim) == 0 .OR. periodic(i_dim) == 1)
1001 SELECT CASE (periodic(i_dim))
1004 nkp_grid_extra(i_dim) = 1
1006 SELECT CASE (bs_env%gw_implementation)
1009 nkp_grid_extra(i_dim) = 6
1011 nkp_grid(i_dim) = bs_env%kpoints_scf_desymm%nkp_grid(i_dim)*4
1012 nkp_grid_extra(i_dim) = bs_env%kpoints_scf_desymm%nkp_grid(i_dim)*8
1015 cpabort(
"Error in periodicity.")
1022 cpabort(
"An error occured when setting up the k-mesh for W.")
1026 nkp_orig = max(nkp_grid(1)*nkp_grid(2)*nkp_grid(3)/2, 1)
1028 nkp_extra = nkp_grid_extra(1)*nkp_grid_extra(2)*nkp_grid_extra(3)/2
1030 nkp = nkp_orig + nkp_extra
1032 kpoints_chi_eps_w%nkp_grid(1:3) = nkp_grid(1:3)
1033 kpoints_chi_eps_w%nkp = nkp
1035 bs_env%nkp_grid_chi_eps_W_orig(1:3) = nkp_grid(1:3)
1036 bs_env%nkp_grid_chi_eps_W_extra(1:3) = nkp_grid_extra(1:3)
1037 bs_env%nkp_chi_eps_W_orig = nkp_orig
1038 bs_env%nkp_chi_eps_W_orig_plus_extra = nkp
1040 ALLOCATE (kpoints_chi_eps_w%xkp(3, nkp), kpoints_chi_eps_w%wkp(nkp))
1041 ALLOCATE (bs_env%wkp_no_extra(nkp), bs_env%wkp_s_p(nkp))
1043 CALL compute_xkp(kpoints_chi_eps_w%xkp, 1, nkp_orig, nkp_grid)
1044 CALL compute_xkp(kpoints_chi_eps_w%xkp, nkp_orig + 1, nkp, nkp_grid_extra)
1046 n_dim = sum(periodic)
1047 IF (n_dim == 0)
THEN
1049 kpoints_chi_eps_w%wkp(1) = 1.0_dp
1050 bs_env%wkp_s_p(1) = 1.0_dp
1051 bs_env%wkp_no_extra(1) = 1.0_dp
1054 n_dim_inv = 1.0_dp/real(n_dim, kind=
dp)
1057 CALL compute_wkp(kpoints_chi_eps_w%wkp(1:nkp_orig), nkp_orig, nkp_extra, n_dim_inv)
1058 CALL compute_wkp(kpoints_chi_eps_w%wkp(nkp_orig + 1:nkp), &
1059 nkp_extra, nkp_orig, n_dim_inv)
1061 bs_env%wkp_no_extra(1:nkp_orig) = 0.0_dp
1062 bs_env%wkp_no_extra(nkp_orig + 1:nkp) = 1.0_dp/real(nkp_extra, kind=
dp)
1064 IF (n_dim == 3)
THEN
1067 exp_s_p = 2.0_dp*n_dim_inv
1068 CALL compute_wkp(bs_env%wkp_s_p(1:nkp_orig), nkp_orig, nkp_extra, exp_s_p)
1069 CALL compute_wkp(bs_env%wkp_s_p(nkp_orig + 1:nkp), nkp_extra, nkp_orig, exp_s_p)
1071 bs_env%wkp_s_p(1:nkp) = bs_env%wkp_no_extra(1:nkp)
1076 IF (bs_env%approx_kp_extrapol)
THEN
1077 bs_env%wkp_orig = 1.0_dp/real(nkp_orig, kind=
dp)
1083 bs_env%nkp_chi_eps_W_batch = 4
1085 bs_env%num_chi_eps_W_batches = (bs_env%nkp_chi_eps_W_orig_plus_extra - 1)/ &
1086 bs_env%nkp_chi_eps_W_batch + 1
1090 IF (u > 0 .AND. bs_env%do_periodic)
THEN
1091 WRITE (u, fmt=
"(T2,A)")
" "
1092 WRITE (u, fmt=
"(T2,1A,T71,3I4)")
"K-point mesh 1 for χ, ε, W", nkp_grid(1:3)
1093 WRITE (u, fmt=
"(T2,2A,T71,3I4)")
"K-point mesh 2 for χ, ε, W ", &
1094 "(for k-point extrapolation of W)", nkp_grid_extra(1:3)
1095 WRITE (u, fmt=
"(T2,A,T80,L)")
"Approximate the k-point extrapolation", &
1096 bs_env%approx_kp_extrapol
1099 CALL timestop(handle)
1101 END SUBROUTINE setup_kpoints_chi_eps_w
1112 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: xkp
1113 INTEGER :: ikp_start, ikp_end
1114 INTEGER,
DIMENSION(3) :: grid
1116 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_xkp'
1118 INTEGER :: handle, i, ix, iy, iz
1120 CALL timeset(routinen, handle)
1127 IF (i > ikp_end) cycle
1129 xkp(1, i) = real(2*ix - grid(1) - 1, kind=
dp)/(2._dp*real(grid(1), kind=
dp))
1130 xkp(2, i) = real(2*iy - grid(2) - 1, kind=
dp)/(2._dp*real(grid(2), kind=
dp))
1131 xkp(3, i) = real(2*iz - grid(3) - 1, kind=
dp)/(2._dp*real(grid(3), kind=
dp))
1138 CALL timestop(handle)
1149 SUBROUTINE compute_wkp(wkp, nkp_1, nkp_2, exponent)
1150 REAL(kind=
dp),
DIMENSION(:) :: wkp
1151 INTEGER :: nkp_1, nkp_2
1152 REAL(kind=
dp) :: exponent
1154 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_wkp'
1157 REAL(kind=
dp) :: nkp_ratio
1159 CALL timeset(routinen, handle)
1161 nkp_ratio = real(nkp_2, kind=
dp)/real(nkp_1, kind=
dp)
1163 wkp(:) = 1.0_dp/real(nkp_1, kind=
dp)/(1.0_dp - nkp_ratio**exponent)
1165 CALL timestop(handle)
1167 END SUBROUTINE compute_wkp
1174 SUBROUTINE setup_cells_3c(qs_env, bs_env)
1179 CHARACTER(LEN=*),
PARAMETER :: routinen =
'setup_cells_3c'
1181 INTEGER :: atom_i, atom_j, atom_k, block_count, handle, i, i_cell_x, i_cell_x_max, &
1182 i_cell_x_min, i_size, ikind, img, j, j_cell, j_cell_max, j_cell_y, j_cell_y_max, &
1183 j_cell_y_min, j_size, k_cell, k_cell_max, k_cell_z, k_cell_z_max, k_cell_z_min, k_size, &
1184 nimage_pairs_3c, nimages_3c, nimages_3c_max, nkind, u
1185 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: kind_of, n_other_3c_images_max
1186 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: index_to_cell_3c_max, nblocks_3c_max
1187 INTEGER,
DIMENSION(3) :: cell_index, n_max
1188 REAL(kind=
dp) :: avail_mem_per_proc_gb, cell_dist, cell_radius_3c, dij, dik, djk, eps, &
1189 exp_min_ao, exp_min_ri, frobenius_norm, mem_3c_gb, mem_occ_per_proc_gb, radius_ao, &
1190 radius_ao_product, radius_ri
1191 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: exp_ao_kind, exp_ri_kind, &
1193 radius_ao_product_kind, radius_ri_kind
1194 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: int_3c
1195 REAL(kind=
dp),
DIMENSION(3) :: rij, rik, rjk, vec_cell_j, vec_cell_k
1196 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: exp_ao, exp_ri
1201 CALL timeset(routinen, handle)
1203 CALL get_qs_env(qs_env, nkind=nkind, atomic_kind_set=atomic_kind_set, particle_set=particle_set, cell=cell)
1205 ALLOCATE (exp_ao_kind(nkind), exp_ri_kind(nkind), radius_ao_kind(nkind), &
1206 radius_ao_product_kind(nkind), radius_ri_kind(nkind))
1208 exp_min_ri = 10.0_dp
1209 exp_min_ao = 10.0_dp
1210 exp_ri_kind = 10.0_dp
1211 exp_ao_kind = 10.0_dp
1213 eps = bs_env%eps_filter*bs_env%heuristic_filter_factor
1222 DO i = 1,
SIZE(exp_ri, 1)
1223 DO j = 1,
SIZE(exp_ri, 2)
1224 IF (exp_ri(i, j) < exp_min_ri .AND. exp_ri(i, j) > 1e-3_dp) exp_min_ri = exp_ri(i, j)
1225 IF (exp_ri(i, j) < exp_ri_kind(ikind) .AND. exp_ri(i, j) > 1e-3_dp)
THEN
1226 exp_ri_kind(ikind) = exp_ri(i, j)
1230 DO i = 1,
SIZE(exp_ao, 1)
1231 DO j = 1,
SIZE(exp_ao, 2)
1232 IF (exp_ao(i, j) < exp_min_ao .AND. exp_ao(i, j) > 1e-3_dp) exp_min_ao = exp_ao(i, j)
1233 IF (exp_ao(i, j) < exp_ao_kind(ikind) .AND. exp_ao(i, j) > 1e-3_dp)
THEN
1234 exp_ao_kind(ikind) = exp_ao(i, j)
1238 radius_ao_kind(ikind) = sqrt(-log(eps)/exp_ao_kind(ikind))
1239 radius_ao_product_kind(ikind) = sqrt(-log(eps)/(2.0_dp*exp_ao_kind(ikind)))
1240 radius_ri_kind(ikind) = sqrt(-log(eps)/exp_ri_kind(ikind))
1243 radius_ao = sqrt(-log(eps)/exp_min_ao)
1244 radius_ao_product = sqrt(-log(eps)/(2.0_dp*exp_min_ao))
1245 radius_ri = sqrt(-log(eps)/exp_min_ri)
1250 cell_radius_3c = radius_ao_product + radius_ri + bs_env%ri_metric%cutoff_radius
1252 n_max(1:3) = bs_env%periodic(1:3)*30
1263 DO i_cell_x = -n_max(1), n_max(1)
1264 DO j_cell_y = -n_max(2), n_max(2)
1265 DO k_cell_z = -n_max(3), n_max(3)
1267 cell_index(1:3) = [i_cell_x, j_cell_y, k_cell_z]
1269 CALL get_cell_dist(cell_index, bs_env%hmat, cell_dist)
1271 IF (cell_dist < cell_radius_3c)
THEN
1272 nimages_3c_max = nimages_3c_max + 1
1273 i_cell_x_min = min(i_cell_x_min, i_cell_x)
1274 i_cell_x_max = max(i_cell_x_max, i_cell_x)
1275 j_cell_y_min = min(j_cell_y_min, j_cell_y)
1276 j_cell_y_max = max(j_cell_y_max, j_cell_y)
1277 k_cell_z_min = min(k_cell_z_min, k_cell_z)
1278 k_cell_z_max = max(k_cell_z_max, k_cell_z)
1287 ALLOCATE (index_to_cell_3c_max(3, nimages_3c_max))
1290 DO i_cell_x = -n_max(1), n_max(1)
1291 DO j_cell_y = -n_max(2), n_max(2)
1292 DO k_cell_z = -n_max(3), n_max(3)
1294 cell_index(1:3) = [i_cell_x, j_cell_y, k_cell_z]
1296 CALL get_cell_dist(cell_index, bs_env%hmat, cell_dist)
1298 IF (cell_dist < cell_radius_3c)
THEN
1300 index_to_cell_3c_max(1:3, img) = cell_index(1:3)
1308 ALLOCATE (nblocks_3c_max(nimages_3c_max, nimages_3c_max))
1309 nblocks_3c_max(:, :) = 0
1312 DO j_cell = 1, nimages_3c_max
1313 DO k_cell = 1, nimages_3c_max
1315 DO atom_j = 1, bs_env%n_atom
1316 DO atom_k = 1, bs_env%n_atom
1317 DO atom_i = 1, bs_env%n_atom
1319 block_count = block_count + 1
1320 IF (
modulo(block_count, bs_env%para_env%num_pe) /= bs_env%para_env%mepos) cycle
1322 CALL scaled_to_real(vec_cell_j, real(index_to_cell_3c_max(1:3, j_cell), kind=
dp), cell)
1323 CALL scaled_to_real(vec_cell_k, real(index_to_cell_3c_max(1:3, k_cell), kind=
dp), cell)
1325 rij =
pbc(particle_set(atom_j)%r(:), cell) -
pbc(particle_set(atom_i)%r(:), cell) + vec_cell_j(:)
1326 rjk =
pbc(particle_set(atom_k)%r(:), cell) -
pbc(particle_set(atom_j)%r(:), cell) &
1327 + vec_cell_k(:) - vec_cell_j(:)
1328 rik(:) = rij(:) + rjk(:)
1332 IF (djk > radius_ao_kind(kind_of(atom_j)) + radius_ao_kind(kind_of(atom_k))) cycle
1333 IF (dij > radius_ao_kind(kind_of(atom_j)) + radius_ri_kind(kind_of(atom_i)) &
1334 + bs_env%ri_metric%cutoff_radius) cycle
1335 IF (dik > radius_ri_kind(kind_of(atom_i)) + radius_ao_kind(kind_of(atom_k)) &
1336 + bs_env%ri_metric%cutoff_radius) cycle
1338 j_size = bs_env%i_ao_end_from_atom(atom_j) - bs_env%i_ao_start_from_atom(atom_j) + 1
1339 k_size = bs_env%i_ao_end_from_atom(atom_k) - bs_env%i_ao_start_from_atom(atom_k) + 1
1340 i_size = bs_env%i_RI_end_from_atom(atom_i) - bs_env%i_RI_start_from_atom(atom_i) + 1
1342 ALLOCATE (int_3c(j_size, k_size, i_size))
1347 basis_j=bs_env%basis_set_AO, &
1348 basis_k=bs_env%basis_set_AO, &
1349 basis_i=bs_env%basis_set_RI, &
1350 cell_j=index_to_cell_3c_max(1:3, j_cell), &
1351 cell_k=index_to_cell_3c_max(1:3, k_cell), &
1352 atom_k=atom_k, atom_j=atom_j, atom_i=atom_i)
1354 frobenius_norm = norm2(int_3c)
1360 IF (frobenius_norm > eps)
THEN
1361 nblocks_3c_max(j_cell, k_cell) = nblocks_3c_max(j_cell, k_cell) + 1
1371 CALL bs_env%para_env%sum(nblocks_3c_max)
1373 ALLOCATE (n_other_3c_images_max(nimages_3c_max))
1374 n_other_3c_images_max(:) = 0
1379 DO j_cell = 1, nimages_3c_max
1380 DO k_cell = 1, nimages_3c_max
1381 IF (nblocks_3c_max(j_cell, k_cell) > 0)
THEN
1382 n_other_3c_images_max(j_cell) = n_other_3c_images_max(j_cell) + 1
1383 nimage_pairs_3c = nimage_pairs_3c + 1
1387 IF (n_other_3c_images_max(j_cell) > 0) nimages_3c = nimages_3c + 1
1391 bs_env%nimages_3c = nimages_3c
1392 ALLOCATE (bs_env%index_to_cell_3c(3, nimages_3c))
1393 ALLOCATE (bs_env%cell_to_index_3c(i_cell_x_min:i_cell_x_max, &
1394 j_cell_y_min:j_cell_y_max, &
1395 k_cell_z_min:k_cell_z_max))
1396 bs_env%cell_to_index_3c(:, :, :) = -1
1398 ALLOCATE (bs_env%nblocks_3c(nimages_3c, nimages_3c))
1399 bs_env%nblocks_3c(nimages_3c, nimages_3c) = 0
1402 DO j_cell_max = 1, nimages_3c_max
1403 IF (n_other_3c_images_max(j_cell_max) == 0) cycle
1405 cell_index(1:3) = index_to_cell_3c_max(1:3, j_cell_max)
1406 bs_env%index_to_cell_3c(1:3, j_cell) = cell_index(1:3)
1407 bs_env%cell_to_index_3c(cell_index(1), cell_index(2), cell_index(3)) = j_cell
1410 DO k_cell_max = 1, nimages_3c_max
1411 IF (n_other_3c_images_max(k_cell_max) == 0) cycle
1414 bs_env%nblocks_3c(j_cell, k_cell) = nblocks_3c_max(j_cell_max, k_cell_max)
1420 mem_3c_gb = real(bs_env%n_RI, kind=
dp)*real(bs_env%n_ao, kind=
dp)**2 &
1421 *real(nimage_pairs_3c, kind=
dp)*8e-9_dp
1426 avail_mem_per_proc_gb = bs_env%input_memory_per_proc_GB - mem_occ_per_proc_gb
1429 bs_env%group_size_tensor = max(int(mem_3c_gb/avail_mem_per_proc_gb + 1.0_dp), 1)
1434 WRITE (u, fmt=
"(T2,A,F52.1,A)")
"Radius of atomic orbitals", radius_ao*
angstrom,
" Å"
1435 WRITE (u, fmt=
"(T2,A,F55.1,A)")
"Radius of RI functions", radius_ri*
angstrom,
" Å"
1436 WRITE (u, fmt=
"(T2,A,I47)")
"Number of cells for 3c integrals", nimages_3c
1437 WRITE (u, fmt=
"(T2,A,I42)")
"Number of cell pairs for 3c integrals", nimage_pairs_3c
1438 WRITE (u,
'(T2,A)')
''
1439 IF (bs_env%auto_memory_per_proc)
THEN
1440 WRITE (u,
'(T2,A,F34.1,A)')
'Detected: Available memory per MPI process', &
1441 bs_env%input_memory_per_proc_GB,
' GB'
1443 WRITE (u,
'(T2,A,F37.1,A)')
'Input: Available memory per MPI process', &
1444 bs_env%input_memory_per_proc_GB,
' GB'
1446 WRITE (u,
'(T2,A,F35.1,A)')
'Used memory per MPI process before GW run', &
1447 mem_occ_per_proc_gb,
' GB'
1448 WRITE (u,
'(T2,A,F44.1,A)')
'Memory of three-center integrals', mem_3c_gb,
' GB'
1451 CALL timestop(handle)
1453 END SUBROUTINE setup_cells_3c
1461 SUBROUTINE get_cell_dist(cell_index, hmat, cell_dist)
1463 INTEGER,
DIMENSION(3) :: cell_index
1464 REAL(kind=
dp) :: hmat(3, 3), cell_dist
1466 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_cell_dist'
1468 INTEGER :: handle, i_dim
1469 INTEGER,
DIMENSION(3) :: cell_index_adj
1470 REAL(kind=
dp) :: cell_dist_3(3)
1472 CALL timeset(routinen, handle)
1477 IF (cell_index(i_dim) > 0) cell_index_adj(i_dim) = cell_index(i_dim) - 1
1478 IF (cell_index(i_dim) < 0) cell_index_adj(i_dim) = cell_index(i_dim) + 1
1479 IF (cell_index(i_dim) == 0) cell_index_adj(i_dim) = cell_index(i_dim)
1482 cell_dist_3(1:3) = matmul(hmat, real(cell_index_adj, kind=
dp))
1484 cell_dist = norm2(cell_dist_3)
1486 CALL timestop(handle)
1488 END SUBROUTINE get_cell_dist
1495 SUBROUTINE set_parallelization_parameters(qs_env, bs_env)
1499 CHARACTER(LEN=*),
PARAMETER :: routinen =
'set_parallelization_parameters'
1501 INTEGER :: color_sub, dummy_1, dummy_2, handle, &
1502 num_pe, num_t_groups, u
1505 CALL timeset(routinen, handle)
1509 num_pe = para_env%num_pe
1512 IF (bs_env%group_size_tensor < 0 .OR. bs_env%group_size_tensor > num_pe)
THEN
1513 bs_env%group_size_tensor = num_pe
1517 IF (
modulo(num_pe, bs_env%group_size_tensor) /= 0)
THEN
1518 CALL find_good_group_size(num_pe, bs_env%group_size_tensor)
1522 color_sub = para_env%mepos/bs_env%group_size_tensor
1523 bs_env%tensor_group_color = color_sub
1525 ALLOCATE (bs_env%para_env_tensor)
1526 CALL bs_env%para_env_tensor%from_split(para_env, color_sub)
1528 num_t_groups = para_env%num_pe/bs_env%group_size_tensor
1529 bs_env%num_tensor_groups = num_t_groups
1531 CALL get_i_j_atoms(bs_env%atoms_i, bs_env%atoms_j, bs_env%n_atom_i, bs_env%n_atom_j, &
1534 ALLOCATE (bs_env%atoms_i_t_group(2, num_t_groups))
1535 ALLOCATE (bs_env%atoms_j_t_group(2, num_t_groups))
1536 DO color_sub = 0, num_t_groups - 1
1537 CALL get_i_j_atoms(bs_env%atoms_i_t_group(1:2, color_sub + 1), &
1538 bs_env%atoms_j_t_group(1:2, color_sub + 1), &
1539 dummy_1, dummy_2, color_sub, bs_env)
1543 IF (u > 0 .AND. .NOT. bs_env%do_gw_ri_rs)
THEN
1544 WRITE (u,
'(T2,A,I47)')
'Group size for tensor operations', bs_env%group_size_tensor
1545 IF (bs_env%group_size_tensor > 1 .AND. bs_env%n_atom < 5)
THEN
1546 WRITE (u,
'(T2,A)')
'The requested group size is > 1 which can lead to bad performance.'
1547 WRITE (u,
'(T2,A)')
'Using more memory per MPI process might improve performance.'
1548 WRITE (u,
'(T2,A)')
'(Also increase MEMORY_PER_PROC when using more memory per process.)'
1552 CALL timestop(handle)
1554 END SUBROUTINE set_parallelization_parameters
1561 SUBROUTINE find_good_group_size(num_pe, group_size)
1563 INTEGER :: num_pe, group_size
1565 CHARACTER(LEN=*),
PARAMETER :: routinen =
'find_good_group_size'
1567 INTEGER :: group_size_minus, group_size_orig, &
1568 group_size_plus, handle, i_diff
1570 CALL timeset(routinen, handle)
1572 group_size_orig = group_size
1574 DO i_diff = 1, num_pe
1576 group_size_minus = group_size - i_diff
1578 IF (
modulo(num_pe, group_size_minus) == 0 .AND. group_size_minus > 0)
THEN
1579 group_size = group_size_minus
1583 group_size_plus = group_size + i_diff
1585 IF (
modulo(num_pe, group_size_plus) == 0 .AND. group_size_plus <= num_pe)
THEN
1586 group_size = group_size_plus
1592 IF (group_size_orig == group_size) cpabort(
"Group size error")
1594 CALL timestop(handle)
1596 END SUBROUTINE find_good_group_size
1607 SUBROUTINE get_i_j_atoms(atoms_i, atoms_j, n_atom_i, n_atom_j, color_sub, bs_env)
1609 INTEGER,
DIMENSION(2) :: atoms_i, atoms_j
1610 INTEGER :: n_atom_i, n_atom_j, color_sub
1613 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_i_j_atoms'
1615 INTEGER :: handle, i_atoms_per_group, i_group, &
1616 ipcol, ipcol_loop, iprow, iprow_loop, &
1617 j_atoms_per_group, npcol, nprow
1619 CALL timeset(routinen, handle)
1622 CALL square_mesh(nprow, npcol, bs_env%num_tensor_groups)
1625 DO ipcol_loop = 0, npcol - 1
1626 DO iprow_loop = 0, nprow - 1
1627 IF (i_group == color_sub)
THEN
1631 i_group = i_group + 1
1635 IF (
modulo(bs_env%n_atom, nprow) == 0)
THEN
1636 i_atoms_per_group = bs_env%n_atom/nprow
1638 i_atoms_per_group = bs_env%n_atom/nprow + 1
1641 IF (
modulo(bs_env%n_atom, npcol) == 0)
THEN
1642 j_atoms_per_group = bs_env%n_atom/npcol
1644 j_atoms_per_group = bs_env%n_atom/npcol + 1
1647 atoms_i(1) = iprow*i_atoms_per_group + 1
1648 atoms_i(2) = min((iprow + 1)*i_atoms_per_group, bs_env%n_atom)
1649 n_atom_i = atoms_i(2) - atoms_i(1) + 1
1651 atoms_j(1) = ipcol*j_atoms_per_group + 1
1652 atoms_j(2) = min((ipcol + 1)*j_atoms_per_group, bs_env%n_atom)
1653 n_atom_j = atoms_j(2) - atoms_j(1) + 1
1655 CALL timestop(handle)
1657 END SUBROUTINE get_i_j_atoms
1665 SUBROUTINE square_mesh(nprow, npcol, nproc)
1666 INTEGER :: nprow, npcol, nproc
1668 CHARACTER(LEN=*),
PARAMETER :: routinen =
'square_mesh'
1670 INTEGER :: gcd_max, handle, ipe, jpe
1672 CALL timeset(routinen, handle)
1675 DO ipe = 1, ceiling(sqrt(real(nproc,
dp)))
1677 IF (ipe*jpe /= nproc) cycle
1678 IF (
gcd(ipe, jpe) >= gcd_max)
THEN
1681 gcd_max =
gcd(ipe, jpe)
1685 CALL timestop(handle)
1687 END SUBROUTINE square_mesh
1694 SUBROUTINE allocate_matrices(qs_env, bs_env)
1698 CHARACTER(LEN=*),
PARAMETER :: routinen =
'allocate_matrices'
1700 INTEGER :: handle, i_t
1705 CALL timeset(routinen, handle)
1707 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
1709 fm_struct => bs_env%fm_ks_Gamma(1)%matrix_struct
1714 NULLIFY (fm_struct_ri_global)
1715 CALL cp_fm_struct_create(fm_struct_ri_global, context=blacs_env, nrow_global=bs_env%n_RI, &
1716 ncol_global=bs_env%n_RI, para_env=para_env)
1717 CALL cp_fm_create(bs_env%fm_RI_RI, fm_struct_ri_global)
1718 CALL cp_fm_create(bs_env%fm_chi_Gamma_freq, fm_struct_ri_global)
1719 CALL cp_fm_create(bs_env%fm_W_MIC_freq, fm_struct_ri_global)
1720 IF (bs_env%approx_kp_extrapol)
THEN
1721 CALL cp_fm_create(bs_env%fm_W_MIC_freq_1_extra, fm_struct_ri_global)
1722 CALL cp_fm_create(bs_env%fm_W_MIC_freq_1_no_extra, fm_struct_ri_global)
1728 IF (.NOT. bs_env%do_gw_ri_rs)
THEN
1730 NULLIFY (blacs_env_tensor)
1737 CALL create_mat_munu(bs_env%mat_ao_ao_tensor, qs_env, bs_env%eps_atom_grid_2d_mat, &
1738 blacs_env_tensor, do_ri_aux_basis=.false.)
1740 CALL create_mat_munu(bs_env%mat_RI_RI_tensor, qs_env, bs_env%eps_atom_grid_2d_mat, &
1741 blacs_env_tensor, do_ri_aux_basis=.true.)
1746 CALL create_mat_munu(bs_env%mat_RI_RI, qs_env, bs_env%eps_atom_grid_2d_mat, &
1747 blacs_env, do_ri_aux_basis=.true., &
1748 custom_row_blk_sizes=bs_env%sizes_RI)
1750 NULLIFY (bs_env%mat_chi_Gamma_tau)
1753 DO i_t = 1, bs_env%num_time_freq_points
1754 ALLOCATE (bs_env%mat_chi_Gamma_tau(i_t)%matrix)
1755 CALL dbcsr_create(bs_env%mat_chi_Gamma_tau(i_t)%matrix, template=bs_env%mat_RI_RI%matrix)
1758 CALL timestop(handle)
1760 END SUBROUTINE allocate_matrices
1767 SUBROUTINE compute_minv_gamma(qs_env, bs_env)
1771 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_Minv_Gamma'
1774 REAL(kind=
dp) :: eigenvalue_threshold, &
1775 metric_regularization
1776 TYPE(
cp_fm_type),
ALLOCATABLE,
DIMENSION(:, :) :: fm_m
1778 CALL timeset(routinen, handle)
1780 CALL cp_fm_create(bs_env%fm_Minv_Gamma, bs_env%fm_RI_RI%matrix_struct)
1781 IF (bs_env%auto_ri%enabled)
THEN
1782 cpassert(bs_env%auto_ri%ready)
1783 CALL cp_fm_to_fm(bs_env%auto_ri%M_pq_inv, bs_env%fm_Minv_Gamma)
1785 metric_regularization = 0.0_dp
1786 eigenvalue_threshold = 0.0_dp
1787 IF (bs_env%do_gw_ri_rs)
THEN
1788 metric_regularization = bs_env%regularization_RI
1789 eigenvalue_threshold = bs_env%eps_eigval_mat_RI
1793 regularization_ri=metric_regularization)
1794 CALL fm_invert(fm_m(1, 1), eigenvalue_threshold, bs_env%unit_nr)
1795 CALL cp_fm_to_fm(fm_m(1, 1), bs_env%fm_Minv_Gamma)
1799 CALL timestop(handle)
1801 END SUBROUTINE compute_minv_gamma
1808 SUBROUTINE compute_v_xc(qs_env, bs_env)
1812 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_V_xc'
1814 INTEGER :: handle, img, ispin, myfun, nimages
1815 LOGICAL :: hf_present
1816 REAL(kind=
dp) :: energy_ex, energy_exc, energy_total, &
1818 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: mat_ks_without_v_xc
1819 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_ks_kp
1824 CALL timeset(routinen, handle)
1826 CALL get_qs_env(qs_env, input=input, energy=energy, dft_control=dft_control)
1829 nimages = dft_control%nimages
1830 dft_control%nimages = bs_env%nimages_scf
1837 hf_present = .false.
1838 IF (
ASSOCIATED(hf_section))
THEN
1841 IF (hf_present)
THEN
1848 energy_total = energy%total
1849 energy_exc = energy%exc
1850 energy_ex = energy%ex
1852 SELECT CASE (bs_env%gw_implementation)
1855 NULLIFY (mat_ks_without_v_xc)
1858 DO ispin = 1, bs_env%n_spin
1859 ALLOCATE (mat_ks_without_v_xc(ispin)%matrix)
1860 IF (hf_present)
THEN
1861 CALL dbcsr_create(mat_ks_without_v_xc(ispin)%matrix, template=bs_env%mat_ao_ao%matrix, &
1862 matrix_type=dbcsr_type_symmetric)
1864 CALL dbcsr_create(mat_ks_without_v_xc(ispin)%matrix, template=bs_env%mat_ao_ao%matrix)
1870 ext_ks_matrix=mat_ks_without_v_xc)
1872 DO ispin = 1, bs_env%n_spin
1874 CALL cp_fm_create(bs_env%fm_V_xc_Gamma(ispin), bs_env%fm_s_Gamma%matrix_struct)
1875 CALL copy_dbcsr_to_fm(mat_ks_without_v_xc(ispin)%matrix, bs_env%fm_V_xc_Gamma(ispin))
1879 beta=1.0_dp, matrix_b=bs_env%fm_ks_Gamma(ispin))
1888 CALL get_qs_env(qs_env=qs_env, matrix_ks_kp=matrix_ks_kp)
1890 ALLOCATE (bs_env%fm_V_xc_R(dft_control%nimages, bs_env%n_spin))
1891 DO ispin = 1, bs_env%n_spin
1892 DO img = 1, dft_control%nimages
1894 CALL copy_dbcsr_to_fm(matrix_ks_kp(ispin, img)%matrix, bs_env%fm_work_mo(1))
1895 CALL cp_fm_create(bs_env%fm_V_xc_R(img, ispin), bs_env%fm_work_mo(1)%matrix_struct, &
1899 beta=1.0_dp, matrix_b=bs_env%fm_work_mo(1))
1906 energy%total = energy_total
1907 energy%exc = energy_exc
1908 energy%ex = energy_ex
1911 dft_control%nimages = nimages
1916 IF (hf_present)
THEN
1924 DO ispin = 1, bs_env%n_spin
1925 DO img = 1, dft_control%nimages
1927 CALL copy_dbcsr_to_fm(matrix_ks_kp(ispin, img)%matrix, bs_env%fm_work_mo(1))
1930 beta=1.0_dp, matrix_b=bs_env%fm_work_mo(1))
1935 CALL timestop(handle)
1937 END SUBROUTINE compute_v_xc
1943 SUBROUTINE init_interaction_radii(bs_env)
1946 CHARACTER(LEN=*),
PARAMETER :: routinen =
'init_interaction_radii'
1948 INTEGER :: handle, ibasis
1951 CALL timeset(routinen, handle)
1953 DO ibasis = 1,
SIZE(bs_env%basis_set_AO)
1955 orb_basis => bs_env%basis_set_AO(ibasis)%gto_basis_set
1958 ri_basis => bs_env%basis_set_RI(ibasis)%gto_basis_set
1963 CALL timestop(handle)
1965 END SUBROUTINE init_interaction_radii
1972 SUBROUTINE create_tensors(qs_env, bs_env)
1976 CHARACTER(LEN=*),
PARAMETER :: routinen =
'create_tensors'
1980 CALL timeset(routinen, handle)
1984 CALL create_3c_t(bs_env%t_RI_AO__AO, bs_env%para_env_tensor,
"(RI AO | AO)", [1, 2], [3], &
1985 bs_env%sizes_RI, bs_env%sizes_AO, &
1986 create_nl_3c=.true., nl_3c=bs_env%nl_3c, qs_env=qs_env)
1987 CALL create_3c_t(bs_env%t_RI__AO_AO, bs_env%para_env_tensor,
"(RI | AO AO)", [1], [2, 3], &
1988 bs_env%sizes_RI, bs_env%sizes_AO)
1990 CALL create_2c_t(bs_env)
1992 CALL timestop(handle)
1994 END SUBROUTINE create_tensors
2009 SUBROUTINE create_3c_t(tensor, para_env, tensor_name, map1, map2, sizes_RI, sizes_AO, &
2010 create_nl_3c, nl_3c, qs_env)
2013 CHARACTER(LEN=12) :: tensor_name
2014 INTEGER,
DIMENSION(:) :: map1, map2
2015 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: sizes_ri, sizes_ao
2016 LOGICAL,
OPTIONAL :: create_nl_3c
2020 CHARACTER(LEN=*),
PARAMETER :: routinen =
'create_3c_t'
2022 INTEGER :: handle, nkind
2023 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: dist_ao_1, dist_ao_2, dist_ri
2024 INTEGER,
DIMENSION(3) :: pcoord, pdims, pdims_3d
2025 LOGICAL :: my_create_nl_3c
2026 TYPE(dbt_pgrid_type) :: pgrid_3d
2031 CALL timeset(routinen, handle)
2034 CALL dbt_pgrid_create(para_env, pdims_3d, pgrid_3d)
2036 pgrid_3d, sizes_ri, sizes_ao, sizes_ao, &
2037 map1=map1, map2=map2, name=tensor_name)
2039 IF (
PRESENT(create_nl_3c))
THEN
2040 my_create_nl_3c = create_nl_3c
2042 my_create_nl_3c = .false.
2045 IF (my_create_nl_3c)
THEN
2046 CALL get_qs_env(qs_env, nkind=nkind, particle_set=particle_set)
2047 CALL dbt_mp_environ_pgrid(pgrid_3d, pdims, pcoord)
2048 CALL mp_comm_t3c_2%create(pgrid_3d%mp_comm_2d, 3, pdims)
2050 nkind, particle_set, mp_comm_t3c_2, own_comm=.true.)
2053 qs_env%bs_env%basis_set_RI, &
2054 qs_env%bs_env%basis_set_AO, &
2055 qs_env%bs_env%basis_set_AO, &
2056 dist_3d, qs_env%bs_env%ri_metric, &
2057 "GW_3c_nl", qs_env, own_dist=.true.)
2060 DEALLOCATE (dist_ri, dist_ao_1, dist_ao_2)
2061 CALL dbt_pgrid_destroy(pgrid_3d)
2063 CALL timestop(handle)
2065 END SUBROUTINE create_3c_t
2071 SUBROUTINE create_2c_t(bs_env)
2074 CHARACTER(LEN=*),
PARAMETER :: routinen =
'create_2c_t'
2077 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: dist_1, dist_2
2078 INTEGER,
DIMENSION(2) :: pdims_2d
2079 TYPE(dbt_pgrid_type) :: pgrid_2d
2081 CALL timeset(routinen, handle)
2086 CALL dbt_pgrid_create(bs_env%para_env_tensor, pdims_2d, pgrid_2d)
2089 bs_env%sizes_AO, bs_env%sizes_AO, &
2091 DEALLOCATE (dist_1, dist_2)
2093 bs_env%sizes_RI, bs_env%sizes_RI, &
2095 DEALLOCATE (dist_1, dist_2)
2097 bs_env%sizes_RI, bs_env%sizes_RI, &
2099 DEALLOCATE (dist_1, dist_2)
2100 CALL dbt_pgrid_destroy(pgrid_2d)
2102 CALL timestop(handle)
2104 END SUBROUTINE create_2c_t
2111 SUBROUTINE check_sparsity_3c(qs_env, bs_env)
2115 CHARACTER(LEN=*),
PARAMETER :: routinen =
'check_sparsity_3c'
2117 INTEGER :: handle, n_atom_step, ri_atom
2118 INTEGER(int_8) :: non_zero_elements_sum, nze
2119 REAL(
dp) :: max_dist_ao_atoms, occ, occupation_sum
2120 REAL(kind=
dp) :: t1, t2
2121 TYPE(dbt_type),
ALLOCATABLE,
DIMENSION(:, :) :: t_3c_global_array
2123 CALL timeset(routinen, handle)
2128 ALLOCATE (t_3c_global_array(1, 1))
2129 CALL dbt_create(bs_env%t_RI_AO__AO, t_3c_global_array(1, 1))
2133 ALLOCATE (bs_env%min_RI_idx_from_AO_AO_atom(bs_env%n_atom, bs_env%n_atom))
2134 ALLOCATE (bs_env%max_RI_idx_from_AO_AO_atom(bs_env%n_atom, bs_env%n_atom))
2135 ALLOCATE (bs_env%min_AO_idx_from_RI_AO_atom(bs_env%n_atom, bs_env%n_atom))
2136 ALLOCATE (bs_env%max_AO_idx_from_RI_AO_atom(bs_env%n_atom, bs_env%n_atom))
2137 bs_env%min_RI_idx_from_AO_AO_atom(:, :) = bs_env%n_RI
2138 bs_env%max_RI_idx_from_AO_AO_atom(:, :) = 1
2139 bs_env%min_AO_idx_from_RI_AO_atom(:, :) = bs_env%n_AO
2140 bs_env%max_AO_idx_from_RI_AO_atom(:, :) = 1
2142 CALL bs_env%para_env%sync()
2145 occupation_sum = 0.0_dp
2146 non_zero_elements_sum = 0
2147 max_dist_ao_atoms = 0.0_dp
2148 n_atom_step = int(sqrt(real(bs_env%n_atom, kind=
dp)))
2150 DO ri_atom = 1, bs_env%n_atom, n_atom_step
2153 bs_env%eps_filter, &
2156 int_eps=bs_env%eps_filter, &
2157 basis_i=bs_env%basis_set_RI, &
2158 basis_j=bs_env%basis_set_AO, &
2159 basis_k=bs_env%basis_set_AO, &
2160 bounds_i=[ri_atom, min(ri_atom + n_atom_step - 1, bs_env%n_atom)], &
2161 potential_parameter=bs_env%ri_metric, &
2162 desymmetrize=.false.)
2164 CALL dbt_filter(t_3c_global_array(1, 1), bs_env%eps_filter)
2166 CALL bs_env%para_env%sync()
2169 non_zero_elements_sum = non_zero_elements_sum + nze
2170 occupation_sum = occupation_sum + occ
2172 CALL get_max_dist_ao_atoms(t_3c_global_array(1, 1), max_dist_ao_atoms, qs_env)
2175 CALL get_i_j_atom_ranges(t_3c_global_array(1, 1), bs_env)
2177 CALL dbt_clear(t_3c_global_array(1, 1))
2184 bs_env%max_dist_AO_atoms = max_dist_ao_atoms
2186 bs_env%occupation_3c_int = occupation_sum
2188 CALL bs_env%para_env%min(bs_env%min_RI_idx_from_AO_AO_atom)
2189 CALL bs_env%para_env%max(bs_env%max_RI_idx_from_AO_AO_atom)
2190 CALL bs_env%para_env%min(bs_env%min_AO_idx_from_RI_AO_atom)
2191 CALL bs_env%para_env%max(bs_env%max_AO_idx_from_RI_AO_atom)
2193 CALL dbt_destroy(t_3c_global_array(1, 1))
2194 DEALLOCATE (t_3c_global_array)
2196 IF (bs_env%unit_nr > 0)
THEN
2197 WRITE (bs_env%unit_nr,
'(T2,A)')
''
2198 WRITE (bs_env%unit_nr,
'(T2,A,F27.1,A)') &
2199 'Computed 3-center integrals (µν|P), execution time', t2 - t1,
' s'
2200 WRITE (bs_env%unit_nr,
'(T2,A,F48.3,A)')
'Percentage of non-zero (µν|P)', &
2201 bs_env%occupation_3c_int*100,
' %'
2202 WRITE (bs_env%unit_nr,
'(T2,A,F33.1,A)')
'Max. distance between µ,ν in non-zero (µν|P)', &
2203 bs_env%max_dist_AO_atoms*
angstrom,
' A'
2204 WRITE (bs_env%unit_nr,
'(T2,2A,I20,A)')
'Required memory if storing all 3-center ', &
2205 'integrals (µν|P)', int(real(non_zero_elements_sum, kind=
dp)*8.0e-9_dp),
' GB'
2208 CALL timestop(handle)
2210 END SUBROUTINE check_sparsity_3c
2218 SUBROUTINE get_max_dist_ao_atoms(t_3c_int, max_dist_AO_atoms, qs_env)
2219 TYPE(dbt_type) :: t_3c_int
2220 REAL(kind=
dp),
INTENT(INOUT) :: max_dist_ao_atoms
2223 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_max_dist_AO_atoms'
2225 INTEGER :: atom_1, atom_2, handle, num_cells
2226 INTEGER,
DIMENSION(3) :: atom_ind
2227 INTEGER,
DIMENSION(:, :),
POINTER :: index_to_cell
2228 REAL(kind=
dp) :: abs_rab
2229 REAL(kind=
dp),
DIMENSION(3) :: rab
2231 TYPE(dbt_iterator_type) :: iter
2235 CALL timeset(routinen, handle)
2237 NULLIFY (cell, particle_set, para_env)
2238 CALL get_qs_env(qs_env, cell=cell, particle_set=particle_set, para_env=para_env)
2249 CALL dbt_iterator_start(iter, t_3c_int)
2250 DO WHILE (dbt_iterator_blocks_left(iter))
2251 CALL dbt_iterator_next_block(iter, atom_ind)
2253 atom_1 = atom_ind(2)
2254 atom_2 = atom_ind(3)
2255 rab =
pbc(particle_set(atom_1)%r(1:3), particle_set(atom_2)%r(1:3), cell)
2256 abs_rab = sqrt(rab(1)**2 + rab(2)**2 + rab(3)**2)
2259 max_dist_ao_atoms = max(max_dist_ao_atoms, abs_rab)
2262 CALL dbt_iterator_stop(iter)
2265 CALL para_env%max(max_dist_ao_atoms)
2267 CALL timestop(handle)
2269 END SUBROUTINE get_max_dist_ao_atoms
2276 SUBROUTINE get_i_j_atom_ranges(t_3c, bs_env)
2277 TYPE(dbt_type) :: t_3c
2280 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_i_j_atom_ranges'
2282 INTEGER :: handle, idx_ao_end, idx_ao_start, &
2283 idx_ri_end, idx_ri_start
2284 INTEGER,
DIMENSION(3) :: atom_ind
2285 TYPE(dbt_iterator_type) :: iter
2287 CALL timeset(routinen, handle)
2295 CALL dbt_iterator_start(iter, t_3c)
2296 DO WHILE (dbt_iterator_blocks_left(iter))
2297 CALL dbt_iterator_next_block(iter, atom_ind)
2300 idx_ri_start = bs_env%i_RI_start_from_atom(atom_ind(1))
2301 idx_ri_end = bs_env%i_RI_end_from_atom(atom_ind(1))
2303 idx_ao_start = bs_env%i_ao_start_from_atom(atom_ind(2))
2304 idx_ao_end = bs_env%i_ao_end_from_atom(atom_ind(2))
2308 bs_env%min_RI_idx_from_AO_AO_atom(atom_ind(2), atom_ind(3)) = &
2309 min(bs_env%min_RI_idx_from_AO_AO_atom(atom_ind(2), atom_ind(3)), idx_ri_start)
2311 bs_env%max_RI_idx_from_AO_AO_atom(atom_ind(2), atom_ind(3)) = &
2312 max(bs_env%max_RI_idx_from_AO_AO_atom(atom_ind(2), atom_ind(3)), idx_ri_end)
2315 bs_env%min_AO_idx_from_RI_AO_atom(atom_ind(1), atom_ind(3)) = &
2316 min(bs_env%min_AO_idx_from_RI_AO_atom(atom_ind(1), atom_ind(3)), idx_ao_start)
2318 bs_env%max_AO_idx_from_RI_AO_atom(atom_ind(1), atom_ind(3)) = &
2319 max(bs_env%max_AO_idx_from_RI_AO_atom(atom_ind(1), atom_ind(3)), idx_ao_end)
2322 CALL dbt_iterator_stop(iter)
2325 CALL timestop(handle)
2327 END SUBROUTINE get_i_j_atom_ranges
2333 SUBROUTINE set_sparsity_parallelization_parameters(bs_env)
2336 CHARACTER(LEN=*),
PARAMETER :: routinen =
'set_sparsity_parallelization_parameters'
2338 INTEGER :: handle, i_ivl, il_ivl, j_ivl, n_atom_per_il_ivl, n_atom_per_ivl, n_intervals_i, &
2339 n_intervals_inner_loop_atoms, n_intervals_j, u
2340 INTEGER(KIND=int_8) :: input_memory_per_proc
2342 CALL timeset(routinen, handle)
2345 bs_env%safety_factor_memory = 0.10_dp
2347 input_memory_per_proc = int(bs_env%input_memory_per_proc_GB*1.0e9_dp, kind=
int_8)
2353 n_atom_per_ivl = int(sqrt(bs_env%safety_factor_memory*input_memory_per_proc &
2354 *bs_env%group_size_tensor/24/bs_env%n_RI &
2355 /sqrt(bs_env%occupation_3c_int)))/bs_env%max_AO_bf_per_atom
2357 n_intervals_i = (bs_env%n_atom_i - 1)/n_atom_per_ivl + 1
2358 n_intervals_j = (bs_env%n_atom_j - 1)/n_atom_per_ivl + 1
2360 bs_env%n_intervals_i = n_intervals_i
2361 bs_env%n_intervals_j = n_intervals_j
2363 ALLOCATE (bs_env%i_atom_intervals(2, n_intervals_i))
2364 ALLOCATE (bs_env%j_atom_intervals(2, n_intervals_j))
2366 DO i_ivl = 1, n_intervals_i
2367 bs_env%i_atom_intervals(1, i_ivl) = (i_ivl - 1)*n_atom_per_ivl + bs_env%atoms_i(1)
2368 bs_env%i_atom_intervals(2, i_ivl) = min(i_ivl*n_atom_per_ivl + bs_env%atoms_i(1) - 1, &
2372 DO j_ivl = 1, n_intervals_j
2373 bs_env%j_atom_intervals(1, j_ivl) = (j_ivl - 1)*n_atom_per_ivl + bs_env%atoms_j(1)
2374 bs_env%j_atom_intervals(2, j_ivl) = min(j_ivl*n_atom_per_ivl + bs_env%atoms_j(1) - 1, &
2378 ALLOCATE (bs_env%skip_Sigma_occ(n_intervals_i, n_intervals_j))
2379 ALLOCATE (bs_env%skip_Sigma_vir(n_intervals_i, n_intervals_j))
2380 bs_env%skip_Sigma_occ(:, :) = .false.
2381 bs_env%skip_Sigma_vir(:, :) = .false.
2382 bs_env%n_skip_chi = 0
2384 ALLOCATE (bs_env%skip_chi(n_intervals_i, n_intervals_j))
2385 bs_env%skip_chi(:, :) = .false.
2386 bs_env%n_skip_sigma = 0
2391 n_atom_per_il_ivl = min(int(bs_env%safety_factor_memory*input_memory_per_proc &
2392 *bs_env%group_size_tensor/n_atom_per_ivl &
2393 /bs_env%max_AO_bf_per_atom &
2394 /bs_env%n_RI/8/sqrt(bs_env%occupation_3c_int) &
2395 /bs_env%max_AO_bf_per_atom), bs_env%n_atom)
2397 n_intervals_inner_loop_atoms = (bs_env%n_atom - 1)/n_atom_per_il_ivl + 1
2399 bs_env%n_intervals_inner_loop_atoms = n_intervals_inner_loop_atoms
2401 ALLOCATE (bs_env%inner_loop_atom_intervals(2, n_intervals_inner_loop_atoms))
2402 DO il_ivl = 1, n_intervals_inner_loop_atoms
2403 bs_env%inner_loop_atom_intervals(1, il_ivl) = (il_ivl - 1)*n_atom_per_il_ivl + 1
2404 bs_env%inner_loop_atom_intervals(2, il_ivl) = min(il_ivl*n_atom_per_il_ivl, bs_env%n_atom)
2409 WRITE (u,
'(T2,A)')
''
2410 WRITE (u,
'(T2,A,I33)')
'Number of i and j atoms in M_λνP(τ), N_νλQ(τ):', n_atom_per_ivl
2411 WRITE (u,
'(T2,A,I18)')
'Number of inner loop atoms for µ in M_λνP = sum_µ (µν|P) G_µλ', &
2415 CALL timestop(handle)
2417 END SUBROUTINE set_sparsity_parallelization_parameters
2424 SUBROUTINE check_for_restart_files(qs_env, bs_env)
2428 CHARACTER(LEN=*),
PARAMETER :: routinen =
'check_for_restart_files'
2430 CHARACTER(LEN=9) :: frmt
2431 CHARACTER(len=default_path_length) :: f_chi, f_s_n, f_s_p, f_s_x, f_w_t, &
2432 prefix, project_name, z_lp_name
2433 INTEGER :: handle, i_spin, i_t_or_w, ind, n_spin, &
2434 num_time_freq_points
2435 LOGICAL :: chi_exists, sigma_neg_time_exists, &
2436 sigma_pos_time_exists, &
2437 sigma_x_spin_exists, w_time_exists, &
2442 CALL timeset(routinen, handle)
2444 num_time_freq_points = bs_env%num_time_freq_points
2445 n_spin = bs_env%n_spin
2447 ALLOCATE (bs_env%read_chi(num_time_freq_points))
2448 ALLOCATE (bs_env%calc_chi(num_time_freq_points))
2449 ALLOCATE (bs_env%Sigma_c_exists(num_time_freq_points, n_spin))
2457 WRITE (prefix,
'(2A)') trim(project_name),
"-RESTART_"
2458 bs_env%prefix = prefix
2460 bs_env%all_W_exist = .true.
2462 DO i_t_or_w = 1, num_time_freq_points
2464 IF (i_t_or_w < 10)
THEN
2465 WRITE (frmt,
'(A)')
'(3A,I1,A)'
2466 WRITE (f_chi, frmt) trim(prefix), bs_env%chi_name,
"_0", i_t_or_w,
".matrix"
2467 WRITE (f_w_t, frmt) trim(prefix), bs_env%W_time_name,
"_0", i_t_or_w,
".matrix"
2468 ELSE IF (i_t_or_w < 100)
THEN
2469 WRITE (frmt,
'(A)')
'(3A,I2,A)'
2470 WRITE (f_chi, frmt) trim(prefix), bs_env%chi_name,
"_", i_t_or_w,
".matrix"
2471 WRITE (f_w_t, frmt) trim(prefix), bs_env%W_time_name,
"_", i_t_or_w,
".matrix"
2473 cpabort(
'Please implement more than 99 time/frequency points.')
2476 INQUIRE (file=trim(f_chi), exist=chi_exists)
2477 INQUIRE (file=trim(f_w_t), exist=w_time_exists)
2479 bs_env%read_chi(i_t_or_w) = chi_exists
2480 bs_env%calc_chi(i_t_or_w) = .NOT. chi_exists
2482 bs_env%all_W_exist = bs_env%all_W_exist .AND. w_time_exists
2485 DO i_spin = 1, n_spin
2487 ind = i_t_or_w + (i_spin - 1)*num_time_freq_points
2490 WRITE (frmt,
'(A)')
'(3A,I1,A)'
2491 WRITE (f_s_p, frmt) trim(prefix), bs_env%Sigma_p_name,
"_0", ind,
".matrix"
2492 WRITE (f_s_n, frmt) trim(prefix), bs_env%Sigma_n_name,
"_0", ind,
".matrix"
2493 ELSE IF (ind < 100)
THEN
2494 WRITE (frmt,
'(A)')
'(3A,I2,A)'
2495 WRITE (f_s_p, frmt) trim(prefix), bs_env%Sigma_p_name,
"_", ind,
".matrix"
2496 WRITE (f_s_n, frmt) trim(prefix), bs_env%Sigma_n_name,
"_", ind,
".matrix"
2498 cpabort(
'Please implement more than 99 combined spin+freq indices.')
2501 INQUIRE (file=trim(f_s_p), exist=sigma_pos_time_exists)
2502 INQUIRE (file=trim(f_s_n), exist=sigma_neg_time_exists)
2504 bs_env%Sigma_c_exists(i_t_or_w, i_spin) = sigma_pos_time_exists .AND. &
2505 sigma_neg_time_exists
2514 WRITE (f_w_t,
'(3A,I1,A)') trim(prefix),
"W_freq_rtp",
"_0", 0,
".matrix"
2515 INQUIRE (file=trim(f_w_t), exist=w_time_exists)
2516 bs_env%all_W_exist = bs_env%all_W_exist .AND. w_time_exists
2520 IF (bs_env%do_gw_ri_rs)
THEN
2521 WRITE (z_lp_name,
'(3A)') trim(prefix),
"Z_lP",
".matrix"
2522 INQUIRE (file=trim(z_lp_name), exist=z_lp_exists)
2523 bs_env%ri_rs%Z_lP_exists = z_lp_exists
2526 IF (bs_env%all_W_exist)
THEN
2527 bs_env%read_chi(:) = .false.
2528 bs_env%calc_chi(:) = .false.
2531 bs_env%Sigma_x_exists = .true.
2532 DO i_spin = 1, n_spin
2533 WRITE (f_s_x,
'(3A,I1,A)') trim(prefix), bs_env%Sigma_x_name,
"_0", i_spin,
".matrix"
2534 INQUIRE (file=trim(f_s_x), exist=sigma_x_spin_exists)
2535 bs_env%Sigma_x_exists = bs_env%Sigma_x_exists .AND. sigma_x_spin_exists
2540 IF (any(bs_env%read_chi(:)) &
2541 .OR. any(bs_env%Sigma_c_exists) &
2542 .OR. bs_env%all_W_exist &
2543 .OR. bs_env%Sigma_x_exists &
2546 IF (qs_env%scf_env%iter_count /= 1)
THEN
2547 CALL cp_warn(__location__,
"SCF needed more than 1 step, "// &
2548 "which might lead to spurious GW results when using GW restart files. ")
2552 CALL timestop(handle)
2554 END SUBROUTINE check_for_restart_files
2561 SUBROUTINE compute_3c_integrals(qs_env, bs_env)
2566 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_3c_integrals'
2568 INTEGER :: handle, j_cell, k_cell, nimages_3c
2570 CALL timeset(routinen, handle)
2572 nimages_3c = bs_env%nimages_3c
2573 ALLOCATE (bs_env%t_3c_int(nimages_3c, nimages_3c))
2574 DO j_cell = 1, nimages_3c
2575 DO k_cell = 1, nimages_3c
2576 CALL dbt_create(bs_env%t_RI_AO__AO, bs_env%t_3c_int(j_cell, k_cell))
2581 bs_env%eps_filter, &
2584 int_eps=bs_env%eps_filter*0.05_dp, &
2585 basis_i=bs_env%basis_set_RI, &
2586 basis_j=bs_env%basis_set_AO, &
2587 basis_k=bs_env%basis_set_AO, &
2588 potential_parameter=bs_env%ri_metric, &
2589 desymmetrize=.false., do_kpoints=.true., cell_sym=.true., &
2590 cell_to_index_ext=bs_env%cell_to_index_3c)
2592 CALL bs_env%para_env%sync()
2594 CALL timestop(handle)
2596 END SUBROUTINE compute_3c_integrals
2602 SUBROUTINE setup_cells_delta_r(bs_env)
2606 CHARACTER(LEN=*),
PARAMETER :: routinen =
'setup_cells_Delta_R'
2610 CALL timeset(routinen, handle)
2615 CALL sum_two_r_grids(bs_env%index_to_cell_3c, &
2616 bs_env%index_to_cell_3c, &
2617 bs_env%nimages_3c, bs_env%nimages_3c, &
2618 bs_env%index_to_cell_Delta_R, &
2619 bs_env%cell_to_index_Delta_R, &
2620 bs_env%nimages_Delta_R)
2622 IF (bs_env%unit_nr > 0)
THEN
2623 WRITE (bs_env%unit_nr, fmt=
"(T2,A,I61)")
"Number of cells ΔR", bs_env%nimages_Delta_R
2626 CALL timestop(handle)
2628 END SUBROUTINE setup_cells_delta_r
2640 SUBROUTINE sum_two_r_grids(index_to_cell_1, index_to_cell_2, nimages_1, nimages_2, &
2641 index_to_cell, cell_to_index, nimages)
2643 INTEGER,
DIMENSION(:, :) :: index_to_cell_1, index_to_cell_2
2644 INTEGER :: nimages_1, nimages_2
2645 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: index_to_cell
2646 INTEGER,
DIMENSION(:, :, :),
POINTER :: cell_to_index
2649 CHARACTER(LEN=*),
PARAMETER :: routinen =
'sum_two_R_grids'
2651 INTEGER :: handle, i_dim, img_1, img_2, nimages_max
2652 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: index_to_cell_tmp
2653 INTEGER,
DIMENSION(3) :: cell_1, cell_2, r, r_max, r_min
2655 CALL timeset(routinen, handle)
2658 r_min(i_dim) = minval(index_to_cell_1(i_dim, :)) + minval(index_to_cell_2(i_dim, :))
2659 r_max(i_dim) = maxval(index_to_cell_1(i_dim, :)) + maxval(index_to_cell_2(i_dim, :))
2662 nimages_max = (r_max(1) - r_min(1) + 1)*(r_max(2) - r_min(2) + 1)*(r_max(3) - r_min(3) + 1)
2664 ALLOCATE (index_to_cell_tmp(3, nimages_max))
2665 index_to_cell_tmp(:, :) = -1
2667 ALLOCATE (cell_to_index(r_min(1):r_max(1), r_min(2):r_max(2), r_min(3):r_max(3)))
2668 cell_to_index(:, :, :) = -1
2672 DO img_1 = 1, nimages_1
2674 DO img_2 = 1, nimages_2
2676 cell_1(1:3) = index_to_cell_1(1:3, img_1)
2677 cell_2(1:3) = index_to_cell_2(1:3, img_2)
2679 r(1:3) = cell_1(1:3) + cell_2(1:3)
2682 IF (cell_to_index(r(1), r(2), r(3)) == -1)
THEN
2684 nimages = nimages + 1
2685 cell_to_index(r(1), r(2), r(3)) = nimages
2686 index_to_cell_tmp(1:3, nimages) = r(1:3)
2694 ALLOCATE (index_to_cell(3, nimages))
2695 index_to_cell(:, :) = index_to_cell_tmp(1:3, 1:nimages)
2697 CALL timestop(handle)
2699 END SUBROUTINE sum_two_r_grids
2705 SUBROUTINE setup_parallelization_delta_r(bs_env)
2709 CHARACTER(LEN=*),
PARAMETER :: routinen =
'setup_parallelization_Delta_R'
2711 INTEGER :: handle, i_cell_delta_r, i_task_local, &
2713 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: i_cell_delta_r_group, &
2714 n_tensor_ops_delta_r
2716 CALL timeset(routinen, handle)
2718 CALL compute_n_tensor_ops_delta_r(bs_env, n_tensor_ops_delta_r)
2720 CALL compute_delta_r_dist(bs_env, n_tensor_ops_delta_r, i_cell_delta_r_group, n_tasks_local)
2722 bs_env%n_tasks_Delta_R_local = n_tasks_local
2724 ALLOCATE (bs_env%task_Delta_R(n_tasks_local))
2727 DO i_cell_delta_r = 1, bs_env%nimages_Delta_R
2729 IF (i_cell_delta_r_group(i_cell_delta_r) /= bs_env%tensor_group_color) cycle
2731 i_task_local = i_task_local + 1
2733 bs_env%task_Delta_R(i_task_local) = i_cell_delta_r
2737 ALLOCATE (bs_env%skip_DR_chi(n_tasks_local))
2738 bs_env%skip_DR_chi(:) = .false.
2739 ALLOCATE (bs_env%skip_DR_Sigma(n_tasks_local))
2740 bs_env%skip_DR_Sigma(:) = .false.
2742 CALL allocate_skip_3xr(bs_env%skip_DR_R12_S_Goccx3c_chi, bs_env)
2743 CALL allocate_skip_3xr(bs_env%skip_DR_R12_S_Gvirx3c_chi, bs_env)
2744 CALL allocate_skip_3xr(bs_env%skip_DR_R_R2_MxM_chi, bs_env)
2746 CALL allocate_skip_3xr(bs_env%skip_DR_R1_S2_Gx3c_Sigma, bs_env)
2747 CALL allocate_skip_3xr(bs_env%skip_DR_R1_R_MxM_Sigma, bs_env)
2749 CALL timestop(handle)
2751 END SUBROUTINE setup_parallelization_delta_r
2758 SUBROUTINE compute_n_tensor_ops_delta_r(bs_env, n_tensor_ops_Delta_R)
2760 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: n_tensor_ops_delta_r
2762 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_n_tensor_ops_Delta_R'
2764 INTEGER :: handle, i_cell_delta_r, i_cell_r, i_cell_r1, i_cell_r1_minus_r, i_cell_r2, &
2765 i_cell_r2_m_r1, i_cell_s1, i_cell_s1_m_r1_p_r2, i_cell_s1_minus_r, i_cell_s2, &
2767 INTEGER,
DIMENSION(3) :: cell_dr, cell_m_r1, cell_r, cell_r1, cell_r1_minus_r, cell_r2, &
2768 cell_r2_m_r1, cell_s1, cell_s1_m_r2_p_r1, cell_s1_minus_r, cell_s1_p_s2_m_r1, cell_s2
2769 LOGICAL :: cell_found
2771 CALL timeset(routinen, handle)
2773 nimages_delta_r = bs_env%nimages_Delta_R
2775 ALLOCATE (n_tensor_ops_delta_r(nimages_delta_r))
2776 n_tensor_ops_delta_r(:) = 0
2779 DO i_cell_delta_r = 1, nimages_delta_r
2781 IF (
modulo(i_cell_delta_r, bs_env%num_tensor_groups) /= bs_env%tensor_group_color) cycle
2783 DO i_cell_r1 = 1, bs_env%nimages_3c
2785 cell_r1(1:3) = bs_env%index_to_cell_3c(1:3, i_cell_r1)
2786 cell_dr(1:3) = bs_env%index_to_cell_Delta_R(1:3, i_cell_delta_r)
2789 CALL add_r(cell_r1, cell_dr, bs_env%index_to_cell_3c, cell_s1, &
2790 cell_found, bs_env%cell_to_index_3c, i_cell_s1)
2791 IF (.NOT. cell_found) cycle
2793 DO i_cell_r2 = 1, bs_env%nimages_scf_desymm
2795 cell_r2(1:3) = bs_env%kpoints_scf_desymm%index_to_cell(1:3, i_cell_r2)
2798 CALL add_r(cell_r2, -cell_r1, bs_env%index_to_cell_3c, cell_r2_m_r1, &
2799 cell_found, bs_env%cell_to_index_3c, i_cell_r2_m_r1)
2800 IF (.NOT. cell_found) cycle
2803 CALL add_r(cell_s1, cell_r2_m_r1, bs_env%index_to_cell_3c, cell_s1_m_r2_p_r1, &
2804 cell_found, bs_env%cell_to_index_3c, i_cell_s1_m_r1_p_r2)
2805 IF (.NOT. cell_found) cycle
2807 n_tensor_ops_delta_r(i_cell_delta_r) = n_tensor_ops_delta_r(i_cell_delta_r) + 1
2811 DO i_cell_s2 = 1, bs_env%nimages_scf_desymm
2813 cell_s2(1:3) = bs_env%kpoints_scf_desymm%index_to_cell(1:3, i_cell_s2)
2814 cell_m_r1(1:3) = -cell_r1(1:3)
2815 cell_s1_p_s2_m_r1(1:3) = cell_s1(1:3) + cell_s2(1:3) - cell_r1(1:3)
2818 IF (.NOT. cell_found) cycle
2821 IF (.NOT. cell_found) cycle
2825 DO i_cell_r = 1, bs_env%nimages_scf_desymm
2827 cell_r = bs_env%kpoints_scf_desymm%index_to_cell(1:3, i_cell_r)
2830 CALL add_r(cell_r1, -cell_r, bs_env%index_to_cell_3c, cell_r1_minus_r, &
2831 cell_found, bs_env%cell_to_index_3c, i_cell_r1_minus_r)
2832 IF (.NOT. cell_found) cycle
2835 CALL add_r(cell_s1, -cell_r, bs_env%index_to_cell_3c, cell_s1_minus_r, &
2836 cell_found, bs_env%cell_to_index_3c, i_cell_s1_minus_r)
2837 IF (.NOT. cell_found) cycle
2845 CALL bs_env%para_env%sum(n_tensor_ops_delta_r)
2847 CALL timestop(handle)
2849 END SUBROUTINE compute_n_tensor_ops_delta_r
2861 SUBROUTINE add_r(cell_1, cell_2, index_to_cell, cell_1_plus_2, cell_found, &
2862 cell_to_index, i_cell_1_plus_2)
2864 INTEGER,
DIMENSION(3) :: cell_1, cell_2
2865 INTEGER,
DIMENSION(:, :) :: index_to_cell
2866 INTEGER,
DIMENSION(3) :: cell_1_plus_2
2867 LOGICAL :: cell_found
2868 INTEGER,
DIMENSION(:, :, :),
INTENT(IN), &
2869 OPTIONAL,
POINTER :: cell_to_index
2870 INTEGER,
INTENT(OUT),
OPTIONAL :: i_cell_1_plus_2
2872 CHARACTER(LEN=*),
PARAMETER :: routinen =
'add_R'
2876 CALL timeset(routinen, handle)
2878 cell_1_plus_2(1:3) = cell_1(1:3) + cell_2(1:3)
2882 IF (
PRESENT(i_cell_1_plus_2))
THEN
2883 IF (cell_found)
THEN
2884 cpassert(
PRESENT(cell_to_index))
2885 i_cell_1_plus_2 = cell_to_index(cell_1_plus_2(1), cell_1_plus_2(2), cell_1_plus_2(3))
2887 i_cell_1_plus_2 = -1000
2891 CALL timestop(handle)
2893 END SUBROUTINE add_r
2902 INTEGER,
DIMENSION(3) :: cell
2903 INTEGER,
DIMENSION(:, :) :: index_to_cell
2904 LOGICAL :: cell_found
2906 CHARACTER(LEN=*),
PARAMETER :: routinen =
'is_cell_in_index_to_cell'
2908 INTEGER :: handle, i_cell, nimg
2909 INTEGER,
DIMENSION(3) :: cell_i
2911 CALL timeset(routinen, handle)
2913 nimg =
SIZE(index_to_cell, 2)
2915 cell_found = .false.
2919 cell_i(1:3) = index_to_cell(1:3, i_cell)
2921 IF (cell_i(1) == cell(1) .AND. cell_i(2) == cell(2) .AND. cell_i(3) == cell(3))
THEN
2927 CALL timestop(handle)
2938 SUBROUTINE compute_delta_r_dist(bs_env, n_tensor_ops_Delta_R, i_cell_Delta_R_group, n_tasks_local)
2940 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: n_tensor_ops_delta_r, &
2941 i_cell_delta_r_group
2942 INTEGER :: n_tasks_local
2944 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_Delta_R_dist'
2946 INTEGER :: handle, i_delta_r_max_op, i_group_min, &
2948 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: n_tensor_ops_delta_r_in_group
2950 CALL timeset(routinen, handle)
2952 nimages_delta_r = bs_env%nimages_Delta_R
2956 IF (u > 0 .AND. nimages_delta_r < bs_env%num_tensor_groups)
THEN
2957 WRITE (u, fmt=
"(T2,A,I5,A,I5,A)")
"There are only ", nimages_delta_r, &
2958 " tasks to work on but there are ", bs_env%num_tensor_groups,
" groups."
2959 WRITE (u, fmt=
"(T2,A)")
"Please reduce the number of MPI processes."
2960 WRITE (u,
'(T2,A)')
''
2963 ALLOCATE (n_tensor_ops_delta_r_in_group(bs_env%num_tensor_groups))
2964 n_tensor_ops_delta_r_in_group(:) = 0
2965 ALLOCATE (i_cell_delta_r_group(nimages_delta_r))
2966 i_cell_delta_r_group(:) = -1
2970 DO WHILE (any(n_tensor_ops_delta_r(:) /= 0))
2973 i_delta_r_max_op = maxloc(n_tensor_ops_delta_r, 1)
2976 i_group_min = minloc(n_tensor_ops_delta_r_in_group, 1)
2979 i_cell_delta_r_group(i_delta_r_max_op) = i_group_min - 1
2980 n_tensor_ops_delta_r_in_group(i_group_min) = n_tensor_ops_delta_r_in_group(i_group_min) + &
2981 n_tensor_ops_delta_r(i_delta_r_max_op)
2984 n_tensor_ops_delta_r(i_delta_r_max_op) = 0
2986 IF (bs_env%tensor_group_color == i_group_min - 1) n_tasks_local = n_tasks_local + 1
2990 CALL timestop(handle)
2992 END SUBROUTINE compute_delta_r_dist
2999 SUBROUTINE allocate_skip_3xr(skip, bs_env)
3000 LOGICAL,
ALLOCATABLE,
DIMENSION(:, :, :) :: skip
3003 CHARACTER(LEN=*),
PARAMETER :: routinen =
'allocate_skip_3xR'
3007 CALL timeset(routinen, handle)
3009 ALLOCATE (skip(bs_env%n_tasks_Delta_R_local, bs_env%nimages_3c, bs_env%nimages_scf_desymm))
3010 skip(:, :, :) = .false.
3012 CALL timestop(handle)
3014 END SUBROUTINE allocate_skip_3xr
3021 SUBROUTINE allocate_matrices_small_cell_full_kp_tensor(qs_env, bs_env)
3025 CHARACTER(LEN=*),
PARAMETER :: routinen =
'allocate_matrices_small_cell_full_kp_tensor'
3027 INTEGER :: handle, i_spin, i_t, img, n_spin, &
3028 nimages_scf, num_time_freq_points
3032 CALL timeset(routinen, handle)
3034 nimages_scf = bs_env%nimages_scf_desymm
3035 num_time_freq_points = bs_env%num_time_freq_points
3036 n_spin = bs_env%n_spin
3038 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
3040 ALLOCATE (bs_env%fm_G_S(nimages_scf))
3041 ALLOCATE (bs_env%fm_Sigma_x_R(nimages_scf))
3042 ALLOCATE (bs_env%fm_chi_R_t(nimages_scf, num_time_freq_points))
3043 ALLOCATE (bs_env%fm_MWM_R_t(nimages_scf, num_time_freq_points))
3044 ALLOCATE (bs_env%fm_Sigma_c_R_neg_tau(nimages_scf, num_time_freq_points, n_spin))
3045 ALLOCATE (bs_env%fm_Sigma_c_R_pos_tau(nimages_scf, num_time_freq_points, n_spin))
3046 DO img = 1, nimages_scf
3047 CALL cp_fm_create(bs_env%fm_G_S(img), bs_env%fm_work_mo(1)%matrix_struct)
3048 CALL cp_fm_create(bs_env%fm_Sigma_x_R(img), bs_env%fm_work_mo(1)%matrix_struct)
3049 DO i_t = 1, num_time_freq_points
3050 CALL cp_fm_create(bs_env%fm_chi_R_t(img, i_t), bs_env%fm_RI_RI%matrix_struct)
3051 CALL cp_fm_create(bs_env%fm_MWM_R_t(img, i_t), bs_env%fm_RI_RI%matrix_struct)
3053 DO i_spin = 1, n_spin
3054 CALL cp_fm_create(bs_env%fm_Sigma_c_R_neg_tau(img, i_t, i_spin), &
3055 bs_env%fm_work_mo(1)%matrix_struct)
3056 CALL cp_fm_create(bs_env%fm_Sigma_c_R_pos_tau(img, i_t, i_spin), &
3057 bs_env%fm_work_mo(1)%matrix_struct)
3058 CALL cp_fm_set_all(bs_env%fm_Sigma_c_R_neg_tau(img, i_t, i_spin), 0.0_dp)
3059 CALL cp_fm_set_all(bs_env%fm_Sigma_c_R_pos_tau(img, i_t, i_spin), 0.0_dp)
3064 CALL timestop(handle)
3066 END SUBROUTINE allocate_matrices_small_cell_full_kp_tensor
3073 SUBROUTINE trafo_v_xc_r_to_kp(qs_env, bs_env)
3077 CHARACTER(LEN=*),
PARAMETER :: routinen =
'trafo_V_xc_R_to_kp'
3079 INTEGER :: handle, ikp, img, ispin, n_ao
3080 INTEGER,
DIMENSION(:, :, :),
POINTER :: cell_to_index_scf
3083 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_ks
3088 CALL timeset(routinen, handle)
3092 CALL get_qs_env(qs_env, matrix_ks_kp=matrix_ks, kpoints=kpoints_scf)
3095 CALL get_kpoint_info(kpoints_scf, sab_nl=sab_nl, cell_to_index=cell_to_index_scf)
3097 CALL cp_cfm_create(cfm_v_xc, bs_env%cfm_work_mo%matrix_struct)
3098 CALL cp_cfm_create(cfm_mo_coeff, bs_env%cfm_work_mo%matrix_struct)
3099 CALL cp_fm_create(fm_v_xc_re, bs_env%cfm_work_mo%matrix_struct)
3101 DO img = 1, bs_env%nimages_scf
3102 DO ispin = 1, bs_env%n_spin
3104 CALL dbcsr_set(matrix_ks(ispin, img)%matrix, 0.0_dp)
3105 CALL copy_fm_to_dbcsr(bs_env%fm_V_xc_R(img, ispin), matrix_ks(ispin, img)%matrix)
3109 ALLOCATE (bs_env%v_xc_n(n_ao, bs_env%nkp_bs_and_DOS, bs_env%n_spin))
3111 DO ispin = 1, bs_env%n_spin
3112 DO ikp = 1, bs_env%nkp_bs_and_DOS
3115 CALL rsmat_to_kp(matrix_ks, ispin, bs_env%kpoints_DOS%xkp(1:3, ikp), &
3116 cell_to_index_scf, sab_nl, bs_env, cfm_v_xc)
3119 CALL cp_cfm_to_cfm(bs_env%cfm_mo_coeff_kp(ikp, ispin), cfm_mo_coeff)
3139 CALL timestop(handle)
3141 END SUBROUTINE trafo_v_xc_r_to_kp
3148 SUBROUTINE heuristic_ri_regularization(qs_env, bs_env)
3152 CHARACTER(LEN=*),
PARAMETER :: routinen =
'heuristic_RI_regularization'
3154 COMPLEX(KIND=dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: m
3155 INTEGER :: handle, ikp, ikp_local, n_ri, nkp, &
3157 REAL(kind=
dp) :: cond_nr, cond_nr_max, max_ev, &
3158 max_ev_ikp, min_ev, min_ev_ikp
3159 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: m_r
3161 CALL timeset(routinen, handle)
3164 CALL get_v_tr_r(m_r, bs_env%ri_metric, 0.0_dp, bs_env, qs_env)
3166 nkp = bs_env%nkp_chi_eps_W_orig_plus_extra
3172 IF (
modulo(ikp, bs_env%para_env%num_pe) /= bs_env%para_env%mepos) cycle
3173 nkp_local = nkp_local + 1
3176 ALLOCATE (m(n_ri, n_ri, nkp_local))
3179 cond_nr_max = 0.0_dp
3186 IF (
modulo(ikp, bs_env%para_env%num_pe) /= bs_env%para_env%mepos) cycle
3188 ikp_local = ikp_local + 1
3191 CALL rs_to_kp(m_r, m(:, :, ikp_local), &
3192 bs_env%kpoints_scf_desymm%index_to_cell, &
3193 bs_env%kpoints_chi_eps_W%xkp(1:3, ikp))
3196 CALL local_complex_power(m(:, :, ikp_local), 1.0_dp, 0.0_dp, cond_nr, min_ev_ikp, max_ev_ikp)
3198 IF (cond_nr > cond_nr_max) cond_nr_max = cond_nr
3199 IF (max_ev_ikp > max_ev) max_ev = max_ev_ikp
3200 IF (min_ev_ikp < min_ev) min_ev = min_ev_ikp
3204 CALL bs_env%para_env%max(cond_nr_max)
3205 CALL bs_env%para_env%min(min_ev)
3206 CALL bs_env%para_env%max(max_ev)
3210 WRITE (u, fmt=
"(T2,A,ES34.1)")
"Min. abs. eigenvalue of RI metric matrix M(k)", min_ev
3211 WRITE (u, fmt=
"(T2,A,ES34.1)")
"Max. abs. eigenvalue of RI metric matrix M(k)", max_ev
3212 WRITE (u, fmt=
"(T2,A,ES50.1)")
"Max. condition number of M(k)", cond_nr_max
3215 CALL timestop(handle)
3217 END SUBROUTINE heuristic_ri_regularization
3227 SUBROUTINE get_v_tr_r(V_tr_R, pot_type, regularization_RI, bs_env, qs_env)
3228 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: v_tr_r
3229 TYPE(libint_potential_type) :: pot_type
3230 REAL(kind=
dp) :: regularization_ri
3234 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_V_tr_R'
3236 INTEGER :: handle, img, nimages_scf_desymm
3237 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: sizes_ri
3238 INTEGER,
DIMENSION(:),
POINTER :: col_bsize, row_bsize
3240 TYPE(
cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: fm_v_tr_r
3242 TYPE(
dbcsr_type),
ALLOCATABLE,
DIMENSION(:) :: mat_v_tr_r
3247 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
3249 CALL timeset(routinen, handle)
3251 NULLIFY (sab_ri, dist_2d)
3254 blacs_env=blacs_env, &
3255 distribution_2d=dist_2d, &
3256 qs_kind_set=qs_kind_set, &
3257 particle_set=particle_set)
3259 ALLOCATE (sizes_ri(bs_env%n_atom))
3260 CALL get_particle_set(particle_set, qs_kind_set, nsgf=sizes_ri, basis=bs_env%basis_set_RI)
3262 pot_type,
"2c_nl_RI", qs_env, sym_ij=.false., &
3265 ALLOCATE (row_bsize(
SIZE(sizes_ri)))
3266 ALLOCATE (col_bsize(
SIZE(sizes_ri)))
3267 row_bsize(:) = sizes_ri
3268 col_bsize(:) = sizes_ri
3270 nimages_scf_desymm = bs_env%nimages_scf_desymm
3271 ALLOCATE (mat_v_tr_r(nimages_scf_desymm))
3272 CALL dbcsr_create(mat_v_tr_r(1),
"(RI|RI)", dbcsr_dist, dbcsr_type_no_symmetry, &
3273 row_bsize, col_bsize)
3274 DEALLOCATE (row_bsize, col_bsize)
3276 DO img = 2, nimages_scf_desymm
3277 CALL dbcsr_create(mat_v_tr_r(img), template=mat_v_tr_r(1))
3281 bs_env%basis_set_RI, pot_type, do_kpoints=.true., &
3282 ext_kpoints=bs_env%kpoints_scf_desymm, &
3283 regularization_ri=regularization_ri)
3285 ALLOCATE (fm_v_tr_r(nimages_scf_desymm))
3286 DO img = 1, nimages_scf_desymm
3287 CALL cp_fm_create(fm_v_tr_r(img), bs_env%fm_RI_RI%matrix_struct)
3292 IF (.NOT.
ALLOCATED(v_tr_r))
THEN
3293 ALLOCATE (v_tr_r(bs_env%n_RI, bs_env%n_RI, nimages_scf_desymm))
3302 CALL timestop(handle)
3310 SUBROUTINE setup_time_and_frequency_minimax_grid(bs_env)
3313 CHARACTER(LEN=*),
PARAMETER :: routinen =
'setup_time_and_frequency_minimax_grid'
3315 INTEGER :: handle, homo, ispin, n_mo, n_top, &
3316 num_time_freq_points, u
3317 REAL(kind=
dp) :: e_max, e_max_ispin, e_min, e_min_ispin, &
3318 e_range, max_error_min
3320 CALL timeset(routinen, handle)
3323 num_time_freq_points = bs_env%num_time_freq_points
3328 DO ispin = 1, bs_env%n_spin
3329 homo = bs_env%n_occ(ispin)
3334 n_top = max(min(bs_env%n_mo_retained, n_mo), homo + 1)
3336 SELECT CASE (bs_env%gw_implementation)
3338 e_min_ispin = bs_env%eigenval_scf_Gamma(homo + 1, ispin) - &
3339 bs_env%eigenval_scf_Gamma(homo, ispin)
3340 e_max_ispin = bs_env%eigenval_scf_Gamma(n_top, ispin) - &
3341 bs_env%eigenval_scf_Gamma(1, ispin)
3343 e_min_ispin = minval(bs_env%eigenval_scf(homo + 1, :, ispin)) - &
3344 maxval(bs_env%eigenval_scf(homo, :, ispin))
3345 e_max_ispin = maxval(bs_env%eigenval_scf(n_top, :, ispin)) - &
3346 minval(bs_env%eigenval_scf(1, :, ispin))
3348 e_min = min(e_min, e_min_ispin)
3349 e_max = max(e_max, e_max_ispin)
3354 IF (bs_env%n_spin > 1)
THEN
3355 CALL cp_hint(__location__, &
3356 "Open-shell GW uses one minimax grid spanning [min gap, max span] across both "// &
3357 "spin channels; raise NUM_TIME_FREQ_POINTS if QP convergence is marginal for "// &
3358 "strongly spin-asymmetric systems.")
3361 e_range = e_max/e_min
3364 bs_env%num_points_per_magnitude, bs_env%time_frequency_grid, &
3365 build_frequency=.true., build_time=.true., build_transforms=.true., &
3366 build_sine=.true., time_scaling=2.0_dp, time_weight_scaling=1.0_dp, &
3367 max_fit_error=max_error_min, print_warning=.false., unit_nr=0, &
3368 prefer_external_backend=.false.)
3371 bs_env%num_freq_points_fit = count(bs_env%time_frequency_grid%frequency < bs_env%freq_max_fit)
3374 ALLOCATE (bs_env%imag_freq_points_fit(bs_env%num_freq_points_fit))
3375 bs_env%imag_freq_points_fit(:) = pack(bs_env%time_frequency_grid%frequency, &
3376 bs_env%time_frequency_grid%frequency < bs_env%freq_max_fit)
3380 IF (bs_env%num_freq_points_fit < bs_env%nparam_pade)
THEN
3381 bs_env%nparam_pade = bs_env%num_freq_points_fit
3386 WRITE (u,
'(T2,A)')
''
3387 WRITE (u,
'(T2,A,F55.2)')
'SCF direct band gap (eV)', e_min*
evolt
3388 WRITE (u,
'(T2,A,F53.2)')
'Max. SCF eigval diff. (eV)', e_max*
evolt
3389 WRITE (u,
'(T2,A,F55.2)')
'E-Range for minimax grid', e_range
3390 WRITE (u,
'(T2,A,I27)')
'Number of Padé parameters for analytic continuation:', &
3392 WRITE (u,
'(T2,A)')
''
3400 CALL timestop(handle)
3402 END SUBROUTINE setup_time_and_frequency_minimax_grid
3414 CHARACTER(LEN=*),
PARAMETER :: routinen =
'de_init_bs_env'
3417 LOGICAL :: retain_nl_3c, rirs_kernel
3419 CALL timeset(routinen, handle)
3427 retain_nl_3c = .false.
3428 IF (
ASSOCIATED(bs_env%nl_3c%ij_list) .AND. (bs_env%rtp_method ==
rtp_method_bse))
THEN
3430 retain_nl_3c = .NOT. rirs_kernel
3433 IF (retain_nl_3c)
THEN
3434 IF (bs_env%unit_nr > 0)
WRITE (bs_env%unit_nr, *)
"Retaining nl_3c for AO-RI RT-BSE self-energy"
3441 CALL timestop(handle)
3458 LOGICAL,
INTENT(OUT),
OPTIONAL :: rirs_kernel
3460 INTEGER :: kernel_ri
3461 LOGICAL :: my_rirs_kernel
3465 NULLIFY (dft_control, input)
3466 CALL get_qs_env(qs_env, dft_control=dft_control, input=input)
3470 SELECT CASE (kernel_ri)
3472 my_rirs_kernel = .true.
3474 my_rirs_kernel = .false.
3476 my_rirs_kernel = bs_env%do_gw_ri_rs
3482 cpwarn(
"RI-RS kernels are implemented for linearized RT-BSE only; forcing AO")
3484 my_rirs_kernel = .false.
3487 IF (
PRESENT(rirs_kernel)) rirs_kernel = my_rirs_kernel
3500 REAL(kind=
dp),
DIMENSION(:, :, :) :: sigma_c_n_time, sigma_c_n_freq
3503 CHARACTER(LEN=*),
PARAMETER :: routinen =
'time_to_freq'
3505 INTEGER :: handle, i_t, j_w, n_occ
3506 REAL(kind=
dp) :: freq_j, time_i, w_cos_ij, w_sin_ij
3507 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: sigma_c_n_cos_time, sigma_c_n_sin_time
3509 CALL timeset(routinen, handle)
3511 ALLOCATE (sigma_c_n_cos_time(bs_env%n_ao, bs_env%num_time_freq_points))
3512 ALLOCATE (sigma_c_n_sin_time(bs_env%n_ao, bs_env%num_time_freq_points))
3514 sigma_c_n_cos_time(:, :) = 0.5_dp*(sigma_c_n_time(:, :, 1) + sigma_c_n_time(:, :, 2))
3515 sigma_c_n_sin_time(:, :) = 0.5_dp*(sigma_c_n_time(:, :, 1) - sigma_c_n_time(:, :, 2))
3517 sigma_c_n_freq(:, :, :) = 0.0_dp
3519 DO i_t = 1, bs_env%num_time_freq_points
3521 DO j_w = 1, bs_env%num_time_freq_points
3523 freq_j = bs_env%time_frequency_grid%frequency(j_w)
3524 time_i = bs_env%time_frequency_grid%imaginary_time(i_t)
3526 w_cos_ij = bs_env%time_frequency_grid%cosine_time_to_frequency_weights(j_w, i_t)*cos(freq_j*time_i)
3527 w_sin_ij = bs_env%time_frequency_grid%sine_time_to_frequency_weights(j_w, i_t)*sin(freq_j*time_i)
3530 sigma_c_n_freq(:, j_w, 1) = sigma_c_n_freq(:, j_w, 1) + &
3531 w_cos_ij*sigma_c_n_cos_time(:, i_t)
3534 sigma_c_n_freq(:, j_w, 2) = sigma_c_n_freq(:, j_w, 2) + &
3535 w_sin_ij*sigma_c_n_sin_time(:, i_t)
3544 n_occ = bs_env%n_occ(ispin)
3545 sigma_c_n_freq(1:n_occ, :, 2) = -sigma_c_n_freq(1:n_occ, :, 2)
3547 CALL timestop(handle)
3562 eigenval_scf, ikp, ispin)
3565 REAL(kind=
dp),
DIMENSION(:, :, :) :: sigma_c_ikp_n_freq
3566 REAL(kind=
dp),
DIMENSION(:) :: sigma_x_ikp_n, v_xc_ikp_n, eigenval_scf
3567 INTEGER :: ikp, ispin
3569 CHARACTER(LEN=*),
PARAMETER :: routinen =
'analyt_conti_and_print'
3571 CHARACTER(len=3) :: occ_vir
3572 CHARACTER(len=default_path_length) :: fname
3573 CHARACTER(len=default_string_length) :: gw_label
3574 INTEGER :: handle, i_mo, ikp_for_print, iunit, &
3576 LOGICAL :: is_bandstruc_kpoint, print_dos_kpoints, &
3578 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: dummy, eigenval_g, sigma_c_ikp_n_qp
3580 CALL timeset(routinen, handle)
3583 ALLOCATE (dummy(n_mo), sigma_c_ikp_n_qp(n_mo), eigenval_g(n_mo))
3584 sigma_c_ikp_n_qp(:) = 0.0_dp
3590 IF (bs_env%gw_flavour ==
evgw0 .AND.
ALLOCATED(bs_env%eigenval_evGW0))
THEN
3591 eigenval_g(:) = bs_env%eigenval_evGW0(:, ikp, ispin)
3593 eigenval_g(:) = eigenval_scf(:)
3599 IF (
modulo(i_mo, bs_env%para_env%num_pe) /= bs_env%para_env%mepos) cycle
3602 bs_env%imag_freq_points_fit, dummy, dummy, &
3603 sigma_c_ikp_n_freq(:, 1:bs_env%num_freq_points_fit, 1)*
z_one + &
3604 sigma_c_ikp_n_freq(:, 1:bs_env%num_freq_points_fit, 2)*
gaussi, &
3605 sigma_x_ikp_n(:) - v_xc_ikp_n(:), &
3606 eigenval_g(:), eigenval_scf(:), &
3607 bs_env%do_hedin_shift, &
3608 i_mo, bs_env%n_occ(ispin), bs_env%n_vir(ispin), &
3609 bs_env%nparam_pade, bs_env%num_freq_points_fit, &
3611 0.0_dp, .true., .false., 1, e_fermi_ext=bs_env%e_fermi(ispin))
3614 CALL bs_env%para_env%sum(sigma_c_ikp_n_qp)
3616 CALL correct_obvious_fitting_fails(sigma_c_ikp_n_qp, ispin, bs_env)
3618 bs_env%eigenval_GW(:, ikp, ispin) = eigenval_scf(:) + &
3619 sigma_c_ikp_n_qp(:) + &
3620 sigma_x_ikp_n(:) - &
3623 IF (
ALLOCATED(bs_env%eigenval_G0W0) .AND. bs_env%ri_rs%evgw0_i_iter <= 1)
THEN
3624 bs_env%eigenval_G0W0(:, ikp, ispin) = bs_env%eigenval_GW(:, ikp, ispin)
3627 bs_env%eigenval_HF(:, ikp, ispin) = eigenval_scf(:) + sigma_x_ikp_n(:) - v_xc_ikp_n(:)
3630 print_dos_kpoints = (bs_env%nkp_only_bs <= 0)
3632 is_bandstruc_kpoint = (ikp > bs_env%nkp_only_DOS)
3633 print_ikp = print_dos_kpoints .OR. is_bandstruc_kpoint
3635 IF (bs_env%para_env%is_source() .AND. print_ikp)
THEN
3637 IF (print_dos_kpoints)
THEN
3638 nkp = bs_env%nkp_only_DOS
3641 nkp = bs_env%nkp_only_bs
3642 ikp_for_print = ikp - bs_env%nkp_only_DOS
3645 fname =
"bandstructure_SCF_and_G0W0"
3649 IF (ikp_for_print == 1 .AND. ispin == 1 .AND. bs_env%ri_rs%evgw0_i_iter <= 1)
THEN
3650 CALL open_file(trim(fname), unit_number=iunit, file_status=
"REPLACE", &
3651 file_action=
"WRITE")
3653 CALL open_file(trim(fname), unit_number=iunit, file_status=
"OLD", &
3654 file_action=
"WRITE", file_position=
"APPEND")
3657 IF (bs_env%gw_flavour ==
evgw0 .AND. ikp_for_print == 1 .AND. ispin == 1)
THEN
3658 WRITE (iunit,
"(A)")
" "
3659 WRITE (iunit,
"(A,I0)")
"evGW0 cycle: ", bs_env%ri_rs%evgw0_i_iter
3662 WRITE (iunit,
"(A)")
" "
3663 WRITE (iunit,
"(A10,I7,A25,3F10.4,T90,A7,I2)")
"kpoint: ", ikp_for_print,
"coordinate: ", &
3664 bs_env%kpoints_DOS%xkp(:, ikp),
"spin: ", ispin
3665 WRITE (iunit,
"(A)")
" "
3667 WRITE (iunit,
"(A5,A12,3A17,A16,A18)")
"n",
"k",
"ϵ_nk^DFT (eV)",
"Σ^c_nk (eV)", &
3668 "Σ^x_nk (eV)",
"v_nk^xc (eV)", trim(gw_label)
3669 WRITE (iunit,
"(A)")
" "
3672 IF (i_mo <= bs_env%n_occ(ispin)) occ_vir =
'occ'
3673 IF (i_mo > bs_env%n_occ(ispin)) occ_vir =
'vir'
3674 WRITE (iunit,
"(I5,3A,I5,4F16.3,F17.3)") i_mo,
' (', occ_vir,
') ', ikp_for_print, &
3675 eigenval_scf(i_mo)*
evolt, &
3676 sigma_c_ikp_n_qp(i_mo)*
evolt, &
3677 sigma_x_ikp_n(i_mo)*
evolt, &
3678 v_xc_ikp_n(i_mo)*
evolt, &
3679 bs_env%eigenval_GW(i_mo, ikp, ispin)*
evolt
3682 WRITE (iunit,
"(A)")
" "
3688 CALL timestop(handle)
3698 SUBROUTINE correct_obvious_fitting_fails(Sigma_c_ikp_n_qp, ispin, bs_env)
3699 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: sigma_c_ikp_n_qp
3703 CHARACTER(LEN=*),
PARAMETER :: routinen =
'correct_obvious_fitting_fails'
3705 INTEGER :: handle, homo, i_mo, j_mo, &
3706 n_levels_scissor, n_mo
3707 LOGICAL :: is_occ, is_vir
3708 REAL(kind=
dp) :: sum_sigma_c
3710 CALL timeset(routinen, handle)
3713 homo = bs_env%n_occ(ispin)
3718 IF (abs(sigma_c_ikp_n_qp(i_mo)) > 13.0_dp/
evolt)
THEN
3720 is_occ = (i_mo <= homo)
3721 is_vir = (i_mo > homo)
3723 n_levels_scissor = 0
3724 sum_sigma_c = 0.0_dp
3730 IF (is_occ .AND. j_mo > homo) cycle
3731 IF (is_vir .AND. j_mo <= homo) cycle
3732 IF (abs(i_mo - j_mo) > 10) cycle
3733 IF (i_mo == j_mo) cycle
3735 n_levels_scissor = n_levels_scissor + 1
3736 sum_sigma_c = sum_sigma_c + sigma_c_ikp_n_qp(j_mo)
3741 sigma_c_ikp_n_qp(i_mo) = sum_sigma_c/real(n_levels_scissor, kind=
dp)
3747 CALL timestop(handle)
3749 END SUBROUTINE correct_obvious_fitting_fails
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
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, ccon)
...
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.
subroutine, public scaled_to_real(r, s, cell)
Transform scaled cell coordinates real coordinates. r=h*s.
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_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
Creates a new full matrix with the given structure.
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.
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, plan)
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.
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.
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.
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
subroutine, public cp_fm_get_diag(matrix, diag)
returns the diagonal elements of a fm
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
subroutine, public cp_fm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
creates a new full matrix with the given structure
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....
stores a mapping of 2D info (e.g. matrix) on a 2D processor distribution (i.e. blacs grid) where cpus...
Automatic RI basis set optimization for molecular GW.
subroutine, public generate_auto_ri_basis(qs_env, bs_env)
Executes the AUTO_RI algorithm defined by Eqs. (1)-(15).
Input and persistent data for automatic RI basis optimization.
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)
...
Full-matrix operations not provided by the CP2K FM packages.
subroutine, public fm_invert(matrix_a, eigenvalue_threshold, unit_nr)
Inverts a symmetric matrix. First, Cholesky decomposition is tried. If it fails, the matrix is diagon...
subroutine, public cfm_contract_aba(matrix_a, matrix_b, matrix_c)
Computes A^H B A for complex full matrices.
subroutine, public local_complex_power(matrix, exponent, eps, cond_nr, min_ev, max_ev)
Compute a spectral power of a local complex Hermitian matrix. Eigenvalues not larger than eps are dis...
subroutine, public get_v_tr_r(v_tr_r, pot_type, regularization_ri, bs_env, qs_env)
...
subroutine, public time_to_freq(bs_env, sigma_c_n_time, sigma_c_n_freq, ispin)
...
subroutine, public rtbse_resolve_rirs_flag(qs_env, bs_env, rirs_kernel)
Resolve the linRTBSE RI-RS kernel switch from the KERNEL_RI input and the GW default.
subroutine, public compute_xkp(xkp, ikp_start, ikp_end, grid)
...
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)
...
subroutine, public create_and_init_bs_env_for_gw(qs_env, bs_env, bs_sec)
Initializes the GW environment from the input and electronic-structure data.
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)
...
subroutine, public de_init_bs_env(qs_env, bs_env)
Releases the memory-heavy GW intermediates that cannot be freed in bs_env_release,...
subroutine, public is_cell_in_index_to_cell(cell, index_to_cell, cell_found)
...
Defines the basic variable types.
integer, parameter, public int_8
integer, parameter, public dp
integer, parameter, public default_string_length
integer, parameter, public default_path_length
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.
Types and basic routines needed for a kpoint calculation.
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, inversion_symmetry_only, symmetry_backend, symmetry_reduction_method, gamma_centered, lattice_fft)
Retrieve information from a kpoint environment.
subroutine, public kpoint_create(kpoint)
Create 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.
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition of mathematical constants and functions.
complex(kind=dp), parameter, public z_one
complex(kind=dp), parameter, public gaussi
Collection of simple mathematical functions and subroutines.
elemental integer function, public gcd(a, b)
computes the greatest common divisor of two number
Interface to the message passing library MPI.
subroutine, public mp_mem_used_per_rank_gb(comm, mem_used_gb)
Memory that is currently occupied by this process, in GB, maximized over all ranks of comm,...
subroutine, public mp_mem_avail_per_rank_gb(comm, mem_avail_gb)
Memory that is currently free on the node, per MPI rank of that node, in GB.
Calls routines to get RI integrals and calculate total energies.
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, custom_row_blk_sizes)
Encapsulate the building of dbcsr_matrix mat_munu.
Framework for 2c-integrals for RI.
subroutine, public ri_2c_integral_mat(qs_env, fm_matrix_minv_l_gamma, fm_matrix_l_struct, dimen_ri, ri_metric, put_mat_ks_env, regularization_ri)
...
subroutine, public trunc_coulomb_for_exchange(qs_env, trunc_coulomb, rel_cutoff_trunc_coulomb_ri_x, cell_grid, do_bvk_cell)
...
Define methods related to particle_type.
subroutine, public get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf, nmao, basis, ncgf)
Get the components of a particle set.
Define the data structure for the particle information.
Definition of physical constants:
real(kind=dp), parameter, public evolt
real(kind=dp), parameter, public angstrom
subroutine, public rsmat_to_kp(mat_rs, ispin, xkp, cell_to_index_scf, sab_nl, bs_env, cfm_kp, imag_rs_mat)
...
subroutine, public allocate_gw_eigenvalues(bs_env)
Allocate the arrays holding the GW quasiparticle energies.
character(len=default_string_length) function, public gw_flavour_label(bs_env)
Name of the GW flavour that was requested, for printing.
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, mimic, 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, matrix_vhxc, 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, xcint_weights, 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, hund_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, proj_shell_charge, lr_atom, do_mtlr, u_j_loop, ao_coef, 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.
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...
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.
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.
Routines for GW, continuous development [Jan Wilhelm].
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 and construction of time/frequency grids for correlation methods.
subroutine, public build_minimax_time_frequency_grid(num_points, energy_min, energy_max, regularization, num_points_per_magnitude, grid, build_frequency, build_time, build_transforms, build_sine, time_scaling, time_weight_scaling, max_fit_error, print_warning, unit_nr, prefer_external_backend, used_external_backend)
Build a minimax time/frequency grid through the common backend boundary.
Provides all information about an atomic kind.
Type defining parameters related to the simulation cell.
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
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.