Refactor communicator handle, works with sdbg

src/almo_scf.F

@@ -81,7 +81,8 @@ MODULE almo_scf
    USE kinds,                           ONLY: default_path_length,&
                                               dp
    USE mathlib,                         ONLY: binomial
-   USE message_passing,                 ONLY: mp_sum
+   USE message_passing,                 ONLY: mp_comm_type,&
+                                              mp_sum
    USE molecule_types,                  ONLY: get_molecule_set_info,&
                                               molecule_type
    USE mscfg_types,                     ONLY: get_matrix_from_submatrices,&
@@ -1923,10 +1924,8 @@ SUBROUTINE nlmo_compactification(qs_env, almo_scf_env, matrix)
       TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:), &
          INTENT(IN)                                      :: matrix
 
-      INTEGER                                            :: iblock_col, iblock_col_size, iblock_row, &
-                                                            iblock_row_size, icol, irow, ispin, &
-                                                            Ncols, Nrows, nspins, para_group, &
-                                                            unit_nr
+      INTEGER :: iblock_col, iblock_col_size, iblock_row, iblock_row_size, icol, irow, ispin, &
+         Ncols, Nrows, nspins, para_group_handle, unit_nr
       LOGICAL                                            :: element_by_element
       REAL(KIND=dp)                                      :: energy, eps_local, eps_start, &
                                                             max_element, spin_factor
@@ -1935,6 +1934,7 @@ SUBROUTINE nlmo_compactification(qs_env, almo_scf_env, matrix)
       TYPE(cp_logger_type), POINTER                      :: logger
       TYPE(dbcsr_iterator_type)                          :: iter
       TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:)        :: matrix_p_tmp, matrix_t_tmp
+      TYPE(mp_comm_type)                                 :: para_group
 
       ! define the output_unit
       logger => cp_get_default_logger()
@@ -2032,9 +2032,10 @@ SUBROUTINE nlmo_compactification(qs_env, almo_scf_env, matrix)
             CALL dbcsr_finalize(matrix_t_tmp(ispin))
             CALL dbcsr_filter(matrix_t_tmp(ispin), eps_local)
 
