LCOV - code coverage report
Current view: top level - src - mp2_gpw.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:e7e05ae) Lines: 450 466 96.6 %
Date: 2024-04-18 06:59:28 Functions: 7 7 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief Calls routines to get RI integrals and calculate total energies
      10             : !> \par History
      11             : !>      10.2011 created [Joost VandeVondele and Mauro Del Ben]
      12             : !>      07.2019 split from mp2_gpw.F [Frederick Stein]
      13             : ! **************************************************************************************************
      14             : MODULE mp2_gpw
      15             :    USE atomic_kind_types,               ONLY: atomic_kind_type
      16             :    USE basis_set_types,                 ONLY: get_gto_basis_set,&
      17             :                                               gto_basis_set_p_type,&
      18             :                                               gto_basis_set_type
      19             :    USE cell_types,                      ONLY: cell_type,&
      20             :                                               get_cell
      21             :    USE cp_blacs_env,                    ONLY: BLACS_GRID_SQUARE,&
      22             :                                               cp_blacs_env_create,&
      23             :                                               cp_blacs_env_release,&
      24             :                                               cp_blacs_env_type
      25             :    USE cp_control_types,                ONLY: dft_control_type
      26             :    USE cp_dbcsr_cp2k_link,              ONLY: cp_dbcsr_alloc_block_from_nbl
      27             :    USE cp_dbcsr_operations,             ONLY: cp_dbcsr_dist2d_to_dist,&
      28             :                                               cp_dbcsr_m_by_n_from_row_template
      29             :    USE cp_fm_types,                     ONLY: cp_fm_get_info,&
      30             :                                               cp_fm_release,&
      31             :                                               cp_fm_type
      32             :    USE cp_log_handling,                 ONLY: &
      33             :         cp_add_default_logger, cp_get_default_logger, cp_logger_create, &
      34             :         cp_logger_get_default_unit_nr, cp_logger_release, cp_logger_set, cp_logger_type, &
      35             :         cp_rm_default_logger, cp_to_string
      36             :    USE dbcsr_api,                       ONLY: &
      37             :         dbcsr_clear_mempools, dbcsr_copy, dbcsr_create, dbcsr_distribution_release, &
      38             :         dbcsr_distribution_type, dbcsr_filter, dbcsr_init_p, dbcsr_iterator_blocks_left, &
      39             :         dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, &
      40             :         dbcsr_p_type, dbcsr_release, dbcsr_reserve_all_blocks, dbcsr_type, dbcsr_type_no_symmetry, &
      41             :         dbcsr_type_real_default, dbcsr_type_symmetric
      42             :    USE dbt_api,                         ONLY: dbt_type
      43             :    USE distribution_1d_types,           ONLY: distribution_1d_release,&
      44             :                                               distribution_1d_type
      45             :    USE distribution_2d_types,           ONLY: distribution_2d_release,&
      46             :                                               distribution_2d_type
      47             :    USE distribution_methods,            ONLY: distribute_molecules_1d,&
      48             :                                               distribute_molecules_2d
      49             :    USE group_dist_types,                ONLY: create_group_dist,&
      50             :                                               get_group_dist,&
      51             :                                               group_dist_d1_type,&
      52             :                                               release_group_dist
      53             :    USE hfx_types,                       ONLY: block_ind_type,&
      54             :                                               hfx_compression_type
      55             :    USE input_constants,                 ONLY: &
      56             :         do_eri_gpw, do_eri_os, do_potential_coulomb, do_potential_id, do_potential_truncated, &
      57             :         eri_default, mp2_method_gpw, ri_default, ri_mp2_method_gpw
      58             :    USE input_section_types,             ONLY: section_vals_val_get
      59             :    USE kinds,                           ONLY: dp
      60             :    USE kpoint_types,                    ONLY: kpoint_type
      61             :    USE libint_wrapper,                  ONLY: cp_libint_static_cleanup,&
      62             :                                               cp_libint_static_init
      63             :    USE machine,                         ONLY: default_output_unit,&
      64             :                                               m_flush
      65             :    USE message_passing,                 ONLY: mp_para_env_release,&
      66             :                                               mp_para_env_type
      67             :    USE molecule_kind_types,             ONLY: molecule_kind_type
      68             :    USE molecule_types,                  ONLY: molecule_type
      69             :    USE mp2_cphf,                        ONLY: solve_z_vector_eq
      70             :    USE mp2_gpw_method,                  ONLY: mp2_gpw_compute
      71             :    USE mp2_integrals,                   ONLY: mp2_ri_gpw_compute_in
      72             :    USE mp2_ri_gpw,                      ONLY: mp2_ri_gpw_compute_en
      73             :    USE mp2_ri_grad,                     ONLY: calc_ri_mp2_nonsep
      74             :    USE mp2_types,                       ONLY: mp2_type,&
      75             :                                               three_dim_real_array
      76             :    USE particle_methods,                ONLY: get_particle_set
      77             :    USE particle_types,                  ONLY: particle_type
      78             :    USE qs_environment_types,            ONLY: get_qs_env,&
      79             :                                               qs_environment_type
      80             :    USE qs_integral_utils,               ONLY: basis_set_list_setup
      81             :    USE qs_interactions,                 ONLY: init_interaction_radii
      82             :    USE qs_kind_types,                   ONLY: get_qs_kind,&
      83             :                                               qs_kind_type
      84             :    USE qs_ks_types,                     ONLY: qs_ks_env_type
      85             :    USE qs_mo_types,                     ONLY: get_mo_set,&
      86             :                                               mo_set_type
      87             :    USE qs_neighbor_list_types,          ONLY: neighbor_list_set_p_type,&
      88             :                                               release_neighbor_list_sets
      89             :    USE qs_neighbor_lists,               ONLY: atom2d_build,&
      90             :                                               atom2d_cleanup,&
      91             :                                               build_neighbor_lists,&
      92             :                                               local_atoms_type,&
      93             :                                               pair_radius_setup
      94             :    USE rpa_main,                        ONLY: rpa_ri_compute_en
      95             :    USE rpa_rse,                         ONLY: rse_energy
      96             : #include "./base/base_uses.f90"
      97             : 
      98             :    IMPLICIT NONE
      99             : 
     100             :    PRIVATE
     101             : 
     102             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mp2_gpw'
     103             : 
     104             :    PUBLIC :: mp2_gpw_main, create_mat_munu, grep_rows_in_subgroups, build_dbcsr_from_rows
     105             : 
     106             : CONTAINS
     107             : 
     108             : ! **************************************************************************************************
     109             : !> \brief with a big bang to mp2
     110             : !> \param qs_env ...
     111             : !> \param mp2_env ...
     112             : !> \param Emp2 ...
     113             : !> \param Emp2_Cou ...
     114             : !> \param Emp2_EX ...
     115             : !> \param Emp2_S ...
     116             : !> \param Emp2_T ...
     117             : !> \param mos_mp2 ...
     118             : !> \param para_env ...
     119             : !> \param unit_nr ...
     120             : !> \param calc_forces ...
     121             : !> \param calc_ex ...
     122             : !> \param do_ri_mp2 ...
     123             : !> \param do_ri_rpa ...
     124             : !> \param do_ri_sos_laplace_mp2 ...
     125             : !> \author Mauro Del Ben and Joost VandeVondele
     126             : ! **************************************************************************************************
     127         606 :    SUBROUTINE mp2_gpw_main(qs_env, mp2_env, Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T, &
     128         606 :                            mos_mp2, para_env, unit_nr, calc_forces, calc_ex, do_ri_mp2, do_ri_rpa, &
     129             :                            do_ri_sos_laplace_mp2)
     130             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     131             :       TYPE(mp2_type)                                     :: mp2_env
     132             :       REAL(KIND=dp), INTENT(OUT)                         :: Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T
     133             :       TYPE(mo_set_type), DIMENSION(:), INTENT(IN)        :: mos_mp2
     134             :       TYPE(mp_para_env_type), POINTER                    :: para_env
     135             :       INTEGER, INTENT(IN)                                :: unit_nr
     136             :       LOGICAL, INTENT(IN)                                :: calc_forces, calc_ex
     137             :       LOGICAL, INTENT(IN), OPTIONAL                      :: do_ri_mp2, do_ri_rpa, &
     138             :                                                             do_ri_sos_laplace_mp2
     139             : 
     140             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'mp2_gpw_main'
     141             : 
     142             :       INTEGER :: blacs_grid_layout, color_sub, dimen, dimen_RI, dimen_RI_red, eri_method, handle, &
     143             :          ispin, local_unit_nr, my_group_L_end, my_group_L_size, my_group_L_start, nmo, nspins, &
     144             :          potential_type, ri_metric_type
     145         606 :       INTEGER, ALLOCATABLE, DIMENSION(:) :: ends_array_mc, ends_array_mc_block, gw_corr_lev_occ, &
     146         606 :          gw_corr_lev_virt, homo, starts_array_mc, starts_array_mc_block
     147             :       INTEGER, DIMENSION(3)                              :: periodic
     148             :       LOGICAL :: blacs_repeatable, do_bse, do_im_time, do_kpoints_cubic_RPA, my_do_gw, &
     149             :          my_do_ri_mp2, my_do_ri_rpa, my_do_ri_sos_laplace_mp2
     150             :       REAL(KIND=dp)                                      :: Emp2_AB, Emp2_BB, Emp2_Cou_BB, &
     151             :                                                             Emp2_EX_BB, eps_gvg_rspace_old, &
     152             :                                                             eps_pgf_orb_old, eps_rho_rspace_old
     153         606 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: Eigenval
     154         606 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :)     :: BIb_C_bse_ab, BIb_C_bse_ij
     155         606 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: mo_eigenvalues
     156         606 :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
     157             :       TYPE(block_ind_type), ALLOCATABLE, &
     158         606 :          DIMENSION(:, :, :)                              :: t_3c_O_ind
     159             :       TYPE(cell_type), POINTER                           :: cell
     160             :       TYPE(cp_blacs_env_type), POINTER                   :: blacs_env_sub, blacs_env_sub_mat_munu
     161             :       TYPE(cp_fm_type)                                   :: fm_matrix_PQ
     162         606 :       TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:)        :: mo_coeff
     163         606 :       TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :)     :: fm_matrix_L_kpoints, fm_matrix_Minv, &
     164         606 :                                                             fm_matrix_Minv_L_kpoints, &
     165         606 :                                                             fm_matrix_Minv_Vtrunc_Minv
     166             :       TYPE(cp_fm_type), POINTER                          :: mo_coeff_ptr
     167             :       TYPE(cp_logger_type), POINTER                      :: logger, logger_sub
     168             :       TYPE(dbcsr_p_type)                                 :: mat_munu, mat_P_global
     169         606 :       TYPE(dbcsr_p_type), ALLOCATABLE, DIMENSION(:)      :: mo_coeff_all, mo_coeff_gw, mo_coeff_o, &
     170         606 :                                                             mo_coeff_v
     171         606 :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: matrix_s
     172         606 :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: matrix_s_kp
     173        4242 :       TYPE(dbt_type)                                     :: t_3c_M
     174         606 :       TYPE(dbt_type), ALLOCATABLE, DIMENSION(:, :)       :: t_3c_O
     175             :       TYPE(dft_control_type), POINTER                    :: dft_control
     176         606 :       TYPE(group_dist_d1_type)                           :: gd_array, gd_B_all, gd_B_occ_bse, &
     177         606 :                                                             gd_B_virt_bse
     178             :       TYPE(group_dist_d1_type), ALLOCATABLE, &
     179         606 :          DIMENSION(:)                                    :: gd_B_virtual
     180             :       TYPE(hfx_compression_type), ALLOCATABLE, &
     181         606 :          DIMENSION(:, :, :)                              :: t_3c_O_compressed
     182             :       TYPE(kpoint_type), POINTER                         :: kpoints, kpoints_from_DFT
     183         606 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos
     184             :       TYPE(mp_para_env_type), POINTER                    :: para_env_sub
     185             :       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
     186         606 :          POINTER                                         :: sab_orb_sub
     187         606 :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     188         606 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
     189             :       TYPE(qs_ks_env_type), POINTER                      :: ks_env
     190             :       TYPE(three_dim_real_array), ALLOCATABLE, &
     191         606 :          DIMENSION(:)                                    :: BIb_C, BIb_C_gw
     192             : 
     193         606 :       CALL timeset(routineN, handle)
     194             : 
     195             :       ! check if we want to do ri-mp2
     196         606 :       my_do_ri_mp2 = .FALSE.
     197         606 :       IF (PRESENT(do_ri_mp2)) my_do_ri_mp2 = do_ri_mp2
     198             : 
     199             :       ! check if we want to do ri-rpa
     200         606 :       my_do_ri_rpa = .FALSE.
     201         606 :       IF (PRESENT(do_ri_rpa)) my_do_ri_rpa = do_ri_rpa
     202             : 
     203             :       ! check if we want to do ri-sos-laplace-mp2
     204         606 :       my_do_ri_sos_laplace_mp2 = .FALSE.
     205         606 :       IF (PRESENT(do_ri_sos_laplace_mp2)) my_do_ri_sos_laplace_mp2 = do_ri_sos_laplace_mp2
     206             : 
     207             :       ! GW and SOS-MP2 cannot be used together
     208         606 :       IF (my_do_ri_sos_laplace_mp2) THEN
     209          58 :          CPASSERT(.NOT. mp2_env%ri_rpa%do_ri_g0w0)
     210             :       END IF
     211             : 
     212             :       ! check if we want to do imaginary time
     213         606 :       do_im_time = mp2_env%do_im_time
     214         606 :       do_bse = qs_env%mp2_env%ri_g0w0%do_bse
     215         606 :       do_kpoints_cubic_RPA = qs_env%mp2_env%ri_rpa_im_time%do_im_time_kpoints
     216             : 
     217         606 :       IF (do_kpoints_cubic_RPA .AND. mp2_env%ri_rpa%do_ri_g0w0) THEN
     218           0 :          CPABORT("Full RPA k-points (DO_KPOINTS in LOW_SCALING section) not implemented with GW")
     219             :       END IF
     220             : 
     221             :       ! Get the number of spins
     222         606 :       nspins = SIZE(mos_mp2)
     223             : 
     224             :       ! ... setup needed to be able to qs_integrate in a subgroup.
     225         606 :       IF (do_kpoints_cubic_RPA) THEN
     226           4 :          CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, kpoints=kpoints_from_DFT)
     227           4 :          mos(1:nspins) => kpoints_from_DFT%kp_env(1)%kpoint_env%mos(1:nspins, 1)
     228             :       ELSE
     229         602 :          CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, mos=mos)
     230             :       END IF
     231         606 :       CALL get_mo_set(mo_set=mos_mp2(1), nao=dimen)
     232        5594 :       ALLOCATE (homo(nspins), Eigenval(dimen, nspins), mo_coeff(nspins))
     233        1352 :       DO ispin = 1, nspins
     234             :          CALL get_mo_set(mo_set=mos_mp2(ispin), &
     235             :                          eigenvalues=mo_eigenvalues, nmo=nmo, homo=homo(ispin), &
     236         746 :                          mo_coeff=mo_coeff_ptr)
     237         746 :          mo_coeff(ispin) = mo_coeff_ptr
     238       16314 :          Eigenval(:, ispin) = mo_eigenvalues(:)
     239             :       END DO
     240             : 
     241             :       ! a para_env
     242         606 :       color_sub = para_env%mepos/mp2_env%mp2_num_proc
     243         606 :       ALLOCATE (para_env_sub)
     244         606 :       CALL para_env_sub%from_split(para_env, color_sub)
     245             : 
     246             :       ! each of the sub groups might need to generate output
     247         606 :       logger => cp_get_default_logger()
     248         606 :       IF (para_env%is_source()) THEN
     249         303 :          local_unit_nr = cp_logger_get_default_unit_nr(logger, local=.FALSE.)
     250             :       ELSE
     251         303 :          local_unit_nr = default_output_unit
     252             :       END IF
     253             : 
     254             :       ! get stuff
     255             :       CALL get_qs_env(qs_env, &
     256             :                       ks_env=ks_env, &
     257             :                       qs_kind_set=qs_kind_set, &
     258             :                       cell=cell, &
     259             :                       particle_set=particle_set, &
     260             :                       atomic_kind_set=atomic_kind_set, &
     261             :                       dft_control=dft_control, &
     262         606 :                       matrix_s_kp=matrix_s_kp)
     263             : 
     264         606 :       CALL get_cell(cell=cell, periodic=periodic)
     265             : 
     266         606 :       IF (do_im_time) THEN
     267             : 
     268         134 :          IF (mp2_env%ri_metric%potential_type == ri_default) THEN
     269         420 :             IF (SUM(periodic) == 1 .OR. SUM(periodic) == 3) THEN
     270           6 :                mp2_env%ri_metric%potential_type = do_potential_id
     271             :             ELSE
     272          54 :                mp2_env%ri_metric%potential_type = do_potential_truncated
     273             :             END IF
     274             :          END IF
     275             : 
     276             :          ! statically initialize libint
     277         134 :          CALL cp_libint_static_init()
     278             : 
     279             :       END IF
     280             : 
     281         606 :       IF (mp2_env%ri_metric%potential_type == ri_default) THEN
     282         260 :          mp2_env%ri_metric%potential_type = do_potential_coulomb
     283             :       END IF
     284             : 
     285         606 :       IF (mp2_env%eri_method == eri_default) THEN
     286         968 :          IF (SUM(periodic) > 0) mp2_env%eri_method = do_eri_gpw
     287         968 :          IF (SUM(periodic) == 0) mp2_env%eri_method = do_eri_os
     288         968 :          IF (SUM(mp2_env%ri_rpa_im_time%kp_grid) > 0) mp2_env%eri_method = do_eri_os
     289         242 :          IF (mp2_env%method == mp2_method_gpw) mp2_env%eri_method = do_eri_gpw
     290         242 :          IF (mp2_env%method == ri_mp2_method_gpw) mp2_env%eri_method = do_eri_gpw
     291         242 :          IF (mp2_env%ri_rpa_im_time%do_im_time_kpoints) mp2_env%eri_method = do_eri_os
     292         242 :          IF (calc_forces .AND. mp2_env%eri_method == do_eri_os) mp2_env%eri_method = do_eri_gpw
     293             :       END IF
     294         606 :       eri_method = mp2_env%eri_method
     295             : 
     296         606 :       IF (unit_nr > 0 .AND. mp2_env%eri_method == do_eri_gpw) THEN
     297             :          WRITE (UNIT=unit_nr, FMT="(T3,A,T71,F10.1)") &
     298         173 :             "GPW_INFO| Density cutoff [a.u.]:", mp2_env%mp2_gpw%cutoff*0.5_dp
     299             :          WRITE (UNIT=unit_nr, FMT="(T3,A,T71,F10.1)") &
     300         173 :             "GPW_INFO| Relative density cutoff [a.u.]:", mp2_env%mp2_gpw%relative_cutoff*0.5_dp
     301         173 :          CALL m_flush(unit_nr)
     302             :       END IF
     303             : 
     304         606 :       IF (.NOT. mp2_env%ri_g0w0%print_local_bandgap) THEN
     305             :          ! a logger
     306         600 :          NULLIFY (logger_sub)
     307             :          CALL cp_logger_create(logger_sub, para_env=para_env_sub, &
     308         600 :                                default_global_unit_nr=local_unit_nr, close_global_unit_on_dealloc=.FALSE.)
     309         600 :          CALL cp_logger_set(logger_sub, local_filename="MP2_localLog")
     310             :          ! set to a custom print level (we could also have a different print level for para_env%source)
     311         600 :          logger_sub%iter_info%print_level = mp2_env%mp2_gpw%print_level
     312         600 :          CALL cp_add_default_logger(logger_sub)
     313             :       END IF
     314             : 
     315             :       ! a blacs_env (ignore the globenv stored defaults for now)
     316         606 :       blacs_grid_layout = BLACS_GRID_SQUARE
     317         606 :       blacs_repeatable = .TRUE.
     318         606 :       NULLIFY (blacs_env_sub)
     319             :       CALL cp_blacs_env_create(blacs_env_sub, para_env_sub, &
     320             :                                blacs_grid_layout, &
     321         606 :                                blacs_repeatable)
     322             : 
     323         606 :       blacs_env_sub_mat_munu => blacs_env_sub
     324             : 
     325         606 :       matrix_s(1:1) => matrix_s_kp(1:1, 1)
     326             : 
     327         606 :       CALL get_eps_old(dft_control, eps_pgf_orb_old, eps_rho_rspace_old, eps_gvg_rspace_old)
     328             : 
     329             :       CALL create_mat_munu(mat_munu, qs_env, mp2_env%mp2_gpw%eps_grid, &
     330             :                            blacs_env_sub_mat_munu, do_alloc_blocks_from_nbl=.NOT. do_im_time, sab_orb_sub=sab_orb_sub, &
     331             :                            do_kpoints=mp2_env%ri_rpa_im_time%do_im_time_kpoints, &
     332         606 :                            dbcsr_sym_type=dbcsr_type_symmetric)
     333             : 
     334             :       ! which RI metric we want to have
     335         606 :       ri_metric_type = mp2_env%ri_metric%potential_type
     336             : 
     337             :       ! which interaction potential
     338         606 :       potential_type = mp2_env%potential_parameter%potential_type
     339             : 
     340             :       ! check if we want to do ri-g0w0 on top of ri-rpa
     341         606 :       my_do_gw = mp2_env%ri_rpa%do_ri_g0w0
     342        3030 :       ALLOCATE (gw_corr_lev_occ(nspins), gw_corr_lev_virt(nspins))
     343         606 :       gw_corr_lev_occ(1) = mp2_env%ri_g0w0%corr_mos_occ
     344         606 :       gw_corr_lev_virt(1) = mp2_env%ri_g0w0%corr_mos_virt
     345         606 :       IF (nspins == 2) THEN
     346         140 :          gw_corr_lev_occ(2) = mp2_env%ri_g0w0%corr_mos_occ_beta
     347         140 :          gw_corr_lev_virt(2) = mp2_env%ri_g0w0%corr_mos_virt_beta
     348             :       END IF
     349             : 
     350             :       ! After the components are inside of the routines, we can move this line insight the branch
     351        8438 :       ALLOCATE (mo_coeff_o(nspins), mo_coeff_v(nspins), mo_coeff_all(nspins), mo_coeff_gw(nspins))
     352             : 
     353             :       ! for imag. time, we do not need this
     354         606 :       IF (.NOT. do_im_time) THEN
     355             : 
     356             :          ! new routine: replicate a full matrix from one para_env to a smaller one
     357             :          ! keeping the memory usage as small as possible in this case the
     358             :          ! output the two part of the C matrix (virtual, occupied)
     359        1054 :          DO ispin = 1, nspins
     360             : 
     361             :             CALL replicate_mat_to_subgroup(para_env, para_env_sub, mo_coeff(ispin), dimen, homo(ispin), mat_munu%matrix, &
     362             :                                            mo_coeff_o(ispin)%matrix, mo_coeff_v(ispin)%matrix, &
     363             :                                            mo_coeff_all(ispin)%matrix, mo_coeff_gw(ispin)%matrix, &
     364        1054 :                                            my_do_gw, gw_corr_lev_occ(ispin), gw_corr_lev_virt(ispin), mp2_env%mp2_gpw%eps_filter)
     365             :          END DO
     366             : 
     367             :       END IF
     368             : 
     369             :       ! now we're kind of ready to go....
     370         606 :       Emp2_S = 0.0_dp
     371         606 :       Emp2_T = 0.0_dp
     372         606 :       IF (my_do_ri_mp2 .OR. my_do_ri_rpa .OR. my_do_ri_sos_laplace_mp2) THEN
     373             :          ! RI-GPW integrals (same stuff for both RPA and MP2)
     374         592 :          IF (nspins == 2) THEN
     375             :             ! open shell case (RI) here the (ia|K) integrals are computed for both the alpha and beta components
     376             :             CALL mp2_ri_gpw_compute_in( &
     377             :                BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd_array, gd_B_virtual, dimen_RI, dimen_RI_red, qs_env, &
     378             :                para_env, para_env_sub, color_sub, cell, particle_set, &
     379             :                atomic_kind_set, qs_kind_set, mo_coeff, fm_matrix_PQ, fm_matrix_L_kpoints, fm_matrix_Minv_L_kpoints, &
     380             :                fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, nmo, homo, mat_munu, sab_orb_sub, &
     381             :                mo_coeff_o, mo_coeff_v, mo_coeff_all, mo_coeff_gw, &
     382             :                mp2_env%mp2_gpw%eps_filter, unit_nr, &
     383             :                mp2_env%mp2_memory, mp2_env%calc_PQ_cond_num, calc_forces, blacs_env_sub, my_do_gw .AND. .NOT. do_im_time, &
     384             :                do_bse, gd_B_all, starts_array_mc, ends_array_mc, starts_array_mc_block, ends_array_mc_block, &
     385             :                gw_corr_lev_occ(1), gw_corr_lev_virt(1), &
     386             :                do_im_time, do_kpoints_cubic_RPA, kpoints, &
     387             :                t_3c_M, t_3c_O, t_3c_O_compressed, t_3c_O_ind, &
     388             :                mp2_env%ri_metric, &
     389         272 :                gd_B_occ_bse, gd_B_virt_bse)
     390             :          ELSE
     391             :             ! closed shell case (RI)
     392             :             CALL mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd_array, gd_B_virtual, &
     393             :                                        dimen_RI, dimen_RI_red, qs_env, para_env, para_env_sub, &
     394             :                                        color_sub, cell, particle_set, &
     395             :                                        atomic_kind_set, qs_kind_set, mo_coeff, fm_matrix_PQ, &
     396             :                                        fm_matrix_L_kpoints, fm_matrix_Minv_L_kpoints, &
     397             :                                        fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, nmo, homo, &
     398             :                                        mat_munu, sab_orb_sub, &
     399             :                                        mo_coeff_o, mo_coeff_v, mo_coeff_all, mo_coeff_gw, &
     400             :                                        mp2_env%mp2_gpw%eps_filter, unit_nr, &
     401             :                                        mp2_env%mp2_memory, mp2_env%calc_PQ_cond_num, calc_forces, &
     402             :                                        blacs_env_sub, my_do_gw .AND. .NOT. do_im_time, do_bse, gd_B_all, &
     403             :                                        starts_array_mc, ends_array_mc, &
     404             :                                        starts_array_mc_block, ends_array_mc_block, &
     405             :                                        gw_corr_lev_occ(1), gw_corr_lev_virt(1), &
     406             :                                        do_im_time, do_kpoints_cubic_RPA, kpoints, &
     407             :                                        t_3c_M, t_3c_O, t_3c_O_compressed, t_3c_O_ind, &
     408         886 :                                        mp2_env%ri_metric, gd_B_occ_bse, gd_B_virt_bse)
     409             :          END IF
     410             : 
     411             :       ELSE
     412             :          ! Canonical MP2-GPW
     413          14 :          IF (nspins == 2) THEN
     414             :             ! alpha-alpha and alpha-beta components
     415           2 :             IF (unit_nr > 0) WRITE (unit_nr, *)
     416           2 :             IF (unit_nr > 0) WRITE (unit_nr, '(T3,A)') 'Alpha (ia|'
     417             :             CALL mp2_gpw_compute( &
     418             :                Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_sub, color_sub, &
     419             :                cell, particle_set, &
     420             :                atomic_kind_set, qs_kind_set, mo_coeff(1), Eigenval, nmo, homo, mat_munu, &
     421             :                sab_orb_sub, mo_coeff_o, mo_coeff_v, mp2_env%mp2_gpw%eps_filter, unit_nr, &
     422           2 :                mp2_env%mp2_memory, calc_ex, blacs_env_sub, Emp2_AB)
     423             : 
     424             :             ! beta-beta component
     425           2 :             IF (unit_nr > 0) WRITE (unit_nr, *)
     426           2 :             IF (unit_nr > 0) WRITE (unit_nr, '(T3,A)') 'Beta (ia|'
     427             :             CALL mp2_gpw_compute( &
     428             :                Emp2_BB, Emp2_Cou_BB, Emp2_EX_BB, qs_env, para_env, para_env_sub, color_sub, cell, particle_set, &
     429             :                atomic_kind_set, qs_kind_set, mo_coeff(2), Eigenval(:, 2:2), nmo, homo(2:2), mat_munu, &
     430             :                sab_orb_sub, mo_coeff_o(2:2), mo_coeff_v(2:2), mp2_env%mp2_gpw%eps_filter, unit_nr, &
     431           2 :                mp2_env%mp2_memory, calc_ex, blacs_env_sub)
     432             : 
     433             :             ! make order on the MP2 energy contributions
     434           2 :             Emp2_Cou = Emp2_Cou*0.25_dp
     435           2 :             Emp2_EX = Emp2_EX*0.5_dp
     436             : 
     437           2 :             Emp2_Cou_BB = Emp2_Cou_BB*0.25_dp
     438           2 :             Emp2_EX_BB = Emp2_EX_BB*0.5_dp
     439             : 
     440           2 :             Emp2_S = Emp2_AB
     441           2 :             Emp2_T = Emp2_Cou + Emp2_Cou_BB + Emp2_EX + Emp2_EX_BB
     442             : 
     443           2 :             Emp2_Cou = Emp2_Cou + Emp2_Cou_BB + Emp2_AB
     444           2 :             Emp2_EX = Emp2_EX + Emp2_EX_BB
     445           2 :             Emp2 = Emp2_EX + Emp2_Cou
     446             : 
     447             :          ELSE
     448             :             ! closed shell case
     449             :             CALL mp2_gpw_compute( &
     450             :                Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_sub, color_sub, cell, particle_set, &
     451             :                atomic_kind_set, qs_kind_set, mo_coeff(1), Eigenval(:, 1:1), nmo, homo(1:1), mat_munu, &
     452             :                sab_orb_sub, mo_coeff_o(1:1), mo_coeff_v(1:1), mp2_env%mp2_gpw%eps_filter, unit_nr, &
     453          12 :                mp2_env%mp2_memory, calc_ex, blacs_env_sub)
     454             :          END IF
     455             :       END IF
     456             : 
     457             :       ! Free possibly large buffers allocated by dbcsr on the GPU,
     458             :       ! large hybrid dgemm/pdgemm's coming later will need the space.
     459         606 :       CALL dbcsr_clear_mempools()
     460             : 
     461         606 :       IF (calc_forces .AND. .NOT. do_im_time) THEN
     462             :          ! make a copy of mo_coeff_o and mo_coeff_v
     463        1988 :          ALLOCATE (mp2_env%ri_grad%mo_coeff_o(nspins), mp2_env%ri_grad%mo_coeff_v(nspins))
     464         604 :          DO ispin = 1, nspins
     465         344 :             NULLIFY (mp2_env%ri_grad%mo_coeff_o(ispin)%matrix)
     466         344 :             CALL dbcsr_init_p(mp2_env%ri_grad%mo_coeff_o(ispin)%matrix)
     467             :             CALL dbcsr_copy(mp2_env%ri_grad%mo_coeff_o(ispin)%matrix, mo_coeff_o(ispin)%matrix, &
     468         344 :                             name="mo_coeff_o"//cp_to_string(ispin))
     469         344 :             NULLIFY (mp2_env%ri_grad%mo_coeff_v(ispin)%matrix)
     470         344 :             CALL dbcsr_init_p(mp2_env%ri_grad%mo_coeff_v(ispin)%matrix)
     471             :             CALL dbcsr_copy(mp2_env%ri_grad%mo_coeff_v(ispin)%matrix, mo_coeff_v(ispin)%matrix, &
     472         604 :                             name="mo_coeff_v"//cp_to_string(ispin))
     473             :          END DO
     474         260 :          CALL get_group_dist(gd_array, color_sub, my_group_L_start, my_group_L_end, my_group_L_size)
     475             :       END IF
     476             :       ! Copy mo coeffs for RPA AXK
     477         606 :       IF (mp2_env%ri_rpa%do_ri_axk) THEN
     478           6 :          NULLIFY (mp2_env%ri_rpa%mo_coeff_o)
     479           6 :          CALL dbcsr_init_p(mp2_env%ri_rpa%mo_coeff_o)
     480           6 :          CALL dbcsr_copy(mp2_env%ri_rpa%mo_coeff_o, mo_coeff_o(1)%matrix, name="mo_coeff_o")
     481           6 :          NULLIFY (mp2_env%ri_rpa%mo_coeff_v)
     482           6 :          CALL dbcsr_init_p(mp2_env%ri_rpa%mo_coeff_v)
     483           6 :          CALL dbcsr_copy(mp2_env%ri_rpa%mo_coeff_v, mo_coeff_v(1)%matrix, name="mo_coeff_v")
     484             :       END IF
     485             : 
     486         606 :       IF (.NOT. do_im_time) THEN
     487             : 
     488        1054 :          DO ispin = 1, nspins
     489         582 :             CALL dbcsr_release(mo_coeff_o(ispin)%matrix)
     490         582 :             DEALLOCATE (mo_coeff_o(ispin)%matrix)
     491         582 :             CALL dbcsr_release(mo_coeff_v(ispin)%matrix)
     492         582 :             DEALLOCATE (mo_coeff_v(ispin)%matrix)
     493        1054 :             IF (my_do_gw) THEN
     494          30 :                CALL dbcsr_release(mo_coeff_all(ispin)%matrix)
     495          30 :                DEALLOCATE (mo_coeff_all(ispin)%matrix)
     496             :             END IF
     497             :          END DO
     498         472 :          DEALLOCATE (mo_coeff_o, mo_coeff_v)
     499         472 :          IF (my_do_gw) DEALLOCATE (mo_coeff_all)
     500             : 
     501             :       END IF
     502             : 
     503         606 :       IF (.NOT. calc_forces) THEN
     504         296 :          IF (.NOT. mp2_env%ri_rpa%do_ri_axk) THEN
     505             : 
     506         290 :             CALL dbcsr_release(mat_munu%matrix)
     507         290 :             DEALLOCATE (mat_munu%matrix)
     508             : 
     509         290 :             CALL release_neighbor_list_sets(sab_orb_sub)
     510             : 
     511             :          END IF
     512             : 
     513             :       END IF
     514             : 
     515             :       ! decide if to do RI-RPA or RI-MP2
     516         606 :       IF (my_do_ri_rpa .OR. my_do_ri_sos_laplace_mp2) THEN
     517             : 
     518         246 :          IF (do_im_time) THEN
     519             : 
     520         134 :             CALL create_matrix_P(mat_P_global, qs_env, mp2_env, para_env)
     521             : 
     522             :             ! To be removed later
     523         566 :             ALLOCATE (BIb_C(nspins))
     524             :          END IF
     525             : 
     526         246 :          IF (.NOT. ALLOCATED(BIb_C)) ALLOCATE (BIb_C(nspins))
     527         954 :          IF (.NOT. ALLOCATED(BIb_C_gw)) ALLOCATE (BIb_C_gw(nspins))
     528         678 :          IF (.NOT. ALLOCATED(gd_B_virtual)) ALLOCATE (gd_B_virtual(nspins))
     529             : 
     530             :          ! RI-RPA
     531             :          CALL rpa_ri_compute_en(qs_env, Emp2, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, &
     532             :                                 para_env, para_env_sub, color_sub, &
     533             :                                 gd_array, gd_B_virtual, gd_B_all, gd_B_occ_bse, gd_B_virt_bse, &
     534             :                                 mo_coeff, fm_matrix_PQ, fm_matrix_L_kpoints, fm_matrix_Minv_L_kpoints, &
     535             :                                 fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, kpoints, &
     536             :                                 Eigenval, nmo, homo, dimen_RI, dimen_RI_red, gw_corr_lev_occ, gw_corr_lev_virt, &
     537             :                                 unit_nr, my_do_ri_sos_laplace_mp2, my_do_gw, do_im_time, do_bse, matrix_s, &
     538             :                                 mat_munu, mat_P_global, &
     539             :                                 t_3c_M, t_3c_O, t_3c_O_compressed, t_3c_O_ind, &
     540             :                                 starts_array_mc, ends_array_mc, &
     541         246 :                                 starts_array_mc_block, ends_array_mc_block, calc_forces)
     542             : 
     543         246 :          IF (mp2_env%ri_rpa%do_rse) &
     544           4 :             CALL rse_energy(qs_env, mp2_env, para_env, dft_control, mo_coeff, nmo, homo, Eigenval)
     545             : 
     546         246 :          IF (do_im_time) THEN
     547         134 :             IF (ASSOCIATED(mat_P_global%matrix)) THEN
     548         134 :                CALL dbcsr_release(mat_P_global%matrix)
     549         134 :                DEALLOCATE (mat_P_global%matrix)
     550             :             END IF
     551             : 
     552         134 :             CALL cp_libint_static_cleanup()
     553         134 :             IF (calc_forces) CALL cp_fm_release(fm_matrix_PQ)
     554             :          END IF
     555             : 
     556             :          ! Release some memory for AXK
     557         246 :          IF (mp2_env%ri_rpa%do_ri_axk .OR. (calc_forces .AND. do_im_time)) THEN
     558             : 
     559          56 :             CALL dbcsr_release(mat_munu%matrix)
     560          56 :             DEALLOCATE (mat_munu%matrix)
     561             : 
     562          56 :             CALL release_neighbor_list_sets(sab_orb_sub)
     563             : 
     564             :          END IF
     565             : 
     566             :       ELSE
     567         360 :          IF (my_do_ri_mp2) THEN
     568         346 :             Emp2 = 0.0_dp
     569         346 :             Emp2_Cou = 0.0_dp
     570         346 :             Emp2_EX = 0.0_dp
     571             : 
     572             :             ! RI-MP2-GPW compute energy
     573             :             CALL mp2_ri_gpw_compute_en( &
     574             :                Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T, BIb_C, mp2_env, para_env, para_env_sub, color_sub, &
     575             :                gd_array, gd_B_virtual, &
     576         346 :                Eigenval, nmo, homo, dimen_RI_red, unit_nr, calc_forces, calc_ex)
     577             : 
     578             :          END IF
     579             :       END IF
     580             : 
     581             :       ! if we need forces time to calculate the MP2 non-separable contribution
     582             :       ! and start computing the Lagrangian
     583         606 :       IF (calc_forces .AND. .NOT. do_im_time) THEN
     584             : 
     585             :          CALL calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, &
     586             :                                  particle_set, atomic_kind_set, qs_kind_set, &
     587             :                                  mo_coeff, nmo, homo, dimen_RI, Eigenval, &
     588             :                                  my_group_L_start, my_group_L_end, my_group_L_size, &
     589         260 :                                  sab_orb_sub, mat_munu, blacs_env_sub)
     590             : 
     591         604 :          DO ispin = 1, nspins
     592         344 :             CALL dbcsr_release(mp2_env%ri_grad%mo_coeff_o(ispin)%matrix)
     593         344 :             DEALLOCATE (mp2_env%ri_grad%mo_coeff_o(ispin)%matrix)
     594             : 
     595         344 :             CALL dbcsr_release(mp2_env%ri_grad%mo_coeff_v(ispin)%matrix)
     596         604 :             DEALLOCATE (mp2_env%ri_grad%mo_coeff_v(ispin)%matrix)
     597             :          END DO
     598         260 :          DEALLOCATE (mp2_env%ri_grad%mo_coeff_o, mp2_env%ri_grad%mo_coeff_v)
     599             : 
     600         260 :          CALL dbcsr_release(mat_munu%matrix)
     601         260 :          DEALLOCATE (mat_munu%matrix)
     602             : 
     603         260 :          CALL release_neighbor_list_sets(sab_orb_sub)
     604             : 
     605             :       END IF
     606             : 
     607             :       !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXx
     608             :       ! moved from above
     609         606 :       IF (my_do_gw .AND. .NOT. do_im_time) THEN
     610          56 :          DO ispin = 1, nspins
     611          30 :             CALL dbcsr_release(mo_coeff_gw(ispin)%matrix)
     612          56 :             DEALLOCATE (mo_coeff_gw(ispin)%matrix)
     613             :          END DO
     614          26 :          DEALLOCATE (mo_coeff_gw)
     615             :       END IF
     616             : 
     617             :       ! re-init the radii to be able to generate pair lists with MP2-appropriate screening
     618         606 :       dft_control%qs_control%eps_pgf_orb = eps_pgf_orb_old
     619         606 :       dft_control%qs_control%eps_rho_rspace = eps_rho_rspace_old
     620         606 :       dft_control%qs_control%eps_gvg_rspace = eps_gvg_rspace_old
     621         606 :       CALL init_interaction_radii(dft_control%qs_control, qs_kind_set)
     622             : 
     623         606 :       CALL cp_blacs_env_release(blacs_env_sub)
     624             : 
     625         606 :       IF (.NOT. mp2_env%ri_g0w0%print_local_bandgap) THEN
     626         600 :          CALL cp_rm_default_logger()
     627         600 :          CALL cp_logger_release(logger_sub)
     628             :       END IF
     629             : 
     630         606 :       CALL mp_para_env_release(para_env_sub)
     631             : 
     632             :       ! finally solve the z-vector equation if forces are required
     633         606 :       IF (calc_forces .AND. .NOT. do_im_time) THEN
     634             :          CALL solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, &
     635         260 :                                 mo_coeff, nmo, homo, Eigenval, unit_nr)
     636             :       END IF
     637             : 
     638         606 :       DEALLOCATE (Eigenval, mo_coeff)
     639             : 
     640         606 :       CALL timestop(handle)
     641             : 
     642        4788 :    END SUBROUTINE mp2_gpw_main
     643             : 
     644             : ! **************************************************************************************************
     645             : !> \brief ...
     646             : !> \param para_env ...
     647             : !> \param para_env_sub ...
     648             : !> \param mo_coeff ...
     649             : !> \param dimen ...
     650             : !> \param homo ...
     651             : !> \param mat_munu ...
     652             : !> \param mo_coeff_o ...
     653             : !> \param mo_coeff_v ...
     654             : !> \param mo_coeff_all ...
     655             : !> \param mo_coeff_gw ...
     656             : !> \param my_do_gw ...
     657             : !> \param gw_corr_lev_occ ...
     658             : !> \param gw_corr_lev_virt ...
     659             : !> \param eps_filter ...
     660             : ! **************************************************************************************************
     661         582 :    SUBROUTINE replicate_mat_to_subgroup(para_env, para_env_sub, mo_coeff, dimen, homo, mat_munu, &
     662             :                                         mo_coeff_o, mo_coeff_v, mo_coeff_all, mo_coeff_gw, my_do_gw, &
     663             :                                         gw_corr_lev_occ, gw_corr_lev_virt, eps_filter)
     664             :       TYPE(mp_para_env_type), INTENT(IN)                 :: para_env, para_env_sub
     665             :       TYPE(cp_fm_type), INTENT(IN)                       :: mo_coeff
     666             :       INTEGER, INTENT(IN)                                :: dimen, homo
     667             :       TYPE(dbcsr_type), INTENT(INOUT)                    :: mat_munu
     668             :       TYPE(dbcsr_type), POINTER                          :: mo_coeff_o, mo_coeff_v, mo_coeff_all, &
     669             :                                                             mo_coeff_gw
     670             :       LOGICAL, INTENT(IN)                                :: my_do_gw
     671             :       INTEGER, INTENT(IN)                                :: gw_corr_lev_occ, gw_corr_lev_virt
     672             :       REAL(KIND=dp), INTENT(IN)                          :: eps_filter
     673             : 
     674             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'replicate_mat_to_subgroup'
     675             : 
     676             :       INTEGER                                            :: handle
     677         582 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: C
     678         582 :       TYPE(group_dist_d1_type)                           :: gd_array
     679             : 
     680         582 :       CALL timeset(routineN, handle)
     681             : 
     682             :       CALL grep_rows_in_subgroups(para_env, para_env_sub, mo_coeff, gd_array, C)
     683             : 
     684             :       ! create and fill mo_coeff_o, mo_coeff_v and mo_coeff_all
     685         582 :       ALLOCATE (mo_coeff_o)
     686             :       CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_o, C(:, 1:homo), &
     687         582 :                                  mat_munu, gd_array, eps_filter)
     688             : 
     689         582 :       ALLOCATE (mo_coeff_v)
     690             :       CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_v, C(:, homo + 1:dimen), &
     691         582 :                                  mat_munu, gd_array, eps_filter)
     692             : 
     693         582 :       IF (my_do_gw) THEN
     694          30 :          ALLOCATE (mo_coeff_gw)
     695             :          CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_gw, C(:, homo - gw_corr_lev_occ + 1:homo + gw_corr_lev_virt), &
     696          30 :                                     mat_munu, gd_array, eps_filter)
     697             : 
     698             :          ! all levels
     699          30 :          ALLOCATE (mo_coeff_all)
     700             :          CALL build_dbcsr_from_rows(para_env_sub, mo_coeff_all, C, &
     701          30 :                                     mat_munu, gd_array, eps_filter)
     702             : 
     703             :       END IF
     704             : 
     705         582 :       DEALLOCATE (C)
     706         582 :       CALL release_group_dist(gd_array)
     707             : 
     708         582 :       CALL timestop(handle)
     709             : 
     710         582 :    END SUBROUTINE replicate_mat_to_subgroup
     711             : 
     712             : ! **************************************************************************************************
     713             : !> \brief ...
     714             : !> \param para_env ...
     715             : !> \param para_env_sub ...
     716             : !> \param mo_coeff ...
     717             : !> \param gd_array ...
     718             : !> \param C ...
     719             : ! **************************************************************************************************
     720         606 :    SUBROUTINE grep_rows_in_subgroups(para_env, para_env_sub, mo_coeff, gd_array, C)
     721             :       TYPE(mp_para_env_type), INTENT(IN)                 :: para_env, para_env_sub
     722             :       TYPE(cp_fm_type), INTENT(IN)                       :: mo_coeff
     723             :       TYPE(group_dist_d1_type), INTENT(OUT)              :: gd_array
     724             :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :), &
     725             :          INTENT(OUT)                                     :: C
     726             : 
     727             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'grep_rows_in_subgroups'
     728             : 
     729             :       INTEGER :: handle, i_global, iiB, j_global, jjB, max_row_col_local, my_mu_end, my_mu_size, &
     730             :          my_mu_start, ncol_global, ncol_local, ncol_rec, nrow_global, nrow_local, nrow_rec, &
     731             :          proc_receive_static, proc_send_static, proc_shift
     732         606 :       INTEGER, ALLOCATABLE, DIMENSION(:, :)              :: local_col_row_info, rec_col_row_info
     733         606 :       INTEGER, DIMENSION(:), POINTER                     :: col_indices, col_indices_rec, &
     734         606 :                                                             row_indices, row_indices_rec
     735         606 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: local_C, rec_C
     736             :       REAL(KIND=dp), CONTIGUOUS, DIMENSION(:, :), &
     737         606 :          POINTER                                         :: local_C_internal
     738             : 
     739         606 :       CALL timeset(routineN, handle)
     740             : 
     741             :       CALL cp_fm_get_info(matrix=mo_coeff, &
     742             :                           ncol_global=ncol_global, &
     743             :                           nrow_global=nrow_global, &
     744             :                           nrow_local=nrow_local, &
     745             :                           ncol_local=ncol_local, &
     746             :                           row_indices=row_indices, &
     747             :                           col_indices=col_indices, &
     748         606 :                           local_data=local_C_internal)
     749             : 
     750         606 :       CALL create_group_dist(gd_array, para_env_sub%num_pe, nrow_global)
     751         606 :       CALL get_group_dist(gd_array, para_env_sub%mepos, my_mu_start, my_mu_end, my_mu_size)
     752             : 
     753             :       ! local storage for the C matrix
     754        2424 :       ALLOCATE (C(my_mu_size, ncol_global))
     755      248548 :       C = 0.0_dp
     756             : 
     757        2424 :       ALLOCATE (local_C(nrow_local, ncol_local))
     758      134229 :       local_C(:, :) = local_C_internal(1:nrow_local, 1:ncol_local)
     759         606 :       NULLIFY (local_C_internal)
     760             : 
     761         606 :       max_row_col_local = MAX(nrow_local, ncol_local)
     762         606 :       CALL para_env%max(max_row_col_local)
     763             : 
     764        2424 :       ALLOCATE (local_col_row_info(0:max_row_col_local, 2))
     765       25026 :       local_col_row_info = 0
     766             :       ! 0,1 nrows
     767         606 :       local_col_row_info(0, 1) = nrow_local
     768        6129 :       local_col_row_info(1:nrow_local, 1) = row_indices(1:nrow_local)
     769             :       ! 0,2 ncols
     770         606 :       local_col_row_info(0, 2) = ncol_local
     771       11604 :       local_col_row_info(1:ncol_local, 2) = col_indices(1:ncol_local)
     772             : 
     773        2424 :       ALLOCATE (rec_col_row_info(0:max_row_col_local, 2))
     774             : 
     775             :       ! accumulate data on C buffer starting from myself
     776        6129 :       DO iiB = 1, nrow_local
     777        5523 :          i_global = row_indices(iiB)
     778        6129 :          IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN
     779      128148 :             DO jjB = 1, ncol_local
     780      122625 :                j_global = col_indices(jjB)
     781      128148 :                C(i_global - my_mu_start + 1, j_global) = local_C(iiB, jjB)
     782             :             END DO
     783             :          END IF
     784             :       END DO
     785             : 
     786             :       ! start ring communication for collecting the data from the other
     787         606 :       proc_send_static = MODULO(para_env%mepos + 1, para_env%num_pe)
     788         606 :       proc_receive_static = MODULO(para_env%mepos - 1, para_env%num_pe)
     789        1212 :       DO proc_shift = 1, para_env%num_pe - 1
     790             :          ! first exchange information on the local data
     791       25026 :          rec_col_row_info = 0
     792         606 :          CALL para_env%sendrecv(local_col_row_info, proc_send_static, rec_col_row_info, proc_receive_static)
     793         606 :          nrow_rec = rec_col_row_info(0, 1)
     794         606 :          ncol_rec = rec_col_row_info(0, 2)
     795             : 
     796        1818 :          ALLOCATE (row_indices_rec(nrow_rec))
     797        6129 :          row_indices_rec = rec_col_row_info(1:nrow_rec, 1)
     798             : 
     799        1818 :          ALLOCATE (col_indices_rec(ncol_rec))
     800       11604 :          col_indices_rec = rec_col_row_info(1:ncol_rec, 2)
     801             : 
     802        2424 :          ALLOCATE (rec_C(nrow_rec, ncol_rec))
     803      134229 :          rec_C = 0.0_dp
     804             : 
     805             :          ! then send and receive the real data
     806         606 :          CALL para_env%sendrecv(local_C, proc_send_static, rec_C, proc_receive_static)
     807             : 
     808             :          ! accumulate the received data on C buffer
     809        6129 :          DO iiB = 1, nrow_rec
     810        5523 :             i_global = row_indices_rec(iiB)
     811        6129 :             IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN
     812      119456 :                DO jjB = 1, ncol_rec
     813      114319 :                   j_global = col_indices_rec(jjB)
     814      119456 :                   C(i_global - my_mu_start + 1, j_global) = rec_C(iiB, jjB)
     815             :                END DO
     816             :             END IF
     817             :          END DO
     818             : 
     819       25026 :          local_col_row_info(:, :) = rec_col_row_info
     820         606 :          DEALLOCATE (local_C)
     821        2424 :          ALLOCATE (local_C(nrow_rec, ncol_rec))
     822      134229 :          local_C(:, :) = rec_C
     823             : 
     824         606 :          DEALLOCATE (col_indices_rec)
     825         606 :          DEALLOCATE (row_indices_rec)
     826        1212 :          DEALLOCATE (rec_C)
     827             :       END DO
     828             : 
     829         606 :       DEALLOCATE (local_C)
     830         606 :       DEALLOCATE (local_col_row_info)
     831         606 :       DEALLOCATE (rec_col_row_info)
     832             : 
     833         606 :       CALL timestop(handle)
     834             : 
     835        2424 :    END SUBROUTINE grep_rows_in_subgroups
     836             : 
     837             : ! **************************************************************************************************
     838             : !> \brief Encapsulate the building of dbcsr_matrices mo_coeff_(v,o,all)
     839             : !> \param para_env_sub ...
     840             : !> \param mo_coeff_to_build ...
     841             : !> \param Cread ...
     842             : !> \param mat_munu ...
     843             : !> \param gd_array ...
     844             : !> \param eps_filter ...
     845             : !> \author Jan Wilhelm, Code by Mauro Del Ben
     846             : ! **************************************************************************************************
     847        1248 :    SUBROUTINE build_dbcsr_from_rows(para_env_sub, mo_coeff_to_build, Cread, &
     848             :                                     mat_munu, gd_array, eps_filter)
     849             :       TYPE(mp_para_env_type), INTENT(IN)                 :: para_env_sub
     850             :       TYPE(dbcsr_type)                                   :: mo_coeff_to_build
     851             :       REAL(KIND=dp), DIMENSION(:, :), INTENT(IN)         :: Cread
     852             :       TYPE(dbcsr_type), INTENT(INOUT)                    :: mat_munu
     853             :       TYPE(group_dist_d1_type), INTENT(IN)               :: gd_array
     854             :       REAL(KIND=dp), INTENT(IN)                          :: eps_filter
     855             : 
     856             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'build_dbcsr_from_rows'
     857             : 
     858             :       INTEGER :: blk, col, col_offset, col_size, handle, i, i_global, j, j_global, my_mu_end, &
     859             :          my_mu_start, ncol_global, proc_receive, proc_send, proc_shift, rec_mu_end, rec_mu_size, &
     860             :          rec_mu_start, row, row_offset, row_size
     861        1248 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: rec_C
     862        1248 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: data_block
     863             :       TYPE(dbcsr_iterator_type)                          :: iter
     864             : 
     865        1248 :       CALL timeset(routineN, handle)
     866             : 
     867        1248 :       ncol_global = SIZE(Cread, 2)
     868             : 
     869        1248 :       CALL get_group_dist(gd_array, para_env_sub%mepos, my_mu_start, my_mu_end)
     870             : 
     871             :       CALL cp_dbcsr_m_by_n_from_row_template(mo_coeff_to_build, template=mat_munu, n=ncol_global, &
     872        1248 :                                              sym=dbcsr_type_no_symmetry, data_type=dbcsr_type_real_default)
     873        1248 :       CALL dbcsr_reserve_all_blocks(mo_coeff_to_build)
     874             : 
     875             :       ! accumulate data on mo_coeff_to_build starting from myself
     876        1248 :       CALL dbcsr_iterator_start(iter, mo_coeff_to_build)
     877        4788 :       DO WHILE (dbcsr_iterator_blocks_left(iter))
     878             :          CALL dbcsr_iterator_next_block(iter, row, col, data_block, blk, &
     879             :                                         row_size=row_size, col_size=col_size, &
     880        3540 :                                         row_offset=row_offset, col_offset=col_offset)
     881       27700 :          DO i = 1, row_size
     882       22912 :             i_global = row_offset + i - 1
     883       26452 :             IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN
     884      284912 :                DO j = 1, col_size
     885      262176 :                   j_global = col_offset + j - 1
     886      284912 :                   data_block(i, j) = Cread(i_global - my_mu_start + 1, col_offset + j - 1)
     887             :                END DO
     888             :             END IF
     889             :          END DO
     890             :       END DO
     891        1248 :       CALL dbcsr_iterator_stop(iter)
     892             : 
     893             :       ! start ring communication in the subgroup for collecting the data from the other
     894             :       ! proc (occupied)
     895        1328 :       DO proc_shift = 1, para_env_sub%num_pe - 1
     896          80 :          proc_send = MODULO(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
     897          80 :          proc_receive = MODULO(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
     898             : 
     899          80 :          CALL get_group_dist(gd_array, proc_receive, rec_mu_start, rec_mu_end, rec_mu_size)
     900             : 
     901         320 :          ALLOCATE (rec_C(rec_mu_size, ncol_global))
     902        9110 :          rec_C = 0.0_dp
     903             : 
     904             :          ! then send and receive the real data
     905        9110 :          CALL para_env_sub%sendrecv(Cread, proc_send, rec_C, proc_receive)
     906             : 
     907             :          ! accumulate data on mo_coeff_to_build the data received from proc_rec
     908          80 :          CALL dbcsr_iterator_start(iter, mo_coeff_to_build)
     909         188 :          DO WHILE (dbcsr_iterator_blocks_left(iter))
     910             :             CALL dbcsr_iterator_next_block(iter, row, col, data_block, blk, &
     911             :                                            row_size=row_size, col_size=col_size, &
     912         108 :                                            row_offset=row_offset, col_offset=col_offset)
     913         912 :             DO i = 1, row_size
     914         724 :                i_global = row_offset + i - 1
     915         832 :                IF (i_global >= rec_mu_start .AND. i_global <= rec_mu_end) THEN
     916        1910 :                   DO j = 1, col_size
     917        1734 :                      j_global = col_offset + j - 1
     918        1910 :                      data_block(i, j) = rec_C(i_global - rec_mu_start + 1, col_offset + j - 1)
     919             :                   END DO
     920             :                END IF
     921             :             END DO
     922             :          END DO
     923          80 :          CALL dbcsr_iterator_stop(iter)
     924             : 
     925        1408 :          DEALLOCATE (rec_C)
     926             : 
     927             :       END DO
     928        1248 :       CALL dbcsr_filter(mo_coeff_to_build, eps_filter)
     929             : 
     930        1248 :       CALL timestop(handle)
     931             : 
     932        2496 :    END SUBROUTINE build_dbcsr_from_rows
     933             : 
     934             : ! **************************************************************************************************
     935             : !> \brief Encapsulate the building of dbcsr_matrix mat_munu
     936             : !> \param mat_munu ...
     937             : !> \param qs_env ...
     938             : !> \param eps_grid ...
     939             : !> \param blacs_env_sub ...
     940             : !> \param do_ri_aux_basis ...
     941             : !> \param do_mixed_basis ...
     942             : !> \param group_size_prim ...
     943             : !> \param do_alloc_blocks_from_nbl ...
     944             : !> \param do_kpoints ...
     945             : !> \param sab_orb_sub ...
     946             : !> \param dbcsr_sym_type ...
     947             : !> \author Jan Wilhelm, code by Mauro Del Ben
     948             : ! **************************************************************************************************
     949         818 :    SUBROUTINE create_mat_munu(mat_munu, qs_env, eps_grid, blacs_env_sub, &
     950             :                               do_ri_aux_basis, do_mixed_basis, group_size_prim, &
     951             :                               do_alloc_blocks_from_nbl, do_kpoints, sab_orb_sub, dbcsr_sym_type)
     952             : 
     953             :       TYPE(dbcsr_p_type), INTENT(OUT)                    :: mat_munu
     954             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     955             :       REAL(KIND=dp)                                      :: eps_grid
     956             :       TYPE(cp_blacs_env_type), POINTER                   :: blacs_env_sub
     957             :       LOGICAL, INTENT(IN), OPTIONAL                      :: do_ri_aux_basis, do_mixed_basis
     958             :       INTEGER, INTENT(IN), OPTIONAL                      :: group_size_prim
     959             :       LOGICAL, INTENT(IN), OPTIONAL                      :: do_alloc_blocks_from_nbl, do_kpoints
     960             :       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
     961             :          OPTIONAL, POINTER                               :: sab_orb_sub
     962             :       CHARACTER, OPTIONAL                                :: dbcsr_sym_type
     963             : 
     964             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'create_mat_munu'
     965             : 
     966             :       CHARACTER                                          :: my_dbcsr_sym_type
     967             :       INTEGER                                            :: handle, ikind, natom, nkind
     968         818 :       INTEGER, DIMENSION(:), POINTER                     :: col_blk_sizes, row_blk_sizes
     969             :       LOGICAL                                            :: my_do_alloc_blocks_from_nbl, &
     970             :                                                             my_do_kpoints, my_do_mixed_basis, &
     971             :                                                             my_do_ri_aux_basis
     972         818 :       LOGICAL, ALLOCATABLE, DIMENSION(:)                 :: orb_present
     973         818 :       REAL(dp), ALLOCATABLE, DIMENSION(:)                :: orb_radius
     974         818 :       REAL(dp), ALLOCATABLE, DIMENSION(:, :)             :: pair_radius
     975             :       REAL(KIND=dp)                                      :: subcells
     976         818 :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
     977             :       TYPE(cell_type), POINTER                           :: cell
     978             :       TYPE(dbcsr_distribution_type), POINTER             :: dbcsr_dist_sub
     979             :       TYPE(dft_control_type), POINTER                    :: dft_control
     980             :       TYPE(distribution_1d_type), POINTER                :: local_molecules_sub, local_particles_sub
     981             :       TYPE(distribution_2d_type), POINTER                :: distribution_2d_sub
     982         818 :       TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER  :: basis_set_ri_aux
     983             :       TYPE(gto_basis_set_type), POINTER                  :: orb_basis_set
     984         818 :       TYPE(local_atoms_type), ALLOCATABLE, DIMENSION(:)  :: atom2d
     985         818 :       TYPE(molecule_kind_type), DIMENSION(:), POINTER    :: molecule_kind_set
     986         818 :       TYPE(molecule_type), DIMENSION(:), POINTER         :: molecule_set
     987             :       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
     988         818 :          POINTER                                         :: my_sab_orb_sub
     989         818 :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     990         818 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
     991             : 
     992         818 :       CALL timeset(routineN, handle)
     993             : 
     994         818 :       NULLIFY (basis_set_ri_aux)
     995             : 
     996         818 :       my_do_ri_aux_basis = .FALSE.
     997         818 :       IF (PRESENT(do_ri_aux_basis)) THEN
     998         188 :          my_do_ri_aux_basis = do_ri_aux_basis
     999             :       END IF
    1000             : 
    1001         818 :       my_do_mixed_basis = .FALSE.
    1002         818 :       IF (PRESENT(do_mixed_basis)) THEN
    1003           0 :          my_do_mixed_basis = do_mixed_basis
    1004             :       END IF
    1005             : 
    1006         818 :       my_do_alloc_blocks_from_nbl = .FALSE.
    1007         818 :       IF (PRESENT(do_alloc_blocks_from_nbl)) THEN
    1008         630 :          my_do_alloc_blocks_from_nbl = do_alloc_blocks_from_nbl
    1009             :       END IF
    1010             : 
    1011         818 :       my_do_kpoints = .FALSE.
    1012         818 :       IF (PRESENT(do_kpoints)) THEN
    1013         740 :          my_do_kpoints = do_kpoints
    1014             :       END IF
    1015             : 
    1016         818 :       my_dbcsr_sym_type = dbcsr_type_no_symmetry
    1017         818 :       IF (PRESENT(dbcsr_sym_type)) THEN
    1018         630 :          my_dbcsr_sym_type = dbcsr_sym_type
    1019             :       END IF
    1020             : 
    1021             :       CALL get_qs_env(qs_env, &
    1022             :                       qs_kind_set=qs_kind_set, &
    1023             :                       cell=cell, &
    1024             :                       particle_set=particle_set, &
    1025             :                       atomic_kind_set=atomic_kind_set, &
    1026             :                       molecule_set=molecule_set, &
    1027             :                       molecule_kind_set=molecule_kind_set, &
    1028         818 :                       dft_control=dft_control)
    1029             : 
    1030         818 :       IF (my_do_kpoints) THEN
    1031             :          ! please choose EPS_PGF_ORB in QS section smaller than EPS_GRID in WFC_GPW section
    1032           8 :          IF (eps_grid < dft_control%qs_control%eps_pgf_orb) THEN
    1033           0 :             eps_grid = dft_control%qs_control%eps_pgf_orb
    1034           0 :             CPWARN("WFC_GPW%EPS_GRID has been set to QS%EPS_PGF_ORB")
    1035             :          END IF
    1036             :       END IF
    1037             : 
    1038             :       ! hack hack hack XXXXXXXXXXXXXXX ... to be fixed
    1039         818 :       dft_control%qs_control%eps_pgf_orb = eps_grid
    1040         818 :       dft_control%qs_control%eps_rho_rspace = eps_grid
    1041         818 :       dft_control%qs_control%eps_gvg_rspace = eps_grid
    1042         818 :       CALL init_interaction_radii(dft_control%qs_control, qs_kind_set)
    1043             : 
    1044             :       ! get a distribution_1d
    1045         818 :       NULLIFY (local_particles_sub, local_molecules_sub)
    1046             :       CALL distribute_molecules_1d(atomic_kind_set=atomic_kind_set, &
    1047             :                                    particle_set=particle_set, &
    1048             :                                    local_particles=local_particles_sub, &
    1049             :                                    molecule_kind_set=molecule_kind_set, &
    1050             :                                    molecule_set=molecule_set, &
    1051             :                                    local_molecules=local_molecules_sub, &
    1052         818 :                                    force_env_section=qs_env%input)
    1053             : 
    1054             :       ! get a distribution_2d
    1055         818 :       NULLIFY (distribution_2d_sub)
    1056             :       CALL distribute_molecules_2d(cell=cell, &
    1057             :                                    atomic_kind_set=atomic_kind_set, &
    1058             :                                    qs_kind_set=qs_kind_set, &
    1059             :                                    particle_set=particle_set, &
    1060             :                                    molecule_kind_set=molecule_kind_set, &
    1061             :                                    molecule_set=molecule_set, &
    1062             :                                    distribution_2d=distribution_2d_sub, &
    1063             :                                    blacs_env=blacs_env_sub, &
    1064         818 :                                    force_env_section=qs_env%input)
    1065             : 
    1066             :       ! Build the sub orbital-orbital overlap neighbor lists
    1067         818 :       CALL section_vals_val_get(qs_env%input, "DFT%SUBCELLS", r_val=subcells)
    1068         818 :       nkind = SIZE(atomic_kind_set)
    1069        2454 :       ALLOCATE (atom2d(nkind))
    1070             : 
    1071             :       CALL atom2d_build(atom2d, local_particles_sub, distribution_2d_sub, atomic_kind_set, &
    1072         818 :                         molecule_set, molecule_only=.FALSE., particle_set=particle_set)
    1073             : 
    1074        2454 :       ALLOCATE (orb_present(nkind))
    1075        2454 :       ALLOCATE (orb_radius(nkind))
    1076        3272 :       ALLOCATE (pair_radius(nkind, nkind))
    1077             : 
    1078        2322 :       DO ikind = 1, nkind
    1079        1504 :          CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set)
    1080        2322 :          IF (ASSOCIATED(orb_basis_set)) THEN
    1081        1504 :             orb_present(ikind) = .TRUE.
    1082        1504 :             CALL get_gto_basis_set(gto_basis_set=orb_basis_set, kind_radius=orb_radius(ikind))
    1083             :          ELSE
    1084           0 :             orb_present(ikind) = .FALSE.
    1085           0 :             orb_radius(ikind) = 0.0_dp
    1086             :          END IF
    1087             :       END DO
    1088             : 
    1089         818 :       CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius)
    1090             : 
    1091         818 :       IF (PRESENT(sab_orb_sub)) THEN
    1092         630 :          NULLIFY (sab_orb_sub)
    1093             :          ! for cubic RPA/GW with kpoints, we need all neighbors and not only the symmetric ones
    1094         630 :          IF (my_do_kpoints) THEN
    1095             :             CALL build_neighbor_lists(sab_orb_sub, particle_set, atom2d, cell, pair_radius, &
    1096             :                                       mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb_sub", &
    1097           4 :                                       symmetric=.FALSE.)
    1098             :          ELSE
    1099             :             CALL build_neighbor_lists(sab_orb_sub, particle_set, atom2d, cell, pair_radius, &
    1100         626 :                                       mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb_sub")
    1101             :          END IF
    1102             :       ELSE
    1103         188 :          NULLIFY (my_sab_orb_sub)
    1104             :          ! for cubic RPA/GW with kpoints, we need all neighbors and not only the symmetric ones
    1105         188 :          IF (my_do_kpoints) THEN
    1106             :             CALL build_neighbor_lists(my_sab_orb_sub, particle_set, atom2d, cell, pair_radius, &
    1107             :                                       mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb_sub", &
    1108           4 :                                       symmetric=.FALSE.)
    1109             :          ELSE
    1110             :             CALL build_neighbor_lists(my_sab_orb_sub, particle_set, atom2d, cell, pair_radius, &
    1111         184 :                                       mic=.FALSE., subcells=subcells, molecular=.FALSE., nlname="sab_orb_sub")
    1112             :          END IF
    1113             :       END IF
    1114         818 :       CALL atom2d_cleanup(atom2d)
    1115         818 :       DEALLOCATE (atom2d)
    1116         818 :       DEALLOCATE (orb_present, orb_radius, pair_radius)
    1117             : 
    1118             :       ! a dbcsr_dist
    1119         818 :       ALLOCATE (dbcsr_dist_sub)
    1120         818 :       CALL cp_dbcsr_dist2d_to_dist(distribution_2d_sub, dbcsr_dist_sub)
    1121             : 
    1122             :       ! build a dbcsr matrix the hard way
    1123         818 :       natom = SIZE(particle_set)
    1124        2454 :       ALLOCATE (row_blk_sizes(natom))
    1125         818 :       IF (my_do_ri_aux_basis) THEN
    1126             : 
    1127         846 :          ALLOCATE (basis_set_ri_aux(nkind))
    1128         170 :          CALL basis_set_list_setup(basis_set_ri_aux, "RI_AUX", qs_kind_set)
    1129         170 :          CALL get_particle_set(particle_set, qs_kind_set, nsgf=row_blk_sizes, basis=basis_set_ri_aux)
    1130         170 :          DEALLOCATE (basis_set_ri_aux)
    1131             : 
    1132         648 :       ELSE IF (my_do_mixed_basis) THEN
    1133             : 
    1134           0 :          ALLOCATE (basis_set_ri_aux(nkind))
    1135           0 :          CALL basis_set_list_setup(basis_set_ri_aux, "RI_AUX", qs_kind_set)
    1136           0 :          CALL get_particle_set(particle_set, qs_kind_set, nsgf=row_blk_sizes, basis=basis_set_ri_aux)
    1137           0 :          DEALLOCATE (basis_set_ri_aux)
    1138             : 
    1139           0 :          ALLOCATE (col_blk_sizes(natom))
    1140             : 
    1141           0 :          CALL get_particle_set(particle_set, qs_kind_set, nsgf=col_blk_sizes)
    1142           0 :          col_blk_sizes = col_blk_sizes*group_size_prim
    1143             : 
    1144             :       ELSE
    1145         648 :          CALL get_particle_set(particle_set, qs_kind_set, nsgf=row_blk_sizes)
    1146             :       END IF
    1147             : 
    1148             :       NULLIFY (mat_munu%matrix)
    1149         818 :       ALLOCATE (mat_munu%matrix)
    1150             : 
    1151         818 :       IF (my_do_ri_aux_basis) THEN
    1152             : 
    1153             :          CALL dbcsr_create(matrix=mat_munu%matrix, &
    1154             :                            name="(ai|munu)", &
    1155             :                            dist=dbcsr_dist_sub, matrix_type=my_dbcsr_sym_type, &
    1156             :                            row_blk_size=row_blk_sizes, col_blk_size=row_blk_sizes, &
    1157         170 :                            nze=0)
    1158             : 
    1159         648 :       ELSE IF (my_do_mixed_basis) THEN
    1160             : 
    1161             :          CALL dbcsr_create(matrix=mat_munu%matrix, &
    1162             :                            name="(ai|munu)", &
    1163             :                            dist=dbcsr_dist_sub, matrix_type=my_dbcsr_sym_type, &
    1164             :                            row_blk_size=row_blk_sizes, col_blk_size=col_blk_sizes, &
    1165           0 :                            nze=0)
    1166             : 
    1167             :       ELSE
    1168             : 
    1169             :          CALL dbcsr_create(matrix=mat_munu%matrix, &
    1170             :                            name="(ai|munu)", &
    1171             :                            dist=dbcsr_dist_sub, matrix_type=my_dbcsr_sym_type, &
    1172             :                            row_blk_size=row_blk_sizes, col_blk_size=row_blk_sizes, &
    1173         648 :                            nze=0)
    1174             : 
    1175         648 :          IF (my_do_alloc_blocks_from_nbl) THEN
    1176             : 
    1177         496 :             IF (PRESENT(sab_orb_sub)) THEN
    1178         496 :                CALL cp_dbcsr_alloc_block_from_nbl(mat_munu%matrix, sab_orb_sub)
    1179             :             ELSE
    1180           0 :                CALL cp_dbcsr_alloc_block_from_nbl(mat_munu%matrix, my_sab_orb_sub)
    1181             :             END IF
    1182             : 
    1183             :          END IF
    1184             : 
    1185             :       END IF
    1186             : 
    1187         818 :       DEALLOCATE (row_blk_sizes)
    1188             : 
    1189         818 :       IF (my_do_mixed_basis) THEN
    1190           0 :          DEALLOCATE (col_blk_sizes)
    1191             :       END IF
    1192             : 
    1193         818 :       CALL dbcsr_distribution_release(dbcsr_dist_sub)
    1194         818 :       DEALLOCATE (dbcsr_dist_sub)
    1195             : 
    1196         818 :       CALL distribution_2d_release(distribution_2d_sub)
    1197             : 
    1198         818 :       CALL distribution_1d_release(local_particles_sub)
    1199         818 :       CALL distribution_1d_release(local_molecules_sub)
    1200             : 
    1201         818 :       IF (.NOT. PRESENT(sab_orb_sub)) THEN
    1202         188 :          CALL release_neighbor_list_sets(my_sab_orb_sub)
    1203             :       END IF
    1204             : 
    1205         818 :       CALL timestop(handle)
    1206             : 
    1207        2454 :    END SUBROUTINE create_mat_munu
    1208             : 
    1209             : ! **************************************************************************************************
    1210             : !> \brief ...
    1211             : !> \param mat_P_global ...
    1212             : !> \param qs_env ...
    1213             : !> \param mp2_env ...
    1214             : !> \param para_env ...
    1215             : ! **************************************************************************************************
    1216         134 :    SUBROUTINE create_matrix_P(mat_P_global, qs_env, mp2_env, para_env)
    1217             : 
    1218             :       TYPE(dbcsr_p_type), INTENT(OUT)                    :: mat_P_global
    1219             :       TYPE(qs_environment_type), POINTER                 :: qs_env
    1220             :       TYPE(mp2_type)                                     :: mp2_env
    1221             :       TYPE(mp_para_env_type), POINTER                    :: para_env
    1222             : 
    1223             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'create_matrix_P'
    1224             : 
    1225             :       INTEGER                                            :: blacs_grid_layout, handle
    1226             :       LOGICAL                                            :: blacs_repeatable
    1227             :       TYPE(cp_blacs_env_type), POINTER                   :: blacs_env_global
    1228             : 
    1229         134 :       CALL timeset(routineN, handle)
    1230             : 
    1231         134 :       blacs_grid_layout = BLACS_GRID_SQUARE
    1232         134 :       blacs_repeatable = .TRUE.
    1233         134 :       NULLIFY (blacs_env_global)
    1234             :       CALL cp_blacs_env_create(blacs_env_global, para_env, &
    1235             :                                blacs_grid_layout, &
    1236         134 :                                blacs_repeatable)
    1237             : 
    1238             :       CALL create_mat_munu(mat_P_global, qs_env, mp2_env%mp2_gpw%eps_grid, &
    1239             :                            blacs_env_global, do_ri_aux_basis=.TRUE., &
    1240         134 :                            do_kpoints=mp2_env%ri_rpa_im_time%do_im_time_kpoints)
    1241             : 
    1242         134 :       CALL dbcsr_reserve_all_blocks(mat_P_global%matrix)
    1243         134 :       CALL cp_blacs_env_release(blacs_env_global)
    1244             : 
    1245         134 :       CALL timestop(handle)
    1246             : 
    1247         134 :    END SUBROUTINE
    1248             : 
    1249             : ! **************************************************************************************************
    1250             : !> \brief ...
    1251             : !> \param dft_control ...
    1252             : !> \param eps_pgf_orb_old ...
    1253             : !> \param eps_rho_rspace_old ...
    1254             : !> \param eps_gvg_rspace_old ...
    1255             : ! **************************************************************************************************
    1256         606 :    PURE SUBROUTINE get_eps_old(dft_control, eps_pgf_orb_old, eps_rho_rspace_old, eps_gvg_rspace_old)
    1257             : 
    1258             :       TYPE(dft_control_type), INTENT(INOUT)              :: dft_control
    1259             :       REAL(kind=dp), INTENT(OUT)                         :: eps_pgf_orb_old, eps_rho_rspace_old, &
    1260             :                                                             eps_gvg_rspace_old
    1261             : 
    1262             :       ! re-init the radii to be able to generate pair lists with MP2-appropriate screening
    1263         606 :       eps_pgf_orb_old = dft_control%qs_control%eps_pgf_orb
    1264         606 :       eps_rho_rspace_old = dft_control%qs_control%eps_rho_rspace
    1265         606 :       eps_gvg_rspace_old = dft_control%qs_control%eps_gvg_rspace
    1266             : 
    1267         606 :    END SUBROUTINE get_eps_old
    1268             : 
    1269             : END MODULE mp2_gpw

Generated by: LCOV version 1.15