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

Removed msg variables and made 'message' global variable.

Browse source
This commit is contained in:
Paul Romano 2011-10-31 15:33:12 -04:00
parent bb4718fea5
commit 91fa0b888c
18 changed files with 333 additions and 362 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/DEPENDENCIES
View file

@ -32,6 +32,7 @@ fileio.o: string.o
fission.o: constants.o
fission.o: cross_section_header.o
fission.o: error.o
fission.o: global.o
fission.o: interpolation.o
fission.o: search.o
@ -91,6 +92,7 @@ input_xml.o: xml-fortran/templates/tallies_t.o
interpolation.o: constants.o
interpolation.o: error.o
interpolation.o: global.o
interpolation.o: search.o
logging.o: constants.o
@ -156,6 +158,7 @@ plot.o: particle_header.o
search.o: constants.o
search.o: error.o
search.o: global.o
source.o: bank_header.o
source.o: constants.o
@ -168,6 +171,7 @@ source.o: physics.o
string.o: constants.o
string.o: error.o
string.o: global.o
tally.o: constants.o
tally.o: cross_section.o

90
src/cross_section.f90
View file

@ -10,7 +10,7 @@ module cross_section
use fileio, only: read_line, read_data, skip_lines
use global
use material_header, only: Material
use output, only: message
use output, only: write_message
use string, only: split_string, str_to_int, str_to_real, &
lower_case, int_to_str
@ -40,7 +40,6 @@ contains
integer :: index_nuclides ! index in nuclides
integer :: index_sab ! index in sab_tables
character(10) :: key ! name of isotope, e.g. 92235.03c
character(MAX_LINE_LEN) :: msg ! output/error message
type(Material), pointer :: mat => null()
type(Nuclide), pointer :: nuc => null()
type(SAB_Table), pointer :: sab => null()
@ -131,9 +130,9 @@ contains
if (dict_has_key(xsdata_dict, key)) then
index = dict_get_key(xsdata_dict, key)
else
msg = "Cannot find cross-section " // trim(key) // " in specified &
&xsdata file."
call fatal_error(msg)
message = "Cannot find cross-section " // trim(key) // &
" in specified xsdata file."
call fatal_error()
end if
! Read the table and add entry to dictionary
@ -156,9 +155,9 @@ contains
! Check to make sure S(a,b) table matched a nuclide
if (mat % sab_nuclide == 0) then
msg = "S(a,b) table " // trim(mat % sab_name) // " did not match " &
message = "S(a,b) table " // trim(mat % sab_name) // " did not match " &
// "any nuclide on material " // trim(int_to_str(mat % uid))
call fatal_error(msg)
call fatal_error()
end if
end if
end do
@ -188,7 +187,6 @@ contains
logical :: file_exists ! does ACE library exist?
logical :: found_xs ! did we find table in library?
character(7) :: readable ! is ACE library readable?
character(MAX_LINE_LEN) :: msg ! output/error message
character(MAX_LINE_LEN) :: line ! single line to read
character(MAX_WORD_LEN) :: words(MAX_WORDS) ! words on a line
character(MAX_WORD_LEN) :: filename ! name of ACE library file
@ -197,11 +195,11 @@ contains
! Check to make sure index in nuclides array and xsdata arrays are valid
if (index_table > size(nuclides)) then
msg = "Index of table to read is greater than length of nuclides."
call fatal_error(msg)
message = "Index of table to read is greater than length of nuclides."
call fatal_error()
elseif (index > size(xsdatas)) then
msg = "Index of xsdata entry is greater than length of xsdatas."
call fatal_error(msg)
message = "Index of xsdata entry is greater than length of xsdatas."
call fatal_error()
end if
filename = xsdatas(index)%path
@ -212,32 +210,32 @@ contains
! Check if input file exists and is readable
inquire(FILE=filename, EXIST=file_exists, READ=readable)
if (.not. file_exists) then
msg = "ACE library '" // trim(filename) // "' does not exist!"
call fatal_error(msg)
message = "ACE library '" // trim(filename) // "' does not exist!"
call fatal_error()
elseif (readable(1:3) == 'NO') then
msg = "ACE library '" // trim(filename) // "' is not readable! &
message = "ACE library '" // trim(filename) // "' is not readable! &
&Change file permissions with chmod command."
call fatal_error(msg)
call fatal_error()
end if
! display message
msg = "Loading ACE cross section table: " // tablename
call message(msg, 6)
message = "Loading ACE cross section table: " // tablename
call write_message(6)
! open file
open(file=filename, unit=in, status='old', &
& action='read', iostat=ioError)
if (ioError /= 0) then
msg = "Error while opening file: " // filename
call fatal_error(msg)
message = "Error while opening file: " // filename
call fatal_error()
end if
found_xs = .false.
do while (.not. found_xs)
call read_line(in, line, ioError)
if (ioError < 0) then
msg = "Could not find ACE table " // tablename // "."
call fatal_error(msg)
message = "Could not find ACE table " // tablename // "."
call fatal_error()
end if
call split_string(line, words, n)
if (trim(words(1)) == trim(tablename)) then
@ -1084,7 +1082,6 @@ contains
logical :: file_exists ! does ACE library exist?
logical :: found_xs ! did we find table in library?
character(7) :: readable ! is ACE library readable?
character(MAX_LINE_LEN) :: msg ! output/error message
character(MAX_LINE_LEN) :: line ! single line to read
character(MAX_WORD_LEN) :: words(MAX_WORDS) ! words on a line
character(MAX_WORD_LEN) :: filename ! name of ACE library file
@ -1099,32 +1096,32 @@ contains
! Check if input file exists and is readable
inquire(FILE=filename, EXIST=file_exists, READ=readable)
if (.not. file_exists) then
msg = "ACE library '" // trim(filename) // "' does not exist!"
call fatal_error(msg)
message = "ACE library '" // trim(filename) // "' does not exist!"
call fatal_error()
elseif (readable(1:3) == 'NO') then
msg = "ACE library '" // trim(filename) // "' is not readable! &
message = "ACE library '" // trim(filename) // "' is not readable! &
&Change file permissions with chmod command."
call fatal_error(msg)
call fatal_error()
end if
! display message
msg = "Loading ACE cross section table: " // tablename
call message(msg, 6)
message = "Loading ACE cross section table: " // tablename
call write_message(6)
! open file
open(file=filename, unit=in, status='old', &
& action='read', iostat=ioError)
if (ioError /= 0) then
msg = "Error while opening file: " // filename
call fatal_error(msg)
message = "Error while opening file: " // filename
call fatal_error()
end if
found_xs = .false.
do while (.not. found_xs)
call read_line(in, line, ioError)
if (ioError < 0) then
msg = "Could not find ACE table " // tablename // "."
call fatal_error(msg)
message = "Could not find ACE table " // tablename // "."
call fatal_error()
end if
call split_string(line, words, n)
if (trim(words(1)) == trim(tablename)) then
@ -1396,7 +1393,6 @@ contains
type(xsData), pointer :: iso => null()
character(MAX_LINE_LEN) :: line
character(MAX_LINE_LEN) :: msg
character(MAX_WORD_LEN) :: words(MAX_WORDS)
character(MAX_WORD_LEN) :: filename
integer :: n
@ -1407,8 +1403,8 @@ contains
integer :: index
integer :: ioError
msg = "Reading cross-section summary file..."
call message(msg, 5)
message = "Reading cross-section summary file..."
call write_message(5)
! Construct filename
filename = trim(path)
@ -1416,20 +1412,20 @@ contains
! Check if xsdata exists and is readable
inquire(FILE=filename, EXIST=file_exists, READ=readable)
if (.not. file_exists) then
msg = "Cross section summary '" // trim(filename) // "' does not exist!"
call fatal_error(msg)
message = "Cross section summary '" // trim(filename) // "' does not exist!"
call fatal_error()
elseif (readable(1:3) == 'NO') then
msg = "Cross section summary '" // trim(filename) // "' is not readable!" &
& // "Change file permissions with chmod command."
call fatal_error(msg)
message = "Cross section summary '" // trim(filename) // "' is not " &
& // "readable! Change file permissions with chmod command."
call fatal_error()
end if
! open xsdata file
open(FILE=filename, UNIT=in, STATUS='old', &
& ACTION='read', IOSTAT=ioError)
if (ioError /= 0) then
msg = "Error while opening file: " // filename
call fatal_error(msg)
message = "Error while opening file: " // filename
call fatal_error()
end if
! determine how many lines
@ -1440,9 +1436,9 @@ contains
! reached end of file
exit
elseif (ioError > 0) then
msg = "Unknown error while reading file: " // filename
message = "Unknown error while reading file: " // filename
close(UNIT=in)
call fatal_error(msg)
call fatal_error()
end if
count = count + 1
end do
@ -1460,9 +1456,9 @@ contains
! Check to make sure there are enough arguments
if (n < 9) then
msg = "Not enough arguments on xsdata line: " // line
message = "Not enough arguments on xsdata line: " // line
close(UNIT=in)
call fatal_error(msg)
call fatal_error()
end if
iso => xsdatas(index)

