From de638eb393883ccc710a37b2d65a766039db957b Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Wed, 30 Nov 2011 15:04:59 -0500 Subject: [PATCH] Improved timing for parallel runs with MPI. --- src/DEPENDENCIES | 1 + src/global.f90 | 15 ++++---- src/initialize.f90 | 6 ++-- src/main.f90 | 17 ++++++--- src/mpi_routines.f90 | 85 ++++++++++++++++++++------------------------ src/output.f90 | 17 ++++++--- src/tally.f90 | 7 ++-- 7 files changed, 78 insertions(+), 70 deletions(-) diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 53e65bfa27..178f95a961 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -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 diff --git a/src/global.f90 b/src/global.f90 index e5533a6385..cce461d0d3 100644 --- a/src/global.f90 +++ b/src/global.f90 @@ -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 diff --git a/src/initialize.f90 b/src/initialize.f90 index 5c1d6a2be5..1dcafcd6de 100644 --- a/src/initialize.f90 +++ b/src/initialize.f90 @@ -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 diff --git a/src/main.f90 b/src/main.f90 index de1c473fc3..6e97bda151 100644 --- a/src/main.f90 +++ b/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 diff --git a/src/mpi_routines.f90 b/src/mpi_routines.f90 index e0a46d7619..2ea05e23f5 100644 --- a/src/mpi_routines.f90 +++ b/src/mpi_routines.f90 @@ -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 diff --git a/src/output.f90 b/src/output.f90 index 8605595935..68603f2d9f 100644 --- a/src/output.f90 +++ b/src/output.f90 @@ -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) diff --git a/src/tally.f90 b/src/tally.f90 index 152cf403c2..ca9f0eb268 100644 --- a/src/tally.f90 +++ b/src/tally.f90 @@ -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)