From d569cd4020059c1d5e44c8bfb6cd5eda472621ae Mon Sep 17 00:00:00 2001 From: Stack-1 Date: Fri, 14 Aug 2026 16:43:59 +0200 Subject: [PATCH] [UPDATE] Drop the MPI_Info window hints, measured to have no effect Paired A/B at 448 ranks, three replicas per arm inside one allocation: with no_locks=true the aggregated MPI_Win_create cost 1463 s against 1450 s without it, the two ranges fully overlapping. A probe with MPI_Win_get_info confirmed this Open MPI retains the hint, so the null result belongs to the hint and not to a failed measurement; same_disp_unit was silently ignored. Removes the cached MPI_Info handles and their helpers, and returns the four PSCW win_create calls to MPI_INFO_NULL. --- base/comm/internals/psi_dswapdata.F90 | 42 +++---------- .../comm/comm_schemes/psb_comm_rma_mod.F90 | 62 ------------------- 2 files changed, 9 insertions(+), 95 deletions(-) diff --git a/base/comm/internals/psi_dswapdata.F90 b/base/comm/internals/psi_dswapdata.F90 index c05c69253..6a4e4f1d4 100644 --- a/base/comm/internals/psi_dswapdata.F90 +++ b/base/comm/internals/psi_dswapdata.F90 @@ -86,7 +86,7 @@ submodule (psi_d_comm_v_mod) psi_d_swapdata_impl use psb_comm_schemes_mod, only: psb_comm_isend_irecv_, psb_comm_ineighbor_alltoallv_, & & psb_comm_persistent_ineighbor_alltoallv_, psb_comm_rma_pull_, psb_comm_rma_push_, & & psb_comm_handle_type - use psb_comm_rma_mod, only: psb_comm_rma_handle, psb_comm_rma_get_wininfo + use psb_comm_rma_mod, only: psb_comm_rma_handle use psb_comm_factory_mod contains @@ -1003,7 +1003,7 @@ contains class(psb_comm_handle_type), intent(inout) :: comm_handle integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm, win_info + integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm integer(psb_mpk_) :: proc_to_comm, prc_rank, recv_count, send_count, send_pos, recv_pos, list_pos integer(psb_mpk_) :: remote_base integer(kind=MPI_ADDRESS_KIND) :: remote_disp, exposed_bytes @@ -1106,14 +1106,8 @@ contains if (.not. rma_handle%window_ready) then element_bytes = storage_size(y%combuf(1))/8 exposed_bytes = int(size(y%combuf),kind=MPI_ADDRESS_KIND) * int(element_bytes,kind=MPI_ADDRESS_KIND) - ! no_locks: this path synchronizes with PSCW only, never with win_lock. - call psb_comm_rma_get_wininfo(win_info, .true., info) - if (info /= psb_success_) then - call psb_errpush(info,name) - goto 9999 - end if call mpi_win_create(y%combuf, exposed_bytes, element_bytes, & - & win_info, ctxt%get_mpic(), rma_handle%win, iret) + & mpi_info_null, ctxt%get_mpic(), rma_handle%win, iret) if (iret /= mpi_success) then info = psb_err_mpi_error_ call psb_errpush(info,name,m_err=(/iret/)) @@ -1233,7 +1227,7 @@ contains class(psb_comm_handle_type), intent(inout) :: comm_handle integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm, win_info + integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm integer(psb_mpk_) :: proc_to_comm, prc_rank, recv_count, send_count, send_pos, recv_pos, list_pos integer(psb_mpk_) :: remote_base integer(kind=MPI_ADDRESS_KIND) :: remote_disp, exposed_bytes @@ -1334,14 +1328,8 @@ contains if (.not. rma_handle%window_ready) then element_bytes = storage_size(y%combuf(1))/8 exposed_bytes = int(size(y%combuf),kind=MPI_ADDRESS_KIND) * int(element_bytes,kind=MPI_ADDRESS_KIND) - ! no_locks: this path synchronizes with PSCW only, never with win_lock. - call psb_comm_rma_get_wininfo(win_info, .true., info) - if (info /= psb_success_) then - call psb_errpush(info,name) - goto 9999 - end if call mpi_win_create(y%combuf, exposed_bytes, element_bytes, & - & win_info, ctxt%get_mpic(), rma_handle%win, iret) + & mpi_info_null, ctxt%get_mpic(), rma_handle%win, iret) if (iret /= mpi_success) then info = psb_err_mpi_error_ call psb_errpush(info,name,m_err=(/iret/)) @@ -2290,7 +2278,7 @@ end subroutine psi_dswap_neighbor_topology_multivect_persistent class(psb_comm_handle_type), intent(inout) :: comm_handle integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm, n, win_info + integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm, n integer(psb_mpk_) :: proc_to_comm, prc_rank, recv_count, send_count, send_pos, recv_pos, list_pos integer(psb_mpk_) :: remote_base integer(kind=MPI_ADDRESS_KIND) :: remote_disp, exposed_bytes @@ -2390,14 +2378,8 @@ end subroutine psi_dswap_neighbor_topology_multivect_persistent if (.not. rma_handle%window_ready) then element_bytes = storage_size(y%combuf(1))/8 exposed_bytes = int(size(y%combuf),kind=MPI_ADDRESS_KIND) * int(element_bytes,kind=MPI_ADDRESS_KIND) - ! no_locks: this path synchronizes with PSCW only, never with win_lock. - call psb_comm_rma_get_wininfo(win_info, .true., info) - if (info /= psb_success_) then - call psb_errpush(info,name) - goto 9999 - end if call mpi_win_create(y%combuf, exposed_bytes, element_bytes, & - & win_info, ctxt%get_mpic(), rma_handle%win, iret) + & mpi_info_null, ctxt%get_mpic(), rma_handle%win, iret) if (iret /= mpi_success) then info = psb_err_mpi_error_ call psb_errpush(info,name,m_err=(/iret/)) @@ -2510,7 +2492,7 @@ end subroutine psi_dswap_neighbor_topology_multivect_persistent class(psb_comm_handle_type), intent(inout) :: comm_handle integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm, n, win_info + integer(psb_mpk_) :: np, my_rank, iret, element_bytes, icomm, n integer(psb_mpk_) :: proc_to_comm, prc_rank, recv_count, send_count, send_pos, recv_pos, list_pos integer(psb_mpk_) :: remote_base integer(kind=MPI_ADDRESS_KIND) :: remote_disp, exposed_bytes @@ -2610,14 +2592,8 @@ end subroutine psi_dswap_neighbor_topology_multivect_persistent if (.not. rma_handle%window_ready) then element_bytes = storage_size(y%combuf(1))/8 exposed_bytes = int(size(y%combuf),kind=MPI_ADDRESS_KIND) * int(element_bytes,kind=MPI_ADDRESS_KIND) - ! no_locks: this path synchronizes with PSCW only, never with win_lock. - call psb_comm_rma_get_wininfo(win_info, .true., info) - if (info /= psb_success_) then - call psb_errpush(info,name) - goto 9999 - end if call mpi_win_create(y%combuf, exposed_bytes, element_bytes, & - & win_info, ctxt%get_mpic(), rma_handle%win, iret) + & mpi_info_null, ctxt%get_mpic(), rma_handle%win, iret) if (iret /= mpi_success) then info = psb_err_mpi_error_ call psb_errpush(info,name,m_err=(/iret/)) diff --git a/base/modules/comm/comm_schemes/psb_comm_rma_mod.F90 b/base/modules/comm/comm_schemes/psb_comm_rma_mod.F90 index 96189dbdc..5d2226833 100644 --- a/base/modules/comm/comm_schemes/psb_comm_rma_mod.F90 +++ b/base/modules/comm/comm_schemes/psb_comm_rma_mod.F90 @@ -15,23 +15,6 @@ module psb_comm_rma_mod include 'mpif.h' #endif - ! Hints attached to every window created by the one-sided schemes. - ! - ! Given no info at all, the implementation has to stay ready for the general - ! case: a passive-target lock could arrive at any moment, and ranks could have - ! passed different displacement units. Staying ready is not free -- it costs - ! metadata exchanged among all ranks on each creation -- and creation is where - ! these schemes spend most of their time. The assertions below hold here and - ! cost nothing to make. - ! - ! Deliberately NOT asserted: same_size. Halo buffers are sized by the local - ! halo, which differs from rank to rank, so that assertion would be false. - ! - ! Cached for the life of the program: the hints never change, and building an - ! info object per window would add to the very cost this is meant to remove. - integer(psb_mpk_), private, save :: rma_wininfo_pscw = mpi_info_null - integer(psb_mpk_), private, save :: rma_wininfo_gen = mpi_info_null - type, extends(psb_comm_handle_type) :: psb_comm_rma_handle integer(psb_mpk_) :: win = mpi_win_null logical :: window_ready = .false. @@ -68,51 +51,6 @@ module psb_comm_rma_mod contains - ! Return the MPI_Info to pass to mpi_win_create, building it on first use. - ! no_locks must be .true. only where the window is synchronized exclusively - ! with PSCW: it asserts that no passive-target epoch will ever be opened on - ! it, and a win_lock afterwards would be erroneous. Today that is the double - ! precision swapdata path; every other path still takes locks. - subroutine psb_comm_rma_get_wininfo(winfo, no_locks, info) - integer(psb_mpk_), intent(out) :: winfo - logical, intent(in) :: no_locks - integer(psb_ipk_), intent(out) :: info - - info = psb_success_ - if (no_locks) then - if (rma_wininfo_pscw == mpi_info_null) then - call psb_comm_rma_build_wininfo(rma_wininfo_pscw, .true., info) - if (info /= psb_success_) return - end if - winfo = rma_wininfo_pscw - else - if (rma_wininfo_gen == mpi_info_null) then - call psb_comm_rma_build_wininfo(rma_wininfo_gen, .false., info) - if (info /= psb_success_) return - end if - winfo = rma_wininfo_gen - end if - end subroutine psb_comm_rma_get_wininfo - - subroutine psb_comm_rma_build_wininfo(winfo, no_locks, info) - integer(psb_mpk_), intent(out) :: winfo - logical, intent(in) :: no_locks - integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: iret - - info = psb_success_ - winfo = mpi_info_null - call mpi_info_create(winfo, iret) - if (iret /= mpi_success) then - info = psb_err_mpi_error_ - winfo = mpi_info_null - return - end if - ! Every rank passes the size of one element of the same type. - call mpi_info_set(winfo, 'same_disp_unit', 'true', iret) - if (no_locks) call mpi_info_set(winfo, 'no_locks', 'true', iret) - end subroutine psb_comm_rma_build_wininfo - subroutine psb_comm_rma_init(this, info) class(psb_comm_rma_handle), intent(inout) :: this integer(psb_ipk_), intent(out) :: info