diff --git a/src/geometry.F90 b/src/geometry.F90 index 19289f9a45..f386dcf008 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -194,6 +194,7 @@ contains integer, optional :: search_cells(:) integer :: i ! index over cells integer :: j ! coordinate level index + integer :: k ! distribcell instance integer :: i_xyz(3) ! indices in lattice integer :: n ! number of cells to search integer :: index_cell ! index in cells array @@ -246,9 +247,32 @@ contains ! ====================================================================== ! AT LOWEST UNIVERSE, TERMINATE SEARCH - ! set material + ! Set the particle material p % last_material = p % material - p % material = c % material(1) +! if (size(c % material) == 1) then + ! Only one material for this cell; assign that one to the particle. + p % material = c % material(1) +! else +! ! Distributed instances of this cell have different materials. +! ! Determine which instance this is and assign the matching material. +! offset = 0 +! do k = 1, p % n_coord +! if (cells(p % coord(k) % cell) % type == CELL_FILL) then +! offset = offset + cells(p % coord(k) % cell) % & +! offset(t % filters(i) % offset) +! elseif(cells(p % coord(k) % cell) % type == CELL_LATTICE) then +! if (lattices(p % coord(k + 1) % lattice) % obj & +! % are_valid_indices([& +! p % coord(k + 1) % lattice_x, & +! p % coord(k + 1) % lattice_y, & +! p % coord(k + 1) % lattice_z])) then +! offset = offset + lattices(p % coord(k + 1) % lattice) % obj % & +! offset(t % filters(i) % offset, & +! p % coord(k + 1) % lattice_x, & +! p % coord(k + 1) % lattice_y, & +! p % coord(k + 1) % lattice_z) +! end if +! end if elseif (c % type == CELL_FILL) then CELL_TYPE ! ====================================================================== diff --git a/src/initialize.F90 b/src/initialize.F90 index 802f890aa9..f28959618f 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -614,31 +614,33 @@ contains ! ======================================================================= ! ADJUST MATERIAL/FILL POINTERS FOR EACH CELL - id = c%material(1) - if (id == MATERIAL_VOID) then - c%type = CELL_NORMAL - elseif (id /= 0) then - if (material_dict%has_key(id)) then - c%type = CELL_NORMAL - c%material(1) = material_dict%get_key(id) - else - call fatal_error("Could not find material " // trim(to_str(id)) & - &// " specified on cell " // trim(to_str(c%id))) - end if - else - id = c%fill - if (universe_dict%has_key(id)) then - c%type = CELL_FILL - c%fill = universe_dict%get_key(id) - elseif (lattice_dict%has_key(id)) then - lid = lattice_dict%get_key(id) - c%type = CELL_LATTICE - c%fill = lid + if (c % material(1) == NONE) then + id = c % fill + if (universe_dict % has_key(id)) then + c % type = CELL_FILL + c % fill = universe_dict % get_key(id) + elseif (lattice_dict % has_key(id)) then + lid = lattice_dict % get_key(id) + c % type = CELL_LATTICE + c % fill = lid else call fatal_error("Specified fill " // trim(to_str(id)) // " on cell "& - &// trim(to_str(c%id)) // " is neither a universe nor a & + &// trim(to_str(c % id)) // " is neither a universe nor a & &lattice.") end if + else + do j = 1, size(c % material) + id = c % material(j) + if (id == MATERIAL_VOID) then + c % type = CELL_NORMAL + else if (material_dict % has_key(id)) then + c % type = CELL_NORMAL + c % material(j) = material_dict % get_key(id) + else + call fatal_error("Could not find material " // trim(to_str(id)) & + &// " specified on cell " // trim(to_str(c % id))) + end if + end do end if end do @@ -1042,11 +1044,12 @@ contains class(Lattice), pointer :: lat ! pointer to lattice type(TallyObject), pointer :: t ! pointer to tally type(TallyFilter), pointer :: filter ! pointer to filter + type(Cell), pointer :: c ! pointer to cell ! Begin gathering list of cells in distribcell tallies n_maps = 0 - ! Populate list of distribcells to track + ! List all cells referenced in distribcell filters. do i = 1, n_tallies t => tallies(i) @@ -1062,6 +1065,14 @@ contains end do end do + ! List all cells with multiple (distributed) materials. + do i = 1, n_cells + c => cells(i) + if (size(c % material) > 1) then + if (.not. cell_list % contains(i)) call cell_list % add(i) + end if + end do + ! Compute the number of unique universes containing these distribcells ! to determine the number of offset tables to allocate do i = 1, n_universes @@ -1076,7 +1087,7 @@ contains ! Allocate the list of offset tables for each unique universe allocate(univ_list(n_maps)) - ! Allocate list to accumulate target distribccell counts in each universe + ! Allocate list to accumulate target distribcell counts in each universe allocate(counts(n_universes, n_maps)) ! Allocate list to track if target distribcells are found in each universe diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 016b811ac4..24b36f3fb8 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -982,8 +982,7 @@ contains subroutine read_geometry_xml() integer :: i, j, k, m, i_x, i_a, input_index - integer :: n - integer :: n_x, n_y, n_z, n_rings, n_rlats, n_hlats + integer :: n, n_mats, n_x, n_y, n_z, n_rings, n_rlats, n_hlats integer :: universe_num integer :: n_cells_in_univ integer :: coeffs_reqd @@ -994,6 +993,7 @@ contains logical :: boundary_exists character(MAX_LINE_LEN) :: filename character(MAX_WORD_LEN) :: word + character(MAX_WORD_LEN), allocatable :: sarray(:) character(1000) :: region_spec type(Cell), pointer :: c class(Surface), pointer :: s @@ -1085,27 +1085,40 @@ contains end if ! Read material - allocate(c % material(1)) - word = '' - if (check_for_node(node_cell, "material")) & - call get_node_value(node_cell, "material", word) - select case(to_lower(word)) - case ('void') - c % material(1) = MATERIAL_VOID + if (check_for_node(node_cell, "material")) then + n_mats = get_arraysize_string(node_cell, "material") - case ('') - ! This case is called if no material was specified - c % material(1) = NONE + if (n_mats > 0) then + allocate(sarray(n_mats)) + call get_node_array(node_cell, "material", sarray) - case default - c % material(1) = int(str_to_int(word), 4) + allocate(c % material(n_mats)) + do j = 1, n_mats + select case(trim(to_lower(sarray(j)))) + case ('void') + c % material(j) = MATERIAL_VOID + case default + c % material(j) = int(str_to_int(sarray(j)), 4) - ! Check for error - if (c % material(1) == ERROR_INT) then - call fatal_error("Invalid material specified on cell " & - &// to_str(c % id)) + ! Check for error + if (c % material(j) == ERROR_INT) then + call fatal_error("Invalid material specified on cell " & + &// to_str(c % id)) + end if + end select + end do + + deallocate(sarray) + + else + allocate(c % material(1)) + c % material(1) = NONE end if - end select + + else + allocate(c % material(1)) + c % material(1) = NONE + end if ! Check to make sure that either material or fill was specified if (c % material(1) == NONE .and. c % fill == NONE) then