diff --git a/.gitignore b/.gitignore index 2bcb475..17dc080 100644 --- a/.gitignore +++ b/.gitignore @@ -22,4 +22,10 @@ cmake-build-*/ /build # Documentation is generated by the build system -/documentation \ No newline at end of file +/documentation + +# Build Artifact +*.dylib +*.a +*.mod +*.o \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 514fbba..ea958bc 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -3,8 +3,8 @@ 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 - src/utilities/internal_utils.F90 PARENT_SCOPE ) diff --git a/src/bindings/mpi_bindings.F90 b/src/bindings/mpi_bindings.F90 index b5b3138..e1c71eb 100644 --- a/src/bindings/mpi_bindings.F90 +++ b/src/bindings/mpi_bindings.F90 @@ -20,6 +20,7 @@ module mpi_bindings MPI_COMM_SIZE, & MPI_GROUP_SIZE, & MPI_INITIALIZED, & + MPI_REDUCE, & ! Data types MPI_COMM_WORLD, & @@ -27,6 +28,7 @@ module mpi_bindings MPI_THREAD_FUNNELED, & MPI_THREAD_SERIALIZED, & MPI_THREAD_MULTIPLE, & + MPI_INTEGER, & ! Derived types MPI_Comm, & @@ -59,13 +61,15 @@ module mpi_bindings MPI_COMM_SIZE, & MPI_GROUP_SIZE, & MPI_INITIALIZED, & + 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 diff --git a/src/routines/mpilib20_reduce.F90 b/src/routines/mpilib20_reduce.F90 new file mode 100644 index 0000000..8779e76 --- /dev/null +++ b/src/routines/mpilib20_reduce.F90 @@ -0,0 +1,94 @@ +!> Wrapping of the MPI_REDUCE methods +!> TODOs +!> Up to rank 3 arrays +!> Remaining types (parametized derived types for precisions?) +!> real(sp), real(dp), real(qp) +!> complex +!> Overload for MPI_IN_PLACE - optional logical could work +!> Testing +!> Refactor when root_id moved to mpi_env_type +module mpilib20_reduce_m + + use mpilib20_init_finalise, only : mpi_env_type, root_id + use mpi_bindings, only : MPI_REDUCE, MPI_Op, & + MPI_INTEGER + + implicit none + + private + + interface mpilib20_reduce + module procedure mpilib20_reduce_int_scalar + module procedure mpilib20_reduce_int_vec + end interface + + public :: mpilib20_reduce + +contains + + + !> Reduces values on all processes to a single value + !> on process defined by process_id + !> TODO usage examples + subroutine mpilib20_reduce_int_scalar(sendbuf, recvbuf, & + operation, mpi_env, & + process_id) + !> Variable containing set to be sent + type(MPI_INTEGER), intent(in) :: sendbuf + !> Variable to receive reduced set + type(MPI_INTEGER), intent(out) :: recvbuf + !> MPI Operation + type(MPI_Op), intent(in) :: operation + !> Instance of the MPI environment + type(mpi_env_type), intent(out) :: mpi_env + !> Rank of the process to receive the reduced set (override default) + integer, optional, intent(in) :: process_id + integer :: process + + !> Overide root process if passed + if (present(process_id)) then + process = process_id + else + process = root_id + end if + + call MPI_REDUCE(sendbuf, recvbuf, 1, MPI_INTEGER, operation, process, & + mpi_env%comm, mpi_env%ierror) + + end subroutine mpilib20_reduce_int_scalar + + + !> Reduces values on all processes to a single value + !> on process defined by process_id + !> TODO usage examples + subroutine mpilib20_reduce_int_vec(sendbuf, recvbuf, & + operation, mpi_env, & + process_id) + !> Variable containing set to be sent + type(MPI_INTEGER), intent(in) :: sendbuf(:) + !> Variable to receive reduced set + type(MPI_INTEGER), 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) :: process_id + integer :: process + + !> Overide root process if passed + if (present(process_id)) then + process = process_id + else + process = root_id + end if + + call assert(size(sendbuf) == size(recvbuf), "size(sendbuf) /= size(recvbuf)") + + call MPI_REDUCE(sendbuf, recvbuf, size(recvbuf), MPI_INTEGER, operation, process, & + mpi_env%comm, mpi_env%ierror) + + end subroutine mpilib20_reduce_int_vec + + +end module mpilib20_reduce_m