diff --git a/src/ace.F90 b/src/ace.F90 index 6a712ccd74..584254149d 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -15,13 +15,13 @@ module ace implicit none - integer :: NXS(16) ! Descriptors for ACE XSS tables - integer :: JXS(32) ! Pointers into ACE XSS tables - real(8), allocatable :: XSS(:) ! Cross section data - integer :: XSS_index ! current index in XSS data + integer :: JXS(32) ! Pointers into ACE XSS tables + integer :: NXS(16) ! Descriptors for ACE XSS tables + real(8), allocatable :: XSS(:) ! Cross section data + integer :: XSS_index ! Current index in XSS data - private :: NXS private :: JXS + private :: NXS private :: XSS contains @@ -151,9 +151,9 @@ contains ! Check to make sure S(a,b) table matched a nuclide 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("S(a,b) table " // trim(mat % sab_names(k)) & + &// " did not match any nuclide on material " & + &// trim(to_str(mat % id))) end if end do ASSIGN_SAB @@ -264,17 +264,14 @@ contains ! Check if ACE library exists and is readable 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("ACE library '" // trim(filename) // "' does not exist!") 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("ACE library '" // trim(filename) // "' is not readable!& + & Change file permissions with chmod command.") end if ! display message - message = "Loading ACE cross section table: " // listing % name - call write_message(6) + call write_message("Loading ACE cross section table: " // listing % name, 6) if (filetype == ASCII) then ! ======================================================================= @@ -293,9 +290,8 @@ contains ! Check that correct xs was found -- if cross_sections.xml is broken, the ! location of the table may be wrong 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("XS listing entry " // trim(listing % name) // " did & + ¬ match ACE data, " // trim(name) // " found instead.") end if ! Read more header and NXS and JXS @@ -377,8 +373,8 @@ contains ! if any fissionable material is found in a fixed source calculation, ! 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("Cannot have fissionable material in a fixed source & + &run.") end if ! for fissionable nuclides, precalculate microscopic nu-fission cross @@ -1315,9 +1311,8 @@ contains ! Abort if no corresponding inelastic reaction was found if (nuc % urr_inelastic == NONE) then - message = "Could not find inelastic reaction specified on " & - // "unresolved resonance probability table." - call fatal_error() + call fatal_error("Could not find inelastic reaction specified on & + &unresolved resonance probability table.") end if end if @@ -1343,9 +1338,8 @@ contains ! Check for negative values 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("Negative value(s) found on probability table & + &for nuclide " // nuc % name) end if end subroutine read_unr_res diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index abba2d47d7..b392e86a28 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 @@ -53,7 +54,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 @@ -159,10 +160,9 @@ contains ! Detect zero flux, abort if located if ((flux - ZERO) < TINY_BIT) then - 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('Detected zero flux without coremap overlay & + &at: (' // to_str(i) // ',' // to_str(j) // ',' // & + &to_str(k) // ') in group ' // to_str(h)) end if ! Get total rr and convert to total xs @@ -626,7 +626,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 @@ -764,8 +764,7 @@ contains ! write that dhats are zero if (dhat_reset) then - message = 'Dhats reset to zero.' - call write_message(1) + call write_message('Dhats reset to zero.', 1) end if end subroutine compute_dhat diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index d14a3af243..8e0eb3fda0 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -44,8 +44,7 @@ contains elseif (trim(cmfd_solver_type) == 'jfnk') then call cmfd_jfnk_execute() else - message = 'solver type became invalid after input processing' - call fatal_error() + call fatal_error('solver type became invalid after input processing') end if #else call cmfd_solver_execute() @@ -255,8 +254,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 @@ -314,8 +313,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("Source sites outside of the CMFD mesh!") end if ! Have master compute weight factors (watch for 0s) @@ -345,12 +343,10 @@ contains n_groups = size(cmfd % egrid) - 1 if (source_bank(i) % E < cmfd % egrid(1)) then e_bin = 1 - message = 'Source pt below energy grid' - call warning() + if (master) call warning('Source pt below energy grid') 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('Source pt above energy grid') else e_bin = binary_search(cmfd % egrid, n_groups + 1, source_bank(i) % E) end if @@ -360,8 +356,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('Source site found outside of CMFD mesh') end if ! Reweight particle @@ -410,15 +405,14 @@ 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 integer :: i ! loop counter ! Print message - message = "CMFD tallies reset" - call write_message(7) + call write_message("CMFD tallies reset", 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 67e8f0d0f3..578ecb9678 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -85,15 +85,14 @@ contains if (.not. file_exists) then ! 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("No CMFD XML file, '" // trim(filename) // "' does not& + & exist!") end if return else ! Tell user - message = "Reading CMFD XML file..." - call write_message(5) + call write_message("Reading CMFD XML file...", 5) end if @@ -105,8 +104,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("No CMFD mesh specified in CMFD XML file.") end if ! Set spatial dimensions in cmfd object @@ -137,8 +135,7 @@ contains cmfd % indices(3))) 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('CMFD coremap not to correct dimensions') end if allocate(iarray(get_arraysize_integer(node_mesh, "map"))) call get_node_array(node_mesh, "map", iarray) @@ -214,8 +211,7 @@ contains temp_str = to_lower(temp_str) 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('Must use PETSc when running adjoint option.') #endif cmfd_run_adjoint = .true. end if @@ -244,8 +240,8 @@ contains call get_node_value(doc, "display", cmfd_display) 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('Dominance Ratio only aviable with power & + &iteration solver') cmfd_display = '' end if @@ -261,9 +257,8 @@ contains if (check_for_node(doc, "gauss_seidel_tolerance")) then n_params = get_arraysize_double(doc, "gauss_seidel_tolerance") if (n_params /= 2) then - message = 'Gauss Seidel tolerance is not 2 parameters & - &(absolute, relative).' - call fatal_error() + call fatal_error('Gauss Seidel tolerance is not 2 parameters & + &(absolute, relative).') end if call get_node_array(doc, "gauss_seidel_tolerance", gs_tol) cmfd_atoli = gs_tol(1) @@ -333,8 +328,7 @@ contains ! 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("Mesh must be two or three dimensions.") end if m % n_dimension = n @@ -347,9 +341,8 @@ contains ! Check that dimensions are all greater than zero call get_node_array(node_mesh, "dimension", iarray3(1:n)) 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("All entries on the element for a tally mesh& + & must be positive.") end if ! Read dimensions in each direction @@ -357,42 +350,37 @@ contains ! Read mesh lower-left corner location 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("Number of entries on must be the same as & + &the number of entries on .") end if call get_node_array(node_mesh, "lower_left", m % lower_left) ! Make sure both upper-right or width were specified if (check_for_node(node_mesh, "upper_right") .and. & check_for_node(node_mesh, "width")) then - message = "Cannot specify both and on a & - &tally mesh." - call fatal_error() + call fatal_error("Cannot specify both and on a & + &tally mesh.") end if ! Make sure either upper-right or width was specified if (.not.check_for_node(node_mesh, "upper_right") .and. & .not.check_for_node(node_mesh, "width")) then - message = "Must specify either and on a & - &tally mesh." - call fatal_error() + call fatal_error("Must specify either and on a & + &tally mesh.") end if if (check_for_node(node_mesh, "width")) then ! Check to ensure width has same dimensions if (get_arraysize_double(node_mesh, "width") /= & 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("Number of entries on must be the same as the & + &number of entries on .") 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("Cannot have a negative on a tally mesh.") end if ! Set width and upper right coordinate @@ -403,17 +391,15 @@ contains ! Check to ensure width has same dimensions if (get_arraysize_double(node_mesh, "upper_right") /= & 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("Number of entries on must be the same & + &as the number of entries on .") end if ! Check that upper-right is above lower-left call get_node_array(node_mesh, "upper_right", rarray3(1:n)) 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("The coordinates must be greater than & + &the coordinates on a tally mesh.") end if ! Set upper right coordinate and width diff --git a/src/cmfd_solver.F90 b/src/cmfd_solver.F90 index b3e8fb8a88..e660c92470 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, only: MAX_LINE_LEN 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 @@ -11,25 +12,25 @@ module cmfd_solver private public :: cmfd_solver_execute - real(8) :: k_n ! new k-eigenvalue - real(8) :: k_o ! old k-eigenvalue - real(8) :: k_s ! shift of eigenvalue - real(8) :: k_ln ! new shifted eigenvalue - real(8) :: k_lo ! old shifted eigenvalue - real(8) :: norm_n ! current norm of source vector - real(8) :: norm_o ! old norm of source vector - real(8) :: kerr ! error in keff - real(8) :: serr ! error in source - real(8) :: ktol ! tolerance on keff - real(8) :: stol ! tolerance on source - logical :: adjoint_calc ! run an adjoint calculation - type(Matrix) :: loss ! cmfd loss matrix - type(Matrix) :: prod ! cmfd prod matrix - type(Vector) :: phi_n ! new flux vector - type(Vector) :: phi_o ! old flux vector - type(Vector) :: s_n ! new source vector - type(Vector) :: s_o ! old flux vector - type(Vector) :: serr_v ! error in source + real(8) :: k_n ! New k-eigenvalue + real(8) :: k_o ! Old k-eigenvalue + real(8) :: k_s ! Shift of eigenvalue + real(8) :: k_ln ! New shifted eigenvalue + real(8) :: k_lo ! Old shifted eigenvalue + real(8) :: norm_n ! Current norm of source vector + real(8) :: norm_o ! Old norm of source vector + real(8) :: kerr ! Error in keff + real(8) :: serr ! Error in source + real(8) :: ktol ! Tolerance on keff + real(8) :: stol ! Tolerance on source + logical :: adjoint_calc ! Run an adjoint calculation + type(Matrix) :: loss ! Cmfd loss matrix + type(Matrix) :: prod ! Cmfd prod matrix + type(Vector) :: phi_n ! New flux vector + type(Vector) :: phi_o ! Old flux vector + type(Vector) :: s_n ! New source vector + type(Vector) :: s_o ! Old flux vector + type(Vector) :: serr_v ! Error in source ! CMFD linear solver interface procedure(linsolve), pointer :: cmfd_linsolver => null() @@ -100,7 +101,6 @@ contains subroutine init_data(adjoint) use constants, only: ONE, ZERO - use error, only: fatal_error use global, only: cmfd, cmfd_shift, keff, cmfd_ktol, cmfd_stol, & cmfd_write_matrices @@ -180,8 +180,6 @@ contains use error, only: fatal_error #ifdef PETSC use global, only: cmfd_write_matrices -#else - use global, only: message #endif #ifdef PETSC @@ -195,8 +193,7 @@ contains call prod % write_petsc_binary('adj_prodmat.bin') end if #else - message = 'Adjoint calculations only allowed with PETSc' - call fatal_error() + call fatal_error('Adjoint calculations only allowed with PETSc') #endif end subroutine compute_adjoint @@ -210,7 +207,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 @@ -237,8 +234,8 @@ 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('Reached maximum iterations in CMFD power iteration & + &solver.') end if ! Compute source vector @@ -357,7 +354,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 @@ -401,8 +398,7 @@ contains ! Check for max iterations met if (igs == 10000) then - message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error('Maximum Gauss-Seidel iterations encountered.') endif ! Copy over x vector @@ -464,7 +460,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 @@ -520,8 +516,7 @@ contains ! Check for max iterations met if (igs == 10000) then - message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error('Maximum Gauss-Seidel iterations encountered.') endif ! Copy over x vector @@ -610,7 +605,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 @@ -653,8 +648,7 @@ contains ! Check for max iterations met if (igs == 10000) then - message = 'Maximum Gauss-Seidel iterations encountered.' - call fatal_error() + call fatal_error('Maximum Gauss-Seidel iterations encountered.') endif ! Copy over x vector diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index cd95568849..c46f90ab17 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -26,8 +26,9 @@ module eigenvalue private public :: run_eigenvalue - real(8) :: keff_generation ! Single-generation k on each processor - real(8) :: k_sum(2) = ZERO ! used to reduce sum and sum_sq + real(8) :: keff_generation ! Single-generation k on each + ! processor + real(8) :: k_sum(2) = ZERO ! Used to reduce sum and sum_sq contains @@ -114,8 +115,8 @@ contains subroutine initialize_batch() - message = "Simulating batch " // trim(to_str(current_batch)) // "..." - call write_message(8) + call write_message("Simulating batch " // trim(to_str(current_batch)) & + &// "...", 8) ! Reset total starting particle weight used for normalizing tallies total_weight = ZERO @@ -301,8 +302,7 @@ contains ! runs enough particles to avoid this in the first place. if (n_bank == 0) then - message = "No fission sites banked on processor " // to_str(rank) - call fatal_error() + call fatal_error("No fission sites banked on processor " // to_str(rank)) end if ! Make sure all processors start at the same point for random sampling. Then @@ -553,8 +553,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("Fission source site(s) outside of entropy box.") end if ! sum values to obtain shannon entropy @@ -772,8 +771,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("Source sites outside of the UFS mesh!") end if #ifdef MPI @@ -803,8 +801,7 @@ contains ! Write message at beginning if (current_batch == 1) then - message = "Replaying history from state point..." - call write_message(1) + call write_message("Replaying history from state point...", 1) end if do current_gen = 1, gen_per_batch @@ -821,8 +818,7 @@ contains ! Write message at end if (current_batch == restart_batch) then - message = "Resuming simulation..." - call write_message(1) + call write_message("Resuming simulation...", 1) end if end subroutine replay_batch_history diff --git a/src/energy_grid.F90 b/src/energy_grid.F90 index 66b95be0de..a006959d92 100644 --- a/src/energy_grid.F90 +++ b/src/energy_grid.F90 @@ -21,8 +21,7 @@ contains type(ListReal), pointer :: list => null() type(Nuclide), pointer :: nuc => null() - message = "Creating unionized energy grid..." - call write_message(5) + call write_message("Creating unionized energy grid...", 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 78fd64c25e..77f663108f 100644 --- a/src/error.F90 +++ b/src/error.F90 @@ -1,6 +1,7 @@ module error use, intrinsic :: ISO_FORTRAN_ENV + use constants use global @@ -17,9 +18,9 @@ contains ! stream. !=============================================================================== - subroutine warning(force) + subroutine warning(message) - logical, optional :: force ! force write from proc other than master + character(*) :: message integer :: i_start ! starting position integer :: i_end ! ending position @@ -27,9 +28,6 @@ contains integer :: length ! length of message integer :: indent ! length of indentation - ! Only allow master to print to screen - if (.not. master .and. .not. present(force)) return - ! Write warning at beginning write(ERROR_UNIT, fmt='(1X,A)', advance='no') 'WARNING: ' @@ -78,8 +76,9 @@ contains ! the program is aborted. !=============================================================================== - subroutine fatal_error(error_code) + subroutine fatal_error(message, error_code) + character(*) :: message integer, optional :: error_code ! error code integer :: code ! error code diff --git a/src/fission.F90 b/src/fission.F90 index 8934b79cf5..27143bf386 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 @@ -27,8 +26,7 @@ contains real(8) :: c ! polynomial coefficient if (nuc % nu_t_type == NU_NONE) then - message = "No neutron emission data for table: " // nuc % name - call fatal_error() + call fatal_error("No neutron emission data for table: " // nuc % name) 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 11290db538..3cbf8673a6 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -1,6 +1,6 @@ module fixed_source - use constants, only: ZERO + use constants, only: ZERO, MAX_LINE_LEN use global use output, only: write_message, header use particle_header, only: Particle @@ -94,8 +94,8 @@ contains subroutine initialize_batch() - message = "Simulating batch " // trim(to_str(current_batch)) // "..." - call write_message(1) + call write_message("Simulating batch " // trim(to_str(current_batch)) & + &// "...", 1) ! Reset total starting particle weight used for normalizing tallies total_weight = ZERO diff --git a/src/geometry.F90 b/src/geometry.F90 index 187a207fd9..043ded05b5 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -11,7 +11,7 @@ module geometry use tally, only: score_surface_current implicit none - + contains !=============================================================================== @@ -100,11 +100,10 @@ contains if (simple_cell_contains(c, p)) then ! the particle should only be contained in one cell per level if (index_cell /= coord % cell) then - message = "Overlapping cells detected: " // & - 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("Overlapping cells detected: " & + &// trim(to_str(cells(index_cell) % id)) // ", " & + &// trim(to_str(cells(coord % cell) % id)) & + &// " on universe " // trim(to_str(univ % id))) end if overlap_check_cnt(index_cell) = overlap_check_cnt(index_cell) + 1 @@ -179,8 +178,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(" Entering cell " // trim(to_str(c % id))) end if if (c % type == CELL_NORMAL) then @@ -384,8 +382,7 @@ contains i_surface = abs(p % surface) surf => surfaces(i_surface) if (verbosity >= 10 .or. trace) then - message = " Crossing surface " // trim(to_str(surf % id)) - call write_message() + call write_message(" Crossing surface " // trim(to_str(surf % id))) end if if (surf % bc == BC_VACUUM .and. (run_mode /= MODE_PLOTTING)) then @@ -417,8 +414,8 @@ 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(" Leaked out of surface " & + &// trim(to_str(surf % id))) end if return @@ -428,9 +425,8 @@ contains ! Do not handle reflective boundary conditions on lower universes if (.not. associated(p % coord, p % coord0)) then - message = "Cannot reflect particle " // trim(to_str(p % id)) // & - " off surface in a lower universe." - call handle_lost_particle(p) + call handle_lost_particle(p, "Cannot reflect particle " & + &// trim(to_str(p % id)) // " off surface in a lower universe.") return end if @@ -562,9 +558,8 @@ contains w = w + 2*dot_prod*R*z case default - message = "Reflection not supported for surface " // & - trim(to_str(surf % id)) - call fatal_error() + call fatal_error("Reflection not supported for surface " & + &// trim(to_str(surf % id))) end select ! Set new particle direction @@ -583,8 +578,8 @@ contains call deallocate_coord(p % coord0 % next) call find_cell(p, found) if (.not. found) then - message = "Couldn't find particle after reflecting from surface." - call handle_lost_particle(p) + call handle_lost_particle(p, "Couldn't find particle after reflecting& + & from surface.") return end if end if @@ -594,8 +589,8 @@ contains ! Diagnostic message if (verbosity >= 10 .or. trace) then - message = " Reflected from surface " // trim(to_str(surf%id)) - call write_message() + call write_message(" Reflected from surface " & + &// trim(to_str(surf%id))) end if return end if @@ -643,10 +638,9 @@ contains ! undefined region in the geometry. if (.not. found) then - message = "After particle " // trim(to_str(p % id)) // " crossed surface " & - // trim(to_str(surfaces(i_surface) % id)) // " it could not be & - &located in any cell and it did not leak." - call handle_lost_particle(p) + call handle_lost_particle(p, "After particle " // trim(to_str(p % id)) & + &// " crossed surface " // trim(to_str(surfaces(i_surface) % id)) & + &// " it could not be located in any cell and it did not leak.") return end if end if @@ -672,11 +666,10 @@ contains lat => lattices(p % coord % lattice) if (verbosity >= 10 .or. trace) then - message = " Crossing lattice " // trim(to_str(lat % id)) // & - ". 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(" Crossing lattice " // trim(to_str(lat % id)) & + &// ". Current position (" // trim(to_str(p % coord % lattice_x)) & + &// "," // trim(to_str(p % coord % lattice_y)) // "," & + &// trim(to_str(p % coord % lattice_z)) // ")") end if if (lat % type == LATTICE_RECT) then @@ -739,9 +732,8 @@ contains ! Search for particle call find_cell(p, found) if (.not. found) then - message = "Could not locate particle " // trim(to_str(p % id)) // & - " after crossing a lattice boundary." - call handle_lost_particle(p) + call handle_lost_particle(p, "Could not locate particle " & + &// trim(to_str(p % id)) // " after crossing a lattice boundary.") return end if else @@ -762,9 +754,9 @@ contains ! Search for particle call find_cell(p, found) if (.not. found) then - message = "Could not locate particle " // trim(to_str(p % id)) // & - " after crossing a lattice boundary." - call handle_lost_particle(p) + call handle_lost_particle(p, "Could not locate particle " & + &// trim(to_str(p % id)) & + &// " after crossing a lattice boundary.") return end if end if @@ -1494,8 +1486,8 @@ contains type(Cell), pointer :: c type(Surface), pointer :: surf - message = "Building neighboring cells lists for each surface..." - call write_message(4) + call write_message("Building neighboring cells lists for each surface...", & + &4) allocate(count_positive(n_surfaces)) allocate(count_negative(n_surfaces)) @@ -1562,12 +1554,13 @@ contains ! HANDLE_LOST_PARTICLE !=============================================================================== - subroutine handle_lost_particle(p) + subroutine handle_lost_particle(p, message) type(Particle), intent(inout) :: p + character(*) :: message ! Print warning and write lost particle file - call warning(force = .true.) + call warning(message) call write_particle_restart(p) ! Increment number of lost particles @@ -1579,8 +1572,7 @@ contains ! Abort the simulation if the maximum number of lost particles has been ! reached if (n_lost_particles == MAX_LOST_PARTICLES) then - message = "Maximum number of lost particles has been reached." - call fatal_error() + call fatal_error("Maximum number of lost particles has been reached.") end if end subroutine handle_lost_particle diff --git a/src/global.F90 b/src/global.F90 index b5f9c4a01e..f4c50b8330 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -272,9 +272,6 @@ module global character(MAX_FILE_LEN) :: path_particle_restart ! Path to particle restart character(MAX_FILE_LEN) :: path_output = '' ! Path to output directory - ! Message used in message/warning/fatal_error - character(2*MAX_LINE_LEN) :: message - ! Random number seed integer(8) :: seed = 1_8 @@ -396,7 +393,7 @@ module global integer :: n_res_scatterers_total = 0 ! total number of resonant scatterers type(Nuclide0K), allocatable, target :: nuclides_0K(:) ! 0K nuclides info -!$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, message, & +!$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, & !$omp& trace, thread_id, current_work, matching_bins) contains diff --git a/src/initialize.F90 b/src/initialize.F90 index 7d4adad493..e0a5bf8b0c 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -156,10 +156,8 @@ contains ! Warn if overlap checking is on if (master .and. check_overlaps) then - message = "" - call write_message() - message = "Cell overlap checking is ON" - call warning() + call write_message("") + call warning("Cell overlap checking is ON") end if ! Stop initialization timer @@ -342,9 +340,8 @@ contains ! Check that number specified was valid if (n_particles == ERROR_INT) then - message = "Must specify integer after " // trim(argv(i-1)) // & - " command-line flag." - call fatal_error() + call fatal_error("Must specify integer after " // trim(argv(i-1)) & + &// " command-line flag.") end if case ('-r', '-restart', '--restart') ! Read path for state point/particle restart @@ -364,8 +361,7 @@ contains path_particle_restart = argv(i) particle_restart_run = .true. case default - message = "Unrecognized file after restart flag." - call fatal_error() + call fatal_error("Unrecognized file after restart flag.") end select ! If its a restart run check for additional source file @@ -383,8 +379,8 @@ contains call sp % read_data(filetype, 'filetype') 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("Second file after restart flag must be a & + &source file") end if ! It is a source file @@ -418,13 +414,13 @@ contains ! Read and set number of OpenMP threads 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("Invalid number of threads specified on command & + &line.") 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("Ignoring number of threads specified on & + &command line.") #endif case ('-?', '-h', '-help', '--help') @@ -440,8 +436,7 @@ contains write_all_tracks = .true. i = i + 1 case default - message = "Unknown command line option: " // argv(i) - call fatal_error() + call fatal_error("Unknown command line option: " // argv(i)) end select last_flag = i @@ -577,9 +572,8 @@ contains i_array = surface_dict % get_key(abs(id)) c % surfaces(j) = sign(i_array, id) 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("Could not find surface " // trim(to_str(abs(id)))& + &// " specified on cell " // trim(to_str(c % id))) end if end if end do @@ -591,9 +585,8 @@ contains if (universe_dict % has_key(id)) then c % universe = universe_dict % get_key(id) else - message = "Could not find universe " // trim(to_str(id)) // & - " specified on cell " // trim(to_str(c % id)) - call fatal_error() + call fatal_error("Could not find universe " // trim(to_str(id)) & + &// " specified on cell " // trim(to_str(c % id))) end if ! ======================================================================= @@ -607,9 +600,8 @@ contains c % type = CELL_NORMAL c % material = material_dict % get_key(id) else - message = "Could not find material " // trim(to_str(id)) // & - " specified on cell " // trim(to_str(c % id)) - call fatal_error() + call fatal_error("Could not find material " // trim(to_str(id)) & + &// " specified on cell " // trim(to_str(c % id))) end if else id = c % fill @@ -626,15 +618,14 @@ contains else if (material_dict % has_key(mid)) then c % material = material_dict % get_key(mid) else - message = "Could not find material " // trim(to_str(mid)) // & - " specified on lattice " // trim(to_str(lid)) - call fatal_error() + call fatal_error("Could not find material " // trim(to_str(mid)) & + &// " specified on lattice " // trim(to_str(lid))) 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("Specified fill " // trim(to_str(id)) // " on cell "& + &// trim(to_str(c % id)) // " is neither a universe nor a & + &lattice.") end if end if end do @@ -659,9 +650,8 @@ contains if (universe_dict % has_key(id)) then lat % universes(j,k,m) = universe_dict % get_key(id) else - message = "Invalid universe number " // trim(to_str(id)) & - // " specified on lattice " // trim(to_str(lat % id)) - call fatal_error() + call fatal_error("Invalid universe number " // trim(to_str(id)) & + &// " specified on lattice " // trim(to_str(lat % id))) end if end do end do @@ -685,9 +675,8 @@ contains if (cell_dict % has_key(id)) then t % filters(j) % int_bins(k) = cell_dict % get_key(id) else - message = "Could not find cell " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error("Could not find cell " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if end do @@ -701,9 +690,8 @@ contains if (surface_dict % has_key(id)) then t % filters(j) % int_bins(k) = surface_dict % get_key(id) else - message = "Could not find surface " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error("Could not find surface " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if end do @@ -714,9 +702,8 @@ contains if (universe_dict % has_key(id)) then t % filters(j) % int_bins(k) = universe_dict % get_key(id) else - message = "Could not find universe " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error("Could not find universe " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if end do @@ -727,9 +714,8 @@ contains if (material_dict % has_key(id)) then t % filters(j) % int_bins(k) = material_dict % get_key(id) else - message = "Could not find material " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error("Could not find material " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if end do @@ -864,8 +850,7 @@ contains ! Check for allocation errors if (alloc_err /= 0) then - message = "Failed to allocate source bank." - call fatal_error() + call fatal_error("Failed to allocate source bank.") end if #ifdef _OPENMP @@ -892,8 +877,7 @@ contains ! Check for allocation errors if (alloc_err /= 0) then - message = "Failed to allocate fission bank." - call fatal_error() + call fatal_error("Failed to allocate fission bank.") end if end subroutine allocate_banks diff --git a/src/input_xml.F90 b/src/input_xml.F90 index e84f072ea8..e992a0eae0 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -20,7 +20,7 @@ module input_xml implicit none save - type(DictIntInt) :: cells_in_univ_dict ! used to count how many cells each + type(DictIntInt) :: cells_in_univ_dict ! Used to count how many cells each ! universe contains contains @@ -76,19 +76,17 @@ contains type(NodeList), pointer :: node_scat_list => null() ! Display output message - message = "Reading settings XML file..." - call write_message(5) + call write_message("Reading settings XML file...", 5) ! Check if settings.xml exists filename = trim(path_input) // "settings.xml" inquire(FILE=filename, EXIST=file_exists) if (.not. file_exists) then - message = "Settings XML file '" // trim(filename) // "' does not exist! & - &In order to run OpenMC, you first need a set of input files; at a & - &minimum, this includes settings.xml, geometry.xml, and & + call fatal_error("Settings XML file '" // trim(filename) // "' does not & + &exist! In order to run OpenMC, you first need a set of input files;& + & at a 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() + &http://mit-crpg.github.io/openmc for further information.") end if ! Parse settings.xml file @@ -104,13 +102,12 @@ contains ! environment variable call get_environment_variable("CROSS_SECTIONS", env_variable) if (len_trim(env_variable) == 0) then - message = "No cross_sections.xml file was specified in settings.xml & - &or in the CROSS_SECTIONS environment variable. OpenMC needs a & - &cross_sections.xml file to identify where to find ACE cross & - §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("No cross_sections.xml file was specified in & + &settings.xml or in the CROSS_SECTIONS environment variable. & + &OpenMC needs a cross_sections.xml file to identify where to & + &find ACE cross section 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.") else path_cross_sections = trim(env_variable) end if @@ -130,8 +127,7 @@ contains ! Make sure that either eigenvalue or fixed source was specified 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(" or not specified.") end if ! Eigenvalue information @@ -144,8 +140,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("Need to specify number of particles per generation.") end if ! Get number of particles @@ -179,8 +174,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("Need to specify number of particles per batch.") end if ! Get number of particles @@ -199,14 +193,11 @@ 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("Number of active batches must be greater than zero.") elseif (n_inactive < 0) then - message = "Number of inactive batches must be non-negative." - call fatal_error() + call fatal_error("Number of inactive batches must be non-negative.") elseif (n_particles <= 0) then - message = "Number of particles must be greater than zero." - call fatal_error() + call fatal_error("Number of particles must be greater than zero.") end if ! Copy random number seed if specified @@ -224,11 +215,9 @@ contains case ('union') grid_method = GRID_UNION case ('lethargy') - message = "Lethargy mapped energy grid not yet supported." - call fatal_error() + call fatal_error("Lethargy mapped energy grid not yet supported.") case default - message = "Unknown energy grid method: " // trim(temp_str) - call fatal_error() + call fatal_error("Unknown energy grid method: " // trim(temp_str)) end select ! Verbosity @@ -243,14 +232,12 @@ contains if (n_threads == NONE) then 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("Invalid number of threads: " // to_str(n_threads)) end if call omp_set_num_threads(n_threads) end if #else - message = "Ignoring number of threads." - call warning() + if (master) call warning("Ignoring number of threads.") #endif end if @@ -261,8 +248,7 @@ contains if (check_for_node(doc, "source")) then call get_node_ptr(doc, "source", node_source) else - message = "No source specified in settings XML file." - call fatal_error() + call fatal_error("No source specified in settings XML file.") end if ! Check if we want to write out source @@ -281,9 +267,8 @@ contains ! Check if source file exists inquire(FILE=path_source, EXIST=file_exists) if (.not. file_exists) then - message = "Binary source file '" // trim(path_source) // & - "' does not exist!" - call fatal_error() + call fatal_error("Binary source file '" // trim(path_source) & + &// "' does not exist!") end if else @@ -309,9 +294,8 @@ contains external_source % type_space = SRC_SPACE_POINT coeffs_reqd = 3 case default - message = "Invalid spatial distribution for external source: " & - // trim(type) - call fatal_error() + call fatal_error("Invalid spatial distribution for external source: "& + &// trim(type)) end select ! Determine number of parameters specified @@ -323,21 +307,19 @@ contains ! Read parameters for spatial distribution if (n < coeffs_reqd) then - message = "Not enough parameters specified for spatial & - &distribution of external source." - call fatal_error() + call fatal_error("Not enough parameters specified for spatial & + &distribution of external source.") elseif (n > coeffs_reqd) then - message = "Too many parameters specified for spatial & - &distribution of external source." - call fatal_error() + call fatal_error("Too many parameters specified for spatial & + &distribution of external source.") elseif (n > 0) then allocate(external_source % params_space(n)) call get_node_array(node_dist, "parameters", & external_source % params_space) end if else - message = "No spatial distribution specified for external source." - call fatal_error() + call fatal_error("No spatial distribution specified for external & + &source.") end if ! Determine external source angular distribution @@ -360,9 +342,8 @@ contains case ('tabular') external_source % type_angle = SRC_ANGLE_TABULAR case default - message = "Invalid angular distribution for external source: " & - // trim(type) - call fatal_error() + call fatal_error("Invalid angular distribution for external source: "& + &// trim(type)) end select ! Determine number of parameters specified @@ -374,13 +355,11 @@ contains ! Read parameters for angle distribution if (n < coeffs_reqd) then - message = "Not enough parameters specified for angle & - &distribution of external source." - call fatal_error() + call fatal_error("Not enough parameters specified for angle & + &distribution of external source.") elseif (n > coeffs_reqd) then - message = "Too many parameters specified for angle & - &distribution of external source." - call fatal_error() + call fatal_error("Too many parameters specified for angle & + &distribution of external source.") elseif (n > 0) then allocate(external_source % params_angle(n)) call get_node_array(node_dist, "parameters", & @@ -414,9 +393,8 @@ contains case ('tabular') external_source % type_energy = SRC_ENERGY_TABULAR case default - message = "Invalid energy distribution for external source: " & - // trim(type) - call fatal_error() + call fatal_error("Invalid energy distribution for external source: " & + &// trim(type)) end select ! Determine number of parameters specified @@ -428,13 +406,11 @@ contains ! Read parameters for energy distribution if (n < coeffs_reqd) then - message = "Not enough parameters specified for energy & - &distribution of external source." - call fatal_error() + call fatal_error("Not enough parameters specified for energy & + &distribution of external source.") elseif (n > coeffs_reqd) then - message = "Too many parameters specified for energy & - &distribution of external source." - call fatal_error() + call fatal_error("Too many parameters specified for energy & + &distribution of external source.") elseif (n > 0) then allocate(external_source % params_energy(n)) call get_node_array(node_dist, "parameters", & @@ -484,9 +460,9 @@ contains ! Make sure that there are three values per particle n_tracks = get_arraysize_integer(doc, "track") 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("Number of integers specified in 'track' is not & + &divisible by 3. Please provide 3 integers per particle to be & + &tracked.") end if ! Allocate space and get list of tracks @@ -506,11 +482,11 @@ contains ! Check to make sure enough values were supplied if (get_arraysize_double(node_entropy, "lower_left") /= 3) then - message = "Need to specify (x,y,z) coordinates of lower-left corner & - &of Shannon entropy mesh." + call fatal_error("Need to specify (x,y,z) coordinates of lower-left & + &corner of Shannon entropy mesh.") elseif (get_arraysize_double(node_entropy, "upper_right") /= 3) then - message = "Need to specify (x,y,z) coordinates of upper-right corner & - &of Shannon entropy mesh." + call fatal_error("Need to specify (x,y,z) coordinates of upper-right & + &corner of Shannon entropy mesh.") end if ! Allocate mesh object and coordinates on mesh @@ -526,10 +502,10 @@ contains entropy_mesh % upper_right) ! Check on values provided - 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() + if (.not. all(entropy_mesh % upper_right > entropy_mesh % lower_left)) & + &then + call fatal_error("Upper-right coordinate must be greater than & + &lower-left coordinate for Shannon entropy mesh.") end if ! Check if dimensions were specified -- if not, they will be calculated @@ -538,9 +514,8 @@ contains ! If so, make sure proper number of values were given 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("Dimension of entropy mesh must be given as three & + &integers.") end if ! Allocate dimensions @@ -568,14 +543,14 @@ contains ! Check to make sure enough values were supplied if (get_arraysize_double(node_ufs, "lower_left") /= 3) then - message = "Need to specify (x,y,z) coordinates of lower-left corner & - &of UFS mesh." + call fatal_error("Need to specify (x,y,z) coordinates of lower-left & + &corner of UFS mesh.") elseif (get_arraysize_double(node_ufs, "upper_right") /= 3) then - message = "Need to specify (x,y,z) coordinates of upper-right corner & - &of UFS mesh." + call fatal_error("Need to specify (x,y,z) coordinates of upper-right & + &corner 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("Dimension of UFS mesh must be given as three & + &integers.") end if ! Allocate mesh object and coordinates on mesh @@ -597,9 +572,8 @@ contains ! Check on values provided 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("Upper-right coordinate must be greater than & + &lower-left coordinate for UFS mesh.") end if ! Calculate width @@ -732,9 +706,8 @@ contains do i = 1, n_source_points if (.not. statepoint_batch % contains(sourcepoint_batch % & get_item(i))) then - message = 'Sourcepoint batches are not a subset& - & of statepoint batches.' - call fatal_error() + call fatal_error('Sourcepoint batches are not a subset& + & of statepoint batches.') end if end do end if @@ -814,9 +787,8 @@ contains ! check to make sure a nuclide is specified 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("No nuclide specified for scatterer " & + &// trim(to_str(i)) // " in settings.xml file!") end if call get_node_value(node_scatterer, "nuclide", & nuclides_0K(i) % nuclide) @@ -828,18 +800,17 @@ contains ! check to make sure xs name for which method is applied is given 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("Must specify the temperature dependent name of & + &scatterer " // trim(to_str(i)) & + &// " given in cross_sections.xml") end if call get_node_value(node_scatterer, "xs_label", & nuclides_0K(i) % name) ! check to make sure 0K xs name for which method is applied is given 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("Must specify the 0K name of scatterer " & + &// trim(to_str(i)) // " given in cross_sections.xml") end if call get_node_value(node_scatterer, "xs_label_0K", & nuclides_0K(i) % name_0K) @@ -851,8 +822,8 @@ 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("Lower resonance scattering energy bound is & + &negative") end if if (check_for_node(node_scatterer, "E_max")) then @@ -862,8 +833,8 @@ 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("Lower resonance scattering energy bound exceeds & + &upper") end if nuclides_0K(i) % nuclide = trim(nuclides_0K(i) % nuclide) @@ -872,9 +843,8 @@ contains nuclides_0K(i) % name_0K = trim(nuclides_0K(i) % name_0K) end do else - message = "No resonant scatterers are specified within the " // "" & - // "resonance_scattering element in settings.xml" - call fatal_error() + call fatal_error("No resonant scatterers are specified within the & + &resonance_scattering element in settings.xml") end if end if @@ -899,8 +869,8 @@ contains case ('jendl-4.0') default_expand = JENDL_40 case default - message = "Unknown natural element expansion option: " // trim(temp_str) - call fatal_error() + call fatal_error("Unknown natural element expansion option: " & + &// trim(temp_str)) end select end if @@ -942,8 +912,7 @@ contains type(NodeList), pointer :: node_lat_list => null() ! Display output message - message = "Reading geometry XML file..." - call write_message(5) + call write_message("Reading geometry XML file...", 5) ! ========================================================================== ! READ CELLS FROM GEOMETRY.XML @@ -952,8 +921,8 @@ contains filename = trim(path_input) // "geometry.xml" 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("Geometry XML file '" // trim(filename) // "' does not & + &exist!") end if ! Parse geometry.xml file @@ -967,8 +936,7 @@ contains ! Check for no cells if (n_cells == 0) then - message = "No cells found in geometry.xml!" - call fatal_error() + call fatal_error("No cells found in geometry.xml!") end if ! Allocate cells array @@ -990,8 +958,7 @@ contains if (check_for_node(node_cell, "id")) then 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("Must specify id of cell in geometry XML file.") end if if (check_for_node(node_cell, "universe")) then call get_node_value(node_cell, "universe", c % universe) @@ -1006,8 +973,8 @@ 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("Two or more cells use the same unique ID: " & + &// to_str(c % id)) end if ! Read material @@ -1027,30 +994,27 @@ 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("Invalid material specified on cell " & + &// to_str(c % id)) end if end select ! Check to make sure that either material or fill was specified 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("Neither material nor fill was specified for cell " & + &// trim(to_str(c % id))) 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("Cannot specify material and fill simultaneously") 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("No surfaces specified for cell " & + &// trim(to_str(c % id))) end if ! Allocate array for surfaces and copy @@ -1064,17 +1028,15 @@ contains ! Rotations can only be applied to cells that are being filled with ! another universe 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("Cannot apply a rotation to cell " // trim(to_str(& + &c % id)) // " because it is not filled with another universe") end if ! Read number of rotation parameters n = get_arraysize_double(node_cell, "rotation") if (n /= 3) then - message = "Incorrect number of rotation parameters on cell " // & - to_str(c % id) - call fatal_error() + call fatal_error("Incorrect number of rotation parameters on cell " & + &// to_str(c % id)) end if ! Copy rotation angles in x,y,z directions @@ -1100,17 +1062,16 @@ contains ! Translations can only be applied to cells that are being filled with ! another universe 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("Cannot apply a translation to cell " & + &// trim(to_str(c % id)) // " because it is not filled with & + &another universe") end if ! Read number of translation parameters n = get_arraysize_double(node_cell, "translation") if (n /= 3) then - message = "Incorrect number of translation parameters on cell " & - // to_str(c % id) - call fatal_error() + call fatal_error("Incorrect number of translation parameters on & + &cell " // to_str(c % id)) end if ! Copy translation vector @@ -1151,8 +1112,7 @@ contains ! Check for no surfaces if (n_surfaces == 0) then - message = "No surfaces found in geometry.xml!" - call fatal_error() + call fatal_error("No surfaces found in geometry.xml!") end if ! Allocate cells array @@ -1168,15 +1128,13 @@ contains if (check_for_node(node_surf, "id")) then 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("Must specify id of surface in geometry XML file.") 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("Two or more surfaces use the same unique ID: " & + &// to_str(s % id)) end if ! Copy and interpret surface type @@ -1218,8 +1176,7 @@ contains s % type = SURF_CONE_Z coeffs_reqd = 4 case default - message = "Invalid surface type: " // trim(word) - call fatal_error() + call fatal_error("Invalid surface type: " // trim(word)) end select ! Check to make sure that the proper number of coefficients @@ -1228,13 +1185,11 @@ contains n = get_arraysize_double(node_surf, "coeffs") if (n < coeffs_reqd) then - message = "Not enough coefficients specified for surface: " // & - trim(to_str(s % id)) - call fatal_error() + call fatal_error("Not enough coefficients specified for surface: " & + &// trim(to_str(s % id))) elseif (n > coeffs_reqd) then - message = "Too many coefficients specified for surface: " // & - trim(to_str(s % id)) - call fatal_error() + call fatal_error("Too many coefficients specified for surface: " & + &// trim(to_str(s % id))) else allocate(s % coeffs(n)) call get_node_array(node_surf, "coeffs", s % coeffs) @@ -1254,9 +1209,8 @@ contains s % bc = BC_REFLECT boundary_exists = .true. case default - message = "Unknown boundary condition '" // trim(word) // & - "' specified on surface " // trim(to_str(s % id)) - call fatal_error() + call fatal_error("Unknown boundary condition '" // trim(word) // & + &"' specified on surface " // trim(to_str(s % id))) end select ! Add surface to dictionary @@ -1267,8 +1221,7 @@ contains ! Check to make sure a boundary condition was applied to at least one ! surface if (.not. boundary_exists) then - message = "No boundary conditions were applied to any surfaces!" - call fatal_error() + call fatal_error("No boundary conditions were applied to any surfaces!") end if ! ========================================================================== @@ -1291,15 +1244,13 @@ contains if (check_for_node(node_lat, "id")) then 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("Must specify id of lattice in geometry XML file.") 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("Two or more lattices use the same unique ID: " & + &// to_str(lat % id)) end if ! Read lattice type @@ -1312,15 +1263,13 @@ contains case ('hex', 'hexagon', 'hexagonal') lat % type = LATTICE_HEX case default - message = "Invalid lattice type: " // trim(word) - call fatal_error() + call fatal_error("Invalid lattice type: " // trim(word)) 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("Lattice must be two or three dimensions.") end if lat % n_dimension = n @@ -1330,9 +1279,8 @@ contains ! Read lattice lower-left location if (size(lat % dimension) /= & 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("Number of entries on must be the same & + &as the number of entries on .") end if allocate(lat % lower_left(n)) @@ -1341,9 +1289,8 @@ contains ! Read lattice widths if (size(lat % dimension) /= & 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("Number of entries on must be the same as & + &the number of entries on .") end if allocate(lat % width(n)) @@ -1362,9 +1309,8 @@ contains ! Check that number of universes matches size n = get_arraysize_integer(node_lat, "universes") 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("Number of universes on does not match & + &size of lattice " // trim(to_str(lat % id)) // ".") end if allocate(temp_int_array(n)) @@ -1440,15 +1386,14 @@ contains type(NodeList), pointer :: node_sab_list => null() ! Display output message - message = "Reading materials XML file..." - call write_message(5) + call write_message("Reading materials XML file...", 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("Material XML file '" // trim(filename) // "' does not & + &exist!") end if ! Initialize default cross section variable @@ -1482,15 +1427,13 @@ contains if (check_for_node(node_mat, "id")) then 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("Must specify id of material in materials XML file") 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("Two or more materials use the same unique ID: " & + &// to_str(mat % id)) end if if (run_mode == MODE_PLOTTING) then @@ -1506,9 +1449,8 @@ contains if (check_for_node(node_mat, "density")) then call get_node_ptr(node_mat, "density", node_dens) else - message = "Must specify density element in material " // & - trim(to_str(mat % id)) - call fatal_error() + call fatal_error("Must specify density element in material " & + &// trim(to_str(mat % id))) end if ! Initialize value to zero @@ -1531,9 +1473,8 @@ contains ! Check for erroneous density sum_density = .false. if (val <= ZERO) then - message = "Need to specify a positive density on material " // & - trim(to_str(mat % id)) // "." - call fatal_error() + call fatal_error("Need to specify a positive density on material " & + &// trim(to_str(mat % id)) // ".") end if ! Adjust material density based on specified units @@ -1547,9 +1488,8 @@ contains case ('atom/cm3', 'atom/cc') mat % density = 1.0e-24 * val case default - message = "Unkwown units '" // trim(units) & - // "' specified on material " // trim(to_str(mat % id)) - call fatal_error() + call fatal_error("Unkwown units '" // trim(units) & + &// "' specified on material " // trim(to_str(mat % id))) end select end if @@ -1559,9 +1499,8 @@ contains ! Check to ensure material has at least one nuclide if (.not. check_for_node(node_mat, "nuclide") .and. & .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("No nuclides or natural elements specified on & + &material " // trim(to_str(mat % id))) end if ! Get pointer list of XML @@ -1574,17 +1513,15 @@ contains ! Check for empty name on nuclide 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("No name specified on nuclide in material " & + &// trim(to_str(mat % id))) end if ! Check for cross section if (.not.check_for_node(node_nuc, "xs")) then if (default_xs == '') then - message = "No cross section specified for nuclide in material " & - // trim(to_str(mat % id)) - call fatal_error() + call fatal_error("No cross section specified for nuclide in & + &material " // trim(to_str(mat % id))) else name = trim(default_xs) end if @@ -1603,14 +1540,12 @@ contains ! weight percents were specified if (.not.check_for_node(node_nuc, "ao") .and. & .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("No atom or weight percent specified for nuclide " & + &// trim(name)) 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("Cannot specify both atom and weight percents for a & + &nuclide: " // trim(name)) end if ! Copy atom/weight percents @@ -1634,9 +1569,8 @@ contains ! Check for empty name on natural element 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("No name specified on nuclide in material " & + &// trim(to_str(mat % id))) end if call get_node_value(node_ele, "name", name) @@ -1645,9 +1579,8 @@ contains call get_node_value(node_ele, "xs", temp_str) else if (default_xs == '') then - message = "No cross section specified for nuclide in material " & - // trim(to_str(mat % id)) - call fatal_error() + call fatal_error("No cross section specified for nuclide in & + &material " // trim(to_str(mat % id))) else temp_str = trim(default_xs) end if @@ -1657,14 +1590,12 @@ contains ! weight percents were specified if (.not.check_for_node(node_ele, "ao") .and. & .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("No atom or weight percent specified for element " & + &// trim(name)) 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("Cannot specify both atom and weight percents for & + &element: " // trim(name)) end if ! Expand element into naturally-occurring isotopes @@ -1673,9 +1604,8 @@ contains call expand_natural_element(name, temp_str, temp_dble, & list_names, list_density) else - message = "The ability to expand a natural element based on weight & - &percentage is not yet supported." - call fatal_error() + call fatal_error("The ability to expand a natural element based on & + &weight percentage is not yet supported.") end if end do NATURAL_ELEMENTS @@ -1693,17 +1623,15 @@ contains ! Check that this nuclide is listed in the cross_sections.xml file name = trim(list_names % get_item(j)) 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("Could not find nuclide " // trim(name) & + &// " in cross_sections.xml file!") end if ! Check to make sure cross-section is continuous energy neutron table n = len_trim(name) 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("Cross-section table " // trim(name) & + &// " is not a continuous-energy neutron table.") end if ! Find xs_listing and set the name/alias according to the listing @@ -1732,9 +1660,8 @@ contains ! given if (.not. (all(mat % atom_density >= ZERO) .or. & 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("Cannot mix atom and weight percents in material " & + &// to_str(mat % id)) end if ! Determine density if it is a sum value @@ -1770,8 +1697,8 @@ contains ! Determine name of S(a,b) table 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("Need to specify and for S(a,b) & + &table.") end if call get_node_value(node_sab, "name", name) call get_node_value(node_sab, "xs", temp_str) @@ -1780,9 +1707,8 @@ contains ! Check that this nuclide is listed in the cross_sections.xml file 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("Could not find S(a,b) table " // trim(name) & + &// " in cross_sections.xml file!") end if ! Find index in xs_listing and set the name and alias according to the @@ -1867,8 +1793,7 @@ contains end if ! Display output message - message = "Reading tallies XML file..." - call write_message(5) + call write_message("Reading tallies XML file...", 5) ! Parse tallies.xml file call open_xmldoc(doc, filename) @@ -1896,8 +1821,7 @@ contains ! Check for user tallies 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("No tallies present in tallies.xml file!") end if ! Allocate tally array @@ -1926,15 +1850,13 @@ contains if (check_for_node(node_mesh, "id")) then 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("Must specify id for mesh in tally XML file.") 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("Two or more meshes use the same unique ID: " & + &// to_str(m % id)) end if ! Read mesh type @@ -1947,15 +1869,13 @@ contains case ('hex', 'hexagon', 'hexagonal') m % type = LATTICE_HEX case default - message = "Invalid mesh type: " // trim(temp_str) - call fatal_error() + call fatal_error("Invalid mesh type: " // trim(temp_str)) 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("Mesh must be two or three dimensions.") end if m % n_dimension = n @@ -1968,9 +1888,8 @@ contains ! Check that dimensions are all greater than zero call get_node_array(node_mesh, "dimension", iarray3(1:n)) 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("All entries on the element for a tally & + &mesh must be positive.") end if ! Read dimensions in each direction @@ -1978,42 +1897,37 @@ contains ! Read mesh lower-left corner location 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("Number of entries on must be the same & + &as the number of entries on .") end if call get_node_array(node_mesh, "lower_left", m % lower_left) ! Make sure both upper-right or width were specified if (check_for_node(node_mesh, "upper_right") .and. & check_for_node(node_mesh, "width")) then - message = "Cannot specify both and on a & - &tally mesh." - call fatal_error() + call fatal_error("Cannot specify both and on a & + &tally mesh.") end if ! Make sure either upper-right or width was specified if (.not.check_for_node(node_mesh, "upper_right") .and. & .not.check_for_node(node_mesh, "width")) then - message = "Must specify either and on a & - &tally mesh." - call fatal_error() + call fatal_error("Must specify either and on a & + &tally mesh.") end if if (check_for_node(node_mesh, "width")) then ! Check to ensure width has same dimensions if (get_arraysize_double(node_mesh, "width") /= & 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("Number of entries on must be the same as & + &the number of entries on .") 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("Cannot have a negative on a tally mesh.") end if ! Set width and upper right coordinate @@ -2024,17 +1938,15 @@ contains ! Check to ensure width has same dimensions if (get_arraysize_double(node_mesh, "upper_right") /= & 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("Number of entries on must be the & + &same as the number of entries on .") end if ! Check that upper-right is above lower-left call get_node_array(node_mesh, "upper_right", rarray3(1:n)) 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("The coordinates must be greater than & + &the coordinates on a tally mesh.") end if ! Set width and upper right coordinate @@ -2077,15 +1989,13 @@ contains if (check_for_node(node_tal, "id")) then 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("Must specify id for tally in tally XML file.") 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("Two or more tallies use the same unique ID: " & + &// to_str(t % id)) end if ! Copy tally label @@ -2096,16 +2006,6 @@ contains ! ======================================================================= ! READ DATA FOR FILTERS - ! In older versions, tally filters were specified with a - ! element followed by sub-elements , , etc. This checks for - ! the old format and if it is present, raises an error - -! 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() -! end if - ! Get pointer list to XML and get number of filters call get_node_list(node_tal, "filter", node_filt_list) n_filters = get_list_size(node_filt_list) @@ -2135,8 +2035,8 @@ contains n_words = get_arraysize_integer(node_filt, "bins") end if else - message = "Bins not set in filter on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error("Bins not set in filter on tally " & + &// trim(to_str(t % id))) end if ! Determine type of filter @@ -2186,8 +2086,7 @@ contains call get_node_array(node_filt, "bins", t % filters(j) % int_bins) case ('surface') - message = "Surface filter is not yet supported!" - call fatal_error() + call fatal_error("Surface filter is not yet supported!") ! Set type of filter t % filters(j) % type = FILTER_SURFACE @@ -2205,8 +2104,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("Can only have one mesh filter specified.") end if ! Determine id of mesh @@ -2217,9 +2115,8 @@ contains i_mesh = mesh_dict % get_key(id) m => meshes(i_mesh) else - message = "Could not find mesh " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id)) - call fatal_error() + call fatal_error("Could not find mesh " // trim(to_str(id)) & + &// " specified on tally " // trim(to_str(t % id))) end if ! Determine number of bins -- this is assuming that the tally is @@ -2258,10 +2155,9 @@ contains case default ! Specified tally filter is invalid, raise error - message = "Unknown filter type '" // & - trim(temp_str) // "' on tally " // & - trim(to_str(t % id)) // "." - call fatal_error() + call fatal_error("Unknown filter type '" & + &// trim(temp_str) // "' on tally " & + &// trim(to_str(t % id)) // ".") end select @@ -2275,9 +2171,8 @@ contains ! Check that both cell and surface weren't specified if (t % find_filter(FILTER_CELL) > 0 .and. & 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("Cannot specify both cell and surface filters for & + &tally " // trim(to_str(t % id))) end if else @@ -2339,10 +2234,9 @@ contains ! Check if no nuclide was found if (.not. associated(pair_list)) then - 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("Could not find the nuclide " & + &// trim(sarray(j)) // " specified in tally " & + &// trim(to_str(t % id)) // " in any material.") end if deallocate(pair_list) else @@ -2353,9 +2247,9 @@ contains ! Check to make sure nuclide specified is in problem 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("The nuclide " // trim(word) // " from tally " & + &// trim(to_str(t % id)) & + &// " is not present in any material.") end if ! Set bin to index in nuclides array @@ -2404,13 +2298,13 @@ contains ! User requested too many orders; throw a warning and set to the ! maximum order. ! The above scheme will essentially take the absolute value - 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("Invalid scattering order of " & + &// trim(to_str(n_order)) // " requested. Setting to the & + &maximum permissible value, " & + &// trim(to_str(MAX_ANG_ORDER))) n_order = MAX_ANG_ORDER - sarray(j) = trim(MOMENT_STRS(imomstr)) // & - trim(to_str(MAX_ANG_ORDER)) + sarray(j) = trim(MOMENT_STRS(imomstr)) & + &// trim(to_str(MAX_ANG_ORDER)) end if ! Find total number of bins for this case if (imomstr >= YN_LOC) then @@ -2435,7 +2329,8 @@ contains j = j + 1 ! Get the input string in scores(l) but if score is one of the moment ! scores then strip off the n and store it as an integer to be used - ! later. Then perform the select case on this modified (number removed) string + ! later. Then perform the select case on this modified (number + ! removed) string score_name = sarray(l) do imomstr = 1, size(MOMENT_STRS) if (starts_with(score_name,trim(MOMENT_STRS(imomstr)))) then @@ -2446,10 +2341,6 @@ contains ! User requested too many orders; throw a warning and set to the ! maximum order. ! The above scheme will essentially take the absolute value - 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() n_order = MAX_ANG_ORDER end if score_name = trim(MOMENT_STRS(imomstr)) // "n" @@ -2473,10 +2364,10 @@ contains ! User requested too many orders; throw a warning and set to the ! maximum order. ! The above scheme will essentially take the absolute value - 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("Invalid scattering order of " & + &// trim(to_str(n_order)) // " requested. Setting to & + &the maximum permissible value, " & + &// trim(to_str(MAX_ANG_ORDER))) n_order = MAX_ANG_ORDER end if score_name = trim(MOMENT_N_STRS(imomstr)) // "n" @@ -2490,26 +2381,24 @@ contains ! 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("Cannot tally flux for an individual nuclide.") 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("Cannot tally flux with an outgoing energy & + &filter.") 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("Cannot tally flux for an individual nuclide.") 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("Cannot tally flux with an outgoing energy & + &filter.") end if t % score_bins(j : j + n_bins - 1) = SCORE_FLUX_YN @@ -2519,16 +2408,14 @@ contains case ('total') t % score_bins(j) = SCORE_TOTAL 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("Cannot tally total reaction rate with an & + &outgoing energy filter.") 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("Cannot tally total reaction rate with an & + &outgoing energy filter.") end if t % score_bins(j : j + n_bins - 1) = SCORE_TOTAL_YN @@ -2597,9 +2484,8 @@ contains ! Set tally estimator to analog t % estimator = ESTIMATOR_ANALOG case ('diffusion') - message = "Diffusion score no longer supported for tallies, & - &please remove" - call fatal_error() + call fatal_error("Diffusion score no longer supported for tallies, & + &please remove") case ('n1n') t % score_bins(j) = SCORE_N_1N @@ -2617,16 +2503,14 @@ contains case ('absorption') t % score_bins(j) = SCORE_ABSORPTION if (t % find_filter(FILTER_ENERGYOUT) > 0) then - message = "Cannot tally absorption rate with an outgoing & - &energy filter." - call fatal_error() + call fatal_error("Cannot tally absorption rate with an outgoing & + &energy filter.") 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("Cannot tally fission rate with an outgoing & + &energy filter.") end if case ('nu-fission') t % score_bins(j) = SCORE_NU_FISSION @@ -2643,10 +2527,9 @@ contains ! Check to make sure that current is the only desired response ! for this tally if (n_words > 1) then - 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("Cannot tally other scoring functions in the & + &same tally as surface currents. Separate other scoring & + &functions into a distinct tally.") end if ! Since the number of bins for the mesh filter was already set @@ -2658,8 +2541,8 @@ 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("Cannot tally surface current without a mesh & + &filter.") end if ! Get pointer to mesh @@ -2705,16 +2588,14 @@ contains if (MT > 1) then t % score_bins(j) = MT else - message = "Invalid MT on : " // & - trim(sarray(l)) - call fatal_error() + call fatal_error("Invalid MT on : " & + &// trim(sarray(l))) end if else ! Specified score was not an integer - message = "Unknown scoring function: " // & - trim(sarray(l)) - call fatal_error() + call fatal_error("Unknown scoring function: " & + &// trim(sarray(l))) end if end select @@ -2725,9 +2606,8 @@ contains ! Deallocate temporary string array of scores deallocate(sarray) else - message = "No specified on tally " // trim(to_str(t % id)) & - // "." - call fatal_error() + call fatal_error("No specified on tally " & + &// trim(to_str(t % id)) // ".") end if ! ======================================================================= @@ -2745,18 +2625,16 @@ contains ! If the estimator was set to an analog estimator, this means the ! tally needs post-collision information if (t % estimator == ESTIMATOR_ANALOG) then - message = "Cannot use track-length estimator for tally " & - // to_str(t % id) - call fatal_error() + call fatal_error("Cannot use track-length estimator for tally " & + &// to_str(t % id)) end if ! Set estimator to track-length estimator t % estimator = ESTIMATOR_TRACKLENGTH case default - message = "Invalid estimator '" // trim(temp_str) & - // "' on tally " // to_str(t % id) - call fatal_error() + call fatal_error("Invalid estimator '" // trim(temp_str) & + &// "' on tally " // to_str(t % id)) end select end if @@ -2800,13 +2678,12 @@ contains filename = trim(path_input) // "plots.xml" 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("Plots XML file '" // trim(filename) & + &// "' does not exist!") end if ! Display output message - message = "Reading plot XML file..." - call write_message(5) + call write_message("Reading plot XML file...", 5) ! Parse plots.xml file call open_xmldoc(doc, filename) @@ -2828,15 +2705,13 @@ contains if (check_for_node(node_plot, "id")) then 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("Must specify plot id in plots XML file.") 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("Two or more plots use the same unique ID: " & + &// to_str(pl % id)) end if ! Copy plot type @@ -2850,9 +2725,8 @@ contains case ("voxel") pl % type = PLOT_TYPE_VOXEL case default - message = "Unsupported plot type '" // trim(temp_str) & - // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Unsupported plot type '" // trim(temp_str) & + &// "' in plot " // trim(to_str(pl % id))) end select ! Set output file path @@ -2873,33 +2747,29 @@ contains if (get_arraysize_integer(node_plot, "pixels") == 2) then call get_node_array(node_plot, "pixels", pl % pixels(1:2)) else - message = " must be length 2 in slice plot " // & - trim(to_str(pl % id)) - call fatal_error() + call fatal_error(" must be length 2 in slice plot " & + &// trim(to_str(pl % id))) end if else if (pl % type == PLOT_TYPE_VOXEL) then if (get_arraysize_integer(node_plot, "pixels") == 3) then call get_node_array(node_plot, "pixels", pl % pixels(1:3)) else - message = " must be length 3 in voxel plot " // & - trim(to_str(pl % id)) - call fatal_error() + call fatal_error(" must be length 3 in voxel plot " & + &// trim(to_str(pl % id))) end if end if ! Copy plot background color if (check_for_node(node_plot, "background")) then 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("Background color ignored in voxel plot " & + &// trim(to_str(pl % id))) 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("Bad background RGB in plot " & + &// trim(to_str(pl % id))) end if else pl % not_found % rgb = (/ 255, 255, 255 /) @@ -2919,9 +2789,8 @@ contains case ("yz") pl % basis = PLOT_BASIS_YZ case default - message = "Unsupported plot basis '" // trim(temp_str) & - // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Unsupported plot basis '" // trim(temp_str) & + &// "' in plot " // trim(to_str(pl % id))) end select end if @@ -2929,9 +2798,8 @@ contains if (get_arraysize_double(node_plot, "origin") == 3) then call get_node_array(node_plot, "origin", pl % origin) else - message = "Origin must be length 3 " & - // "in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Origin must be length 3 in plot " & + &// trim(to_str(pl % id))) end if ! Copy plotting width @@ -2939,17 +2807,15 @@ contains if (get_arraysize_double(node_plot, "width") == 2) then call get_node_array(node_plot, "width", pl % width(1:2)) else - message = " must be length 2 in slice plot " // & - trim(to_str(pl % id)) - call fatal_error() + call fatal_error(" must be length 2 in slice plot " & + &// trim(to_str(pl % id))) end if else if (pl % type == PLOT_TYPE_VOXEL) then if (get_arraysize_double(node_plot, "width") == 3) then call get_node_array(node_plot, "width", pl % width(1:3)) else - message = " must be length 3 in voxel plot " // & - trim(to_str(pl % id)) - call fatal_error() + call fatal_error(" must be length 3 in voxel plot " & + &// trim(to_str(pl % id))) end if end if @@ -2980,9 +2846,8 @@ contains end do case default - message = "Unsupported plot color type '" // trim(temp_str) & - // "' in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Unsupported plot color type '" // trim(temp_str) & + &// "' in plot " // trim(to_str(pl % id))) end select ! Get the number of nodes and get a list of them @@ -2993,9 +2858,8 @@ contains if (n_cols /= 0) then 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("Color specifications ignored in voxel & + &plot " // trim(to_str(pl % id))) end if do j = 1, n_cols @@ -3005,18 +2869,16 @@ contains ! Check and make sure 3 values are specified for RGB 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("Bad RGB in plot " & + &// trim(to_str(pl % id))) end if ! Ensure that there is an id for this color specification if (check_for_node(node_col, "id")) then call get_node_value(node_col, "id", col_id) else - message = "Must specify id for color specification in plot " // & - trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Must specify id for color specification in & + &plot " // trim(to_str(pl % id))) end if ! Add RGB @@ -3026,9 +2888,8 @@ contains col_id = cell_dict % get_key(col_id) call get_node_array(node_col, "rgb", pl % colors(col_id) % rgb) 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("Could not find cell " // trim(to_str(col_id)) & + &// " specified in plot " // trim(to_str(pl % id))) end if else if (pl % color_by == PLOT_COLOR_MATS) then @@ -3037,9 +2898,9 @@ contains col_id = material_dict % get_key(col_id) call get_node_array(node_col, "rgb", pl % colors(col_id) % rgb) 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("Could not find material " & + &// trim(to_str(col_id)) // " specified in plot " & + &// trim(to_str(pl % id))) end if end if @@ -3052,9 +2913,8 @@ contains if (n_meshlines /= 0) then if (pl % type == PLOT_TYPE_VOXEL) then - message = "Meshlines ignored in voxel plot " // & - trim(to_str(pl % id)) - call warning() + call warning("Meshlines ignored in voxel plot " & + &// trim(to_str(pl % id))) end if select case(n_meshlines) @@ -3069,9 +2929,8 @@ contains if (check_for_node(node_meshlines, "meshtype")) then call get_node_value(node_meshlines, "meshtype", meshtype) else - message = "Must specify a meshtype for meshlines " // & - "specification in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Must specify a meshtype for meshlines & + &specification in plot " // trim(to_str(pl % id))) end if ! Ensure that there is a linewidth for this meshlines specification @@ -3079,9 +2938,8 @@ contains call get_node_value(node_meshlines, "linewidth", & pl % meshlines_width) else - message = "Must specify a linewidth for meshlines " // & - "specification in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Must specify a linewidth for meshlines & + &specification in plot " // trim(to_str(pl % id))) end if ! Check for color @@ -3089,9 +2947,8 @@ contains ! Check and make sure 3 values are specified for RGB 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("Bad RGB for meshlines color in plot " & + &// trim(to_str(pl % id))) end if call get_node_array(node_meshlines, "color", & @@ -3107,19 +2964,17 @@ contains case ('ufs') 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("No UFS mesh for meshlines on plot " & + &// trim(to_str(pl % id))) end if - + pl % meshlines_mesh => ufs_mesh case ('cmfd') 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("Need CMFD run to plot CMFD mesh for & + &meshlines on plot " // trim(to_str(pl % id))) end if i_mesh = cmfd_tallies(1) % & @@ -3128,19 +2983,17 @@ contains pl % meshlines_mesh => meshes(i_mesh) case ('entropy') - + 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("No entropy mesh for meshlines on plot " & + &// trim(to_str(pl % id))) 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("No dimension specified on entropy mesh & + &for meshlines on plot " // trim(to_str(pl % id))) end if - + pl % meshlines_mesh => entropy_mesh case ('tally') @@ -3149,37 +3002,31 @@ contains if (check_for_node(node_meshlines, "id")) then call get_node_value(node_meshlines, "id", meshid) 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("Must specify a mesh id for meshlines tally & + &mesh specification in plot " // trim(to_str(pl % id))) end if ! Check if the specified tally mesh exists if (mesh_dict % has_key(meshid)) then pl % meshlines_mesh => meshes(mesh_dict % get_key(meshid)) 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("Non-rectangular mesh specified in & + &meshlines for plot " // trim(to_str(pl % id))) 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("Could not find mesh " & + &// trim(to_str(meshid)) // " specified in meshlines for & + &plot " // trim(to_str(pl % id))) end if case default - message = "Invalid type for meshlines on plot " // & - trim(to_str(pl % id)) // ": " // trim(meshtype) - call fatal_error() + call fatal_error("Invalid type for meshlines on plot " & + &// trim(to_str(pl % id)) // ": " // trim(meshtype)) end select case default - message = "Mutliple meshlines" // & - " specified in plot " // trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Mutliple meshlines specified in plot " & + &// trim(to_str(pl % id))) end select end if @@ -3190,16 +3037,14 @@ contains if (n_masks /= 0) then if (pl % type == PLOT_TYPE_VOXEL) then - message = "Mask ignored in voxel plot " // & - trim(to_str(pl % id)) - call warning() + if (master) call warning("Mask ignored in voxel plot " & + &// trim(to_str(pl % id))) 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("Mutliple masks specified in plot " & + &// trim(to_str(pl % id))) case (1) ! Get pointer to mask @@ -3209,9 +3054,8 @@ contains n_comp = 0 n_comp = get_arraysize_integer(node_mask, "components") if (n_comp == 0) then - message = "Missing in mask of plot " // & - trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Missing in mask of plot " & + &// trim(to_str(pl % id))) end if allocate(iarray(n_comp)) call get_node_array(node_mask, "components", iarray) @@ -3226,9 +3070,9 @@ contains if (cell_dict % has_key(col_id)) then iarray(j) = cell_dict % get_key(col_id) 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("Could not find cell " & + &// trim(to_str(col_id)) // " specified in the mask in & + &plot " // trim(to_str(pl % id))) end if else if (pl % color_by == PLOT_COLOR_MATS) then @@ -3236,9 +3080,9 @@ contains if (material_dict % has_key(col_id)) then iarray(j) = material_dict % get_key(col_id) 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("Could not find material " & + &// trim(to_str(col_id)) // " specified in the mask in & + &plot " // trim(to_str(pl % id))) end if end if @@ -3250,9 +3094,8 @@ contains if (check_for_node(node_mask, "background")) then call get_node_array(node_mask, "background", pl % colors(j) % rgb) else - message = "Missing in mask of plot " // & - trim(to_str(pl % id)) - call fatal_error() + call fatal_error("Missing in mask of plot " & + &// trim(to_str(pl % id))) end if end if end do @@ -3296,13 +3139,11 @@ contains inquire(FILE=path_cross_sections, EXIST=file_exists) if (.not. file_exists) then ! 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("Cross sections XML file '" & + &// trim(path_cross_sections) // "' does not exist!") end if - message = "Reading cross sections XML file..." - call write_message(5) + call write_message("Reading cross sections XML file...", 5) ! Parse cross_sections.xml file call open_xmldoc(doc, path_cross_sections) @@ -3328,8 +3169,8 @@ contains elseif (len_trim(temp_str) == 0) then filetype = ASCII else - message = "Unknown filetype in cross_sections.xml: " // trim(temp_str) - call fatal_error() + call fatal_error("Unknown filetype in cross_sections.xml: " & + &// trim(temp_str)) end if ! copy default record length and entries for binary files @@ -3344,8 +3185,8 @@ 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("No ACE table listings present in cross_sections.xml & + &file!") else allocate(xs_listings(n_listings)) end if @@ -3403,8 +3244,7 @@ contains if (check_for_node(node_ace, "path")) then call get_node_value(node_ace, "path", temp_str) else - message = "Path missing for isotope " // listing % name - call fatal_error() + call fatal_error("Path missing for isotope " // listing % name) end if if (starts_with(temp_str, '/')) then @@ -3427,9 +3267,9 @@ contains ! Check that 0K nuclides are listed in the cross_sections.xml file do i = 1, n_res_scatterers_total 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("Could not find nuclide " & + &// trim(nuclides_0K(i) % name_0K) & + &// " in cross_sections.xml file!") end if end do @@ -4268,8 +4108,7 @@ contains call list_density % append(density * 0.992742_8) case default - message = "Cannot expand element: " // name - call fatal_error() + call fatal_error("Cannot expand element: " // name) end select diff --git a/src/interpolation.F90 b/src/interpolation.F90 index 748e187a34..5c44ed7c3d 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 @@ -118,8 +117,7 @@ contains r = (log(x) - log(x0))/(log(x1) - log(x0)) y = exp((1-r)*log(y0) + r*log(y1)) case default - message = "Unsupported interpolation scheme: " // to_str(interp) - call fatal_error() + call fatal_error("Unsupported interpolation scheme: " // to_str(interp)) end select end function interpolate_tab1_array @@ -204,8 +202,7 @@ contains r = (log(x) - log(x0))/(log(x1) - log(x0)) y = exp((1-r)*log(y0) + r*log(y1)) case default - message = "Unsupported interpolation scheme: " // to_str(interp) - call fatal_error() + call fatal_error("Unsupported interpolation scheme: " // to_str(interp)) end select end function interpolate_tab1_object diff --git a/src/output.F90 b/src/output.F90 index 1493b82943..4d0ef7edd4 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -193,8 +193,9 @@ contains ! standard output stream. !=============================================================================== - subroutine write_message(level) + subroutine write_message(message, level) + character(*) :: message integer, optional :: level ! verbosity level integer :: i_start ! starting position @@ -1587,8 +1588,8 @@ contains write(ou,102) "Leakage Fraction", global_tallies(LEAKAGE) % sum, & global_tallies(LEAKAGE) % sum_sq else - message = "Could not compute uncertainties -- only one active batch simulated!" - call warning() + if (master) call warning("Could not compute uncertainties -- only one & + &active batch simulated!") 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 db2490dd2a..6ff5d63c2d 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -16,8 +16,7 @@ module particle_restart private public :: run_particle_restart - ! Binary file - type(BinaryOutput) :: pr + type(BinaryOutput) :: pr ! Binary file contains @@ -73,9 +72,8 @@ contains type(Particle), intent(inout) :: p ! Write meessage - message = "Loading particle restart file " // trim(path_particle_restart) & - // "..." - call write_message(1) + call write_message("Loading particle restart file " & + &// trim(path_particle_restart) // "...", 1) ! Open file call pr % file_open(path_particle_restart, 'r') diff --git a/src/physics.F90 b/src/physics.F90 index 04cc66afa2..8fa0575cdc 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -47,17 +47,15 @@ contains ! Display information about collision if (verbosity >= 10 .or. trace) then - 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(" " // trim(reaction_name(p % event_MT)) & + &// " with " // trim(adjustl(nuclides(p % event_nuclide) % name)) & + &// ". Energy = " // trim(to_str(p % E * 1e6_8)) // " eV.") 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("Killing neutron with extremely low energy") end if end subroutine collision @@ -159,8 +157,7 @@ contains ! Check to make sure that a nuclide was sampled 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("Did not sample any nuclide during collision.") end if ! Find atom density @@ -368,9 +365,8 @@ contains ! Check to make sure inelastic scattering reaction sampled if (i > nuc % n_reaction) then call write_particle_restart(p) - message = "Did not sample any reaction for nuclide " // & - trim(nuc % name) - call fatal_error() + call fatal_error("Did not sample any reaction for nuclide " & + &// trim(nuc % name)) end if rxn => nuc % reactions(i) @@ -721,8 +717,8 @@ contains mu = sab % inelastic_data(l) % mu(k, j) else - message = "Invalid secondary energy mode on S(a,b) table " // & - trim(sab % name) + call fatal_error("Invalid secondary energy mode on S(a,b) table " & + &// trim(sab % name)) end if ! (inelastic secondary energy treatment) end if ! (elastic or inelastic) @@ -974,8 +970,7 @@ contains end do case default - message = "Not a recognized resonance scattering treatment!" - call fatal_error() + call fatal_error("Not a recognized resonance scattering treatment!") end select end subroutine sample_target_velocity @@ -1093,8 +1088,7 @@ contains call get_mesh_indices(ufs_mesh, p % coord0 % xyz, ijk, in_mesh) if (.not. in_mesh) then call write_particle_restart(p) - message = "Source site outside UFS mesh!" - call fatal_error() + call fatal_error("Source site outside UFS mesh!") end if if (source_frac(1,ijk(1),ijk(2),ijk(3)) /= ZERO) then @@ -1119,10 +1113,9 @@ contains ! Check for fission bank size getting hit if (n_bank + nu > size(fission_bank)) then - 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("Maximum number of sites in fission bank & + &reached. This can result in irreproducible results using different & + &numbers of processes/threads.") end if ! Bank source neutrons @@ -1247,9 +1240,8 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Resampled energy distribution maximum number of " // & - "times for nuclide " // nuc % name - call fatal_error() + call fatal_error("Resampled energy distribution maximum number of " & + &// "times for nuclide " // nuc % name) end if end do @@ -1274,9 +1266,8 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Resampled energy distribution maximum number of " // & - "times for nuclide " // nuc % name - call fatal_error() + call fatal_error("Resampled energy distribution maximum number of " & + &// "times for nuclide " // nuc % name) end if end do @@ -1457,8 +1448,7 @@ contains end if else ! call write_particle_restart(p) - message = "Unknown interpolation type: " // trim(to_str(interp)) - call fatal_error() + call fatal_error("Unknown interpolation type: " // trim(to_str(interp))) end if ! Because of floating-point roundoff, it may be possible for mu to be @@ -1469,8 +1459,8 @@ contains else ! call write_particle_restart(p) - message = "Unknown angular distribution type: " // trim(to_str(type)) - call fatal_error() + call fatal_error("Unknown angular distribution type: " & + &// trim(to_str(type))) end if end function sample_angle @@ -1617,9 +1607,8 @@ contains NET = int(edist % data(3 + 2*NR + NE)) if (NR > 0) then ! call write_particle_restart(p) - message = "Multiple interpolation regions not supported while & - &attempting to sample equiprobable energy bins." - call fatal_error() + call fatal_error("Multiple interpolation regions not supported while & + &attempting to sample equiprobable energy bins.") end if ! determine index on incoming energy grid and interpolation factor @@ -1682,14 +1671,12 @@ contains NR = int(edist % data(1)) NE = int(edist % data(2 + 2*NR)) if (NR == 1) then - message = "Assuming linear-linear interpolation when sampling & - &continuous tabular distribution" - call warning() + if (master) call warning("Assuming linear-linear interpolation when & + &sampling continuous tabular distribution") 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("Multiple interpolation regions not supported while & + &attempting to sample continuous tabular distribution.") end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1747,9 +1734,8 @@ contains if (ND > 0) then ! discrete lines present ! call write_particle_restart(p) - message = "Discrete lines in continuous tabular distributed not & - &yet supported" - call fatal_error() + call fatal_error("Discrete lines in continuous tabular distributed not & + &yet supported") end if ! determine outgoing energy bin @@ -1789,8 +1775,7 @@ contains end if else ! call write_particle_restart(p) - message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error("Unknown interpolation type: " // trim(to_str(INTT))) end if ! Now interpolate between incident energy bins i and i + 1 @@ -1831,8 +1816,7 @@ contains n_sample = n_sample + 1 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("Too many rejections on Maxwell fission spectrum.") end if end do @@ -1864,8 +1848,7 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Too many rejections on evaporation spectrum." - call fatal_error() + call fatal_error("Too many rejections on evaporation spectrum.") end if end do @@ -1906,8 +1889,7 @@ contains n_sample = n_sample + 1 if (n_sample == MAX_SAMPLE) then ! call write_particle_restart(p) - message = "Too many rejections on Watt spectrum." - call fatal_error() + call fatal_error("Too many rejections on Watt spectrum.") end if end do @@ -1917,8 +1899,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("Law 44 called without giving mu_out as argument.") end if ! read number of interpolation regions and incoming energies @@ -1926,9 +1907,8 @@ contains NE = int(edist % data(2 + 2*NR)) if (NR > 0) then ! call write_particle_restart(p) - message = "Multiple interpolation regions not supported while & - &attempting to sample Kalbach-Mann distribution." - call fatal_error() + call fatal_error("Multiple interpolation regions not supported while & + &attempting to sample Kalbach-Mann distribution.") end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -1987,9 +1967,8 @@ contains if (ND > 0) then ! discrete lines present ! call write_particle_restart(p) - message = "Discrete lines in continuous tabular distributed not & - &yet supported" - call fatal_error() + call fatal_error("Discrete lines in continuous tabular distributed not & + &yet supported") end if ! determine outgoing energy bin @@ -2043,8 +2022,7 @@ contains KM_A = A_k + (A_k1 - A_k)*(E_out - E_l_k)/(E_l_k1 - E_l_k) else ! call write_particle_restart() - message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error("Unknown interpolation type: " // trim(to_str(INTT))) end if ! Now interpolate between incident energy bins i and i + 1 @@ -2070,8 +2048,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("Law 61 called without giving mu_out as argument.") end if ! read number of interpolation regions and incoming energies @@ -2079,9 +2056,8 @@ contains NE = int(edist % data(2 + 2*NR)) if (NR > 0) then ! call write_particle_restart() - message = "Multiple interpolation regions not supported while & - &attempting to sample correlated energy-angle distribution." - call fatal_error() + call fatal_error("Multiple interpolation regions not supported while & + &attempting to sample correlated energy-angle distribution.") end if ! find energy bin and calculate interpolation factor -- if the energy is @@ -2140,9 +2116,8 @@ contains if (ND > 0) then ! discrete lines present ! call write_particle_restart() - message = "Discrete lines in continuous tabular distributed not & - &yet supported" - call fatal_error() + call fatal_error("Discrete lines in continuous tabular distributed not & + &yet supported") end if ! determine outgoing energy bin @@ -2183,8 +2158,7 @@ contains end if else ! call write_particle_restart() - message = "Unknown interpolation type: " // trim(to_str(INTT)) - call fatal_error() + call fatal_error("Unknown interpolation type: " // trim(to_str(INTT))) end if ! Now interpolate between incident energy bins i and i + 1 @@ -2247,8 +2221,7 @@ contains end if else ! call write_particle_restart() - message = "Unknown interpolation type: " // trim(to_str(JJ)) - call fatal_error() + call fatal_error("Unknown interpolation type: " // trim(to_str(JJ))) end if case (66) diff --git a/src/plot.F90 b/src/plot.F90 index 91b2520eb4..1297b746c4 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -31,8 +31,8 @@ contains pl => plots(i) ! Display output message - message = "Processing plot " // trim(to_str(pl % id)) // "..." - call write_message(5) + call write_message("Processing plot " // trim(to_str(pl % id)) & + &// "...", 5) if (pl % type == PLOT_TYPE_SLICE) then ! create 2d image diff --git a/src/search.F90 b/src/search.F90 index 962874a7f9..c8fc71d365 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 @@ -32,8 +32,7 @@ contains R = n if (val < array(L) .or. val > array(R)) then - message = "Value outside of array during binary search" - call fatal_error() + call fatal_error("Value outside of array during binary search") end if n_iteration = 0 @@ -60,8 +59,8 @@ contains ! check for large number of iterations 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("Reached maximum number of iterations on binary & + &search.") end if end do @@ -85,8 +84,7 @@ contains R = n if (val < array(L) .or. val > array(R)) then - message = "Value outside of array during binary search" - call fatal_error() + call fatal_error("Value outside of array during binary search") end if n_iteration = 0 @@ -113,8 +111,8 @@ contains ! check for large number of iterations 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("Reached maximum number of iterations on binary & + &search.") end if end do @@ -138,8 +136,7 @@ contains R = n if (val < array(L) .or. val > array(R)) then - message = "Value outside of array during binary search" - call fatal_error() + call fatal_error("Value outside of array during binary search") end if n_iteration = 0 @@ -166,8 +163,8 @@ contains ! check for large number of iterations 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("Reached maximum number of iterations on binary & + &search.") end if end do diff --git a/src/solver_interface.F90 b/src/solver_interface.F90 index b629a0789f..043b3fd116 100644 --- a/src/solver_interface.F90 +++ b/src/solver_interface.F90 @@ -1,7 +1,6 @@ module solver_interface use error, only: fatal_error - use global, only: message use matrix_header, only: Matrix use vector_header, only: Vector diff --git a/src/source.F90 b/src/source.F90 index 9575020e6d..07c1bfb411 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -34,15 +34,14 @@ contains type(Bank), pointer :: src => null() ! source bank site type(BinaryOutput) :: sp ! statepoint/source binary file - message = "Initializing source particles..." - call write_message(6) + call write_message("Initializing source particles...", 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('Reading source file from ' // trim(path_source) & + &// '...', 6) ! Open the binary file call sp % file_open(path_source, 'r', serial = .false.) @@ -52,8 +51,8 @@ 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("Specified starting source file not a source file & + &type.") end if ! Read in the source bank @@ -79,8 +78,7 @@ contains ! Write out initial source if (write_initial_source) then - message = 'Writing out initial source guess...' - call write_message(1) + call write_message('Writing out initial source guess...', 1) #ifdef HDF5 filename = trim(path_output) // 'initial_source.h5' #else @@ -142,9 +140,8 @@ contains if (.not. found) then num_resamples = num_resamples + 1 if (num_resamples == MAX_EXTSRC_RESAMPLES) then - message = "Maximum number of external source spatial resamples & - &reached!" - call fatal_error() + call fatal_error("Maximum number of external source spatial & + &resamples reached!") end if end if end do @@ -172,9 +169,8 @@ contains if (.not. found) then num_resamples = num_resamples + 1 if (num_resamples == MAX_EXTSRC_RESAMPLES) then - message = "Maximum number of external source spatial resamples & - &reached!" - call fatal_error() + call fatal_error("Maximum number of external source spatial & + &resamples reached!") end if cycle end if @@ -207,8 +203,7 @@ contains site % uvw = external_source % params_angle case default - message = "No angle distribution specified for external source!" - call fatal_error() + call fatal_error("No angle distribution specified for external source!") end select ! Sample energy distribution @@ -239,8 +234,7 @@ contains end do case default - message = "No energy distribution specified for external source!" - call fatal_error() + call fatal_error("No energy distribution specified for external source!") 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 8aff2ec364..5d8b370cd2 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -26,7 +26,7 @@ module state_point implicit none - type(BinaryOutput) :: sp ! statepoint/source output file + type(BinaryOutput) :: sp ! Statepoint/source output file contains @@ -54,8 +54,7 @@ contains #endif ! Write message - message = "Creating state point " // trim(filename) // "..." - call write_message(1) + call write_message("Creating state point " // trim(filename) // "...", 1) if (master) then ! Create statepoint file @@ -315,8 +314,8 @@ contains #endif ! Write message for new file creation - message = "Creating source file " // trim(filename) // "..." - call write_message(1) + call write_message("Creating source file " // trim(filename) // "...", & + &1) ! Create separate source file call sp % file_create(filename, serial = .false.) @@ -360,8 +359,7 @@ contains #endif ! Write message for new file creation - message = "Creating source file " // trim(filename) // "..." - call write_message(1) + call write_message("Creating source file " // trim(filename) // "...", 1) ! Always create this file because it will be overwritten call sp % file_create(filename, serial = .false.) @@ -531,8 +529,8 @@ contains type(TallyObject), pointer :: t => null() ! Write message - message = "Loading state point " // trim(path_state_point) // "..." - call write_message(1) + call write_message("Loading state point " // trim(path_state_point) & + &// "...", 1) ! Open file for reading call sp % file_open(path_state_point, 'r', serial = .false.) @@ -544,9 +542,8 @@ contains ! current version call sp % read_data(int_array(1), "revision") if (int_array(1) /= REVISION_STATEPOINT) then - message = "State point version does not match current version " & - // "in OpenMC." - call fatal_error() + call fatal_error("State point version does not match current version & + &in OpenMC.") end if ! Read OpenMC version @@ -555,9 +552,8 @@ contains call sp % read_data(int_array(3), "version_release") if (int_array(1) /= VERSION_MAJOR .or. int_array(2) /= VERSION_MINOR & .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("State point file was created with a different & + &version of OpenMC.") end if ! Read date and time @@ -667,8 +663,8 @@ contains ! Check size of tally results array 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("Input file tally structure is different from & + &restart.") end if ! Read number of filters @@ -741,8 +737,8 @@ 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("Source bank must be contained in statepoint restart & + &file") end if ! Read tallies to master @@ -754,8 +750,8 @@ contains ! Read number of global tallies 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("Number of global tallies does not match in state & + &point.") end if ! Read global tally data @@ -791,8 +787,8 @@ contains call sp % file_close() ! Write message - message = "Loading source file " // trim(path_source_point) // "..." - call write_message(1) + call write_message("Loading source file " // trim(path_source_point) & + &// "...", 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 d4f8873a0a..cff69bb16e 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 @@ -49,9 +49,8 @@ contains if (i_end > 0) then n = n + 1 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("The word '" // string(i_start:i_end) & + &// "' is longer than the space allocated for it.") end if words(n) = string(i_start:i_end) ! reset indices @@ -210,8 +209,8 @@ function zero_padded(num, n_digits) result(str) ! Make sure n_digits is reasonable. 10 digits is the maximum needed for the ! 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('zero_padded called with an unreasonably large & + &n_digits (>10)') 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 f86d67d168..87f5a2cab7 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -21,8 +21,7 @@ module tally implicit none - ! Tally map positioning array - integer :: position(N_FILTER_TYPES - 3) = 0 + integer :: position(N_FILTER_TYPES - 3) = 0 ! Tally map positioning array !$omp threadprivate(position) contains @@ -871,8 +870,8 @@ contains end do REACTION_LOOP else - message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end if end select @@ -1009,8 +1008,8 @@ contains end do else - message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end if end select end if @@ -1209,8 +1208,8 @@ contains end do REACTION_LOOP else - message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end if end select @@ -1361,8 +1360,8 @@ contains end do else - message = "Invalid score type on tally " // to_str(t % id) // "." - call fatal_error() + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end if end select @@ -1707,9 +1706,8 @@ contains case (SCORE_EVENTS) score = ONE case default - message = "Invalid score type on tally " // & - to_str(t % id) // "." - call fatal_error() + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end select else @@ -1783,9 +1781,8 @@ contains case (SCORE_EVENTS) score = ONE case default - message = "Invalid score type on tally " // & - to_str(t % id) // "." - call fatal_error() + call fatal_error("Invalid score type on tally " & + &// to_str(t % id) // ".") end select end if @@ -2223,8 +2220,7 @@ contains ! Check for errors if (filter_index <= 0 .or. filter_index > & t % total_filter_bins) then - message = "Score index outside range." - call fatal_error() + call fatal_error("Score index outside range.") end if ! Add to surface current tally @@ -2563,18 +2559,16 @@ 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("Active tallies should not exist before CMFD tallies!") else if (active_analog_tallies % size() > 0) then - message = 'Active analog tallies should not exist before CMFD tallies!' - call fatal_error() + call fatal_error('Active analog tallies should not exist before CMFD & + &tallies!') else if (active_tracklength_tallies % size() > 0) then - message = "Active tracklength tallies should not exist before CMFD & - &tallies!" - call fatal_error() + call fatal_error("Active tracklength tallies should not exist before & + &CMFD tallies!") else if (active_current_tallies % size() > 0) then - message = "Active current tallies should not exist before CMFD tallies!" - call fatal_error() + call fatal_error("Active current tallies should not exist before CMFD & + &tallies!") end if do i = 1, n_cmfd_tallies diff --git a/src/tracking.F90 b/src/tracking.F90 index 68a0e3d09a..9545d41ee6 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -39,8 +39,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("Simulating Particle " // trim(to_str(p % id))) end if ! If the cell hasn't been determined based on the particle's location, @@ -50,8 +49,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("Could not locate particle " // trim(to_str(p % id))) end if ! set birth cell attribute @@ -198,9 +196,8 @@ contains ! If particle has too many events, display warning and kill it n_event = n_event + 1 if (n_event == MAX_EVENTS) then - message = "Particle " // trim(to_str(p%id)) // " underwent maximum & - &number of events." - call warning() + if (master) call warning("Particle " // trim(to_str(p%id)) & + &// " underwent maximum number of events.") p % alive = .false. end if diff --git a/src/xml_interface.F90 b/src/xml_interface.F90 index 64842a69ec..1a24bc14b3 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 @@ -201,9 +200,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -234,9 +232,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -267,9 +264,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -300,9 +296,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -333,9 +328,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -366,9 +360,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Extract value @@ -399,9 +392,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " // & + getNodeName(ptr) // ".") end if ! Extract value @@ -432,9 +424,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Get the size @@ -461,9 +452,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " & + &// getNodeName(ptr) // ".") end if ! Get the size @@ -490,9 +480,8 @@ contains ! Leave if it was not found if (.not. found) then - message = "Node " // node_name // " not part of Node " // & - getNodeName(ptr) // "." - call fatal_error() + call fatal_error("Node " // node_name // " not part of Node " // & + getNodeName(ptr) // ".") end if ! Get the size