crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-29 06:35:48 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 5

Added temporary variable for receive buffer on REDUCEs with MPI_IN_PLACE to prevent aliasing issues on BG/P.

Browse source
This commit is contained in:
Paul Romano 2012-04-26 15:21:39 +00:00
parent d3d47eb331
commit 7284e79591
3 changed files with 15 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/intercycle.F90
View file

@ -372,7 +372,8 @@ contains
call MPI_REDUCE(MPI_IN_PLACE, k_batch, 1, MPI_REAL8, MPI_SUM, 0, &
MPI_COMM_WORLD, mpi_err)
else
call MPI_REDUCE(k_batch, k_batch, 1, MPI_REAL8, MPI_SUM, 0, &
! Receive buffer not significant at other processors
call MPI_REDUCE(k_batch, temp, 1, MPI_REAL8, MPI_SUM, 0, &
MPI_COMM_WORLD, mpi_err)
end if
#endif

6
src/mesh.F90
View file

@ -170,7 +170,8 @@ contains
logical :: in_mesh ! was single site outside mesh?
logical :: outside ! was any site outside mesh?
#ifdef MPI
integer :: n ! total size of count variable
integer :: n ! total size of count variable
real(8) :: dummy ! temporary receive buffer for non-root reductions
#endif
! initialize variables
@ -229,7 +230,8 @@ contains
call MPI_REDUCE(MPI_IN_PLACE, cnt, n, MPI_REAL8, MPI_SUM, 0, &
MPI_COMM_WORLD, mpi_err)
else
call MPI_REDUCE(cnt, cnt, n, MPI_REAL8, MPI_SUM, 0, &
! Receive buffer not significant at other processors
call MPI_REDUCE(cnt, dummy, n, MPI_REAL8, MPI_SUM, 0, &
MPI_COMM_WORLD, mpi_err)
end if

14
src/tally.F90
View file

@ -1347,6 +1347,7 @@ contains
integer :: n_bins ! total number of bins
real(8), allocatable :: tally_temp(:,:) ! contiguous array of scores
real(8) :: global_temp(N_GLOBAL_TALLIES)
real(8) :: dummy ! temporary receive buffer for non-root reduces
type(TallyObject), pointer :: t => null()
do i = 1, n_tallies
@ -1370,7 +1371,7 @@ contains
t % scores(:,:) % value = tally_temp
else
! Receive buffer not significant at other processors
call MPI_REDUCE(tally_temp, tally_temp, n_bins, MPI_REAL8, &
call MPI_REDUCE(tally_temp, dummy, n_bins, MPI_REAL8, &
MPI_SUM, 0, MPI_COMM_WORLD, mpi_err)
! Reset value on other processors
@ -1390,7 +1391,8 @@ contains
! Transfer values back to global_tallies on master
global_tallies(:) % value = global_temp
else
call MPI_REDUCE(global_temp, global_temp, N_GLOBAL_TALLIES, &
! Receive buffer not significant at other processors
call MPI_REDUCE(global_temp, dummy, N_GLOBAL_TALLIES, &
MPI_REAL8, MPI_SUM, 0, MPI_COMM_WORLD, mpi_err)
! Reset value on other processors
@ -1404,7 +1406,8 @@ contains
call MPI_REDUCE(MPI_IN_PLACE, total_weight, 1, MPI_REAL8, MPI_SUM, &
0, MPI_COMM_WORLD, mpi_err)
else
call MPI_REDUCE(total_weight, total_weight, 1, MPI_REAL8, MPI_SUM, &
! Receive buffer not significant at other processors
call MPI_REDUCE(total_weight, dummy, 1, MPI_REAL8, MPI_SUM, &
0, MPI_COMM_WORLD, mpi_err)
end if
end if
@ -1428,6 +1431,7 @@ contains
integer :: n_bins ! total number of bins
real(8), allocatable :: tally_temp(:,:,:) ! contiguous array of scores
real(8) :: global_temp(2,N_GLOBAL_TALLIES)
real(8) :: dummy ! temporary receive buffer for non-root reduces
type(TallyObject), pointer :: t => null()
do i = 1, n_tallies
@ -1453,7 +1457,7 @@ contains
t % scores(:,:) % sum_sq = tally_temp(2,:,:)
else
! Receive buffer not significant at other processors
call MPI_REDUCE(tally_temp, tally_temp, n_bins, MPI_REAL8, MPI_SUM, &
call MPI_REDUCE(tally_temp, dummy, n_bins, MPI_REAL8, MPI_SUM, &
0, MPI_COMM_WORLD, mpi_err)
end if
@ -1477,7 +1481,7 @@ contains
global_tallies(:) % sum_sq = global_temp(2,:)
else
! Receive buffer not significant at other processors
call MPI_REDUCE(global_temp, global_temp, n_bins, MPI_REAL8, MPI_SUM, &
call MPI_REDUCE(global_temp, dummy, n_bins, MPI_REAL8, MPI_SUM, &
0, MPI_COMM_WORLD, mpi_err)
end if