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

changed how messages are handled

Browse source 
Conflicts:
	src/cmfd_execute.F90
	src/input_xml.F90
	src/string.F90
	src/tally_new.F90
	src/tracking.F90
This commit is contained in:
Bryan Herman 2014-07-25 09:08:36 -04:00 • committed by Sterling Harper
parent 8c44836944
commit b11c54f52b
26 changed files with 360 additions and 358 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/ace.F90
View file

@ -155,7 +155,7 @@ contains
if (mat % i_sab_nuclides(k) == NONE) then
message = "S(a,b) table " // trim(mat % sab_names(k)) // " did not &
&match any nuclide on material " // trim(to_str(mat % id))
call fatal_error()
call fatal_error(message)
end if
end do ASSIGN_SAB
@ -267,16 +267,16 @@ contains
inquire(FILE=filename, EXIST=file_exists, READ=readable)
if (.not. file_exists) then
message = "ACE library '" // trim(filename) // "' does not exist!"
call fatal_error()
call fatal_error(message)
elseif (readable(1:3) == 'NO') then
message = "ACE library '" // trim(filename) // "' is not readable! &
&Change file permissions with chmod command."
call fatal_error()
call fatal_error(message)
end if
! display message
message = "Loading ACE cross section table: " // listing % name
call write_message(6)
call write_message(message, 6)
if (filetype == ASCII) then
! =======================================================================
@ -297,7 +297,7 @@ contains
if(adjustl(name) /= adjustl(listing % name)) then
message = "XS listing entry " // trim(listing % name) // " did not &
&match ACE data, " // trim(name) // " found instead."
call fatal_error()
call fatal_error(message)
end if
! Read more header and NXS and JXS
@ -380,7 +380,7 @@ contains
! abort the run.
if (run_mode == MODE_FIXEDSOURCE .and. nuc % fissionable) then
message = "Cannot have fissionable material in a fixed source run."
call fatal_error()
call fatal_error(message)
end if
! for fissionable nuclides, precalculate microscopic nu-fission cross
@ -1319,7 +1319,7 @@ contains
if (nuc % urr_inelastic == NONE) then
message = "Could not find inelastic reaction specified on " &
// "unresolved resonance probability table."
call fatal_error()
call fatal_error(message)
end if
end if
@ -1347,7 +1347,7 @@ contains
if (any(nuc % urr_data % prob < ZERO)) then
message = "Negative value(s) found on probability table for nuclide " &
// nuc % name
call warning()
if (master) call warning(message)
end if
end subroutine read_unr_res

9
src/cmfd_data.F90
View file

@ -5,6 +5,7 @@ module cmfd_data
! parameters for CMFD calculation.
!==============================================================================
use constants
implicit none
private
@ -55,7 +56,7 @@ contains
OUT_FRONT, IN_TOP, OUT_TOP, CMFD_NOACCEL, ZERO, &
ONE, TINY_BIT
use error, only: fatal_error
use global, only: cmfd, message, n_cmfd_tallies, cmfd_tallies, meshes,&
use global, only: cmfd, n_cmfd_tallies, cmfd_tallies, meshes,&
matching_bins
use mesh, only: mesh_indices_to_bin
use mesh_header, only: StructuredMesh
@ -164,7 +165,7 @@ contains
message = 'Detected zero flux without coremap overlay at: (' &
// to_str(i) // ',' // to_str(j) // ',' // to_str(k) &
// ') in group ' // to_str(h)
call fatal_error()
call fatal_error(message)
end if
! Get total rr and convert to total xs
@ -628,7 +629,7 @@ contains
subroutine compute_dhat()
use constants, only: CMFD_NOACCEL, ZERO
use global, only: cmfd, cmfd_coremap, message, dhat_reset
use global, only: cmfd, cmfd_coremap, dhat_reset
use output, only: write_message
use string, only: to_str
@ -767,7 +768,7 @@ contains
! write that dhats are zero
if (dhat_reset) then
message = 'Dhats reset to zero.'
call write_message(1)
call write_message(message, 1)
end if
end subroutine compute_dhat

18
src/cmfd_execute.F90
View file

@ -47,7 +47,7 @@ contains
call cmfd_jfnk_execute()
else
message = 'solver type became invalid after input processing'
call fatal_error()
call fatal_error(message)
end if
#else
call cmfd_solver_execute()
@ -257,8 +257,8 @@ contains
use constants, only: ZERO, ONE
use error, only: warning, fatal_error
use global, only: meshes, source_bank, work, n_user_meshes, message, &
cmfd, master
use global, only: meshes, source_bank, work, n_user_meshes, cmfd, &
master
use mesh_header, only: StructuredMesh
use mesh, only: count_bank_sites, get_mesh_indices
use search, only: binary_search
@ -317,7 +317,7 @@ contains
! Check for sites outside of the mesh
if (master .and. outside) then
message = "Source sites outside of the CMFD mesh!"
call fatal_error()
call fatal_error(message)
end if
! Have master compute weight factors (watch for 0s)
@ -348,11 +348,11 @@ contains
if (source_bank(i) % E < cmfd % egrid(1)) then
e_bin = 1
message = 'Source pt below energy grid'
call warning()
if (master) call warning(message)
elseif (source_bank(i) % E > cmfd % egrid(n_groups + 1)) then
e_bin = n_groups
message = 'Source pt above energy grid'
call warning()
if (master) call warning(message)
else
e_bin = binary_search(cmfd % egrid, n_groups + 1, source_bank(i) % E)
end if
@ -363,7 +363,7 @@ contains
! Check for outside of mesh
if (.not. in_mesh) then
message = 'Source site found outside of CMFD mesh'
call fatal_error()
call fatal_error(message)
end if
! Reweight particle
@ -412,7 +412,7 @@ contains
subroutine cmfd_tally_reset()
use global, only: n_cmfd_tallies, cmfd_tallies, message
use global, only: n_cmfd_tallies, cmfd_tallies
use output, only: write_message
use tally, only: reset_result
@ -420,7 +420,7 @@ contains
! Print message
message = "CMFD tallies reset"
call write_message(7)
call write_message(message, 7)
! Begin loop around CMFD tallies
do i = 1, n_cmfd_tallies

