Skip to content

Commit 3fee58e

Browse files
adit4443yaadit4443ya
authored
FEAT: Implement Wrappers of MPI_COMM_GROUP, MPI_GROUP_SIZE and MPI_GROUP_FREE (#130)
1 parent cb6e5c8 commit 3fee58e

File tree

3 files changed

+142
-0
lines changed

3 files changed

+142
-0
lines changed

‎src/mpi.f90

Lines changed: 76 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,18 @@ module mpi
4545
module procedure MPI_Comm_size_proc
4646
end interface MPI_Comm_size
4747

48+
interface MPI_Comm_Group
49+
module procedure MPI_Comm_Group_proc
50+
end interface MPI_Comm_Group
51+
52+
interface MPI_Group_free
53+
module procedure MPI_Group_free_proc
54+
end interface MPI_Group_free
55+
56+
interface MPI_Group_size
57+
module procedure MPI_Group_size_proc
58+
end interface MPI_Group_size
59+
4860
interface MPI_Comm_dup
4961
module procedure MPI_Comm_dup_proc
5062
end interface MPI_Comm_dup
@@ -274,6 +286,70 @@ subroutine MPI_Comm_size_proc(comm, size, ierror)
274286
end if
275287
end subroutine
276288

289+
subroutine MPI_Comm_Group_proc(comm, group, ierror)
290+
use mpi_c_bindings, only: c_mpi_comm_group, c_mpi_group_f2c, c_mpi_group_c2f
291+
use iso_c_binding, only: c_int, c_ptr
292+
integer, intent(in) :: comm
293+
integer, intent(out) :: group
294+
integer, optional, intent(out) :: ierror
295+
integer(kind=MPI_HANDLE_KIND) :: c_comm, c_group
296+
integer :: local_ierr
297+
298+
c_comm = handle_mpi_comm_f2c(comm)
299+
c_group = c_mpi_group_f2c(group)
300+
local_ierr = c_mpi_comm_group(c_comm, c_group)
301+
group = c_mpi_group_c2f(c_group)
302+
303+
if (present(ierror)) then
304+
ierror = local_ierr
305+
else
306+
if (local_ierr /= 0) then
307+
print *, "MPI_Comm_Group failed with error code: ", local_ierr
308+
end if
309+
end if
310+
end subroutine MPI_Comm_Group_proc
311+
312+
subroutine MPI_Group_size_proc(group, size, ierror)
313+
use mpi_c_bindings, only: c_mpi_group_size, c_mpi_group_f2c
314+
use iso_c_binding, only: c_int, c_ptr
315+
integer, intent(in) :: group
316+
integer, intent(out) :: size
317+
integer, optional, intent(out) :: ierror
318+
integer(kind=MPI_HANDLE_KIND) :: c_group
319+
integer :: local_ierr
320+
321+
c_group = c_mpi_group_f2c(group)
322+
local_ierr = c_mpi_group_size(c_group, size)
323+
324+
if (present(ierror)) then
325+
ierror = local_ierr
326+
else
327+
if (local_ierr /= 0) then
328+
print *, "MPI_Group_size failed with error code: ", local_ierr
329+
end if
330+
end if
331+
end subroutine MPI_Group_size_proc
332+
333+
subroutine MPI_Group_free_proc(group, ierror)
334+
use mpi_c_bindings, only: c_mpi_group_free, c_mpi_group_f2c
335+
use iso_c_binding, only: c_int, c_ptr
336+
integer, intent(in) :: group
337+
integer, optional, intent(out) :: ierror
338+
integer(kind=MPI_HANDLE_KIND) :: c_group
339+
integer :: local_ierr
340+
341+
c_group = c_mpi_group_f2c(group)
342+
local_ierr = c_mpi_group_free(c_group)
343+
344+
if (present(ierror)) then
345+
ierror = local_ierr
346+
else
347+
if (local_ierr /= 0) then
348+
print *, "MPI_Group_free failed with error code: ", local_ierr
349+
end if
350+
end if
351+
end subroutine MPI_Group_free_proc
352+
277353
subroutine MPI_Comm_dup_proc(comm, newcomm, ierror)
278354
use mpi_c_bindings, only: c_mpi_comm_dup, c_mpi_comm_c2f
279355
integer, intent(in) :: comm

‎src/mpi_c_bindings.f90

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -67,6 +67,18 @@ function c_mpi_info_f2c(info_f) bind(C, name="MPI_Info_f2c")
6767
integer(kind=MPI_HANDLE_KIND) :: c_mpi_info_f2c
6868
end function c_mpi_info_f2c
6969

70+
function c_mpi_group_f2c(group_f) bind(C, name="MPI_Group_f2c")
71+
use iso_c_binding, only: c_int, c_ptr
72+
integer(c_int), value :: group_f
73+
integer(kind=MPI_HANDLE_KIND) :: c_mpi_group_f2c
74+
end function c_mpi_group_f2c
75+
76+
function c_mpi_group_c2f(group_c) bind(C, name="MPI_Group_c2f")
77+
use iso_c_binding, only: c_int, c_ptr
78+
integer(kind=MPI_HANDLE_KIND), value :: group_c
79+
integer(c_int) :: c_mpi_group_c2f
80+
end function c_mpi_group_c2f
81+
7082
function c_mpi_init(argc, argv) bind(C, name="MPI_Init")
7183
use iso_c_binding, only : c_int, c_ptr
7284
!> TODO: is the intent need to be explicitly specified
@@ -306,5 +318,25 @@ function c_mpi_reduce(sendbuf, recvbuf, count, c_dtype, c_op, root, c_comm) &
306318
integer(c_int) :: c_mpi_reduce
307319
end function c_mpi_reduce
308320

321+
function c_mpi_comm_group(comm, group) bind(C, name="MPI_Comm_group")
322+
use iso_c_binding, only: c_ptr, c_int
323+
integer(kind=MPI_HANDLE_KIND), value :: comm
324+
integer(kind=MPI_HANDLE_KIND), intent(out) :: group
325+
integer(c_int) :: c_mpi_comm_group
326+
end function c_mpi_comm_group
327+
328+
function c_mpi_group_size(group, size) bind(C, name="MPI_Group_size")
329+
use iso_c_binding, only: c_ptr, c_int
330+
integer(kind=MPI_HANDLE_KIND), value :: group
331+
integer(c_int), intent(out) :: size
332+
integer(c_int) :: c_mpi_group_size
333+
end function c_mpi_group_size
334+
335+
function c_mpi_group_free(group) bind(C, name="MPI_Group_free")
336+
use iso_c_binding, only: c_ptr, c_int
337+
integer(kind=MPI_HANDLE_KIND), intent(in) :: group
338+
integer(c_int) :: c_mpi_group_free
339+
end function c_mpi_group_free
340+
309341
end interface
310342
end module mpi_c_bindings

‎tests/comm_group_1.f90

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
program comm_group_1
2+
use mpi
3+
implicit none
4+
integer :: ierr, rank, size, group, group_size
5+
logical :: error
6+
7+
! Initialize MPI
8+
call MPI_Init(ierr)
9+
call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr)
10+
call MPI_Comm_size(MPI_COMM_WORLD, size, ierr)
11+
12+
! Get the group of MPI_COMM_WORLD
13+
call MPI_Comm_group(MPI_COMM_WORLD, group, ierr)
14+
15+
! Check group size
16+
call MPI_Group_size(group, group_size, ierr)
17+
18+
! Verify result
19+
error = .false.
20+
if (group_size /= size) then
21+
print *, "Rank ", rank, ": Error: Expected group size ", size, ", got ", group_size
22+
error = .true.
23+
else if (rank == 0) then
24+
print *, "MPI_Comm_group test passed: group size = ", group_size
25+
end if
26+
27+
! Free the group
28+
call MPI_Group_free(group, ierr)
29+
30+
! Clean up
31+
call MPI_Finalize(ierr)
32+
33+
if (error) stop 1
34+
end program comm_group_1

0 commit comments

Comments
 (0)