-            CALL dbcsr_get_info(matrix_t_tmp(ispin), group=para_group, &
+            CALL dbcsr_get_info(matrix_t_tmp(ispin), group=para_group_handle, &
                                 nfullrows_total=Nrows, &
                                 nfullcols_total=Ncols)
+            CALL para_group%set_handle(para_group_handle)
             CALL mp_sum(retained(ispin), para_group)
 
             !devide by the total no. elements

src/almo_scf_methods.F

@@ -55,6 +55,7 @@ MODULE almo_scf_methods
                                               matrix_sqrt_Newton_Schulz
    USE kinds,                           ONLY: dp
    USE mathlib,                         ONLY: binomial
+   USE message_passing,                 ONLY: mp_comm_type
    USE util,                            ONLY: sort
 #include "./base/base_uses.f90"
 
@@ -3237,23 +3238,25 @@ SUBROUTINE construct_test(matrix_no, dpattern, map, node_of_domain)
       TYPE(dbcsr_type)                                   :: copy1
       TYPE(domain_submatrix_type), ALLOCATABLE, &
          DIMENSION(:)                                    :: subm_nn, subm_no
+      TYPE(mp_comm_type)                                 :: group
 
       CALL timeset(routineN, handle)
 
       ndomains = dbcsr_nblkcols_total(dpattern)
       CALL dbcsr_get_info(dpattern, group=GroupID)
+      CALL group%set_handle(groupid)
 
       ALLOCATE (subm_no(ndomains), subm_nn(ndomains))
       CALL init_submatrices(subm_no)
       CALL init_submatrices(subm_nn)
 
       !CALL dbcsr_print(matrix_nn)
       !CALL construct_submatrices(matrix_nn,subm_nn,dpattern,map,select_row_col)
-      !CALL print_submatrices(subm_nn,GroupID)
+      !CALL print_submatrices(subm_nn,Group)
 
       !CALL dbcsr_print(matrix_no)
       CALL construct_submatrices(matrix_no, subm_no, dpattern, map, node_of_domain, select_row)
-      CALL print_submatrices(subm_no, GroupID)
+      CALL print_submatrices(subm_no, group)
 
       CALL dbcsr_create(copy1, template=matrix_no)
       CALL dbcsr_copy(copy1, matrix_no)

src/almo_scf_optimizer.F

@@ -93,7 +93,8 @@ MODULE almo_scf_optimizer
    USE kinds,                           ONLY: dp
    USE machine,                         ONLY: m_flush,&
                                               m_walltime
-   USE message_passing,                 ONLY: mp_sum
+   USE message_passing,                 ONLY: mp_comm_type,&
+                                              mp_sum
    USE particle_methods,                ONLY: get_particle_set
    USE particle_types,                  ONLY: particle_type
    USE qs_energy_types,                 ONLY: qs_energy_type
@@ -880,7 +881,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, &
       CHARACTER(LEN=20)                                  :: iter_type
       INTEGER :: cg_iteration, dim_op, fixed_line_search_niter, handle, idim0, ielem, ispin, &
          iteration, line_search_iteration, max_iter, my_special_case, ndomains, nmo, nspins, &
-         outer_iteration, outer_max_iter, para_group, prec_type, reim, unit_nr
+         outer_iteration, outer_max_iter, para_group_handle, prec_type, reim, unit_nr
       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: nocc
       LOGICAL :: blissful_neglect, converged, just_started, line_search, normalize_orbitals, &
          optimize_theta, outer_prepare_to_exit, penalty_occ_local, penalty_occ_vol, &
@@ -902,6 +903,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, &
          STsiginv_0, tempNOcc, tempNOcc_1, tempOccOcc
       TYPE(domain_submatrix_type), ALLOCATABLE, &
          DIMENSION(:, :)                                 :: bad_modes_projector_down, domain_r_down
+      TYPE(mp_comm_type)                                 :: para_group
 
       CALL timeset(routineN, handle)
 
@@ -1315,7 +1317,8 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, &
                   ALLOCATE (z2(nmo))
                   ALLOCATE (reim_diag(nmo))
 
-                  CALL dbcsr_get_info(tempOccOcc(ispin), group=para_group)
+                  CALL dbcsr_get_info(tempOccOcc(ispin), group=para_group_handle)
+                  CALL para_group%set_handle(para_group_handle)
 
                   DO idim0 = 1, SIZE(op_sm_set_qs, 2) ! this loop is over miller ind
 
@@ -2020,7 +2023,7 @@ SUBROUTINE almo_scf_construct_nlmos(qs_env, optimizer, &
       CHARACTER(LEN=30)                                  :: iter_type, print_string
       INTEGER :: cg_iteration, dim_op, handle, iatom, idim0, isgf, ispin, iteration, &
          line_search_iteration, linear_search_type, max_iter, natom, ncol, nspins, &
-         outer_iteration, outer_max_iter, para_group, prec_type, reim, unit_nr
+         outer_iteration, outer_max_iter, para_group_handle, prec_type, reim, unit_nr
       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: first_sgf, last_sgf, nocc, nsgf
       LOGICAL                                            :: converged, d_bfgs, just_started, l_bfgs, &
                                                             line_search, outer_prepare_to_exit, &
@@ -2043,6 +2046,7 @@ SUBROUTINE almo_scf_construct_nlmos(qs_env, optimizer, &
          tempOccOcc2, tempOccOcc3
       TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:, :, :)  :: m_B0
       TYPE(lbfgs_history_type)                           :: nlmo_lbfgs_history
+      TYPE(mp_comm_type)                                 :: para_group
       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
 
@@ -2413,7 +2417,8 @@ SUBROUTINE almo_scf_construct_nlmos(qs_env, optimizer, &
 
             DO ispin = 1, nspins
 
-               CALL dbcsr_get_info(m_sig_sqrti_ii(ispin), group=para_group)
+               CALL dbcsr_get_info(m_sig_sqrti_ii(ispin), group=para_group_handle)
+               CALL para_group%set_handle(para_group_handle)
 
                ! compute diagonal (a^t.sigma0.a)^(-1/2)
                CALL dbcsr_multiply("N", "N", 1.0_dp, &
@@ -6474,10 +6479,12 @@ SUBROUTINE compute_obj_nlmos(localization_obj_function_ispin, penalty_func_ispin
 
       CHARACTER(len=*), PARAMETER                        :: routineN = 'compute_obj_nlmos'
 
-      INTEGER                                            :: handle, idim0, ielem, para_group, reim
+      INTEGER                                            :: handle, idim0, ielem, para_group_handle, &
+                                                            reim
       REAL(KIND=dp)                                      :: det1, fval
       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: reim_diag, z2
       TYPE(dbcsr_type)                                   :: tempNOcc1, tempOccOcc1, tempOccOcc2
+      TYPE(mp_comm_type)                                 :: para_group
 
       CALL timeset(routineN, handle)
 
@@ -6496,7 +6503,8 @@ SUBROUTINE compute_obj_nlmos(localization_obj_function_ispin, penalty_func_ispin
       ALLOCATE (z2(nocc))
       ALLOCATE (reim_diag(nocc))
 
-      CALL dbcsr_get_info(tempOccOcc2, group=para_group)
+      CALL dbcsr_get_info(tempOccOcc2, group=para_group_handle)
+      CALL para_group%set_handle(para_group_handle)
 
       DO idim0 = 1, SIZE(m_B0, 2) ! this loop is over miller ind
 

src/almo_scf_qs.F

@@ -50,7 +50,8 @@ MODULE almo_scf_qs
                                               do_bondparm_covalent,&
                                               do_bondparm_vdw
    USE kinds,                           ONLY: dp
-   USE message_passing,                 ONLY: mp_allgather
+   USE message_passing,                 ONLY: mp_allgather,&
+                                              mp_comm_type
    USE molecule_types,                  ONLY: get_molecule_set_info,&
                                               molecule_type
    USE particle_types,                  ONLY: particle_type
@@ -871,6 +872,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env)
       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: matrix_s
       TYPE(dbcsr_type)                                   :: matrix_s_sym
       TYPE(molecule_type), DIMENSION(:), POINTER         :: molecule_set
+      TYPE(mp_comm_type)                                 :: group
       TYPE(neighbor_list_iterator_p_type), &
          DIMENSION(:), POINTER                           :: nl_iterator, nl_iterator2
       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
@@ -944,6 +946,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env)
 
       CALL dbcsr_get_info(almo_scf_env%quench_t(ispin), distribution=dist)
       CALL dbcsr_distribution_get(dist, numnodes=nNodes, group=GroupID, mynode=mynode)
+      CALL group%set_handle(groupid)
 
       ! create global atom neighbor list from the local lists
       ! first, calculate number of local pairs
@@ -977,7 +980,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env)
 
       ! third, communicate local length to the other nodes
       ALLOCATE (list_length_cpu(nNodes), list_offset_cpu(nNodes))
-      CALL mp_allgather(2*local_list_length, list_length_cpu, GroupID)
+      CALL mp_allgather(2*local_list_length, list_length_cpu, group)
 
       ! fourth, create a global list
       list_offset_cpu(1) = 0
@@ -990,7 +993,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env)
       ! fifth, communicate all list data
       ALLOCATE (global_list(global_list_length))
       CALL mp_allgather(local_list, global_list, &
-                        list_length_cpu, list_offset_cpu, GroupID)
+                        list_length_cpu, list_offset_cpu, group)
       DEALLOCATE (list_length_cpu, list_offset_cpu)
       DEALLOCATE (local_list)
 
@@ -1393,7 +1396,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env)
 
       ! first, communicate map sizes on the other nodes
       ALLOCATE (domain_entries_cpu(nNodes), offset_for_cpu(nNodes))