32
src/cmfd_input.F90
View file

@ -88,14 +88,14 @@ contains
! CMFD is optional unless it is in on from settings
if (cmfd_on) then
message = "No CMFD XML file, '" // trim(filename) // "' does not exist!"
call fatal_error()
call fatal_error(message)
end if
return
else
! Tell user
message = "Reading CMFD XML file..."
call write_message(5)
call write_message(message, 5)
end if
@ -108,7 +108,7 @@ contains
! Check if mesh is there
if (.not.found) then
message = "No CMFD mesh specified in CMFD XML file."
call fatal_error()
call fatal_error(message)
end if
! Set spatial dimensions in cmfd object
@ -140,7 +140,7 @@ contains
if (get_arraysize_integer(node_mesh, "map") /= &
product(cmfd % indices(1:3))) then
message = 'FATAL==>CMFD coremap not to correct dimensions'
call fatal_error()
call fatal_error(message)
end if
allocate(iarray(get_arraysize_integer(node_mesh, "map")))
call get_node_array(node_mesh, "map", iarray)
@ -217,7 +217,7 @@ contains
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
#ifndef PETSC
message = 'Must use PETSc when running adjoint option.'
call fatal_error()
call fatal_error(message)
#endif
cmfd_run_adjoint = .true.
end if
@ -247,7 +247,7 @@ contains
if (trim(cmfd_display) == 'dominance' .and. &
trim(cmfd_solver_type) /= 'power') then
message = 'Dominance Ratio only aviable with power iteration solver'
call warning()
if (master) call warning(message)
cmfd_display = ''
end if
@ -265,7 +265,7 @@ contains
if (n_params /= 2) then
message = 'Gauss Seidel tolerance is not 2 parameters &
&(absolute, relative).'
call fatal_error()
call fatal_error(message)
end if
call get_node_array(doc, "gauss_seidel_tolerance", gs_tol)
cmfd_atoli = gs_tol(1)
@ -336,7 +336,7 @@ contains
n = get_arraysize_integer(node_mesh, "dimension")
if (n /= 2 .and. n /= 3) then
message = "Mesh must be two or three dimensions."
call fatal_error()
call fatal_error(message)
end if
m % n_dimension = n
@ -351,7 +351,7 @@ contains
if (any(iarray3(1:n) <= 0)) then
message = "All entries on the <dimension> element for a tally mesh &
&must be positive."
call fatal_error()
call fatal_error(message)
end if
! Read dimensions in each direction
@ -361,7 +361,7 @@ contains
if (m % n_dimension /= get_arraysize_double(node_mesh, "lower_left")) then
message = "Number of entries on <lower_left> must be the same as &
&the number of entries on <dimension>."
call fatal_error()
call fatal_error(message)
end if
call get_node_array(node_mesh, "lower_left", m % lower_left)
@ -370,7 +370,7 @@ contains
check_for_node(node_mesh, "width")) then
message = "Cannot specify both <upper_right> and <width> on a &
&tally mesh."
call fatal_error()
call fatal_error(message)
end if
! Make sure either upper-right or width was specified
@ -378,7 +378,7 @@ contains
.not.check_for_node(node_mesh, "width")) then
message = "Must specify either <upper_right> and <width> on a &
&tally mesh."
call fatal_error()
call fatal_error(message)
end if
if (check_for_node(node_mesh, "width")) then
@ -387,14 +387,14 @@ contains
get_arraysize_double(node_mesh, "lower_left")) then
message = "Number of entries on <width> must be the same as the &
&number of entries on <lower_left>."
call fatal_error()
call fatal_error(message)
end if
! Check for negative widths
call get_node_array(node_mesh, "width", rarray3(1:n))
if (any(rarray3(1:n) < ZERO)) then
message = "Cannot have a negative <width> on a tally mesh."
call fatal_error()
call fatal_error(message)
end if
! Set width and upper right coordinate
@ -407,7 +407,7 @@ contains
get_arraysize_double(node_mesh, "lower_left")) then
message = "Number of entries on <upper_right> must be the same as &
&the number of entries on <lower_left>."
call fatal_error()
call fatal_error(message)
end if
! Check that upper-right is above lower-left
@ -415,7 +415,7 @@ contains
if (any(rarray3(1:n) < m % lower_left)) then
message = "The <upper_right> coordinates must be greater than the &
&<lower_left> coordinates on a tally mesh."
call fatal_error()
call fatal_error(message)
end if
! Set upper right coordinate and width

22
src/cmfd_solver.F90
View file

