diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 66d4d4dc59..acc83a4a3b 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -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 diff --git a/src/cross_section.f90 b/src/cross_section.f90 index f675a0aaa5..419fbea811 100644 --- a/src/cross_section.f90 +++ b/src/cross_section.f90 @@ -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) diff --git a/src/energy_grid.f90 b/src/energy_grid.f90 index c4b428774f..04c50bbb0e 100644 --- a/src/energy_grid.f90 +++ b/src/energy_grid.f90 @@ -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 diff --git a/src/error.f90 b/src/error.f90 index 83d95f695a..ddeb6007b1 100644 --- a/src/error.f90 +++ b/src/error.f90 @@ -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,*) diff --git a/src/fission.f90 b/src/fission.f90 index d26a1101e9..75612a7757 100644 --- a/src/fission.f90 +++ b/src/fission.f90 @@ -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)) diff --git a/src/geometry.f90 b/src/geometry.f90 index 6b2254cf8f..fbde7b4a4f 100644 --- a/src/geometry.f90 +++ b/src/geometry.f90 @@ -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)) diff --git a/src/global.f90 b/src/global.f90 index f0d7028081..bd50e86ae2 100644 --- a/src/global.f90 +++ b/src/global.f90 @@ -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 diff --git a/src/initialize.f90 b/src/initialize.f90 index 784afab02d..ecb1abf9ea 100644 --- a/src/initialize.f90 +++ b/src/initialize.f90 @@ -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 diff --git a/src/input_xml.f90 b/src/input_xml.f90 index de2b252e18..316ae489bc 100644 --- a/src/input_xml.f90 +++ b/src/input_xml.f90 @@ -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 must be the same as the " // & - "number of entries on ." - call fatal_error(msg) + message = "Number of entries on must be the same as " // & + "the number of entries on ." + 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 must be the same as the " // & - "number of entries on ." - call fatal_error(msg) + message = "Number of entries on must be the same as " // & + "the number of entries on ." + 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 must be the same as the " // & - "number of entries on ." - call fatal_error(msg) + message = "Number of entries on must be the same as " // & + "the number of entries on ." + 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 must be the same as the " // & - "number of entries on ." - call fatal_error(msg) + message = "Number of entries on must be the same as " // & + "the number of entries on ." + 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) diff --git a/src/interpolation.f90 b/src/interpolation.f90 index c0e6f631b6..231007e738 100644 --- a/src/interpolation.f90 +++ b/src/interpolation.f90 @@ -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 diff --git a/src/main.f90 b/src/main.f90 index 9bbb16c6a4..d95a2f62ec 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -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 diff --git a/src/mpi_routines.f90 b/src/mpi_routines.f90 index b19b3aa665..80fe466b8f 100644 --- a/src/mpi_routines.f90 +++ b/src/mpi_routines.f90 @@ -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 diff --git a/src/output.f90 b/src/output.f90 index 527463effe..e19915e602 100644 --- a/src/output.f90 +++ b/src/output.f90 @@ -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 diff --git a/src/physics.f90 b/src/physics.f90 index f47f6d8f09..74f4d777e9 100644 --- a/src/physics.f90 +++ b/src/physics.f90 @@ -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) diff --git a/src/search.f90 b/src/search.f90 index 445b72acdf..dd9b02c7ff 100644 --- a/src/search.f90 +++ b/src/search.f90 @@ -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) diff --git a/src/source.f90 b/src/source.f90 index 8add3cb5ca..7f8a303afc 100644 --- a/src/source.f90 +++ b/src/source.f90 @@ -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) diff --git a/src/string.f90 b/src/string.f90 index 54453b2123..e3ed5f11ad 100644 --- a/src/string.f90 +++ b/src/string.f90 @@ -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 diff --git a/src/tally.f90 b/src/tally.f90 index fcd49e04f7..792bc921a2 100644 --- a/src/tally.f90 +++ b/src/tally.f90 @@ -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