From d6ea51556265e712758e056072416122ad059e97 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 13 Sep 2011 21:48:22 -0400 Subject: [PATCH] Got rid of current cell, surface, lattice, universe, and material pointers. --- src/geometry.f90 | 48 +++++++++++++++++++----------------------------- src/global.f90 | 7 ------- src/score.f90 | 17 +++++++++++------ 3 files changed, 30 insertions(+), 42 deletions(-) diff --git a/src/geometry.f90 b/src/geometry.f90 index cfd9585a56..5ccb8e5747 100644 --- a/src/geometry.f90 +++ b/src/geometry.f90 @@ -32,11 +32,11 @@ contains integer :: current_surface ! current surface of particle (with sign) type(Surface), pointer :: surf => null() - current_surface = p%surface + current_surface = p % surface - n_surfaces = size(c%surfaces) + n_surfaces = size(c % surfaces) allocate(expression(n_surfaces)) - expression = c%surfaces + expression = c % surfaces do i = 1, n_surfaces ! Don't change logical operator @@ -61,7 +61,7 @@ contains ! Compare sense of point to specified sense specified_sense = sign(1,expression(i)) - actual_sense = sense(surf, p%xyz_local) + actual_sense = sense(surf, p % xyz_local) if (actual_sense == specified_sense) then expression(i) = 1 else @@ -114,12 +114,8 @@ contains ! If this cell contains a universe or lattice, search for the particle ! in that universe/lattice if (c % type == CELL_NORMAL) then - ! set current pointers found = .true. - cCell => c - cMaterial => materials(cCell%material) - cUniverse => univ - + ! set particle attributes p % cell = univ % cells(i) p % universe = dict_get_key(universe_dict, univ % uid) @@ -137,7 +133,6 @@ contains elseif (c % type == CELL_LATTICE) then ! Set current lattice lat => lattices(c % fill) - cLattice => lat p % lattice = c % fill ! determine universe based on lattice position @@ -170,7 +165,8 @@ contains end subroutine find_cell !=============================================================================== -! CROSS_SURFACE moves a particle into a new cell +! CROSS_SURFACE handles all surface crossings, whether the particle leaks out of +! the geometry, is reflected, or crosses into a new lattice or cell !=============================================================================== subroutine cross_surface(p, last_cell) @@ -198,24 +194,24 @@ contains type(Cell), pointer :: c type(Universe), pointer :: lower_univ => null() - surf => surfaces(abs(p%surface)) + surf => surfaces(abs(p % surface)) if (verbosity >= 10) then - msg = " Crossing surface " // trim(int_to_str(surf%uid)) + msg = " Crossing surface " // trim(int_to_str(surf % uid)) call message(msg) end if - if (surf%bc == BC_VACUUM) then + if (surf % bc == BC_VACUUM) then ! ======================================================================= ! PARTICLE LEAKS OUT OF PROBLEM - p%alive = .false. + p % alive = .false. if (verbosity >= 10) then - msg = " Leaked out of surface " // trim(int_to_str(surf%uid)) + msg = " Leaked out of surface " // trim(int_to_str(surf % uid)) call message(msg) end if return - elseif (surf%bc == BC_REFLECT) then + elseif (surf % bc == BC_REFLECT) then ! ======================================================================= ! PARTICLE REFLECTS FROM SURFACE @@ -322,11 +318,11 @@ contains ! ========================================================================== ! SEARCH NEIGHBOR LISTS FOR NEXT CELL - if (p%surface > 0 .and. allocated(surf%neighbor_pos)) then + if (p % surface > 0 .and. allocated(surf % neighbor_pos)) then ! If coming from negative side of surface, search all the neighboring ! cells on the positive side - do i = 1, size(surf%neighbor_pos) - index_cell = surf%neighbor_pos(i) + do i = 1, size(surf % neighbor_pos) + index_cell = surf % neighbor_pos(i) c => cells(index_cell) if (cell_contains(c, p)) then if (c % type == CELL_FILL) then @@ -340,17 +336,15 @@ contains ! set current pointers p % cell = index_cell p % material = c % material - cCell => c - cMaterial => materials(cCell%material) end if return end if end do - elseif (p%surface < 0 .and. allocated(surf%neighbor_neg)) then + elseif (p % surface < 0 .and. allocated(surf % neighbor_neg)) then ! If coming from positive side of surface, search all the neighboring ! cells on the negative side - do i = 1, size(surf%neighbor_neg) - index_cell = surf%neighbor_neg(i) + do i = 1, size(surf % neighbor_neg) + index_cell = surf % neighbor_neg(i) c => cells(index_cell) if (cell_contains(c, p)) then if (c % type == CELL_FILL) then @@ -364,8 +358,6 @@ contains ! set current pointers p % cell = index_cell p % material = c % material - cCell => c - cMaterial => materials(cCell%material) end if return end if @@ -380,8 +372,6 @@ contains if (cell_contains(c, p)) then p % cell = i p % material = c % material - cCell => c - cMaterial => materials(cCell%material) return end if end do diff --git a/src/global.f90 b/src/global.f90 index adcbb703cd..5631b376ed 100644 --- a/src/global.f90 +++ b/src/global.f90 @@ -56,13 +56,6 @@ module global type(NuclideMicroXS), allocatable :: micro_xs(:) type(MaterialMacroXS) :: material_xs - ! Current cell, surface, material - type(Cell), pointer :: cCell - type(Universe), pointer :: cUniverse - type(Lattice), pointer :: cLattice - type(Surface), pointer :: cSurface - type(Material), pointer :: cMaterial - ! unionized energy grid integer :: n_grid ! number of points on unionized grid real(8), allocatable :: e_grid(:) ! energies on unionized grid diff --git a/src/score.f90 b/src/score.f90 index 598b57a3ef..3025d0661b 100644 --- a/src/score.f90 +++ b/src/score.f90 @@ -104,8 +104,9 @@ contains real(8) :: val ! value to score real(8) :: Sigma ! macroscopic cross section of reaction character(MAX_LINE_LEN) :: msg ! output/error message - type(Cell), pointer :: c => null() - type(Tally), pointer :: t => null() + type(Cell), pointer :: c => null() + type(Tally), pointer :: t => null() + type(Material), pointer :: mat => null() ! ========================================================================== ! HANDLE LOCAL TALLIES @@ -170,7 +171,8 @@ contains r_bin = 0 do j = 1, n_reaction MT = t % reactions(j) - Sigma = get_macro_xs(p, cMaterial, MT) + mat => materials(p % material) + Sigma = get_macro_xs(p, mat, MT) val = Sigma * flux r_bin = r_bin + 1 call add_to_score(t % score(r_bin, c_bin, e_bin), & @@ -183,7 +185,8 @@ contains r_bin = 1 do j = 1, n_reaction MT = t % reactions(j) - Sigma = get_macro_xs(p, cMaterial, MT) + mat => materials(p % material) + Sigma = get_macro_xs(p, mat, MT) val = Sigma * flux call add_to_score(t % score(r_bin, c_bin, e_bin), & & val) @@ -234,7 +237,8 @@ contains r_bin = 0 do j = 1, n_reaction MT = t % reactions(j) - Sigma = get_macro_xs(p, cMaterial, MT) + mat => materials(p % material) + Sigma = get_macro_xs(p, mat, MT) val = Sigma * flux r_bin = r_bin + 1 call add_to_score(t % score(r_bin, c_bin, e_bin), & @@ -247,7 +251,8 @@ contains r_bin = 1 do j = 1, n_reaction MT = t % reactions(j) - Sigma = get_macro_xs(p, cMaterial, MT) + mat => materials(p % material) + Sigma = get_macro_xs(p, mat, MT) val = Sigma * flux call add_to_score(t % score(r_bin, c_bin, e_bin), & & val)