@ -2,6 +2,7 @@ module cmfd_solver
! This module contains routines to execute the power iteration solver
use constants
use cmfd_loss_operator, only: init_loss_matrix, build_loss_matrix
use cmfd_prod_operator, only: init_prod_matrix, build_prod_matrix
use matrix_header, only: Matrix
@ -30,6 +31,7 @@ module cmfd_solver
type(Vector) :: s_n ! new source vector
type(Vector) :: s_o ! old flux vector
type(Vector) :: serr_v ! error in source
character(2*MAX_LINE_LEN) :: message
! CMFD linear solver interface
procedure(linsolve), pointer :: cmfd_linsolver => null()
@ -180,8 +182,6 @@ contains
use error, only: fatal_error
#ifdef PETSC
use global, only: cmfd_write_matrices
#else
use global, only: message
#endif
#ifdef PETSC
@ -196,7 +196,7 @@ contains
end if
#else
message = 'Adjoint calculations only allowed with PETSc'
call fatal_error()
call fatal_error(message)
#endif
end subroutine compute_adjoint
@ -210,7 +210,7 @@ contains
use constants, only: ONE
use error, only: fatal_error
use global, only: cmfd_atoli, cmfd_rtoli, message
use global, only: cmfd_atoli, cmfd_rtoli
integer :: i ! iteration counter
integer :: innerits ! # of inner iterations
@ -238,7 +238,7 @@ contains
! Check if reached iteration 10000
if (i == 10000) then
message = 'Reached maximum iterations in CMFD power iteration solver.'
call fatal_error()
call fatal_error(message)
end if
! Compute source vector
@ -357,7 +357,7 @@ contains
use constants, only: ONE, ZERO
use error, only: fatal_error
use global, only: cmfd, cmfd_spectral, message
use global, only: cmfd, cmfd_spectral
type(Matrix), intent(inout) :: A ! coefficient matrix
type(Vector), intent(inout) :: b ! right hand side vector
@ -402,7 +402,7 @@ contains
! Check for max iterations met
if (igs == 10000) then
message = 'Maximum Gauss-Seidel iterations encountered.'
call fatal_error()
call fatal_error(message)
endif
! Copy over x vector
@ -464,7 +464,7 @@ contains
use constants, only: ONE, ZERO
use error, only: fatal_error
use global, only: cmfd, cmfd_spectral, message
use global, only: cmfd, cmfd_spectral
type(Matrix), intent(inout) :: A ! coefficient matrix
type(Vector), intent(inout) :: b ! right hand side vector
@ -521,7 +521,7 @@ contains
! Check for max iterations met
if (igs == 10000) then
message = 'Maximum Gauss-Seidel iterations encountered.'
call fatal_error()
call fatal_error(message)
endif
! Copy over x vector
@ -610,7 +610,7 @@ contains
use constants, only: ONE, ZERO
use error, only: fatal_error
use global, only: cmfd, cmfd_spectral, message
use global, only: cmfd, cmfd_spectral
type(Matrix), intent(inout) :: A ! coefficient matrix
type(Vector), intent(inout) :: b ! right hand side vector
@ -654,7 +654,7 @@ contains
! Check for max iterations met
if (igs == 10000) then
message = 'Maximum Gauss-Seidel iterations encountered.'
call fatal_error()
call fatal_error(message)
endif
! Copy over x vector

12
src/eigenvalue.F90
View file

@ -116,7 +116,7 @@ contains
subroutine initialize_batch()
message = "Simulating batch " // trim(to_str(current_batch)) // "..."
call write_message(8)
call write_message(message, 8)
! Reset total starting particle weight used for normalizing tallies
total_weight = ZERO
@ -303,7 +303,7 @@ contains
if (n_bank == 0) then
message = "No fission sites banked on processor " // to_str(rank)
call fatal_error()
call fatal_error(message)
end if
! Make sure all processors start at the same point for random sampling. Then
@ -555,7 +555,7 @@ contains
! display warning message if there were sites outside entropy box
if (sites_outside) then
message = "Fission source site(s) outside of entropy box."
call warning()
if (master) call warning(message)
end if
! sum values to obtain shannon entropy
@ -774,7 +774,7 @@ contains
! Check for sites outside of the mesh
if (master .and. sites_outside) then
message = "Source sites outside of the UFS mesh!"
call fatal_error()
call fatal_error(message)
end if
#ifdef MPI
@ -805,7 +805,7 @@ contains
! Write message at beginning
if (current_batch == 1) then
message = "Replaying history from state point..."
call write_message(1)
call write_message(message, 1)
end if
do current_gen = 1, gen_per_batch
@ -823,7 +823,7 @@ contains
! Write message at end
if (current_batch == restart_batch) then
message = "Resuming simulation..."
call write_message(1)
call write_message(message, 1)
end if
end subroutine replay_batch_history

2
src/energy_grid.F90
View file

@ -24,7 +24,7 @@ contains
type(Nuclide), pointer :: nuc => null()
message = "Creating unionized energy grid..."
call write_message(5)
call write_message(message, 5)
! Add grid points for each nuclide in the problem
do i = 1, n_nuclides_total

6
src/error.F90
View file

@ -1,6 +1,9 @@
module error
use, intrinsic :: ISO_FORTRAN_ENV
use constants
use global
#ifdef MPI
use mpi
@ -73,8 +76,9 @@ contains
! the program is aborted.
!===============================================================================
subroutine fatal_error(error_code)
subroutine fatal_error(message, error_code)
character(2*MAX_LINE_LEN) :: message
integer, optional :: error_code ! error code
integer :: code ! error code

3
src/fission.F90
View file

@ -3,7 +3,6 @@ module fission
use ace_header, only: Nuclide
use constants
use error, only: fatal_error
use global, only: message
use interpolation, only: interpolate_tab1
use search, only: binary_search
@ -30,7 +29,7 @@ contains
if (nuc % nu_t_type == NU_NONE) then
message = "No neutron emission data for table: " // nuc % name
call fatal_error()
call fatal_error(message)
elseif (nuc % nu_t_type == NU_POLYNOMIAL) then
! determine number of coefficients
NC = int(nuc % nu_t_data(1))