7
src/energy_grid.f90
View file

@ -4,7 +4,7 @@ module energy_grid
use datatypes, only: list_insert, list_size, list_delete
use datatypes_header, only: ListReal
use global
use output, only: message
use output, only: write_message
contains
@ -23,10 +23,9 @@ contains
type(Material), pointer :: mat => null()
type(Nuclide), pointer :: nuc => null()
integer :: i, j
character(MAX_LINE_LEN) :: msg
msg = "Creating unionized energy grid..."
call message(msg, 5)
message = "Creating unionized energy grid..."
call write_message(5)
! loop over all materials
do i = 1, n_materials

22
src/error.f90
View file

@ -2,7 +2,7 @@ module error
use ISO_FORTRAN_ENV
use global, only: master, free_memory
use global, only: master, free_memory, message
implicit none
@ -17,9 +17,7 @@ contains
! stream.
!===============================================================================
subroutine warning(msg)
character(*), intent(in) :: msg
subroutine warning()
integer :: n_lines
integer :: i
@ -29,12 +27,12 @@ contains
write(ou, fmt='(1X,A9)', advance='no') 'WARNING: '
n_lines = (len_trim(msg)-1)/70 + 1
n_lines = (len_trim(message)-1)/70 + 1
do i = 1, n_lines
if (i == 1) then
write(ou, fmt='(A70)') msg(70*(i-1)+1:70*i)
write(ou, fmt='(A70)') message(70*(i-1)+1:70*i)
else
write(ou, fmt='(10X,A70)') msg(70*(i-1)+1:70*i)
write(ou, fmt='(10X,A70)') message(70*(i-1)+1:70*i)
end if
end do
@ -46,9 +44,7 @@ contains
! the program is aborted.
!===============================================================================
subroutine fatal_error(msg)
character(*), intent(in) :: msg
subroutine fatal_error()
integer :: n_lines
integer :: i
@ -57,12 +53,12 @@ contains
if (master) then
write(eu, fmt='(1X,A7)', advance='no') 'ERROR: '
n_lines = (len_trim(msg)-1)/72 + 1
n_lines = (len_trim(message)-1)/72 + 1
do i = 1, n_lines
if (i == 1) then
write(eu, fmt='(A72)') msg(72*(i-1)+1:72*i)
write(eu, fmt='(A72)') message(72*(i-1)+1:72*i)
else
write(eu, fmt='(7X,A72)') msg(72*(i-1)+1:72*i)
write(eu, fmt='(7X,A72)') message(72*(i-1)+1:72*i)
end if
end do
write(eu,*)

6
src/fission.f90
View file

@ -3,6 +3,7 @@ module fission
use constants
use cross_section_header, only: Nuclide
use error, only: fatal_error
use global, only: message
use interpolation, only: interpolate_tab1
use search, only: binary_search
@ -24,11 +25,10 @@ contains
integer :: i ! loop index
integer :: NC ! number of polynomial coefficients
real(8) :: c ! polynomial coefficient
character(MAX_LINE_LEN) :: msg ! error message
if (nuc % nu_t_type == NU_NONE) then
msg = "No neutron emission data for table: " // nuc % name
call fatal_error(msg)
message = "No neutron emission data for table: " // nuc % name
call fatal_error()
elseif (nuc % nu_t_type == NU_POLYNOMIAL) then
! determine number of coefficients
NC = int(nuc % nu_t_data(1))

81
src/geometry.f90
View file

@ -5,7 +5,7 @@ module geometry
use error, only: fatal_error
use geometry_header, only: Cell, Surface, Universe, Lattice
use global
use output, only: message
use output, only: write_message
use particle_header, only: Particle
use string, only: int_to_str
@ -95,7 +95,6 @@ contains
type(Particle), pointer :: p ! pointer to particle
logical, intent(inout) :: found ! particle found?
character(MAX_LINE_LEN) :: msg ! error message
integer :: i ! index over cells
integer :: x, y
type(Cell), pointer :: c ! pointer to cell
@ -127,8 +126,8 @@ contains
if (found) then
exit
else
msg = "Could not locate particle in universe: "
call fatal_error(msg)
message = "Could not locate particle in universe: "
call fatal_error()
end if
elseif (c % type == CELL_LATTICE) then
! Set current lattice
@ -153,9 +152,9 @@ contains
if (found) then
exit
else
msg = "Could not locate particle in lattice: " &
message = "Could not locate particle in lattice: " &
& // int_to_str(lat % uid)
call fatal_error(msg)
call fatal_error()
end if
end if
end if
@ -191,7 +190,6 @@ contains
real(8) :: dot_prod ! dot product of direction and normal
real(8) :: norm ! "norm" of surface normal
logical :: found ! particle found in universe?
character(MAX_LINE_LEN) :: msg ! output/error message?
type(Surface), pointer :: surf => null()
type(Cell), pointer :: c => null()
type(Lattice), pointer :: lat => null()
@ -199,8 +197,8 @@ contains
surf => surfaces(abs(p % surface))
if (verbosity >= 10) then
msg = " Crossing surface " // trim(int_to_str(surf % uid))
call message(msg)
message = " Crossing surface " // trim(int_to_str(surf % uid))
call write_message()
end if
if (surf % bc == BC_VACUUM .and. (.not. plotting)) then
@ -209,8 +207,8 @@ contains
p % alive = .false.
if (verbosity >= 10) then
msg = " Leaked out of surface " // trim(int_to_str(surf % uid))
call message(msg)
message = " Leaked out of surface " // trim(int_to_str(surf % uid))
call write_message()
end if
return
@ -301,9 +299,9 @@ contains
! Set vector
p % uvw = (/ u, v, w /)
case default
msg = "Reflection not supported for surface " // &
message = "Reflection not supported for surface " // &
trim(int_to_str(surf % uid))
call fatal_error(msg)
call fatal_error()
end select
! Reassign particle's cell and surface
@ -312,8 +310,8 @@ contains
! Diagnostic message
if (verbosity >= 10) then
msg = " Reflected from surface " // trim(int_to_str(surf%uid))
call message(msg)
message = " Reflected from surface " // trim(int_to_str(surf%uid))
call write_message()
end if
return
end if
@ -332,8 +330,8 @@ contains
lower_univ => universes(c % fill)
call find_cell(lower_univ, p, found)
if (.not. found) then
msg = "Could not locate particle in universe: "
call fatal_error(msg)
message = "Could not locate particle in universe: "
call fatal_error()
end if
elseif (c % type == CELL_LATTICE) then
! Set current lattice
@ -356,9 +354,9 @@ contains
call find_cell(lower_univ, p, found)
if (.not. found) then
msg = "Could not locate particle in lattice: " &
& // int_to_str(lat % uid)
call fatal_error(msg)
message = "Could not locate particle in lattice: " // &
trim(int_to_str(lat % uid))
call fatal_error()
end if
else
! set current pointers
@ -379,8 +377,8 @@ contains
lower_univ => universes(c % fill)
call find_cell(lower_univ, p, found)
if (.not. found) then
msg = "Could not locate particle in universe: "
call fatal_error(msg)
message = "Could not locate particle in universe: "
call fatal_error()
end if
elseif (c % type == CELL_LATTICE) then
! Set current lattice
@ -403,9 +401,9 @@ contains
call find_cell(lower_univ, p, found)
if (.not. found) then
msg = "Could not locate particle in lattice: " &
& // int_to_str(lat % uid)
call fatal_error(msg)
message = "Could not locate particle in lattice: " // &
trim(int_to_str(lat % uid))
call fatal_error()
end if
else
! set current pointers
@ -430,9 +428,9 @@ contains
end do
! Couldn't find next cell anywhere!
msg = "After particle crossed surface " // trim(int_to_str(p%surface)) // &
& ", it could not be located in any cell and it did not leak."
call fatal_error(msg)
message = "After particle crossed surface " // trim(int_to_str(p%surface)) &
// ", it could not be located in any cell and it did not leak."
call fatal_error()
end subroutine cross_surface
@ -459,13 +457,12 @@ contains
real(8) :: x0 ! half the width of lattice element
real(8) :: y0 ! half the height of lattice element
logical :: found ! particle found in cell?
character(MAX_LINE_LEN) :: msg ! output/error message
type(Lattice), pointer :: lat
type(Universe), pointer :: univ
if (verbosity >= 10) then
msg = " Crossing lattice"
call message(msg)
message = " Crossing lattice"
call write_message()
end if
lat => lattices(p % lattice)
@ -530,11 +527,11 @@ contains
i_x = p % index_x
i_y = p % index_y
if (i_x < 1 .or. i_x > lat % n_x) then
msg = "Reached edge of lattice."
call fatal_error(msg)
message = "Reached edge of lattice."
call fatal_error()
elseif (i_y < 1 .or. i_y > lat % n_y) then
msg = "Reached edge of lattice."
call fatal_error(msg)
message = "Reached edge of lattice."
call fatal_error()
end if
! Find universe for next lattice element
@ -543,8 +540,8 @@ contains
! Find cell in next lattice element
call find_cell(univ, p, found)
if (.not. found) then
msg = "Could not locate particle in universe: "
call fatal_error(msg)
message = "Could not locate particle in universe: "
call fatal_error()
end if
end subroutine cross_lattice
@ -578,7 +575,6 @@ contains
real(8) :: a,b,c,k ! quadratic equation coefficients
real(8) :: quad ! discriminant of quadratic equation
logical :: on_surface ! is particle on surface?
character(MAX_LINE_LEN) :: msg ! output/error message
type(Cell), pointer :: cell_p => null()
type(Cell), pointer :: parent_p => null()
type(Surface), pointer :: surf_p => null()
@ -882,8 +878,8 @@ contains
end if
case (SURF_GQ)
msg = "Surface distance not yet implement for general quadratic."
call fatal_error(msg)
message = "Surface distance not yet implement for general quadratic."
call fatal_error()
end select
@ -1114,12 +1110,11 @@ contains
integer, allocatable :: count_positive(:) ! # of cells on positive side
integer, allocatable :: count_negative(:) ! # of cells on negative side
logical :: positive ! positive side specified in surface list
character(MAX_LINE_LEN) :: msg ! output/error message
type(Cell), pointer :: c
type(Surface), pointer :: surf
msg = "Building neighboring cells lists for each surface..."
call message(msg, 4)
message = "Building neighboring cells lists for each surface..."
call write_message(4)
allocate(count_positive(n_surfaces))
allocate(count_negative(n_surfaces))

