From f143e7d5d02fb6c475a650ff2145a9ac5c502204 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 21 Apr 2011 22:58:37 +0000 Subject: [PATCH] Overhauled fission bank synchronization to make it scalable. --- ChangeLog | 17 +++++++ src/main.f90 | 5 +- src/mcnp_random.f90 | 16 +++++++ src/mpi_routines.f90 | 108 ++++++++++++++++++++++++++++--------------- src/source.f90 | 8 ++-- 5 files changed, 112 insertions(+), 42 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8874be2888..668d2b5ee2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,20 @@ +2011-04-21 Paul Romano + + * 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 * geometry.f90: Removed level on calls to message(). diff --git a/src/main.f90 b/src/main.f90 index 5067c18c02..5b6e35f743 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -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) diff --git a/src/mcnp_random.f90 b/src/mcnp_random.f90 index ba309cbdd5..70cdbaa701 100644 --- a/src/mcnp_random.f90 +++ b/src/mcnp_random.f90 @@ -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 diff --git a/src/mpi_routines.f90 b/src/mpi_routines.f90 index 4c1145ded2..9aee563ee1 100644 --- a/src/mpi_routines.f90 +++ b/src/mpi_routines.f90 @@ -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() diff --git a/src/source.f90 b/src/source.f90 index 008f0f5da4..f26f21c7c9 100644 --- a/src/source.f90 +++ b/src/source.f90 @@ -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