2
src/fixed_source.F90
View file

@ -97,7 +97,7 @@ contains
subroutine initialize_batch()
message = "Simulating batch " // trim(to_str(current_batch)) // "..."
call write_message(1)
call write_message(message, 1)
! Reset total starting particle weight used for normalizing tallies
total_weight = ZERO

20
src/geometry.F90
View file

@ -106,7 +106,7 @@ contains
trim(to_str(cells(index_cell) % id)) // ", " // &
trim(to_str(cells(coord % cell) % id)) // &
" on universe " // trim(to_str(univ % id))
call fatal_error()
call fatal_error(message)
end if
overlap_check_cnt(index_cell) = overlap_check_cnt(index_cell) + 1
@ -182,7 +182,7 @@ contains
! Show cell information on trace
if (verbosity >= 10 .or. trace) then
message = " Entering cell " // trim(to_str(c % id))
call write_message()
call write_message(message)
end if
if (c % type == CELL_NORMAL) then
@ -387,7 +387,7 @@ contains
surf => surfaces(i_surface)
if (verbosity >= 10 .or. trace) then
message = " Crossing surface " // trim(to_str(surf % id))
call write_message()
call write_message(message)
end if
if (surf % bc == BC_VACUUM .and. (run_mode /= MODE_PLOTTING)) then
@ -420,7 +420,7 @@ contains
! Display message
if (verbosity >= 10 .or. trace) then
message = " Leaked out of surface " // trim(to_str(surf % id))
call write_message()
call write_message(message)
end if
return
@ -566,7 +566,7 @@ contains
case default
message = "Reflection not supported for surface " // &
trim(to_str(surf % id))
call fatal_error()
call fatal_error(message)
end select
! Set new particle direction
@ -597,7 +597,7 @@ contains
! Diagnostic message
if (verbosity >= 10 .or. trace) then
message = " Reflected from surface " // trim(to_str(surf%id))
call write_message()
call write_message(message)
end if
return
end if
@ -678,7 +678,7 @@ contains
". Current position (" // trim(to_str(p % coord % lattice_x)) &
// "," // trim(to_str(p % coord % lattice_y)) // "," // &
trim(to_str(p % coord % lattice_z)) // ")"
call write_message()
call write_message(message)
end if
if (lat % type == LATTICE_RECT) then
@ -1497,7 +1497,7 @@ contains
type(Surface), pointer :: surf
message = "Building neighboring cells lists for each surface..."
call write_message(4)
call write_message(message, 4)
allocate(count_positive(n_surfaces))
allocate(count_negative(n_surfaces))
@ -1569,7 +1569,7 @@ contains
type(Particle), intent(inout) :: p
! Print warning and write lost particle file
call warning(force = .true.)
call warning(message)
call write_particle_restart(p)
! Increment number of lost particles
@ -1582,7 +1582,7 @@ contains
! reached
if (n_lost_particles == MAX_LOST_PARTICLES) then
message = "Maximum number of lost particles has been reached."
call fatal_error()
call fatal_error(message)
end if
end subroutine handle_lost_particle

40
src/initialize.F90
View file

@ -159,9 +159,9 @@ contains
! Warn if overlap checking is on
if (master .and. check_overlaps) then
message = ""
call write_message()
call write_message(message)
message = "Cell overlap checking is ON"
call warning()
if (master) call warning(message)
end if
! Stop initialization timer
@ -346,7 +346,7 @@ contains
if (n_particles == ERROR_INT) then
message = "Must specify integer after " // trim(argv(i-1)) // &
" command-line flag."
call fatal_error()
call fatal_error(message)
end if
case ('-r', '-restart', '--restart')
! Read path for state point/particle restart
@ -367,7 +367,7 @@ contains
particle_restart_run = .true.
case default
message = "Unrecognized file after restart flag."
call fatal_error()
call fatal_error(message)
end select
! If its a restart run check for additional source file
@ -386,7 +386,7 @@ contains
call sp % file_close()
if (filetype /= FILETYPE_SOURCE) then
message = "Second file after restart flag must be a source file"
call fatal_error()
call fatal_error(message)
end if
! It is a source file
@ -421,12 +421,12 @@ contains
n_threads = int(str_to_int(argv(i)), 4)
if (n_threads < 1) then
message = "Invalid number of threads specified on command line."
call fatal_error()
call fatal_error(message)
end if
call omp_set_num_threads(n_threads)
#else
message = "Ignoring number of threads specified on command line."
call warning()
if (master) call warning(message)
#endif
case ('-?', '-h', '-help', '--help')
@ -443,7 +443,7 @@ contains
i = i + 1
case default
message = "Unknown command line option: " // argv(i)
call fatal_error()
call fatal_error(message)
end select
last_flag = i
@ -581,7 +581,7 @@ contains
else
message = "Could not find surface " // trim(to_str(abs(id))) // &
" specified on cell " // trim(to_str(c % id))
call fatal_error()
call fatal_error(message)
end if
end if
end do
@ -595,7 +595,7 @@ contains
else
message = "Could not find universe " // trim(to_str(id)) // &
" specified on cell " // trim(to_str(c % id))
call fatal_error()
call fatal_error(message)
end if
! =======================================================================
@ -611,7 +611,7 @@ contains
else
message = "Could not find material " // trim(to_str(id)) // &
" specified on cell " // trim(to_str(c % id))
call fatal_error()
call fatal_error(message)
end if
else
id = c % fill
@ -630,13 +630,13 @@ contains
else
message = "Could not find material " // trim(to_str(mid)) // &
" specified on lattice " // trim(to_str(lid))
call fatal_error()
call fatal_error(message)
end if
else
message = "Specified fill " // trim(to_str(id)) // " on cell " // &
trim(to_str(c % id)) // " is neither a universe nor a lattice."
call fatal_error()
call fatal_error(message)
end if
end if
end do
@ -663,7 +663,7 @@ contains
else
message = "Invalid universe number " // trim(to_str(id)) &
// " specified on lattice " // trim(to_str(lat % id))
call fatal_error()
call fatal_error(message)
end if
end do
end do
@ -689,7 +689,7 @@ contains
else
message = "Could not find cell " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
call fatal_error()
call fatal_error(message)
end if
end do
@ -705,7 +705,7 @@ contains
else
message = "Could not find surface " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
call fatal_error()
call fatal_error(message)
end if
end do
@ -718,7 +718,7 @@ contains
else
message = "Could not find universe " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
call fatal_error()
call fatal_error(message)
end if
end do
@ -731,7 +731,7 @@ contains
else
message = "Could not find material " // trim(to_str(id)) // &
" specified on tally " // trim(to_str(t % id))
call fatal_error()
call fatal_error(message)
end if
end do
@ -867,7 +867,7 @@ contains
! Check for allocation errors
if (alloc_err /= 0) then
message = "Failed to allocate source bank."
call fatal_error()
call fatal_error(message)
end if
#ifdef _OPENMP
@ -895,7 +895,7 @@ contains
! Check for allocation errors
if (alloc_err /= 0) then
message = "Failed to allocate fission bank."
call fatal_error()
call fatal_error(message)
end if
end subroutine allocate_banks

