crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-28 14:15:42 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 5

Added timing class. Moved warnings and errors to a new module named error. Removed many MPI_WTIME calls.

Browse source
This commit is contained in:
Paul Romano 2011-07-25 20:41:54 -04:00
parent a29c7d8db4
commit bc3924af7d
16 changed files with 473 additions and 245 deletions
Download patch file Download diff file Expand all files Collapse all files

27
src/Makefile
View file

@ -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

21
src/ace.f90
View file

@ -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

13
src/cross_section.f90
View file

@ -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)

74
src/error.f90 Normal file
View file

@ -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

83
src/fileio.f90
View file

@ -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

21
src/geometry.f90
View file

@ -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

6
src/global.f90
View file

@ -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, &

69
src/main.f90
View file

@ -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

11
src/mpi_routines.f90
View file

@ -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

203
src/output.f90
View file

@ -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

55
src/physics.f90
View file

@ -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)

5
src/score.f90
View file

@ -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
! =======================================================================

4
src/search.f90
View file

@ -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)

20
src/string.f90
View file

@ -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
!===============================================================================

94
src/timing.f90 Normal file
View file

@ -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

12
src/types.f90
View file

@ -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