api/reduce

.gitignore

@@ -3,4 +3,13 @@
 
 # IntelliJ
 .idea/
-cmake-build-*/
+cmake-build-*/
+
+# Build Dirs
+build/
+
+# Build Artifact
+*.dylib
+*.a
+*.mod
+*.o

src/CMakeLists.txt

@@ -4,6 +4,7 @@ include_directories("${CMAKE_SOURCE_DIR}/src")
 set(SOURCE_CODE
    src/mpilib20.F90
    src/routines/mpilib20_init_finalise.F90
+   src/routines/mpilib20_reduce.F90
    src/bindings/mpi_bindings.F90
    src/errors_warnings/asserts.F90 
    PARENT_SCOPE

src/bindings/mpi_bindings.F90

@@ -19,13 +19,15 @@ module mpi_bindings
             MPI_FINALIZE,    &
             MPI_COMM_SIZE,   &
             MPI_GROUP_SIZE,  &
+            MPI_REDUCE,      &
 
             ! Data types  
             MPI_COMM_WORLD,        &
             MPI_THREAD_SINGLE,     &
             MPI_THREAD_FUNNELED,   &
             MPI_THREAD_SERIALIZED, &
             MPI_THREAD_MULTIPLE,   &
+            MPI_INTEGER,           &
 
             ! Derived types 
             MPI_Comm,          &
@@ -57,13 +59,15 @@ module mpi_bindings
              MPI_FINALIZE,    &
              MPI_COMM_SIZE,   &
              MPI_GROUP_SIZE,  &
+             MPI_REDUCE,      &
 
              ! Data types  
-             MPI_COMM_WORLD, &
-             MPI_THREAD_SINGLE, &
-             MPI_THREAD_FUNNELED, &
+             MPI_COMM_WORLD,        &
+             MPI_THREAD_SINGLE,     &
+             MPI_THREAD_FUNNELED,   &
              MPI_THREAD_SERIALIZED, &
-             MPI_THREAD_MULTIPLE
+             MPI_THREAD_MULTIPLE,   &
+            MPI_INTEGER
 
         implicit none
         public 

src/routines/generic_templates.md

@@ -0,0 +1,23 @@
+# Generic Subroutine Templates
+Store templates for the most generic form of a subroutine to be overloaded. Allowing rapid replication.
+
+## MPI_REDUCE
+```fortran
+!> MPI_REDUCE WRAPPER: INTEGER
+    subroutine mpilib20_reduce_type(sendbuf, recvbuf, op, root, mpi_env)
+        use mpi_bindings, only : MPI_REDUCE, MPI_Op, &
+            MPI_TYPE
+        !> Variable containing set to be sent
+        type(MPI_TYPE),          intent(in)      :: sendbuf
+        !> Variable to receive reduced set
+        type(MPI_TYPE),          intent(inout)   :: recvbuf
+        !> MPI Operation
+        type(MPI_Op),       intent(in)      :: op
+        !> Rank of the process to receive the reduced set
+        integer,            intent(in)      :: root
+        !> Instance of the MPI environment
+        type(mpi_env_type), intent(inout)   :: mpi_env
+
+        call MPI_REDUCE(sendbuf, recvbuf, 1, MPI_TYPE, op, root, mpi_env%comm, mpi_env%ierror)
+    end subroutine mpilib20_reduce_type
+````

src/routines/mpilib20_reduce.F90

@@ -0,0 +1,83 @@
+!> Wrapping of the MPI_REDUCE methods
+!> TODOs
+!> Unravel how MPI_Datatype operates
+!> Overload for MPI_IN_PLACE?
+!> Testing
+module mpilib20_reduce_m
+
+    use mpilib20_init_finalise, only : mpi_env_type
+
+    implicit none
+
+    private
+
+    interface mpilib20_reduce
+        module procedure mpilib20_reduce_int_scalar
+        module procedure mpilib20_reduce_int_vec
+    end interface
+
+    public :: mpilib20_REDUCE
+
+contains
+
+    !> MPI_REDUCE WRAPPER: INTEGER
+    subroutine mpilib20_reduce_int_scalar(sendbuf, recvbuf, operation, mpi_env, root)
+        use mpi_bindings, only : MPI_REDUCE, MPI_Op, &
+            MPI_Datatype, MPI_INTEGER
+        use mpilib20_init_finalise, only : root_id
+        !> Variable containing set to be sent
+        type(MPI_Datatype),          intent(in)      :: sendbuf
+        !> Variable to receive reduced set
+        type(MPI_Datatype),          intent(inout)   :: recvbuf
+        !> MPI Operation
+        type(MPI_Op),                intent(in)      :: operation
+        !> Instance of the MPI environment
+        type(mpi_env_type),          intent(inout)   :: mpi_env
+        !> Rank of the process to receive the reduced set (override default)
+        integer, optional,           intent(in)      :: root
+        integer                                      :: use_root
+
+        !> Overide root process if passed
+        if (present(root)) then
+            use_root = root
+        else
+            use_root = root_id
+        end if
+
+        call MPI_REDUCE(sendbuf, recvbuf, 1, MPI_INTEGER, operation, use_root, mpi_env%comm, mpi_env%ierror)
+
+    end subroutine mpilib20_reduce_int_scalar
+
+    !> MPI_REDUCE WRAPPER: INTEGER(:)
+    !> Rank 1 arrays don't require flattening
+    subroutine mpilib20_reduce_int_vec(sendbuf, recvbuf, operation, mpi_env, root)
+        use mpi_bindings, only : MPI_REDUCE, MPI_Op, &
+            MPI_Datatype, MPI_INTEGER
+        use mpilib20_init_finalise, only : root_id
+        !> Variable containing set to be sent
+        type(MPI_Datatype),         intent(in)      :: sendbuf(:)
+        !> Variable to receive reduced set
+        type(MPI_Datatype),         intent(inout)   :: recvbuf(:)
+        !> MPI Operation
+        type(MPI_Op),               intent(in)      :: operation
+        !> Instance of the MPI environment
+        type(mpi_env_type),         intent(inout)   :: mpi_env
+        !> Rank of the process to receive the reduced set (override default)
+        integer, optional,          intent(in)      :: root
+        integer                                     :: count
+        integer                                     :: use_root
+
+        !> Overide root process if passed
+        if (present(root)) then
+            use_root = root
+        else
+            use_root = root_id
+        end if
+        !> Element count based-on receiving buffer size
+        count = size(recvbuf)
+
+        call MPI_REDUCE(sendbuf, recvbuf, count, MPI_INTEGER, operation, root, mpi_env%comm, mpi_env%ierror)
+
+    end subroutine mpilib20_reduce_int_vec
+
+end module mpilib20_reduce_m