354
src/input_xml.F90
View file

File diff suppressed because it is too large Load diff

5
src/interpolation.F90
View file

@ -3,7 +3,6 @@ module interpolation
use constants
use endf_header, only: Tab1
use error, only: fatal_error
use global, only: message
use search, only: binary_search
use string, only: to_str
@ -121,7 +120,7 @@ contains
y = exp((1-r)*log(y0) + r*log(y1))
case default
message = "Unsupported interpolation scheme: " // to_str(interp)
call fatal_error()
call fatal_error(message)
end select
end function interpolate_tab1_array
@ -207,7 +206,7 @@ contains
y = exp((1-r)*log(y0) + r*log(y1))
case default
message = "Unsupported interpolation scheme: " // to_str(interp)
call fatal_error()
call fatal_error(message)
end select
end function interpolate_tab1_object

6
src/output.F90
View file

@ -22,8 +22,6 @@ module output
integer :: ou = OUTPUT_UNIT
integer :: eu = ERROR_UNIT
character(2*MAX_LINE_LEN) :: message
contains
!===============================================================================
@ -197,6 +195,7 @@ contains
subroutine write_message(message, level)
character(2*MAX_LINE_LEN) :: message
integer, optional :: level ! verbosity level
integer :: i_start ! starting position
@ -1556,6 +1555,7 @@ contains
subroutine print_results()
character(2*MAX_LINE_LEN) :: message
real(8) :: alpha ! significance level for CI
real(8) :: t_value ! t-value for confidence intervals
@ -1590,7 +1590,7 @@ contains
global_tallies(LEAKAGE) % sum_sq
else
message = "Could not compute uncertainties -- only one active batch simulated!"
call warning()
if (master) call warning(message)
write(ou,103) "k-effective (Collision)", global_tallies(K_COLLISION) % sum
write(ou,103) "k-effective (Track-length)", global_tallies(K_TRACKLENGTH) % sum

2
src/particle_restart.F90
View file

@ -77,7 +77,7 @@ contains
! Write meessage
message = "Loading particle restart file " // trim(path_particle_restart) &
// "..."
call write_message(1)
call write_message(message, 1)
! Open file
call pr % file_open(path_particle_restart, 'r')

56
src/physics.F90
View file

