From 52b31d8ac9ac4b3f6127c07c5dd55dcf2aab7e98 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Wed, 3 Jun 2015 16:42:55 +0700 Subject: [PATCH] Use omp reduction instead of atomic on global tallies --- src/eigenvalue.F90 | 26 +++++++++++++++++++++++++- src/geometry.F90 | 4 +--- src/global.F90 | 4 ++++ src/physics.F90 | 8 ++------ src/tracking.F90 | 8 ++------ 5 files changed, 34 insertions(+), 16 deletions(-) diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 3b7f149a87..edf3e2985c 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -75,7 +75,11 @@ contains ! ==================================================================== ! LOOP OVER PARTICLES -!$omp parallel do schedule(static) firstprivate(p) +!$omp parallel do schedule(static) firstprivate(p) & +!$omp reduction(+:tally_tracklength) & +!$omp reduction(+:tally_collision) & +!$omp reduction(+:tally_leakage) & +!$omp reduction(+:tally_absorption) PARTICLE_LOOP: do i_work = 1, work current_work = i_work @@ -171,6 +175,22 @@ contains subroutine finalize_generation() + ! Update global tallies with the omp private accumulation variables + global_tallies(K_TRACKLENGTH) % value = & + global_tallies(K_TRACKLENGTH) % value + tally_tracklength + global_tallies(K_COLLISION) % value = & + global_tallies(K_COLLISION) % value + tally_collision + global_tallies(LEAKAGE) % value = & + global_tallies(LEAKAGE) % value + tally_leakage + global_tallies(K_ABSORPTION) % value = & + global_tallies(K_ABSORPTION) % value + tally_absorption + + ! reset private tallies + tally_tracklength = 0 + tally_collision = 0 + tally_leakage = 0 + tally_absorption = 0 + #ifdef _OPENMP ! Join the fission bank from each thread into one global fission bank call join_bank_from_threads() @@ -210,6 +230,10 @@ contains if (.not. active_batches) then call reset_result(global_tallies) n_realizations = 0 + tally_tracklength = 0 + tally_collision = 0 + tally_leakage = 0 + tally_absorption = 0 end if ! Perform CMFD calculation if on diff --git a/src/geometry.F90 b/src/geometry.F90 index 6f6b5f20b1..faf4cd1d06 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -320,9 +320,7 @@ contains ! Score to global leakage tally if (tallies_on) then -!$omp atomic - global_tallies(LEAKAGE) % value = & - global_tallies(LEAKAGE) % value + p % wgt + tally_leakage = tally_leakage + p % wgt end if ! Display message diff --git a/src/global.F90 b/src/global.F90 index 2ec111dc08..86e638e62e 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -116,6 +116,10 @@ module global ! 3) leakage fraction type(TallyResult), allocatable, target :: global_tallies(:) + real(8) :: tally_tracklength = 0 + real(8) :: tally_collision = 0 + real(8) :: tally_leakage = 0 + real(8) :: tally_absorption = 0 ! Tally map structure type(TallyMap), allocatable :: tally_maps(:) diff --git a/src/physics.F90 b/src/physics.F90 index 1c8120672d..c85f102b6e 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -253,18 +253,14 @@ contains p % last_wgt = p % wgt ! Score implicit absorption estimate of keff -!$omp atomic - global_tallies(K_ABSORPTION) % value = & - global_tallies(K_ABSORPTION) % value + p % absorb_wgt * & + tally_absorption = tally_absorption + p % absorb_wgt * & micro_xs(i_nuclide) % nu_fission / micro_xs(i_nuclide) % absorption else ! See if disappearance reaction happens if (micro_xs(i_nuclide) % absorption > & prn() * micro_xs(i_nuclide) % total) then ! Score absorption estimate of keff -!$omp atomic - global_tallies(K_ABSORPTION) % value = & - global_tallies(K_ABSORPTION) % value + p % wgt * & + tally_absorption = tally_absorption + p % wgt * & micro_xs(i_nuclide) % nu_fission / micro_xs(i_nuclide) % absorption p % alive = .false. diff --git a/src/tracking.F90 b/src/tracking.F90 index f7c58bffb0..59c31c6b17 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -110,9 +110,7 @@ contains call score_tracklength_tally(p, distance) ! Score track-length estimate of k-eff -!$omp atomic - global_tallies(K_TRACKLENGTH) % value = & - global_tallies(K_TRACKLENGTH) % value + p % wgt * distance * & + tally_tracklength = tally_tracklength + p % wgt * distance * & material_xs % nu_fission if (d_collision > d_boundary) then @@ -138,9 +136,7 @@ contains ! PARTICLE HAS COLLISION ! Score collision estimate of keff -!$omp atomic - global_tallies(K_COLLISION) % value = & - global_tallies(K_COLLISION) % value + p % wgt * & + tally_collision = tally_collision + p % wgt * & material_xs % nu_fission / material_xs % total ! score surface current tallies -- this has to be done before the collision