7
src/global.f90
View file

@ -146,8 +146,11 @@ module global
! ============================================================================
! MISCELLANEOUS VARIABLES
character(MAX_WORD_LEN) :: path_input
character(MAX_WORD_LEN) :: path_xsdata
character(MAX_WORD_LEN) :: path_input ! Path to input file
character(MAX_WORD_LEN) :: path_xsdata ! Path to xsdata file
! Message used in message/warning/fatal_error
character(MAX_LINE_LEN) :: message
! Problem type
integer :: problem_type = PROB_CRITICALITY

62
src/initialize.f90
View file

@ -271,7 +271,6 @@ contains
integer :: k
integer :: index ! index in surfaces/materials array
integer :: uid ! user-specified uid
character(MAX_LINE_LEN) :: msg ! output/error message
type(Cell), pointer :: c => null()
type(Lattice), pointer :: l => null()
type(TallyObject), pointer :: t => null()
@ -288,9 +287,9 @@ contains
index = dict_get_key(surface_dict, abs(uid))
c % surfaces(j) = sign(index, uid)
else
msg = "Could not find surface " // trim(int_to_str(abs(uid))) // &
message = "Could not find surface " // trim(int_to_str(abs(uid))) // &
& " specified on cell " // trim(int_to_str(c % uid))
call fatal_error(msg)
call fatal_error()
end if
end if
end do
@ -302,9 +301,9 @@ contains
if (dict_has_key(universe_dict, uid)) then
c % universe = dict_get_key(universe_dict, uid)
else
msg = "Could not find universe " // trim(int_to_str(uid)) // &
message = "Could not find universe " // trim(int_to_str(uid)) // &
" specified on cell " // trim(int_to_str(c % uid))
call fatal_error(msg)
call fatal_error()
end if
! =======================================================================
@ -316,9 +315,9 @@ contains
c % type = CELL_NORMAL
c % material = dict_get_key(material_dict, uid)
else
msg = "Could not find material " // trim(int_to_str(uid)) // &
message = "Could not find material " // trim(int_to_str(uid)) // &
" specified on cell " // trim(int_to_str(c % uid))
call fatal_error(msg)
call fatal_error()
end if
else
uid = c % fill
@ -329,9 +328,9 @@ contains
c % type = CELL_LATTICE
c % fill = dict_get_key(lattice_dict, uid)
else
msg = "Specified fill " // trim(int_to_str(uid)) // " on cell " // &
message = "Specified fill " // trim(int_to_str(uid)) // " on cell " // &
trim(int_to_str(c % uid)) // " is neither a universe nor a lattice."
call fatal_error(msg)
call fatal_error()
end if
end if
end do
@ -347,9 +346,9 @@ contains
if (dict_has_key(universe_dict, uid)) then
l % element(j,k) = dict_get_key(universe_dict, uid)
else
msg = "Invalid universe number " // trim(int_to_str(uid)) &
message = "Invalid universe number " // trim(int_to_str(uid)) &
// " specified on lattice " // trim(int_to_str(l % uid))
call fatal_error(msg)
call fatal_error()
end if
end do
end do
@ -367,9 +366,9 @@ contains
if (dict_has_key(cell_dict, uid)) then
t % cell_bins(j) % scalar = dict_get_key(cell_dict, uid)
else
msg = "Could not find cell " // trim(int_to_str(uid)) // &
message = "Could not find cell " // trim(int_to_str(uid)) // &
& " specified on tally " // trim(int_to_str(t % uid))
call fatal_error(msg)
call fatal_error()
end if
end do
end if
@ -383,9 +382,9 @@ contains
if (dict_has_key(surface_dict, uid)) then
t % surface_bins(j) % scalar = dict_get_key(surface_dict, uid)
else
msg = "Could not find surface " // trim(int_to_str(uid)) // &
message = "Could not find surface " // trim(int_to_str(uid)) // &
& " specified on tally " // trim(int_to_str(t % uid))
call fatal_error(msg)
call fatal_error()
end if
end do
end if
@ -399,9 +398,9 @@ contains
if (dict_has_key(universe_dict, uid)) then
t % universe_bins(j) % scalar = dict_get_key(universe_dict, uid)
else
msg = "Could not find universe " // trim(int_to_str(uid)) // &
message = "Could not find universe " // trim(int_to_str(uid)) // &
& " specified on tally " // trim(int_to_str(t % uid))
call fatal_error(msg)
call fatal_error()
end if
end do
end if
@ -415,9 +414,9 @@ contains
if (dict_has_key(material_dict, uid)) then
t % material_bins(j) % scalar = dict_get_key(material_dict, uid)
else
msg = "Could not find material " // trim(int_to_str(uid)) // &
message = "Could not find material " // trim(int_to_str(uid)) // &
& " specified on tally " // trim(int_to_str(t % uid))
call fatal_error(msg)
call fatal_error()
end if
end do
end if
@ -431,9 +430,9 @@ contains
if (dict_has_key(cell_dict, uid)) then
t % cellborn_bins(j) % scalar = dict_get_key(cell_dict, uid)
else
msg = "Could not find material " // trim(int_to_str(uid)) // &
message = "Could not find material " // trim(int_to_str(uid)) // &
& " specified on tally " // trim(int_to_str(t % uid))
call fatal_error(msg)
call fatal_error()
end if
end do
end if
@ -446,9 +445,9 @@ contains
if (dict_has_key(mesh_dict, uid)) then
t % mesh = dict_get_key(mesh_dict, uid)
else
msg = "Could not find mesh " // trim(int_to_str(uid)) // &
message = "Could not find mesh " // trim(int_to_str(uid)) // &
& " specified on tally " // trim(int_to_str(t % uid))
call fatal_error(msg)
call fatal_error()
end if
end if
end do
@ -531,7 +530,6 @@ contains
logical :: percent_in_atom ! nuclides specified in atom percent?
logical :: density_in_atom ! density specified in atom/b-cm?
character(10) :: key ! name of nuclide, e.g. 92235.03c
character(MAX_LINE_LEN) :: msg ! output/error message
type(Material), pointer :: mat => null()
! first find the index in the xsdata array for each nuclide in each material
@ -542,9 +540,9 @@ contains
! given
if (.not. (all(mat%atom_percent > ZERO) .or. &
& all(mat%atom_percent < ZERO))) then
msg = "Cannot mix atom and weight percents in material " // &
message = "Cannot mix atom and weight percents in material " // &
& int_to_str(mat%uid)
call fatal_error(msg)
call fatal_error()
end if
percent_in_atom = (mat%atom_percent(1) > ZERO)
@ -558,18 +556,18 @@ contains
! Check to make sure cross-section is continuous energy neutron table
n = len_trim(key)
if (key(n:n) /= 'c') then
msg = "Cross-section table " // trim(key) // " is not a " // &
"continuous-energy neutron table."
call fatal_error(msg)
message = "Cross-section table " // trim(key) // &
" is not a continuous-energy neutron table."
call fatal_error()
end if
if (dict_has_key(xsdata_dict, key)) then
index = dict_get_key(xsdata_dict, key)
mat % xsdata(j) = index
else
msg = "Cannot find cross-section " // trim(key) // " in specified &
&xsdata file."
call fatal_error(msg)
message = "Cannot find cross-section " // trim(key) // &
" in specified xsdata file."
call fatal_error()
end if
! determine atomic weight ratio

