From 6314cba397d4ebe041ecd8e15f9fce5facdeb177 Mon Sep 17 00:00:00 2001 From: Aditya Trivedi Date: Fri, 21 Mar 2025 03:56:49 +0530 Subject: [PATCH 1/3] Remove C-Wrapper for MPI_Init_Thread --- src/mpi.f90 | 31 +++++++++++++++++++++---------- src/mpi_c_bindings.f90 | 12 +++++++----- src/mpi_wrapper.c | 8 -------- 3 files changed, 28 insertions(+), 23 deletions(-) diff --git a/src/mpi.f90 b/src/mpi.f90 index 1d9621e..e1edbb2 100644 --- a/src/mpi.f90 +++ b/src/mpi.f90 @@ -127,21 +127,32 @@ subroutine MPI_Init_proc(ierr) end subroutine subroutine MPI_Init_thread_proc(required, provided, ierr) - use mpi_c_bindings, only : c_mpi_init_thread - use iso_c_binding, only: c_int + use mpi_c_bindings, only: c_mpi_init_thread + use iso_c_binding, only: c_int, c_ptr, c_null_ptr integer, intent(in) :: required integer, intent(out) :: provided integer, optional, intent(out) :: ierr - integer :: local_ierr + integer(c_int) :: local_ierr + integer(c_int) :: argc = 0 + type(c_ptr) :: argv = c_null_ptr + integer(c_int) :: c_required + integer(c_int) :: c_provided + + ! Map Fortran MPI_THREAD_FUNNELED to C MPI_THREAD_FUNNELED if needed + c_required = int(required, c_int) + + ! Call C MPI_Init_thread directly + local_ierr = c_mpi_init_thread(argc, argv, required, provided) + + ! Copy output values back to Fortran + provided = int(c_provided) + if (present(ierr)) then - call c_mpi_init_thread(required, provided, ierr) - else - call c_mpi_init_thread(required, provided, local_ierr) - if (local_ierr /= 0) then - print *, "MPI_Init_thread failed with error code: ", local_ierr - end if + ierr = int(local_ierr) + else if (local_ierr /= 0) then + print *, "MPI_Init_thread failed with error code: ", local_ierr end if - end subroutine + end subroutine MPI_Init_thread_proc subroutine MPI_Finalize_proc(ierr) use mpi_c_bindings, only: c_mpi_finalize diff --git a/src/mpi_c_bindings.f90 b/src/mpi_c_bindings.f90 index ca628e0..03c756e 100644 --- a/src/mpi_c_bindings.f90 +++ b/src/mpi_c_bindings.f90 @@ -7,12 +7,14 @@ subroutine c_mpi_init(ierr) bind(C, name="mpi_init_wrapper") integer(c_int), intent(out) :: ierr end subroutine c_mpi_init - subroutine c_mpi_init_thread(required, provided, ierr) bind(C, name="mpi_init_thread_wrapper") - use iso_c_binding, only: c_int - integer(c_int), intent(in) :: required + function c_mpi_init_thread(argc, argv, required, provided) bind(C, name="MPI_Init_thread") + use iso_c_binding, only: c_int, c_ptr + integer(c_int) :: argc + type(c_ptr) :: argv + integer(c_int), value :: required integer(c_int), intent(out) :: provided - integer(c_int), intent(out) :: ierr - end subroutine c_mpi_init_thread + integer(c_int) :: c_mpi_init_thread + end function c_mpi_init_thread integer(c_int) function c_mpi_finalize() bind(C, name="MPI_Finalize") use iso_c_binding, only : c_int diff --git a/src/mpi_wrapper.c b/src/mpi_wrapper.c index fec20bc..24fa7b7 100644 --- a/src/mpi_wrapper.c +++ b/src/mpi_wrapper.c @@ -10,14 +10,6 @@ void mpi_init_wrapper(int *ierr) { *ierr = MPI_Init(&argc, &argv); } -void mpi_init_thread_wrapper(int *required, int *provided, int *ierr) { - int argc = 0; - char **argv = NULL; - - int thread_support = (*required == 1) ? MPI_THREAD_FUNNELED : *required; - *ierr = MPI_Init_thread(&argc, &argv, thread_support, provided); -} - void mpi_comm_size_wrapper(int *comm_f, int *size, int *ierr) { MPI_Comm comm = MPI_Comm_f2c(*comm_f); *ierr = MPI_Comm_size(comm, size); From 11586dfc4badd10fe76700f9052b190c9234dd47 Mon Sep 17 00:00:00 2001 From: Aditya Trivedi Date: Fri, 21 Mar 2025 03:58:56 +0530 Subject: [PATCH 2/3] Add Test for MPI_Init_Thread --- tests/init_2.f90 | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 tests/init_2.f90 diff --git a/tests/init_2.f90 b/tests/init_2.f90 new file mode 100644 index 0000000..2e9e834 --- /dev/null +++ b/tests/init_2.f90 @@ -0,0 +1,18 @@ +program main + use mpi, only: MPI_Init_thread, MPI_Finalize, MPI_THREAD_FUNNELED + implicit none + + integer :: provided, ierr + + ! Initialize MPI with thread support + call MPI_Init_thread(MPI_THREAD_FUNNELED, provided, ierr) + + if (ierr /= 0) then + print *, "Error initializing MPI with threads" + stop + end if + print *, "Running MPI with thread support" + + ! Finalize MPI + call MPI_Finalize(ierr) +end program main \ No newline at end of file From b0c2fd753814f752b420f906fd0780344b01a2b0 Mon Sep 17 00:00:00 2001 From: Gaurav Dhingra Date: Fri, 21 Mar 2025 12:29:08 +0530 Subject: [PATCH 3/3] use `error stop` instead of just `stop` to exit with non-zero status --- tests/init_2.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/init_2.f90 b/tests/init_2.f90 index 2e9e834..620a437 100644 --- a/tests/init_2.f90 +++ b/tests/init_2.f90 @@ -1,4 +1,4 @@ -program main +program init_2 use mpi, only: MPI_Init_thread, MPI_Finalize, MPI_THREAD_FUNNELED implicit none @@ -9,10 +9,10 @@ program main if (ierr /= 0) then print *, "Error initializing MPI with threads" - stop + error stop end if print *, "Running MPI with thread support" ! Finalize MPI call MPI_Finalize(ierr) -end program main \ No newline at end of file +end program init_2