Skip to content

Fixes to MPI to improve robustness #263

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
astrofrog merged 2 commits into from
Jul 26, 2026
Merged

Fixes to MPI to improve robustness #263

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
2ed3924
Give the mp_n_photons send buffer the save attribute and free the fir…
astrofrog Jul 24, 2026
cbe07e5
Compute broadcast size inside the main-process block in mp_table_read…
astrofrog Jul 24, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
32 changes: 21 additions & 11 deletions src/mpi/mpi_io.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
! MD5 of template: 744398b07cde70659e77bf8ee3986c3f
! MD5 of template: 9b916a2ee87489dd7e583277a1e87b9e
module mpi_hdf5_io

use core_lib
Expand Down Expand Up @@ -365,8 +365,10 @@ subroutine mp_table_read_column_auto_1d_mpi_character(handle, path, name, array)
character(len=*),intent(in) :: path, name
character(len=*),allocatable,intent(out) :: array(:)
integer :: n1
if(main_process()) call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
if(main_process()) then
call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
end if
call mpi_bcast(n1, 1, mpi_integer4, rank_main, mpi_comm_world, ierr)
if(.not. main_process()) allocate(array(n1))
call mpi_bcast(array, n1 * len(array), mpi_character, rank_main, mpi_comm_world, ierr)
Expand Down Expand Up @@ -438,8 +440,10 @@ subroutine mp_table_read_column_auto_1d_mpi_integer8(handle, path, name, array)
character(len=*),intent(in) :: path, name
integer(idp),allocatable,intent(out) :: array(:)
integer :: n1
if(main_process()) call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
if(main_process()) then
call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
end if
call mpi_bcast(n1, 1, mpi_integer4, rank_main, mpi_comm_world, ierr)
if(.not. main_process()) allocate(array(n1))
call mpi_bcast(array, n1, mpi_integer8, rank_main, mpi_comm_world, ierr)
Expand Down Expand Up @@ -758,8 +762,10 @@ subroutine mp_table_read_column_auto_1d_mpi_integer4(handle, path, name, array)
character(len=*),intent(in) :: path, name
integer,allocatable,intent(out) :: array(:)
integer :: n1
if(main_process()) call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
if(main_process()) then
call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
end if
call mpi_bcast(n1, 1, mpi_integer4, rank_main, mpi_comm_world, ierr)
if(.not. main_process()) allocate(array(n1))
call mpi_bcast(array, n1, mpi_integer4, rank_main, mpi_comm_world, ierr)
Expand Down Expand Up @@ -1078,8 +1084,10 @@ subroutine mp_table_read_column_auto_1d_mpi_real8(handle, path, name, array)
character(len=*),intent(in) :: path, name
real(dp),allocatable,intent(out) :: array(:)
integer :: n1
if(main_process()) call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
if(main_process()) then
call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
end if
call mpi_bcast(n1, 1, mpi_integer4, rank_main, mpi_comm_world, ierr)
if(.not. main_process()) allocate(array(n1))
call mpi_bcast(array, n1, mpi_real8, rank_main, mpi_comm_world, ierr)
Expand Down Expand Up @@ -1398,8 +1406,10 @@ subroutine mp_table_read_column_auto_1d_mpi_real4(handle, path, name, array)
character(len=*),intent(in) :: path, name
real(sp),allocatable,intent(out) :: array(:)
integer :: n1
if(main_process()) call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
if(main_process()) then
call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
end if
call mpi_bcast(n1, 1, mpi_integer4, rank_main, mpi_comm_world, ierr)
if(.not. main_process()) allocate(array(n1))
call mpi_bcast(array, n1, mpi_real4, rank_main, mpi_comm_world, ierr)
Expand Down
12 changes: 8 additions & 4 deletions src/mpi/mpi_io_template.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -364,8 +364,10 @@ subroutine mp_table_read_column_auto_1d_mpi_character(handle, path, name, array)
character(len=*),intent(in) :: path, name
character(len=*),allocatable,intent(out) :: array(:)
integer :: n1
if(main_process()) call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
if(main_process()) then
call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
end if
call mpi_bcast(n1, 1, mpi_integer4, rank_main, mpi_comm_world, ierr)
if(.not. main_process()) allocate(array(n1))
call mpi_bcast(array, n1 * len(array), mpi_character, rank_main, mpi_comm_world, ierr)
Expand Down Expand Up @@ -438,8 +440,10 @@ subroutine mp_table_read_column_auto_1d_<T>(handle, path, name, array)
character(len=*),intent(in) :: path, name
@T,allocatable,intent(out) :: array(:)
integer :: n1
if(main_process()) call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
if(main_process()) then
call hdf5_table_read_column_auto(handle, path, name, array)
n1 = size(array)
end if
call mpi_bcast(n1, 1, mpi_integer4, rank_main, mpi_comm_world, ierr)
if(.not. main_process()) allocate(array(n1))
call mpi_bcast(array, n1, <T>, rank_main, mpi_comm_world, ierr)
Expand Down
10 changes: 8 additions & 2 deletions src/mpi/mpi_routines.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -73,7 +73,7 @@ subroutine mp_n_photons(n_photons_tot, n_photons_curr, n_photons_stats, n_photon
integer(idp),intent(out) :: n_photons

! Number of photons used for MPI transfer
integer(idp),volatile,allocatable :: n_photons_send(:)
integer(idp),volatile,allocatable,save :: n_photons_send(:)

! Loop variable and dummy variable
integer :: ir
Expand Down Expand Up @@ -153,8 +153,12 @@ subroutine mp_n_photons(n_photons_tot, n_photons_curr, n_photons_stats, n_photon

n_photons_curr = n_photons_curr + n_photons_send(ir)

! Send number of photons and initialize receive for status check
! Send number of photons and initialize receive for status check.
! The send buffer has the save attribute and each slot is only
! reused once the acknowledgement from the worker has been
! received, so the request can be freed straight away.
call mpi_isend(n_photons_send(ir), 1, mpi_integer8, ir, tag1, mpi_comm_world, request_dum, ierr)
call mpi_request_free(request_dum, ierr)
call mpi_irecv(dtime(ir), 1, mpi_real8, ir, tag2, mpi_comm_world, request(ir), ierr)

if(first) started(ir) = .true.
Expand Down Expand Up @@ -186,6 +190,7 @@ subroutine mp_n_photons(n_photons_tot, n_photons_curr, n_photons_stats, n_photon
if(flag) then
n_photons_send(ir) = 0_idp
call mpi_isend(n_photons_send(ir), 1, mpi_integer8, ir, tag1, mpi_comm_world, request_dum, ierr)
call mpi_request_free(request_dum, ierr)
call mpi_irecv(dum_dp, 1, mpi_real8, ir, tag2, mpi_comm_world, request(ir), ierr)
stopped(ir) = .true.
if(debug) write(*,'("[mpi_routines] send abort signal to rank ",I0)') ir
Expand All @@ -196,6 +201,7 @@ subroutine mp_n_photons(n_photons_tot, n_photons_curr, n_photons_stats, n_photon
else if(.not.started(ir)) then
n_photons_send(ir) = 0_idp
call mpi_isend(n_photons_send(ir), 1, mpi_integer8, ir, tag1, mpi_comm_world, request_dum, ierr)
call mpi_request_free(request_dum, ierr)
call mpi_irecv(dum_dp, 1, mpi_real8, ir, tag2, mpi_comm_world, request(ir), ierr)
started(ir) = .true.
stopped(ir) = .true.
Expand Down
Loading