192
src/input_xml.f90
View file

@ -7,7 +7,7 @@ module input_xml
use geometry_header, only: Cell, Surface, Lattice
use global
use mesh_header, only: StructuredMesh
use output, only: message
use output, only: write_message
use string, only: lower_case, int_to_str, str_to_int, str_to_real, &
split_string
use tally_header, only: TallyObject
@ -47,19 +47,18 @@ contains
integer :: coeffs_reqd
logical :: file_exists
character(MAX_WORD_LEN) :: type
character(MAX_LINE_LEN) :: msg
character(MAX_LINE_LEN) :: filename
! Display output message
msg = "Reading settings XML file..."
call message(msg, 5)
message = "Reading settings XML file..."
call write_message(5)
! Check if settings.xml exists
filename = trim(path_input) // "settings.xml"
inquire(FILE=filename, EXIST=file_exists)
if (.not. file_exists) then
msg = "Settings XML file '" // trim(filename) // "' does not exist!"
call fatal_error(msg)
message = "Settings XML file '" // trim(filename) // "' does not exist!"
call fatal_error()
end if
! Parse settings.xml file
@ -88,19 +87,18 @@ contains
external_source % type = SRC_BOX
coeffs_reqd = 6
case default
msg = "Invalid source type: " // trim(source_ % type)
call fatal_error(msg)
message = "Invalid source type: " // trim(source_ % type)
call fatal_error()
end select
! Coefficients for external surface
n = size(source_ % coeffs)
if (n < coeffs_reqd) then
msg = "Not enough coefficients specified for external source."
print *, n, coeffs_reqd
call fatal_error(msg)
message = "Not enough coefficients specified for external source."
call fatal_error()
elseif (n > coeffs_reqd) then
msg = "Too many coefficients specified for external source."
call fatal_error(msg)
message = "Too many coefficients specified for external source."
call fatal_error()
else
allocate(external_source % values(n))
external_source % values = source_ % coeffs
@ -135,15 +133,14 @@ contains
integer :: coeffs_reqd
logical :: file_exists
character(MAX_LINE_LEN) :: filename
character(MAX_LINE_LEN) :: msg
character(MAX_WORD_LEN) :: word
type(Cell), pointer :: c => null()
type(Surface), pointer :: s => null()
type(Lattice), pointer :: l => null()
! Display output message
msg = "Reading geometry XML file..."
call message(msg, 5)
message = "Reading geometry XML file..."
call write_message(5)
! ==========================================================================
! READ CELLS FROM GEOMETRY.XML
@ -152,8 +149,8 @@ contains
filename = trim(path_input) // "geometry.xml"
inquire(FILE=filename, EXIST=file_exists)
if (.not. file_exists) then
msg = "Geometry XML file '" // trim(filename) // "' does not exist!"
call fatal_error(msg)
message = "Geometry XML file '" // trim(filename) // "' does not exist!"
call fatal_error()
end if
! Parse geometry.xml file
@ -175,22 +172,23 @@ contains
! Check to make sure that either material or fill was specified
if (c % material == 0 .and. c % fill == 0) then
msg = "Neither material nor fill was specified for cell " // &
message = "Neither material nor fill was specified for cell " // &
trim(int_to_str(c % uid))
call fatal_error(msg)
call fatal_error()
end if
! Check to make sure that both material and fill haven't been
! specified simultaneously
if (c % material /= 0 .and. c % fill /= 0) then
msg = "Cannot specify material and fill simultaneously"
call fatal_error(msg)
message = "Cannot specify material and fill simultaneously"
call fatal_error()
end if
! Check to make sure that surfaces were specified
if (.not. associated(cell_(i) % surfaces)) then
msg = "No surfaces specified for cell " // trim(int_to_str(c % uid))
call fatal_error(msg)
message = "No surfaces specified for cell " // &
trim(int_to_str(c % uid))
call fatal_error()
end if
! Allocate array for surfaces and copy
@ -274,8 +272,8 @@ contains
s % type = SURF_GQ
coeffs_reqd = 10
case default
msg = "Invalid surface type: " // trim(surface_(i) % type)
call fatal_error(msg)
message = "Invalid surface type: " // trim(surface_(i) % type)
call fatal_error()
end select
! Check to make sure that the proper number of coefficients
@ -284,14 +282,14 @@ contains
n = size(surface_(i) % coeffs)
if (n < coeffs_reqd) then
msg = "Not enough coefficients specified for surface: " // &
message = "Not enough coefficients specified for surface: " // &
trim(int_to_str(s % uid))
print *, n, coeffs_reqd
call fatal_error(msg)
call fatal_error()
elseif (n > coeffs_reqd) then
msg = "Too many coefficients specified for surface: " // &
message = "Too many coefficients specified for surface: " // &
trim(int_to_str(s % uid))
call fatal_error(msg)
call fatal_error()
else
allocate(s % coeffs(n))
s % coeffs = surface_(i) % coeffs
@ -310,9 +308,9 @@ contains
case ('periodic')
s % bc = BC_PERIODIC
case default
msg = "Unknown boundary condition '" // trim(word) // &
message = "Unknown boundary condition '" // trim(word) // &
"' specified on surface " // trim(int_to_str(s % uid))
call fatal_error(msg)
call fatal_error()
end select
! Add surface to dictionary
@ -342,15 +340,15 @@ contains
case ('hex', 'hexagon', 'hexagonal')
l % type = LATTICE_HEX
case default
msg = "Invalid lattice type: " // trim(lattice_(i) % type)
call fatal_error(msg)
message = "Invalid lattice type: " // trim(lattice_(i) % type)
call fatal_error()
end select
! Read number of lattice cells in each dimension
n = size(lattice_(i) % dimension)
if (n /= 2 .and. n /= 3) then
msg = "Lattice must be two or three dimensions."
call fatal_error(msg)
message = "Lattice must be two or three dimensions."
call fatal_error()
end if
n_x = lattice_(i) % dimension(1)
n_y = lattice_(i) % dimension(2)
@ -359,18 +357,18 @@ contains
! Read lattice origin location
if (size(lattice_(i) % dimension) /= size(lattice_(i) % origin)) then
msg = "Number of entries on <origin> must be the same as the " // &
"number of entries on <dimension>."
call fatal_error(msg)
message = "Number of entries on <origin> must be the same as " // &
"the number of entries on <dimension>."
call fatal_error()
end if
l % x0 = lattice_(i) % origin(1)
l % y0 = lattice_(i) % origin(2)
! Read lattice widths
if (size(lattice_(i) % width) /= size(lattice_(i) % origin)) then
msg = "Number of entries on <width> must be the same as the " // &
"number of entries on <origin>."
call fatal_error(msg)
message = "Number of entries on <width> must be the same as " // &
"the number of entries on <origin>."
call fatal_error()
end if
l % width_x = lattice_(i) % width(1)
l % width_y = lattice_(i) % width(2)
@ -406,21 +404,20 @@ contains
character(MAX_WORD_LEN) :: units
character(MAX_WORD_LEN) :: name
character(MAX_LINE_LEN) :: filename
character(MAX_LINE_LEN) :: msg
type(Material), pointer :: m => null()
type(nuclide_xml), pointer :: nuc => null()
type(sab_xml), pointer :: sab => null()
! Display output message
msg = "Reading materials XML file..."
call message(msg, 5)
message = "Reading materials XML file..."
call write_message(5)
! Check is materials.xml exists
filename = trim(path_input) // "materials.xml"
inquire(FILE=filename, EXIST=file_exists)
if (.not. file_exists) then
msg = "Material XML file '" // trim(filename) // "' does not exist!"
call fatal_error(msg)
message = "Material XML file '" // trim(filename) // "' does not exist!"
call fatal_error()
end if
! Parse materials.xml file
@ -452,15 +449,16 @@ contains
case ('atom/cm3', 'atom/cc')
m % density = 1.0e-24 * val
case default
msg = "Unkwown units '" // trim(material_(i) % density % units) // &
"' specified on material " // trim(int_to_str(m % uid))
call fatal_error(msg)
message = "Unkwown units '" // trim(material_(i) % density % units) &
// "' specified on material " // trim(int_to_str(m % uid))
call fatal_error()
end select
! Check to ensure material has at least one nuclide
if (.not. associated(material_(i) % nuclides)) then
msg = "No nuclides specified on material " // trim(int_to_str(m % uid))
call fatal_error(msg)
message = "No nuclides specified on material " // &
trim(int_to_str(m % uid))
call fatal_error()
end if
! allocate arrays in Material object
@ -481,13 +479,13 @@ contains
! Check if no atom/weight percents were specified or if both atom and
! weight percents were specified
if (nuc % ao == ZERO .and. nuc % wo == ZERO) then
msg = "No atom or weight percent specified for nuclide " // &
message = "No atom or weight percent specified for nuclide " // &
trim(name)
call fatal_error(msg)
call fatal_error()
elseif (nuc % ao /= ZERO .and. nuc % wo /= ZERO) then
msg = "Cannot specify both atom and weight percents for a nuclide: " &
// trim(name)
call fatal_error(msg)
message = "Cannot specify both atom and weight percents for a " &
// "nuclide: " // trim(name)
call fatal_error()
end if
! Copy atom/weight percents
@ -504,8 +502,8 @@ contains
m % sab_name = name
m % has_sab_table = .true.
elseif (size(material_(i) % sab) > 1) then
msg = "Cannot have multiple S(a,b) tables on a single material."
call fatal_error(msg)
message = "Cannot have multiple S(a,b) tables on a single material."
call fatal_error()
end if
end do
@ -533,7 +531,6 @@ contains
integer :: n_words ! number of words read
logical :: file_exists ! does tallies.xml file exist?
character(MAX_LINE_LEN) :: filename
character(MAX_LINE_LEN) :: msg
character(MAX_WORD_LEN) :: word
character(MAX_WORD_LEN) :: words(MAX_WORDS)
type(TallyObject), pointer :: t => null()
@ -549,8 +546,8 @@ contains
end if
! Display output message
msg = "Reading tallies XML file..."
call message(msg, 5)
message = "Reading tallies XML file..."
call write_message(5)
! Parse tallies.xml file
call read_xml_file_tallies_t(filename)
@ -569,8 +566,8 @@ contains
! Allocate tallies array
if (.not. associated(tally_)) then
n_tallies = 0
msg = "No tallies present in tallies.xml file!"
call warning(msg)
message = "No tallies present in tallies.xml file!"
call warning()
else
n_tallies = size(tally_)
allocate(tallies(n_tallies))
@ -594,15 +591,15 @@ contains
case ('hex', 'hexagon', 'hexagonal')
m % type = LATTICE_HEX
case default
msg = "Invalid mesh type: " // trim(mesh_(i) % type)
call fatal_error(msg)
message = "Invalid mesh type: " // trim(mesh_(i) % type)
call fatal_error()
end select
! Determine number of dimensions for mesh
n = size(mesh_(i) % dimension)
if (n /= 2 .and. n /= 3) then
msg = "Mesh must be two or three dimensions."
call fatal_error(msg)
message = "Mesh must be two or three dimensions."
call fatal_error()
end if
m % n_dimension = n
@ -616,17 +613,17 @@ contains
! Read mesh origin location
if (m % n_dimension /= size(mesh_(i) % origin)) then
msg = "Number of entries on <origin> must be the same as the " // &
"number of entries on <dimension>."
call fatal_error(msg)
message = "Number of entries on <origin> must be the same as " // &
"the number of entries on <dimension>."
call fatal_error()
end if
m % origin = mesh_(i) % origin
! Read mesh widths
if (size(mesh_(i) % width) /= size(mesh_(i) % origin)) then
msg = "Number of entries on <width> must be the same as the " // &
"number of entries on <origin>."
call fatal_error(msg)
message = "Number of entries on <width> must be the same as " // &
"the number of entries on <origin>."
call fatal_error()
end if
m % width = mesh_(i) % width
@ -654,9 +651,9 @@ contains
! Check to make sure that both cells and surfaces were not specified
if (len_trim(tally_(i) % filters % cell) > 0 .and. &
len_trim(tally_(i) % filters % surface) > 0) then
msg = "Cannot specify both cell and surface filters for tally " &
message = "Cannot specify both cell and surface filters for tally " &
// trim(int_to_str(t % uid))
call fatal_error(msg)
call fatal_error()
end if
! TODO: Parse logical expressions instead of just each word
@ -710,9 +707,9 @@ contains
index = dict_get_key(mesh_dict, uid)
m => meshes(index)
else
msg = "Could not find mesh " // trim(int_to_str(uid)) // &
message = "Could not find mesh " // trim(int_to_str(uid)) // &
" specified on tally " // trim(int_to_str(t % uid))
call fatal_error(msg)
call fatal_error()
end if
t % n_bins(T_MESH) = t % n_bins(T_MESH) + product(m % dimension)
@ -759,15 +756,15 @@ contains
case ('flux')
t % macro_bins(j) % scalar = MACRO_FLUX
if (t % n_bins(T_ENERGYOUT) > 0) then
msg = "Cannot tally flux with an outgoing energy filter."
call fatal_error(msg)
message = "Cannot tally flux with an outgoing energy filter."
call fatal_error()
end if
case ('total')
t % macro_bins(j) % scalar = MACRO_TOTAL
if (t % n_bins(T_ENERGYOUT) > 0) then
msg = "Cannot tally total reaction rate with an outgoing " &
// "energy filter."
call fatal_error(msg)
message = "Cannot tally total reaction rate with an " &
// "outgoing energy filter."
call fatal_error()
end if
case ('scatter')
t % macro_bins(j) % scalar = MACRO_SCATTER
@ -790,16 +787,16 @@ contains
case ('absorption')
t % macro_bins(j) % scalar = MACRO_ABSORPTION
if (t % n_bins(T_ENERGYOUT) > 0) then
msg = "Cannot tally absorption rate with an outgoing " &
message = "Cannot tally absorption rate with an outgoing " &
// "energy filter."
call fatal_error(msg)
call fatal_error()
end if
case ('fission')
t % macro_bins(j) % scalar = MACRO_FISSION
if (t % n_bins(T_ENERGYOUT) > 0) then
msg = "Cannot tally fission rate with an outgoing " &
message = "Cannot tally fission rate with an outgoing " &
// "energy filter."
call fatal_error(msg)
call fatal_error()
end if
case ('nu-fission')
t % macro_bins(j) % scalar = MACRO_NU_FISSION
@ -810,17 +807,17 @@ contains
! Check to make sure that current is the only desired response
! for this tally
if (n_words > 1) then
msg = "Cannot tally other macro reactions in the same " &
message = "Cannot tally other macro reactions in the same " &
// "tally as surface currents. Separate other macro " &
// "reactions into a distinct tally."
call fatal_error(msg)
call fatal_error()
end if
! Check to make sure that only the mesh filter was specified
if (t % mesh == 0 .or. t % n_bins(T_MESH) /= &
product(t % n_bins, t % n_bins > 0)) then
msg = "Surface currents must be used with a mesh filter only."
call fatal_error(msg)
message = "Surface currents must be used with a mesh filter only."
call fatal_error()
end if
! Since the number of bins for the mesh filter was already set
@ -844,8 +841,8 @@ contains
end if
case default
msg = "Unknown macro reaction: " // trim(words(j))
call fatal_error(msg)
message = "Unknown macro reaction: " // trim(words(j))
call fatal_error()
end select
end do
t % n_macro_bins = n_words
@ -866,19 +863,18 @@ contains
logical :: file_exists ! does tallies.xml file exist?
character(MAX_LINE_LEN) :: filename
character(MAX_LINE_LEN) :: msg
! Check if plot.xml exists
filename = trim(path_input) // "plot.xml"
inquire(FILE=filename, EXIST=file_exists)
if (.not. file_exists) then
msg = "Plot XML file '" // trim(filename) // "' does not exist!"
call fatal_error(msg)
message = "Plot XML file '" // trim(filename) // "' does not exist!"
call fatal_error()
end if
! Display output message
msg = "Reading plot XML file..."
call message(msg, 5)
message = "Reading plot XML file..."
call write_message(5)
! Parse plot.xml file
call read_xml_file_plot_t(filename)

6
src/interpolation.f90
View file

@ -2,6 +2,7 @@ module interpolation
use constants
use error, only: fatal_error
use global, only: message
use search, only: binary_search
implicit none
@ -34,7 +35,6 @@ contains
real(8) :: r ! interpolation factor
real(8) :: x0, x1 ! bounding x values
real(8) :: y0, y1 ! bounding y values
character(MAX_LINE_LEN) :: msg
! determine starting location
if (present(loc_start)) then
@ -76,8 +76,8 @@ contains
elseif (n_regions == 1) then
interp = data(loc_interp + 1)
elseif (n_regions > 1) then
msg = "Multiple interpolation regions not yet supported."
call fatal_error(msg)
message = "Multiple interpolation regions not yet supported."
call fatal_error()
end if
! handle special case of histogram interpolation

4
src/main.f90
View file

@ -5,7 +5,7 @@ program main
use initialize, only: initialize_run
use mcnp_random, only: RN_init_particle
use mpi_routines, only: synchronize_bank
use output, only: message, header, print_runtime
use output, only: write_message, header, print_runtime
use particle_header, only: Particle
use plot, only: run_plot
use physics, only: transport
@ -70,7 +70,7 @@ contains
call timer_start(time_compute)
msg = "Simulating cycle " // trim(int_to_str(i_cycle)) // "..."
call message(msg, 8)
call write_message(8)
! Set all tallies to zero
n_bank = 0