@ -52,14 +52,14 @@ contains
message = " " // trim(reaction_name(p % event_MT)) // " with " // &
trim(adjustl(nuclides(p % event_nuclide) % name)) // &
". Energy = " // trim(to_str(p % E * 1e6_8)) // " eV."
call write_message()
call write_message(message)
end if
! check for very low energy
if (p % E < 1.0e-100_8) then
p % alive = .false.
message = "Killing neutron with extremely low energy"
call warning()
if (master) call warning(message)
end if
end subroutine collision
@ -162,7 +162,7 @@ contains
if (i > mat % n_nuclides) then
call write_particle_restart(p)
message = "Did not sample any nuclide during collision."
call fatal_error()
call fatal_error(message)
end if
! Find atom density
@ -372,7 +372,7 @@ contains
call write_particle_restart(p)
message = "Did not sample any reaction for nuclide " // &
trim(nuc % name)
call fatal_error()
call fatal_error(message)
end if
rxn => nuc % reactions(i)
@ -977,7 +977,7 @@ contains
case default
message = "Not a recognized resonance scattering treatment!"
call fatal_error()
call fatal_error(message)
end select
end subroutine sample_target_velocity
@ -1096,7 +1096,7 @@ contains
if (.not. in_mesh) then
call write_particle_restart(p)
message = "Source site outside UFS mesh!"
call fatal_error()
call fatal_error(message)
end if
if (source_frac(1,ijk(1),ijk(2),ijk(3)) /= ZERO) then
@ -1124,7 +1124,7 @@ contains
message = "Maximum number of sites in fission bank reached. This can &
&result in irreproducible results using different numbers of &
&processes/threads."
call warning()
if (master) call warning(message)
end if
! Bank source neutrons
@ -1251,7 +1251,7 @@ contains
! call write_particle_restart(p)
message = "Resampled energy distribution maximum number of " // &
"times for nuclide " // nuc % name
call fatal_error()
call fatal_error(message)
end if
end do
@ -1278,7 +1278,7 @@ contains
! call write_particle_restart(p)
message = "Resampled energy distribution maximum number of " // &
"times for nuclide " // nuc % name
call fatal_error()
call fatal_error(message)
end if
end do
@ -1460,7 +1460,7 @@ contains
else
! call write_particle_restart(p)
message = "Unknown interpolation type: " // trim(to_str(interp))
call fatal_error()
call fatal_error(message)
end if
! Because of floating-point roundoff, it may be possible for mu to be
@ -1472,7 +1472,7 @@ contains
else
! call write_particle_restart(p)
message = "Unknown angular distribution type: " // trim(to_str(type))
call fatal_error()
call fatal_error(message)
end if
end function sample_angle
@ -1621,7 +1621,7 @@ contains
! call write_particle_restart(p)
message = "Multiple interpolation regions not supported while &
&attempting to sample equiprobable energy bins."
call fatal_error()
call fatal_error(message)
end if
! determine index on incoming energy grid and interpolation factor
@ -1686,12 +1686,12 @@ contains
if (NR == 1) then
message = "Assuming linear-linear interpolation when sampling &
&continuous tabular distribution"
call warning()
if (master) call warning(message)
else if (NR > 1) then
! call write_particle_restart(p)
message = "Multiple interpolation regions not supported while &
&attempting to sample continuous tabular distribution."
call fatal_error()
call fatal_error(message)
end if
! find energy bin and calculate interpolation factor -- if the energy is
@ -1751,7 +1751,7 @@ contains
! call write_particle_restart(p)
message = "Discrete lines in continuous tabular distributed not &
&yet supported"
call fatal_error()
call fatal_error(message)
end if
! determine outgoing energy bin
@ -1792,7 +1792,7 @@ contains
else
! call write_particle_restart(p)
message = "Unknown interpolation type: " // trim(to_str(INTT))
call fatal_error()
call fatal_error(message)
end if
! Now interpolate between incident energy bins i and i + 1
@ -1834,7 +1834,7 @@ contains
if (n_sample == MAX_SAMPLE) then
! call write_particle_restart(p)
message = "Too many rejections on Maxwell fission spectrum."
call fatal_error()
call fatal_error(message)
end if
end do
@ -1867,7 +1867,7 @@ contains
if (n_sample == MAX_SAMPLE) then
! call write_particle_restart(p)
message = "Too many rejections on evaporation spectrum."
call fatal_error()
call fatal_error(message)
end if
end do
@ -1909,7 +1909,7 @@ contains
if (n_sample == MAX_SAMPLE) then
! call write_particle_restart(p)
message = "Too many rejections on Watt spectrum."
call fatal_error()
call fatal_error(message)
end if
end do
@ -1920,7 +1920,7 @@ contains
if (.not. present(mu_out)) then
! call write_particle_restart(p)
message = "Law 44 called without giving mu_out as argument."
call fatal_error()
call fatal_error(message)
end if
! read number of interpolation regions and incoming energies
@ -1930,7 +1930,7 @@ contains
! call write_particle_restart(p)
message = "Multiple interpolation regions not supported while &
&attempting to sample Kalbach-Mann distribution."
call fatal_error()
call fatal_error(message)
end if
! find energy bin and calculate interpolation factor -- if the energy is
@ -1991,7 +1991,7 @@ contains
! call write_particle_restart(p)
message = "Discrete lines in continuous tabular distributed not &
&yet supported"
call fatal_error()
call fatal_error(message)
end if
! determine outgoing energy bin
@ -2046,7 +2046,7 @@ contains
else
! call write_particle_restart()
message = "Unknown interpolation type: " // trim(to_str(INTT))
call fatal_error()
call fatal_error(message)
end if
! Now interpolate between incident energy bins i and i + 1
@ -2073,7 +2073,7 @@ contains
if (.not. present(mu_out)) then
! call write_particle_restart()
message = "Law 61 called without giving mu_out as argument."
call fatal_error()
call fatal_error(message)
end if
! read number of interpolation regions and incoming energies
@ -2083,7 +2083,7 @@ contains
! call write_particle_restart()
message = "Multiple interpolation regions not supported while &
&attempting to sample correlated energy-angle distribution."
call fatal_error()
call fatal_error(message)
end if
! find energy bin and calculate interpolation factor -- if the energy is
@ -2144,7 +2144,7 @@ contains
! call write_particle_restart()
message = "Discrete lines in continuous tabular distributed not &
&yet supported"
call fatal_error()
call fatal_error(message)
end if
! determine outgoing energy bin
@ -2186,7 +2186,7 @@ contains
else
! call write_particle_restart()
message = "Unknown interpolation type: " // trim(to_str(INTT))
call fatal_error()
call fatal_error(message)
end if
! Now interpolate between incident energy bins i and i + 1
@ -2250,7 +2250,7 @@ contains
else
! call write_particle_restart()
message = "Unknown interpolation type: " // trim(to_str(JJ))
call fatal_error()
call fatal_error(message)
end if
case (66)

2
src/plot.F90
View file

@ -34,7 +34,7 @@ contains
! Display output message
message = "Processing plot " // trim(to_str(pl % id)) // "..."
call write_message(5)
call write_message(message, 5)
if (pl % type == PLOT_TYPE_SLICE) then
! create 2d image

14
src/search.F90
View file

