From bc3924af7df09577854f5a3af05cd044a9f6a8c5 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 25 Jul 2011 20:41:54 -0400 Subject: [PATCH] Added timing class. Moved warnings and errors to a new module named error. Removed many MPI_WTIME calls. --- src/Makefile | 27 +++--- src/ace.f90 | 21 ++--- src/cross_section.f90 | 13 +-- src/error.f90 | 74 +++++++++++++++ src/fileio.f90 | 83 ++++++++--------- src/geometry.f90 | 21 ++--- src/global.f90 | 6 ++ src/main.f90 | 69 ++++++++------ src/mpi_routines.f90 | 11 +-- src/output.f90 | 203 ++++++++++++++++++++---------------------- src/physics.f90 | 55 ++++++------ src/score.f90 | 5 +- src/search.f90 | 4 +- src/string.f90 | 20 ++++- src/timing.f90 | 94 +++++++++++++++++++ src/types.f90 | 12 +++ 16 files changed, 473 insertions(+), 245 deletions(-) create mode 100644 src/error.f90 create mode 100644 src/timing.f90 diff --git a/src/Makefile b/src/Makefile index 95260434c4..77cec390d4 100644 --- a/src/Makefile +++ b/src/Makefile @@ -7,6 +7,7 @@ modules = ace.f90 \ data_structures.f90 \ endf.f90 \ energy_grid.f90 \ + error.f90 \ fileio.f90 \ geometry.f90 \ global.f90 \ @@ -19,6 +20,7 @@ modules = ace.f90 \ source.f90 \ string.f90 \ score.f90 \ + timing.f90 \ types.f90 main_objects = $(modules:.f90=.o) $(main:.f90=.o) @@ -59,25 +61,30 @@ unittest: $(test_objects) #-------------------------------------------------------------------- # Dependencies -ace.o: global.o output.o string.o fileio.o string.o endf.o -cross_section.o: global.o string.o data_structures.o output.o +ace.o: global.o output.o string.o fileio.o string.o endf.o error.o +cross_section.o: global.o string.o data_structures.o output.o error.o data_structures.o: global.o endf.o: global.o energy_grid.o: global.o output.o data_structures.o -fileio.o: types.o global.o string.o output.o data_structures.o -geometry.o: types.o global.o output.o string.o data_structures.o +error.o: global.o +fileio.o: types.o global.o string.o output.o data_structures.o \ + error.o +geometry.o: types.o global.o output.o string.o data_structures.o \ + error.o global.o: types.o logging.o: global.o main.o: global.o fileio.o output.o geometry.o mcnp_random.o \ source.o physics.o cross_section.o data_structures.o \ ace.o energy_grid.o score.o logging.o -mpi_routines.o: global.o output.o types.o mcnp_random.o source.o -output.o: global.o types.o data_structures.o endf.o +mpi_routines.o: global.o output.o types.o mcnp_random.o source.o \ + error.o +output.o: global.o types.o data_structures.o endf.o string.o physics.o: types.o global.o mcnp_random.o geometry.o output.o \ - search.o endf.o score.o -score.o: global.o output.o ace.o -search.o: output.o + search.o endf.o score.o error.o +score.o: global.o output.o ace.o error.o +search.o: global.o error.o source.o: global.o mcnp_random.o output.o physics.o -string.o: global.o output.o +string.o: global.o error.o +timing.o: global.o types.o error.o types.o: unittest.o: global.o energy_grid.o mpi_routines.o diff --git a/src/ace.f90 b/src/ace.f90 index 97e5c45af5..b18d160514 100644 --- a/src/ace.f90 +++ b/src/ace.f90 @@ -1,7 +1,8 @@ module ace use global - use output, only: error, message + use error, only: fatal_error + use output, only: message use string, only: lower_case use fileio, only: read_line, read_data, skip_lines use string, only: split_string @@ -68,7 +69,7 @@ contains n_thermal = n_thermal + 1 case default msg = "Unknown cross section table type: " // key - call error(msg) + call fatal_error(msg) end select end do end do @@ -145,11 +146,11 @@ contains inquire(FILE=filename, EXIST=file_exists, READ=readable) if (.not. file_exists) then msg = "ACE library '" // trim(filename) // "' does not exist!" - call error(msg) + call fatal_error(msg) elseif (readable(1:3) == 'NO') then msg = "ACE library '" // trim(filename) // "' is not readable! & &Change file permissions with chmod command." - call error(msg) + call fatal_error(msg) end if ! display message @@ -161,7 +162,7 @@ contains & action='read', iostat=ioError) if (ioError /= 0) then msg = "Error while opening file: " // filename - call error(msg) + call fatal_error(msg) end if found_xs = .false. @@ -169,7 +170,7 @@ contains call read_line(in, line, ioError) if (ioError < 0) then msg = "Could not find ACE table " // tablename // "." - call error(msg) + call fatal_error(msg) end if call split_string(line, words, n) if (trim(words(1)) == trim(tablename)) then @@ -956,11 +957,11 @@ contains inquire(FILE=filename, EXIST=file_exists, READ=readable) if (.not. file_exists) then msg = "ACE library '" // trim(filename) // "' does not exist!" - call error(msg) + call fatal_error(msg) elseif (readable(1:3) == 'NO') then msg = "ACE library '" // trim(filename) // "' is not readable! & &Change file permissions with chmod command." - call error(msg) + call fatal_error(msg) end if ! display message @@ -972,7 +973,7 @@ contains & action='read', iostat=ioError) if (ioError /= 0) then msg = "Error while opening file: " // filename - call error(msg) + call fatal_error(msg) end if found_xs = .false. @@ -980,7 +981,7 @@ contains call read_line(in, line, ioError) if (ioError < 0) then msg = "Could not find ACE table " // tablename // "." - call error(msg) + call fatal_error(msg) end if call split_string(line, words, n) if (trim(words(1)) == trim(tablename)) then diff --git a/src/cross_section.f90 b/src/cross_section.f90 index 54bc61881a..b1bc1a20a6 100644 --- a/src/cross_section.f90 +++ b/src/cross_section.f90 @@ -3,7 +3,8 @@ module cross_section use global use string, only: split_string use data_structures, only: dict_create, dict_add_key, dict_get_key - use output, only: error, message + use output, only: message + use error, only: fatal_error use types, only: xsData implicit none @@ -47,11 +48,11 @@ contains inquire(FILE=filename, EXIST=file_exists, READ=readable) if (.not. file_exists) then msg = "Cross section summary '" // trim(filename) // "' does not exist!" - call error(msg) + call fatal_error(msg) elseif (readable(1:3) == 'NO') then msg = "Cross section summary '" // trim(filename) // "' is not readable!" & & // "Change file permissions with chmod command." - call error(msg) + call fatal_error(msg) end if ! open xsdata file @@ -59,7 +60,7 @@ contains & ACTION='read', IOSTAT=ioError) if (ioError /= 0) then msg = "Error while opening file: " // filename - call error(msg) + call fatal_error(msg) end if ! determine how many lines @@ -72,7 +73,7 @@ contains elseif (ioError > 0) then msg = "Unknown error while reading file: " // filename close(UNIT=in) - call error(msg) + call fatal_error(msg) end if count = count + 1 end do @@ -95,7 +96,7 @@ contains if (n < 9) then msg = "Not enough arguments on xsdata line: " // line close(UNIT=in) - call error(msg) + call fatal_error(msg) end if iso => xsdatas(index) diff --git a/src/error.f90 b/src/error.f90 new file mode 100644 index 0000000000..410691e1d7 --- /dev/null +++ b/src/error.f90 @@ -0,0 +1,74 @@ +module error + + use ISO_FORTRAN_ENV + use global + + implicit none + + integer :: ou = OUTPUT_UNIT + integer :: eu = ERROR_UNIT + +contains + +!=============================================================================== +! WARNING issues a warning to the user in the log file and the standard output +! stream. +!=============================================================================== + + subroutine warning(msg) + + character(*), intent(in) :: msg + + integer :: n_lines + integer :: i + + ! Only allow master to print to screen + if (.not. master) return + + write(ou, fmt='(1X,A9)', advance='no') 'WARNING: ' + + n_lines = (len_trim(msg)-1)/70 + 1 + do i = 1, n_lines + if (i == 1) then + write(ou, fmt='(A70)') msg(70*(i-1)+1:70*i) + else + write(ou, fmt='(10X,A70)') msg(70*(i-1)+1:70*i) + end if + end do + + end subroutine warning + +!=============================================================================== +! FATAL_ERROR alerts the user that an error has been encountered and displays a +! message about the particular problem. Errors are considered 'fatal' and hence +! the program is aborted. +!=============================================================================== + + subroutine fatal_error(msg) + + character(*), intent(in) :: msg + + integer :: n_lines + integer :: i + + ! Only allow master to print to screen + if (master) then + write(eu, fmt='(1X,A7)', advance='no') 'ERROR: ' + + n_lines = (len_trim(msg)-1)/72 + 1 + do i = 1, n_lines + if (i == 1) then + write(eu, fmt='(A72)') msg(72*(i-1)+1:72*i) + else + write(eu, fmt='(7X,A72)') msg(72*(i-1)+1:72*i) + end if + end do + write(eu,*) + end if + + ! All processors abort + call free_memory() + + end subroutine fatal_error + +end module error diff --git a/src/fileio.f90 b/src/fileio.f90 index 96ef4b1ef2..4aa7993575 100644 --- a/src/fileio.f90 +++ b/src/fileio.f90 @@ -4,7 +4,8 @@ module fileio use types, only: Cell, Surface, ExtSource, ListKeyValueCI use string, only: split_string_wl, lower_case, split_string, & & concatenate, is_number - use output, only: message, warning, error + use error, only: fatal_error, warning + use output, only: message use data_structures, only: dict_create, dict_add_key, dict_get_key, & & dict_has_key, DICT_NULL, dict_keys, list_size @@ -44,21 +45,21 @@ contains call GET_COMMAND_ARGUMENT(1, path_input) else msg = "No input file specified!" - call error(msg) + call fatal_error(msg) end if ! Check if input file exists and is readable inquire(FILE=path_input, EXIST=file_exists, READ=readable) if (.not. file_exists) then msg = "Input file '" // trim(path_input) // "' does not exist!" - call error(msg) + call fatal_error(msg) elseif (readable(1:3) == 'NO') then ! Need to explicitly check for a NO status -- Intel compiler looks at ! file attributes only if the file is open on a unit. Therefore, it will ! always return UNKNOWN msg = "Input file '" // trim(path_input) // "' is not readable! & &Change file permissions with chmod command." - call error(msg) + call fatal_error(msg) end if end subroutine read_command_line @@ -101,7 +102,7 @@ contains & ACTION='read', IOSTAT=ioError) if (ioError /= 0) then msg = "Error while opening file: " // filename - call error(msg) + call fatal_error(msg) end if do @@ -149,15 +150,15 @@ contains if (n_cells == 0) then msg = "No cells specified!" close(UNIT=in) - call error(msg) + call fatal_error(msg) elseif (n_surfaces == 0) then msg = "No surfaces specified!" close(UNIT=in) - call error(msg) + call fatal_error(msg) elseif (n_materials == 0) then msg = "No materials specified!" close(UNIT=in) - call error(msg) + call fatal_error(msg) end if close(UNIT=in) @@ -248,7 +249,7 @@ contains & ACTION='read', IOSTAT=ioError) if (ioError /= 0) then msg = "Error while opening file: " // filename - call error(msg) + call fatal_error(msg) end if do @@ -301,7 +302,7 @@ contains verbosity = str_to_int(words(2)) if (verbosity == ERROR_INT) then msg = "Invalid verbosity: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if case default @@ -350,7 +351,7 @@ contains surf_num = abs(surf_num) msg = "Could not find surface " // trim(int_to_str(surf_num)) // & & " specified on cell " // trim(int_to_str(c%uid)) - call error(msg) + call fatal_error(msg) end if c%surfaces(j) = sign(index, surf_num) end if @@ -362,7 +363,7 @@ contains if (index == DICT_NULL) then msg = "Could not find material " // trim(int_to_str(c%material)) // & & " specified on cell " // trim(int_to_str(c%uid)) - call error(msg) + call fatal_error(msg) end if c%material = index end if @@ -372,7 +373,7 @@ contains key_list => dict_keys(bc_dict) if (.not. associated(key_list)) then msg = "No boundary conditions specified!" - call error(msg) + call fatal_error(msg) end if ! Set boundary conditions for surfaces @@ -478,7 +479,7 @@ contains c % uid = str_to_int(words(2)) if (c % uid == ERROR_INT) then msg = "Invalid cell name: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if call dict_add_key(cell_dict, c%uid, index) @@ -486,7 +487,7 @@ contains universe_num = str_to_int(words(3)) if (universe_num == ERROR_INT) then msg = "Invalid universe: " // trim(words(3)) - call error(msg) + call fatal_error(msg) end if c % universe = dict_get_key(universe_dict, universe_num) @@ -499,7 +500,7 @@ contains universe_num = str_to_int(words(5)) if (universe_num == ERROR_INT) then msg = "Invalid universe fill: " // trim(words(5)) - call error(msg) + call fatal_error(msg) end if ! check whether universe or lattice @@ -516,7 +517,7 @@ contains c % fill = 0 if (c % material == ERROR_INT) then msg = "Invalid material number: " // trim(words(4)) - call error(msg) + call fatal_error(msg) end if n_surfaces = n_words - 4 end if @@ -571,7 +572,7 @@ contains read(words(2), FMT='(I8)', IOSTAT=ioError) surf % uid if (ioError > 0) then msg = "Invalid surface name: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if call dict_add_key(surface_dict, surf % uid, index) @@ -620,13 +621,13 @@ contains coeffs_reqd = 10 case default msg = "Invalid surface type: " // trim(words(3)) - call error(msg) + call fatal_error(msg) end select ! Make sure there are enough coefficients for surface type if (n_words-3 < coeffs_reqd) then msg = "Not enough coefficients for surface: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if ! Read list of surfaces @@ -657,7 +658,7 @@ contains surface_uid = str_to_int(words(2)) if (surface_uid == ERROR_INT) then msg = "Invalid surface name: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if ! Read boundary condition @@ -672,7 +673,7 @@ contains bc = BC_REFLECT case default msg = "Invalid boundary condition: " // trim(words(3)) - call error(msg) + call fatal_error(msg) end select ! Add (uid, bc) to dictionary @@ -705,7 +706,7 @@ contains universe_num = str_to_int(words(2)) if (universe_num == ERROR_INT) then msg = "Invalid universe: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if lat % uid = universe_num @@ -719,7 +720,7 @@ contains lat % type = LATTICE_HEX case default msg = "Invalid lattice type: " // trim(words(3)) - call error(msg) + call fatal_error(msg) end select ! Read number of lattice cells in each direction @@ -727,10 +728,10 @@ contains n_y = str_to_int(words(5)) if (n_x == ERROR_INT) then msg = "Invalid number of lattice cells in x-direction: " // trim(words(4)) - call error(msg) + call fatal_error(msg) elseif (n_y == ERROR_INT) then msg = "Invalid number of lattice cells in y-direction: " // trim(words(5)) - call error(msg) + call fatal_error(msg) end if lat % n_x = n_x lat % n_y = n_y @@ -747,7 +748,7 @@ contains if (n_words - 9 < n_x * n_y) then print *, n_words, n_x, n_y msg = "Not enough lattice positions specified." - call error(msg) + call fatal_error(msg) end if ! Read lattice positions @@ -758,7 +759,7 @@ contains universe_num = str_to_int(words(index_word)) if (universe_num == ERROR_INT) then msg = "Invalid universe number: " // trim(words(index_word)) - call error(msg) + call fatal_error(msg) end if lat % element(i, n_y-j) = dict_get_key(universe_dict, universe_num) end do @@ -790,13 +791,13 @@ contains values_reqd = 6 case default msg = "Invalid source type: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end select ! Make sure there are enough values for this source type if (n_words-2 < values_reqd) then msg = "Not enough values for source of type: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if ! Read values @@ -835,7 +836,7 @@ contains t % uid = str_to_int(words(2)) if (t % uid == ERROR_INT) then msg = "Invalid tally name: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if call dict_add_key(tally_dict, t % uid, index) @@ -863,7 +864,7 @@ contains MT = str_to_int(words(i+j)) if (MT == ERROR_INT) then msg = "Invalid reaction MT on tally: " // int_to_str(t%uid) - call error(msg) + call fatal_error(msg) end if t % reactions(j) = MT end do @@ -895,7 +896,7 @@ contains cell_uid = str_to_int(words(i+j)) if (cell_uid == ERROR_INT) then msg = "Invalid cell number on tally: " // int_to_str(t%uid) - call error(msg) + call fatal_error(msg) end if t % cells(j) = cell_uid end do @@ -927,7 +928,7 @@ contains E = str_to_real(words(i+j)) if (E == ERROR_REAL) then msg = "Invalid energy on tally: " // int_to_str(t % uid) - call error(msg) + call fatal_error(msg) end if t % energies(j) = E end do @@ -982,7 +983,7 @@ contains ! Check for correct number of arguments if (mod(n_words,2) == 0 .or. n_words < 5) then msg = "Invalid number of arguments for material: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if ! Determine and set number of isotopes @@ -994,7 +995,7 @@ contains read(words(2), FMT='(I8)', IOSTAT=ioError) mat % uid if (ioError > 0) then msg = "Invalid surface name: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if call dict_add_key(material_dict, mat%uid, index) @@ -1045,7 +1046,7 @@ contains & all(mat%atom_percent < ZERO))) then msg = "Cannot mix atom and weight percents in material " // & & int_to_str(mat%uid) - call error(msg) + call fatal_error(msg) end if percent_in_atom = (mat%atom_percent(1) > ZERO) @@ -1059,7 +1060,7 @@ contains if (index == DICT_NULL) then msg = "Cannot find cross-section " // trim(key) // " in specified & &xsdata file." - call error(msg) + call fatal_error(msg) end if mat % isotopes(j) = index @@ -1130,21 +1131,21 @@ contains n_cycles = str_to_int(words(2)) if (n_cycles == ERROR_INT) then msg = "Invalid number of cycles: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if ! Read number of inactive cycles n_inactive = str_to_int(words(3)) if (n_inactive == ERROR_INT) then msg = "Invalid number of inactive cycles: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if ! Read number of particles n_particles = str_to_int(words(4)) if (n_particles == ERROR_INT) then msg = "Invalid number of particles: " // trim(words(2)) - call error(msg) + call fatal_error(msg) end if end subroutine read_criticality diff --git a/src/geometry.f90 b/src/geometry.f90 index 0d1839a5e4..cfd4d423cc 100644 --- a/src/geometry.f90 +++ b/src/geometry.f90 @@ -2,7 +2,8 @@ module geometry use global use types, only: Cell, Surface - use output, only: error, message + use output, only: message + use error, only: fatal_error use data_structures, only: dict_get_key implicit none @@ -128,7 +129,7 @@ contains exit else msg = "Could not locate particle in universe: " - call error(msg) + call fatal_error(msg) end if elseif (c % type == CELL_LATTICE) then ! Set current lattice @@ -156,7 +157,7 @@ contains else msg = "Could not locate particle in lattice: " & & // int_to_str(lat % uid) - call error(msg) + call fatal_error(msg) end if end if end if @@ -209,7 +210,7 @@ contains call find_cell(lower_univ, p, found) if (.not. found) then msg = "Could not locate particle in universe: " - call error(msg) + call fatal_error(msg) end if else ! set current pointers @@ -232,7 +233,7 @@ contains call find_cell(lower_univ, p, found) if (.not. found) then msg = "Could not locate particle in universe: " - call error(msg) + call fatal_error(msg) end if else ! set current pointers @@ -259,7 +260,7 @@ contains ! Couldn't find next cell anywhere! msg = "After particle crossed surface " // trim(int_to_str(p%surface)) // & & ", it could not be located in any cell and it did not leak." - call error(msg) + call fatal_error(msg) end subroutine cross_surface @@ -358,10 +359,10 @@ contains i_y = p % index_y if (i_x < 1 .or. i_x > lat % n_x) then msg = "Reached edge of lattice." - call error(msg) + call fatal_error(msg) elseif (i_y < 1 .or. i_y > lat % n_y) then msg = "Reached edge of lattice." - call error(msg) + call fatal_error(msg) end if ! Find universe for next lattice element @@ -371,7 +372,7 @@ contains call find_cell(univ, p, found) if (.not. found) then msg = "Could not locate particle in universe: " - call error(msg) + call fatal_error(msg) end if end subroutine cross_lattice @@ -699,7 +700,7 @@ contains case (SURF_GQ) msg = "Surface distance not yet implement for general quadratic." - call error(msg) + call fatal_error(msg) end select diff --git a/src/global.f90 b/src/global.f90 index b2bd3fb44a..e7757a0eba 100644 --- a/src/global.f90 +++ b/src/global.f90 @@ -87,6 +87,12 @@ module global logical :: master ! master process? logical :: mpi_enabled ! is MPI in use and initialized? + ! Timing variables + type(TimerObj) :: time_total ! timer for total run + type(TimerObj) :: time_init ! timer for initialization + type(TimerObj) :: time_intercycle ! timer for intercycle synchronization + type(TimerObj) :: time_compute ! timer for computation + ! Paths to input file, cross section data, etc character(max_word_len) :: & & path_input, & diff --git a/src/main.f90 b/src/main.f90 index c2dcf5eb45..acd4a5bb70 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -2,9 +2,9 @@ program main use global use fileio, only: read_input, read_command_line, read_count, & - & normalize_ao, build_universe - use output, only: title, echo_input, message, warning, error, & - & print_summary, print_particle + normalize_ao, build_universe + use output, only: title, echo_input, message, print_summary, & + print_particle, header, print_runtime use geometry, only: neighbor_lists use mcnp_random, only: RN_init_problem, RN_init_particle use source, only: init_source, get_source_particle @@ -12,9 +12,10 @@ program main use cross_section, only: read_xsdata, material_total_xs use ace, only: read_xs use energy_grid, only: unionized_grid, original_indices - use mpi_routines, only: setup_mpi, synchronize_bank, t_sync + use mpi_routines, only: setup_mpi, synchronize_bank use score, only: calculate_keff use logging, only: create_log + use timing, only: timer_start, timer_stop #ifdef MPI use mpi @@ -26,6 +27,10 @@ program main character(max_line_len) :: msg type(Universe), pointer :: univ + ! Start timers + call timer_start(time_total) + call timer_start(time_init) + ! Setup MPI call setup_mpi() @@ -38,6 +43,11 @@ program main ! Initialize random number generator. The first argument corresponds to which ! random number generator to use- in this case one of the L'Ecuyer 63-bit ! RNGs. + + ! Print initialization header block + if (master) call header("INITIALIZATION", 1) + + ! initialize random number generator call RN_init_problem(3, 0_8, 0_8, 0_8, 0) ! Set default values for settings @@ -75,17 +85,23 @@ program main ! calculate total material cross-sections for sampling path lenghts call material_total_xs() + ! create source particles + call init_source() + + ! stop timer for initialization + call timer_stop(time_init) if (master) then call echo_input() call print_summary() end if - ! create source particles - call init_source() - ! start problem call run_problem() + ! show timing statistics + call timer_stop(time_total) + if (master) call print_runtime() + ! deallocate arrays call free_memory() @@ -108,23 +124,25 @@ contains type(Particle), pointer :: p => null() character(max_line_len) :: msg - msg = "Running problem..." - call message(msg, 6) + if (master) call header("BEGIN SIMULATION", 1) tallies_on = .false. -#ifdef MPI - t0 = MPI_WTIME() -#endif - + ! ========================================================================== + ! LOOP OVER CYCLES CYCLE_LOOP: do i_cycle = 1, n_cycles + ! Start timer for computation + call timer_start(time_compute) + msg = "Simulating cycle " // trim(int_to_str(i_cycle)) // "..." call message(msg, 8) ! Set all tallies to zero n_bank = 0 + ! ======================================================================= + ! LOOP OVER HISTORIES HISTORY_LOOP: do ! grab source particle from bank @@ -143,6 +161,16 @@ contains end do HISTORY_LOOP + ! Accumulate time for computation + call timer_stop(time_compute) + + ! ======================================================================= + ! WRAP UP FISSION BANK AND COMPUTE TALLIES, KEFF, ETC + + ! Start timer for inter-cycle synchronization + call timer_start(time_intercycle) + + ! Distribute fission bank across processors evenly call synchronize_bank(i_cycle) ! Collect results and statistics @@ -153,19 +181,10 @@ contains ! Turn tallies on once inactive cycles are complete if (i_cycle == n_inactive) tallies_on = .true. - end do CYCLE_LOOP + ! Stop timer for inter-cycle synchronization + call timer_stop(time_intercycle) -#ifdef MPI - ! print run time - t1 = MPI_WTIME() - if (master) then - print *, "Time elapsed = " // real_to_str(t1 - t0) - print *, "Init time = " // real_to_str(t_sync(1)) - print *, "Sample time = " // real_to_str(t_sync(2)) - print *, "Send/recv time = " // real_to_str(t_sync(3)) - print *, "Rebuild time = " // real_to_str(t_sync(4)) - end if -#endif + end do CYCLE_LOOP end subroutine run_problem diff --git a/src/mpi_routines.f90 b/src/mpi_routines.f90 index 9cf687c2ef..f5a7a0c826 100644 --- a/src/mpi_routines.f90 +++ b/src/mpi_routines.f90 @@ -1,7 +1,8 @@ module mpi_routines use global - use output, only: message, error + use error, only: fatal_error + use output, only: message use mcnp_random, only: rang, RN_init_particle, RN_skip use source, only: copy_from_bank, source_index @@ -41,21 +42,21 @@ contains call MPI_INIT(ierr) if (ierr /= MPI_SUCCESS) then msg = "Failed to initialize MPI." - call error(msg) + call fatal_error(msg) end if ! Determine number of processors call MPI_COMM_SIZE(MPI_COMM_WORLD, n_procs, ierr) if (ierr /= MPI_SUCCESS) then msg = "Could not determine number of processors." - call error(msg) + call fatal_error(msg) end if ! Determine rank of each processor call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr) if (ierr /= MPI_SUCCESS) then msg = "Could not determine MPI rank." - call error(msg) + call fatal_error(msg) end if ! Determine master @@ -157,7 +158,7 @@ contains ! Check if there are no fission sites if (total == 0) then msg = "No fission sites banked!" - call error(msg) + call fatal_error(msg) end if ! Make sure all processors start at the same point for random sampling diff --git a/src/output.f90 b/src/output.f90 index 2d3a3a5c1f..4caa3c205d 100644 --- a/src/output.f90 +++ b/src/output.f90 @@ -5,6 +5,7 @@ module output use types, only: Cell, Universe, Surface use data_structures, only: dict_get_key use endf, only: reaction_name + use string, only: upper_case implicit none @@ -24,17 +25,17 @@ contains character(8) :: time write(ou,*) - write(ou,*) ' .d88888b. 888b d888 .d8888b. ' - write(ou,*) 'd88P" "Y88b 8888b d8888 d88P Y88b' - write(ou,*) '888 888 88888b.d88888 888 888' - write(ou,*) '888 888 88888b. .d88b. 88888b. 888Y88888P888 888 ' - write(ou,*) '888 888 888 "88b d8P Y8b 888 "88b 888 Y888P 888 888 ' - write(ou,*) '888 888 888 888 88888888 888 888 888 Y8P 888 888 888' - write(ou,*) 'Y88b. .d88P 888 d88P Y8b. 888 888 888 " 888 Y88b d88P' - write(ou,*) ' "Y88888P" 88888P" "Y8888 888 888 888 888 "Y8888P" ' - write(ou,*) '____________888________________________________________________' - write(ou,*) ' 888 ' - write(ou,*) ' 888 ' + write(ou,*) ' .d88888b. 888b d888 .d8888b.' + write(ou,*) ' d88P" "Y88b 8888b d8888 d88P Y88b' + write(ou,*) ' 888 888 88888b.d88888 888 888' + write(ou,*) ' 888 888 88888b. .d88b. 88888b. 888Y88888P888 888 ' + write(ou,*) ' 888 888 888 "88b d8P Y8b 888 "88b 888 Y888P 888 888 ' + write(ou,*) ' 888 888 888 888 88888888 888 888 888 Y8P 888 888 888' + write(ou,*) ' Y88b. .d88P 888 d88P Y8b. 888 888 888 " 888 Y88b d88P' + write(ou,*) ' "Y88888P" 88888P" "Y8888 888 888 888 888 "Y8888P"' + write(ou,*) '__________________888______________________________________________________' + write(ou,*) ' 888' + write(ou,*) ' 888' write(ou,*) ! Write version information @@ -59,10 +60,7 @@ contains subroutine echo_input() ! Display problem summary - write(ou,*) '=============================================' - write(ou,*) '=> PROBLEM SUMMARY <=' - write(ou,*) '=============================================' - write(ou,*) + call header("PROBLEM SUMMARY") if (problem_type == PROB_CRITICALITY) then write(ou,100) 'Problem type:', 'Criticality' write(ou,100) 'Number of Cycles:', int_to_str(n_cycles) @@ -71,22 +69,73 @@ contains write(ou,100) 'Problem type:', 'External Source' end if write(ou,100) 'Number of Particles:', int_to_str(n_particles) - write(ou,*) + ! Display geometry summary - write(ou,*) '=============================================' - write(ou,*) '=> GEOMETRY SUMMARY <=' - write(ou,*) '=============================================' - write(ou,*) + call header("GEOMETRY SUMMARY") write(ou,100) 'Number of Cells:', int_to_str(n_cells) write(ou,100) 'Number of Surfaces:', int_to_str(n_surfaces) write(ou,100) 'Number of Materials:', int_to_str(n_materials) - write(ou,*) ! Format descriptor for columns 100 format (1X,A,T35,A) end subroutine echo_input +!=============================================================================== +! HEADER displays a header block according to a specified level. If no level is +! specified, it is assumed to be a minor header block (H3). +!=============================================================================== + + subroutine header(msg, level) + + character(*), intent(in) :: msg + integer, optional :: level + + integer :: header_level + integer :: n, m + character(75) :: line + + ! set default header level + if (.not. present(level)) then + header_level = 3 + else + header_level = level + end if + + ! Print first blank line + write(ou,*) + + ! determine how many times to repeat '=' character + n = (63 - len_trim(msg))/2 + m = n + if (mod(len_trim(msg),2) == 0) m = m + 1 + + ! convert line to upper case + line = msg + call upper_case(line) + + ! print header based on level + select case (header_level) + case (1) + ! determine number of spaces to put in from of header + write(ou,*) repeat('=', 75) + write(ou,*) repeat('=', n) // '> ' // trim(line) // ' <' // & + & repeat('=', m) + write(ou,*) repeat('=', 75) + case (2) + write(ou,*) trim(line) + write(ou,*) repeat('-', 75) + case (3) + n = (63 - len_trim(line))/2 + write(ou,*) repeat('=', n) // '> ' // trim(line) // ' <' // & + & repeat('=', m) + end select + + ! Print trailing blank line + write(ou, *) + + end subroutine header + !=============================================================================== ! MESSAGE displays an informational message to the log file and the standard ! output stream. @@ -112,67 +161,6 @@ contains end subroutine message -!=============================================================================== -! WARNING issues a warning to the user in the log file and the standard output -! stream. -!=============================================================================== - - subroutine warning(msg) - - character(*), intent(in) :: msg - - integer :: n_lines - integer :: i - - ! Only allow master to print to screen - if (.not. master) return - - write(ou, fmt='(1X,A9)', advance='no') 'WARNING: ' - - n_lines = (len_trim(msg)-1)/70 + 1 - do i = 1, n_lines - if (i == 1) then - write(ou, fmt='(A70)') msg(70*(i-1)+1:70*i) - else - write(ou, fmt='(10X,A70)') msg(70*(i-1)+1:70*i) - end if - end do - - end subroutine warning - -!=============================================================================== -! ERROR alerts the user that an error has been encountered and displays a -! message about the particular problem. Errors are considered 'fatal' and hence -! the program is aborted. -!=============================================================================== - - subroutine error(msg) - - character(*), intent(in) :: msg - - integer :: n_lines - integer :: i - - ! Only allow master to print to screen - if (master) then - write(eu, fmt='(1X,A7)', advance='no') 'ERROR: ' - - n_lines = (len_trim(msg)-1)/72 + 1 - do i = 1, n_lines - if (i == 1) then - write(eu, fmt='(A72)') msg(72*(i-1)+1:72*i) - else - write(eu, fmt='(7X,A72)') msg(72*(i-1)+1:72*i) - end if - end do - write(eu,*) - end if - - ! All processors abort - call free_memory() - - end subroutine error - !=============================================================================== ! GET_TODAY determines the date and time at which the program began execution ! and returns it in a readable format @@ -585,20 +573,14 @@ contains integer :: i ! print summary of cells - write(ou,*) '=============================================' - write(ou,*) '=> CELL SUMMARY <=' - write(ou,*) '=============================================' - write(ou,*) + call header("CELL SUMMARY") do i = 1, n_cells c => cells(i) call print_cell(c) end do ! print summary of universes - write(ou,*) '=============================================' - write(ou,*) '=> UNIVERSE SUMMARY <=' - write(ou,*) '=============================================' - write(ou,*) + call header("UNIVERSE SUMMARY") do i = 1, n_universes u => universes(i) call print_universe(u) @@ -606,10 +588,7 @@ contains ! print summary of lattices if (n_lattices > 0) then - write(ou,*) '=============================================' - write(ou,*) '=> LATTICE SUMMARY <=' - write(ou,*) '=============================================' - write(ou,*) + call header("LATTICE SUMMARY") do i = 1, n_lattices l => lattices(i) call print_lattice(l) @@ -617,20 +596,14 @@ contains end if ! print summary of surfaces - write(ou,*) '=============================================' - write(ou,*) '=> SURFACE SUMMARY <=' - write(ou,*) '=============================================' - write(ou,*) + call header("SURFACE SUMMARY") do i = 1, n_surfaces s => surfaces(i) call print_surface(s) end do ! print summary of materials - write(ou,*) '=============================================' - write(ou,*) '=> MATERIAL SUMMARY <=' - write(ou,*) '=============================================' - write(ou,*) + call header("MATERIAL SUMMARY") do i = 1, n_materials m => materials(i) call print_material(m) @@ -638,10 +611,7 @@ contains ! print summary of tallies if (n_tallies > 0) then - write(ou,*) '=============================================' - write(ou,*) '=> TALLY SUMMARY <=' - write(ou,*) '=============================================' - write(ou,*) + call header("TALLY SUMMARY") do i = 1, n_tallies t=> tallies(i) call print_tally(t) @@ -657,4 +627,25 @@ contains end subroutine print_summary +!=============================================================================== +! PRINT_RUNTIME displays the total time elapsed for the entire run, for +! initialization, for computation, and for intercycle synchronization. +!=============================================================================== + + subroutine print_runtime() + + ! display header block + call header("Time Elapsed") + + ! display time elapsed for various sections + write(ou,100) "Total time elapsed", real_to_str(time_total % elapsed) + write(ou,100) "Total time for initialization", real_to_str(time_init % elapsed) + write(ou,100) "Total time in computation", real_to_str(time_compute % elapsed) + write(ou,100) "Total time between cycles", real_to_str(time_intercycle % elapsed) + + ! format for write statments +100 format (1X,A,T33,"= ",A,"seconds") + + end subroutine print_runtime + end module output diff --git a/src/physics.f90 b/src/physics.f90 index 6f77cd6937..818afd671c 100644 --- a/src/physics.f90 +++ b/src/physics.f90 @@ -5,7 +5,8 @@ module physics & cross_lattice use types, only: Particle use mcnp_random, only: rang - use output, only: error, warning, message, print_particle + use output, only: message, print_particle + use error, only: fatal_error, warning use search, only: binary_search use endf, only: reaction_name use score, only: score_tally @@ -42,7 +43,7 @@ contains if (.not. found_cell) then write(msg, 100) "Could not locate cell for particle at: ", p % xyz 100 format (A,3ES11.3) - call error(msg) + call fatal_error(msg) end if end if @@ -381,7 +382,7 @@ contains ! DETERMINE TOTAL NU if (table % nu_t_type == NU_NONE) then msg = "No neutron emission data for table: " // table % name - call error(msg) + call fatal_error(msg) elseif (table % nu_t_type == NU_POLYNOMIAL) then ! determine number of coefficients NC = int(table % nu_t_data(1)) @@ -400,7 +401,7 @@ contains if (NR /= 0) then msg = "Multiple interpolation regions not supported while & &attempting to determine total nu." - call error(msg) + call fatal_error(msg) end if ! determine number of energies @@ -449,7 +450,7 @@ contains if (NR /= 0) then msg = "Multiple interpolation regions not supported while & &attempting to determine prompt nu." - call error(msg) + call fatal_error(msg) end if ! determine number of energies @@ -486,7 +487,7 @@ contains if (NR /= 0) then msg = "Multiple interpolation regions not supported while & &attempting to determine delayed nu." - call error(msg) + call fatal_error(msg) end if ! determine number of energies @@ -551,7 +552,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &sampling delayed neutron precursor yield." - call error(msg) + call fatal_error(msg) end if ! interpolate on energy grid @@ -902,7 +903,7 @@ contains end if else msg = "Unknown interpolation type: " // trim(int_to_str(interp)) - call error(msg) + call fatal_error(msg) end if if (abs(mu) > ONE) then @@ -914,7 +915,7 @@ contains else msg = "Unknown angular distribution type: " // trim(int_to_str(type)) - call error(msg) + call fatal_error(msg) end if end function sample_angle @@ -1031,7 +1032,7 @@ contains if (edist % n_interp > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample secondary energy distribution." - call error(msg) + call fatal_error(msg) end if ! Determine which secondary energy distribution law to use @@ -1048,7 +1049,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample equiprobable energy bins." - call error(msg) + call fatal_error(msg) end if ! determine index on incoming energy grid and interpolation factor @@ -1095,7 +1096,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample continuous tabular distribution." - call error(msg) + call fatal_error(msg) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1154,7 +1155,7 @@ contains ! discrete lines present msg = "Discrete lines in continuous tabular distributed not & &yet supported" - call error(msg) + call fatal_error(msg) end if ! determine outgoing energy bin @@ -1188,7 +1189,7 @@ contains end if else msg = "Unknown interpolation type: " // trim(int_to_str(INTT)) - call error(msg) + call fatal_error(msg) end if ! Now interpolate between incident energy bins i and i + 1 @@ -1212,7 +1213,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample Maxwell fission spectrum." - call error(msg) + call fatal_error(msg) end if ! find incident energy bin and calculate interpolation factor @@ -1247,7 +1248,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample evaporation spectrum." - call error(msg) + call fatal_error(msg) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1295,7 +1296,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample Watt fission spectrum." - call error(msg) + call fatal_error(msg) end if ! find incident energy bin and calculate interpolation factor @@ -1325,7 +1326,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample Watt fission spectrum." - call error(msg) + call fatal_error(msg) end if ! find incident energy bin and calculate interpolation factor @@ -1356,7 +1357,7 @@ contains if (.not. present(mu_out)) then msg = "Law 44 called without giving mu_out as argument." - call error(msg) + call fatal_error(msg) end if ! read number of interpolation regions and incoming energies @@ -1365,7 +1366,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample Kalbach-Mann distribution." - call error(msg) + call fatal_error(msg) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1425,7 +1426,7 @@ contains ! discrete lines present msg = "Discrete lines in continuous tabular distributed not & &yet supported" - call error(msg) + call fatal_error(msg) end if ! determine outgoing energy bin @@ -1473,7 +1474,7 @@ contains KM_A = A_k + (A_k1 - A_k)*(E_out - E_l_k)/(E_l_k1 - E_l_k) else msg = "Unknown interpolation type: " // trim(int_to_str(INTT)) - call error(msg) + call fatal_error(msg) end if ! Now interpolate between incident energy bins i and i + 1 @@ -1499,7 +1500,7 @@ contains if (.not. present(mu_out)) then msg = "Law 44 called without giving mu_out as argument." - call error(msg) + call fatal_error(msg) end if ! read number of interpolation regions and incoming energies @@ -1508,7 +1509,7 @@ contains if (NR > 0) then msg = "Multiple interpolation regions not supported while & &attempting to sample correlated energy-angle distribution." - call error(msg) + call fatal_error(msg) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1568,7 +1569,7 @@ contains ! discrete lines present msg = "Discrete lines in continuous tabular distributed not & &yet supported" - call error(msg) + call fatal_error(msg) end if ! determine outgoing energy bin @@ -1603,7 +1604,7 @@ contains end if else msg = "Unknown interpolation type: " // trim(int_to_str(INTT)) - call error(msg) + call fatal_error(msg) end if ! Now interpolate between incident energy bins i and i + 1 @@ -1656,7 +1657,7 @@ contains end if else msg = "Unknown interpolation type: " // trim(int_to_str(JJ)) - call error(msg) + call fatal_error(msg) end if case (66) diff --git a/src/score.f90 b/src/score.f90 index ffcda97e8b..75bcf50cf4 100644 --- a/src/score.f90 +++ b/src/score.f90 @@ -1,7 +1,8 @@ module score use global - use output, only: message, error + use output, only: message + use error, only: fatal_error use ace, only: get_macro_xs use search, only: binary_search @@ -141,7 +142,7 @@ contains end do else msg = "Invalid type for cell bins in tally " // int_to_str(t % uid) - call error(msg) + call fatal_error(msg) end if ! ======================================================================= diff --git a/src/search.f90 b/src/search.f90 index e06642111e..b039a0f2b9 100644 --- a/src/search.f90 +++ b/src/search.f90 @@ -1,7 +1,7 @@ module search use global - use output, only: error + use error, only: fatal_error contains @@ -27,7 +27,7 @@ contains if (val < array(L) .or. val > array(R)) then msg = "Value outside of array during binary search" - call error(msg) + call fatal_error(msg) end if do while (R - L > 1) diff --git a/src/string.f90 b/src/string.f90 index c7be8311f6..80f6f294c3 100644 --- a/src/string.f90 +++ b/src/string.f90 @@ -1,7 +1,7 @@ module string use global - use output, only: error, warning + use error, only: warning implicit none @@ -162,6 +162,24 @@ contains end subroutine lower_case +!=============================================================================== +! UPPER_CASE converts a string to all upper case characters +!=============================================================================== + + elemental subroutine upper_case(word) + + character(*), intent(inout) :: word + + integer :: i + integer :: ic + + do i = 1,len(word) + ic = ichar(word(i:i)) + if (ic >= 97 .and. ic < 122) word(i:i) = char(ic-32) + end do + + end subroutine upper_case + !=============================================================================== ! IS_NUMBER determines whether a string of characters is all 0-9 characters !=============================================================================== diff --git a/src/timing.f90 b/src/timing.f90 new file mode 100644 index 0000000000..90d7e1d79d --- /dev/null +++ b/src/timing.f90 @@ -0,0 +1,94 @@ +module timing + + use global + use types, only: TimerObj + use error, only: warning + + implicit none + +contains + +!=============================================================================== +! TIMER_START +!=============================================================================== + + subroutine timer_start(timer) + + type(TimerObj), intent(inout) :: timer + + character(max_line_len) :: msg ! warning message + + ! Check if timer is already running + if (timer % running) then + msg = "Tried to start a timer that was already running!" + call warning(msg) + return + end if + + ! Turn timer on and measure starting time + timer % running = .true. + call system_clock(timer % start_counts) + + end subroutine timer_start + +!=============================================================================== +! TIMER_GET_VALUE +!=============================================================================== + + function timer_get_value(timer) result(elapsed) + + type(TimerObj), intent(in) :: timer ! the timer + real(8) :: elapsed ! total elapsed time + + integer :: end_counts ! current number of counts + integer :: count_rate ! system-dependent counting rate + real :: elapsed_time ! elapsed time since last start + + if (timer % running) then + call system_clock(end_counts, count_rate) + elapsed_time = real(end_counts - timer % start_counts)/real(count_rate) + elapsed = timer % elapsed + elapsed_time + else + elapsed = timer % elapsed + end if + + end function timer_get_value + +!=============================================================================== +! TIMER_STOP +!=============================================================================== + + subroutine timer_stop(timer) + + type(TimerObj), intent(inout) :: timer + + character(max_line_len) :: msg + + ! Check to make sure timer was running + if (.not. timer % running) then + msg = "Tried to stop a timer that was not running!" + call warning(msg) + return + end if + + ! Stop timer and add time + timer % elapsed = timer_get_value(timer) + timer % running = .false. + + end subroutine timer_stop + +!=============================================================================== +! TIMER_RESET +!=============================================================================== + + subroutine timer_reset(timer) + + type(TimerObj), intent(inout) :: timer + + timer % running = .false. + timer % start_counts = 0 + timer % elapsed = ZERO + + end subroutine timer_reset + +end module timing diff --git a/src/types.f90 b/src/types.f90 index 4d0077e572..522ef77854 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -313,6 +313,18 @@ module types character(150) :: path end type xsData +!=============================================================================== +! TIMEROBJ represents a timer that can be started and stopped to measure how +! long different routines run. The intrinsic routine system_clock is used to +! measure time rather than cpu_time. +!=============================================================================== + + type TimerObj + logical :: running = .false. ! is timer running? + integer :: start_counts = 0 ! counts when started + real(8) :: elapsed = 0. ! total time elapsed in seconds + end type TimerObj + !=============================================================================== ! KEYVALUECI stores the (key,value) pair for a dictionary where the key is a ! string and the value is an integer. Note that we need to store the key in