From 31c65a29b15317ce5b1cc777247fb96ad149af17 Mon Sep 17 00:00:00 2001 From: Ben Hourahine Date: Sat, 22 Jul 2023 11:33:40 +0100 Subject: [PATCH 01/10] Minor comment and source formatting --- lib/mpifx_win.fpp | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp index c9f4bc9..f36eaf2 100644 --- a/lib/mpifx_win.fpp +++ b/lib/mpifx_win.fpp @@ -1,7 +1,7 @@ #:include 'mpifx.fypp' #:set TYPES = NUMERIC_TYPES -!> Contains routined for MPI shared memory. +!> Contains routined for MPI shared memory windows. module mpifx_win_module use mpifx_common_module use iso_c_binding, only : c_ptr, c_f_pointer @@ -13,17 +13,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. + integer, public :: id !< Window id. + integer :: comm_id !< Communicator id. contains !> Initializes an MPI shared memory window. -#:for TYPE in TYPES + #:for TYPE in TYPES generic :: allocate_shared => mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$ -#:endfor + #:endfor -#:for TYPE in TYPES + #:for TYPE in TYPES procedure, private :: mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$ -#:endfor + #:endfor !> Locks a shared memory segment for remote access. procedure :: lock => mpifx_win_lock @@ -46,14 +46,16 @@ contains #:def mpifx_win_allocate_shared_template(SUFFIX, TYPE) - !> 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) @@ -81,10 +83,10 @@ 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) + 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) call mpi_win_shared_query(self%id, mycomm%leadrank, global_mem_size, disp_unit, global_baseptr,& & error1) @@ -119,6 +121,7 @@ contains end subroutine mpifx_win_lock + !> Unlocks a shared memory segment. Finishes a remote access epoch. !! !! \param self Handle of the shared memory window. @@ -137,6 +140,7 @@ contains end subroutine mpifx_win_unlock + !> Synchronizes shared memory across MPI ranks after remote access. !> Completes all memory stores in a remote access epoch. !! @@ -159,6 +163,7 @@ contains end subroutine mpifx_win_sync + !> Ensure consistency of stores between fence calls !! !! \param self Handle of the shared memory window. @@ -184,6 +189,7 @@ contains end subroutine mpifx_win_fence + !> Deallocates memory associated with a shared memory segment. !! !! \param self Handle of the shared memory window. From e4d45661906372605f1598097a0c0e2872aaab78 Mon Sep 17 00:00:00 2001 From: Tobias Melson Date: Wed, 18 Oct 2023 17:52:04 +0200 Subject: [PATCH 02/10] Pass int64 type to mpifx_win_allocate_shared --- lib/mpifx_constants.fpp | 4 +++- lib/mpifx_win.fpp | 22 +++++++++++++++------- test/test_win_shared_mem.f90 | 11 ++++++++++- 3 files changed, 28 insertions(+), 9 deletions(-) diff --git a/lib/mpifx_constants.fpp b/lib/mpifx_constants.fpp index 2266e01..48ff532 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,8 @@ module mpifx_constants_module !> Exit code for failed assertions integer, parameter :: MPIFX_ASSERT_FAILED = 2 + integer, parameter :: MPIFX_SIZE_T = MPI_ADDRESS_KIND + end module mpifx_constants_module !> \endcond diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp index f36eaf2..ef0c9f4 100644 --- a/lib/mpifx_win.fpp +++ b/lib/mpifx_win.fpp @@ -1,9 +1,11 @@ #:include 'mpifx.fypp' #:set TYPES = NUMERIC_TYPES +#:set INT_TYPES = ['int32', 'int64'] !> Contains routined for MPI shared memory windows. module mpifx_win_module use mpifx_common_module + use mpifx_constants_module, only : MPIFX_SIZE_T use iso_c_binding, only : c_ptr, c_f_pointer implicit none private @@ -18,11 +20,15 @@ module mpifx_win_module contains !> Initializes an MPI shared memory window. #:for TYPE in TYPES - generic :: allocate_shared => mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$ + #:for INT_TYPE in INT_TYPES + generic :: allocate_shared => mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$_${INT_TYPE}$ + #:endfor #:endfor #:for TYPE in TYPES - procedure, private :: mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$ + #:for INT_TYPE in INT_TYPES + procedure, private :: mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$_${INT_TYPE}$ + #:endfor #:endfor !> Locks a shared memory segment for remote access. @@ -44,7 +50,7 @@ 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. @@ -64,9 +70,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 @@ -211,9 +217,11 @@ contains #:for TYPE in TYPES #:set FTYPE = FORTRAN_TYPES[TYPE] - #:set SUFFIX = TYPE_ABBREVS[TYPE] - $:mpifx_win_allocate_shared_template(SUFFIX, FTYPE) + #:for ADDRESS_KIND, INT_TYPE in zip(['', '(MPIFX_SIZE_T)'], INT_TYPES) + #:set SUFFIX = TYPE_ABBREVS[TYPE] + '_' + INT_TYPE + $:mpifx_win_allocate_shared_template(SUFFIX, FTYPE, ADDRESS_KIND) + #:endfor #:endfor 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() From 15cc24d9f5dcb873533726f57848e225aa2887b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?B=C3=A1lint=20Aradi?= Date: Fri, 17 Nov 2023 10:53:30 +0100 Subject: [PATCH 03/10] Change mpi window allocation to use F08 interface --- lib/mpifx_win.fpp | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp index ef0c9f4..5585d89 100644 --- a/lib/mpifx_win.fpp +++ b/lib/mpifx_win.fpp @@ -4,7 +4,9 @@ !> Contains routined for MPI shared memory windows. module mpifx_win_module - use mpifx_common_module + use mpi_f08 + 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 implicit none @@ -15,8 +17,8 @@ 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 @@ -89,17 +91,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) + 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]) @@ -122,7 +124,7 @@ 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 @@ -141,7 +143,7 @@ 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 @@ -161,10 +163,10 @@ 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 @@ -190,7 +192,7 @@ 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 @@ -209,7 +211,7 @@ 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 From a5be7b8f061a484a3c81a6eb54d7748a604e114a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?B=C3=A1lint=20Aradi?= Date: Fri, 17 Nov 2023 19:27:01 +0100 Subject: [PATCH 04/10] Streamline fypp-constructs in mpifx_win.fpp --- lib/mpifx_win.fpp | 30 +++++++++++++----------------- 1 file changed, 13 insertions(+), 17 deletions(-) diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp index 5585d89..e85e711 100644 --- a/lib/mpifx_win.fpp +++ b/lib/mpifx_win.fpp @@ -1,6 +1,6 @@ #:include 'mpifx.fypp' -#:set TYPES = NUMERIC_TYPES -#:set INT_TYPES = ['int32', 'int64'] +#:set WIN_DATA_TYPES = NUMERIC_TYPES +#:set ADDRESS_KINDS_SUFFIXES = [('int32', 'i4'), ('int64', 'i8')] !> Contains routined for MPI shared memory windows. module mpifx_win_module @@ -9,6 +9,7 @@ module mpifx_win_module 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 @@ -20,16 +21,12 @@ module mpifx_win_module 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 - #:for INT_TYPE in INT_TYPES - generic :: allocate_shared => mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$_${INT_TYPE}$ - #:endfor - #:endfor - #:for TYPE in TYPES - #:for INT_TYPE in INT_TYPES - procedure, private :: mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$_${INT_TYPE}$ + #: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 @@ -72,9 +69,9 @@ contains & local_length, local_pointer, error) class(mpifx_win), intent(out) :: self class(mpifx_comm), intent(in) :: mycomm - integer${ADDRESS_KIND}$, intent(in) :: global_length + integer(${ADDRESS_KIND}$), intent(in) :: global_length ${TYPE}$, pointer, intent(out) :: global_pointer(:) - integer${ADDRESS_KIND}$, 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 @@ -217,11 +214,10 @@ contains end subroutine mpifx_win_free -#:for TYPE in TYPES +#:for TYPE in WIN_DATA_TYPES #:set FTYPE = FORTRAN_TYPES[TYPE] - - #:for ADDRESS_KIND, INT_TYPE in zip(['', '(MPIFX_SIZE_T)'], INT_TYPES) - #:set SUFFIX = TYPE_ABBREVS[TYPE] + '_' + INT_TYPE + #: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 From 17e157f1fd0afcc6dcf7d9762fe385f00133fe44 Mon Sep 17 00:00:00 2001 From: Justin Bich Date: Sat, 25 Nov 2023 17:09:50 +0100 Subject: [PATCH 05/10] Update all module imports --- lib/CMakeLists.txt | 1 - lib/meson.build | 1 - lib/mpifx_abort.fpp | 4 +++- lib/mpifx_allgather.fpp | 4 +++- lib/mpifx_allgatherv.fpp | 4 +++- lib/mpifx_allreduce.fpp | 6 ++++-- lib/mpifx_barrier.fpp | 12 +++++++----- lib/mpifx_bcast.fpp | 6 ++++-- lib/mpifx_comm.fpp | 2 +- lib/mpifx_common.fpp | 13 ------------- lib/mpifx_finalize.fpp | 8 +++++--- lib/mpifx_gather.fpp | 22 ++++++++++++---------- lib/mpifx_gatherv.fpp | 4 +++- lib/mpifx_get_processor_name.fpp | 1 - lib/mpifx_helper.fpp | 2 +- lib/mpifx_init.fpp | 6 ++++-- lib/mpifx_recv.fpp | 12 +++++++----- lib/mpifx_reduce.fpp | 24 +++++++++++++----------- lib/mpifx_scatter.fpp | 24 +++++++++++++----------- lib/mpifx_scatterv.fpp | 10 ++++++---- lib/mpifx_send.fpp | 6 ++++-- test/test_scatterv.f90 | 2 +- 22 files changed, 94 insertions(+), 80 deletions(-) delete mode 100644 lib/mpifx_common.fpp 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_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..4b0fb8f 100644 --- a/lib/mpifx_get_processor_name.fpp +++ b/lib/mpifx_get_processor_name.fpp @@ -1,6 +1,5 @@ !> Contains the extended MPI communicator. module mpifx_get_processor_name_module - use mpifx_helper_module use mpi 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..6f5f681 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 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..4459795 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 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/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 From 3910952a224f57895fe1a9bb95abb4f7d9c82931 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?B=C3=A1lint=20Aradi?= Date: Tue, 30 Jan 2024 20:27:19 +0100 Subject: [PATCH 06/10] Fix missing imports --- lib/mpifx_get_processor_name.fpp | 1 + lib/mpifx_recv.fpp | 2 +- lib/mpifx_send.fpp | 2 +- 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/mpifx_get_processor_name.fpp b/lib/mpifx_get_processor_name.fpp index 4b0fb8f..577dc91 100644 --- a/lib/mpifx_get_processor_name.fpp +++ b/lib/mpifx_get_processor_name.fpp @@ -1,6 +1,7 @@ !> Contains the extended MPI communicator. module mpifx_get_processor_name_module use mpi + use mpifx_helper_module, only : handle_errorflag implicit none private diff --git a/lib/mpifx_recv.fpp b/lib/mpifx_recv.fpp index 6f5f681..3ce0523 100644 --- a/lib/mpifx_recv.fpp +++ b/lib/mpifx_recv.fpp @@ -6,7 +6,7 @@ module mpifx_recv_module use mpi use mpifx_comm_module, only : mpifx_comm - use mpifx_helper_module, only : dp, sp + use mpifx_helper_module, only : dp, sp, getoptarg, handle_errorflag, setoptarg implicit none private diff --git a/lib/mpifx_send.fpp b/lib/mpifx_send.fpp index 4459795..aae2569 100644 --- a/lib/mpifx_send.fpp +++ b/lib/mpifx_send.fpp @@ -6,7 +6,7 @@ module mpifx_send_module use mpi use mpifx_comm_module, only : mpifx_comm - use mpifx_helper_module, only : default_tag, dp, sp + use mpifx_helper_module, only : default_tag, dp, sp, getoptarg, handle_errorflag implicit none private From 8af4e5859e3159b05a0bb3747d7ae0b378b1421d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?B=C3=A1lint=20Aradi?= Date: Wed, 31 Jan 2024 16:26:33 +0100 Subject: [PATCH 07/10] Update changelog --- CHANGELOG.rst | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) 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 === From 04e9f00060d7a5fdd5d301773bc108b65bc39f88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?B=C3=A1lint=20Aradi?= Date: Wed, 7 Feb 2024 08:55:26 +0100 Subject: [PATCH 08/10] Add documentation to lib/mpifx_constants.fpp Co-authored-by: Ben Hourahine --- lib/mpifx_constants.fpp | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/mpifx_constants.fpp b/lib/mpifx_constants.fpp index 48ff532..35391d5 100644 --- a/lib/mpifx_constants.fpp +++ b/lib/mpifx_constants.fpp @@ -19,6 +19,7 @@ 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 From 3d39c42f8b384c097caae050e4904e98663afda2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?B=C3=A1lint=20Aradi?= Date: Wed, 7 Feb 2024 09:28:00 +0100 Subject: [PATCH 09/10] Make mpi_f08 imports explicit --- lib/mpifx_win.fpp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp index e85e711..1e4b301 100644 --- a/lib/mpifx_win.fpp +++ b/lib/mpifx_win.fpp @@ -4,7 +4,9 @@ !> Contains routined for MPI shared memory windows. module mpifx_win_module - use mpi_f08 + 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 From b66aedb74acd5f122e4f4cf5f086a1ce2f5cdeac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?B=C3=A1lint=20Aradi?= Date: Thu, 8 Feb 2024 15:42:51 +0100 Subject: [PATCH 10/10] Update Readme --- README.rst | 38 ++++++++++++++++++++++++++++++-------- 1 file changed, 30 insertions(+), 8 deletions(-) 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)