-      CALL mp_allgather(2*domain_map_local_entries, domain_entries_cpu, GroupID)
+      CALL mp_allgather(2*domain_map_local_entries, domain_entries_cpu, group)
 
       ! second, create
       offset_for_cpu(1) = 0
@@ -1411,7 +1414,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env)
          domain_map_local(2*ientry) = almo_scf_env%domain_map(ispin)%pairs(ientry, 2)
       END DO
       CALL mp_allgather(domain_map_local, domain_map_global, &
-                        domain_entries_cpu, offset_for_cpu, GroupID)
+                        domain_entries_cpu, offset_for_cpu, group)
       DEALLOCATE (domain_entries_cpu, offset_for_cpu)
       DEALLOCATE (domain_map_local)
 

src/arnoldi/arnoldi_api.F

@@ -41,7 +41,8 @@ MODULE arnoldi_api
                                               create_replicated_row_vec_from_matrix,&
                                               dbcsr_matrix_colvec_multiply
    USE kinds,                           ONLY: dp
-   USE message_passing,                 ONLY: mp_sum
+   USE message_passing,                 ONLY: mp_comm_type,&
+                                              mp_sum
 #include "../base/base_uses.f90"
 
    IMPLICIT NONE
@@ -309,7 +310,7 @@ SUBROUTINE arnoldi_conjugate_gradient(matrix_a, vec_x, matrix_p, converged, thre
 
       CHARACTER(LEN=*), PARAMETER :: routineN = 'arnoldi_conjugate_gradient'
 
-      INTEGER                                            :: handle, i, j, mpgrp, nb, nloc, no
+      INTEGER                                            :: handle, i, j, nb, nloc, no
       INTEGER, DIMENSION(:), POINTER                     :: rb_offset, rb_size
       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: xvec
       TYPE(arnoldi_control_type), POINTER                :: control
@@ -368,8 +369,7 @@ SUBROUTINE arnoldi_conjugate_gradient(matrix_a, vec_x, matrix_p, converged, thre
       END DO
       CALL dbcsr_iterator_stop(dbcsr_iter)
       control => get_control(my_arnoldi)
-      mpgrp = control%mp_group
-      CALL mp_sum(vec_x, mpgrp)
+      CALL mp_sum(vec_x, control%mp_group)
       ! Deallocated the work vectors
       CALL dbcsr_release(x)
       CALL dbcsr_release(vectors%input_vec)
@@ -395,11 +395,12 @@ SUBROUTINE conjugate_gradient(arnoldi_data, arnoldi_matrices, vectors)
       TYPE(dbcsr_p_type), DIMENSION(:)                   :: arnoldi_matrices
       TYPE(m_x_v_vectors_type)                           :: vectors
 
-      INTEGER                                            :: iter, mpgrp, pcgrp
+      INTEGER                                            :: iter
       REAL(KIND=dp)                                      :: alpha, beta, pap, rsnew, rsold
       TYPE(arnoldi_control_type), POINTER                :: control
       TYPE(dbcsr_type)                                   :: apvec, pvec, rvec, zvec
       TYPE(dbcsr_type), POINTER                          :: amat, pmat, xvec
+      TYPE(mp_comm_type)                                 :: mpgrp, pcgrp
 
       control => get_control(arnoldi_data)
       control%converged = .FALSE.
@@ -507,7 +508,7 @@ END SUBROUTINE conjugate_gradient
 ! **************************************************************************************************
    FUNCTION vec_dot_vec(avec, bvec, mpgrp) RESULT(adotb)
       TYPE(dbcsr_type)                                   :: avec, bvec
-      INTEGER, INTENT(IN)                                :: mpgrp
+      TYPE(mp_comm_type), INTENT(IN)                     :: mpgrp
       REAL(KIND=dp)                                      :: adotb
 
       INTEGER                                            :: i, j

src/arnoldi/arnoldi_data_methods.F

@@ -107,6 +107,7 @@ SUBROUTINE setup_arnoldi_control(arnoldi_data, matrix, max_iter, threshold, sele
       INTEGER                                            :: selection_crit, nval_request, nrestarts
       LOGICAL                                            :: generalized_ev, iram
 
+      INTEGER :: prow_handle, pcol_handle, group_handle
       LOGICAL                                            :: subgroups_defined
       TYPE(arnoldi_control_type), POINTER                :: control
       TYPE(dbcsr_distribution_type)                      :: distri
@@ -116,11 +117,15 @@ SUBROUTINE setup_arnoldi_control(arnoldi_data, matrix, max_iter, threshold, sele
       CALL dbcsr_get_info(matrix=matrix(1)%matrix, distribution=distri)
       CALL dbcsr_mp_grid_setup(distri)
       CALL dbcsr_distribution_get(distri, &
-                                  group=control%mp_group, &
+                                  group=group_handle, &
                                   mynode=control%myproc, &
                                   subgroups_defined=subgroups_defined, &
-                                  prow_group=control%prow_group, &
-                                  pcol_group=control%pcol_group)
+                                  prow_group=prow_handle, &
+                                  pcol_group=pcol_handle)
+
+      CALL control%mp_group%set_handle(group_handle)
+      CALL control%prow_group%set_handle(prow_handle)
+      CALL control%pcol_group%set_handle(pcol_handle)
 
       IF (.NOT. subgroups_defined) &
          CPABORT("arnoldi only with subgroups")