mirror of
https://github.com/openmc-dev/openmc.git
synced 2026-07-28 14:15:42 -04:00
Improved timing for parallel runs with MPI.
This commit is contained in:
Paul Romano
parent
4cabea8c03
commit
de638eb393
7 changed files with 78 additions and 70 deletions
|
|
@ -128,6 +128,7 @@ mpi_routines.o: output.o
|
|||
mpi_routines.o: particle_header.o
|
||||
mpi_routines.o: random_lcg.o
|
||||
mpi_routines.o: tally_header.o
|
||||
mpi_routines.o: timing.o
|
||||
|
||||
output.o: constants.o
|
||||
output.o: datatypes.o
|
||||
|
|
|
|||
|
|
@ -118,14 +118,21 @@ module global
|
|||
integer :: rank ! rank of process
|
||||
logical :: master ! master process?
|
||||
logical :: mpi_enabled ! is MPI in use and initialized?
|
||||
integer :: mpi_err ! MPI error code
|
||||
|
||||
! ============================================================================
|
||||
! TIMING VARIABLES
|
||||
|
||||
type(Timer) :: time_total ! timer for total run
|
||||
type(Timer) :: time_init ! timer for initialization
|
||||
type(Timer) :: time_initialize ! timer for initialization
|
||||
type(Timer) :: time_read_xs ! timer for reading cross sections
|
||||
type(Timer) :: time_intercycle ! timer for intercycle synchronization
|
||||
type(Timer) :: time_ic_tallies ! timer for intercycle accumulate tallies
|
||||
type(Timer) :: time_ic_sample ! timer for intercycle sampling
|
||||
type(Timer) :: time_ic_sendrecv ! timer for intercycle SEND/RECV
|
||||
type(Timer) :: time_ic_rebuild ! timer for intercycle source bank rebuild
|
||||
type(Timer) :: time_inactive ! timer for inactive cycles
|
||||
type(Timer) :: time_active ! timer for active cycles
|
||||
type(Timer) :: time_compute ! timer for computation
|
||||
|
||||
! ===========================================================================
|
||||
|
|
@ -169,10 +176,6 @@ contains
|
|||
|
||||
subroutine free_memory()
|
||||
|
||||
#ifdef MPI
|
||||
integer :: ierr
|
||||
#endif
|
||||
|
||||
! Deallocate cells, surfaces, materials
|
||||
if (allocated(cells)) deallocate(cells)
|
||||
if (allocated(surfaces)) deallocate(surfaces)
|
||||
|
|
@ -193,7 +196,7 @@ contains
|
|||
|
||||
#ifdef MPI
|
||||
! If MPI is in use and enabled, terminate it
|
||||
call MPI_FINALIZE(ierr)
|
||||
call MPI_FINALIZE(mpi_err)
|
||||
#endif
|
||||
|
||||
end subroutine free_memory
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ contains
|
|||
type(Universe), pointer :: univ
|
||||
|
||||
! Start initialization timer
|
||||
call timer_start(time_init)
|
||||
call timer_start(time_initialize)
|
||||
|
||||
! Setup MPI
|
||||
call setup_mpi()
|
||||
|
|
@ -84,7 +84,9 @@ contains
|
|||
call normalize_ao()
|
||||
|
||||
! Read ACE-format cross sections
|
||||
call timer_start(time_read_xs)
|
||||
call read_xs()
|
||||
call timer_stop(time_read_xs)
|
||||
|
||||
! Construct unionized energy grid from cross-sections
|
||||
call unionized_grid()
|
||||
|
|
@ -108,7 +110,7 @@ contains
|
|||
end if
|
||||
|
||||
! Stop initialization timer
|
||||
call timer_stop(time_init)
|
||||
call timer_stop(time_initialize)
|
||||
|
||||
end subroutine initialize_run
|
||||
|
||||
|
|
|
|||
17
src/main.f90
17
src/main.f90
|
|
@ -33,10 +33,13 @@ program main
|
|||
else
|
||||
call run_problem()
|
||||
|
||||
! Calculate statistics for tallies and write to tallies.out
|
||||
call tally_statistics()
|
||||
if (master) call write_tallies()
|
||||
|
||||
! show timing statistics
|
||||
call timer_stop(time_total)
|
||||
if (master) call print_runtime()
|
||||
if (master) call write_tallies()
|
||||
end if
|
||||
|
||||
! deallocate arrays
|
||||
|
|
@ -58,6 +61,7 @@ contains
|
|||
if (master) call header("BEGIN SIMULATION", 1)
|
||||
|
||||
tallies_on = .false.
|
||||
call timer_start(time_active)
|
||||
call timer_start(time_inactive)
|
||||
|
||||
! ==========================================================================
|
||||
|
|
@ -103,7 +107,11 @@ contains
|
|||
call timer_start(time_intercycle)
|
||||
|
||||
! Collect tallies
|
||||
if (tallies_on) call synchronize_tallies()
|
||||
if (tallies_on) then
|
||||
call timer_start(time_ic_tallies)
|
||||
call synchronize_tallies()
|
||||
call timer_stop(time_ic_tallies)
|
||||
end if
|
||||
|
||||
! Distribute fission bank across processors evenly
|
||||
call synchronize_bank(i_cycle)
|
||||
|
|
@ -124,12 +132,11 @@ contains
|
|||
|
||||
end do CYCLE_LOOP
|
||||
|
||||
call timer_stop(time_active)
|
||||
|
||||
! ==========================================================================
|
||||
! END OF RUN WRAPUP
|
||||
|
||||
! Calculate statistics for tallies
|
||||
call tally_statistics()
|
||||
|
||||
if (master) call header("SIMULATION FINISHED", 1)
|
||||
|
||||
end subroutine run_problem
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ module mpi_routines
|
|||
use particle_header, only: Particle, initialize_particle
|
||||
use random_lcg, only: prn, set_particle_seed, prn_skip
|
||||
use tally_header, only: TallyObject
|
||||
use timing, only: timer_start, timer_stop
|
||||
|
||||
#ifdef MPI
|
||||
use mpi
|
||||
|
|
@ -16,7 +17,6 @@ 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) ! synchronization time
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -30,7 +30,6 @@ contains
|
|||
|
||||
#ifdef MPI
|
||||
integer :: i
|
||||
integer :: ierr ! Error status
|
||||
integer :: bank_blocks(4) ! Count for each datatype
|
||||
integer :: bank_types(4) ! Datatypes
|
||||
integer(MPI_ADDRESS_KIND) :: bank_disp(4) ! Displacements
|
||||
|
|
@ -40,22 +39,22 @@ contains
|
|||
mpi_enabled = .true.
|
||||
|
||||
! Initialize MPI
|
||||
call MPI_INIT(ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
call MPI_INIT(mpi_err)
|
||||
if (mpi_err /= MPI_SUCCESS) then
|
||||
message = "Failed to initialize MPI."
|
||||
call fatal_error()
|
||||
end if
|
||||
|
||||
! Determine number of processors
|
||||
call MPI_COMM_SIZE(MPI_COMM_WORLD, n_procs, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
call MPI_COMM_SIZE(MPI_COMM_WORLD, n_procs, mpi_err)
|
||||
if (mpi_err /= MPI_SUCCESS) then
|
||||
message = "Could not determine number of processors."
|
||||
call fatal_error()
|
||||
end if
|
||||
|
||||
! Determine rank of each processor
|
||||
call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
call MPI_COMM_RANK(MPI_COMM_WORLD, rank, mpi_err)
|
||||
if (mpi_err /= MPI_SUCCESS) then
|
||||
message = "Could not determine MPI rank."
|
||||
call fatal_error()
|
||||
end if
|
||||
|
|
@ -68,10 +67,10 @@ contains
|
|||
end if
|
||||
|
||||
! Determine displacements for MPI_BANK type
|
||||
call MPI_GET_ADDRESS(b % id, bank_disp(1), ierr)
|
||||
call MPI_GET_ADDRESS(b % xyz, bank_disp(2), ierr)
|
||||
call MPI_GET_ADDRESS(b % uvw, bank_disp(3), ierr)
|
||||
call MPI_GET_ADDRESS(b % E, bank_disp(4), ierr)
|
||||
call MPI_GET_ADDRESS(b % id, bank_disp(1), mpi_err)
|
||||
call MPI_GET_ADDRESS(b % xyz, bank_disp(2), mpi_err)
|
||||
call MPI_GET_ADDRESS(b % uvw, bank_disp(3), mpi_err)
|
||||
call MPI_GET_ADDRESS(b % E, bank_disp(4), mpi_err)
|
||||
|
||||
! Adjust displacements
|
||||
base = bank_disp(1)
|
||||
|
|
@ -83,10 +82,9 @@ contains
|
|||
bank_blocks = (/ 1, 3, 3, 1 /)
|
||||
bank_types = (/ MPI_INTEGER8, MPI_REAL8, MPI_REAL8, MPI_REAL8 /)
|
||||
call MPI_TYPE_CREATE_STRUCT(4, bank_blocks, bank_disp, &
|
||||
& bank_types, MPI_BANK, ierr)
|
||||
call MPI_TYPE_COMMIT(MPI_BANK, ierr)
|
||||
& bank_types, MPI_BANK, mpi_err)
|
||||
call MPI_TYPE_COMMIT(MPI_BANK, mpi_err)
|
||||
|
||||
t_sync = ZERO
|
||||
#else
|
||||
! if no MPI, set processor to master
|
||||
mpi_enabled = .false.
|
||||
|
|
@ -122,32 +120,25 @@ contains
|
|||
& right_bank(:) ! bank sites to send/recv to or fram right node
|
||||
|
||||
#ifdef MPI
|
||||
integer :: ierr
|
||||
integer :: status(MPI_STATUS_SIZE) ! message status
|
||||
integer :: request ! communication request for sending sites
|
||||
integer :: request_left ! communication request for recv sites from left
|
||||
integer :: request_right ! communication request for recv sites from right
|
||||
real(8) :: t0, t1, t2, t3, t4
|
||||
#endif
|
||||
|
||||
message = "Collecting number of fission sites..."
|
||||
call write_message(8)
|
||||
|
||||
#ifdef MPI
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
t0 = MPI_WTIME()
|
||||
|
||||
! Determine starting index for fission bank and total sites in fission bank
|
||||
start = 0_8
|
||||
call MPI_EXSCAN(n_bank, start, 1, MPI_INTEGER8, MPI_SUM, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
& MPI_COMM_WORLD, mpi_err)
|
||||
finish = start + n_bank
|
||||
total = finish
|
||||
call MPI_BCAST(total, 1, MPI_INTEGER8, n_procs - 1, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
& MPI_COMM_WORLD, mpi_err)
|
||||
|
||||
t1 = MPI_WTIME()
|
||||
t_sync(1) = t_sync(1) + (t1 - t0)
|
||||
#else
|
||||
start = 0_8
|
||||
finish = n_bank
|
||||
|
|
@ -179,6 +170,8 @@ contains
|
|||
message = "Sampling fission sites..."
|
||||
call write_message(8)
|
||||
|
||||
call timer_start(time_ic_sample)
|
||||
|
||||
! ==========================================================================
|
||||
! SAMPLE N_PARTICLES FROM FISSION BANK AND PLACE IN TEMP_SITES
|
||||
do i = 1, int(n_bank,4)
|
||||
|
|
@ -207,11 +200,11 @@ contains
|
|||
#ifdef MPI
|
||||
start = 0_8
|
||||
call MPI_EXSCAN(index_local, start, 1, MPI_INTEGER8, MPI_SUM, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
& MPI_COMM_WORLD, mpi_err)
|
||||
finish = start + index_local
|
||||
total = finish
|
||||
call MPI_BCAST(total, 1, MPI_INTEGER8, n_procs - 1, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
& MPI_COMM_WORLD, mpi_err)
|
||||
#else
|
||||
start = 0_8
|
||||
finish = index_local
|
||||
|
|
@ -251,10 +244,10 @@ contains
|
|||
send_to_right = 0
|
||||
end if
|
||||
|
||||
#ifdef MPI
|
||||
t2 = MPI_WTIME()
|
||||
t_sync(2) = t_sync(2) + (t2 - t1)
|
||||
call timer_stop(time_ic_sample)
|
||||
call timer_start(time_ic_sendrecv)
|
||||
|
||||
#ifdef MPI
|
||||
message = "Sending fission sites..."
|
||||
call write_message(8)
|
||||
|
||||
|
|
@ -266,24 +259,24 @@ contains
|
|||
if (send_to_right > 0) then
|
||||
i = index_local - send_to_right + 1
|
||||
call MPI_ISEND(temp_sites(i), send_to_right, MPI_BANK, rank+1, 0, &
|
||||
& MPI_COMM_WORLD, request, ierr)
|
||||
& MPI_COMM_WORLD, request, mpi_err)
|
||||
else if (send_to_right < 0) then
|
||||
call MPI_IRECV(right_bank, -send_to_right, MPI_BANK, rank+1, 1, &
|
||||
& MPI_COMM_WORLD, request_right, ierr)
|
||||
& MPI_COMM_WORLD, request_right, mpi_err)
|
||||
end if
|
||||
|
||||
if (send_to_left < 0) then
|
||||
call MPI_IRECV(left_bank, -send_to_left, MPI_BANK, rank-1, 0, &
|
||||
& MPI_COMM_WORLD, request_left, ierr)
|
||||
& MPI_COMM_WORLD, request_left, mpi_err)
|
||||
else if (send_to_left > 0) then
|
||||
call MPI_ISEND(temp_sites(1), send_to_left, MPI_BANK, rank-1, 1, &
|
||||
& MPI_COMM_WORLD, request, ierr)
|
||||
& MPI_COMM_WORLD, request, mpi_err)
|
||||
end if
|
||||
|
||||
t3 = MPI_WTIME()
|
||||
t_sync(3) = t_sync(3) + (t3 - t2)
|
||||
#endif
|
||||
|
||||
call timer_stop(time_ic_sendrecv)
|
||||
call timer_start(time_ic_rebuild)
|
||||
|
||||
message = "Constructing source bank..."
|
||||
call write_message(8)
|
||||
|
||||
|
|
@ -294,7 +287,7 @@ contains
|
|||
j = int(index_local,4) - send_to_right ! size of second block
|
||||
call copy_from_bank(temp_sites, i+1, j)
|
||||
#ifdef MPI
|
||||
call MPI_WAIT(request_left, status, ierr)
|
||||
call MPI_WAIT(request_left, status, mpi_err)
|
||||
#endif
|
||||
call copy_from_bank(left_bank, 1, i)
|
||||
else if (send_to_left >= 0 .and. send_to_right < 0) then
|
||||
|
|
@ -302,7 +295,7 @@ contains
|
|||
j = -send_to_right ! size of second block
|
||||
call copy_from_bank(temp_sites(1+send_to_left), 1, i)
|
||||
#ifdef MPI
|
||||
call MPI_WAIT(request_right, status, ierr)
|
||||
call MPI_WAIT(request_right, status, mpi_err)
|
||||
#endif
|
||||
call copy_from_bank(right_bank, i+1, j)
|
||||
else if (send_to_left >= 0 .and. send_to_right >= 0) then
|
||||
|
|
@ -314,23 +307,22 @@ contains
|
|||
k = -send_to_right
|
||||
call copy_from_bank(temp_sites, i+1, j)
|
||||
#ifdef MPI
|
||||
call MPI_WAIT(request_left, status, ierr)
|
||||
call MPI_WAIT(request_left, status, mpi_err)
|
||||
#endif
|
||||
call copy_from_bank(left_bank, 1, i)
|
||||
#ifdef MPI
|
||||
call MPI_WAIT(request_right, status, ierr)
|
||||
call MPI_WAIT(request_right, status, mpi_err)
|
||||
#endif
|
||||
call copy_from_bank(right_bank, i+j+1, k)
|
||||
end if
|
||||
|
||||
! Reset source index
|
||||
source_index = 0_8
|
||||
|
||||
call timer_stop(time_ic_rebuild)
|
||||
|
||||
#ifdef MPI
|
||||
t4 = MPI_WTIME()
|
||||
t_sync(4) = t_sync(4) + (t4 - t3)
|
||||
|
||||
deallocate(left_bank )
|
||||
deallocate(left_bank)
|
||||
deallocate(right_bank)
|
||||
#endif
|
||||
deallocate(temp_sites)
|
||||
|
|
@ -380,7 +372,6 @@ contains
|
|||
integer :: n
|
||||
integer :: m
|
||||
integer :: n_bins
|
||||
integer :: ierr
|
||||
real(8), allocatable :: tally_temp(:,:)
|
||||
type(TallyObject), pointer :: t
|
||||
|
||||
|
|
@ -398,14 +389,14 @@ contains
|
|||
if (master) then
|
||||
! Description of MPI_IN_PLANE
|
||||
call MPI_REDUCE(MPI_IN_PLACE, tally_temp, n_bins, MPI_REAL8, MPI_SUM, &
|
||||
0, MPI_COMM_WORLD, ierr)
|
||||
0, MPI_COMM_WORLD, mpi_err)
|
||||
|
||||
! Transfer values to val_history on master
|
||||
t % scores(:,:) % val_history = tally_temp
|
||||
else
|
||||
! Receive buffer not significant at other processors
|
||||
call MPI_REDUCE(tally_temp, tally_temp, n_bins, MPI_REAL8, MPI_SUM, &
|
||||
0, MPI_COMM_WORLD, ierr)
|
||||
0, MPI_COMM_WORLD, mpi_err)
|
||||
|
||||
! Reset val_history on other processors
|
||||
t % scores(:,:) % val_history = 0
|
||||
|
|
|
|||
|
|
@ -718,7 +718,7 @@ contains
|
|||
write(ou,*)
|
||||
|
||||
! Format descriptor for columns
|
||||
100 format (1X,A,T35,A)
|
||||
100 format (1X,A,T25,A)
|
||||
|
||||
nullify(s)
|
||||
nullify(c)
|
||||
|
|
@ -768,13 +768,20 @@ contains
|
|||
character(15) :: string
|
||||
|
||||
! display header block
|
||||
call header("Time Elapsed")
|
||||
call header("Timing Statistics")
|
||||
|
||||
! display time elapsed for various sections
|
||||
write(ou,100) "Total time elapsed", time_total % elapsed
|
||||
write(ou,100) "Total time for initialization", time_init % elapsed
|
||||
write(ou,100) "Total time for initialization", time_initialize % elapsed
|
||||
write(ou,100) " Reading cross sections", time_read_xs % elapsed
|
||||
write(ou,100) "Total time in computation", time_compute % elapsed
|
||||
write(ou,100) "Total time between cycles", time_intercycle % elapsed
|
||||
write(ou,100) " Accumulating tallies", time_ic_tallies % elapsed
|
||||
write(ou,100) " Sampling source sites", time_ic_sample % elapsed
|
||||
write(ou,100) " SEND/RECV source sites", time_ic_sendrecv % elapsed
|
||||
write(ou,100) " Reconstruct source bank", time_ic_rebuild % elapsed
|
||||
write(ou,100) "Total time in inactive cycles", time_inactive % elapsed
|
||||
write(ou,100) "Total time in active cycles", time_active % elapsed
|
||||
write(ou,100) "Total time elapsed", time_total % elapsed
|
||||
|
||||
! display header block
|
||||
call header("Run Statistics")
|
||||
|
|
@ -788,7 +795,7 @@ contains
|
|||
write(ou,*)
|
||||
|
||||
! format for write statements
|
||||
100 format (1X,A,T33,"= ",ES11.4," seconds")
|
||||
100 format (1X,A,T35,"= ",ES11.4," seconds")
|
||||
101 format (1X,A,T20,"= ",A," neutrons/second")
|
||||
102 format (1X,A,T20,"= ",F8.5," +/- ",F8.5)
|
||||
|
||||
|
|
|
|||
|
|
@ -35,9 +35,6 @@ contains
|
|||
real(8), save :: k1 = 0. ! accumulated keff
|
||||
real(8), save :: k2 = 0. ! accumulated keff**2
|
||||
real(8) :: std ! stdev of keff over active cycles
|
||||
#ifdef MPI
|
||||
integer :: ierr
|
||||
#endif
|
||||
|
||||
message = "Calculate cycle keff..."
|
||||
call write_message(8)
|
||||
|
|
@ -51,7 +48,7 @@ contains
|
|||
#ifdef MPI
|
||||
! Collect number bank sites onto master process
|
||||
call MPI_REDUCE(n_bank, total_bank, 1, MPI_INTEGER8, MPI_SUM, 0, &
|
||||
& MPI_COMM_WORLD, ierr)
|
||||
& MPI_COMM_WORLD, mpi_err)
|
||||
#else
|
||||
total_bank = n_bank
|
||||
#endif
|
||||
|
|
@ -78,7 +75,7 @@ contains
|
|||
end if
|
||||
|
||||
#ifdef MPI
|
||||
call MPI_BCAST(keff, 1, MPI_REAL8, 0, MPI_COMM_WORLD, ierr)
|
||||
call MPI_BCAST(keff, 1, MPI_REAL8, 0, MPI_COMM_WORLD, mpi_err)
|
||||
#endif
|
||||
|
||||
100 format (2X,I4,2X,F8.5)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue