From 0b16fa4a34156eb8f4ad9221905d3f7e82840a00 Mon Sep 17 00:00:00 2001 From: Gaurav Dhingra Date: Tue, 1 Apr 2025 17:47:49 +0530 Subject: [PATCH 1/3] add test program for MPI_Allreduce where sendbuf is REAL8 --- tests/{allreduce.f90 => allreduce_1.f90} | 0 tests/allreduce_2.f90 | 34 ++++++++++++++++++++++++ 2 files changed, 34 insertions(+) rename tests/{allreduce.f90 => allreduce_1.f90} (100%) create mode 100644 tests/allreduce_2.f90 diff --git a/tests/allreduce.f90 b/tests/allreduce_1.f90 similarity index 100% rename from tests/allreduce.f90 rename to tests/allreduce_1.f90 diff --git a/tests/allreduce_2.f90 b/tests/allreduce_2.f90 new file mode 100644 index 0000000..bf513a1 --- /dev/null +++ b/tests/allreduce_2.f90 @@ -0,0 +1,34 @@ +program allreduce_2 + use mpi + implicit none + + integer :: ierr + integer :: rank + integer :: nprocs + real(8) :: local_val + real(8) :: global_sum + real(8) :: expected_sum + real(8), parameter :: tol = 1.0e-12 + + call MPI_INIT(ierr) + + call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr) + call MPI_COMM_SIZE(MPI_COMM_WORLD, nprocs, ierr) + + local_val = rank + 1 + print *, 'Rank ', rank, ' has local value = ', local_val + + ! this tests MPI_Allreduce where the first argument is of type 'REAL8' + call MPI_Allreduce(local_val, global_sum, 1, MPI_REAL8, MPI_SUM, MPI_COMM_WORLD, ierr) + print *, 'Rank ', rank, ' sees global sum = ', global_sum + ! calculate expected sum: n * (n + 1) / 2, where n = nprocs + expected_sum = real(nprocs, 8) * real(nprocs + 1, 8) / 2.0_8 + + if (abs(global_sum - expected_sum) > tol) then + print *, 'Error on Rank ', rank, ': global_sum = ', global_sum, & + ' does not match expected_sum = ', expected_sum + error stop + end if + + call MPI_FINALIZE(ierr) +end program allreduce_2 From 32e22093f56a8407864caa1cedc8edb6f83d5886 Mon Sep 17 00:00:00 2001 From: Gaurav Dhingra Date: Tue, 1 Apr 2025 17:49:03 +0530 Subject: [PATCH 2/3] rename program --- tests/allreduce_1.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/allreduce_1.f90 b/tests/allreduce_1.f90 index 0ab283c..1041170 100644 --- a/tests/allreduce_1.f90 +++ b/tests/allreduce_1.f90 @@ -12,7 +12,7 @@ subroutine uop( cin, cout, count) end subroutine end module mod_uop -program main +program allreduce_1 use mpi use mod_uop integer ierr, errs @@ -45,4 +45,4 @@ program main print *, "Allreduce test completed with ", errs, " errors." call mpi_finalize(errs) -end +end program allreduce_1 From e9881ee5f78a1ffcb6394df18ae13ebaa991819f Mon Sep 17 00:00:00 2001 From: Gaurav Dhingra Date: Tue, 1 Apr 2025 17:57:17 +0530 Subject: [PATCH 3/3] add test program for MPI_Allreduce where sendbuf is an array of integers --- tests/allreduce_3.f90 | 44 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 tests/allreduce_3.f90 diff --git a/tests/allreduce_3.f90 b/tests/allreduce_3.f90 new file mode 100644 index 0000000..be19932 --- /dev/null +++ b/tests/allreduce_3.f90 @@ -0,0 +1,44 @@ +program allreduce_3 + use mpi + implicit none + + integer :: ierr + integer :: rank + integer :: nprocs + integer, parameter :: array_size = 4 + integer :: local_array(array_size) + integer :: global_sum(array_size) + integer :: expected_sum(array_size) + integer :: i + + call MPI_INIT(ierr) + + call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr) + call MPI_COMM_SIZE(MPI_COMM_WORLD, nprocs, ierr) + + do i = 1, array_size + local_array(i) = (rank + 1) * i + end do + + print *, 'Rank ', rank, ' has local array = ', local_array + + call MPI_Allreduce(local_array, global_sum, array_size, MPI_INTEGER, & + MPI_SUM, MPI_COMM_WORLD, ierr) + + print *, 'Rank ', rank, ' sees global sum = ', global_sum + + do i = 1, array_size + expected_sum(i) = i * nprocs * (nprocs + 1) / 2 + end do + + do i = 1, array_size + if (global_sum(i) /= expected_sum(i)) then + print *, 'Error on Rank ', rank, ' at position ', i, & + ': global_sum = ', global_sum(i), & + ' does not match expected_sum = ', expected_sum(i) + error stop + end if + end do + + call MPI_FINALIZE(ierr) +end program allreduce_3