Skip to content

remove C wrapper of MPI_Allreduce_scalar #87

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.

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
merged 2 commits into from
Apr 2, 2025
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
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
26 changes: 22 additions & 4 deletions src/mpi.f90
Original file line number Diff line number Diff line change
Expand Up @@ -399,12 +399,30 @@ subroutine MPI_Irecv_proc(buf, count, datatype, source, tag, comm, request, ierr
end subroutine

subroutine MPI_Allreduce_scalar(sendbuf, recvbuf, count, datatype, op, comm, ierror)
use mpi_c_bindings, only: c_mpi_allreduce_scalar
real(8), intent(in) :: sendbuf
real(8), intent(out) :: recvbuf
use iso_c_binding, only: c_int, c_ptr, c_loc
use mpi_c_bindings, only: c_mpi_allreduce_scalar, c_mpi_datatype_f2c, c_mpi_op_f2c, c_mpi_comm_f2c
real(8), intent(in), target :: sendbuf
real(8), intent(out), target :: recvbuf
integer, intent(in) :: count, datatype, op, comm
integer, intent(out), optional :: ierror
call c_mpi_allreduce_scalar(sendbuf, recvbuf, count, datatype, op, comm, ierror)
type(c_ptr) :: sendbuf_ptr, recvbuf_ptr, c_datatype, c_op, c_comm
integer(c_int) :: local_ierr

sendbuf_ptr = c_loc(sendbuf)
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this doesn't handle the case when sendbuf is sent as MPI_IN_PLACE

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this definitely needs handling of MPI_IN_PLACE, without which POT3D will run into an infinite loop.

recvbuf_ptr = c_loc(recvbuf)
c_datatype = c_mpi_datatype_f2c(datatype)
c_op = c_mpi_op_f2c(op)
c_comm = c_mpi_comm_f2c(comm)

local_ierr = c_mpi_allreduce_scalar(sendbuf_ptr, recvbuf_ptr, count, c_datatype, c_op, c_comm)

if (present(ierror)) then
ierror = local_ierr
else
if (local_ierr /= MPI_SUCCESS) then
print *, "MPI_Allreduce_scalar failed with error code: ", local_ierr
end if
end if
end subroutine

subroutine MPI_Allreduce_1d(sendbuf, recvbuf, count, datatype, op, comm, ierror)
Expand Down
17 changes: 9 additions & 8 deletions src/mpi_c_bindings.f90
Original file line number Diff line number Diff line change
Expand Up @@ -120,14 +120,15 @@ function c_mpi_irecv(buf, count, datatype, source, tag, comm, request) bind(C, n
integer(c_int) :: c_mpi_irecv
end function

subroutine c_mpi_allreduce_scalar(sendbuf, recvbuf, count, datatype, op, comm, ierror) &
bind(C, name="mpi_allreduce_wrapper_real")
use iso_c_binding, only: c_int, c_double
real(c_double), intent(in) :: sendbuf
real(c_double), intent(out) :: recvbuf
integer(c_int), intent(in) :: count, datatype, op, comm
integer(c_int), intent(out), optional :: ierror
end subroutine
function c_mpi_allreduce_scalar(sendbuf, recvbuf, count, datatype, op, comm) &
bind(C, name="MPI_Allreduce")
use iso_c_binding, only: c_int, c_double, c_ptr
type(c_ptr), value :: sendbuf
type(c_ptr), value :: recvbuf
integer(c_int), value :: count
type(c_ptr), value :: datatype, op, comm
integer(c_int) :: c_mpi_allreduce_scalar
end function

subroutine c_mpi_allreduce_1d(sendbuf, recvbuf, count, datatype, op, comm, ierror) &
bind(C, name="mpi_allreduce_wrapper_real")
Expand Down
Loading