From 9017a7d5331730915557c879fc7e3345fc171e3c Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Thu, 23 Jun 2016 16:40:18 -0500 Subject: [PATCH 01/23] Start coding object-oriented tally filters --- src/cmfd_data.F90 | 11 +- src/cmfd_input.F90 | 90 +- src/initialize.F90 | 105 +- src/input_xml.F90 | 505 ++++---- src/output.F90 | 826 ++++++------- src/state_point.F90 | 46 +- src/summary.F90 | 72 +- src/tally.F90 | 2269 ++++++++++++++++------------------- src/tally_filter.F90 | 913 ++++++++++++++ src/tally_filter_header.F90 | 64 + src/tally_header.F90 | 21 +- src/tally_initialize.F90 | 88 +- src/trigger.F90 | 8 +- 13 files changed, 2859 insertions(+), 2159 deletions(-) create mode 100644 src/tally_filter.F90 create mode 100644 src/tally_filter_header.F90 diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 347351e31..61e74716c 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -6,6 +6,7 @@ module cmfd_data !============================================================================== use constants + use tally_filter, only: MeshFilter implicit none private @@ -94,7 +95,10 @@ contains ! Associate tallies and mesh t => cmfd_tallies(1) - i_mesh = t % filters(t % find_filter(FILTER_MESH)) % int_bins(1) + select type(filt => t % filters(t % find_filter(FILTER_MESH)) % obj) + type is (MeshFilter) + i_mesh = filt % mesh + end select m => meshes(i_mesh) ! Set mesh widths @@ -109,7 +113,10 @@ contains ! Associate tallies and mesh t => cmfd_tallies(ital) - i_mesh = t % filters(t % find_filter(FILTER_MESH)) % int_bins(1) + select type(filt => t % filters(t % find_filter(FILTER_MESH)) % obj) + type is (MeshFilter) + i_mesh = filt % mesh + end select m => meshes(i_mesh) i_filter_mesh = t % find_filter(FILTER_MESH) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index f69c09fe1..ecd22b5ab 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -267,7 +267,9 @@ contains use mesh_header, only: RegularMesh use string use tally, only: setup_active_cmfdtallies - use tally_header, only: TallyObject, TallyFilter + use tally_header, only: TallyObject + use tally_filter_header + use tally_filter use tally_initialize, only: add_tallies use xml_interface @@ -283,7 +285,7 @@ contains real(8) :: rarray3(3) ! temp double array type(TallyObject), pointer :: t type(RegularMesh), pointer :: m - type(TallyFilter) :: filters(N_FILTER_TYPES) ! temporary filters + type(TallyFilterContainer) :: filters(N_FILTER_TYPES) ! temporary filters type(Node), pointer :: node_mesh ! Set global variables if they are 0 (this can happen if there is no tally @@ -410,21 +412,25 @@ contains ! Set up mesh filter n_filters = 1 - filters(n_filters) % type = FILTER_MESH - filters(n_filters) % n_bins = product(m % dimension) - allocate(filters(n_filters) % int_bins(1)) - filters(n_filters) % int_bins(1) = n_user_meshes + 1 + allocate(MeshFilter::filters(n_filters) % obj) + select type (filt => filters(n_filters) % obj) + type is (MeshFilter) + filt % n_bins = product(m % dimension) + filt % mesh = n_user_meshes + 1 + end select t % find_filter(FILTER_MESH) = n_filters ! Read and set incoming energy mesh filter if (check_for_node(node_mesh, "energy")) then n_filters = n_filters + 1 - filters(n_filters) % type = FILTER_ENERGYIN - ng = get_arraysize_double(node_mesh, "energy") - filters(n_filters) % n_bins = ng - 1 - allocate(filters(n_filters) % real_bins(ng)) - call get_node_array(node_mesh, "energy", & - filters(n_filters) % real_bins) + allocate(EnergyFilter::filters(n_filters) % obj) + select type (filt => filters(n_filters) % obj) + type is (EnergyFilter) + ng = get_arraysize_double(node_mesh, "energy") + filt % n_bins = ng - 1 + allocate(filt % bins(ng)) + call get_node_array(node_mesh, "energy", filt % bins) + end select t % find_filter(FILTER_ENERGYIN) = n_filters end if @@ -481,12 +487,14 @@ contains ! read and set outgoing energy mesh filter if (check_for_node(node_mesh, "energy")) then n_filters = n_filters + 1 - filters(n_filters) % type = FILTER_ENERGYOUT - ng = get_arraysize_double(node_mesh, "energy") - filters(n_filters) % n_bins = ng - 1 - allocate(filters(n_filters) % real_bins(ng)) - call get_node_array(node_mesh, "energy", & - filters(n_filters) % real_bins) + allocate(EnergyoutFilter::filters(n_filters) % obj) + select type (filt => filters(n_filters) % obj) + type is (EnergyoutFilter) + ng = get_arraysize_double(node_mesh, "energy") + filt % n_bins = ng - 1 + allocate(filt % bins(ng)) + call get_node_array(node_mesh, "energy", filt % bins) + end select t % find_filter(FILTER_ENERGYOUT) = n_filters end if @@ -496,8 +504,12 @@ contains t % filters = filters(1:n_filters) ! deallocate filters bins array - if (check_for_node(node_mesh, "energy")) & - deallocate(filters(n_filters) % real_bins) + if (check_for_node(node_mesh, "energy")) then + select type (filt => filters(n_filters) % obj) + type is (EnergyoutFilter) + deallocate(filt % bins) + end select + end if ! Allocate macro reactions allocate(t % score_bins(2)) @@ -522,16 +534,18 @@ contains ! Add extra filter for surface n_filters = n_filters + 1 - filters(n_filters) % type = FILTER_SURFACE - filters(n_filters) % n_bins = 2 * m % n_dimension - allocate(filters(n_filters) % int_bins(2 * m % n_dimension)) - if (m % n_dimension == 2) then - filters(n_filters) % int_bins = (/ IN_RIGHT, OUT_RIGHT, IN_FRONT, & - OUT_FRONT /) - elseif (m % n_dimension == 3) then - filters(n_filters) % int_bins = (/ IN_RIGHT, OUT_RIGHT, IN_FRONT, & - OUT_FRONT, IN_TOP, OUT_TOP /) - end if + allocate(SurfaceFilter::filters(n_filters) % obj) + select type(filt => filters(n_filters) % obj) + type is(SurfaceFilter) + filt % n_bins = 2 * m % n_dimension + allocate(filt % surfaces(2 * m % n_dimension)) + if (m % n_dimension == 2) then + filt % surfaces = (/ IN_RIGHT, OUT_RIGHT, IN_FRONT, OUT_FRONT /) + elseif (m % n_dimension == 3) then + filt % surfaces = (/ IN_RIGHT, OUT_RIGHT, IN_FRONT, OUT_FRONT, & + IN_TOP, OUT_TOP /) + end if + end select t % find_filter(FILTER_SURFACE) = n_filters ! Allocate and set filters @@ -540,7 +554,10 @@ contains t % filters = filters(1:n_filters) ! Deallocate filters bins array - deallocate(filters(n_filters) % int_bins) + select type(filt => filters(n_filters) % obj) + type is (SurfaceFilter) + deallocate(filt % surfaces) + end select ! Allocate macro reactions allocate(t % score_bins(1)) @@ -558,14 +575,17 @@ contains ! We need to increase the dimension by one since we also need ! currents coming into and out of the boundary mesh cells. i_filter_mesh = t % find_filter(FILTER_MESH) - t % filters(i_filter_mesh) % n_bins = product(m % dimension + 1) + t % filters(i_filter_mesh) % obj % n_bins = product(m % dimension + 1) end if ! Deallocate filter bins - deallocate(filters(1) % int_bins) - if (check_for_node(node_mesh, "energy")) & - deallocate(filters(2) % real_bins) + if (check_for_node(node_mesh, "energy")) then + select type(filt => filters(2) % obj) + type is (EnergyFilter) + deallocate(filt % bins) + end select + end if end do diff --git a/src/initialize.F90 b/src/initialize.F90 index 48b3ee61a..d267df631 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -23,8 +23,9 @@ module initialize use state_point, only: load_state_point use string, only: to_str, starts_with, ends_with, str_to_int use summary, only: write_summary - use tally_header, only: TallyObject, TallyResult, TallyFilter + use tally_header, only: TallyObject, TallyResult use tally_initialize,only: configure_tallies + use tally_filter use tally, only: init_tally_routines #ifdef MPI @@ -722,76 +723,15 @@ contains ! ======================================================================= ! ADJUST INDICES FOR EACH TALLY FILTER - FILTER_LOOP: do j = 1, t%n_filters - - select case (t%filters(j)%type) - case (FILTER_DISTRIBCELL) - do k = 1, size(t%filters(j)%int_bins) - id = t%filters(j)%int_bins(k) - if (cell_dict%has_key(id)) then - t%filters(j)%int_bins(k) = cell_dict%get_key(id) - else - call fatal_error("Could not find cell " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t%id))) - end if - - end do - case (FILTER_CELL, FILTER_CELLBORN) - - do k = 1, t%filters(j)%n_bins - id = t%filters(j)%int_bins(k) - if (cell_dict%has_key(id)) then - t%filters(j)%int_bins(k) = cell_dict%get_key(id) - else - call fatal_error("Could not find cell " // trim(to_str(id)) & - &// " specified on tally " // trim(to_str(t%id))) - end if - end do - - case (FILTER_SURFACE) + FILTER_LOOP: do j = 1, t % n_filters + select type(filt => t % filters(j) % obj) + type is (SurfaceFilter) ! Check if this is a surface filter only for surface currents - if (any(t%score_bins == SCORE_CURRENT)) cycle FILTER_LOOP - - do k = 1, t%filters(j)%n_bins - id = t%filters(j)%int_bins(k) - if (surface_dict%has_key(id)) then - t%filters(j)%int_bins(k) = surface_dict%get_key(id) - else - call fatal_error("Could not find surface " // trim(to_str(id)) & - &// " specified on tally " // trim(to_str(t%id))) - end if - end do - - case (FILTER_UNIVERSE) - - do k = 1, t%filters(j)%n_bins - id = t%filters(j)%int_bins(k) - if (universe_dict%has_key(id)) then - t%filters(j)%int_bins(k) = universe_dict%get_key(id) - else - call fatal_error("Could not find universe " // trim(to_str(id)) & - &// " specified on tally " // trim(to_str(t%id))) - end if - end do - - case (FILTER_MATERIAL) - - do k = 1, t%filters(j)%n_bins - id = t%filters(j)%int_bins(k) - if (material_dict%has_key(id)) then - t%filters(j)%int_bins(k) = material_dict%get_key(id) - else - call fatal_error("Could not find material " // trim(to_str(id)) & - &// " specified on tally " // trim(to_str(t%id))) - end if - end do - - case (FILTER_MESH) - - ! The mesh filter already has been set to the index in meshes rather - ! than the user-specified id, so it doesn't need to be changed. - + if (.not. any(t%score_bins == SCORE_CURRENT)) & + call filt % initialize() + class default + call filt % initialize() end select end do FILTER_LOOP @@ -971,13 +911,10 @@ contains ! We need distribcell if any tallies have distribcell filters. do i = 1, n_tallies do j = 1, tallies(i) % n_filters - if (tallies(i) % filters(j) % type == FILTER_DISTRIBCELL) then + select type(filt => tallies(i) % filters(j) % obj) + type is (DistribcellFilter) distribcell_active = .true. - if (size(tallies(i) % filters(j) % int_bins) > 1) then - call fatal_error("A distribcell filter was specified with & - &multiple bins. This feature is not supported.") - end if - end if + end select end do end do @@ -1001,12 +938,11 @@ contains ! Set the number of bins in all distribcell filters. do i = 1, n_tallies do j = 1, tallies(i) % n_filters - associate (filt => tallies(i) % filters(j)) - if (filt % type == FILTER_DISTRIBCELL) then - ! Set the number of bins to the number of instances of the cell. - filt % n_bins = cells(filt % int_bins(1)) % instances - end if - end associate + select type(filt => tallies(i) % filters(j) % obj) + type is (DistribcellFilter) + ! Set the number of bins to the number of instances of the cell. + filt % n_bins = cells(filt % cell) % instances + end select end do end do @@ -1067,9 +1003,10 @@ contains ! List all cells referenced in distribcell filters. do i = 1, n_tallies do j = 1, tallies(i) % n_filters - if (tallies(i) % filters(j) % type == FILTER_DISTRIBCELL) then - call cell_list % add(tallies(i) % filters(j) % int_bins(1)) - end if + select type(filt => tallies(i) % filters(j) % obj) + type is (DistribcellFilter) + call cell_list % add(filt % cell) + end select end do end do diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 3c6143e5a..fc244670f 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -19,7 +19,8 @@ module input_xml use stl_vector, only: VectorInt use string, only: str_to_int, str_to_real, tokenize, & to_lower, to_str, starts_with, ends_with - use tally_header, only: TallyObject, TallyFilter + use tally_header, only: TallyObject + use tally_filter use tally_initialize, only: add_tallies use xml_interface @@ -2642,7 +2643,7 @@ contains type(ElemKeyValueCI), pointer :: pair_list type(TallyObject), pointer :: t type(RegularMesh), pointer :: m - type(TallyFilter), allocatable :: filters(:) ! temporary filters + type(TallyFilterContainer), allocatable :: filters(:) ! temporary filters type(Node), pointer :: doc => null() type(Node), pointer :: node_mesh => null() type(Node), pointer :: node_tal => null() @@ -2916,148 +2917,153 @@ contains select case (temp_str) case ('distribcell') - - ! Set type of filter - t % filters(j) % type = FILTER_DISTRIBCELL - - ! Going to add new filters to this tally if n_words > 1 - - ! Allocate and store bins - allocate(t % filters(j) % int_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % int_bins) + ! Allocate and declare the filter type + allocate(DistribcellFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (DistribcellFilter) + filt % type = FILTER_DISTRIBCELL + if (n_words /= 1) call fatal_error("Only one cell can be & + &specified per distribcell filter.") + ! Store bins + call get_node_value(node_filt, "bins", filt % cell) + end select case ('cell') - ! Set type of filter - t % filters(j) % type = FILTER_CELL - - ! Set number of bins - t % filters(j) % n_bins = n_words - - ! Allocate and store bins - allocate(t % filters(j) % int_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % int_bins) + ! Allocate and declare the filter type + allocate(CellFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (CellFilter) + filt % type = FILTER_CELL + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % cells(n_words)) + call get_node_array(node_filt, "bins", filt % cells) + end select case ('cellborn') - ! Set type of filter - t % filters(j) % type = FILTER_CELLBORN - - ! Set number of bins - t % filters(j) % n_bins = n_words - - ! Allocate and store bins - allocate(t % filters(j) % int_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % int_bins) + ! Allocate and declare the filter type + allocate(CellbornFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (CellbornFilter) + filt % type = FILTER_CELLBORN + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % cells(n_words)) + call get_node_array(node_filt, "bins", filt % cells) + end select case ('material') - ! Set type of filter - t % filters(j) % type = FILTER_MATERIAL - - ! Set number of bins - t % filters(j) % n_bins = n_words - - ! Allocate and store bins - allocate(t % filters(j) % int_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % int_bins) + ! Allocate and declare the filter type + allocate(MaterialFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (MaterialFilter) + filt % type = FILTER_MATERIAL + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % materials(n_words)) + call get_node_array(node_filt, "bins", filt % materials) + end select case ('universe') - ! Set type of filter - t % filters(j) % type = FILTER_UNIVERSE - - ! Set number of bins - t % filters(j) % n_bins = n_words - - ! Allocate and store bins - allocate(t % filters(j) % int_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % int_bins) + ! Allocate and declare the filter type + allocate(UniverseFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (UniverseFilter) + filt % type = FILTER_UNIVERSE + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % universes(n_words)) + call get_node_array(node_filt, "bins", filt % universes) + end select case ('surface') call fatal_error("Surface filter is not yet supported!") - - ! Set type of filter - t % filters(j) % type = FILTER_SURFACE - - ! Set number of bins - t % filters(j) % n_bins = n_words - - ! Allocate and store bins - allocate(t % filters(j) % int_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % int_bins) + ! Allocate and declare the filter type + allocate(SurfaceFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (SurfaceFilter) + filt % type = FILTER_SURFACE + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % surfaces(n_words)) + call get_node_array(node_filt, "bins", filt % surfaces) + end select case ('mesh') - ! Set type of filter - t % filters(j) % type = FILTER_MESH + ! Allocate and declare the filter type + allocate(MeshFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (MeshFilter) + filt % type = FILTER_MESH + if (n_words /= 1) call fatal_error("Only one mesh can be & + &specified per mesh filter.") - ! Check to make sure multiple meshes weren't given - if (n_words /= 1) then - call fatal_error("Can only have one mesh filter specified.") - end if + ! Determine id of mesh + call get_node_value(node_filt, "bins", id) - ! Determine id of mesh - call get_node_value(node_filt, "bins", id) + ! Get pointer to mesh + if (mesh_dict % has_key(id)) then + i_mesh = mesh_dict % get_key(id) + m => meshes(i_mesh) + else + call fatal_error("Could not find mesh " // trim(to_str(id)) & + // " specified on tally " // trim(to_str(t % id))) + end if - ! Get pointer to mesh - if (mesh_dict % has_key(id)) then - i_mesh = mesh_dict % get_key(id) - m => meshes(i_mesh) - else - call fatal_error("Could not find mesh " // trim(to_str(id)) & - // " specified on tally " // trim(to_str(t % id))) - end if + ! Determine number of bins -- this is assuming that the tally is + ! a volume tally and not a surface current tally. If it is a + ! surface current tally, the number of bins will get reset later + filt % n_bins = product(m % dimension) - ! Determine number of bins -- this is assuming that the tally is - ! a volume tally and not a surface current tally. If it is a - ! surface current tally, the number of bins will get reset later - t % filters(j) % n_bins = product(m % dimension) - - ! Allocate and store index of mesh - allocate(t % filters(j) % int_bins(1)) - t % filters(j) % int_bins(1) = i_mesh + ! Store the index of the mesh + filt % mesh = i_mesh + end select case ('energy') - ! Set type of filter - t % filters(j) % type = FILTER_ENERGYIN + ! Allocate and declare the filter type + allocate(EnergyFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (EnergyFilter) + filt % type = FILTER_ENERGYIN + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) - ! Set number of bins - t % filters(j) % n_bins = n_words - 1 - - ! Allocate and store bins - allocate(t % filters(j) % real_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % real_bins) - - ! We can save tallying time if we know that the tally bins - ! match the energy group structure. In that case, the matching bin - ! index is simply the group (after flipping for the different - ! ordering of the library and tallying systems). - if (.not. run_CE) then - if (n_words == energy_groups + 1) then - if (all(t % filters(j) % real_bins == & - energy_bins(energy_groups + 1:1:-1))) & - t % energy_matches_groups = .true. + ! We can save tallying time if we know that the tally bins match + ! the energy group structure. In that case, the matching bin + ! index is simply the group (after flipping for the different + ! ordering of the library and tallying systems). + if (.not. run_CE) then + if (n_words == energy_groups + 1) then + if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & + t % energy_matches_groups = .true. + end if end if - end if + end select case ('energyout') - ! Set type of filter - t % filters(j) % type = FILTER_ENERGYOUT + ! Allocate and declare the filter type + allocate(EnergyoutFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (EnergyoutFilter) + filt % type = FILTER_ENERGYOUT + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) - ! Set number of bins - t % filters(j) % n_bins = n_words - 1 - - ! Allocate and store bins - allocate(t % filters(j) % real_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % real_bins) - - ! We can save tallying time if we know that the tally bins - ! match the energy group structure. In that case, the matching bin - ! index is simply the group (after flipping for the different - ! ordering of the library and tallying systems). - if (.not. run_CE) then - if (n_words == energy_groups + 1) then - if (all(t % filters(j) % real_bins == & - energy_bins(energy_groups + 1:1:-1))) & - t % energyout_matches_groups = .true. + ! We can save tallying time if we know that the tally bins match + ! the energy group structure. In that case, the matching bin + ! index is simply the group (after flipping for the different + ! ordering of the library and tallying systems). + if (.not. run_CE) then + if (n_words == energy_groups + 1) then + if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & + t % energy_matches_groups = .true. + end if end if - end if + end select ! Set to analog estimator t % estimator = ESTIMATOR_ANALOG @@ -3072,123 +3078,127 @@ contains & for multi-group mode.") end if - ! Set type of filter - t % filters(j) % type = FILTER_DELAYEDGROUP + ! Allocate and declare the filter type + allocate(DelayedGroupFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (DelayedGroupFilter) + filt % type = FILTER_DELAYEDGROUP + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % groups(n_words)) + call get_node_array(node_filt, "bins", filt % groups) - ! Set number of bins - t % filters(j) % n_bins = n_words - - ! Allocate and store bins - allocate(t % filters(j) % int_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % int_bins) - - ! Check bins to make sure all are between 1 and MAX_DELAYED_GROUPS - do d = 1, n_words - if (t % filters(j) % int_bins(d) < 1 .or. & - t % filters(j) % int_bins(d) > MAX_DELAYED_GROUPS) then - call fatal_error("Encountered delayedgroup bin with index " & - // trim(to_str(t % filters(j) % int_bins(d))) // " that is& - & outside the range of 1 to MAX_DELAYED_GROUPS ( " & - // trim(to_str(MAX_DELAYED_GROUPS)) // ")") - end if - end do + ! Check that bins are all are between 1 and MAX_DELAYED_GROUPS + do d = 1, n_words + if (filt % groups(d) < 1 .or. & + filt % groups(d) > MAX_DELAYED_GROUPS) then + call fatal_error("Encountered delayedgroup bin with index " & + // trim(to_str(filt % groups(d))) // " that is outside & + &the range of 1 to MAX_DELAYED_GROUPS ( " & + // trim(to_str(MAX_DELAYED_GROUPS)) // ")") + end if + end do + end select case ('mu') - ! Set type of filter - t % filters(j) % type = FILTER_MU + ! Allocate and declare the filter type + allocate(MuFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (MuFilter) + filt % type = FILTER_MU + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) - ! Set number of bins - t % filters(j) % n_bins = n_words - 1 - - ! Allocate and store bins - allocate(t % filters(j) % real_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % real_bins) - - ! Allow a user to input a lone number which will mean that - ! you subivide [-1,1] evenly with the input being the number of bins - if (n_words == 1) then - Nangle = int(t % filters(j) % real_bins(1)) - if (Nangle > 1) then - t % filters(j) % n_bins = Nangle - dangle = TWO / real(Nangle,8) - deallocate(t % filters(j) % real_bins) - allocate(t % filters(j) % real_bins(Nangle + 1)) - do iangle = 1, Nangle - t % filters(j) % real_bins(iangle) = -ONE + (iangle - 1) * dangle - end do - t % filters(j) % real_bins(Nangle + 1) = ONE - else - call fatal_error("Number of bins for mu filter must be& - & greater than 1 on tally " // trim(to_str(t % id)) // ".") + ! Allow a user to input a lone number which will mean that you + ! subdivide [-1,1] evenly with the input being the number of bins + if (n_words == 1) then + Nangle = int(filt % bins(1)) + if (Nangle > 1) then + filt % n_bins = Nangle + dangle = TWO / real(Nangle,8) + deallocate(filt % bins) + allocate(filt % bins(Nangle + 1)) + do iangle = 1, Nangle + filt % bins(iangle) = -ONE + (iangle - 1) * dangle + end do + filt % bins(Nangle + 1) = ONE + else + call fatal_error("Number of bins for mu filter must be& + & greater than 1 on tally " & + // trim(to_str(t % id)) // ".") + end if end if - - end if + end select ! Set to analog estimator t % estimator = ESTIMATOR_ANALOG case ('polar') - ! Set type of filter - t % filters(j) % type = FILTER_POLAR + ! Allocate and declare the filter type + allocate(PolarFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (PolarFilter) + filt % type = FILTER_POLAR + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) - ! Set number of bins - t % filters(j) % n_bins = n_words - 1 - - ! Allocate and store bins - allocate(t % filters(j) % real_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % real_bins) - - ! Allow a user to input a lone number which will mean that - ! you subivide [0,pi] evenly with the input being the number of bins - if (n_words == 1) then - Nangle = int(t % filters(j) % real_bins(1)) - if (Nangle > 1) then - t % filters(j) % n_bins = Nangle - dangle = PI / real(Nangle,8) - deallocate(t % filters(j) % real_bins) - allocate(t % filters(j) % real_bins(Nangle + 1)) - do iangle = 1, Nangle - t % filters(j) % real_bins(iangle) = (iangle - 1) * dangle - end do - t % filters(j) % real_bins(Nangle + 1) = PI - else - call fatal_error("Number of bins for polar filter must be& - & greater than 1 on tally " // trim(to_str(t % id)) // ".") + ! Allow a user to input a lone number which will mean that you + ! subdivide [0,pi] evenly with the input being the number of bins + if (n_words == 1) then + Nangle = int(filt % bins(1)) + if (Nangle > 1) then + filt % n_bins = Nangle + dangle = PI / real(Nangle,8) + deallocate(filt % bins) + allocate(filt % bins(Nangle + 1)) + do iangle = 1, Nangle + filt % bins(iangle) = (iangle - 1) * dangle + end do + filt % bins(Nangle + 1) = PI + else + call fatal_error("Number of bins for mu filter must be& + & greater than 1 on tally " & + // trim(to_str(t % id)) // ".") + end if end if - - end if + end select case ('azimuthal') - ! Set type of filter - t % filters(j) % type = FILTER_AZIMUTHAL + ! Allocate and declare the filter type + allocate(AzimuthalFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (AzimuthalFilter) + filt % type = FILTER_AZIMUTHAL + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) - ! Set number of bins - t % filters(j) % n_bins = n_words - 1 - - ! Allocate and store bins - allocate(t % filters(j) % real_bins(n_words)) - call get_node_array(node_filt, "bins", t % filters(j) % real_bins) - - ! Allow a user to input a lone number which will mean that - ! you sub-divide [-pi,pi) evenly with the input being the number of - ! bins - if (n_words == 1) then - Nangle = int(t % filters(j) % real_bins(1)) - if (Nangle > 1) then - t % filters(j) % n_bins = Nangle - dangle = TWO * PI / real(Nangle,8) - deallocate(t % filters(j) % real_bins) - allocate(t % filters(j) % real_bins(Nangle + 1)) - do iangle = 1, Nangle - t % filters(j) % real_bins(iangle) = -PI + (iangle - 1) * dangle - end do - t % filters(j) % real_bins(Nangle + 1) = PI - else - call fatal_error("Number of bins for azimuthal filter must be& - & greater than 1 on tally " // trim(to_str(t % id)) // ".") + ! Allow a user to input a lone number which will mean that you + ! subdivide [-pi,pi) evenly with the input being the number of + ! bins + if (n_words == 1) then + Nangle = int(filt % bins(1)) + if (Nangle > 1) then + filt % n_bins = Nangle + dangle = TWO * PI / real(Nangle,8) + deallocate(filt % bins) + allocate(filt % bins(Nangle + 1)) + do iangle = 1, Nangle + filt % bins(iangle) = -PI + (iangle - 1) * dangle + end do + filt % bins(Nangle + 1) = PI + else + call fatal_error("Number of bins for mu filter must be& + & greater than 1 on tally " & + // trim(to_str(t % id)) // ".") + end if end if - - end if + end select case default ! Specified tally filter is invalid, raise error @@ -3201,7 +3211,7 @@ contains ! Set find_filter, e.g. if filter(3) has type FILTER_CELL, then ! find_filter(FILTER_CELL) would be set to 3. - t % find_filter(t % filters(j) % type) = j + t % find_filter(t % filters(j) % obj % type) = j end do READ_FILTERS @@ -3251,7 +3261,7 @@ contains ! Check if a delayedgroup filter is present for this tally do l = 1, t % n_filters - if (t % filters(l) % type == FILTER_DELAYEDGROUP) then + if (t % filters(l) % obj % type == FILTER_DELAYEDGROUP) then call warning("A delayedgroup filter was used on a total & &nuclide tally. Cross section libraries are not & &guaranteed to have the same delayed group structure & @@ -3315,7 +3325,7 @@ contains ! Check if a delayedgroup filter is present for this tally do l = 1, t % n_filters - if (t % filters(l) % type == FILTER_DELAYEDGROUP) then + if (t % filters(l) % obj % type == FILTER_DELAYEDGROUP) then call warning("A delayedgroup filter was used on a total nuclide & &tally. Cross section libraries are not guaranteed to have the& & same delayed group structure across all isotopes. In & @@ -3633,13 +3643,18 @@ contains &filter.") end if - ! Get pointer to mesh - i_mesh = t % filters(k) % int_bins(1) - m => meshes(i_mesh) + ! Declare the type of the mesh filter + select type(filt => t % filters(k) % obj) + type is (MeshFilter) - ! We need to increase the dimension by one since we also need - ! currents coming into and out of the boundary mesh cells. - t % filters(k) % n_bins = product(m % dimension + 1) + ! Get pointer to mesh + i_mesh = filt % mesh + m => meshes(i_mesh) + + ! We need to increase the dimension by one since we also need + ! currents coming into and out of the boundary mesh cells. + filt % n_bins = product(m % dimension + 1) + end select ! Copy filters to temporary array allocate(filters(t % n_filters + 1)) @@ -3651,17 +3666,19 @@ contains ! Add surface filter t % n_filters = t % n_filters + 1 - t % filters(t % n_filters) % type = FILTER_SURFACE - t % filters(t % n_filters) % n_bins = 2 * m % n_dimension - allocate(t % filters(t % n_filters) % int_bins(& - 2 * m % n_dimension)) - if (m % n_dimension == 2) then - t % filters(t % n_filters) % int_bins = (/ IN_RIGHT, & - OUT_RIGHT, IN_FRONT, OUT_FRONT /) - elseif (m % n_dimension == 3) then - t % filters(t % n_filters) % int_bins = (/ IN_RIGHT, & - OUT_RIGHT, IN_FRONT, OUT_FRONT, IN_TOP, OUT_TOP /) - end if + allocate(SurfaceFilter::t % filters(t % n_filters) % obj) + select type (filt => t % filters(t % n_filters) % obj) + type is (SurfaceFilter) + filt % type = FILTER_SURFACE + filt % n_bins = 2 * m % n_dimension + allocate(filt % surfaces(2 * m % n_dimension)) + if (m % n_dimension == 2) then + filt % surfaces = (/ IN_RIGHT, OUT_RIGHT, IN_FRONT, OUT_FRONT /) + elseif (m % n_dimension == 3) then + filt % surfaces = (/ IN_RIGHT, OUT_RIGHT, IN_FRONT, OUT_FRONT,& + IN_TOP, OUT_TOP /) + end if + end select t % find_filter(FILTER_SURFACE) = t % n_filters case ('events') @@ -4372,9 +4389,11 @@ contains &meshlines on plot " // trim(to_str(pl % id))) end if - i_mesh = cmfd_tallies(1) % & - filters(cmfd_tallies(1) % find_filter(FILTER_MESH)) % & - int_bins(1) + select type(filt => cmfd_tallies(1) % & + filters(cmfd_tallies(1) % find_filter(FILTER_MESH)) % obj) + type is (MeshFilter) + i_mesh = filt % mesh + end select pl % meshlines_mesh => meshes(i_mesh) case ('entropy') diff --git a/src/output.F90 b/src/output.F90 index d7dfe7e1c..5fe9685a2 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -757,233 +757,233 @@ contains ! Skip if there are no tallies if (n_tallies == 0) return - ! Initialize names for tally filter types - filter_name(FILTER_UNIVERSE) = "Universe" - filter_name(FILTER_MATERIAL) = "Material" - filter_name(FILTER_DISTRIBCELL) = "Distributed Cell" - filter_name(FILTER_CELL) = "Cell" - filter_name(FILTER_CELLBORN) = "Birth Cell" - filter_name(FILTER_SURFACE) = "Surface" - filter_name(FILTER_MESH) = "Mesh" - filter_name(FILTER_ENERGYIN) = "Incoming Energy" - filter_name(FILTER_ENERGYOUT) = "Outgoing Energy" - filter_name(FILTER_MU) = "Change-in-Angle" - filter_name(FILTER_POLAR) = "Polar Angle" - filter_name(FILTER_AZIMUTHAL) = "Azimuthal Angle" - filter_name(FILTER_DELAYEDGROUP) = "Delayed Group" - - ! Initialize names for scores - score_names(abs(SCORE_FLUX)) = "Flux" - score_names(abs(SCORE_TOTAL)) = "Total Reaction Rate" - score_names(abs(SCORE_SCATTER)) = "Scattering Rate" - score_names(abs(SCORE_NU_SCATTER)) = "Scattering Production Rate" - score_names(abs(SCORE_ABSORPTION)) = "Absorption Rate" - score_names(abs(SCORE_FISSION)) = "Fission Rate" - score_names(abs(SCORE_NU_FISSION)) = "Nu-Fission Rate" - score_names(abs(SCORE_KAPPA_FISSION)) = "Kappa-Fission Rate" - score_names(abs(SCORE_EVENTS)) = "Events" - score_names(abs(SCORE_FLUX_YN)) = "Flux Moment" - score_names(abs(SCORE_TOTAL_YN)) = "Total Reaction Rate Moment" - score_names(abs(SCORE_SCATTER_N)) = "Scattering Rate Moment" - score_names(abs(SCORE_SCATTER_PN)) = "Scattering Rate Moment" - score_names(abs(SCORE_SCATTER_YN)) = "Scattering Rate Moment" - score_names(abs(SCORE_NU_SCATTER_N)) = "Scattering Prod. Rate Moment" - score_names(abs(SCORE_NU_SCATTER_PN)) = "Scattering Prod. Rate Moment" - score_names(abs(SCORE_NU_SCATTER_YN)) = "Scattering Prod. Rate Moment" - score_names(abs(SCORE_DELAYED_NU_FISSION)) = "Delayed-Nu-Fission Rate" - score_names(abs(SCORE_INVERSE_VELOCITY)) = "Flux-Weighted Inverse Velocity" - - ! Create filename for tally output - filename = trim(path_output) // "tallies.out" - - ! Open tally file for writing - open(FILE=filename, NEWUNIT=unit_tally, STATUS='replace', ACTION='write') - - ! Calculate t-value for confidence intervals - if (confidence_intervals) then - alpha = ONE - CONFIDENCE_LEVEL - t_value = t_percentile(ONE - alpha/TWO, n_realizations - 1) - end if - - TALLY_LOOP: do i = 1, n_tallies - t => tallies(i) - - if (confidence_intervals) then - ! Calculate t-value for confidence intervals - if (confidence_intervals) then - alpha = ONE - CONFIDENCE_LEVEL - t_value = t_percentile(ONE - alpha/TWO, t % n_realizations - 1) - end if - - ! Multiply uncertainty by t-value - t % results % sum_sq = t_value * t % results % sum_sq - end if - - ! Write header block - if (t % name == "") then - call header("TALLY " // trim(to_str(t % id)), unit=unit_tally, & - level=3) - else - call header("TALLY " // trim(to_str(t % id)) // ": " & - // trim(t % name), unit=unit_tally, level=3) - endif - - ! Handle surface current tallies separately - if (t % type == TALLY_SURFACE_CURRENT) then - call write_surface_current(t, unit_tally) - cycle - end if - - ! WARNING: Admittedly, the logic for moving for printing results is - ! extremely confusing and took quite a bit of time to get correct. The - ! logic is structured this way since it is not practical to have a do - ! loop for each filter variable (given that only a few filters are likely - ! to be used for a given tally. - - ! Initialize bins, filter level, and indentation - matching_bins(1:t%n_filters) = 0 - j = 1 - indent = 0 - - print_bin: do - find_bin: do - ! Check for no filters - if (t % n_filters == 0) exit find_bin - - ! Increment bin combination - matching_bins(j) = matching_bins(j) + 1 - - ! ================================================================= - ! REACHED END OF BINS FOR THIS FILTER, MOVE TO NEXT FILTER - - if (matching_bins(j) > t % filters(j) % n_bins) then - ! If this is the first filter, then exit - if (j == 1) exit print_bin - - matching_bins(j) = 0 - j = j - 1 - indent = indent - 2 - - ! ================================================================= - ! VALID BIN -- WRITE FILTER INFORMATION OR EXIT TO WRITE RESULTS - - else - ! Check if this is last filter - if (j == t % n_filters) exit find_bin - - ! Print current filter information - type = t % filters(j) % type - write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & - trim(filter_name(type)), trim(get_label(t, j)) - indent = indent + 2 - j = j + 1 - end if - - end do find_bin - - ! Print filter information - if (t % n_filters > 0) then - type = t % filters(j) % type - write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & - trim(filter_name(type)), trim(get_label(t, j)) - end if - - ! Determine scoring index for this bin combination -- note that unlike - ! in the score_tally subroutine, we have to use max(bins,1) since all - ! bins below the lowest filter level will be zeros - - if (t % n_filters > 0) then - filter_index = sum((max(matching_bins(1:t%n_filters),1) - 1) * t % stride) + 1 - else - filter_index = 1 - end if - - ! Write results for this filter bin combination - score_index = 0 - if (t % n_filters > 0) indent = indent + 2 - do n = 1, t % n_nuclide_bins - ! Write label for nuclide - i_nuclide = t % nuclide_bins(n) - if (i_nuclide == -1) then - write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & - "Total Material" - else - if (run_CE) then - i_listing = nuclides(i_nuclide) % listing - else - i_listing = nuclides_MG(i_nuclide) % obj % listing - end if - write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & - trim(xs_listings(i_listing) % alias) - end if - - indent = indent + 2 - k = 0 - do l = 1, t % n_user_score_bins - k = k + 1 - score_index = score_index + 1 - select case(t % score_bins(k)) - case (SCORE_SCATTER_N, SCORE_NU_SCATTER_N) - score_name = 'P' // trim(to_str(t % moment_order(k))) // " " // & - score_names(abs(t % score_bins(k))) - write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & - repeat(" ", indent), score_name, & - to_str(t % results(score_index,filter_index) % sum), & - trim(to_str(t % results(score_index,filter_index) % sum_sq)) - case (SCORE_SCATTER_PN, SCORE_NU_SCATTER_PN) - score_index = score_index - 1 - do n_order = 0, t % moment_order(k) - score_index = score_index + 1 - score_name = 'P' // trim(to_str(n_order)) // " " //& - score_names(abs(t % score_bins(k))) - write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & - repeat(" ", indent), score_name, & - to_str(t % results(score_index,filter_index) % sum), & - trim(to_str(t % results(score_index,filter_index) & - % sum_sq)) - end do - k = k + t % moment_order(k) - case (SCORE_SCATTER_YN, SCORE_NU_SCATTER_YN, SCORE_FLUX_YN, & - SCORE_TOTAL_YN) - score_index = score_index - 1 - do n_order = 0, t % moment_order(k) - do nm_order = -n_order, n_order - score_index = score_index + 1 - score_name = 'Y' // trim(to_str(n_order)) // ',' // & - trim(to_str(nm_order)) // " " & - // score_names(abs(t % score_bins(k))) - write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & - repeat(" ", indent), score_name, & - to_str(t % results(score_index,filter_index) % sum), & - trim(to_str(t % results(score_index,filter_index)& - % sum_sq)) - end do - end do - k = k + (t % moment_order(k) + 1)**2 - 1 - case default - if (t % score_bins(k) > 0) then - score_name = reaction_name(t % score_bins(k)) - else - score_name = score_names(abs(t % score_bins(k))) - end if - write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & - repeat(" ", indent), score_name, & - to_str(t % results(score_index,filter_index) % sum), & - trim(to_str(t % results(score_index,filter_index) % sum_sq)) - end select - end do - indent = indent - 2 - - end do - indent = indent - 2 - - if (t % n_filters == 0) exit print_bin - - end do print_bin - - end do TALLY_LOOP - - close(UNIT=unit_tally) +! ! Initialize names for tally filter types +! filter_name(FILTER_UNIVERSE) = "Universe" +! filter_name(FILTER_MATERIAL) = "Material" +! filter_name(FILTER_DISTRIBCELL) = "Distributed Cell" +! filter_name(FILTER_CELL) = "Cell" +! filter_name(FILTER_CELLBORN) = "Birth Cell" +! filter_name(FILTER_SURFACE) = "Surface" +! filter_name(FILTER_MESH) = "Mesh" +! filter_name(FILTER_ENERGYIN) = "Incoming Energy" +! filter_name(FILTER_ENERGYOUT) = "Outgoing Energy" +! filter_name(FILTER_MU) = "Change-in-Angle" +! filter_name(FILTER_POLAR) = "Polar Angle" +! filter_name(FILTER_AZIMUTHAL) = "Azimuthal Angle" +! filter_name(FILTER_DELAYEDGROUP) = "Delayed Group" +! +! ! Initialize names for scores +! score_names(abs(SCORE_FLUX)) = "Flux" +! score_names(abs(SCORE_TOTAL)) = "Total Reaction Rate" +! score_names(abs(SCORE_SCATTER)) = "Scattering Rate" +! score_names(abs(SCORE_NU_SCATTER)) = "Scattering Production Rate" +! score_names(abs(SCORE_ABSORPTION)) = "Absorption Rate" +! score_names(abs(SCORE_FISSION)) = "Fission Rate" +! score_names(abs(SCORE_NU_FISSION)) = "Nu-Fission Rate" +! score_names(abs(SCORE_KAPPA_FISSION)) = "Kappa-Fission Rate" +! score_names(abs(SCORE_EVENTS)) = "Events" +! score_names(abs(SCORE_FLUX_YN)) = "Flux Moment" +! score_names(abs(SCORE_TOTAL_YN)) = "Total Reaction Rate Moment" +! score_names(abs(SCORE_SCATTER_N)) = "Scattering Rate Moment" +! score_names(abs(SCORE_SCATTER_PN)) = "Scattering Rate Moment" +! score_names(abs(SCORE_SCATTER_YN)) = "Scattering Rate Moment" +! score_names(abs(SCORE_NU_SCATTER_N)) = "Scattering Prod. Rate Moment" +! score_names(abs(SCORE_NU_SCATTER_PN)) = "Scattering Prod. Rate Moment" +! score_names(abs(SCORE_NU_SCATTER_YN)) = "Scattering Prod. Rate Moment" +! score_names(abs(SCORE_DELAYED_NU_FISSION)) = "Delayed-Nu-Fission Rate" +! score_names(abs(SCORE_INVERSE_VELOCITY)) = "Flux-Weighted Inverse Velocity" +! +! ! Create filename for tally output +! filename = trim(path_output) // "tallies.out" +! +! ! Open tally file for writing +! open(FILE=filename, NEWUNIT=unit_tally, STATUS='replace', ACTION='write') +! +! ! Calculate t-value for confidence intervals +! if (confidence_intervals) then +! alpha = ONE - CONFIDENCE_LEVEL +! t_value = t_percentile(ONE - alpha/TWO, n_realizations - 1) +! end if +! +! TALLY_LOOP: do i = 1, n_tallies +! t => tallies(i) +! +! if (confidence_intervals) then +! ! Calculate t-value for confidence intervals +! if (confidence_intervals) then +! alpha = ONE - CONFIDENCE_LEVEL +! t_value = t_percentile(ONE - alpha/TWO, t % n_realizations - 1) +! end if +! +! ! Multiply uncertainty by t-value +! t % results % sum_sq = t_value * t % results % sum_sq +! end if +! +! ! Write header block +! if (t % name == "") then +! call header("TALLY " // trim(to_str(t % id)), unit=unit_tally, & +! level=3) +! else +! call header("TALLY " // trim(to_str(t % id)) // ": " & +! // trim(t % name), unit=unit_tally, level=3) +! endif +! +! ! Handle surface current tallies separately +! if (t % type == TALLY_SURFACE_CURRENT) then +! call write_surface_current(t, unit_tally) +! cycle +! end if +! +! ! WARNING: Admittedly, the logic for moving for printing results is +! ! extremely confusing and took quite a bit of time to get correct. The +! ! logic is structured this way since it is not practical to have a do +! ! loop for each filter variable (given that only a few filters are likely +! ! to be used for a given tally. +! +! ! Initialize bins, filter level, and indentation +! matching_bins(1:t%n_filters) = 0 +! j = 1 +! indent = 0 +! +! print_bin: do +! find_bin: do +! ! Check for no filters +! if (t % n_filters == 0) exit find_bin +! +! ! Increment bin combination +! matching_bins(j) = matching_bins(j) + 1 +! +! ! ================================================================= +! ! REACHED END OF BINS FOR THIS FILTER, MOVE TO NEXT FILTER +! +! if (matching_bins(j) > t % filters(j) % n_bins) then +! ! If this is the first filter, then exit +! if (j == 1) exit print_bin +! +! matching_bins(j) = 0 +! j = j - 1 +! indent = indent - 2 +! +! ! ================================================================= +! ! VALID BIN -- WRITE FILTER INFORMATION OR EXIT TO WRITE RESULTS +! +! else +! ! Check if this is last filter +! if (j == t % n_filters) exit find_bin +! +! ! Print current filter information +! type = t % filters(j) % type +! write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & +! trim(filter_name(type)), trim(get_label(t, j)) +! indent = indent + 2 +! j = j + 1 +! end if +! +! end do find_bin +! +! ! Print filter information +! if (t % n_filters > 0) then +! type = t % filters(j) % type +! write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & +! trim(filter_name(type)), trim(get_label(t, j)) +! end if +! +! ! Determine scoring index for this bin combination -- note that unlike +! ! in the score_tally subroutine, we have to use max(bins,1) since all +! ! bins below the lowest filter level will be zeros +! +! if (t % n_filters > 0) then +! filter_index = sum((max(matching_bins(1:t%n_filters),1) - 1) * t % stride) + 1 +! else +! filter_index = 1 +! end if +! +! ! Write results for this filter bin combination +! score_index = 0 +! if (t % n_filters > 0) indent = indent + 2 +! do n = 1, t % n_nuclide_bins +! ! Write label for nuclide +! i_nuclide = t % nuclide_bins(n) +! if (i_nuclide == -1) then +! write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & +! "Total Material" +! else +! if (run_CE) then +! i_listing = nuclides(i_nuclide) % listing +! else +! i_listing = nuclides_MG(i_nuclide) % obj % listing +! end if +! write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & +! trim(xs_listings(i_listing) % alias) +! end if +! +! indent = indent + 2 +! k = 0 +! do l = 1, t % n_user_score_bins +! k = k + 1 +! score_index = score_index + 1 +! select case(t % score_bins(k)) +! case (SCORE_SCATTER_N, SCORE_NU_SCATTER_N) +! score_name = 'P' // trim(to_str(t % moment_order(k))) // " " // & +! score_names(abs(t % score_bins(k))) +! write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & +! repeat(" ", indent), score_name, & +! to_str(t % results(score_index,filter_index) % sum), & +! trim(to_str(t % results(score_index,filter_index) % sum_sq)) +! case (SCORE_SCATTER_PN, SCORE_NU_SCATTER_PN) +! score_index = score_index - 1 +! do n_order = 0, t % moment_order(k) +! score_index = score_index + 1 +! score_name = 'P' // trim(to_str(n_order)) // " " //& +! score_names(abs(t % score_bins(k))) +! write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & +! repeat(" ", indent), score_name, & +! to_str(t % results(score_index,filter_index) % sum), & +! trim(to_str(t % results(score_index,filter_index) & +! % sum_sq)) +! end do +! k = k + t % moment_order(k) +! case (SCORE_SCATTER_YN, SCORE_NU_SCATTER_YN, SCORE_FLUX_YN, & +! SCORE_TOTAL_YN) +! score_index = score_index - 1 +! do n_order = 0, t % moment_order(k) +! do nm_order = -n_order, n_order +! score_index = score_index + 1 +! score_name = 'Y' // trim(to_str(n_order)) // ',' // & +! trim(to_str(nm_order)) // " " & +! // score_names(abs(t % score_bins(k))) +! write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & +! repeat(" ", indent), score_name, & +! to_str(t % results(score_index,filter_index) % sum), & +! trim(to_str(t % results(score_index,filter_index)& +! % sum_sq)) +! end do +! end do +! k = k + (t % moment_order(k) + 1)**2 - 1 +! case default +! if (t % score_bins(k) > 0) then +! score_name = reaction_name(t % score_bins(k)) +! else +! score_name = score_names(abs(t % score_bins(k))) +! end if +! write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & +! repeat(" ", indent), score_name, & +! to_str(t % results(score_index,filter_index) % sum), & +! trim(to_str(t % results(score_index,filter_index) % sum_sq)) +! end select +! end do +! indent = indent - 2 +! +! end do +! indent = indent - 2 +! +! if (t % n_filters == 0) exit print_bin +! +! end do print_bin +! +! end do TALLY_LOOP +! +! close(UNIT=unit_tally) end subroutine write_tallies @@ -1011,151 +1011,151 @@ contains character(MAX_LINE_LEN) :: string type(RegularMesh), pointer :: m - ! Get pointer to mesh - i_filter_mesh = t % find_filter(FILTER_MESH) - i_filter_surf = t % find_filter(FILTER_SURFACE) - m => meshes(t % filters(i_filter_mesh) % int_bins(1)) - - ! initialize bins array - matching_bins(1:t%n_filters) = 1 - - ! determine how many energy in bins there are - i_filter_ein = t % find_filter(FILTER_ENERGYIN) - if (i_filter_ein > 0) then - print_ebin = .true. - n = t % filters(i_filter_ein) % n_bins - else - print_ebin = .false. - n = 1 - end if - - do i = 1, m % dimension(1) - string = "Mesh Index (" // trim(to_str(i)) // ", " - len1 = len_trim(string) - do j = 1, m % dimension(2) - string = string(1:len1+1) // trim(to_str(j)) // ", " - len2 = len_trim(string) - do k = 1, m % dimension(3) - ! Write mesh cell index - string = string(1:len2+1) // trim(to_str(k)) // ")" - write(UNIT=unit_tally, FMT='(1X,A)') trim(string) - - do l = 1, n - if (print_ebin) then - ! Set incoming energy bin - matching_bins(i_filter_ein) = l - - ! Write incoming energy bin - write(UNIT=unit_tally, FMT='(3X,A,1X,A)') & - "Incoming Energy", trim(get_label(t, i_filter_ein)) - end if - - ! Left Surface - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, (/ i-1, j, k /) + 1, .true.) - matching_bins(i_filter_surf) = IN_RIGHT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Outgoing Current to Left", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - matching_bins(i_filter_surf) = OUT_RIGHT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Incoming Current from Left", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - ! Right Surface - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) - matching_bins(i_filter_surf) = IN_RIGHT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Incoming Current from Right", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - matching_bins(i_filter_surf) = OUT_RIGHT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Outgoing Current to Right", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - ! Back Surface - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, (/ i, j-1, k /) + 1, .true.) - matching_bins(i_filter_surf) = IN_FRONT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Outgoing Current to Back", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - matching_bins(i_filter_surf) = OUT_FRONT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Incoming Current from Back", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - ! Front Surface - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) - matching_bins(i_filter_surf) = IN_FRONT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Incoming Current from Front", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - matching_bins(i_filter_surf) = OUT_FRONT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Outgoing Current to Front", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - ! Bottom Surface - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, (/ i, j, k-1 /) + 1, .true.) - matching_bins(i_filter_surf) = IN_TOP - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Outgoing Current to Bottom", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - matching_bins(i_filter_surf) = OUT_TOP - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Incoming Current from Bottom", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - ! Top Surface - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) - matching_bins(i_filter_surf) = IN_TOP - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Incoming Current from Top", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - - matching_bins(i_filter_surf) = OUT_TOP - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & - "Outgoing Current to Top", & - to_str(t % results(1,filter_index) % sum), & - trim(to_str(t % results(1,filter_index) % sum_sq)) - end do - - end do - end do - end do +! ! Get pointer to mesh +! i_filter_mesh = t % find_filter(FILTER_MESH) +! i_filter_surf = t % find_filter(FILTER_SURFACE) +! m => meshes(t % filters(i_filter_mesh) % int_bins(1)) +! +! ! initialize bins array +! matching_bins(1:t%n_filters) = 1 +! +! ! determine how many energy in bins there are +! i_filter_ein = t % find_filter(FILTER_ENERGYIN) +! if (i_filter_ein > 0) then +! print_ebin = .true. +! n = t % filters(i_filter_ein) % n_bins +! else +! print_ebin = .false. +! n = 1 +! end if +! +! do i = 1, m % dimension(1) +! string = "Mesh Index (" // trim(to_str(i)) // ", " +! len1 = len_trim(string) +! do j = 1, m % dimension(2) +! string = string(1:len1+1) // trim(to_str(j)) // ", " +! len2 = len_trim(string) +! do k = 1, m % dimension(3) +! ! Write mesh cell index +! string = string(1:len2+1) // trim(to_str(k)) // ")" +! write(UNIT=unit_tally, FMT='(1X,A)') trim(string) +! +! do l = 1, n +! if (print_ebin) then +! ! Set incoming energy bin +! matching_bins(i_filter_ein) = l +! +! ! Write incoming energy bin +! write(UNIT=unit_tally, FMT='(3X,A,1X,A)') & +! "Incoming Energy", trim(get_label(t, i_filter_ein)) +! end if +! +! ! Left Surface +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, (/ i-1, j, k /) + 1, .true.) +! matching_bins(i_filter_surf) = IN_RIGHT +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Outgoing Current to Left", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! matching_bins(i_filter_surf) = OUT_RIGHT +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Incoming Current from Left", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! ! Right Surface +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) +! matching_bins(i_filter_surf) = IN_RIGHT +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Incoming Current from Right", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! matching_bins(i_filter_surf) = OUT_RIGHT +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Outgoing Current to Right", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! ! Back Surface +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, (/ i, j-1, k /) + 1, .true.) +! matching_bins(i_filter_surf) = IN_FRONT +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Outgoing Current to Back", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! matching_bins(i_filter_surf) = OUT_FRONT +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Incoming Current from Back", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! ! Front Surface +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) +! matching_bins(i_filter_surf) = IN_FRONT +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Incoming Current from Front", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! matching_bins(i_filter_surf) = OUT_FRONT +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Outgoing Current to Front", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! ! Bottom Surface +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, (/ i, j, k-1 /) + 1, .true.) +! matching_bins(i_filter_surf) = IN_TOP +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Outgoing Current to Bottom", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! matching_bins(i_filter_surf) = OUT_TOP +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Incoming Current from Bottom", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! ! Top Surface +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) +! matching_bins(i_filter_surf) = IN_TOP +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Incoming Current from Top", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! +! matching_bins(i_filter_surf) = OUT_TOP +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & +! "Outgoing Current to Top", & +! to_str(t % results(1,filter_index) % sum), & +! trim(to_str(t % results(1,filter_index) % sum_sq)) +! end do +! +! end do +! end do +! end do end subroutine write_surface_current @@ -1178,47 +1178,47 @@ contains type(RegularMesh), pointer :: m type(Universe), pointer :: univ - bin = matching_bins(i_filter) - - select case(t % filters(i_filter) % type) - case (FILTER_UNIVERSE) - i = t % filters(i_filter) % int_bins(bin) - label = to_str(universes(i) % id) - case (FILTER_MATERIAL) - i = t % filters(i_filter) % int_bins(bin) - label = to_str(materials(i) % id) - case (FILTER_CELL, FILTER_CELLBORN) - i = t % filters(i_filter) % int_bins(bin) - label = to_str(cells(i) % id) - case (FILTER_DISTRIBCELL) - label = '' - univ => universes(BASE_UNIVERSE) - offset = 0 - call find_offset(t % filters(i_filter) % int_bins(1), & - univ, bin-1, offset, label) - case (FILTER_SURFACE) - i = t % filters(i_filter) % int_bins(bin) - label = to_str(surfaces(i)%obj%id) - case (FILTER_MESH) - m => meshes(t % filters(i_filter) % int_bins(1)) - allocate(ijk(m % n_dimension)) - call bin_to_mesh_indices(m, bin, ijk) - if (m % n_dimension == 2) then - label = "Index (" // trim(to_str(ijk(1))) // ", " // & - trim(to_str(ijk(2))) // ")" - elseif (m % n_dimension == 3) then - label = "Index (" // trim(to_str(ijk(1))) // ", " // & - trim(to_str(ijk(2))) // ", " // trim(to_str(ijk(3))) // ")" - end if - case (FILTER_ENERGYIN, FILTER_ENERGYOUT, FILTER_MU, FILTER_POLAR, & - FILTER_AZIMUTHAL) - E0 = t % filters(i_filter) % real_bins(bin) - E1 = t % filters(i_filter) % real_bins(bin + 1) - label = "[" // trim(to_str(E0)) // ", " // trim(to_str(E1)) // ")" - case (FILTER_DELAYEDGROUP) - i = t % filters(i_filter) % int_bins(bin) - label = to_str(i) - end select +! bin = matching_bins(i_filter) +! +! select case(t % filters(i_filter) % type) +! case (FILTER_UNIVERSE) +! i = t % filters(i_filter) % int_bins(bin) +! label = to_str(universes(i) % id) +! case (FILTER_MATERIAL) +! i = t % filters(i_filter) % int_bins(bin) +! label = to_str(materials(i) % id) +! case (FILTER_CELL, FILTER_CELLBORN) +! i = t % filters(i_filter) % int_bins(bin) +! label = to_str(cells(i) % id) +! case (FILTER_DISTRIBCELL) +! label = '' +! univ => universes(BASE_UNIVERSE) +! offset = 0 +! call find_offset(t % filters(i_filter) % int_bins(1), & +! univ, bin-1, offset, label) +! case (FILTER_SURFACE) +! i = t % filters(i_filter) % int_bins(bin) +! label = to_str(surfaces(i)%obj%id) +! case (FILTER_MESH) +! m => meshes(t % filters(i_filter) % int_bins(1)) +! allocate(ijk(m % n_dimension)) +! call bin_to_mesh_indices(m, bin, ijk) +! if (m % n_dimension == 2) then +! label = "Index (" // trim(to_str(ijk(1))) // ", " // & +! trim(to_str(ijk(2))) // ")" +! elseif (m % n_dimension == 3) then +! label = "Index (" // trim(to_str(ijk(1))) // ", " // & +! trim(to_str(ijk(2))) // ", " // trim(to_str(ijk(3))) // ")" +! end if +! case (FILTER_ENERGYIN, FILTER_ENERGYOUT, FILTER_MU, FILTER_POLAR, & +! FILTER_AZIMUTHAL) +! E0 = t % filters(i_filter) % real_bins(bin) +! E1 = t % filters(i_filter) % real_bins(bin + 1) +! label = "[" // trim(to_str(E0)) // ", " // trim(to_str(E1)) // ")" +! case (FILTER_DELAYEDGROUP) +! i = t % filters(i_filter) % int_bins(bin) +! label = to_str(i) +! end select end function get_label diff --git a/src/state_point.F90 b/src/state_point.F90 index f37950134..68905ca4a 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -243,51 +243,7 @@ contains FILTER_LOOP: do j = 1, tally % n_filters filter_group = create_group(tally_group, "filter " // & trim(to_str(j))) - - ! Write name of type - select case (tally % filters(j) % type) - case(FILTER_UNIVERSE) - call write_dataset(filter_group, "type", "universe") - case(FILTER_MATERIAL) - call write_dataset(filter_group, "type", "material") - case(FILTER_CELL) - call write_dataset(filter_group, "type", "cell") - case(FILTER_CELLBORN) - call write_dataset(filter_group, "type", "cellborn") - case(FILTER_SURFACE) - call write_dataset(filter_group, "type", "surface") - case(FILTER_MESH) - call write_dataset(filter_group, "type", "mesh") - case(FILTER_ENERGYIN) - call write_dataset(filter_group, "type", "energy") - case(FILTER_ENERGYOUT) - call write_dataset(filter_group, "type", "energyout") - case(FILTER_MU) - call write_dataset(filter_group, "type", "mu") - case(FILTER_POLAR) - call write_dataset(filter_group, "type", "polar") - case(FILTER_AZIMUTHAL) - call write_dataset(filter_group, "type", "azimuthal") - case(FILTER_DISTRIBCELL) - call write_dataset(filter_group, "type", "distribcell") - case(FILTER_DELAYEDGROUP) - call write_dataset(filter_group, "type", "delayedgroup") - end select - - call write_dataset(filter_group, "n_bins", & - tally % filters(j) % n_bins) - if (tally % filters(j) % type == FILTER_ENERGYIN .or. & - tally % filters(j) % type == FILTER_ENERGYOUT .or. & - tally % filters(j) % type == FILTER_MU .or. & - tally % filters(j) % type == FILTER_POLAR .or. & - tally % filters(j) % type == FILTER_AZIMUTHAL) then - call write_dataset(filter_group, "bins", & - tally % filters(j) % real_bins) - else - call write_dataset(filter_group, "bins", & - tally % filters(j) % int_bins) - end if - + call tally % filters(j) % obj % to_statepoint(filter_group) call close_group(filter_group) end do FILTER_LOOP diff --git a/src/summary.F90 b/src/summary.F90 index 2ec96042c..52b4ad9dd 100644 --- a/src/summary.F90 +++ b/src/summary.F90 @@ -3,7 +3,7 @@ module summary use constants use endf, only: reaction_name use geometry_header, only: Cell, Universe, Lattice, RectLattice, & - &HexLattice, BASE_UNIVERSE + &HexLattice use global use hdf5_interface use material_header, only: Material @@ -13,7 +13,6 @@ module summary use surface_header use string, only: to_str use tally_header, only: TallyObject - use output, only: find_offset use hdf5 @@ -586,10 +585,6 @@ contains type(RegularMesh), pointer :: m type(TallyObject), pointer :: t - integer :: offset ! distibcell offset - character(MAX_LINE_LEN), allocatable :: paths(:) ! distribcell paths array - character(MAX_LINE_LEN) :: path ! distribcell path - tallies_group = create_group(file_id, "tallies") ! Write total number of meshes @@ -634,70 +629,7 @@ contains FILTER_LOOP: do j = 1, t % n_filters filter_group = create_group(tally_group, "filter " // trim(to_str(j))) - - ! Write number of bins for this filter - call write_dataset(filter_group, "n_bins", t % filters(j) % n_bins) - - ! Write filter bins - if (t % filters(j) % type == FILTER_ENERGYIN .or. & - t % filters(j)% type == FILTER_ENERGYOUT .or. & - t % filters(j) % type == FILTER_MU .or. & - t % filters(j) % type == FILTER_POLAR .or. & - t % filters(j) % type == FILTER_AZIMUTHAL) then - call write_dataset(filter_group, "bins", t % filters(j) % real_bins) - else - call write_dataset(filter_group, "bins", t % filters(j) % int_bins) - end if - - ! Write paths to reach each distribcell instance - if (t % filters(j) % type == FILTER_DISTRIBCELL) then - ! Allocate array of strings for each distribcell path - allocate(paths(t % filters(j) % n_bins)) - - ! Store path for each distribcell instance - do k = 1, t % filters(j) % n_bins - path = '' - offset = 1 - call find_offset(t % filters(j) % int_bins(1), & - universes(BASE_UNIVERSE), k, offset, path) - paths(k) = path - end do - - ! Write array of distribcell paths to summary file - call write_dataset(filter_group, "paths", paths) - deallocate(paths) - end if - - ! Write name of type - select case (t%filters(j)%type) - case(FILTER_UNIVERSE) - call write_dataset(filter_group, "type", "universe") - case(FILTER_MATERIAL) - call write_dataset(filter_group, "type", "material") - case(FILTER_CELL) - call write_dataset(filter_group, "type", "cell") - case(FILTER_CELLBORN) - call write_dataset(filter_group, "type", "cellborn") - case(FILTER_SURFACE) - call write_dataset(filter_group, "type", "surface") - case(FILTER_MESH) - call write_dataset(filter_group, "type", "mesh") - case(FILTER_ENERGYIN) - call write_dataset(filter_group, "type", "energy") - case(FILTER_ENERGYOUT) - call write_dataset(filter_group, "type", "energyout") - case(FILTER_DISTRIBCELL) - call write_dataset(filter_group, "type", "distribcell") - case(FILTER_MU) - call write_dataset(filter_group, "type", "mu") - case(FILTER_POLAR) - call write_dataset(filter_group, "type", "polar") - case(FILTER_AZIMUTHAL) - call write_dataset(filter_group, "type", "azimuthal") - case(FILTER_DELAYEDGROUP) - call write_dataset(filter_group, "type", "delayedgroup") - end select - + call t % filters(j) % obj % to_summary(filter_group) call close_group(filter_group) end do FILTER_LOOP diff --git a/src/tally.F90 b/src/tally.F90 index b40a39ce0..b11a1eabf 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -15,6 +15,7 @@ module tally use search, only: binary_search use string, only: to_str use tally_header, only: TallyResult, TallyMapItem, TallyMapElement + use tally_filter #ifdef MPI use message_passing @@ -473,23 +474,28 @@ contains ! Check if the delayed group filter is present if (dg_filter > 0) then + select type(filt => t % filters(dg_filter) % obj) + type is (DelayedGroupFilter) - ! Loop over all delayed group bins and tally to them - ! individually - do d_bin = 1, t % filters(dg_filter) % n_bins + ! Loop over all delayed group bins and tally to them + ! individually + do d_bin = 1, filt % n_bins - ! Get the delayed group for this bin - d = t % filters(dg_filter) % int_bins(d_bin) + ! Get the delayed group for this bin + d = filt % groups(d_bin) - ! Compute the yield for this delayed group - yield = nuclides(p % event_nuclide) % nu(E, EMISSION_DELAYED, d) + ! Compute the yield for this delayed group + yield = nuclides(p % event_nuclide) & + % nu(E, EMISSION_DELAYED, d) - ! Compute the score and tally to bin - score = p % absorb_wgt * yield * micro_xs(p % event_nuclide) & - % fission / micro_xs(p % event_nuclide) % absorption - call score_fission_delayed_dg(t, d_bin, score, score_index) - end do - cycle SCORE_LOOP + ! Compute the score and tally to bin + score = p % absorb_wgt * yield & + * micro_xs(p % event_nuclide) % fission & + / micro_xs(p % event_nuclide) % absorption + call score_fission_delayed_dg(t, d_bin, score, score_index) + end do + cycle SCORE_LOOP + end select else ! If the delayed group filter is not present, compute the score ! by multiplying the absorbed weight by the fraction of the @@ -513,18 +519,22 @@ contains ! Check if the delayed group filter is present if (dg_filter > 0) then + select type(filt => t % filters(dg_filter) % obj) + type is (DelayedGroupFilter) - ! Loop over all delayed group bins and tally to them individually - do d_bin = 1, t % filters(dg_filter) % n_bins + ! Loop over all delayed group bins and tally to them + ! individually + do d_bin = 1, filt % n_bins - ! Get the delayed group for this bin - d = t % filters(dg_filter) % int_bins(d_bin) + ! Get the delayed group for this bin + d = filt % groups(d_bin) - ! Compute the score and tally to bin - score = keff * p % wgt_bank / p % n_bank * p % n_delayed_bank(d) - call score_fission_delayed_dg(t, d_bin, score, score_index) - end do - cycle SCORE_LOOP + ! Compute the score and tally to bin + score = keff * p % wgt_bank / p % n_bank * p % n_delayed_bank(d) + call score_fission_delayed_dg(t, d_bin, score, score_index) + end do + cycle SCORE_LOOP + end select else ! Add the contribution from all delayed groups @@ -538,22 +548,26 @@ contains ! Check if the delayed group filter is present if (dg_filter > 0) then + select type(filt => t % filters(dg_filter) % obj) + type is (DelayedGroupFilter) - ! Loop over all delayed group bins and tally to them individually - do d_bin = 1, t % filters(dg_filter) % n_bins + ! Loop over all delayed group bins and tally to them + ! individually + do d_bin = 1, filt % n_bins - ! Get the delayed group for this bin - d = t % filters(dg_filter) % int_bins(d_bin) + ! Get the delayed group for this bin + d = filt % groups(d_bin) - ! Compute the yield for this delayed group - yield = nuclides(i_nuclide) % nu(E, EMISSION_DELAYED, d) + ! Compute the yield for this delayed group + yield = nuclides(i_nuclide) % nu(E, EMISSION_DELAYED, d) - ! Compute the score and tally to bin - score = micro_xs(i_nuclide) % fission * yield * & - atom_density * flux - call score_fission_delayed_dg(t, d_bin, score, score_index) - end do - cycle SCORE_LOOP + ! Compute the score and tally to bin + score = micro_xs(i_nuclide) % fission * yield * & + atom_density * flux + call score_fission_delayed_dg(t, d_bin, score, score_index) + end do + cycle SCORE_LOOP + end select else ! If the delayed group filter is not present, compute the score @@ -567,31 +581,35 @@ contains ! Check if the delayed group filter is present if (dg_filter > 0) then + select type(filt => t % filters(dg_filter) % obj) + type is (DelayedGroupFilter) - ! Loop over all nuclides in the current material - do l = 1, materials(p % material) % n_nuclides + ! Loop over all nuclides in the current material + do l = 1, materials(p % material) % n_nuclides - ! Get atom density - atom_density_ = materials(p % material) % atom_density(l) + ! Get atom density + atom_density_ = materials(p % material) % atom_density(l) - ! Get index in nuclides array - i_nuc = materials(p % material) % nuclide(l) + ! Get index in nuclides array + i_nuc = materials(p % material) % nuclide(l) - ! Loop over all delayed group bins and tally to them individually - do d_bin = 1, t % filters(dg_filter) % n_bins + ! Loop over all delayed group bins and tally to them + ! individually + do d_bin = 1, filt % n_bins - ! Get the delayed group for this bin - d = t % filters(dg_filter) % int_bins(d_bin) + ! Get the delayed group for this bin + d = filt % groups(d_bin) - ! Get the yield for the desired nuclide and delayed group - yield = nuclides(i_nuc) % nu(E, EMISSION_DELAYED, d) + ! Get the yield for the desired nuclide and delayed group + yield = nuclides(i_nuc) % nu(E, EMISSION_DELAYED, d) - ! Compute the score and tally to bin - score = micro_xs(i_nuc) % fission * yield * atom_density_ * flux - call score_fission_delayed_dg(t, d_bin, score, score_index) + ! Compute the score and tally to bin + score = micro_xs(i_nuc) % fission * yield * atom_density_ * flux + call score_fission_delayed_dg(t, d_bin, score, score_index) + end do end do - end do - cycle SCORE_LOOP + cycle SCORE_LOOP + end select else score = ZERO @@ -1520,52 +1538,52 @@ contains type(TallyObject), intent(inout) :: t integer, intent(in) :: i_score ! index for score - integer :: i ! index of outgoing energy filter - integer :: n ! number of energies on filter - integer :: k ! loop index for bank sites - integer :: bin_energyout ! original outgoing energy bin - integer :: i_filter ! index for matching filter bin combination - real(8) :: score ! actual score - real(8) :: E_out ! energy of fission bank site - - ! save original outgoing energy bin and score index - i = t % find_filter(FILTER_ENERGYOUT) - bin_energyout = matching_bins(i) - - ! Get number of energies on filter - n = size(t % filters(i) % real_bins) - - ! Since the creation of fission sites is weighted such that it is - ! expected to create n_particles sites, we need to multiply the - ! score by keff to get the true nu-fission rate. Otherwise, the sum - ! of all nu-fission rates would be ~1.0. - - ! loop over number of particles banked - do k = 1, p % n_bank - ! determine score based on bank site weight and keff - score = keff * fission_bank(n_bank - p % n_bank + k) % wgt - - ! determine outgoing energy from fission bank - E_out = fission_bank(n_bank - p % n_bank + k) % E - - ! check if outgoing energy is within specified range on filter - if (E_out < t % filters(i) % real_bins(1) .or. & - E_out > t % filters(i) % real_bins(n)) cycle - - ! change outgoing energy bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) - - ! determine scoring index - i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - - ! Add score to tally -!$omp atomic - t % results(i_score, i_filter) % value = & - t % results(i_score, i_filter) % value + score - end do - - ! reset outgoing energy bin and score index - matching_bins(i) = bin_energyout +! integer :: i ! index of outgoing energy filter +! integer :: n ! number of energies on filter +! integer :: k ! loop index for bank sites +! integer :: bin_energyout ! original outgoing energy bin +! integer :: i_filter ! index for matching filter bin combination +! real(8) :: score ! actual score +! real(8) :: E_out ! energy of fission bank site +! +! ! save original outgoing energy bin and score index +! i = t % find_filter(FILTER_ENERGYOUT) +! bin_energyout = matching_bins(i) +! +! ! Get number of energies on filter +! n = size(t % filters(i) % real_bins) +! +! ! Since the creation of fission sites is weighted such that it is +! ! expected to create n_particles sites, we need to multiply the +! ! score by keff to get the true nu-fission rate. Otherwise, the sum +! ! of all nu-fission rates would be ~1.0. +! +! ! loop over number of particles banked +! do k = 1, p % n_bank +! ! determine score based on bank site weight and keff +! score = keff * fission_bank(n_bank - p % n_bank + k) % wgt +! +! ! determine outgoing energy from fission bank +! E_out = fission_bank(n_bank - p % n_bank + k) % E +! +! ! check if outgoing energy is within specified range on filter +! if (E_out < t % filters(i) % real_bins(1) .or. & +! E_out > t % filters(i) % real_bins(n)) cycle +! +! ! change outgoing energy bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) +! +! ! determine scoring index +! i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! +! ! Add score to tally +!!$omp atomic +! t % results(i_score, i_filter) % value = & +! t % results(i_score, i_filter) % value + score +! end do +! +! ! reset outgoing energy bin and score index +! matching_bins(i) = bin_energyout end subroutine score_fission_eout_ce @@ -1576,74 +1594,74 @@ contains integer, intent(in) :: i_nuclide ! index for nuclide real(8), intent(in) :: atom_density - integer :: i ! index of outgoing energy filter - integer :: n ! number of energies on filter - integer :: k ! loop index for bank sites - integer :: bin_energyout ! original outgoing energy bin - integer :: i_filter ! index for matching filter bin combination - real(8) :: score ! actual score - integer :: gout ! energy group of fission bank site - integer :: gin ! energy group of incident particle - real(8) :: E_out - - ! save original outgoing energy bin and score index - i = t % find_filter(FILTER_ENERGYOUT) - bin_energyout = matching_bins(i) - - ! Get number of energies on filter - n = size(t % filters(i) % real_bins) - - ! Since the creation of fission sites is weighted such that it is - ! expected to create n_particles sites, we need to multiply the - ! score by keff to get the true nu-fission rate. Otherwise, the sum - ! of all nu-fission rates would be ~1.0. - - ! loop over number of particles banked - do k = 1, p % n_bank - ! determine score based on bank site weight and keff - score = keff * fission_bank(n_bank - p % n_bank + k) % wgt - if (i_nuclide > 0) then - if (survival_biasing) then - gin = p % g - else - gin = p % last_g - end if - score = score * atom_density * & - nuclides_MG(i_nuclide) % obj % get_xs('fission', gin, & - UVW=p % last_uvw) / & - macro_xs(p % material) % obj % get_xs('fission', gin, & - UVW=p % last_uvw) - end if - - if (t % energyout_matches_groups) then - ! determine outgoing energy from fission bank - gout = int(fission_bank(n_bank - p % n_bank + k) % E) - - ! change outgoing energy bin - matching_bins(i) = gout - else - ! determine outgoing energy from fission bank - E_out = energy_bin_avg(int(fission_bank(n_bank - p % n_bank + k) % E)) - - ! check if outgoing energy is within specified range on filter - if (E_out < t % filters(i) % real_bins(1) .or. & - E_out > t % filters(i) % real_bins(n)) cycle - - ! change outgoing energy bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) - end if - - ! determine scoring index - i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - - ! Add score to tally -!$omp atomic - t % results(i_score, i_filter) % value = & - t % results(i_score, i_filter) % value + score - end do - - ! reset outgoing energy bin and score index - matching_bins(i) = bin_energyout +! integer :: i ! index of outgoing energy filter +! integer :: n ! number of energies on filter +! integer :: k ! loop index for bank sites +! integer :: bin_energyout ! original outgoing energy bin +! integer :: i_filter ! index for matching filter bin combination +! real(8) :: score ! actual score +! integer :: gout ! energy group of fission bank site +! integer :: gin ! energy group of incident particle +! real(8) :: E_out +! +! ! save original outgoing energy bin and score index +! i = t % find_filter(FILTER_ENERGYOUT) +! bin_energyout = matching_bins(i) +! +! ! Get number of energies on filter +! n = size(t % filters(i) % real_bins) +! +! ! Since the creation of fission sites is weighted such that it is +! ! expected to create n_particles sites, we need to multiply the +! ! score by keff to get the true nu-fission rate. Otherwise, the sum +! ! of all nu-fission rates would be ~1.0. +! +! ! loop over number of particles banked +! do k = 1, p % n_bank +! ! determine score based on bank site weight and keff +! score = keff * fission_bank(n_bank - p % n_bank + k) % wgt +! if (i_nuclide > 0) then +! if (survival_biasing) then +! gin = p % g +! else +! gin = p % last_g +! end if +! score = score * atom_density * & +! nuclides_MG(i_nuclide) % obj % get_xs('fission', gin, & +! UVW=p % last_uvw) / & +! macro_xs(p % material) % obj % get_xs('fission', gin, & +! UVW=p % last_uvw) +! end if +! +! if (t % energyout_matches_groups) then +! ! determine outgoing energy from fission bank +! gout = int(fission_bank(n_bank - p % n_bank + k) % E) +! +! ! change outgoing energy bin +! matching_bins(i) = gout +! else +! ! determine outgoing energy from fission bank +! E_out = energy_bin_avg(int(fission_bank(n_bank - p % n_bank + k) % E)) +! +! ! check if outgoing energy is within specified range on filter +! if (E_out < t % filters(i) % real_bins(1) .or. & +! E_out > t % filters(i) % real_bins(n)) cycle +! +! ! change outgoing energy bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) +! end if +! +! ! determine scoring index +! i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! +! ! Add score to tally +!!$omp atomic +! t % results(i_score, i_filter) % value = & +! t % results(i_score, i_filter) % value + score +! end do +! +! ! reset outgoing energy bin and score index +! matching_bins(i) = bin_energyout end subroutine score_fission_eout_mg @@ -1660,86 +1678,86 @@ contains type(TallyObject), intent(inout) :: t integer, intent(in) :: i_score ! index for score - integer :: i ! index of outgoing energy filter - integer :: j ! index of delayedgroup filter - integer :: d ! delayed group - integer :: g ! another delayed group - integer :: d_bin ! delayed group bin index - integer :: n ! number of energies on filter - integer :: k ! loop index for bank sites - integer :: bin_energyout ! original outgoing energy bin - integer :: i_filter ! index for matching filter bin combination - real(8) :: score ! actual score - real(8) :: E_out ! energy of fission bank site - - ! Save original outgoing energy bin - i = t % find_filter(FILTER_ENERGYOUT) - bin_energyout = matching_bins(i) - - ! Get the index of delayed group filter - j = t % find_filter(FILTER_DELAYEDGROUP) - - ! Get number of energies on filter - n = size(t % filters(i) % real_bins) - - ! Since the creation of fission sites is weighted such that it is - ! expected to create n_particles sites, we need to multiply the - ! score by keff to get the true delayed-nu-fission rate. - - ! loop over number of particles banked - do k = 1, p % n_bank - - ! get the delayed group - g = fission_bank(n_bank - p % n_bank + k) % delayed_group - - ! check if the particle was born delayed - if (g /= 0) then - - ! determine score based on bank site weight and keff - score = keff * fission_bank(n_bank - p % n_bank + k) % wgt - - ! determine outgoing energy from fission bank - E_out = fission_bank(n_bank - p % n_bank + k) % E - - ! check if outgoing energy is within specified range on filter - if (E_out < t % filters(i) % real_bins(1) .or. & - E_out > t % filters(i) % real_bins(n)) cycle - - ! change outgoing energy bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) - - ! if the delayed group filter is present, tally to corresponding - ! delayed group bin if it exists - if (j > 0) then - - ! loop over delayed group bins until the corresponding bin is found - do d_bin = 1, t % filters(j) % n_bins - d = t % filters(j) % int_bins(d_bin) - - ! check whether the delayed group of the particle is equal to the - ! delayed group of this bin - if (d == g) then - call score_fission_delayed_dg(t, d_bin, score, i_score) - end if - end do - - ! if the delayed group filter is not present, add score to tally - else - - ! determine scoring index - i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - - ! Add score to tally -!$omp atomic - t % results(i_score, i_filter) % value = & - t % results(i_score, i_filter) % value + score - end if - end if - end do - - ! reset outgoing energy bin - matching_bins(i) = bin_energyout - +! integer :: i ! index of outgoing energy filter +! integer :: j ! index of delayedgroup filter +! integer :: d ! delayed group +! integer :: g ! another delayed group +! integer :: d_bin ! delayed group bin index +! integer :: n ! number of energies on filter +! integer :: k ! loop index for bank sites +! integer :: bin_energyout ! original outgoing energy bin +! integer :: i_filter ! index for matching filter bin combination +! real(8) :: score ! actual score +! real(8) :: E_out ! energy of fission bank site +! +! ! Save original outgoing energy bin +! i = t % find_filter(FILTER_ENERGYOUT) +! bin_energyout = matching_bins(i) +! +! ! Get the index of delayed group filter +! j = t % find_filter(FILTER_DELAYEDGROUP) +! +! ! Get number of energies on filter +! n = size(t % filters(i) % real_bins) +! +! ! Since the creation of fission sites is weighted such that it is +! ! expected to create n_particles sites, we need to multiply the +! ! score by keff to get the true delayed-nu-fission rate. +! +! ! loop over number of particles banked +! do k = 1, p % n_bank +! +! ! get the delayed group +! g = fission_bank(n_bank - p % n_bank + k) % delayed_group +! +! ! check if the particle was born delayed +! if (g /= 0) then +! +! ! determine score based on bank site weight and keff +! score = keff * fission_bank(n_bank - p % n_bank + k) % wgt +! +! ! determine outgoing energy from fission bank +! E_out = fission_bank(n_bank - p % n_bank + k) % E +! +! ! check if outgoing energy is within specified range on filter +! if (E_out < t % filters(i) % real_bins(1) .or. & +! E_out > t % filters(i) % real_bins(n)) cycle +! +! ! change outgoing energy bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) +! +! ! if the delayed group filter is present, tally to corresponding +! ! delayed group bin if it exists +! if (j > 0) then +! +! ! loop over delayed group bins until the corresponding bin is found +! do d_bin = 1, t % filters(j) % n_bins +! d = t % filters(j) % int_bins(d_bin) +! +! ! check whether the delayed group of the particle is equal to the +! ! delayed group of this bin +! if (d == g) then +! call score_fission_delayed_dg(t, d_bin, score, i_score) +! end if +! end do +! +! ! if the delayed group filter is not present, add score to tally +! else +! +! ! determine scoring index +! i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! +! ! Add score to tally +!!$omp atomic +! t % results(i_score, i_filter) % value = & +! t % results(i_score, i_filter) % value + score +! end if +! end if +! end do +! +! ! reset outgoing energy bin +! matching_bins(i) = bin_energyout +! end subroutine score_fission_delayed_eout !=============================================================================== @@ -1751,25 +1769,25 @@ contains type(TallyObject), intent(inout) :: t integer, intent(in) :: score_index ! index for score + real(8), intent(in) :: score ! actual score integer, intent(in) :: d_bin ! delayed group bin index - integer :: bin_original ! original bin index - integer :: filter_index ! index for matching filter bin combination - real(8) :: score ! actual score - - ! save original delayed group bin - bin_original = matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) - matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = d_bin - - ! Compute the filter index based on the modified matching_bins - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - -!$omp atomic - t % results(score_index, filter_index) % value = & - t % results(score_index, filter_index) % value + score - - ! reset original delayed group bin - matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = bin_original +! integer :: bin_original ! original bin index +! integer :: filter_index ! index for matching filter bin combination +! +! ! save original delayed group bin +! bin_original = matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) +! matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = d_bin +! +! ! Compute the filter index based on the modified matching_bins +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! +!!$omp atomic +! t % results(score_index, filter_index) % value = & +! t % results(score_index, filter_index) % value + score +! +! ! reset original delayed group bin +! matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = bin_original end subroutine score_fission_delayed_dg @@ -1899,274 +1917,274 @@ contains integer, intent(in) :: i_tally real(8), intent(in) :: d_track - integer :: i ! loop index for filter/score bins - integer :: j ! loop index for direction - integer :: k ! loop index for mesh cell crossings - integer :: b ! loop index for nuclide bins - integer :: ijk0(3) ! indices of starting coordinates - integer :: ijk1(3) ! indices of ending coordinates - integer :: ijk_cross(3) ! indices of mesh cell crossed - integer :: n_cross ! number of surface crossings - integer :: filter_index ! single index for single bin - integer :: i_nuclide ! index in nuclides array - integer :: i_filter_mesh ! index of mesh filter in filters array - real(8) :: atom_density ! density of individual nuclide in atom/b-cm - real(8) :: flux ! tracklength estimate of flux - real(8) :: uvw(3) ! cosine of angle of particle - real(8) :: xyz0(3) ! starting/intermediate coordinates - real(8) :: xyz1(3) ! ending coordinates of particle - real(8) :: xyz_cross(3) ! coordinates of next boundary - real(8) :: d(3) ! distance to each bounding surface - real(8) :: distance ! distance traveled in mesh cell - logical :: found_bin ! was a scoring bin found? - logical :: start_in_mesh ! starting coordinates inside mesh? - logical :: end_in_mesh ! ending coordinates inside mesh? - real(8) :: theta - real(8) :: phi - type(TallyObject), pointer :: t - type(RegularMesh), pointer :: m - type(Material), pointer :: mat - - t => tallies(i_tally) - matching_bins(1:t%n_filters) = 1 - - ! ========================================================================== - ! CHECK IF THIS TRACK INTERSECTS THE MESH - - ! Copy starting and ending location of particle - xyz0 = p % coord(1) % xyz - (d_track - TINY_BIT) * p % coord(1) % uvw - xyz1 = p % coord(1) % xyz - TINY_BIT * p % coord(1) % uvw - - ! Get index for mesh filter - i_filter_mesh = t % find_filter(FILTER_MESH) - - ! Determine indices for starting and ending location - m => meshes(t % filters(i_filter_mesh) % int_bins(1)) - call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) - call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) - - ! Check if start or end is in mesh -- if not, check if track still - ! intersects with mesh - if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then - if (m % n_dimension == 2) then - if (.not. mesh_intersects_2d(m, xyz0, xyz1)) return - else - if (.not. mesh_intersects_3d(m, xyz0, xyz1)) return - end if - end if - - ! Reset starting and ending location - xyz0 = p % coord(1) % xyz - d_track * p % coord(1) % uvw - xyz1 = p % coord(1) % xyz - - ! ========================================================================= - ! CHECK FOR SCORING COMBINATION FOR FILTERS OTHER THAN MESH - - FILTER_LOOP: do i = 1, t % n_filters - - select case (t % filters(i) % type) - case (FILTER_UNIVERSE) - ! determine next universe bin - ! TODO: Account for multiple universes when performing this filter - matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & - p % coord(p % n_coord) % universe, i_tally) - - case (FILTER_MATERIAL) - matching_bins(i) = get_next_bin(FILTER_MATERIAL, & - p % material, i_tally) - - case (FILTER_CELL) - ! determine next cell bin - do j = 1, p % n_coord - position(FILTER_CELL) = 0 - matching_bins(i) = get_next_bin(FILTER_CELL, & - p % coord(j) % cell, i_tally) - if (matching_bins(i) /= NO_BIN_FOUND) exit - end do - - case (FILTER_CELLBORN) - ! determine next cellborn bin - matching_bins(i) = get_next_bin(FILTER_CELLBORN, & - p % cell_born, i_tally) - - case (FILTER_SURFACE) - ! determine next surface bin - matching_bins(i) = get_next_bin(FILTER_SURFACE, & - p % surface, i_tally) - - case (FILTER_ENERGYIN) - ! determine incoming energy bin - k = t % filters(i) % n_bins - - ! check if energy of the particle is within energy bins - if (p % E < t % filters(i) % real_bins(1) .or. & - p % E > t % filters(i) % real_bins(k + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find incoming energy bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - k + 1, p % E) - end if - - case (FILTER_POLAR) - ! Get theta value - theta = acos(p % coord(1) % uvw(3)) - - ! determine polar angle bin - k = t % filters(i) % n_bins - - ! check if particle is within polar angle bins - if (theta < t % filters(i) % real_bins(1) .or. & - theta > t % filters(i) % real_bins(k + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find polar angle bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - k + 1, theta) - end if - - case (FILTER_AZIMUTHAL) - ! make sure the correct direction vector is used - phi = atan2(p % coord(1) % uvw(2), p % coord(1) % uvw(1)) - - ! determine mu bin - k = t % filters(i) % n_bins - - ! check if particle is within azimuthal angle bins - if (phi < t % filters(i) % real_bins(1) .or. & - phi > t % filters(i) % real_bins(k + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find azimuthal angle bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - k + 1, phi) - end if - - end select - - ! Check if no matching bin was found - if (matching_bins(i) == NO_BIN_FOUND) return - - end do FILTER_LOOP - - ! ========================================================================== - ! DETERMINE WHICH MESH CELLS TO SCORE TO - - ! Calculate number of surface crossings - n_cross = sum(abs(ijk1(:m % n_dimension) - ijk0(:m % n_dimension))) + 1 - - ! Copy particle's direction - uvw = p % coord(1) % uvw - - ! Bounding coordinates - do j = 1, m % n_dimension - if (uvw(j) > 0) then - xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) - else - xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) - end if - end do - - MESH_LOOP: do k = 1, n_cross - found_bin = .false. - - ! Calculate distance to each bounding surface. We need to treat special - ! case where the cosine of the angle is zero since this would result in a - ! divide-by-zero. - - if (k == n_cross) xyz_cross = xyz1 - - do j = 1, m % n_dimension - if (uvw(j) == 0) then - d(j) = INFINITY - else - d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) - end if - end do - - ! Determine the closest bounding surface of the mesh cell by calculating - ! the minimum distance - - j = minloc(d(:m % n_dimension), 1) - distance = d(j) - - ! Now use the minimum distance and diretion of the particle to determine - ! which surface was crossed - - if (all(ijk0(:m % n_dimension) >= 1) .and. all(ijk0(:m % n_dimension) <= m % dimension)) then - ijk_cross = ijk0 - found_bin = .true. - end if - - ! Increment indices and determine new crossing point - if (uvw(j) > 0) then - ijk0(j) = ijk0(j) + 1 - xyz_cross(j) = xyz_cross(j) + m % width(j) - else - ijk0(j) = ijk0(j) - 1 - xyz_cross(j) = xyz_cross(j) - m % width(j) - end if - - ! ======================================================================= - ! SCORE TO THIS MESH CELL - - if (found_bin) then - ! Calculate track-length estimate of flux - flux = p % wgt * distance - - ! Determine mesh bin - matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, ijk_cross) - - ! Determining scoring index - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - - if (t % all_nuclides) then - if (p % material /= MATERIAL_VOID) then - ! Score reaction rates for each nuclide in material - call score_all_nuclides(p, i_tally, flux, filter_index) - end if - else - NUCLIDE_BIN_LOOP: do b = 1, t % n_nuclide_bins - ! Get index of nuclide in nuclides array - i_nuclide = t % nuclide_bins(b) - - if (i_nuclide > 0) then - if (p % material /= MATERIAL_VOID) then - ! Get pointer to current material - mat => materials(p % material) - - ! Determine if nuclide is actually in material - NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides - ! If index of nuclide matches the j-th nuclide listed in - ! the material, break out of the loop - if (i_nuclide == mat % nuclide(j)) exit - - ! If we've reached the last nuclide in the material, it - ! means the specified nuclide to be tallied is not in this - ! material - if (j == mat % n_nuclides) then - cycle NUCLIDE_BIN_LOOP - end if - end do NUCLIDE_MAT_LOOP - - atom_density = mat % atom_density(j) - else - atom_density = ZERO - end if - end if - - ! Determine score for each bin - call score_general(p, t, (b-1)*t % n_score_bins, filter_index, & - i_nuclide, atom_density, flux) - - end do NUCLIDE_BIN_LOOP - end if - end if - - ! Calculate new coordinates - xyz0 = xyz0 + distance * uvw - - end do MESH_LOOP +! integer :: i ! loop index for filter/score bins +! integer :: j ! loop index for direction +! integer :: k ! loop index for mesh cell crossings +! integer :: b ! loop index for nuclide bins +! integer :: ijk0(3) ! indices of starting coordinates +! integer :: ijk1(3) ! indices of ending coordinates +! integer :: ijk_cross(3) ! indices of mesh cell crossed +! integer :: n_cross ! number of surface crossings +! integer :: filter_index ! single index for single bin +! integer :: i_nuclide ! index in nuclides array +! integer :: i_filter_mesh ! index of mesh filter in filters array +! real(8) :: atom_density ! density of individual nuclide in atom/b-cm +! real(8) :: flux ! tracklength estimate of flux +! real(8) :: uvw(3) ! cosine of angle of particle +! real(8) :: xyz0(3) ! starting/intermediate coordinates +! real(8) :: xyz1(3) ! ending coordinates of particle +! real(8) :: xyz_cross(3) ! coordinates of next boundary +! real(8) :: d(3) ! distance to each bounding surface +! real(8) :: distance ! distance traveled in mesh cell +! logical :: found_bin ! was a scoring bin found? +! logical :: start_in_mesh ! starting coordinates inside mesh? +! logical :: end_in_mesh ! ending coordinates inside mesh? +! real(8) :: theta +! real(8) :: phi +! type(TallyObject), pointer :: t +! type(RegularMesh), pointer :: m +! type(Material), pointer :: mat +! +! t => tallies(i_tally) +! matching_bins(1:t%n_filters) = 1 +! +! ! ========================================================================== +! ! CHECK IF THIS TRACK INTERSECTS THE MESH +! +! ! Copy starting and ending location of particle +! xyz0 = p % coord(1) % xyz - (d_track - TINY_BIT) * p % coord(1) % uvw +! xyz1 = p % coord(1) % xyz - TINY_BIT * p % coord(1) % uvw +! +! ! Get index for mesh filter +! i_filter_mesh = t % find_filter(FILTER_MESH) +! +! ! Determine indices for starting and ending location +! m => meshes(t % filters(i_filter_mesh) % int_bins(1)) +! call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) +! call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) +! +! ! Check if start or end is in mesh -- if not, check if track still +! ! intersects with mesh +! if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then +! if (m % n_dimension == 2) then +! if (.not. mesh_intersects_2d(m, xyz0, xyz1)) return +! else +! if (.not. mesh_intersects_3d(m, xyz0, xyz1)) return +! end if +! end if +! +! ! Reset starting and ending location +! xyz0 = p % coord(1) % xyz - d_track * p % coord(1) % uvw +! xyz1 = p % coord(1) % xyz +! +! ! ========================================================================= +! ! CHECK FOR SCORING COMBINATION FOR FILTERS OTHER THAN MESH +! +! FILTER_LOOP: do i = 1, t % n_filters +! +! select case (t % filters(i) % type) +! case (FILTER_UNIVERSE) +! ! determine next universe bin +! ! TODO: Account for multiple universes when performing this filter +! matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & +! p % coord(p % n_coord) % universe, i_tally) +! +! case (FILTER_MATERIAL) +! matching_bins(i) = get_next_bin(FILTER_MATERIAL, & +! p % material, i_tally) +! +! case (FILTER_CELL) +! ! determine next cell bin +! do j = 1, p % n_coord +! position(FILTER_CELL) = 0 +! matching_bins(i) = get_next_bin(FILTER_CELL, & +! p % coord(j) % cell, i_tally) +! if (matching_bins(i) /= NO_BIN_FOUND) exit +! end do +! +! case (FILTER_CELLBORN) +! ! determine next cellborn bin +! matching_bins(i) = get_next_bin(FILTER_CELLBORN, & +! p % cell_born, i_tally) +! +! case (FILTER_SURFACE) +! ! determine next surface bin +! matching_bins(i) = get_next_bin(FILTER_SURFACE, & +! p % surface, i_tally) +! +! case (FILTER_ENERGYIN) +! ! determine incoming energy bin +! k = t % filters(i) % n_bins +! +! ! check if energy of the particle is within energy bins +! if (p % E < t % filters(i) % real_bins(1) .or. & +! p % E > t % filters(i) % real_bins(k + 1)) then +! matching_bins(i) = NO_BIN_FOUND +! else +! ! search to find incoming energy bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, & +! k + 1, p % E) +! end if +! +! case (FILTER_POLAR) +! ! Get theta value +! theta = acos(p % coord(1) % uvw(3)) +! +! ! determine polar angle bin +! k = t % filters(i) % n_bins +! +! ! check if particle is within polar angle bins +! if (theta < t % filters(i) % real_bins(1) .or. & +! theta > t % filters(i) % real_bins(k + 1)) then +! matching_bins(i) = NO_BIN_FOUND +! else +! ! search to find polar angle bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, & +! k + 1, theta) +! end if +! +! case (FILTER_AZIMUTHAL) +! ! make sure the correct direction vector is used +! phi = atan2(p % coord(1) % uvw(2), p % coord(1) % uvw(1)) +! +! ! determine mu bin +! k = t % filters(i) % n_bins +! +! ! check if particle is within azimuthal angle bins +! if (phi < t % filters(i) % real_bins(1) .or. & +! phi > t % filters(i) % real_bins(k + 1)) then +! matching_bins(i) = NO_BIN_FOUND +! else +! ! search to find azimuthal angle bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, & +! k + 1, phi) +! end if +! +! end select +! +! ! Check if no matching bin was found +! if (matching_bins(i) == NO_BIN_FOUND) return +! +! end do FILTER_LOOP +! +! ! ========================================================================== +! ! DETERMINE WHICH MESH CELLS TO SCORE TO +! +! ! Calculate number of surface crossings +! n_cross = sum(abs(ijk1(:m % n_dimension) - ijk0(:m % n_dimension))) + 1 +! +! ! Copy particle's direction +! uvw = p % coord(1) % uvw +! +! ! Bounding coordinates +! do j = 1, m % n_dimension +! if (uvw(j) > 0) then +! xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) +! else +! xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) +! end if +! end do +! +! MESH_LOOP: do k = 1, n_cross +! found_bin = .false. +! +! ! Calculate distance to each bounding surface. We need to treat special +! ! case where the cosine of the angle is zero since this would result in a +! ! divide-by-zero. +! +! if (k == n_cross) xyz_cross = xyz1 +! +! do j = 1, m % n_dimension +! if (uvw(j) == 0) then +! d(j) = INFINITY +! else +! d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) +! end if +! end do +! +! ! Determine the closest bounding surface of the mesh cell by calculating +! ! the minimum distance +! +! j = minloc(d(:m % n_dimension), 1) +! distance = d(j) +! +! ! Now use the minimum distance and diretion of the particle to determine +! ! which surface was crossed +! +! if (all(ijk0(:m % n_dimension) >= 1) .and. all(ijk0(:m % n_dimension) <= m % dimension)) then +! ijk_cross = ijk0 +! found_bin = .true. +! end if +! +! ! Increment indices and determine new crossing point +! if (uvw(j) > 0) then +! ijk0(j) = ijk0(j) + 1 +! xyz_cross(j) = xyz_cross(j) + m % width(j) +! else +! ijk0(j) = ijk0(j) - 1 +! xyz_cross(j) = xyz_cross(j) - m % width(j) +! end if +! +! ! ======================================================================= +! ! SCORE TO THIS MESH CELL +! +! if (found_bin) then +! ! Calculate track-length estimate of flux +! flux = p % wgt * distance +! +! ! Determine mesh bin +! matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, ijk_cross) +! +! ! Determining scoring index +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! +! if (t % all_nuclides) then +! if (p % material /= MATERIAL_VOID) then +! ! Score reaction rates for each nuclide in material +! call score_all_nuclides(p, i_tally, flux, filter_index) +! end if +! else +! NUCLIDE_BIN_LOOP: do b = 1, t % n_nuclide_bins +! ! Get index of nuclide in nuclides array +! i_nuclide = t % nuclide_bins(b) +! +! if (i_nuclide > 0) then +! if (p % material /= MATERIAL_VOID) then +! ! Get pointer to current material +! mat => materials(p % material) +! +! ! Determine if nuclide is actually in material +! NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides +! ! If index of nuclide matches the j-th nuclide listed in +! ! the material, break out of the loop +! if (i_nuclide == mat % nuclide(j)) exit +! +! ! If we've reached the last nuclide in the material, it +! ! means the specified nuclide to be tallied is not in this +! ! material +! if (j == mat % n_nuclides) then +! cycle NUCLIDE_BIN_LOOP +! end if +! end do NUCLIDE_MAT_LOOP +! +! atom_density = mat % atom_density(j) +! else +! atom_density = ZERO +! end if +! end if +! +! ! Determine score for each bin +! call score_general(p, t, (b-1)*t % n_score_bins, filter_index, & +! i_nuclide, atom_density, flux) +! +! end do NUCLIDE_BIN_LOOP +! end if +! end if +! +! ! Calculate new coordinates +! xyz0 = xyz0 + distance * uvw +! +! end do MESH_LOOP end subroutine score_tl_on_mesh @@ -2309,181 +2327,8 @@ contains FILTER_LOOP: do i = 1, t % n_filters - select case (t % filters(i) % type) - case (FILTER_MESH) - ! determine mesh bin - m => meshes(t % filters(i) % int_bins(1)) - - ! Determine if we're in the mesh first - call get_mesh_bin(m, p % coord(1) % xyz, matching_bins(i)) - - case (FILTER_UNIVERSE) - ! determine next universe bin - ! TODO: Account for multiple universes when performing this filter - matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & - p % coord(p % n_coord) % universe, i_tally) - - case (FILTER_MATERIAL) - if (p % material == MATERIAL_VOID) then - matching_bins(i) = NO_BIN_FOUND - else - matching_bins(i) = get_next_bin(FILTER_MATERIAL, & - p % material, i_tally) - endif - - case (FILTER_CELL) - ! determine next cell bin - do j = 1, p % n_coord - position(FILTER_CELL) = 0 - matching_bins(i) = get_next_bin(FILTER_CELL, & - p % coord(j) % cell, i_tally) - if (matching_bins(i) /= NO_BIN_FOUND) exit - end do - - case (FILTER_DISTRIBCELL) - ! determine next distribcell bin - distribcell_index = cells(t % filters(i) % int_bins(1)) & - % distribcell_index - matching_bins(i) = NO_BIN_FOUND - offset = 0 - do j = 1, p % n_coord - if (cells(p % coord(j) % cell) % type == CELL_FILL) then - offset = offset + cells(p % coord(j) % cell) % & - offset(distribcell_index) - elseif(cells(p % coord(j) % cell) % type == CELL_LATTICE) then - if (lattices(p % coord(j + 1) % lattice) % obj & - % are_valid_indices([& - p % coord(j + 1) % lattice_x, & - p % coord(j + 1) % lattice_y, & - p % coord(j + 1) % lattice_z])) then - offset = offset + lattices(p % coord(j + 1) % lattice) % obj % & - offset(distribcell_index, & - p % coord(j + 1) % lattice_x, & - p % coord(j + 1) % lattice_y, & - p % coord(j + 1) % lattice_z) - end if - end if - if (t % filters(i) % int_bins(1) == p % coord(j) % cell) then - matching_bins(i) = offset + 1 - exit - end if - end do - - case (FILTER_CELLBORN) - ! determine next cellborn bin - matching_bins(i) = get_next_bin(FILTER_CELLBORN, & - p % cell_born, i_tally) - - case (FILTER_SURFACE) - ! determine next surface bin - matching_bins(i) = get_next_bin(FILTER_SURFACE, & - p % surface, i_tally) - - case (FILTER_ENERGYIN) - ! determine incoming energy bin - n = t % filters(i) % n_bins - - ! make sure the correct energy is used - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - E = p % E - else - E = p % last_E - end if - - ! check if energy of the particle is within energy bins - if (E < t % filters(i) % real_bins(1) .or. & - E > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find incoming energy bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, E) - end if - - case (FILTER_ENERGYOUT) - ! determine outgoing energy bin - n = t % filters(i) % n_bins - - ! check if energy of the particle is within energy bins - if (p % E < t % filters(i) % real_bins(1) .or. & - p % E > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find incoming energy bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, p % E) - end if - - case (FILTER_DELAYEDGROUP) - - if (survival_biasing .and. t % find_filter(FILTER_ENERGYOUT) <= 0) then - matching_bins(i) = 1 - elseif (active_tracklength_tallies % size() > 0) then - matching_bins(i) = 1 - else - if (p % delayed_group == 0) then - matching_bins = NO_BIN_FOUND - else - matching_bins(i) = p % delayed_group - end if - end if - - case (FILTER_MU) - ! determine mu bin - n = t % filters(i) % n_bins - - ! check if particle is within mu bins - if (p % mu < t % filters(i) % real_bins(1) .or. & - p % mu > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find mu bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, p % mu) - end if - - case (FILTER_POLAR) - ! make sure the correct direction vector is used - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - theta = acos(p % coord(1) % uvw(3)) - else - theta = acos(p % last_uvw(3)) - end if - - ! determine polar angle bin - n = t % filters(i) % n_bins - - ! check if particle is within polar angle bins - if (theta < t % filters(i) % real_bins(1) .or. & - theta > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find polar angle bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, theta) - end if - - case (FILTER_AZIMUTHAL) - ! make sure the correct direction vector is used - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - phi = atan2(p % coord(1) % uvw(2), p % coord(1) % uvw(1)) - else - phi = atan2(p % last_uvw(2), p % last_uvw(1)) - end if - ! determine mu bin - n = t % filters(i) % n_bins - - ! check if particle is within azimuthal angle bins - if (phi < t % filters(i) % real_bins(1) .or. & - phi > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find azimuthal angle bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, phi) - end if - - end select + matching_bins(i) = t % filters(i) % obj % get_next_bin(p, t % estimator, & + NO_BIN_FOUND) ! If the current filter didn't match, exit this subroutine if (matching_bins(i) == NO_BIN_FOUND) then @@ -2501,212 +2346,212 @@ contains integer, intent(in) :: i_tally logical, intent(out) :: found_bin - integer :: i ! loop index for filters - integer :: j - integer :: n ! number of bins for single filter - integer :: distribcell_index ! index in distribcell arrays - integer :: offset ! offset for distribcell - real(8) :: theta, phi ! Polar and Azimuthal Angles, respectively - real(8) :: E - type(TallyObject), pointer :: t - type(RegularMesh), pointer :: m - - found_bin = .true. - t => tallies(i_tally) - matching_bins(1:t%n_filters) = 1 - - FILTER_LOOP: do i = 1, t % n_filters - - select case (t % filters(i) % type) - case (FILTER_MESH) - ! determine mesh bin - m => meshes(t % filters(i) % int_bins(1)) - - ! Determine if we're in the mesh first - call get_mesh_bin(m, p % coord(1) % xyz, matching_bins(i)) - - case (FILTER_UNIVERSE) - ! determine next universe bin - ! TODO: Account for multiple universes when performing this filter - matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & - p % coord(p % n_coord) % universe, i_tally) - - case (FILTER_MATERIAL) - if (p % material == MATERIAL_VOID) then - matching_bins(i) = NO_BIN_FOUND - else - matching_bins(i) = get_next_bin(FILTER_MATERIAL, & - p % material, i_tally) - endif - - case (FILTER_CELL) - ! determine next cell bin - do j = 1, p % n_coord - position(FILTER_CELL) = 0 - matching_bins(i) = get_next_bin(FILTER_CELL, & - p % coord(j) % cell, i_tally) - if (matching_bins(i) /= NO_BIN_FOUND) exit - end do - - case (FILTER_DISTRIBCELL) - ! determine next distribcell bin - distribcell_index = cells(t % filters(i) % int_bins(1)) & - % distribcell_index - matching_bins(i) = NO_BIN_FOUND - offset = 0 - do j = 1, p % n_coord - if (cells(p % coord(j) % cell) % type == CELL_FILL) then - offset = offset + cells(p % coord(j) % cell) % & - offset(distribcell_index) - elseif(cells(p % coord(j) % cell) % type == CELL_LATTICE) then - if (lattices(p % coord(j + 1) % lattice) % obj & - % are_valid_indices([& - p % coord(j + 1) % lattice_x, & - p % coord(j + 1) % lattice_y, & - p % coord(j + 1) % lattice_z])) then - offset = offset + lattices(p % coord(j + 1) % lattice) % obj % & - offset(distribcell_index, & - p % coord(j + 1) % lattice_x, & - p % coord(j + 1) % lattice_y, & - p % coord(j + 1) % lattice_z) - end if - end if - if (t % filters(i) % int_bins(1) == p % coord(j) % cell) then - matching_bins(i) = offset + 1 - exit - end if - end do - - case (FILTER_CELLBORN) - ! determine next cellborn bin - matching_bins(i) = get_next_bin(FILTER_CELLBORN, & - p % cell_born, i_tally) - - case (FILTER_SURFACE) - ! determine next surface bin - matching_bins(i) = get_next_bin(FILTER_SURFACE, & - p % surface, i_tally) - - case (FILTER_ENERGYIN) - if (t % energy_matches_groups) then - ! make sure the correct energy group is used - ! Since all groups are filters, the filter bin is the group - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - matching_bins(i) = p % g - else - matching_bins(i) = p % last_g - end if - ! Tallies are ordered in increasing groups, group indices - ! however are the opposite, so switch - matching_bins(i) = energy_groups - matching_bins(i) + 1 - else - ! make sure the correct energy is used - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - E = p % E - else - E = p % last_E - end if - n = t % filters(i) % n_bins - - ! check if energy of the particle is within energy bins - if (E < t % filters(i) % real_bins(1) .or. & - E > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find incoming energy bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, E) - end if - end if - - case (FILTER_ENERGYOUT) - if (t % energyout_matches_groups) then - ! Since all groups are filters, the filter bin is the group - matching_bins(i) = p % g - - ! Tallies are ordered in increasing groups, group indices - ! however are the opposite, so switch - matching_bins(i) = energy_groups - matching_bins(i) + 1 - else - ! determine outgoing energy bin - n = t % filters(i) % n_bins - - ! check if energy of the particle is within energy bins - if (p % E < t % filters(i) % real_bins(1) .or. & - p % E > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find incoming energy bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, p % E) - end if - end if - - case (FILTER_MU) - ! determine mu bin - n = t % filters(i) % n_bins - - ! check if particle is within mu bins - if (p % mu < t % filters(i) % real_bins(1) .or. & - p % mu > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find mu bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, p % mu) - end if - - case (FILTER_POLAR) - ! make sure the correct direction vector is used - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - theta = acos(p % coord(1) % uvw(3)) - else - theta = acos(p % last_uvw(3)) - end if - - ! determine polar angle bin - n = t % filters(i) % n_bins - - ! check if particle is within polar angle bins - if (theta < t % filters(i) % real_bins(1) .or. & - theta > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find polar angle bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, theta) - end if - - case (FILTER_AZIMUTHAL) - ! make sure the correct direction vector is used - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - phi = atan2(p % coord(1) % uvw(2), p % coord(1) % uvw(1)) - else - phi = atan2(p % last_uvw(2), p % last_uvw(1)) - end if - ! determine mu bin - n = t % filters(i) % n_bins - - ! check if particle is within azimuthal angle bins - if (phi < t % filters(i) % real_bins(1) .or. & - phi > t % filters(i) % real_bins(n + 1)) then - matching_bins(i) = NO_BIN_FOUND - else - ! search to find azimuthal angle bin - matching_bins(i) = binary_search(t % filters(i) % real_bins, & - n + 1, phi) - end if - - end select - - ! If the current filter didn't match, exit this subroutine - if (matching_bins(i) == NO_BIN_FOUND) then - found_bin = .false. - return - end if - - end do FILTER_LOOP - +! integer :: i ! loop index for filters +! integer :: j +! integer :: n ! number of bins for single filter +! integer :: distribcell_index ! index in distribcell arrays +! integer :: offset ! offset for distribcell +! real(8) :: theta, phi ! Polar and Azimuthal Angles, respectively +! real(8) :: E +! type(TallyObject), pointer :: t +! type(RegularMesh), pointer :: m +! +! found_bin = .true. +! t => tallies(i_tally) +! matching_bins(1:t%n_filters) = 1 +! +! FILTER_LOOP: do i = 1, t % n_filters +! +! select case (t % filters(i) % type) +! case (FILTER_MESH) +! ! determine mesh bin +! m => meshes(t % filters(i) % int_bins(1)) +! +! ! Determine if we're in the mesh first +! call get_mesh_bin(m, p % coord(1) % xyz, matching_bins(i)) +! +! case (FILTER_UNIVERSE) +! ! determine next universe bin +! ! TODO: Account for multiple universes when performing this filter +! matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & +! p % coord(p % n_coord) % universe, i_tally) +! +! case (FILTER_MATERIAL) +! if (p % material == MATERIAL_VOID) then +! matching_bins(i) = NO_BIN_FOUND +! else +! matching_bins(i) = get_next_bin(FILTER_MATERIAL, & +! p % material, i_tally) +! endif +! +! case (FILTER_CELL) +! ! determine next cell bin +! do j = 1, p % n_coord +! position(FILTER_CELL) = 0 +! matching_bins(i) = get_next_bin(FILTER_CELL, & +! p % coord(j) % cell, i_tally) +! if (matching_bins(i) /= NO_BIN_FOUND) exit +! end do +! +! case (FILTER_DISTRIBCELL) +! ! determine next distribcell bin +! distribcell_index = cells(t % filters(i) % int_bins(1)) & +! % distribcell_index +! matching_bins(i) = NO_BIN_FOUND +! offset = 0 +! do j = 1, p % n_coord +! if (cells(p % coord(j) % cell) % type == CELL_FILL) then +! offset = offset + cells(p % coord(j) % cell) % & +! offset(distribcell_index) +! elseif(cells(p % coord(j) % cell) % type == CELL_LATTICE) then +! if (lattices(p % coord(j + 1) % lattice) % obj & +! % are_valid_indices([& +! p % coord(j + 1) % lattice_x, & +! p % coord(j + 1) % lattice_y, & +! p % coord(j + 1) % lattice_z])) then +! offset = offset + lattices(p % coord(j + 1) % lattice) % obj % & +! offset(distribcell_index, & +! p % coord(j + 1) % lattice_x, & +! p % coord(j + 1) % lattice_y, & +! p % coord(j + 1) % lattice_z) +! end if +! end if +! if (t % filters(i) % int_bins(1) == p % coord(j) % cell) then +! matching_bins(i) = offset + 1 +! exit +! end if +! end do +! +! case (FILTER_CELLBORN) +! ! determine next cellborn bin +! matching_bins(i) = get_next_bin(FILTER_CELLBORN, & +! p % cell_born, i_tally) +! +! case (FILTER_SURFACE) +! ! determine next surface bin +! matching_bins(i) = get_next_bin(FILTER_SURFACE, & +! p % surface, i_tally) +! +! case (FILTER_ENERGYIN) +! if (t % energy_matches_groups) then +! ! make sure the correct energy group is used +! ! Since all groups are filters, the filter bin is the group +! if (t % estimator == ESTIMATOR_TRACKLENGTH) then +! matching_bins(i) = p % g +! else +! matching_bins(i) = p % last_g +! end if +! ! Tallies are ordered in increasing groups, group indices +! ! however are the opposite, so switch +! matching_bins(i) = energy_groups - matching_bins(i) + 1 +! else +! ! make sure the correct energy is used +! if (t % estimator == ESTIMATOR_TRACKLENGTH) then +! E = p % E +! else +! E = p % last_E +! end if +! n = t % filters(i) % n_bins +! +! ! check if energy of the particle is within energy bins +! if (E < t % filters(i) % real_bins(1) .or. & +! E > t % filters(i) % real_bins(n + 1)) then +! matching_bins(i) = NO_BIN_FOUND +! else +! ! search to find incoming energy bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, & +! n + 1, E) +! end if +! end if +! +! case (FILTER_ENERGYOUT) +! if (t % energyout_matches_groups) then +! ! Since all groups are filters, the filter bin is the group +! matching_bins(i) = p % g +! +! ! Tallies are ordered in increasing groups, group indices +! ! however are the opposite, so switch +! matching_bins(i) = energy_groups - matching_bins(i) + 1 +! else +! ! determine outgoing energy bin +! n = t % filters(i) % n_bins +! +! ! check if energy of the particle is within energy bins +! if (p % E < t % filters(i) % real_bins(1) .or. & +! p % E > t % filters(i) % real_bins(n + 1)) then +! matching_bins(i) = NO_BIN_FOUND +! else +! ! search to find incoming energy bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, & +! n + 1, p % E) +! end if +! end if +! +! case (FILTER_MU) +! ! determine mu bin +! n = t % filters(i) % n_bins +! +! ! check if particle is within mu bins +! if (p % mu < t % filters(i) % real_bins(1) .or. & +! p % mu > t % filters(i) % real_bins(n + 1)) then +! matching_bins(i) = NO_BIN_FOUND +! else +! ! search to find mu bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, & +! n + 1, p % mu) +! end if +! +! case (FILTER_POLAR) +! ! make sure the correct direction vector is used +! if (t % estimator == ESTIMATOR_TRACKLENGTH) then +! theta = acos(p % coord(1) % uvw(3)) +! else +! theta = acos(p % last_uvw(3)) +! end if +! +! ! determine polar angle bin +! n = t % filters(i) % n_bins +! +! ! check if particle is within polar angle bins +! if (theta < t % filters(i) % real_bins(1) .or. & +! theta > t % filters(i) % real_bins(n + 1)) then +! matching_bins(i) = NO_BIN_FOUND +! else +! ! search to find polar angle bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, & +! n + 1, theta) +! end if +! +! case (FILTER_AZIMUTHAL) +! ! make sure the correct direction vector is used +! if (t % estimator == ESTIMATOR_TRACKLENGTH) then +! phi = atan2(p % coord(1) % uvw(2), p % coord(1) % uvw(1)) +! else +! phi = atan2(p % last_uvw(2), p % last_uvw(1)) +! end if +! ! determine mu bin +! n = t % filters(i) % n_bins +! +! ! check if particle is within azimuthal angle bins +! if (phi < t % filters(i) % real_bins(1) .or. & +! phi > t % filters(i) % real_bins(n + 1)) then +! matching_bins(i) = NO_BIN_FOUND +! else +! ! search to find azimuthal angle bin +! matching_bins(i) = binary_search(t % filters(i) % real_bins, & +! n + 1, phi) +! end if +! +! end select +! +! ! If the current filter didn't match, exit this subroutine +! if (matching_bins(i) == NO_BIN_FOUND) then +! found_bin = .false. +! return +! end if +! +! end do FILTER_LOOP +! end subroutine get_scoring_bins_mg !=============================================================================== @@ -2718,307 +2563,307 @@ contains type(Particle), intent(in) :: p - integer :: i - integer :: i_tally - integer :: j ! loop indices - integer :: k ! loop indices - integer :: ijk0(3) ! indices of starting coordinates - integer :: ijk1(3) ! indices of ending coordinates - integer :: n_cross ! number of surface crossings - integer :: n ! number of incoming energy bins - integer :: filter_index ! index of scoring bin - integer :: i_filter_mesh ! index of mesh filter in filters array - integer :: i_filter_surf ! index of surface filter in filters - real(8) :: uvw(3) ! cosine of angle of particle - real(8) :: xyz0(3) ! starting/intermediate coordinates - real(8) :: xyz1(3) ! ending coordinates of particle - real(8) :: xyz_cross(3) ! coordinates of bounding surfaces - real(8) :: d(3) ! distance to each bounding surface - real(8) :: distance ! actual distance traveled - logical :: start_in_mesh ! particle's starting xyz in mesh? - logical :: end_in_mesh ! particle's ending xyz in mesh? - logical :: x_same ! same starting/ending x index (i) - logical :: y_same ! same starting/ending y index (j) - logical :: z_same ! same starting/ending z index (k) - type(TallyObject), pointer :: t - type(RegularMesh), pointer :: m - - TALLY_LOOP: do i = 1, active_current_tallies % size() - ! Copy starting and ending location of particle - xyz0 = p % last_xyz - xyz1 = p % coord(1) % xyz - - ! Get pointer to tally - i_tally = active_current_tallies % get_item(i) - t => tallies(i_tally) - - ! Get index for mesh and surface filters - i_filter_mesh = t % find_filter(FILTER_MESH) - i_filter_surf = t % find_filter(FILTER_SURFACE) - - ! Determine indices for starting and ending location - m => meshes(t % filters(i_filter_mesh) % int_bins(1)) - call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) - call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) - - ! Check to if start or end is in mesh -- if not, check if track still - ! intersects with mesh - if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then - if (m % n_dimension == 2) then - if (.not. mesh_intersects_2d(m, xyz0, xyz1)) cycle - else - if (.not. mesh_intersects_3d(m, xyz0, xyz1)) cycle - end if - end if - - ! Calculate number of surface crossings - n_cross = sum(abs(ijk1 - ijk0)) - if (n_cross == 0) then - cycle - end if - - ! Copy particle's direction - uvw = p % coord(1) % uvw - - ! determine incoming energy bin - j = t % find_filter(FILTER_ENERGYIN) - if (j > 0) then - n = t % filters(j) % n_bins - ! check if energy of the particle is within energy bins - if (p % E < t % filters(j) % real_bins(1) .or. & - p % E > t % filters(j) % real_bins(n + 1)) then - cycle - end if - - ! search to find incoming energy bin - matching_bins(j) = binary_search(t % filters(j) % real_bins, & - n + 1, p % E) - end if - - ! ======================================================================= - ! SPECIAL CASES WHERE TWO INDICES ARE THE SAME - - x_same = (ijk0(1) == ijk1(1)) - y_same = (ijk0(2) == ijk1(2)) - z_same = (ijk0(3) == ijk1(3)) - - if (x_same .and. y_same) then - ! Only z crossings - if (uvw(3) > 0) then - do j = ijk0(3), ijk1(3) - 1 - ijk0(3) = j - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = OUT_TOP - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!$omp atomic - t % results(1, filter_index) % value = & - t % results(1, filter_index) % value + p % wgt - end if - end do - else - do j = ijk0(3) - 1, ijk1(3), -1 - ijk0(3) = j - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = IN_TOP - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!$omp atomic - t % results(1, filter_index) % value = & - t % results(1, filter_index) % value + p % wgt - end if - end do - end if - cycle - elseif (x_same .and. z_same) then - ! Only y crossings - if (uvw(2) > 0) then - do j = ijk0(2), ijk1(2) - 1 - ijk0(2) = j - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = OUT_FRONT - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!$omp atomic - t % results(1, filter_index) % value = & - t % results(1, filter_index) % value + p % wgt - end if - end do - else - do j = ijk0(2) - 1, ijk1(2), -1 - ijk0(2) = j - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = IN_FRONT - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!$omp atomic - t % results(1, filter_index) % value = & - t % results(1, filter_index) % value + p % wgt - end if - end do - end if - cycle - elseif (y_same .and. z_same) then - ! Only x crossings - if (uvw(1) > 0) then - do j = ijk0(1), ijk1(1) - 1 - ijk0(1) = j - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = OUT_RIGHT - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!$omp atomic - t % results(1, filter_index) % value = & - t % results(1, filter_index) % value + p % wgt - end if - end do - else - do j = ijk0(1) - 1, ijk1(1), -1 - ijk0(1) = j - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = IN_RIGHT - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!$omp atomic - t % results(1, filter_index) % value = & - t % results(1, filter_index) % value + p % wgt - end if - end do - end if - cycle - end if - - ! ======================================================================= - ! GENERIC CASE - - ! Bounding coordinates - do j = 1, 3 - if (uvw(j) > 0) then - xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) - else - xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) - end if - end do - - do k = 1, n_cross - ! Reset scoring bin index - matching_bins(i_filter_surf) = 0 - - ! Calculate distance to each bounding surface. We need to treat - ! special case where the cosine of the angle is zero since this would - ! result in a divide-by-zero. - - do j = 1, 3 - if (uvw(j) == 0) then - d(j) = INFINITY - else - d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) - end if - end do - - ! Determine the closest bounding surface of the mesh cell by - ! calculating the minimum distance - - distance = minval(d) - - ! Now use the minimum distance and diretion of the particle to - ! determine which surface was crossed - - if (distance == d(1)) then - if (uvw(1) > 0) then - ! Crossing into right mesh cell -- this is treated as outgoing - ! current from (i,j,k) - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = OUT_RIGHT - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - end if - ijk0(1) = ijk0(1) + 1 - xyz_cross(1) = xyz_cross(1) + m % width(1) - else - ! Crossing into left mesh cell -- this is treated as incoming - ! current in (i-1,j,k) - ijk0(1) = ijk0(1) - 1 - xyz_cross(1) = xyz_cross(1) - m % width(1) - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = IN_RIGHT - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - end if - end if - elseif (distance == d(2)) then - if (uvw(2) > 0) then - ! Crossing into front mesh cell -- this is treated as outgoing - ! current in (i,j,k) - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = OUT_FRONT - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - end if - ijk0(2) = ijk0(2) + 1 - xyz_cross(2) = xyz_cross(2) + m % width(2) - else - ! Crossing into back mesh cell -- this is treated as incoming - ! current in (i,j-1,k) - ijk0(2) = ijk0(2) - 1 - xyz_cross(2) = xyz_cross(2) - m % width(2) - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = IN_FRONT - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - end if - end if - else if (distance == d(3)) then - if (uvw(3) > 0) then - ! Crossing into top mesh cell -- this is treated as outgoing - ! current in (i,j,k) - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = OUT_TOP - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - end if - ijk0(3) = ijk0(3) + 1 - xyz_cross(3) = xyz_cross(3) + m % width(3) - else - ! Crossing into bottom mesh cell -- this is treated as incoming - ! current in (i,j,k-1) - ijk0(3) = ijk0(3) - 1 - xyz_cross(3) = xyz_cross(3) - m % width(3) - if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - matching_bins(i_filter_surf) = IN_TOP - matching_bins(i_filter_mesh) = & - mesh_indices_to_bin(m, ijk0 + 1, .true.) - end if - end if - end if - - ! Determine scoring index - if (matching_bins(i_filter_surf) > 0) then - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - - ! Check for errors - if (filter_index <= 0 .or. filter_index > & - t % total_filter_bins) then - call fatal_error("Score index outside range.") - end if - - ! Add to surface current tally -!$omp atomic - t % results(1, filter_index) % value = & - t % results(1, filter_index) % value + p % wgt - end if - - ! Calculate new coordinates - xyz0 = xyz0 + distance * uvw - end do - - end do TALLY_LOOP +! integer :: i +! integer :: i_tally +! integer :: j ! loop indices +! integer :: k ! loop indices +! integer :: ijk0(3) ! indices of starting coordinates +! integer :: ijk1(3) ! indices of ending coordinates +! integer :: n_cross ! number of surface crossings +! integer :: n ! number of incoming energy bins +! integer :: filter_index ! index of scoring bin +! integer :: i_filter_mesh ! index of mesh filter in filters array +! integer :: i_filter_surf ! index of surface filter in filters +! real(8) :: uvw(3) ! cosine of angle of particle +! real(8) :: xyz0(3) ! starting/intermediate coordinates +! real(8) :: xyz1(3) ! ending coordinates of particle +! real(8) :: xyz_cross(3) ! coordinates of bounding surfaces +! real(8) :: d(3) ! distance to each bounding surface +! real(8) :: distance ! actual distance traveled +! logical :: start_in_mesh ! particle's starting xyz in mesh? +! logical :: end_in_mesh ! particle's ending xyz in mesh? +! logical :: x_same ! same starting/ending x index (i) +! logical :: y_same ! same starting/ending y index (j) +! logical :: z_same ! same starting/ending z index (k) +! type(TallyObject), pointer :: t +! type(RegularMesh), pointer :: m +! +! TALLY_LOOP: do i = 1, active_current_tallies % size() +! ! Copy starting and ending location of particle +! xyz0 = p % last_xyz +! xyz1 = p % coord(1) % xyz +! +! ! Get pointer to tally +! i_tally = active_current_tallies % get_item(i) +! t => tallies(i_tally) +! +! ! Get index for mesh and surface filters +! i_filter_mesh = t % find_filter(FILTER_MESH) +! i_filter_surf = t % find_filter(FILTER_SURFACE) +! +! ! Determine indices for starting and ending location +! m => meshes(t % filters(i_filter_mesh) % int_bins(1)) +! call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) +! call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) +! +! ! Check to if start or end is in mesh -- if not, check if track still +! ! intersects with mesh +! if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then +! if (m % n_dimension == 2) then +! if (.not. mesh_intersects_2d(m, xyz0, xyz1)) cycle +! else +! if (.not. mesh_intersects_3d(m, xyz0, xyz1)) cycle +! end if +! end if +! +! ! Calculate number of surface crossings +! n_cross = sum(abs(ijk1 - ijk0)) +! if (n_cross == 0) then +! cycle +! end if +! +! ! Copy particle's direction +! uvw = p % coord(1) % uvw +! +! ! determine incoming energy bin +! j = t % find_filter(FILTER_ENERGYIN) +! if (j > 0) then +! n = t % filters(j) % n_bins +! ! check if energy of the particle is within energy bins +! if (p % E < t % filters(j) % real_bins(1) .or. & +! p % E > t % filters(j) % real_bins(n + 1)) then +! cycle +! end if +! +! ! search to find incoming energy bin +! matching_bins(j) = binary_search(t % filters(j) % real_bins, & +! n + 1, p % E) +! end if +! +! ! ======================================================================= +! ! SPECIAL CASES WHERE TWO INDICES ARE THE SAME +! +! x_same = (ijk0(1) == ijk1(1)) +! y_same = (ijk0(2) == ijk1(2)) +! z_same = (ijk0(3) == ijk1(3)) +! +! if (x_same .and. y_same) then +! ! Only z crossings +! if (uvw(3) > 0) then +! do j = ijk0(3), ijk1(3) - 1 +! ijk0(3) = j +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = OUT_TOP +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!!$omp atomic +! t % results(1, filter_index) % value = & +! t % results(1, filter_index) % value + p % wgt +! end if +! end do +! else +! do j = ijk0(3) - 1, ijk1(3), -1 +! ijk0(3) = j +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = IN_TOP +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!!$omp atomic +! t % results(1, filter_index) % value = & +! t % results(1, filter_index) % value + p % wgt +! end if +! end do +! end if +! cycle +! elseif (x_same .and. z_same) then +! ! Only y crossings +! if (uvw(2) > 0) then +! do j = ijk0(2), ijk1(2) - 1 +! ijk0(2) = j +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = OUT_FRONT +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!!$omp atomic +! t % results(1, filter_index) % value = & +! t % results(1, filter_index) % value + p % wgt +! end if +! end do +! else +! do j = ijk0(2) - 1, ijk1(2), -1 +! ijk0(2) = j +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = IN_FRONT +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!!$omp atomic +! t % results(1, filter_index) % value = & +! t % results(1, filter_index) % value + p % wgt +! end if +! end do +! end if +! cycle +! elseif (y_same .and. z_same) then +! ! Only x crossings +! if (uvw(1) > 0) then +! do j = ijk0(1), ijk1(1) - 1 +! ijk0(1) = j +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = OUT_RIGHT +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!!$omp atomic +! t % results(1, filter_index) % value = & +! t % results(1, filter_index) % value + p % wgt +! end if +! end do +! else +! do j = ijk0(1) - 1, ijk1(1), -1 +! ijk0(1) = j +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = IN_RIGHT +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!!$omp atomic +! t % results(1, filter_index) % value = & +! t % results(1, filter_index) % value + p % wgt +! end if +! end do +! end if +! cycle +! end if +! +! ! ======================================================================= +! ! GENERIC CASE +! +! ! Bounding coordinates +! do j = 1, 3 +! if (uvw(j) > 0) then +! xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) +! else +! xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) +! end if +! end do +! +! do k = 1, n_cross +! ! Reset scoring bin index +! matching_bins(i_filter_surf) = 0 +! +! ! Calculate distance to each bounding surface. We need to treat +! ! special case where the cosine of the angle is zero since this would +! ! result in a divide-by-zero. +! +! do j = 1, 3 +! if (uvw(j) == 0) then +! d(j) = INFINITY +! else +! d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) +! end if +! end do +! +! ! Determine the closest bounding surface of the mesh cell by +! ! calculating the minimum distance +! +! distance = minval(d) +! +! ! Now use the minimum distance and diretion of the particle to +! ! determine which surface was crossed +! +! if (distance == d(1)) then +! if (uvw(1) > 0) then +! ! Crossing into right mesh cell -- this is treated as outgoing +! ! current from (i,j,k) +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = OUT_RIGHT +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! end if +! ijk0(1) = ijk0(1) + 1 +! xyz_cross(1) = xyz_cross(1) + m % width(1) +! else +! ! Crossing into left mesh cell -- this is treated as incoming +! ! current in (i-1,j,k) +! ijk0(1) = ijk0(1) - 1 +! xyz_cross(1) = xyz_cross(1) - m % width(1) +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = IN_RIGHT +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! end if +! end if +! elseif (distance == d(2)) then +! if (uvw(2) > 0) then +! ! Crossing into front mesh cell -- this is treated as outgoing +! ! current in (i,j,k) +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = OUT_FRONT +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! end if +! ijk0(2) = ijk0(2) + 1 +! xyz_cross(2) = xyz_cross(2) + m % width(2) +! else +! ! Crossing into back mesh cell -- this is treated as incoming +! ! current in (i,j-1,k) +! ijk0(2) = ijk0(2) - 1 +! xyz_cross(2) = xyz_cross(2) - m % width(2) +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = IN_FRONT +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! end if +! end if +! else if (distance == d(3)) then +! if (uvw(3) > 0) then +! ! Crossing into top mesh cell -- this is treated as outgoing +! ! current in (i,j,k) +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = OUT_TOP +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! end if +! ijk0(3) = ijk0(3) + 1 +! xyz_cross(3) = xyz_cross(3) + m % width(3) +! else +! ! Crossing into bottom mesh cell -- this is treated as incoming +! ! current in (i,j,k-1) +! ijk0(3) = ijk0(3) - 1 +! xyz_cross(3) = xyz_cross(3) - m % width(3) +! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then +! matching_bins(i_filter_surf) = IN_TOP +! matching_bins(i_filter_mesh) = & +! mesh_indices_to_bin(m, ijk0 + 1, .true.) +! end if +! end if +! end if +! +! ! Determine scoring index +! if (matching_bins(i_filter_surf) > 0) then +! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +! +! ! Check for errors +! if (filter_index <= 0 .or. filter_index > & +! t % total_filter_bins) then +! call fatal_error("Score index outside range.") +! end if +! +! ! Add to surface current tally +!!$omp atomic +! t % results(1, filter_index) % value = & +! t % results(1, filter_index) % value + p % wgt +! end if +! +! ! Calculate new coordinates +! xyz0 = xyz0 + distance * uvw +! end do +! +! end do TALLY_LOOP end subroutine score_surface_current diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 new file mode 100644 index 000000000..5bb71df6f --- /dev/null +++ b/src/tally_filter.F90 @@ -0,0 +1,913 @@ +module tally_filter + + use constants, only: ONE, NO_BIN_FOUND + use geometry_header, only: BASE_UNIVERSE + use global + use hdf5_interface + use mesh_header, only: RegularMesh + use mesh, only: get_mesh_bin, bin_to_mesh_indices, & + get_mesh_indices, mesh_indices_to_bin, & + mesh_intersects_2d, mesh_intersects_3d + use output, only: find_offset + use particle_header, only: Particle + use search, only: binary_search + use string, only: to_str + use tally_filter_header + + implicit none + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: MeshFilter + integer :: mesh + contains + procedure :: get_next_bin => get_next_bin_mesh + procedure :: get_score => get_score_mesh + procedure :: to_statepoint => to_statepoint_mesh + procedure :: to_summary => to_statepoint_mesh + procedure :: initialize => initialize_mesh + end type MeshFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: UniverseFilter + integer, allocatable :: universes(:) + contains + procedure :: get_next_bin => get_next_bin_universe + procedure :: get_score => get_score_universe + procedure :: to_statepoint => to_statepoint_universe + procedure :: to_summary => to_statepoint_universe + procedure :: initialize => initialize_universe + end type UniverseFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: MaterialFilter + integer, allocatable :: materials(:) + contains + procedure :: get_next_bin => get_next_bin_material + procedure :: get_score => get_score_material + procedure :: to_statepoint => to_statepoint_material + procedure :: to_summary => to_statepoint_material + procedure :: initialize => initialize_material + end type MaterialFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: CellFilter + integer, allocatable :: cells(:) + contains + procedure :: get_next_bin => get_next_bin_cell + procedure :: get_score => get_score_cell + procedure :: to_statepoint => to_statepoint_cell + procedure :: to_summary => to_statepoint_cell + procedure :: initialize => initialize_cell + end type CellFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: DistribcellFilter + integer :: cell + contains + procedure :: get_next_bin => get_next_bin_distribcell + procedure :: get_score => get_score_distribcell + procedure :: to_statepoint => to_statepoint_distribcell + procedure :: to_summary => to_summary_distribcell + procedure :: initialize => initialize_distribcell + end type DistribcellFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: CellbornFilter + integer, allocatable :: cells(:) + contains + procedure :: get_next_bin => get_next_bin_cellborn + procedure :: get_score => get_score_cellborn + procedure :: to_statepoint => to_statepoint_cellborn + procedure :: to_summary => to_statepoint_cellborn + procedure :: initialize => initialize_cellborn + end type CellbornFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: SurfaceFilter + integer, allocatable :: surfaces(:) + contains + procedure :: get_next_bin => get_next_bin_surface + procedure :: get_score => get_score_surface + procedure :: to_statepoint => to_statepoint_surface + procedure :: to_summary => to_statepoint_surface + procedure :: initialize => initialize_surface + end type SurfaceFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: EnergyFilter + real(8), allocatable :: bins(:) + contains + procedure :: get_next_bin => get_next_bin_energy + procedure :: get_score => get_score_energy + procedure :: to_statepoint => to_statepoint_energy + procedure :: to_summary => to_statepoint_energy + procedure :: initialize => initialize_energy + end type EnergyFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: EnergyoutFilter + real(8), allocatable :: bins(:) + contains + procedure :: get_next_bin => get_next_bin_energyout + procedure :: get_score => get_score_energyout + procedure :: to_statepoint => to_statepoint_energyout + procedure :: to_summary => to_statepoint_energyout + procedure :: initialize => initialize_energyout + end type EnergyoutFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: DelayedGroupFilter + integer, allocatable :: groups(:) + contains + procedure :: get_next_bin => get_next_bin_dg + procedure :: get_score => get_score_dg + procedure :: to_statepoint => to_statepoint_dg + procedure :: to_summary => to_statepoint_dg + procedure :: initialize => initialize_dg + end type DelayedGroupFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: MuFilter + real(8), allocatable :: bins(:) + contains + procedure :: get_next_bin => get_next_bin_mu + procedure :: get_score => get_score_mu + procedure :: to_statepoint => to_statepoint_mu + procedure :: to_summary => to_statepoint_mu + procedure :: initialize => initialize_mu + end type MuFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: PolarFilter + real(8), allocatable :: bins(:) + contains + procedure :: get_next_bin => get_next_bin_polar + procedure :: get_score => get_score_polar + procedure :: to_statepoint => to_statepoint_polar + procedure :: to_summary => to_statepoint_polar + procedure :: initialize => initialize_polar + end type PolarFilter + +!=============================================================================== +!=============================================================================== + type, extends(TallyFilter) :: AzimuthalFilter + real(8), allocatable :: bins(:) + contains + procedure :: get_next_bin => get_next_bin_azimuthal + procedure :: get_score => get_score_azimuthal + procedure :: to_statepoint => to_statepoint_azimuthal + procedure :: to_summary => to_statepoint_azimuthal + procedure :: initialize => initialize_azimuthal + end type AzimuthalFilter + +contains + + + + + + + + +!=============================================================================== +!=============================================================================== + function get_next_bin_mesh(this, p, estimator, current_bin) result(next_bin) + class(MeshFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + type(RegularMesh), pointer :: m + + m => meshes(this % mesh) + call get_mesh_bin(m, p % coord(1) % xyz, next_bin) + end function get_next_bin_mesh + + function get_score_mesh(this, bin) result(score) + class(MeshFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_mesh + + subroutine to_statepoint_mesh(this, filter_group) + class(MeshFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "mesh") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % mesh ) + end subroutine to_statepoint_mesh + + subroutine initialize_mesh(this) + class(MeshFilter), intent(inout) :: this + end subroutine initialize_mesh + +!=============================================================================== +!=============================================================================== + function get_next_bin_universe(this, p, estimator, current_bin) & + result(next_bin) + class(UniverseFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: i, j, start + logical :: bin_found + + if (current_bin == NO_BIN_FOUND) then + start = 1 + else + start = current_bin + 1 + end if + + bin_found = .false. + do i = start, this % n_bins + do j = 1, p % n_coord + if (p % coord(j) % universe == this % universes(i)) then + next_bin = i + bin_found = .true. + exit + end if + end do + if (bin_found) exit + end do + + if (.not. bin_found) next_bin = NO_BIN_FOUND + end function get_next_bin_universe + + function get_score_universe(this, bin) result(score) + class(UniverseFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_universe + + subroutine to_statepoint_universe(this, filter_group) + class(UniverseFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "universe") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % universes ) + end subroutine to_statepoint_universe + + subroutine initialize_universe(this) + class(UniverseFilter), intent(inout) :: this + + integer :: i, id + + do i = 1, this % n_bins + id = this % universes(i) + if (universe_dict % has_key(id)) then + this % universes(i) = universe_dict % get_key(id) + else + call fatal_error("Could not find universe " // trim(to_str(id)) & + &// " specified on a tally filter.") + end if + end do + end subroutine initialize_universe + +!=============================================================================== +!=============================================================================== + function get_next_bin_material(this, p, estimator, current_bin) & + result(next_bin) + class(MaterialFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: i + logical :: bin_found + + if (current_bin == NO_BIN_FOUND) then + bin_found = .false. + do i = 1, this % n_bins + if (p % material == this % materials(i)) then + next_bin = i + bin_found = .true. + exit + end if + end do + if (.not. bin_found) next_bin = NO_BIN_FOUND + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_material + + function get_score_material(this, bin) result(score) + class(MaterialFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_material + + subroutine to_statepoint_material(this, filter_group) + class(MaterialFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "material") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % materials ) + end subroutine to_statepoint_material + + subroutine initialize_material(this) + class(MaterialFilter), intent(inout) :: this + + integer :: i, id + + do i = 1, this % n_bins + id = this % materials(i) + if (material_dict % has_key(id)) then + this % materials(i) = material_dict % get_key(id) + else + call fatal_error("Could not find material " // trim(to_str(id)) & + &// " specified on a tally filter.") + end if + end do + end subroutine initialize_material + +!=============================================================================== +!=============================================================================== + function get_next_bin_cell(this, p, estimator, current_bin) result(next_bin) + class(CellFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: i, j, start + logical :: bin_found + + if (current_bin == NO_BIN_FOUND) then + start = 1 + else + start = current_bin + 1 + end if + + bin_found = .false. + do i = start, this % n_bins + do j = 1, p % n_coord + if (p % coord(j) % cell == this % cells(i)) then + next_bin = i + bin_found = .true. + exit + end if + end do + if (bin_found) exit + end do + + if (.not. bin_found) next_bin = NO_BIN_FOUND + end function get_next_bin_cell + + function get_score_cell(this, bin) result(score) + class(CellFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_cell + + subroutine to_statepoint_cell(this, filter_group) + class(CellFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "cell") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % cells ) + end subroutine to_statepoint_cell + + subroutine initialize_cell(this) + class(CellFilter), intent(inout) :: this + + integer :: i, id + + do i = 1, this % n_bins + id = this % cells(i) + if (cell_dict % has_key(id)) then + this % cells(i) = cell_dict % get_key(id) + else + call fatal_error("Could not find cell " // trim(to_str(id)) & + &// " specified on tally filter.") + end if + end do + end subroutine initialize_cell + +!=============================================================================== +!=============================================================================== + function get_next_bin_distribcell(this, p, estimator, current_bin) & + result(next_bin) + class(DistribcellFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: distribcell_index, offset, i + + distribcell_index = cells(this % cell) % distribcell_index + + if (current_bin == NO_BIN_FOUND) then + offset = 0 + do i = 1, p % n_coord + if (cells(p % coord(i) % cell) % type == CELL_FILL) then + offset = offset + cells(p % coord(i) % cell) % & + offset(distribcell_index) + elseif (cells(p % coord(i) % cell) % type == CELL_LATTICE) then + if (lattices(p % coord(i + 1) % lattice) % obj & + % are_valid_indices([& + p % coord(i + 1) % lattice_x, & + p % coord(i + 1) % lattice_y, & + p % coord(i + 1) % lattice_z])) then + offset = offset + lattices(p % coord(i + 1) % lattice) % obj % & + offset(distribcell_index, & + p % coord(i + 1) % lattice_x, & + p % coord(i + 1) % lattice_y, & + p % coord(i + 1) % lattice_z) + end if + end if + if (this % cell == p % coord(i) % cell) then + next_bin = offset + 1 + exit + end if + end do + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_distribcell + + function get_score_distribcell(this, bin) result(score) + class(DistribcellFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_distribcell + + subroutine to_statepoint_distribcell(this, filter_group) + class(DistribcellFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "distribcell") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % cell ) + end subroutine to_statepoint_distribcell + + subroutine to_summary_distribcell(this, filter_group) + class(DistribcellFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + integer :: offset, k + character(MAX_LINE_LEN), allocatable :: paths(:) + character(MAX_LINE_LEN) :: path + + call write_dataset(filter_group, "type", "distribcell") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % cell ) + + ! Write paths to reach each distribcell instance + + ! Allocate array of strings for each distribcell path + allocate(paths(this % n_bins)) + + ! Store path for each distribcell instance + do k = 1, this % n_bins + path = '' + offset = 1 + call find_offset(this % cell, universes(BASE_UNIVERSE), k, offset, path) + paths(k) = path + end do + + ! Write array of distribcell paths to summary file + call write_dataset(filter_group, "paths", paths) + deallocate(paths) + end subroutine to_summary_distribcell + + subroutine initialize_distribcell(this) + class(DistribcellFilter), intent(inout) :: this + + integer :: i, id + + do i = 1, this % n_bins + id = this % cell + if (cell_dict % has_key(id)) then + this % cell = cell_dict % get_key(id) + else + call fatal_error("Could not find cell " // trim(to_str(id)) & + &// " specified on tally filter.") + end if + end do + end subroutine initialize_distribcell + +!=============================================================================== +!=============================================================================== + function get_next_bin_cellborn(this, p, estimator, current_bin) & + result(next_bin) + class(CellbornFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: i + logical :: bin_found + + if (current_bin == NO_BIN_FOUND) then + bin_found = .false. + do i = 1, this % n_bins + if (p % cell_born == this % cells(i)) then + next_bin = i + bin_found = .true. + exit + end if + end do + if (.not. bin_found) next_bin = NO_BIN_FOUND + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_cellborn + + function get_score_cellborn(this, bin) result(score) + class(CellbornFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_cellborn + + subroutine to_statepoint_cellborn(this, filter_group) + class(CellbornFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "cellborn") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % cells ) + end subroutine to_statepoint_cellborn + + subroutine initialize_cellborn(this) + class(CellbornFilter), intent(inout) :: this + + integer :: i, id + + do i = 1, this % n_bins + id = this % cells(i) + if (cell_dict % has_key(id)) then + this % cells(i) = cell_dict % get_key(id) + else + call fatal_error("Could not find cell " // trim(to_str(id)) & + &// " specified on tally filter.") + end if + end do + end subroutine initialize_cellborn + +!=============================================================================== +!=============================================================================== + function get_next_bin_surface(this, p, estimator, current_bin) & + result(next_bin) + class(SurfaceFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: i + logical :: bin_found + + if (current_bin == NO_BIN_FOUND) then + bin_found = .false. + do i = 1, this % n_bins + if (p % surface == this % surfaces(i)) then + next_bin = i + bin_found = .true. + exit + end if + end do + if (.not. bin_found) next_bin = NO_BIN_FOUND + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_surface + + function get_score_surface(this, bin) result(score) + class(SurfaceFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_surface + + subroutine to_statepoint_surface(this, filter_group) + class(SurfaceFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "surface") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % surfaces ) + end subroutine to_statepoint_surface + + subroutine initialize_surface(this) + class(SurfaceFilter), intent(inout) :: this + + integer :: i, id + + do i = 1, this % n_bins + id = this % surfaces(i) + if (surface_dict % has_key(id)) then + this % surfaces(i) = surface_dict % get_key(id) + else + call fatal_error("Could not find surface " // trim(to_str(id)) & + &// " specified on tally filter.") + end if + end do + end subroutine initialize_surface + +!=============================================================================== +!=============================================================================== + function get_next_bin_energy(this, p, estimator, current_bin) result(next_bin) + class(EnergyFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: n + real(8) :: E + + if (current_bin == NO_BIN_FOUND) then + n = this % n_bins + + ! Make sure the correct energy is used. + if (estimator == ESTIMATOR_TRACKLENGTH) then + E = p % E + else + E = p % last_E + end if + + ! Check if energy of the particle is within energy bins. + if (E < this % bins(1) .or. E > this % bins(n + 1)) then + next_bin = NO_BIN_FOUND + else + ! Search to find incoming energy bin. + next_bin = binary_search(this % bins, n + 1, E) + end if + + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_energy + + function get_score_energy(this, bin) result(score) + class(EnergyFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_energy + + subroutine to_statepoint_energy(this, filter_group) + class(EnergyFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "energy") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % bins ) + end subroutine to_statepoint_energy + + subroutine initialize_energy(this) + class(EnergyFilter), intent(inout) :: this + end subroutine initialize_energy + +!=============================================================================== +!=============================================================================== + function get_next_bin_energyout(this, p, estimator, current_bin) & + result(next_bin) + class(EnergyoutFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: n + + if (current_bin == NO_BIN_FOUND) then + n = this % n_bins + + ! Check if energy of the particle is within energy bins. + if (p % E < this % bins(1) .or. p % E > this % bins(n + 1)) then + next_bin = NO_BIN_FOUND + else + ! Search to find incoming energy bin. + next_bin = binary_search(this % bins, n + 1, p % E) + end if + + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_energyout + + function get_score_energyout(this, bin) result(score) + class(EnergyoutFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_energyout + + subroutine to_statepoint_energyout(this, filter_group) + class(EnergyoutFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "energyout") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % bins ) + end subroutine to_statepoint_energyout + + subroutine initialize_energyout(this) + class(EnergyoutFilter), intent(inout) :: this + end subroutine initialize_energyout + +!=============================================================================== +!=============================================================================== + function get_next_bin_dg(this, p, estimator, current_bin) result(next_bin) + class(DelayedGroupFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + end function get_next_bin_dg + + function get_score_dg(this, bin) result(score) + class(DelayedGroupFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_dg + + subroutine to_statepoint_dg(this, filter_group) + class(DelayedGroupFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "delayedgroup") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % groups ) + end subroutine to_statepoint_dg + + subroutine initialize_dg(this) + class(DelayedGroupFilter), intent(inout) :: this + end subroutine initialize_dg + +!=============================================================================== +!=============================================================================== + function get_next_bin_mu(this, p, estimator, current_bin) result(next_bin) + class(MuFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: n + + if (current_bin == NO_BIN_FOUND) then + n = this % n_bins + + ! Check if energy of the particle is within energy bins. + if (p % mu < this % bins(1) .or. p % mu > this % bins(n + 1)) then + next_bin = NO_BIN_FOUND + else + ! Search to find incoming energy bin. + next_bin = binary_search(this % bins, n + 1, p % mu) + end if + + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_mu + + function get_score_mu(this, bin) result(score) + class(MuFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_mu + + subroutine to_statepoint_mu(this, filter_group) + class(MuFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "mu") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % bins ) + end subroutine to_statepoint_mu + + subroutine initialize_mu(this) + class(MuFilter), intent(inout) :: this + end subroutine initialize_mu + +!=============================================================================== +!=============================================================================== + function get_next_bin_polar(this, p, estimator, current_bin) result(next_bin) + class(PolarFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: n + real(8) :: theta + + if (current_bin == NO_BIN_FOUND) then + n = this % n_bins + + ! Make sure the correct direction vector is used. + if (estimator == ESTIMATOR_TRACKLENGTH) then + theta = acos(p % coord(1) % uvw(3)) + else + theta = acos(p % last_uvw(3)) + end if + + ! Check if particle is within polar angle bins. + if (theta < this % bins(1) .or. theta > this % bins(n + 1)) then + next_bin = NO_BIN_FOUND + else + ! Search to find polar angle bin. + next_bin = binary_search(this % bins, n + 1, theta) + end if + + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_polar + + function get_score_polar(this, bin) result(score) + class(PolarFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_polar + + subroutine to_statepoint_polar(this, filter_group) + class(PolarFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "polar") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % bins ) + end subroutine to_statepoint_polar + + subroutine initialize_polar(this) + class(PolarFilter), intent(inout) :: this + end subroutine initialize_polar + +!=============================================================================== +!=============================================================================== + function get_next_bin_azimuthal(this, p, estimator, current_bin) & + result(next_bin) + class(AzimuthalFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + + integer :: n + real(8) :: phi + + if (current_bin == NO_BIN_FOUND) then + n = this % n_bins + + ! Make sure the correct direction vector is used. + if (estimator == ESTIMATOR_TRACKLENGTH) then + phi = atan2(p % coord(1) % uvw(2), p % coord(1) % uvw(1)) + else + phi = atan2(p % last_uvw(2), p % last_uvw(1)) + end if + + ! Check if particle is within azimuthal angle bins. + if (phi < this % bins(1) .or. phi > this % bins(n + 1)) then + next_bin = NO_BIN_FOUND + else + ! Search to find azimuthal angle bin. + next_bin = binary_search(this % bins, n + 1, phi) + end if + + else + next_bin = NO_BIN_FOUND + end if + end function get_next_bin_azimuthal + + function get_score_azimuthal(this, bin) result(score) + class(AzimuthalFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_azimuthal + + subroutine to_statepoint_azimuthal(this, filter_group) + class(AzimuthalFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call write_dataset(filter_group, "type", "azimuthal") + call write_dataset(filter_group, "n_bins", this % n_bins) + call write_dataset(filter_group, "bins", this % bins ) + end subroutine to_statepoint_azimuthal + + subroutine initialize_azimuthal(this) + class(AzimuthalFilter), intent(inout) :: this + end subroutine initialize_azimuthal + +end module tally_filter diff --git a/src/tally_filter_header.F90 b/src/tally_filter_header.F90 new file mode 100644 index 000000000..b373f8d41 --- /dev/null +++ b/src/tally_filter_header.F90 @@ -0,0 +1,64 @@ +module tally_filter_header + + use particle_header, only: Particle + + use hdf5 + + implicit none + + type, abstract :: TallyFilter + integer :: n_bins = 0 + integer :: type + contains + procedure(get_next_bin_), deferred :: get_next_bin + procedure(get_score_), deferred :: get_score + procedure(to_statepoint_), deferred :: to_statepoint + procedure(to_summary_), deferred :: to_summary + procedure(initialize_), deferred :: initialize + end type TallyFilter + + type TallyFilterContainer + class(TallyFilter), allocatable :: obj + end type TallyFilterContainer + + abstract interface + + function get_next_bin_(this, p, estimator, current_bin) result(next_bin) + import TallyFilter + import Particle + class(TallyFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer :: next_bin + end function get_next_bin_ + + function get_score_(this, bin) result(score) + import TallyFilter + class(TallyFilter), intent(in) :: this + integer, intent(in) :: bin + real(8) :: score + end function get_score_ + + subroutine to_statepoint_(this, filter_group) + import TallyFilter + import HID_T + class(TallyFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + end subroutine to_statepoint_ + + subroutine to_summary_(this, filter_group) + import TallyFilter + import HID_T + class(TallyFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + end subroutine to_summary_ + + subroutine initialize_(this) + import TallyFilter + class(TallyFilter), intent(inout) :: this + end subroutine initialize_ + + end interface + +end module tally_filter_header diff --git a/src/tally_header.F90 b/src/tally_header.F90 index 8db9ab0e1..46a6e2d9c 100644 --- a/src/tally_header.F90 +++ b/src/tally_header.F90 @@ -1,7 +1,9 @@ module tally_header - use constants, only: NONE, N_FILTER_TYPES - use trigger_header, only: TriggerObject + use constants, only: NONE, N_FILTER_TYPES + use tally_filter_header, only: TallyFilterContainer + use trigger_header, only: TriggerObject + use, intrinsic :: ISO_C_BINDING implicit none @@ -52,12 +54,12 @@ module tally_header ! should score to the tally. !=============================================================================== - type TallyFilter - integer :: type = NONE - integer :: n_bins = 0 - integer, allocatable :: int_bins(:) - real(8), allocatable :: real_bins(:) ! Only used for energy filters - end type TallyFilter +! type TallyFilter +! integer :: type = NONE +! integer :: n_bins = 0 +! integer, allocatable :: int_bins(:) +! real(8), allocatable :: real_bins(:) ! Only used for energy filters +! end type TallyFilter !=============================================================================== ! TALLYOBJECT describes a user-specified tally. The region of phase space to @@ -77,7 +79,8 @@ module tally_header ! Information about what filters should be used integer :: n_filters ! Number of filters - type(TallyFilter), allocatable :: filters(:) ! Filter data (type/bins) + !type(TallyFilter), allocatable :: filters(:) ! Filter data (type/bins) + type(TallyFilterContainer), allocatable :: filters(:) ! The stride attribute is used for determining the index in the results ! array for a matching_bin combination. Since multiple dimensions are diff --git a/src/tally_initialize.F90 b/src/tally_initialize.F90 index 73aa18c60..d8f7176a6 100644 --- a/src/tally_initialize.F90 +++ b/src/tally_initialize.F90 @@ -55,7 +55,7 @@ contains n = 1 STRIDE: do j = t % n_filters, 1, -1 t % stride(j) = n - n = n * t % filters(j) % n_bins + n = n * t % filters(j) % obj % n_bins end do STRIDE ! Set total number of filter and scoring bins @@ -83,49 +83,49 @@ contains subroutine setup_tally_maps() - integer :: i ! loop index for tallies - integer :: j ! loop index for filters - integer :: k ! loop index for bins - integer :: bin ! filter bin entries - integer :: type ! type of tally filter - type(TallyObject), pointer :: t - - ! allocate tally map array -- note that we don't need a tally map for the - ! energy_in and energy_out filters - allocate(tally_maps(N_FILTER_TYPES - 3)) - - ! allocate list of items for each different filter type - allocate(tally_maps(FILTER_UNIVERSE) % items(n_universes)) - allocate(tally_maps(FILTER_MATERIAL) % items(n_materials)) - allocate(tally_maps(FILTER_CELL) % items(n_cells)) - allocate(tally_maps(FILTER_CELLBORN) % items(n_cells)) - allocate(tally_maps(FILTER_SURFACE) % items(n_surfaces)) - - TALLY_LOOP: do i = 1, n_tallies - ! Get pointer to tally - t => tallies(i) - - ! No need to set up tally maps for surface current tallies - if (t % type == TALLY_SURFACE_CURRENT) cycle - - FILTER_LOOP: do j = 1, t % n_filters - ! Determine type of filter - type = t % filters(j) % type - - if (type == FILTER_CELL .or. type == FILTER_SURFACE .or. & - type == FILTER_MATERIAL .or. type == FILTER_UNIVERSE .or. & - type == FILTER_CELLBORN) then - - ! Add map elements - BIN_LOOP: do k = 1, t % filters(j) % n_bins - bin = t % filters(j) % int_bins(k) - call add_map_element(tally_maps(type) % items(bin), i, k) - end do BIN_LOOP - end if - - end do FILTER_LOOP - - end do TALLY_LOOP +! integer :: i ! loop index for tallies +! integer :: j ! loop index for filters +! integer :: k ! loop index for bins +! integer :: bin ! filter bin entries +! integer :: type ! type of tally filter +! type(TallyObject), pointer :: t +! +! ! allocate tally map array -- note that we don't need a tally map for the +! ! energy_in and energy_out filters +! allocate(tally_maps(N_FILTER_TYPES - 3)) +! +! ! allocate list of items for each different filter type +! allocate(tally_maps(FILTER_UNIVERSE) % items(n_universes)) +! allocate(tally_maps(FILTER_MATERIAL) % items(n_materials)) +! allocate(tally_maps(FILTER_CELL) % items(n_cells)) +! allocate(tally_maps(FILTER_CELLBORN) % items(n_cells)) +! allocate(tally_maps(FILTER_SURFACE) % items(n_surfaces)) +! +! TALLY_LOOP: do i = 1, n_tallies +! ! Get pointer to tally +! t => tallies(i) +! +! ! No need to set up tally maps for surface current tallies +! if (t % type == TALLY_SURFACE_CURRENT) cycle +! +! FILTER_LOOP: do j = 1, t % n_filters +! ! Determine type of filter +! type = t % filters(j) % type +! +! if (type == FILTER_CELL .or. type == FILTER_SURFACE .or. & +! type == FILTER_MATERIAL .or. type == FILTER_UNIVERSE .or. & +! type == FILTER_CELLBORN) then +! +! ! Add map elements +! BIN_LOOP: do k = 1, t % filters(j) % n_bins +! bin = t % filters(j) % int_bins(k) +! call add_map_element(tally_maps(type) % items(bin), i, k) +! end do BIN_LOOP +! end if +! +! end do FILTER_LOOP +! +! end do TALLY_LOOP end subroutine setup_tally_maps diff --git a/src/trigger.F90 b/src/trigger.F90 index ed362154b..9756dd5a7 100644 --- a/src/trigger.F90 +++ b/src/trigger.F90 @@ -12,6 +12,7 @@ module trigger use mesh_header, only: RegularMesh use trigger_header, only: TriggerObject use tally, only: TallyObject + use tally_filter, only: MeshFilter implicit none @@ -300,7 +301,10 @@ contains ! Get pointer to mesh i_filter_mesh = t % find_filter(FILTER_MESH) i_filter_surf = t % find_filter(FILTER_SURFACE) - m => meshes(t % filters(i_filter_mesh) % int_bins(1)) + select type(filt => t % filters(i_filter_mesh) % obj) + type is (MeshFilter) + m => meshes(filt % mesh) + end select ! initialize bins array matching_bins(1:t % n_filters) = 1 @@ -309,7 +313,7 @@ contains i_filter_ein = t % find_filter(FILTER_ENERGYIN) if (i_filter_ein > 0) then print_ebin = .true. - n = t % filters(i_filter_ein) % n_bins + n = t % filters(i_filter_ein) % obj % n_bins else print_ebin = .false. n = 1 From 5f3825d758ed3e92011b392403d9f10ce182dd5a Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Thu, 23 Jun 2016 19:43:08 -0500 Subject: [PATCH 02/23] Use type-bound methods for tallies.out output --- src/output.F90 | 1058 ++++++++++++----------------------- src/tally_filter.F90 | 429 +++++++++++++- src/tally_filter_header.F90 | 10 + 3 files changed, 796 insertions(+), 701 deletions(-) diff --git a/src/output.F90 b/src/output.F90 index 5fe9685a2..ba0ad71c9 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -17,6 +17,7 @@ module output use sab_header, only: SAlphaBeta use string, only: to_upper, to_str use tally_header, only: TallyObject + use tally_filter implicit none @@ -748,7 +749,6 @@ contains real(8) :: t_value ! t-values for confidence intervals real(8) :: alpha ! significance level for CI character(MAX_FILE_LEN) :: filename ! name of output file - character(16) :: filter_name(N_FILTER_TYPES) ! names of tally filters character(36) :: score_names(N_SCORE_TYPES) ! names of scoring function character(36) :: score_name ! names of scoring function ! to be applied at write-time @@ -757,233 +757,216 @@ contains ! Skip if there are no tallies if (n_tallies == 0) return -! ! Initialize names for tally filter types -! filter_name(FILTER_UNIVERSE) = "Universe" -! filter_name(FILTER_MATERIAL) = "Material" -! filter_name(FILTER_DISTRIBCELL) = "Distributed Cell" -! filter_name(FILTER_CELL) = "Cell" -! filter_name(FILTER_CELLBORN) = "Birth Cell" -! filter_name(FILTER_SURFACE) = "Surface" -! filter_name(FILTER_MESH) = "Mesh" -! filter_name(FILTER_ENERGYIN) = "Incoming Energy" -! filter_name(FILTER_ENERGYOUT) = "Outgoing Energy" -! filter_name(FILTER_MU) = "Change-in-Angle" -! filter_name(FILTER_POLAR) = "Polar Angle" -! filter_name(FILTER_AZIMUTHAL) = "Azimuthal Angle" -! filter_name(FILTER_DELAYEDGROUP) = "Delayed Group" -! -! ! Initialize names for scores -! score_names(abs(SCORE_FLUX)) = "Flux" -! score_names(abs(SCORE_TOTAL)) = "Total Reaction Rate" -! score_names(abs(SCORE_SCATTER)) = "Scattering Rate" -! score_names(abs(SCORE_NU_SCATTER)) = "Scattering Production Rate" -! score_names(abs(SCORE_ABSORPTION)) = "Absorption Rate" -! score_names(abs(SCORE_FISSION)) = "Fission Rate" -! score_names(abs(SCORE_NU_FISSION)) = "Nu-Fission Rate" -! score_names(abs(SCORE_KAPPA_FISSION)) = "Kappa-Fission Rate" -! score_names(abs(SCORE_EVENTS)) = "Events" -! score_names(abs(SCORE_FLUX_YN)) = "Flux Moment" -! score_names(abs(SCORE_TOTAL_YN)) = "Total Reaction Rate Moment" -! score_names(abs(SCORE_SCATTER_N)) = "Scattering Rate Moment" -! score_names(abs(SCORE_SCATTER_PN)) = "Scattering Rate Moment" -! score_names(abs(SCORE_SCATTER_YN)) = "Scattering Rate Moment" -! score_names(abs(SCORE_NU_SCATTER_N)) = "Scattering Prod. Rate Moment" -! score_names(abs(SCORE_NU_SCATTER_PN)) = "Scattering Prod. Rate Moment" -! score_names(abs(SCORE_NU_SCATTER_YN)) = "Scattering Prod. Rate Moment" -! score_names(abs(SCORE_DELAYED_NU_FISSION)) = "Delayed-Nu-Fission Rate" -! score_names(abs(SCORE_INVERSE_VELOCITY)) = "Flux-Weighted Inverse Velocity" -! -! ! Create filename for tally output -! filename = trim(path_output) // "tallies.out" -! -! ! Open tally file for writing -! open(FILE=filename, NEWUNIT=unit_tally, STATUS='replace', ACTION='write') -! -! ! Calculate t-value for confidence intervals -! if (confidence_intervals) then -! alpha = ONE - CONFIDENCE_LEVEL -! t_value = t_percentile(ONE - alpha/TWO, n_realizations - 1) -! end if -! -! TALLY_LOOP: do i = 1, n_tallies -! t => tallies(i) -! -! if (confidence_intervals) then -! ! Calculate t-value for confidence intervals -! if (confidence_intervals) then -! alpha = ONE - CONFIDENCE_LEVEL -! t_value = t_percentile(ONE - alpha/TWO, t % n_realizations - 1) -! end if -! -! ! Multiply uncertainty by t-value -! t % results % sum_sq = t_value * t % results % sum_sq -! end if -! -! ! Write header block -! if (t % name == "") then -! call header("TALLY " // trim(to_str(t % id)), unit=unit_tally, & -! level=3) -! else -! call header("TALLY " // trim(to_str(t % id)) // ": " & -! // trim(t % name), unit=unit_tally, level=3) -! endif -! -! ! Handle surface current tallies separately -! if (t % type == TALLY_SURFACE_CURRENT) then -! call write_surface_current(t, unit_tally) -! cycle -! end if -! -! ! WARNING: Admittedly, the logic for moving for printing results is -! ! extremely confusing and took quite a bit of time to get correct. The -! ! logic is structured this way since it is not practical to have a do -! ! loop for each filter variable (given that only a few filters are likely -! ! to be used for a given tally. -! -! ! Initialize bins, filter level, and indentation -! matching_bins(1:t%n_filters) = 0 -! j = 1 -! indent = 0 -! -! print_bin: do -! find_bin: do -! ! Check for no filters -! if (t % n_filters == 0) exit find_bin -! -! ! Increment bin combination -! matching_bins(j) = matching_bins(j) + 1 -! -! ! ================================================================= -! ! REACHED END OF BINS FOR THIS FILTER, MOVE TO NEXT FILTER -! -! if (matching_bins(j) > t % filters(j) % n_bins) then -! ! If this is the first filter, then exit -! if (j == 1) exit print_bin -! -! matching_bins(j) = 0 -! j = j - 1 -! indent = indent - 2 -! -! ! ================================================================= -! ! VALID BIN -- WRITE FILTER INFORMATION OR EXIT TO WRITE RESULTS -! -! else -! ! Check if this is last filter -! if (j == t % n_filters) exit find_bin -! -! ! Print current filter information -! type = t % filters(j) % type -! write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & -! trim(filter_name(type)), trim(get_label(t, j)) -! indent = indent + 2 -! j = j + 1 -! end if -! -! end do find_bin -! -! ! Print filter information -! if (t % n_filters > 0) then -! type = t % filters(j) % type -! write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & -! trim(filter_name(type)), trim(get_label(t, j)) -! end if -! -! ! Determine scoring index for this bin combination -- note that unlike -! ! in the score_tally subroutine, we have to use max(bins,1) since all -! ! bins below the lowest filter level will be zeros -! -! if (t % n_filters > 0) then -! filter_index = sum((max(matching_bins(1:t%n_filters),1) - 1) * t % stride) + 1 -! else -! filter_index = 1 -! end if -! -! ! Write results for this filter bin combination -! score_index = 0 -! if (t % n_filters > 0) indent = indent + 2 -! do n = 1, t % n_nuclide_bins -! ! Write label for nuclide -! i_nuclide = t % nuclide_bins(n) -! if (i_nuclide == -1) then -! write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & -! "Total Material" -! else -! if (run_CE) then -! i_listing = nuclides(i_nuclide) % listing -! else -! i_listing = nuclides_MG(i_nuclide) % obj % listing -! end if -! write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & -! trim(xs_listings(i_listing) % alias) -! end if -! -! indent = indent + 2 -! k = 0 -! do l = 1, t % n_user_score_bins -! k = k + 1 -! score_index = score_index + 1 -! select case(t % score_bins(k)) -! case (SCORE_SCATTER_N, SCORE_NU_SCATTER_N) -! score_name = 'P' // trim(to_str(t % moment_order(k))) // " " // & -! score_names(abs(t % score_bins(k))) -! write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & -! repeat(" ", indent), score_name, & -! to_str(t % results(score_index,filter_index) % sum), & -! trim(to_str(t % results(score_index,filter_index) % sum_sq)) -! case (SCORE_SCATTER_PN, SCORE_NU_SCATTER_PN) -! score_index = score_index - 1 -! do n_order = 0, t % moment_order(k) -! score_index = score_index + 1 -! score_name = 'P' // trim(to_str(n_order)) // " " //& -! score_names(abs(t % score_bins(k))) -! write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & -! repeat(" ", indent), score_name, & -! to_str(t % results(score_index,filter_index) % sum), & -! trim(to_str(t % results(score_index,filter_index) & -! % sum_sq)) -! end do -! k = k + t % moment_order(k) -! case (SCORE_SCATTER_YN, SCORE_NU_SCATTER_YN, SCORE_FLUX_YN, & -! SCORE_TOTAL_YN) -! score_index = score_index - 1 -! do n_order = 0, t % moment_order(k) -! do nm_order = -n_order, n_order -! score_index = score_index + 1 -! score_name = 'Y' // trim(to_str(n_order)) // ',' // & -! trim(to_str(nm_order)) // " " & -! // score_names(abs(t % score_bins(k))) -! write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & -! repeat(" ", indent), score_name, & -! to_str(t % results(score_index,filter_index) % sum), & -! trim(to_str(t % results(score_index,filter_index)& -! % sum_sq)) -! end do -! end do -! k = k + (t % moment_order(k) + 1)**2 - 1 -! case default -! if (t % score_bins(k) > 0) then -! score_name = reaction_name(t % score_bins(k)) -! else -! score_name = score_names(abs(t % score_bins(k))) -! end if -! write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & -! repeat(" ", indent), score_name, & -! to_str(t % results(score_index,filter_index) % sum), & -! trim(to_str(t % results(score_index,filter_index) % sum_sq)) -! end select -! end do -! indent = indent - 2 -! -! end do -! indent = indent - 2 -! -! if (t % n_filters == 0) exit print_bin -! -! end do print_bin -! -! end do TALLY_LOOP -! -! close(UNIT=unit_tally) + ! Initialize names for scores + score_names(abs(SCORE_FLUX)) = "Flux" + score_names(abs(SCORE_TOTAL)) = "Total Reaction Rate" + score_names(abs(SCORE_SCATTER)) = "Scattering Rate" + score_names(abs(SCORE_NU_SCATTER)) = "Scattering Production Rate" + score_names(abs(SCORE_ABSORPTION)) = "Absorption Rate" + score_names(abs(SCORE_FISSION)) = "Fission Rate" + score_names(abs(SCORE_NU_FISSION)) = "Nu-Fission Rate" + score_names(abs(SCORE_KAPPA_FISSION)) = "Kappa-Fission Rate" + score_names(abs(SCORE_EVENTS)) = "Events" + score_names(abs(SCORE_FLUX_YN)) = "Flux Moment" + score_names(abs(SCORE_TOTAL_YN)) = "Total Reaction Rate Moment" + score_names(abs(SCORE_SCATTER_N)) = "Scattering Rate Moment" + score_names(abs(SCORE_SCATTER_PN)) = "Scattering Rate Moment" + score_names(abs(SCORE_SCATTER_YN)) = "Scattering Rate Moment" + score_names(abs(SCORE_NU_SCATTER_N)) = "Scattering Prod. Rate Moment" + score_names(abs(SCORE_NU_SCATTER_PN)) = "Scattering Prod. Rate Moment" + score_names(abs(SCORE_NU_SCATTER_YN)) = "Scattering Prod. Rate Moment" + score_names(abs(SCORE_DELAYED_NU_FISSION)) = "Delayed-Nu-Fission Rate" + score_names(abs(SCORE_INVERSE_VELOCITY)) = "Flux-Weighted Inverse Velocity" + + ! Create filename for tally output + filename = trim(path_output) // "tallies.out" + + ! Open tally file for writing + open(FILE=filename, NEWUNIT=unit_tally, STATUS='replace', ACTION='write') + + ! Calculate t-value for confidence intervals + if (confidence_intervals) then + alpha = ONE - CONFIDENCE_LEVEL + t_value = t_percentile(ONE - alpha/TWO, n_realizations - 1) + end if + + TALLY_LOOP: do i = 1, n_tallies + t => tallies(i) + + if (confidence_intervals) then + ! Calculate t-value for confidence intervals + if (confidence_intervals) then + alpha = ONE - CONFIDENCE_LEVEL + t_value = t_percentile(ONE - alpha/TWO, t % n_realizations - 1) + end if + + ! Multiply uncertainty by t-value + t % results % sum_sq = t_value * t % results % sum_sq + end if + + ! Write header block + if (t % name == "") then + call header("TALLY " // trim(to_str(t % id)), unit=unit_tally, & + level=3) + else + call header("TALLY " // trim(to_str(t % id)) // ": " & + // trim(t % name), unit=unit_tally, level=3) + endif + + ! Handle surface current tallies separately + if (t % type == TALLY_SURFACE_CURRENT) then + call write_surface_current(t, unit_tally) + cycle + end if + + ! WARNING: Admittedly, the logic for moving for printing results is + ! extremely confusing and took quite a bit of time to get correct. The + ! logic is structured this way since it is not practical to have a do + ! loop for each filter variable (given that only a few filters are likely + ! to be used for a given tally. + + ! Initialize bins, filter level, and indentation + matching_bins(1:t%n_filters) = 0 + j = 1 + indent = 0 + + print_bin: do + find_bin: do + ! Check for no filters + if (t % n_filters == 0) exit find_bin + + ! Increment bin combination + matching_bins(j) = matching_bins(j) + 1 + + ! ================================================================= + ! REACHED END OF BINS FOR THIS FILTER, MOVE TO NEXT FILTER + + if (matching_bins(j) > t % filters(j) % obj % n_bins) then + ! If this is the first filter, then exit + if (j == 1) exit print_bin + + matching_bins(j) = 0 + j = j - 1 + indent = indent - 2 + + ! ================================================================= + ! VALID BIN -- WRITE FILTER INFORMATION OR EXIT TO WRITE RESULTS + + else + ! Check if this is last filter + if (j == t % n_filters) exit find_bin + + ! Print current filter information + write(UNIT=unit_tally, FMT='(1X,2A)') repeat(" ", indent), & + trim(t % filters(j) % obj % text_label(matching_bins(j))) + indent = indent + 2 + j = j + 1 + end if + + end do find_bin + + ! Print filter information + if (t % n_filters > 0) then + write(UNIT=unit_tally, FMT='(1X,2A)') repeat(" ", indent), & + trim(t % filters(j) % obj % text_label(matching_bins(j))) + end if + + ! Determine scoring index for this bin combination -- note that unlike + ! in the score_tally subroutine, we have to use max(bins,1) since all + ! bins below the lowest filter level will be zeros + + if (t % n_filters > 0) then + filter_index = sum((max(matching_bins(1:t%n_filters),1) - 1) * t % stride) + 1 + else + filter_index = 1 + end if + + ! Write results for this filter bin combination + score_index = 0 + if (t % n_filters > 0) indent = indent + 2 + do n = 1, t % n_nuclide_bins + ! Write label for nuclide + i_nuclide = t % nuclide_bins(n) + if (i_nuclide == -1) then + write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & + "Total Material" + else + if (run_CE) then + i_listing = nuclides(i_nuclide) % listing + else + i_listing = nuclides_MG(i_nuclide) % obj % listing + end if + write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & + trim(xs_listings(i_listing) % alias) + end if + + indent = indent + 2 + k = 0 + do l = 1, t % n_user_score_bins + k = k + 1 + score_index = score_index + 1 + select case(t % score_bins(k)) + case (SCORE_SCATTER_N, SCORE_NU_SCATTER_N) + score_name = 'P' // trim(to_str(t % moment_order(k))) // " " // & + score_names(abs(t % score_bins(k))) + write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & + repeat(" ", indent), score_name, & + to_str(t % results(score_index,filter_index) % sum), & + trim(to_str(t % results(score_index,filter_index) % sum_sq)) + case (SCORE_SCATTER_PN, SCORE_NU_SCATTER_PN) + score_index = score_index - 1 + do n_order = 0, t % moment_order(k) + score_index = score_index + 1 + score_name = 'P' // trim(to_str(n_order)) // " " //& + score_names(abs(t % score_bins(k))) + write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & + repeat(" ", indent), score_name, & + to_str(t % results(score_index,filter_index) % sum), & + trim(to_str(t % results(score_index,filter_index) & + % sum_sq)) + end do + k = k + t % moment_order(k) + case (SCORE_SCATTER_YN, SCORE_NU_SCATTER_YN, SCORE_FLUX_YN, & + SCORE_TOTAL_YN) + score_index = score_index - 1 + do n_order = 0, t % moment_order(k) + do nm_order = -n_order, n_order + score_index = score_index + 1 + score_name = 'Y' // trim(to_str(n_order)) // ',' // & + trim(to_str(nm_order)) // " " & + // score_names(abs(t % score_bins(k))) + write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & + repeat(" ", indent), score_name, & + to_str(t % results(score_index,filter_index) % sum), & + trim(to_str(t % results(score_index,filter_index)& + % sum_sq)) + end do + end do + k = k + (t % moment_order(k) + 1)**2 - 1 + case default + if (t % score_bins(k) > 0) then + score_name = reaction_name(t % score_bins(k)) + else + score_name = score_names(abs(t % score_bins(k))) + end if + write(UNIT=unit_tally, FMT='(1X,2A,1X,A,"+/- ",A)') & + repeat(" ", indent), score_name, & + to_str(t % results(score_index,filter_index) % sum), & + trim(to_str(t % results(score_index,filter_index) % sum_sq)) + end select + end do + indent = indent - 2 + + end do + indent = indent - 2 + + if (t % n_filters == 0) exit print_bin + + end do print_bin + + end do TALLY_LOOP + + close(UNIT=unit_tally) end subroutine write_tallies @@ -1011,477 +994,156 @@ contains character(MAX_LINE_LEN) :: string type(RegularMesh), pointer :: m -! ! Get pointer to mesh -! i_filter_mesh = t % find_filter(FILTER_MESH) -! i_filter_surf = t % find_filter(FILTER_SURFACE) -! m => meshes(t % filters(i_filter_mesh) % int_bins(1)) -! -! ! initialize bins array -! matching_bins(1:t%n_filters) = 1 -! -! ! determine how many energy in bins there are -! i_filter_ein = t % find_filter(FILTER_ENERGYIN) -! if (i_filter_ein > 0) then -! print_ebin = .true. -! n = t % filters(i_filter_ein) % n_bins -! else -! print_ebin = .false. -! n = 1 -! end if -! -! do i = 1, m % dimension(1) -! string = "Mesh Index (" // trim(to_str(i)) // ", " -! len1 = len_trim(string) -! do j = 1, m % dimension(2) -! string = string(1:len1+1) // trim(to_str(j)) // ", " -! len2 = len_trim(string) -! do k = 1, m % dimension(3) -! ! Write mesh cell index -! string = string(1:len2+1) // trim(to_str(k)) // ")" -! write(UNIT=unit_tally, FMT='(1X,A)') trim(string) -! -! do l = 1, n -! if (print_ebin) then -! ! Set incoming energy bin -! matching_bins(i_filter_ein) = l -! -! ! Write incoming energy bin -! write(UNIT=unit_tally, FMT='(3X,A,1X,A)') & -! "Incoming Energy", trim(get_label(t, i_filter_ein)) -! end if -! -! ! Left Surface -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, (/ i-1, j, k /) + 1, .true.) -! matching_bins(i_filter_surf) = IN_RIGHT -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Outgoing Current to Left", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! matching_bins(i_filter_surf) = OUT_RIGHT -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Incoming Current from Left", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! ! Right Surface -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) -! matching_bins(i_filter_surf) = IN_RIGHT -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Incoming Current from Right", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! matching_bins(i_filter_surf) = OUT_RIGHT -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Outgoing Current to Right", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! ! Back Surface -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, (/ i, j-1, k /) + 1, .true.) -! matching_bins(i_filter_surf) = IN_FRONT -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Outgoing Current to Back", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! matching_bins(i_filter_surf) = OUT_FRONT -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Incoming Current from Back", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! ! Front Surface -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) -! matching_bins(i_filter_surf) = IN_FRONT -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Incoming Current from Front", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! matching_bins(i_filter_surf) = OUT_FRONT -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Outgoing Current to Front", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! ! Bottom Surface -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, (/ i, j, k-1 /) + 1, .true.) -! matching_bins(i_filter_surf) = IN_TOP -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Outgoing Current to Bottom", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! matching_bins(i_filter_surf) = OUT_TOP -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Incoming Current from Bottom", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! ! Top Surface -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) -! matching_bins(i_filter_surf) = IN_TOP -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Incoming Current from Top", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! -! matching_bins(i_filter_surf) = OUT_TOP -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & -! "Outgoing Current to Top", & -! to_str(t % results(1,filter_index) % sum), & -! trim(to_str(t % results(1,filter_index) % sum_sq)) -! end do -! -! end do -! end do -! end do + ! Get pointer to mesh + i_filter_mesh = t % find_filter(FILTER_MESH) + i_filter_surf = t % find_filter(FILTER_SURFACE) + select type(filt => t % filters(i_filter_mesh) % obj) + type is (MeshFilter) + m => meshes(filt % mesh) + end select + + ! initialize bins array + matching_bins(1:t%n_filters) = 1 + + ! determine how many energy in bins there are + i_filter_ein = t % find_filter(FILTER_ENERGYIN) + if (i_filter_ein > 0) then + print_ebin = .true. + n = t % filters(i_filter_ein) % obj % n_bins + else + print_ebin = .false. + n = 1 + end if + + do i = 1, m % dimension(1) + string = "Mesh Index (" // trim(to_str(i)) // ", " + len1 = len_trim(string) + do j = 1, m % dimension(2) + string = string(1:len1+1) // trim(to_str(j)) // ", " + len2 = len_trim(string) + do k = 1, m % dimension(3) + ! Write mesh cell index + string = string(1:len2+1) // trim(to_str(k)) // ")" + write(UNIT=unit_tally, FMT='(1X,A)') trim(string) + + do l = 1, n + if (print_ebin) then + ! Set incoming energy bin + matching_bins(i_filter_ein) = l + + ! Write incoming energy bin + write(UNIT=unit_tally, FMT='(3X,A)') & + t % filters(i_filter_ein) % obj % text_label( & + matching_bins(i_filter_ein)) + end if + + ! Left Surface + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, (/ i-1, j, k /) + 1, .true.) + matching_bins(i_filter_surf) = IN_RIGHT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Outgoing Current to Left", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + matching_bins(i_filter_surf) = OUT_RIGHT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Incoming Current from Left", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + ! Right Surface + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) + matching_bins(i_filter_surf) = IN_RIGHT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Incoming Current from Right", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + matching_bins(i_filter_surf) = OUT_RIGHT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Outgoing Current to Right", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + ! Back Surface + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, (/ i, j-1, k /) + 1, .true.) + matching_bins(i_filter_surf) = IN_FRONT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Outgoing Current to Back", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + matching_bins(i_filter_surf) = OUT_FRONT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Incoming Current from Back", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + ! Front Surface + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) + matching_bins(i_filter_surf) = IN_FRONT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Incoming Current from Front", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + matching_bins(i_filter_surf) = OUT_FRONT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Outgoing Current to Front", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + ! Bottom Surface + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, (/ i, j, k-1 /) + 1, .true.) + matching_bins(i_filter_surf) = IN_TOP + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Outgoing Current to Bottom", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + matching_bins(i_filter_surf) = OUT_TOP + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Incoming Current from Bottom", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + ! Top Surface + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) + matching_bins(i_filter_surf) = IN_TOP + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Incoming Current from Top", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + + matching_bins(i_filter_surf) = OUT_TOP + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & + "Outgoing Current to Top", & + to_str(t % results(1,filter_index) % sum), & + trim(to_str(t % results(1,filter_index) % sum_sq)) + end do + + end do + end do + end do end subroutine write_surface_current -!=============================================================================== -! GET_LABEL returns a label for a cell/surface/etc given a tally, filter type, -! and corresponding bin -!=============================================================================== - - function get_label(t, i_filter) result(label) - type(TallyObject), intent(in) :: t ! tally object - integer, intent(in) :: i_filter ! index in filters array - character(MAX_LINE_LEN) :: label ! user-specified identifier - - integer :: i ! index in cells/surfaces/etc array - integer :: bin - integer :: offset - integer, allocatable :: ijk(:) ! indices in mesh - real(8) :: E0 ! lower bound for energy bin - real(8) :: E1 ! upper bound for energy bin - type(RegularMesh), pointer :: m - type(Universe), pointer :: univ - -! bin = matching_bins(i_filter) -! -! select case(t % filters(i_filter) % type) -! case (FILTER_UNIVERSE) -! i = t % filters(i_filter) % int_bins(bin) -! label = to_str(universes(i) % id) -! case (FILTER_MATERIAL) -! i = t % filters(i_filter) % int_bins(bin) -! label = to_str(materials(i) % id) -! case (FILTER_CELL, FILTER_CELLBORN) -! i = t % filters(i_filter) % int_bins(bin) -! label = to_str(cells(i) % id) -! case (FILTER_DISTRIBCELL) -! label = '' -! univ => universes(BASE_UNIVERSE) -! offset = 0 -! call find_offset(t % filters(i_filter) % int_bins(1), & -! univ, bin-1, offset, label) -! case (FILTER_SURFACE) -! i = t % filters(i_filter) % int_bins(bin) -! label = to_str(surfaces(i)%obj%id) -! case (FILTER_MESH) -! m => meshes(t % filters(i_filter) % int_bins(1)) -! allocate(ijk(m % n_dimension)) -! call bin_to_mesh_indices(m, bin, ijk) -! if (m % n_dimension == 2) then -! label = "Index (" // trim(to_str(ijk(1))) // ", " // & -! trim(to_str(ijk(2))) // ")" -! elseif (m % n_dimension == 3) then -! label = "Index (" // trim(to_str(ijk(1))) // ", " // & -! trim(to_str(ijk(2))) // ", " // trim(to_str(ijk(3))) // ")" -! end if -! case (FILTER_ENERGYIN, FILTER_ENERGYOUT, FILTER_MU, FILTER_POLAR, & -! FILTER_AZIMUTHAL) -! E0 = t % filters(i_filter) % real_bins(bin) -! E1 = t % filters(i_filter) % real_bins(bin + 1) -! label = "[" // trim(to_str(E0)) // ", " // trim(to_str(E1)) // ")" -! case (FILTER_DELAYEDGROUP) -! i = t % filters(i_filter) % int_bins(bin) -! label = to_str(i) -! end select - - end function get_label - -!=============================================================================== -! FIND_OFFSET uses a given map number, a target cell ID, and a target offset -! to build a string which is the path from the base universe to the target cell -! with the given offset -!=============================================================================== - - recursive subroutine find_offset(goal, univ, final, offset, path) - - integer, intent(in) :: goal ! The target cell index - type(Universe), intent(in) :: univ ! Universe to begin search - integer, intent(in) :: final ! Target offset - integer, intent(inout) :: offset ! Current offset - character(*), intent(inout) :: path ! Path to offset - - integer :: map ! Index in maps vector - integer :: i, j ! Index over cells - integer :: k, l, m ! Indices in lattice - integer :: old_k, old_l, old_m ! Previous indices in lattice - integer :: n_x, n_y, n_z ! Lattice cell array dimensions - integer :: n ! Number of cells to search - integer :: cell_index ! Index in cells array - integer :: lat_offset ! Offset from lattice - integer :: temp_offset ! Looped sum of offsets - logical :: this_cell = .false. ! Advance in this cell? - logical :: later_cell = .false. ! Fill cells after this one? - type(Cell), pointer :: c ! Pointer to current cell - type(Universe), pointer :: next_univ ! Next universe to loop through - class(Lattice), pointer :: lat ! Pointer to current lattice - - ! Get the distribcell index for this cell - map = cells(goal) % distribcell_index - - n = univ % n_cells - - ! Write to the geometry stack - if (univ%id == 0) then - path = trim(path) // to_str(univ%id) - else - path = trim(path) // "->" // to_str(univ%id) - end if - - ! Look through all cells in this universe - do i = 1, n - ! If the cell matches the goal and the offset matches final, write to the - ! geometry stack - if (univ % cells(i) == goal .and. offset == final) then - c => cells(univ % cells(i)) - path = trim(path) // "->" // to_str(c % id) - return - end if - end do - - ! Find the fill cell or lattice cell that we need to enter - do i = 1, n - - later_cell = .false. - - cell_index = univ % cells(i) - c => cells(cell_index) - - this_cell = .false. - - ! If we got here, we still think the target is in this universe - ! or further down, but it's not this exact cell. - ! Compare offset to next cell to see if we should enter this cell - if (i /= n) then - - do j = i+1, n - - cell_index = univ % cells(j) - c => cells(cell_index) - - ! Skip normal cells which do not have offsets - if (c % type == CELL_NORMAL) then - cycle - end if - - ! Break loop once we've found the next cell with an offset - exit - end do - - ! Ensure we didn't just end the loop by iteration - if (c % type /= CELL_NORMAL) then - - ! There are more cells in this universe that it could be in - later_cell = .true. - - ! Two cases, lattice or fill cell - if (c % type == CELL_FILL) then - temp_offset = c % offset(map) - - ! Get the offset of the first lattice location - else - lat => lattices(c % fill) % obj - temp_offset = lat % offset(map, 1, 1, 1) - end if - - ! If the final offset is in the range of offset - temp_offset+offset - ! then the goal is in this cell - if (final < temp_offset + offset) then - this_cell = .true. - end if - end if - end if - - if (n == 1 .and. c % type /= CELL_NORMAL) then - this_cell = .true. - end if - - if (.not. later_cell) then - this_cell = .true. - end if - - ! Get pointer to THIS cell because target must be in this cell - if (this_cell) then - - cell_index = univ % cells(i) - c => cells(cell_index) - - path = trim(path) // "->" // to_str(c%id) - - ! ==================================================================== - ! CELL CONTAINS LOWER UNIVERSE, RECURSIVELY FIND CELL - if (c % type == CELL_FILL) then - - ! Enter this cell to update the current offset - offset = c % offset(map) + offset - - next_univ => universes(c % fill) - call find_offset(goal, next_univ, final, offset, path) - return - - ! ==================================================================== - ! CELL CONTAINS LATTICE, RECURSIVELY FIND CELL - elseif (c % type == CELL_LATTICE) then - - ! Set current lattice - lat => lattices(c % fill) % obj - - select type (lat) - - ! ================================================================== - ! RECTANGULAR LATTICES - type is (RectLattice) - - ! Write to the geometry stack - path = trim(path) // "->" // to_str(lat%id) - - n_x = lat % n_cells(1) - n_y = lat % n_cells(2) - n_z = lat % n_cells(3) - old_m = 1 - old_l = 1 - old_k = 1 - - ! Loop over lattice coordinates - do k = 1, n_x - do l = 1, n_y - do m = 1, n_z - - if (final >= lat % offset(map, k, l, m) + offset) then - if (k == n_x .and. l == n_y .and. m == n_z) then - ! This is last lattice cell, so target must be here - lat_offset = lat % offset(map, k, l, m) - offset = offset + lat_offset - next_univ => universes(lat % universes(k, l, m)) - path = trim(path) // "(" // trim(to_str(k)) // & - "," // trim(to_str(l)) // "," // & - trim(to_str(m)) // ")" - call find_offset(goal, next_univ, final, offset, path) - return - else - old_m = m - old_l = l - old_k = k - cycle - end if - else - ! Target is at this lattice position - lat_offset = lat % offset(map, old_k, old_l, old_m) - offset = offset + lat_offset - next_univ => universes(lat % universes(old_k, old_l, old_m)) - path = trim(path) // "(" // trim(to_str(old_k)) // & - "," // trim(to_str(old_l)) // "," // & - trim(to_str(old_m)) // ")" - call find_offset(goal, next_univ, final, offset, path) - return - end if - - end do - end do - end do - - ! ================================================================== - ! HEXAGONAL LATTICES - type is (HexLattice) - - ! Write to the geometry stack - path = trim(path) // "->" // to_str(lat%id) - - n_z = lat % n_axial - n_y = 2 * lat % n_rings - 1 - n_x = 2 * lat % n_rings - 1 - old_m = 1 - old_l = 1 - old_k = 1 - - ! Loop over lattice coordinates - do m = 1, n_z - do l = 1, n_y - do k = 1, n_x - - ! This array position is never used - if (k + l < lat % n_rings + 1) then - cycle - ! This array position is never used - else if (k + l > 3*lat % n_rings - 1) then - cycle - end if - - if (final >= lat % offset(map, k, l, m) + offset) then - if (k == lat % n_rings .and. l == n_y .and. m == n_z) then - ! This is last lattice cell, so target must be here - lat_offset = lat % offset(map, k, l, m) - offset = offset + lat_offset - next_univ => universes(lat % universes(k, l, m)) - path = trim(path) // "(" // & - trim(to_str(k - lat % n_rings)) // "," // & - trim(to_str(l - lat % n_rings)) // "," // & - trim(to_str(m)) // ")" - call find_offset(goal, next_univ, final, offset, path) - return - else - old_m = m - old_l = l - old_k = k - cycle - end if - else - ! Target is at this lattice position - lat_offset = lat % offset(map, old_k, old_l, old_m) - offset = offset + lat_offset - next_univ => universes(lat % universes(old_k, old_l, old_m)) - path = trim(path) // "(" // & - trim(to_str(old_k - lat % n_rings)) // "," // & - trim(to_str(old_l - lat % n_rings)) // "," // & - trim(to_str(old_m)) // ")" - call find_offset(goal, next_univ, final, offset, path) - return - end if - - end do - end do - end do - - end select - - end if - end if - end do - end subroutine find_offset - end module output diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index 5bb71df6f..13b9fa48c 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -1,18 +1,19 @@ module tally_filter use constants, only: ONE, NO_BIN_FOUND - use geometry_header, only: BASE_UNIVERSE + use geometry_header, only: BASE_UNIVERSE, RectLattice, HexLattice use global use hdf5_interface use mesh_header, only: RegularMesh use mesh, only: get_mesh_bin, bin_to_mesh_indices, & get_mesh_indices, mesh_indices_to_bin, & mesh_intersects_2d, mesh_intersects_3d - use output, only: find_offset use particle_header, only: Particle use search, only: binary_search use string, only: to_str - use tally_filter_header + use tally_filter_header, only: TallyFilter, TallyFilterContainer + + use hdf5, only: HID_T implicit none @@ -26,6 +27,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_mesh procedure :: to_summary => to_statepoint_mesh procedure :: initialize => initialize_mesh + procedure :: text_label => text_label_mesh end type MeshFilter !=============================================================================== @@ -38,6 +40,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_universe procedure :: to_summary => to_statepoint_universe procedure :: initialize => initialize_universe + procedure :: text_label => text_label_universe end type UniverseFilter !=============================================================================== @@ -50,6 +53,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_material procedure :: to_summary => to_statepoint_material procedure :: initialize => initialize_material + procedure :: text_label => text_label_material end type MaterialFilter !=============================================================================== @@ -62,6 +66,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_cell procedure :: to_summary => to_statepoint_cell procedure :: initialize => initialize_cell + procedure :: text_label => text_label_cell end type CellFilter !=============================================================================== @@ -74,6 +79,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_distribcell procedure :: to_summary => to_summary_distribcell procedure :: initialize => initialize_distribcell + procedure :: text_label => text_label_distribcell end type DistribcellFilter !=============================================================================== @@ -86,6 +92,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_cellborn procedure :: to_summary => to_statepoint_cellborn procedure :: initialize => initialize_cellborn + procedure :: text_label => text_label_cellborn end type CellbornFilter !=============================================================================== @@ -98,6 +105,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_surface procedure :: to_summary => to_statepoint_surface procedure :: initialize => initialize_surface + procedure :: text_label => text_label_surface end type SurfaceFilter !=============================================================================== @@ -110,6 +118,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_energy procedure :: to_summary => to_statepoint_energy procedure :: initialize => initialize_energy + procedure :: text_label => text_label_energy end type EnergyFilter !=============================================================================== @@ -122,6 +131,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_energyout procedure :: to_summary => to_statepoint_energyout procedure :: initialize => initialize_energyout + procedure :: text_label => text_label_energyout end type EnergyoutFilter !=============================================================================== @@ -134,6 +144,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_dg procedure :: to_summary => to_statepoint_dg procedure :: initialize => initialize_dg + procedure :: text_label => text_label_dg end type DelayedGroupFilter !=============================================================================== @@ -146,6 +157,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_mu procedure :: to_summary => to_statepoint_mu procedure :: initialize => initialize_mu + procedure :: text_label => text_label_mu end type MuFilter !=============================================================================== @@ -158,6 +170,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_polar procedure :: to_summary => to_statepoint_polar procedure :: initialize => initialize_polar + procedure :: text_label => text_label_polar end type PolarFilter !=============================================================================== @@ -170,6 +183,7 @@ module tally_filter procedure :: to_statepoint => to_statepoint_azimuthal procedure :: to_summary => to_statepoint_azimuthal procedure :: initialize => initialize_azimuthal + procedure :: text_label => text_label_azimuthal end type AzimuthalFilter contains @@ -215,6 +229,26 @@ contains class(MeshFilter), intent(inout) :: this end subroutine initialize_mesh + function text_label_mesh(this, bin) result(label) + class(MeshFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + integer, allocatable :: ijk(:) + type(RegularMesh), pointer :: m + + m => meshes(this % mesh) + allocate(ijk(m % n_dimension)) + call bin_to_mesh_indices(m, bin, ijk) + if (m % n_dimension == 2) then + label = "Mesh Index (" // trim(to_str(ijk(1))) // ", " // & + trim(to_str(ijk(2))) // ")" + elseif (m % n_dimension == 3) then + label = "Mesh Index (" // trim(to_str(ijk(1))) // ", " // & + trim(to_str(ijk(2))) // ", " // trim(to_str(ijk(3))) // ")" + end if + end function text_label_mesh + !=============================================================================== !=============================================================================== function get_next_bin_universe(this, p, estimator, current_bin) & @@ -280,6 +314,14 @@ contains end do end subroutine initialize_universe + function text_label_universe(this, bin) result(label) + class(UniverseFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + label = "Universe " // to_str(universes(this % universes(bin)) % id) + end function text_label_universe + !=============================================================================== !=============================================================================== function get_next_bin_material(this, p, estimator, current_bin) & @@ -339,6 +381,14 @@ contains end do end subroutine initialize_material + function text_label_material(this, bin) result(label) + class(MaterialFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + label = "Material " // to_str(materials(this % materials(bin)) % id) + end function text_label_material + !=============================================================================== !=============================================================================== function get_next_bin_cell(this, p, estimator, current_bin) result(next_bin) @@ -403,6 +453,14 @@ contains end do end subroutine initialize_cell + function text_label_cell(this, bin) result(label) + class(CellFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + label = "Cell " // to_str(cells(this % cells(bin)) % id) + end function text_label_cell + !=============================================================================== !=============================================================================== function get_next_bin_distribcell(this, p, estimator, current_bin) & @@ -507,6 +565,20 @@ contains end do end subroutine initialize_distribcell + function text_label_distribcell(this, bin) result(label) + class(DistribcellFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + integer :: offset + type(Universe), pointer :: univ + + univ => universes(BASE_UNIVERSE) + offset = 0 + call find_offset(this % cell, univ, bin-1, offset, label) + label = "Distributed Cell " // label + end function text_label_distribcell + !=============================================================================== !=============================================================================== function get_next_bin_cellborn(this, p, estimator, current_bin) & @@ -566,6 +638,14 @@ contains end do end subroutine initialize_cellborn + function text_label_cellborn(this, bin) result(label) + class(CellbornFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + label = "Birth Cell " // to_str(cells(this % cells(bin)) % id) + end function text_label_cellborn + !=============================================================================== !=============================================================================== function get_next_bin_surface(this, p, estimator, current_bin) & @@ -625,6 +705,14 @@ contains end do end subroutine initialize_surface + function text_label_surface(this, bin) result(label) + class(SurfaceFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + label = "Surface " // to_str(surfaces(this % surfaces(bin)) % obj % id) + end function text_label_surface + !=============================================================================== !=============================================================================== function get_next_bin_energy(this, p, estimator, current_bin) result(next_bin) @@ -679,6 +767,19 @@ contains class(EnergyFilter), intent(inout) :: this end subroutine initialize_energy + function text_label_energy(this, bin) result(label) + class(EnergyFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + real(8) :: E0, E1 + + E0 = this % bins(bin) + E1 = this % bins(bin + 1) + label = "Incoming Energy [" // trim(to_str(E0)) // ", " & + // trim(to_str(E1)) // ")" + end function text_label_energy + !=============================================================================== !=============================================================================== function get_next_bin_energyout(this, p, estimator, current_bin) & @@ -726,6 +827,19 @@ contains class(EnergyoutFilter), intent(inout) :: this end subroutine initialize_energyout + function text_label_energyout(this, bin) result(label) + class(EnergyoutFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + real(8) :: E0, E1 + + E0 = this % bins(bin) + E1 = this % bins(bin + 1) + label = "Outgoing Energy [" // trim(to_str(E0)) // ", " & + // trim(to_str(E1)) // ")" + end function text_label_energyout + !=============================================================================== !=============================================================================== function get_next_bin_dg(this, p, estimator, current_bin) result(next_bin) @@ -755,6 +869,14 @@ contains class(DelayedGroupFilter), intent(inout) :: this end subroutine initialize_dg + function text_label_dg(this, bin) result(label) + class(DelayedGroupFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + label = "Delayed Group " // to_str(this % groups(bin)) + end function text_label_dg + !=============================================================================== !=============================================================================== function get_next_bin_mu(this, p, estimator, current_bin) result(next_bin) @@ -801,6 +923,19 @@ contains class(MuFilter), intent(inout) :: this end subroutine initialize_mu + function text_label_mu(this, bin) result(label) + class(MuFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + real(8) :: E0, E1 + + E0 = this % bins(bin) + E1 = this % bins(bin + 1) + label = "Change-in-Angle [" // trim(to_str(E0)) // ", " & + // trim(to_str(E1)) // ")" + end function text_label_mu + !=============================================================================== !=============================================================================== function get_next_bin_polar(this, p, estimator, current_bin) result(next_bin) @@ -855,6 +990,19 @@ contains class(PolarFilter), intent(inout) :: this end subroutine initialize_polar + function text_label_polar(this, bin) result(label) + class(PolarFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + real(8) :: E0, E1 + + E0 = this % bins(bin) + E1 = this % bins(bin + 1) + label = "Polar Angle [" // trim(to_str(E0)) // ", " // trim(to_str(E1)) & + // ")" + end function text_label_polar + !=============================================================================== !=============================================================================== function get_next_bin_azimuthal(this, p, estimator, current_bin) & @@ -910,4 +1058,279 @@ contains class(AzimuthalFilter), intent(inout) :: this end subroutine initialize_azimuthal + function text_label_azimuthal(this, bin) result(label) + class(AzimuthalFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + + real(8) :: E0, E1 + + E0 = this % bins(bin) + E1 = this % bins(bin + 1) + label = "Azimuthal Angle [" // trim(to_str(E0)) // ", " & + // trim(to_str(E1)) // ")" + end function text_label_azimuthal + +!=============================================================================== +! FIND_OFFSET uses a given map number, a target cell ID, and a target offset +! to build a string which is the path from the base universe to the target cell +! with the given offset +!=============================================================================== + + recursive subroutine find_offset(goal, univ, final, offset, path) + + integer, intent(in) :: goal ! The target cell index + type(Universe), intent(in) :: univ ! Universe to begin search + integer, intent(in) :: final ! Target offset + integer, intent(inout) :: offset ! Current offset + character(*), intent(inout) :: path ! Path to offset + + integer :: map ! Index in maps vector + integer :: i, j ! Index over cells + integer :: k, l, m ! Indices in lattice + integer :: old_k, old_l, old_m ! Previous indices in lattice + integer :: n_x, n_y, n_z ! Lattice cell array dimensions + integer :: n ! Number of cells to search + integer :: cell_index ! Index in cells array + integer :: lat_offset ! Offset from lattice + integer :: temp_offset ! Looped sum of offsets + logical :: this_cell = .false. ! Advance in this cell? + logical :: later_cell = .false. ! Fill cells after this one? + type(Cell), pointer :: c ! Pointer to current cell + type(Universe), pointer :: next_univ ! Next universe to loop through + class(Lattice), pointer :: lat ! Pointer to current lattice + + ! Get the distribcell index for this cell + map = cells(goal) % distribcell_index + + n = univ % n_cells + + ! Write to the geometry stack + if (univ%id == 0) then + path = trim(path) // to_str(univ%id) + else + path = trim(path) // "->" // to_str(univ%id) + end if + + ! Look through all cells in this universe + do i = 1, n + ! If the cell matches the goal and the offset matches final, write to the + ! geometry stack + if (univ % cells(i) == goal .and. offset == final) then + c => cells(univ % cells(i)) + path = trim(path) // "->" // to_str(c % id) + return + end if + end do + + ! Find the fill cell or lattice cell that we need to enter + do i = 1, n + + later_cell = .false. + + cell_index = univ % cells(i) + c => cells(cell_index) + + this_cell = .false. + + ! If we got here, we still think the target is in this universe + ! or further down, but it's not this exact cell. + ! Compare offset to next cell to see if we should enter this cell + if (i /= n) then + + do j = i+1, n + + cell_index = univ % cells(j) + c => cells(cell_index) + + ! Skip normal cells which do not have offsets + if (c % type == CELL_NORMAL) then + cycle + end if + + ! Break loop once we've found the next cell with an offset + exit + end do + + ! Ensure we didn't just end the loop by iteration + if (c % type /= CELL_NORMAL) then + + ! There are more cells in this universe that it could be in + later_cell = .true. + + ! Two cases, lattice or fill cell + if (c % type == CELL_FILL) then + temp_offset = c % offset(map) + + ! Get the offset of the first lattice location + else + lat => lattices(c % fill) % obj + temp_offset = lat % offset(map, 1, 1, 1) + end if + + ! If the final offset is in the range of offset - temp_offset+offset + ! then the goal is in this cell + if (final < temp_offset + offset) then + this_cell = .true. + end if + end if + end if + + if (n == 1 .and. c % type /= CELL_NORMAL) then + this_cell = .true. + end if + + if (.not. later_cell) then + this_cell = .true. + end if + + ! Get pointer to THIS cell because target must be in this cell + if (this_cell) then + + cell_index = univ % cells(i) + c => cells(cell_index) + + path = trim(path) // "->" // to_str(c%id) + + ! ==================================================================== + ! CELL CONTAINS LOWER UNIVERSE, RECURSIVELY FIND CELL + if (c % type == CELL_FILL) then + + ! Enter this cell to update the current offset + offset = c % offset(map) + offset + + next_univ => universes(c % fill) + call find_offset(goal, next_univ, final, offset, path) + return + + ! ==================================================================== + ! CELL CONTAINS LATTICE, RECURSIVELY FIND CELL + elseif (c % type == CELL_LATTICE) then + + ! Set current lattice + lat => lattices(c % fill) % obj + + select type (lat) + + ! ================================================================== + ! RECTANGULAR LATTICES + type is (RectLattice) + + ! Write to the geometry stack + path = trim(path) // "->" // to_str(lat%id) + + n_x = lat % n_cells(1) + n_y = lat % n_cells(2) + n_z = lat % n_cells(3) + old_m = 1 + old_l = 1 + old_k = 1 + + ! Loop over lattice coordinates + do k = 1, n_x + do l = 1, n_y + do m = 1, n_z + + if (final >= lat % offset(map, k, l, m) + offset) then + if (k == n_x .and. l == n_y .and. m == n_z) then + ! This is last lattice cell, so target must be here + lat_offset = lat % offset(map, k, l, m) + offset = offset + lat_offset + next_univ => universes(lat % universes(k, l, m)) + path = trim(path) // "(" // trim(to_str(k)) // & + "," // trim(to_str(l)) // "," // & + trim(to_str(m)) // ")" + call find_offset(goal, next_univ, final, offset, path) + return + else + old_m = m + old_l = l + old_k = k + cycle + end if + else + ! Target is at this lattice position + lat_offset = lat % offset(map, old_k, old_l, old_m) + offset = offset + lat_offset + next_univ => universes(lat % universes(old_k, old_l, old_m)) + path = trim(path) // "(" // trim(to_str(old_k)) // & + "," // trim(to_str(old_l)) // "," // & + trim(to_str(old_m)) // ")" + call find_offset(goal, next_univ, final, offset, path) + return + end if + + end do + end do + end do + + ! ================================================================== + ! HEXAGONAL LATTICES + type is (HexLattice) + + ! Write to the geometry stack + path = trim(path) // "->" // to_str(lat%id) + + n_z = lat % n_axial + n_y = 2 * lat % n_rings - 1 + n_x = 2 * lat % n_rings - 1 + old_m = 1 + old_l = 1 + old_k = 1 + + ! Loop over lattice coordinates + do m = 1, n_z + do l = 1, n_y + do k = 1, n_x + + ! This array position is never used + if (k + l < lat % n_rings + 1) then + cycle + ! This array position is never used + else if (k + l > 3*lat % n_rings - 1) then + cycle + end if + + if (final >= lat % offset(map, k, l, m) + offset) then + if (k == lat % n_rings .and. l == n_y .and. m == n_z) then + ! This is last lattice cell, so target must be here + lat_offset = lat % offset(map, k, l, m) + offset = offset + lat_offset + next_univ => universes(lat % universes(k, l, m)) + path = trim(path) // "(" // & + trim(to_str(k - lat % n_rings)) // "," // & + trim(to_str(l - lat % n_rings)) // "," // & + trim(to_str(m)) // ")" + call find_offset(goal, next_univ, final, offset, path) + return + else + old_m = m + old_l = l + old_k = k + cycle + end if + else + ! Target is at this lattice position + lat_offset = lat % offset(map, old_k, old_l, old_m) + offset = offset + lat_offset + next_univ => universes(lat % universes(old_k, old_l, old_m)) + path = trim(path) // "(" // & + trim(to_str(old_k - lat % n_rings)) // "," // & + trim(to_str(old_l - lat % n_rings)) // "," // & + trim(to_str(old_m)) // ")" + call find_offset(goal, next_univ, final, offset, path) + return + end if + + end do + end do + end do + + end select + + end if + end if + end do + end subroutine find_offset + end module tally_filter diff --git a/src/tally_filter_header.F90 b/src/tally_filter_header.F90 index b373f8d41..7fbe62547 100644 --- a/src/tally_filter_header.F90 +++ b/src/tally_filter_header.F90 @@ -1,5 +1,6 @@ module tally_filter_header + use constants, only: MAX_LINE_LEN use particle_header, only: Particle use hdf5 @@ -15,6 +16,7 @@ module tally_filter_header procedure(to_statepoint_), deferred :: to_statepoint procedure(to_summary_), deferred :: to_summary procedure(initialize_), deferred :: initialize + procedure(text_label_), deferred :: text_label end type TallyFilter type TallyFilterContainer @@ -59,6 +61,14 @@ module tally_filter_header class(TallyFilter), intent(inout) :: this end subroutine initialize_ + function text_label_(this, bin) result(label) + import TallyFilter + import MAX_LINE_LEN + class(TallyFilter), intent(in) :: this + integer, intent(in) :: bin + character(MAX_LINE_LEN) :: label + end function text_label_ + end interface end module tally_filter_header From f917ad72a4102faec0e8e92d6df2dad59cc6777d Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Thu, 23 Jun 2016 23:46:22 -0500 Subject: [PATCH 03/23] Reconnect current tallies --- openmc/filter.py | 5 + src/cmfd_input.F90 | 4 +- src/initialize.F90 | 4 +- src/tally.F90 | 600 ++++++++++++++++++++++----------------------- 4 files changed, 308 insertions(+), 305 deletions(-) diff --git a/openmc/filter.py b/openmc/filter.py index 72fb3b14e..d2615fba1 100644 --- a/openmc/filter.py +++ b/openmc/filter.py @@ -163,6 +163,11 @@ class Filter(object): if not isinstance(bins, Iterable): bins = [bins] + # If the bin is 0D numpy array, promote to 1D + elif isinstance(bins, np.ndarray): + if bins.shape == (): + bins = bins.reshape((1,)) + # If the bins are in a collection, convert it to a list else: bins = list(bins) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index ecd22b5ab..68ce03107 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -583,9 +583,9 @@ contains if (check_for_node(node_mesh, "energy")) then select type(filt => filters(2) % obj) type is (EnergyFilter) - deallocate(filt % bins) + deallocate(filt % bins) end select - end if + end if end do diff --git a/src/initialize.F90 b/src/initialize.F90 index d267df631..3c1e44ff7 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -731,7 +731,7 @@ contains if (.not. any(t%score_bins == SCORE_CURRENT)) & call filt % initialize() class default - call filt % initialize() + call filt % initialize() end select end do FILTER_LOOP @@ -1005,7 +1005,7 @@ contains do j = 1, tallies(i) % n_filters select type(filt => tallies(i) % filters(j) % obj) type is (DistribcellFilter) - call cell_list % add(filt % cell) + call cell_list % add(filt % cell) end select end do end do diff --git a/src/tally.F90 b/src/tally.F90 index b11a1eabf..9a04feb05 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -2563,307 +2563,305 @@ contains type(Particle), intent(in) :: p -! integer :: i -! integer :: i_tally -! integer :: j ! loop indices -! integer :: k ! loop indices -! integer :: ijk0(3) ! indices of starting coordinates -! integer :: ijk1(3) ! indices of ending coordinates -! integer :: n_cross ! number of surface crossings -! integer :: n ! number of incoming energy bins -! integer :: filter_index ! index of scoring bin -! integer :: i_filter_mesh ! index of mesh filter in filters array -! integer :: i_filter_surf ! index of surface filter in filters -! real(8) :: uvw(3) ! cosine of angle of particle -! real(8) :: xyz0(3) ! starting/intermediate coordinates -! real(8) :: xyz1(3) ! ending coordinates of particle -! real(8) :: xyz_cross(3) ! coordinates of bounding surfaces -! real(8) :: d(3) ! distance to each bounding surface -! real(8) :: distance ! actual distance traveled -! logical :: start_in_mesh ! particle's starting xyz in mesh? -! logical :: end_in_mesh ! particle's ending xyz in mesh? -! logical :: x_same ! same starting/ending x index (i) -! logical :: y_same ! same starting/ending y index (j) -! logical :: z_same ! same starting/ending z index (k) -! type(TallyObject), pointer :: t -! type(RegularMesh), pointer :: m -! -! TALLY_LOOP: do i = 1, active_current_tallies % size() -! ! Copy starting and ending location of particle -! xyz0 = p % last_xyz -! xyz1 = p % coord(1) % xyz -! -! ! Get pointer to tally -! i_tally = active_current_tallies % get_item(i) -! t => tallies(i_tally) -! -! ! Get index for mesh and surface filters -! i_filter_mesh = t % find_filter(FILTER_MESH) -! i_filter_surf = t % find_filter(FILTER_SURFACE) -! -! ! Determine indices for starting and ending location -! m => meshes(t % filters(i_filter_mesh) % int_bins(1)) -! call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) -! call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) -! -! ! Check to if start or end is in mesh -- if not, check if track still -! ! intersects with mesh -! if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then -! if (m % n_dimension == 2) then -! if (.not. mesh_intersects_2d(m, xyz0, xyz1)) cycle -! else -! if (.not. mesh_intersects_3d(m, xyz0, xyz1)) cycle -! end if -! end if -! -! ! Calculate number of surface crossings -! n_cross = sum(abs(ijk1 - ijk0)) -! if (n_cross == 0) then -! cycle -! end if -! -! ! Copy particle's direction -! uvw = p % coord(1) % uvw -! -! ! determine incoming energy bin -! j = t % find_filter(FILTER_ENERGYIN) -! if (j > 0) then -! n = t % filters(j) % n_bins -! ! check if energy of the particle is within energy bins -! if (p % E < t % filters(j) % real_bins(1) .or. & -! p % E > t % filters(j) % real_bins(n + 1)) then -! cycle -! end if -! -! ! search to find incoming energy bin -! matching_bins(j) = binary_search(t % filters(j) % real_bins, & -! n + 1, p % E) -! end if -! -! ! ======================================================================= -! ! SPECIAL CASES WHERE TWO INDICES ARE THE SAME -! -! x_same = (ijk0(1) == ijk1(1)) -! y_same = (ijk0(2) == ijk1(2)) -! z_same = (ijk0(3) == ijk1(3)) -! -! if (x_same .and. y_same) then -! ! Only z crossings -! if (uvw(3) > 0) then -! do j = ijk0(3), ijk1(3) - 1 -! ijk0(3) = j -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = OUT_TOP -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!!$omp atomic -! t % results(1, filter_index) % value = & -! t % results(1, filter_index) % value + p % wgt -! end if -! end do -! else -! do j = ijk0(3) - 1, ijk1(3), -1 -! ijk0(3) = j -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = IN_TOP -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!!$omp atomic -! t % results(1, filter_index) % value = & -! t % results(1, filter_index) % value + p % wgt -! end if -! end do -! end if -! cycle -! elseif (x_same .and. z_same) then -! ! Only y crossings -! if (uvw(2) > 0) then -! do j = ijk0(2), ijk1(2) - 1 -! ijk0(2) = j -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = OUT_FRONT -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!!$omp atomic -! t % results(1, filter_index) % value = & -! t % results(1, filter_index) % value + p % wgt -! end if -! end do -! else -! do j = ijk0(2) - 1, ijk1(2), -1 -! ijk0(2) = j -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = IN_FRONT -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!!$omp atomic -! t % results(1, filter_index) % value = & -! t % results(1, filter_index) % value + p % wgt -! end if -! end do -! end if -! cycle -! elseif (y_same .and. z_same) then -! ! Only x crossings -! if (uvw(1) > 0) then -! do j = ijk0(1), ijk1(1) - 1 -! ijk0(1) = j -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = OUT_RIGHT -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!!$omp atomic -! t % results(1, filter_index) % value = & -! t % results(1, filter_index) % value + p % wgt -! end if -! end do -! else -! do j = ijk0(1) - 1, ijk1(1), -1 -! ijk0(1) = j -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = IN_RIGHT -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -!!$omp atomic -! t % results(1, filter_index) % value = & -! t % results(1, filter_index) % value + p % wgt -! end if -! end do -! end if -! cycle -! end if -! -! ! ======================================================================= -! ! GENERIC CASE -! -! ! Bounding coordinates -! do j = 1, 3 -! if (uvw(j) > 0) then -! xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) -! else -! xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) -! end if -! end do -! -! do k = 1, n_cross -! ! Reset scoring bin index -! matching_bins(i_filter_surf) = 0 -! -! ! Calculate distance to each bounding surface. We need to treat -! ! special case where the cosine of the angle is zero since this would -! ! result in a divide-by-zero. -! -! do j = 1, 3 -! if (uvw(j) == 0) then -! d(j) = INFINITY -! else -! d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) -! end if -! end do -! -! ! Determine the closest bounding surface of the mesh cell by -! ! calculating the minimum distance -! -! distance = minval(d) -! -! ! Now use the minimum distance and diretion of the particle to -! ! determine which surface was crossed -! -! if (distance == d(1)) then -! if (uvw(1) > 0) then -! ! Crossing into right mesh cell -- this is treated as outgoing -! ! current from (i,j,k) -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = OUT_RIGHT -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! end if -! ijk0(1) = ijk0(1) + 1 -! xyz_cross(1) = xyz_cross(1) + m % width(1) -! else -! ! Crossing into left mesh cell -- this is treated as incoming -! ! current in (i-1,j,k) -! ijk0(1) = ijk0(1) - 1 -! xyz_cross(1) = xyz_cross(1) - m % width(1) -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = IN_RIGHT -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! end if -! end if -! elseif (distance == d(2)) then -! if (uvw(2) > 0) then -! ! Crossing into front mesh cell -- this is treated as outgoing -! ! current in (i,j,k) -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = OUT_FRONT -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! end if -! ijk0(2) = ijk0(2) + 1 -! xyz_cross(2) = xyz_cross(2) + m % width(2) -! else -! ! Crossing into back mesh cell -- this is treated as incoming -! ! current in (i,j-1,k) -! ijk0(2) = ijk0(2) - 1 -! xyz_cross(2) = xyz_cross(2) - m % width(2) -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = IN_FRONT -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! end if -! end if -! else if (distance == d(3)) then -! if (uvw(3) > 0) then -! ! Crossing into top mesh cell -- this is treated as outgoing -! ! current in (i,j,k) -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = OUT_TOP -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! end if -! ijk0(3) = ijk0(3) + 1 -! xyz_cross(3) = xyz_cross(3) + m % width(3) -! else -! ! Crossing into bottom mesh cell -- this is treated as incoming -! ! current in (i,j,k-1) -! ijk0(3) = ijk0(3) - 1 -! xyz_cross(3) = xyz_cross(3) - m % width(3) -! if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then -! matching_bins(i_filter_surf) = IN_TOP -! matching_bins(i_filter_mesh) = & -! mesh_indices_to_bin(m, ijk0 + 1, .true.) -! end if -! end if -! end if -! -! ! Determine scoring index -! if (matching_bins(i_filter_surf) > 0) then -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! -! ! Check for errors -! if (filter_index <= 0 .or. filter_index > & -! t % total_filter_bins) then -! call fatal_error("Score index outside range.") -! end if -! -! ! Add to surface current tally -!!$omp atomic -! t % results(1, filter_index) % value = & -! t % results(1, filter_index) % value + p % wgt -! end if -! -! ! Calculate new coordinates -! xyz0 = xyz0 + distance * uvw -! end do -! -! end do TALLY_LOOP + integer :: i + integer :: i_tally + integer :: j ! loop indices + integer :: k ! loop indices + integer :: ijk0(3) ! indices of starting coordinates + integer :: ijk1(3) ! indices of ending coordinates + integer :: n_cross ! number of surface crossings + integer :: n ! number of incoming energy bins + integer :: filter_index ! index of scoring bin + integer :: i_filter_mesh ! index of mesh filter in filters array + integer :: i_filter_surf ! index of surface filter in filters + real(8) :: uvw(3) ! cosine of angle of particle + real(8) :: xyz0(3) ! starting/intermediate coordinates + real(8) :: xyz1(3) ! ending coordinates of particle + real(8) :: xyz_cross(3) ! coordinates of bounding surfaces + real(8) :: d(3) ! distance to each bounding surface + real(8) :: distance ! actual distance traveled + logical :: start_in_mesh ! particle's starting xyz in mesh? + logical :: end_in_mesh ! particle's ending xyz in mesh? + logical :: x_same ! same starting/ending x index (i) + logical :: y_same ! same starting/ending y index (j) + logical :: z_same ! same starting/ending z index (k) + type(TallyObject), pointer :: t + type(RegularMesh), pointer :: m + + TALLY_LOOP: do i = 1, active_current_tallies % size() + ! Copy starting and ending location of particle + xyz0 = p % last_xyz + xyz1 = p % coord(1) % xyz + + ! Get pointer to tally + i_tally = active_current_tallies % get_item(i) + t => tallies(i_tally) + + ! Get index for mesh and surface filters + i_filter_mesh = t % find_filter(FILTER_MESH) + i_filter_surf = t % find_filter(FILTER_SURFACE) + + ! Get pointer to mesh + select type(filt => t % filters(i_filter_mesh) % obj) + type is (MeshFilter) + m => meshes(filt % mesh) + end select + + ! Determine indices for starting and ending location + call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) + call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) + + ! Check to if start or end is in mesh -- if not, check if track still + ! intersects with mesh + if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then + if (m % n_dimension == 2) then + if (.not. mesh_intersects_2d(m, xyz0, xyz1)) cycle + else + if (.not. mesh_intersects_3d(m, xyz0, xyz1)) cycle + end if + end if + + ! Calculate number of surface crossings + n_cross = sum(abs(ijk1 - ijk0)) + if (n_cross == 0) then + cycle + end if + + ! Copy particle's direction + uvw = p % coord(1) % uvw + + ! determine incoming energy bin + j = t % find_filter(FILTER_ENERGYIN) + if (j > 0) then + matching_bins(j) = t % filters(j) % obj & + % get_next_bin(p, ESTIMATOR_COLLISION, NO_BIN_FOUND) + if (matching_bins(j) == NO_BIN_FOUND) cycle + end if + + ! ======================================================================= + ! SPECIAL CASES WHERE TWO INDICES ARE THE SAME + + x_same = (ijk0(1) == ijk1(1)) + y_same = (ijk0(2) == ijk1(2)) + z_same = (ijk0(3) == ijk1(3)) + + if (x_same .and. y_same) then + ! Only z crossings + if (uvw(3) > 0) then + do j = ijk0(3), ijk1(3) - 1 + ijk0(3) = j + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = OUT_TOP + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!$omp atomic + t % results(1, filter_index) % value = & + t % results(1, filter_index) % value + p % wgt + end if + end do + else + do j = ijk0(3) - 1, ijk1(3), -1 + ijk0(3) = j + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = IN_TOP + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!$omp atomic + t % results(1, filter_index) % value = & + t % results(1, filter_index) % value + p % wgt + end if + end do + end if + cycle + elseif (x_same .and. z_same) then + ! Only y crossings + if (uvw(2) > 0) then + do j = ijk0(2), ijk1(2) - 1 + ijk0(2) = j + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = OUT_FRONT + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!$omp atomic + t % results(1, filter_index) % value = & + t % results(1, filter_index) % value + p % wgt + end if + end do + else + do j = ijk0(2) - 1, ijk1(2), -1 + ijk0(2) = j + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = IN_FRONT + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!$omp atomic + t % results(1, filter_index) % value = & + t % results(1, filter_index) % value + p % wgt + end if + end do + end if + cycle + elseif (y_same .and. z_same) then + ! Only x crossings + if (uvw(1) > 0) then + do j = ijk0(1), ijk1(1) - 1 + ijk0(1) = j + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = OUT_RIGHT + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!$omp atomic + t % results(1, filter_index) % value = & + t % results(1, filter_index) % value + p % wgt + end if + end do + else + do j = ijk0(1) - 1, ijk1(1), -1 + ijk0(1) = j + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = IN_RIGHT + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 +!$omp atomic + t % results(1, filter_index) % value = & + t % results(1, filter_index) % value + p % wgt + end if + end do + end if + cycle + end if + + ! ======================================================================= + ! GENERIC CASE + + ! Bounding coordinates + do j = 1, 3 + if (uvw(j) > 0) then + xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) + else + xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + end if + end do + + do k = 1, n_cross + ! Reset scoring bin index + matching_bins(i_filter_surf) = 0 + + ! Calculate distance to each bounding surface. We need to treat + ! special case where the cosine of the angle is zero since this would + ! result in a divide-by-zero. + + do j = 1, 3 + if (uvw(j) == 0) then + d(j) = INFINITY + else + d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) + end if + end do + + ! Determine the closest bounding surface of the mesh cell by + ! calculating the minimum distance + + distance = minval(d) + + ! Now use the minimum distance and diretion of the particle to + ! determine which surface was crossed + + if (distance == d(1)) then + if (uvw(1) > 0) then + ! Crossing into right mesh cell -- this is treated as outgoing + ! current from (i,j,k) + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = OUT_RIGHT + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + end if + ijk0(1) = ijk0(1) + 1 + xyz_cross(1) = xyz_cross(1) + m % width(1) + else + ! Crossing into left mesh cell -- this is treated as incoming + ! current in (i-1,j,k) + ijk0(1) = ijk0(1) - 1 + xyz_cross(1) = xyz_cross(1) - m % width(1) + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = IN_RIGHT + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + end if + end if + elseif (distance == d(2)) then + if (uvw(2) > 0) then + ! Crossing into front mesh cell -- this is treated as outgoing + ! current in (i,j,k) + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = OUT_FRONT + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + end if + ijk0(2) = ijk0(2) + 1 + xyz_cross(2) = xyz_cross(2) + m % width(2) + else + ! Crossing into back mesh cell -- this is treated as incoming + ! current in (i,j-1,k) + ijk0(2) = ijk0(2) - 1 + xyz_cross(2) = xyz_cross(2) - m % width(2) + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = IN_FRONT + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + end if + end if + else if (distance == d(3)) then + if (uvw(3) > 0) then + ! Crossing into top mesh cell -- this is treated as outgoing + ! current in (i,j,k) + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = OUT_TOP + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + end if + ijk0(3) = ijk0(3) + 1 + xyz_cross(3) = xyz_cross(3) + m % width(3) + else + ! Crossing into bottom mesh cell -- this is treated as incoming + ! current in (i,j,k-1) + ijk0(3) = ijk0(3) - 1 + xyz_cross(3) = xyz_cross(3) - m % width(3) + if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then + matching_bins(i_filter_surf) = IN_TOP + matching_bins(i_filter_mesh) = & + mesh_indices_to_bin(m, ijk0 + 1, .true.) + end if + end if + end if + + ! Determine scoring index + if (matching_bins(i_filter_surf) > 0) then + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + + ! Check for errors + if (filter_index <= 0 .or. filter_index > & + t % total_filter_bins) then + call fatal_error("Score index outside range.") + end if + + ! Add to surface current tally +!$omp atomic + t % results(1, filter_index) % value = & + t % results(1, filter_index) % value + p % wgt + end if + + ! Calculate new coordinates + xyz0 = xyz0 + distance * uvw + end do + + end do TALLY_LOOP end subroutine score_surface_current From 0b83f58fd17188403563a033be3314b0c4105fcb Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 24 Jun 2016 00:01:59 -0500 Subject: [PATCH 04/23] Reconnect tracklength mesh tallies --- src/tally.F90 | 563 ++++++++++++++++++++++---------------------------- 1 file changed, 249 insertions(+), 314 deletions(-) diff --git a/src/tally.F90 b/src/tally.F90 index 9a04feb05..3236f8fcd 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -1538,52 +1538,56 @@ contains type(TallyObject), intent(inout) :: t integer, intent(in) :: i_score ! index for score -! integer :: i ! index of outgoing energy filter -! integer :: n ! number of energies on filter -! integer :: k ! loop index for bank sites -! integer :: bin_energyout ! original outgoing energy bin -! integer :: i_filter ! index for matching filter bin combination -! real(8) :: score ! actual score -! real(8) :: E_out ! energy of fission bank site -! -! ! save original outgoing energy bin and score index -! i = t % find_filter(FILTER_ENERGYOUT) -! bin_energyout = matching_bins(i) -! -! ! Get number of energies on filter -! n = size(t % filters(i) % real_bins) -! -! ! Since the creation of fission sites is weighted such that it is -! ! expected to create n_particles sites, we need to multiply the -! ! score by keff to get the true nu-fission rate. Otherwise, the sum -! ! of all nu-fission rates would be ~1.0. -! -! ! loop over number of particles banked -! do k = 1, p % n_bank -! ! determine score based on bank site weight and keff -! score = keff * fission_bank(n_bank - p % n_bank + k) % wgt -! -! ! determine outgoing energy from fission bank -! E_out = fission_bank(n_bank - p % n_bank + k) % E -! -! ! check if outgoing energy is within specified range on filter -! if (E_out < t % filters(i) % real_bins(1) .or. & -! E_out > t % filters(i) % real_bins(n)) cycle -! -! ! change outgoing energy bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) -! -! ! determine scoring index -! i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! -! ! Add score to tally -!!$omp atomic -! t % results(i_score, i_filter) % value = & -! t % results(i_score, i_filter) % value + score -! end do -! -! ! reset outgoing energy bin and score index -! matching_bins(i) = bin_energyout + integer :: i ! index of outgoing energy filter + integer :: n ! number of energies on filter + integer :: k ! loop index for bank sites + integer :: bin_energyout ! original outgoing energy bin + integer :: i_filter ! index for matching filter bin combination + real(8) :: score ! actual score + real(8) :: E_out ! energy of fission bank site + + ! save original outgoing energy bin and score index + i = t % find_filter(FILTER_ENERGYOUT) + bin_energyout = matching_bins(i) + + ! Declare the filter type + select type(filt => t % filters(i) % obj) + type is (EnergyoutFilter) + + ! Get number of energies on filter + n = size(filt % bins) + + ! Since the creation of fission sites is weighted such that it is + ! expected to create n_particles sites, we need to multiply the + ! score by keff to get the true nu-fission rate. Otherwise, the sum + ! of all nu-fission rates would be ~1.0. + + ! loop over number of particles banked + do k = 1, p % n_bank + ! determine score based on bank site weight and keff + score = keff * fission_bank(n_bank - p % n_bank + k) % wgt + + ! determine outgoing energy from fission bank + E_out = fission_bank(n_bank - p % n_bank + k) % E + + ! check if outgoing energy is within specified range on filter + if (E_out < filt % bins(1) .or. E_out > filt % bins(n)) cycle + + ! change outgoing energy bin + matching_bins(i) = binary_search(filt % bins, n, E_out) + + ! determine scoring index + i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + + ! Add score to tally +!$omp atomic + t % results(i_score, i_filter) % value = & + t % results(i_score, i_filter) % value + score + end do + end select + + ! reset outgoing energy bin and score index + matching_bins(i) = bin_energyout end subroutine score_fission_eout_ce @@ -1917,274 +1921,205 @@ contains integer, intent(in) :: i_tally real(8), intent(in) :: d_track -! integer :: i ! loop index for filter/score bins -! integer :: j ! loop index for direction -! integer :: k ! loop index for mesh cell crossings -! integer :: b ! loop index for nuclide bins -! integer :: ijk0(3) ! indices of starting coordinates -! integer :: ijk1(3) ! indices of ending coordinates -! integer :: ijk_cross(3) ! indices of mesh cell crossed -! integer :: n_cross ! number of surface crossings -! integer :: filter_index ! single index for single bin -! integer :: i_nuclide ! index in nuclides array -! integer :: i_filter_mesh ! index of mesh filter in filters array -! real(8) :: atom_density ! density of individual nuclide in atom/b-cm -! real(8) :: flux ! tracklength estimate of flux -! real(8) :: uvw(3) ! cosine of angle of particle -! real(8) :: xyz0(3) ! starting/intermediate coordinates -! real(8) :: xyz1(3) ! ending coordinates of particle -! real(8) :: xyz_cross(3) ! coordinates of next boundary -! real(8) :: d(3) ! distance to each bounding surface -! real(8) :: distance ! distance traveled in mesh cell -! logical :: found_bin ! was a scoring bin found? -! logical :: start_in_mesh ! starting coordinates inside mesh? -! logical :: end_in_mesh ! ending coordinates inside mesh? -! real(8) :: theta -! real(8) :: phi -! type(TallyObject), pointer :: t -! type(RegularMesh), pointer :: m -! type(Material), pointer :: mat -! -! t => tallies(i_tally) -! matching_bins(1:t%n_filters) = 1 -! -! ! ========================================================================== -! ! CHECK IF THIS TRACK INTERSECTS THE MESH -! -! ! Copy starting and ending location of particle -! xyz0 = p % coord(1) % xyz - (d_track - TINY_BIT) * p % coord(1) % uvw -! xyz1 = p % coord(1) % xyz - TINY_BIT * p % coord(1) % uvw -! -! ! Get index for mesh filter -! i_filter_mesh = t % find_filter(FILTER_MESH) -! -! ! Determine indices for starting and ending location -! m => meshes(t % filters(i_filter_mesh) % int_bins(1)) -! call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) -! call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) -! -! ! Check if start or end is in mesh -- if not, check if track still -! ! intersects with mesh -! if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then -! if (m % n_dimension == 2) then -! if (.not. mesh_intersects_2d(m, xyz0, xyz1)) return -! else -! if (.not. mesh_intersects_3d(m, xyz0, xyz1)) return -! end if -! end if -! -! ! Reset starting and ending location -! xyz0 = p % coord(1) % xyz - d_track * p % coord(1) % uvw -! xyz1 = p % coord(1) % xyz -! -! ! ========================================================================= -! ! CHECK FOR SCORING COMBINATION FOR FILTERS OTHER THAN MESH -! -! FILTER_LOOP: do i = 1, t % n_filters -! -! select case (t % filters(i) % type) -! case (FILTER_UNIVERSE) -! ! determine next universe bin -! ! TODO: Account for multiple universes when performing this filter -! matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & -! p % coord(p % n_coord) % universe, i_tally) -! -! case (FILTER_MATERIAL) -! matching_bins(i) = get_next_bin(FILTER_MATERIAL, & -! p % material, i_tally) -! -! case (FILTER_CELL) -! ! determine next cell bin -! do j = 1, p % n_coord -! position(FILTER_CELL) = 0 -! matching_bins(i) = get_next_bin(FILTER_CELL, & -! p % coord(j) % cell, i_tally) -! if (matching_bins(i) /= NO_BIN_FOUND) exit -! end do -! -! case (FILTER_CELLBORN) -! ! determine next cellborn bin -! matching_bins(i) = get_next_bin(FILTER_CELLBORN, & -! p % cell_born, i_tally) -! -! case (FILTER_SURFACE) -! ! determine next surface bin -! matching_bins(i) = get_next_bin(FILTER_SURFACE, & -! p % surface, i_tally) -! -! case (FILTER_ENERGYIN) -! ! determine incoming energy bin -! k = t % filters(i) % n_bins -! -! ! check if energy of the particle is within energy bins -! if (p % E < t % filters(i) % real_bins(1) .or. & -! p % E > t % filters(i) % real_bins(k + 1)) then -! matching_bins(i) = NO_BIN_FOUND -! else -! ! search to find incoming energy bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, & -! k + 1, p % E) -! end if -! -! case (FILTER_POLAR) -! ! Get theta value -! theta = acos(p % coord(1) % uvw(3)) -! -! ! determine polar angle bin -! k = t % filters(i) % n_bins -! -! ! check if particle is within polar angle bins -! if (theta < t % filters(i) % real_bins(1) .or. & -! theta > t % filters(i) % real_bins(k + 1)) then -! matching_bins(i) = NO_BIN_FOUND -! else -! ! search to find polar angle bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, & -! k + 1, theta) -! end if -! -! case (FILTER_AZIMUTHAL) -! ! make sure the correct direction vector is used -! phi = atan2(p % coord(1) % uvw(2), p % coord(1) % uvw(1)) -! -! ! determine mu bin -! k = t % filters(i) % n_bins -! -! ! check if particle is within azimuthal angle bins -! if (phi < t % filters(i) % real_bins(1) .or. & -! phi > t % filters(i) % real_bins(k + 1)) then -! matching_bins(i) = NO_BIN_FOUND -! else -! ! search to find azimuthal angle bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, & -! k + 1, phi) -! end if -! -! end select -! -! ! Check if no matching bin was found -! if (matching_bins(i) == NO_BIN_FOUND) return -! -! end do FILTER_LOOP -! -! ! ========================================================================== -! ! DETERMINE WHICH MESH CELLS TO SCORE TO -! -! ! Calculate number of surface crossings -! n_cross = sum(abs(ijk1(:m % n_dimension) - ijk0(:m % n_dimension))) + 1 -! -! ! Copy particle's direction -! uvw = p % coord(1) % uvw -! -! ! Bounding coordinates -! do j = 1, m % n_dimension -! if (uvw(j) > 0) then -! xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) -! else -! xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) -! end if -! end do -! -! MESH_LOOP: do k = 1, n_cross -! found_bin = .false. -! -! ! Calculate distance to each bounding surface. We need to treat special -! ! case where the cosine of the angle is zero since this would result in a -! ! divide-by-zero. -! -! if (k == n_cross) xyz_cross = xyz1 -! -! do j = 1, m % n_dimension -! if (uvw(j) == 0) then -! d(j) = INFINITY -! else -! d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) -! end if -! end do -! -! ! Determine the closest bounding surface of the mesh cell by calculating -! ! the minimum distance -! -! j = minloc(d(:m % n_dimension), 1) -! distance = d(j) -! -! ! Now use the minimum distance and diretion of the particle to determine -! ! which surface was crossed -! -! if (all(ijk0(:m % n_dimension) >= 1) .and. all(ijk0(:m % n_dimension) <= m % dimension)) then -! ijk_cross = ijk0 -! found_bin = .true. -! end if -! -! ! Increment indices and determine new crossing point -! if (uvw(j) > 0) then -! ijk0(j) = ijk0(j) + 1 -! xyz_cross(j) = xyz_cross(j) + m % width(j) -! else -! ijk0(j) = ijk0(j) - 1 -! xyz_cross(j) = xyz_cross(j) - m % width(j) -! end if -! -! ! ======================================================================= -! ! SCORE TO THIS MESH CELL -! -! if (found_bin) then -! ! Calculate track-length estimate of flux -! flux = p % wgt * distance -! -! ! Determine mesh bin -! matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, ijk_cross) -! -! ! Determining scoring index -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! -! if (t % all_nuclides) then -! if (p % material /= MATERIAL_VOID) then -! ! Score reaction rates for each nuclide in material -! call score_all_nuclides(p, i_tally, flux, filter_index) -! end if -! else -! NUCLIDE_BIN_LOOP: do b = 1, t % n_nuclide_bins -! ! Get index of nuclide in nuclides array -! i_nuclide = t % nuclide_bins(b) -! -! if (i_nuclide > 0) then -! if (p % material /= MATERIAL_VOID) then -! ! Get pointer to current material -! mat => materials(p % material) -! -! ! Determine if nuclide is actually in material -! NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides -! ! If index of nuclide matches the j-th nuclide listed in -! ! the material, break out of the loop -! if (i_nuclide == mat % nuclide(j)) exit -! -! ! If we've reached the last nuclide in the material, it -! ! means the specified nuclide to be tallied is not in this -! ! material -! if (j == mat % n_nuclides) then -! cycle NUCLIDE_BIN_LOOP -! end if -! end do NUCLIDE_MAT_LOOP -! -! atom_density = mat % atom_density(j) -! else -! atom_density = ZERO -! end if -! end if -! -! ! Determine score for each bin -! call score_general(p, t, (b-1)*t % n_score_bins, filter_index, & -! i_nuclide, atom_density, flux) -! -! end do NUCLIDE_BIN_LOOP -! end if -! end if -! -! ! Calculate new coordinates -! xyz0 = xyz0 + distance * uvw -! -! end do MESH_LOOP + integer :: i ! loop index for filter/score bins + integer :: j ! loop index for direction + integer :: k ! loop index for mesh cell crossings + integer :: b ! loop index for nuclide bins + integer :: ijk0(3) ! indices of starting coordinates + integer :: ijk1(3) ! indices of ending coordinates + integer :: ijk_cross(3) ! indices of mesh cell crossed + integer :: n_cross ! number of surface crossings + integer :: filter_index ! single index for single bin + integer :: i_nuclide ! index in nuclides array + integer :: i_filter_mesh ! index of mesh filter in filters array + real(8) :: atom_density ! density of individual nuclide in atom/b-cm + real(8) :: flux ! tracklength estimate of flux + real(8) :: uvw(3) ! cosine of angle of particle + real(8) :: xyz0(3) ! starting/intermediate coordinates + real(8) :: xyz1(3) ! ending coordinates of particle + real(8) :: xyz_cross(3) ! coordinates of next boundary + real(8) :: d(3) ! distance to each bounding surface + real(8) :: distance ! distance traveled in mesh cell + logical :: found_bin ! was a scoring bin found? + logical :: start_in_mesh ! starting coordinates inside mesh? + logical :: end_in_mesh ! ending coordinates inside mesh? + real(8) :: theta + real(8) :: phi + type(TallyObject), pointer :: t + type(RegularMesh), pointer :: m + type(Material), pointer :: mat + + t => tallies(i_tally) + matching_bins(1:t%n_filters) = 1 + + ! ========================================================================== + ! CHECK IF THIS TRACK INTERSECTS THE MESH + + ! Copy starting and ending location of particle + xyz0 = p % coord(1) % xyz - (d_track - TINY_BIT) * p % coord(1) % uvw + xyz1 = p % coord(1) % xyz - TINY_BIT * p % coord(1) % uvw + + ! Get index for mesh filter + i_filter_mesh = t % find_filter(FILTER_MESH) + + ! Get pointer to mesh + select type(filt => t % filters(i_filter_mesh) % obj) + type is (MeshFilter) + m => meshes(filt % mesh) + end select + + ! Determine indices for starting and ending location + call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) + call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) + + ! Check if start or end is in mesh -- if not, check if track still + ! intersects with mesh + if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then + if (m % n_dimension == 2) then + if (.not. mesh_intersects_2d(m, xyz0, xyz1)) return + else + if (.not. mesh_intersects_3d(m, xyz0, xyz1)) return + end if + end if + + ! Reset starting and ending location + xyz0 = p % coord(1) % xyz - d_track * p % coord(1) % uvw + xyz1 = p % coord(1) % xyz + + ! ========================================================================= + ! CHECK FOR SCORING COMBINATION FOR FILTERS OTHER THAN MESH + + FILTER_LOOP: do i = 1, t % n_filters + + ! Ignore this filter if it's the mesh filter + if (i == i_filter_mesh) cycle + + matching_bins(i) = t % filters(i) % obj % get_next_bin(p, t % estimator, & + NO_BIN_FOUND) + + ! Check if no matching bin was found + if (matching_bins(i) == NO_BIN_FOUND) return + + end do FILTER_LOOP + + ! ========================================================================== + ! DETERMINE WHICH MESH CELLS TO SCORE TO + + ! Calculate number of surface crossings + n_cross = sum(abs(ijk1(:m % n_dimension) - ijk0(:m % n_dimension))) + 1 + + ! Copy particle's direction + uvw = p % coord(1) % uvw + + ! Bounding coordinates + do j = 1, m % n_dimension + if (uvw(j) > 0) then + xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) + else + xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + end if + end do + + MESH_LOOP: do k = 1, n_cross + found_bin = .false. + + ! Calculate distance to each bounding surface. We need to treat special + ! case where the cosine of the angle is zero since this would result in a + ! divide-by-zero. + + if (k == n_cross) xyz_cross = xyz1 + + do j = 1, m % n_dimension + if (uvw(j) == 0) then + d(j) = INFINITY + else + d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) + end if + end do + + ! Determine the closest bounding surface of the mesh cell by calculating + ! the minimum distance + + j = minloc(d(:m % n_dimension), 1) + distance = d(j) + + ! Now use the minimum distance and diretion of the particle to determine + ! which surface was crossed + + if (all(ijk0(:m % n_dimension) >= 1) .and. all(ijk0(:m % n_dimension) <= m % dimension)) then + ijk_cross = ijk0 + found_bin = .true. + end if + + ! Increment indices and determine new crossing point + if (uvw(j) > 0) then + ijk0(j) = ijk0(j) + 1 + xyz_cross(j) = xyz_cross(j) + m % width(j) + else + ijk0(j) = ijk0(j) - 1 + xyz_cross(j) = xyz_cross(j) - m % width(j) + end if + + ! ======================================================================= + ! SCORE TO THIS MESH CELL + + if (found_bin) then + ! Calculate track-length estimate of flux + flux = p % wgt * distance + + ! Determine mesh bin + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, ijk_cross) + + ! Determining scoring index + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + + if (t % all_nuclides) then + if (p % material /= MATERIAL_VOID) then + ! Score reaction rates for each nuclide in material + call score_all_nuclides(p, i_tally, flux, filter_index) + end if + else + NUCLIDE_BIN_LOOP: do b = 1, t % n_nuclide_bins + ! Get index of nuclide in nuclides array + i_nuclide = t % nuclide_bins(b) + + if (i_nuclide > 0) then + if (p % material /= MATERIAL_VOID) then + ! Get pointer to current material + mat => materials(p % material) + + ! Determine if nuclide is actually in material + NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides + ! If index of nuclide matches the j-th nuclide listed in + ! the material, break out of the loop + if (i_nuclide == mat % nuclide(j)) exit + + ! If we've reached the last nuclide in the material, it + ! means the specified nuclide to be tallied is not in this + ! material + if (j == mat % n_nuclides) then + cycle NUCLIDE_BIN_LOOP + end if + end do NUCLIDE_MAT_LOOP + + atom_density = mat % atom_density(j) + else + atom_density = ZERO + end if + end if + + ! Determine score for each bin + call score_general(p, t, (b-1)*t % n_score_bins, filter_index, & + i_nuclide, atom_density, flux) + + end do NUCLIDE_BIN_LOOP + end if + end if + + ! Calculate new coordinates + xyz0 = xyz0 + distance * uvw + + end do MESH_LOOP end subroutine score_tl_on_mesh From 8212333425a9baaf2c9b0730fbf0bea4cd7ab244 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 24 Jun 2016 11:27:22 -0500 Subject: [PATCH 05/23] Reconnect delayed fission tallies --- src/tally.F90 | 202 ++++++++++++++++++++++++++------------------------ 1 file changed, 106 insertions(+), 96 deletions(-) diff --git a/src/tally.F90 b/src/tally.F90 index 3236f8fcd..08275588b 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -1682,86 +1682,96 @@ contains type(TallyObject), intent(inout) :: t integer, intent(in) :: i_score ! index for score -! integer :: i ! index of outgoing energy filter -! integer :: j ! index of delayedgroup filter -! integer :: d ! delayed group -! integer :: g ! another delayed group -! integer :: d_bin ! delayed group bin index -! integer :: n ! number of energies on filter -! integer :: k ! loop index for bank sites -! integer :: bin_energyout ! original outgoing energy bin -! integer :: i_filter ! index for matching filter bin combination -! real(8) :: score ! actual score -! real(8) :: E_out ! energy of fission bank site -! -! ! Save original outgoing energy bin -! i = t % find_filter(FILTER_ENERGYOUT) -! bin_energyout = matching_bins(i) -! -! ! Get the index of delayed group filter -! j = t % find_filter(FILTER_DELAYEDGROUP) -! -! ! Get number of energies on filter -! n = size(t % filters(i) % real_bins) -! -! ! Since the creation of fission sites is weighted such that it is -! ! expected to create n_particles sites, we need to multiply the -! ! score by keff to get the true delayed-nu-fission rate. -! -! ! loop over number of particles banked -! do k = 1, p % n_bank -! -! ! get the delayed group -! g = fission_bank(n_bank - p % n_bank + k) % delayed_group -! -! ! check if the particle was born delayed -! if (g /= 0) then -! -! ! determine score based on bank site weight and keff -! score = keff * fission_bank(n_bank - p % n_bank + k) % wgt -! -! ! determine outgoing energy from fission bank -! E_out = fission_bank(n_bank - p % n_bank + k) % E -! -! ! check if outgoing energy is within specified range on filter -! if (E_out < t % filters(i) % real_bins(1) .or. & -! E_out > t % filters(i) % real_bins(n)) cycle -! -! ! change outgoing energy bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) -! -! ! if the delayed group filter is present, tally to corresponding -! ! delayed group bin if it exists -! if (j > 0) then -! -! ! loop over delayed group bins until the corresponding bin is found -! do d_bin = 1, t % filters(j) % n_bins -! d = t % filters(j) % int_bins(d_bin) -! -! ! check whether the delayed group of the particle is equal to the -! ! delayed group of this bin -! if (d == g) then -! call score_fission_delayed_dg(t, d_bin, score, i_score) -! end if -! end do -! -! ! if the delayed group filter is not present, add score to tally -! else -! -! ! determine scoring index -! i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! -! ! Add score to tally -!!$omp atomic -! t % results(i_score, i_filter) % value = & -! t % results(i_score, i_filter) % value + score -! end if -! end if -! end do -! -! ! reset outgoing energy bin -! matching_bins(i) = bin_energyout -! + integer :: i ! index of outgoing energy filter + integer :: j ! index of delayedgroup filter + integer :: d ! delayed group + integer :: g ! another delayed group + integer :: d_bin ! delayed group bin index + integer :: n ! number of energies on filter + integer :: k ! loop index for bank sites + integer :: bin_energyout ! original outgoing energy bin + integer :: i_filter ! index for matching filter bin combination + real(8) :: score ! actual score + real(8) :: E_out ! energy of fission bank site + + ! Save original outgoing energy bin + i = t % find_filter(FILTER_ENERGYOUT) + bin_energyout = matching_bins(i) + + ! Get the index of delayed group filter + j = t % find_filter(FILTER_DELAYEDGROUP) + + ! Declare the energyout filter type + select type(eo_filt => t % filters(i) % obj) + type is (EnergyoutFilter) + + ! Get number of energies on filter + n = size(eo_filt % bins) + + ! Since the creation of fission sites is weighted such that it is + ! expected to create n_particles sites, we need to multiply the + ! score by keff to get the true delayed-nu-fission rate. + + ! loop over number of particles banked + do k = 1, p % n_bank + + ! get the delayed group + g = fission_bank(n_bank - p % n_bank + k) % delayed_group + + ! check if the particle was born delayed + if (g /= 0) then + + ! determine score based on bank site weight and keff + score = keff * fission_bank(n_bank - p % n_bank + k) % wgt + + ! determine outgoing energy from fission bank + E_out = fission_bank(n_bank - p % n_bank + k) % E + + ! check if outgoing energy is within specified range on filter + if (E_out < eo_filt % bins(1) .or. E_out > eo_filt % bins(n)) cycle + + ! change outgoing energy bin + matching_bins(i) = binary_search(eo_filt % bins, n, E_out) + + ! if the delayed group filter is present, tally to corresponding + ! delayed group bin if it exists + if (j > 0) then + + ! Declare the delayed group filter type + select type(dg_filt => t % filters(j) % obj) + type is (DelayedGroupFilter) + + ! loop over delayed group bins until the corresponding bin is + ! found + do d_bin = 1, dg_filt % n_bins + d = dg_filt % groups(d_bin) + + ! check whether the delayed group of the particle is equal to + ! the delayed group of this bin + if (d == g) then + call score_fission_delayed_dg(t, d_bin, score, i_score) + end if + end do + end select + + ! if the delayed group filter is not present, add score to tally + else + + ! determine scoring index + i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + + ! Add score to tally +!$omp atomic + t % results(i_score, i_filter) % value = & + t % results(i_score, i_filter) % value + score + end if + end if + end do + end select + + ! reset outgoing energy bin + matching_bins(i) = bin_energyout + end subroutine score_fission_delayed_eout !=============================================================================== @@ -1776,22 +1786,22 @@ contains real(8), intent(in) :: score ! actual score integer, intent(in) :: d_bin ! delayed group bin index -! integer :: bin_original ! original bin index -! integer :: filter_index ! index for matching filter bin combination -! -! ! save original delayed group bin -! bin_original = matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) -! matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = d_bin -! -! ! Compute the filter index based on the modified matching_bins -! filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! -!!$omp atomic -! t % results(score_index, filter_index) % value = & -! t % results(score_index, filter_index) % value + score -! -! ! reset original delayed group bin -! matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = bin_original + integer :: bin_original ! original bin index + integer :: filter_index ! index for matching filter bin combination + + ! save original delayed group bin + bin_original = matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) + matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = d_bin + + ! Compute the filter index based on the modified matching_bins + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + +!$omp atomic + t % results(score_index, filter_index) % value = & + t % results(score_index, filter_index) % value + score + + ! reset original delayed group bin + matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = bin_original end subroutine score_fission_delayed_dg From b0b3f4eb948d35afc457d0dae30511ea692b9970 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 24 Jun 2016 12:53:19 -0500 Subject: [PATCH 06/23] Reconnect MG tallies --- src/input_xml.F90 | 10 +- src/tally.F90 | 380 +++++++++---------------------------------- src/tally_filter.F90 | 56 +++++-- 3 files changed, 123 insertions(+), 323 deletions(-) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index fc244670f..e1cb94e25 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -3037,7 +3037,10 @@ contains if (.not. run_CE) then if (n_words == energy_groups + 1) then if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & - t % energy_matches_groups = .true. + then + t % energy_matches_groups = .true. + filt % matches_transport_groups = .true. + end if end if end if end select @@ -3060,7 +3063,10 @@ contains if (.not. run_CE) then if (n_words == energy_groups + 1) then if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & - t % energy_matches_groups = .true. + then + t % energyout_matches_groups = .true. + filt % matches_transport_groups = .true. + end if end if end if end select diff --git a/src/tally.F90 b/src/tally.F90 index 08275588b..98ee1d7f2 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -29,7 +29,6 @@ module tally procedure(score_general_), pointer :: score_general => null() procedure(score_analog_tally_), pointer :: score_analog_tally => null() - procedure(get_scoring_bins_), pointer :: get_scoring_bins => null() abstract interface subroutine score_general_(p, t, start_index, filter_index, i_nuclide, & @@ -49,13 +48,6 @@ module tally import Particle type(Particle), intent(in) :: p end subroutine score_analog_tally_ - - subroutine get_scoring_bins_(p, i_tally, found_bin) - import Particle - type(Particle), intent(in) :: p - integer, intent(in) :: i_tally - logical, intent(out) :: found_bin - end subroutine get_scoring_bins_ end interface contains @@ -69,11 +61,9 @@ contains if (run_CE) then score_general => score_general_ce score_analog_tally => score_analog_tally_ce - get_scoring_bins => get_scoring_bins_ce else score_general => score_general_mg score_analog_tally => score_analog_tally_mg - get_scoring_bins => get_scoring_bins_mg end if end subroutine init_tally_routines @@ -1598,74 +1588,78 @@ contains integer, intent(in) :: i_nuclide ! index for nuclide real(8), intent(in) :: atom_density -! integer :: i ! index of outgoing energy filter -! integer :: n ! number of energies on filter -! integer :: k ! loop index for bank sites -! integer :: bin_energyout ! original outgoing energy bin -! integer :: i_filter ! index for matching filter bin combination -! real(8) :: score ! actual score -! integer :: gout ! energy group of fission bank site -! integer :: gin ! energy group of incident particle -! real(8) :: E_out -! -! ! save original outgoing energy bin and score index -! i = t % find_filter(FILTER_ENERGYOUT) -! bin_energyout = matching_bins(i) -! -! ! Get number of energies on filter -! n = size(t % filters(i) % real_bins) -! -! ! Since the creation of fission sites is weighted such that it is -! ! expected to create n_particles sites, we need to multiply the -! ! score by keff to get the true nu-fission rate. Otherwise, the sum -! ! of all nu-fission rates would be ~1.0. -! -! ! loop over number of particles banked -! do k = 1, p % n_bank -! ! determine score based on bank site weight and keff -! score = keff * fission_bank(n_bank - p % n_bank + k) % wgt -! if (i_nuclide > 0) then -! if (survival_biasing) then -! gin = p % g -! else -! gin = p % last_g -! end if -! score = score * atom_density * & -! nuclides_MG(i_nuclide) % obj % get_xs('fission', gin, & -! UVW=p % last_uvw) / & -! macro_xs(p % material) % obj % get_xs('fission', gin, & -! UVW=p % last_uvw) -! end if -! -! if (t % energyout_matches_groups) then -! ! determine outgoing energy from fission bank -! gout = int(fission_bank(n_bank - p % n_bank + k) % E) -! -! ! change outgoing energy bin -! matching_bins(i) = gout -! else -! ! determine outgoing energy from fission bank -! E_out = energy_bin_avg(int(fission_bank(n_bank - p % n_bank + k) % E)) -! -! ! check if outgoing energy is within specified range on filter -! if (E_out < t % filters(i) % real_bins(1) .or. & -! E_out > t % filters(i) % real_bins(n)) cycle -! -! ! change outgoing energy bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) -! end if -! -! ! determine scoring index -! i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 -! -! ! Add score to tally -!!$omp atomic -! t % results(i_score, i_filter) % value = & -! t % results(i_score, i_filter) % value + score -! end do -! -! ! reset outgoing energy bin and score index -! matching_bins(i) = bin_energyout + integer :: i ! index of outgoing energy filter + integer :: n ! number of energies on filter + integer :: k ! loop index for bank sites + integer :: bin_energyout ! original outgoing energy bin + integer :: i_filter ! index for matching filter bin combination + real(8) :: score ! actual score + integer :: gout ! energy group of fission bank site + integer :: gin ! energy group of incident particle + real(8) :: E_out + + ! save original outgoing energy bin and score index + i = t % find_filter(FILTER_ENERGYOUT) + bin_energyout = matching_bins(i) + + ! Declare the filter type + select type(filt => t % filters(i) % obj) + type is (EnergyoutFilter) + + ! Get number of energies on filter + n = size(filt % bins) + + ! Since the creation of fission sites is weighted such that it is + ! expected to create n_particles sites, we need to multiply the + ! score by keff to get the true nu-fission rate. Otherwise, the sum + ! of all nu-fission rates would be ~1.0. + + ! loop over number of particles banked + do k = 1, p % n_bank + ! determine score based on bank site weight and keff + score = keff * fission_bank(n_bank - p % n_bank + k) % wgt + if (i_nuclide > 0) then + if (survival_biasing) then + gin = p % g + else + gin = p % last_g + end if + score = score * atom_density * & + nuclides_MG(i_nuclide) % obj % get_xs('fission', gin, & + UVW=p % last_uvw) / & + macro_xs(p % material) % obj % get_xs('fission', gin, & + UVW=p % last_uvw) + end if + + if (t % energyout_matches_groups) then + ! determine outgoing energy from fission bank + gout = int(fission_bank(n_bank - p % n_bank + k) % E) + + ! change outgoing energy bin + matching_bins(i) = gout + else + ! determine outgoing energy from fission bank + E_out = energy_bin_avg(int(fission_bank(n_bank - p % n_bank + k) % E)) + + ! check if outgoing energy is within specified range on filter + if (E_out < filt % bins(1) .or. E_out > filt % bins(n)) cycle + + ! change outgoing energy bin + matching_bins(i) = binary_search(filt % bins, n, E_out) + end if + + ! determine scoring index + i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + + ! Add score to tally +!$omp atomic + t % results(i_score, i_filter) % value = & + t % results(i_score, i_filter) % value + score + end do + + ! reset outgoing energy bin and score index + matching_bins(i) = bin_energyout + end select end subroutine score_fission_eout_mg @@ -1953,8 +1947,6 @@ contains logical :: found_bin ! was a scoring bin found? logical :: start_in_mesh ! starting coordinates inside mesh? logical :: end_in_mesh ! ending coordinates inside mesh? - real(8) :: theta - real(8) :: phi type(TallyObject), pointer :: t type(RegularMesh), pointer :: m type(Material), pointer :: mat @@ -2250,21 +2242,14 @@ contains ! for a tally based on the particle's current attributes. !=============================================================================== - subroutine get_scoring_bins_ce(p, i_tally, found_bin) + subroutine get_scoring_bins(p, i_tally, found_bin) type(Particle), intent(in) :: p integer, intent(in) :: i_tally logical, intent(out) :: found_bin - integer :: i ! loop index for filters - integer :: j - integer :: n ! number of bins for single filter - integer :: offset ! offset for distribcell - integer :: distribcell_index ! index in distribcell arrays - real(8) :: E ! particle energy - real(8) :: theta, phi ! Polar and Azimuthal Angles, respectively + integer :: i type(TallyObject), pointer :: t - type(RegularMesh), pointer :: m found_bin = .true. t => tallies(i_tally) @@ -2283,221 +2268,7 @@ contains end do FILTER_LOOP - end subroutine get_scoring_bins_ce - - subroutine get_scoring_bins_mg(p, i_tally, found_bin) - - type(Particle), intent(in) :: p - integer, intent(in) :: i_tally - logical, intent(out) :: found_bin - -! integer :: i ! loop index for filters -! integer :: j -! integer :: n ! number of bins for single filter -! integer :: distribcell_index ! index in distribcell arrays -! integer :: offset ! offset for distribcell -! real(8) :: theta, phi ! Polar and Azimuthal Angles, respectively -! real(8) :: E -! type(TallyObject), pointer :: t -! type(RegularMesh), pointer :: m -! -! found_bin = .true. -! t => tallies(i_tally) -! matching_bins(1:t%n_filters) = 1 -! -! FILTER_LOOP: do i = 1, t % n_filters -! -! select case (t % filters(i) % type) -! case (FILTER_MESH) -! ! determine mesh bin -! m => meshes(t % filters(i) % int_bins(1)) -! -! ! Determine if we're in the mesh first -! call get_mesh_bin(m, p % coord(1) % xyz, matching_bins(i)) -! -! case (FILTER_UNIVERSE) -! ! determine next universe bin -! ! TODO: Account for multiple universes when performing this filter -! matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & -! p % coord(p % n_coord) % universe, i_tally) -! -! case (FILTER_MATERIAL) -! if (p % material == MATERIAL_VOID) then -! matching_bins(i) = NO_BIN_FOUND -! else -! matching_bins(i) = get_next_bin(FILTER_MATERIAL, & -! p % material, i_tally) -! endif -! -! case (FILTER_CELL) -! ! determine next cell bin -! do j = 1, p % n_coord -! position(FILTER_CELL) = 0 -! matching_bins(i) = get_next_bin(FILTER_CELL, & -! p % coord(j) % cell, i_tally) -! if (matching_bins(i) /= NO_BIN_FOUND) exit -! end do -! -! case (FILTER_DISTRIBCELL) -! ! determine next distribcell bin -! distribcell_index = cells(t % filters(i) % int_bins(1)) & -! % distribcell_index -! matching_bins(i) = NO_BIN_FOUND -! offset = 0 -! do j = 1, p % n_coord -! if (cells(p % coord(j) % cell) % type == CELL_FILL) then -! offset = offset + cells(p % coord(j) % cell) % & -! offset(distribcell_index) -! elseif(cells(p % coord(j) % cell) % type == CELL_LATTICE) then -! if (lattices(p % coord(j + 1) % lattice) % obj & -! % are_valid_indices([& -! p % coord(j + 1) % lattice_x, & -! p % coord(j + 1) % lattice_y, & -! p % coord(j + 1) % lattice_z])) then -! offset = offset + lattices(p % coord(j + 1) % lattice) % obj % & -! offset(distribcell_index, & -! p % coord(j + 1) % lattice_x, & -! p % coord(j + 1) % lattice_y, & -! p % coord(j + 1) % lattice_z) -! end if -! end if -! if (t % filters(i) % int_bins(1) == p % coord(j) % cell) then -! matching_bins(i) = offset + 1 -! exit -! end if -! end do -! -! case (FILTER_CELLBORN) -! ! determine next cellborn bin -! matching_bins(i) = get_next_bin(FILTER_CELLBORN, & -! p % cell_born, i_tally) -! -! case (FILTER_SURFACE) -! ! determine next surface bin -! matching_bins(i) = get_next_bin(FILTER_SURFACE, & -! p % surface, i_tally) -! -! case (FILTER_ENERGYIN) -! if (t % energy_matches_groups) then -! ! make sure the correct energy group is used -! ! Since all groups are filters, the filter bin is the group -! if (t % estimator == ESTIMATOR_TRACKLENGTH) then -! matching_bins(i) = p % g -! else -! matching_bins(i) = p % last_g -! end if -! ! Tallies are ordered in increasing groups, group indices -! ! however are the opposite, so switch -! matching_bins(i) = energy_groups - matching_bins(i) + 1 -! else -! ! make sure the correct energy is used -! if (t % estimator == ESTIMATOR_TRACKLENGTH) then -! E = p % E -! else -! E = p % last_E -! end if -! n = t % filters(i) % n_bins -! -! ! check if energy of the particle is within energy bins -! if (E < t % filters(i) % real_bins(1) .or. & -! E > t % filters(i) % real_bins(n + 1)) then -! matching_bins(i) = NO_BIN_FOUND -! else -! ! search to find incoming energy bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, & -! n + 1, E) -! end if -! end if -! -! case (FILTER_ENERGYOUT) -! if (t % energyout_matches_groups) then -! ! Since all groups are filters, the filter bin is the group -! matching_bins(i) = p % g -! -! ! Tallies are ordered in increasing groups, group indices -! ! however are the opposite, so switch -! matching_bins(i) = energy_groups - matching_bins(i) + 1 -! else -! ! determine outgoing energy bin -! n = t % filters(i) % n_bins -! -! ! check if energy of the particle is within energy bins -! if (p % E < t % filters(i) % real_bins(1) .or. & -! p % E > t % filters(i) % real_bins(n + 1)) then -! matching_bins(i) = NO_BIN_FOUND -! else -! ! search to find incoming energy bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, & -! n + 1, p % E) -! end if -! end if -! -! case (FILTER_MU) -! ! determine mu bin -! n = t % filters(i) % n_bins -! -! ! check if particle is within mu bins -! if (p % mu < t % filters(i) % real_bins(1) .or. & -! p % mu > t % filters(i) % real_bins(n + 1)) then -! matching_bins(i) = NO_BIN_FOUND -! else -! ! search to find mu bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, & -! n + 1, p % mu) -! end if -! -! case (FILTER_POLAR) -! ! make sure the correct direction vector is used -! if (t % estimator == ESTIMATOR_TRACKLENGTH) then -! theta = acos(p % coord(1) % uvw(3)) -! else -! theta = acos(p % last_uvw(3)) -! end if -! -! ! determine polar angle bin -! n = t % filters(i) % n_bins -! -! ! check if particle is within polar angle bins -! if (theta < t % filters(i) % real_bins(1) .or. & -! theta > t % filters(i) % real_bins(n + 1)) then -! matching_bins(i) = NO_BIN_FOUND -! else -! ! search to find polar angle bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, & -! n + 1, theta) -! end if -! -! case (FILTER_AZIMUTHAL) -! ! make sure the correct direction vector is used -! if (t % estimator == ESTIMATOR_TRACKLENGTH) then -! phi = atan2(p % coord(1) % uvw(2), p % coord(1) % uvw(1)) -! else -! phi = atan2(p % last_uvw(2), p % last_uvw(1)) -! end if -! ! determine mu bin -! n = t % filters(i) % n_bins -! -! ! check if particle is within azimuthal angle bins -! if (phi < t % filters(i) % real_bins(1) .or. & -! phi > t % filters(i) % real_bins(n + 1)) then -! matching_bins(i) = NO_BIN_FOUND -! else -! ! search to find azimuthal angle bin -! matching_bins(i) = binary_search(t % filters(i) % real_bins, & -! n + 1, phi) -! end if -! -! end select -! -! ! If the current filter didn't match, exit this subroutine -! if (matching_bins(i) == NO_BIN_FOUND) then -! found_bin = .false. -! return -! end if -! -! end do FILTER_LOOP -! - end subroutine get_scoring_bins_mg + end subroutine get_scoring_bins !=============================================================================== ! SCORE_SURFACE_CURRENT tallies surface crossings in a mesh tally by manually @@ -2515,7 +2286,6 @@ contains integer :: ijk0(3) ! indices of starting coordinates integer :: ijk1(3) ! indices of ending coordinates integer :: n_cross ! number of surface crossings - integer :: n ! number of incoming energy bins integer :: filter_index ! index of scoring bin integer :: i_filter_mesh ! index of mesh filter in filters array integer :: i_filter_surf ! index of surface filter in filters diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index 13b9fa48c..b119c1edf 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -112,6 +112,7 @@ module tally_filter !=============================================================================== type, extends(TallyFilter) :: EnergyFilter real(8), allocatable :: bins(:) + logical :: matches_transport_groups = .false. contains procedure :: get_next_bin => get_next_bin_energy procedure :: get_score => get_score_energy @@ -125,6 +126,7 @@ module tally_filter !=============================================================================== type, extends(TallyFilter) :: EnergyoutFilter real(8), allocatable :: bins(:) + logical :: matches_transport_groups = .false. contains procedure :: get_next_bin => get_next_bin_energyout procedure :: get_score => get_score_energyout @@ -728,19 +730,32 @@ contains if (current_bin == NO_BIN_FOUND) then n = this % n_bins - ! Make sure the correct energy is used. - if (estimator == ESTIMATOR_TRACKLENGTH) then - E = p % E - else - E = p % last_E - end if + if ((.not. run_CE) .and. this % matches_transport_groups) then + if (estimator == ESTIMATOR_TRACKLENGTH) then + next_bin = p % g + else + next_bin = p % last_g + end if + + ! Tallies are ordered in increasing groups, group indices + ! however are the opposite, so switch + next_bin = energy_groups - next_bin + 1 - ! Check if energy of the particle is within energy bins. - if (E < this % bins(1) .or. E > this % bins(n + 1)) then - next_bin = NO_BIN_FOUND else - ! Search to find incoming energy bin. - next_bin = binary_search(this % bins, n + 1, E) + ! Make sure the correct energy is used. + if (estimator == ESTIMATOR_TRACKLENGTH) then + E = p % E + else + E = p % last_E + end if + + ! Check if energy of the particle is within energy bins. + if (E < this % bins(1) .or. E > this % bins(n + 1)) then + next_bin = NO_BIN_FOUND + else + ! Search to find incoming energy bin. + next_bin = binary_search(this % bins, n + 1, E) + end if end if else @@ -795,12 +810,21 @@ contains if (current_bin == NO_BIN_FOUND) then n = this % n_bins - ! Check if energy of the particle is within energy bins. - if (p % E < this % bins(1) .or. p % E > this % bins(n + 1)) then - next_bin = NO_BIN_FOUND + if ((.not. run_CE) .and. this % matches_transport_groups) then + next_bin = p % g + + ! Tallies are ordered in increasing groups, group indices + ! however are the opposite, so switch + next_bin = energy_groups - next_bin + 1 + else - ! Search to find incoming energy bin. - next_bin = binary_search(this % bins, n + 1, p % E) + ! Check if energy of the particle is within energy bins. + if (p % E < this % bins(1) .or. p % E > this % bins(n + 1)) then + next_bin = NO_BIN_FOUND + else + ! Search to find incoming energy bin. + next_bin = binary_search(this % bins, n + 1, p % E) + end if end if else From ab04cd0338818ad68c2b03005d4ec0ba4e1ef061 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 24 Jun 2016 13:21:44 -0500 Subject: [PATCH 07/23] Fix CMFD --- src/cmfd_input.F90 | 40 ++++++++++++++-------------------------- 1 file changed, 14 insertions(+), 26 deletions(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 68ce03107..ec99a1c66 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -276,7 +276,7 @@ contains type(Node), pointer :: doc ! pointer to XML doc info character(MAX_LINE_LEN) :: temp_str ! temp string - integer :: i ! loop counter + integer :: i, j ! loop counter integer :: n ! size of arrays in mesh specification integer :: ng ! number of energy groups (default 1) integer :: n_filters ! number of filters @@ -415,6 +415,7 @@ contains allocate(MeshFilter::filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (MeshFilter) + filt % type = FILTER_MESH filt % n_bins = product(m % dimension) filt % mesh = n_user_meshes + 1 end select @@ -426,6 +427,7 @@ contains allocate(EnergyFilter::filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (EnergyFilter) + filt % type = FILTER_ENERGYIN ng = get_arraysize_double(node_mesh, "energy") filt % n_bins = ng - 1 allocate(filt % bins(ng)) @@ -456,7 +458,9 @@ contains ! Allocate and set filters t % n_filters = n_filters allocate(t % filters(n_filters)) - t % filters = filters(1:n_filters) + do j = 1, n_filters + call move_alloc(filters(j) % obj, t % filters(j) % obj) + end do ! Allocate scoring bins allocate(t % score_bins(3)) @@ -490,6 +494,7 @@ contains allocate(EnergyoutFilter::filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (EnergyoutFilter) + filt % type = FILTER_ENERGYOUT ng = get_arraysize_double(node_mesh, "energy") filt % n_bins = ng - 1 allocate(filt % bins(ng)) @@ -501,15 +506,9 @@ contains ! Allocate and set filters t % n_filters = n_filters allocate(t % filters(n_filters)) - t % filters = filters(1:n_filters) - - ! deallocate filters bins array - if (check_for_node(node_mesh, "energy")) then - select type (filt => filters(n_filters) % obj) - type is (EnergyoutFilter) - deallocate(filt % bins) - end select - end if + do j = 1, n_filters + call move_alloc(filters(j) % obj, t % filters(j) % obj) + end do ! Allocate macro reactions allocate(t % score_bins(2)) @@ -537,6 +536,7 @@ contains allocate(SurfaceFilter::filters(n_filters) % obj) select type(filt => filters(n_filters) % obj) type is(SurfaceFilter) + filt % type = FILTER_SURFACE filt % n_bins = 2 * m % n_dimension allocate(filt % surfaces(2 * m % n_dimension)) if (m % n_dimension == 2) then @@ -551,13 +551,9 @@ contains ! Allocate and set filters t % n_filters = n_filters allocate(t % filters(n_filters)) - t % filters = filters(1:n_filters) - - ! Deallocate filters bins array - select type(filt => filters(n_filters) % obj) - type is (SurfaceFilter) - deallocate(filt % surfaces) - end select + do j = 1, n_filters + call move_alloc(filters(j) % obj, t % filters(j) % obj) + end do ! Allocate macro reactions allocate(t % score_bins(1)) @@ -579,14 +575,6 @@ contains end if - ! Deallocate filter bins - if (check_for_node(node_mesh, "energy")) then - select type(filt => filters(2) % obj) - type is (EnergyFilter) - deallocate(filt % bins) - end select - end if - end do ! Put cmfd tallies into active tally array and turn tallies on From 64c77a21b10e60ed07949b437174d10b7c772753 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 24 Jun 2016 15:10:17 -0500 Subject: [PATCH 08/23] Fix distribcell --- src/tally_filter.F90 | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index b119c1edf..951562a6e 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -475,6 +475,8 @@ contains integer :: distribcell_index, offset, i + next_bin = NO_BIN_FOUND + distribcell_index = cells(this % cell) % distribcell_index if (current_bin == NO_BIN_FOUND) then @@ -501,8 +503,6 @@ contains exit end if end do - else - next_bin = NO_BIN_FOUND end if end function get_next_bin_distribcell @@ -556,15 +556,13 @@ contains integer :: i, id - do i = 1, this % n_bins - id = this % cell - if (cell_dict % has_key(id)) then - this % cell = cell_dict % get_key(id) - else - call fatal_error("Could not find cell " // trim(to_str(id)) & - &// " specified on tally filter.") - end if - end do + id = this % cell + if (cell_dict % has_key(id)) then + this % cell = cell_dict % get_key(id) + else + call fatal_error("Could not find cell " // trim(to_str(id)) & + &// " specified on tally filter.") + end if end subroutine initialize_distribcell function text_label_distribcell(this, bin) result(label) @@ -577,6 +575,7 @@ contains univ => universes(BASE_UNIVERSE) offset = 0 + label = '' call find_offset(this % cell, univ, bin-1, offset, label) label = "Distributed Cell " // label end function text_label_distribcell From 065fe6f162bfefa4d684f7833ddaa778255e85b1 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Mon, 27 Jun 2016 13:11:17 -0500 Subject: [PATCH 09/23] Fix current tallies --- src/output.F90 | 5 ++--- src/tally.F90 | 5 +++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/output.F90 b/src/output.F90 index ba0ad71c9..c9c0cffbe 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -737,7 +737,6 @@ contains integer :: k ! loop index for scoring bins integer :: n ! loop index for nuclides integer :: l ! loop index for user scores - integer :: type ! type of tally filter integer :: indent ! number of spaces to preceed output integer :: filter_index ! index in results array for filters integer :: score_index ! scoring bin index @@ -1033,8 +1032,8 @@ contains ! Write incoming energy bin write(UNIT=unit_tally, FMT='(3X,A)') & - t % filters(i_filter_ein) % obj % text_label( & - matching_bins(i_filter_ein)) + trim(t % filters(i_filter_ein) % obj % text_label( & + matching_bins(i_filter_ein))) end if ! Left Surface diff --git a/src/tally.F90 b/src/tally.F90 index 98ee1d7f2..7db2f4e8f 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -2345,11 +2345,12 @@ contains ! Copy particle's direction uvw = p % coord(1) % uvw - ! determine incoming energy bin + ! Determine incoming energy bin. We need to tell the energy filter this + ! is a tracklength tally so it uses the pre-collision energy. j = t % find_filter(FILTER_ENERGYIN) if (j > 0) then matching_bins(j) = t % filters(j) % obj & - % get_next_bin(p, ESTIMATOR_COLLISION, NO_BIN_FOUND) + % get_next_bin(p, ESTIMATOR_TRACKLENGTH, NO_BIN_FOUND) if (matching_bins(j) == NO_BIN_FOUND) cycle end if From 1f02570c2438fb45ea5e5cd69c7f77d05f574f67 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Mon, 27 Jun 2016 15:22:48 -0500 Subject: [PATCH 10/23] Move get_score functionality into get_next_bin --- src/tally.F90 | 15 +- src/tally_filter.F90 | 313 ++++++++++++++---------------------- src/tally_filter_header.F90 | 23 +-- 3 files changed, 142 insertions(+), 209 deletions(-) diff --git a/src/tally.F90 b/src/tally.F90 index 7db2f4e8f..3544ed5c5 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -1944,6 +1944,7 @@ contains real(8) :: xyz_cross(3) ! coordinates of next boundary real(8) :: d(3) ! distance to each bounding surface real(8) :: distance ! distance traveled in mesh cell + real(8) :: filt_score ! score applied by filters logical :: found_bin ! was a scoring bin found? logical :: start_in_mesh ! starting coordinates inside mesh? logical :: end_in_mesh ! ending coordinates inside mesh? @@ -1996,8 +1997,8 @@ contains ! Ignore this filter if it's the mesh filter if (i == i_filter_mesh) cycle - matching_bins(i) = t % filters(i) % obj % get_next_bin(p, t % estimator, & - NO_BIN_FOUND) + call t % filters(i) % obj % get_next_bin(p, t % estimator, NO_BIN_FOUND, & + matching_bins(i), filt_score) ! Check if no matching bin was found if (matching_bins(i) == NO_BIN_FOUND) return @@ -2249,6 +2250,7 @@ contains logical, intent(out) :: found_bin integer :: i + real(8) :: filt_score ! score applied by filters type(TallyObject), pointer :: t found_bin = .true. @@ -2257,8 +2259,8 @@ contains FILTER_LOOP: do i = 1, t % n_filters - matching_bins(i) = t % filters(i) % obj % get_next_bin(p, t % estimator, & - NO_BIN_FOUND) + call t % filters(i) % obj % get_next_bin(p, t % estimator, NO_BIN_FOUND, & + matching_bins(i), filt_score) ! If the current filter didn't match, exit this subroutine if (matching_bins(i) == NO_BIN_FOUND) then @@ -2295,6 +2297,7 @@ contains real(8) :: xyz_cross(3) ! coordinates of bounding surfaces real(8) :: d(3) ! distance to each bounding surface real(8) :: distance ! actual distance traveled + real(8) :: filt_score ! score applied by filters logical :: start_in_mesh ! particle's starting xyz in mesh? logical :: end_in_mesh ! particle's ending xyz in mesh? logical :: x_same ! same starting/ending x index (i) @@ -2349,8 +2352,8 @@ contains ! is a tracklength tally so it uses the pre-collision energy. j = t % find_filter(FILTER_ENERGYIN) if (j > 0) then - matching_bins(j) = t % filters(j) % obj & - % get_next_bin(p, ESTIMATOR_TRACKLENGTH, NO_BIN_FOUND) + call t % filters(i) % obj % get_next_bin(p, ESTIMATOR_TRACKLENGTH, & + & NO_BIN_FOUND, matching_bins(j), filt_score) if (matching_bins(j) == NO_BIN_FOUND) cycle end if diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index 951562a6e..c0b7dc5c5 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -23,7 +23,6 @@ module tally_filter integer :: mesh contains procedure :: get_next_bin => get_next_bin_mesh - procedure :: get_score => get_score_mesh procedure :: to_statepoint => to_statepoint_mesh procedure :: to_summary => to_statepoint_mesh procedure :: initialize => initialize_mesh @@ -36,7 +35,6 @@ module tally_filter integer, allocatable :: universes(:) contains procedure :: get_next_bin => get_next_bin_universe - procedure :: get_score => get_score_universe procedure :: to_statepoint => to_statepoint_universe procedure :: to_summary => to_statepoint_universe procedure :: initialize => initialize_universe @@ -49,7 +47,6 @@ module tally_filter integer, allocatable :: materials(:) contains procedure :: get_next_bin => get_next_bin_material - procedure :: get_score => get_score_material procedure :: to_statepoint => to_statepoint_material procedure :: to_summary => to_statepoint_material procedure :: initialize => initialize_material @@ -62,7 +59,6 @@ module tally_filter integer, allocatable :: cells(:) contains procedure :: get_next_bin => get_next_bin_cell - procedure :: get_score => get_score_cell procedure :: to_statepoint => to_statepoint_cell procedure :: to_summary => to_statepoint_cell procedure :: initialize => initialize_cell @@ -75,7 +71,6 @@ module tally_filter integer :: cell contains procedure :: get_next_bin => get_next_bin_distribcell - procedure :: get_score => get_score_distribcell procedure :: to_statepoint => to_statepoint_distribcell procedure :: to_summary => to_summary_distribcell procedure :: initialize => initialize_distribcell @@ -88,7 +83,6 @@ module tally_filter integer, allocatable :: cells(:) contains procedure :: get_next_bin => get_next_bin_cellborn - procedure :: get_score => get_score_cellborn procedure :: to_statepoint => to_statepoint_cellborn procedure :: to_summary => to_statepoint_cellborn procedure :: initialize => initialize_cellborn @@ -101,7 +95,6 @@ module tally_filter integer, allocatable :: surfaces(:) contains procedure :: get_next_bin => get_next_bin_surface - procedure :: get_score => get_score_surface procedure :: to_statepoint => to_statepoint_surface procedure :: to_summary => to_statepoint_surface procedure :: initialize => initialize_surface @@ -115,7 +108,6 @@ module tally_filter logical :: matches_transport_groups = .false. contains procedure :: get_next_bin => get_next_bin_energy - procedure :: get_score => get_score_energy procedure :: to_statepoint => to_statepoint_energy procedure :: to_summary => to_statepoint_energy procedure :: initialize => initialize_energy @@ -129,7 +121,6 @@ module tally_filter logical :: matches_transport_groups = .false. contains procedure :: get_next_bin => get_next_bin_energyout - procedure :: get_score => get_score_energyout procedure :: to_statepoint => to_statepoint_energyout procedure :: to_summary => to_statepoint_energyout procedure :: initialize => initialize_energyout @@ -142,7 +133,6 @@ module tally_filter integer, allocatable :: groups(:) contains procedure :: get_next_bin => get_next_bin_dg - procedure :: get_score => get_score_dg procedure :: to_statepoint => to_statepoint_dg procedure :: to_summary => to_statepoint_dg procedure :: initialize => initialize_dg @@ -155,7 +145,6 @@ module tally_filter real(8), allocatable :: bins(:) contains procedure :: get_next_bin => get_next_bin_mu - procedure :: get_score => get_score_mu procedure :: to_statepoint => to_statepoint_mu procedure :: to_summary => to_statepoint_mu procedure :: initialize => initialize_mu @@ -168,7 +157,6 @@ module tally_filter real(8), allocatable :: bins(:) contains procedure :: get_next_bin => get_next_bin_polar - procedure :: get_score => get_score_polar procedure :: to_statepoint => to_statepoint_polar procedure :: to_summary => to_statepoint_polar procedure :: initialize => initialize_polar @@ -181,7 +169,6 @@ module tally_filter real(8), allocatable :: bins(:) contains procedure :: get_next_bin => get_next_bin_azimuthal - procedure :: get_score => get_score_azimuthal procedure :: to_statepoint => to_statepoint_azimuthal procedure :: to_summary => to_statepoint_azimuthal procedure :: initialize => initialize_azimuthal @@ -199,24 +186,21 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_mesh(this, p, estimator, current_bin) result(next_bin) - class(MeshFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_mesh(this, p, estimator, current_bin, next_bin, score) + class(MeshFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score type(RegularMesh), pointer :: m m => meshes(this % mesh) call get_mesh_bin(m, p % coord(1) % xyz, next_bin) - end function get_next_bin_mesh - function get_score_mesh(this, bin) result(score) - class(MeshFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_mesh + score = ONE + end subroutine get_next_bin_mesh subroutine to_statepoint_mesh(this, filter_group) class(MeshFilter), intent(in) :: this @@ -253,13 +237,14 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_universe(this, p, estimator, current_bin) & - result(next_bin) - class(UniverseFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_universe(this, p, estimator, current_bin, next_bin, & + score) + class(UniverseFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: i, j, start logical :: bin_found @@ -283,13 +268,8 @@ contains end do if (.not. bin_found) next_bin = NO_BIN_FOUND - end function get_next_bin_universe - - function get_score_universe(this, bin) result(score) - class(UniverseFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_universe + score = ONE + end subroutine get_next_bin_universe subroutine to_statepoint_universe(this, filter_group) class(UniverseFilter), intent(in) :: this @@ -326,13 +306,14 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_material(this, p, estimator, current_bin) & - result(next_bin) - class(MaterialFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_material(this, p, estimator, current_bin, next_bin, & + score) + class(MaterialFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: i logical :: bin_found @@ -350,13 +331,8 @@ contains else next_bin = NO_BIN_FOUND end if - end function get_next_bin_material - - function get_score_material(this, bin) result(score) - class(MaterialFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_material + score = ONE + end subroutine get_next_bin_material subroutine to_statepoint_material(this, filter_group) class(MaterialFilter), intent(in) :: this @@ -393,12 +369,13 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_cell(this, p, estimator, current_bin) result(next_bin) - class(CellFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_cell(this, p, estimator, current_bin, next_bin, score) + class(CellFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: i, j, start logical :: bin_found @@ -422,13 +399,8 @@ contains end do if (.not. bin_found) next_bin = NO_BIN_FOUND - end function get_next_bin_cell - - function get_score_cell(this, bin) result(score) - class(CellFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_cell + score = ONE + end subroutine get_next_bin_cell subroutine to_statepoint_cell(this, filter_group) class(CellFilter), intent(in) :: this @@ -465,13 +437,14 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_distribcell(this, p, estimator, current_bin) & - result(next_bin) - class(DistribcellFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_distribcell(this, p, estimator, current_bin, & + next_bin, score) + class(DistribcellFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: distribcell_index, offset, i @@ -504,13 +477,8 @@ contains end if end do end if - end function get_next_bin_distribcell - - function get_score_distribcell(this, bin) result(score) - class(DistribcellFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_distribcell + score = ONE + end subroutine get_next_bin_distribcell subroutine to_statepoint_distribcell(this, filter_group) class(DistribcellFilter), intent(in) :: this @@ -582,13 +550,14 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_cellborn(this, p, estimator, current_bin) & - result(next_bin) - class(CellbornFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_cellborn(this, p, estimator, current_bin, next_bin, & + score) + class(CellbornFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: i logical :: bin_found @@ -606,13 +575,8 @@ contains else next_bin = NO_BIN_FOUND end if - end function get_next_bin_cellborn - - function get_score_cellborn(this, bin) result(score) - class(CellbornFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_cellborn + score = ONE + end subroutine get_next_bin_cellborn subroutine to_statepoint_cellborn(this, filter_group) class(CellbornFilter), intent(in) :: this @@ -649,13 +613,14 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_surface(this, p, estimator, current_bin) & - result(next_bin) - class(SurfaceFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_surface(this, p, estimator, current_bin, next_bin, & + score) + class(SurfaceFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: i logical :: bin_found @@ -673,13 +638,8 @@ contains else next_bin = NO_BIN_FOUND end if - end function get_next_bin_surface - - function get_score_surface(this, bin) result(score) - class(SurfaceFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_surface + score = ONE + end subroutine get_next_bin_surface subroutine to_statepoint_surface(this, filter_group) class(SurfaceFilter), intent(in) :: this @@ -716,12 +676,14 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_energy(this, p, estimator, current_bin) result(next_bin) - class(EnergyFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_energy(this, p, estimator, current_bin, next_bin, & + score) + class(EnergyFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: n real(8) :: E @@ -760,13 +722,8 @@ contains else next_bin = NO_BIN_FOUND end if - end function get_next_bin_energy - - function get_score_energy(this, bin) result(score) - class(EnergyFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_energy + score = ONE + end subroutine get_next_bin_energy subroutine to_statepoint_energy(this, filter_group) class(EnergyFilter), intent(in) :: this @@ -796,13 +753,14 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_energyout(this, p, estimator, current_bin) & - result(next_bin) - class(EnergyoutFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_energyout(this, p, estimator, current_bin, next_bin, & + score) + class(EnergyoutFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: n @@ -829,13 +787,8 @@ contains else next_bin = NO_BIN_FOUND end if - end function get_next_bin_energyout - - function get_score_energyout(this, bin) result(score) - class(EnergyoutFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_energyout + score = ONE + end subroutine get_next_bin_energyout subroutine to_statepoint_energyout(this, filter_group) class(EnergyoutFilter), intent(in) :: this @@ -865,19 +818,15 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_dg(this, p, estimator, current_bin) result(next_bin) - class(DelayedGroupFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin - end function get_next_bin_dg - - function get_score_dg(this, bin) result(score) - class(DelayedGroupFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_dg + subroutine get_next_bin_dg(this, p, estimator, current_bin, next_bin, score) + class(DelayedGroupFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score + score = ONE + end subroutine get_next_bin_dg subroutine to_statepoint_dg(this, filter_group) class(DelayedGroupFilter), intent(in) :: this @@ -902,12 +851,13 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_mu(this, p, estimator, current_bin) result(next_bin) - class(MuFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_mu(this, p, estimator, current_bin, next_bin, score) + class(MuFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: n @@ -925,13 +875,8 @@ contains else next_bin = NO_BIN_FOUND end if - end function get_next_bin_mu - - function get_score_mu(this, bin) result(score) - class(MuFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_mu + score = ONE + end subroutine get_next_bin_mu subroutine to_statepoint_mu(this, filter_group) class(MuFilter), intent(in) :: this @@ -961,12 +906,13 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_polar(this, p, estimator, current_bin) result(next_bin) - class(PolarFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_polar(this, p, estimator, current_bin, next_bin, score) + class(PolarFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: n real(8) :: theta @@ -992,13 +938,8 @@ contains else next_bin = NO_BIN_FOUND end if - end function get_next_bin_polar - - function get_score_polar(this, bin) result(score) - class(PolarFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_polar + score = ONE + end subroutine get_next_bin_polar subroutine to_statepoint_polar(this, filter_group) class(PolarFilter), intent(in) :: this @@ -1028,13 +969,14 @@ contains !=============================================================================== !=============================================================================== - function get_next_bin_azimuthal(this, p, estimator, current_bin) & - result(next_bin) - class(AzimuthalFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin + subroutine get_next_bin_azimuthal(this, p, estimator, current_bin, next_bin, & + score) + class(AzimuthalFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score integer :: n real(8) :: phi @@ -1060,13 +1002,8 @@ contains else next_bin = NO_BIN_FOUND end if - end function get_next_bin_azimuthal - - function get_score_azimuthal(this, bin) result(score) - class(AzimuthalFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_azimuthal + score = ONE + end subroutine get_next_bin_azimuthal subroutine to_statepoint_azimuthal(this, filter_group) class(AzimuthalFilter), intent(in) :: this diff --git a/src/tally_filter_header.F90 b/src/tally_filter_header.F90 index 7fbe62547..7da8eea06 100644 --- a/src/tally_filter_header.F90 +++ b/src/tally_filter_header.F90 @@ -12,7 +12,6 @@ module tally_filter_header integer :: type contains procedure(get_next_bin_), deferred :: get_next_bin - procedure(get_score_), deferred :: get_score procedure(to_statepoint_), deferred :: to_statepoint procedure(to_summary_), deferred :: to_summary procedure(initialize_), deferred :: initialize @@ -25,22 +24,16 @@ module tally_filter_header abstract interface - function get_next_bin_(this, p, estimator, current_bin) result(next_bin) + subroutine get_next_bin_(this, p, estimator, current_bin, next_bin, score) import TallyFilter import Particle - class(TallyFilter), intent(in) :: this - type(Particle), intent(in) :: p - integer, intent(in) :: estimator - integer, intent(in) :: current_bin - integer :: next_bin - end function get_next_bin_ - - function get_score_(this, bin) result(score) - import TallyFilter - class(TallyFilter), intent(in) :: this - integer, intent(in) :: bin - real(8) :: score - end function get_score_ + class(TallyFilter), intent(in) :: this + type(Particle), intent(in) :: p + integer, intent(in) :: estimator + integer, intent(in) :: current_bin + integer, intent(out) :: next_bin + real(8), intent(out) :: score + end subroutine get_next_bin_ subroutine to_statepoint_(this, filter_group) import TallyFilter From 4c2585660b5a2c5cc806414fe37cb7020543c5d9 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Tue, 28 Jun 2016 15:29:41 -0500 Subject: [PATCH 11/23] Implement new tally filter loop --- src/global.F90 | 5 +- src/mesh.F90 | 112 +++--- src/tally.F90 | 778 +++++++++++++++++---------------------- src/tally_filter.F90 | 167 ++++++++- src/tally_initialize.F90 | 1 + 5 files changed, 564 insertions(+), 499 deletions(-) diff --git a/src/global.F90 b/src/global.F90 index 357887199..24a672637 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -141,6 +141,7 @@ module global type(RegularMesh), allocatable, target :: meshes(:) type(TallyObject), allocatable, target :: tallies(:) integer, allocatable :: matching_bins(:) + real(8), allocatable :: filter_weights(:) ! Pointers for different tallies type(TallyObject), pointer :: user_tallies(:) => null() @@ -447,7 +448,8 @@ module global type(Nuclide0K), allocatable, target :: nuclides_0K(:) ! 0K nuclides info !$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, & -!$omp& trace, thread_id, current_work, matching_bins) +!$omp& trace, thread_id, current_work, matching_bins, & +!$omp& filter_weights) contains @@ -514,6 +516,7 @@ contains if (allocated(meshes)) deallocate(meshes) if (allocated(tallies)) deallocate(tallies) if (allocated(matching_bins)) deallocate(matching_bins) + if (allocated(filter_weights)) deallocate(filter_weights) if (allocated(tally_maps)) deallocate(tally_maps) ! Deallocate fission and source bank and entropy diff --git a/src/mesh.F90 b/src/mesh.F90 index 4ec84345b..333062d78 100644 --- a/src/mesh.F90 +++ b/src/mesh.F90 @@ -290,34 +290,42 @@ contains ! Check if line intersects left surface -- calculate the intersection point ! y - yi = y0 + (xm0 - x0) * (y1 - y0) / (x1 - x0) - if (yi >= ym0 .and. yi < ym1) then - intersects = .true. - return + if ( (x0 < xm0 .and. x1 > xm0) .or. (x0 > xm0 .and. x1 < xm0) ) then + yi = y0 + (xm0 - x0) * (y1 - y0) / (x1 - x0) + if (yi >= ym0 .and. yi < ym1) then + intersects = .true. + return + end if end if ! Check if line intersects back surface -- calculate the intersection point ! x - xi = x0 + (ym0 - y0) * (x1 - x0) / (y1 - y0) - if (xi >= xm0 .and. xi < xm1) then - intersects = .true. - return + if ( (y0 < ym0 .and. y1 > ym0) .or. (y0 > ym0 .and. y1 < ym0) ) then + xi = x0 + (ym0 - y0) * (x1 - x0) / (y1 - y0) + if (xi >= xm0 .and. xi < xm1) then + intersects = .true. + return + end if end if ! Check if line intersects right surface -- calculate the intersection ! point y - yi = y0 + (xm1 - x0) * (y1 - y0) / (x1 - x0) - if (yi >= ym0 .and. yi < ym1) then - intersects = .true. - return + if ( (x0 < xm1 .and. x1 > xm1) .or. (x0 > xm1 .and. x1 < xm1) ) then + yi = y0 + (xm1 - x0) * (y1 - y0) / (x1 - x0) + if (yi >= ym0 .and. yi < ym1) then + intersects = .true. + return + end if end if ! Check if line intersects front surface -- calculate the intersection point ! x - xi = x0 + (ym1 - y0) * (x1 - x0) / (y1 - y0) - if (xi >= xm0 .and. xi < xm1) then - intersects = .true. - return + if ( (y0 < ym1 .and. y1 > ym1) .or. (y0 > ym1 .and. y1 < ym1) ) then + xi = x0 + (ym1 - y0) * (x1 - x0) / (y1 - y0) + if (xi >= xm0 .and. xi < xm1) then + intersects = .true. + return + end if end if end function mesh_intersects_2d @@ -359,56 +367,68 @@ contains ! Check if line intersects left surface -- calculate the intersection point ! (y,z) - yi = y0 + (xm0 - x0) * (y1 - y0) / (x1 - x0) - zi = z0 + (xm0 - x0) * (z1 - z0) / (x1 - x0) - if (yi >= ym0 .and. yi < ym1 .and. zi >= zm0 .and. zi < zm1) then - intersects = .true. - return + if ( (x0 < xm0 .and. x1 > xm0) .or. (x0 > xm0 .and. x1 < xm0) ) then + yi = y0 + (xm0 - x0) * (y1 - y0) / (x1 - x0) + zi = z0 + (xm0 - x0) * (z1 - z0) / (x1 - x0) + if (yi >= ym0 .and. yi < ym1 .and. zi >= zm0 .and. zi < zm1) then + intersects = .true. + return + end if end if ! Check if line intersects back surface -- calculate the intersection point ! (x,z) - xi = x0 + (ym0 - y0) * (x1 - x0) / (y1 - y0) - zi = z0 + (ym0 - y0) * (z1 - z0) / (y1 - y0) - if (xi >= xm0 .and. xi < xm1 .and. zi >= zm0 .and. zi < zm1) then - intersects = .true. - return + if ( (y0 < ym0 .and. y1 > ym0) .or. (y0 > ym0 .and. y1 < ym0) ) then + xi = x0 + (ym0 - y0) * (x1 - x0) / (y1 - y0) + zi = z0 + (ym0 - y0) * (z1 - z0) / (y1 - y0) + if (xi >= xm0 .and. xi < xm1 .and. zi >= zm0 .and. zi < zm1) then + intersects = .true. + return + end if end if ! Check if line intersects bottom surface -- calculate the intersection ! point (x,y) - xi = x0 + (zm0 - z0) * (x1 - x0) / (z1 - z0) - yi = y0 + (zm0 - z0) * (y1 - y0) / (z1 - z0) - if (xi >= xm0 .and. xi < xm1 .and. yi >= ym0 .and. yi < ym1) then - intersects = .true. - return + if ( (z0 < zm0 .and. z1 > zm0) .or. (z0 > zm0 .and. z1 < zm0) ) then + xi = x0 + (zm0 - z0) * (x1 - x0) / (z1 - z0) + yi = y0 + (zm0 - z0) * (y1 - y0) / (z1 - z0) + if (xi >= xm0 .and. xi < xm1 .and. yi >= ym0 .and. yi < ym1) then + intersects = .true. + return + end if end if ! Check if line intersects right surface -- calculate the intersection point ! (y,z) - yi = y0 + (xm1 - x0) * (y1 - y0) / (x1 - x0) - zi = z0 + (xm1 - x0) * (z1 - z0) / (x1 - x0) - if (yi >= ym0 .and. yi < ym1 .and. zi >= zm0 .and. zi < zm1) then - intersects = .true. - return + if ( (x0 < xm1 .and. x1 > xm1) .or. (x0 > xm1 .and. x1 < xm1) ) then + yi = y0 + (xm1 - x0) * (y1 - y0) / (x1 - x0) + zi = z0 + (xm1 - x0) * (z1 - z0) / (x1 - x0) + if (yi >= ym0 .and. yi < ym1 .and. zi >= zm0 .and. zi < zm1) then + intersects = .true. + return + end if end if ! Check if line intersects front surface -- calculate the intersection point ! (x,z) - xi = x0 + (ym1 - y0) * (x1 - x0) / (y1 - y0) - zi = z0 + (ym1 - y0) * (z1 - z0) / (y1 - y0) - if (xi >= xm0 .and. xi < xm1 .and. zi >= zm0 .and. zi < zm1) then - intersects = .true. - return + if ( (y0 < ym1 .and. y1 > ym1) .or. (y0 > ym1 .and. y1 < ym1) ) then + xi = x0 + (ym1 - y0) * (x1 - x0) / (y1 - y0) + zi = z0 + (ym1 - y0) * (z1 - z0) / (y1 - y0) + if (xi >= xm0 .and. xi < xm1 .and. zi >= zm0 .and. zi < zm1) then + intersects = .true. + return + end if end if ! Check if line intersects top surface -- calculate the intersection point ! (x,y) - xi = x0 + (zm1 - z0) * (x1 - x0) / (z1 - z0) - yi = y0 + (zm1 - z0) * (y1 - y0) / (z1 - z0) - if (xi >= xm0 .and. xi < xm1 .and. yi >= ym0 .and. yi < ym1) then - intersects = .true. - return + if ( (z0 < zm1 .and. z1 > zm1) .or. (z0 > zm1 .and. z1 < zm1) ) then + xi = x0 + (zm1 - z0) * (x1 - x0) / (z1 - z0) + yi = y0 + (zm1 - z0) * (y1 - y0) / (z1 - z0) + if (xi >= xm0 .and. xi < xm1 .and. yi >= ym0 .and. yi < ym1) then + intersects = .true. + return + end if end if end function mesh_intersects_3d diff --git a/src/tally.F90 b/src/tally.F90 index 3544ed5c5..7bc45f1fc 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -1349,11 +1349,12 @@ contains integer :: i integer :: i_tally + integer :: i_filt integer :: k ! loop index for nuclide bins ! position during the loop integer :: filter_index ! single index for single bin integer :: i_nuclide ! index in nuclides array - logical :: found_bin ! scoring bin found? + real(8) :: filter_weight type(TallyObject), pointer :: t ! A loop over all tallies is necessary because we need to simultaneously @@ -1364,63 +1365,101 @@ contains i_tally = active_analog_tallies % get_item(i) t => tallies(i_tally) - ! ======================================================================= - ! DETERMINE SCORING BIN COMBINATION + ! Find the first bin in each filter. There may be more than one matching + ! bin per filter, but we'll deal with those later. + do i_filt = 1, t % n_filters + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + NO_BIN_FOUND, matching_bins(i_filt), filter_weights(i_filt)) + ! If there are no valid bins for this filter, then there is nothing to + ! score and we can move on to the next tally. + if (matching_bins(i_filt) == NO_BIN_FOUND) cycle TALLY_LOOP + end do - call get_scoring_bins(p, i_tally, found_bin) - if (.not. found_bin) cycle + ! ======================================================================== + ! Loop until we've covered all valid bins on each of the filters. - ! ======================================================================= - ! CALCULATE RESULTS AND ACCUMULATE TALLY + FILTER_LOOP: do - ! If we have made it here, we have a scoring combination of bins for this - ! tally -- now we need to determine where in the results array we should - ! be accumulating the tally values + ! Determine scoring index and weight for this filter combination + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_weight = product(filter_weights(:t % n_filters)) - ! Determine scoring index for this filter combination - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + ! ====================================================================== + ! Nuclide logic - ! Check for nuclide bins - k = 0 - NUCLIDE_LOOP: do while (k < t % n_nuclide_bins) + ! Check for nuclide bins + k = 0 + NUCLIDE_LOOP: do while (k < t % n_nuclide_bins) - ! Increment the index in the list of nuclide bins - k = k + 1 + ! Increment the index in the list of nuclide bins + k = k + 1 + + if (t % all_nuclides) then + ! In the case that the user has requested to tally all nuclides, we + ! can take advantage of the fact that we know exactly how nuclide + ! bins correspond to nuclide indices. + if (k == 1) then + ! If we just entered, set the nuclide bin index to the index in + ! the nuclides array since this will match the index in the + ! nuclide bin array. + k = p % event_nuclide + elseif (k == p % event_nuclide + 1) then + ! After we've tallied the individual nuclide bin, we also need + ! to contribute to the total material bin which is the last bin + k = n_nuclides_total + 1 + else + ! After we've tallied in both the individual nuclide bin and the + ! total material bin, we're done + exit + end if - if (t % all_nuclides) then - ! In the case that the user has requested to tally all nuclides, we - ! can take advantage of the fact that we know exactly how nuclide - ! bins correspond to nuclide indices. - if (k == 1) then - ! If we just entered, set the nuclide bin index to the index in - ! the nuclides array since this will match the index in the - ! nuclide bin array. - k = p % event_nuclide - elseif (k == p % event_nuclide + 1) then - ! After we've tallied the individual nuclide bin, we also need - ! to contribute to the total material bin which is the last bin - k = n_nuclides_total + 1 else - ! After we've tallied in both the individual nuclide bin and the - ! total material bin, we're done - exit + ! If the user has explicitly specified nuclides (or specified + ! none), we need to search through the nuclide bin list one by + ! one. First we need to get the value of the nuclide bin + i_nuclide = t % nuclide_bins(k) + + ! Now compare the value against that of the colliding nuclide. + if (i_nuclide /= p % event_nuclide .and. i_nuclide /= -1) cycle end if - else - ! If the user has explicitly specified nuclides (or specified - ! none), we need to search through the nuclide bin list one by - ! one. First we need to get the value of the nuclide bin - i_nuclide = t % nuclide_bins(k) + ! Determine score for each bin + call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & + i_nuclide, ZERO, ZERO) - ! Now compare the value against that of the colliding nuclide. - if (i_nuclide /= p % event_nuclide .and. i_nuclide /= -1) cycle - end if + end do NUCLIDE_LOOP - ! Determine score for each bin - call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & - i_nuclide, ZERO, ZERO) + ! ====================================================================== + ! Filter logic - end do NUCLIDE_LOOP + ! If there are no filters, then we are done. + if (t % n_filters == 0) exit FILTER_LOOP + + ! Increment the filter bins, starting with the last filter. If we get a + ! NO_BIN_FOUND for the last filter, it means we finished all valid bins + ! for that filter, but next-to-last filter might have more than one + ! valid bin so we need to increment that one as well, and so on. + do i_filt = t % n_filters, 1, -1 + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + matching_bins(i_filt), matching_bins(i_filt), & + filter_weights(i_filt)) + if (matching_bins(i_filt) /= NO_BIN_FOUND) exit + end do + + ! If we got all NO_BIN_FOUNDs, then we have finished all valid bins for + ! each of the filters. Exit the loop. + if (all(matching_bins(:t % n_filters) == NO_BIN_FOUND)) exit FILTER_LOOP + + ! Reset all the filters with NO_BIN_FOUND. This will set them back to + ! their first valid bin. + do i_filt = 1, t % n_filters + if (matching_bins(i_filt) == NO_BIN_FOUND) then + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + matching_bins(i_filt), matching_bins(i_filt), & + filter_weights(i_filt)) + end if + end do + end do FILTER_LOOP ! If the user has specified that we can assume all tallies are spatially ! separate, this implies that once a tally has been scored to, we needn't @@ -1442,14 +1481,15 @@ contains integer :: i, m integer :: i_tally + integer :: i_filt integer :: k ! loop index for nuclide bins ! position during the loop integer :: filter_index ! single index for single bin integer :: i_nuclide ! index in nuclides array - logical :: found_bin ! scoring bin found? + real(8) :: filter_weight + real(8) :: atom_density type(TallyObject), pointer :: t type(Material), pointer :: mat - real(8) :: atom_density ! A loop over all tallies is necessary because we need to simultaneously ! determine different filter bins for the same tally in order to score to it @@ -1463,44 +1503,82 @@ contains ! nuclides are in the material mat => materials(p % material) - ! ======================================================================= - ! DETERMINE SCORING BIN COMBINATION + ! Find the first bin in each filter. There may be more than one matching + ! bin per filter, but we'll deal with those later. + do i_filt = 1, t % n_filters + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + NO_BIN_FOUND, matching_bins(i_filt), filter_weights(i_filt)) + ! If there are no valid bins for this filter, then there is nothing to + ! score and we can move on to the next tally. + if (matching_bins(i_filt) == NO_BIN_FOUND) cycle TALLY_LOOP + end do - call get_scoring_bins(p, i_tally, found_bin) - if (.not. found_bin) cycle + ! ======================================================================== + ! Loop until we've covered all valid bins on each of the filters. - ! ======================================================================= - ! CALCULATE RESULTS AND ACCUMULATE TALLY + FILTER_LOOP: do - ! If we have made it here, we have a scoring combination of bins for this - ! tally -- now we need to determine where in the results array we should - ! be accumulating the tally values + ! Determine scoring index and weight for this filter combination + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_weight = product(filter_weights(:t % n_filters)) - ! Determine scoring index for this filter combination - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + ! ====================================================================== + ! Nuclide logic - ! Check for nuclide bins - k = 0 - NUCLIDE_LOOP: do while (k < t % n_nuclide_bins) + ! Check for nuclide bins + k = 0 + NUCLIDE_LOOP: do while (k < t % n_nuclide_bins) - ! Increment the index in the list of nuclide bins - k = k + 1 + ! Increment the index in the list of nuclide bins + k = k + 1 - i_nuclide = t % nuclide_bins(k) + i_nuclide = t % nuclide_bins(k) - ! Check to see if this nuclide was in the material of our collision. - do m = 1, mat % n_nuclides - if (mat % nuclide(m) == i_nuclide) then - atom_density = mat % atom_density(m) - exit - end if + ! Check to see if this nuclide was in the material of our collision. + do m = 1, mat % n_nuclides + if (mat % nuclide(m) == i_nuclide) then + atom_density = mat % atom_density(m) + exit + end if + end do + + ! Determine score for each bin + call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & + i_nuclide, atom_density, ZERO) + + end do NUCLIDE_LOOP + + ! ====================================================================== + ! Filter logic + + ! If there are no filters, then we are done. + if (t % n_filters == 0) exit FILTER_LOOP + + ! Increment the filter bins, starting with the last filter. If we get a + ! NO_BIN_FOUND for the last filter, it means we finished all valid bins + ! for that filter, but next-to-last filter might have more than one + ! valid bin so we need to increment that one as well, and so on. + do i_filt = t % n_filters, 1, -1 + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + matching_bins(i_filt), matching_bins(i_filt), & + filter_weights(i_filt)) + if (matching_bins(i_filt) /= NO_BIN_FOUND) exit end do - ! Determine score for each bin - call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & - i_nuclide, atom_density, ZERO) + ! If we got all NO_BIN_FOUNDs, then we have finished all valid bins for + ! each of the filters. Exit the loop. + if (all(matching_bins(:t % n_filters) == NO_BIN_FOUND)) exit FILTER_LOOP - end do NUCLIDE_LOOP + ! Reset all the filters with NO_BIN_FOUND. This will set them back to + ! their first valid bin. + do i_filt = 1, t % n_filters + if (matching_bins(i_filt) == NO_BIN_FOUND) then + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + matching_bins(i_filt), matching_bins(i_filt), & + filter_weights(i_filt)) + end if + end do + end do FILTER_LOOP ! If the user has specified that we can assume all tallies are spatially ! separate, this implies that once a tally has been scored to, we needn't @@ -1813,13 +1891,14 @@ contains integer :: i integer :: i_tally + integer :: i_filt integer :: j ! loop index for scoring bins integer :: k ! loop index for nuclide bins integer :: filter_index ! single index for single bin integer :: i_nuclide ! index in nuclides array (from bins) real(8) :: flux ! tracklength estimate of flux real(8) :: atom_density ! atom density of single nuclide in atom/b-cm - logical :: found_bin ! scoring bin found? + real(8) :: filter_weight type(TallyObject), pointer :: t type(Material), pointer :: mat @@ -1834,70 +1913,101 @@ contains i_tally = active_tracklength_tallies % get_item(i) t => tallies(i_tally) - ! Check if this tally has a mesh filter -- if so, we treat it separately - ! since multiple bins can be scored to with a single track + ! Find the first bin in each filter. There may be more than one matching + ! bin per filter, but we'll deal with those later. + do i_filt = 1, t % n_filters + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + NO_BIN_FOUND, matching_bins(i_filt), filter_weights(i_filt)) + ! If there are no valid bins for this filter, then there is nothing to + ! score and we can move on to the next tally. + if (matching_bins(i_filt) == NO_BIN_FOUND) cycle TALLY_LOOP + end do - if (t % find_filter(FILTER_MESH) > 0) then - call score_tl_on_mesh(p, i_tally, distance) - cycle - end if + ! ======================================================================== + ! Loop until we've covered all valid bins on each of the filters. - ! ======================================================================= - ! DETERMINE SCORING BIN COMBINATION + FILTER_LOOP: do - call get_scoring_bins(p, i_tally, found_bin) - if (.not. found_bin) cycle + ! Determine scoring index and weight for this filter combination + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_weight = product(filter_weights(:t % n_filters)) - ! ======================================================================= - ! CALCULATE RESULTS AND ACCUMULATE TALLY + ! ====================================================================== + ! Nuclide logic - ! If we have made it here, we have a scoring combination of bins for this - ! tally -- now we need to determine where in the results array we should - ! be accumulating the tally values - - ! Determine scoring index for this filter combination - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - - if (t % all_nuclides) then - if (p % material /= MATERIAL_VOID) then - call score_all_nuclides(p, i_tally, flux, filter_index) - end if - else - - NUCLIDE_BIN_LOOP: do k = 1, t % n_nuclide_bins - ! Get index of nuclide in nuclides array - i_nuclide = t % nuclide_bins(k) - - if (i_nuclide > 0) then - if (p % material /= MATERIAL_VOID) then - ! Get pointer to current material - mat => materials(p % material) - - ! Determine if nuclide is actually in material - NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides - ! If index of nuclide matches the j-th nuclide listed in the - ! material, break out of the loop - if (i_nuclide == mat % nuclide(j)) exit - - ! If we've reached the last nuclide in the material, it means - ! the specified nuclide to be tallied is not in this material - if (j == mat % n_nuclides) then - cycle NUCLIDE_BIN_LOOP - end if - end do NUCLIDE_MAT_LOOP - - atom_density = mat % atom_density(j) - else - atom_density = ZERO - end if + if (t % all_nuclides) then + if (p % material /= MATERIAL_VOID) then + call score_all_nuclides(p, i_tally, flux, filter_index) end if + else - ! Determine score for each bin - call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & - i_nuclide, atom_density, flux) + NUCLIDE_BIN_LOOP: do k = 1, t % n_nuclide_bins + ! Get index of nuclide in nuclides array + i_nuclide = t % nuclide_bins(k) - end do NUCLIDE_BIN_LOOP - end if + if (i_nuclide > 0) then + if (p % material /= MATERIAL_VOID) then + ! Get pointer to current material + mat => materials(p % material) + + ! Determine if nuclide is actually in material + NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides + ! If index of nuclide matches the j-th nuclide listed in the + ! material, break out of the loop + if (i_nuclide == mat % nuclide(j)) exit + + ! If we've reached the last nuclide in the material, it means + ! the specified nuclide to be tallied is not in this material + if (j == mat % n_nuclides) then + cycle NUCLIDE_BIN_LOOP + end if + end do NUCLIDE_MAT_LOOP + + atom_density = mat % atom_density(j) + else + atom_density = ZERO + end if + end if + + ! Determine score for each bin + call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & + i_nuclide, atom_density, flux * filter_weight) + + end do NUCLIDE_BIN_LOOP + + end if + + ! ====================================================================== + ! Filter logic + + ! If there are no filters, then we are done. + if (t % n_filters == 0) exit FILTER_LOOP + + ! Increment the filter bins, starting with the last filter. If we get a + ! NO_BIN_FOUND for the last filter, it means we finished all valid bins + ! for that filter, but next-to-last filter might have more than one + ! valid bin so we need to increment that one as well, and so on. + do i_filt = t % n_filters, 1, -1 + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + matching_bins(i_filt), matching_bins(i_filt), & + filter_weights(i_filt)) + if (matching_bins(i_filt) /= NO_BIN_FOUND) exit + end do + + ! If we got all NO_BIN_FOUNDs, then we have finished all valid bins for + ! each of the filters. Exit the loop. + if (all(matching_bins(:t % n_filters) == NO_BIN_FOUND)) exit FILTER_LOOP + + ! Reset all the filters with NO_BIN_FOUND. This will set them back to + ! their first valid bin. + do i_filt = 1, t % n_filters + if (matching_bins(i_filt) == NO_BIN_FOUND) then + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + matching_bins(i_filt), matching_bins(i_filt), & + filter_weights(i_filt)) + end if + end do + end do FILTER_LOOP ! If the user has specified that we can assume all tallies are spatially ! separate, this implies that once a tally has been scored to, we needn't @@ -1913,219 +2023,6 @@ contains end subroutine score_tracklength_tally -!=============================================================================== -! SCORE_TL_ON_MESH calculate fluxes and reaction rates based on the track-length -! estimate of the flux specifically for tallies that have mesh filters. For -! these tallies, it is possible to score to multiple mesh cells for each track. -!=============================================================================== - - subroutine score_tl_on_mesh(p, i_tally, d_track) - - type(Particle), intent(in) :: p - integer, intent(in) :: i_tally - real(8), intent(in) :: d_track - - integer :: i ! loop index for filter/score bins - integer :: j ! loop index for direction - integer :: k ! loop index for mesh cell crossings - integer :: b ! loop index for nuclide bins - integer :: ijk0(3) ! indices of starting coordinates - integer :: ijk1(3) ! indices of ending coordinates - integer :: ijk_cross(3) ! indices of mesh cell crossed - integer :: n_cross ! number of surface crossings - integer :: filter_index ! single index for single bin - integer :: i_nuclide ! index in nuclides array - integer :: i_filter_mesh ! index of mesh filter in filters array - real(8) :: atom_density ! density of individual nuclide in atom/b-cm - real(8) :: flux ! tracklength estimate of flux - real(8) :: uvw(3) ! cosine of angle of particle - real(8) :: xyz0(3) ! starting/intermediate coordinates - real(8) :: xyz1(3) ! ending coordinates of particle - real(8) :: xyz_cross(3) ! coordinates of next boundary - real(8) :: d(3) ! distance to each bounding surface - real(8) :: distance ! distance traveled in mesh cell - real(8) :: filt_score ! score applied by filters - logical :: found_bin ! was a scoring bin found? - logical :: start_in_mesh ! starting coordinates inside mesh? - logical :: end_in_mesh ! ending coordinates inside mesh? - type(TallyObject), pointer :: t - type(RegularMesh), pointer :: m - type(Material), pointer :: mat - - t => tallies(i_tally) - matching_bins(1:t%n_filters) = 1 - - ! ========================================================================== - ! CHECK IF THIS TRACK INTERSECTS THE MESH - - ! Copy starting and ending location of particle - xyz0 = p % coord(1) % xyz - (d_track - TINY_BIT) * p % coord(1) % uvw - xyz1 = p % coord(1) % xyz - TINY_BIT * p % coord(1) % uvw - - ! Get index for mesh filter - i_filter_mesh = t % find_filter(FILTER_MESH) - - ! Get pointer to mesh - select type(filt => t % filters(i_filter_mesh) % obj) - type is (MeshFilter) - m => meshes(filt % mesh) - end select - - ! Determine indices for starting and ending location - call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) - call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) - - ! Check if start or end is in mesh -- if not, check if track still - ! intersects with mesh - if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then - if (m % n_dimension == 2) then - if (.not. mesh_intersects_2d(m, xyz0, xyz1)) return - else - if (.not. mesh_intersects_3d(m, xyz0, xyz1)) return - end if - end if - - ! Reset starting and ending location - xyz0 = p % coord(1) % xyz - d_track * p % coord(1) % uvw - xyz1 = p % coord(1) % xyz - - ! ========================================================================= - ! CHECK FOR SCORING COMBINATION FOR FILTERS OTHER THAN MESH - - FILTER_LOOP: do i = 1, t % n_filters - - ! Ignore this filter if it's the mesh filter - if (i == i_filter_mesh) cycle - - call t % filters(i) % obj % get_next_bin(p, t % estimator, NO_BIN_FOUND, & - matching_bins(i), filt_score) - - ! Check if no matching bin was found - if (matching_bins(i) == NO_BIN_FOUND) return - - end do FILTER_LOOP - - ! ========================================================================== - ! DETERMINE WHICH MESH CELLS TO SCORE TO - - ! Calculate number of surface crossings - n_cross = sum(abs(ijk1(:m % n_dimension) - ijk0(:m % n_dimension))) + 1 - - ! Copy particle's direction - uvw = p % coord(1) % uvw - - ! Bounding coordinates - do j = 1, m % n_dimension - if (uvw(j) > 0) then - xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) - else - xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) - end if - end do - - MESH_LOOP: do k = 1, n_cross - found_bin = .false. - - ! Calculate distance to each bounding surface. We need to treat special - ! case where the cosine of the angle is zero since this would result in a - ! divide-by-zero. - - if (k == n_cross) xyz_cross = xyz1 - - do j = 1, m % n_dimension - if (uvw(j) == 0) then - d(j) = INFINITY - else - d(j) = (xyz_cross(j) - xyz0(j))/uvw(j) - end if - end do - - ! Determine the closest bounding surface of the mesh cell by calculating - ! the minimum distance - - j = minloc(d(:m % n_dimension), 1) - distance = d(j) - - ! Now use the minimum distance and diretion of the particle to determine - ! which surface was crossed - - if (all(ijk0(:m % n_dimension) >= 1) .and. all(ijk0(:m % n_dimension) <= m % dimension)) then - ijk_cross = ijk0 - found_bin = .true. - end if - - ! Increment indices and determine new crossing point - if (uvw(j) > 0) then - ijk0(j) = ijk0(j) + 1 - xyz_cross(j) = xyz_cross(j) + m % width(j) - else - ijk0(j) = ijk0(j) - 1 - xyz_cross(j) = xyz_cross(j) - m % width(j) - end if - - ! ======================================================================= - ! SCORE TO THIS MESH CELL - - if (found_bin) then - ! Calculate track-length estimate of flux - flux = p % wgt * distance - - ! Determine mesh bin - matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, ijk_cross) - - ! Determining scoring index - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - - if (t % all_nuclides) then - if (p % material /= MATERIAL_VOID) then - ! Score reaction rates for each nuclide in material - call score_all_nuclides(p, i_tally, flux, filter_index) - end if - else - NUCLIDE_BIN_LOOP: do b = 1, t % n_nuclide_bins - ! Get index of nuclide in nuclides array - i_nuclide = t % nuclide_bins(b) - - if (i_nuclide > 0) then - if (p % material /= MATERIAL_VOID) then - ! Get pointer to current material - mat => materials(p % material) - - ! Determine if nuclide is actually in material - NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides - ! If index of nuclide matches the j-th nuclide listed in - ! the material, break out of the loop - if (i_nuclide == mat % nuclide(j)) exit - - ! If we've reached the last nuclide in the material, it - ! means the specified nuclide to be tallied is not in this - ! material - if (j == mat % n_nuclides) then - cycle NUCLIDE_BIN_LOOP - end if - end do NUCLIDE_MAT_LOOP - - atom_density = mat % atom_density(j) - else - atom_density = ZERO - end if - end if - - ! Determine score for each bin - call score_general(p, t, (b-1)*t % n_score_bins, filter_index, & - i_nuclide, atom_density, flux) - - end do NUCLIDE_BIN_LOOP - end if - end if - - ! Calculate new coordinates - xyz0 = xyz0 + distance * uvw - - end do MESH_LOOP - - end subroutine score_tl_on_mesh - !=============================================================================== ! SCORE_COLLISION_TALLY calculates fluxes and reaction rates based on the ! 1/Sigma_t estimate of the flux. This is triggered after every collision. It @@ -2140,6 +2037,7 @@ contains integer :: i integer :: i_tally + integer :: i_filt integer :: j ! loop index for scoring bins integer :: k ! loop index for nuclide bins integer :: filter_index ! single index for single bin @@ -2147,7 +2045,7 @@ contains real(8) :: flux ! collision estimate of flux real(8) :: atom_density ! atom density of single nuclide ! in atom/b-cm - logical :: found_bin ! scoring bin found? + real(8) :: filter_weight type(TallyObject), pointer :: t type(Material), pointer :: mat @@ -2167,62 +2065,101 @@ contains i_tally = active_collision_tallies % get_item(i) t => tallies(i_tally) - ! ======================================================================= - ! DETERMINE SCORING BIN COMBINATION + ! Find the first bin in each filter. There may be more than one matching + ! bin per filter, but we'll deal with those later. + do i_filt = 1, t % n_filters + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + NO_BIN_FOUND, matching_bins(i_filt), filter_weights(i_filt)) + ! If there are no valid bins for this filter, then there is nothing to + ! score and we can move on to the next tally. + if (matching_bins(i_filt) == NO_BIN_FOUND) cycle TALLY_LOOP + end do - call get_scoring_bins(p, i_tally, found_bin) - if (.not. found_bin) cycle + ! ======================================================================== + ! Loop until we've covered all valid bins on each of the filters. - ! ======================================================================= - ! CALCULATE RESULTS AND ACCUMULATE TALLY + FILTER_LOOP: do - ! If we have made it here, we have a scoring combination of bins for this - ! tally -- now we need to determine where in the results array we should - ! be accumulating the tally values + ! Determine scoring index and weight for this filter combination + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_weight = product(filter_weights(:t % n_filters)) - ! Determine scoring index for this filter combination - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + ! ====================================================================== + ! Nuclide logic - if (t % all_nuclides) then - if (p % material /= MATERIAL_VOID) then - call score_all_nuclides(p, i_tally, flux, filter_index) - end if - else - - NUCLIDE_BIN_LOOP: do k = 1, t % n_nuclide_bins - ! Get index of nuclide in nuclides array - i_nuclide = t % nuclide_bins(k) - - if (i_nuclide > 0) then - if (p % material /= MATERIAL_VOID) then - ! Get pointer to current material - mat => materials(p % material) - - ! Determine if nuclide is actually in material - NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides - ! If index of nuclide matches the j-th nuclide listed in the - ! material, break out of the loop - if (i_nuclide == mat % nuclide(j)) exit - - ! If we've reached the last nuclide in the material, it means - ! the specified nuclide to be tallied is not in this material - if (j == mat % n_nuclides) then - cycle NUCLIDE_BIN_LOOP - end if - end do NUCLIDE_MAT_LOOP - - atom_density = mat % atom_density(j) - else - atom_density = ZERO - end if + if (t % all_nuclides) then + if (p % material /= MATERIAL_VOID) then + call score_all_nuclides(p, i_tally, flux, filter_index) end if + else - ! Determine score for each bin - call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & - i_nuclide, atom_density, flux) + NUCLIDE_BIN_LOOP: do k = 1, t % n_nuclide_bins + ! Get index of nuclide in nuclides array + i_nuclide = t % nuclide_bins(k) - end do NUCLIDE_BIN_LOOP - end if + if (i_nuclide > 0) then + if (p % material /= MATERIAL_VOID) then + ! Get pointer to current material + mat => materials(p % material) + + ! Determine if nuclide is actually in material + NUCLIDE_MAT_LOOP: do j = 1, mat % n_nuclides + ! If index of nuclide matches the j-th nuclide listed in the + ! material, break out of the loop + if (i_nuclide == mat % nuclide(j)) exit + + ! If we've reached the last nuclide in the material, it means + ! the specified nuclide to be tallied is not in this material + if (j == mat % n_nuclides) then + cycle NUCLIDE_BIN_LOOP + end if + end do NUCLIDE_MAT_LOOP + + atom_density = mat % atom_density(j) + else + atom_density = ZERO + end if + end if + + ! Determine score for each bin + call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & + i_nuclide, atom_density, flux * filter_weight) + + end do NUCLIDE_BIN_LOOP + + end if + + ! ====================================================================== + ! Filter logic + + ! If there are no filters, then we are done. + if (t % n_filters == 0) exit FILTER_LOOP + + ! Increment the filter bins, starting with the last filter. If we get a + ! NO_BIN_FOUND for the last filter, it means we finished all valid bins + ! for that filter, but next-to-last filter might have more than one + ! valid bin so we need to increment that one as well, and so on. + do i_filt = t % n_filters, 1, -1 + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + matching_bins(i_filt), matching_bins(i_filt), & + filter_weights(i_filt)) + if (matching_bins(i_filt) /= NO_BIN_FOUND) exit + end do + + ! If we got all NO_BIN_FOUNDs, then we have finished all valid bins for + ! each of the filters. Exit the loop. + if (all(matching_bins(:t % n_filters) == NO_BIN_FOUND)) exit FILTER_LOOP + + ! Reset all the filters with NO_BIN_FOUND. This will set them back to + ! their first valid bin. + do i_filt = 1, t % n_filters + if (matching_bins(i_filt) == NO_BIN_FOUND) then + call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & + matching_bins(i_filt), matching_bins(i_filt), & + filter_weights(i_filt)) + end if + end do + end do FILTER_LOOP ! If the user has specified that we can assume all tallies are spatially ! separate, this implies that once a tally has been scored to, we needn't @@ -2584,61 +2521,6 @@ contains end subroutine score_surface_current -!=============================================================================== -! GET_NEXT_BIN determines the next scoring bin for a particular filter variable -!=============================================================================== - - function get_next_bin(filter_type, filter_value, i_tally) result(bin) - - integer, intent(in) :: filter_type ! e.g. FILTER_MATERIAL - integer, intent(in) :: filter_value ! value of filter, e.g. material 3 - integer, intent(in) :: i_tally ! index of tally - integer :: bin ! index of filter - - integer :: i_tally_check - integer :: n - - ! If there are no scoring bins for this item, then return immediately - if (.not. allocated(tally_maps(filter_type) % items(filter_value) % elements)) then - bin = NO_BIN_FOUND - return - end if - - ! Check how many elements there are for this item - n = size(tally_maps(filter_type) % items(filter_value) % elements) - - do - ! Increment position in elements - position(filter_type) = position(filter_type) + 1 - - ! If we've reached the end of the array, there is no more bin to score to - if (position(filter_type) > n) then - position(filter_type) = 0 - bin = NO_BIN_FOUND - return - end if - - i_tally_check = tally_maps(filter_type) % items(filter_value) % & - elements(position(filter_type)) % index_tally - - if (i_tally_check > i_tally) then - ! Since the index being checked against is greater than the index we - ! need (and the tally indices were added to elements sequentially), we - ! know that no more bins will be scoring bins for this tally - position(filter_type) = 0 - bin = NO_BIN_FOUND - return - elseif (i_tally_check == i_tally) then - ! Found a match - bin = tally_maps(filter_type) % items(filter_value) % & - elements(position(filter_type)) % index_bin - return - end if - - end do - - end function get_next_bin - !=============================================================================== ! SYNCHRONIZE_TALLIES accumulates the sum of the contributions from each history ! within the batch to a new random variable diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index c0b7dc5c5..8bf66ab1b 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -1,6 +1,6 @@ module tally_filter - use constants, only: ONE, NO_BIN_FOUND + use constants, only: ONE, NO_BIN_FOUND, FP_PRECISION use geometry_header, only: BASE_UNIVERSE, RectLattice, HexLattice use global use hdf5_interface @@ -194,12 +194,171 @@ contains integer, intent(out) :: next_bin real(8), intent(out) :: score - type(RegularMesh), pointer :: m + integer :: j ! loop index for direction + integer :: ijk0(3) ! indices of starting coordinates + integer :: ijk1(3) ! indices of ending coordinates + real(8) :: uvw(3) ! cosine of angle of particle + real(8) :: xyz0(3) ! starting/intermediate coordinates + real(8) :: xyz1(3) ! ending coordinates of particle + real(8) :: xyz_cross(3) ! coordinates of next boundary + real(8) :: d(3) ! distance to each bounding surface + real(8) :: total_distance ! distance of entire particle track + real(8) :: distance ! distance traveled in mesh cell + logical :: start_in_mesh ! starting coordinates inside mesh? + logical :: end_in_mesh ! ending coordinates inside mesh? + type(RegularMesh), pointer :: m + ! Get a pointer to the mesh. m => meshes(this % mesh) - call get_mesh_bin(m, p % coord(1) % xyz, next_bin) - score = ONE + if (estimator /= ESTIMATOR_TRACKLENGTH) then + if (current_bin == NO_BIN_FOUND) then + call get_mesh_bin(m, p % coord(1) % xyz, next_bin) + else + next_bin = NO_BIN_FOUND + end if + score = ONE + + else + ! Copy starting and ending location of particle. + xyz0 = p % last_xyz + TINY_BIT * p % coord(1) % uvw + xyz1 = p % coord(1) % xyz - TINY_BIT * p % coord(1) % uvw + + ! Determine indices for starting and ending location. + call get_mesh_indices(m, xyz0, ijk0(:m % n_dimension), start_in_mesh) + call get_mesh_indices(m, xyz1, ijk1(:m % n_dimension), end_in_mesh) + + ! If this is the first iteration of the filter loop, check if the track + ! intersects any part of the mesh. + if (current_bin == NO_BIN_FOUND) then + if ((.not. start_in_mesh) .and. (.not. end_in_mesh)) then + if (m % n_dimension == 2) then + if (.not. mesh_intersects_2d(m, xyz0, xyz1)) then + next_bin = NO_BIN_FOUND + return + end if + else + if (.not. mesh_intersects_3d(m, xyz0, xyz1)) then + next_bin = NO_BIN_FOUND + return + end if + end if + end if + end if + + ! Reset starting, ending locations and particle direction. + xyz0 = p % last_xyz + xyz1 = p % coord(1) % xyz + uvw = p % coord(1) % uvw + + ! Compute the length of the entire track. + total_distance = sqrt(sum((xyz1 - xyz0)**2)) + + if (current_bin == NO_BIN_FOUND) then + if (any(ijk0(:m % n_dimension) < 1) & + .or. any(ijk0(:m % n_dimension) > m % dimension)) then + do while (any(ijk0(:m % n_dimension) < 1) & + .or. any(ijk0(:m % n_dimension) > m % dimension)) + do j = 1, m % n_dimension + if (abs(uvw(j)) < FP_PRECISION) then + d(j) = INFINITY + else if (uvw(j) > 0) then + xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) + d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + else + xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + end if + end do + j = minloc(d(:m % n_dimension), 1) + if (uvw(j) > ZERO) then + ijk0(j) = ijk0(j) + 1 + else + ijk0(j) = ijk0(j) - 1 + end if + end do + distance = d(j) + xyz0 = xyz0 + distance * uvw + end if + end if + + + ! ======================================================================== + ! If we've already scored some mesh bins, figure out which mesh cell is + ! next and where the particle enters that cell. + + if (current_bin /= NO_BIN_FOUND) then + ! Get the indices to the last bin. + call bin_to_mesh_indices(m, current_bin, ijk0(:m % n_dimension)) + + ! If the particle track ends in that bin, then we are done. + if (all(ijk0(:m % n_dimension) == ijk1(:m % n_dimension))) then + next_bin = NO_BIN_FOUND + return + end if + + ! Figure out which face of the previous mesh cell our track exits, i.e. + ! the closest surface of that cell for which + ! dot(p % uvw, face_normal) > 0. + do j = 1, m % n_dimension + if (abs(uvw(j)) < FP_PRECISION) then + d(j) = INFINITY + else if (uvw(j) > 0) then + xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) + d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + else + xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + end if + end do + j = minloc(d(:m % n_dimension), 1) + + ! Translate the starting coordintes by the distance to that face. This + ! should be the xyz that we computed the distance to in the last + ! iteration of the filter loop. + distance = d(j) + xyz0 = xyz0 + distance * uvw + + ! Increment the indices into the next mesh cell. + if (uvw(j) > ZERO) then + ijk0(j) = ijk0(j) + 1 + xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) + else + ijk0(j) = ijk0(j) - 1 + xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + end if + + ! If the next indices are invalid, then the track has left the mesh and + ! we are done. + if (any(ijk0(:m % n_dimension) < 1) & + .or. any(ijk0(:m % n_dimension) > m % dimension)) then + next_bin = NO_BIN_FOUND + return + end if + end if + + ! Compute the length of the track segment in this mesh cell. + if (all(ijk0(:m % n_dimension) == ijk1(:m % n_dimension))) then + distance = sqrt(sum((xyz1 - xyz0)**2)) + else + do j = 1, m % n_dimension + if (abs(uvw(j)) < FP_PRECISION) then + d(j) = INFINITY + else if (uvw(j) > 0) then + xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) + d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + else + xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + end if + end do + distance = minval(d(:m % n_dimension)) + end if + + ! Assign the next tally bin and the score + next_bin = mesh_indices_to_bin(m, ijk0(:m % n_dimension)) + score = distance / total_distance + endif end subroutine get_next_bin_mesh subroutine to_statepoint_mesh(this, filter_group) diff --git a/src/tally_initialize.F90 b/src/tally_initialize.F90 index d8f7176a6..86e4520a5 100644 --- a/src/tally_initialize.F90 +++ b/src/tally_initialize.F90 @@ -70,6 +70,7 @@ contains ! Allocate array for matching filter bins !$omp parallel allocate(matching_bins(max_n_filters)) + allocate(filter_weights(max_n_filters)) !$omp end parallel end subroutine setup_tally_arrays From a8686acbe5ba48128d248d69cb772b8109dfc25c Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Thu, 30 Jun 2016 12:27:42 -0500 Subject: [PATCH 12/23] Fix tracklength mesh tallies Unfortunately this required a bit of a hack. Since the filters do not know the length of the tack, they need to get the old coordinates from p % last_xyz. But p % last_xyz isn't updated at every event. Changing the tracking so p % last_xyz is updated at every event results in CMFD SIGFPEs, so we need to keep the old p % last_xyz as p % last_xyz_current --- src/geometry.F90 | 4 +-- src/particle_header.F90 | 34 +++++++++++++---------- src/particle_restart.F90 | 11 ++++---- src/tally.F90 | 6 +++- src/tally_filter.F90 | 13 ++++++--- src/tracking.F90 | 5 +++- tests/test_score_current/results_true.dat | 2 +- 7 files changed, 46 insertions(+), 29 deletions(-) diff --git a/src/geometry.F90 b/src/geometry.F90 index 767e2db10..6d4ca7767 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -499,7 +499,7 @@ contains end if ! Set previous coordinate going slightly past surface crossing - p % last_xyz = p % coord(1) % xyz + TINY_BIT * p % coord(1) % uvw + p % last_xyz_current = p % coord(1) % xyz + TINY_BIT * p % coord(1) % uvw ! Diagnostic message if (verbosity >= 10 .or. trace) then @@ -563,7 +563,7 @@ contains end if ! Set previous coordinate going slightly past surface crossing - p % last_xyz = p % coord(1) % xyz + TINY_BIT * p % coord(1) % uvw + p % last_xyz_current = p % coord(1) % xyz + TINY_BIT * p % coord(1) % uvw ! Diagnostic message if (verbosity >= 10 .or. trace) then diff --git a/src/particle_header.F90 b/src/particle_header.F90 index a313c6ed5..ee854aea3 100644 --- a/src/particle_header.F90 +++ b/src/particle_header.F90 @@ -59,10 +59,13 @@ module particle_header logical :: alive ! is particle alive? ! Pre-collision physical data - real(8) :: last_xyz(3) ! previous coordinates - real(8) :: last_uvw(3) ! previous direction coordinates - real(8) :: last_wgt ! pre-collision particle weight - real(8) :: absorb_wgt ! weight absorbed for survival biasing + real(8) :: last_xyz_current(3) ! coordinates of the last collision or + ! reflective/periodic surface crossing + ! for current tallies + real(8) :: last_xyz(3) ! previous coordinates + real(8) :: last_uvw(3) ! previous direction coordinates + real(8) :: last_wgt ! pre-collision particle weight + real(8) :: absorb_wgt ! weight absorbed for survival biasing ! What event last took place logical :: fission ! did the particle cause implicit fission @@ -193,20 +196,21 @@ contains call this % initialize() ! copy attributes from source bank site - this % wgt = src % wgt - this % last_wgt = src % wgt - this % coord(1) % xyz = src % xyz - this % coord(1) % uvw = src % uvw - this % last_xyz = src % xyz - this % last_uvw = src % uvw + this % wgt = src % wgt + this % last_wgt = src % wgt + this % coord(1) % xyz = src % xyz + this % coord(1) % uvw = src % uvw + this % last_xyz_current = src % xyz + this % last_xyz = src % xyz + this % last_uvw = src % uvw if (run_CE) then - this % E = src % E + this % E = src % E else - this % g = int(src % E) - this % last_g = int(src % E) - this % E = energy_bin_avg(this % g) + this % g = int(src % E) + this % last_g = int(src % E) + this % E = energy_bin_avg(this % g) end if - this % last_E = this % E + this % last_E = this % E end subroutine initialize_from_source diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index e5cca17bf..b780c1c32 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -102,11 +102,12 @@ contains call read_dataset(p % coord(1) % uvw, file_id, 'uvw') ! Set particle last attributes - p % last_wgt = p % wgt - p % last_xyz = p % coord(1)%xyz - p % last_uvw = p % coord(1)%uvw - p % last_E = p % E - p % last_g = p % g + p % last_wgt = p % wgt + p % last_xyz_current = p % coord(1)%xyz + p % last_xyz = p % coord(1)%xyz + p % last_uvw = p % coord(1)%uvw + p % last_E = p % E + p % last_g = p % g ! Close hdf5 file call file_close(file_id) diff --git a/src/tally.F90 b/src/tally.F90 index 7bc45f1fc..5bff92c99 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -1378,6 +1378,7 @@ contains ! ======================================================================== ! Loop until we've covered all valid bins on each of the filters. + filter_weight = ONE FILTER_LOOP: do ! Determine scoring index and weight for this filter combination @@ -1516,6 +1517,7 @@ contains ! ======================================================================== ! Loop until we've covered all valid bins on each of the filters. + filter_weight = ONE FILTER_LOOP: do ! Determine scoring index and weight for this filter combination @@ -1926,6 +1928,7 @@ contains ! ======================================================================== ! Loop until we've covered all valid bins on each of the filters. + filter_weight = ONE FILTER_LOOP: do ! Determine scoring index and weight for this filter combination @@ -2078,6 +2081,7 @@ contains ! ======================================================================== ! Loop until we've covered all valid bins on each of the filters. + filter_weight = ONE FILTER_LOOP: do ! Determine scoring index and weight for this filter combination @@ -2245,7 +2249,7 @@ contains TALLY_LOOP: do i = 1, active_current_tallies % size() ! Copy starting and ending location of particle - xyz0 = p % last_xyz + xyz0 = p % last_xyz_current xyz1 = p % coord(1) % xyz ! Get pointer to tally diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index 8bf66ab1b..6629e588a 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -607,11 +607,8 @@ contains integer :: distribcell_index, offset, i - next_bin = NO_BIN_FOUND - - distribcell_index = cells(this % cell) % distribcell_index - if (current_bin == NO_BIN_FOUND) then + distribcell_index = cells(this % cell) % distribcell_index offset = 0 do i = 1, p % n_coord if (cells(p % coord(i) % cell) % type == CELL_FILL) then @@ -635,6 +632,8 @@ contains exit end if end do + else + next_bin = NO_BIN_FOUND end if score = ONE end subroutine get_next_bin_distribcell @@ -984,6 +983,12 @@ contains integer, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: score + + if (current_bin == NO_BIN_FOUND) then + next_bin = 1 + else + next_bin = NO_BIN_FOUND + end if score = ONE end subroutine get_next_bin_dg diff --git a/src/tracking.F90 b/src/tracking.F90 index d52b09a75..69fb78c35 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -191,7 +191,7 @@ contains p % fission = .false. ! Save coordinates for tallying purposes - p % last_xyz = p % coord(1) % xyz + p % last_xyz_current = p % coord(1) % xyz ! Set last material to none since cross sections will need to be ! re-evaluated @@ -211,6 +211,9 @@ contains end do end if + ! Save coordinates for tallying purposes + p % last_xyz = p % coord(1) % xyz + ! If particle has too many events, display warning and kill it n_event = n_event + 1 if (n_event == MAX_EVENTS) then diff --git a/tests/test_score_current/results_true.dat b/tests/test_score_current/results_true.dat index d3ac03a70..5d26226ae 100644 --- a/tests/test_score_current/results_true.dat +++ b/tests/test_score_current/results_true.dat @@ -1 +1 @@ -a9310752363eb059ff40f16ac9716b41ccab6ec6607d29f498069318745e485d18d784264304cc2586865bd58cef7587203cc22a1d485c58ddd63c14c0defdb9 \ No newline at end of file +bafab1921a12146abb2bb29603b52b9cc28a5a950a7a6bb1e3f012c05891c310fad643760d4f148b04d0fef3d1f3e141d146e3a278d81cc6fc8187c37717c5e7 \ No newline at end of file From 13f5a32d7ac129965709e99397ea37b41e6361ac Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Thu, 30 Jun 2016 14:30:03 -0500 Subject: [PATCH 13/23] Fix distribcell --- src/tally_filter.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index 6629e588a..0c2e13f9b 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -605,8 +605,10 @@ contains integer, intent(out) :: next_bin real(8), intent(out) :: score + logical :: cell_found integer :: distribcell_index, offset, i + cell_found = .false. if (current_bin == NO_BIN_FOUND) then distribcell_index = cells(this % cell) % distribcell_index offset = 0 @@ -629,12 +631,14 @@ contains end if if (this % cell == p % coord(i) % cell) then next_bin = offset + 1 + cell_found = .true. exit end if end do else next_bin = NO_BIN_FOUND end if + if (.not. cell_found) next_bin = NO_BIN_FOUND score = ONE end subroutine get_next_bin_distribcell From 32e89bb03dd6d320b7e0b096ccb6ffce665a96b1 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 1 Jul 2016 00:18:26 -0500 Subject: [PATCH 14/23] Cleanup object-oriented filters --- src/global.F90 | 6 +- src/input_xml.F90 | 2 - src/tally.F90 | 4 +- src/tally_filter.F90 | 287 ++++++++++++++++++++---------------- src/tally_filter_header.F90 | 83 ++++++++--- src/tally_header.F90 | 50 +------ src/tally_initialize.F90 | 94 +----------- 7 files changed, 223 insertions(+), 303 deletions(-) diff --git a/src/global.F90 b/src/global.F90 index 24a672637..2211f338d 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -14,7 +14,7 @@ module global use set_header, only: SetInt use surface_header, only: SurfaceContainer use source_header, only: SourceDistribution - use tally_header, only: TallyObject, TallyMap, TallyResult + use tally_header, only: TallyObject, TallyResult use trigger_header, only: KTrigger use timer_header, only: Timer @@ -181,9 +181,6 @@ module global !$omp threadprivate(global_tally_collision, global_tally_absorption, & !$omp& global_tally_tracklength, global_tally_leakage) - ! Tally map structure - type(TallyMap), allocatable :: tally_maps(:) - integer :: n_meshes = 0 ! # of structured meshes integer :: n_user_meshes = 0 ! # of structured user meshes integer :: n_tallies = 0 ! # of tallies @@ -517,7 +514,6 @@ contains if (allocated(tallies)) deallocate(tallies) if (allocated(matching_bins)) deallocate(matching_bins) if (allocated(filter_weights)) deallocate(filter_weights) - if (allocated(tally_maps)) deallocate(tally_maps) ! Deallocate fission and source bank and entropy !$omp parallel diff --git a/src/input_xml.F90 b/src/input_xml.F90 index e1cb94e25..28accf9df 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -3038,7 +3038,6 @@ contains if (n_words == energy_groups + 1) then if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & then - t % energy_matches_groups = .true. filt % matches_transport_groups = .true. end if end if @@ -3064,7 +3063,6 @@ contains if (n_words == energy_groups + 1) then if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & then - t % energyout_matches_groups = .true. filt % matches_transport_groups = .true. end if end if diff --git a/src/tally.F90 b/src/tally.F90 index 5bff92c99..dcf1215eb 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -14,7 +14,7 @@ module tally use particle_header, only: LocalCoord, Particle use search, only: binary_search use string, only: to_str - use tally_header, only: TallyResult, TallyMapItem, TallyMapElement + use tally_header, only: TallyResult use tally_filter #ifdef MPI @@ -1711,7 +1711,7 @@ contains UVW=p % last_uvw) end if - if (t % energyout_matches_groups) then + if (filt % matches_transport_groups) then ! determine outgoing energy from fission bank gout = int(fission_bank(n_bank - p % n_bank + k) % E) diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index 0c2e13f9b..097c11e3b 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -1,16 +1,16 @@ module tally_filter - use constants, only: ONE, NO_BIN_FOUND, FP_PRECISION - use geometry_header, only: BASE_UNIVERSE, RectLattice, HexLattice + use constants, only: ONE, NO_BIN_FOUND, FP_PRECISION + use geometry_header, only: BASE_UNIVERSE, RectLattice, HexLattice use global use hdf5_interface - use mesh_header, only: RegularMesh - use mesh, only: get_mesh_bin, bin_to_mesh_indices, & - get_mesh_indices, mesh_indices_to_bin, & - mesh_intersects_2d, mesh_intersects_3d - use particle_header, only: Particle - use search, only: binary_search - use string, only: to_str + use mesh_header, only: RegularMesh + use mesh, only: get_mesh_bin, bin_to_mesh_indices, & + get_mesh_indices, mesh_indices_to_bin, & + mesh_intersects_2d, mesh_intersects_3d + use particle_header, only: Particle + use search, only: binary_search + use string, only: to_str use tally_filter_header, only: TallyFilter, TallyFilterContainer use hdf5, only: HID_T @@ -18,54 +18,57 @@ module tally_filter implicit none !=============================================================================== +! MESHFILTER indexes the location of particle events to a regular mesh. For +! tracklength tallies, it will produce multiple valid bins and the bin weight +! will correspond to the fraction of the track length that lies in that bin. !=============================================================================== type, extends(TallyFilter) :: MeshFilter integer :: mesh contains procedure :: get_next_bin => get_next_bin_mesh procedure :: to_statepoint => to_statepoint_mesh - procedure :: to_summary => to_statepoint_mesh - procedure :: initialize => initialize_mesh procedure :: text_label => text_label_mesh end type MeshFilter !=============================================================================== +! UNIVERSEFILTER specifies which geometric universes tally events reside in. !=============================================================================== type, extends(TallyFilter) :: UniverseFilter integer, allocatable :: universes(:) contains procedure :: get_next_bin => get_next_bin_universe procedure :: to_statepoint => to_statepoint_universe - procedure :: to_summary => to_statepoint_universe - procedure :: initialize => initialize_universe procedure :: text_label => text_label_universe + procedure :: initialize => initialize_universe end type UniverseFilter !=============================================================================== +! MATERIAL specifies which material tally events reside in. !=============================================================================== type, extends(TallyFilter) :: MaterialFilter integer, allocatable :: materials(:) contains procedure :: get_next_bin => get_next_bin_material procedure :: to_statepoint => to_statepoint_material - procedure :: to_summary => to_statepoint_material - procedure :: initialize => initialize_material procedure :: text_label => text_label_material + procedure :: initialize => initialize_material end type MaterialFilter !=============================================================================== +! CELLFILTER specifies which geometric cells tally events reside in. !=============================================================================== type, extends(TallyFilter) :: CellFilter integer, allocatable :: cells(:) contains procedure :: get_next_bin => get_next_bin_cell procedure :: to_statepoint => to_statepoint_cell - procedure :: to_summary => to_statepoint_cell - procedure :: initialize => initialize_cell procedure :: text_label => text_label_cell + procedure :: initialize => initialize_cell end type CellFilter !=============================================================================== +! DISTRIBCELLFILTER specifies which distributed geometric cells tally events +! reside in. !=============================================================================== type, extends(TallyFilter) :: DistribcellFilter integer :: cell @@ -73,134 +76,147 @@ module tally_filter procedure :: get_next_bin => get_next_bin_distribcell procedure :: to_statepoint => to_statepoint_distribcell procedure :: to_summary => to_summary_distribcell - procedure :: initialize => initialize_distribcell procedure :: text_label => text_label_distribcell + procedure :: initialize => initialize_distribcell end type DistribcellFilter !=============================================================================== +! CELLBORNFILTER specifies which cell the particle was born in. !=============================================================================== type, extends(TallyFilter) :: CellbornFilter integer, allocatable :: cells(:) contains procedure :: get_next_bin => get_next_bin_cellborn procedure :: to_statepoint => to_statepoint_cellborn - procedure :: to_summary => to_statepoint_cellborn - procedure :: initialize => initialize_cellborn procedure :: text_label => text_label_cellborn + procedure :: initialize => initialize_cellborn end type CellbornFilter !=============================================================================== +! SURFACEFILTER is currently not implemented for usual geometric surfaces, but +! it is used as a placeholder for mesh surfaces used in current tallies. !=============================================================================== type, extends(TallyFilter) :: SurfaceFilter integer, allocatable :: surfaces(:) contains procedure :: get_next_bin => get_next_bin_surface procedure :: to_statepoint => to_statepoint_surface - procedure :: to_summary => to_statepoint_surface - procedure :: initialize => initialize_surface procedure :: text_label => text_label_surface + procedure :: initialize => initialize_surface end type SurfaceFilter !=============================================================================== +! ENERGYFILTER bins the incident neutron energy. !=============================================================================== type, extends(TallyFilter) :: EnergyFilter real(8), allocatable :: bins(:) + + ! True if transport group number can be used directly to get bin number logical :: matches_transport_groups = .false. + contains procedure :: get_next_bin => get_next_bin_energy procedure :: to_statepoint => to_statepoint_energy - procedure :: to_summary => to_statepoint_energy - procedure :: initialize => initialize_energy procedure :: text_label => text_label_energy end type EnergyFilter !=============================================================================== +! ENERGYOUTFILTER bins the outgoing neutron energy. Only scattering events use +! the get_next_bin functionality. Nu-fission tallies manually iterate over the +! filter bins. !=============================================================================== type, extends(TallyFilter) :: EnergyoutFilter real(8), allocatable :: bins(:) + + ! True if transport group number can be used directly to get bin number logical :: matches_transport_groups = .false. + contains procedure :: get_next_bin => get_next_bin_energyout procedure :: to_statepoint => to_statepoint_energyout - procedure :: to_summary => to_statepoint_energyout - procedure :: initialize => initialize_energyout procedure :: text_label => text_label_energyout end type EnergyoutFilter !=============================================================================== +! DELAYEDGROUPFILTER bins outgoing fission neutrons in their delayed groups. +! The get_next_bin functionality is not actually used. The bins are manually +! iterated over in the scoring subroutines. !=============================================================================== type, extends(TallyFilter) :: DelayedGroupFilter integer, allocatable :: groups(:) contains procedure :: get_next_bin => get_next_bin_dg procedure :: to_statepoint => to_statepoint_dg - procedure :: to_summary => to_statepoint_dg - procedure :: initialize => initialize_dg procedure :: text_label => text_label_dg end type DelayedGroupFilter !=============================================================================== +! MUFILTER bins the incoming-outgoing direction cosine. This is only used for +! scatter reactions. !=============================================================================== type, extends(TallyFilter) :: MuFilter real(8), allocatable :: bins(:) contains procedure :: get_next_bin => get_next_bin_mu procedure :: to_statepoint => to_statepoint_mu - procedure :: to_summary => to_statepoint_mu - procedure :: initialize => initialize_mu procedure :: text_label => text_label_mu end type MuFilter !=============================================================================== +! POLARFILTER bins the incident neutron polar angle (relative to the global +! z-axis). !=============================================================================== type, extends(TallyFilter) :: PolarFilter real(8), allocatable :: bins(:) contains procedure :: get_next_bin => get_next_bin_polar procedure :: to_statepoint => to_statepoint_polar - procedure :: to_summary => to_statepoint_polar - procedure :: initialize => initialize_polar procedure :: text_label => text_label_polar end type PolarFilter !=============================================================================== +! AZIMUTHALFILTER bins the incident neutron azimuthal angle (relative to the +! global xy-plane). !=============================================================================== type, extends(TallyFilter) :: AzimuthalFilter real(8), allocatable :: bins(:) contains procedure :: get_next_bin => get_next_bin_azimuthal procedure :: to_statepoint => to_statepoint_azimuthal - procedure :: to_summary => to_statepoint_azimuthal - procedure :: initialize => initialize_azimuthal procedure :: text_label => text_label_azimuthal end type AzimuthalFilter contains - - - - - - +!=============================================================================== +! METHODS: for a description of these methods, see their counterparts bound to +! the abstract TallyFilter class. +!=============================================================================== !=============================================================================== +! MeshFilter methods !=============================================================================== - subroutine get_next_bin_mesh(this, p, estimator, current_bin, next_bin, score) + subroutine get_next_bin_mesh(this, p, estimator, current_bin, next_bin, & + weight) class(MeshFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight + + integer, parameter :: MAX_SEARCH_ITER = 100 ! Maximum number of times we can + ! can loop while trying to find + ! the first intersection. integer :: j ! loop index for direction integer :: ijk0(3) ! indices of starting coordinates integer :: ijk1(3) ! indices of ending coordinates + integer :: search_iter ! loop count for intersection search real(8) :: uvw(3) ! cosine of angle of particle real(8) :: xyz0(3) ! starting/intermediate coordinates real(8) :: xyz1(3) ! ending coordinates of particle - real(8) :: xyz_cross(3) ! coordinates of next boundary + real(8) :: xyz_cross ! coordinates of next boundary real(8) :: d(3) ! distance to each bounding surface real(8) :: total_distance ! distance of entire particle track real(8) :: distance ! distance traveled in mesh cell @@ -212,15 +228,23 @@ contains m => meshes(this % mesh) if (estimator /= ESTIMATOR_TRACKLENGTH) then + ! If this is an analog or collision tally, then there can only be one + ! valid mesh bin. if (current_bin == NO_BIN_FOUND) then call get_mesh_bin(m, p % coord(1) % xyz, next_bin) else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE else - ! Copy starting and ending location of particle. + ! A track can span multiple mesh bins so we need to handle a lot of + ! intersection logic for tracklength tallies. + + ! Copy the starting and ending coordinates of the particle. Offset these + ! just a bit for the purposes of determining if there was an intersection + ! in case the mesh surfaces coincide with lattice/geometric surfaces which + ! might produce finite-precision errors. xyz0 = p % last_xyz + TINY_BIT * p % coord(1) % uvw xyz1 = p % coord(1) % xyz - TINY_BIT * p % coord(1) % uvw @@ -246,7 +270,7 @@ contains end if end if - ! Reset starting, ending locations and particle direction. + ! Copy the un-modified coordinates the particle direction. xyz0 = p % last_xyz xyz1 = p % coord(1) % xyz uvw = p % coord(1) % uvw @@ -254,20 +278,30 @@ contains ! Compute the length of the entire track. total_distance = sqrt(sum((xyz1 - xyz0)**2)) + ! If we're looking for the first valid bin, check to see if the particle + ! starts inside the mesh. if (current_bin == NO_BIN_FOUND) then if (any(ijk0(:m % n_dimension) < 1) & .or. any(ijk0(:m % n_dimension) > m % dimension)) then + + ! The particle does not start in the mesh so keep iterating the ijk0 + ! indices to cross the nearest mesh surface until we've found a valid + ! bin. MAX_SEARCH_ITER prevents an infinite loop. + search_iter = 0 do while (any(ijk0(:m % n_dimension) < 1) & .or. any(ijk0(:m % n_dimension) > m % dimension)) + if (search_iter == MAX_SEARCH_ITER) call fatal_error("Failed to & + &find a mesh intersection on a tally mesh filter.") + do j = 1, m % n_dimension if (abs(uvw(j)) < FP_PRECISION) then d(j) = INFINITY else if (uvw(j) > 0) then - xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) - d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + xyz_cross = m % lower_left(j) + ijk0(j) * m % width(j) + d(j) = (xyz_cross - xyz0(j)) / uvw(j) else - xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) - d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + xyz_cross = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + d(j) = (xyz_cross - xyz0(j)) / uvw(j) end if end do j = minloc(d(:m % n_dimension), 1) @@ -279,10 +313,10 @@ contains end do distance = d(j) xyz0 = xyz0 + distance * uvw + end if end if - ! ======================================================================== ! If we've already scored some mesh bins, figure out which mesh cell is ! next and where the particle enters that cell. @@ -304,11 +338,11 @@ contains if (abs(uvw(j)) < FP_PRECISION) then d(j) = INFINITY else if (uvw(j) > 0) then - xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) - d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + xyz_cross = m % lower_left(j) + ijk0(j) * m % width(j) + d(j) = (xyz_cross - xyz0(j)) / uvw(j) else - xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) - d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + xyz_cross = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + d(j) = (xyz_cross - xyz0(j)) / uvw(j) end if end do j = minloc(d(:m % n_dimension), 1) @@ -322,10 +356,8 @@ contains ! Increment the indices into the next mesh cell. if (uvw(j) > ZERO) then ijk0(j) = ijk0(j) + 1 - xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) else ijk0(j) = ijk0(j) - 1 - xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) end if ! If the next indices are invalid, then the track has left the mesh and @@ -339,17 +371,20 @@ contains ! Compute the length of the track segment in this mesh cell. if (all(ijk0(:m % n_dimension) == ijk1(:m % n_dimension))) then + ! The track ends in this cell. Use the particle end location rather + ! than the mesh surface. distance = sqrt(sum((xyz1 - xyz0)**2)) else + ! The track exits this cell. Use the distance to the mesh surface. do j = 1, m % n_dimension if (abs(uvw(j)) < FP_PRECISION) then d(j) = INFINITY else if (uvw(j) > 0) then - xyz_cross(j) = m % lower_left(j) + ijk0(j) * m % width(j) - d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + xyz_cross = m % lower_left(j) + ijk0(j) * m % width(j) + d(j) = (xyz_cross - xyz0(j)) / uvw(j) else - xyz_cross(j) = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) - d(j) = (xyz_cross(j) - xyz0(j)) / uvw(j) + xyz_cross = m % lower_left(j) + (ijk0(j) - 1) * m % width(j) + d(j) = (xyz_cross - xyz0(j)) / uvw(j) end if end do distance = minval(d(:m % n_dimension)) @@ -357,7 +392,7 @@ contains ! Assign the next tally bin and the score next_bin = mesh_indices_to_bin(m, ijk0(:m % n_dimension)) - score = distance / total_distance + weight = distance / total_distance endif end subroutine get_next_bin_mesh @@ -370,10 +405,6 @@ contains call write_dataset(filter_group, "bins", this % mesh ) end subroutine to_statepoint_mesh - subroutine initialize_mesh(this) - class(MeshFilter), intent(inout) :: this - end subroutine initialize_mesh - function text_label_mesh(this, bin) result(label) class(MeshFilter), intent(in) :: this integer, intent(in) :: bin @@ -395,15 +426,16 @@ contains end function text_label_mesh !=============================================================================== +! UniverseFilter methods !=============================================================================== subroutine get_next_bin_universe(this, p, estimator, current_bin, next_bin, & - score) + weight) class(UniverseFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: i, j, start logical :: bin_found @@ -427,7 +459,7 @@ contains end do if (.not. bin_found) next_bin = NO_BIN_FOUND - score = ONE + weight = ONE end subroutine get_next_bin_universe subroutine to_statepoint_universe(this, filter_group) @@ -444,6 +476,7 @@ contains integer :: i, id + ! Convert ids to indices. do i = 1, this % n_bins id = this % universes(i) if (universe_dict % has_key(id)) then @@ -464,15 +497,16 @@ contains end function text_label_universe !=============================================================================== +! MaterialFilter methods !=============================================================================== subroutine get_next_bin_material(this, p, estimator, current_bin, next_bin, & - score) + weight) class(MaterialFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: i logical :: bin_found @@ -490,7 +524,7 @@ contains else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_material subroutine to_statepoint_material(this, filter_group) @@ -507,6 +541,7 @@ contains integer :: i, id + ! Convert ids to indices. do i = 1, this % n_bins id = this % materials(i) if (material_dict % has_key(id)) then @@ -527,14 +562,16 @@ contains end function text_label_material !=============================================================================== +! CellFilter methods !=============================================================================== - subroutine get_next_bin_cell(this, p, estimator, current_bin, next_bin, score) + subroutine get_next_bin_cell(this, p, estimator, current_bin, next_bin, & + weight) class(CellFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: i, j, start logical :: bin_found @@ -558,7 +595,7 @@ contains end do if (.not. bin_found) next_bin = NO_BIN_FOUND - score = ONE + weight = ONE end subroutine get_next_bin_cell subroutine to_statepoint_cell(this, filter_group) @@ -575,6 +612,7 @@ contains integer :: i, id + ! Convert ids to indices. do i = 1, this % n_bins id = this % cells(i) if (cell_dict % has_key(id)) then @@ -595,15 +633,16 @@ contains end function text_label_cell !=============================================================================== +! DistribcellFilter methods !=============================================================================== subroutine get_next_bin_distribcell(this, p, estimator, current_bin, & - next_bin, score) + next_bin, weight) class(DistribcellFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight logical :: cell_found integer :: distribcell_index, offset, i @@ -639,7 +678,7 @@ contains next_bin = NO_BIN_FOUND end if if (.not. cell_found) next_bin = NO_BIN_FOUND - score = ONE + weight = ONE end subroutine get_next_bin_distribcell subroutine to_statepoint_distribcell(this, filter_group) @@ -684,8 +723,9 @@ contains subroutine initialize_distribcell(this) class(DistribcellFilter), intent(inout) :: this - integer :: i, id + integer :: id + ! Convert id to index. id = this % cell if (cell_dict % has_key(id)) then this % cell = cell_dict % get_key(id) @@ -711,15 +751,16 @@ contains end function text_label_distribcell !=============================================================================== +! CellbornFilter methods !=============================================================================== subroutine get_next_bin_cellborn(this, p, estimator, current_bin, next_bin, & - score) + weight) class(CellbornFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: i logical :: bin_found @@ -737,7 +778,7 @@ contains else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_cellborn subroutine to_statepoint_cellborn(this, filter_group) @@ -754,6 +795,7 @@ contains integer :: i, id + ! Convert ids to indices. do i = 1, this % n_bins id = this % cells(i) if (cell_dict % has_key(id)) then @@ -774,15 +816,16 @@ contains end function text_label_cellborn !=============================================================================== +! SurfaceFilter methods !=============================================================================== subroutine get_next_bin_surface(this, p, estimator, current_bin, next_bin, & - score) + weight) class(SurfaceFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: i logical :: bin_found @@ -800,7 +843,7 @@ contains else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_surface subroutine to_statepoint_surface(this, filter_group) @@ -817,6 +860,7 @@ contains integer :: i, id + ! Convert ids to indices. do i = 1, this % n_bins id = this % surfaces(i) if (surface_dict % has_key(id)) then @@ -837,15 +881,16 @@ contains end function text_label_surface !=============================================================================== +! EnergyFilter methods !=============================================================================== subroutine get_next_bin_energy(this, p, estimator, current_bin, next_bin, & - score) + weight) class(EnergyFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: n real(8) :: E @@ -884,7 +929,7 @@ contains else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_energy subroutine to_statepoint_energy(this, filter_group) @@ -896,10 +941,6 @@ contains call write_dataset(filter_group, "bins", this % bins ) end subroutine to_statepoint_energy - subroutine initialize_energy(this) - class(EnergyFilter), intent(inout) :: this - end subroutine initialize_energy - function text_label_energy(this, bin) result(label) class(EnergyFilter), intent(in) :: this integer, intent(in) :: bin @@ -914,15 +955,16 @@ contains end function text_label_energy !=============================================================================== +! EnergyoutFilter methods !=============================================================================== subroutine get_next_bin_energyout(this, p, estimator, current_bin, next_bin, & - score) + weight) class(EnergyoutFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: n @@ -949,7 +991,7 @@ contains else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_energyout subroutine to_statepoint_energyout(this, filter_group) @@ -961,10 +1003,6 @@ contains call write_dataset(filter_group, "bins", this % bins ) end subroutine to_statepoint_energyout - subroutine initialize_energyout(this) - class(EnergyoutFilter), intent(inout) :: this - end subroutine initialize_energyout - function text_label_energyout(this, bin) result(label) class(EnergyoutFilter), intent(in) :: this integer, intent(in) :: bin @@ -979,21 +1017,22 @@ contains end function text_label_energyout !=============================================================================== +! DelayedGroupFilter methods !=============================================================================== - subroutine get_next_bin_dg(this, p, estimator, current_bin, next_bin, score) + subroutine get_next_bin_dg(this, p, estimator, current_bin, next_bin, weight) class(DelayedGroupFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight if (current_bin == NO_BIN_FOUND) then next_bin = 1 else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_dg subroutine to_statepoint_dg(this, filter_group) @@ -1005,10 +1044,6 @@ contains call write_dataset(filter_group, "bins", this % groups ) end subroutine to_statepoint_dg - subroutine initialize_dg(this) - class(DelayedGroupFilter), intent(inout) :: this - end subroutine initialize_dg - function text_label_dg(this, bin) result(label) class(DelayedGroupFilter), intent(in) :: this integer, intent(in) :: bin @@ -1018,14 +1053,15 @@ contains end function text_label_dg !=============================================================================== +! MuFilter methods !=============================================================================== - subroutine get_next_bin_mu(this, p, estimator, current_bin, next_bin, score) + subroutine get_next_bin_mu(this, p, estimator, current_bin, next_bin, weight) class(MuFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: n @@ -1043,7 +1079,7 @@ contains else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_mu subroutine to_statepoint_mu(this, filter_group) @@ -1055,10 +1091,6 @@ contains call write_dataset(filter_group, "bins", this % bins ) end subroutine to_statepoint_mu - subroutine initialize_mu(this) - class(MuFilter), intent(inout) :: this - end subroutine initialize_mu - function text_label_mu(this, bin) result(label) class(MuFilter), intent(in) :: this integer, intent(in) :: bin @@ -1073,14 +1105,16 @@ contains end function text_label_mu !=============================================================================== +! PolarFilter methods !=============================================================================== - subroutine get_next_bin_polar(this, p, estimator, current_bin, next_bin, score) + subroutine get_next_bin_polar(this, p, estimator, current_bin, next_bin, & + weight) class(PolarFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: n real(8) :: theta @@ -1106,7 +1140,7 @@ contains else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_polar subroutine to_statepoint_polar(this, filter_group) @@ -1118,10 +1152,6 @@ contains call write_dataset(filter_group, "bins", this % bins ) end subroutine to_statepoint_polar - subroutine initialize_polar(this) - class(PolarFilter), intent(inout) :: this - end subroutine initialize_polar - function text_label_polar(this, bin) result(label) class(PolarFilter), intent(in) :: this integer, intent(in) :: bin @@ -1136,15 +1166,16 @@ contains end function text_label_polar !=============================================================================== +! AzimuthalFilter methods !=============================================================================== subroutine get_next_bin_azimuthal(this, p, estimator, current_bin, next_bin, & - score) + weight) class(AzimuthalFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight integer :: n real(8) :: phi @@ -1170,7 +1201,7 @@ contains else next_bin = NO_BIN_FOUND end if - score = ONE + weight = ONE end subroutine get_next_bin_azimuthal subroutine to_statepoint_azimuthal(this, filter_group) @@ -1182,10 +1213,6 @@ contains call write_dataset(filter_group, "bins", this % bins ) end subroutine to_statepoint_azimuthal - subroutine initialize_azimuthal(this) - class(AzimuthalFilter), intent(inout) :: this - end subroutine initialize_azimuthal - function text_label_azimuthal(this, bin) result(label) class(AzimuthalFilter), intent(in) :: this integer, intent(in) :: bin @@ -1200,9 +1227,9 @@ contains end function text_label_azimuthal !=============================================================================== -! FIND_OFFSET uses a given map number, a target cell ID, and a target offset -! to build a string which is the path from the base universe to the target cell -! with the given offset +! FIND_OFFSET (for distribcell) uses a given map number, a target cell ID, and +! a target offset to build a string which is the path from the base universe to +! the target cell with the given offset !=============================================================================== recursive subroutine find_offset(goal, univ, final, offset, path) diff --git a/src/tally_filter_header.F90 b/src/tally_filter_header.F90 index 7da8eea06..505579b75 100644 --- a/src/tally_filter_header.F90 +++ b/src/tally_filter_header.F90 @@ -1,30 +1,41 @@ module tally_filter_header - use constants, only: MAX_LINE_LEN + use constants, only: MAX_LINE_LEN use particle_header, only: Particle use hdf5 implicit none +!=============================================================================== +! TALLYFILTER describes a filter that limits what events score to a tally. For +! example, a cell filter indicates that only particles in a specified cell +! should score to the tally. +!=============================================================================== + type, abstract :: TallyFilter integer :: n_bins = 0 integer :: type contains - procedure(get_next_bin_), deferred :: get_next_bin + procedure(get_next_bin_), deferred :: get_next_bin procedure(to_statepoint_), deferred :: to_statepoint - procedure(to_summary_), deferred :: to_summary - procedure(initialize_), deferred :: initialize - procedure(text_label_), deferred :: text_label + procedure :: to_summary => to_summary_ + procedure(text_label_), deferred :: text_label + procedure :: initialize => initialize_ end type TallyFilter - type TallyFilterContainer - class(TallyFilter), allocatable :: obj - end type TallyFilterContainer - abstract interface - subroutine get_next_bin_(this, p, estimator, current_bin, next_bin, score) +!=============================================================================== +! GET_NEXT_BIN gives the index for the next valid filter bin and a weight that +! will be applied to the flux. +! +! In principle, a filter can have multiple valid bins. If current_bin = +! NO_BIN_FOUND, then this method should give the first valid bin. Providing the +! first valid bin should then give the second valid bin, and so on. When there +! are no valid bins left, the next_bin should be NO_VALID_BIN. + + subroutine get_next_bin_(this, p, estimator, current_bin, next_bin, weight) import TallyFilter import Particle class(TallyFilter), intent(in) :: this @@ -32,9 +43,13 @@ module tally_filter_header integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: score + real(8), intent(out) :: weight end subroutine get_next_bin_ +!=============================================================================== +! TO_STATPEOINT writes all the information needed to reconstruct the filter to +! the given filter_group. + subroutine to_statepoint_(this, filter_group) import TallyFilter import HID_T @@ -42,17 +57,10 @@ module tally_filter_header integer(HID_T), intent(in) :: filter_group end subroutine to_statepoint_ - subroutine to_summary_(this, filter_group) - import TallyFilter - import HID_T - class(TallyFilter), intent(in) :: this - integer(HID_T), intent(in) :: filter_group - end subroutine to_summary_ - - subroutine initialize_(this) - import TallyFilter - class(TallyFilter), intent(inout) :: this - end subroutine initialize_ +!=============================================================================== +! TEXT_LABEL returns a string describing the given filter bin. For example, an +! energy filter might return the string "Incoming Energy [0.625E-6, 20.0)". +! This is used to write the tallies.out file. function text_label_(this, bin) result(label) import TallyFilter @@ -64,4 +72,35 @@ module tally_filter_header end interface +!=============================================================================== +! TALLYFILTERCONTAINER contains an allocatable TallyFilter object for arrays of +! TallyFilters +!=============================================================================== + + type TallyFilterContainer + class(TallyFilter), allocatable :: obj + end type TallyFilterContainer + +contains + +!=============================================================================== +! TO_SUMMARY writes all the information needed to reconstruct the filter to the +! given filter_group. If this procedure is not overridden by the derived class, +! then it will call to_statepoint by default. + + subroutine to_summary_(this, filter_group) + class(TallyFilter), intent(in) :: this + integer(HID_T), intent(in) :: filter_group + + call this % to_statepoint(filter_group) + end subroutine to_summary_ + +!=============================================================================== +! INITIALIZE sets up any internal data, as necessary. If this procedure is not +! overriden by the derived class, then it will do nothing by default. + + subroutine initialize_(this) + class(TallyFilter), intent(inout) :: this + end subroutine initialize_ + end module tally_filter_header diff --git a/src/tally_header.F90 b/src/tally_header.F90 index 46a6e2d9c..b786d9c29 100644 --- a/src/tally_header.F90 +++ b/src/tally_header.F90 @@ -8,36 +8,6 @@ module tally_header implicit none -!=============================================================================== -! TALLYMAPELEMENT gives an index to a tally which is to be scored and the -! corresponding bin for the filter variable -!=============================================================================== - - type TallyMapElement - integer :: index_tally - integer :: index_bin - end type TallyMapElement - -!=============================================================================== -! TALLYMAPITEM contains a list of tally/bin combinations for each mappable -! filter bin specified. -!=============================================================================== - - type TallyMapItem - type(TallyMapElement), allocatable :: elements(:) - end type TallyMapItem - -!=============================================================================== -! TALLYMAP contains a list of pairs of indices to tallies and the corresponding -! bin for a given filter. There is one TallyMap for each mappable filter -! type. The items array is as long as the corresponding array for that filter, -! e.g. for tally_maps(FILTER_CELL), items is n_cells long. -!=============================================================================== - - type TallyMap - type(TallyMapItem), allocatable :: items(:) - end type TallyMap - !=============================================================================== ! TALLYRESULT provides accumulation of results in a particular tally bin !=============================================================================== @@ -48,19 +18,6 @@ module tally_header real(C_DOUBLE) :: sum_sq = 0. end type TallyResult -!=============================================================================== -! TALLYFILTER describes a filter that limits what events score to a tally. For -! example, a cell filter indicates that only particles in a specified cell -! should score to the tally. -!=============================================================================== - -! type TallyFilter -! integer :: type = NONE -! integer :: n_bins = 0 -! integer, allocatable :: int_bins(:) -! real(8), allocatable :: real_bins(:) ! Only used for energy filters -! end type TallyFilter - !=============================================================================== ! TALLYOBJECT describes a user-specified tally. The region of phase space to ! tally in is given by the TallyFilters and the results are stored in a @@ -78,8 +35,7 @@ module tally_header ! Information about what filters should be used - integer :: n_filters ! Number of filters - !type(TallyFilter), allocatable :: filters(:) ! Filter data (type/bins) + integer :: n_filters ! Number of filters type(TallyFilterContainer), allocatable :: filters(:) ! The stride attribute is used for determining the index in the results @@ -127,10 +83,6 @@ module tally_header ! Tally precision triggers integer :: n_triggers = 0 ! # of triggers type(TriggerObject), allocatable :: triggers(:) ! Array of triggers - - ! Multi-Group Specific Information To Enable Rapid Tallying - logical :: energy_matches_groups = .false. - logical :: energyout_matches_groups = .false. end type TallyObject end module tally_header diff --git a/src/tally_initialize.F90 b/src/tally_initialize.F90 index 86e4520a5..a48faeead 100644 --- a/src/tally_initialize.F90 +++ b/src/tally_initialize.F90 @@ -2,7 +2,7 @@ module tally_initialize use constants use global - use tally_header, only: TallyObject, TallyMapElement, TallyMapItem + use tally_header, only: TallyObject implicit none private @@ -23,7 +23,6 @@ contains allocate(global_tallies(N_GLOBAL_TALLIES)) call setup_tally_arrays() - call setup_tally_maps() end subroutine configure_tallies @@ -75,97 +74,6 @@ contains end subroutine setup_tally_arrays -!=============================================================================== -! SETUP_TALLY_MAPS creates a map that allows a quick determination of which -! tallies and bins need to be scored to when a particle makes a collision. This -! subroutine also sets the stride attribute for each tally as well as allocating -! storage for the results array. -!=============================================================================== - - subroutine setup_tally_maps() - -! integer :: i ! loop index for tallies -! integer :: j ! loop index for filters -! integer :: k ! loop index for bins -! integer :: bin ! filter bin entries -! integer :: type ! type of tally filter -! type(TallyObject), pointer :: t -! -! ! allocate tally map array -- note that we don't need a tally map for the -! ! energy_in and energy_out filters -! allocate(tally_maps(N_FILTER_TYPES - 3)) -! -! ! allocate list of items for each different filter type -! allocate(tally_maps(FILTER_UNIVERSE) % items(n_universes)) -! allocate(tally_maps(FILTER_MATERIAL) % items(n_materials)) -! allocate(tally_maps(FILTER_CELL) % items(n_cells)) -! allocate(tally_maps(FILTER_CELLBORN) % items(n_cells)) -! allocate(tally_maps(FILTER_SURFACE) % items(n_surfaces)) -! -! TALLY_LOOP: do i = 1, n_tallies -! ! Get pointer to tally -! t => tallies(i) -! -! ! No need to set up tally maps for surface current tallies -! if (t % type == TALLY_SURFACE_CURRENT) cycle -! -! FILTER_LOOP: do j = 1, t % n_filters -! ! Determine type of filter -! type = t % filters(j) % type -! -! if (type == FILTER_CELL .or. type == FILTER_SURFACE .or. & -! type == FILTER_MATERIAL .or. type == FILTER_UNIVERSE .or. & -! type == FILTER_CELLBORN) then -! -! ! Add map elements -! BIN_LOOP: do k = 1, t % filters(j) % n_bins -! bin = t % filters(j) % int_bins(k) -! call add_map_element(tally_maps(type) % items(bin), i, k) -! end do BIN_LOOP -! end if -! -! end do FILTER_LOOP -! -! end do TALLY_LOOP - - end subroutine setup_tally_maps - -!=============================================================================== -! ADD_MAP_ELEMENT adds a pair of tally and bin indices to the list for a given -! cell/surface/etc. -!=============================================================================== - - subroutine add_map_element(item, index_tally, index_bin) - - type(TallyMapItem), intent(inout) :: item - integer, intent(in) :: index_tally ! index in tallies array - integer, intent(in) :: index_bin ! index in bins array - - integer :: n ! size of elements array - type(TallyMapElement), allocatable :: temp(:) - - if (.not. allocated(item % elements)) then - allocate(item % elements(1)) - item % elements(1) % index_tally = index_tally - item % elements(1) % index_bin = index_bin - else - ! determine size of elements array - n = size(item % elements) - - ! allocate temporary storage and copy elements - allocate(temp(n+1)) - temp(1:n) = item % elements - - ! move allocation back to main array - call move_alloc(FROM=temp, TO=item%elements) - - ! set new element - item % elements(n+1) % index_tally = index_tally - item % elements(n+1) % index_bin = index_bin - end if - - end subroutine add_map_element - !=============================================================================== ! ADD_TALLIES extends the tallies array with a new group of tallies and assigns ! pointers to each group. This is called once for user tallies, once for CMFD From c4e1844c99ef94d7754ff00ce747943ed838bc24 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 1 Jul 2016 00:40:43 -0500 Subject: [PATCH 15/23] Remove type attribute from filters --- src/cmfd_input.F90 | 4 --- src/input_xml.F90 | 55 +++++++++++++++++++++---------------- src/tally.F90 | 34 ----------------------- src/tally_filter.F90 | 2 +- src/tally_filter_header.F90 | 1 - 5 files changed, 33 insertions(+), 63 deletions(-) diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index ec99a1c66..69b9eb6c0 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -415,7 +415,6 @@ contains allocate(MeshFilter::filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (MeshFilter) - filt % type = FILTER_MESH filt % n_bins = product(m % dimension) filt % mesh = n_user_meshes + 1 end select @@ -427,7 +426,6 @@ contains allocate(EnergyFilter::filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (EnergyFilter) - filt % type = FILTER_ENERGYIN ng = get_arraysize_double(node_mesh, "energy") filt % n_bins = ng - 1 allocate(filt % bins(ng)) @@ -494,7 +492,6 @@ contains allocate(EnergyoutFilter::filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (EnergyoutFilter) - filt % type = FILTER_ENERGYOUT ng = get_arraysize_double(node_mesh, "energy") filt % n_bins = ng - 1 allocate(filt % bins(ng)) @@ -536,7 +533,6 @@ contains allocate(SurfaceFilter::filters(n_filters) % obj) select type(filt => filters(n_filters) % obj) type is(SurfaceFilter) - filt % type = FILTER_SURFACE filt % n_bins = 2 * m % n_dimension allocate(filt % surfaces(2 * m % n_dimension)) if (m % n_dimension == 2) then diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 28accf9df..c8e5b28af 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -2921,60 +2921,65 @@ contains allocate(DistribcellFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (DistribcellFilter) - filt % type = FILTER_DISTRIBCELL if (n_words /= 1) call fatal_error("Only one cell can be & &specified per distribcell filter.") ! Store bins call get_node_value(node_filt, "bins", filt % cell) end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_DISTRIBCELL) = j case ('cell') ! Allocate and declare the filter type allocate(CellFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (CellFilter) - filt % type = FILTER_CELL ! Allocate and store bins filt % n_bins = n_words allocate(filt % cells(n_words)) call get_node_array(node_filt, "bins", filt % cells) end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_CELL) = j case ('cellborn') ! Allocate and declare the filter type allocate(CellbornFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (CellbornFilter) - filt % type = FILTER_CELLBORN ! Allocate and store bins filt % n_bins = n_words allocate(filt % cells(n_words)) call get_node_array(node_filt, "bins", filt % cells) end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_CELLBORN) = j case ('material') ! Allocate and declare the filter type allocate(MaterialFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (MaterialFilter) - filt % type = FILTER_MATERIAL ! Allocate and store bins filt % n_bins = n_words allocate(filt % materials(n_words)) call get_node_array(node_filt, "bins", filt % materials) end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_MATERIAL) = j case ('universe') ! Allocate and declare the filter type allocate(UniverseFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (UniverseFilter) - filt % type = FILTER_UNIVERSE ! Allocate and store bins filt % n_bins = n_words allocate(filt % universes(n_words)) call get_node_array(node_filt, "bins", filt % universes) end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_UNIVERSE) = j case ('surface') call fatal_error("Surface filter is not yet supported!") @@ -2982,19 +2987,19 @@ contains allocate(SurfaceFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (SurfaceFilter) - filt % type = FILTER_SURFACE ! Allocate and store bins filt % n_bins = n_words allocate(filt % surfaces(n_words)) call get_node_array(node_filt, "bins", filt % surfaces) end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_SURFACE) = j case ('mesh') ! Allocate and declare the filter type allocate(MeshFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (MeshFilter) - filt % type = FILTER_MESH if (n_words /= 1) call fatal_error("Only one mesh can be & &specified per mesh filter.") @@ -3018,13 +3023,14 @@ contains ! Store the index of the mesh filt % mesh = i_mesh end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_MESH) = j case ('energy') ! Allocate and declare the filter type allocate(EnergyFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (EnergyFilter) - filt % type = FILTER_ENERGYIN ! Allocate and store bins filt % n_bins = n_words - 1 allocate(filt % bins(n_words)) @@ -3043,13 +3049,14 @@ contains end if end if end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_ENERGYIN) = j case ('energyout') ! Allocate and declare the filter type allocate(EnergyoutFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (EnergyoutFilter) - filt % type = FILTER_ENERGYOUT ! Allocate and store bins filt % n_bins = n_words - 1 allocate(filt % bins(n_words)) @@ -3068,6 +3075,8 @@ contains end if end if end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_ENERGYOUT) = j ! Set to analog estimator t % estimator = ESTIMATOR_ANALOG @@ -3086,7 +3095,6 @@ contains allocate(DelayedGroupFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (DelayedGroupFilter) - filt % type = FILTER_DELAYEDGROUP ! Allocate and store bins filt % n_bins = n_words allocate(filt % groups(n_words)) @@ -3103,13 +3111,14 @@ contains end if end do end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_DELAYEDGROUP) = j case ('mu') ! Allocate and declare the filter type allocate(MuFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (MuFilter) - filt % type = FILTER_MU ! Allocate and store bins filt % n_bins = n_words - 1 allocate(filt % bins(n_words)) @@ -3135,6 +3144,8 @@ contains end if end if end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_MU) = j ! Set to analog estimator t % estimator = ESTIMATOR_ANALOG @@ -3144,7 +3155,6 @@ contains allocate(PolarFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (PolarFilter) - filt % type = FILTER_POLAR ! Allocate and store bins filt % n_bins = n_words - 1 allocate(filt % bins(n_words)) @@ -3170,13 +3180,14 @@ contains end if end if end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_POLAR) = j case ('azimuthal') ! Allocate and declare the filter type allocate(AzimuthalFilter::t % filters(j) % obj) select type (filt => t % filters(j) % obj) type is (AzimuthalFilter) - filt % type = FILTER_AZIMUTHAL ! Allocate and store bins filt % n_bins = n_words - 1 allocate(filt % bins(n_words)) @@ -3203,6 +3214,8 @@ contains end if end if end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_AZIMUTHAL) = j case default ! Specified tally filter is invalid, raise error @@ -3212,11 +3225,6 @@ contains end select - ! Set find_filter, e.g. if filter(3) has type FILTER_CELL, then - ! find_filter(FILTER_CELL) would be set to 3. - - t % find_filter(t % filters(j) % obj % type) = j - end do READ_FILTERS ! Check that both cell and surface weren't specified @@ -3265,7 +3273,8 @@ contains ! Check if a delayedgroup filter is present for this tally do l = 1, t % n_filters - if (t % filters(l) % obj % type == FILTER_DELAYEDGROUP) then + select type(filt => t % filters(l) % obj) + type is (DelayedGroupFilter) call warning("A delayedgroup filter was used on a total & &nuclide tally. Cross section libraries are not & &guaranteed to have the same delayed group structure & @@ -3274,7 +3283,7 @@ contains &all isotopes while the JEFF 3.1.1 library has the same & &delayed group structure across all isotopes. Use with & &caution!") - end if + end select end do t % nuclide_bins(j) = -1 @@ -3329,7 +3338,8 @@ contains ! Check if a delayedgroup filter is present for this tally do l = 1, t % n_filters - if (t % filters(l) % obj % type == FILTER_DELAYEDGROUP) then + select type(filt => t % filters(l) % obj) + type is (DelayedGroupFilter) call warning("A delayedgroup filter was used on a total nuclide & &tally. Cross section libraries are not guaranteed to have the& & same delayed group structure across all isotopes. In & @@ -3337,7 +3347,7 @@ contains &group structure across all isotopes while the JEFF 3.1.1 & &library has the same delayed group structure across all & &isotopes. Use with caution!") - end if + end select end do end if @@ -3673,7 +3683,6 @@ contains allocate(SurfaceFilter::t % filters(t % n_filters) % obj) select type (filt => t % filters(t % n_filters) % obj) type is (SurfaceFilter) - filt % type = FILTER_SURFACE filt % n_bins = 2 * m % n_dimension allocate(filt % surfaces(2 * m % n_dimension)) if (m % n_dimension == 2) then diff --git a/src/tally.F90 b/src/tally.F90 index dcf1215eb..fed64324b 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -2179,40 +2179,6 @@ contains end subroutine score_collision_tally -!=============================================================================== -! GET_SCORING_BINS determines a combination of filter bins that should be scored -! for a tally based on the particle's current attributes. -!=============================================================================== - - subroutine get_scoring_bins(p, i_tally, found_bin) - - type(Particle), intent(in) :: p - integer, intent(in) :: i_tally - logical, intent(out) :: found_bin - - integer :: i - real(8) :: filt_score ! score applied by filters - type(TallyObject), pointer :: t - - found_bin = .true. - t => tallies(i_tally) - matching_bins(1:t%n_filters) = 1 - - FILTER_LOOP: do i = 1, t % n_filters - - call t % filters(i) % obj % get_next_bin(p, t % estimator, NO_BIN_FOUND, & - matching_bins(i), filt_score) - - ! If the current filter didn't match, exit this subroutine - if (matching_bins(i) == NO_BIN_FOUND) then - found_bin = .false. - return - end if - - end do FILTER_LOOP - - end subroutine get_scoring_bins - !=============================================================================== ! SCORE_SURFACE_CURRENT tallies surface crossings in a mesh tally by manually ! determining which mesh surfaces were crossed diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index 097c11e3b..eeb720fd2 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -435,7 +435,7 @@ contains integer, intent(in) :: estimator integer, intent(in) :: current_bin integer, intent(out) :: next_bin - real(8), intent(out) :: weight + real(8), intent(out) :: weight integer :: i, j, start logical :: bin_found diff --git a/src/tally_filter_header.F90 b/src/tally_filter_header.F90 index 505579b75..5b5e278e3 100644 --- a/src/tally_filter_header.F90 +++ b/src/tally_filter_header.F90 @@ -15,7 +15,6 @@ module tally_filter_header type, abstract :: TallyFilter integer :: n_bins = 0 - integer :: type contains procedure(get_next_bin_), deferred :: get_next_bin procedure(to_statepoint_), deferred :: to_statepoint From d97c7ea4b354b8e6f30a5540051bad828f2ea482 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 1 Jul 2016 16:32:25 -0500 Subject: [PATCH 16/23] Add overlapping cells and universes to tally test --- tests/test_tallies/inputs_true.dat | 2 +- tests/test_tallies/results_true.dat | 2 +- tests/test_tallies/test_tallies.py | 7 ++++--- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/tests/test_tallies/inputs_true.dat b/tests/test_tallies/inputs_true.dat index e3d37be30..0cc1084bf 100644 --- a/tests/test_tallies/inputs_true.dat +++ b/tests/test_tallies/inputs_true.dat @@ -1 +1 @@ -ea09926d8f5c6c96529bf5529f4deb3be78eda2da80adbbf3440147c337587358c2b1823bc72df9463676135573eb481dcd361b735f18365216645ee81092f1e \ No newline at end of file +51e84302cef4982ccd82a546bc3dea0d33ec1976e0825df69fae04e3c6c28859a6e41f0b0f96ed6a9fec9dd6782c984ffefa493eeb40bb23bcd0bd7376412c46 \ No newline at end of file diff --git a/tests/test_tallies/results_true.dat b/tests/test_tallies/results_true.dat index ff3a82845..96450f3e0 100644 --- a/tests/test_tallies/results_true.dat +++ b/tests/test_tallies/results_true.dat @@ -1 +1 @@ -a0c7d6ca246ecd7dd5fed06373af142390971401c4e97744f29e55810ab9c231c97c4d8947cdf0b3d2df0ae829a9ddf768e5b2d889bbea34f2b6db0e567db884 \ No newline at end of file +d890ab7b790d6672ce94ab4144c5f6b1a7ffae63cfe3bff5cdcf75a1458e3819650b547de9c137a223bc2725c7d7670b06636377f55b69078274a89ebc7c5851 \ No newline at end of file diff --git a/tests/test_tallies/test_tallies.py b/tests/test_tallies/test_tallies.py index 9e40d4185..439d5573b 100644 --- a/tests/test_tallies/test_tallies.py +++ b/tests/test_tallies/test_tallies.py @@ -113,10 +113,11 @@ class TalliesTestHarness(PyAPITestHarness): polar_tally4.estimator = 'tracklength' universe_tally = Tally() - universe_tally.filters = [Filter(type='universe', bins=(1, 2, 3, 4))] + universe_tally.filters = [ + Filter(type='universe', bins=(1, 2, 3, 4, 6, 8))] universe_tally.scores = ['total'] - cell_filter = Filter(type='cell', bins=(10, 21, 22, 23)) + cell_filter = Filter(type='cell', bins=(10, 21, 22, 23, 60)) score_tallies = [Tally(), Tally(), Tally()] for t in score_tallies: t.filters = [cell_filter] @@ -127,7 +128,7 @@ class TalliesTestHarness(PyAPITestHarness): score_tallies[1].estimator = 'analog' score_tallies[2].estimator = 'collision' - cell_filter2 = Filter(type='cell', bins=(21, 22, 23, 27, 28, 29)) + cell_filter2 = Filter(type='cell', bins=(21, 22, 23, 27, 28, 29, 60)) flux_tallies = [Tally() for i in range(4)] for t in flux_tallies: t.filters = [cell_filter2] From f3378f52064593e0bf90f0506e8a3969d004467b Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 15 Jul 2016 23:35:12 -0500 Subject: [PATCH 17/23] Style fixes; remove t % n_filters --- openmc/filter.py | 2 +- src/cmfd_data.F90 | 48 ++- src/cmfd_input.F90 | 11 +- src/initialize.F90 | 8 +- src/input_xml.F90 | 702 +++++++++++++++++++-------------------- src/output.F90 | 55 +-- src/state_point.F90 | 4 +- src/summary.F90 | 4 +- src/tally.F90 | 95 +++--- src/tally_header.F90 | 4 - src/tally_initialize.F90 | 6 +- src/trigger.F90 | 30 +- 12 files changed, 499 insertions(+), 470 deletions(-) diff --git a/openmc/filter.py b/openmc/filter.py index d2615fba1..b1c040a32 100644 --- a/openmc/filter.py +++ b/openmc/filter.py @@ -166,7 +166,7 @@ class Filter(object): # If the bin is 0D numpy array, promote to 1D elif isinstance(bins, np.ndarray): if bins.shape == (): - bins = bins.reshape((1,)) + bins.shape = (1,) # If the bins are in a collection, convert it to a list else: diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 61e74716c..0f1d9420b 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -145,7 +145,7 @@ contains TALLY: if (ital == 1) then ! Reset all bins to 1 - matching_bins(1:t%n_filters) = 1 + matching_bins(1:size(t % filters)) = 1 ! Set ijk as mesh indices ijk = (/ i, j, k /) @@ -159,7 +159,8 @@ contains end if ! Calculate score index from bins - score_index = sum((matching_bins(1:t%n_filters) - 1) * t%stride) + 1 + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t%stride) + 1 ! Get flux flux = t % results(1,score_index) % sum @@ -188,7 +189,7 @@ contains INGROUP: do g = 1, ng ! Reset all bins to 1 - matching_bins(1:t%n_filters) = 1 + matching_bins(1:size(t % filters)) = 1 ! Set ijk as mesh indices ijk = (/ i, j, k /) @@ -205,7 +206,8 @@ contains end if ! Calculate score index from bins - score_index = sum((matching_bins(1:t%n_filters) - 1) * t%stride) + 1 + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t%stride) + 1 ! Get scattering cmfd % scattxs(h,g,i,j,k) = t % results(1,score_index) % sum /& @@ -227,7 +229,7 @@ contains else if (ital == 3) then ! Initialize and filter for energy - matching_bins(1:t%n_filters) = 1 + matching_bins(1:size(t % filters)) = 1 if (i_filter_ein > 0) then matching_bins(i_filter_ein) = ng - h + 1 end if @@ -236,60 +238,72 @@ contains matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i-1, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_RIGHT - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t%stride) + 1 ! outgoing cmfd % current(1,h,i,j,k) = t % results(1,score_index) % sum matching_bins(i_filter_surf) = OUT_RIGHT - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! incoming cmfd % current(2,h,i,j,k) = t % results(1,score_index) % sum ! Right surface matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_RIGHT - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! incoming cmfd % current(3,h,i,j,k) = t % results(1,score_index) % sum matching_bins(i_filter_surf) = OUT_RIGHT - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! outgoing cmfd % current(4,h,i,j,k) = t % results(1,score_index) % sum ! Back surface matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j-1, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_FRONT - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! outgoing cmfd % current(5,h,i,j,k) = t % results(1,score_index) % sum matching_bins(i_filter_surf) = OUT_FRONT - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! incoming cmfd % current(6,h,i,j,k) = t % results(1,score_index) % sum ! Front surface matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_FRONT - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! incoming cmfd % current(7,h,i,j,k) = t % results(1,score_index) % sum matching_bins(i_filter_surf) = OUT_FRONT - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! outgoing cmfd % current(8,h,i,j,k) = t % results(1,score_index) % sum ! Bottom surface matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j, k-1 /) + 1, .true.) matching_bins(i_filter_surf) = IN_TOP - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! outgoing cmfd % current(9,h,i,j,k) = t % results(1,score_index) % sum matching_bins(i_filter_surf) = OUT_TOP - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! incoming cmfd % current(10,h,i,j,k) = t % results(1,score_index) % sum ! Top surface matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_TOP - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! incoming cmfd % current(11,h,i,j,k) = t % results(1,score_index) % sum matching_bins(i_filter_surf) = OUT_TOP - score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing + score_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! outgoing cmfd % current(12,h,i,j,k) = t % results(1,score_index) % sum end if TALLY diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 69b9eb6c0..baa08e76e 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -412,7 +412,7 @@ contains ! Set up mesh filter n_filters = 1 - allocate(MeshFilter::filters(n_filters) % obj) + allocate(MeshFilter :: filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (MeshFilter) filt % n_bins = product(m % dimension) @@ -423,7 +423,7 @@ contains ! Read and set incoming energy mesh filter if (check_for_node(node_mesh, "energy")) then n_filters = n_filters + 1 - allocate(EnergyFilter::filters(n_filters) % obj) + allocate(EnergyFilter :: filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (EnergyFilter) ng = get_arraysize_double(node_mesh, "energy") @@ -454,7 +454,6 @@ contains t % type = TALLY_VOLUME ! Allocate and set filters - t % n_filters = n_filters allocate(t % filters(n_filters)) do j = 1, n_filters call move_alloc(filters(j) % obj, t % filters(j) % obj) @@ -489,7 +488,7 @@ contains ! read and set outgoing energy mesh filter if (check_for_node(node_mesh, "energy")) then n_filters = n_filters + 1 - allocate(EnergyoutFilter::filters(n_filters) % obj) + allocate(EnergyoutFilter :: filters(n_filters) % obj) select type (filt => filters(n_filters) % obj) type is (EnergyoutFilter) ng = get_arraysize_double(node_mesh, "energy") @@ -501,7 +500,6 @@ contains end if ! Allocate and set filters - t % n_filters = n_filters allocate(t % filters(n_filters)) do j = 1, n_filters call move_alloc(filters(j) % obj, t % filters(j) % obj) @@ -530,7 +528,7 @@ contains ! Add extra filter for surface n_filters = n_filters + 1 - allocate(SurfaceFilter::filters(n_filters) % obj) + allocate(SurfaceFilter :: filters(n_filters) % obj) select type(filt => filters(n_filters) % obj) type is(SurfaceFilter) filt % n_bins = 2 * m % n_dimension @@ -545,7 +543,6 @@ contains t % find_filter(FILTER_SURFACE) = n_filters ! Allocate and set filters - t % n_filters = n_filters allocate(t % filters(n_filters)) do j = 1, n_filters call move_alloc(filters(j) % obj, t % filters(j) % obj) diff --git a/src/initialize.F90 b/src/initialize.F90 index 3c1e44ff7..1972ea366 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -723,7 +723,7 @@ contains ! ======================================================================= ! ADJUST INDICES FOR EACH TALLY FILTER - FILTER_LOOP: do j = 1, t % n_filters + FILTER_LOOP: do j = 1, size(t % filters) select type(filt => t % filters(j) % obj) type is (SurfaceFilter) @@ -910,7 +910,7 @@ contains ! We need distribcell if any tallies have distribcell filters. do i = 1, n_tallies - do j = 1, tallies(i) % n_filters + do j = 1, size(tallies(i) % filters) select type(filt => tallies(i) % filters(j) % obj) type is (DistribcellFilter) distribcell_active = .true. @@ -937,7 +937,7 @@ contains ! Set the number of bins in all distribcell filters. do i = 1, n_tallies - do j = 1, tallies(i) % n_filters + do j = 1, size(tallies(i) % filters) select type(filt => tallies(i) % filters(j) % obj) type is (DistribcellFilter) ! Set the number of bins to the number of instances of the cell. @@ -1002,7 +1002,7 @@ contains ! List all cells referenced in distribcell filters. do i = 1, n_tallies - do j = 1, tallies(i) % n_filters + do j = 1, size(tallies(i) % filters) select type(filt => tallies(i) % filters(j) % obj) type is (DistribcellFilter) call cell_list % add(filt % cell) diff --git a/src/input_xml.F90 b/src/input_xml.F90 index c8e5b28af..f0b442c88 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -2883,360 +2883,352 @@ contains call get_node_list(node_tal, "filter", node_filt_list) n_filters = get_list_size(node_filt_list) - if (n_filters /= 0) then + ! Allocate filters array + allocate(t % filters(n_filters)) - ! Allocate filters array - t % n_filters = n_filters - allocate(t % filters(n_filters)) + READ_FILTERS: do j = 1, n_filters + ! Get pointer to filter xml node + call get_list_item(node_filt_list, j, node_filt) - READ_FILTERS: do j = 1, n_filters - ! Get pointer to filter xml node - call get_list_item(node_filt_list, j, node_filt) + ! Convert filter type to lower case + temp_str = '' + if (check_for_node(node_filt, "type")) & + call get_node_value(node_filt, "type", temp_str) + temp_str = to_lower(temp_str) - ! Convert filter type to lower case - temp_str = '' - if (check_for_node(node_filt, "type")) & - call get_node_value(node_filt, "type", temp_str) - temp_str = to_lower(temp_str) - - ! Determine number of bins - if (check_for_node(node_filt, "bins")) then - if (temp_str == 'energy' .or. temp_str == 'energyout' .or. & - temp_str == 'mu' .or. temp_str == 'polar' .or. & - temp_str == 'azimuthal') then - n_words = get_arraysize_double(node_filt, "bins") - else - n_words = get_arraysize_integer(node_filt, "bins") - end if + ! Determine number of bins + if (check_for_node(node_filt, "bins")) then + if (temp_str == 'energy' .or. temp_str == 'energyout' .or. & + temp_str == 'mu' .or. temp_str == 'polar' .or. & + temp_str == 'azimuthal') then + n_words = get_arraysize_double(node_filt, "bins") else - call fatal_error("Bins not set in filter on tally " & - // trim(to_str(t % id))) + n_words = get_arraysize_integer(node_filt, "bins") end if - - ! Determine type of filter - select case (temp_str) - - case ('distribcell') - ! Allocate and declare the filter type - allocate(DistribcellFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (DistribcellFilter) - if (n_words /= 1) call fatal_error("Only one cell can be & - &specified per distribcell filter.") - ! Store bins - call get_node_value(node_filt, "bins", filt % cell) - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_DISTRIBCELL) = j - - case ('cell') - ! Allocate and declare the filter type - allocate(CellFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (CellFilter) - ! Allocate and store bins - filt % n_bins = n_words - allocate(filt % cells(n_words)) - call get_node_array(node_filt, "bins", filt % cells) - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_CELL) = j - - case ('cellborn') - ! Allocate and declare the filter type - allocate(CellbornFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (CellbornFilter) - ! Allocate and store bins - filt % n_bins = n_words - allocate(filt % cells(n_words)) - call get_node_array(node_filt, "bins", filt % cells) - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_CELLBORN) = j - - case ('material') - ! Allocate and declare the filter type - allocate(MaterialFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (MaterialFilter) - ! Allocate and store bins - filt % n_bins = n_words - allocate(filt % materials(n_words)) - call get_node_array(node_filt, "bins", filt % materials) - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_MATERIAL) = j - - case ('universe') - ! Allocate and declare the filter type - allocate(UniverseFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (UniverseFilter) - ! Allocate and store bins - filt % n_bins = n_words - allocate(filt % universes(n_words)) - call get_node_array(node_filt, "bins", filt % universes) - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_UNIVERSE) = j - - case ('surface') - call fatal_error("Surface filter is not yet supported!") - ! Allocate and declare the filter type - allocate(SurfaceFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (SurfaceFilter) - ! Allocate and store bins - filt % n_bins = n_words - allocate(filt % surfaces(n_words)) - call get_node_array(node_filt, "bins", filt % surfaces) - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_SURFACE) = j - - case ('mesh') - ! Allocate and declare the filter type - allocate(MeshFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (MeshFilter) - if (n_words /= 1) call fatal_error("Only one mesh can be & - &specified per mesh filter.") - - ! Determine id of mesh - call get_node_value(node_filt, "bins", id) - - ! Get pointer to mesh - if (mesh_dict % has_key(id)) then - i_mesh = mesh_dict % get_key(id) - m => meshes(i_mesh) - else - call fatal_error("Could not find mesh " // trim(to_str(id)) & - // " specified on tally " // trim(to_str(t % id))) - end if - - ! Determine number of bins -- this is assuming that the tally is - ! a volume tally and not a surface current tally. If it is a - ! surface current tally, the number of bins will get reset later - filt % n_bins = product(m % dimension) - - ! Store the index of the mesh - filt % mesh = i_mesh - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_MESH) = j - - case ('energy') - ! Allocate and declare the filter type - allocate(EnergyFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (EnergyFilter) - ! Allocate and store bins - filt % n_bins = n_words - 1 - allocate(filt % bins(n_words)) - call get_node_array(node_filt, "bins", filt % bins) - - ! We can save tallying time if we know that the tally bins match - ! the energy group structure. In that case, the matching bin - ! index is simply the group (after flipping for the different - ! ordering of the library and tallying systems). - if (.not. run_CE) then - if (n_words == energy_groups + 1) then - if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & - then - filt % matches_transport_groups = .true. - end if - end if - end if - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_ENERGYIN) = j - - case ('energyout') - ! Allocate and declare the filter type - allocate(EnergyoutFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (EnergyoutFilter) - ! Allocate and store bins - filt % n_bins = n_words - 1 - allocate(filt % bins(n_words)) - call get_node_array(node_filt, "bins", filt % bins) - - ! We can save tallying time if we know that the tally bins match - ! the energy group structure. In that case, the matching bin - ! index is simply the group (after flipping for the different - ! ordering of the library and tallying systems). - if (.not. run_CE) then - if (n_words == energy_groups + 1) then - if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & - then - filt % matches_transport_groups = .true. - end if - end if - end if - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_ENERGYOUT) = j - - ! Set to analog estimator - t % estimator = ESTIMATOR_ANALOG - - case ('delayedgroup') - ! Check to see if running in MG mode, because if so, the current - ! system isnt set up yet to support delayed group data and thus - ! these tallies - if (.not. run_CE) then - call fatal_error("delayedgroup filter on tally " & - // trim(to_str(t % id)) // " not yet supported& - & for multi-group mode.") - end if - - ! Allocate and declare the filter type - allocate(DelayedGroupFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (DelayedGroupFilter) - ! Allocate and store bins - filt % n_bins = n_words - allocate(filt % groups(n_words)) - call get_node_array(node_filt, "bins", filt % groups) - - ! Check that bins are all are between 1 and MAX_DELAYED_GROUPS - do d = 1, n_words - if (filt % groups(d) < 1 .or. & - filt % groups(d) > MAX_DELAYED_GROUPS) then - call fatal_error("Encountered delayedgroup bin with index " & - // trim(to_str(filt % groups(d))) // " that is outside & - &the range of 1 to MAX_DELAYED_GROUPS ( " & - // trim(to_str(MAX_DELAYED_GROUPS)) // ")") - end if - end do - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_DELAYEDGROUP) = j - - case ('mu') - ! Allocate and declare the filter type - allocate(MuFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (MuFilter) - ! Allocate and store bins - filt % n_bins = n_words - 1 - allocate(filt % bins(n_words)) - call get_node_array(node_filt, "bins", filt % bins) - - ! Allow a user to input a lone number which will mean that you - ! subdivide [-1,1] evenly with the input being the number of bins - if (n_words == 1) then - Nangle = int(filt % bins(1)) - if (Nangle > 1) then - filt % n_bins = Nangle - dangle = TWO / real(Nangle,8) - deallocate(filt % bins) - allocate(filt % bins(Nangle + 1)) - do iangle = 1, Nangle - filt % bins(iangle) = -ONE + (iangle - 1) * dangle - end do - filt % bins(Nangle + 1) = ONE - else - call fatal_error("Number of bins for mu filter must be& - & greater than 1 on tally " & - // trim(to_str(t % id)) // ".") - end if - end if - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_MU) = j - - ! Set to analog estimator - t % estimator = ESTIMATOR_ANALOG - - case ('polar') - ! Allocate and declare the filter type - allocate(PolarFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (PolarFilter) - ! Allocate and store bins - filt % n_bins = n_words - 1 - allocate(filt % bins(n_words)) - call get_node_array(node_filt, "bins", filt % bins) - - ! Allow a user to input a lone number which will mean that you - ! subdivide [0,pi] evenly with the input being the number of bins - if (n_words == 1) then - Nangle = int(filt % bins(1)) - if (Nangle > 1) then - filt % n_bins = Nangle - dangle = PI / real(Nangle,8) - deallocate(filt % bins) - allocate(filt % bins(Nangle + 1)) - do iangle = 1, Nangle - filt % bins(iangle) = (iangle - 1) * dangle - end do - filt % bins(Nangle + 1) = PI - else - call fatal_error("Number of bins for mu filter must be& - & greater than 1 on tally " & - // trim(to_str(t % id)) // ".") - end if - end if - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_POLAR) = j - - case ('azimuthal') - ! Allocate and declare the filter type - allocate(AzimuthalFilter::t % filters(j) % obj) - select type (filt => t % filters(j) % obj) - type is (AzimuthalFilter) - ! Allocate and store bins - filt % n_bins = n_words - 1 - allocate(filt % bins(n_words)) - call get_node_array(node_filt, "bins", filt % bins) - - ! Allow a user to input a lone number which will mean that you - ! subdivide [-pi,pi) evenly with the input being the number of - ! bins - if (n_words == 1) then - Nangle = int(filt % bins(1)) - if (Nangle > 1) then - filt % n_bins = Nangle - dangle = TWO * PI / real(Nangle,8) - deallocate(filt % bins) - allocate(filt % bins(Nangle + 1)) - do iangle = 1, Nangle - filt % bins(iangle) = -PI + (iangle - 1) * dangle - end do - filt % bins(Nangle + 1) = PI - else - call fatal_error("Number of bins for mu filter must be& - & greater than 1 on tally " & - // trim(to_str(t % id)) // ".") - end if - end if - end select - ! Set the filter index in the tally find_filter array - t % find_filter(FILTER_AZIMUTHAL) = j - - case default - ! Specified tally filter is invalid, raise error - call fatal_error("Unknown filter type '" & - // trim(temp_str) // "' on tally " & - // trim(to_str(t % id)) // ".") - - end select - - end do READ_FILTERS - - ! Check that both cell and surface weren't specified - if (t % find_filter(FILTER_CELL) > 0 .and. & - t % find_filter(FILTER_SURFACE) > 0) then - call fatal_error("Cannot specify both cell and surface filters for & - &tally " // trim(to_str(t % id))) + else + call fatal_error("Bins not set in filter on tally " & + // trim(to_str(t % id))) end if - else - ! No filters were specified - t % n_filters = 0 + ! Determine type of filter + select case (temp_str) + + case ('distribcell') + ! Allocate and declare the filter type + allocate(DistribcellFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (DistribcellFilter) + if (n_words /= 1) call fatal_error("Only one cell can be & + &specified per distribcell filter.") + ! Store bins + call get_node_value(node_filt, "bins", filt % cell) + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_DISTRIBCELL) = j + + case ('cell') + ! Allocate and declare the filter type + allocate(CellFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (CellFilter) + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % cells(n_words)) + call get_node_array(node_filt, "bins", filt % cells) + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_CELL) = j + + case ('cellborn') + ! Allocate and declare the filter type + allocate(CellbornFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (CellbornFilter) + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % cells(n_words)) + call get_node_array(node_filt, "bins", filt % cells) + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_CELLBORN) = j + + case ('material') + ! Allocate and declare the filter type + allocate(MaterialFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (MaterialFilter) + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % materials(n_words)) + call get_node_array(node_filt, "bins", filt % materials) + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_MATERIAL) = j + + case ('universe') + ! Allocate and declare the filter type + allocate(UniverseFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (UniverseFilter) + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % universes(n_words)) + call get_node_array(node_filt, "bins", filt % universes) + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_UNIVERSE) = j + + case ('surface') + call fatal_error("Surface filter is not yet supported!") + ! Allocate and declare the filter type + allocate(SurfaceFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (SurfaceFilter) + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % surfaces(n_words)) + call get_node_array(node_filt, "bins", filt % surfaces) + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_SURFACE) = j + + case ('mesh') + ! Allocate and declare the filter type + allocate(MeshFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (MeshFilter) + if (n_words /= 1) call fatal_error("Only one mesh can be & + &specified per mesh filter.") + + ! Determine id of mesh + call get_node_value(node_filt, "bins", id) + + ! Get pointer to mesh + if (mesh_dict % has_key(id)) then + i_mesh = mesh_dict % get_key(id) + m => meshes(i_mesh) + else + call fatal_error("Could not find mesh " // trim(to_str(id)) & + // " specified on tally " // trim(to_str(t % id))) + end if + + ! Determine number of bins -- this is assuming that the tally is + ! a volume tally and not a surface current tally. If it is a + ! surface current tally, the number of bins will get reset later + filt % n_bins = product(m % dimension) + + ! Store the index of the mesh + filt % mesh = i_mesh + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_MESH) = j + + case ('energy') + ! Allocate and declare the filter type + allocate(EnergyFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (EnergyFilter) + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) + + ! We can save tallying time if we know that the tally bins match + ! the energy group structure. In that case, the matching bin + ! index is simply the group (after flipping for the different + ! ordering of the library and tallying systems). + if (.not. run_CE) then + if (n_words == energy_groups + 1) then + if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & + then + filt % matches_transport_groups = .true. + end if + end if + end if + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_ENERGYIN) = j + + case ('energyout') + ! Allocate and declare the filter type + allocate(EnergyoutFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (EnergyoutFilter) + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) + + ! We can save tallying time if we know that the tally bins match + ! the energy group structure. In that case, the matching bin + ! index is simply the group (after flipping for the different + ! ordering of the library and tallying systems). + if (.not. run_CE) then + if (n_words == energy_groups + 1) then + if (all(filt % bins == energy_bins(energy_groups + 1:1:-1))) & + then + filt % matches_transport_groups = .true. + end if + end if + end if + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_ENERGYOUT) = j + + ! Set to analog estimator + t % estimator = ESTIMATOR_ANALOG + + case ('delayedgroup') + ! Check to see if running in MG mode, because if so, the current + ! system isnt set up yet to support delayed group data and thus + ! these tallies + if (.not. run_CE) then + call fatal_error("delayedgroup filter on tally " & + // trim(to_str(t % id)) // " not yet supported& + & for multi-group mode.") + end if + + ! Allocate and declare the filter type + allocate(DelayedGroupFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (DelayedGroupFilter) + ! Allocate and store bins + filt % n_bins = n_words + allocate(filt % groups(n_words)) + call get_node_array(node_filt, "bins", filt % groups) + + ! Check that bins are all are between 1 and MAX_DELAYED_GROUPS + do d = 1, n_words + if (filt % groups(d) < 1 .or. & + filt % groups(d) > MAX_DELAYED_GROUPS) then + call fatal_error("Encountered delayedgroup bin with index " & + // trim(to_str(filt % groups(d))) // " that is outside & + &the range of 1 to MAX_DELAYED_GROUPS ( " & + // trim(to_str(MAX_DELAYED_GROUPS)) // ")") + end if + end do + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_DELAYEDGROUP) = j + + case ('mu') + ! Allocate and declare the filter type + allocate(MuFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (MuFilter) + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) + + ! Allow a user to input a lone number which will mean that you + ! subdivide [-1,1] evenly with the input being the number of bins + if (n_words == 1) then + Nangle = int(filt % bins(1)) + if (Nangle > 1) then + filt % n_bins = Nangle + dangle = TWO / real(Nangle,8) + deallocate(filt % bins) + allocate(filt % bins(Nangle + 1)) + do iangle = 1, Nangle + filt % bins(iangle) = -ONE + (iangle - 1) * dangle + end do + filt % bins(Nangle + 1) = ONE + else + call fatal_error("Number of bins for mu filter must be& + & greater than 1 on tally " & + // trim(to_str(t % id)) // ".") + end if + end if + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_MU) = j + + ! Set to analog estimator + t % estimator = ESTIMATOR_ANALOG + + case ('polar') + ! Allocate and declare the filter type + allocate(PolarFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (PolarFilter) + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) + + ! Allow a user to input a lone number which will mean that you + ! subdivide [0,pi] evenly with the input being the number of bins + if (n_words == 1) then + Nangle = int(filt % bins(1)) + if (Nangle > 1) then + filt % n_bins = Nangle + dangle = PI / real(Nangle,8) + deallocate(filt % bins) + allocate(filt % bins(Nangle + 1)) + do iangle = 1, Nangle + filt % bins(iangle) = (iangle - 1) * dangle + end do + filt % bins(Nangle + 1) = PI + else + call fatal_error("Number of bins for mu filter must be& + & greater than 1 on tally " & + // trim(to_str(t % id)) // ".") + end if + end if + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_POLAR) = j + + case ('azimuthal') + ! Allocate and declare the filter type + allocate(AzimuthalFilter::t % filters(j) % obj) + select type (filt => t % filters(j) % obj) + type is (AzimuthalFilter) + ! Allocate and store bins + filt % n_bins = n_words - 1 + allocate(filt % bins(n_words)) + call get_node_array(node_filt, "bins", filt % bins) + + ! Allow a user to input a lone number which will mean that you + ! subdivide [-pi,pi) evenly with the input being the number of + ! bins + if (n_words == 1) then + Nangle = int(filt % bins(1)) + if (Nangle > 1) then + filt % n_bins = Nangle + dangle = TWO * PI / real(Nangle,8) + deallocate(filt % bins) + allocate(filt % bins(Nangle + 1)) + do iangle = 1, Nangle + filt % bins(iangle) = -PI + (iangle - 1) * dangle + end do + filt % bins(Nangle + 1) = PI + else + call fatal_error("Number of bins for mu filter must be& + & greater than 1 on tally " & + // trim(to_str(t % id)) // ".") + end if + end if + end select + ! Set the filter index in the tally find_filter array + t % find_filter(FILTER_AZIMUTHAL) = j + + case default + ! Specified tally filter is invalid, raise error + call fatal_error("Unknown filter type '" & + // trim(temp_str) // "' on tally " & + // trim(to_str(t % id)) // ".") + + end select + + end do READ_FILTERS + + ! Check that both cell and surface weren't specified + if (t % find_filter(FILTER_CELL) > 0 .and. & + t % find_filter(FILTER_SURFACE) > 0) then + call fatal_error("Cannot specify both cell and surface filters for & + &tally " // trim(to_str(t % id))) end if ! ======================================================================= @@ -3272,7 +3264,7 @@ contains if (trim(sarray(j)) == 'total') then ! Check if a delayedgroup filter is present for this tally - do l = 1, t % n_filters + do l = 1, size(t % filters) select type(filt => t % filters(l) % obj) type is (DelayedGroupFilter) call warning("A delayedgroup filter was used on a total & @@ -3337,7 +3329,7 @@ contains t % n_nuclide_bins = 1 ! Check if a delayedgroup filter is present for this tally - do l = 1, t % n_filters + do l = 1, size(t % filters) select type(filt => t % filters(l) % obj) type is (DelayedGroupFilter) call warning("A delayedgroup filter was used on a total nuclide & @@ -3671,17 +3663,17 @@ contains end select ! Copy filters to temporary array - allocate(filters(t % n_filters + 1)) - filters(1:t % n_filters) = t % filters + allocate(filters(size(t % filters) + 1)) + filters(1:size(t % filters)) = t % filters ! Move allocation back -- filters becomes deallocated during ! this call call move_alloc(FROM=filters, TO=t%filters) ! Add surface filter - t % n_filters = t % n_filters + 1 - allocate(SurfaceFilter::t % filters(t % n_filters) % obj) - select type (filt => t % filters(t % n_filters) % obj) + n_filters = size(t % filters) + allocate(SurfaceFilter :: t % filters(n_filters) % obj) + select type (filt => t % filters(size(t % filters)) % obj) type is (SurfaceFilter) filt % n_bins = 2 * m % n_dimension allocate(filt % surfaces(2 * m % n_dimension)) @@ -3692,7 +3684,7 @@ contains IN_TOP, OUT_TOP /) end if end select - t % find_filter(FILTER_SURFACE) = t % n_filters + t % find_filter(FILTER_SURFACE) = size(t % filters) case ('events') t % score_bins(j) = SCORE_EVENTS diff --git a/src/output.F90 b/src/output.F90 index c9c0cffbe..7717593a7 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -825,14 +825,14 @@ contains ! to be used for a given tally. ! Initialize bins, filter level, and indentation - matching_bins(1:t%n_filters) = 0 + matching_bins(1:size(t % filters)) = 0 j = 1 indent = 0 print_bin: do find_bin: do ! Check for no filters - if (t % n_filters == 0) exit find_bin + if (size(t % filters) == 0) exit find_bin ! Increment bin combination matching_bins(j) = matching_bins(j) + 1 @@ -853,7 +853,7 @@ contains else ! Check if this is last filter - if (j == t % n_filters) exit find_bin + if (j == size(t % filters)) exit find_bin ! Print current filter information write(UNIT=unit_tally, FMT='(1X,2A)') repeat(" ", indent), & @@ -865,7 +865,7 @@ contains end do find_bin ! Print filter information - if (t % n_filters > 0) then + if (size(t % filters) > 0) then write(UNIT=unit_tally, FMT='(1X,2A)') repeat(" ", indent), & trim(t % filters(j) % obj % text_label(matching_bins(j))) end if @@ -874,15 +874,16 @@ contains ! in the score_tally subroutine, we have to use max(bins,1) since all ! bins below the lowest filter level will be zeros - if (t % n_filters > 0) then - filter_index = sum((max(matching_bins(1:t%n_filters),1) - 1) * t % stride) + 1 + if (size(t % filters) > 0) then + filter_index = sum((max(matching_bins(1:size(t % filters)),1) - 1) & + * t % stride) + 1 else filter_index = 1 end if ! Write results for this filter bin combination score_index = 0 - if (t % n_filters > 0) indent = indent + 2 + if (size(t % filters) > 0) indent = indent + 2 do n = 1, t % n_nuclide_bins ! Write label for nuclide i_nuclide = t % nuclide_bins(n) @@ -959,7 +960,7 @@ contains end do indent = indent - 2 - if (t % n_filters == 0) exit print_bin + if (size(t % filters) == 0) exit print_bin end do print_bin @@ -1002,7 +1003,7 @@ contains end select ! initialize bins array - matching_bins(1:t%n_filters) = 1 + matching_bins(1:size(t % filters)) = 1 ! determine how many energy in bins there are i_filter_ein = t % find_filter(FILTER_ENERGYIN) @@ -1040,14 +1041,16 @@ contains matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i-1, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_RIGHT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Left", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_RIGHT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Left", & to_str(t % results(1,filter_index) % sum), & @@ -1057,14 +1060,16 @@ contains matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_RIGHT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Right", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_RIGHT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Right", & to_str(t % results(1,filter_index) % sum), & @@ -1074,14 +1079,16 @@ contains matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j-1, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_FRONT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Back", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_FRONT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Back", & to_str(t % results(1,filter_index) % sum), & @@ -1091,14 +1098,16 @@ contains matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_FRONT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Front", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_FRONT - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Front", & to_str(t % results(1,filter_index) % sum), & @@ -1108,14 +1117,16 @@ contains matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j, k-1 /) + 1, .true.) matching_bins(i_filter_surf) = IN_TOP - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Bottom", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_TOP - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Bottom", & to_str(t % results(1,filter_index) % sum), & @@ -1125,14 +1136,16 @@ contains matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_TOP - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Top", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) matching_bins(i_filter_surf) = OUT_TOP - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 write(UNIT=unit_tally, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Top", & to_str(t % results(1,filter_index) % sum), & diff --git a/src/state_point.F90 b/src/state_point.F90 index 68905ca4a..0529fb54b 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -237,10 +237,10 @@ contains end select call write_dataset(tally_group, "n_realizations", & tally % n_realizations) - call write_dataset(tally_group, "n_filters", tally % n_filters) + call write_dataset(tally_group, "n_filters", size(tally % filters)) ! Write filter information - FILTER_LOOP: do j = 1, tally % n_filters + FILTER_LOOP: do j = 1, size(tally % filters) filter_group = create_group(tally_group, "filter " // & trim(to_str(j))) call tally % filters(j) % obj % to_statepoint(filter_group) diff --git a/src/summary.F90 b/src/summary.F90 index 52b4ad9dd..6f8c19067 100644 --- a/src/summary.F90 +++ b/src/summary.F90 @@ -625,9 +625,9 @@ contains call write_dataset(tally_group, "name", t%name) ! Write number of filters - call write_dataset(tally_group, "n_filters", t%n_filters) + call write_dataset(tally_group, "n_filters", size(t % filters)) - FILTER_LOOP: do j = 1, t % n_filters + FILTER_LOOP: do j = 1, size(t % filters) filter_group = create_group(tally_group, "filter " // trim(to_str(j))) call t % filters(j) % obj % to_summary(filter_group) call close_group(filter_group) diff --git a/src/tally.F90 b/src/tally.F90 index fed64324b..361b4a3bf 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -1367,7 +1367,7 @@ contains ! Find the first bin in each filter. There may be more than one matching ! bin per filter, but we'll deal with those later. - do i_filt = 1, t % n_filters + do i_filt = 1, size(t % filters) call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & NO_BIN_FOUND, matching_bins(i_filt), filter_weights(i_filt)) ! If there are no valid bins for this filter, then there is nothing to @@ -1382,8 +1382,9 @@ contains FILTER_LOOP: do ! Determine scoring index and weight for this filter combination - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - filter_weight = product(filter_weights(:t % n_filters)) + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 + filter_weight = product(filter_weights(:size(t % filters))) ! ====================================================================== ! Nuclide logic @@ -1434,13 +1435,13 @@ contains ! Filter logic ! If there are no filters, then we are done. - if (t % n_filters == 0) exit FILTER_LOOP + if (size(t % filters) == 0) exit FILTER_LOOP ! Increment the filter bins, starting with the last filter. If we get a ! NO_BIN_FOUND for the last filter, it means we finished all valid bins ! for that filter, but next-to-last filter might have more than one ! valid bin so we need to increment that one as well, and so on. - do i_filt = t % n_filters, 1, -1 + do i_filt = size(t % filters), 1, -1 call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & matching_bins(i_filt), matching_bins(i_filt), & filter_weights(i_filt)) @@ -1449,11 +1450,12 @@ contains ! If we got all NO_BIN_FOUNDs, then we have finished all valid bins for ! each of the filters. Exit the loop. - if (all(matching_bins(:t % n_filters) == NO_BIN_FOUND)) exit FILTER_LOOP + if (all(matching_bins(:size(t % filters)) == NO_BIN_FOUND)) & + exit FILTER_LOOP ! Reset all the filters with NO_BIN_FOUND. This will set them back to ! their first valid bin. - do i_filt = 1, t % n_filters + do i_filt = 1, size(t % filters) if (matching_bins(i_filt) == NO_BIN_FOUND) then call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & matching_bins(i_filt), matching_bins(i_filt), & @@ -1506,7 +1508,7 @@ contains ! Find the first bin in each filter. There may be more than one matching ! bin per filter, but we'll deal with those later. - do i_filt = 1, t % n_filters + do i_filt = 1, size(t % filters) call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & NO_BIN_FOUND, matching_bins(i_filt), filter_weights(i_filt)) ! If there are no valid bins for this filter, then there is nothing to @@ -1521,8 +1523,9 @@ contains FILTER_LOOP: do ! Determine scoring index and weight for this filter combination - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - filter_weight = product(filter_weights(:t % n_filters)) + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 + filter_weight = product(filter_weights(:size(t % filters))) ! ====================================================================== ! Nuclide logic @@ -1554,13 +1557,13 @@ contains ! Filter logic ! If there are no filters, then we are done. - if (t % n_filters == 0) exit FILTER_LOOP + if (size(t % filters) == 0) exit FILTER_LOOP ! Increment the filter bins, starting with the last filter. If we get a ! NO_BIN_FOUND for the last filter, it means we finished all valid bins ! for that filter, but next-to-last filter might have more than one ! valid bin so we need to increment that one as well, and so on. - do i_filt = t % n_filters, 1, -1 + do i_filt = size(t % filters), 1, -1 call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & matching_bins(i_filt), matching_bins(i_filt), & filter_weights(i_filt)) @@ -1569,11 +1572,12 @@ contains ! If we got all NO_BIN_FOUNDs, then we have finished all valid bins for ! each of the filters. Exit the loop. - if (all(matching_bins(:t % n_filters) == NO_BIN_FOUND)) exit FILTER_LOOP + if (all(matching_bins(:size(t % filters)) == NO_BIN_FOUND)) & + exit FILTER_LOOP ! Reset all the filters with NO_BIN_FOUND. This will set them back to ! their first valid bin. - do i_filt = 1, t % n_filters + do i_filt = 1, size(t % filters) if (matching_bins(i_filt) == NO_BIN_FOUND) then call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & matching_bins(i_filt), matching_bins(i_filt), & @@ -1647,7 +1651,7 @@ contains matching_bins(i) = binary_search(filt % bins, n, E_out) ! determine scoring index - i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + i_filter = sum((matching_bins(1:size(t%filters)) - 1) * t % stride) + 1 ! Add score to tally !$omp atomic @@ -1729,7 +1733,7 @@ contains end if ! determine scoring index - i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + i_filter = sum((matching_bins(1:size(t%filters)) - 1) * t % stride) + 1 ! Add score to tally !$omp atomic @@ -1832,7 +1836,8 @@ contains else ! determine scoring index - i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + i_filter = sum((matching_bins(1:size(t%filters)) - 1) * t % stride)& + + 1 ! Add score to tally !$omp atomic @@ -1868,7 +1873,8 @@ contains matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = d_bin ! Compute the filter index based on the modified matching_bins - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 !$omp atomic t % results(score_index, filter_index) % value = & @@ -1917,7 +1923,7 @@ contains ! Find the first bin in each filter. There may be more than one matching ! bin per filter, but we'll deal with those later. - do i_filt = 1, t % n_filters + do i_filt = 1, size(t % filters) call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & NO_BIN_FOUND, matching_bins(i_filt), filter_weights(i_filt)) ! If there are no valid bins for this filter, then there is nothing to @@ -1932,8 +1938,9 @@ contains FILTER_LOOP: do ! Determine scoring index and weight for this filter combination - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - filter_weight = product(filter_weights(:t % n_filters)) + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 + filter_weight = product(filter_weights(:size(t % filters))) ! ====================================================================== ! Nuclide logic @@ -1984,13 +1991,13 @@ contains ! Filter logic ! If there are no filters, then we are done. - if (t % n_filters == 0) exit FILTER_LOOP + if (size(t % filters) == 0) exit FILTER_LOOP ! Increment the filter bins, starting with the last filter. If we get a ! NO_BIN_FOUND for the last filter, it means we finished all valid bins ! for that filter, but next-to-last filter might have more than one ! valid bin so we need to increment that one as well, and so on. - do i_filt = t % n_filters, 1, -1 + do i_filt = size(t % filters), 1, -1 call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & matching_bins(i_filt), matching_bins(i_filt), & filter_weights(i_filt)) @@ -1999,11 +2006,12 @@ contains ! If we got all NO_BIN_FOUNDs, then we have finished all valid bins for ! each of the filters. Exit the loop. - if (all(matching_bins(:t % n_filters) == NO_BIN_FOUND)) exit FILTER_LOOP + if (all(matching_bins(:size(t % filters)) == NO_BIN_FOUND)) & + exit FILTER_LOOP ! Reset all the filters with NO_BIN_FOUND. This will set them back to ! their first valid bin. - do i_filt = 1, t % n_filters + do i_filt = 1, size(t % filters) if (matching_bins(i_filt) == NO_BIN_FOUND) then call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & matching_bins(i_filt), matching_bins(i_filt), & @@ -2070,7 +2078,7 @@ contains ! Find the first bin in each filter. There may be more than one matching ! bin per filter, but we'll deal with those later. - do i_filt = 1, t % n_filters + do i_filt = 1, size(t % filters) call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & NO_BIN_FOUND, matching_bins(i_filt), filter_weights(i_filt)) ! If there are no valid bins for this filter, then there is nothing to @@ -2085,8 +2093,9 @@ contains FILTER_LOOP: do ! Determine scoring index and weight for this filter combination - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 - filter_weight = product(filter_weights(:t % n_filters)) + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 + filter_weight = product(filter_weights(:size(t % filters))) ! ====================================================================== ! Nuclide logic @@ -2137,13 +2146,13 @@ contains ! Filter logic ! If there are no filters, then we are done. - if (t % n_filters == 0) exit FILTER_LOOP + if (size(t % filters) == 0) exit FILTER_LOOP ! Increment the filter bins, starting with the last filter. If we get a ! NO_BIN_FOUND for the last filter, it means we finished all valid bins ! for that filter, but next-to-last filter might have more than one ! valid bin so we need to increment that one as well, and so on. - do i_filt = t % n_filters, 1, -1 + do i_filt = size(t % filters), 1, -1 call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & matching_bins(i_filt), matching_bins(i_filt), & filter_weights(i_filt)) @@ -2152,11 +2161,12 @@ contains ! If we got all NO_BIN_FOUNDs, then we have finished all valid bins for ! each of the filters. Exit the loop. - if (all(matching_bins(:t % n_filters) == NO_BIN_FOUND)) exit FILTER_LOOP + if (all(matching_bins(:size(t % filters)) == NO_BIN_FOUND)) & + exit FILTER_LOOP ! Reset all the filters with NO_BIN_FOUND. This will set them back to ! their first valid bin. - do i_filt = 1, t % n_filters + do i_filt = 1, size(t % filters) if (matching_bins(i_filt) == NO_BIN_FOUND) then call t % filters(i_filt) % obj % get_next_bin(p, t % estimator, & matching_bins(i_filt), matching_bins(i_filt), & @@ -2280,7 +2290,8 @@ contains matching_bins(i_filter_surf) = OUT_TOP matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 !$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -2293,7 +2304,8 @@ contains matching_bins(i_filter_surf) = IN_TOP matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 !$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -2310,7 +2322,8 @@ contains matching_bins(i_filter_surf) = OUT_FRONT matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 !$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -2323,7 +2336,8 @@ contains matching_bins(i_filter_surf) = IN_FRONT matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 !$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -2340,7 +2354,8 @@ contains matching_bins(i_filter_surf) = OUT_RIGHT matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 !$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -2353,7 +2368,8 @@ contains matching_bins(i_filter_surf) = IN_RIGHT matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 !$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -2469,7 +2485,8 @@ contains ! Determine scoring index if (matching_bins(i_filter_surf) > 0) then - filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:size(t % filters)) - 1) & + * t % stride) + 1 ! Check for errors if (filter_index <= 0 .or. filter_index > & diff --git a/src/tally_header.F90 b/src/tally_header.F90 index b786d9c29..fe385458b 100644 --- a/src/tally_header.F90 +++ b/src/tally_header.F90 @@ -32,10 +32,6 @@ module tally_header integer :: type ! volume, surface current integer :: estimator ! collision, track-length real(8) :: volume ! volume of region - - ! Information about what filters should be used - - integer :: n_filters ! Number of filters type(TallyFilterContainer), allocatable :: filters(:) ! The stride attribute is used for determining the index in the results diff --git a/src/tally_initialize.F90 b/src/tally_initialize.F90 index a48faeead..1ae403bd6 100644 --- a/src/tally_initialize.F90 +++ b/src/tally_initialize.F90 @@ -44,15 +44,15 @@ contains t => tallies(i) ! Allocate stride and matching_bins arrays - allocate(t % stride(t % n_filters)) - max_n_filters = max(max_n_filters, t % n_filters) + allocate(t % stride(size(t % filters))) + max_n_filters = max(max_n_filters, size(t % filters)) ! The filters are traversed in opposite order so that the last filter has ! the shortest stride in memory and the first filter has the largest ! stride n = 1 - STRIDE: do j = t % n_filters, 1, -1 + STRIDE: do j = size(t % filters), 1, -1 t % stride(j) = n n = n * t % filters(j) % obj % n_bins end do STRIDE diff --git a/src/trigger.F90 b/src/trigger.F90 index 9756dd5a7..2fd0e2a12 100644 --- a/src/trigger.F90 +++ b/src/trigger.F90 @@ -166,7 +166,7 @@ contains else ! Initialize bins, filter level - matching_bins(1:t % n_filters) = 0 + matching_bins(1:size(t % filters)) = 0 FILTER_LOOP: do filter_index = 1, t % total_filter_bins @@ -266,7 +266,7 @@ contains end if end if end do NUCLIDE_LOOP - if (t % n_filters == 0) exit FILTER_LOOP + if (size(t % filters) == 0) exit FILTER_LOOP end do FILTER_LOOP end if end do TRIGGER_LOOP @@ -307,7 +307,7 @@ contains end select ! initialize bins array - matching_bins(1:t % n_filters) = 1 + matching_bins(1:size(t % filters)) = 1 ! determine how many energyin bins there are i_filter_ein = t % find_filter(FILTER_ENERGYIN) @@ -333,7 +333,7 @@ contains mesh_indices_to_bin(m, (/ i-1, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_RIGHT filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -345,7 +345,7 @@ contains matching_bins(i_filter_surf) = OUT_RIGHT filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -360,7 +360,7 @@ contains mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_RIGHT filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -372,7 +372,7 @@ contains matching_bins(i_filter_surf) = OUT_RIGHT filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -387,7 +387,7 @@ contains mesh_indices_to_bin(m, (/ i, j-1, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_FRONT filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -400,7 +400,7 @@ contains matching_bins(i_filter_surf) = OUT_FRONT filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -415,7 +415,7 @@ contains mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_FRONT filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -427,7 +427,7 @@ contains matching_bins(i_filter_surf) = OUT_FRONT filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -442,7 +442,7 @@ contains mesh_indices_to_bin(m, (/ i, j, k-1 /) + 1, .true.) matching_bins(i_filter_surf) = IN_TOP filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -454,7 +454,7 @@ contains matching_bins(i_filter_surf) = OUT_TOP filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -469,7 +469,7 @@ contains mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) matching_bins(i_filter_surf) = IN_TOP filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev @@ -481,7 +481,7 @@ contains matching_bins(i_filter_surf) = OUT_TOP filter_index = & - sum((matching_bins(1:t % n_filters) - 1) * t % stride) + 1 + sum((matching_bins(1:size(t % filters)) - 1) * t % stride) + 1 call get_trigger_uncertainty(std_dev, rel_err, 1, filter_index, t) if (trigger % std_dev < std_dev) then trigger % std_dev = std_dev From a53f830e0c5a9f5c18c89b214684816bd5c60cdc Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Tue, 19 Jul 2016 15:58:21 -0500 Subject: [PATCH 18/23] Use filter weights with analog tallies Currently, this doesn't do anything because filter weights are only relevant for tracklength tallies with mesh filters. --- src/tally.F90 | 148 ++++++++++++++++++++++++++------------------------ 1 file changed, 77 insertions(+), 71 deletions(-) diff --git a/src/tally.F90 b/src/tally.F90 index 361b4a3bf..45c9e5ea3 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -69,8 +69,10 @@ contains !=============================================================================== ! SCORE_GENERAL* adds scores to the tally array for the given filter and -! nuclide. This will work for either analog or tracklength tallies. Note that -! atom_density and flux are not used for analog tallies. +! nuclide. This function is called by all volume tallies. For analog tallies, +! the flux estimate depends on the score type so the flux argument is really +! just used for filter weights. The atom_density argument is not used for +! analog tallies. !=============================================================================== subroutine score_general_ce(p, t, start_index, filter_index, i_nuclide, & @@ -128,7 +130,7 @@ contains else score = p % last_wgt end if - score = score / material_xs % total + score = score / material_xs % total * flux else ! For flux, we need no cross section @@ -144,9 +146,9 @@ contains if (survival_biasing) then ! We need to account for the fact that some weight was already ! absorbed - score = p % last_wgt + p % absorb_wgt + score = p % last_wgt + p % absorb_wgt * flux else - score = p % last_wgt + score = p % last_wgt * flux end if else @@ -181,7 +183,7 @@ contains ! Score the flux weighted inverse velocity with velocity in units of ! cm/s score = score / material_xs % total & - / (sqrt(TWO * E / (MASS_NEUTRON_MEV)) * C_LIGHT * 100.0_8) + / (sqrt(TWO * E / (MASS_NEUTRON_MEV)) * C_LIGHT * 100.0_8) * flux else ! For inverse velocity, we don't need a cross section. The velocity is @@ -197,7 +199,7 @@ contains ! Since only scattering events make it here, again we can use ! the weight entering the collision as the estimator for the ! reaction rate - score = p % last_wgt + score = p % last_wgt * flux else ! Note SCORE_SCATTER_N not available for tracklength/collision. @@ -220,7 +222,7 @@ contains ! Since only scattering events make it here, again we can use ! the weight entering the collision as the estimator for the ! reaction rate - score = p % last_wgt + score = p % last_wgt * flux case (SCORE_SCATTER_YN) @@ -233,7 +235,7 @@ contains ! Since only scattering events make it here, again we can use ! the weight entering the collision as the estimator for the ! reaction rate - score = p % last_wgt + score = p % last_wgt * flux case (SCORE_NU_SCATTER, SCORE_NU_SCATTER_N) @@ -247,7 +249,7 @@ contains (p % event_MT >= N_N1 .and. p % event_MT <= N_NC)) then ! Don't waste time on very common reactions we know have multiplicities ! of one. - score = p % last_wgt + score = p % last_wgt * flux else m = nuclides(p%event_nuclide)%reaction_index% & get_key(p % event_MT) @@ -257,11 +259,11 @@ contains select type (yield => rxn % products(1) % yield) type is (Constant1D) ! Grab the yield from the reaction - score = p % last_wgt * yield % y + score = p % last_wgt * yield % y * flux class default ! the yield was already incorporated in to p % wgt per the ! scattering routine - score = p % wgt + score = p % wgt * flux end select end associate end if @@ -281,7 +283,7 @@ contains (p % event_MT >= N_N1 .and. p % event_MT <= N_NC)) then ! Don't waste time on very common reactions we know have multiplicities ! of one. - score = p % last_wgt + score = p % last_wgt * flux else m = nuclides(p%event_nuclide)%reaction_index% & get_key(p % event_MT) @@ -291,11 +293,11 @@ contains select type (yield => rxn % products(1) % yield) type is (Constant1D) ! Grab the yield from the reaction - score = p % last_wgt * yield % y + score = p % last_wgt * yield % y * flux class default ! the yield was already incorporated in to p % wgt per the ! scattering routine - score = p % wgt + score = p % wgt * flux end select end associate end if @@ -315,7 +317,7 @@ contains (p % event_MT >= N_N1 .and. p % event_MT <= N_NC)) then ! Don't waste time on very common reactions we know have multiplicities ! of one. - score = p % last_wgt + score = p % last_wgt * flux else m = nuclides(p%event_nuclide)%reaction_index% & get_key(p % event_MT) @@ -325,11 +327,11 @@ contains select type (yield => rxn % products(1) % yield) type is (Constant1D) ! Grab the yield from the reaction - score = p % last_wgt * yield % y + score = p % last_wgt * yield % y * flux class default ! the yield was already incorporated in to p % wgt per the ! scattering routine - score = p % wgt + score = p % wgt * flux end select end associate end if @@ -340,13 +342,13 @@ contains if (survival_biasing) then ! No absorption events actually occur if survival biasing is on -- ! just use weight absorbed in survival biasing - score = p % absorb_wgt + score = p % absorb_wgt * flux else ! Skip any event where the particle wasn't absorbed if (p % event == EVENT_SCATTER) cycle SCORE_LOOP ! All fission and absorption events will contribute here, so we ! can just use the particle's weight entering the collision - score = p % last_wgt + score = p % last_wgt * flux end if else @@ -366,7 +368,7 @@ contains ! fission if (micro_xs(p % event_nuclide) % absorption > ZERO) then score = p % absorb_wgt * micro_xs(p % event_nuclide) % fission & - / micro_xs(p % event_nuclide) % absorption + / micro_xs(p % event_nuclide) % absorption * flux else score = ZERO end if @@ -377,7 +379,7 @@ contains ! particle's weight entering the collision as the estimate for the ! fission reaction rate score = p % last_wgt * micro_xs(p % event_nuclide) % fission & - / micro_xs(p % event_nuclide) % absorption + / micro_xs(p % event_nuclide) % absorption * flux end if else @@ -408,7 +410,7 @@ contains ! nu-fission if (micro_xs(p % event_nuclide) % absorption > ZERO) then score = p % absorb_wgt * micro_xs(p % event_nuclide) % & - nu_fission / micro_xs(p % event_nuclide) % absorption + nu_fission / micro_xs(p % event_nuclide) % absorption * flux else score = ZERO end if @@ -420,7 +422,7 @@ contains ! score the number of particles that were banked in the fission ! bank. Since this was weighted by 1/keff, we multiply by keff ! to get the proper score. - score = keff * p % wgt_bank + score = keff * p % wgt_bank * flux end if else @@ -640,7 +642,7 @@ contains score = p%absorb_wgt * & nuc%reactions(nuc%index_fission(1))%Q_value * & micro_xs(p%event_nuclide)%fission / & - micro_xs(p%event_nuclide)%absorption + micro_xs(p%event_nuclide)%absorption * flux end if end associate else @@ -654,7 +656,7 @@ contains score = p%last_wgt * & nuc%reactions(nuc%index_fission(1))%Q_value * & micro_xs(p%event_nuclide)%fission / & - micro_xs(p%event_nuclide)%absorption + micro_xs(p%event_nuclide)%absorption * flux end if end associate end if @@ -692,7 +694,7 @@ contains if (t % estimator == ESTIMATOR_ANALOG) then ! Check if event MT matches if (p % event_MT /= ELASTIC) cycle SCORE_LOOP - score = p % last_wgt + score = p % last_wgt * flux else if (i_nuclide > 0) then @@ -707,7 +709,7 @@ contains ! Any other score is assumed to be a MT number. Thus, we just need ! to check if it matches the MT number of the event if (p % event_MT /= score_bin) cycle SCORE_LOOP - score = p % last_wgt + score = p % last_wgt * flux else ! Any other cross section has to be calculated on-the-fly. For @@ -863,7 +865,7 @@ contains else score = p % last_wgt end if - score = score / material_xs % total + score = score / material_xs % total * flux else ! For flux, we need no cross section @@ -886,7 +888,7 @@ contains if (i_nuclide > 0) then score = score * atom_density * & nucxs % get_xs('total', p_g, UVW=p_uvw) / & - matxs % get_xs('total', p_g, UVW=p_uvw) + matxs % get_xs('total', p_g, UVW=p_uvw) * flux end if else @@ -912,7 +914,7 @@ contains else score = p % last_wgt end if - score = score * inverse_velocities(p_g) / material_xs % total + score = score * inverse_velocities(p_g) / material_xs % total * flux else ! For inverse velocity, we need no cross section @@ -935,7 +937,7 @@ contains ! Since only scattering events make it here, again we can use ! the weight entering the collision as the estimator for the ! reaction rate - score = p % last_wgt + score = p % last_wgt * flux ! Since we transport based on material data, the angle selected ! was not selected from the f(mu) for the nuclide. Therefore @@ -978,7 +980,7 @@ contains ! For scattering production, we need to use the pre-collision ! weight times the multiplicity as the estimate for the number of ! neutrons exiting a reaction with neutrons in the exit channel - score = p % wgt + score = p % wgt * flux ! Since we transport based on material data, the angle selected ! was not selected from the f(mu) for the nuclide. Therefore @@ -1008,13 +1010,13 @@ contains if (survival_biasing) then ! No absorption events actually occur if survival biasing is on -- ! just use weight absorbed in survival biasing - score = p % absorb_wgt + score = p % absorb_wgt * flux else ! Skip any event where the particle wasn't absorbed if (p % event == EVENT_SCATTER) cycle SCORE_LOOP ! All fission and absorption events will contribute here, so we ! can just use the particle's weight entering the collision - score = p % last_wgt + score = p % last_wgt * flux end if if (i_nuclide > 0) then score = score * atom_density * & @@ -1037,24 +1039,24 @@ contains ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in ! fission - score = p % absorb_wgt + score = p % absorb_wgt * flux else ! Skip any non-absorption events if (p % event == EVENT_SCATTER) cycle SCORE_LOOP ! All fission events will contribute, so again we can use ! particle's weight entering the collision as the estimate for the ! fission reaction rate - score = p % last_wgt + score = p % last_wgt * flux end if if (i_nuclide > 0) then - score = score * atom_density * & - nucxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) - else - score = score * & - matxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) - end if + score = score * atom_density * & + nucxs % get_xs('fission', p_g, UVW=p_uvw) / & + matxs % get_xs('absorption', p_g, UVW=p_uvw) + else + score = score * & + matxs % get_xs('fission', p_g, UVW=p_uvw) / & + matxs % get_xs('absorption', p_g, UVW=p_uvw) + end if else if (i_nuclide > 0) then score = nucxs % get_xs('fission', p_g, UVW=p_uvw) * & @@ -1084,7 +1086,7 @@ contains ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in ! nu-fission - score = p % absorb_wgt + score = p % absorb_wgt * flux if (i_nuclide > 0) then score = score * atom_density * & nucxs % get_xs('nu_fission', p_g, UVW=p_uvw) / & @@ -1102,7 +1104,7 @@ contains ! score the number of particles that were banked in the fission ! bank. Since this was weighted by 1/keff, we multiply by keff ! to get the proper score. - score = keff * p % wgt_bank + score = keff * p % wgt_bank * flux if (i_nuclide > 0) then score = score * atom_density * & nucxs % get_xs('fission', p_g, UVW=p_uvw) / & @@ -1126,14 +1128,14 @@ contains ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in ! fission - score = p % absorb_wgt + score = p % absorb_wgt * flux else ! Skip any non-absorption events if (p % event == EVENT_SCATTER) cycle SCORE_LOOP ! All fission events will contribute, so again we can use ! particle's weight entering the collision as the estimate for the ! fission reaction rate - score = p % last_wgt + score = p % last_wgt * flux end if if (i_nuclide > 0) then score = score * atom_density * & @@ -1354,7 +1356,7 @@ contains ! position during the loop integer :: filter_index ! single index for single bin integer :: i_nuclide ! index in nuclides array - real(8) :: filter_weight + real(8) :: filter_weight ! combined weight of all filters type(TallyObject), pointer :: t ! A loop over all tallies is necessary because we need to simultaneously @@ -1378,7 +1380,6 @@ contains ! ======================================================================== ! Loop until we've covered all valid bins on each of the filters. - filter_weight = ONE FILTER_LOOP: do ! Determine scoring index and weight for this filter combination @@ -1427,7 +1428,7 @@ contains ! Determine score for each bin call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & - i_nuclide, ZERO, ZERO) + i_nuclide, ZERO, filter_weight) end do NUCLIDE_LOOP @@ -1489,7 +1490,7 @@ contains ! position during the loop integer :: filter_index ! single index for single bin integer :: i_nuclide ! index in nuclides array - real(8) :: filter_weight + real(8) :: filter_weight ! combined weight of all filters real(8) :: atom_density type(TallyObject), pointer :: t type(Material), pointer :: mat @@ -1519,7 +1520,6 @@ contains ! ======================================================================== ! Loop until we've covered all valid bins on each of the filters. - filter_weight = ONE FILTER_LOOP: do ! Determine scoring index and weight for this filter combination @@ -1549,7 +1549,7 @@ contains ! Determine score for each bin call score_general(p, t, (k-1)*t % n_score_bins, filter_index, & - i_nuclide, atom_density, ZERO) + i_nuclide, atom_density, filter_weight) end do NUCLIDE_LOOP @@ -1617,6 +1617,7 @@ contains integer :: k ! loop index for bank sites integer :: bin_energyout ! original outgoing energy bin integer :: i_filter ! index for matching filter bin combination + real(8) :: filter_weight ! combined weight of all filters real(8) :: score ! actual score real(8) :: E_out ! energy of fission bank site @@ -1650,13 +1651,14 @@ contains ! change outgoing energy bin matching_bins(i) = binary_search(filt % bins, n, E_out) - ! determine scoring index + ! determine scoring index and weight for this filter combination i_filter = sum((matching_bins(1:size(t%filters)) - 1) * t % stride) + 1 + filter_weight = product(filter_weights(:size(t % filters))) ! Add score to tally !$omp atomic t % results(i_score, i_filter) % value = & - t % results(i_score, i_filter) % value + score + t % results(i_score, i_filter) % value + score * filter_weight end do end select @@ -1677,6 +1679,7 @@ contains integer :: k ! loop index for bank sites integer :: bin_energyout ! original outgoing energy bin integer :: i_filter ! index for matching filter bin combination + real(8) :: filter_weight ! combined weight of all filters real(8) :: score ! actual score integer :: gout ! energy group of fission bank site integer :: gin ! energy group of incident particle @@ -1732,13 +1735,14 @@ contains matching_bins(i) = binary_search(filt % bins, n, E_out) end if - ! determine scoring index + ! determine scoring index and weight for this filter combination i_filter = sum((matching_bins(1:size(t%filters)) - 1) * t % stride) + 1 + filter_weight = product(filter_weights(:size(t % filters))) ! Add score to tally !$omp atomic t % results(i_score, i_filter) % value = & - t % results(i_score, i_filter) % value + score + t % results(i_score, i_filter) % value + score * filter_weight end do ! reset outgoing energy bin and score index @@ -1769,6 +1773,7 @@ contains integer :: k ! loop index for bank sites integer :: bin_energyout ! original outgoing energy bin integer :: i_filter ! index for matching filter bin combination + real(8) :: filter_weight ! combined weight of all filters real(8) :: score ! actual score real(8) :: E_out ! energy of fission bank site @@ -1835,14 +1840,15 @@ contains ! if the delayed group filter is not present, add score to tally else - ! determine scoring index + ! determine scoring index and weight for this filter combination i_filter = sum((matching_bins(1:size(t%filters)) - 1) * t % stride)& + 1 + filter_weight = product(filter_weights(:size(t % filters))) ! Add score to tally !$omp atomic t % results(i_score, i_filter) % value = & - t % results(i_score, i_filter) % value + score + t % results(i_score, i_filter) % value + score * filter_weight end if end if end do @@ -1861,24 +1867,26 @@ contains subroutine score_fission_delayed_dg(t, d_bin, score, score_index) type(TallyObject), intent(inout) :: t - integer, intent(in) :: score_index ! index for score - real(8), intent(in) :: score ! actual score integer, intent(in) :: d_bin ! delayed group bin index + real(8), intent(in) :: score ! actual score + integer, intent(in) :: score_index ! index for score integer :: bin_original ! original bin index integer :: filter_index ! index for matching filter bin combination + real(8) :: filter_weight ! combined weight of all filters ! save original delayed group bin bin_original = matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = d_bin - ! Compute the filter index based on the modified matching_bins - filter_index = sum((matching_bins(1:size(t % filters)) - 1) & - * t % stride) + 1 + ! determine scoring index and weight on the modified matching_bins + filter_index = sum((matching_bins(1:size(t % filters)) - 1) * t % stride) & + + 1 + filter_weight = product(filter_weights(:size(t % filters))) !$omp atomic t % results(score_index, filter_index) % value = & - t % results(score_index, filter_index) % value + score + t % results(score_index, filter_index) % value + score * filter_weight ! reset original delayed group bin matching_bins(t % find_filter(FILTER_DELAYEDGROUP)) = bin_original @@ -1906,7 +1914,7 @@ contains integer :: i_nuclide ! index in nuclides array (from bins) real(8) :: flux ! tracklength estimate of flux real(8) :: atom_density ! atom density of single nuclide in atom/b-cm - real(8) :: filter_weight + real(8) :: filter_weight ! combined weight of all filters type(TallyObject), pointer :: t type(Material), pointer :: mat @@ -1934,7 +1942,6 @@ contains ! ======================================================================== ! Loop until we've covered all valid bins on each of the filters. - filter_weight = ONE FILTER_LOOP: do ! Determine scoring index and weight for this filter combination @@ -2056,7 +2063,7 @@ contains real(8) :: flux ! collision estimate of flux real(8) :: atom_density ! atom density of single nuclide ! in atom/b-cm - real(8) :: filter_weight + real(8) :: filter_weight ! combined weight of all filters type(TallyObject), pointer :: t type(Material), pointer :: mat @@ -2089,7 +2096,6 @@ contains ! ======================================================================== ! Loop until we've covered all valid bins on each of the filters. - filter_weight = ONE FILTER_LOOP: do ! Determine scoring index and weight for this filter combination From 43bca87b04f6c14e4f8a7acf67c6258a0f7d698d Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Mon, 25 Jul 2016 11:50:56 -0500 Subject: [PATCH 19/23] Reimplement tally filter maps --- src/tally_filter.F90 | 107 ++++++++++++++++++++++++++----------------- 1 file changed, 65 insertions(+), 42 deletions(-) diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index eeb720fd2..8496bd99a 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -1,6 +1,7 @@ module tally_filter use constants, only: ONE, NO_BIN_FOUND, FP_PRECISION + use dict_header, only: DictIntInt use geometry_header, only: BASE_UNIVERSE, RectLattice, HexLattice use global use hdf5_interface @@ -35,6 +36,7 @@ module tally_filter !=============================================================================== type, extends(TallyFilter) :: UniverseFilter integer, allocatable :: universes(:) + type(DictIntInt) :: map contains procedure :: get_next_bin => get_next_bin_universe procedure :: to_statepoint => to_statepoint_universe @@ -47,6 +49,7 @@ module tally_filter !=============================================================================== type, extends(TallyFilter) :: MaterialFilter integer, allocatable :: materials(:) + type(DictIntInt) :: map contains procedure :: get_next_bin => get_next_bin_material procedure :: to_statepoint => to_statepoint_material @@ -59,6 +62,7 @@ module tally_filter !=============================================================================== type, extends(TallyFilter) :: CellFilter integer, allocatable :: cells(:) + type(DictIntInt) :: map contains procedure :: get_next_bin => get_next_bin_cell procedure :: to_statepoint => to_statepoint_cell @@ -85,6 +89,7 @@ module tally_filter !=============================================================================== type, extends(TallyFilter) :: CellbornFilter integer, allocatable :: cells(:) + type(DictIntInt) :: map contains procedure :: get_next_bin => get_next_bin_cellborn procedure :: to_statepoint => to_statepoint_cellborn @@ -437,25 +442,29 @@ contains integer, intent(out) :: next_bin real(8), intent(out) :: weight - integer :: i, j, start + integer :: i, start logical :: bin_found + ! Find the coordinate level of the last bin we found. if (current_bin == NO_BIN_FOUND) then start = 1 else - start = current_bin + 1 - end if - - bin_found = .false. - do i = start, this % n_bins - do j = 1, p % n_coord - if (p % coord(j) % universe == this % universes(i)) then - next_bin = i - bin_found = .true. + do i = 1, p % n_coord + if (p % coord(i) % universe == this % universes(current_bin)) then + start = i + 1 exit end if end do - if (bin_found) exit + end if + + ! Starting one coordinate level deeper, find the next bin. + bin_found = .false. + do i = start, p % n_coord + if (this % map % has_key(p % coord(i) % universe)) then + next_bin = this % map % get_key(p % coord(i) % universe) + bin_found = .true. + exit + end if end do if (.not. bin_found) next_bin = NO_BIN_FOUND @@ -486,6 +495,11 @@ contains &// " specified on a tally filter.") end if end do + + ! Generate mapping from universe indices to filter bins. + do i = 1, this % n_bins + call this % map % add_key(this % universes(i), i) + end do end subroutine initialize_universe function text_label_universe(this, bin) result(label) @@ -509,18 +523,13 @@ contains real(8), intent(out) :: weight integer :: i - logical :: bin_found if (current_bin == NO_BIN_FOUND) then - bin_found = .false. - do i = 1, this % n_bins - if (p % material == this % materials(i)) then - next_bin = i - bin_found = .true. - exit - end if - end do - if (.not. bin_found) next_bin = NO_BIN_FOUND + if (this % map % has_key(p % material)) then + next_bin = this % map % get_key(p % material) + else + next_bin = NO_BIN_FOUND + end if else next_bin = NO_BIN_FOUND end if @@ -551,6 +560,11 @@ contains &// " specified on a tally filter.") end if end do + + ! Generate mapping from material indices to filter bins. + do i = 1, this % n_bins + call this % map % add_key(this % materials(i), i) + end do end subroutine initialize_material function text_label_material(this, bin) result(label) @@ -573,25 +587,29 @@ contains integer, intent(out) :: next_bin real(8), intent(out) :: weight - integer :: i, j, start + integer :: i, start logical :: bin_found + ! Find the coordinate level of the last bin we found. if (current_bin == NO_BIN_FOUND) then start = 1 else - start = current_bin + 1 - end if - - bin_found = .false. - do i = start, this % n_bins - do j = 1, p % n_coord - if (p % coord(j) % cell == this % cells(i)) then - next_bin = i - bin_found = .true. + do i = 1, p % n_coord + if (p % coord(i) % cell == this % cells(current_bin)) then + start = i + 1 exit end if end do - if (bin_found) exit + end if + + ! Starting one coordinate level deeper, find the next bin. + bin_found = .false. + do i = start, p % n_coord + if (this % map % has_key(p % coord(i) % cell)) then + next_bin = this % map % get_key(p % coord(i) % cell) + bin_found = .true. + exit + end if end do if (.not. bin_found) next_bin = NO_BIN_FOUND @@ -622,6 +640,11 @@ contains &// " specified on tally filter.") end if end do + + ! Generate mapping from cell indices to filter bins. + do i = 1, this % n_bins + call this % map % add_key(this % cells(i), i) + end do end subroutine initialize_cell function text_label_cell(this, bin) result(label) @@ -763,18 +786,13 @@ contains real(8), intent(out) :: weight integer :: i - logical :: bin_found if (current_bin == NO_BIN_FOUND) then - bin_found = .false. - do i = 1, this % n_bins - if (p % cell_born == this % cells(i)) then - next_bin = i - bin_found = .true. - exit - end if - end do - if (.not. bin_found) next_bin = NO_BIN_FOUND + if (this % map % has_key(p % cell_born)) then + next_bin = this % map % get_key(p % cell_born) + else + next_bin = NO_BIN_FOUND + end if else next_bin = NO_BIN_FOUND end if @@ -805,6 +823,11 @@ contains &// " specified on tally filter.") end if end do + + ! Generate mapping from cell indices to filter bins. + do i = 1, this % n_bins + call this % map % add_key(this % cells(i), i) + end do end subroutine initialize_cellborn function text_label_cellborn(this, bin) result(label) From 2a607bea9dacc0f1fff9e3e85a6cd3b5b2718fec Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Thu, 28 Jul 2016 17:06:35 -0500 Subject: [PATCH 20/23] Address #678 comments --- src/initialize.F90 | 2 +- src/mesh.F90 | 20 ++++++++++---------- src/tally_filter_header.F90 | 14 +++++++------- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/initialize.F90 b/src/initialize.F90 index 8814f11e3..99adf967f 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -717,7 +717,7 @@ contains select type(filt => t % filters(j) % obj) type is (SurfaceFilter) ! Check if this is a surface filter only for surface currents - if (.not. any(t%score_bins == SCORE_CURRENT)) & + if (.not. any(t % score_bins == SCORE_CURRENT)) & call filt % initialize() class default call filt % initialize() diff --git a/src/mesh.F90 b/src/mesh.F90 index 333062d78..0b227f4f5 100644 --- a/src/mesh.F90 +++ b/src/mesh.F90 @@ -290,7 +290,7 @@ contains ! Check if line intersects left surface -- calculate the intersection point ! y - if ( (x0 < xm0 .and. x1 > xm0) .or. (x0 > xm0 .and. x1 < xm0) ) then + if ((x0 < xm0 .and. x1 > xm0) .or. (x0 > xm0 .and. x1 < xm0)) then yi = y0 + (xm0 - x0) * (y1 - y0) / (x1 - x0) if (yi >= ym0 .and. yi < ym1) then intersects = .true. @@ -300,7 +300,7 @@ contains ! Check if line intersects back surface -- calculate the intersection point ! x - if ( (y0 < ym0 .and. y1 > ym0) .or. (y0 > ym0 .and. y1 < ym0) ) then + if ((y0 < ym0 .and. y1 > ym0) .or. (y0 > ym0 .and. y1 < ym0)) then xi = x0 + (ym0 - y0) * (x1 - x0) / (y1 - y0) if (xi >= xm0 .and. xi < xm1) then intersects = .true. @@ -310,7 +310,7 @@ contains ! Check if line intersects right surface -- calculate the intersection ! point y - if ( (x0 < xm1 .and. x1 > xm1) .or. (x0 > xm1 .and. x1 < xm1) ) then + if ((x0 < xm1 .and. x1 > xm1) .or. (x0 > xm1 .and. x1 < xm1)) then yi = y0 + (xm1 - x0) * (y1 - y0) / (x1 - x0) if (yi >= ym0 .and. yi < ym1) then intersects = .true. @@ -320,7 +320,7 @@ contains ! Check if line intersects front surface -- calculate the intersection point ! x - if ( (y0 < ym1 .and. y1 > ym1) .or. (y0 > ym1 .and. y1 < ym1) ) then + if ((y0 < ym1 .and. y1 > ym1) .or. (y0 > ym1 .and. y1 < ym1)) then xi = x0 + (ym1 - y0) * (x1 - x0) / (y1 - y0) if (xi >= xm0 .and. xi < xm1) then intersects = .true. @@ -367,7 +367,7 @@ contains ! Check if line intersects left surface -- calculate the intersection point ! (y,z) - if ( (x0 < xm0 .and. x1 > xm0) .or. (x0 > xm0 .and. x1 < xm0) ) then + if ((x0 < xm0 .and. x1 > xm0) .or. (x0 > xm0 .and. x1 < xm0)) then yi = y0 + (xm0 - x0) * (y1 - y0) / (x1 - x0) zi = z0 + (xm0 - x0) * (z1 - z0) / (x1 - x0) if (yi >= ym0 .and. yi < ym1 .and. zi >= zm0 .and. zi < zm1) then @@ -378,7 +378,7 @@ contains ! Check if line intersects back surface -- calculate the intersection point ! (x,z) - if ( (y0 < ym0 .and. y1 > ym0) .or. (y0 > ym0 .and. y1 < ym0) ) then + if ((y0 < ym0 .and. y1 > ym0) .or. (y0 > ym0 .and. y1 < ym0)) then xi = x0 + (ym0 - y0) * (x1 - x0) / (y1 - y0) zi = z0 + (ym0 - y0) * (z1 - z0) / (y1 - y0) if (xi >= xm0 .and. xi < xm1 .and. zi >= zm0 .and. zi < zm1) then @@ -389,7 +389,7 @@ contains ! Check if line intersects bottom surface -- calculate the intersection ! point (x,y) - if ( (z0 < zm0 .and. z1 > zm0) .or. (z0 > zm0 .and. z1 < zm0) ) then + if ((z0 < zm0 .and. z1 > zm0) .or. (z0 > zm0 .and. z1 < zm0)) then xi = x0 + (zm0 - z0) * (x1 - x0) / (z1 - z0) yi = y0 + (zm0 - z0) * (y1 - y0) / (z1 - z0) if (xi >= xm0 .and. xi < xm1 .and. yi >= ym0 .and. yi < ym1) then @@ -400,7 +400,7 @@ contains ! Check if line intersects right surface -- calculate the intersection point ! (y,z) - if ( (x0 < xm1 .and. x1 > xm1) .or. (x0 > xm1 .and. x1 < xm1) ) then + if ((x0 < xm1 .and. x1 > xm1) .or. (x0 > xm1 .and. x1 < xm1)) then yi = y0 + (xm1 - x0) * (y1 - y0) / (x1 - x0) zi = z0 + (xm1 - x0) * (z1 - z0) / (x1 - x0) if (yi >= ym0 .and. yi < ym1 .and. zi >= zm0 .and. zi < zm1) then @@ -411,7 +411,7 @@ contains ! Check if line intersects front surface -- calculate the intersection point ! (x,z) - if ( (y0 < ym1 .and. y1 > ym1) .or. (y0 > ym1 .and. y1 < ym1) ) then + if ((y0 < ym1 .and. y1 > ym1) .or. (y0 > ym1 .and. y1 < ym1)) then xi = x0 + (ym1 - y0) * (x1 - x0) / (y1 - y0) zi = z0 + (ym1 - y0) * (z1 - z0) / (y1 - y0) if (xi >= xm0 .and. xi < xm1 .and. zi >= zm0 .and. zi < zm1) then @@ -422,7 +422,7 @@ contains ! Check if line intersects top surface -- calculate the intersection point ! (x,y) - if ( (z0 < zm1 .and. z1 > zm1) .or. (z0 > zm1 .and. z1 < zm1) ) then + if ((z0 < zm1 .and. z1 > zm1) .or. (z0 > zm1 .and. z1 < zm1)) then xi = x0 + (zm1 - z0) * (x1 - x0) / (z1 - z0) yi = y0 + (zm1 - z0) * (y1 - y0) / (z1 - z0) if (xi >= xm0 .and. xi < xm1 .and. yi >= ym0 .and. yi < ym1) then diff --git a/src/tally_filter_header.F90 b/src/tally_filter_header.F90 index 5b5e278e3..d469311e6 100644 --- a/src/tally_filter_header.F90 +++ b/src/tally_filter_header.F90 @@ -18,9 +18,9 @@ module tally_filter_header contains procedure(get_next_bin_), deferred :: get_next_bin procedure(to_statepoint_), deferred :: to_statepoint - procedure :: to_summary => to_summary_ + procedure :: to_summary => filter_to_summary procedure(text_label_), deferred :: text_label - procedure :: initialize => initialize_ + procedure :: initialize => filter_initialize end type TallyFilter abstract interface @@ -46,7 +46,7 @@ module tally_filter_header end subroutine get_next_bin_ !=============================================================================== -! TO_STATPEOINT writes all the information needed to reconstruct the filter to +! TO_STATEPOINT writes all the information needed to reconstruct the filter to ! the given filter_group. subroutine to_statepoint_(this, filter_group) @@ -87,19 +87,19 @@ contains ! given filter_group. If this procedure is not overridden by the derived class, ! then it will call to_statepoint by default. - subroutine to_summary_(this, filter_group) + subroutine filter_to_summary(this, filter_group) class(TallyFilter), intent(in) :: this integer(HID_T), intent(in) :: filter_group call this % to_statepoint(filter_group) - end subroutine to_summary_ + end subroutine filter_to_summary !=============================================================================== ! INITIALIZE sets up any internal data, as necessary. If this procedure is not ! overriden by the derived class, then it will do nothing by default. - subroutine initialize_(this) + subroutine filter_initialize(this) class(TallyFilter), intent(inout) :: this - end subroutine initialize_ + end subroutine filter_initialize end module tally_filter_header From 8062256fb3a678d42338f12cf19102ef981c0a69 Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Fri, 29 Jul 2016 16:40:30 -0500 Subject: [PATCH 21/23] Shorten filter % get_next_bin logic --- src/tally_filter.F90 | 55 ++++++++++++------------------------- src/tally_filter_header.F90 | 2 +- 2 files changed, 19 insertions(+), 38 deletions(-) diff --git a/src/tally_filter.F90 b/src/tally_filter.F90 index ee1810e6c..c0e1c8853 100644 --- a/src/tally_filter.F90 +++ b/src/tally_filter.F90 @@ -206,7 +206,7 @@ contains class(MeshFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight @@ -438,12 +438,11 @@ contains class(UniverseFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight integer :: i, start - logical :: bin_found ! Find the coordinate level of the last bin we found. if (current_bin == NO_BIN_FOUND) then @@ -458,16 +457,13 @@ contains end if ! Starting one coordinate level deeper, find the next bin. - bin_found = .false. + next_bin = NO_BIN_FOUND do i = start, p % n_coord if (this % map % has_key(p % coord(i) % universe)) then next_bin = this % map % get_key(p % coord(i) % universe) - bin_found = .true. exit end if end do - - if (.not. bin_found) next_bin = NO_BIN_FOUND weight = ONE end subroutine get_next_bin_universe @@ -518,18 +514,15 @@ contains class(MaterialFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight + next_bin = NO_BIN_FOUND if (current_bin == NO_BIN_FOUND) then if (this % map % has_key(p % material)) then next_bin = this % map % get_key(p % material) - else - next_bin = NO_BIN_FOUND end if - else - next_bin = NO_BIN_FOUND end if weight = ONE end subroutine get_next_bin_material @@ -581,12 +574,11 @@ contains class(CellFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight integer :: i, start - logical :: bin_found ! Find the coordinate level of the last bin we found. if (current_bin == NO_BIN_FOUND) then @@ -601,16 +593,13 @@ contains end if ! Starting one coordinate level deeper, find the next bin. - bin_found = .false. + next_bin = NO_BIN_FOUND do i = start, p % n_coord if (this % map % has_key(p % coord(i) % cell)) then next_bin = this % map % get_key(p % coord(i) % cell) - bin_found = .true. exit end if end do - - if (.not. bin_found) next_bin = NO_BIN_FOUND weight = ONE end subroutine get_next_bin_cell @@ -661,7 +650,7 @@ contains class(DistribcellFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight @@ -779,18 +768,15 @@ contains class(CellbornFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight + next_bin = NO_BIN_FOUND if (current_bin == NO_BIN_FOUND) then if (this % map % has_key(p % cell_born)) then next_bin = this % map % get_key(p % cell_born) - else - next_bin = NO_BIN_FOUND end if - else - next_bin = NO_BIN_FOUND end if weight = ONE end subroutine get_next_bin_cellborn @@ -842,25 +828,20 @@ contains class(SurfaceFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight integer :: i - logical :: bin_found + next_bin = NO_BIN_FOUND if (current_bin == NO_BIN_FOUND) then - bin_found = .false. do i = 1, this % n_bins if (p % surface == this % surfaces(i)) then next_bin = i - bin_found = .true. exit end if end do - if (.not. bin_found) next_bin = NO_BIN_FOUND - else - next_bin = NO_BIN_FOUND end if weight = ONE end subroutine get_next_bin_surface @@ -907,7 +888,7 @@ contains class(EnergyFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight @@ -981,7 +962,7 @@ contains class(EnergyoutFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight @@ -1042,7 +1023,7 @@ contains class(DelayedGroupFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight @@ -1078,7 +1059,7 @@ contains class(MuFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight @@ -1131,7 +1112,7 @@ contains class(PolarFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight @@ -1192,7 +1173,7 @@ contains class(AzimuthalFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight diff --git a/src/tally_filter_header.F90 b/src/tally_filter_header.F90 index d469311e6..43ef846e3 100644 --- a/src/tally_filter_header.F90 +++ b/src/tally_filter_header.F90 @@ -40,7 +40,7 @@ module tally_filter_header class(TallyFilter), intent(in) :: this type(Particle), intent(in) :: p integer, intent(in) :: estimator - integer, intent(in) :: current_bin + integer, value, intent(in) :: current_bin integer, intent(out) :: next_bin real(8), intent(out) :: weight end subroutine get_next_bin_ From a324262bac6a35267810a1170aee33a9f195ca7f Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Mon, 1 Aug 2016 13:53:03 -0500 Subject: [PATCH 22/23] Fix unassigned energy in SCORE_PROMPT_NU_FISSION --- src/tally.F90 | 6 ++++++ tests/test_mgxs_library_mesh/results_true.dat | 8 ++++---- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/tally.F90 b/src/tally.F90 index 94143184a..2c7711917 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -482,6 +482,12 @@ contains score = micro_xs(i_nuclide) % fission * nuclides(i_nuclide) % & nu(E, EMISSION_PROMPT) * atom_density * flux else + ! make sure the correct energy is used + if (t % estimator == ESTIMATOR_TRACKLENGTH) then + E = p % E + else + E = p % last_E + end if score = ZERO diff --git a/tests/test_mgxs_library_mesh/results_true.dat b/tests/test_mgxs_library_mesh/results_true.dat index e3d7ca647..03019cfd3 100644 --- a/tests/test_mgxs_library_mesh/results_true.dat +++ b/tests/test_mgxs_library_mesh/results_true.dat @@ -126,7 +126,7 @@ 3 2 2 1 1 total 3.799163e-07 1.806470e-07 mesh 1 group in nuclide mean std. dev. x y z -0 1 1 1 1 total 0.025735 0.002840 -1 1 2 1 1 total 0.028773 0.006349 -2 2 1 1 1 total 0.022306 0.004010 -3 2 2 1 1 total 0.024549 0.009379 +0 1 1 1 1 total 0.025920 0.002893 +1 1 2 1 1 total 0.028922 0.006394 +2 2 1 1 1 total 0.022467 0.004039 +3 2 2 1 1 total 0.024923 0.009632 From 13da37de4bc32471bffbd567cfdc6ff46f40ca0f Mon Sep 17 00:00:00 2001 From: Sterling Harper Date: Tue, 2 Aug 2016 08:37:16 -0500 Subject: [PATCH 23/23] For real fix unassigned energy in SCORE_PROMPT --- src/tally.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/tally.F90 b/src/tally.F90 index 6e406c93a..ec46a6194 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -471,16 +471,17 @@ contains end if else + ! make sure the correct energy is used + if (t % estimator == ESTIMATOR_TRACKLENGTH) then + E = p % E + else + E = p % last_E + end if + if (i_nuclide > 0) then score = micro_xs(i_nuclide) % fission * nuclides(i_nuclide) % & nu(E, EMISSION_PROMPT) * atom_density * flux else - ! make sure the correct energy is used - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - E = p % E - else - E = p % last_E - end if score = ZERO