36
src/mpi_routines.f90
View file

@ -4,7 +4,7 @@ module mpi_routines
use error, only: fatal_error
use global
use mcnp_random, only: rang, RN_init_particle, RN_skip
use output, only: message
use output, only: write_message
use particle_header, only: Particle, initialize_particle
use tally_header, only: TallyObject
@ -35,7 +35,6 @@ contains
integer :: bank_types(4) ! Datatypes
integer(MPI_ADDRESS_KIND) :: bank_disp(4) ! Displacements
integer(MPI_ADDRESS_KIND) :: base
character(MAX_LINE_LEN) :: msg ! Error message
type(Bank) :: b
mpi_enabled = .true.
@ -43,22 +42,22 @@ contains
! Initialize MPI
call MPI_INIT(ierr)
if (ierr /= MPI_SUCCESS) then
msg = "Failed to initialize MPI."
call fatal_error(msg)
message = "Failed to initialize MPI."
call fatal_error()
end if
! Determine number of processors
call MPI_COMM_SIZE(MPI_COMM_WORLD, n_procs, ierr)
if (ierr /= MPI_SUCCESS) then
msg = "Could not determine number of processors."
call fatal_error(msg)
message = "Could not determine number of processors."
call fatal_error()
end if
! Determine rank of each processor
call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
if (ierr /= MPI_SUCCESS) then
msg = "Could not determine MPI rank."
call fatal_error(msg)
message = "Could not determine MPI rank."
call fatal_error()
end if
! Determine master
@ -122,7 +121,6 @@ contains
& temp_sites(:), & ! local array of extra sites on each node
& left_bank(:), & ! bank sites to send/recv to or from left node
& right_bank(:) ! bank sites to send/recv to or fram right node
character(MAX_LINE_LEN) :: msg
#ifdef MPI
integer :: ierr
@ -133,8 +131,8 @@ contains
real(8) :: t0, t1, t2, t3, t4
#endif
msg = "Collecting number of fission sites..."
call message(msg, 8)
message = "Collecting number of fission sites..."
call write_message(8)
#ifdef MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
@ -159,8 +157,8 @@ contains
! Check if there are no fission sites
if (total == 0) then
msg = "No fission sites banked!"
call fatal_error(msg)
message = "No fission sites banked!"
call fatal_error()
end if
! Make sure all processors start at the same point for random sampling
@ -180,8 +178,8 @@ contains
end if
p_sample = real(sites_needed,8)/real(total,8)
msg = "Sampling fission sites..."
call message(msg, 8)
message = "Sampling fission sites..."
call write_message(8)
! ==========================================================================
! SAMPLE N_PARTICLES FROM FISSION BANK AND PLACE IN TEMP_SITES
@ -252,8 +250,8 @@ contains
t2 = MPI_WTIME()
t_sync(2) = t_sync(2) + (t2 - t1)
msg = "Sending fission sites..."
call message(msg, 8)
message = "Sending fission sites..."
call write_message(8)
! ==========================================================================
! SEND BANK SITES TO NEIGHBORS
@ -281,8 +279,8 @@ contains
t_sync(3) = t_sync(3) + (t3 - t2)
#endif
msg = "Constructing source bank..."
call message(msg, 8)
message = "Constructing source bank..."
call write_message(8)
! ==========================================================================
! RECONSTRUCT SOURCE BANK

15
src/output.f90
View file

@ -152,14 +152,13 @@ contains
end subroutine header
!===============================================================================
! MESSAGE displays an informational message to the log file and the standard
! output stream.
! WRITE_MESSAGE displays an informational message to the log file and the
! standard output stream.
!===============================================================================
subroutine message(msg, level)
subroutine write_message(level)
character(*), intent(in) :: msg
integer, optional :: level
integer, optional :: level
integer :: n_lines
integer :: i
@ -168,13 +167,13 @@ contains
if (.not. master .and. present(level)) return
if (.not. present(level) .or. level <= verbosity) then
n_lines = (len_trim(msg)-1)/79 + 1
n_lines = (len_trim(message)-1)/79 + 1
do i = 1, n_lines
write(ou, fmt='(1X,A)') trim(msg(79*(i-1)+1:79*i))
write(ou, fmt='(1X,A)') trim(message(79*(i-1)+1:79*i))
end do
end if
end subroutine message
end subroutine write_message
!===============================================================================
! GET_TODAY determines the date and time at which the program began execution

117
src/physics.f90
View file

