From 7d8610133b33a7aa7b262ece17fa59735812748c Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 15 Sep 2011 22:30:44 -0400 Subject: [PATCH] Initial tally restructuring and reading. --- examples/basic/tallies.xml | 6 +- src/constants.f90 | 12 +- src/input_xml.f90 | 151 +++++++++++++++- src/output.f90 | 106 +++++++---- src/score.f90 | 356 ++++++++++++++++++------------------- src/tally_header.f90 | 52 ++++-- src/xml_tallies.f90 | 125 ++++++------- 7 files changed, 502 insertions(+), 306 deletions(-) diff --git a/examples/basic/tallies.xml b/examples/basic/tallies.xml index ff2e3ecacf..4ecd15801d 100644 --- a/examples/basic/tallies.xml +++ b/examples/basic/tallies.xml @@ -4,15 +4,13 @@ - 1 + 1 0.0 0.625 20.0e6 - 1 2 -4 -8 + total scatter absorption fission nu-fission - - U-238 diff --git a/src/constants.f90 b/src/constants.f90 index 08a72922b6..fa7681a0af 100644 --- a/src/constants.f90 +++ b/src/constants.f90 @@ -151,12 +151,14 @@ module constants N_PT = 116, & N_DA = 117 - ! Tally distinguishers + ! Tally macro reactions integer, parameter :: & - TALLY_FLUX = -1, & ! tally the flux only - TALLY_ALL = 0, & ! tally all reactions - TALLY_BINS = 1, & ! tally individual (reactions, cells) - TALLY_SUM = 2 ! tally sum of specified (reactions, cells) + MACRO_FLUX = -1, & ! flux + MACRO_TOTAL = -2, & ! total reaction rate + MACRO_SCATTER = -3, & ! total scattering rate + MACRO_ABSORPTION = -4, & ! total absorption rate + MACRO_FISSION = -5, & ! total fission rate + MACRO_NU_FISSION = -6 ! total neutron production rate ! Fission neutron emission (nu) type integer, parameter :: & diff --git a/src/input_xml.f90 b/src/input_xml.f90 index 97bec57fd7..df9cb9e25f 100644 --- a/src/input_xml.f90 +++ b/src/input_xml.f90 @@ -7,7 +7,8 @@ module input_xml use geometry_header, only: Cell, Surface, Lattice use global use output, only: message - use string, only: lower_case, int_to_str + use string, only: lower_case, int_to_str, str_to_int, str_to_real, & + split_string implicit none @@ -26,6 +27,7 @@ contains call read_settings_xml() call read_geometry_xml() call read_materials_xml() + call read_tallies_xml() end subroutine read_input_xml @@ -40,6 +42,7 @@ contains integer :: n integer :: coeffs_reqd + logical :: file_exists character(MAX_WORD_LEN) :: type character(MAX_LINE_LEN) :: msg character(MAX_LINE_LEN) :: filename @@ -48,8 +51,15 @@ contains msg = "Reading settings XML file..." call message(msg, 5) - ! Parse settings.xml file + ! 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) + end if + + ! Parse settings.xml file call read_xml_file_settings_t(filename) ! Cross-section library path @@ -111,6 +121,7 @@ contains integer :: universe_num integer :: count integer :: coeffs_reqd + logical :: file_exists character(MAX_LINE_LEN) :: filename character(MAX_LINE_LEN) :: msg character(MAX_WORD_LEN) :: word @@ -125,8 +136,15 @@ contains ! ========================================================================== ! READ CELLS FROM GEOMETRY.XML - ! Parse geometry.xml file + ! Check if geometry.xml exists 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) + end if + + ! Parse geometry.xml file call read_xml_file_geometry_t(filename) ! Allocate cells array @@ -372,6 +390,7 @@ contains integer :: i, j integer :: n real(8) :: val + logical :: file_exists character(MAX_WORD_LEN) :: units character(MAX_WORD_LEN) :: name character(MAX_LINE_LEN) :: filename @@ -383,8 +402,15 @@ contains msg = "Reading materials XML file..." call message(msg, 5) - ! Parse materials.xml file + ! 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) + end if + + ! Parse materials.xml file call read_xml_file_materials_t(filename) ! Allocate cells array @@ -474,17 +500,30 @@ contains use xml_data_tallies_t - integer :: i + integer :: i ! loop over user-specified tallies + integer :: j ! loop over words + integer :: n_words character(MAX_LINE_LEN) :: filename character(MAX_LINE_LEN) :: msg + character(MAX_WORD_LEN) :: word + character(MAX_WORD_LEN) :: words(MAX_WORDS) + logical :: file_exists type(Tally), pointer :: t => null() + ! Check if tallies.xml exists + filename = trim(path_input) // "tallies.xml" + inquire(FILE=filename, EXIST=file_exists) + if (.not. file_exists) then + ! Since a tallies.xml file is optional, no error is issued here + n_tallies = 0 + return + end if + ! Display output message msg = "Reading tallies XML file..." call message(msg, 5) ! Parse tallies.xml file - filename = trim(path_input) // "tallies.xml" call read_xml_file_tallies_t(filename) ! Allocate cells array @@ -497,6 +536,106 @@ contains ! Copy material uid t % uid = tally_(i) % id + ! 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 " & + // trim(int_to_str(t % uid)) + call fatal_error(msg) + end if + + ! TODO: Parse logical expressions instead of just each word + + ! Read cell filter bins + if (len_trim(tally_(i) % filters % cell) > 0) then + call split_string(tally_(i) % filters % cell, words, n_words) + allocate(t % cell_bins(n_words)) + do j = 1, n_words + t % cell_bins(j) % scalar = str_to_int(words(j)) + end do + end if + + ! Read surface filter bins + if (len_trim(tally_(i) % filters % surface) > 0) then + call split_string(tally_(i) % filters % surface, words, n_words) + allocate(t % surface_bins(n_words)) + do j = 1, n_words + t % surface_bins(j) % scalar = str_to_int(words(j)) + end do + end if + + ! Read material filter bins + if (len_trim(tally_(i) % filters % material) > 0) then + call split_string(tally_(i) % filters % material, words, n_words) + allocate(t % material_bins(n_words)) + do j = 1, n_words + t % material_bins(j) % scalar = str_to_int(words(j)) + end do + end if + + ! Read mesh filter bins + if (len_trim(tally_(i) % filters % mesh) > 0) then + call split_string(tally_(i) % filters % mesh, words, n_words) + allocate(t % mesh_bins(n_words)) + do j = 1, n_words + t % mesh_bins(j) % scalar = str_to_int(words(j)) + end do + end if + + ! Read birth region filter bins + if (len_trim(tally_(i) % filters % bornin) > 0) then + call split_string(tally_(i) % filters % bornin, words, n_words) + allocate(t % bornin_bins(n_words)) + do j = 1, n_words + t % bornin_bins(j) % scalar = str_to_int(words(j)) + end do + end if + + ! Read incoming energy filter bins + if (len_trim(tally_(i) % filters % energy) > 0) then + call split_string(tally_(i) % filters % energy, words, n_words) + allocate(t % energy_in(n_words)) + do j = 1, n_words + t % energy_in(j) = str_to_real(words(j)) + end do + end if + + ! Read outgoing energy filter bins + if (len_trim(tally_(i) % filters % energyout) > 0) then + call split_string(tally_(i) % filters % energyout, words, n_words) + allocate(t % energy_out(n_words)) + do j = 1, n_words + t % energy_out(j) = str_to_real(words(j)) + end do + end if + + ! Read macro reactions + if (len_trim(tally_(i) % macros) > 0) then + call split_string(tally_(i) % macros, words, n_words) + allocate(t % macro_bins(n_words)) + do j = 1, n_words + word = words(j) + call lower_case(word) + select case (trim(word)) + case ('flux') + t % macro_bins(j) % scalar = MACRO_FLUX + case ('total') + t % macro_bins(j) % scalar = MACRO_TOTAL + case ('scatter') + t % macro_bins(j) % scalar = MACRO_SCATTER + case ('absorption') + t % macro_bins(j) % scalar = MACRO_ABSORPTION + case ('fission') + t % macro_bins(j) % scalar = MACRO_FISSION + case ('nu-fission') + t % macro_bins(j) % scalar = MACRO_NU_FISSION + case default + msg = "Unknown macro reaction: " // trim(words(j)) + call fatal_error(msg) + end select + end do + end if + end do end subroutine read_tallies_xml diff --git a/src/output.f90 b/src/output.f90 index f074344e01..4d35060f4c 100644 --- a/src/output.f90 +++ b/src/output.f90 @@ -506,52 +506,92 @@ contains type(Tally), pointer :: tal integer :: i - integer :: MT character(MAX_LINE_LEN) :: string write(ou,*) 'Tally ' // int_to_str(tal % uid) - select case (tal % reaction_type) - case (TALLY_FLUX) - write(ou,*) ' Type: Flux' - case (TALLY_ALL) - write(ou,*) ' Type: Total Collision Rate' - case (TALLY_BINS) - write(ou,*) ' Type: Partial reactions' - case (TALLY_SUM) - write(ou,*) ' Type: Partial reactions (summed)' - end select - - select case (tal % cell_type) - case (TALLY_BINS) - write(ou,*) ' Cell Type: Separate bins' - case (TALLY_SUM) - write(ou,*) ' Cell Type: Sum over cells' - end select - - if (allocated(tal % reactions)) then + if (associated(tal % cell_bins)) then string = "" - do i = 1, size(tal % reactions) - MT = tal % reactions(i) - string = trim(string) // ' ' // trim(reaction_name(MT)) + do i = 1, size(tal % cell_bins) + string = trim(string) // ' ' // trim(int_to_str(& + tal % cell_bins(i) % scalar)) end do - write(ou,*) ' Reactions:' // trim(string) + write(ou, *) ' Cell Bins:' // trim(string) end if - if (allocated(cells)) then + if (associated(tal % surface_bins)) then string = "" - do i = 1, size(tal % cells) - string = trim(string) // ' ' // trim(int_to_str(tal % cells(i))) + do i = 1, size(tal % surface_bins) + string = trim(string) // ' ' // trim(int_to_str(& + tal % surface_bins(i) % scalar)) end do - write(ou,*) ' Cells:' // trim(string) + write(ou, *) ' Surface Bins:' // trim(string) end if - - if (allocated(tal % energies)) then + + if (associated(tal % material_bins)) then string = "" - do i = 1, size(tal % energies) - string = trim(string) // ' ' // trim(real_to_str(tal % energies(i))) + do i = 1, size(tal % material_bins) + string = trim(string) // ' ' // trim(int_to_str(& + tal % material_bins(i) % scalar)) end do - write(ou,*) ' Energies:' // trim(string) + write(ou, *) ' Material Bins:' // trim(string) + end if + + if (associated(tal % mesh_bins)) then + string = "" + do i = 1, size(tal % mesh_bins) + string = trim(string) // ' ' // trim(int_to_str(& + tal % mesh_bins(i) % scalar)) + end do + write(ou, *) ' Mesh Bins:' // trim(string) + end if + + if (associated(tal % bornin_bins)) then + string = "" + do i = 1, size(tal % bornin_bins) + string = trim(string) // ' ' // trim(int_to_str(& + tal % bornin_bins(i) % scalar)) + end do + write(ou, *) ' Birth Region Bins:' // trim(string) + end if + + if (allocated(tal % energy_in)) then + string = "" + do i = 1, size(tal % energy_in) + string = trim(string) // ' ' // trim(real_to_str(& + tal % energy_in(i))) + end do + write(ou,*) ' Incoming Energy Bins:' // trim(string) + end if + + if (allocated(tal % energy_out)) then + string = "" + do i = 1, size(tal % energy_out) + string = trim(string) // ' ' // trim(real_to_str(& + tal % energy_out(i))) + end do + write(ou,*) ' Outgoing Energy Bins:' // trim(string) + end if + + if (associated(tal % macro_bins)) then + string = "" + do i = 1, size(tal % macro_bins) + select case (tal % macro_bins(i) % scalar) + case (MACRO_FLUX) + string = trim(string) // ' flux' + case (MACRO_TOTAL) + string = trim(string) // ' total' + case (MACRO_SCATTER) + string = trim(string) // ' scatter' + case (MACRO_ABSORPTION) + string = trim(string) // ' absorption' + case (MACRO_FISSION) + string = trim(string) // ' fission' + case (MACRO_NU_FISSION) + string = trim(string) // ' nu-fission' + end select + end do + write(ou,*) ' Macro Reactions:' // trim(string) end if write(ou,*) diff --git a/src/score.f90 b/src/score.f90 index 3025d0661b..0617f94563 100644 --- a/src/score.f90 +++ b/src/score.f90 @@ -91,181 +91,181 @@ contains type(Particle), pointer :: p ! particle real(8), intent(in) :: flux ! estimator of flux - integer :: i ! index for tallies in cell - integer :: j ! index for reactions in tally - integer :: e_bin ! energy bin - integer :: c_bin ! cell bin - integer :: r_bin ! reaction bin - integer :: n_energy ! number of energy bins - integer :: n_reaction ! number of reactions - integer :: type ! cell or reaction type - integer :: MT ! reaction MT value - real(8) :: E ! energy of particle - real(8) :: val ! value to score - real(8) :: Sigma ! macroscopic cross section of reaction - character(MAX_LINE_LEN) :: msg ! output/error message - type(Cell), pointer :: c => null() - type(Tally), pointer :: t => null() - type(Material), pointer :: mat => null() - - ! ========================================================================== - ! HANDLE LOCAL TALLIES - - c => cells(p % cell) - if (.not. allocated(c % tallies)) return - - ! if so, loop over each tally - do i = 1, size(c % tallies) - t => tallies(c % tallies(i)) - - ! ======================================================================= - ! DETERMINE ENERGY BIN - if (allocated(t % energies)) then - E = p % E - n_energy = size(t % energies) - if (E < t % energies(1) .or. E > t % energies(n_energy)) then - ! Energy outside of specified range - cycle - else - e_bin = binary_search(t % energies, n_energy, E) - end if - end if - - ! ======================================================================= - ! DETERMINE CELL BIN - type = t % cell_type - if (type == TALLY_SUM) then - ! Sum tallies from separate cells into one bin - c_bin = 1 - elseif (type == TALLY_BINS) then - ! Need to determine cell bin - do j = 1, size(t % cells) - if (p % cell == t % cells(j)) then - c_bin = j - exit - end if - end do - else - msg = "Invalid type for cell bins in tally " // int_to_str(t % uid) - call fatal_error(msg) - end if - - ! ======================================================================= - ! DETERMINE REACTION BIN AND ADD VALUE TO SCORE - type = t % reaction_type - if (type == TALLY_FLUX) then - ! Tally flux only - val = flux - call add_to_score(t % score(r_bin, c_bin, e_bin), val) - - elseif (type == TALLY_ALL) then - ! Tally total reaction rate - val = ONE - r_bin = 1 - call add_to_score(t % score(r_bin, c_bin, e_bin), val) - - elseif (type == TALLY_BINS) then - ! Individually bin reactions - n_reaction = t % reaction_type - - r_bin = 0 - do j = 1, n_reaction - MT = t % reactions(j) - mat => materials(p % material) - Sigma = get_macro_xs(p, mat, MT) - val = Sigma * flux - r_bin = r_bin + 1 - call add_to_score(t % score(r_bin, c_bin, e_bin), & - & val) - end do - elseif (type == TALLY_SUM) then - ! Tally reactions in one bin - n_reaction = t % reaction_type - - r_bin = 1 - do j = 1, n_reaction - MT = t % reactions(j) - mat => materials(p % material) - Sigma = get_macro_xs(p, mat, MT) - val = Sigma * flux - call add_to_score(t % score(r_bin, c_bin, e_bin), & - & val) - end do - end if - end do - - ! ========================================================================== - ! HANDLE GLOBAL TALLIES - - do i = 1, n_tallies_global - t => tallies_global(i) - - ! ======================================================================= - ! DETERMINE ENERGY BIN - if (allocated(t % energies)) then - E = p % E - n_energy = size(t % energies) - if (E < t % energies(1) .or. E > t % energies(n_energy)) then - ! Energy outside of specified range - cycle - else - e_bin = binary_search(t % energies, n_energy, E) - end if - end if - - ! Since it's a global tally, the cell bin is unity - c_bin = 1 - - ! ======================================================================= - ! DETERMINE REACTION BIN AND ADD VALUE TO SCORE - type = t % reaction_type - if (type == TALLY_FLUX) then - ! Tally flux only - val = flux - call add_to_score(t % score(r_bin, c_bin, e_bin), val) - - elseif (type == TALLY_ALL) then - ! Tally total reaction rate - val = ONE - r_bin = 1 - call add_to_score(t % score(r_bin, c_bin, e_bin), val) - - elseif (type == TALLY_BINS) then - ! Individually bin reactions - n_reaction = t % reaction_type - - r_bin = 0 - do j = 1, n_reaction - MT = t % reactions(j) - mat => materials(p % material) - Sigma = get_macro_xs(p, mat, MT) - val = Sigma * flux - r_bin = r_bin + 1 - call add_to_score(t % score(r_bin, c_bin, e_bin), & - & val) - end do - elseif (type == TALLY_SUM) then - ! Tally reactions in one bin - n_reaction = t % reaction_type - - r_bin = 1 - do j = 1, n_reaction - MT = t % reactions(j) - mat => materials(p % material) - Sigma = get_macro_xs(p, mat, MT) - val = Sigma * flux - call add_to_score(t % score(r_bin, c_bin, e_bin), & - & val) - end do - end if - - end do - - ! ========================================================================== - ! TODO: Add lattice tallies - - ! ========================================================================== - ! TODO: Add mesh tallies +!!$ integer :: i ! index for tallies in cell +!!$ integer :: j ! index for reactions in tally +!!$ integer :: e_bin ! energy bin +!!$ integer :: c_bin ! cell bin +!!$ integer :: r_bin ! reaction bin +!!$ integer :: n_energy ! number of energy bins +!!$ integer :: n_reaction ! number of reactions +!!$ integer :: type ! cell or reaction type +!!$ integer :: MT ! reaction MT value +!!$ real(8) :: E ! energy of particle +!!$ real(8) :: val ! value to score +!!$ real(8) :: Sigma ! macroscopic cross section of reaction +!!$ character(MAX_LINE_LEN) :: msg ! output/error message +!!$ type(Cell), pointer :: c => null() +!!$ type(Tally), pointer :: t => null() +!!$ type(Material), pointer :: mat => null() +!!$ +!!$ ! ========================================================================== +!!$ ! HANDLE LOCAL TALLIES +!!$ +!!$ c => cells(p % cell) +!!$ if (.not. allocated(c % tallies)) return +!!$ +!!$ ! if so, loop over each tally +!!$ do i = 1, size(c % tallies) +!!$ t => tallies(c % tallies(i)) +!!$ +!!$ ! ======================================================================= +!!$ ! DETERMINE ENERGY BIN +!!$ if (allocated(t % energies)) then +!!$ E = p % E +!!$ n_energy = size(t % energies) +!!$ if (E < t % energies(1) .or. E > t % energies(n_energy)) then +!!$ ! Energy outside of specified range +!!$ cycle +!!$ else +!!$ e_bin = binary_search(t % energies, n_energy, E) +!!$ end if +!!$ end if +!!$ +!!$ ! ======================================================================= +!!$ ! DETERMINE CELL BIN +!!$ type = t % cell_type +!!$ if (type == TALLY_SUM) then +!!$ ! Sum tallies from separate cells into one bin +!!$ c_bin = 1 +!!$ elseif (type == TALLY_BINS) then +!!$ ! Need to determine cell bin +!!$ do j = 1, size(t % cells) +!!$ if (p % cell == t % cells(j)) then +!!$ c_bin = j +!!$ exit +!!$ end if +!!$ end do +!!$ else +!!$ msg = "Invalid type for cell bins in tally " // int_to_str(t % uid) +!!$ call fatal_error(msg) +!!$ end if +!!$ +!!$ ! ======================================================================= +!!$ ! DETERMINE REACTION BIN AND ADD VALUE TO SCORE +!!$ type = t % reaction_type +!!$ if (type == TALLY_FLUX) then +!!$ ! Tally flux only +!!$ val = flux +!!$ call add_to_score(t % score(r_bin, c_bin, e_bin), val) +!!$ +!!$ elseif (type == TALLY_ALL) then +!!$ ! Tally total reaction rate +!!$ val = ONE +!!$ r_bin = 1 +!!$ call add_to_score(t % score(r_bin, c_bin, e_bin), val) +!!$ +!!$ elseif (type == TALLY_BINS) then +!!$ ! Individually bin reactions +!!$ n_reaction = t % reaction_type +!!$ +!!$ r_bin = 0 +!!$ do j = 1, n_reaction +!!$ MT = t % reactions(j) +!!$ mat => materials(p % material) +!!$ Sigma = get_macro_xs(p, mat, MT) +!!$ val = Sigma * flux +!!$ r_bin = r_bin + 1 +!!$ call add_to_score(t % score(r_bin, c_bin, e_bin), & +!!$ & val) +!!$ end do +!!$ elseif (type == TALLY_SUM) then +!!$ ! Tally reactions in one bin +!!$ n_reaction = t % reaction_type +!!$ +!!$ r_bin = 1 +!!$ do j = 1, n_reaction +!!$ MT = t % reactions(j) +!!$ mat => materials(p % material) +!!$ Sigma = get_macro_xs(p, mat, MT) +!!$ val = Sigma * flux +!!$ call add_to_score(t % score(r_bin, c_bin, e_bin), & +!!$ & val) +!!$ end do +!!$ end if +!!$ end do +!!$ +!!$ ! ========================================================================== +!!$ ! HANDLE GLOBAL TALLIES +!!$ +!!$ do i = 1, n_tallies_global +!!$ t => tallies_global(i) +!!$ +!!$ ! ======================================================================= +!!$ ! DETERMINE ENERGY BIN +!!$ if (allocated(t % energies)) then +!!$ E = p % E +!!$ n_energy = size(t % energies) +!!$ if (E < t % energies(1) .or. E > t % energies(n_energy)) then +!!$ ! Energy outside of specified range +!!$ cycle +!!$ else +!!$ e_bin = binary_search(t % energies, n_energy, E) +!!$ end if +!!$ end if +!!$ +!!$ ! Since it's a global tally, the cell bin is unity +!!$ c_bin = 1 +!!$ +!!$ ! ======================================================================= +!!$ ! DETERMINE REACTION BIN AND ADD VALUE TO SCORE +!!$ type = t % reaction_type +!!$ if (type == TALLY_FLUX) then +!!$ ! Tally flux only +!!$ val = flux +!!$ call add_to_score(t % score(r_bin, c_bin, e_bin), val) +!!$ +!!$ elseif (type == TALLY_ALL) then +!!$ ! Tally total reaction rate +!!$ val = ONE +!!$ r_bin = 1 +!!$ call add_to_score(t % score(r_bin, c_bin, e_bin), val) +!!$ +!!$ elseif (type == TALLY_BINS) then +!!$ ! Individually bin reactions +!!$ n_reaction = t % reaction_type +!!$ +!!$ r_bin = 0 +!!$ do j = 1, n_reaction +!!$ MT = t % reactions(j) +!!$ mat => materials(p % material) +!!$ Sigma = get_macro_xs(p, mat, MT) +!!$ val = Sigma * flux +!!$ r_bin = r_bin + 1 +!!$ call add_to_score(t % score(r_bin, c_bin, e_bin), & +!!$ & val) +!!$ end do +!!$ elseif (type == TALLY_SUM) then +!!$ ! Tally reactions in one bin +!!$ n_reaction = t % reaction_type +!!$ +!!$ r_bin = 1 +!!$ do j = 1, n_reaction +!!$ MT = t % reactions(j) +!!$ mat => materials(p % material) +!!$ Sigma = get_macro_xs(p, mat, MT) +!!$ val = Sigma * flux +!!$ call add_to_score(t % score(r_bin, c_bin, e_bin), & +!!$ & val) +!!$ end do +!!$ end if +!!$ +!!$ end do +!!$ +!!$ ! ========================================================================== +!!$ ! TODO: Add lattice tallies +!!$ +!!$ ! ========================================================================== +!!$ ! TODO: Add mesh tallies end subroutine score_tally @@ -278,9 +278,9 @@ contains type(TallyScore), intent(inout) :: score real(8), intent(in) :: val - score % n_events = score % n_events + 1 - score % val = score % val + val - score % val_sq = score % val_sq + val*val +!!$ score % n_events = score % n_events + 1 +!!$ score % val = score % val + val +!!$ score % val_sq = score % val_sq + val*val end subroutine add_to_score diff --git a/src/tally_header.f90 b/src/tally_header.f90 index df49d5e4f9..1617404a47 100644 --- a/src/tally_header.f90 +++ b/src/tally_header.f90 @@ -3,7 +3,7 @@ module tally_header implicit none !=============================================================================== -! TALLYSCORE +! TALLYSCORE provides accumulation of scores in a particular tally bin !=============================================================================== type TallyScore @@ -13,27 +13,53 @@ module tally_header end type TallyScore !=============================================================================== -! TALLY +! TALLYFILTER represents a single bin filter for a tally to score in. This could +! be, for example, a single cell OR a collection of cells. +!=============================================================================== + + type TallyFilter + integer :: scalar = 0 + integer, allocatable :: array(:) + end type TallyFilter + +!=============================================================================== +! TALLY describes a user-specified tally. The region of phase space to tally in +! is given by the TallyBins and the scores are stored in a TallyScore array. !=============================================================================== type Tally + ! Basic data + integer :: uid integer :: type real(8) :: volume integer :: cell_type integer :: reaction_type integer :: material_type - integer, allocatable :: reactions(:) - integer, allocatable :: cells(:) - integer, allocatable :: materials(:) - integer, allocatable :: universes(:) - real(8), allocatable :: energies(:) - real(8) :: xyz_min(3) - real(8) :: xyz_max(3) - integer :: n_x - integer :: n_y - integer :: n_z - type(TallyScore), allocatable :: score(:,:,:) + + ! Tally bin specifications + + type(TallyFilter), pointer :: cell_bins(:) => null() + type(TallyFilter), pointer :: surface_bins(:) => null() + type(TallyFilter), pointer :: universe_bins(:) => null() + type(TallyFilter), pointer :: material_bins(:) => null() + type(TallyFilter), pointer :: mesh_bins(:) => null() + type(TallyFilter), pointer :: bornin_bins(:) => null() + real(8), allocatable :: energy_in(:) + real(8), allocatable :: energy_out(:) + + ! Macroscopic properties to score + + type(TallyFilter), pointer :: macro_bins(:) => null() + + ! Scores for each bin -- the most natural way to have scores would be to + ! have a dimension for each different type of bin, but older Fortran + ! standards are limited to 7 dimensions or less, so instead we map a + ! combination of the bins into one integer and have that as the index into + ! a one-dimensional array + + type(TallyScore), allocatable :: score(:) + end type Tally end module tally_header diff --git a/src/xml_tallies.f90 b/src/xml_tallies.f90 index dc4e56ee8b..2fb0a46fb1 100644 --- a/src/xml_tallies.f90 +++ b/src/xml_tallies.f90 @@ -7,18 +7,20 @@ module xml_data_tallies_t logical, private :: strict_ type filter_xml - character(len=250) :: region + character(len=250) :: cell + character(len=250) :: surface + character(len=250) :: universe + character(len=250) :: material + character(len=250) :: mesh character(len=250) :: bornin character(len=250) :: energy character(len=250) :: energyout - character(len=250) :: material - character(len=250) :: surface - character(len=250) :: mesh end type filter_xml type tally_xml integer :: id type(filter_xml) :: filters + character(len=250) :: macros character(len=250) :: reactions character(len=250) :: nuclides end type tally_xml @@ -67,20 +69,22 @@ subroutine read_xml_type_filter_xml( info, starttag, endtag, attribs, noattribs, logical :: error logical :: endtag_org character(len=len(starttag)) :: tag - logical :: has_region + logical :: has_cell + logical :: has_surface + logical :: has_universe + logical :: has_material + logical :: has_mesh logical :: has_bornin logical :: has_energy logical :: has_energyout - logical :: has_material - logical :: has_surface - logical :: has_mesh - has_region = .false. + has_cell = .false. + has_surface = .false. + has_universe = .false. + has_material = .false. + has_mesh = .false. has_bornin = .false. has_energy = .false. has_energyout = .false. - has_material = .false. - has_surface = .false. - has_mesh = .false. call init_xml_type_filter_xml(dvar) has_dvar = .true. error = .false. @@ -129,10 +133,26 @@ subroutine read_xml_type_filter_xml( info, starttag, endtag, attribs, noattribs, endif endif select case( tag ) - case('region') + case('cell') call read_xml_word( & info, tag, endtag, attribs, noattribs, data, nodata, & - dvar%region, has_region ) + dvar%cell, has_cell ) + case('surface') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%surface, has_surface ) + case('universe') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%universe, has_universe ) + case('material') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%material, has_material ) + case('mesh') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%mesh, has_mesh ) case('bornin') call read_xml_word( & info, tag, endtag, attribs, noattribs, data, nodata, & @@ -145,18 +165,6 @@ subroutine read_xml_type_filter_xml( info, starttag, endtag, attribs, noattribs, call read_xml_word( & info, tag, endtag, attribs, noattribs, data, nodata, & dvar%energyout, has_energyout ) - case('material') - call read_xml_word( & - info, tag, endtag, attribs, noattribs, data, nodata, & - dvar%material, has_material ) - case('surface') - call read_xml_word( & - info, tag, endtag, attribs, noattribs, data, nodata, & - dvar%surface, has_surface ) - case('mesh') - call read_xml_word( & - info, tag, endtag, attribs, noattribs, data, nodata, & - dvar%mesh, has_mesh ) case ('comment', '!--') ! Simply ignore case default @@ -169,34 +177,6 @@ subroutine read_xml_type_filter_xml( info, starttag, endtag, attribs, noattribs, nodata = 0 if ( .not. xml_ok(info) ) exit end do - if ( .not. has_region ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on region') - endif - if ( .not. has_bornin ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on bornin') - endif - if ( .not. has_energy ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on energy') - endif - if ( .not. has_energyout ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on energyout') - endif - if ( .not. has_material ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on material') - endif - if ( .not. has_surface ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on surface') - endif - if ( .not. has_mesh ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on mesh') - endif end subroutine read_xml_type_filter_xml subroutine init_xml_type_filter_xml_array( dvar ) type(filter_xml), dimension(:), pointer :: dvar @@ -207,6 +187,14 @@ subroutine init_xml_type_filter_xml_array( dvar ) end subroutine init_xml_type_filter_xml_array subroutine init_xml_type_filter_xml(dvar) type(filter_xml) :: dvar + dvar%cell = '' + dvar%surface = '' + dvar%universe = '' + dvar%material = '' + dvar%mesh = '' + dvar%bornin = '' + dvar%energy = '' + dvar%energyout = '' end subroutine init_xml_type_filter_xml subroutine write_xml_type_filter_xml_array( & info, tag, indent, dvar ) @@ -230,13 +218,14 @@ subroutine write_xml_type_filter_xml( & indentation = ' ' write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& '<',trim(tag), '>' - call write_to_xml_word( info, 'region', indent+3, dvar%region) + call write_to_xml_word( info, 'cell', indent+3, dvar%cell) + call write_to_xml_word( info, 'surface', indent+3, dvar%surface) + call write_to_xml_word( info, 'universe', indent+3, dvar%universe) + call write_to_xml_word( info, 'material', indent+3, dvar%material) + call write_to_xml_word( info, 'mesh', indent+3, dvar%mesh) call write_to_xml_word( info, 'bornin', indent+3, dvar%bornin) call write_to_xml_word( info, 'energy', indent+3, dvar%energy) call write_to_xml_word( info, 'energyout', indent+3, dvar%energyout) - call write_to_xml_word( info, 'material', indent+3, dvar%material) - call write_to_xml_word( info, 'surface', indent+3, dvar%surface) - call write_to_xml_word( info, 'mesh', indent+3, dvar%mesh) write(info%lun,'(4a)') indentation(1:min(indent,100)), & '' end subroutine write_xml_type_filter_xml @@ -286,10 +275,12 @@ subroutine read_xml_type_tally_xml( info, starttag, endtag, attribs, noattribs, character(len=len(starttag)) :: tag logical :: has_id logical :: has_filters + logical :: has_macros logical :: has_reactions logical :: has_nuclides has_id = .false. has_filters = .false. + has_macros = .false. has_reactions = .false. has_nuclides = .false. call init_xml_type_tally_xml(dvar) @@ -348,6 +339,10 @@ subroutine read_xml_type_tally_xml( info, starttag, endtag, attribs, noattribs, call read_xml_type_filter_xml( & info, tag, endtag, attribs, noattribs, data, nodata, & dvar%filters, has_filters ) + case('macros') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%macros, has_macros ) case('reactions') call read_xml_word( & info, tag, endtag, attribs, noattribs, data, nodata, & @@ -376,14 +371,6 @@ subroutine read_xml_type_tally_xml( info, starttag, endtag, attribs, noattribs, has_dvar = .false. call xml_report_errors(info, 'Missing data on filters') endif - if ( .not. has_reactions ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on reactions') - endif - if ( .not. has_nuclides ) then - has_dvar = .false. - call xml_report_errors(info, 'Missing data on nuclides') - endif end subroutine read_xml_type_tally_xml subroutine init_xml_type_tally_xml_array( dvar ) type(tally_xml), dimension(:), pointer :: dvar @@ -394,6 +381,9 @@ subroutine init_xml_type_tally_xml_array( dvar ) end subroutine init_xml_type_tally_xml_array subroutine init_xml_type_tally_xml(dvar) type(tally_xml) :: dvar + dvar%macros = '' + dvar%reactions = '' + dvar%nuclides = '' end subroutine init_xml_type_tally_xml subroutine write_xml_type_tally_xml_array( & info, tag, indent, dvar ) @@ -419,6 +409,7 @@ subroutine write_xml_type_tally_xml( & '<',trim(tag), '>' call write_to_xml_integer( info, 'id', indent+3, dvar%id) call write_xml_type_filter_xml( info, 'filters', indent+3, dvar%filters) + call write_to_xml_word( info, 'macros', indent+3, dvar%macros) call write_to_xml_word( info, 'reactions', indent+3, dvar%reactions) call write_to_xml_word( info, 'nuclides', indent+3, dvar%nuclides) write(info%lun,'(4a)') indentation(1:min(indent,100)), & @@ -445,7 +436,7 @@ subroutine read_xml_file_tallies_t(fname, lurep, errout) call init_xml_file_tallies_t call xml_open( info, fname, .true. ) - call xml_options( info, report_errors=.true., ignore_whitespace=.true.) + call xml_options( info, report_errors=.false., ignore_whitespace=.true.) lurep_ = 0 if ( present(lurep) ) then lurep_ = lurep