@ -1,7 +1,7 @@
module search
use constants
use error, only: fatal_error
use global, only: message
integer, parameter :: MAX_ITERATION = 64
@ -35,7 +35,7 @@ contains
if (val < array(L) .or. val > array(R)) then
message = "Value outside of array during binary search"
call fatal_error()
call fatal_error(message)
end if
n_iteration = 0
@ -63,7 +63,7 @@ contains
n_iteration = n_iteration + 1
if (n_iteration == MAX_ITERATION) then
message = "Reached maximum number of iterations on binary search."
call fatal_error()
call fatal_error(message)
end if
end do
@ -88,7 +88,7 @@ contains
if (val < array(L) .or. val > array(R)) then
message = "Value outside of array during binary search"
call fatal_error()
call fatal_error(message)
end if
n_iteration = 0
@ -116,7 +116,7 @@ contains
n_iteration = n_iteration + 1
if (n_iteration == MAX_ITERATION) then
message = "Reached maximum number of iterations on binary search."
call fatal_error()
call fatal_error(message)
end if
end do
@ -141,7 +141,7 @@ contains
if (val < array(L) .or. val > array(R)) then
message = "Value outside of array during binary search"
call fatal_error()
call fatal_error(message)
end if
n_iteration = 0
@ -169,7 +169,7 @@ contains
n_iteration = n_iteration + 1
if (n_iteration == MAX_ITERATION) then
message = "Reached maximum number of iterations on binary search."
call fatal_error()
call fatal_error(message)
end if
end do

6
src/solver_interface.F90
View file

@ -1,7 +1,7 @@
module solver_interface
use constants
use error, only: fatal_error
use global, only: message
use matrix_header, only: Matrix
use vector_header, only: Vector
@ -13,6 +13,8 @@ module solver_interface
implicit none
private
character(2*MAX_LINE_LEN) :: message
! GMRES solver type
type, public :: GMRESSolver
#ifdef PETSC
@ -70,8 +72,6 @@ module solver_interface
integer :: petsc_err ! petsc error code
#endif
character(2*MAX_LINE_LEN) :: message
contains
#ifdef PETSC

16
src/source.F90
View file

@ -37,14 +37,14 @@ contains
type(BinaryOutput) :: sp ! statepoint/source binary file
message = "Initializing source particles..."
call write_message(6)
call write_message(message, 6)
if (path_source /= '') then
! Read the source from a binary file instead of sampling from some
! assumed source distribution
message = 'Reading source file from ' // trim(path_source) // '...'
call write_message(6)
call write_message(message, 6)
! Open the binary file
call sp % file_open(path_source, 'r', serial = .false.)
@ -55,7 +55,7 @@ contains
! Check to make sure this is a source file
if (itmp /= FILETYPE_SOURCE) then
message = "Specified starting source file not a source file type."
call fatal_error()
call fatal_error(message)
end if
! Read in the source bank
@ -82,7 +82,7 @@ contains
! Write out initial source
if (write_initial_source) then
message = 'Writing out initial source guess...'
call write_message(1)
call write_message(message, 1)
#ifdef HDF5
filename = trim(path_output) // 'initial_source.h5'
#else
@ -146,7 +146,7 @@ contains
if (num_resamples == MAX_EXTSRC_RESAMPLES) then
message = "Maximum number of external source spatial resamples &
&reached!"
call fatal_error()
call fatal_error(message)
end if
end if
end do
@ -176,7 +176,7 @@ contains
if (num_resamples == MAX_EXTSRC_RESAMPLES) then
message = "Maximum number of external source spatial resamples &
&reached!"
call fatal_error()
call fatal_error(message)
end if
cycle
end if
@ -210,7 +210,7 @@ contains
case default
message = "No angle distribution specified for external source!"
call fatal_error()
call fatal_error(message)
end select
! Sample energy distribution
@ -242,7 +242,7 @@ contains
case default
message = "No energy distribution specified for external source!"
call fatal_error()
call fatal_error(message)
end select
! Set the random number generator back to the tracking stream.

20
src/state_point.F90
View file

@ -56,7 +56,7 @@ contains
! Write message
message = "Creating state point " // trim(filename) // "..."
call write_message(1)
call write_message(message, 1)
if (master) then
! Create statepoint file
@ -317,7 +317,7 @@ contains
! Write message for new file creation
message = "Creating source file " // trim(filename) // "..."
call write_message(1)
call write_message(message, 1)
! Create separate source file
call sp % file_create(filename, serial = .false.)
@ -362,7 +362,7 @@ contains
! Write message for new file creation
message = "Creating source file " // trim(filename) // "..."
call write_message(1)
call write_message(message, 1)
! Always create this file because it will be overwritten
call sp % file_create(filename, serial = .false.)
@ -533,7 +533,7 @@ contains
! Write message
message = "Loading state point " // trim(path_state_point) // "..."
call write_message(1)
call write_message(message, 1)
! Open file for reading
call sp % file_open(path_state_point, 'r', serial = .false.)
@ -547,7 +547,7 @@ contains
if (int_array(1) /= REVISION_STATEPOINT) then
message = "State point version does not match current version " &
// "in OpenMC."
call fatal_error()
call fatal_error(message)
end if
! Read OpenMC version
@ -558,7 +558,7 @@ contains
.or. int_array(3) /= VERSION_RELEASE) then
message = "State point file was created with a different version " &
// "of OpenMC."
call warning()
if (master) call warning(message)
end if
! Read date and time
@ -669,7 +669,7 @@ contains
if (int_array(1) /= t % total_score_bins .and. &
int_array(2) /= t % total_filter_bins) then
message = "Input file tally structure is different from restart."
call fatal_error()
call fatal_error(message)
end if
! Read number of filters
@ -743,7 +743,7 @@ contains
! Check to make sure source bank is present
if (path_source_point == path_state_point .and. .not. source_present) then
message = "Source bank must be contained in statepoint restart file"
call fatal_error()
call fatal_error(message)
end if
! Read tallies to master
@ -756,7 +756,7 @@ contains
call sp % read_data(int_array(1), "n_global_tallies", collect=.false.)
if (int_array(1) /= N_GLOBAL_TALLIES) then
message = "Number of global tallies does not match in state point."
call fatal_error()
call fatal_error(message)
end if
! Read global tally data
@ -793,7 +793,7 @@ contains
! Write message
message = "Loading source file " // trim(path_source_point) // "..."
call write_message(1)
call write_message(message, 1)
! Open source file
call sp % file_open(path_source_point, 'r', serial = .false.)