@ -11,7 +11,7 @@ module physics
use global
use interpolation, only: interpolate_tab1
use mcnp_random, only: rang
use output, only: message, print_particle
use output, only: write_message, print_particle
use particle_header, only: Particle
use tally, only: score_tally
use search, only: binary_search
@ -36,7 +36,6 @@ contains
real(8) :: distance ! distance particle travels
logical :: found_cell ! found cell which particle is in?
logical :: in_lattice ! is surface crossing in lattice?
character(MAX_LINE_LEN) :: msg ! output/error message
type(Universe), pointer :: univ
if (p % cell == 0) then
@ -45,9 +44,9 @@ contains
! if particle couldn't be located, print error
if (.not. found_cell) then
write(msg, '(A,3ES11.3)') &
write(message, '(A,3ES11.3)') &
"Could not locate cell for particle at: ", p % xyz
call fatal_error(msg)
call fatal_error()
end if
! set birth cell attribute
@ -55,13 +54,13 @@ contains
end if
if (verbosity >= 9) then
msg = "Simulating Particle " // trim(int_to_str(p % uid))
call message(msg)
message = "Simulating Particle " // trim(int_to_str(p % uid))
call write_message()
end if
if (verbosity >= 10) then
msg = " Born in cell " // trim(int_to_str(cells(p%cell)%uid))
call message(msg)
message = " Born in cell " // trim(int_to_str(cells(p%cell)%uid))
call write_message()
end if
! find energy index, interpolation factor
@ -393,8 +392,8 @@ contains
! check for very low energy
if (p % E < 1.0e-100_8) then
p % alive = .false.
! msg = "Killing neutron with extremely low energy"
! call warning(msg)
! message = "Killing neutron with extremely low energy"
! call warning(message)
end if
! Score collision estimator tallies for any macro tallies -- this is done
@ -444,7 +443,6 @@ contains
real(8) :: prob ! cumulative probability
real(8) :: cutoff ! random number
real(8) :: atom_density ! atom density of nuclide in atom/b-cm
character(MAX_LINE_LEN) :: msg ! output/error message
type(Material), pointer :: mat => null()
type(Nuclide), pointer :: nuc => null()
type(Reaction), pointer :: rxn => null()
@ -464,8 +462,8 @@ contains
! Check to make sure that a nuclide was sampled
if (i > mat % n_nuclides) then
msg = "Did not sample any nuclide during collision."
call fatal_error(msg)
message = "Did not sample any nuclide during collision."
call fatal_error()
end if
! Find atom density and microscopic total cross section
@ -528,9 +526,9 @@ contains
! Check to make sure partial fission reaction sampled
if (i > nuc % n_fission) then
msg = "Did not sample any partial fission reaction for " // &
"survival biasing in " // trim(nuc % name)
call fatal_error(msg)
message = "Did not sample any partial fission reaction " // &
"for survival biasing in " // trim(nuc % name)
call fatal_error()
end if
rxn => nuc % reactions(nuc % index_fission(i))
@ -636,10 +634,10 @@ contains
! Check to make sure inelastic scattering reaction sampled
if (i > nuc % n_reaction) then
msg = "Did not sample any reaction for nuclide " // &
message = "Did not sample any reaction for nuclide " // &
trim(nuc % name) // " on material " // &
trim(int_to_str(mat % uid))
call fatal_error(msg)
call fatal_error()
end if
rxn => nuc % reactions(i)
@ -767,7 +765,6 @@ contains
real(8) :: mu_i1jk ! outgoing cosine k for E_in(i+1) and E_out(j)
real(8) :: prob ! probability for sampling Bragg edge
real(8) :: u, v, w ! directional cosines
character(MAX_LINE_LEN) :: msg
type(SAB_Table), pointer :: sab => null()
! Get pointer to S(a,b) table
@ -865,7 +862,7 @@ contains
j = 1
end if
else
msg = "Invalid secondary energy mode on S(a,b) table " // &
message = "Invalid secondary energy mode on S(a,b) table " // &
trim(sab % name)
end if
@ -1027,7 +1024,6 @@ contains
real(8) :: yield ! delayed neutron precursor yield
real(8) :: prob ! cumulative probability
logical :: actual_event ! did fission actually occur? (no survival biasing)
character(MAX_LINE_LEN) :: msg ! error message
type(Nuclide), pointer :: nuc
! Get pointer to nuclide
@ -1099,9 +1095,9 @@ contains
NR = nuc % nu_d_precursor_data(loc + 1)
NE = nuc % nu_d_precursor_data(loc + 2 + 2*NR)
if (NR > 0) then
msg = "Multiple interpolation regions not supported while &
message = "Multiple interpolation regions not supported while &
&sampling delayed neutron precursor yield."
call fatal_error(msg)
call fatal_error()
end if
! interpolate on energy grid
@ -1264,13 +1260,12 @@ contains
type(Particle), pointer :: p
integer :: cell_num ! user-specified cell number
character(MAX_LINE_LEN) :: msg ! output/error message
p % alive = .false.
if (verbosity >= 10) then
cell_num = cells(p % cell)%uid
msg = " Absorbed in cell " // trim(int_to_str(cell_num))
call message(msg)
message = " Absorbed in cell " // trim(int_to_str(cell_num))
call write_message()
end if
end subroutine n_absorption
@ -1302,7 +1297,6 @@ contains
real(8) :: c_k ! cumulative frequency at k
real(8) :: c_k1 ! cumulative frequency at k+1
real(8) :: p0,p1 ! probability distribution
character(MAX_LINE_LEN) :: msg ! error message
! check if reaction has angular distribution -- if not, sample outgoing
! angle isotropically
@ -1379,20 +1373,20 @@ contains
mu = mu0 + (sqrt(p0*p0 + 2*frac*(xi - c_k))-p0)/frac
end if
else
msg = "Unknown interpolation type: " // trim(int_to_str(interp))
call fatal_error(msg)
message = "Unknown interpolation type: " // trim(int_to_str(interp))
call fatal_error()
end if
if (abs(mu) > ONE) then
msg = "Sampled cosine of angle outside [-1, 1)."
call warning(msg)
message = "Sampled cosine of angle outside [-1, 1)."
call warning()
mu = sign(ONE,mu)
end if
else
msg = "Unknown angular distribution type: " // trim(int_to_str(type))
call fatal_error(msg)
message = "Unknown angular distribution type: " // trim(int_to_str(type))
call fatal_error()
end if
end function sample_angle
@ -1501,15 +1495,14 @@ contains
real(8) :: E_max ! parameter for n-body dist
real(8) :: x, y, v ! intermediate variables for n-body dist
real(8) :: r1, r2, r3, r4, r5, r6
character(MAX_LINE_LEN) :: msg ! error message
! TODO: If there are multiple scattering laws, sample scattering law
! Check for multiple interpolation regions
if (edist % n_interp > 0) then
msg = "Multiple interpolation regions not supported while &
message = "Multiple interpolation regions not supported while &
&attempting to sample secondary energy distribution."
call fatal_error(msg)
call fatal_error()
end if
! Determine which secondary energy distribution law to use
@ -1524,9 +1517,9 @@ contains
NE = edist % data(2 + 2*NR)
NET = edist % data(3 + 2*NR + NE)
if (NR > 0) then
msg = "Multiple interpolation regions not supported while &
message = "Multiple interpolation regions not supported while &
&attempting to sample equiprobable energy bins."
call fatal_error(msg)
call fatal_error()
end if
! determine index on incoming energy grid and interpolation factor
@ -1591,9 +1584,9 @@ contains
NR = edist % data(1)
NE = edist % data(2 + 2*NR)
if (NR > 0) then
msg = "Multiple interpolation regions not supported while &
message = "Multiple interpolation regions not supported while &
&attempting to sample continuous tabular distribution."
call fatal_error(msg)
call fatal_error()
end if
! find energy bin and calculate interpolation factor -- if the energy is
@ -1650,9 +1643,9 @@ contains
if (ND > 0) then
! discrete lines present
msg = "Discrete lines in continuous tabular distributed not &
message = "Discrete lines in continuous tabular distributed not &
&yet supported"
call fatal_error(msg)
call fatal_error()
end if
! determine outgoing energy bin
@ -1685,8 +1678,8 @@ contains
& p_l_k)/frac
end if
else
msg = "Unknown interpolation type: " // trim(int_to_str(INTT))
call fatal_error(msg)
message = "Unknown interpolation type: " // trim(int_to_str(INTT))
call fatal_error()
end if
! Now interpolate between incident energy bins i and i + 1
@ -1762,17 +1755,17 @@ contains
! KALBACH-MANN CORRELATED SCATTERING
if (.not. present(mu_out)) then
msg = "Law 44 called without giving mu_out as argument."
call fatal_error(msg)
message = "Law 44 called without giving mu_out as argument."
call fatal_error()
end if
! read number of interpolation regions and incoming energies
NR = edist % data(1)
NE = edist % data(2 + 2*NR)
if (NR > 0) then
msg = "Multiple interpolation regions not supported while &
message = "Multiple interpolation regions not supported while &
&attempting to sample Kalbach-Mann distribution."
call fatal_error(msg)
call fatal_error()
end if
! find energy bin and calculate interpolation factor -- if the energy is
@ -1830,9 +1823,9 @@ contains
if (ND > 0) then
! discrete lines present
msg = "Discrete lines in continuous tabular distributed not &
message = "Discrete lines in continuous tabular distributed not &
&yet supported"
call fatal_error(msg)
call fatal_error()
end if
! determine outgoing energy bin
@ -1879,8 +1872,8 @@ contains
KM_R = R_k + (R_k1 - R_k)*(E_out - E_l_k)/(E_l_k1 - E_l_k)
KM_A = A_k + (A_k1 - A_k)*(E_out - E_l_k)/(E_l_k1 - E_l_k)
else
msg = "Unknown interpolation type: " // trim(int_to_str(INTT))
call fatal_error(msg)
message = "Unknown interpolation type: " // trim(int_to_str(INTT))
call fatal_error()
end if
! Now interpolate between incident energy bins i and i + 1
@ -1905,17 +1898,17 @@ contains
! CORRELATED ENERGY AND ANGLE DISTRIBUTION
if (.not. present(mu_out)) then
msg = "Law 44 called without giving mu_out as argument."
call fatal_error(msg)
message = "Law 44 called without giving mu_out as argument."
call fatal_error()
end if
! read number of interpolation regions and incoming energies
NR = edist % data(1)
NE = edist % data(2 + 2*NR)
if (NR > 0) then
msg = "Multiple interpolation regions not supported while &
message = "Multiple interpolation regions not supported while &
&attempting to sample correlated energy-angle distribution."
call fatal_error(msg)
call fatal_error()
end if
! find energy bin and calculate interpolation factor -- if the energy is
@ -1973,9 +1966,9 @@ contains
if (ND > 0) then
! discrete lines present
msg = "Discrete lines in continuous tabular distributed not &
message = "Discrete lines in continuous tabular distributed not &
&yet supported"
call fatal_error(msg)
call fatal_error()
end if
! determine outgoing energy bin
@ -2009,8 +2002,8 @@ contains
& p_l_k)/frac
end if
else
msg = "Unknown interpolation type: " // trim(int_to_str(INTT))
call fatal_error(msg)
message = "Unknown interpolation type: " // trim(int_to_str(INTT))
call fatal_error()
end if
! Now interpolate between incident energy bins i and i + 1
@ -2062,8 +2055,8 @@ contains
mu_out = mu_k + (sqrt(p_k*p_k + 2*frac*(r3 - c_k))-p_k)/frac
end if
else
msg = "Unknown interpolation type: " // trim(int_to_str(JJ))
call fatal_error(msg)
message = "Unknown interpolation type: " // trim(int_to_str(JJ))
call fatal_error()
end if
case (66)

