crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-27 21:55:41 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 5

Merge branch 'develop' into log-energy-grid

Browse source 
Conflicts:
	src/input_xml.F90
This commit is contained in:
Paul Romano 2014-10-23 00:42:44 -04:00
commit 972fa31fe5
30 changed files with 705 additions and 998 deletions
Download patch file Download diff file Expand all files Collapse all files

8
docs/source/usersguide/input.rst
View file

@ -1096,7 +1096,7 @@ The ``<tally>`` element accepts the following sub-elements:
all of the harmonic moments of order 0 to N. N must be between 0 and 10.
:total-YN:
The total reaction rate expanded via spherical harmonics about the
The total reaction rate expanded via spherical harmonics about the
direction of motion of the neutron, :math:`\Omega`.
This score will tally all of the harmonic moments of order 0 to N. N must
be between 0 and 10.
@ -1233,7 +1233,7 @@ sub-elements:
attribute or sub-element:
:pixels:
Specifies the number of pixes or voxels to be used along each of the basis
Specifies the number of pixels or voxels to be used along each of the basis
directions for "slice" and "voxel" plots, respectively. Should be two or
three integers separated by spaces.
@ -1325,11 +1325,11 @@ attributes or sub-elements. These are not used in "voxel" plots:
boundaries. Specifying this as 0 indicates that lines will be 1 pixel
thick, specifying 1 indicates 3 pixels thick, specifying 2 indicates
5 pixels thick, etc.
:color:
Specifies the custom color for the meshlines boundaries. Should be 3
integers separated by whitespace. This element is optional.
*Default*: 0 0 0 (black)
*Default*: None

46
src/ace.F90
View file

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

15
src/cmfd_data.F90
View file

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

24
src/cmfd_execute.F90
View file

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

66
src/cmfd_input.F90
View file

@ -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 <dimension> element for a tally mesh &
&must be positive."
call fatal_error()
call fatal_error("All entries on the <dimension> 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 <lower_left> must be the same as &
&the number of entries on <dimension>."
call fatal_error()
call fatal_error("Number of entries on <lower_left> must be the same as &
&the number of entries on <dimension>.")
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 <upper_right> and <width> on a &
&tally mesh."
call fatal_error()
call fatal_error("Cannot specify both <upper_right> and <width> 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 <upper_right> and <width> on a &
&tally mesh."
call fatal_error()
call fatal_error("Must specify either <upper_right> and <width> 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 <width> must be the same as the &
&number of entries on <lower_left>."
call fatal_error()
call fatal_error("Number of entries on <width> must be the same as the &
&number of entries on <lower_left>.")
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("Cannot have a negative <width> 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 <upper_right> must be the same as &
&the number of entries on <lower_left>."
call fatal_error()
call fatal_error("Number of entries on <upper_right> must be the same &
&as the number of entries on <lower_left>.")
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 <upper_right> coordinates must be greater than the &
&<lower_left> coordinates on a tally mesh."
call fatal_error()
call fatal_error("The <upper_right> coordinates must be greater than &
&the <lower_left> coordinates on a tally mesh.")
end if
! Set upper right coordinate and width

66
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, 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

24
src/eigenvalue.F90
View file

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

3
src/energy_grid.F90
View file

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

11
src/error.F90
View file

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

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

6
src/fixed_source.F90
View file

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

78
src/geometry.F90
View file

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

5
src/global.F90
View file

@ -273,9 +273,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
@ -397,7 +394,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

86
src/initialize.F90
View file

@ -158,10 +158,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
@ -344,9 +342,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
@ -366,8 +363,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
@ -385,8 +381,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
@ -420,13 +416,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')
@ -442,8 +438,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
@ -579,9 +574,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
@ -593,9 +587,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
! =======================================================================
@ -609,9 +602,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
@ -628,15 +620,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
@ -661,9 +652,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
@ -687,9 +677,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
@ -703,9 +692,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
@ -716,9 +704,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
@ -729,9 +716,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
@ -866,8 +852,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
@ -894,8 +879,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

880
src/input_xml.F90
View file

File diff suppressed because it is too large Load diff

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

7
src/output.F90
View file

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

8
src/particle_restart.F90
View file

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

119
src/physics.F90
View file

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

4
src/plot.F90
View file

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

17
src/relaxng/plots.rnc
View file

@ -3,28 +3,29 @@ element plots {
(element id { xsd:int } | attribute id { xsd:int })? &
(element filename { xsd:string { maxLength = "50" } } |
attribute filename { xsd:string { maxLength = "50" } })? &
(element type { "slice" } | attribute type { "slice" })? &
(element type { "slice" | "voxel" } |
attribute type { "slice" | "voxel" })? &
(element color { ( "cell" | "mat" | "material" ) } |
attribute color { ( "cell" | "mat" | "material" ) })? &
(element origin { list { xsd:double+ } } |
(element origin { list { xsd:double+ } } |
attribute origin { list { xsd:double+ } })? &
(element width { list { xsd:double+ } } |
(element width { list { xsd:double+ } } |
attribute width { list { xsd:double+ } })? &
(element basis { ( "xy" | "yz" | "xz" ) } |
attribute basis { ( "xy" | "yz" | "xz" ) })? &
(element pixels { list { xsd:int+ } } |
(element pixels { list { xsd:int+ } } |
attribute pixels { list { xsd:int+ } })? &
(element background { list { xsd:int+ } } |
attribute background { list { xsd:int+ } })? &
element col_spec {
(element id { xsd:int } | attribute id { xsd:int }) &
(element rgb { list { xsd:int+ } } |
(element rgb { list { xsd:int+ } } |
attribute rgb { list { xsd:int+ } })
}* &
element mask {
(element components { list { xsd:int+ } } |
(element components { list { xsd:int+ } } |
attribute components { list { xsd:int+ } }) &
(element background { list { xsd:int+ } } |
(element background { list { xsd:int+ } } |
attribute background { list { xsd:int+ } })
}* &
element meshlines {
@ -32,7 +33,7 @@ element plots {
attribute meshtype { ( "tally" | "entropy" | "ufs" | "cmfd" ) }) &
(element id { xsd:int } | attribute id { xsd:int })? &
(element linewidth { xsd:int } | attribute linewidth { xsd:int }) &
(element color { list { xsd:int+ } } |
(element color { list { xsd:int+ } } |
attribute color { list { xsd:int+ } })?
}*
}*

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

1
src/solver_interface.F90
View file

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

30
src/source.F90
View file

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

42
src/state_point.F90
View file

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

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

48
src/tally.F90
View file

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

11
src/tracking.F90
View file

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

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

2
tests/test_trace/test_trace.py
View file

@ -23,7 +23,7 @@ def test_run():
print(stdout)
returncode = proc.returncode
assert returncode == 0, 'OpenMC did not exit successfully.'
assert stdout.find('Simulating Particle 453') != -1
assert stdout.find(b'Simulating Particle 453') != -1
def test_created_statepoint():
statepoint = glob.glob(os.path.join(cwd, 'statepoint.10.*'))