6
src/string.F90
View file

@ -2,7 +2,7 @@ module string
use constants, only: MAX_WORDS, MAX_LINE_LEN, ERROR_INT, ERROR_REAL
use error, only: fatal_error, warning
use global, only: message
use global, only: master
implicit none
@ -53,7 +53,7 @@ contains
if (i_end - i_start + 1 > len(words(n))) then
message = "The word '" // string(i_start:i_end) // &
"' is longer than the space allocated for it."
call warning()
if (master) call warning(message)
end if
words(n) = string(i_start:i_end)
! reset indices
@ -213,7 +213,7 @@ function zero_padded(num, n_digits) result(str)
! largest integer(4).
if (n_digits > 10) then
message = 'zero_padded called with an unreasonably large n_digits (>10)'
call fatal_error()
call fatal_error(message)
end if
! Write a format string of the form '(In.m)' where n is the max width and

22
src/tally.F90
View file

@ -874,7 +874,7 @@ contains
else
message = "Invalid score type on tally " // to_str(t % id) // "."
call fatal_error()
call fatal_error(message)
end if
end select
@ -1012,7 +1012,7 @@ contains
else
message = "Invalid score type on tally " // to_str(t % id) // "."
call fatal_error()
call fatal_error(message)
end if
end select
end if
@ -1212,7 +1212,7 @@ contains
else
message = "Invalid score type on tally " // to_str(t % id) // "."
call fatal_error()
call fatal_error(message)
end if
end select
@ -1364,7 +1364,7 @@ contains
else
message = "Invalid score type on tally " // to_str(t % id) // "."
call fatal_error()
call fatal_error(message)
end if
end select
@ -1711,7 +1711,7 @@ contains
case default
message = "Invalid score type on tally " // &
to_str(t % id) // "."
call fatal_error()
call fatal_error(message)
end select
else
@ -1787,7 +1787,7 @@ contains
case default
message = "Invalid score type on tally " // &
to_str(t % id) // "."
call fatal_error()
call fatal_error(message)
end select
end if
@ -2226,7 +2226,7 @@ contains
if (filter_index <= 0 .or. filter_index > &
t % total_filter_bins) then
message = "Score index outside range."
call fatal_error()
call fatal_error(message)
end if
! Add to surface current tally
@ -2566,17 +2566,17 @@ contains
! check to see if any of the active tally lists has been allocated
if (active_tallies % size() > 0) then
message = "Active tallies should not exist before CMFD tallies!"
call fatal_error()
call fatal_error(message)
else if (active_analog_tallies % size() > 0) then
message = 'Active analog tallies should not exist before CMFD tallies!'
call fatal_error()
call fatal_error(message)
else if (active_tracklength_tallies % size() > 0) then
message = "Active tracklength tallies should not exist before CMFD &
&tallies!"
call fatal_error()
call fatal_error(message)
else if (active_current_tallies % size() > 0) then
message = "Active current tallies should not exist before CMFD tallies!"
call fatal_error()
call fatal_error(message)
end if
do i = 1, n_cmfd_tallies

6
src/tracking.F90
View file

@ -42,7 +42,7 @@ contains
! Display message if high verbosity or trace is on
if (verbosity >= 9 .or. trace) then
message = "Simulating Particle " // trim(to_str(p % id))
call write_message()
call write_message(message)
end if
! If the cell hasn't been determined based on the particle's location,
@ -53,7 +53,7 @@ contains
! Particle couldn't be located
if (.not. found_cell) then
message = "Could not locate particle " // trim(to_str(p % id))
call fatal_error()
call fatal_error(message)
end if
! set birth cell attribute
@ -202,7 +202,7 @@ contains
if (n_event == MAX_EVENTS) then
message = "Particle " // trim(to_str(p%id)) // " underwent maximum &
&number of events."
call warning()
if (master) call warning(message)
p % alive = .false.
end if

21
src/xml_interface.F90
View file

@ -2,7 +2,6 @@ module xml_interface
use constants, only: MAX_LINE_LEN
use error, only: fatal_error
use global, only: message
use openmc_fox
implicit none
@ -205,7 +204,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Extract value
@ -238,7 +237,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Extract value
@ -271,7 +270,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Extract value
@ -304,7 +303,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Extract value
@ -337,7 +336,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Extract value
@ -370,7 +369,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Extract value
@ -403,7 +402,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Extract value
@ -436,7 +435,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Get the size
@ -465,7 +464,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Get the size
@ -494,7 +493,7 @@ contains
if (.not. found) then
message = "Node " // node_name // " not part of Node " // &
getNodeName(ptr) // "."
call fatal_error()
call fatal_error(message)
end if
! Get the size