6
src/search.f90
View file

@ -2,6 +2,7 @@ module search
use constants, only: ONE, MAX_LINE_LEN
use error, only: fatal_error
use global, only: message
contains
@ -20,14 +21,13 @@ contains
integer :: L
integer :: R
real(8) :: testval
character(MAX_LINE_LEN) :: msg
L = 1
R = n
if (val < array(L) .or. val > array(R)) then
msg = "Value outside of array during binary search"
call fatal_error(msg)
message = "Value outside of array during binary search"
call fatal_error()
end if
do while (R - L > 1)

4
src/source.f90
View file

@ -5,7 +5,7 @@ module source
use cross_section_header, only: Nuclide
use global
use mcnp_random, only: rang, RN_init_particle
use output, only: message
use output, only: write_message
use particle_header, only: Particle, initialize_particle
use physics, only: watt_spectrum
@ -33,7 +33,7 @@ contains
character(MAX_LINE_LEN) :: msg ! error message
msg = 'Initializing source particles...'
call message(msg, 6)
call write_message(6)
! Determine maximum amount of particles to simulate on each processor
maxwork = ceiling(real(n_particles)/n_procs,8)

8
src/string.f90
View file

@ -2,6 +2,7 @@ module string
use constants, only: MAX_WORDS, MAX_LINE_LEN, ERROR_INT, ERROR_REAL
use error, only: warning
use global, only: message
implicit none
@ -31,7 +32,6 @@ contains
integer :: i ! current index
integer :: i_start ! starting index of word
integer :: i_end ! ending index of word
character(MAX_LINE_LEN) :: msg
i_start = 0
i_end = 0
@ -49,9 +49,9 @@ contains
if (i_end > 0) then
n = n + 1
if (i_end - i_start + 1 > len(words(n))) then
msg = "The word '" // string(i_start:i_end) // "' is longer than " &
& // "the space allocated for it."
call warning(msg)
message = "The word '" // string(i_start:i_end) // &
"' is longer than the space allocated for it."
call warning()
end if
words(n) = string(i_start:i_end)
! reset indices

28
src/tally.f90
View file

@ -6,7 +6,7 @@ module tally
use global
use mesh, only: get_mesh_bin, bin_to_mesh_indices, get_mesh_indices
use mesh_header, only: StructuredMesh
use output, only: message, header
use output, only: write_message, header
use search, only: binary_search
use string, only: int_to_str, real_to_str
use tally_header, only: TallyScore, TallyMapItem, TallyMapElement
@ -36,13 +36,12 @@ contains
real(8), save :: k1 = 0. ! accumulated keff
real(8), save :: k2 = 0. ! accumulated keff**2
real(8) :: std ! stdev of keff over active cycles
character(MAX_LINE_LEN) :: msg ! output/error message
#ifdef MPI
integer :: ierr
#endif
msg = "Calculate cycle keff..."
call message(msg, 8)
message = "Calculate cycle keff..."
call write_message(8)
! set k1 and k2 at beginning of run
if (i_cycle == 1) then
@ -103,7 +102,6 @@ contains
integer :: n ! number of bins
integer :: filter_bins ! running total of number of filter bins
integer :: score_bins ! number of scoring bins
character(MAX_LINE_LEN) :: msg ! output/error message
type(TallyObject), pointer :: t => null()
type(StructuredMesh), pointer :: m => null()
@ -243,8 +241,8 @@ contains
if (n > 0) then
score_bins = n
else
msg = "Must have macro tally bins!"
call fatal_error(msg)
message = "Must have macro tally bins!"
call fatal_error()
end if
! Allocate scores for tally
@ -319,7 +317,6 @@ contains
logical :: in_mesh
logical :: has_energyout_bin
logical :: analog
character(MAX_LINE_LEN) :: msg
type(TallyObject), pointer :: t
type(StructuredMesh), pointer :: m
@ -392,8 +389,8 @@ contains
if (.not. in_mesh) cycle
if (t % surface_current) then
msg = "Surface current mesh tally not yet implemented."
call fatal_error(msg)
message = "Surface current mesh tally not yet implemented."
call fatal_error()
else
bins(T_MESH) = mesh_bin
end if
@ -500,8 +497,8 @@ contains
case (MACRO_NU_FISSION)
cycle
case default
msg = "Invalid macro reaction on analog tally."
call fatal_error(msg)
message = "Invalid macro reaction on analog tally."
call fatal_error()
end select
end if
@ -793,11 +790,8 @@ contains
! Check for errors
if (score_index < 0 .or. score_index > t % n_total_bins) then
print *, ijk0
print *, ijk1
print *, score_index
print *, t % stride(1:3), t % n_total_bins
call fatal_error("Score_index outside range.")
message = "Score index outside range."
call fatal_error()
end if
! Add to surface current tally