From ced4c05400d3c3b96f8037366163748cd7ab406d Mon Sep 17 00:00:00 2001
From: Paul Romano <paul.k.romano@gmail.com>
Date: Fri, 26 Jan 2018 13:24:10 -0600
Subject: [PATCH] Use contiguous derived MPI type to avoid broadcasting counts
 > 2**31 - 1

---
 CMakeLists.txt     |  5 ++++-
 src/simulation.F90 | 21 ++++++++++++++++++---
 2 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/CMakeLists.txt b/CMakeLists.txt
index 51bdcc4d9..8104b5fb1 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -50,6 +50,9 @@ if($ENV{FC} MATCHES "(mpi[^/]*|ftn)$")
   message("-- Detected MPI wrapper: $ENV{FC}")
   add_definitions(-DMPI)
   set(MPI_ENABLED TRUE)
+
+  # Get directory containing MPI wrapper
+  get_filename_component(MPI_DIR $ENV{FC} DIRECTORY)
 endif()
 
 # Check for Fortran 2008 MPI interface
@@ -552,7 +555,7 @@ foreach(test ${TESTS})
       add_test(NAME ${TEST_NAME}
         WORKING_DIRECTORY ${TEST_PATH}
         COMMAND ${PYTHON_EXECUTABLE} ${TEST_NAME} --exe $<TARGET_FILE:openmc>
-        --mpi_exec $ENV{MPI_DIR}/bin/mpiexec)
+        --mpi_exec ${MPI_DIR}/mpiexec)
     else()
       # Perform a serial test
       add_test(NAME ${TEST_NAME}
diff --git a/src/simulation.F90 b/src/simulation.F90
index ef29e7832..061ca2fda 100644
--- a/src/simulation.F90
+++ b/src/simulation.F90
@@ -472,8 +472,14 @@ contains
 #ifdef MPI
     integer    :: n       ! size of arrays
     integer    :: mpi_err  ! MPI error code
+    integer    :: count_per_filter ! number of result values for one filter bin
     integer(8) :: temp
     real(8)    :: tempr(3) ! temporary array for communication
+#ifdef MPIF08
+    type(MPI_Datatype) :: result_block
+#else
+    integer :: result_block
+#endif
 #endif
 
     ! Skip if simulation was never run
@@ -498,9 +504,18 @@ contains
     ! Broadcast tally results so that each process has access to results
     if (allocated(tallies)) then
       do i = 1, size(tallies)
-        n = size(tallies(i) % obj % results)
-        call MPI_BCAST(tallies(i) % obj % results, n, MPI_DOUBLE, 0, &
-             mpi_intracomm, mpi_err)
+        associate (results => tallies(i) % obj % results)
+          ! Create a new datatype that consists of all values for a given filter
+          ! bin and then use that to broadcast. This is done to minimize the
+          ! chance of the 'count' argument of MPI_BCAST exceeding 2**31
+          n = size(results, 3)
+          count_per_filter = size(results, 1) * size(results, 2)
+          call MPI_TYPE_CONTIGUOUS(count_per_filter, MPI_DOUBLE, &
+               result_block, mpi_err)
+          call MPI_TYPE_COMMIT(result_block, mpi_err)
+          call MPI_BCAST(results, n, result_block, 0, mpi_intracomm, mpi_err)
+          call MPI_TYPE_FREE(result_block, mpi_err)
+        end associate
       end do
     end if