From b11c54f52b796f57bad60e52eb739aaf40c3e2ef Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 25 Jul 2014 09:08:36 -0400 Subject: [PATCH] changed how messages are handled Conflicts: src/cmfd_execute.F90 src/input_xml.F90 src/string.F90 src/tally_new.F90 src/tracking.F90 --- src/ace.F90 | 16 +- src/cmfd_data.F90 | 9 +- src/cmfd_execute.F90 | 18 +- src/cmfd_input.F90 | 32 ++-- src/cmfd_solver.F90 | 22 +-- src/eigenvalue.F90 | 12 +- src/energy_grid.F90 | 2 +- src/error.F90 | 6 +- src/fission.F90 | 3 +- src/fixed_source.F90 | 2 +- src/geometry.F90 | 20 +-- src/initialize.F90 | 40 ++--- src/input_xml.F90 | 354 +++++++++++++++++++-------------------- src/interpolation.F90 | 5 +- src/output.F90 | 6 +- src/particle_restart.F90 | 2 +- src/physics.F90 | 56 +++---- src/plot.F90 | 2 +- src/search.F90 | 14 +- src/solver_interface.F90 | 6 +- src/source.F90 | 16 +- src/state_point.F90 | 20 +-- src/string.F90 | 6 +- src/tally.F90 | 22 +-- src/tracking.F90 | 6 +- src/xml_interface.F90 | 21 ++- 26 files changed, 360 insertions(+), 358 deletions(-) diff --git a/src/ace.F90 b/src/ace.F90 index 6696c1dfa4..a5b042f3ab 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -155,7 +155,7 @@ contains if (mat % i_sab_nuclides(k) == NONE) then message = "S(a,b) table " // trim(mat % sab_names(k)) // " did not & &match any nuclide on material " // trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if end do ASSIGN_SAB @@ -267,16 +267,16 @@ contains inquire(FILE=filename, EXIST=file_exists, READ=readable) if (.not. file_exists) then message = "ACE library '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) elseif (readable(1:3) == 'NO') then message = "ACE library '" // trim(filename) // "' is not readable! & &Change file permissions with chmod command." - call fatal_error() + call fatal_error(message) end if ! display message message = "Loading ACE cross section table: " // listing % name - call write_message(6) + call write_message(message, 6) if (filetype == ASCII) then ! ======================================================================= @@ -297,7 +297,7 @@ contains if(adjustl(name) /= adjustl(listing % name)) then message = "XS listing entry " // trim(listing % name) // " did not & &match ACE data, " // trim(name) // " found instead." - call fatal_error() + call fatal_error(message) end if ! Read more header and NXS and JXS @@ -380,7 +380,7 @@ contains ! abort the run. if (run_mode == MODE_FIXEDSOURCE .and. nuc % fissionable) then message = "Cannot have fissionable material in a fixed source run." - call fatal_error() + call fatal_error(message) end if ! for fissionable nuclides, precalculate microscopic nu-fission cross @@ -1319,7 +1319,7 @@ contains if (nuc % urr_inelastic == NONE) then message = "Could not find inelastic reaction specified on " & // "unresolved resonance probability table." - call fatal_error() + call fatal_error(message) end if end if @@ -1347,7 +1347,7 @@ contains if (any(nuc % urr_data % prob < ZERO)) then message = "Negative value(s) found on probability table for nuclide " & // nuc % name - call warning() + if (master) call warning(message) end if end subroutine read_unr_res diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 2e4d1e1c4e..c49fc7808c 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -5,6 +5,7 @@ module cmfd_data ! parameters for CMFD calculation. !============================================================================== + use constants implicit none private @@ -55,7 +56,7 @@ contains OUT_FRONT, IN_TOP, OUT_TOP, CMFD_NOACCEL, ZERO, & ONE, TINY_BIT use error, only: fatal_error - use global, only: cmfd, message, n_cmfd_tallies, cmfd_tallies, meshes,& + use global, only: cmfd, n_cmfd_tallies, cmfd_tallies, meshes,& matching_bins use mesh, only: mesh_indices_to_bin use mesh_header, only: StructuredMesh @@ -164,7 +165,7 @@ contains message = 'Detected zero flux without coremap overlay at: (' & // to_str(i) // ',' // to_str(j) // ',' // to_str(k) & // ') in group ' // to_str(h) - call fatal_error() + call fatal_error(message) end if ! Get total rr and convert to total xs @@ -628,7 +629,7 @@ contains subroutine compute_dhat() use constants, only: CMFD_NOACCEL, ZERO - use global, only: cmfd, cmfd_coremap, message, dhat_reset + use global, only: cmfd, cmfd_coremap, dhat_reset use output, only: write_message use string, only: to_str @@ -767,7 +768,7 @@ contains ! write that dhats are zero if (dhat_reset) then message = 'Dhats reset to zero.' - call write_message(1) + call write_message(message, 1) end if end subroutine compute_dhat diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 2f74f512f8..19e4a8364d 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -47,7 +47,7 @@ contains call cmfd_jfnk_execute() else message = 'solver type became invalid after input processing' - call fatal_error() + call fatal_error(message) end if #else call cmfd_solver_execute() @@ -257,8 +257,8 @@ contains use constants, only: ZERO, ONE use error, only: warning, fatal_error - use global, only: meshes, source_bank, work, n_user_meshes, message, & - cmfd, master + use global, only: meshes, source_bank, work, n_user_meshes, cmfd, & + master use mesh_header, only: StructuredMesh use mesh, only: count_bank_sites, get_mesh_indices use search, only: binary_search @@ -317,7 +317,7 @@ contains ! Check for sites outside of the mesh if (master .and. outside) then message = "Source sites outside of the CMFD mesh!" - call fatal_error() + call fatal_error(message) end if ! Have master compute weight factors (watch for 0s) @@ -348,11 +348,11 @@ contains if (source_bank(i) % E < cmfd % egrid(1)) then e_bin = 1 message = 'Source pt below energy grid' - call warning() + if (master) call warning(message) elseif (source_bank(i) % E > cmfd % egrid(n_groups + 1)) then e_bin = n_groups message = 'Source pt above energy grid' - call warning() + if (master) call warning(message) else e_bin = binary_search(cmfd % egrid, n_groups + 1, source_bank(i) % E) end if @@ -363,7 +363,7 @@ contains ! Check for outside of mesh if (.not. in_mesh) then message = 'Source site found outside of CMFD mesh' - call fatal_error() + call fatal_error(message) end if ! Reweight particle @@ -412,7 +412,7 @@ contains subroutine cmfd_tally_reset() - use global, only: n_cmfd_tallies, cmfd_tallies, message + use global, only: n_cmfd_tallies, cmfd_tallies use output, only: write_message use tally, only: reset_result @@ -420,7 +420,7 @@ contains ! Print message message = "CMFD tallies reset" - call write_message(7) + call write_message(message, 7) ! Begin loop around CMFD tallies do i = 1, n_cmfd_tallies diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index dc6bcfa37a..32797a616f 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -88,14 +88,14 @@ contains ! CMFD is optional unless it is in on from settings if (cmfd_on) then message = "No CMFD XML file, '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) end if return else ! Tell user message = "Reading CMFD XML file..." - call write_message(5) + call write_message(message, 5) end if @@ -108,7 +108,7 @@ contains ! Check if mesh is there if (.not.found) then message = "No CMFD mesh specified in CMFD XML file." - call fatal_error() + call fatal_error(message) end if ! Set spatial dimensions in cmfd object @@ -140,7 +140,7 @@ contains if (get_arraysize_integer(node_mesh, "map") /= & product(cmfd % indices(1:3))) then message = 'FATAL==>CMFD coremap not to correct dimensions' - call fatal_error() + call fatal_error(message) end if allocate(iarray(get_arraysize_integer(node_mesh, "map"))) call get_node_array(node_mesh, "map", iarray) @@ -217,7 +217,7 @@ contains if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') & #ifndef PETSC message = 'Must use PETSc when running adjoint option.' - call fatal_error() + call fatal_error(message) #endif cmfd_run_adjoint = .true. end if @@ -247,7 +247,7 @@ contains if (trim(cmfd_display) == 'dominance' .and. & trim(cmfd_solver_type) /= 'power') then message = 'Dominance Ratio only aviable with power iteration solver' - call warning() + if (master) call warning(message) cmfd_display = '' end if @@ -265,7 +265,7 @@ contains if (n_params /= 2) then message = 'Gauss Seidel tolerance is not 2 parameters & &(absolute, relative).' - call fatal_error() + call fatal_error(message) end if call get_node_array(doc, "gauss_seidel_tolerance", gs_tol) cmfd_atoli = gs_tol(1) @@ -336,7 +336,7 @@ contains n = get_arraysize_integer(node_mesh, "dimension") if (n /= 2 .and. n /= 3) then message = "Mesh must be two or three dimensions." - call fatal_error() + call fatal_error(message) end if m % n_dimension = n @@ -351,7 +351,7 @@ contains if (any(iarray3(1:n) <= 0)) then message = "All entries on the element for a tally mesh & &must be positive." - call fatal_error() + call fatal_error(message) end if ! Read dimensions in each direction @@ -361,7 +361,7 @@ contains if (m % n_dimension /= get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if call get_node_array(node_mesh, "lower_left", m % lower_left) @@ -370,7 +370,7 @@ contains check_for_node(node_mesh, "width")) then message = "Cannot specify both and on a & &tally mesh." - call fatal_error() + call fatal_error(message) end if ! Make sure either upper-right or width was specified @@ -378,7 +378,7 @@ contains .not.check_for_node(node_mesh, "width")) then message = "Must specify either and on a & &tally mesh." - call fatal_error() + call fatal_error(message) end if if (check_for_node(node_mesh, "width")) then @@ -387,14 +387,14 @@ contains get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as the & &number of entries on ." - call fatal_error() + call fatal_error(message) end if ! Check for negative widths call get_node_array(node_mesh, "width", rarray3(1:n)) if (any(rarray3(1:n) < ZERO)) then message = "Cannot have a negative on a tally mesh." - call fatal_error() + call fatal_error(message) end if ! Set width and upper right coordinate @@ -407,7 +407,7 @@ contains get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if ! Check that upper-right is above lower-left @@ -415,7 +415,7 @@ contains if (any(rarray3(1:n) < m % lower_left)) then message = "The coordinates must be greater than the & & coordinates on a tally mesh." - call fatal_error() + call fatal_error(message) end if ! Set upper right coordinate and width diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index b3e8fb8a88..15406c143c 100644 --- a/src/cmfd_solver.F90 +++ b/src/cmfd_solver.F90 @@ -2,6 +2,7 @@ module cmfd_solver ! This module contains routines to execute the power iteration solver + use constants use cmfd_loss_operator, only: init_loss_matrix, build_loss_matrix use cmfd_prod_operator, only: init_prod_matrix, build_prod_matrix use matrix_header, only: Matrix @@ -30,6 +31,7 @@ module cmfd_solver type(Vector) :: s_n ! new source vector type(Vector) :: s_o ! old flux vector type(Vector) :: serr_v ! error in source + character(2*MAX_LINE_LEN) :: message ! CMFD linear solver interface procedure(linsolve), pointer :: cmfd_linsolver => null() @@ -180,8 +182,6 @@ contains use error, only: fatal_error #ifdef PETSC use global, only: cmfd_write_matrices -#else - use global, only: message #endif #ifdef PETSC @@ -196,7 +196,7 @@ contains end if #else message = 'Adjoint calculations only allowed with PETSc' - call fatal_error() + call fatal_error(message) #endif end subroutine compute_adjoint @@ -210,7 +210,7 @@ contains use constants, only: ONE use error, only: fatal_error - use global, only: cmfd_atoli, cmfd_rtoli, message + use global, only: cmfd_atoli, cmfd_rtoli integer :: i ! iteration counter integer :: innerits ! # of inner iterations @@ -238,7 +238,7 @@ contains ! Check if reached iteration 10000 if (i == 10000) then message = 'Reached maximum iterations in CMFD power iteration solver.' - call fatal_error() + call fatal_error(message) end if ! Compute source vector @@ -357,7 +357,7 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_spectral, message + use global, only: cmfd, cmfd_spectral type(Matrix), intent(inout) :: A ! coefficient matrix type(Vector), intent(inout) :: b ! right hand side vector @@ -402,7 +402,7 @@ contains ! Check for max iterations met if (igs == 10000) then message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error(message) endif ! Copy over x vector @@ -464,7 +464,7 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_spectral, message + use global, only: cmfd, cmfd_spectral type(Matrix), intent(inout) :: A ! coefficient matrix type(Vector), intent(inout) :: b ! right hand side vector @@ -521,7 +521,7 @@ contains ! Check for max iterations met if (igs == 10000) then message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error(message) endif ! Copy over x vector @@ -610,7 +610,7 @@ contains use constants, only: ONE, ZERO use error, only: fatal_error - use global, only: cmfd, cmfd_spectral, message + use global, only: cmfd, cmfd_spectral type(Matrix), intent(inout) :: A ! coefficient matrix type(Vector), intent(inout) :: b ! right hand side vector @@ -654,7 +654,7 @@ contains ! Check for max iterations met if (igs == 10000) then message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error(message) endif ! Copy over x vector diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 0c298ba6d6..b0152ddeeb 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -116,7 +116,7 @@ contains subroutine initialize_batch() message = "Simulating batch " // trim(to_str(current_batch)) // "..." - call write_message(8) + call write_message(message, 8) ! Reset total starting particle weight used for normalizing tallies total_weight = ZERO @@ -303,7 +303,7 @@ contains if (n_bank == 0) then message = "No fission sites banked on processor " // to_str(rank) - call fatal_error() + call fatal_error(message) end if ! Make sure all processors start at the same point for random sampling. Then @@ -555,7 +555,7 @@ contains ! display warning message if there were sites outside entropy box if (sites_outside) then message = "Fission source site(s) outside of entropy box." - call warning() + if (master) call warning(message) end if ! sum values to obtain shannon entropy @@ -774,7 +774,7 @@ contains ! Check for sites outside of the mesh if (master .and. sites_outside) then message = "Source sites outside of the UFS mesh!" - call fatal_error() + call fatal_error(message) end if #ifdef MPI @@ -805,7 +805,7 @@ contains ! Write message at beginning if (current_batch == 1) then message = "Replaying history from state point..." - call write_message(1) + call write_message(message, 1) end if do current_gen = 1, gen_per_batch @@ -823,7 +823,7 @@ contains ! Write message at end if (current_batch == restart_batch) then message = "Resuming simulation..." - call write_message(1) + call write_message(message, 1) end if end subroutine replay_batch_history diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 95097edd59..8d8c549b06 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -24,7 +24,7 @@ contains type(Nuclide), pointer :: nuc => null() message = "Creating unionized energy grid..." - call write_message(5) + call write_message(message, 5) ! Add grid points for each nuclide in the problem do i = 1, n_nuclides_total diff --git a/src/error.F90 b/src/error.F90 index 1c35be8161..78030d18b0 100644 --- a/src/error.F90 +++ b/src/error.F90 @@ -1,6 +1,9 @@ module error use, intrinsic :: ISO_FORTRAN_ENV + use constants + + use global #ifdef MPI use mpi @@ -73,8 +76,9 @@ contains ! the program is aborted. !=============================================================================== - subroutine fatal_error(error_code) + subroutine fatal_error(message, error_code) + character(2*MAX_LINE_LEN) :: message integer, optional :: error_code ! error code integer :: code ! error code diff --git a/src/fission.F90 b/src/fission.F90 index cff8b7d9dc..de82a134a7 100644 --- a/src/fission.F90 +++ b/src/fission.F90 @@ -3,7 +3,6 @@ module fission use ace_header, only: Nuclide use constants use error, only: fatal_error - use global, only: message use interpolation, only: interpolate_tab1 use search, only: binary_search @@ -30,7 +29,7 @@ contains if (nuc % nu_t_type == NU_NONE) then message = "No neutron emission data for table: " // nuc % name - call fatal_error() + call fatal_error(message) elseif (nuc % nu_t_type == NU_POLYNOMIAL) then ! determine number of coefficients NC = int(nuc % nu_t_data(1)) diff --git a/src/fixed_source.F90 b/src/fixed_source.F90 index 84993646d7..b98e35ad92 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -97,7 +97,7 @@ contains subroutine initialize_batch() message = "Simulating batch " // trim(to_str(current_batch)) // "..." - call write_message(1) + call write_message(message, 1) ! Reset total starting particle weight used for normalizing tallies total_weight = ZERO diff --git a/src/geometry.F90 b/src/geometry.F90 index 17ab753379..a0663900ba 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -106,7 +106,7 @@ contains trim(to_str(cells(index_cell) % id)) // ", " // & trim(to_str(cells(coord % cell) % id)) // & " on universe " // trim(to_str(univ % id)) - call fatal_error() + call fatal_error(message) end if overlap_check_cnt(index_cell) = overlap_check_cnt(index_cell) + 1 @@ -182,7 +182,7 @@ contains ! Show cell information on trace if (verbosity >= 10 .or. trace) then message = " Entering cell " // trim(to_str(c % id)) - call write_message() + call write_message(message) end if if (c % type == CELL_NORMAL) then @@ -387,7 +387,7 @@ contains surf => surfaces(i_surface) if (verbosity >= 10 .or. trace) then message = " Crossing surface " // trim(to_str(surf % id)) - call write_message() + call write_message(message) end if if (surf % bc == BC_VACUUM .and. (run_mode /= MODE_PLOTTING)) then @@ -420,7 +420,7 @@ contains ! Display message if (verbosity >= 10 .or. trace) then message = " Leaked out of surface " // trim(to_str(surf % id)) - call write_message() + call write_message(message) end if return @@ -566,7 +566,7 @@ contains case default message = "Reflection not supported for surface " // & trim(to_str(surf % id)) - call fatal_error() + call fatal_error(message) end select ! Set new particle direction @@ -597,7 +597,7 @@ contains ! Diagnostic message if (verbosity >= 10 .or. trace) then message = " Reflected from surface " // trim(to_str(surf%id)) - call write_message() + call write_message(message) end if return end if @@ -678,7 +678,7 @@ contains ". Current position (" // trim(to_str(p % coord % lattice_x)) & // "," // trim(to_str(p % coord % lattice_y)) // "," // & trim(to_str(p % coord % lattice_z)) // ")" - call write_message() + call write_message(message) end if if (lat % type == LATTICE_RECT) then @@ -1497,7 +1497,7 @@ contains type(Surface), pointer :: surf message = "Building neighboring cells lists for each surface..." - call write_message(4) + call write_message(message, 4) allocate(count_positive(n_surfaces)) allocate(count_negative(n_surfaces)) @@ -1569,7 +1569,7 @@ contains type(Particle), intent(inout) :: p ! Print warning and write lost particle file - call warning(force = .true.) + call warning(message) call write_particle_restart(p) ! Increment number of lost particles @@ -1582,7 +1582,7 @@ contains ! reached if (n_lost_particles == MAX_LOST_PARTICLES) then message = "Maximum number of lost particles has been reached." - call fatal_error() + call fatal_error(message) end if end subroutine handle_lost_particle diff --git a/src/initialize.F90 b/src/initialize.F90 index 7e25498535..a4384cbbb3 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -159,9 +159,9 @@ contains ! Warn if overlap checking is on if (master .and. check_overlaps) then message = "" - call write_message() + call write_message(message) message = "Cell overlap checking is ON" - call warning() + if (master) call warning(message) end if ! Stop initialization timer @@ -346,7 +346,7 @@ contains if (n_particles == ERROR_INT) then message = "Must specify integer after " // trim(argv(i-1)) // & " command-line flag." - call fatal_error() + call fatal_error(message) end if case ('-r', '-restart', '--restart') ! Read path for state point/particle restart @@ -367,7 +367,7 @@ contains particle_restart_run = .true. case default message = "Unrecognized file after restart flag." - call fatal_error() + call fatal_error(message) end select ! If its a restart run check for additional source file @@ -386,7 +386,7 @@ contains call sp % file_close() if (filetype /= FILETYPE_SOURCE) then message = "Second file after restart flag must be a source file" - call fatal_error() + call fatal_error(message) end if ! It is a source file @@ -421,12 +421,12 @@ contains n_threads = int(str_to_int(argv(i)), 4) if (n_threads < 1) then message = "Invalid number of threads specified on command line." - call fatal_error() + call fatal_error(message) end if call omp_set_num_threads(n_threads) #else message = "Ignoring number of threads specified on command line." - call warning() + if (master) call warning(message) #endif case ('-?', '-h', '-help', '--help') @@ -443,7 +443,7 @@ contains i = i + 1 case default message = "Unknown command line option: " // argv(i) - call fatal_error() + call fatal_error(message) end select last_flag = i @@ -581,7 +581,7 @@ contains else message = "Could not find surface " // trim(to_str(abs(id))) // & " specified on cell " // trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if end if end do @@ -595,7 +595,7 @@ contains else message = "Could not find universe " // trim(to_str(id)) // & " specified on cell " // trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if ! ======================================================================= @@ -611,7 +611,7 @@ contains else message = "Could not find material " // trim(to_str(id)) // & " specified on cell " // trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if else id = c % fill @@ -630,13 +630,13 @@ contains else message = "Could not find material " // trim(to_str(mid)) // & " specified on lattice " // trim(to_str(lid)) - call fatal_error() + call fatal_error(message) end if else message = "Specified fill " // trim(to_str(id)) // " on cell " // & trim(to_str(c % id)) // " is neither a universe nor a lattice." - call fatal_error() + call fatal_error(message) end if end if end do @@ -663,7 +663,7 @@ contains else message = "Invalid universe number " // trim(to_str(id)) & // " specified on lattice " // trim(to_str(lat % id)) - call fatal_error() + call fatal_error(message) end if end do end do @@ -689,7 +689,7 @@ contains else message = "Could not find cell " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if end do @@ -705,7 +705,7 @@ contains else message = "Could not find surface " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if end do @@ -718,7 +718,7 @@ contains else message = "Could not find universe " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if end do @@ -731,7 +731,7 @@ contains else message = "Could not find material " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if end do @@ -867,7 +867,7 @@ contains ! Check for allocation errors if (alloc_err /= 0) then message = "Failed to allocate source bank." - call fatal_error() + call fatal_error(message) end if #ifdef _OPENMP @@ -895,7 +895,7 @@ contains ! Check for allocation errors if (alloc_err /= 0) then message = "Failed to allocate fission bank." - call fatal_error() + call fatal_error(message) end if end subroutine allocate_banks diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 3b080f2141..247a97b09b 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -78,7 +78,7 @@ contains ! Display output message message = "Reading settings XML file..." - call write_message(5) + call write_message(message, 5) ! Check if settings.xml exists filename = trim(path_input) // "settings.xml" @@ -89,7 +89,7 @@ contains &minimum, this includes settings.xml, geometry.xml, and & &materials.xml. Please consult the user's guide at & &http://mit-crpg.github.io/openmc for further information." - call fatal_error() + call fatal_error(message) end if ! Parse settings.xml file @@ -111,7 +111,7 @@ contains §ion libraries. Please consult the user's guide at & &http://mit-crpg.github.io/openmc for information on how to set & &up ACE cross section libraries." - call fatal_error() + call fatal_error(message) else path_cross_sections = trim(env_variable) end if @@ -132,7 +132,7 @@ contains if (.not.check_for_node(doc, "eigenvalue") .and. & .not.check_for_node(doc, "fixed_source")) then message = " or not specified." - call fatal_error() + call fatal_error(message) end if ! Eigenvalue information @@ -146,7 +146,7 @@ contains ! Check number of particles if (.not.check_for_node(node_mode, "particles")) then message = "Need to specify number of particles per generation." - call fatal_error() + call fatal_error(message) end if ! Get number of particles @@ -181,7 +181,7 @@ contains ! Check number of particles if (.not.check_for_node(node_mode, "particles")) then message = "Need to specify number of particles per batch." - call fatal_error() + call fatal_error(message) end if ! Get number of particles @@ -201,13 +201,13 @@ contains ! Check number of active batches, inactive batches, and particles if (n_active <= 0) then message = "Number of active batches must be greater than zero." - call fatal_error() + call fatal_error(message) elseif (n_inactive < 0) then message = "Number of inactive batches must be non-negative." - call fatal_error() + call fatal_error(message) elseif (n_particles <= 0) then message = "Number of particles must be greater than zero." - call fatal_error() + call fatal_error(message) end if ! Copy random number seed if specified @@ -226,10 +226,10 @@ contains grid_method = GRID_UNION case ('lethargy') message = "Lethargy mapped energy grid not yet supported." - call fatal_error() + call fatal_error(message) case default message = "Unknown energy grid method: " // trim(temp_str) - call fatal_error() + call fatal_error(message) end select ! Verbosity @@ -245,13 +245,13 @@ contains call get_node_value(doc, "threads", n_threads) if (n_threads < 1) then message = "Invalid number of threads: " // to_str(n_threads) - call fatal_error() + call fatal_error(message) end if call omp_set_num_threads(n_threads) end if #else message = "Ignoring number of threads." - call warning() + if (master) call warning(message) #endif end if @@ -263,7 +263,7 @@ contains call get_node_ptr(doc, "source", node_source) else message = "No source specified in settings XML file." - call fatal_error() + call fatal_error(message) end if ! Check if we want to write out source @@ -284,7 +284,7 @@ contains if (.not. file_exists) then message = "Binary source file '" // trim(path_source) // & "' does not exist!" - call fatal_error() + call fatal_error(message) end if else @@ -312,7 +312,7 @@ contains case default message = "Invalid spatial distribution for external source: " & // trim(type) - call fatal_error() + call fatal_error(message) end select ! Determine number of parameters specified @@ -326,11 +326,11 @@ contains if (n < coeffs_reqd) then message = "Not enough parameters specified for spatial & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > coeffs_reqd) then message = "Too many parameters specified for spatial & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > 0) then allocate(external_source % params_space(n)) call get_node_array(node_dist, "parameters", & @@ -338,7 +338,7 @@ contains end if else message = "No spatial distribution specified for external source." - call fatal_error() + call fatal_error(message) end if ! Determine external source angular distribution @@ -363,7 +363,7 @@ contains case default message = "Invalid angular distribution for external source: " & // trim(type) - call fatal_error() + call fatal_error(message) end select ! Determine number of parameters specified @@ -377,11 +377,11 @@ contains if (n < coeffs_reqd) then message = "Not enough parameters specified for angle & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > coeffs_reqd) then message = "Too many parameters specified for angle & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > 0) then allocate(external_source % params_angle(n)) call get_node_array(node_dist, "parameters", & @@ -417,7 +417,7 @@ contains case default message = "Invalid energy distribution for external source: " & // trim(type) - call fatal_error() + call fatal_error(message) end select ! Determine number of parameters specified @@ -431,11 +431,11 @@ contains if (n < coeffs_reqd) then message = "Not enough parameters specified for energy & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > coeffs_reqd) then message = "Too many parameters specified for energy & &distribution of external source." - call fatal_error() + call fatal_error(message) elseif (n > 0) then allocate(external_source % params_energy(n)) call get_node_array(node_dist, "parameters", & @@ -487,7 +487,7 @@ contains if (mod(n_tracks, 3) /= 0) then message = "Number of integers specified in 'track' is not divisible & &by 3. Please provide 3 integers per particle to be tracked." - call fatal_error() + call fatal_error(message) end if ! Allocate space and get list of tracks @@ -530,7 +530,7 @@ contains if (.not. all(entropy_mesh % upper_right > entropy_mesh % lower_left)) then message = "Upper-right coordinate must be greater than lower-left & &coordinate for Shannon entropy mesh." - call fatal_error() + call fatal_error(message) end if ! Check if dimensions were specified -- if not, they will be calculated @@ -541,7 +541,7 @@ contains if (get_arraysize_integer(node_entropy, "dimension") /= 3) then message = "Dimension of entropy mesh must be given as three & &integers." - call fatal_error() + call fatal_error(message) end if ! Allocate dimensions @@ -576,7 +576,7 @@ contains &of UFS mesh." elseif (get_arraysize_integer(node_ufs, "dimension") /= 3) then message = "Dimension of UFS mesh must be given as three integers." - call fatal_error() + call fatal_error(message) end if ! Allocate mesh object and coordinates on mesh @@ -600,7 +600,7 @@ contains if (.not. all(ufs_mesh % upper_right > ufs_mesh % lower_left)) then message = "Upper-right coordinate must be greater than lower-left & &coordinate for UFS mesh." - call fatal_error() + call fatal_error(message) end if ! Calculate width @@ -735,7 +735,7 @@ contains get_item(i))) then message = 'Sourcepoint batches are not a subset& & of statepoint batches.' - call fatal_error() + call fatal_error(message) end if end do end if @@ -817,7 +817,7 @@ contains if (.not. check_for_node(node_scatterer, "nuclide")) then message = "No nuclide specified for scatterer " // trim(to_str(i)) & // " in settings.xml file!" - call fatal_error() + call fatal_error(message) end if call get_node_value(node_scatterer, "nuclide", & nuclides_0K(i) % nuclide) @@ -831,7 +831,7 @@ contains if (.not. check_for_node(node_scatterer, "xs_label")) then message = "Must specify the temperature dependent name of " // '' & //"scatterer " // trim(to_str(i)) // " given in cross_sections.xml" - call fatal_error() + call fatal_error(message) end if call get_node_value(node_scatterer, "xs_label", & nuclides_0K(i) % name) @@ -840,7 +840,7 @@ contains if (.not. check_for_node(node_scatterer, "xs_label_0K")) then message = "Must specify the 0K name of " // '' & //"scatterer "// trim(to_str(i)) // " given in cross_sections.xml" - call fatal_error() + call fatal_error(message) end if call get_node_value(node_scatterer, "xs_label_0K", & nuclides_0K(i) % name_0K) @@ -853,7 +853,7 @@ contains ! check that E_min is non-negative if (nuclides_0K(i) % E_min < ZERO) then message = "Lower resonance scattering energy bound is negative" - call fatal_error() + call fatal_error(message) end if if (check_for_node(node_scatterer, "E_max")) then @@ -864,7 +864,7 @@ contains ! check that E_max is not less than E_min if (nuclides_0K(i) % E_max < nuclides_0K(i) % E_min) then message = "Lower resonance scattering energy bound exceeds upper" - call fatal_error() + call fatal_error(message) end if nuclides_0K(i) % nuclide = trim(nuclides_0K(i) % nuclide) @@ -875,7 +875,7 @@ contains else message = "No resonant scatterers are specified within the " // "" & // "resonance_scattering element in settings.xml" - call fatal_error() + call fatal_error(message) end if end if @@ -901,7 +901,7 @@ contains default_expand = JENDL_40 case default message = "Unknown natural element expansion option: " // trim(temp_str) - call fatal_error() + call fatal_error(message) end select end if @@ -944,7 +944,7 @@ contains ! Display output message message = "Reading geometry XML file..." - call write_message(5) + call write_message(message, 5) ! ========================================================================== ! READ CELLS FROM GEOMETRY.XML @@ -954,7 +954,7 @@ contains inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then message = "Geometry XML file '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) end if ! Parse geometry.xml file @@ -969,7 +969,7 @@ contains ! Check for no cells if (n_cells == 0) then message = "No cells found in geometry.xml!" - call fatal_error() + call fatal_error(message) end if ! Allocate cells array @@ -992,7 +992,7 @@ contains call get_node_value(node_cell, "id", c % id) else message = "Must specify id of cell in geometry XML file." - call fatal_error() + call fatal_error(message) end if if (check_for_node(node_cell, "universe")) then call get_node_value(node_cell, "universe", c % universe) @@ -1008,7 +1008,7 @@ contains ! Check to make sure 'id' hasn't been used if (cell_dict % has_key(c % id)) then message = "Two or more cells use the same unique ID: " // to_str(c % id) - call fatal_error() + call fatal_error(message) end if ! Read material @@ -1029,7 +1029,7 @@ contains ! Check for error if (c % material == ERROR_INT) then message = "Invalid material specified on cell " // to_str(c % id) - call fatal_error() + call fatal_error(message) end if end select @@ -1037,21 +1037,21 @@ contains if (c % material == NONE .and. c % fill == NONE) then message = "Neither material nor fill was specified for cell " // & trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if ! Check to make sure that both material and fill haven't been ! specified simultaneously if (c % material /= NONE .and. c % fill /= NONE) then message = "Cannot specify material and fill simultaneously" - call fatal_error() + call fatal_error(message) end if ! Check to make sure that surfaces were specified if (.not. check_for_node(node_cell, "surfaces")) then message = "No surfaces specified for cell " // & trim(to_str(c % id)) - call fatal_error() + call fatal_error(message) end if ! Allocate array for surfaces and copy @@ -1067,7 +1067,7 @@ contains if (c % fill == NONE) then message = "Cannot apply a rotation to cell " // trim(to_str(& c % id)) // " because it is not filled with another universe" - call fatal_error() + call fatal_error(message) end if ! Read number of rotation parameters @@ -1075,7 +1075,7 @@ contains if (n /= 3) then message = "Incorrect number of rotation parameters on cell " // & to_str(c % id) - call fatal_error() + call fatal_error(message) end if ! Copy rotation angles in x,y,z directions @@ -1103,7 +1103,7 @@ contains if (c % fill == NONE) then message = "Cannot apply a translation to cell " // trim(to_str(& c % id)) // " because it is not filled with another universe" - call fatal_error() + call fatal_error(message) end if ! Read number of translation parameters @@ -1111,7 +1111,7 @@ contains if (n /= 3) then message = "Incorrect number of translation parameters on cell " & // to_str(c % id) - call fatal_error() + call fatal_error(message) end if ! Copy translation vector @@ -1153,7 +1153,7 @@ contains ! Check for no surfaces if (n_surfaces == 0) then message = "No surfaces found in geometry.xml!" - call fatal_error() + call fatal_error(message) end if ! Allocate cells array @@ -1170,14 +1170,14 @@ contains call get_node_value(node_surf, "id", s % id) else message = "Must specify id of surface in geometry XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (surface_dict % has_key(s % id)) then message = "Two or more surfaces use the same unique ID: " // & to_str(s % id) - call fatal_error() + call fatal_error(message) end if ! Copy and interpret surface type @@ -1220,7 +1220,7 @@ contains coeffs_reqd = 4 case default message = "Invalid surface type: " // trim(word) - call fatal_error() + call fatal_error(message) end select ! Check to make sure that the proper number of coefficients @@ -1231,11 +1231,11 @@ contains if (n < coeffs_reqd) then message = "Not enough coefficients specified for surface: " // & trim(to_str(s % id)) - call fatal_error() + call fatal_error(message) elseif (n > coeffs_reqd) then message = "Too many coefficients specified for surface: " // & trim(to_str(s % id)) - call fatal_error() + call fatal_error(message) else allocate(s % coeffs(n)) call get_node_array(node_surf, "coeffs", s % coeffs) @@ -1257,7 +1257,7 @@ contains case default message = "Unknown boundary condition '" // trim(word) // & "' specified on surface " // trim(to_str(s % id)) - call fatal_error() + call fatal_error(message) end select ! Add surface to dictionary @@ -1269,7 +1269,7 @@ contains ! surface if (.not. boundary_exists) then message = "No boundary conditions were applied to any surfaces!" - call fatal_error() + call fatal_error(message) end if ! ========================================================================== @@ -1293,14 +1293,14 @@ contains call get_node_value(node_lat, "id", lat % id) else message = "Must specify id of lattice in geometry XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (lattice_dict % has_key(lat % id)) then message = "Two or more lattices use the same unique ID: " // & to_str(lat % id) - call fatal_error() + call fatal_error(message) end if ! Read lattice type @@ -1314,14 +1314,14 @@ contains lat % type = LATTICE_HEX case default message = "Invalid lattice type: " // trim(word) - call fatal_error() + call fatal_error(message) end select ! Read number of lattice cells in each dimension n = get_arraysize_integer(node_lat, "dimension") if (n /= 2 .and. n /= 3) then message = "Lattice must be two or three dimensions." - call fatal_error() + call fatal_error(message) end if lat % n_dimension = n @@ -1333,7 +1333,7 @@ contains get_arraysize_double(node_lat, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if allocate(lat % lower_left(n)) @@ -1344,7 +1344,7 @@ contains get_arraysize_double(node_lat, "width")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if allocate(lat % width(n)) @@ -1365,7 +1365,7 @@ contains if (n /= n_x*n_y*n_z) then message = "Number of universes on does not match size of & &lattice " // trim(to_str(lat % id)) // "." - call fatal_error() + call fatal_error(message) end if allocate(temp_int_array(n)) @@ -1442,14 +1442,14 @@ contains ! Display output message message = "Reading materials XML file..." - call write_message(5) + call write_message(message, 5) ! Check is materials.xml exists filename = trim(path_input) // "materials.xml" inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then message = "Material XML file '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) end if ! Initialize default cross section variable @@ -1484,14 +1484,14 @@ contains call get_node_value(node_mat, "id", mat % id) else message = "Must specify id of material in materials XML file" - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (material_dict % has_key(mat % id)) then message = "Two or more materials use the same unique ID: " // & to_str(mat % id) - call fatal_error() + call fatal_error(message) end if if (run_mode == MODE_PLOTTING) then @@ -1509,7 +1509,7 @@ contains else message = "Must specify density element in material " // & trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if ! Initialize value to zero @@ -1534,7 +1534,7 @@ contains if (val <= ZERO) then message = "Need to specify a positive density on material " // & trim(to_str(mat % id)) // "." - call fatal_error() + call fatal_error(message) end if ! Adjust material density based on specified units @@ -1550,7 +1550,7 @@ contains case default message = "Unkwown units '" // trim(units) & // "' specified on material " // trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end select end if @@ -1562,7 +1562,7 @@ contains .not. check_for_node(node_mat, "element")) then message = "No nuclides or natural elements specified on material " // & trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if ! Get pointer list of XML @@ -1577,7 +1577,7 @@ contains if (.not.check_for_node(node_nuc, "name")) then message = "No name specified on nuclide in material " // & trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if ! Check for cross section @@ -1585,7 +1585,7 @@ contains if (default_xs == '') then message = "No cross section specified for nuclide in material " & // trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) else name = trim(default_xs) end if @@ -1606,12 +1606,12 @@ contains .not.check_for_node(node_nuc, "wo")) then message = "No atom or weight percent specified for nuclide " // & trim(name) - call fatal_error() + call fatal_error(message) elseif (check_for_node(node_nuc, "ao") .and. & check_for_node(node_nuc, "wo")) then message = "Cannot specify both atom and weight percents for a & &nuclide: " // trim(name) - call fatal_error() + call fatal_error(message) end if ! Copy atom/weight percents @@ -1637,7 +1637,7 @@ contains if (.not.check_for_node(node_ele, "name")) then message = "No name specified on nuclide in material " // & trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) end if call get_node_value(node_ele, "name", name) @@ -1648,7 +1648,7 @@ contains if (default_xs == '') then message = "No cross section specified for nuclide in material " & // trim(to_str(mat % id)) - call fatal_error() + call fatal_error(message) else temp_str = trim(default_xs) end if @@ -1660,12 +1660,12 @@ contains .not.check_for_node(node_ele, "wo")) then message = "No atom or weight percent specified for element " // & trim(name) - call fatal_error() + call fatal_error(message) elseif (check_for_node(node_ele, "ao") .and. & check_for_node(node_ele, "wo")) then message = "Cannot specify both atom and weight percents for a & &element: " // trim(name) - call fatal_error() + call fatal_error(message) end if ! Expand element into naturally-occurring isotopes @@ -1676,7 +1676,7 @@ contains else message = "The ability to expand a natural element based on weight & &percentage is not yet supported." - call fatal_error() + call fatal_error(message) end if end do NATURAL_ELEMENTS @@ -1696,7 +1696,7 @@ contains if (.not. xs_listing_dict % has_key(to_lower(name))) then message = "Could not find nuclide " // trim(name) // & " in cross_sections.xml file!" - call fatal_error() + call fatal_error(message) end if ! Check to make sure cross-section is continuous energy neutron table @@ -1704,7 +1704,7 @@ contains if (name(n:n) /= 'c') then message = "Cross-section table " // trim(name) // & " is not a continuous-energy neutron table." - call fatal_error() + call fatal_error(message) end if ! Find xs_listing and set the name/alias according to the listing @@ -1735,7 +1735,7 @@ contains all(mat % atom_density <= ZERO))) then message = "Cannot mix atom and weight percents in material " // & to_str(mat % id) - call fatal_error() + call fatal_error(message) end if ! Determine density if it is a sum value @@ -1772,7 +1772,7 @@ contains if (.not.check_for_node(node_sab, "name") .or. & .not.check_for_node(node_sab, "xs")) then message = "Need to specify and for S(a,b) table." - call fatal_error() + call fatal_error(message) end if call get_node_value(node_sab, "name", name) call get_node_value(node_sab, "xs", temp_str) @@ -1783,7 +1783,7 @@ contains if (.not. xs_listing_dict % has_key(to_lower(name))) then message = "Could not find S(a,b) table " // trim(name) // & " in cross_sections.xml file!" - call fatal_error() + call fatal_error(message) end if ! Find index in xs_listing and set the name and alias according to the @@ -1869,7 +1869,7 @@ contains ! Display output message message = "Reading tallies XML file..." - call write_message(5) + call write_message(message, 5) ! Parse tallies.xml file call open_xmldoc(doc, filename) @@ -1898,7 +1898,7 @@ contains n_user_tallies = get_list_size(node_tal_list) if (n_user_tallies == 0) then message = "No tallies present in tallies.xml file!" - call warning() + if (master) call warning(message) end if ! Allocate tally array @@ -1928,14 +1928,14 @@ contains call get_node_value(node_mesh, "id", m % id) else message = "Must specify id for mesh in tally XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (mesh_dict % has_key(m % id)) then message = "Two or more meshes use the same unique ID: " // & to_str(m % id) - call fatal_error() + call fatal_error(message) end if ! Read mesh type @@ -1949,14 +1949,14 @@ contains m % type = LATTICE_HEX case default message = "Invalid mesh type: " // trim(temp_str) - call fatal_error() + call fatal_error(message) end select ! Determine number of dimensions for mesh n = get_arraysize_integer(node_mesh, "dimension") if (n /= 2 .and. n /= 3) then message = "Mesh must be two or three dimensions." - call fatal_error() + call fatal_error(message) end if m % n_dimension = n @@ -1971,7 +1971,7 @@ contains if (any(iarray3(1:n) <= 0)) then message = "All entries on the element for a tally mesh & &must be positive." - call fatal_error() + call fatal_error(message) end if ! Read dimensions in each direction @@ -1981,7 +1981,7 @@ contains if (m % n_dimension /= get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if call get_node_array(node_mesh, "lower_left", m % lower_left) @@ -1990,7 +1990,7 @@ contains check_for_node(node_mesh, "width")) then message = "Cannot specify both and on a & &tally mesh." - call fatal_error() + call fatal_error(message) end if ! Make sure either upper-right or width was specified @@ -1998,7 +1998,7 @@ contains .not.check_for_node(node_mesh, "width")) then message = "Must specify either and on a & &tally mesh." - call fatal_error() + call fatal_error(message) end if if (check_for_node(node_mesh, "width")) then @@ -2007,14 +2007,14 @@ contains get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as the & &number of entries on ." - call fatal_error() + call fatal_error(message) end if ! Check for negative widths call get_node_array(node_mesh, "width", rarray3(1:n)) if (any(rarray3(1:n) < ZERO)) then message = "Cannot have a negative on a tally mesh." - call fatal_error() + call fatal_error(message) end if ! Set width and upper right coordinate @@ -2027,7 +2027,7 @@ contains get_arraysize_double(node_mesh, "lower_left")) then message = "Number of entries on must be the same as & &the number of entries on ." - call fatal_error() + call fatal_error(message) end if ! Check that upper-right is above lower-left @@ -2035,7 +2035,7 @@ contains if (any(rarray3(1:n) < m % lower_left)) then message = "The coordinates must be greater than the & & coordinates on a tally mesh." - call fatal_error() + call fatal_error(message) end if ! Set width and upper right coordinate @@ -2079,14 +2079,14 @@ contains call get_node_value(node_tal, "id", t % id) else message = "Must specify id for tally in tally XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (tally_dict % has_key(t % id)) then message = "Two or more tallies use the same unique ID: " // & to_str(t % id) - call fatal_error() + call fatal_error(message) end if ! Copy tally label @@ -2104,7 +2104,7 @@ contains ! if (get_number_nodes(node_tal, "filters") > 0) then ! message = "Tally filters should be specified with multiple & ! &elements. Did you forget to change your element?" -! call fatal_error() +! call fatal_error(message) ! end if ! Get pointer list to XML and get number of filters @@ -2137,7 +2137,7 @@ contains end if else message = "Bins not set in filter on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if ! Determine type of filter @@ -2188,7 +2188,7 @@ contains case ('surface') message = "Surface filter is not yet supported!" - call fatal_error() + call fatal_error(message) ! Set type of filter t % filters(j) % type = FILTER_SURFACE @@ -2207,7 +2207,7 @@ contains ! Check to make sure multiple meshes weren't given if (n_words /= 1) then message = "Can only have one mesh filter specified." - call fatal_error() + call fatal_error(message) end if ! Determine id of mesh @@ -2220,7 +2220,7 @@ contains else message = "Could not find mesh " // trim(to_str(id)) // & " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if ! Determine number of bins -- this is assuming that the tally is @@ -2262,7 +2262,7 @@ contains message = "Unknown filter type '" // & trim(temp_str) // "' on tally " // & trim(to_str(t % id)) // "." - call fatal_error() + call fatal_error(message) end select @@ -2278,7 +2278,7 @@ contains t % find_filter(FILTER_SURFACE) > 0) then message = "Cannot specify both cell and surface filters for tally " & // trim(to_str(t % id)) - call fatal_error() + call fatal_error(message) end if else @@ -2343,7 +2343,7 @@ contains message = "Could not find the nuclide " // trim(& sarray(j)) // " specified in tally " & // trim(to_str(t % id)) // " in any material." - call fatal_error() + call fatal_error(message) end if deallocate(pair_list) else @@ -2356,7 +2356,7 @@ contains if (.not. nuclide_dict % has_key(to_lower(word))) then message = "The nuclide " // trim(word) // " from tally " // & trim(to_str(t % id)) // " is not present in any material." - call fatal_error() + call fatal_error(message) end if ! Set bin to index in nuclides array @@ -2408,7 +2408,7 @@ contains message = "Invalid scattering order of " // trim(to_str(n_order)) // & " requested. Setting to the maximum permissible value, " // & trim(to_str(MAX_ANG_ORDER)) - call warning() + if (master) call warning(message) n_order = MAX_ANG_ORDER sarray(j) = trim(MOMENT_STRS(imomstr)) // & trim(to_str(MAX_ANG_ORDER)) @@ -2450,7 +2450,7 @@ contains message = "Invalid scattering order of " // trim(to_str(n_order)) // & " requested. Setting to the maximum permissible value, " // & trim(to_str(MAX_ANG_ORDER)) - call warning() + if (master) call warning(message) n_order = MAX_ANG_ORDER end if score_name = trim(MOMENT_STRS(imomstr)) // "n" @@ -2477,7 +2477,7 @@ contains message = "Invalid scattering order of " // trim(to_str(n_order)) // & " requested. Setting to the maximum permissible value, " // & trim(to_str(MAX_ANG_ORDER)) - call warning() + if (master) call warning(message) n_order = MAX_ANG_ORDER end if score_name = trim(MOMENT_N_STRS(imomstr)) // "n" @@ -2492,25 +2492,25 @@ contains if (.not. (t % n_nuclide_bins == 1 .and. & t % nuclide_bins(1) == -1)) then message = "Cannot tally flux for an individual nuclide." - call fatal_error() + call fatal_error(message) end if t % score_bins(j) = SCORE_FLUX if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally flux with an outgoing energy filter." - call fatal_error() + call fatal_error(message) end if case ('flux-yn') ! Prohibit user from tallying flux for an individual nuclide if (.not. (t % n_nuclide_bins == 1 .and. & t % nuclide_bins(1) == -1)) then message = "Cannot tally flux for an individual nuclide." - call fatal_error() + call fatal_error(message) end if if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally flux with an outgoing energy filter." - call fatal_error() + call fatal_error(message) end if t % score_bins(j : j + n_bins - 1) = SCORE_FLUX_YN @@ -2522,14 +2522,14 @@ contains if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally total reaction rate with an & &outgoing energy filter." - call fatal_error() + call fatal_error(message) end if case ('total-yn') if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally total reaction rate with an & &outgoing energy filter." - call fatal_error() + call fatal_error(message) end if t % score_bins(j : j + n_bins - 1) = SCORE_TOTAL_YN @@ -2600,7 +2600,7 @@ contains case ('diffusion') message = "Diffusion score no longer supported for tallies, & &please remove" - call fatal_error() + call fatal_error(message) case ('n1n') t % score_bins(j) = SCORE_N_1N @@ -2620,14 +2620,14 @@ contains if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally absorption rate with an outgoing & &energy filter." - call fatal_error() + call fatal_error(message) end if case ('fission') t % score_bins(j) = SCORE_FISSION if (t % find_filter(FILTER_ENERGYOUT) > 0) then message = "Cannot tally fission rate with an outgoing & &energy filter." - call fatal_error() + call fatal_error(message) end if case ('nu-fission') t % score_bins(j) = SCORE_NU_FISSION @@ -2647,7 +2647,7 @@ contains message = "Cannot tally other scoring functions in the same & &tally as surface currents. Separate other scoring & &functions into a distinct tally." - call fatal_error() + call fatal_error(message) end if ! Since the number of bins for the mesh filter was already set @@ -2660,7 +2660,7 @@ contains ! Check to make sure mesh filter was specified if (k == 0) then message = "Cannot tally surface current without a mesh filter." - call fatal_error() + call fatal_error(message) end if ! Get pointer to mesh @@ -2708,14 +2708,14 @@ contains else message = "Invalid MT on : " // & trim(sarray(l)) - call fatal_error() + call fatal_error(message) end if else ! Specified score was not an integer message = "Unknown scoring function: " // & trim(sarray(l)) - call fatal_error() + call fatal_error(message) end if end select @@ -2728,7 +2728,7 @@ contains else message = "No specified on tally " // trim(to_str(t % id)) & // "." - call fatal_error() + call fatal_error(message) end if ! ======================================================================= @@ -2748,7 +2748,7 @@ contains if (t % estimator == ESTIMATOR_ANALOG) then message = "Cannot use track-length estimator for tally " & // to_str(t % id) - call fatal_error() + call fatal_error(message) end if ! Set estimator to track-length estimator @@ -2757,7 +2757,7 @@ contains case default message = "Invalid estimator '" // trim(temp_str) & // "' on tally " // to_str(t % id) - call fatal_error() + call fatal_error(message) end select end if @@ -2802,12 +2802,12 @@ contains inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then message = "Plots XML file '" // trim(filename) // "' does not exist!" - call fatal_error() + call fatal_error(message) end if ! Display output message message = "Reading plot XML file..." - call write_message(5) + call write_message(message, 5) ! Parse plots.xml file call open_xmldoc(doc, filename) @@ -2830,14 +2830,14 @@ contains call get_node_value(node_plot, "id", pl % id) else message = "Must specify plot id in plots XML file." - call fatal_error() + call fatal_error(message) end if ! Check to make sure 'id' hasn't been used if (plot_dict % has_key(pl % id)) then message = "Two or more plots use the same unique ID: " // & to_str(pl % id) - call fatal_error() + call fatal_error(message) end if ! Copy plot type @@ -2853,7 +2853,7 @@ contains case default message = "Unsupported plot type '" // trim(temp_str) & // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end select ! Set output file path @@ -2876,7 +2876,7 @@ contains else message = " must be length 2 in slice plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else if (pl % type == PLOT_TYPE_VOXEL) then if (get_arraysize_integer(node_plot, "pixels") == 3) then @@ -2884,7 +2884,7 @@ contains else message = " must be length 3 in voxel plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if @@ -2893,14 +2893,14 @@ contains if (pl % type == PLOT_TYPE_VOXEL) then message = "Background color ignored in voxel plot " // & trim(to_str(pl % id)) - call warning() + if (master) call warning(message) end if if (get_arraysize_integer(node_plot, "background") == 3) then call get_node_array(node_plot, "background", pl % not_found % rgb) else message = "Bad background RGB " & // "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else pl % not_found % rgb = (/ 255, 255, 255 /) @@ -2922,7 +2922,7 @@ contains case default message = "Unsupported plot basis '" // trim(temp_str) & // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end select end if @@ -2932,7 +2932,7 @@ contains else message = "Origin must be length 3 " & // "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Copy plotting width @@ -2942,7 +2942,7 @@ contains else message = " must be length 2 in slice plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else if (pl % type == PLOT_TYPE_VOXEL) then if (get_arraysize_double(node_plot, "width") == 3) then @@ -2950,7 +2950,7 @@ contains else message = " must be length 3 in voxel plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if @@ -2983,7 +2983,7 @@ contains case default message = "Unsupported plot color type '" // trim(temp_str) & // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end select ! Get the number of nodes and get a list of them @@ -2996,7 +2996,7 @@ contains if (pl % type == PLOT_TYPE_VOXEL) then message = "Color specifications ignored in voxel plot " // & trim(to_str(pl % id)) - call warning() + if (master) call warning(message) end if do j = 1, n_cols @@ -3008,7 +3008,7 @@ contains if (get_arraysize_double(node_col, "rgb") /= 3) then message = "Bad RGB " & // "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Ensure that there is an id for this color specification @@ -3017,7 +3017,7 @@ contains else message = "Must specify id for color specification in plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Add RGB @@ -3029,7 +3029,7 @@ contains else message = "Could not find cell " // trim(to_str(col_id)) // & " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else if (pl % color_by == PLOT_COLOR_MATS) then @@ -3040,7 +3040,7 @@ contains else message = "Could not find material " // trim(to_str(col_id)) // & " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if @@ -3055,7 +3055,7 @@ contains if (pl % type == PLOT_TYPE_VOXEL) then message = "Meshlines ignored in voxel plot " // & trim(to_str(pl % id)) - call warning() + call warning(message) end if select case(n_meshlines) @@ -3072,7 +3072,7 @@ contains else message = "Must specify a meshtype for meshlines " // & "specification in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Ensure that there is a linewidth for this meshlines specification @@ -3082,7 +3082,7 @@ contains else message = "Must specify a linewidth for meshlines " // & "specification in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Check for color @@ -3092,7 +3092,7 @@ contains if (get_arraysize_double(node_meshlines, "color") /= 3) then message = "Bad RGB for meshlines color " // & "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if call get_node_array(node_meshlines, "color", & @@ -3110,7 +3110,7 @@ contains if (.not. associated(ufs_mesh)) then message = "No UFS mesh for meshlines on plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if pl % meshlines_mesh => ufs_mesh @@ -3120,7 +3120,7 @@ contains if (.not. cmfd_run) then message = "Need CMFD run to plot CMFD mesh for meshlines " // & "on plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if i_mesh = cmfd_tallies(1) % & @@ -3133,13 +3133,13 @@ contains if (.not. associated(entropy_mesh)) then message = "No entropy mesh for meshlines on plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if if (.not. allocated(entropy_mesh % dimension)) then message = "No dimension specified on entropy mesh for " // & "meshlines on plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if pl % meshlines_mesh => entropy_mesh @@ -3152,7 +3152,7 @@ contains else message = "Must specify a mesh id for meshlines tally mesh" // & "specification in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if ! Check if the specified tally mesh exists @@ -3161,26 +3161,26 @@ contains if (meshes(meshid) % type /= LATTICE_RECT) then message = "Non-rectangular mesh specified in meshlines " // & "for plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else message = "Could not find mesh " // & trim(to_str(meshid)) // & " specified in meshlines for plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if case default message = "Invalid type for meshlines on plot " // & trim(to_str(pl % id)) // ": " // trim(meshtype) - call fatal_error() + call fatal_error(message) end select case default message = "Mutliple meshlines" // & " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end select end if @@ -3193,14 +3193,14 @@ contains if (pl % type == PLOT_TYPE_VOXEL) then message = "Mask ignored in voxel plot " // & trim(to_str(pl % id)) - call warning() + if (master) call warning(message) end if select case(n_masks) case default message = "Mutliple masks" // & " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) case (1) ! Get pointer to mask @@ -3212,7 +3212,7 @@ contains if (n_comp == 0) then message = "Missing in mask of plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if allocate(iarray(n_comp)) call get_node_array(node_mask, "components", iarray) @@ -3229,7 +3229,7 @@ contains else message = "Could not find cell " // trim(to_str(col_id)) // & " specified in the mask in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if else if (pl % color_by == PLOT_COLOR_MATS) then @@ -3239,7 +3239,7 @@ contains else message = "Could not find material " // trim(to_str(col_id)) // & " specified in the mask in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if @@ -3253,7 +3253,7 @@ contains else message = "Missing in mask of plot " // & trim(to_str(pl % id)) - call fatal_error() + call fatal_error(message) end if end if end do @@ -3299,11 +3299,11 @@ contains ! Could not find cross_sections.xml file message = "Cross sections XML file '" // trim(path_cross_sections) // & "' does not exist!" - call fatal_error() + call fatal_error(message) end if message = "Reading cross sections XML file..." - call write_message(5) + call write_message(message, 5) ! Parse cross_sections.xml file call open_xmldoc(doc, path_cross_sections) @@ -3330,7 +3330,7 @@ contains filetype = ASCII else message = "Unknown filetype in cross_sections.xml: " // trim(temp_str) - call fatal_error() + call fatal_error(message) end if ! copy default record length and entries for binary files @@ -3346,7 +3346,7 @@ contains ! Allocate xs_listings array if (n_listings == 0) then message = "No ACE table listings present in cross_sections.xml file!" - call fatal_error() + call fatal_error(message) else allocate(xs_listings(n_listings)) end if @@ -3405,7 +3405,7 @@ contains call get_node_value(node_ace, "path", temp_str) else message = "Path missing for isotope " // listing % name - call fatal_error() + call fatal_error(message) end if if (starts_with(temp_str, '/')) then @@ -3430,7 +3430,7 @@ contains if (.not. xs_listing_dict % has_key(trim(nuclides_0K(i) % name_0K))) then message = "Could not find nuclide " // trim(nuclides_0K(i) % name_0K) // & " in cross_sections.xml file!" - call fatal_error() + call fatal_error(message) end if end do @@ -4270,7 +4270,7 @@ contains case default message = "Cannot expand element: " // name - call fatal_error() + call fatal_error(message) end select diff --git a/src/interpolation.F90 b/src/interpolation.F90 index 531f69ee8c..36c7aa37a2 100644 --- a/src/interpolation.F90 +++ b/src/interpolation.F90 @@ -3,7 +3,6 @@ module interpolation use constants use endf_header, only: Tab1 use error, only: fatal_error - use global, only: message use search, only: binary_search use string, only: to_str @@ -121,7 +120,7 @@ contains y = exp((1-r)*log(y0) + r*log(y1)) case default message = "Unsupported interpolation scheme: " // to_str(interp) - call fatal_error() + call fatal_error(message) end select end function interpolate_tab1_array @@ -207,7 +206,7 @@ contains y = exp((1-r)*log(y0) + r*log(y1)) case default message = "Unsupported interpolation scheme: " // to_str(interp) - call fatal_error() + call fatal_error(message) end select end function interpolate_tab1_object diff --git a/src/output.F90 b/src/output.F90 index 697bc4834c..bd70eeccfb 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -22,8 +22,6 @@ module output integer :: ou = OUTPUT_UNIT integer :: eu = ERROR_UNIT - character(2*MAX_LINE_LEN) :: message - contains !=============================================================================== @@ -197,6 +195,7 @@ contains subroutine write_message(message, level) + character(2*MAX_LINE_LEN) :: message integer, optional :: level ! verbosity level integer :: i_start ! starting position @@ -1556,6 +1555,7 @@ contains subroutine print_results() + character(2*MAX_LINE_LEN) :: message real(8) :: alpha ! significance level for CI real(8) :: t_value ! t-value for confidence intervals @@ -1590,7 +1590,7 @@ contains global_tallies(LEAKAGE) % sum_sq else message = "Could not compute uncertainties -- only one active batch simulated!" - call warning() + if (master) call warning(message) write(ou,103) "k-effective (Collision)", global_tallies(K_COLLISION) % sum write(ou,103) "k-effective (Track-length)", global_tallies(K_TRACKLENGTH) % sum diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 11adb417a7..73ddfd4ae0 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -77,7 +77,7 @@ contains ! Write meessage message = "Loading particle restart file " // trim(path_particle_restart) & // "..." - call write_message(1) + call write_message(message, 1) ! Open file call pr % file_open(path_particle_restart, 'r') diff --git a/src/physics.F90 b/src/physics.F90 index d060c37a40..7bcfa45507 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -52,14 +52,14 @@ contains message = " " // trim(reaction_name(p % event_MT)) // " with " // & trim(adjustl(nuclides(p % event_nuclide) % name)) // & ". Energy = " // trim(to_str(p % E * 1e6_8)) // " eV." - call write_message() + call write_message(message) end if ! check for very low energy if (p % E < 1.0e-100_8) then p % alive = .false. message = "Killing neutron with extremely low energy" - call warning() + if (master) call warning(message) end if end subroutine collision @@ -162,7 +162,7 @@ contains if (i > mat % n_nuclides) then call write_particle_restart(p) message = "Did not sample any nuclide during collision." - call fatal_error() + call fatal_error(message) end if ! Find atom density @@ -372,7 +372,7 @@ contains call write_particle_restart(p) message = "Did not sample any reaction for nuclide " // & trim(nuc % name) - call fatal_error() + call fatal_error(message) end if rxn => nuc % reactions(i) @@ -977,7 +977,7 @@ contains case default message = "Not a recognized resonance scattering treatment!" - call fatal_error() + call fatal_error(message) end select end subroutine sample_target_velocity @@ -1096,7 +1096,7 @@ contains if (.not. in_mesh) then call write_particle_restart(p) message = "Source site outside UFS mesh!" - call fatal_error() + call fatal_error(message) end if if (source_frac(1,ijk(1),ijk(2),ijk(3)) /= ZERO) then @@ -1124,7 +1124,7 @@ contains message = "Maximum number of sites in fission bank reached. This can & &result in irreproducible results using different numbers of & &processes/threads." - call warning() + if (master) call warning(message) end if ! Bank source neutrons @@ -1251,7 +1251,7 @@ contains ! call write_particle_restart(p) message = "Resampled energy distribution maximum number of " // & "times for nuclide " // nuc % name - call fatal_error() + call fatal_error(message) end if end do @@ -1278,7 +1278,7 @@ contains ! call write_particle_restart(p) message = "Resampled energy distribution maximum number of " // & "times for nuclide " // nuc % name - call fatal_error() + call fatal_error(message) end if end do @@ -1460,7 +1460,7 @@ contains else ! call write_particle_restart(p) message = "Unknown interpolation type: " // trim(to_str(interp)) - call fatal_error() + call fatal_error(message) end if ! Because of floating-point roundoff, it may be possible for mu to be @@ -1472,7 +1472,7 @@ contains else ! call write_particle_restart(p) message = "Unknown angular distribution type: " // trim(to_str(type)) - call fatal_error() + call fatal_error(message) end if end function sample_angle @@ -1621,7 +1621,7 @@ contains ! call write_particle_restart(p) message = "Multiple interpolation regions not supported while & &attempting to sample equiprobable energy bins." - call fatal_error() + call fatal_error(message) end if ! determine index on incoming energy grid and interpolation factor @@ -1686,12 +1686,12 @@ contains if (NR == 1) then message = "Assuming linear-linear interpolation when sampling & &continuous tabular distribution" - call warning() + if (master) call warning(message) else if (NR > 1) then ! call write_particle_restart(p) message = "Multiple interpolation regions not supported while & &attempting to sample continuous tabular distribution." - call fatal_error() + call fatal_error(message) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1751,7 +1751,7 @@ contains ! call write_particle_restart(p) message = "Discrete lines in continuous tabular distributed not & &yet supported" - call fatal_error() + call fatal_error(message) end if ! determine outgoing energy bin @@ -1792,7 +1792,7 @@ contains else ! call write_particle_restart(p) message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error(message) end if ! Now interpolate between incident energy bins i and i + 1 @@ -1834,7 +1834,7 @@ contains if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) message = "Too many rejections on Maxwell fission spectrum." - call fatal_error() + call fatal_error(message) end if end do @@ -1867,7 +1867,7 @@ contains if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) message = "Too many rejections on evaporation spectrum." - call fatal_error() + call fatal_error(message) end if end do @@ -1909,7 +1909,7 @@ contains if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) message = "Too many rejections on Watt spectrum." - call fatal_error() + call fatal_error(message) end if end do @@ -1920,7 +1920,7 @@ contains if (.not. present(mu_out)) then ! call write_particle_restart(p) message = "Law 44 called without giving mu_out as argument." - call fatal_error() + call fatal_error(message) end if ! read number of interpolation regions and incoming energies @@ -1930,7 +1930,7 @@ contains ! call write_particle_restart(p) message = "Multiple interpolation regions not supported while & &attempting to sample Kalbach-Mann distribution." - call fatal_error() + call fatal_error(message) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1991,7 +1991,7 @@ contains ! call write_particle_restart(p) message = "Discrete lines in continuous tabular distributed not & &yet supported" - call fatal_error() + call fatal_error(message) end if ! determine outgoing energy bin @@ -2046,7 +2046,7 @@ contains else ! call write_particle_restart() message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error(message) end if ! Now interpolate between incident energy bins i and i + 1 @@ -2073,7 +2073,7 @@ contains if (.not. present(mu_out)) then ! call write_particle_restart() message = "Law 61 called without giving mu_out as argument." - call fatal_error() + call fatal_error(message) end if ! read number of interpolation regions and incoming energies @@ -2083,7 +2083,7 @@ contains ! call write_particle_restart() message = "Multiple interpolation regions not supported while & &attempting to sample correlated energy-angle distribution." - call fatal_error() + call fatal_error(message) end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -2144,7 +2144,7 @@ contains ! call write_particle_restart() message = "Discrete lines in continuous tabular distributed not & &yet supported" - call fatal_error() + call fatal_error(message) end if ! determine outgoing energy bin @@ -2186,7 +2186,7 @@ contains else ! call write_particle_restart() message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error(message) end if ! Now interpolate between incident energy bins i and i + 1 @@ -2250,7 +2250,7 @@ contains else ! call write_particle_restart() message = "Unknown interpolation type: " // trim(to_str(JJ)) - call fatal_error() + call fatal_error(message) end if case (66) diff --git a/src/plot.F90 b/src/plot.F90 index 099e61dffb..93ff5066f7 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -34,7 +34,7 @@ contains ! Display output message message = "Processing plot " // trim(to_str(pl % id)) // "..." - call write_message(5) + call write_message(message, 5) if (pl % type == PLOT_TYPE_SLICE) then ! create 2d image diff --git a/src/search.F90 b/src/search.F90 index 23f8841bdc..a48348524f 100644 --- a/src/search.F90 +++ b/src/search.F90 @@ -1,7 +1,7 @@ module search + use constants use error, only: fatal_error - use global, only: message integer, parameter :: MAX_ITERATION = 64 @@ -35,7 +35,7 @@ contains if (val < array(L) .or. val > array(R)) then message = "Value outside of array during binary search" - call fatal_error() + call fatal_error(message) end if n_iteration = 0 @@ -63,7 +63,7 @@ contains n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then message = "Reached maximum number of iterations on binary search." - call fatal_error() + call fatal_error(message) end if end do @@ -88,7 +88,7 @@ contains if (val < array(L) .or. val > array(R)) then message = "Value outside of array during binary search" - call fatal_error() + call fatal_error(message) end if n_iteration = 0 @@ -116,7 +116,7 @@ contains n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then message = "Reached maximum number of iterations on binary search." - call fatal_error() + call fatal_error(message) end if end do @@ -141,7 +141,7 @@ contains if (val < array(L) .or. val > array(R)) then message = "Value outside of array during binary search" - call fatal_error() + call fatal_error(message) end if n_iteration = 0 @@ -169,7 +169,7 @@ contains n_iteration = n_iteration + 1 if (n_iteration == MAX_ITERATION) then message = "Reached maximum number of iterations on binary search." - call fatal_error() + call fatal_error(message) end if end do diff --git a/src/solver_interface.F90 b/src/solver_interface.F90 index b4d7cfca17..f4b4032e65 100644 --- a/src/solver_interface.F90 +++ b/src/solver_interface.F90 @@ -1,7 +1,7 @@ module solver_interface + use constants use error, only: fatal_error - use global, only: message use matrix_header, only: Matrix use vector_header, only: Vector @@ -13,6 +13,8 @@ module solver_interface implicit none private + character(2*MAX_LINE_LEN) :: message + ! GMRES solver type type, public :: GMRESSolver #ifdef PETSC @@ -70,8 +72,6 @@ module solver_interface integer :: petsc_err ! petsc error code #endif - character(2*MAX_LINE_LEN) :: message - contains #ifdef PETSC diff --git a/src/source.F90 b/src/source.F90 index 25cfd7e6b4..68a9994967 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -37,14 +37,14 @@ contains type(BinaryOutput) :: sp ! statepoint/source binary file message = "Initializing source particles..." - call write_message(6) + call write_message(message, 6) if (path_source /= '') then ! Read the source from a binary file instead of sampling from some ! assumed source distribution message = 'Reading source file from ' // trim(path_source) // '...' - call write_message(6) + call write_message(message, 6) ! Open the binary file call sp % file_open(path_source, 'r', serial = .false.) @@ -55,7 +55,7 @@ contains ! Check to make sure this is a source file if (itmp /= FILETYPE_SOURCE) then message = "Specified starting source file not a source file type." - call fatal_error() + call fatal_error(message) end if ! Read in the source bank @@ -82,7 +82,7 @@ contains ! Write out initial source if (write_initial_source) then message = 'Writing out initial source guess...' - call write_message(1) + call write_message(message, 1) #ifdef HDF5 filename = trim(path_output) // 'initial_source.h5' #else @@ -146,7 +146,7 @@ contains if (num_resamples == MAX_EXTSRC_RESAMPLES) then message = "Maximum number of external source spatial resamples & &reached!" - call fatal_error() + call fatal_error(message) end if end if end do @@ -176,7 +176,7 @@ contains if (num_resamples == MAX_EXTSRC_RESAMPLES) then message = "Maximum number of external source spatial resamples & &reached!" - call fatal_error() + call fatal_error(message) end if cycle end if @@ -210,7 +210,7 @@ contains case default message = "No angle distribution specified for external source!" - call fatal_error() + call fatal_error(message) end select ! Sample energy distribution @@ -242,7 +242,7 @@ contains case default message = "No energy distribution specified for external source!" - call fatal_error() + call fatal_error(message) end select ! Set the random number generator back to the tracking stream. diff --git a/src/state_point.F90 b/src/state_point.F90 index 6a769c6872..af960c0923 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -56,7 +56,7 @@ contains ! Write message message = "Creating state point " // trim(filename) // "..." - call write_message(1) + call write_message(message, 1) if (master) then ! Create statepoint file @@ -317,7 +317,7 @@ contains ! Write message for new file creation message = "Creating source file " // trim(filename) // "..." - call write_message(1) + call write_message(message, 1) ! Create separate source file call sp % file_create(filename, serial = .false.) @@ -362,7 +362,7 @@ contains ! Write message for new file creation message = "Creating source file " // trim(filename) // "..." - call write_message(1) + call write_message(message, 1) ! Always create this file because it will be overwritten call sp % file_create(filename, serial = .false.) @@ -533,7 +533,7 @@ contains ! Write message message = "Loading state point " // trim(path_state_point) // "..." - call write_message(1) + call write_message(message, 1) ! Open file for reading call sp % file_open(path_state_point, 'r', serial = .false.) @@ -547,7 +547,7 @@ contains if (int_array(1) /= REVISION_STATEPOINT) then message = "State point version does not match current version " & // "in OpenMC." - call fatal_error() + call fatal_error(message) end if ! Read OpenMC version @@ -558,7 +558,7 @@ contains .or. int_array(3) /= VERSION_RELEASE) then message = "State point file was created with a different version " & // "of OpenMC." - call warning() + if (master) call warning(message) end if ! Read date and time @@ -669,7 +669,7 @@ contains if (int_array(1) /= t % total_score_bins .and. & int_array(2) /= t % total_filter_bins) then message = "Input file tally structure is different from restart." - call fatal_error() + call fatal_error(message) end if ! Read number of filters @@ -743,7 +743,7 @@ contains ! Check to make sure source bank is present if (path_source_point == path_state_point .and. .not. source_present) then message = "Source bank must be contained in statepoint restart file" - call fatal_error() + call fatal_error(message) end if ! Read tallies to master @@ -756,7 +756,7 @@ contains call sp % read_data(int_array(1), "n_global_tallies", collect=.false.) if (int_array(1) /= N_GLOBAL_TALLIES) then message = "Number of global tallies does not match in state point." - call fatal_error() + call fatal_error(message) end if ! Read global tally data @@ -793,7 +793,7 @@ contains ! Write message message = "Loading source file " // trim(path_source_point) // "..." - call write_message(1) + call write_message(message, 1) ! Open source file call sp % file_open(path_source_point, 'r', serial = .false.) diff --git a/src/string.F90 b/src/string.F90 index 85bfaa6751..05037d019f 100644 --- a/src/string.F90 +++ b/src/string.F90 @@ -2,7 +2,7 @@ module string use constants, only: MAX_WORDS, MAX_LINE_LEN, ERROR_INT, ERROR_REAL use error, only: fatal_error, warning - use global, only: message + use global, only: master implicit none @@ -53,7 +53,7 @@ contains if (i_end - i_start + 1 > len(words(n))) then message = "The word '" // string(i_start:i_end) // & "' is longer than the space allocated for it." - call warning() + if (master) call warning(message) end if words(n) = string(i_start:i_end) ! reset indices @@ -213,7 +213,7 @@ function zero_padded(num, n_digits) result(str) ! largest integer(4). if (n_digits > 10) then message = 'zero_padded called with an unreasonably large n_digits (>10)' - call fatal_error() + call fatal_error(message) end if ! Write a format string of the form '(In.m)' where n is the max width and diff --git a/src/tally.F90 b/src/tally.F90 index 91c28fbcf9..1803eb34e3 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -874,7 +874,7 @@ contains else message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end if end select @@ -1012,7 +1012,7 @@ contains else message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end if end select end if @@ -1212,7 +1212,7 @@ contains else message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end if end select @@ -1364,7 +1364,7 @@ contains else message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end if end select @@ -1711,7 +1711,7 @@ contains case default message = "Invalid score type on tally " // & to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end select else @@ -1787,7 +1787,7 @@ contains case default message = "Invalid score type on tally " // & to_str(t % id) // "." - call fatal_error() + call fatal_error(message) end select end if @@ -2226,7 +2226,7 @@ contains if (filter_index <= 0 .or. filter_index > & t % total_filter_bins) then message = "Score index outside range." - call fatal_error() + call fatal_error(message) end if ! Add to surface current tally @@ -2566,17 +2566,17 @@ contains ! check to see if any of the active tally lists has been allocated if (active_tallies % size() > 0) then message = "Active tallies should not exist before CMFD tallies!" - call fatal_error() + call fatal_error(message) else if (active_analog_tallies % size() > 0) then message = 'Active analog tallies should not exist before CMFD tallies!' - call fatal_error() + call fatal_error(message) else if (active_tracklength_tallies % size() > 0) then message = "Active tracklength tallies should not exist before CMFD & &tallies!" - call fatal_error() + call fatal_error(message) else if (active_current_tallies % size() > 0) then message = "Active current tallies should not exist before CMFD tallies!" - call fatal_error() + call fatal_error(message) end if do i = 1, n_cmfd_tallies diff --git a/src/tracking.F90 b/src/tracking.F90 index 5ddfd32384..f0eb381eb4 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -42,7 +42,7 @@ contains ! Display message if high verbosity or trace is on if (verbosity >= 9 .or. trace) then message = "Simulating Particle " // trim(to_str(p % id)) - call write_message() + call write_message(message) end if ! If the cell hasn't been determined based on the particle's location, @@ -53,7 +53,7 @@ contains ! Particle couldn't be located if (.not. found_cell) then message = "Could not locate particle " // trim(to_str(p % id)) - call fatal_error() + call fatal_error(message) end if ! set birth cell attribute @@ -202,7 +202,7 @@ contains if (n_event == MAX_EVENTS) then message = "Particle " // trim(to_str(p%id)) // " underwent maximum & &number of events." - call warning() + if (master) call warning(message) p % alive = .false. end if diff --git a/src/xml_interface.F90 b/src/xml_interface.F90 index 0860c4fab5..43103b153c 100644 --- a/src/xml_interface.F90 +++ b/src/xml_interface.F90 @@ -2,7 +2,6 @@ module xml_interface use constants, only: MAX_LINE_LEN use error, only: fatal_error - use global, only: message use openmc_fox implicit none @@ -205,7 +204,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -238,7 +237,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -271,7 +270,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -304,7 +303,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -337,7 +336,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -370,7 +369,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -403,7 +402,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Extract value @@ -436,7 +435,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Get the size @@ -465,7 +464,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Get the size @@ -494,7 +493,7 @@ contains if (.not. found) then message = "Node " // node_name // " not part of Node " // & getNodeName(ptr) // "." - call fatal_error() + call fatal_error(message) end if ! Get the size