diff --git a/CHANGELOG.rst b/CHANGELOG.rst index a773e3f..f371905 100644 --- a/CHANGELOG.rst +++ b/CHANGELOG.rst @@ -4,6 +4,22 @@ Change Log Notable project changes in various releases. + +1.5 +=== + +Added +----- + +* mpifx_win allows allocations with 64 bit allocation size parameter + + +Changed +------- + +* mpifx_win is fully standard conforming now (using the F08 MPI-interface) + + 1.4 === diff --git a/README.rst b/README.rst index c6119e1..43540f4 100644 --- a/README.rst +++ b/README.rst @@ -3,7 +3,7 @@ MpiFx - Modern Fortran Interface for MPI **************************************** The open source library `MpiFx `_ provides -modern Fortran (Fortran 2003) wrappers around routines of the MPI library to +modern Fortran (Fortran 2008) wrappers around routines of the MPI library to make their use as simple as possible. Currently several data distribution routines are covered. @@ -14,14 +14,36 @@ The documentation is included inside the repository, but is also available at Installation ============ +The preferred way of obtaining MpiFx is to install it via the Conda package +management framework using `Miniconda +`_ or `Anaconda +`_. Make sure to add/enable the +``conda-forge`` channel in order to be able to access MpiFx, and ensure that the +``conda-forge`` channel is the first repository to be searched for packages. + +We provide both, OpenMPI and MPICH based build variants, choose the one suiting +your needs. For example, issue :: + + conda install 'mpifx=*=mpi_mpich_*' + +or :: + + conda install 'mpifx=*=mpi_openmpi_*' + +to get the last stable release of MpiFx for the respective MPI framework. + + +Building from source +==================== + Prerequisites ------------- * CMake (version >= 3.16) -* Fortran 2003 compatible Fortran compiler +* Fortran 2008 compatible Fortran compiler -* MPI-library and wrappers for your compiler +* MPI-library and wrappers for your compiler supporting the `mpi_f08` interface * `Fypp preprocessor `_ @@ -40,7 +62,7 @@ You can influence the configuration via CMake-variables, which are listed in or pass them as command line options at the configuration phase, e.g.:: FC=ifort cmake -B _build -DBUILD_TESTING=NO . - + Testing ------- @@ -61,15 +83,15 @@ CMake build * Make sure to add the root folder of the installed library to the ``CMAKE_PREFIX_PATH`` environment variable. -* Use ``find_package()`` in `CMakeLists.txt` to locate the library and link +* Use ``find_package()`` in `CMakeLists.txt` to locate the library and link ``MpiFx::MpiFx`` to every target which relies directly on the library :: cmake_minimum_required(VERSION 3.16) - + project(TestMpiFx LANGUAGES Fortran) - + find_package(MpiFx REQUIRED) - + add_executable(test_mpifx test_mpifx.f90) target_link_libraries(test_mpifx MpiFx::MpiFx) diff --git a/lib/CMakeLists.txt b/lib/CMakeLists.txt index 0cdf659..f5d23d5 100644 --- a/lib/CMakeLists.txt +++ b/lib/CMakeLists.txt @@ -7,7 +7,6 @@ set(sources-fpp mpifx_barrier.fpp mpifx_bcast.fpp mpifx_comm.fpp - mpifx_common.fpp mpifx_constants.fpp mpifx_finalize.fpp mpifx_gather.fpp diff --git a/lib/meson.build b/lib/meson.build index c590372..962bea4 100644 --- a/lib/meson.build +++ b/lib/meson.build @@ -9,7 +9,6 @@ sources_fpp = files( 'mpifx_barrier.fpp', 'mpifx_bcast.fpp', 'mpifx_comm.fpp', - 'mpifx_common.fpp', 'mpifx_constants.fpp', 'mpifx_finalize.fpp', 'mpifx_gather.fpp', diff --git a/lib/mpifx_abort.fpp b/lib/mpifx_abort.fpp index 0d7203f..26a2522 100644 --- a/lib/mpifx_abort.fpp +++ b/lib/mpifx_abort.fpp @@ -1,6 +1,8 @@ !> Contains wrapper for \c MPI_ABORT. module mpifx_abort_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : handle_errorflag implicit none private diff --git a/lib/mpifx_allgather.fpp b/lib/mpifx_allgather.fpp index 893d2fa..94ffe02 100644 --- a/lib/mpifx_allgather.fpp +++ b/lib/mpifx_allgather.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_ALLGATHER module mpifx_allgather_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, handle_errorflag, sp implicit none private diff --git a/lib/mpifx_allgatherv.fpp b/lib/mpifx_allgatherv.fpp index 55898bb..df6afd6 100644 --- a/lib/mpifx_allgatherv.fpp +++ b/lib/mpifx_allgatherv.fpp @@ -106,7 +106,9 @@ !> Contains wrapper for \c MPI_allgatherv module mpifx_allgatherv_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, handle_errorflag, sp implicit none private diff --git a/lib/mpifx_allreduce.fpp b/lib/mpifx_allreduce.fpp index c3e30c8..783a6ad 100644 --- a/lib/mpifx_allreduce.fpp +++ b/lib/mpifx_allreduce.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_ALLREDUCE. module mpifx_allreduce_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, handle_errorflag, sp implicit none private @@ -86,7 +88,7 @@ module mpifx_allreduce_module !! write(*, "(I2.2,'-',I3.3,'|',1X,A,3F8.2)") 4, mycomm%rank, & !! & "Obtained result (prod):", resvalr(:) !! call mpifx_finalize() - !! + !! !! end program test_allreduceip !! interface mpifx_allreduceip diff --git a/lib/mpifx_barrier.fpp b/lib/mpifx_barrier.fpp index cf8efde..c98908c 100644 --- a/lib/mpifx_barrier.fpp +++ b/lib/mpifx_barrier.fpp @@ -1,8 +1,10 @@ #:include 'mpifx.fypp' -!> Contains wrapper for \c MPI_BARRIER. +!> Contains wrapper for \c MPI_BARRIER. module mpifx_barrier_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : handle_errorflag implicit none private @@ -35,12 +37,12 @@ contains subroutine mpifx_barrier(mycomm, error) type(mpifx_comm), intent(in) :: mycomm integer, intent(out), optional :: error - + integer :: error0 - + call mpi_barrier(mycomm%id, error0) call handle_errorflag(error0, "MPI_BARRIER in mpifx_barrier", error) - + end subroutine mpifx_barrier diff --git a/lib/mpifx_bcast.fpp b/lib/mpifx_bcast.fpp index 264c1fb..cdb339a 100644 --- a/lib/mpifx_bcast.fpp +++ b/lib/mpifx_bcast.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_BCAST. module mpifx_bcast_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, getoptarg, handle_errorflag, sp implicit none private @@ -80,7 +82,7 @@ contains #:enddef mpifx_bcast_template - + #:for TYPE in TYPES #:for RANK in RANKS diff --git a/lib/mpifx_comm.fpp b/lib/mpifx_comm.fpp index 1d7b01a..ac30042 100644 --- a/lib/mpifx_comm.fpp +++ b/lib/mpifx_comm.fpp @@ -1,7 +1,7 @@ !> Contains the extended MPI communicator. module mpifx_comm_module use mpi - use mpifx_helper_module + use mpifx_helper_module, only : getoptarg, handle_errorflag implicit none private diff --git a/lib/mpifx_common.fpp b/lib/mpifx_common.fpp deleted file mode 100644 index d00d1fc..0000000 --- a/lib/mpifx_common.fpp +++ /dev/null @@ -1,13 +0,0 @@ -!> Exports constants, helper functions, MPI descriptor and legacy MPI routines. -!! \cond HIDDEN -module mpifx_common_module - use mpi - use mpifx_helper_module - use mpifx_comm_module - implicit none - - public - -end module mpifx_common_module - -!> \endcond diff --git a/lib/mpifx_constants.fpp b/lib/mpifx_constants.fpp index 2266e01..35391d5 100644 --- a/lib/mpifx_constants.fpp +++ b/lib/mpifx_constants.fpp @@ -10,7 +10,7 @@ module mpifx_constants_module public :: MPI_MODE_NOSTORE, MPI_MODE_NOPUT, MPI_MODE_NOPRECEDE, MPI_MODE_NOSUCCEED public :: MPI_THREAD_SINGLE, MPI_THREAD_FUNNELED, MPI_THREAD_SERIALIZED, MPI_THREAD_MULTIPLE public :: MPI_COMM_TYPE_SHARED - public :: MPIFX_UNHANDLED_ERROR, MPIFX_ASSERT_FAILED + public :: MPIFX_UNHANDLED_ERROR, MPIFX_ASSERT_FAILED, MPIFX_SIZE_T !> Exit code for errors which were not caught due to missing optional arguments @@ -19,6 +19,9 @@ module mpifx_constants_module !> Exit code for failed assertions integer, parameter :: MPIFX_ASSERT_FAILED = 2 + !> Native integer for MPI addresses + integer, parameter :: MPIFX_SIZE_T = MPI_ADDRESS_KIND + end module mpifx_constants_module !> \endcond diff --git a/lib/mpifx_finalize.fpp b/lib/mpifx_finalize.fpp index b9b98cc..21976bf 100644 --- a/lib/mpifx_finalize.fpp +++ b/lib/mpifx_finalize.fpp @@ -1,6 +1,8 @@ -!> Contains wrapper for \c MPI_FINALIZE. +!> Contains wrapper for \c MPI_FINALIZE. module mpifx_finalize_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : handle_errorflag implicit none private @@ -39,5 +41,5 @@ contains call handle_errorflag(error0, "Error: mpi_finalize() in mpifx_finalize()", error) end subroutine mpifx_finalize - + end module mpifx_finalize_module diff --git a/lib/mpifx_gather.fpp b/lib/mpifx_gather.fpp index b79bc2a..5370bf0 100644 --- a/lib/mpifx_gather.fpp +++ b/lib/mpifx_gather.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_GATHER module mpifx_gather_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, getoptarg, handle_errorflag, sp implicit none private @@ -30,17 +32,17 @@ module mpifx_gather_module !! program test_gather !! use libmpifx_module !! implicit none - !! + !! !! type(mpifx_comm) :: mycomm !! integer :: send0 !! integer, allocatable :: send1(:) !! integer, allocatable :: recv1(:), recv2(:,:) !! character(100) :: formstr !! character(*), parameter :: label = "(I2.2,'-',I3.3,'|',1X" - !! + !! !! call mpifx_init() !! call mycomm%init() - !! + !! !! ! I0 -> I1 !! send0 = mycomm%rank * 2 ! Arbitrary number to send !! if (mycomm%lead) then @@ -55,7 +57,7 @@ module mpifx_gather_module !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1(:) !! end if !! deallocate(recv1) - !! + !! !! ! I1 -> I1 !! allocate(send1(2)) !! send1(:) = [ mycomm%rank, mycomm%rank + 1 ] ! Arbitrary numbers @@ -70,7 +72,7 @@ module mpifx_gather_module !! if (mycomm%lead) then !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1 !! end if - !! + !! !! ! I1 -> I2 !! send1(:) = [ mycomm%rank, mycomm%rank + 1 ] !! if (mycomm%lead) then @@ -82,9 +84,9 @@ module mpifx_gather_module !! if (mycomm%lead) then !! write(*, *) mycomm%rank, "Recv2 buffer:", recv2 !! end if - !! + !! !! call mpifx_finalize() - !! + !! !! end program test_gather !! interface mpifx_gather @@ -100,7 +102,7 @@ module mpifx_gather_module #:endfor #:endfor end interface mpifx_gather - + contains #:def mpifx_gather_dr0_template(SUFFIX, TYPE, MPITYPE, RANK, HASLENGTH) @@ -135,7 +137,7 @@ contains call mpi_gather(send, ${COUNT}$, ${MPITYPE}$, recv, ${COUNT}$, ${MPITYPE}$, root0,& & mycomm%id, error0) call handle_errorflag(error0, "MPI_GATHER in mpifx_gather_${SUFFIX}$", error) - + end subroutine mpifx_gather_${SUFFIX}$ #:enddef mpifx_gather_dr0_template diff --git a/lib/mpifx_gatherv.fpp b/lib/mpifx_gatherv.fpp index c1cb677..6fb1170 100644 --- a/lib/mpifx_gatherv.fpp +++ b/lib/mpifx_gatherv.fpp @@ -131,7 +131,9 @@ !> Contains wrapper for \c MPI_gatherv module mpifx_gatherv_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, handle_errorflag, sp implicit none private diff --git a/lib/mpifx_get_processor_name.fpp b/lib/mpifx_get_processor_name.fpp index 7e274b6..577dc91 100644 --- a/lib/mpifx_get_processor_name.fpp +++ b/lib/mpifx_get_processor_name.fpp @@ -1,7 +1,7 @@ !> Contains the extended MPI communicator. module mpifx_get_processor_name_module - use mpifx_helper_module use mpi + use mpifx_helper_module, only : handle_errorflag implicit none private diff --git a/lib/mpifx_helper.fpp b/lib/mpifx_helper.fpp index 70fa09b..44100b0 100644 --- a/lib/mpifx_helper.fpp +++ b/lib/mpifx_helper.fpp @@ -6,7 +6,7 @@ module mpifx_helper_module use mpi use, intrinsic :: iso_fortran_env, only : stderr => error_unit - use mpifx_constants_module + use mpifx_constants_module, only : MPIFX_ASSERT_FAILED, MPIFX_UNHANDLED_ERROR implicit none private diff --git a/lib/mpifx_init.fpp b/lib/mpifx_init.fpp index 387b758..98422a5 100644 --- a/lib/mpifx_init.fpp +++ b/lib/mpifx_init.fpp @@ -1,7 +1,9 @@ !> Contains wrapper for \c MPI_INIT. module mpifx_init_module - use mpifx_common_module - use mpifx_constants_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_constants_module, only : MPIFX_UNHANDLED_ERROR + use mpifx_helper_module, only : handle_errorflag implicit none private diff --git a/lib/mpifx_recv.fpp b/lib/mpifx_recv.fpp index d5ec093..3ce0523 100644 --- a/lib/mpifx_recv.fpp +++ b/lib/mpifx_recv.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_RECV module mpifx_recv_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, sp, getoptarg, handle_errorflag, setoptarg implicit none private @@ -15,7 +17,7 @@ module mpifx_recv_module !! !! \details All functions have the same argument list only differing in the !! type and rank of the second argument. The second argument can be of - !! type integer (i), real (s), double precision (d), complex (c), + !! type integer (i), real (s), double precision (d), complex (c), !! double complex (z), logical (b) and character (h). Its rank can vary from !! zero (scalar) up to the maximum rank. !! @@ -60,7 +62,7 @@ contains #:def mpifx_recv_template(SUFFIX, TYPE, MPITYPE, RANK, HASLENGTH) #:assert RANK >= 0 - + !> Receives a message from a given process. !! \param mycomm MPI descriptor. !! \param msg Msg to be received. @@ -105,6 +107,6 @@ contains $:mpifx_recv_template(SUFFIX, FTYPE, MPITYPE, RANK, HASLENGTH) #:endfor -#:endfor - +#:endfor + end module mpifx_recv_module diff --git a/lib/mpifx_reduce.fpp b/lib/mpifx_reduce.fpp index b14fdb3..4f538ad 100644 --- a/lib/mpifx_reduce.fpp +++ b/lib/mpifx_reduce.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_REDUCE. module mpifx_reduce_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, getoptarg, handle_errorflag, sp implicit none private @@ -13,8 +15,8 @@ module mpifx_reduce_module !> Reduces a scalar/array on a given node. !! !! \details All functions have the same argument list only differing in the - !! type and rank of the second and third arguments. The second and third - !! arguments can be of type integer (i), real (s), double precision (d), + !! type and rank of the second and third arguments. The second and third + !! arguments can be of type integer (i), real (s), double precision (d), !! complex (c), double complex (z) or logical (l). Their rank can vary from !! zero (scalars) up to the maximum rank. Both arguments must be of same !! type and rank. @@ -42,7 +44,7 @@ module mpifx_reduce_module !! write(*, "(I2.2,'-',I3.3,'|',1X,A,3F8.2)") 4, mycomm%rank, & !! & "Obtained result (prod):", resvalr(:) !! call mpifx_finalize() - !! + !! !! end program test_reduce !! interface mpifx_reduce @@ -86,9 +88,9 @@ module mpifx_reduce_module !! write(*, "(I2.2,'-',I3.3,'|',1X,A,3F8.2)") 4, mycomm%rank, & !! & "Obtained result (prod):", resvalr(:) !! call mpifx_finalize() - !! + !! !! end program test_reduceip - !! + !! interface mpifx_reduceip #:for TYPE in TYPES #:for RANK in RANKS @@ -129,16 +131,16 @@ contains call mpi_reduce(orig, reduced, ${COUNT}$, ${MPITYPE}$, reduceop, root0, mycomm%id, error0) call handle_errorflag(error0, "MPI_REDUCE in mpifx_reduce_${SUFFIX}$", error) - + end subroutine mpifx_reduce_${SUFFIX}$ #:enddef mpifx_reduce_template - + #:def mpifx_reduceip_template(SUFFIX, TYPE, MPITYPE, RANK) #:assert RANK >= 0 - + !> Reduces results on one process (type ${SUFFIX}$). !! !! \param mycomm MPI communicator. @@ -170,12 +172,12 @@ contains & error0) end if call handle_errorflag(error0, "MPI_REDUCE in mpifx_reduce_${SUFFIX}$", error) - + end subroutine mpifx_reduceip_${SUFFIX}$ #:enddef mpifx_reduceip_template - + #:for TYPE in TYPES #:for RANK in RANKS diff --git a/lib/mpifx_scatter.fpp b/lib/mpifx_scatter.fpp index de288b9..ee9505e 100644 --- a/lib/mpifx_scatter.fpp +++ b/lib/mpifx_scatter.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_SCATTER module mpifx_scatter_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, getoptarg, handle_errorflag, sp implicit none private @@ -30,16 +32,16 @@ module mpifx_scatter_module !! program test_scatter !! use libmpifx_module !! implicit none - !! + !! !! type(mpifx_comm) :: mycomm !! integer, allocatable :: send1(:), send2(:,:) !! integer :: recv0 !! integer, allocatable :: recv1(:) !! integer :: ii - !! + !! !! call mpifx_init() !! call mycomm%init() - !! + !! !! ! I1 -> I0 !! if (mycomm%lead) then !! allocate(send1(mycomm%size)) @@ -51,7 +53,7 @@ module mpifx_scatter_module !! recv0 = 0 !! call mpifx_scatter(mycomm, send1, recv0) !! write(*, *) mycomm%rank, "Recv0 buffer:", recv0 - !! + !! !! ! I1 -> I1 !! if (mycomm%lead) then !! deallocate(send1) @@ -63,7 +65,7 @@ module mpifx_scatter_module !! recv1(:) = 0 !! call mpifx_scatter(mycomm, send1, recv1) !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1 - !! + !! !! ! I2 -> I1 !! if (mycomm%lead) then !! allocate(send2(2, mycomm%size)) @@ -75,9 +77,9 @@ module mpifx_scatter_module !! recv1(:) = 0 !! call mpifx_scatter(mycomm, send2, recv1) !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1 - !! + !! !! call mpifx_finalize() - !! + !! !! end program test_scatter !! interface mpifx_scatter @@ -119,12 +121,12 @@ contains @:ASSERT(.not. mycomm%lead .or. size(send) == size(recv) * mycomm%size) @:ASSERT(.not. mycomm%lead& & .or. size(send, dim=${RANK}$) == size(recv, dim=${RANK}$) * mycomm%size) - + call getoptarg(mycomm%leadrank, root0, root) call mpi_scatter(send, ${COUNT}$, ${MPITYPE}$, recv, ${COUNT}$, ${MPITYPE}$, root0,& & mycomm%id, error0) call handle_errorflag(error0, "MPI_SCATTER in mpifx_scatter_${SUFFIX}$", error) - + end subroutine mpifx_scatter_${SUFFIX}$ #:enddef mpifx_scatter_dr0_template @@ -133,7 +135,7 @@ contains #:def mpifx_scatter_dr1_template(SUFFIX, TYPE, MPITYPE, RANK, HASLENGTH) #:assert RANK > 0 - + !> Scatters results on one process (type ${SUFFIX}$). !! !! \param mycomm MPI communicator. diff --git a/lib/mpifx_scatterv.fpp b/lib/mpifx_scatterv.fpp index aaa4944..44586c6 100644 --- a/lib/mpifx_scatterv.fpp +++ b/lib/mpifx_scatterv.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_SCATTER module mpifx_scatterv_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : dp, getoptarg, handle_errorflag, sp implicit none private @@ -113,7 +115,7 @@ contains @:ASSERT(.not. mycomm%lead .or. size(send) == size(recv) * mycomm%size) @:ASSERT(.not. mycomm%lead& & .or. size(send, dim=${RANK}$) == size(recv, dim=${RANK}$) * mycomm%size) - + call getoptarg(mycomm%leadrank, root0, root) if (mycomm%rank == root0) then if (present(displs)) then @@ -132,7 +134,7 @@ contains & mycomm%id, error0) call handle_errorflag(error0, "MPI_SCATTER in mpifx_scatterv_${SUFFIX}$", error) - + end subroutine mpifx_scatterv_${SUFFIX}$ #:enddef mpifx_scatterv_dr0_template @@ -141,7 +143,7 @@ contains #:def mpifx_scatterv_dr1_template(SUFFIX, TYPE, MPITYPE, RANK, HASLENGTH) #:assert RANK > 0 - + !> Scatter results from one process (type ${SUFFIX}$). !! !! \param mycomm MPI communicator. diff --git a/lib/mpifx_send.fpp b/lib/mpifx_send.fpp index fc775dd..aae2569 100644 --- a/lib/mpifx_send.fpp +++ b/lib/mpifx_send.fpp @@ -4,7 +4,9 @@ !> Contains wrapper for \c MPI_SEND module mpifx_send_module - use mpifx_common_module + use mpi + use mpifx_comm_module, only : mpifx_comm + use mpifx_helper_module, only : default_tag, dp, sp, getoptarg, handle_errorflag implicit none private @@ -15,7 +17,7 @@ module mpifx_send_module !! !! \details All functions have the same argument list only differing in the !! type and rank of the second argument. The second argument can be of - !! type integer (i), real (s), double precision (d), complex (c), + !! type integer (i), real (s), double precision (d), complex (c), !! double complex (z), logical (b) and character (h). Its rank can vary from !! zero (scalar) up to the maximum rank. !! diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp index c9f4bc9..1e4b301 100644 --- a/lib/mpifx_win.fpp +++ b/lib/mpifx_win.fpp @@ -1,10 +1,17 @@ #:include 'mpifx.fypp' -#:set TYPES = NUMERIC_TYPES +#:set WIN_DATA_TYPES = NUMERIC_TYPES +#:set ADDRESS_KINDS_SUFFIXES = [('int32', 'i4'), ('int64', 'i8')] -!> Contains routined for MPI shared memory. +!> Contains routined for MPI shared memory windows. module mpifx_win_module - use mpifx_common_module + use mpi_f08, only : MPI_ADDRESS_KIND, mpi_barrier, mpi_comm, MPI_INFO_NULL, MPI_MODE_NOCHECK,& + & mpi_win, mpi_win_allocate_shared, mpi_win_fence, mpi_win_free, mpi_win_lock_all,& + & mpi_win_shared_query, mpi_win_sync, mpi_win_unlock + use mpifx_helper_module, only : handle_errorflag, sp, dp + use mpifx_comm_module, only : mpifx_comm + use mpifx_constants_module, only : MPIFX_SIZE_T use iso_c_binding, only : c_ptr, c_f_pointer + use iso_fortran_env, only : int32, int64 implicit none private @@ -13,17 +20,17 @@ module mpifx_win_module !> MPI shared memory window with some additional information. type mpifx_win private - integer, public :: id !< Window id. - integer :: comm_id !< Communicator id. + type(mpi_win) :: win !< MPI window handle. + type(mpi_comm) :: comm !< MPI communicator handle. contains - !> Initializes an MPI shared memory window. -#:for TYPE in TYPES - generic :: allocate_shared => mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$ -#:endfor -#:for TYPE in TYPES - procedure, private :: mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$ -#:endfor + #:for TYPE in WIN_DATA_TYPES + #:for _, ADDRESS_SUFFIX in ADDRESS_KINDS_SUFFIXES + #:set SUFFIX = TYPE_ABBREVS[TYPE] + '_' + ADDRESS_SUFFIX + procedure, private :: mpifx_win_allocate_shared_${SUFFIX}$ + generic :: allocate_shared => mpifx_win_allocate_shared_${SUFFIX}$ + #:endfor + #:endfor !> Locks a shared memory segment for remote access. procedure :: lock => mpifx_win_lock @@ -44,16 +51,18 @@ module mpifx_win_module contains -#:def mpifx_win_allocate_shared_template(SUFFIX, TYPE) +#:def mpifx_win_allocate_shared_template(SUFFIX, TYPE, ADDRESS_KIND) - !> Initialized a window handle and returns a pointer to the address associated with a shared memory segment. + !> Initialized a window handle and returns a pointer to the address associated with a shared + !> memory segment. !! !! \param self Handle of the shared memory window on return. !! \param mycomm MPI communicator. !! \param global_length Number of elements of type ${TYPE}$ in the entire shared memory window. !! \param global_pointer Pointer to the shared data array of length 'global_length' on return. !! \param local_length Number of elements of type ${TYPE}$ occupied by the current rank. - !! \param local_pointer Pointer to the local chunk of the data array of length 'local_length' on return. + !! \param local_pointer Pointer to the local chunk of the data array of length 'local_length' on + !! return. !! \param error Optional error code on return. !! !! \see MPI documentation (\c MPI_WIN_ALLOCATE_SHARED) @@ -62,9 +71,9 @@ contains & local_length, local_pointer, error) class(mpifx_win), intent(out) :: self class(mpifx_comm), intent(in) :: mycomm - integer, intent(in) :: global_length + integer(${ADDRESS_KIND}$), intent(in) :: global_length ${TYPE}$, pointer, intent(out) :: global_pointer(:) - integer, intent(in), optional :: local_length + integer(${ADDRESS_KIND}$), intent(in), optional :: local_length ${TYPE}$, pointer, intent(out), optional :: local_pointer(:) integer, intent(out), optional :: error @@ -81,17 +90,17 @@ contains local_mem_size = int(global_length, kind=MPI_ADDRESS_KIND) * disp_unit end if - call mpi_win_allocate_shared(local_mem_size, disp_unit, MPI_INFO_NULL, mycomm%id, local_baseptr,& - & self%id, error0) - call handle_errorflag(error0, "MPI_WIN_ALLOCATE_SHARED in mpifx_win_allocate_shared_${SUFFIX}$",& - & error) + self%comm%mpi_val = mycomm%id + call mpi_win_allocate_shared(local_mem_size, disp_unit, MPI_INFO_NULL, self%comm,& + & local_baseptr, self%win, error0) + call handle_errorflag(error0,& + & "MPI_WIN_ALLOCATE_SHARED in mpifx_win_allocate_shared_${SUFFIX}$", error) - call mpi_win_shared_query(self%id, mycomm%leadrank, global_mem_size, disp_unit, global_baseptr,& - & error1) + call mpi_win_shared_query(self%win, mycomm%leadrank, global_mem_size, disp_unit,& + & global_baseptr, error1) call handle_errorflag(error1, "MPI_WIN_SHARED_QUERY in mpifx_win_allocate_shared_${SUFFIX}$",& & error) - self%comm_id = mycomm%id call c_f_pointer(global_baseptr, global_pointer, [global_length]) if (present(local_pointer)) then call c_f_pointer(local_baseptr, local_pointer, [local_length]) @@ -114,11 +123,12 @@ contains integer :: error0 - call mpi_win_lock_all(MPI_MODE_NOCHECK, self%id, error0) + call mpi_win_lock_all(MPI_MODE_NOCHECK, self%win, error0) call handle_errorflag(error0, "MPI_WIN_LOCK_ALL in mpifx_win_lock", error) end subroutine mpifx_win_lock + !> Unlocks a shared memory segment. Finishes a remote access epoch. !! !! \param self Handle of the shared memory window. @@ -132,11 +142,12 @@ contains integer :: error0 - call mpi_win_unlock_all(self%id, error0) + call mpi_win_unlock_all(self%win, error0) call handle_errorflag(error0, "MPI_WIN_UNLOCK_ALL in mpifx_win_unlock", error) end subroutine mpifx_win_unlock + !> Synchronizes shared memory across MPI ranks after remote access. !> Completes all memory stores in a remote access epoch. !! @@ -151,14 +162,15 @@ contains integer :: error0, error1 - call mpi_win_sync(self%id, error0) + call mpi_win_sync(self%win, error0) call handle_errorflag(error0, "MPI_WIN_SYNC in mpifx_win_sync", error) - call mpi_barrier(self%comm_id, error1) + call mpi_barrier(self%comm, error1) call handle_errorflag(error1, "MPI_BARRIER in mpifx_win_sync", error) end subroutine mpifx_win_sync + !> Ensure consistency of stores between fence calls !! !! \param self Handle of the shared memory window. @@ -179,11 +191,12 @@ contains assert_ = assert end if - call mpi_win_fence(assert_, self%id, error0) + call mpi_win_fence(assert_, self%win, error0) call handle_errorflag(error0, "MPI_WIN_FENCE in mpifx_win_fence", error) end subroutine mpifx_win_fence + !> Deallocates memory associated with a shared memory segment. !! !! \param self Handle of the shared memory window. @@ -197,17 +210,18 @@ contains integer :: error0 - call mpi_win_free(self%id, error0) + call mpi_win_free(self%win, error0) call handle_errorflag(error0, "MPI_WIN_FREE in mpifx_win_free", error) end subroutine mpifx_win_free -#:for TYPE in TYPES +#:for TYPE in WIN_DATA_TYPES #:set FTYPE = FORTRAN_TYPES[TYPE] - #:set SUFFIX = TYPE_ABBREVS[TYPE] - - $:mpifx_win_allocate_shared_template(SUFFIX, FTYPE) + #:for ADDRESS_KIND, ADDRESS_SUFFIX in ADDRESS_KINDS_SUFFIXES + #:set SUFFIX = TYPE_ABBREVS[TYPE] + '_' + ADDRESS_SUFFIX + $:mpifx_win_allocate_shared_template(SUFFIX, FTYPE, ADDRESS_KIND) + #:endfor #:endfor diff --git a/test/test_scatterv.f90 b/test/test_scatterv.f90 index 6de8d51..00777b2 100644 --- a/test/test_scatterv.f90 +++ b/test/test_scatterv.f90 @@ -81,5 +81,5 @@ program test_scatterv write(*, label // formstr) 8, mycomm%rank, "Recv1 buffer:", recv1 call mpifx_finalize() - + end program test_scatterv diff --git a/test/test_win_shared_mem.f90 b/test/test_win_shared_mem.f90 index fbad591..ead4583 100644 --- a/test/test_win_shared_mem.f90 +++ b/test/test_win_shared_mem.f90 @@ -5,7 +5,9 @@ program test_win_shared_mem type(mpifx_comm) :: globalcomm, nodecomm type(mpifx_win) :: win integer, parameter :: sample_value = 42, size_rank_0 = 7, size_rank_other = 4 - integer :: global_length, local_length, rank, ii + integer(MPIFX_SIZE_T) :: global_length, local_length + integer :: global_length_int32, local_length_int32 + integer :: rank, ii integer, pointer :: global_pointer(:), local_pointer(:) call mpifx_init() @@ -77,6 +79,13 @@ program test_win_shared_mem end if end do + call win%free() + + ! Initialize again with int32 sizes + global_length_int32 = global_length + local_length_int32 = local_length + call win%allocate_shared(nodecomm, global_length_int32, global_pointer, local_length_int32, local_pointer) + call win%free() call mpifx_finalize()