From 5f286204b77eb9ddeed5f03bc49797977d73a378 Mon Sep 17 00:00:00 2001
From: Daniel Arndt <daniel.arndt@iwr.uni-heidelberg.de>
Date: Sat, 28 Apr 2018 14:18:54 +0200
Subject: [PATCH] Add Utilities::MPI::MPI_Comm_create_group

---
 include/deal.II/base/mpi.h | 34 ++++++++++++++++
 source/base/mpi.cc         | 79 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 113 insertions(+)

diff --git a/include/deal.II/base/mpi.h b/include/deal.II/base/mpi.h
index 58e0878a39..4d50ccb9d2 100644
--- a/include/deal.II/base/mpi.h
+++ b/include/deal.II/base/mpi.h
@@ -125,6 +125,40 @@ namespace Utilities
      */
     MPI_Comm duplicate_communicator (const MPI_Comm &mpi_communicator);
 
+    /**
+     * If @comm is an intracommunicator, this function returns a new
+     * communicator @p newcomm with communication group defined by the
+     * @p group argument. The function is only collective over the group of
+     * processes that actually want to create the communicator, i.e., that
+     * are named in the @p group argument. If multiple threads at a given
+     * process perform concurrent create_group() operations, the user must
+     * distinguish these operations by providing different @p tag or @p comm
+     * arguments.
+     *
+     * This function was introduced in the MPI-3.0 standard. If available,
+     * the corresponding function in the provided MPI implementation is used.
+     * Otherwise, the implementation follows the one described in the
+     * following publication:
+     * @code{.bib}
+     * @inproceedings{dinan2011noncollective,
+     *  title={Noncollective communicator creation in MPI},
+     *  author={Dinan, James and Krishnamoorthy, Sriram and Balaji, Pavan and
+     *          Hammond, Jeff R and Krishnan, Manojkumar and Tipparaju, Vinod
+     *          and Vishnu, Abhinav},
+     *  booktitle={European MPI Users' Group Meeting},
+     *  pages={282--291},
+     *  year={2011},
+     *  organization={Springer}
+     * }
+     * @endcode
+     */
+#ifdef DEAL_II_WITH_MPI
+    int create_group(const MPI_Comm  &comm,
+                     const MPI_Group &group,
+                     const int        tag,
+                     MPI_Comm        *new_comm);
+#endif
+
     /**
      * Return the sum over all processors of the value @p t. This function is
      * collective over all processors given in the
diff --git a/source/base/mpi.cc b/source/base/mpi.cc
index a5ba1c84d8..8ba5697412 100644
--- a/source/base/mpi.cc
+++ b/source/base/mpi.cc
@@ -91,6 +91,85 @@ namespace Utilities
     }
 
 
+
+    int create_group(const MPI_Comm  &comm,
+                     const MPI_Group &group,
+                     const int        tag,
+                     MPI_Comm        *new_comm)
+    {
+#if DEAL_II_MPI_VERSION_GTE(3, 0)
+      return MPI_Comm_create_group(comm, group, tag, new_comm);
+#else
+      int rank;
+      int ierr = MPI_Comm_rank(comm, &rank);
+      AssertThrowMPI(ierr);
+
+      int grp_rank;
+      ierr = MPI_Group_rank(group, &grp_rank);
+      AssertThrowMPI(ierr);
+      if (grp_rank == MPI_UNDEFINED)
+        {
+          *new_comm = MPI_COMM_NULL;
+          return MPI_SUCCESS;
+        }
+
+      int grp_size;
+      ierr = MPI_Group_size(group, &grp_size);
+      AssertThrowMPI(ierr);
+
+      ierr = MPI_Comm_dup(MPI_COMM_SELF, new_comm);
+      AssertThrowMPI(ierr);
+
+      MPI_Group parent_grp;
+      ierr = MPI_Comm_group(comm, &parent_grp);
+      AssertThrowMPI(ierr);
+
+      std::vector<int> pids(grp_size);
+      std::vector<int> grp_pids(grp_size);
+      std::iota(grp_pids.begin(), grp_pids.end(), 0);
+      ierr = MPI_Group_translate_ranks(group, grp_size, grp_pids.data(), parent_grp, pids.data());
+      AssertThrowMPI(ierr);
+      ierr = MPI_Group_free(&parent_grp);
+      AssertThrowMPI(ierr);
+
+      MPI_Comm comm_old = *new_comm;
+      MPI_Comm ic;
+      for (int merge_sz = 1; merge_sz < grp_size; merge_sz *=2)
+        {
+          const int gid = grp_rank/merge_sz;
+          comm_old = *new_comm;
+          if (gid % 2 == 0)
+            {
+              if ((gid + 1) * merge_sz < grp_size)
+                {
+                  ierr = (MPI_Intercomm_create(*new_comm, 0, comm, pids[(gid + 1) * merge_sz], tag, &ic));
+                  AssertThrowMPI(ierr);
+                  ierr = MPI_Intercomm_merge(ic, 0 /* LOW */, new_comm);
+                  AssertThrowMPI(ierr);
+                }
+            }
+          else
+            {
+              ierr = MPI_Intercomm_create(*new_comm, 0, comm, pids[(gid - 1) * merge_sz], tag, &ic);
+              AssertThrowMPI(ierr);
+              ierr = MPI_Intercomm_merge(ic, 1 /* HIGH */, new_comm);
+              AssertThrowMPI(ierr);
+            }
+          if (*new_comm != comm_old)
+            {
+              ierr = MPI_Comm_free(&ic);
+              AssertThrowMPI(ierr);
+              ierr = MPI_Comm_free(&comm_old);
+              AssertThrowMPI(ierr);
+            }
+        }
+
+      return MPI_SUCCESS;
+#endif
+    }
+
+
+
     std::vector<unsigned int>
     compute_point_to_point_communication_pattern (const MPI_Comm &mpi_comm,
                                                   const std::vector<unsigned int> &destinations)
-- 
2.39.5