add test program for MPI_Allreduce where sendbuf is REAL8

tests/allreduce.f90 → 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

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

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