mirror of
https://github.com/openmc-dev/openmc.git
synced 2026-07-27 21:55:41 -04:00
Overhauled fission bank synchronization to make it scalable.
This commit is contained in:
Paul Romano
parent
9a60b43946
commit
f143e7d5d0
5 changed files with 112 additions and 42 deletions
17
ChangeLog
17
ChangeLog
|
|
@ -1,3 +1,20 @@
|
|||
2011-04-21 Paul Romano <romano7@mit.edu>
|
||||
|
||||
* main.f90: Moved RN_init_particle at end of cycle to
|
||||
synchronize_bank routine.
|
||||
* mcnp_random.f90: Added RN_skip subroutine since RN_skip_ahead
|
||||
was private and needed a specific seed. RN_skip is used in
|
||||
synchronize_bank.
|
||||
* mpi_routines.f90: Dramatically overhauled the fission bank
|
||||
synchronization algorithm. The algorithm was non-scalable due to
|
||||
each processor needing to iterate over the global list of fission
|
||||
sites when sampling. This has been modified so that each processor
|
||||
samples sites locally without knowledge of how many sites other
|
||||
processors have sampled. Essentially, this requires an extra
|
||||
MPI_EXSCAN and MPI_BCAST, but should be much faster than what was
|
||||
there before.
|
||||
* source.f90: Set uid of particle during get_source_particle
|
||||
|
||||
2011-04-21 Paul Romano <romano7@mit.edu>
|
||||
|
||||
* geometry.f90: Removed level on calls to message().
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ program main
|
|||
use output, only: title, echo_input, message, warning, error, &
|
||||
& print_summary, print_particle
|
||||
use geometry, only: neighbor_lists
|
||||
use mcnp_random, only: RN_init_problem, rang, RN_init_particle
|
||||
use mcnp_random, only: RN_init_problem, RN_init_particle
|
||||
use source, only: init_source, get_source_particle
|
||||
use physics, only: transport
|
||||
use cross_section, only: read_xsdata, material_total_xs
|
||||
|
|
@ -141,8 +141,7 @@ contains
|
|||
|
||||
end do HISTORY_LOOP
|
||||
|
||||
call RN_init_particle(int(i_cycle,8))
|
||||
call synchronize_bank()
|
||||
call synchronize_bank(i_cycle)
|
||||
|
||||
! Collect results and statistics
|
||||
call calculate_keff(i_cycle)
|
||||
|
|
|
|||
|
|
@ -60,6 +60,7 @@ module mcnp_random
|
|||
PUBLIC :: RN_test_basic
|
||||
PUBLIC :: RN_test_skip
|
||||
PUBLIC :: RN_test_mixed
|
||||
PUBLIC :: RN_skip
|
||||
|
||||
!-------------------------------------
|
||||
! Constants for standard RN generators
|
||||
|
|
@ -189,6 +190,21 @@ CONTAINS
|
|||
|
||||
!-------------------------------------------------------------------
|
||||
|
||||
subroutine RN_skip( skip )
|
||||
! initialize MCNP random number parameters for particle "nps"
|
||||
!
|
||||
! * generate a new particle seed from the base seed
|
||||
! & particle index
|
||||
! * set the RN count to zero
|
||||
implicit none
|
||||
integer(I8), intent(in) :: skip
|
||||
|
||||
RN_SEED = RN_skip_ahead( RN_SEED, skip )
|
||||
|
||||
end subroutine RN_skip
|
||||
|
||||
!-------------------------------------------------------------------
|
||||
|
||||
function RN_skip_ahead( seed, skip )
|
||||
! advance the seed "skip" RNs: seed*RN_MULT^n mod RN_MOD
|
||||
implicit none
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
module mpi_routines
|
||||
|
||||
use global
|
||||
use output, only: message, error
|
||||
use mcnp_random, only: rang
|
||||
use source, only: copy_from_bank, source_index
|
||||
use output, only: message, error
|
||||
use mcnp_random, only: rang, RN_init_particle, RN_skip
|
||||
use source, only: copy_from_bank, source_index
|
||||
|
||||
#ifdef MPI
|
||||
use mpi
|
||||
|
|
@ -13,8 +13,7 @@ module mpi_routines
|
|||
|
||||
integer :: MPI_BANK ! MPI datatype for fission bank
|
||||
integer(8) :: bank_index ! Fission bank site unique identifier
|
||||
|
||||
real(8) :: t_sync(4)
|
||||
real(8) :: t_sync(4) ! synchronization time
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -97,12 +96,15 @@ contains
|
|||
end subroutine setup_mpi
|
||||
|
||||
!=====================================================================
|
||||
! SYNCHRONIZE_BANK
|
||||
!=====================================================================
|
||||
! SYNCHRONIZE_BANK samples source sites from the fission sites that
|
||||
! were accumulated during the cycle. This routine is what allows this
|
||||
! Monte Carlo to scale to large numbers of processors where other
|
||||
! codes cannot.
|
||||
! =====================================================================
|
||||
|
||||
subroutine synchronize_bank()
|
||||
subroutine synchronize_bank(i_cycle)
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: i_cycle
|
||||
|
||||
integer :: i, j, k ! loop indices
|
||||
#ifdef MPI
|
||||
|
|
@ -134,7 +136,7 @@ contains
|
|||
|
||||
! Determine starting index for fission bank and total sites in
|
||||
! fission bank
|
||||
start = 0
|
||||
start = 0_8
|
||||
call MPI_EXSCAN(n_bank, start, 1, MPI_INTEGER8, MPI_SUM, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
finish = start + n_bank
|
||||
|
|
@ -142,12 +144,6 @@ contains
|
|||
call MPI_BCAST(total, 1, MPI_INTEGER8, n_procs - 1, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
|
||||
! Check if there are no fission sites
|
||||
if (total == 0) then
|
||||
msg = "No fission sites banked!"
|
||||
call error(msg)
|
||||
end if
|
||||
|
||||
t1 = MPI_WTIME()
|
||||
t_sync(1) = t_sync(1) + (t1 - t0)
|
||||
#else
|
||||
|
|
@ -156,6 +152,19 @@ contains
|
|||
total = n_bank
|
||||
#endif
|
||||
|
||||
! Check if there are no fission sites
|
||||
if (total == 0) then
|
||||
msg = "No fission sites banked!"
|
||||
call error(msg)
|
||||
end if
|
||||
|
||||
! Make sure all processors start at the same point for random
|
||||
! sampling
|
||||
call RN_init_particle(int(i_cycle,8))
|
||||
|
||||
! Skip ahead however many random numbers are needed
|
||||
call RN_skip(start)
|
||||
|
||||
allocate(temp_sites(2*work))
|
||||
count = 0_8 ! Index for local source_bank
|
||||
index = 0_8 ! Index for global source uid -- must account for all nodes
|
||||
|
|
@ -171,7 +180,7 @@ contains
|
|||
|
||||
! ================================================================
|
||||
! SAMPLE N_PARTICLES FROM FISSION BANK AND PLACE IN TEMP_SITES
|
||||
do i = 1, total
|
||||
do i = 1, n_bank
|
||||
|
||||
! If there are less than n_particles particles banked,
|
||||
! automatically add int(n_particles/total) sites to
|
||||
|
|
@ -180,33 +189,60 @@ contains
|
|||
! remaining 100 would be randomly sampled.
|
||||
if (total < n_particles) then
|
||||
do j = 1,int(n_particles/total)
|
||||
index = index + 1
|
||||
! If index is within this node's range, add site to source
|
||||
if (i > start .and. i <= finish) then
|
||||
count = count + 1
|
||||
temp_sites(count) = fission_bank(i-start)
|
||||
temp_sites(count) % uid = index
|
||||
end if
|
||||
count = count + 1
|
||||
temp_sites(count) = fission_bank(i)
|
||||
end do
|
||||
end if
|
||||
|
||||
! Randomly sample sites needed
|
||||
sites_remaining = total - i + 1
|
||||
if (sites_needed == sites_remaining .or. &
|
||||
rang() < real(sites_needed)/real(sites_remaining)) then
|
||||
index = index + 1
|
||||
if (i > start .and. i <= finish) then
|
||||
count = count + 1
|
||||
temp_sites(count) = fission_bank(i-start)
|
||||
temp_sites(count) % uid = index
|
||||
end if
|
||||
sites_needed = sites_needed - 1
|
||||
if (rang() < real(sites_needed)/real(total)) then
|
||||
count = count + 1
|
||||
temp_sites(count) = fission_bank(i)
|
||||
end if
|
||||
end do
|
||||
|
||||
! Now that we've sampled sites, check where the boundaries of data
|
||||
! are for the source bank
|
||||
#ifdef MPI
|
||||
start = 0_8
|
||||
call MPI_EXSCAN(count, start, 1, MPI_INTEGER8, MPI_SUM, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
finish = start + count
|
||||
total = finish
|
||||
call MPI_BCAST(total, 1, MPI_INTEGER8, n_procs - 1, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
#else
|
||||
start = 0_8
|
||||
finish = count
|
||||
total = count
|
||||
#endif
|
||||
|
||||
! Determine how many sites to send to adjacent nodes
|
||||
send_to_left = bank_first - temp_sites(1)%uid
|
||||
send_to_right = temp_sites(1)%uid + (count-1) - bank_last
|
||||
send_to_left = bank_first - 1 - start
|
||||
send_to_right = finish - bank_last
|
||||
|
||||
if (rank == n_procs - 1) then
|
||||
if (total > n_particles) then
|
||||
! If we have extra sites sampled, we will simply discard the
|
||||
! extra ones on the last processor
|
||||
if (rank == n_procs - 1) then
|
||||
count = count - send_to_right
|
||||
end if
|
||||
|
||||
elseif (total < n_particles) then
|
||||
! If we have too few sites, grab sites from the very end of
|
||||
! the fission bank
|
||||
sites_needed = n_particles - total
|
||||
do i = 1, sites_needed
|
||||
count = count + 1
|
||||
temp_sites(count) = fission_bank(n_bank - sites_needed + i)
|
||||
end do
|
||||
end if
|
||||
|
||||
! the last processor should not be sending sites to right
|
||||
send_to_right = 0
|
||||
end if
|
||||
|
||||
#ifdef MPI
|
||||
t2 = MPI_WTIME()
|
||||
|
|
@ -269,7 +305,7 @@ contains
|
|||
end if
|
||||
|
||||
! Reset source index
|
||||
source_index = 0
|
||||
source_index = 0_8
|
||||
|
||||
#ifdef MPI
|
||||
t4 = MPI_WTIME()
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ module source
|
|||
|
||||
implicit none
|
||||
|
||||
integer :: source_index
|
||||
integer(8) :: source_index
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -101,7 +101,7 @@ contains
|
|||
end do
|
||||
|
||||
! Reset source index
|
||||
source_index = 0
|
||||
source_index = 0_8
|
||||
|
||||
end subroutine init_source
|
||||
|
||||
|
|
@ -125,6 +125,9 @@ contains
|
|||
! point to next source particle
|
||||
p => source_bank(source_index)
|
||||
|
||||
! set uid
|
||||
p % uid = bank_first + source_index
|
||||
|
||||
end function get_source_particle
|
||||
|
||||
!=====================================================================
|
||||
|
|
@ -166,7 +169,6 @@ contains
|
|||
|
||||
do i = 1, n_sites
|
||||
j = index + i - 1
|
||||
source_bank(j) % uid = temp_bank(i) % uid
|
||||
source_bank(j) % xyz = temp_bank(i) % xyz
|
||||
source_bank(j) % xyz_local = temp_bank(i) % xyz
|
||||
source_bank(j) % uvw = temp_bank(i) % uvw
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue