diff --git a/CMakeLists.txt b/CMakeLists.txt index 12f844370..671c807a8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -115,6 +115,7 @@ add_subdirectory(SharedModules) add_subdirectory(Visualisation) add_subdirectory(ParticleObjects) add_subdirectory(NamedGrids) +add_subdirectory(RandomRayObjects) add_subdirectory(NuclearData) add_subdirectory(Geometry) diff --git a/DataStructures/charMap_class.f90 b/DataStructures/charMap_class.f90 index b1e14f798..1d6f5d41a 100644 --- a/DataStructures/charMap_class.f90 +++ b/DataStructures/charMap_class.f90 @@ -193,7 +193,7 @@ end function length !! Errors: !! None !! - subroutine add(self, key, val) + recursive subroutine add(self, key, val) class(charMap), intent(inout) :: self character(nameLen), intent(in) :: key integer(shortInt), intent(in) :: val diff --git a/DataStructures/intMap_class.f90 b/DataStructures/intMap_class.f90 index d5863768f..59530ae6f 100644 --- a/DataStructures/intMap_class.f90 +++ b/DataStructures/intMap_class.f90 @@ -184,7 +184,7 @@ end function length !! Errors: !! None !! - subroutine add(self, key, val) + recursive subroutine add(self, key, val) class(intMap), intent(inout) :: self integer(shortInt), intent(in) :: key integer(shortInt), intent(in) :: val diff --git a/DataStructures/linkedList_class.f90 b/DataStructures/linkedList_class.f90 index 4a242f2ed..6a4d7b71a 100644 --- a/DataStructures/linkedList_class.f90 +++ b/DataStructures/linkedList_class.f90 @@ -147,7 +147,6 @@ end function get_shortInt !! subroutine kill_shortInt(self) class(linkedIntList), intent(inout) :: self - integer(shortInt) :: i class(intNode), pointer :: resNode ! Traverse the list and nullify pointers diff --git a/Geometry/Surfaces/QuadSurfaces/plane_class.f90 b/Geometry/Surfaces/QuadSurfaces/plane_class.f90 index dfb913868..bb3da58b2 100644 --- a/Geometry/Surfaces/QuadSurfaces/plane_class.f90 +++ b/Geometry/Surfaces/QuadSurfaces/plane_class.f90 @@ -39,6 +39,9 @@ module plane_class procedure :: distance procedure :: going procedure :: kill + + ! Local procedure + procedure :: build end type plane @@ -97,9 +100,34 @@ subroutine init(self, dict) self % norm = coeffs(1:3) self % offset = coeffs(4) + end subroutine init + + !! + !! Build plane from components + !! + !! Args: + !! id [in] -> Surface ID + !! norm [in] -> normal vector of plane (normalised if not already) + !! offset [in] -> offset of plane + !! + !! Errors: + !! fatalError if id or radius are -ve + !! + subroutine build(self, id, norm, offset) + class(plane), intent(inout) :: self + integer(shortInt), intent(in) :: id + real(defReal), dimension(:), intent(in) :: norm + real(defReal), intent(in) :: offset + character(100), parameter :: Here = 'build (plane_class.f90)' + if (id < 1) call fatalError(Here,'Invalid surface id provided. ID must be > 1') - end subroutine init + call self % setID(id) + + self % norm = norm / norm2(norm) + self % offset = offset + + end subroutine build !! !! Return axis-aligned bounding box for the surface diff --git a/Geometry/Surfaces/box_class.f90 b/Geometry/Surfaces/box_class.f90 index 221903c9b..cd78dfbcb 100644 --- a/Geometry/Surfaces/box_class.f90 +++ b/Geometry/Surfaces/box_class.f90 @@ -51,6 +51,7 @@ module box_class procedure :: kill procedure :: setBC procedure :: explicitBC + procedure :: explicitRayBC procedure :: transformBC end type box @@ -325,6 +326,61 @@ subroutine setBC(self, BC) end subroutine setBC + !! + !! Apply explicit BCs, treating vacuums as reflective. + !! + !! See surface_inter for details + !! + !! Note: + !! - Go through all directions in order to account for corners + !! + subroutine explicitRayBC(self, r, u, hitVacuum) + class(box), intent(in) :: self + real(defReal), dimension(3), intent(inout) :: r + real(defReal), dimension(3), intent(inout) :: u + logical(defBool), intent(out) :: hitVacuum + integer(shortInt) :: ax, bc + real(defReal) :: r0 + character(100), parameter :: Here = 'explicitRayBC (box_class.f90)' + + hitVacuum = .FALSE. + + ! Loop over directions + axis : do ax = 1, 3 + ! Find position wrt origin + r0 = r(ax) - self % origin(ax) + + ! Skip if particle is well inside the domain + if (abs(r0) <= self % halfwidth(ax) - self % surfTol()) cycle axis + + ! Choose correct BC + if (r0 < ZERO) then + bc = self % BC(2*ax - 1) + else + bc = self % BC(2*ax) + end if + + ! Apply BC + select case(bc) + case (VACUUM_BC) + ! Treat as reflective but note the vacuum hit + u(ax) = -u(ax) + hitVacuum = .TRUE. + + case (REFLECTIVE_BC) + u(ax) = -u(ax) + + case (PERIODIC_BC) + ! Calculate displacement and perform translation + r(ax) = r(ax) - TWO * sign(self % halfwidth(ax), r0) + + case default + call fatalError(Here, 'Unrecognised BC: '// numToChar(bc)) + end select + end do axis + + end subroutine explicitRayBC + !! !! Apply explicit BCs !! diff --git a/Geometry/Surfaces/squareCylinder_class.f90 b/Geometry/Surfaces/squareCylinder_class.f90 index 5e41d95ec..f02cefea9 100644 --- a/Geometry/Surfaces/squareCylinder_class.f90 +++ b/Geometry/Surfaces/squareCylinder_class.f90 @@ -67,6 +67,7 @@ module squareCylinder_class procedure :: kill procedure :: setBC procedure :: explicitBC + procedure :: explicitRayBC procedure :: transformBC end type squareCylinder @@ -431,6 +432,68 @@ subroutine explicitBC(self, r, u) end subroutine explicitBC + !! + !! Apply explicit BCs for ray problems: enforces a reflection when + !! a vacuum was hit and reports this + !! + !! See surface_inter for details + !! + !! Note: + !! - Go through all directions in order to account for corners + !! + subroutine explicitRayBC(self, r, u, hitVacuum) + class(squareCylinder), intent(in) :: self + real(defReal), dimension(3), intent(inout) :: r + real(defReal), dimension(3), intent(inout) :: u + logical(defBool), intent(out) :: hitVacuum + integer(shortInt) :: ax, bc, i + real(defReal) :: r0 + character(100), parameter :: Here = 'explicitRayBC (squareCylinder_class.f90)' + + hitVacuum = .FALSE. + + ! Loop over directions + ! Becouse of the mix of 2D and 3D vectors to get right component use: + ! i -> for 2D vectors + ! ax -> for 3D vectors (r & u) + axis : do i = 1, 2 + ax = self % plane(i) + + ! Find position wrt origin + r0 = r(ax) - self % origin(i) + + ! Skip if particle is well inside the domain + if (abs(r0) <= self % halfwidth(i) - self % surfTol()) cycle axis + + ! Choose correct BC + if (r0 < ZERO) then + bc = self % BC(2*ax - 1) + else + bc = self % BC(2*ax) + end if + + ! Apply BC + select case(bc) + case (VACUUM_BC) + ! Treat as reflective but state that a vacuum was struck + u(ax) = -u(ax) + hitVacuum = .TRUE. + + case (REFLECTIVE_BC) + u(ax) = -u(ax) + + case (PERIODIC_BC) + ! Calculate displacement and perform translation + r(ax) = r(ax) - TWO * sign(self % halfwidth(i), r0) + + case default + call fatalError(Here, 'Unrecognised BC: '// numToChar(bc)) + + end select + end do axis + + end subroutine explicitRayBC + !! !! Apply co-ordinate transform BC !! diff --git a/Geometry/Surfaces/surface_inter.f90 b/Geometry/Surfaces/surface_inter.f90 index e0b28b2c2..e82ce58c7 100644 --- a/Geometry/Surfaces/surface_inter.f90 +++ b/Geometry/Surfaces/surface_inter.f90 @@ -29,21 +29,22 @@ module surface_inter !! surfId -> Surface ID for this surface !! !! Interface: - !! setId -> Set surface ID - !! id -> Return surface ID - !! setTol -> Set surface tolerance - !! surfTol -> Get value of surface tolerance - !! setBC -> Load boundary conditions in surface-specific order - !! myType -> Returns a string with surface type name - !! init -> Initialise surface from a dictionary - !! boundingBox -> Return definition of axis-aligned bounding box over the surface - !! kill -> Return to unitinitialised state - !! halfspace -> Return halfspace ocupied by a particle - !! evaluate -> Return remainder of the surface equation c = F(r) - !! distance -> Return distance to the surface - !! going -> Determine to which halfspace particle is currently going - !! explicitBC -> Apply explicit BCs - !! transformBC -> Apply transform BCs + !! setId -> Set surface ID + !! id -> Return surface ID + !! setTol -> Set surface tolerance + !! surfTol -> Get value of surface tolerance + !! setBC -> Load boundary conditions in surface-specific order + !! myType -> Returns a string with surface type name + !! init -> Initialise surface from a dictionary + !! boundingBox -> Return definition of axis-aligned bounding box over the surface + !! kill -> Return to unitinitialised state + !! halfspace -> Return halfspace ocupied by a particle + !! evaluate -> Return remainder of the surface equation c = F(r) + !! distance -> Return distance to the surface + !! going -> Determine to which halfspace particle is currently going + !! explicitBC -> Apply explicit BCs + !! explicitRayBC -> Apply explicit BCs for ray problems + !! transformBC -> Apply transform BCs !! type, public, abstract :: surface private @@ -68,6 +69,7 @@ module surface_inter procedure(distance), deferred :: distance procedure(going), deferred :: going procedure :: explicitBC + procedure :: explicitRayBC procedure :: transformBC end type surface @@ -375,6 +377,28 @@ subroutine explicitBC(self, r, u) end subroutine explicitBC + !! + !! Apply explicit BCs, treating vacuums as reflective. + !! Used for ray problems + !! + !! FatalError by default. Override in a subclass to change it! + !! + !! Args: + !! r [inout] -> Position pre and post BC. Assume that (F(r) ~= 0) + !! u [inout] -> Direction pre and post BC. Assume that norm2(u) = 1.0 + !! hitVacuum [out] -> Was a vacuum boundary struck? + !! + subroutine explicitRayBC(self, r, u, hitVacuum) + class(surface), intent(in) :: self + real(defReal), dimension(3), intent(inout) :: r + real(defReal), dimension(3), intent(inout) :: u + logical(defBool), intent(out) :: hitVacuum + character(100), parameter :: Here = 'explicitRayBC (surface_inter.f90)' + + call fatalError(Here,'The boundary surface has not implemented ray handling!') + + end subroutine explicitRayBC + !! !! Apply co-ordinate transform BC !! diff --git a/Geometry/Tests/geometryStd_iTest.f90 b/Geometry/Tests/geometryStd_iTest.f90 index 75def8e56..7896ac8b6 100644 --- a/Geometry/Tests/geometryStd_iTest.f90 +++ b/Geometry/Tests/geometryStd_iTest.f90 @@ -3,9 +3,11 @@ module geometryStd_iTest use numPrecision use universalVariables use dictionary_class, only : dictionary + use dictParser_func, only : charToDict use charMap_class, only : charMap use dictParser_func, only : fileToDict use coord_class, only : coordList + use geometry_inter, only : geometry use geometryStd_class, only : geometryStd use funit @@ -19,7 +21,7 @@ module geometryStd_iTest !! @Test subroutine test_lattice_geom() - type(geometryStd) :: geom + class(geometryStd), target, allocatable :: geom character(*), parameter :: path = './IntegrationTestFiles/Geometry/test_lat' type(charMap) :: mats integer(shortInt) :: i, idx, matIdx, uniqueID, event @@ -33,7 +35,7 @@ subroutine test_lattice_geom() real(defReal), dimension(6) :: aabb real(defReal) :: maxDist real(defReal), parameter :: TOL = 1.0E-7_defReal - + ! Load dictionary call fileToDict(dict, path) @@ -44,10 +46,11 @@ subroutine test_lattice_geom() do i = 1, size(keys) call mats % add(keys(i), i) end do - + ! Build geometry + allocate(geom) call geom % init(dict, mats, silent=.true.) - + ! Get material at few locations name = 'water' idx = mats % get(name) @@ -66,7 +69,7 @@ subroutine test_lattice_geom() u = [ZERO, ZERO, ONE] call coords % init(r, u) call geom % placeCoord(coords) - + ! Verify positions @assertEqual(r, coords % lvl(1) % r, TOL) @assertEqual(r, coords % lvl(2) % r, TOL) @@ -79,7 +82,7 @@ subroutine test_lattice_geom() ! Slice plot -> Material call geom % slicePlot(img, [ZERO, ZERO, ZERO], 'z', 'material') - + ! Verify some pixels name = 'water' idx = mats % get(name) @@ -99,7 +102,7 @@ subroutine test_lattice_geom() call geom % slicePlot(img, r, 'z', 'uniqueID', [1.26_defReal, 1.26_defReal]) ! Verify some pixels - ! Note that this test depends on universe leyout order in gromGraph + ! Note that this test depends on universe layout order in geomGraph ! If it changes this test fill fail @assertEqual(2, img(5,5)) @assertEqual(3, img(1,1)) @@ -125,7 +128,7 @@ subroutine test_lattice_geom() @assertEqual(r_ref, coords % lvl(1) % r, TOL) @assertEqual(u_ref, coords % lvl(1) % dir, TOL) @assertEqual(idx, coords % matIdx) - + !*** Test global movement r = [ZERO, ZERO, ZERO] u = [ZERO, -ONE, ZERO] @@ -222,7 +225,7 @@ end subroutine test_lattice_geom !! @Test subroutine test_tilted_cylinder() - type(geometryStd) :: geom + class(geometryStd), target, allocatable :: geom character(*), parameter :: path = './IntegrationTestFiles/Geometry/test_cyl' type(charMap) :: mats integer(shortInt) :: idxW, idxF, i @@ -232,7 +235,7 @@ subroutine test_tilted_cylinder() character(nameLen), dimension(:), allocatable :: keys integer(shortInt), dimension(20,20) :: img integer(shortInt), dimension(20,20,20) :: img3 - real(defReal), dimension(3) :: r + real(defReal), dimension(3) :: r ! Load dictionary call fileToDict(dict, path) @@ -246,6 +249,7 @@ subroutine test_tilted_cylinder() end do ! Build geometry + allocate(geom) call geom % init(dict, mats, silent=.true.) ! Get fuel and water index @@ -254,7 +258,7 @@ subroutine test_tilted_cylinder() name = 'mox43' idxF = mats % get(name) - + !*** Test slice normal to x & y ! X-axis at 1.0 r = [1.0_defReal, 0.0_defReal, 0.0_defReal] @@ -265,7 +269,7 @@ subroutine test_tilted_cylinder() @assertEqual(idxW, img(17, 3)) @assertEqual(idxF, img(10, 10)) @assertEqual(idxF, img(18, 1)) - + ! Y-axis at 3.0 r = [0.0_defReal, 3.0_defReal, 0.0_defReal] call geom % slicePlot(img, r, 'y', 'material') diff --git a/Geometry/Universes/CMakeLists.txt b/Geometry/Universes/CMakeLists.txt index 00dcd9153..e5890e52c 100644 --- a/Geometry/Universes/CMakeLists.txt +++ b/Geometry/Universes/CMakeLists.txt @@ -4,6 +4,7 @@ add_sources( ./universe_inter.f90 ./universeShelf_class.f90 ./cellUniverse_class.f90 ./pinUniverse_class.f90 + ./azimPinUniverse_class.f90 ./latUniverse_class.f90 ./rootUniverse_class.f90 ) @@ -12,6 +13,7 @@ add_sources( ./universe_inter.f90 add_unit_tests( ./Tests/universe_test.f90 ./Tests/cellUniverse_test.f90 ./Tests/pinUniverse_test.f90 + ./Tests/azimPinUniverse_test.f90 ./Tests/latUniverse_test.f90 ./Tests/rootUniverse_test.f90 ./Tests/uniFills_test.f90 diff --git a/Geometry/Universes/Tests/azimPinUniverse_test.f90 b/Geometry/Universes/Tests/azimPinUniverse_test.f90 new file mode 100644 index 000000000..fd2ebab03 --- /dev/null +++ b/Geometry/Universes/Tests/azimPinUniverse_test.f90 @@ -0,0 +1,401 @@ +module azimPinUniverse_test + + use numPrecision + use universalVariables, only : INF, SURF_TOL + use dictionary_class, only : dictionary + use dictParser_func, only : charToDict + use charMap_class, only : charMap + use coord_class, only : coord + use surfaceShelf_class, only : surfaceShelf + use cellShelf_class, only : cellShelf + use azimPinUniverse_class, only : azimPinUniverse, MOVING_IN, MOVING_OUT, MOVING_CLOCK, & + MOVING_ANTI, MOVING_CLOCK_FORWARD, MOVING_CLOCK_BACK + use fUnit + implicit none + + ! Parameters + character(*), parameter :: UNI_DEF1 = & + "id 7; type azimPinUniverse; naz 4; origin (0.0 0.0 0.0); rotation (0.0 0.0 0.0); & + &radii (2.5 1.5 0.0); fills (u<7> u<14> void);" + character(*), parameter :: UNI_DEF2 = & + "id 8; type azimPinUniverse; naz 8; origin (0.0 0.0 0.0); rotation (0.0 0.0 0.0); & + &radii (4.0 2.5 1.5 0.0); fills (u<20> u<7> u<14> void);" + + ! Variables + type(surfaceShelf) :: surfs + type(cellShelf) :: cells + type(charMap) :: mats + type(azimPinUniverse) :: uni1, uni2 + + +contains + + !! + !! Set-up test enviroment + !! +@Before + subroutine setup() + character(nameLen) :: name + integer(shortInt), dimension(:), allocatable :: fill + type(dictionary) :: dict + integer(shortInt), dimension(:), allocatable :: fillArray + + ! Load void material + name = 'void' + call mats % add(name, 13) + + ! Build universe + call charToDict(dict, UNI_DEF1) + call uni1 % init(fill, dict, cells, surfs, mats) + + ! Set index + call uni1 % setIdx(3) + + ! Verify fill array + @assertEqual([-14, -14, -14, -14, -7, -7, -7, -7, 13, 13, 13, 13], fill) + + ! Build second universe + fillArray = [-14, -14, -14, -14, -14, -14, -14, -14,-7, -7, -7, -7, -7, -7, -7, -7, & + -20, -20, -20, -20, -20, -20, -20, -20, 13, 13, 13, 13, 13, 13, 13, 13] + call charToDict(dict, UNI_DEF2) + call uni2 % init(fill, dict, cells, surfs, mats) + call uni2 % setIdx(26) + @assertEqual(fillArray, fill) + + end subroutine setup + + !! + !! Clean after test + !! +@After + subroutine clean() + + call surfs % kill() + call cells % kill() + call mats % kill() + call uni1 % kill() + call uni2 % kill() + + end subroutine clean + + !! + !! Test miscellaneous functionality + !! +@Test + subroutine test_misc() + real(defReal), dimension(3,3) :: mat + + ! Get id + @assertEqual(7, uni1 % id()) + + ! Set ID + call uni1 % setId(7) + @assertEqual(7, uni1 % id()) + + end subroutine test_misc + + !! + !! Test entering a universe + !! +@Test + subroutine test_enter() + type(coord) :: new + real(defReal), dimension(3) :: r_ref, u_ref, r, dir + real(defReal), parameter :: TOL = 1.0E-7_defReal + + ! ** Enter into local cell 1 + r = [1.0_defReal, 0.0_defReal, 0.0_defReal ] + dir = [ZERO, ZERO, ONE] + + call uni1 % enter(new, r, dir) + + ! Verify location + r_ref = r + u_ref = dir + @assertEqual(r_ref, new % r, TOL) + @assertEqual(u_ref, new % dir, TOL) + @assertEqual(3, new % uniIdx) + @assertEqual(1, new % localID) + @assertEqual(0, new % cellIdx) + + ! ** Enter into local cell 2 + r = [0.0_defReal, 1.0_defReal, 0.0_defReal ] + dir = [ZERO, ZERO, ONE] + + call uni1 % enter(new, r, dir) + + ! Verify location + r_ref = r + u_ref = dir + @assertEqual(r_ref, new % r, TOL) + @assertEqual(u_ref, new % dir, TOL) + @assertEqual(3, new % uniIdx) + @assertEqual(2, new % localID) + @assertEqual(0, new % cellIdx) + + ! ** Enter into local cell 8 + r = [0.0_defReal, -2.3_defReal, -980.0_defReal ] + dir = [ZERO, ZERO, ONE] + + call uni1 % enter(new, r, dir) + + ! Verify location + r_ref = r + u_ref = dir + @assertEqual(r_ref, new % r, TOL) + @assertEqual(u_ref, new % dir, TOL) + @assertEqual(3, new % uniIdx) + @assertEqual(8, new % localID) + @assertEqual(0, new % cellIdx) + + ! ** Enter into local cell 11 + r = [-2.6_defReal, 0.0_defReal, -980.0_defReal ] + dir = [ZERO, ZERO, ONE] + + call uni1 % enter(new, r, dir) + + ! Verify location + r_ref = r + u_ref = dir + @assertEqual(r_ref, new % r, TOL) + @assertEqual(u_ref, new % dir, TOL) + @assertEqual(3, new % uniIdx) + @assertEqual(11, new % localID) + @assertEqual(0, new % cellIdx) + + ! VERIFY THAT ROTATION IS NOT SET (all angles were 0.0) + @assertFalse(new % isRotated) + + ! In universe 2, enter local cell 21 + r = [-3.0_defReal, 0.1_defReal, 32.0_defReal] + call uni2 % enter(new, r, dir) + + ! Verify location + r_ref = r + u_ref = dir + @assertEqual(r_ref, new % r, TOL) + @assertEqual(u_ref, new % dir, TOL) + @assertEqual(26, new % uniIdx) + @assertEqual(21, new % localID) + @assertEqual(0, new % cellIdx) + + end subroutine test_enter + + !! + !! Test distance calculation + !! +@Test + subroutine test_distance() + real(defReal) :: d, ref + integer(shortInt) :: surfIdx + type(coord) :: pos + real(defReal), parameter :: TOL = 1.0E-6_defReal + + ! ** In local cell 1 distance to radial boundary + pos % r = [1.0_defReal, 0.0_defReal, 0.0_defReal] + pos % dir = [ONE, ZERO, ZERO] + pos % uniIdx = 3 + pos % cellIdx = 0 + pos % localId = 1 + + call uni1 % distance(d, surfIdx, pos) + + ref = 0.5_defReal + @assertEqual(ref, d, ref * tol) + @assertEqual(MOVING_OUT, surfIdx) + + ! ** In local cell 1 distance to anti-clockwise boundary + pos % r = [1.0_defReal, 0.0_defReal, 0.0_defReal] + pos % dir = [-SQRT2_2, SQRT2_2, ZERO] + pos % uniIdx = 3 + pos % cellIdx = 0 + pos % localId = 1 + + call uni1 % distance(d, surfIdx, pos) + + ref = SQRT2_2 + @assertEqual(ref, d, ref * tol) + @assertEqual(MOVING_ANTI, surfIdx) + + ! ** In local cell 3 distance to clockwise boundary + pos % r = [-1.0_defReal, 0.0_defReal, 0.0_defReal] + pos % dir = [SQRT2_2, SQRT2_2, ZERO] + pos % uniIdx = 3 + pos % cellIdx = 0 + pos % localId = 3 + + call uni1 % distance(d, surfIdx, pos) + + ref = SQRT2_2 + @assertEqual(ref, d, ref * tol) + @assertEqual(MOVING_CLOCK, surfIdx) + + ! ** In local cell 4 distance to clockwise boundary + ! ** Moves back around! + pos % r = [0.0_defReal, -1.0_defReal, 0.0_defReal] + pos % dir = [SQRT2_2, SQRT2_2, ZERO] + pos % uniIdx = 3 + pos % cellIdx = 0 + pos % localId = 4 + + call uni1 % distance(d, surfIdx, pos) + + ref = SQRT2_2 + @assertEqual(ref, d, ref * tol) + @assertEqual(MOVING_CLOCK_FORWARD, surfIdx) + + ! ** In outermost cell moving away + pos % r = [2.0_defReal, 1.6_defReal, 0.0_defReal] + pos % dir = [ONE, ZERO, ZERO] + pos % localId = 9 + + call uni1 % distance(d, surfIdx, pos) + @assertEqual(INF, d) + ! Surface momento is undefined -> No crossing + + ! In ordinary cell in-between + pos % r = [0.0_defReal, 1.6_defReal, 0.0_defReal] + pos % dir = [ZERO, -ONE, ZERO] + pos % localId = 5 + + call uni1 % distance(d, surfIdx, pos) + ref = 0.1_defReal + @assertEqual(ref, d, ref * tol) + @assertEqual(MOVING_IN, surfIdx) + + ! Universe 2 + + + end subroutine test_distance + + !! + !! Test cell-to cell crossing + !! +@Test + subroutine test_cross() + type(coord) :: pos + integer(shortInt) :: idx + real(defReal) :: eps + + ! Cross from cell 2 to cell 6 + eps = HALF * SURF_TOL + pos % r = [0.0_defReal, 1.5_defReal-eps, 0.0_defReal] + pos % dir = [ZERO, ONE, ZERO] + pos % uniIdx = 8 + pos % cellIdx = 0 + pos % localId = 2 + + idx = MOVING_OUT + call uni1 % cross(pos, idx) + + @assertEqual(6, pos % localId) + + ! Cross from cell 6 to cell 2 + eps = HALF * SURF_TOL + pos % r = [0.0_defReal, 1.5_defReal+eps, 0.0_defReal] + pos % dir = [ZERO, -ONE, ZERO] + + idx = MOVING_IN + call uni1 % cross(pos, idx) + + @assertEqual(2, pos % localId) + + ! Cross from cell 1 to cell 4 + eps = HALF * SURF_TOL + pos % r = [SQRT2_2, -SQRT2_2, ZERO] + pos % dir = [-SQRT2_2, -SQRT2_2, ZERO] + pos % r = pos % r - eps * pos % dir + pos % localID = 1 + + idx = MOVING_CLOCK_BACK + call uni1 % cross(pos, idx) + + @assertEqual(4, pos % localId) + + ! Universe 2 + ! + + end subroutine test_cross + + !! + !! Test cell offset + !! +@Test + subroutine test_cellOffset() + type(coord) :: pos + + ! Cell 2 + pos % r = [0.0_defReal, 1.0_defReal, 0.0_defReal] + pos % dir = [ZERO, ONE, ZERO] + pos % uniIdx = 3 + pos % cellIdx = 0 + pos % localId = 2 + + @assertEqual([ZERO, ZERO, ZERO], uni1 % cellOffset(pos) ) + + ! Cell 11 + pos % r = [-7.0_defReal, 0.0_defReal, 0.0_defReal] + pos % dir = [ZERO, ONE, ZERO] + pos % uniIdx = 3 + pos % cellIdx = 0 + pos % localId = 11 + + @assertEqual([ZERO, ZERO, ZERO], uni1 % cellOffset(pos) ) + + end subroutine test_cellOffset + + !! + !! Test surface transitions + !! + !! Check that there is no problem with distance calculations + !! if particle is placed very close to an annulus or plane surface + !! (within SURF_TOL) + !! +@Test + subroutine test_edgeCases() + type(coord) :: pos + integer(shortInt) :: idx, localID, cellIdx + real(defReal) :: eps, d + real(defReal), parameter :: TOL = 1.0E-7_defReal + + ! At boundary between cell 2 and 6 + eps = HALF * SURF_TOL + pos % r = [0.0_defReal, 1.5_defReal-eps, 0.0_defReal] + pos % dir = [ONE, -0.00001_defReal, ZERO] + pos % dir = pos % dir / norm2(pos % dir) + pos % uniIdx = 8 + pos % cellIdx = 0 + + ! Should find particle in cell 2 + ! And return very small distance -> MOVING OUT + call uni1 % findCell(localID, cellIdx, pos % r, pos % dir) + @assertEqual(2, localID) + + pos % localID = 2 + call uni1 % distance(d, idx, pos) + + @assertEqual(ZERO, d, 1.0E-3_defReal) + @assertEqual(MOVING_OUT, idx) + + ! At boundary between cell 4 and 1 + eps = 1.1*SURF_TOL + pos % r = [SQRT2_2, -SQRT2_2, ZERO] + pos % dir = [-SQRT2_2, -SQRT2_2, ZERO] + pos % r = pos % r + eps * pos % dir + pos % dir = -pos % dir + + ! Should find particle in cell 4 + ! And return very small distance -> MOVING_CLOCK_FORWARD + call uni1 % findCell(localID, cellIDx, pos % r, pos % dir) + @assertEqual(4, localID) + + pos % localID = 4 + call uni1 % distance(d, idx, pos) + + @assertEqual(ZERO, d, 1.0E-3_defReal) + @assertEqual(MOVING_CLOCK_FORWARD, idx) + + end subroutine test_edgeCases + + +end module azimPinUniverse_test diff --git a/Geometry/Universes/azimPinUniverse_class.f90 b/Geometry/Universes/azimPinUniverse_class.f90 new file mode 100644 index 000000000..3b6f863f9 --- /dev/null +++ b/Geometry/Universes/azimPinUniverse_class.f90 @@ -0,0 +1,540 @@ +module azimPinUniverse_class + + use numPrecision + use universalVariables, only : INF, targetNotFound + use genericProcedures, only : fatalError, numToChar, swap + use dictionary_class, only : dictionary + use coord_class, only : coord + use charMap_class, only : charMap + use surfaceShelf_class, only : surfaceShelf + use cylinder_class, only : cylinder + use plane_class, only : plane + use cell_inter, only : cell + use cellShelf_class, only : cellShelf + use universe_inter, only : universe, kill_super => kill, charToFill + implicit none + private + + ! Parameters + ! Are public for use in unit tests + integer(shortInt), parameter, public :: MOVING_IN = -1, MOVING_OUT = -2, & + MOVING_ANTI = -3, MOVING_CLOCK = -4, & + MOVING_CLOCK_BACK = -5, & + MOVING_CLOCK_FORWARD = -6 + + !! + !! Universe that represents a single pin + !! A version of the pinUniverse which is equi-azimuthally divided. + !! + !! Is composed from co-centring cylinders divided azimuthally by planes. + !! In the most central cylinder and first azimuthal segment, the cell will + !! have an ID of 1. This increases by 1 while proceeding across azimuthal + !! segments. Proceeding radially outwards, the ID is incremented by the + !! number of azimuthal regions. + !! + !! This has been generalised to allow different numbers of azimuthal divisions + !! in each radial division, e.g., a pin cell with 4 azimuthal divisions in the + !! fuel but 8 azimuthal divisions in the moderator + !! + !! Simplified input for uniform azimuthal division + !! Sample Dictionary Input: + !! azimPinUni { + !! id 7; + !! type azimPinUniverse; + !! naz 4; + !! #origin (1.0 0.0 0.1);# + !! #rotation (30.0 0.0 0.0);# + !! radii (3.0 4.5 0.0 1.0 ); + !! fills (u<3> void clad u<4>); + !! } + !! + !! Input for non-uniform azimuthal division + !! Sample Dictionary Input: + !! azimPinUni { + !! id 7; + !! type azimPinUniverse; + !! nazR (4 8); + !! #origin (1.0 0.0 0.1);# + !! #rotation (30.0 0.0 0.0);# + !! radii (3.0 0.0 ); + !! fills (u<3> water ); + !! } + !! + !! naz corresponds to the number of azimuthal regions produced. Must be a multiple of 2. + !! Takes origin at 0 degrees, i.e., the centre of the first azimuthal slice. + !! There must be 0.0 entry, which indicates outermost annulus (infinite radius). + !! + !! Alternatively, nazR is the number of azimuthal divisions per radial region, from + !! the centre radiating outwards. + !! + !! `fills` and `radii` are given as pairs by position in the input arrays. Thus, fills + !! are sorted together with the `radii`. As a result, in the example, local cells 1 to 4 + !! are filled with u<4>, cell 5 to 8 with u<3> etc. + !! + !! !!!!! + !! TODO: Just for the moment, there are no azimuthally different fills. This should be remedied! + !! !!!!! + !! + !! Public Members: + !! nAz -> Number of azimuthal regions in each radial ring + !! r_sqr -> Array of radius^2 for each annulus + !! theta -> Array of azimuthal boundary angles in radians. + !! annuli -> Array of cylinder surfaces that represent diffrent annuli + !! planes -> Array of planes for providing azimuthal division + !! normals -> Array of plane normals for convenience + !! + !! Interface: + !! universe interface + !! + type, public, extends(universe) :: azimPinUniverse + private + integer(shortInt), dimension(:), allocatable :: nAz + real(defReal), dimension(:), allocatable :: r_sq + real(defReal), dimension(:), allocatable :: theta + type(cylinder), dimension(:), allocatable :: annuli + type(plane), dimension(:), allocatable :: planes + real(defReal), dimension(:,:), allocatable :: normals + contains + ! Superclass procedures + procedure :: init + procedure :: kill + procedure :: findCell + procedure :: distance + procedure :: cross + procedure :: cellOffset + end type azimPinUniverse + +contains + + !! + !! Initialise Universe + !! + !! See universe_inter for details. + !! + !! Errors: + !! fatalError for invalid input + !! + subroutine init(self, fill, dict, cells, surfs, mats) + class(azimPinUniverse), intent(inout) :: self + integer(shortInt), dimension(:), allocatable, intent(out) :: fill + class(dictionary), intent(in) :: dict + type(cellShelf), intent(inout) :: cells + type(surfaceShelf), intent(inout) :: surfs + type(charMap), intent(in) :: mats + integer(shortInt) :: id, idx, N, i, j, r, nAzTotal + real(defReal), dimension(:), allocatable :: radii, temp + integer(shortInt), dimension(:), allocatable :: tempInt + character(nameLen), dimension(:), allocatable :: fillNames + real(defReal) :: dTheta, theta0 + character(100), parameter :: Here = 'init (azimPinUniverse_class.f90)' + + ! Load basic data + call dict % get(id, 'id') + if (id <= 0) call fatalError(Here, 'Universe ID must be +ve. Is: '//numToChar(id)) + call self % setId(id) + + ! Load radii and fill data + call dict % get(radii, 'radii') + call dict % get(fillNames, 'fills') + + ! Check values + if (size(radii) /= size(fillNames)) then + call fatalError(Here, 'Size of radii and fills does not match') + + else if (any(radii < ZERO)) then + call fatalError(Here, 'Found -ve value of radius.') + + end if + + ! Load azimuthal division + if (dict % isPresent('naz') .and. dict % isPresent('nazR')) then + call fatalError(Here,'Cannot have both a naz and nazR entry') + + ! Only one azimuthal discretisation + elseif (dict % isPresent('naz')) then + allocate(self % nAz(size(radii))) + call dict % get(N, 'naz') + self % nAz = N + + ! Variable azimuthal discretisation + elseif (dict % isPresent('nazR')) then + call dict % get(tempInt, 'nazR') + if (size(tempInt) /= size(radii)) call fatalError(Here,'Number of radial regions is not consistent '//& + 'between nazR and radii') + allocate(self % nAz(size(tempInt))) + self % nAz = tempInt + else + call fatalError(Here,'Must have either a naz or nazR entry') + end if + if (any(self % nAz < 2)) call fatalError(Here,'Number of azimuthal regions must be 2 or more') + + ! Use binary logic to check if nAz is a power of 2 + do r = 1, size(self % naz) + if (IAND(self % nAz(r), self % nAz(r) - 1) /= 0) call fatalError(Here, 'Number of azimuthal regions must be a power of 2') + end do + + ! Load origin + if (dict % isPresent('origin')) then + call dict % get(temp, 'origin') + + if (size(temp) /= 3) then + call fatalError(Here, 'Origin must have size 3. Has: '//numToChar(size(temp))) + end if + call self % setTransform(origin=temp) + + end if + + ! Load rotation + if (dict % isPresent('rotation')) then + call dict % get(temp, 'rotation') + + if (size(temp) /= 3) then + call fatalError(Here, '3 rotation angles must be given. Has: '//numToChar(size(temp))) + end if + call self % setTransform(rotation=temp) + end if + + + ! Sort radii with selection sort + ! Start with value 0.0 that represents outermost element + ! Change 0.0 to infinity + N = size(radii) + idx = minloc(radii, 1) + if (radii(idx) /= ZERO) call fatalError(Here, 'Did not find outermost element with radius 0.0.') + call swap( radii(idx), radii(N)) + call swap( fillNames(idx), fillNames(N)) + radii(N) = INF * 1.1_defReal + + do i = N-1,1,-1 + idx = maxloc(radii(1:i), 1) + call swap( radii(idx), radii(i)) + call swap( fillNames(idx), fillNames(i)) + end do + + ! Check for duplicate values of radii + do i = 1, N-1 + if (radii(i) == radii(i+1)) then + call fatalError(Here, 'Duplicate value of radius: '//numToChar(radii(i))) + end if + end do + + ! Load data & Build cylinders + self % r_sq = radii * radii + + allocate(self % annuli(N)) + do i = 1, N + call self % annuli(i) % build(id=1, origin=[ZERO, ZERO, ZERO], & + type='zCylinder', radius=radii(i) ) + end do + + ! Load data and build planes + allocate(self % theta(sum(self % nAz))) + allocate(self % planes(sum(self % nAz)/2)) + allocate(self % normals(sum(self % nAz)/2,2)) + + nAzTotal = 0 + do r = 1, N + + dTheta = TWO_PI / self % nAz(r) + theta0 = HALF * dTheta + do i = 1, self % nAz(r) + self % theta(nAzTotal + i) = theta0 + theta0 = theta0 + dTheta + end do + + ! Build the planes, rotated at angle theta from the line x = 0 + do i = 1, self % nAz(r)/2 + self % normals(nAzTotal/2 + i,1) = -sin(self % theta(nAzTotal + i)) + self % normals(nAzTotal/2 + i,2) = cos(self % theta(nAzTotal + i)) + call self % planes(nAzTotal/2 + i) % build(id=1, & + norm = [self % normals(nAzTotal/2 + i,1), self % normals(nAzTotal/2 + i,2), ZERO], offset=ZERO) + end do + + nAzTotal = nAzTotal + self % nAz(r) + end do + + ! Create fill array + allocate(fill(nAzTotal)) + + nAzTotal = 0 + do i = 1, N + do j = 1, self % nAz(i) + fill(nAzTotal + j) = charToFill(fillNames(i), mats, Here) + end do + nAzTotal = nAzTotal + self % nAz(i) + end do + + end subroutine init + + !! + !! Find local cell ID given a point + !! + !! See universe_inter for details. + !! + subroutine findCell(self, localID, cellIdx, r, u) + class(azimPinUniverse), intent(inout) :: self + integer(shortInt), intent(out) :: localID + integer(shortInt), intent(out) :: cellIdx + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(3), intent(in) :: u + real(defReal) :: r_sq, theta, mul, planeDir + integer(shortInt) :: aIdx, rIdx, pIdx, baseAIdx + + r_sq = r(1)*r(1) + r(2)*r(2) + theta = atan2(r(2),r(1)) + ! Correct theta for negative values + if (theta < ZERO) theta = TWO_PI + theta + + cellIdx = 0 + + ! Need to include surface tolerance. Determine multiplier by direction + if ( r(1)*u(1) + r(2)*u(2) >= ZERO) then + mul = -ONE + else + mul = ONE + end if + + ! Find local cell + ! Start by finding annular region + do rIdx = 1, size(self % r_sq) + if( r_sq < self % r_sq(rIdx) + mul * self % annuli(rIdx) % surfTol() ) exit + end do + ! If reached here without exiting, rIdx = size(self % r_sq) + 1 + + ! Find base azimuthal index given radial zone + baseAIdx = 0 + if (rIdx > 1) baseAIdx = sum(self % nAz(1:(rIdx-1))) + + ! Find azimuthal segment + do aIdx = 1, self % nAz(rIdx) + if (aIdx > self % nAz(rIdx)/2) then + pIdx = aIdx - self % nAz(rIdx)/2 + planeDir = -ONE + else + pIdx = aIdx + planeDir = ONE + end if + ! Surface tolerance multiplier determined by relative direction of particle + ! and theta + if (planeDir*self % normals(baseAIdx/2 + pIdx,1)*u(1) + planeDir*self % normals(baseAIdx/2 + pIdx,2)*u(2) >= ZERO) then + mul = -ONE + else + mul = ONE + end if + if (theta < self % theta(baseAIdx + aIdx) + mul * self % planes(baseAIdx/2 + pIdx) % surfTol() ) exit + end do + ! If exceeded the search, theta is <2pi but greater than the largest theta. + ! Therefore, it lies in the negative theta portion of the first segment. + if (aIdx == self % nAz(rIdx) + 1) aIdx = 1 + localID = aIdx + baseAIdx + + end subroutine findCell + + !! + !! Return distance to the next boundary between local cells in the universe + !! + !! See universe_inter for details. + !! + !! Errors: + !! fatalError is localID is invalid + !! + subroutine distance(self, d, surfIdx, coords) + class(azimPinUniverse), intent(inout) :: self + real(defReal), intent(out) :: d + integer(shortInt), intent(out) :: surfIdx + type(coord), intent(in) :: coords + real(defReal) :: d_out_annul, d_in_annul + real(defReal) :: d_plus, d_minus, dAz + integer(shortInt) :: id, aIdx, rIdx, i, searchIdxP, searchIdxM + integer(shortInt) :: sense, minus_sense, plus_sense, baseIdx + character(100), parameter :: Here = 'distance (azimPinUniverse_class.f90)' + + ! Get local id + id = coords % localID + + if (id < 1 .or. id > sum(self % nAz)) then + call fatalError(Here, 'Invalid local ID: '//numToChar(id)) + end if + + ! Identify annulus index and azimuthal index + do i = 1, size(self % annuli) + id = id - self % nAz(i) + if (id < 1) then + rIdx = i + aIdx = id + self % nAz(i) + exit + end if + end do + + baseIdx = 0 + if (rIdx > 1) baseIdx = sum(self % nAz(1:(rIdx-1)))/2 + + ! Check distance to annuli + ! Outer distance + if (rIdx > size(self % r_sq)) then + d_out_annul = INF + else + d_out_annul = self % annuli(rIdx) % distance(coords % r, coords % dir) + end if + + ! Inner distance + if (rIdx == 1) then + d_in_annul = INF + else + d_in_annul = self % annuli(rIdx-1) % distance(coords % r, coords % dir) + end if + + ! Select distance and surface + if ( d_in_annul < d_out_annul) then + surfIdx = MOVING_IN + d = d_in_annul + + else + surfIdx = MOVING_OUT + d = d_out_annul + end if + + ! Check distance to azimuthal planes + + ! Check whether in the first or second half of azimuthal segments + ! If in second half, find the same azimuthal indices as in the first half + searchIdxP = aIdx + baseIdx + if (aIdx > self % nAz(rIdx)/2) searchIdxP = searchIdxP - self % nAz(rIdx)/2 + + ! Set default senses for which cell will be entered + minus_sense = MOVING_CLOCK + plus_sense = MOVING_ANTI + + ! Check for first or last cells circling round + if (aIdx == 1) then + minus_sense = MOVING_CLOCK_BACK + else if (aIdx == self % nAz(rIdx)) then + plus_sense = MOVING_CLOCK_FORWARD + end if + + ! If in the first cell or nAz/2 + 1 cell, find correct plane + if (searchIdxP == baseIdx + 1) then + searchIdxM = self % nAz(rIdx)/2 + baseIdx + else + searchIdxM = searchIdxP - 1 + end if + + ! Identify which two planes (or only one if nAz = 2) + ! Check to see if in second half of azimuthal segments + if (self % nAz(rIdx) > 2) then + d_plus = self % planes(searchIdxP) % distance(coords % r, coords % dir) + d_minus = self % planes(searchIdxM) % distance(coords % r, coords % dir) + else + d_plus = self % planes(baseIdx + 1) % distance(coords % r, coords % dir) + d_minus = INF + end if + + ! Choose minimum azimuthal + if (d_plus < d_minus) then + dAz = d_plus + sense = plus_sense + else + dAz = d_minus + sense = minus_sense + end if + + ! Compare radial distance with azimuthal + if (dAz < d) then + surfIdx = sense + d = dAz + end if + + end subroutine distance + + !! + !! Cross between local cells + !! + !! See universe_inter for details. + !! + !! Errors: + !! fatalError if surface from distance is not MOVING_IN or MOVING_OUT + !! + subroutine cross(self, coords, surfIdx) + class(azimPinUniverse), intent(inout) :: self + type(coord), intent(inout) :: coords + integer(shortInt), intent(in) :: surfIdx + integer(shortInt) :: aIdx, i + character(100), parameter :: Here = 'cross (azimPinUniverse_class.f90)' + + ! Need radial region to work out how much to increment the clock by + ! Identify annulus index and azimuthal index + aIdx = coords % localID + do i = 1, size(self % annuli) + aIdx = aIdx - self % nAz(i) + if (aIdx < 1) exit + end do + + ! Need to determine whether completing a circle, i.e., moving from + ! the last azimuthal segment to the first and vice versa + if (surfIdx == MOVING_CLOCK) then + coords % localID = coords % localID - 1 + + else if (surfIdx == MOVING_ANTI) then + coords % localID = coords % localID + 1 + + else if (surfIdx == MOVING_CLOCK_BACK) then + coords % localID = coords % localID + self % nAz(i) - 1 + + else if (surfIdx == MOVING_CLOCK_FORWARD) then + coords % localID = coords % localID - self % nAz(i) + 1 + + ! Need to be replaced with find subroutines in the general case, sadly + else if (surfIdx == MOVING_IN) then + if (self % nAz(i) == self % nAz(i-1)) then + coords % localID = coords % localID - self % nAz(i) + else + call self % findCell(coords % localID, coords % cellIdx, coords % r, coords % dir) + end if + else if (surfIdx == MOVING_OUT) then + if (self % nAz(i) == self % nAz(i+1)) then + coords % localID = coords % localID + self % nAz(i) + else + call self % findCell(coords % localID, coords % cellIdx, coords % r, coords % dir) + end if + else + call fatalError(Here, 'Unknown surface memento: '//numToChar(surfIdx)) + + end if + + end subroutine cross + + !! + !! Return offset for the current cell + !! + !! See universe_inter for details. + !! + function cellOffset(self, coords) result (offset) + class(azimPinUniverse), intent(in) :: self + type(coord), intent(in) :: coords + real(defReal), dimension(3) :: offset + + ! There is no cell offset + offset = ZERO + + end function cellOffset + + !! + !! Return to uninitialised state + !! + subroutine kill(self) + class(azimPinUniverse), intent(inout) :: self + + ! Superclass + call kill_super(self) + + ! Kill local + if(allocated(self % r_sq)) deallocate(self % r_sq) + if(allocated(self % annuli)) deallocate(self % annuli) + if(allocated(self % theta)) deallocate(self % theta) + if(allocated(self % planes)) deallocate(self % planes) + if(allocated(self % normals)) deallocate(self % normals) + if(allocated(self % nAz)) deallocate(self % nAz) + + end subroutine kill + +end module azimPinUniverse_class diff --git a/Geometry/Universes/latUniverse_class.f90 b/Geometry/Universes/latUniverse_class.f90 index 8232ca6f8..9f7453065 100644 --- a/Geometry/Universes/latUniverse_class.f90 +++ b/Geometry/Universes/latUniverse_class.f90 @@ -41,6 +41,7 @@ module latUniverse_class !! type latUniverse; !! #origin (0.0 0.0 0.0); # !! #rotation (30.0 0.0 0.0); # + !! #offset 1; # !! shape (3 2 2); !! pitch (1.0 1.0 1.0); !! padMat ; @@ -82,6 +83,7 @@ module latUniverse_class real(defReal), dimension(3) :: a_bar = ZERO type(box) :: outline integer(shortInt) :: outLocalID = 0 + logical(defBool) :: offset = .true. contains ! Superclass procedures procedure :: init @@ -121,6 +123,9 @@ subroutine init(self, fill, dict, cells, surfs, mats) ! With: id, origin rotations... call self % setupBase(dict) + ! Perform offsets? + call dict % getOrDefault(self % offset, 'offset', .true.) + ! Load pitch call dict % get(temp, 'pitch') N = size(temp) @@ -332,7 +337,7 @@ function cellOffset(self, coords) result (offset) type(coord), intent(in) :: coords real(defReal), dimension(3) :: offset - if (coords % localID == self % outLocalID) then + if ((coords % localID == self % outLocalID) .or. .not. self % offset) then offset = ZERO else @@ -358,6 +363,7 @@ subroutine kill(self) self % a_bar = ZERO call self % outline % kill() self % outLocalID = 0 + self % offset = .true. end subroutine kill diff --git a/Geometry/Universes/universeFactory_func.f90 b/Geometry/Universes/universeFactory_func.f90 index 551cc6a23..1c42f0c1f 100644 --- a/Geometry/Universes/universeFactory_func.f90 +++ b/Geometry/Universes/universeFactory_func.f90 @@ -11,19 +11,21 @@ module universeFactory_func use universe_inter, only : universe ! Universes - use rootUniverse_class, only : rootUniverse - use cellUniverse_class, only : cellUniverse - use pinUniverse_class, only : pinUniverse - use latUniverse_class, only : latUniverse + use rootUniverse_class, only : rootUniverse + use cellUniverse_class, only : cellUniverse + use pinUniverse_class, only : pinUniverse + use azimPinUniverse_class, only : azimPinUniverse + use latUniverse_class, only : latUniverse implicit none private ! List contains acceptable types of universe ! NOTE: It is necessary to adjust trailing blanks so all entries have the same length - character(nameLen), dimension(*), parameter :: AVAILABLE_UNI = ['rootUniverse',& - 'cellUniverse',& - 'pinUniverse ',& - 'latUniverse '] + character(nameLen), dimension(*), parameter :: AVAILABLE_UNI = ['rootUniverse ',& + 'cellUniverse ',& + 'pinUniverse ',& + 'azimPinUniverse ',& + 'latUniverse '] ! Public Interface public :: new_universe_ptr @@ -69,6 +71,9 @@ subroutine new_universe_ptr(ptr, fill, dict, cells, surfs, mats) case ('pinUniverse') allocate(pinUniverse :: ptr) + case ('azimPinUniverse') + allocate(azimPinUniverse :: ptr) + case ('latUniverse') allocate(latUniverse :: ptr) diff --git a/Geometry/geomGraph_class.f90 b/Geometry/geomGraph_class.f90 index d9cce614e..e9804ed71 100644 --- a/Geometry/geomGraph_class.f90 +++ b/Geometry/geomGraph_class.f90 @@ -51,26 +51,32 @@ module geomGraph_class !! array -> Array with graph data !! uniqueCells -> Number of uniqueCells in the structure !! usedMats -> Sorted list of matIdxs which are used in the geometry + !! isExtended -> Logical stating whether or not the graph is extended !! !! Interface: - !! init -> Build fron uniFills and dictionary definition - !! getFill -> Get filling information at location given by uniRootIr & localID - !! kill -> Return to uninitialised state + !! init -> Build fron uniFills and dictionary definition + !! getFill -> Get filling invormation at location given by uniRootIr & localID + !! getMatFromUID -> Get material ID given a cell unique ID + !! kill -> Return to uninitialised state !! type, public :: geomGraph type(location), dimension(:), allocatable :: array integer(shortInt) :: uniqueCells = 0 integer(shortInt), dimension(:), allocatable :: usedMats + integer(shortInt), dimension(:), allocatable :: matsByCell + logical(defBool) :: isExtended = .FALSE. contains procedure :: init procedure :: getFill + procedure :: getMatFromUID procedure :: kill ! Private procedures procedure, private :: buildShrunk procedure, private :: buildExtended procedure, private :: setUniqueIDs + procedure, private :: buildMatArrayByCell end type geomGraph contains @@ -145,7 +151,27 @@ elemental subroutine getFill(self, idx, id, uniRootID, localID) id = self % array(uniRootId + localID -1) % id end subroutine getFill + + !! + !! Given a valid unique ID, returns a material index. + !! No checks, so make sure not to feed something incorrect... + !! + !! Args: + !! ID -> uniqueID of a cell + !! + !! Result: + !! matIdx -> material index of the cell's contents + !! + !! + pure function getMatFromUID(self, ID) result(matIdx) + class(geomGraph), intent(in) :: self + integer(shortInt), intent(in) :: ID + integer(shortInt) :: matIdx + matIdx = self % matsByCell(ID) + + end function getMatFromUID + !! !! Return to uninitialised state !! @@ -229,6 +255,8 @@ subroutine buildShrunk(self, fills) ! Set unique IDs -> Enumerate sinks call self % setUniqueIDs() + call self % buildMatArrayByCell() + end subroutine buildShrunk !! @@ -291,6 +319,10 @@ subroutine buildExtended(self, fills) ! Set unique IDs -> Enumerate sinks call self % setUniqueIDs() + self % isExtended = .TRUE. + + call self % buildMatArrayByCell() + end subroutine buildExtended !! @@ -344,6 +376,27 @@ subroutine setUniqueIDs(self) end subroutine setUniqueIDs + !! + !! Builds an array of material indices corresponding to cell uniqueIDs. + !! This allows for more quickly finding matIdxs given a unique ID. + !! + subroutine buildMatArrayByCell(self) + class(geomGraph), intent(inout) :: self + integer(shortInt) :: i, cells, fill + + allocate(self % matsByCell(self % uniqueCells)) + + cells = 0 + do i = 1, size(self % array) + fill = self % array(i) % idx + if (fill > 0) then ! It is material filling + cells = cells + 1 + self % matsByCell(cells) = fill + end if + end do + + end subroutine buildMatArrayByCell + !! !! Put universe data on the array !! diff --git a/Geometry/geometryStd_class.f90 b/Geometry/geometryStd_class.f90 index 49fb71230..febad3245 100644 --- a/Geometry/geometryStd_class.f90 +++ b/Geometry/geometryStd_class.f90 @@ -30,14 +30,16 @@ module geometryStd_class !! universes. !! !! Boundary conditions in diffrent movement models are handeled: - !! move -> explicitBC - !! moveGlobal -> explicitBC - !! teleport -> Co-ordinate transfrom + !! move -> explicitBC + !! moveGlobal -> explicitBC + !! moveRay -> explicitBC with vacuum handled as reflective + !! moveRayGlobal -> explicitBC with vacuum handled as reflective + !! teleport -> Co-ordinate transfrom !! !! Sample Dictionary Input: !! geometry { !! type geometryStd; - !! + !! !! } !! !! Public Members: @@ -59,9 +61,12 @@ module geometryStd_class procedure :: bounds procedure :: move_noCache procedure :: move_withCache + procedure :: moveRay_noCache + procedure :: moveRay_withCache procedure :: moveGlobal procedure :: teleport procedure :: activeMats + procedure :: numberOfCells ! Private procedures procedure, private :: diveToMat @@ -270,6 +275,8 @@ subroutine move_withCache(self, coords, maxDist, event, cache) character(100), parameter :: Here = 'move_withCache (geometryStd_class.f90)' if (.not.coords % isPlaced()) then + print *, coords % lvl(1) % r + print *, coords % lvl(1) % dir call fatalError(Here, 'Coordinate list is not placed in the geometry') end if @@ -314,6 +321,142 @@ subroutine move_withCache(self, coords, maxDist, event, cache) end if end subroutine move_withCache + + !! + !! Given coordinates placed in the geometry move point through the geometry + !! + !! See geometry_inter for details + !! + !! Uses explicit BC while treating vacuum boundaries as reflective + !! + subroutine moveRay_noCache(self, coords, maxDist, event, hitVacuum) + class(geometryStd), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + logical(defBool), intent(out) :: hitVacuum + integer(shortInt) :: surfIdx, level + real(defReal) :: dist + class(surface), pointer :: surf + class(universe), pointer :: uni + character(100), parameter :: Here = 'moveRay_noCache (geometryStd_class.f90)' + + hitVacuum = .FALSE. + + if (.not.coords % isPlaced()) then + print *, coords % lvl(1) % r + print *, coords % lvl(1) % dir + call fatalError(Here, 'Coordinate list is not placed in the geometry') + end if + + ! Find distance to the next surface + call self % closestDist(dist, surfIdx, level, coords) + + if (maxDist < dist) then ! Moves within cell + call coords % moveLocal(maxDist, coords % nesting) + event = COLL_EV + maxDist = maxDist ! Left for explicitness. Compiler will not stand it anyway + + else if (surfIdx == self % geom % borderIdx .and. level == 1) then ! Hits domain boundary + ! Move global to the boundary + call coords % moveGlobal(dist) + event = BOUNDARY_EV + maxDist = dist + + ! Get boundary surface and apply BCs + surf => self % geom % surfs % getPtr(self % geom % borderIdx) + call surf % explicitRayBC(coords % lvl(1) % r, coords % lvl(1) % dir, hitVacuum) + + ! Place back in geometry + call self % placeCoord(coords) + + else ! Crosses to diffrent local cell + ! Move to boundary at hit level + call coords % moveLocal(dist, level) + event = CROSS_EV + maxDist = dist + + ! Get universe and cross to the next cell + uni => self % geom % unis % getPtr_fast(coords % lvl(level) % uniIdx) + call uni % cross(coords % lvl(level), surfIdx) + + ! Get material + call self % diveToMat(coords, level) + + end if + + end subroutine moveRay_noCache + + + !! + !! Given coordinates placed in the geometry move point through the geometry + !! + !! See geometry_inter for details + !! + !! Uses explicit BC while treating vacuum boundaries as reflective + !! + subroutine moveRay_withCache(self, coords, maxDist, event, cache, hitVacuum) + class(geometryStd), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + type(distCache), intent(inout) :: cache + logical(defBool), intent(out) :: hitVacuum + integer(shortInt) :: surfIdx, level + real(defReal) :: dist + class(surface), pointer :: surf + class(universe), pointer :: uni + character(100), parameter :: Here = 'moveRay_withCache (geometryStd_class.f90)' + + hitVacuum = .FALSE. + + if (.not.coords % isPlaced()) then + print *, coords % lvl(1) % r + print *, coords % lvl(1) % dir + call fatalError(Here, 'Coordinate list is not placed in the geometry') + end if + + ! Find distance to the next surface + call self % closestDist_cache(dist, surfIdx, level, coords, cache) + + if (maxDist < dist) then ! Moves within cell + call coords % moveLocal(maxDist, coords % nesting) + event = COLL_EV + maxDist = maxDist ! Left for explicitness. Compiler will not stand it anyway + cache % lvl = 0 + + else if (surfIdx == self % geom % borderIdx .and. level == 1) then ! Hits domain boundary + ! Move global to the boundary + call coords % moveGlobal(dist) + event = BOUNDARY_EV + maxDist = dist + cache % lvl = 0 + + ! Get boundary surface and apply BCs + surf => self % geom % surfs % getPtr(self % geom % borderIdx) + call surf % explicitRayBC(coords % lvl(1) % r, coords % lvl(1) % dir, hitVacuum) + + ! Place back in geometry + call self % placeCoord(coords) + + else ! Crosses to diffrent local cell + ! Move to boundary at hit level + call coords % moveLocal(dist, level) + event = CROSS_EV + maxDist = dist + cache % dist(1:level-1) = cache % dist(1:level-1) - dist + cache % lvl = level - 1 + + ! Get universe and cross to the next cell + uni => self % geom % unis % getPtr_fast(coords % lvl(level) % uniIdx) + call uni % cross(coords % lvl(level), surfIdx) + + ! Get material + call self % diveToMat(coords, level) + + end if + + end subroutine moveRay_withCache !! !! Move a particle in the top (global) level in the geometry @@ -422,6 +565,20 @@ function activeMats(self) result(matList) end if end function activeMats + + !! + !! Returns the number of unique cells present in the geometry + !! + !! See geometry_inter for details + !! + function numberOfCells(self) result(n) + class(geometryStd), intent(in) :: self + integer(shortInt) :: n + + ! Takes the number of cells from geomGraph + n = self % geom % graph % uniqueCells + + end function numberOfCells !! !! Descend down the geometry structure until material is reached diff --git a/Geometry/geometry_inter.f90 b/Geometry/geometry_inter.f90 index 973007549..a9e639a6d 100644 --- a/Geometry/geometry_inter.f90 +++ b/Geometry/geometry_inter.f90 @@ -30,23 +30,27 @@ module geometry_inter type, public, abstract :: geometry contains ! Generic procedures - generic :: move => move_noCache, move_withCache + generic :: move => move_noCache, move_withCache, moveRay_withCache, moveRay_noCache ! Deferred procedures - procedure(init), deferred :: init - procedure(kill), deferred :: kill - procedure(placeCoord), deferred :: placeCoord - procedure(whatIsAt), deferred :: whatIsAt - procedure(bounds), deferred :: bounds - procedure(move_noCache), deferred :: move_noCache - procedure(move_withCache), deferred :: move_withCache - procedure(moveGlobal), deferred :: moveGlobal - procedure(teleport), deferred :: teleport - procedure(activeMats), deferred :: activeMats + procedure(init), deferred :: init + procedure(kill), deferred :: kill + procedure(placeCoord), deferred :: placeCoord + procedure(whatIsAt), deferred :: whatIsAt + procedure(bounds), deferred :: bounds + procedure(move_noCache), deferred :: move_noCache + procedure(move_withCache), deferred :: move_withCache + procedure(moveRay_noCache), deferred :: moveRay_noCache + procedure(moveRay_withCache), deferred :: moveRay_withCache + procedure(moveGlobal), deferred :: moveGlobal + procedure(teleport), deferred :: teleport + procedure(activeMats), deferred :: activeMats + procedure(numberOfCells), deferred :: numberOfCells ! Common procedures procedure :: slicePlot - procedure :: voxelplot + procedure :: voxelPlot + end type geometry abstract interface @@ -133,13 +137,13 @@ end function bounds !! !! Given coordinates placed in the geometry move point through the geometry !! - !! Move by up to maxDist stopping at domain boundary or untill matIdx or uniqueID changes + !! Move by up to maxDist stopping at domain boundary or untill matIdx or uniqueID changes. !! When particle hits boundary, boundary conditions are applied before returning. !! !! Following events can be returned: !! COLL_EV -> Particle moved by entire maxDist. Collision happens !! BOUNDARY_EV -> Particle hit domain boundary - !! CROSS_EV -> Partilce crossed to a region with different matIdx or uniqueID + !! CROSS_EV -> Particle crossed to a region with different matIdx or uniqueID !! LOST_EV -> Something gone wrong in tracking and particle is lost !! !! Args: @@ -164,7 +168,7 @@ end subroutine move_noCache !! !! Given coordinates placed in the geometry move point through the geometry !! - !! Move by up to maxDist stopping at domain boundary or untill matIdx or uniqueID changes + !! Move by up to maxDist stopping at domain boundary or until matIdx or uniqueID changes. !! When particle hits boundary, boundary conditions are applied before returning. !! !! Use distance cache to avoid needless recalculation of the next crossing at @@ -173,12 +177,12 @@ end subroutine move_noCache !! Following events can be returned: !! COLL_EV -> Particle moved by entire maxDist. Collision happens !! BOUNDARY_EV -> Particle hit domain boundary - !! CROSS_EV -> Partilce crossed to a region with different matIdx or uniqueID + !! CROSS_EV -> Particle crossed to a region with different matIdx or uniqueID !! LOST_EV -> Something gone wrong in tracking and particle is lost !! !! Args: !! coords [inout] -> Coordinate list of the particle to be moved through the geometry - !! maxDict [inout] -> Maximum distance to move the position. If movment is stopped + !! maxDict [inout] -> Maximum distance to move the position. If movement is stopped !! prematurely (e.g. hitting boundary), maxDist is set to the distance the particle has !! moved by. !! event [out] -> Event flag that specifies what finished the movement. @@ -196,6 +200,47 @@ subroutine move_withCache(self, coords, maxDist, event, cache) type(distCache), intent(inout) :: cache end subroutine move_withCache + !! + !! Move, but ensuring that vacuum boundaries are treated as reflective and communicating + !! a vacuum strike back. + !! This is implemented for handling Random Ray/MoC problems where rays are not terminated + !! as they strike a vacuum boundary, but are instead reflected. + !! + !! Identical in interface to move, with the exception that a flag is included + !! for identifying a vacuum boundary hit: + !! + !! hitVacuum [out] -> false if a vacuum was not hit, true if it was. + !! + subroutine moveRay_noCache(self, coords, maxDist, event, hitVacuum) + import :: geometry, coordList, defReal, shortInt, defBool + class(geometry), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + logical(defBool), intent(out) :: hitVacuum + end subroutine moveRay_noCache + + !! + !! Move, but ensuring that vacuum boundaries are treated as reflective and communicating + !! a vacuum strike back. + !! This is implemented for handling Random Ray/MoC problems where rays are not terminated + !! as they strike a vacuum boundary, but are instead reflected. + !! + !! Identical in interface to move_withCache, with the exception that a flag is included + !! for identifying a vacuum boundary hit: + !! + !! hitVacuum [out] -> false if a vacuum was not hit, true if it was. + !! + subroutine moveRay_withCache(self, coords, maxDist, event, cache, hitVacuum) + import :: geometry, coordList, defReal, shortInt, distCache, defBool + class(geometry), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + type(distCache), intent(inout) :: cache + logical(defBool), intent(out) :: hitVacuum + end subroutine moveRay_withCache + !! !! Move a particle in the top (global) level in the geometry !! @@ -207,7 +252,7 @@ end subroutine move_withCache !! BOUNDARY_EV -> Particle hit domain boundary !! !! Args: - !! coords [inout] -> Initialised (but not necesserly placed) coordList for a particle to be + !! coords [inout] -> Initialised (but not necessarily placed) coordList for a particle to be !! moved. Will become placed on exit. !! maxDict [inout] -> Maximum distance to move the position. If movment is stopped !! prematurely (e.g. hitting boundary), maxDist is set to the distance the particle has @@ -232,9 +277,9 @@ end subroutine moveGlobal !! applied and movement continious untill full distance is reached. !! !! Args: - !! coords [inout] -> Initialised (but not necesserly placed) coordList for a particle to be - !! moved. Will become placed on exit. - !! dist [in] -> Distance by which move the particle + !! coords [inout] -> Initialised (but not necessarily placed) coordList for a particle to be + !! moved. Will become placed on exit. + !! dist [in] -> Distance by which to move the particle !! !! Errors: !! If maxDist < 0.0 behaviour is unspecified @@ -262,6 +307,21 @@ function activeMats(self) result(matList) integer(shortInt), dimension(:), allocatable :: matList end function activeMats + !! + !! Returns the number of unique cells present in the geometry + !! + !! Args: + !! None + !! + !! Result: + !! Integer of the number of unique (material containing) cells in the geometry. + !! + function numberOfCells(self) result(n) + import :: geometry, shortInt + class(geometry), intent(in) :: self + integer(shortInt) :: n + end function numberOfCells + end interface contains diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_RoddedB_TRRM b/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_RoddedB_TRRM new file mode 100644 index 000000000..a47dad612 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_RoddedB_TRRM @@ -0,0 +1,1142 @@ +type randomRayPhysicsPackage; + +pop 117000; +active 950; +inactive 1525; +dead 12.56; +termination 628.12; +plot 0; +cache 1; +XSdata mg; +dataType mg; +outputFile C5G7_RoddedB_TRRM ; + +tally { + fiss_flx { type rayClerk; response (fiss flx); + fiss {type macroResponse; MT -6;} + flx {type fluxResponse;} + map {type multiMap; + maps (xax yax); + xax { type spaceMap; axis x; grid lin; min -32.13; max 32.13; N 51;} + yax { type spaceMap; axis y; grid lin; min -32.13; max 32.13; N 51;} + } + } +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 0 1 1 0); + graph {type extended;} + + surfaces { + Domain { id 3; type box; origin (0.0 0.0 0.0); halfwidth (32.13 32.13 32.13);} + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { id 1; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (UO2 UO2 UO2 water water water);} + pin2 { id 2; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (GT GT GT water water water);} + pin3 { id 3; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox43 mox43 mox43 water water water);} + pin4 { id 4; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox7 mox7 mox7 water water water);} + pin5 { id 5; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox87 mox87 mox87 water water water);} + pin6 { id 6; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (FC FC FC water water water);} + + // Control rod + pin7 { id 7; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0); rotation (22.5 0 0); fills (CR CR CR water water water);} + + // Infinite moderator + pin30 { id 30; type pinUniverse; radii (0.0); fills (water);} + +// Lattices +latUO2{ + id 10; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 6 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOX{ + id 20; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 6 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latJustRods { + id 21; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 7 40 40 7 40 40 7 40 40 40 40 40 + 40 40 40 7 40 40 40 40 40 40 40 40 40 7 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 7 40 40 7 40 40 7 40 40 7 40 40 7 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 7 40 40 7 40 40 40 40 40 7 40 40 7 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 7 40 40 7 40 40 7 40 40 7 40 40 7 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 7 40 40 40 40 40 40 40 40 40 7 40 40 40 + 40 40 40 40 40 7 40 40 7 40 40 7 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +); +} + +latFineModer +{ +id 40; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (0.126 0.126 0.0); +shape (10 10 0); +padMat water; +map ( +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +); +} + +latModUp +{ +id 50; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latModLeft +{ +id 60; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +); +} + +latModCorner +{ +id 70; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latUO2Rod{ + id 80; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 7 1 1 7 1 1 7 1 1 1 1 1 + 1 1 1 7 1 1 1 1 1 1 1 1 1 7 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 7 1 1 7 1 1 7 1 1 7 1 1 7 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 7 1 1 7 1 1 6 1 1 7 1 1 7 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 7 1 1 7 1 1 7 1 1 7 1 1 7 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 7 1 1 1 1 1 1 1 1 1 7 1 1 1 + 1 1 1 1 1 7 1 1 7 1 1 7 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOXRod{ + id 90; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 7 4 4 7 4 4 7 4 4 4 4 3 + 3 4 4 7 4 5 5 5 5 5 5 5 4 7 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 7 5 5 2 5 5 7 5 5 7 5 5 7 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 7 5 5 7 5 5 6 5 5 7 5 5 7 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 7 5 5 7 5 5 7 5 5 7 5 5 7 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 7 4 5 5 5 5 5 5 5 4 7 4 4 3 + 3 4 4 4 4 7 4 4 7 4 4 7 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latCore +{ + id 100; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (21.42 21.42 0.357); + shape (3 3 180); + padMat water; + map ( + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +); +} + +} + +} + +viz { +// bmp1 { +// type bmp; +// output material_yz; +// what material; +// centre (-21.42 0.0 0.0); +// axis x; +// res (2000 2000); } +// bmp2 { +// type bmp; +// output material_xy; +// what material; +// centre (0.0 0.0 31.0); +// axis z; +// res (2000 2000); } +// bmp3 { +// type bmp; +// output ID_yz; +// what uniqueID; +// centre (-21.42 0.0 0.0); +// axis x; +// res (2000 2000); } +// myVTK { +// type vtk; +// what uniqueID; +// centre (-21.42 0.0 0.0); +// axis x; +// res (2000 2000); } + myVTK { + type vtk; + what uniqueID; + corner (-21.42 -32.13 -32.13); + width (0.1 64.26 64.26); + vox (1 2000 2000); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + numberOfGroups 7; + + water { + temp 300; + xsFile ../XS_C5G7/moder; + composition { } + } + + mox43 { + temp 300; + xsFile ../XS_C5G7/MOX43; + composition { } + } + + mox7 { + temp 300; + xsFile ../XS_C5G7/MOX7; + composition { } + } + + mox87 { + temp 300; + xsFile ../XS_C5G7/MOX87; + composition { } + } + + UO2 { + temp 300; + xsFile ../XS_C5G7/UO2; + composition { } + } + + // Fission chamber + FC { + temp 300; + xsFile ../XS_C5G7/FC; + composition { } + } + + // Guide tube + GT { + temp 300; + xsFile ../XS_C5G7/GT; + composition { } + } + + // Control rod + CR { + temp 300; + xsFile ../XS_C5G7/CR; + composition { } + } +} +} + + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_TRRM b/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_TRRM new file mode 100644 index 000000000..f4f8a77be --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_TRRM @@ -0,0 +1,302 @@ +type randomRayPhysicsPackage; +lin 0; +pop 1750; +active 1000; +inactive 700; +dead 20; +termination 220; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile C5G7_TRRM; + +tally { + fiss_flx { type rayClerk; response (fiss flx); + fiss {type macroResponse; MT -6;} + flx {type fluxResponse;} + map {type multiMap; + maps (xax yax); + xax { type spaceMap; axis x; grid lin; min -32.13; max 32.13; N 51;} + yax { type spaceMap; axis y; grid lin; min -32.13; max 32.13; N 51;} + } + } +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 0 1 1 1); + graph {type extended;} + + surfaces { + Domain { id 3; type box; origin (0.0 0.0 0.0); halfwidth (32.13 32.13 32.13);} + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { id 1; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (UO2 UO2 UO2 water water water);} + pin2 { id 2; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (GT GT GT water water water);} + pin3 { id 3; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox43 mox43 mox43 water water water);} + pin4 { id 4; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox7 mox7 mox7 water water water);} + pin5 { id 5; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox87 mox87 mox87 water water water);} + pin6 { id 6; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (FC FC FC water water water);} + + // Infinite moderator + pin30 { id 30; type pinUniverse; radii (0.0); fills (water);} + +// Lattices +latUO2{ + id 10; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 6 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOX{ + id 20; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 6 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latFineModer +{ +id 40; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (0.126 0.126 0.0); +shape (10 10 0); +padMat water; +map ( +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +); +} + +latModUp +{ +id 50; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latModLeft +{ +id 60; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +); +} + +latModCorner +{ +id 70; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latCore +{ + id 100; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (21.42 21.42 0.0); + shape (3 3 0); + padMat water; + map ( +10 20 60 +20 10 60 +50 50 70 +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner (-32.13 -32.13 -1.0); + width (64.26 64.26 2.0); + vox (2000 2000 1); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + water { + temp 300; + xsFile ./XS_C5G7/moder; + composition { } + } + + mox43 { + temp 300; + xsFile ./XS_C5G7/MOX43; + composition { } + } + + mox7 { + temp 300; + xsFile ./XS_C5G7/MOX7; + composition { } + } + + mox87 { + temp 300; + xsFile ./XS_C5G7/MOX87; + composition { } + } + + UO2 { + temp 300; + xsFile ./XS_C5G7/UO2; + composition { } + } + + // Fission chamber + FC { + temp 300; + xsFile ./XS_C5G7/FC; + composition { } + } + + // Guide tube + GT { + temp 300; + xsFile ./XS_C5G7/GT; + composition { } + } + +} +} + + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_TRRM_coarse b/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_TRRM_coarse new file mode 100644 index 000000000..f66f7262a --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/C5G7_TRRM_coarse @@ -0,0 +1,296 @@ +type randomRayPhysicsPackage; + +lin 1; +2d 1; +pop 1750; +active 1200; +inactive 1000; +dead 20; +termination 220; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile C5G7_TRRM_coarse; + +tally { + fiss_flx { type rayClerk; response (fiss flx); + fiss {type macroResponse; MT -6;} + flx {type fluxResponse;} + map {type multiMap; + maps (xax yax); + xax { type spaceMap; axis x; grid lin; min -32.13; max 32.13; N 51;} + yax { type spaceMap; axis y; grid lin; min -32.13; max 32.13; N 51;} + } + } +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 0 1 1 1); + graph {type extended;} + + surfaces { + Domain { id 3; type box; origin (0.0 0.0 0.0); halfwidth (32.13 32.13 32.13);} + } + + cells {} + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { id 1; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (UO2 water);} + pin2 { id 2; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (GT water);} + pin3 { id 3; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (mox43 water);} + pin4 { id 4; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (mox7 water);} + pin5 { id 5; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (mox87 water);} + pin6 { id 6; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (FC water);} + + // Infinite moderator + pin30 { id 30; type pinUniverse; radii (0.0); fills (water);} + +// Lattices +latUO2{ + id 10; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 6 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOX{ + id 20; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 6 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latFineModer +{ +id 40; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (0.63 0.63 0.0); +shape (2 2 0); +padMat water; +map ( +30 30 +30 30 +); +} + +latModUp +{ +id 50; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latModLeft +{ +id 60; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +); +} + +latModCorner +{ +id 70; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latCore +{ + id 100; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (21.42 21.42 0.0); + shape (3 3 0); + padMat water; + map ( +10 20 60 +20 10 60 +50 50 70 +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner (-32.13 -32.13 -1.0); + width (64.26 64.26 2.0); + vox (2000 2000 1); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + water { + temp 300; + xsFile ./XS_C5G7/moder; + composition { } + } + + mox43 { + temp 300; + xsFile ./XS_C5G7/MOX43; + composition { } + } + + mox7 { + temp 300; + xsFile ./XS_C5G7/MOX7; + composition { } + } + + mox87 { + temp 300; + xsFile ./XS_C5G7/MOX87; + composition { } + } + + UO2 { + temp 300; + xsFile ./XS_C5G7/UO2; + composition { } + } + + // Fission chamber + FC { + temp 300; + xsFile ./XS_C5G7/FC; + composition { } + } + + // Guide tube + GT { + temp 300; + xsFile ./XS_C5G7/GT; + composition { } + } + +} +} + + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/CR b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/CR new file mode 100644 index 000000000..e4dbeae5b --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/CR @@ -0,0 +1,31 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (1.7049E-03 8.36224E-03 8.37901E-02 3.97797E-01 6.98763E-01 9.29508E-01 1.17836); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +1.70563E-01 4.44012E-02 9.83670E-05 1.27786E-07 0.0 0.000000E+00 0.000000E+00 +0.000000E+00 4.71050E-01 6.85480E-04 3.91395E-10 0.0 0.0 0.0 +0.000000E+00 0.000000E+00 8.01859E-01 7.20132E-04 0.0 0.0 0.0 +0.000000E+00 0.000000E+00 0.000000E+00 5.70752E-01 1.46015E-03 0.0 0.0 +0.000000E+00 0.000000E+00 0.000000E+00 6.55562E-05 2.07838E-01 3.81486E-03 3.69760E-9 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.02427E-03 2.02465E-01 4.75290E-3 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 3.53043E-03 6.58597E-01 +); + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/FC b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/FC new file mode 100644 index 000000000..441cd9895 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/FC @@ -0,0 +1,34 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (5.113152100E-04 7.580717436E-05 3.159662810E-04 1.162255940E-03 3.397554610E-03 9.187885028E-03 2.324191959E-02); +fission (4.790020000E-09 5.825640000E-09 4.637190000E-07 5.244060000E-06 1.453900000E-07 7.149720000E-07 2.080410000E-06); +nu ( 2.762829800E+00 2.462390398E+00 2.433799348E+00 2.433799384E+00 2.433800124E+00 2.433800205E+00 2.433800068E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +6.616590000E-02 5.907000000E-02 2.833400000E-04 1.462200000E-06 2.064200000E-08 0.000000000E+00 0.000000000E+00 +0.000000000E+00 2.403770000E-01 5.243500000E-02 2.499000000E-04 1.923900000E-05 2.987500000E-06 4.214000000E-07 +0.000000000E+00 0.000000000E+00 1.834250000E-01 9.228800000E-02 6.936500000E-03 1.079000000E-03 2.054300000E-04 +0.000000000E+00 0.000000000E+00 0.000000000E+00 7.907690000E-02 1.699900000E-01 2.586000000E-02 4.925600000E-03 +0.000000000E+00 0.000000000E+00 0.000000000E+00 3.734000000E-05 9.975700000E-02 2.067900000E-01 2.447800000E-02 +0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 9.174200000E-04 3.167740000E-01 2.387600000E-01 +0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 4.979300000E-02 1.099100000E+00 +); + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/GT b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/GT new file mode 100644 index 000000000..77ed9f30f --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/GT @@ -0,0 +1,31 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (5.113200E-04 7.580100E-05 3.157200E-04 1.158200E-03 3.397500E-03 9.187800E-03 2.324200E-02); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +6.616590E-02 5.907000E-02 2.833400E-04 1.462200E-06 2.064200E-08 0.000000E+00 0.000000E+00 +0.000000E+00 2.403770E-01 5.243500E-02 2.499000E-04 1.923900E-05 2.987500E-06 4.214000E-07 +0.000000E+00 0.000000E+00 1.832970E-01 9.239700E-02 6.944600E-03 1.080300E-03 2.056700E-04 +0.000000E+00 0.000000E+00 0.000000E+00 7.885110E-02 1.701400E-01 2.588100E-02 4.929700E-03 +0.000000E+00 0.000000E+00 0.000000E+00 3.733300E-05 9.973720E-02 2.067900E-01 2.447800E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 9.172600E-04 3.167650E-01 2.387700E-01 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.979200E-02 1.099120E+00 +); + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX43 b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX43 new file mode 100644 index 000000000..46054ba02 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX43 @@ -0,0 +1,36 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (8.0686000E-04 2.8808020E-03 2.2271650E-02 8.1322800E-02 1.2917650E-01 1.7642300E-01 1.6038200E-01); + +fission ( 7.627040E-03 8.768980E-04 5.698350E-03 2.288720E-02 1.076350E-02 2.327570E-01 2.489680E-01); + +nu (2.852089E+00 2.890990E+00 2.854860E+00 2.860730E+00 2.854470E+00 2.864150E+00 2.867800E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +1.288760E-01 4.141300E-02 8.229000E-06 5.040500E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 3.254520E-01 1.639500E-03 1.598200E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 4.531880E-01 2.614200E-03 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 4.571730E-01 5.539400E-03 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 1.604600E-04 2.768140E-01 9.312700E-03 9.165600E-09 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.005100E-03 2.529620E-01 1.485000E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 8.494800E-03 2.650070E-01 +); + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX7 b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX7 new file mode 100644 index 000000000..3db4c6cb1 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX7 @@ -0,0 +1,36 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (8.112400E-04 2.971050E-03 2.445944E-02 8.915700E-02 1.670164E-01 2.446660E-01 2.224070E-01); +fission (8.254460E-03 1.325650E-03 8.421560E-03 3.287300E-02 1.596360E-02 3.237940E-01 3.628030E-01); +nu ( 2.884980E+00 2.910790E+00 2.865740E+00 2.870630E+00 2.867140E+00 2.866580E+00 2.875390E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + + +P0 ( +1.304570E-01 4.179200E-02 8.510500E-06 5.132900E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 3.284280E-01 1.643600E-03 2.201700E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 4.583710E-01 2.533100E-03 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 4.637090E-01 5.476600E-03 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 1.761900E-04 2.823130E-01 8.728900E-03 9.001600E-09 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.276000E-03 2.497510E-01 1.311400E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 8.864500E-03 2.595290E-01 +); + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX87 b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX87 new file mode 100644 index 000000000..6d47c4a11 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/MOX87 @@ -0,0 +1,34 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (8.141100E-04 3.031340E-03 2.596840E-02 9.367530E-02 1.891424E-01 2.838120E-01 2.595710E-01); +fission (8.672090E-03 1.624260E-03 1.027160E-02 3.904470E-02 1.925760E-02 3.748880E-01 4.305990E-01); +nu ( 2.904260E+00 2.917950E+00 2.869860E+00 2.874910E+00 2.871750E+00 2.867520E+00 2.878079E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +1.315040E-01 4.204600E-02 8.697200E-06 5.193800E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 3.304030E-01 1.646300E-03 2.600600E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 4.617920E-01 2.474900E-03 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 4.680210E-01 5.433000E-03 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 1.859700E-04 2.857710E-01 8.397300E-03 8.928000E-09 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.391600E-03 2.476140E-01 1.232200E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 8.968100E-03 2.560930E-01 +); + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/UO2 b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/UO2 new file mode 100644 index 000000000..ffb187b5d --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/UO2 @@ -0,0 +1,34 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; +capture ( 8.1274000E-04 2.8980990E-03 2.0315800E-02 7.7671200E-02 1.2211600E-02 2.8225200E-02 6.6776000E-02); +fission ( 7.212060E-3 8.193010E-4 6.453200E-3 1.856480E-2 1.780840E-2 8.303480E-2 2.160040E-1); +nu ( 2.7814494E+00 2.4744300E+00 2.4338297E+00 2.4338000E+00 2.43380E+00 2.43380E+00 2.43380E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +1.2753700E-01 4.2378000E-02 9.4374000E-06 5.5163000E-09 0.0000000E+00 0.0000000E+00 0.0000000E+00 +0.0000000E+00 3.2445600E-01 1.6314000E-03 3.1427000E-09 0.0000000E+00 0.0000000E+00 0.0000000E+00 +0.0000000E+00 0.0000000E+00 4.5094000E-01 2.6792000E-03 0.0000000E+00 0.0000000E+00 0.0000000E+00 +0.0000000E+00 0.0000000E+00 0.0000000E+00 4.5256500E-01 5.5664000E-03 0.0000000E+00 0.0000000E+00 +0.0000000E+00 0.0000000E+00 0.0000000E+00 1.2525000E-04 2.7140100E-01 1.0255000E-02 1.0021000E-08 +0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.2968000E-03 2.6580200E-01 1.6809000E-02 +0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 8.5458000E-03 2.7308000E-01 +); + + diff --git a/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/moder b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/moder new file mode 100644 index 000000000..029b934f1 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/C5G7/XS_C5G7/moder @@ -0,0 +1,31 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (6.010500E-04 1.579300E-05 3.371600E-04 1.940600E-03 5.741600E-03 1.500100E-02 3.723900E-02); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +4.447770E-02 1.134000E-01 7.234700E-04 3.749900E-06 5.318400E-08 0.000000E+00 0.000000E+00 +0.000000E+00 2.823340E-01 1.299400E-01 6.234000E-04 4.800200E-05 7.448600E-06 1.045500E-06 +0.000000E+00 0.000000E+00 3.452560E-01 2.245700E-01 1.699900E-02 2.644300E-03 5.034400E-04 +0.000000E+00 0.000000E+00 0.000000E+00 9.102840E-02 4.155100E-01 6.373200E-02 1.213900E-02 +0.000000E+00 0.000000E+00 0.000000E+00 7.143700E-05 1.391380E-01 5.118200E-01 6.122900E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.215700E-03 6.999130E-01 5.373200E-01 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.324400E-01 2.480700E+00 +); + diff --git a/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/absorberA b/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/absorberA new file mode 100644 index 000000000..2494eb505 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/absorberA @@ -0,0 +1,16 @@ +// This XS corresponds to the Case 2 for the Kobayashi dogleg benchmark + +numberOfGroups 1; + +capture ( +//0.05 //scatter case +0.10 // absorber case +); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + //0.05 // scatter case + 0.0 // absorber case +); + diff --git a/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/absorberS b/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/absorberS new file mode 100644 index 000000000..5f4b0c316 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/absorberS @@ -0,0 +1,14 @@ +// This XS corresponds to the Case 2 for the Kobayashi dogleg benchmark + +numberOfGroups 1; + +capture ( +0.05 //scatter case +); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + 0.05 // scatter case +); + diff --git a/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/voidA b/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/voidA new file mode 100644 index 000000000..adfd286ba --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/voidA @@ -0,0 +1,16 @@ +// This XS corresponds to the Case 2 for the Kobayashi dogleg benchmark + +numberOfGroups 1; + +capture ( +//0.5E-4 // scatter case +1.0E-4 // absorber case +); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + //0.5E-4 // scatter case + 0.0 // absorber case +); + diff --git a/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/voidS b/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/voidS new file mode 100644 index 000000000..5945ee09a --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/DogLeg/XS_dog/voidS @@ -0,0 +1,14 @@ +// This XS corresponds to the Case 2 for the Kobayashi dogleg benchmark + +numberOfGroups 1; + +capture ( +0.5E-4 // scatter case +); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + 0.5E-4 // scatter case +); + diff --git a/InputFiles/Benchmarks/RandomRay/DogLeg/dogleg_TRRM_absorb b/InputFiles/Benchmarks/RandomRay/DogLeg/dogleg_TRRM_absorb new file mode 100644 index 000000000..b15076cbf --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/DogLeg/dogleg_TRRM_absorb @@ -0,0 +1,467 @@ +type fixedSourceRRPhysicsPackage; + +pop 1000; +active 2100; +inactive 0; +dead 120; +termination 1220; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile dogleg_TRRM_absorb; + +source { sourceMat ( 1.0 ); } + +tally { + intFlux {type rayClerk; response (flx); flx {type fluxResponse;} + map {type materialMap; materials (sourceMat);} + } +} + +samplePoints { +A3_1 ( 5.0 5.0 5.0 ); +A3_2 ( 5.0 15.0 5.0 ); +A3_3 ( 5.0 25.0 5.0 ); +A3_4 ( 5.0 35.0 5.0 ); +A3_5 ( 5.0 45.0 5.0 ); +A3_6 ( 5.0 55.0 5.0 ); +A3_7 ( 5.0 65.0 5.0 ); +A3_8 ( 5.0 75.0 5.0 ); +A3_9 ( 5.0 85.0 5.0 ); +A3_10 ( 5.0 95.0 5.0 ); +B3_1 (5.0 55.0 5.0); +B3_2 (15.0 55.0 5.0); +B3_3 (25.0 55.0 5.0); +B3_4 (35.0 55.0 5.0); +B3_5 (45.0 55.0 5.0); +B3_6 (55.0 55.0 5.0); +C3_1 (5.0 95.0 35.0); +C3_2 (15.0 95.0 35.0); +C3_3 (25.0 95.0 35.0); +C3_4 (35.0 95.0 35.0); +C3_5 (45.0 95.0 35.0); +C3_6 (55.0 95.0 35.0); + +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 1 0 1 0 ); + graph { type extended; } + + surfaces { + Domain { id 3; type box; origin ( 30.0 50.0 30.0 ); halfwidth ( 30.0 50.0 30.0 ); } + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { type pinUniverse; id 1; radii ( 0.0 ); fills ( absorber ); } + pin2 { type pinUniverse; id 2; radii ( 0.0 ); fills ( voidMat ); } + pin3 { type pinUniverse; id 3; radii ( 0.0 ); fills ( sourceMat ); } + +// Lattices +latAbsCentred { + id 15; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.1111111111111111 1.1111111111111111 1.11111111111111 ); + shape ( 9 9 9 ); + padMat absorber; + map ( + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 +); +} + +latVoidCentred { + id 25; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.1111111111111111 1.11111111111111111 1.111111111111111111); + shape ( 9 9 9 ); + padMat voidMat; + map ( +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +); +} + +latSourceCentred { + id 35; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.11111111111111 1.111111111111111 1.11111111111111 ); + shape ( 9 9 9 ); + padMat sourceMat; + map ( +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +); +} + +latGeom +{ + id 100; + type latUniverse; + origin ( 30.0 50.0 30.0 ); + pitch ( 10.0 10.0 10.0 ); + shape ( 6 10 6 ); + padMat absorber; + map ( + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +25 25 25 25 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +35 15 15 15 15 15 + +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner ( 0.0 0.0 0.0 ); + width ( 60.0 100.0 60.0 ); + vox ( 60 100 60 ); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + absorber { + temp 300; + xsFile ./XS_dog/absorberA; + composition { } + } + + voidMat { + temp 300; + xsFile ./XS_dog/voidA; + composition { } + } + + sourceMat { + temp 300; + xsFile ./XS_dog/absorberA; + composition { } + } + + +} +} + + diff --git a/InputFiles/Benchmarks/RandomRay/DogLeg/dogleg_TRRM_scatter b/InputFiles/Benchmarks/RandomRay/DogLeg/dogleg_TRRM_scatter new file mode 100644 index 000000000..ea0fcaaf8 --- /dev/null +++ b/InputFiles/Benchmarks/RandomRay/DogLeg/dogleg_TRRM_scatter @@ -0,0 +1,466 @@ +type fixedSourceRRPhysicsPackage; +lin 0; +pop 1000; +active 2000; +inactive 100; +dead 120; +termination 1220; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile dogleg_TRRM_scatter; + +source { sourceMat ( 1.0 ); } + +tally { + intFlux {type rayClerk; response (flx); flx {type fluxResponse;} + map {type materialMap; materials (sourceMat absorber);} + } +} + +samplePoints { +A3_1 ( 5.0 5.0 5.0 ); +A3_2 ( 5.0 15.0 5.0 ); +A3_3 ( 5.0 25.0 5.0 ); +A3_4 ( 5.0 35.0 5.0 ); +A3_5 ( 5.0 45.0 5.0 ); +A3_6 ( 5.0 55.0 5.0 ); +A3_7 ( 5.0 65.0 5.0 ); +A3_8 ( 5.0 75.0 5.0 ); +A3_9 ( 5.0 85.0 5.0 ); +A3_10 ( 5.0 95.0 5.0 ); +B3_1 (5.0 55.0 5.0); +B3_2 (15.0 55.0 5.0); +B3_3 (25.0 55.0 5.0); +B3_4 (35.0 55.0 5.0); +B3_5 (45.0 55.0 5.0); +B3_6 (55.0 55.0 5.0); +C3_1 (5.0 95.0 35.0); +C3_2 (15.0 95.0 35.0); +C3_3 (25.0 95.0 35.0); +C3_4 (35.0 95.0 35.0); +C3_5 (45.0 95.0 35.0); +C3_6 (55.0 95.0 35.0); + +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 1 0 1 0 ); + graph { type extended; } + + surfaces { + Domain { id 3; type box; origin ( 30.0 50.0 30.0 ); halfwidth ( 30.0 50.0 30.0 ); } + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { type pinUniverse; id 1; radii ( 0.0 ); fills ( absorber ); } + pin2 { type pinUniverse; id 2; radii ( 0.0 ); fills ( voidMat ); } + pin3 { type pinUniverse; id 3; radii ( 0.0 ); fills ( sourceMat ); } + +// Lattices +latAbsCentred { + id 15; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.1111111111111111 1.1111111111111111 1.11111111111111 ); + shape ( 9 9 9 ); + padMat absorber; + map ( + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 +); +} + +latVoidCentred { + id 25; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.1111111111111111 1.11111111111111111 1.111111111111111111); + shape ( 9 9 9 ); + padMat voidMat; + map ( +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +); +} + +latSourceCentred { + id 35; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.11111111111111 1.111111111111111 1.11111111111111 ); + shape ( 9 9 9 ); + padMat absorber; + map ( +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +); +} + +latGeom +{ + id 100; + type latUniverse; + origin ( 30.0 50.0 30.0 ); + pitch ( 10.0 10.0 10.0 ); + shape ( 6 10 6 ); + padMat absorber; + map ( + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +25 25 25 25 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +35 15 15 15 15 15 + +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner ( 0.0 0.0 0.0 ); + width ( 60.0 100.0 60.0 ); + vox ( 60 100 60 ); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + absorber { + temp 300; + xsFile ./XS_dog/absorberS; + composition { } + } + + voidMat { + temp 300; + xsFile ./XS_dog/voidS; + composition { } + } + + sourceMat { + temp 300; + xsFile ./XS_dog/absorberS; + composition { } + } + +} +} + + diff --git a/InputFiles/C5G7 b/InputFiles/C5G7 new file mode 100644 index 000000000..587f61027 --- /dev/null +++ b/InputFiles/C5G7 @@ -0,0 +1,211 @@ +type eigenPhysicsPackage; + +pop 12000; +active 20; +inactive 300; +XSdata mg; +dataType mg; +outputFile C5G7_MGMC_2D ; + +collisionOperator { neutronMG {type neutronMGstd; } } + +transportOperator { type transportOperatorST; } + +inactiveTally { + } + } + +activeTally { + fissionMap {type collisionClerk; + map {type multiMap; + maps (xax yax); + xax { type spaceMap; axis x; grid lin; min -32.13; max 10.71; N 34;} + yax { type spaceMap; axis y; grid lin; min -10.71; max 32.13; N 34;} + } + response (fiss); + fiss { type macroResponse; MT -6; } + } +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 0 1 1 1); + graph {type extended;} + + surfaces { + Domain { id 3; type box; origin (0.0 0.0 0.0); halfwidth (32.13 32.13 32.13);} + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + //pin1 { id 1; type pinUniverse; radii (0.5400 0.0 ); fills (UO2 water);} + //pin2 { id 2; type pinUniverse; radii (0.5400 0.0 ); fills (GT water);} + //pin3 { id 3; type pinUniverse; radii (0.5400 0.0 ); fills (mox43 water);} + //pin4 { id 4; type pinUniverse; radii (0.5400 0.0 ); fills (mox7 water);} + //pin5 { id 5; type pinUniverse; radii (0.5400 0.0 ); fills (mox87 water);} + //pin6 { id 6; type pinUniverse; radii (0.5400 0.0 ); fills (FC water);} + pin1 { id 1; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.66 0.78 0.0 ); fills (UO2 UO2 UO2 water water water);} + pin2 { id 2; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.66 0.78 0.0 ); fills (GT GT GT water water water);} + pin3 { id 3; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.66 0.78 0.0 ); fills (mox43 mox43 mox43 water water water);} + pin4 { id 4; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.66 0.78 0.0 ); fills (mox7 mox7 mox7 water water water);} + pin5 { id 5; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.66 0.78 0.0 ); fills (mox87 mox87 mox87 water water water);} + pin6 { id 6; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.66 0.78 0.0 ); fills (FC FC FC water water water);} + + // Infinite moderator + pin30 { id 30; type pinUniverse; radii (0.0); fills (water);} + +// Lattices +latUO2{ + id 10; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 6 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOX{ + id 20; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 6 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latCore +{ + id 100; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (21.42 21.42 0.0); + shape (3 3 0); + padMat water; + map ( +10 20 30 +20 10 30 +30 30 30 +); +} + +} + +} + +viz { + bmp1 { + type bmp; + output C5G7_xy; + what uniqueID; + centre (0.0 0.0 10.0); + axis z; + res (1000 1000); } +// myVTK { +// type vtk; +// what uniqueID; +// corner (-32.13 -32.13 -214.1); +// width (64.26 64.26 428.2); +// vox (700 700 50); +// } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + numberOfGroups 7; + + water { + temp 300; + xsFile ./XS_C5G7/moder; + composition { } + } + + mox43 { + temp 300; + xsFile ./XS_C5G7/MOX43; + composition { } + } + + mox7 { + temp 300; + xsFile ./XS_C5G7/MOX7; + composition { } + } + + mox87 { + temp 300; + xsFile ./XS_C5G7/MOX87; + composition { } + } + + UO2 { + temp 300; + xsFile ./XS_C5G7/UO2; + composition { } + } + + // Fission chamber + FC { + temp 300; + xsFile ./XS_C5G7/FC; + composition { } + } + + // Guide tube + GT { + temp 300; + xsFile ./XS_C5G7/GT; + composition { } + } + +} +} + + diff --git a/InputFiles/TRRM/C5G7_RoddedB_TRRM b/InputFiles/TRRM/C5G7_RoddedB_TRRM new file mode 100644 index 000000000..4a64d3e05 --- /dev/null +++ b/InputFiles/TRRM/C5G7_RoddedB_TRRM @@ -0,0 +1,1131 @@ +type randomRayPhysicsPackage; + +pop 117000; +active 950; +inactive 1525; +dead 12.56; +termination 628.12; +plot 0; +cache 1; +XSdata mg; +dataType mg; +outputFile C5G7_RoddedB_TRRM ; + + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 0 1 1 0); + graph {type extended;} + + surfaces { + Domain { id 3; type box; origin (0.0 0.0 0.0); halfwidth (32.13 32.13 32.13);} + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { id 1; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (UO2 UO2 UO2 water water water);} + pin2 { id 2; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (GT GT GT water water water);} + pin3 { id 3; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox43 mox43 mox43 water water water);} + pin4 { id 4; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox7 mox7 mox7 water water water);} + pin5 { id 5; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox87 mox87 mox87 water water water);} + pin6 { id 6; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (FC FC FC water water water);} + + // Control rod + pin7 { id 7; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0); rotation (22.5 0 0); fills (CR CR CR water water water);} + + // Infinite moderator + pin30 { id 30; type pinUniverse; radii (0.0); fills (water);} + +// Lattices +latUO2{ + id 10; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 6 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOX{ + id 20; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 6 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latJustRods { + id 21; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 7 40 40 7 40 40 7 40 40 40 40 40 + 40 40 40 7 40 40 40 40 40 40 40 40 40 7 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 7 40 40 7 40 40 7 40 40 7 40 40 7 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 7 40 40 7 40 40 40 40 40 7 40 40 7 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 7 40 40 7 40 40 7 40 40 7 40 40 7 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 7 40 40 40 40 40 40 40 40 40 7 40 40 40 + 40 40 40 40 40 7 40 40 7 40 40 7 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 + 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +); +} + +latFineModer +{ +id 40; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (0.126 0.126 0.0); +shape (10 10 0); +padMat water; +map ( +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +); +} + +latModUp +{ +id 50; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latModLeft +{ +id 60; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +); +} + +latModCorner +{ +id 70; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latUO2Rod{ + id 80; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 7 1 1 7 1 1 7 1 1 1 1 1 + 1 1 1 7 1 1 1 1 1 1 1 1 1 7 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 7 1 1 7 1 1 7 1 1 7 1 1 7 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 7 1 1 7 1 1 6 1 1 7 1 1 7 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 7 1 1 7 1 1 7 1 1 7 1 1 7 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 7 1 1 1 1 1 1 1 1 1 7 1 1 1 + 1 1 1 1 1 7 1 1 7 1 1 7 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOXRod{ + id 90; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 7 4 4 7 4 4 7 4 4 4 4 3 + 3 4 4 7 4 5 5 5 5 5 5 5 4 7 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 7 5 5 2 5 5 7 5 5 7 5 5 7 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 7 5 5 7 5 5 6 5 5 7 5 5 7 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 7 5 5 7 5 5 7 5 5 7 5 5 7 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 7 4 5 5 5 5 5 5 5 4 7 4 4 3 + 3 4 4 4 4 7 4 4 7 4 4 7 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latCore +{ + id 100; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (21.42 21.42 0.357); + shape (3 3 180); + padMat water; + map ( + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +21 21 60 +21 21 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 90 60 +90 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +80 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +10 20 60 +20 10 60 +50 50 70 + +); +} + +} + +} + +viz { +// bmp1 { +// type bmp; +// output material_yz; +// what material; +// centre (-21.42 0.0 0.0); +// axis x; +// res (2000 2000); } +// bmp2 { +// type bmp; +// output material_xy; +// what material; +// centre (0.0 0.0 31.0); +// axis z; +// res (2000 2000); } +// bmp3 { +// type bmp; +// output ID_yz; +// what uniqueID; +// centre (-21.42 0.0 0.0); +// axis x; +// res (2000 2000); } +// myVTK { +// type vtk; +// what uniqueID; +// centre (-21.42 0.0 0.0); +// axis x; +// res (2000 2000); } + myVTK { + type vtk; + what uniqueID; + corner (-21.42 -32.13 -32.13); + width (0.1 64.26 64.26); + vox (1 2000 2000); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + numberOfGroups 7; + + water { + temp 300; + xsFile ../XS_C5G7/moder; + composition { } + } + + mox43 { + temp 300; + xsFile ../XS_C5G7/MOX43; + composition { } + } + + mox7 { + temp 300; + xsFile ../XS_C5G7/MOX7; + composition { } + } + + mox87 { + temp 300; + xsFile ../XS_C5G7/MOX87; + composition { } + } + + UO2 { + temp 300; + xsFile ../XS_C5G7/UO2; + composition { } + } + + // Fission chamber + FC { + temp 300; + xsFile ../XS_C5G7/FC; + composition { } + } + + // Guide tube + GT { + temp 300; + xsFile ../XS_C5G7/GT; + composition { } + } + + // Control rod + CR { + temp 300; + xsFile ../XS_C5G7/CR; + composition { } + } +} +} + + diff --git a/InputFiles/TRRM/C5G7_TRRM b/InputFiles/TRRM/C5G7_TRRM new file mode 100644 index 000000000..507ae9eb0 --- /dev/null +++ b/InputFiles/TRRM/C5G7_TRRM @@ -0,0 +1,301 @@ +type randomRayPhysicsPackage; +lin 0; +pop 1750; +active 2600; +inactive 1000; +dead 20; +termination 220; +plot 0; +cache 1; +XSdata mg; +dataType mg; +outputFile C5G7_TRRM; + +fissionMap {type multiMap; + maps (xax yax); + xax { type spaceMap; axis x; grid lin; min -32.13; max 10.71; N 34;} + yax { type spaceMap; axis y; grid lin; min -10.71; max 32.13; N 34;} +} +fluxMap {type multiMap; + maps (xax yax); + xax { type spaceMap; axis x; grid lin; min -32.13; max 32.13; N 51;} + yax { type spaceMap; axis y; grid lin; min -32.13; max 32.13; N 51;} +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 0 1 1 1); + graph {type extended;} + + surfaces { + Domain { id 3; type box; origin (0.0 0.0 0.0); halfwidth (32.13 32.13 32.13);} + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { id 1; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (UO2 UO2 UO2 water water water);} + pin2 { id 2; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (GT GT GT water water water);} + pin3 { id 3; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox43 mox43 mox43 water water water);} + pin4 { id 4; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox7 mox7 mox7 water water water);} + pin5 { id 5; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (mox87 mox87 mox87 water water water);} + pin6 { id 6; type azimPinUniverse; naz 8; radii (0.311769 0.440908 0.5400 0.63 0.72 0.0 ); rotation (22.5 0 0); fills (FC FC FC water water water);} + + // Infinite moderator + pin30 { id 30; type pinUniverse; radii (0.0); fills (water);} + +// Lattices +latUO2{ + id 10; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 6 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOX{ + id 20; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 6 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latFineModer +{ +id 40; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (0.126 0.126 0.0); +shape (10 10 0); +padMat water; +map ( +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 +); +} + +latModUp +{ +id 50; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latModLeft +{ +id 60; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +); +} + +latModCorner +{ +id 70; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latCore +{ + id 100; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (21.42 21.42 0.0); + shape (3 3 0); + padMat water; + map ( +10 20 60 +20 10 60 +50 50 70 +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner (-32.13 -32.13 -1.0); + width (64.26 64.26 2.0); + vox (2000 2000 1); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + water { + temp 300; + xsFile ../XS_C5G7/moder; + composition { } + } + + mox43 { + temp 300; + xsFile ../XS_C5G7/MOX43; + composition { } + } + + mox7 { + temp 300; + xsFile ../XS_C5G7/MOX7; + composition { } + } + + mox87 { + temp 300; + xsFile ../XS_C5G7/MOX87; + composition { } + } + + UO2 { + temp 300; + xsFile ../XS_C5G7/UO2; + composition { } + } + + // Fission chamber + FC { + temp 300; + xsFile ../XS_C5G7/FC; + composition { } + } + + // Guide tube + GT { + temp 300; + xsFile ../XS_C5G7/GT; + composition { } + } + +} +} + + diff --git a/InputFiles/TRRM/C5G7_TRRM_coarse b/InputFiles/TRRM/C5G7_TRRM_coarse new file mode 100644 index 000000000..fa48ce491 --- /dev/null +++ b/InputFiles/TRRM/C5G7_TRRM_coarse @@ -0,0 +1,294 @@ +type randomRayPhysicsPackage; + +lin 1; +pop 1750; +active 2600; +inactive 1000; +dead 20; +termination 220; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile C5G7_TRRM_coarse; + +fissionMap {type multiMap; + maps (xax yax); + xax { type spaceMap; axis x; grid lin; min -32.13; max 10.71; N 34;} + yax { type spaceMap; axis y; grid lin; min -10.71; max 32.13; N 34;} +} +fluxMap {type multiMap; + maps (xax yax); + xax { type spaceMap; axis x; grid lin; min -32.13; max 32.13; N 51;} + yax { type spaceMap; axis y; grid lin; min -32.13; max 32.13; N 51;} +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 0 1 1 1); + graph {type extended;} + + surfaces { + Domain { id 3; type box; origin (0.0 0.0 0.0); halfwidth (32.13 32.13 32.13);} + } + + cells {} + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { id 1; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (UO2 water);} + pin2 { id 2; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (GT water);} + pin3 { id 3; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (mox43 water);} + pin4 { id 4; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (mox7 water);} + pin5 { id 5; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (mox87 water);} + pin6 { id 6; type azimPinUniverse; nazR (4 8); radii (0.5400 0.0); rotation (0 0 0); fills (FC water);} + + // Infinite moderator + pin30 { id 30; type pinUniverse; radii (0.0); fills (water);} + +// Lattices +latUO2{ + id 10; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 6 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 + 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +); +} + +latMOX{ + id 20; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (1.26 1.26 0.0); + shape (17 17 0); + padMat water; + map ( + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 6 5 5 2 5 5 2 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 4 5 5 5 5 5 5 5 5 5 5 5 4 4 3 + 3 4 2 5 5 2 5 5 2 5 5 2 5 5 2 4 3 + 3 4 4 4 5 5 5 5 5 5 5 5 5 4 4 4 3 + 3 4 4 2 4 5 5 5 5 5 5 5 4 2 4 4 3 + 3 4 4 4 4 2 4 4 2 4 4 2 4 4 4 4 3 + 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 +); +} + +latFineModer +{ +id 40; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (0.63 0.63 0.0); +shape (2 2 0); +padMat water; +map ( +30 30 +30 30 +); +} + +latModUp +{ +id 50; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latModLeft +{ +id 60; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +); +} + +latModCorner +{ +id 70; +type latUniverse; +origin (0.0 0.0 0.0); +pitch (1.26 1.26 0.0); +shape (17 17 0); +padMat water; +map ( +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +40 40 40 40 40 40 40 40 40 40 40 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 +); +} + +latCore +{ + id 100; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (21.42 21.42 0.0); + shape (3 3 0); + padMat water; + map ( +10 20 60 +20 10 60 +50 50 70 +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner (-32.13 -32.13 -1.0); + width (64.26 64.26 2.0); + vox (2000 2000 1); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + water { + temp 300; + xsFile ../XS_C5G7/moder; + composition { } + } + + mox43 { + temp 300; + xsFile ../XS_C5G7/MOX43; + composition { } + } + + mox7 { + temp 300; + xsFile ../XS_C5G7/MOX7; + composition { } + } + + mox87 { + temp 300; + xsFile ../XS_C5G7/MOX87; + composition { } + } + + UO2 { + temp 300; + xsFile ../XS_C5G7/UO2; + composition { } + } + + // Fission chamber + FC { + temp 300; + xsFile ../XS_C5G7/FC; + composition { } + } + + // Guide tube + GT { + temp 300; + xsFile ../XS_C5G7/GT; + composition { } + } + +} +} + + diff --git a/InputFiles/TRRM/XS_dog/absorberA b/InputFiles/TRRM/XS_dog/absorberA new file mode 100644 index 000000000..2494eb505 --- /dev/null +++ b/InputFiles/TRRM/XS_dog/absorberA @@ -0,0 +1,16 @@ +// This XS corresponds to the Case 2 for the Kobayashi dogleg benchmark + +numberOfGroups 1; + +capture ( +//0.05 //scatter case +0.10 // absorber case +); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + //0.05 // scatter case + 0.0 // absorber case +); + diff --git a/InputFiles/TRRM/XS_dog/absorberS b/InputFiles/TRRM/XS_dog/absorberS new file mode 100644 index 000000000..5f4b0c316 --- /dev/null +++ b/InputFiles/TRRM/XS_dog/absorberS @@ -0,0 +1,14 @@ +// This XS corresponds to the Case 2 for the Kobayashi dogleg benchmark + +numberOfGroups 1; + +capture ( +0.05 //scatter case +); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + 0.05 // scatter case +); + diff --git a/InputFiles/TRRM/XS_dog/voidA b/InputFiles/TRRM/XS_dog/voidA new file mode 100644 index 000000000..adfd286ba --- /dev/null +++ b/InputFiles/TRRM/XS_dog/voidA @@ -0,0 +1,16 @@ +// This XS corresponds to the Case 2 for the Kobayashi dogleg benchmark + +numberOfGroups 1; + +capture ( +//0.5E-4 // scatter case +1.0E-4 // absorber case +); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + //0.5E-4 // scatter case + 0.0 // absorber case +); + diff --git a/InputFiles/TRRM/XS_dog/voidS b/InputFiles/TRRM/XS_dog/voidS new file mode 100644 index 000000000..5945ee09a --- /dev/null +++ b/InputFiles/TRRM/XS_dog/voidS @@ -0,0 +1,14 @@ +// This XS corresponds to the Case 2 for the Kobayashi dogleg benchmark + +numberOfGroups 1; + +capture ( +0.5E-4 // scatter case +); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + 0.5E-4 // scatter case +); + diff --git a/InputFiles/TRRM/dogleg_TRRM_absorb b/InputFiles/TRRM/dogleg_TRRM_absorb new file mode 100644 index 000000000..cbddd28f0 --- /dev/null +++ b/InputFiles/TRRM/dogleg_TRRM_absorb @@ -0,0 +1,462 @@ +type fixedSourceRRPhysicsPackage; + +pop 10000; +active 2100; +inactive 0; +dead 120; +termination 1220; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile dogleg_TRRM_absorb; + +integrate (sourceMat); +source { sourceMat ( 1.0 ); } + +samplePoints { +A3_1 ( 5.0 5.0 5.0 ); +A3_2 ( 5.0 15.0 5.0 ); +A3_3 ( 5.0 25.0 5.0 ); +A3_4 ( 5.0 35.0 5.0 ); +A3_5 ( 5.0 45.0 5.0 ); +A3_6 ( 5.0 55.0 5.0 ); +A3_7 ( 5.0 65.0 5.0 ); +A3_8 ( 5.0 75.0 5.0 ); +A3_9 ( 5.0 85.0 5.0 ); +A3_10 ( 5.0 95.0 5.0 ); +B3_1 (5.0 55.0 5.0); +B3_2 (15.0 55.0 5.0); +B3_3 (25.0 55.0 5.0); +B3_4 (35.0 55.0 5.0); +B3_5 (45.0 55.0 5.0); +B3_6 (55.0 55.0 5.0); +C3_1 (5.0 95.0 35.0); +C3_2 (15.0 95.0 35.0); +C3_3 (25.0 95.0 35.0); +C3_4 (35.0 95.0 35.0); +C3_5 (45.0 95.0 35.0); +C3_6 (55.0 95.0 35.0); + +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 1 0 1 0 ); + graph { type extended; } + + surfaces { + Domain { id 3; type box; origin ( 30.0 50.0 30.0 ); halfwidth ( 30.0 50.0 30.0 ); } + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { type pinUniverse; id 1; radii ( 0.0 ); fills ( absorber ); } + pin2 { type pinUniverse; id 2; radii ( 0.0 ); fills ( voidMat ); } + pin3 { type pinUniverse; id 3; radii ( 0.0 ); fills ( sourceMat ); } + +// Lattices +latAbsCentred { + id 15; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.1111111111111111 1.1111111111111111 1.11111111111111 ); + shape ( 9 9 9 ); + padMat absorber; + map ( + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 +); +} + +latVoidCentred { + id 25; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.1111111111111111 1.11111111111111111 1.111111111111111111); + shape ( 9 9 9 ); + padMat voidMat; + map ( +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +); +} + +latSourceCentred { + id 35; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.11111111111111 1.111111111111111 1.11111111111111 ); + shape ( 9 9 9 ); + padMat sourceMat; + map ( +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +); +} + +latGeom +{ + id 100; + type latUniverse; + origin ( 30.0 50.0 30.0 ); + pitch ( 10.0 10.0 10.0 ); + shape ( 6 10 6 ); + padMat absorber; + map ( + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +25 25 25 25 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +35 15 15 15 15 15 + +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner ( 0.0 0.0 0.0 ); + width ( 60.0 100.0 60.0 ); + vox ( 60 100 60 ); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + absorber { + temp 300; + xsFile ./XS_dog/absorberA; + composition { } + } + + voidMat { + temp 300; + xsFile ./XS_dog/voidA; + composition { } + } + + sourceMat { + temp 300; + xsFile ./XS_dog/absorberA; + composition { } + } + + +} +} + + diff --git a/InputFiles/TRRM/dogleg_TRRM_absorb_coarse b/InputFiles/TRRM/dogleg_TRRM_absorb_coarse new file mode 100644 index 000000000..303c3a6c8 --- /dev/null +++ b/InputFiles/TRRM/dogleg_TRRM_absorb_coarse @@ -0,0 +1,229 @@ +type fixedSourceRRPhysicsPackage; + +lin 1; +pop 2000; +active 2000; +inactive 100; +dead 120; +termination 1220; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile dogleg_TRRM_absorb_coarse; + +integrate (sourceMat); +source { sourceMat ( 1.0 ); } + +samplePoints { +A3_1 ( 5.0 5.0 5.0 ); +A3_2 ( 5.0 15.0 5.0 ); +A3_3 ( 5.0 25.0 5.0 ); +A3_4 ( 5.0 35.0 5.0 ); +A3_5 ( 5.0 45.0 5.0 ); +A3_6 ( 5.0 55.0 5.0 ); +A3_7 ( 5.0 65.0 5.0 ); +A3_8 ( 5.0 75.0 5.0 ); +A3_9 ( 5.0 85.0 5.0 ); +A3_10 ( 5.0 95.0 5.0 ); +B3_1 (5.0 55.0 5.0); +B3_2 (15.0 55.0 5.0); +B3_3 (25.0 55.0 5.0); +B3_4 (35.0 55.0 5.0); +B3_5 (45.0 55.0 5.0); +B3_6 (55.0 55.0 5.0); +C3_1 (5.0 95.0 35.0); +C3_2 (15.0 95.0 35.0); +C3_3 (25.0 95.0 35.0); +C3_4 (35.0 95.0 35.0); +C3_5 (45.0 95.0 35.0); +C3_6 (55.0 95.0 35.0); + +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 1 0 1 0 ); + graph { type extended; } + + surfaces { + Domain { id 3; type box; origin ( 30.0 50.0 30.0 ); halfwidth ( 30.0 50.0 30.0 ); } + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { type pinUniverse; id 1; radii ( 0.0 ); fills ( absorber ); } + pin2 { type pinUniverse; id 2; radii ( 0.0 ); fills ( voidMat ); } + pin3 { type pinUniverse; id 3; radii ( 0.0 ); fills ( sourceMat ); } + +// Lattices +latAbsCentred { + id 15; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 3.333333333333333 3.33333333333333333 3.333333333333333333 ); + shape ( 3 3 3 ); + padMat absorber; + map ( + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 +); +} + +latVoidCentred { + id 25; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 3.3333333333333333 3.3333333333333333333 3.33333333333333333333); + shape ( 3 3 3 ); + padMat voidMat; + map ( +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +); +} + +latSourceCentred { + id 35; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 3.3333333333333333333 3.333333333333333333 3.333333333333333 ); + shape ( 3 3 3 ); + padMat sourceMat; + map ( +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +); +} + +latGeom +{ + id 100; + type latUniverse; + origin ( 30.0 50.0 30.0 ); + pitch ( 10.0 10.0 10.0 ); + shape ( 6 10 6 ); + padMat absorber; + map ( + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +25 25 25 25 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +35 15 15 15 15 15 + +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner ( 0.0 0.0 0.0 ); + width ( 60.0 100.0 60.0 ); + vox ( 60 100 60 ); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + absorber { + temp 300; + xsFile ./XS_dog/absorberA; + composition { } + } + + voidMat { + temp 300; + xsFile ./XS_dog/voidA; + composition { } + } + + sourceMat { + temp 300; + xsFile ./XS_dog/absorberA; + composition { } + } + + +} +} + + diff --git a/InputFiles/TRRM/dogleg_TRRM_scatter b/InputFiles/TRRM/dogleg_TRRM_scatter new file mode 100644 index 000000000..8a9c18ef3 --- /dev/null +++ b/InputFiles/TRRM/dogleg_TRRM_scatter @@ -0,0 +1,462 @@ +type fixedSourceRRPhysicsPackage; +lin 0; +!pop 10000; +pop 3000; +active 2000; +inactive 100; +dead 120; +termination 1220; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile dogleg_TRRM_scatter; + +source { sourceMat ( 1.0 ); } +integrate (sourceMat absorber); + +samplePoints { +A3_1 ( 5.0 5.0 5.0 ); +A3_2 ( 5.0 15.0 5.0 ); +A3_3 ( 5.0 25.0 5.0 ); +A3_4 ( 5.0 35.0 5.0 ); +A3_5 ( 5.0 45.0 5.0 ); +A3_6 ( 5.0 55.0 5.0 ); +A3_7 ( 5.0 65.0 5.0 ); +A3_8 ( 5.0 75.0 5.0 ); +A3_9 ( 5.0 85.0 5.0 ); +A3_10 ( 5.0 95.0 5.0 ); +B3_1 (5.0 55.0 5.0); +B3_2 (15.0 55.0 5.0); +B3_3 (25.0 55.0 5.0); +B3_4 (35.0 55.0 5.0); +B3_5 (45.0 55.0 5.0); +B3_6 (55.0 55.0 5.0); +C3_1 (5.0 95.0 35.0); +C3_2 (15.0 95.0 35.0); +C3_3 (25.0 95.0 35.0); +C3_4 (35.0 95.0 35.0); +C3_5 (45.0 95.0 35.0); +C3_6 (55.0 95.0 35.0); + +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 1 0 1 0 ); + graph { type extended; } + + surfaces { + Domain { id 3; type box; origin ( 30.0 50.0 30.0 ); halfwidth ( 30.0 50.0 30.0 ); } + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { type pinUniverse; id 1; radii ( 0.0 ); fills ( absorber ); } + pin2 { type pinUniverse; id 2; radii ( 0.0 ); fills ( voidMat ); } + pin3 { type pinUniverse; id 3; radii ( 0.0 ); fills ( sourceMat ); } + +// Lattices +latAbsCentred { + id 15; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.1111111111111111 1.1111111111111111 1.11111111111111 ); + shape ( 9 9 9 ); + padMat absorber; + map ( + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 +); +} + +latVoidCentred { + id 25; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.1111111111111111 1.11111111111111111 1.111111111111111111); + shape ( 9 9 9 ); + padMat voidMat; + map ( +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +); +} + +latSourceCentred { + id 35; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 1.11111111111111 1.111111111111111 1.11111111111111 ); + shape ( 9 9 9 ); + padMat absorber; + map ( +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +); +} + +latGeom +{ + id 100; + type latUniverse; + origin ( 30.0 50.0 30.0 ); + pitch ( 10.0 10.0 10.0 ); + shape ( 6 10 6 ); + padMat absorber; + map ( + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +25 25 25 25 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +35 15 15 15 15 15 + +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner ( 0.0 0.0 0.0 ); + width ( 60.0 100.0 60.0 ); + vox ( 60 100 60 ); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + absorber { + temp 300; + xsFile ./XS_dog/absorberS; + composition { } + } + + voidMat { + temp 300; + xsFile ./XS_dog/voidS; + composition { } + } + + sourceMat { + temp 300; + xsFile ./XS_dog/absorberS; + composition { } + } + +} +} + + diff --git a/InputFiles/TRRM/dogleg_TRRM_scatter_coarse b/InputFiles/TRRM/dogleg_TRRM_scatter_coarse new file mode 100644 index 000000000..d58590659 --- /dev/null +++ b/InputFiles/TRRM/dogleg_TRRM_scatter_coarse @@ -0,0 +1,229 @@ +type fixedSourceRRPhysicsPackage; + +lin 1; +pop 2000; +pop 120; +active 4000; +inactive 1000; +dead 100; +termination 500; +plot 1; +cache 1; +XSdata mg; +dataType mg; +outputFile dogleg_TRRM_scatter_coarse; + +source { sourceMat ( 1.0 ); } +integrate (sourceMat absorber); + +samplePoints { +A3_1 ( 5.0 5.0 5.0 ); +A3_2 ( 5.0 15.0 5.0 ); +A3_3 ( 5.0 25.0 5.0 ); +A3_4 ( 5.0 35.0 5.0 ); +A3_5 ( 5.0 45.0 5.0 ); +A3_6 ( 5.0 55.0 5.0 ); +A3_7 ( 5.0 65.0 5.0 ); +A3_8 ( 5.0 75.0 5.0 ); +A3_9 ( 5.0 85.0 5.0 ); +A3_10 ( 5.0 95.0 5.0 ); +B3_1 (5.0 55.0 5.0); +B3_2 (15.0 55.0 5.0); +B3_3 (25.0 55.0 5.0); +B3_4 (35.0 55.0 5.0); +B3_5 (45.0 55.0 5.0); +B3_6 (55.0 55.0 5.0); +C3_1 (5.0 95.0 35.0); +C3_2 (15.0 95.0 35.0); +C3_3 (25.0 95.0 35.0); +C3_4 (35.0 95.0 35.0); +C3_5 (45.0 95.0 35.0); +C3_6 (55.0 95.0 35.0); + +} + +geometry { + type geometryStd; + // ( -x, +x, -y, +y, -z, +z) + boundary ( 1 0 1 0 1 0 ); + graph { type extended; } + + surfaces { + Domain { id 3; type box; origin ( 30.0 50.0 30.0 ); halfwidth ( 30.0 50.0 30.0 ); } + } + + cells { } + + universes { + root { id 1000; type rootUniverse; border 3; fill u<100>; } + + // Pin universes + pin1 { type pinUniverse; id 1; radii ( 0.0 ); fills ( absorber ); } + pin2 { type pinUniverse; id 2; radii ( 0.0 ); fills ( voidMat ); } + pin3 { type pinUniverse; id 3; radii ( 0.0 ); fills ( sourceMat ); } + +// Lattices +latAbsCentred { + id 15; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 3.333333333333333333 3.3333333333333333 3.33333333333333333 ); + shape ( 3 3 3 ); + padMat absorber; + map ( + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 +); +} + +latVoidCentred { + id 25; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 3.33333333333333333333 3.333333333333333333 3.333333333333333333); + shape ( 3 3 3 ); + padMat voidMat; + map ( +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +2 2 2 2 2 2 2 2 2 +); +} + +latSourceCentred { + id 35; + type latUniverse; + origin ( 0.0 0.0 0.0 ); + pitch ( 3.3333333333333333333 3.3333333333333333333 3.3333333333333333333 ); + shape ( 3 3 3 ); + padMat sourceMat; + map ( +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +3 3 3 3 3 3 3 3 3 +); +} + +latGeom +{ + id 100; + type latUniverse; + origin ( 30.0 50.0 30.0 ); + pitch ( 10.0 10.0 10.0 ); + shape ( 6 10 6 ); + padMat absorber; + map ( + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 25 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 + +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +15 15 15 15 15 15 +25 25 25 25 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +25 15 15 15 15 15 +35 15 15 15 15 15 + +); +} + +} + +} + +viz { + myVTK { + type vtk; + what uniqueID; + corner ( 0.0 0.0 0.0 ); + width ( 60.0 100.0 60.0 ); + vox ( 60 100 60 ); + } +} + + +nuclearData { + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + materials { + + absorber { + temp 300; + xsFile ./XS_dog/absorberS; + composition { } + } + + voidMat { + temp 300; + xsFile ./XS_dog/voidS; + composition { } + } + + sourceMat { + temp 300; + xsFile ./XS_dog/absorberS; + composition { } + } + +} +} + + diff --git a/InputFiles/XS/Ua_1_0_XSS b/InputFiles/XS/Ua_1_0_XSS new file mode 100644 index 000000000..294ac4b76 --- /dev/null +++ b/InputFiles/XS/Ua_1_0_XSS @@ -0,0 +1,18 @@ +// This XSS are for a Ua-1-0-IN/SL Benchamrk Problem +// Source: A. Sood, R. A. Forster, and D. K. Parsons, +// ‘Analytical Benchmark Test Set For Criticality Code Verification’ +// + +numberOfGroups 1; + +capture (0.013056); +fission (0.065280); +nu (2.7); +chi (1.0); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + 0.248064 +); + diff --git a/InputFiles/XS_C5G7/CR b/InputFiles/XS_C5G7/CR new file mode 100644 index 000000000..e4dbeae5b --- /dev/null +++ b/InputFiles/XS_C5G7/CR @@ -0,0 +1,31 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (1.7049E-03 8.36224E-03 8.37901E-02 3.97797E-01 6.98763E-01 9.29508E-01 1.17836); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +1.70563E-01 4.44012E-02 9.83670E-05 1.27786E-07 0.0 0.000000E+00 0.000000E+00 +0.000000E+00 4.71050E-01 6.85480E-04 3.91395E-10 0.0 0.0 0.0 +0.000000E+00 0.000000E+00 8.01859E-01 7.20132E-04 0.0 0.0 0.0 +0.000000E+00 0.000000E+00 0.000000E+00 5.70752E-01 1.46015E-03 0.0 0.0 +0.000000E+00 0.000000E+00 0.000000E+00 6.55562E-05 2.07838E-01 3.81486E-03 3.69760E-9 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.02427E-03 2.02465E-01 4.75290E-3 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 3.53043E-03 6.58597E-01 +); + diff --git a/InputFiles/XS_C5G7/FC b/InputFiles/XS_C5G7/FC new file mode 100644 index 000000000..441cd9895 --- /dev/null +++ b/InputFiles/XS_C5G7/FC @@ -0,0 +1,34 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (5.113152100E-04 7.580717436E-05 3.159662810E-04 1.162255940E-03 3.397554610E-03 9.187885028E-03 2.324191959E-02); +fission (4.790020000E-09 5.825640000E-09 4.637190000E-07 5.244060000E-06 1.453900000E-07 7.149720000E-07 2.080410000E-06); +nu ( 2.762829800E+00 2.462390398E+00 2.433799348E+00 2.433799384E+00 2.433800124E+00 2.433800205E+00 2.433800068E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +6.616590000E-02 5.907000000E-02 2.833400000E-04 1.462200000E-06 2.064200000E-08 0.000000000E+00 0.000000000E+00 +0.000000000E+00 2.403770000E-01 5.243500000E-02 2.499000000E-04 1.923900000E-05 2.987500000E-06 4.214000000E-07 +0.000000000E+00 0.000000000E+00 1.834250000E-01 9.228800000E-02 6.936500000E-03 1.079000000E-03 2.054300000E-04 +0.000000000E+00 0.000000000E+00 0.000000000E+00 7.907690000E-02 1.699900000E-01 2.586000000E-02 4.925600000E-03 +0.000000000E+00 0.000000000E+00 0.000000000E+00 3.734000000E-05 9.975700000E-02 2.067900000E-01 2.447800000E-02 +0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 9.174200000E-04 3.167740000E-01 2.387600000E-01 +0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 4.979300000E-02 1.099100000E+00 +); + diff --git a/InputFiles/XS_C5G7/GT b/InputFiles/XS_C5G7/GT new file mode 100644 index 000000000..77ed9f30f --- /dev/null +++ b/InputFiles/XS_C5G7/GT @@ -0,0 +1,31 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (5.113200E-04 7.580100E-05 3.157200E-04 1.158200E-03 3.397500E-03 9.187800E-03 2.324200E-02); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +6.616590E-02 5.907000E-02 2.833400E-04 1.462200E-06 2.064200E-08 0.000000E+00 0.000000E+00 +0.000000E+00 2.403770E-01 5.243500E-02 2.499000E-04 1.923900E-05 2.987500E-06 4.214000E-07 +0.000000E+00 0.000000E+00 1.832970E-01 9.239700E-02 6.944600E-03 1.080300E-03 2.056700E-04 +0.000000E+00 0.000000E+00 0.000000E+00 7.885110E-02 1.701400E-01 2.588100E-02 4.929700E-03 +0.000000E+00 0.000000E+00 0.000000E+00 3.733300E-05 9.973720E-02 2.067900E-01 2.447800E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 9.172600E-04 3.167650E-01 2.387700E-01 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.979200E-02 1.099120E+00 +); + diff --git a/InputFiles/XS_C5G7/MOX43 b/InputFiles/XS_C5G7/MOX43 new file mode 100644 index 000000000..46054ba02 --- /dev/null +++ b/InputFiles/XS_C5G7/MOX43 @@ -0,0 +1,36 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (8.0686000E-04 2.8808020E-03 2.2271650E-02 8.1322800E-02 1.2917650E-01 1.7642300E-01 1.6038200E-01); + +fission ( 7.627040E-03 8.768980E-04 5.698350E-03 2.288720E-02 1.076350E-02 2.327570E-01 2.489680E-01); + +nu (2.852089E+00 2.890990E+00 2.854860E+00 2.860730E+00 2.854470E+00 2.864150E+00 2.867800E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +1.288760E-01 4.141300E-02 8.229000E-06 5.040500E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 3.254520E-01 1.639500E-03 1.598200E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 4.531880E-01 2.614200E-03 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 4.571730E-01 5.539400E-03 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 1.604600E-04 2.768140E-01 9.312700E-03 9.165600E-09 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.005100E-03 2.529620E-01 1.485000E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 8.494800E-03 2.650070E-01 +); + diff --git a/InputFiles/XS_C5G7/MOX7 b/InputFiles/XS_C5G7/MOX7 new file mode 100644 index 000000000..3db4c6cb1 --- /dev/null +++ b/InputFiles/XS_C5G7/MOX7 @@ -0,0 +1,36 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (8.112400E-04 2.971050E-03 2.445944E-02 8.915700E-02 1.670164E-01 2.446660E-01 2.224070E-01); +fission (8.254460E-03 1.325650E-03 8.421560E-03 3.287300E-02 1.596360E-02 3.237940E-01 3.628030E-01); +nu ( 2.884980E+00 2.910790E+00 2.865740E+00 2.870630E+00 2.867140E+00 2.866580E+00 2.875390E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + + +P0 ( +1.304570E-01 4.179200E-02 8.510500E-06 5.132900E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 3.284280E-01 1.643600E-03 2.201700E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 4.583710E-01 2.533100E-03 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 4.637090E-01 5.476600E-03 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 1.761900E-04 2.823130E-01 8.728900E-03 9.001600E-09 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.276000E-03 2.497510E-01 1.311400E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 8.864500E-03 2.595290E-01 +); + diff --git a/InputFiles/XS_C5G7/MOX87 b/InputFiles/XS_C5G7/MOX87 new file mode 100644 index 000000000..6d47c4a11 --- /dev/null +++ b/InputFiles/XS_C5G7/MOX87 @@ -0,0 +1,34 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (8.141100E-04 3.031340E-03 2.596840E-02 9.367530E-02 1.891424E-01 2.838120E-01 2.595710E-01); +fission (8.672090E-03 1.624260E-03 1.027160E-02 3.904470E-02 1.925760E-02 3.748880E-01 4.305990E-01); +nu ( 2.904260E+00 2.917950E+00 2.869860E+00 2.874910E+00 2.871750E+00 2.867520E+00 2.878079E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +1.315040E-01 4.204600E-02 8.697200E-06 5.193800E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 3.304030E-01 1.646300E-03 2.600600E-09 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 4.617920E-01 2.474900E-03 0.000000E+00 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 4.680210E-01 5.433000E-03 0.000000E+00 0.000000E+00 +0.000000E+00 0.000000E+00 0.000000E+00 1.859700E-04 2.857710E-01 8.397300E-03 8.928000E-09 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.391600E-03 2.476140E-01 1.232200E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 8.968100E-03 2.560930E-01 +); + diff --git a/InputFiles/XS_C5G7/UO2 b/InputFiles/XS_C5G7/UO2 new file mode 100644 index 000000000..ffb187b5d --- /dev/null +++ b/InputFiles/XS_C5G7/UO2 @@ -0,0 +1,34 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; +capture ( 8.1274000E-04 2.8980990E-03 2.0315800E-02 7.7671200E-02 1.2211600E-02 2.8225200E-02 6.6776000E-02); +fission ( 7.212060E-3 8.193010E-4 6.453200E-3 1.856480E-2 1.780840E-2 8.303480E-2 2.160040E-1); +nu ( 2.7814494E+00 2.4744300E+00 2.4338297E+00 2.4338000E+00 2.43380E+00 2.43380E+00 2.43380E+00); +chi ( 5.8791E-01 4.1176E-01 3.3906E-04 1.1761E-07 0.0000E+00 0.0000E+00 0.0000E+00); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +1.2753700E-01 4.2378000E-02 9.4374000E-06 5.5163000E-09 0.0000000E+00 0.0000000E+00 0.0000000E+00 +0.0000000E+00 3.2445600E-01 1.6314000E-03 3.1427000E-09 0.0000000E+00 0.0000000E+00 0.0000000E+00 +0.0000000E+00 0.0000000E+00 4.5094000E-01 2.6792000E-03 0.0000000E+00 0.0000000E+00 0.0000000E+00 +0.0000000E+00 0.0000000E+00 0.0000000E+00 4.5256500E-01 5.5664000E-03 0.0000000E+00 0.0000000E+00 +0.0000000E+00 0.0000000E+00 0.0000000E+00 1.2525000E-04 2.7140100E-01 1.0255000E-02 1.0021000E-08 +0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.2968000E-03 2.6580200E-01 1.6809000E-02 +0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 8.5458000E-03 2.7308000E-01 +); + + diff --git a/InputFiles/XS_C5G7/moder b/InputFiles/XS_C5G7/moder new file mode 100644 index 000000000..029b934f1 --- /dev/null +++ b/InputFiles/XS_C5G7/moder @@ -0,0 +1,31 @@ +// This XSS are from the C5G7 Benchamrk Problem +// Source: OECD-NEA +// ‘Benchmark specification for deterministic 2D/3D MOX +// fuel assembly transport calculations without spatial +// homogenisation (C5G7 MOX)’ +// + +numberOfGroups 7; + +capture (6.010500E-04 1.579300E-05 3.371600E-04 1.940600E-03 5.741600E-03 1.500100E-02 3.723900E-02); + +scatteringMultiplicity ( +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +1.0 1.0 1.0 1.0 1.0 1.0 1.0 +); + +P0 ( +4.447770E-02 1.134000E-01 7.234700E-04 3.749900E-06 5.318400E-08 0.000000E+00 0.000000E+00 +0.000000E+00 2.823340E-01 1.299400E-01 6.234000E-04 4.800200E-05 7.448600E-06 1.045500E-06 +0.000000E+00 0.000000E+00 3.452560E-01 2.245700E-01 1.699900E-02 2.644300E-03 5.034400E-04 +0.000000E+00 0.000000E+00 0.000000E+00 9.102840E-02 4.155100E-01 6.373200E-02 1.213900E-02 +0.000000E+00 0.000000E+00 0.000000E+00 7.143700E-05 1.391380E-01 5.118200E-01 6.122900E-02 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.215700E-03 6.999130E-01 5.373200E-01 +0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.324400E-01 2.480700E+00 +); + diff --git a/IntegrationTestFiles/PhysicsPackages/SlabTRRM b/IntegrationTestFiles/PhysicsPackages/SlabTRRM new file mode 100644 index 000000000..bc2b3e13a --- /dev/null +++ b/IntegrationTestFiles/PhysicsPackages/SlabTRRM @@ -0,0 +1,60 @@ +type randomRayPhysicsPackage; + +pop 10; +active 10; +inactive 50; +termination 100; +dead 1; +XSdata mg; +dataType mg; + +geometry { + type geometryStd; + boundary (1 1 1 1 1 1); + graph {type extended;} + + surfaces + { + squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth (9.4959 10.0 10.0); } + } + + + cells + { + } + + universes + { + + root + { + id 1; + type rootUniverse; + border 1; + fill fuel; + } + } +} + +nuclearData { + + handles { + mg { type baseMgNeutronDatabase; PN P0;} + } + + +materials { + + fuel { + temp 273; + composition { + } + xsFile ./IntegrationTestFiles/PhysicsPackages/XS/Ua_1_0_XSS; + } + +} + +} + + + diff --git a/IntegrationTestFiles/PhysicsPackages/XS/Ua_1_0_XSS b/IntegrationTestFiles/PhysicsPackages/XS/Ua_1_0_XSS new file mode 100644 index 000000000..294ac4b76 --- /dev/null +++ b/IntegrationTestFiles/PhysicsPackages/XS/Ua_1_0_XSS @@ -0,0 +1,18 @@ +// This XSS are for a Ua-1-0-IN/SL Benchamrk Problem +// Source: A. Sood, R. A. Forster, and D. K. Parsons, +// ‘Analytical Benchmark Test Set For Criticality Code Verification’ +// + +numberOfGroups 1; + +capture (0.013056); +fission (0.065280); +nu (2.7); +chi (1.0); + +scatteringMultiplicity ( 1.0 ); + +P0 ( + 0.248064 +); + diff --git a/NuclearData/Reactions/reactionMG/multiScatterMG_class.f90 b/NuclearData/Reactions/reactionMG/multiScatterMG_class.f90 index 275e30277..70f478fe7 100644 --- a/NuclearData/Reactions/reactionMG/multiScatterMG_class.f90 +++ b/NuclearData/Reactions/reactionMG/multiScatterMG_class.f90 @@ -346,6 +346,10 @@ subroutine buildFromDict(self, dict) ! Calculate P0 total scattering XSs ! Behold the GLORY of Fortran you lowly C++ slaves! + ! ...Sadly slightly diminished by a compiler bug which + ! sizes scatterXSs as 1 before it's allocated. But this + ! should work without the allocation, normally! + allocate(self % scatterXSs(nG)) self % scatterXSs = sum(self % P0, 1) end subroutine buildFromDict diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index 3231ab5d1..bf9fd1789 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -254,7 +254,7 @@ function matName(idx) result(name) character(nameLen) :: name if( idx <= 0 .or. nMat() < idx) then - name = '' + name = 'Unknown material!' else name = materialDefs(idx) % name diff --git a/NuclearData/mgNeutronData/baseMgNeutron/baseMgNeutronDatabase_class.f90 b/NuclearData/mgNeutronData/baseMgNeutron/baseMgNeutronDatabase_class.f90 index 587a9ecbc..4096096be 100644 --- a/NuclearData/mgNeutronData/baseMgNeutron/baseMgNeutronDatabase_class.f90 +++ b/NuclearData/mgNeutronData/baseMgNeutron/baseMgNeutronDatabase_class.f90 @@ -63,6 +63,8 @@ module baseMgNeutronDatabase_class contains ! Superclass Interface procedure :: getTrackingXS + + ! Local interface procedure :: getTrackMatXS procedure :: getTotalMatXS procedure :: getMajorantXS @@ -73,8 +75,6 @@ module baseMgNeutronDatabase_class procedure :: kill procedure :: init procedure :: activate - - ! Local interface procedure :: initMajorant procedure :: nGroups diff --git a/NuclearData/mgNeutronData/baseMgNeutron/baseMgNeutronMaterial_class.f90 b/NuclearData/mgNeutronData/baseMgNeutron/baseMgNeutronMaterial_class.f90 index dc98bdc35..0ab258e33 100644 --- a/NuclearData/mgNeutronData/baseMgNeutron/baseMgNeutronMaterial_class.f90 +++ b/NuclearData/mgNeutronData/baseMgNeutron/baseMgNeutronMaterial_class.f90 @@ -71,16 +71,25 @@ module baseMgNeutronMaterial_class real(defReal),dimension(:,:), allocatable :: data class(multiScatterMG), allocatable :: scatter type(fissionMG), allocatable :: fission + integer(shortInt) :: nG contains ! Superclass procedures procedure :: kill procedure :: getMacroXSs_byG procedure :: getTotalXS + procedure :: getNuFissionXS + procedure :: getFissionXS + procedure :: getChi + procedure :: getScatterXS ! Local procedures procedure :: init procedure :: nGroups + procedure :: getTotalPtr + procedure :: getNuFissionPtr + procedure :: getChiPtr + procedure :: getScatterPtr end type baseMgNeutronMaterial @@ -159,6 +168,108 @@ function getTotalXS(self, G, rand) result(xs) end function getTotalXS + !! + !! Return NuFission XS for energy group G + !! + !! See mgNeutronMaterial documentationfor details + !! + function getNuFissionXS(self, G, rand) result(xs) + class(baseMgNeutronMaterial), intent(in) :: self + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + real(defReal) :: xs + character(100), parameter :: Here = ' getNuFissionXS (baseMgNeutronMaterial_class.f90)' + + ! Verify bounds + if (self % isFissile()) then + if(G < 1 .or. self % nGroups() < G) then + call fatalError(Here,'Invalid group number: '//numToChar(G)// & + ' Data has only: ' // numToChar(self % nGroups())) + xs = ZERO ! Avoid warning + end if + xs = self % data(NU_FISSION, G) + else + xs = ZERO + end if + + end function getNuFissionXS + + !! + !! Return Fission XS for energy group G + !! + !! See mgNeutronMaterial documentationfor details + !! + function getFissionXS(self, G, rand) result(xs) + class(baseMgNeutronMaterial), intent(in) :: self + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + real(defReal) :: xs + character(100), parameter :: Here = ' getFissionXS (baseMgNeutronMaterial_class.f90)' + + ! Verify bounds + if (self % isFissile()) then + if(G < 1 .or. self % nGroups() < G) then + call fatalError(Here,'Invalid group number: '//numToChar(G)// & + ' Data has only: ' // numToChar(self % nGroups())) + xs = ZERO ! Avoid warning + end if + xs = self % data(FISSION_XS, G) + else + xs = ZERO + end if + + end function getFissionXS + + !! + !! Return chi for energy group G + !! + !! See mgNeutronMaterial documentationfor details + !! + function getChi(self, G, rand) result(chi) + class(baseMgNeutronMaterial), intent(in) :: self + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + real(defReal) :: chi + character(100), parameter :: Here = ' getChi (baseMgNeutronMaterial_class.f90)' + + if (self % isFissile()) then + ! Verify bounds + if(G < 1 .or. self % nGroups() < G) then + call fatalError(Here,'Invalid group number: '//numToChar(G)// & + ' Data has only: ' // numToChar(self % nGroups())) + chi = ZERO ! Avoid warning + end if + + chi = self % fission % data(G,2) + else + chi = ZERO + end if + + end function getChi + + !! + !! Return scatter XS for incoming energy group Gin and outgoing group Gout + !! + !! See mgNeutronMaterial documentationfor details + !! + function getScatterXS(self, Gin, Gout, rand) result(xs) + class(baseMgNeutronMaterial), intent(in) :: self + integer(shortInt), intent(in) :: Gin + integer(shortInt), intent(in) :: Gout + class(RNG), intent(inout) :: rand + real(defReal) :: xs + character(100), parameter :: Here = ' getScatterXS (baseMgNeutronMaterial_class.f90)' + + ! Verify bounds + if(Gin < 1 .or. self % nGroups() < Gin .or. Gout < 1 .or. self % nGroups() < Gout) then + call fatalError(Here,'Invalid group numbers: '//numToChar(Gin)//' and '//numToChar(Gout) & + //' Data has only: ' // numToChar(self % nGroups())) + xs = ZERO ! Avoid warning + end if + xs = self % scatter % P0(Gout,Gin) + + end function getScatterXS + !! !! Initialise Base MG Neutron Material fromdictionary @@ -192,6 +303,7 @@ subroutine init(self, dict, scatterKey) ! Read number of groups call dict % get(nG, 'numberOfGroups') if(nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) + self % nG = nG ! Set fissile flag call self % set(fissile = dict % isPresent('fission')) @@ -286,13 +398,65 @@ pure function nGroups(self) result(nG) integer(shortInt) :: nG if(allocated(self % data)) then - nG = size(self % data,2) + nG = self % nG else nG = 0 end if end function nGroups + + !! + !! Return pointer to Total XSs + !! + function getTotalPtr(self) result(xs) + class(baseMgNeutronMaterial), intent(in), target :: self + real(defReal), dimension(:), pointer :: xs + + xs => self % data(TOTAL_XS, :) + + end function getTotalPtr + + !! + !! Return pointer to NuFission XSs + !! + function getNuFissionPtr(self) result(xs) + class(baseMgNeutronMaterial), intent(in), target :: self + real(defReal), dimension(:), pointer :: xs + + if (self % isFissile()) then + xs => self % data(NU_FISSION, :) + else + xs => null() + end if + + end function getNuFissionPtr + + !! + !! Return pointer to Chis + !! + function getChiPtr(self) result(chi) + class(baseMgNeutronMaterial), intent(in), target :: self + real(defReal), dimension(:), pointer :: chi + + if (self % isFissile()) then + chi => self % fission % data(:,2) + else + chi => null() + end if + + end function getChiPtr + + !! + !! Return pointer to scatter XSs + !! + function getScatterPtr(self) result(xs) + class(baseMgNeutronMaterial), intent(in), target :: self + real(defReal), dimension(:,:), pointer :: xs + + xs => self % scatter % P0(:, :) + end function getScatterPtr + !! !! Cast materialHandle pointer to baseMgNeutronMaterial type pointer !! diff --git a/NuclearData/mgNeutronData/mgNeutronDatabase_inter.f90 b/NuclearData/mgNeutronData/mgNeutronDatabase_inter.f90 index 9caca7c1e..e600d0a34 100644 --- a/NuclearData/mgNeutronData/mgNeutronDatabase_inter.f90 +++ b/NuclearData/mgNeutronData/mgNeutronDatabase_inter.f90 @@ -1,7 +1,7 @@ module mgNeutronDatabase_inter use numPrecision - + ! Nuclear Data Interfaces & Objects use nuclearDatabase_inter, only : nuclearDatabase @@ -16,7 +16,7 @@ module mgNeutronDatabase_inter !! !! An abstract class that groups all MG Neutron Data objects !! - !! It does nothing, It adds nothing, + !! It does nothing, It adds nothing, (other than give the number of groups) !! It just provides a common superclass for related classes !! and holds the number of energy groups !! @@ -25,8 +25,29 @@ module mgNeutronDatabase_inter !! type, public, abstract, extends(nuclearDatabase) :: mgNeutronDatabase integer(shortInt) :: nG = 0 + contains end type mgNeutronDatabase + abstract interface + + !! + !! Returns the number of energy groups used + !! + !! Args: + !! None + !! + !! Result: + !! Integer number of energy groups + !! + pure function nGroups(self) result(ng) + import :: mgNeutronDatabase, shortInt + class(mgNeutronDatabase), intent(in) :: self + integer(shortInt) :: ng + end function nGroups + + + end interface + contains !! diff --git a/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 b/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 index daa90c37f..a2391a980 100644 --- a/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 +++ b/NuclearData/mgNeutronData/mgNeutronMaterial_inter.f90 @@ -51,6 +51,10 @@ module mgNeutronMaterial_inter ! Local procedures procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG procedure(getTotalXS), deferred :: getTotalXS + procedure(getNuFissionXS), deferred :: getNuFissionXS + procedure(getFissionXS), deferred :: getFissionXS + procedure(getChi), deferred :: getChi + procedure(getScatterXS), deferred :: getScatterXS procedure :: isFissile procedure :: set @@ -96,9 +100,95 @@ function getTotalXS(self, G, rand) result(xs) class(RNG), intent(inout) :: rand real(defReal) :: xs end function getTotalXS - end interface + !! + !! Return Macroscopic nu*Fission XS in a given group for the material + !! + !! Args: + !! G [in] -> Requested energygroup + !! rand [inout] -> Random number generator + !! + !! Result: + !! xs -> nuSigmaF value + !! + !! Errors: + !! fatalError if G is out-of-bounds for the stored data + !! + function getNuFissionXS(self, G, rand) result(xs) + import :: mgNeutronMaterial, defReal, shortInt, RNG + class(mgNeutronMaterial), intent(in) :: self + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + real(defReal) :: xs + end function getNuFissionXS + + !! + !! Return Macroscopic Fission XS in a given group for the material + !! + !! Args: + !! G [in] -> Requested energygroup + !! rand [inout] -> Random number generator + !! + !! Result: + !! xs -> nuSigmaF value + !! + !! Errors: + !! fatalError if G is out-of-bounds for the stored data + !! + function getFissionXS(self, G, rand) result(xs) + import :: mgNeutronMaterial, defReal, shortInt, RNG + class(mgNeutronMaterial), intent(in) :: self + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + real(defReal) :: xs + end function getFissionXS + + !! + !! Return fission spectrum (chi) in a given group for the material + !! + !! Args: + !! G [in] -> Requested energygroup + !! rand [inout] -> Random number generator + !! + !! Result: + !! chi -> fission spectrum value + !! + !! Errors: + !! fatalError if G is out-of-bounds for the stored data + !! + function getChi(self, G, rand) result(chi) + import :: mgNeutronMaterial, defReal, shortInt, RNG + class(mgNeutronMaterial), intent(in) :: self + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + real(defReal) :: chi + end function getChi + + !! + !! Return Macroscopic Scatter XSs for ingoing energy Gin and outgoing + !! energy Gout for the material + !! + !! Args: + !! Gin [in] -> Requested ingoing energygroup + !! Gout [in] -> Requested outgoing energygroup + !! rand [inout] -> Random number generator + !! + !! Result: + !! xs -> scatter XS + !! + !! Errors: + !! fatalError if Gin or Gout are out-of-bounds for the stored data + !! + function getScatterXS(self, Gin, Gout, rand) result(xs) + import :: mgNeutronMaterial, defReal, shortInt, RNG + class(mgNeutronMaterial), intent(in) :: self + integer(shortInt), intent(in) :: Gin + integer(shortInt), intent(in) :: Gout + class(RNG), intent(inout) :: rand + real(defReal) :: xs + end function getScatterXS + end interface contains diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index 8b16e96e7..ec2f72b6d 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -298,7 +298,7 @@ subroutine activate(type, name, activeMat, silent) if(.not.allocated(databases(idx) % nd)) call make(name, silent = silent_loc) ! Activate - call databases(idx) % nd % activate(activeMat) + call databases(idx) % nd % activate(activeMat, silent_loc) ptr => databases(idx) % nd ! Register as active @@ -415,13 +415,13 @@ function getNeutronCE() result(ptr) end function getNeutronCE !! - !! Return pointer to an active Neutron CE Database + !! Return pointer to an active Neutron MG Database !! !! Args: !! None !! !! Result: - !! ceNeutronDatabase class pointer + !! mgNeutronDatabase class pointer !! !! Errors: !! If there is no active database returns NULL ptr diff --git a/ParticleObjects/Source/materialSource_class.f90 b/ParticleObjects/Source/materialSource_class.f90 index 3a0c468e3..4863d2c56 100644 --- a/ParticleObjects/Source/materialSource_class.f90 +++ b/ParticleObjects/Source/materialSource_class.f90 @@ -153,7 +153,7 @@ function sampleParticle(self, rand) result(p) rejection : do ! Protect against infinite loop i = i +1 - if ( i > 200) then + if ( i > 5000) then call fatalError(Here, 'Infinite loop in sampling source. Please check that'//& ' defined volume contains source material.') end if diff --git a/PhysicsPackages/CMakeLists.txt b/PhysicsPackages/CMakeLists.txt index a1db7a1f4..71ab46f88 100644 --- a/PhysicsPackages/CMakeLists.txt +++ b/PhysicsPackages/CMakeLists.txt @@ -3,8 +3,11 @@ add_sources( ./physicsPackage_inter.f90 ./physicsPackageFactory_func.f90 ./eigenPhysicsPackage_class.f90 - ./fixedSourcePhysicsPackage_class.f90 + ./fixedSourcePhysicsPackage_class.f90 ./vizPhysicsPackage_class.f90 ./rayVolPhysicsPackage_class.f90 + ./randomRayPhysicsPackage_class.f90 + ./fixedSourceRRPhysicsPackage_class.f90 ) - #./dynamPhysicsPackage_class.f90) + +add_integration_tests(./Tests/randomRay_iTest.f90) diff --git a/PhysicsPackages/Tests/randomRay_iTest.f90 b/PhysicsPackages/Tests/randomRay_iTest.f90 new file mode 100644 index 000000000..f192d0a88 --- /dev/null +++ b/PhysicsPackages/Tests/randomRay_iTest.f90 @@ -0,0 +1,46 @@ +module randomRay_iTest + + use numPrecision + use dictionary_class, only : dictionary + use dictParser_func, only : charToDict + use charMap_class, only : charMap + use dictParser_func, only : fileToDict + use randomRayPhysicsPackage_class, only : randomRayPhysicsPackage + use fUnit + + implicit none + + +contains + + !! + !! Random ray integration test. + !! Homogeneous, reflected box. + !! Should have a precise eigenvalue, the ratio of nuSigmaF/SigmaA. + !! Uncertainties will not be present as all points in phase space are identical. + !! +@Test + subroutine test_random_ray() + type(randomRayPhysicsPackage) :: pp + character(*), parameter :: path = './IntegrationTestFiles/PhysicsPackages/SlabTRRM' + type(dictionary) :: dict + real(defReal) :: keff + real(defReal), parameter :: TOL = 1.0E-5_defReal + + ! Load dictionary + call fileToDict(dict, path) + + ! Initialise physics package and run + call pp % init(dict, loud = .false.) + call pp % run() + + ! Extract and verify keff + keff = pp % keffScore(1) + @assertEqual(keff, 2.25_defReal, TOL) + + ! Kill physics package + call pp % kill() + + end subroutine test_random_ray + +end module randomRay_iTest diff --git a/PhysicsPackages/eigenPhysicsPackage_class.f90 b/PhysicsPackages/eigenPhysicsPackage_class.f90 index 13822191c..227c96a4d 100644 --- a/PhysicsPackages/eigenPhysicsPackage_class.f90 +++ b/PhysicsPackages/eigenPhysicsPackage_class.f90 @@ -103,6 +103,9 @@ module eigenPhysicsPackage_class ! Timer bins integer(shortInt) :: timerMain + real(defReal) :: activeTime + real(defReal) :: inactiveTime + integer(shortInt) :: timerParticle real (defReal) :: time_transport = 0.0 real (defReal) :: CPU_time_start real (defReal) :: CPU_time_end @@ -123,17 +126,23 @@ module eigenPhysicsPackage_class subroutine run(self) class(eigenPhysicsPackage), intent(inout) :: self - print *, repeat("<>",50) - print *, "/\/\ EIGENVALUE CALCULATION /\/\" + if (self % loud) then + print *, repeat("<>",50) + print *, "/\/\ EIGENVALUE CALCULATION /\/\" + end if call self % generateInitialState() call self % cycles(self % inactiveTally, self % inactiveAtch, self % N_inactive) + self % inactiveTime = timerTime(self % timerParticle) call self % cycles(self % activeTally, self % activeAtch, self % N_active) + self % activeTime = timerTime(self % timerParticle) call self % collectResults() - print * - print *, "\/\/ END OF EIGENVALUE CALCULATION \/\/" - print * + if (self % loud) then + print * + print *, "\/\/ END OF EIGENVALUE CALCULATION \/\/" + print * + end if end subroutine !! @@ -162,7 +171,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Initialise neutron neutron % geomIdx = self % geomIdx - + ! Create a collision + transport operator which can be made thread private collOp = self % collOp transOp = self % transOp @@ -175,6 +184,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call timerReset(self % timerMain) call timerStart(self % timerMain) + call timerReset(self % timerParticle) + do i=1,N_cycles ! Send start of cycle report @@ -183,6 +194,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) nParticles = self % thisCycle % popSize() + call timerStart(self % timerParticle) !$omp parallel do schedule(dynamic) gen: do n = 1, nParticles @@ -279,14 +291,16 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Display progress - call printFishLineR(i) - print * - print *, 'Cycle: ', numToChar(i), ' of ', numToChar(N_cycles) - print *, 'Pop: ', numToChar(Nstart) , ' -> ', numToChar(Nend) - print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) - print *, 'End time: ', trim(secToChar(end_T)) - print *, 'Time to end: ', trim(secToChar(T_toEnd)) - call tally % display() + if (self % loud) then + call printFishLineR(i) + print * + print *, 'Cycle: ', numToChar(i), ' of ', numToChar(N_cycles) + print *, 'Pop: ', numToChar(Nstart) , ' -> ', numToChar(Nend) + print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) + print *, 'End time: ', trim(secToChar(end_T)) + print *, 'Time to end: ', trim(secToChar(T_toEnd)) + call tally % display() + end if end do ! Load elapsed time @@ -308,10 +322,10 @@ subroutine generateInitialState(self) call self % thisCycle % init(3 * self % pop) call self % nextCycle % init(3 * self % pop) - ! Generate initial source - print *, "GENERATING INITIAL FISSION SOURCE" + ! Generate initial surce + if (self % loud) print *, "GENERATING INITIAL FISSION SOURCE" call self % initSource % generate(self % thisCycle, self % pop, self % pRNG) - print *, "DONE!" + if (self % loud) print *, "DONE!" ! Update RNG after source generation call self % pRNG % stride(self % pop) @@ -337,8 +351,14 @@ subroutine collectResults(self) name = 'Inactive_Cycles' call out % printValue(self % N_inactive,name) + name = 'inactive_particles_per_s' + call out % printValue(self % pop * self % N_inactive /self % inactiveTime,name) + name = 'Active_Cycles' call out % printValue(self % N_active,name) + + name = 'active_particles_per_s' + call out % printValue(self % pop * self % N_active / self % activeTime,name) call cpu_time(self % CPU_time_end) name = 'Total_CPU_Time' @@ -368,9 +388,10 @@ end subroutine collectResults !! !! Initialise from individual components and dictionaries for inactive and active tally !! - subroutine init(self, dict) + subroutine init(self, dict, loud) class(eigenPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict + logical(defBool), intent(in), optional :: loud class(dictionary),pointer :: tempDict type(dictionary) :: locDict1, locDict2 integer(shortInt) :: seed_temp @@ -386,6 +407,12 @@ subroutine init(self, dict) call cpu_time(self % CPU_time_start) + if (present(loud)) then + self % loud = loud + else + self % loud = .true. + end if + ! Read calculation settings call dict % get( self % pop,'pop') call dict % get( self % N_inactive,'inactive') @@ -416,6 +443,7 @@ subroutine init(self, dict) ! Register timer self % timerMain = registerTimer('transportTime') + self % timerParticle = registerTimer('particleTime') ! Initialise RNG allocate(self % pRNG) @@ -447,20 +475,20 @@ subroutine init(self, dict) ! Build geometry tempDict => dict % getDictPtr('geometry') geomName = 'eigenGeom' - call new_geometry(tempDict, geomName) + call new_geometry(tempDict, geomName, .not. self % loud) self % geomIdx = gr_geomIdx(geomName) self % geom => gr_geomPtr(self % geomIdx) ! Activate Nuclear Data *** All materials are active - call ndReg_activate(self % particleType, nucData, self % geom % activeMats()) + call ndReg_activate(self % particleType, nucData, self % geom % activeMats(), .not. self % loud) self % nucData => ndReg_get(self % particleType) ! Call visualisation if (dict % isPresent('viz')) then - print *, "Initialising visualiser" + if (self % loud) print *, "Initialising visualiser" tempDict => dict % getDictPtr('viz') call viz % init(self % geom, tempDict) - print *, "Constructing visualisation" + if (self % loud) print *, "Constructing visualisation" call viz % makeViz() call viz % kill() endif @@ -549,7 +577,7 @@ subroutine init(self, dict) call self % activeTally % push(self % activeAtch) - call self % printSettings() + if (self % loud) call self % printSettings() end subroutine init diff --git a/PhysicsPackages/fixedSourcePhysicsPackage_class.f90 b/PhysicsPackages/fixedSourcePhysicsPackage_class.f90 index 855ccc7c1..0557e7fdf 100644 --- a/PhysicsPackages/fixedSourcePhysicsPackage_class.f90 +++ b/PhysicsPackages/fixedSourcePhysicsPackage_class.f90 @@ -112,15 +112,19 @@ module fixedSourcePhysicsPackage_class subroutine run(self) class(fixedSourcePhysicsPackage), intent(inout) :: self - print *, repeat("<>",50) - print *, "/\/\ FIXED SOURCE CALCULATION /\/\" + if (self % loud) then + print *, repeat("<>",50) + print *, "/\/\ FIXED SOURCE CALCULATION /\/\" + end if call self % cycles(self % tally, self % N_cycles) call self % collectResults() - print * - print *, "\/\/ END OF FIXED SOURCE CALCULATION \/\/" - print * + if (self % loud) then + print * + print *, "\/\/ END OF FIXED SOURCE CALCULATION \/\/" + print * + end if end subroutine !! @@ -172,6 +176,9 @@ subroutine cycles(self, tally, N_cycles) call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) end if + ! Update RNG after source generation + call self % pRNG % stride(self % pop) + call tally % reportCycleStart(self % thisCycle) !$omp parallel do schedule(dynamic) @@ -240,7 +247,7 @@ subroutine cycles(self, tally, N_cycles) ! Update RNG call self % pRNG % stride(self % pop) - + ! Send end of cycle report call tally % reportCycleEnd(self % thisCycle) @@ -253,14 +260,16 @@ subroutine cycles(self, tally, N_cycles) T_toEnd = max(ZERO, end_T - elapsed_T) ! Display progress - call printFishLineR(i) - print * - print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) - print *, 'Pop: ', numToChar(self % pop) - print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) - print *, 'End time: ', trim(secToChar(end_T)) - print *, 'Time to end: ', trim(secToChar(T_toEnd)) - call tally % display() + if (self % loud) then + call printFishLineR(i) + print * + print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) + print *, 'Pop: ', numToChar(self % pop) + print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) + print *, 'End time: ', trim(secToChar(end_T)) + print *, 'Time to end: ', trim(secToChar(T_toEnd)) + call tally % display() + end if end do end subroutine cycles @@ -300,9 +309,10 @@ end subroutine collectResults !! !! Initialise from individual components and dictionaries for source and tally !! - subroutine init(self, dict) + subroutine init(self, dict, loud) class(fixedSourcePhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict + logical(defBool), intent(in), optional :: loud class(dictionary),pointer :: tempDict integer(shortInt) :: seed_temp, commonBufferSize integer(longInt) :: seed @@ -316,6 +326,12 @@ subroutine init(self, dict) call cpu_time(self % CPU_time_start) + if (present(loud)) then + self % loud = loud + else + self % loud = .true. + end if + ! Read calculation settings call dict % get( self % pop,'pop') call dict % get( self % N_cycles,'cycles') @@ -373,20 +389,20 @@ subroutine init(self, dict) ! Build geometry tempDict => dict % getDictPtr('geometry') geomName = 'fixedSourceGeom' - call new_geometry(tempDict, geomName) + call new_geometry(tempDict, geomName, .not. self % loud) self % geomIdx = gr_geomIdx(geomName) self % geom => gr_geomPtr(self % geomIdx) ! Activate Nuclear Data *** All materials are active - call ndReg_activate(self % particleType, nucData, self % geom % activeMats()) + call ndReg_activate(self % particleType, nucData, self % geom % activeMats(), .not. self % loud) self % nucData => ndReg_get(self % particleType) ! Call visualisation if (dict % isPresent('viz')) then - print *, "Initialising visualiser" + if (self % loud) print *, "Initialising visualiser" tempDict => dict % getDictPtr('viz') call viz % init(self % geom, tempDict) - print *, "Constructing visualisation" + if (self % loud) print *, "Constructing visualisation" call viz % makeViz() call viz % kill() endif @@ -433,7 +449,7 @@ subroutine init(self, dict) 'Buffer size should be greater than the shift threshold') end if - call self % printSettings() + if (self % loud) call self % printSettings() end subroutine init diff --git a/PhysicsPackages/fixedSourceRRPhysicsPackage_class.f90 b/PhysicsPackages/fixedSourceRRPhysicsPackage_class.f90 new file mode 100644 index 000000000..5f2479d04 --- /dev/null +++ b/PhysicsPackages/fixedSourceRRPhysicsPackage_class.f90 @@ -0,0 +1,684 @@ +module fixedSourceRRPhysicsPackage_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError, numToChar, printFishLineR + use hashFunctions_func, only : FNV_1 + use dictionary_class, only : dictionary + use outputFile_class, only : outputFile + use rng_class, only : RNG + use physicsPackage_inter, only : physicsPackage + + ! Timers + use timer_mod, only : registerTimer, timerStart, timerStop, & + timerTime, timerReset, secToChar + + ! Geometry + use geometry_inter, only : geometry + use geometryStd_class, only : geometryStd + use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_geomIdx => geomIdx, & + gr_fieldIdx => fieldIdx, gr_fieldPtr => fieldPtr + use geometryFactory_func, only : new_geometry + + ! Nuclear Data + use nuclearDataReg_mod, only : ndReg_init => init, & + ndReg_getMatNames => getMatNames, & + ndReg_activate => activate, & + ndReg_kill => kill, & + ndReg_getNeutronMG => getNeutronMG + use mgNeutronDatabase_inter, only : mgNeutronDatabase + use baseMgNeutronDatabase_class, only : baseMgNeutronDatabase + use baseMgNeutronMaterial_class, only : baseMgNeutronMaterial, baseMgNeutronMaterial_CptrCast + + ! Visualisation + use visualiser_class, only : visualiser + + ! Tally + use tallyAdmin_class, only : tallyAdmin + + ! Random ray specific modules + use dataRR_class, only : dataRR + use arraysRR_class, only : arraysRR + use rayHandling_func, only : transportSweep, initialiseRay + + ! Random ray - or a standard particle + use particle_class, only : ray => particle + use particleDungeon_class, only : particleDungeon + + implicit none + private + + !! + !! Physics package to perform The Random Ray Method (TRRM) fixed source calculations. + !! For now, sources are material sources, isotropic in a given material volume. + !! + !! TODO: introduce uncollided transport sweep + !! + !! Tracks rays across the geometry, attenuating their flux. After some dead length, + !! rays begin scoring to estimates of the scalar flux and volume. Each ray has a + !! uniform termination length, after which it is stopped and the next ray is tracked. + !! Once all rays have been tracked, a cycle concludes and fluxes, sources, and keff + !! are updated. + !! + !! Both inactive and active cycles occur, as in Monte Carlo eigenvalue calculations. + !! These can be terminated after a specified number of iterations or on reaching some + !! chosen convergence criterion (though the latter hasn't been implemented yet). + !! + !! Calculates relative volume of different materials in the problem by performing + !! random ray tracing in the geometry. The volume is normalised such that the total domain + !! volume is 1.0. + !! + !! IMPORTANT N.B.: Geometry type must be extended! Won't run if shrunk. + !! This is because spatial discretisation is determined by the number of unique cells in the + !! geometry. + !! Also, this is obviously for multi-group calculations only. + !! + !! Sample Input Dictionary: + !! PP { + !! type fixedSourceRRPhysicsPackage; + !! dead 10; // Dead length where rays do not score to scalar fluxes + !! termination 100; // Length a ray travels before it is terminated + !! rays 1000; // Number of rays to sample per iteration + !! inactive 100; // Number of convergence cycles + !! active 200; // Number of scoring cycles + !! #seed 86868;# // Optional RNG seed + !! #cache 1;# // Optionally use distance caching to accelerate ray tracing + !! #plot 1;# // Optionally make VTK viewable plot of fluxes and uncertainties + !! #rho 0;# // Optional stabilisation for negative in-group scattering XSs + !! #lin 0;# // Optionally use linear (rather than flat) sources + !! #2d 0;# // Optional input to stablise linear sources in 2D problems + !! #volPolicy 1;# // Optional input to specify how volumes should be handled + !! #missPolicy 1;# // Optional input to specify how misses should be handled + !! #cadis 0;# // Optionally generate adjoints for global variance reduction + !! + !! source { + !! sourceMaterialName1 (strengthG1 strengthG2 ... strengthGN); + !! #sourceMaterialName2 (strengthG1 strengthG2 ... strengthGN);# + !! } + !! + !! tally {} + !! geometry {} + !! nuclearData {} + !! } + !! + !! Private Members + !! geom -> Pointer to the geometry. + !! geomIdx -> Index of the geometry in geometry Registry. + !! rand -> Random number generator. + !! timerMain -> Index of the timer defined to measure calculation time. + !! mgData -> MG database. Calculation obviously cannot be run in CE. + !! nG -> Number of energy groups, kept for convenience. + !! nCells -> Number of unique cells in the geometry, kept for convenience. + !! doCADIS -> Logical to check whether to do adjoint calculations + !! + !! termination -> Distance a ray can travel before it is terminated + !! dead -> Distance a ray must travel before it becomes active + !! pop -> Number of rays to track per cycle + !! inactive -> Number of inactive cycles to perform + !! active -> Number of active cycles to perform + !! cache -> Logical check whether to use distance caching + !! outputFile -> Output file name + !! outputFormat-> Output file format + !! plotResults -> Plot results with VTK? + !! viz -> Output visualiser + !! tally -> Tally admin for outputting results + !! + !! intersectionsTotal -> Total number of ray traces for the calculation + !! + !! Interface: + !! physicsPackage interface + !! + type, public, extends(physicsPackage) :: fixedSourceRRPhysicsPackage + private + ! Components + class(geometryStd), pointer :: geom + integer(shortInt) :: geomIdx = 0 + type(RNG) :: rand + type(arraysRR) :: arrays + type(dataRR) :: XSData + class(baseMgNeutronDatabase), pointer :: mgData => null() + integer(shortInt) :: nG = 0 + integer(shortInt) :: nCells = 0 + type(tallyAdmin),pointer :: tally => null() + + ! Settings + real(defReal) :: termination = ZERO + real(defReal) :: dead = ZERO + integer(shortInt) :: pop = 0 + integer(shortInt) :: inactive = 0 + integer(shortInt) :: active = 0 + logical(defBool) :: cache = .false. + real(defReal) :: rho = ZERO + logical(defBool) :: lin = .false. + real(defReal) :: keff = ONE + character(pathLen) :: outputFile + character(nameLen) :: outputFormat + logical(defBool) :: plotResults = .false. + logical(defBool) :: printFlux = .false. + logical(defBool) :: printVolume = .false. + logical(defBool) :: printCells = .false. + type(visualiser) :: viz + real(defReal), dimension(:,:), allocatable :: samplePoints + character(nameLen),dimension(:), allocatable :: sampleNames + logical(defBool) :: doCADIS = .false. + + ! Results space + integer(longInt) :: intersectionsTotal = 0 + + ! Timer bins + integer(shortInt) :: timerMain + integer(shortInt) :: timerTransport + real (defReal) :: time_transport = ZERO + real (defReal) :: CPU_time_start + real (defReal) :: CPU_time_end + + contains + ! Superclass procedures + procedure :: init + procedure :: run + procedure :: kill + + ! Private procedures + procedure, private :: cycles + procedure, private :: printResults + procedure, private :: printSettings + + end type fixedSourceRRPhysicsPackage + +contains + + !! + !! Initialise Physics Package from dictionary + !! + !! See physicsPackage_inter for details + !! + subroutine init(self, dict, loud) + class(fixedSourceRRPhysicsPackage), intent(inout) :: self + class(dictionary), intent(inout) :: dict + logical(defBool), intent(in), optional :: loud + integer(shortInt) :: seed_temp, n, nPoints, volP, missP + integer(longInt) :: seed + character(10) :: time + character(8) :: date + character(:),allocatable :: string + class(dictionary),pointer :: tempDict, graphDict + real(defReal), dimension(:), allocatable :: tempArray + class(mgNeutronDatabase),pointer :: db + character(nameLen) :: geomName, graphType, nucData + class(geometry), pointer :: geom + type(outputFile) :: test_out + character(100), parameter :: Here = 'init (fixedSourceRRPhysicsPackage_class.f90)' + + call cpu_time(self % CPU_time_start) + + if (present(loud)) then + self % loud = loud + else + self % loud = .true. + end if + + ! Load settings + call dict % get( nucData, 'XSdata') + call dict % get(self % termination, 'termination') + call dict % get(self % dead, 'dead') + call dict % get(self % pop, 'pop') + call dict % get(self % active, 'active') + call dict % get(self % inactive, 'inactive') + call dict % getOrDefault(self % keff, 'keff', ONE) + + call dict % getOrDefault(volP, 'volPolicy', 1) + call dict % getOrDefault(missP, 'missPolicy', 1) + + call dict % getOrDefault(self % doCadis, 'cadis', .false.) + + ! Perform distance caching? + call dict % getOrDefault(self % cache, 'cache', .false.) + + ! Stabilisation factor for negative in-group scattering + call dict % getOrDefault(self % rho, 'rho', ZERO) + + ! Use linear sources? + call dict % getOrDefault(self % lin, 'lin', .false.) + + ! Read outputfile path + call dict % getOrDefault(self % outputFile,'outputFile','./output') + + ! Get output format and verify + ! Initialise output file before calculation (so mistake in format will be cought early) + call dict % getOrDefault(self % outputFormat, 'outputFormat', 'asciiMATLAB') + call test_out % init(self % outputFormat) + + ! Check settings + if (self % termination <= ZERO) call fatalError(Here, & + 'Ray termination distance (termination) is less than or equal to zero.') + if (self % pop < 1) call fatalError(Here, 'Must have 1 or more rays (pop).') + if (self % dead < ZERO) call fatalError(Here, 'Dead length must be positive.') + if (self % termination <= self % dead) call fatalError(Here,& + 'Ray termination length must be greater than ray dead length') + + ! Return flux values at sample points? + ! Store a set of points to return values at on concluding the simulation + if (dict % isPresent('samplePoints')) then + + tempDict => dict % getDictPtr('samplePoints') + call tempDict % keys(self % sampleNames) + nPoints = size(self % sampleNames) + allocate(self % samplePoints(3, nPoints)) + do n = 1, nPoints + + call tempDict % get(tempArray, self % sampleNames(n)) + if (size(tempArray) /= 3) call fatalError(Here, 'Sample points must be 3 dimensional') + self % samplePoints(:, n) = tempArray + + end do + + end if + + ! Register timer + self % timerMain = registerTimer('simulationTime') + self % timerTransport = registerTimer('transportTime') + + ! Initialise RNG + if( dict % isPresent('seed')) then + call dict % get(seed_temp,'seed') + else + ! Obtain time string and hash it to obtain random seed + call date_and_time(date, time) + string = date // time + call FNV_1(string,seed_temp) + end if + seed = seed_temp + call self % rand % init(seed) + + ! Build Nuclear Data + call ndReg_init(dict % getDictPtr("nuclearData")) + + ! Build geometry + tempDict => dict % getDictPtr('geometry') + geomName = 'randomRayGeom' + call new_geometry(tempDict, geomName, silent = .not. self % loud) + self % geomIdx = gr_geomIdx(geomName) + geom => gr_geomPtr(self % geomIdx) + + ! Ensure geometry is geometryStd + select type(geom) + type is (geometryStd) + self % geom => geom + class default + call fatalError(Here,'Unrecognised geometry type') + end select + + ! Ensure that geometry graph is extended + graphDict => tempDict % getDictPtr('graph') + call graphDict % get(graphType,'type') + if (graphType /= 'extended') call fatalError(Here,& + 'Geometry graph type must be "extended" for random ray calculations.') + + ! Initialise tally Admin + if (dict % isPresent('tally')) then + tempDict => dict % getDictPtr('tally') + allocate(self % tally) + call self % tally % init(tempDict) + end if + + ! Activatee nuclear data + call ndReg_activate(P_NEUTRON_MG, nucData, self % geom % activeMats(), silent = .not. self % loud) + + ! Ensure that nuclear data is multi-group + db => ndReg_getNeutronMG() + if (.not. associated(db)) call fatalError(Here,& + 'No MG nuclear database was constructed') + + ! Ensure nuclear data is baseMgNeutronDatabase + select type(db) + type is (baseMgNeutronDatabase) + self % mgData => db + class default + call fatalError(Here,'Unrecognised MG database type') + end select + + ! Store number of energy groups for convenience + self % nG = self % mgData % nGroups() + + ! Call visualisation + if (dict % isPresent('viz')) then + if (self % loud) print *, "Initialising visualiser" + tempDict => dict % getDictPtr('viz') + call self % viz % init(geom, tempDict) + if (self % loud) print *, "Constructing visualisation" + call self % viz % makeViz() + call self % viz % kill() + endif + + ! Check for results plotting and initialise VTK + call dict % getOrDefault(self % plotResults,'plot',.false.) + if (self % plotResults) then + ! Initialise a visualiser to be used when results are available + if (self % loud) print *, "Initialising results visualiser" + tempDict => dict % getDictPtr('viz') + call self % viz % init(geom, tempDict) + if (self % loud) print *, "Constructing geometry visualisation" + call self % viz % initVTK() + end if + + ! Store number of cells in geometry for convenience + self % nCells = self % geom % numberOfCells() + + ! Read fixed source dictionary + tempDict => dict % getDictPtr('source') + + ! Initialise RR arrays and nuclear data + call self % arrays % init(self % mgData, self % geom, & + self % pop * (self % termination - self % dead), self % rho, self % lin, & + .false., self % loud, dictFS = tempDict, volPolicy = volP, missPolicy = missP) + + ! Zeros the prevFlux - makes for a better initial guess than 1's in eigenvalue! + call self % arrays % resetFluxes() + + end subroutine init + + !! + !! Run calculation + !! + !! See physicsPackage_inter for details + !! + subroutine run(self) + class(fixedSourceRRPhysicsPackage), intent(inout) :: self + + if (self % loud) call self % printSettings() + call self % cycles() + call self % printResults() + if (self % doCadis) then + if (self % loud) print *,'Performing adjoint calculation' + ! Reinitialise VTK + !if (self % plotResults) call self % viz % initVTK() + call self % arrays % initAdjoint() + call self % cycles() + self % outputFile = trim(self % outputFile)//'_adj' + call self % printResults() + end if + + end subroutine run + + !! + !! Perform cycles of The Random Ray Method. + !! + !! Randomly places the ray starting point and direction uniformly. + !! Rays are tracked until they reach some specified termination length. + !! During tracking, fluxes are attenuated (and adjusted according to BCs), + !! scoring to fluxes and volume estimates when the ray has surpassed its + !! specified dead length. + !! + !! Inactive and active iterations occur, terminating subject either to + !! given criteria or when a fixed number of iterations has been passed. + !! + subroutine cycles(self) + class(fixedSourceRRPhysicsPackage), target, intent(inout) :: self + type(ray), save :: r + type(RNG), target, save :: pRNG + real(defReal) :: hitRate + real(defReal) :: ONE_KEFF, elapsed_T, end_T, & + T_toEnd, transport_T + logical(defBool) :: keepRunning, isActive + integer(shortInt) :: i, itInac, itAct, it + integer(longInt), save :: ints + integer(longInt) :: intersections + class(arraysRR), pointer :: arrayPtr + type(particleDungeon) :: dummyDungeon + !$omp threadprivate(pRNG, r, ints) + + ! Reset and start timer + call timerReset(self % timerMain) + call timerStart(self % timerMain) + + arrayPtr => self % arrays + call arrayPtr % zeroPrevFlux() + + ! Stopping criterion is on number of convergence iterations. + ! TODO: Make this on, e.g., entropy during inactive, followed by stochastic noise during active! + itInac = 0 + itAct = 0 + isActive = .false. + keepRunning = .true. + + ! Keep a fixed keff + ONE_KEFF = ONE / self % keff + + ! Power iteration + do while( keepRunning ) + + if (isActive) then + itAct = itAct + 1 + else + itInac = itInac + 1 + end if + it = itInac + itAct + + call arrayPtr % updateSource(ONE_KEFF) + + ! Reset and start transport timer + call timerReset(self % timerTransport) + call timerStart(self % timerTransport) + intersections = 0 + + !$omp parallel do schedule(dynamic) reduction(+:intersections) + do i = 1, self % pop + + ! Set seed + pRNG = self % rand + call pRNG % stride(i) + r % pRNG => pRNG + + ! Set ray attributes + call initialiseRay(r, arrayPtr) + + ! Transport ray until termination criterion met + call transportSweep(r, ints, self % nG, self % cache, self % dead, & + self % termination, arrayPtr) + intersections = intersections + ints + + end do + !$omp end parallel do + + self % intersectionsTotal = self % intersectionsTotal + intersections + + call timerStop(self % timerTransport) + + ! Update RNG on master thread + call self % rand % stride(self % pop + 1) + + ! Normalise flux estimate and combines with source + call arrayPtr % normaliseFluxAndVolume(it) + + ! Accumulate flux scores and tally results + if (isActive) then + call arrayPtr % accumulateFluxScores() + if (associated(self % tally)) then + call arrayPtr % tallyResults(self % tally) + call self % tally % reportCycleEnd(dummyDungeon) + end if + end if + + ! Calculate proportion of cells that were hit + hitRate = arrayPtr % getCellHitRate(it) + call arrayPtr % wipeCellHits() + + ! Evaluate stopping criterion for active or inactive iterations + if (isActive) then + keepRunning = (itAct < self % active) + else + isActive = (itInac >= self % inactive) + end if + + ! Set previous iteration flux to scalar flux + ! and zero scalar flux + call arrayPtr % resetFluxes() + + ! Calculate times + call timerStop(self % timerMain) + elapsed_T = timerTime(self % timerMain) + transport_T = timerTime(self % timerTransport) + self % time_transport = self % time_transport + transport_T + + ! Predict time to end + end_T = real(self % active + self % inactive, defReal) * elapsed_T / it + T_toEnd = max(ZERO, end_T - elapsed_T) + + ! Display progress + if (self % loud) then + call printFishLineR(it) + print * + print *, 'Iteration: ', numToChar(it), ' of ', numToChar(self % active + self % inactive) + if(isActive) then + print *,'Active iterations' + else + print *,'Inactive iterations' + end if + print *, 'Cell hit rate: ', trim(numToChar(real(hitRate,defReal))) + print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) + print *, 'End time: ', trim(secToChar(end_T)) + print *, 'Time to end: ', trim(secToChar(T_toEnd)) + print *, 'Time per integration (ns): ', & + trim(numToChar(transport_T*10**9/(self % nG * intersections))) + end if + + end do + + ! Finalise flux and keff scores + call arrayPtr % finaliseFluxScores(itAct) + + end subroutine cycles + + !! + !! Output calculation results to a file + !! + !! Args: + !! None + !! + subroutine printResults(self) + class(fixedSourceRRPhysicsPackage), target, intent(inout) :: self + type(outputFile), target :: out + character(nameLen) :: name + class(outputFile), pointer :: outPtr + class(visualiser), pointer :: vizPtr + + call out % init(self % outputFormat, filename = self % outputFile) + + name = 'seed' + call out % printValue(self % rand % getSeed(),name) + + name = 'pop' + call out % printValue(self % pop,name) + + name = 'Inactive_Cycles' + call out % printValue(self % inactive,name) + + name = 'Active_Cycles' + call out % printValue(self % active,name) + + call cpu_time(self % CPU_time_end) + name = 'Total_CPU_Time' + call out % printValue((self % CPU_time_end - self % CPU_time_start),name) + + name = 'Total_Transport_Time' + call out % printValue(self % time_transport,name) + + name = 'Time_Per_Integration' + call out % printValue(self % time_transport/(self % intersectionsTotal * self % nG),name) + + name = 'Clock_Time' + call out % printValue(timerTime(self % timerMain),name) + + name = 'Hit_rate' + call out % printValue(self % arrays % getAverageHitRate(),name) + + ! Print tally + if (associated(self % tally)) then + name = 'tally' + call out % startBlock(name) + call self % tally % print(out) + call out % endBlock() + end if + + ! Output fluxes at a point + if (allocated(self % samplePoints)) then + outPtr => out + call self % arrays % outputPointFluxes(outPtr, self % samplePoints, self % sampleNames) + outPtr => null() + end if + + ! Send all fluxes and SDs to VTK + vizPtr => self % viz + if (self % plotResults) call self % arrays % outputToVTK(vizPtr) + + end subroutine printResults + + !! + !! Print settings of the random ray calculation + !! + !! Args: + !! None + !! + subroutine printSettings(self) + class(fixedSourceRRPhysicsPackage), intent(in) :: self + + print *, repeat("<>", MAX_COL/2) + print *, "/\/\ RANDOM RAY FIXED SOURCE CALCULATION /\/\" + if (self % doCadis) print *, "Will run a subsequent adjoint calculation" + if (self % lin) print *, "Using linear source" + print *, "Using "//numToChar(self % inactive)// " iterations for "& + //"the inactive cycles" + print *, "Using "//numToChar(self % active)// " iterations for "& + //"the active cycles" + print * + print *, "Rays per cycle: "// numToChar(self % pop) + print *, "Ray dead length: "//numToChar(self % dead) + print *, "Ray termination length: "//numToChar(self % termination) + print *, "Initial RNG Seed: "// numToChar(self % rand % getSeed()) + print * + print *, "Number of cells in the geometry: "// numToChar(self % nCells) + print *, "Number of energy groups: "// numToChar(self % nG) + if (self % cache) print *, "Accelerated with distance caching" + print *, repeat("<>", MAX_COL/2) + + end subroutine printSettings + + !! + !! Return to uninitialised state + !! + subroutine kill(self) + class(fixedSourceRRPhysicsPackage), intent(inout) :: self + + ! Clean Nuclear Data, Geometry and visualisation + call ndreg_kill() + call self % viz % kill() + + ! Clean contents + self % geom => null() + self % geomIdx = 0 + self % timerMain = 0 + self % timerTransport = 0 + self % mgData => null() + self % nG = 0 + self % nCells = 0 + self % termination = ZERO + self % dead = ZERO + self % pop = 0 + self % inactive = 0 + self % active = 0 + self % cache = .false. + self % lin = .false. + self % plotResults = .false. + self % keff = ONE + call self % arrays % kill() + call self % XSData % kill() + if(allocated(self % samplePoints)) deallocate(self % samplePoints) + if(allocated(self % sampleNames)) deallocate(self % sampleNames) + if(associated(self % tally)) then + call self % tally % kill() + self % tally => null() + end if + + end subroutine kill + +end module fixedSourceRRPhysicsPackage_class diff --git a/PhysicsPackages/physicsPackageFactory_func.f90 b/PhysicsPackages/physicsPackageFactory_func.f90 index 48de37e1c..c793453e3 100644 --- a/PhysicsPackages/physicsPackageFactory_func.f90 +++ b/PhysicsPackages/physicsPackageFactory_func.f90 @@ -11,10 +11,12 @@ module physicsPackageFactory_func use physicsPackage_inter, only : physicsPackage ! Implementations - use eigenPhysicsPackage_class, only : eigenPhysicsPackage - use fixedSourcePhysicsPackage_class, only : fixedSourcePhysicsPackage - use vizPhysicsPackage_class, only : vizPhysicsPackage - use rayVolPhysicsPackage_class, only : rayVolPhysicsPackage + use eigenPhysicsPackage_class, only : eigenPhysicsPackage + use fixedSourcePhysicsPackage_class, only : fixedSourcePhysicsPackage + use vizPhysicsPackage_class, only : vizPhysicsPackage + use rayVolPhysicsPackage_class, only : rayVolPhysicsPackage + use randomRayPhysicsPackage_class, only : randomRayPhysicsPackage + use fixedSourceRRPhysicsPackage_class, only : fixedSourceRRPhysicsPackage ! use dynamPhysicsPackage_class, only : dynamPhysicsPackage implicit none @@ -24,10 +26,12 @@ module physicsPackageFactory_func ! It is printed if type was unrecognised ! NOTE: ! For now it is necessary to adjust trailing blanks so all enteries have the same length - character(nameLen),dimension(*),parameter :: AVAILABLE_physicsPackages = [ 'eigenPhysicsPackage ',& - 'fixedSourcePhysicsPackage',& - 'vizPhysicsPackage ',& - 'rayVolPhysicsPackage '] + character(nameLen),dimension(*),parameter :: AVAILABLE_physicsPackages = [ 'eigenPhysicsPackage ',& + 'fixedSourcePhysicsPackage ',& + 'vizPhysicsPackage ',& + 'randomRayPhysicsPackage ',& + 'fixedSourceRRPhysicsPackage ',& + 'rayVolPhysicsPackage '] !! !! Public interface @@ -60,6 +64,12 @@ function new_physicsPackage(dict) result(new) case('vizPhysicsPackage') allocate( vizPhysicsPackage :: new) + case('randomRayPhysicsPackage') + allocate( randomRayPhysicsPackage :: new) + + case('fixedSourceRRPhysicsPackage') + allocate( fixedSourceRRPhysicsPackage :: new) + case('rayVolPhysicsPackage') allocate( rayVolPhysicsPackage :: new) diff --git a/PhysicsPackages/physicsPackage_inter.f90 b/PhysicsPackages/physicsPackage_inter.f90 index a5e3e1792..8b3640100 100644 --- a/PhysicsPackages/physicsPackage_inter.f90 +++ b/PhysicsPackages/physicsPackage_inter.f90 @@ -9,10 +9,12 @@ module physicsPackage_inter !! !! Abstract interface of physics Package !! Physics package is controles a calculation flow - !! Each type of calculation has diffrent physics package + !! Each type of calculation has different physics package + !! Loud is for displaying calculation progress !! type, public,abstract :: physicsPackage private + logical(defBool), public :: loud contains procedure(init), deferred :: init procedure(run),deferred :: run @@ -23,11 +25,13 @@ module physicsPackage_inter !! !! Initialise Physics Package from dictionary !! - subroutine init(self,dict) + subroutine init(self,dict,loud) import :: physicsPackage, & - dictionary - class(physicsPackage), intent(inout) :: self - class(dictionary), intent(inout) :: dict + dictionary, & + defBool + class(physicsPackage), intent(inout) :: self + class(dictionary), intent(inout) :: dict + logical(defBool), intent(in), optional :: loud end subroutine init !! diff --git a/PhysicsPackages/randomRayPhysicsPackage_class.f90 b/PhysicsPackages/randomRayPhysicsPackage_class.f90 new file mode 100644 index 000000000..7b9201fd3 --- /dev/null +++ b/PhysicsPackages/randomRayPhysicsPackage_class.f90 @@ -0,0 +1,659 @@ +module randomRayPhysicsPackage_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError, numToChar, printFishLineR + use hashFunctions_func, only : FNV_1 + use dictionary_class, only : dictionary + use outputFile_class, only : outputFile + use rng_class, only : RNG + use physicsPackage_inter, only : physicsPackage + + ! Timers + use timer_mod, only : registerTimer, timerStart, timerStop, & + timerTime, timerReset, secToChar + + ! Geometry + use geometry_inter, only : geometry + use geometryStd_class, only : geometryStd + use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_geomIdx => geomIdx, & + gr_fieldIdx => fieldIdx, gr_fieldPtr => fieldPtr + use geometryFactory_func, only : new_geometry + + ! Nuclear Data + use nuclearDataReg_mod, only : ndReg_init => init, & + ndReg_getMatNames => getMatNames, & + ndReg_activate => activate, & + ndReg_kill => kill, & + ndReg_getNeutronMG => getNeutronMG + use mgNeutronDatabase_inter, only : mgNeutronDatabase + use baseMgNeutronDatabase_class, only : baseMgNeutronDatabase + use baseMgNeutronMaterial_class, only : baseMgNeutronMaterial, baseMgNeutronMaterial_CptrCast + + ! Visualisation + use visualiser_class, only : visualiser + + ! Tally map for fission rate + use tallyAdmin_class, only : tallyAdmin + + ! Random ray specific modules + use dataRR_class, only : dataRR + use arraysRR_class, only : arraysRR + use rayHandling_func, only : transportSweep, initialiseRay + + ! Random ray - or a standard particle + use particle_class, only : ray => particle + use particleDungeon_class, only : particleDungeon + + implicit none + private + + !! + !! Physics package to perform The Random Ray Method (TRRM) eigenvalue calculations + !! + !! Tracks rays across the geometry, attenuating their flux. After some dead length, + !! rays begin scoring to estimates of the scalar flux and volume. Each ray has a + !! uniform termination length, after which it is stopped and the next ray is tracked. + !! Once all rays have been tracked, a cycle concludes and fluxes, sources, and keff + !! are updated. + !! + !! Both inactive and active cycles occur, as in Monte Carlo. These can be terminated + !! after a specified number of iterations or on reaching some chosen convergence + !! criterion (though the latter hasn't been implemented yet). + !! + !! Calculates relative volume of different materials in the problem by performing + !! random ray tracing in the geometry. The volume is normalised such that the total domain + !! volume is 1.0. + !! + !! IMPORTANT N.B.: Geometry type must be extended! Won't run if shrunk. + !! This is because spatial discretisation is determined by the number of unique cells in the + !! geometry. + !! Also, this is obviously for multi-group calculations only. + !! + !! Sample Input Dictionary: + !! PP { + !! type randomRayPhysicsPackage; + !! dead 10; // Dead length where rays do not score to scalar fluxes + !! termination 100; // Length a ray travels before it is terminated + !! rays 1000; // Number of rays to sample per iteration + !! inactive 100; // Number of convergence cycles + !! active 200; // Number of scoring cycles + !! #seed 86868;# // Optional RNG seed + !! #cache 1;# // Optionally use distance caching to accelerate ray tracing + !! #fissionMap {}# // Optionally output fission rates according to a given map + !! #fluxMap {}# // Optionally output one-group fluxes according to a given map + !! #plot 1;# // Optionally make VTK viewable plot of fluxes and uncertainties + !! #rho 0;# // Optional stabilisation for negative in-group scattering XSs + !! #lin 0;# // Optionally use linear (rather than flat) sources + !! #2d 0;# // Optional input to stablise linear sources in 2D problems + !! #volPolicy 1;# // Optional input to specify how volumes should be handled + !! #missPolicy 1;# // Optional input to specify how misses should be handled + !! + !! geometry {} + !! nuclearData {} + !! tally {} + !! } + !! + !! Private Members + !! geom -> Pointer to the geometry. + !! geomIdx -> Index of the geometry in geometry Registry. + !! rand -> Random number generator. + !! timerMain -> Index of the timer defined to measure calculation time. + !! mgData -> MG database. Calculation obviously cannot be run in CE. + !! nG -> Number of energy groups, kept for convenience. + !! nCells -> Number of unique cells in the geometry, kept for convenience. + !! + !! termination -> Distance a ray can travel before it is terminated + !! dead -> Distance a ray must travel before it becomes active + !! pop -> Number of rays to track per cycle + !! inactive -> Number of inactive cycles to perform + !! active -> Number of active cycles to perform + !! cache -> Logical check whether to use distance caching + !! outputFile -> Output file name + !! outputFormat-> Output file format + !! plotResults -> Plot results? + !! viz -> Output visualiser + !! tally -> Tally admin for outputting results + !! + !! keff -> Estimated value of keff + !! keffScore -> Vector holding cumulative keff score and keff^2 score + !! + !! tally -> Tally admin to output results + !! + !! intersectionsTotal -> Total number of ray traces for the calculation + !! + !! Interface: + !! physicsPackage interface + !! + type, public, extends(physicsPackage) :: randomRayPhysicsPackage + private + ! Components + class(geometryStd), pointer :: geom + integer(shortInt) :: geomIdx = 0 + type(RNG) :: rand + type(arraysRR) :: arrays + type(dataRR) :: XSData + class(baseMgNeutronDatabase), pointer :: mgData => null() + integer(shortInt) :: nG = 0 + integer(shortInt) :: nCells = 0 + type(tallyAdmin),pointer :: tally => null() + + ! Settings + real(defReal) :: termination = ZERO + real(defReal) :: dead = ZERO + integer(shortInt) :: pop = 0 + integer(shortInt) :: inactive = 0 + integer(shortInt) :: active = 0 + logical(defBool) :: cache = .false. + real(defReal) :: rho = ZERO + logical(defBool) :: lin = .false. + character(pathLen) :: outputFile + character(nameLen) :: outputFormat + logical(defBool) :: plotResults = .false. + logical(defBool) :: printFlux = .false. + logical(defBool) :: printVolume = .false. + logical(defBool) :: printCells = .false. + type(visualiser) :: viz + + ! Results space + ! keffScore is public for integration testing + real(defReal) :: keff = ONE + real(defReal), dimension(2), public :: keffScore = ZERO + integer(longInt) :: intersectionsTotal = 0 + + ! Timer bins + integer(shortInt) :: timerMain + integer(shortInt) :: timerTransport + real (defReal) :: time_transport = ZERO + real (defReal) :: CPU_time_start + real (defReal) :: CPU_time_end + + contains + ! Superclass procedures + procedure :: init + procedure :: run + procedure :: kill + + ! Private procedures + procedure, private :: cycles + procedure, private :: printResults + procedure, private :: printSettings + + end type randomRayPhysicsPackage + +contains + + !! + !! Initialise Physics Package from dictionary + !! + !! See physicsPackage_inter for details + !! + subroutine init(self, dict, loud) + class(randomRayPhysicsPackage), intent(inout) :: self + class(dictionary), intent(inout) :: dict + logical(defBool), intent(in), optional :: loud + integer(shortInt) :: seed_temp, volP, missP + integer(longInt) :: seed + character(10) :: time + character(8) :: date + character(:),allocatable :: string + class(dictionary),pointer :: tempDict, graphDict + class(mgNeutronDatabase),pointer :: db + character(nameLen) :: geomName, graphType, nucData + class(geometry), pointer :: geom + type(outputFile) :: test_out + logical(defBool) :: set2D + character(100), parameter :: Here = 'init (randomRayPhysicsPackage_class.f90)' + + call cpu_time(self % CPU_time_start) + + if (present(loud)) then + self % loud = loud + else + self % loud = .true. + end if + + ! Load settings + call dict % get( nucData, 'XSdata') + call dict % get(self % termination, 'termination') + call dict % get(self % dead, 'dead') + call dict % get(self % pop, 'pop') + call dict % get(self % active, 'active') + call dict % get(self % inactive, 'inactive') + call dict % getOrDefault(self % keff, 'keff', ONE) + + call dict % getOrDefault(volP, 'volPolicy', 1) + call dict % getOrDefault(missP, 'missPolicy', 1) + + ! Perform distance caching? + call dict % getOrDefault(self % cache, 'cache', .false.) + + ! Stabilisation factor for negative in-group scattering + call dict % getOrDefault(self % rho, 'rho', ZERO) + + ! Use linear sources? + call dict % getOrDefault(self % lin, 'lin', .false.) + + ! Is the problem 2D? + call dict % getOrDefault(set2D, '2d', .false.) + + ! Read outputfile path + call dict % getOrDefault(self % outputFile,'outputFile','./output') + + ! Get output format and verify + ! Initialise output file before calculation (so mistake in format will be cought early) + call dict % getOrDefault(self % outputFormat, 'outputFormat', 'asciiMATLAB') + call test_out % init(self % outputFormat) + + ! Check settings + if (self % termination <= ZERO) call fatalError(Here, & + 'Ray termination distance (termination) is less than or equal to zero.') + if (self % pop < 1) call fatalError(Here, 'Must have 1 or more rays (pop).') + if (self % dead < ZERO) call fatalError(Here, 'Dead length must be positive.') + if (self % termination <= self % dead) call fatalError(Here,& + 'Ray termination length must be greater than ray dead length') + + ! Register timer + self % timerMain = registerTimer('simulationTime') + self % timerTransport = registerTimer('transportTime') + + ! Initialise RNG + if( dict % isPresent('seed')) then + call dict % get(seed_temp,'seed') + else + ! Obtain time string and hash it to obtain random seed + call date_and_time(date, time) + string = date // time + call FNV_1(string,seed_temp) + end if + seed = seed_temp + call self % rand % init(seed) + + ! Build Nuclear Data + call ndReg_init(dict % getDictPtr("nuclearData")) + + ! Build geometry + tempDict => dict % getDictPtr('geometry') + geomName = 'randomRayGeom' + call new_geometry(tempDict, geomName, silent = .not. self % loud) + self % geomIdx = gr_geomIdx(geomName) + geom => gr_geomPtr(self % geomIdx) + + ! Ensure geometry is geometryStd + select type(geom) + type is (geometryStd) + self % geom => geom + class default + call fatalError(Here,'Unrecognised geometry type') + end select + + ! Ensure that geometry graph is extended + graphDict => tempDict % getDictPtr('graph') + call graphDict % get(graphType,'type') + if (graphType /= 'extended') call fatalError(Here,& + 'Geometry graph type must be "extended" for random ray calculations.') + + ! Initialise tally Admin + if (dict % isPresent('tally')) then + tempDict => dict % getDictPtr('tally') + allocate(self % tally) + call self % tally % init(tempDict) + end if + + ! Activatee nuclear data + call ndReg_activate(P_NEUTRON_MG, nucData, self % geom % activeMats(), silent = .not. self % loud) + + ! Ensure that nuclear data is multi-group + db => ndReg_getNeutronMG() + if (.not. associated(db)) call fatalError(Here,& + 'No MG nuclear database was constructed') + + ! Ensure nuclear data is baseMgNeutronDatabase + select type(db) + type is (baseMgNeutronDatabase) + self % mgData => db + class default + call fatalError(Here,'Unrecognised MG database type') + end select + + ! Store number of energy groups for convenience + self % nG = self % mgData % nGroups() + + ! Call visualisation + if (dict % isPresent('viz')) then + if (self % loud) print *, "Initialising visualiser" + tempDict => dict % getDictPtr('viz') + call self % viz % init(geom, tempDict) + if (self % loud) print *, "Constructing visualisation" + call self % viz % makeViz() + call self % viz % kill() + endif + + ! Check for results plotting and initialise VTK + call dict % getOrDefault(self % plotResults,'plot',.false.) + if (self % plotResults) then + ! Initialise a visualiser to be used when results are available + if (self % loud) print *, "Initialising results visualiser" + tempDict => dict % getDictPtr('viz') + call self % viz % init(geom, tempDict) + if (self % loud) print *, "Constructing geometry visualisation" + call self % viz % initVTK() + end if + + ! Store number of cells in geometry for convenience + self % nCells = self % geom % numberOfCells() + + ! Initialise RR arrays and nuclear data + call self % arrays % init(self % mgData, self % geom, & + self % pop * (self % termination - self % dead), self % rho, self % lin, & + .false., self % loud, volPolicy = volP, missPolicy = missP, set2D = set2D) + + end subroutine init + + !! + !! Run calculation + !! + !! See physicsPackage_inter for details + !! + subroutine run(self) + class(randomRayPhysicsPackage), intent(inout) :: self + + if (self % loud) call self % printSettings() + call self % cycles() + call self % printResults() + + end subroutine run + + !! + !! Perform cycles of The Random Ray Method. + !! + !! Randomly places the ray starting point and direction uniformly. + !! Rays are tracked until they reach some specified termination length. + !! During tracking, fluxes are attenuated (and adjusted according to BCs), + !! scoring to fluxes and volume estimates when the ray has surpassed its + !! specified dead length. + !! + !! Inactive and active iterations occur, terminating subject either to + !! given criteria or when a fixed number of iterations has been passed. + !! + subroutine cycles(self) + class(randomRayPhysicsPackage), target, intent(inout) :: self + type(ray), save :: r + type(RNG), target, save :: pRNG + real(defReal) :: hitRate + real(defReal) :: ONE_KEFF, elapsed_T, end_T, T_toEnd, transport_T, & + N1, Nm1 + logical(defBool) :: keepRunning, isActive + integer(shortInt) :: i, itInac, itAct, it + integer(longInt), save :: ints + integer(longInt) :: intersections + class(arraysRR), pointer :: arrayPtr + type(particleDungeon) :: dummyDungeon + !$omp threadprivate(pRNG, r, ints) + + ! Reset and start timer + call timerReset(self % timerMain) + call timerStart(self % timerMain) + + arrayPtr => self % arrays + + ! Stopping criterion is on number of convergence iterations. + ! TODO: Make this on, e.g., entropy during inactive, followed by stochastic noise during active! + itInac = 0 + itAct = 0 + isActive = .false. + keepRunning = .true. + + ! Power iteration + do while( keepRunning ) + + if (isActive) then + itAct = itAct + 1 + else + itInac = itInac + 1 + end if + it = itInac + itAct + + ONE_KEFF = ONE / self % keff + call arrayPtr % updateSource(ONE_KEFF) + + ! Reset and start transport timer + call timerReset(self % timerTransport) + call timerStart(self % timerTransport) + intersections = 0 + + !$omp parallel do schedule(dynamic) reduction(+:intersections) + do i = 1, self % pop + + ! Set seed + pRNG = self % rand + call pRNG % stride(i) + r % pRNG => pRNG + + ! Set ray attributes + call initialiseRay(r, arrayPtr) + + ! Transport ray until termination criterion met + call transportSweep(r, ints, self % nG, self % cache, self % dead, & + self % termination, arrayPtr) + intersections = intersections + ints + + end do + !$omp end parallel do + + self % intersectionsTotal = self % intersectionsTotal + intersections + + call timerStop(self % timerTransport) + + ! Update RNG on master thread + call self % rand % stride(self % pop + 1) + + ! Normalise flux estimate and combines with source + call arrayPtr % normaliseFluxAndVolume(it) + + ! Calculate new k and accumulate stats + self % keff = arrayPtr % calculateKeff(self % keff) + if (isActive) then + self % keffScore(1) = self % keffScore(1) + self % keff + self % keffScore(2) = self % keffScore(2) + self % keff * self % keff + end if + + ! Accumulate flux scores and tally results + if (isActive) then + call arrayPtr % accumulateFluxScores() + if (associated(self % tally)) then + call arrayPtr % tallyResults(self % tally) + call self % tally % reportCycleEnd(dummyDungeon) + end if + end if + + ! Calculate proportion of cells that were hit + hitRate = arrayPtr % getCellHitRate(it) + call arrayPtr % wipeCellHits() + + ! Evaluate stopping criterion for active or inactive iterations + if (isActive) then + keepRunning = (itAct < self % active) + else + isActive = (itInac >= self % inactive) + end if + + ! Set previous iteration flux to scalar flux + ! and zero scalar flux + call arrayPtr % resetFluxes() + + ! Calculate times + call timerStop(self % timerMain) + elapsed_T = timerTime(self % timerMain) + transport_T = timerTime(self % timerTransport) + self % time_transport = self % time_transport + transport_T + + ! Predict time to end + end_T = real(self % active + self % inactive, defReal) * elapsed_T / it + T_toEnd = max(ZERO, end_T - elapsed_T) + + ! Display progress + if (self % loud) then + call printFishLineR(it) + print * + print *, 'Iteration: ', numToChar(it), ' of ', numToChar(self % active + self % inactive) + if(isActive) then + print *,'Active iterations' + else + print *,'Inactive iterations' + end if + print *, 'Cell hit rate: ', trim(numToChar(real(hitRate,defReal))) + print *, 'keff: ', trim(numToChar(real(self % keff,defReal))) + print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) + print *, 'End time: ', trim(secToChar(end_T)) + print *, 'Time to end: ', trim(secToChar(T_toEnd)) + print *, 'Time per integration (ns): ', & + trim(numToChar(transport_T*10**9/(self % nG * intersections))) + end if + + end do + + ! Finalise flux and keff scores + call arrayPtr % finaliseFluxScores(itAct) + if (itAct /= 1) then + Nm1 = 1.0_defReal/(itAct - 1) + else + Nm1 = 1.0_defReal + end if + N1 = 1.0_defReal/itAct + self % keffScore(1) = self % keffScore(1) * N1 + self % keffScore(2) = self % keffScore(2) * N1 + self % keffScore(2) = sqrt(Nm1*(self % keffScore(2) - & + self % keffScore(1) * self % keffScore(1))) + + end subroutine cycles + + !! + !! Output calculation results to a file + !! + !! Args: + !! None + !! + subroutine printResults(self) + class(randomRayPhysicsPackage), target, intent(inout) :: self + type(outputFile), target :: out + character(nameLen) :: name + class(visualiser), pointer :: vizPtr + + call out % init(self % outputFormat, filename = self % outputFile) + + name = 'seed' + call out % printValue(self % rand % getSeed(),name) + + name = 'pop' + call out % printValue(self % pop,name) + + name = 'Inactive_Cycles' + call out % printValue(self % inactive,name) + + name = 'Active_Cycles' + call out % printValue(self % active,name) + + call cpu_time(self % CPU_time_end) + name = 'Total_CPU_Time' + call out % printValue((self % CPU_time_end - self % CPU_time_start),name) + + name = 'Total_Transport_Time' + call out % printValue(self % time_transport,name) + + name = 'Time_Per_Integration' + call out % printValue(self % time_transport/(self % intersectionsTotal * self % nG),name) + + name = 'Clock_Time' + call out % printValue(timerTime(self % timerMain),name) + + name = 'Hit_rate' + call out % printValue(self % arrays % getAverageHitRate(),name) + + ! Print keff + name = 'keff' + call out % startBlock(name) + call out % printResult(self % keffScore(1), self % keffScore(2), name) + call out % endBlock() + + ! Print tally + if (associated(self % tally)) then + name = 'tally' + call out % startBlock(name) + call self % tally % print(out) + call out % endBlock() + end if + + ! Send all fluxes and SDs to VTK + vizPtr => self % viz + if (self % plotResults) call self % arrays % outputToVTK(vizPtr) + + end subroutine printResults + + !! + !! Print settings of the random ray calculation + !! + !! Args: + !! None + !! + subroutine printSettings(self) + class(randomRayPhysicsPackage), intent(in) :: self + + print *, repeat("<>", MAX_COL/2) + print *, "/\/\ RANDOM RAY EIGENVALUE CALCULATION /\/\" + if (self % lin) print *, "Using linear source" + print *, "Using "//numToChar(self % inactive)// " iterations for "& + //"the inactive cycles" + print *, "Using "//numToChar(self % active)// " iterations for "& + //"the active cycles" + print * + print *, "Rays per cycle: "// numToChar(self % pop) + print *, "Ray dead length: "//numToChar(self % dead) + print *, "Ray termination length: "//numToChar(self % termination) + print *, "Initial RNG Seed: "// numToChar(self % rand % getSeed()) + print * + print *, "Number of cells in the geometry: "// numToChar(self % nCells) + print *, "Number of energy groups: "// numToChar(self % nG) + if (self % cache) print *, "Accelerated with distance caching" + print *, repeat("<>", MAX_COL/2) + + end subroutine printSettings + + !! + !! Return to uninitialised state + !! + subroutine kill(self) + class(randomRayPhysicsPackage), intent(inout) :: self + + ! Clean Nuclear Data, Geometry and visualisation + call ndreg_kill() + call self % viz % kill() + + ! Clean contents + self % geom => null() + self % geomIdx = 0 + self % timerMain = 0 + self % timerTransport = 0 + self % mgData => null() + self % nG = 0 + self % nCells = 0 + self % termination = ZERO + self % dead = ZERO + self % pop = 0 + self % inactive = 0 + self % active = 0 + self % cache = .false. + self % lin = .false. + self % plotResults = .false. + self % keff = ONE + self % keffScore = ZERO + call self % arrays % kill() + call self % XSData % kill() + if (associated(self % tally)) then + call self % tally % kill() + self % tally => null() + end if + + end subroutine kill + +end module randomRayPhysicsPackage_class diff --git a/PhysicsPackages/rayVolPhysicsPackage_class.f90 b/PhysicsPackages/rayVolPhysicsPackage_class.f90 index 4a92298ec..14d2b53c0 100644 --- a/PhysicsPackages/rayVolPhysicsPackage_class.f90 +++ b/PhysicsPackages/rayVolPhysicsPackage_class.f90 @@ -126,9 +126,10 @@ module rayVolPhysicsPackage_class !! !! See physicsPackage_inter for details !! - subroutine init(self,dict) + subroutine init(self,dict,loud) class(rayVolPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict + logical(defBool), intent(in), optional :: loud integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -138,6 +139,12 @@ subroutine init(self,dict) character(nameLen) :: geomName character(100), parameter :: Here = 'init (rayVolPhysicsPackage_class.f90)' + if (present(loud)) then + self % loud = loud + else + self % loud = .true. + end if + ! Load settings call dict % get(self % mfp, 'mfp') call dict % get(self % abs_prob, 'abs_prob') @@ -198,9 +205,9 @@ end subroutine init subroutine run(self) class(rayVolPhysicsPackage), intent(inout) :: self - call self % printSettings() + if (self % loud) call self % printSettings() call self % cycles(self % rand) - call self % printResults() + if (self % loud) call self % printResults() end subroutine run @@ -295,14 +302,16 @@ subroutine cycles(self, rand) av_speed = self % totDist / cycle_T * 1.0E-3_defReal ! Display progress - call printFishLineR(gen) - print * - print *, 'Cycle: ', numToChar(gen), ' of ', numToChar(self % N_cycles) - print *, 'Pop: ', numToChar(self % pop) - print '(A, ES12.5)', ' Av. Ray speed: [m/s]: ', av_speed - print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) - print *, 'End time: ', trim(secToChar(end_T)) - print *, 'Time to end: ', trim(secToChar(T_toEnd)) + if (self % loud) then + call printFishLineR(gen) + print * + print *, 'Cycle: ', numToChar(gen), ' of ', numToChar(self % N_cycles) + print *, 'Pop: ', numToChar(self % pop) + print '(A, ES12.5)', ' Av. Ray speed: [m/s]: ', av_speed + print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) + print *, 'End time: ', trim(secToChar(end_T)) + print *, 'Time to end: ', trim(secToChar(T_toEnd)) + end if ! Process scores self % res(:, SCORE) = self % res(:, SCORE) / self % totDist diff --git a/PhysicsPackages/vizPhysicsPackage_class.f90 b/PhysicsPackages/vizPhysicsPackage_class.f90 index 13acb7d68..21ae36bca 100644 --- a/PhysicsPackages/vizPhysicsPackage_class.f90 +++ b/PhysicsPackages/vizPhysicsPackage_class.f90 @@ -57,7 +57,7 @@ module vizPhysicsPackage_class subroutine run(self) class(vizPhysicsPackage), intent(inout) :: self - print *, "Constructing visualisation" + if (self % loud) print *, "Constructing visualisation" call self % viz % makeViz() call self % viz % kill() @@ -66,14 +66,21 @@ subroutine run(self) !! !! Initialise from individual components and dictionaries !! - subroutine init(self, dict) + subroutine init(self, dict, loud) class(vizPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict + logical(defBool), intent(in), optional :: loud class(dictionary),pointer :: tempDict class(geometry), pointer :: geom character(nameLen) :: geomName character(100), parameter :: Here ='init (vizPhysicsPackage_class.f90)' + if (present(loud)) then + self % loud = loud + else + self % loud = .true. + end if + ! Register timer self % timerMain = registerTimer('transportTime') @@ -83,13 +90,13 @@ subroutine init(self, dict) ! Build geometry tempDict => dict % getDictPtr('geometry') geomName = 'visualGeom' - call new_geometry(tempDict, geomName) + call new_geometry(tempDict, geomName, .not. self % loud) self % geomIdx = gr_geomIdx(geomName) self % geom => gr_geomPtr(self % geomIdx) ! Call visualisation if (dict % isPresent('viz')) then - print *, "Initialising visualiser" + if (self % loud) print *, "Initialising visualiser" tempDict => dict % getDictPtr('viz') geom => self % geom call self % viz % init(geom, tempDict) diff --git a/RandomRayObjects/CMakeLists.txt b/RandomRayObjects/CMakeLists.txt new file mode 100644 index 000000000..5c5ced04e --- /dev/null +++ b/RandomRayObjects/CMakeLists.txt @@ -0,0 +1,8 @@ + +# Add Source Files to the global list +add_sources( ./arraysRR_class.f90 + ./rayHandling_func.f90 + ./dataRR_class.f90 + ./mathsRR_func.f90 + ./constantsRR.f90 + ) diff --git a/RandomRayObjects/arraysRR_class.f90 b/RandomRayObjects/arraysRR_class.f90 new file mode 100644 index 000000000..1cc9e4651 --- /dev/null +++ b/RandomRayObjects/arraysRR_class.f90 @@ -0,0 +1,2441 @@ +module arraysRR_class + + use numPrecision + use universalVariables + use constantsRR + use genericProcedures, only : fatalError, numToChar, rotateVector, printFishLineR + use dictionary_class, only : dictionary + use outputFile_class, only : outputFile + + ! Data + use baseMgNeutronDatabase_class, only : baseMgNeutronDatabase + use dataRR_class, only : dataRR + + ! Geometry + use coord_class, only : coordList + use geometryStd_class, only : geometryStd + + ! Visualisation + use visualiser_class, only : visualiser + + ! Tallying + use tallyMap_inter, only : tallyMap + use particle_class, only : particle, particleState + use tallyAdmin_class, only : tallyAdmin + + ! For locks + use omp_lib + + implicit none + private + + + !! + !! Object to store all arrays in random ray + !! By default, will have the current flux, previous flux, accumulated flux, + !! source arrays, and geometric arrays. + !! + !! Can be extended to having corresponding flux and source moments, as well + !! as the fixed source and additional geometric info. + !! + !! Private Members + !! nG -> Number of energy groups, kept for convenience. + !! nCells -> Number of unique cells in the geometry, kept for convenience. + !! lengthPerIt -> RR active length per iteration, kept for convenience + !! XSData -> Pointer to nuclear data, for convenience. + !! geom -> Pointer to geometry, for convenience. + !! rho -> Stabilisation factor: 0 is no stabilisation, 1 is aggressive stabilisation + !! ani -> Order of anisotropic flux moments to be stored + !! simulationType -> Identifies which simulation to perform: flat/linear, isotropic/anisotropic + !! set2D -> Stabilises LS in 2D problems if true (zeros Z moment) + !! + !! scalarFlux -> Array of scalar flux values of length [nG * nCells] + !! prevFlux -> Array of previous scalar flux values of length [nG * nCells] + !! fluxScores -> Array of scalar flux values and squared values to be reported + !! in results [nG * nCells, 2] + !! + !! source -> Array of sources [nG * nCells] + !! fixedSource -> Array of fixed sources [nG * nCells] + !! sourceIdx -> Array of material indices containing fixed sources + !! + !! volumeTracks -> Array of sum of track lengths for computing volumes [nCells] + !! volume -> Array of dimensionless cell volumes [nCells] + !! + !! cellHit -> Array of ints whether a cell was visited this iteration [nCells] + !! cellTotalHit -> Array of total number of hits for a cell over all iterations [nCells] + !! cellPos -> Array of cell positions [3 * nCells] + !! + !! scalarX -> Array of x-spatial moments of scalar flux [nG * nCells] + !! scalarY -> Array of y-spatial moments of scalar flux [nG * nCells] + !! scalarZ -> Array of z-spatial moments of scalar flux [nG * nCells] + !! prevX -> Array of previous x-spatial moments of scalar flux [nG * nCells] + !! prevY -> Array of previous y-spatial moments of scalar flux [nG * nCells] + !! prevZ -> Array of previous z-spatial moments of scalar flux [nG * nCells] + !! sourceX -> Array of source x-spatial gradients of scalar flux [nG * nCells] + !! sourceY -> Array of source y-spatial gradients of scalar flux [nG * nCells] + !! sourceZ -> Array of source z-spatial gradients of scalar flux [nG * nCells] + !! momMat -> Array of symmetric spatial moment matrices [nCells * matSize] + !! momTracks -> Array of weighted tracks used to computer spatial moment matrices [nCells * matSize] + !! centroid -> Array of cell centroid values [nCells * nDim] + !! centroidTracks -> Array of weighted tracks used to computer centroids [nCells * nDim] + !! + !! locks -> Array of OpenMP locks for each geometric cell + !! + type, public :: arraysRR + private + ! Components + class(geometryStd), pointer :: geom => null() + type(dataRR) :: XSData + integer(shortInt) :: nG = 0 + integer(shortInt) :: nCells = 0 + real(defReal) :: lengthPerIt = ZERO + real(defFlt) :: rho = 0.0_defFlt + integer(shortInt) :: ani = 0 + integer(shortInt) :: simulationType = 0 + real(defReal) :: totalVolume = ONE + integer(shortInt) :: volPolicy = hybrid !simAverage + integer(shortInt) :: missPolicy = hybrid !srcPolicy + logical(defBool) :: set2D = .false. ! Stabilises LS in 2D problems + + ! Flux arrays + real(defReal), dimension(:), allocatable :: scalarFlux + real(defReal), dimension(:), allocatable :: prevFlux + real(defReal), dimension(:,:), allocatable :: fluxScores + + ! Source arrays + real(defFlt), dimension(:), allocatable :: source + real(defFlt), dimension(:), allocatable :: fixedSource + integer(shortInt), dimension(:), allocatable :: sourceIdx + + ! Geometry arrays + real(defReal), dimension(:), allocatable :: volumeTracks + real(defReal), dimension(:), allocatable :: allVolumeTracks + real(defReal), dimension(:), allocatable :: volume + integer(shortInt), dimension(:), allocatable :: cellHit + integer(longInt), dimension(:), allocatable :: cellTotalHit + logical(defBool), dimension(:), allocatable :: cellFound + real(defReal), dimension(:,:), allocatable :: cellPos + + ! Linear source arrays + real(defReal), dimension(:), allocatable :: scalarX + real(defReal), dimension(:), allocatable :: scalarY + real(defReal), dimension(:), allocatable :: scalarZ + real(defReal), dimension(:), allocatable :: prevX + real(defReal), dimension(:), allocatable :: prevY + real(defReal), dimension(:), allocatable :: prevZ + real(defFlt), dimension(:), allocatable :: sourceX + real(defFlt), dimension(:), allocatable :: sourceY + real(defFlt), dimension(:), allocatable :: sourceZ + real(defFlt), dimension(:), allocatable :: fixedX + real(defFlt), dimension(:), allocatable :: fixedY + real(defFlt), dimension(:), allocatable :: fixedZ + real(defReal), dimension(:), allocatable :: momMat + real(defReal), dimension(:), allocatable :: momTracks + real(defReal), dimension(:), allocatable :: centroid + real(defReal), dimension(:), allocatable :: centroidTracks + + real(defReal), dimension(:,:), allocatable :: xScores + real(defReal), dimension(:,:), allocatable :: yScores + real(defReal), dimension(:,:), allocatable :: zScores + + ! OMP locks + integer(kind=omp_lock_kind), dimension(:), allocatable :: locks + + ! Other data + real(defReal) :: averageHit = ZERO + integer(shortInt) :: iterations = 0 + + contains + + ! Public procedures + procedure :: init + procedure :: initAdjoint + procedure :: kill + + ! Access procedures + procedure :: getDataPointer + procedure :: getGeomPointer + procedure :: getFluxPointer + procedure :: getSourcePointer + procedure :: getSource + procedure :: getFixedSource + procedure :: getPrevFlux + procedure :: getFluxScore + procedure :: getFluxSD + procedure :: getNG + procedure :: getVolume + procedure :: getCellPos + procedure :: wasHit + procedure :: getCellHitRate + procedure :: getSimulationType + procedure :: wasFound + procedure :: hasFixedSource + procedure :: getFluxAtAPoint + + procedure :: getFluxXYZPointers + procedure :: getSourceXYZPointers + procedure :: getCentroid + procedure :: getMomentMatrix + procedure :: getFluxMoments + procedure :: getFluxMomentSDs + + ! Change individual elements of the type + ! Predominantly for use in the transport sweep + procedure :: incrementVolume + procedure :: incrementCentroid + procedure :: incrementMoments + procedure :: hitCell + procedure :: getAverageHitRate + procedure :: wipeCellHits + procedure :: newFound + procedure :: setLock + procedure :: unsetLock + procedure :: setActiveLength + + ! Basic RR procedures + procedure :: resetFluxes + procedure :: normaliseFluxAndVolume + procedure :: updateSource + procedure :: accumulateFluxScores + procedure :: finaliseFluxScores + procedure :: calculateKeff + procedure :: zeroPrevFlux + + ! Tally results for use with MC tally machinery + procedure :: tallyResults + + ! Output procedures + procedure :: outputToVTK + procedure :: outputPointFluxes + + ! Private procedures + procedure, private :: initialiseFixedSource + + procedure, private :: resetFluxesFlatIso + procedure, private :: resetFluxesLinearIso + procedure, private :: resetFluxesLIFA + procedure, private :: resetFluxesFlatAni + + procedure, private :: normaliseFluxAndVolumeFlatIso + procedure, private :: normaliseFluxAndVolumeLinearIso + procedure, private :: normaliseFluxAndVolumeLIFA + procedure, private :: normaliseFluxAndVolumeFlatAni + + procedure, private :: sourceUpdateKernelFlatIso + procedure, private :: sourceUpdateKernelLinearIso + procedure, private :: sourceUpdateKernelLIFA + procedure, private :: sourceUpdateKernelFlatAni + + procedure, private :: accumulateFluxScoresFlat + procedure, private :: accumulateFluxScoresLinear + + procedure, private :: finaliseFluxScoresFlat + procedure, private :: finaliseFluxScoresLinear + + procedure, private :: calculateKeffKernel + procedure, private :: invertMatrix + + end type arraysRR + +contains + + !! + !! Initialise the arrays object + !! + !! The object is fed sizes and requirements by the physics package. + !! This will allocate the necessary arrays + !! + subroutine init(self, db, geom, lengthPerIt, rho, lin, doKinetics, loud, & + dictFS, volPolicy, missPolicy, set2D) + class(arraysRR), intent(inout) :: self + class(baseMgNeutronDatabase), pointer, intent(in) :: db + class(geometryStd), pointer, intent(in) :: geom + real(defReal), intent(in) :: lengthPerIt + real(defReal), intent(in) :: rho + logical(defBool), intent(in) :: lin + logical(defBool), intent(in) :: doKinetics + logical(defBool), intent(in) :: loud + class(dictionary), pointer, intent(inout), optional :: dictFS + integer(shortInt), intent(in), optional :: volPolicy, missPolicy + logical(defBool), intent(in), optional :: set2D + integer(shortInt) :: ani, i + real(defReal), dimension(6) :: bb + character(100), parameter :: Here = 'init (arraysRR_class.f90)' + + call self % XSData % init(db, doKinetics, loud) + self % nG = self % XSdata % getNG() + self % geom => geom + self % nCells = self % geom % numberOfCells() + + self % lengthPerIt = lengthPerIt + self % rho = real(rho, defFlt) + + if (present(volPolicy)) then + self % volPolicy = volPolicy + else + self % volPolicy = simAverage + end if + if (present(missPolicy)) then + self % missPolicy = missPolicy + else + self % missPolicy = srcPolicy + end if + + if (present(set2D)) then + self % set2D = set2D + else + self % set2D = .false. + end if + + ! Assume bounding box of the geometry is filled (and a box) + ! Can this be relaxed in future? + bb = self % geom % bounds() + self % totalVolume = (bb(4) - bb(1)) * (bb(5) - bb(2)) * (bb(6) - bb(3)) + + ! Set simulation type + ! TODO: read ani from nuclear data + ani = 0 + if (.not. lin .and. ani == 0) then + self % simulationType = flatIso + elseif (lin .and. ani == 0) then + self % simulationType = linearIso + elseif (.not. lin .and. ani > 0) then + self % simulationType = flatAni + else + self % simulationType = linearAni + end if + self % ani = ani + + ! Allocate and initialise arrays + allocate(self % scalarFlux(self % nG * self % nCells)) + allocate(self % prevFlux(self % nG * self % nCells)) + allocate(self % fluxScores(2, self % nG * self % nCells)) + allocate(self % source(self % nG * self % nCells)) + allocate(self % volumeTracks(self % nCells)) + allocate(self % allVolumeTracks(self % nCells)) + allocate(self % volume(self % nCells)) + allocate(self % cellHit(self % nCells)) + allocate(self % cellTotalHit(self % nCells)) + allocate(self % cellPos(nDim, self % nCells)) + + self % scalarFlux = ZERO + self % prevFlux = ONE + self % fluxScores = ZERO + self % source = 0.0_defFlt + self % volumeTracks = ZERO + self % allVolumeTracks = ZERO + self % volume = ZERO + self % cellHit = 0 + self % cellTotalHit = 0 + self % cellPos = -INFINITY + + ! Initialise the fixed source if present + if (present(dictFS)) then + allocate(self % fixedSource(self % nG * self % nCells)) + self % fixedSource = 0.0_defFlt + call self % initialiseFixedSource(dictFS) + end if + + ! Allocate linear components, if present + if (lin) then + + allocate(self % scalarX(self % nCells * self % nG)) + allocate(self % scalarY(self % nCells * self % nG)) + allocate(self % scalarZ(self % nCells * self % nG)) + allocate(self % prevX(self % nCells * self % nG)) + allocate(self % prevY(self % nCells * self % nG)) + allocate(self % prevZ(self % nCells * self % nG)) + allocate(self % sourceX(self % nCells * self % nG)) + allocate(self % sourceY(self % nCells * self % nG)) + allocate(self % sourceZ(self % nCells * self % nG)) + allocate(self % momMat(self % nCells * matSize)) + allocate(self % momTracks(self % nCells * matSize)) + allocate(self % centroid(self % nCells * nDim)) + allocate(self % centroidTracks(self % nCells * nDim)) + allocate(self % xScores(2, self % nG * self % nCells)) + allocate(self % yScores(2, self % nG * self % nCells)) + allocate(self % zScores(2, self % nG * self % nCells)) + + self % scalarX = ZERO + self % scalarY = ZERO + self % scalarZ = ZERO + self % prevX = ZERO + self % prevY = ZERO + self % prevZ = ZERO + self % sourceX = 0.0_defFlt + self % sourceY = 0.0_defFlt + self % sourceZ = 0.0_defFlt + self % momMat = ZERO + self % momTracks = ZERO + self % centroid = ZERO + self % centroidTracks = ZERO + self % xScores = ZERO + self % yScores = ZERO + self % zScores = ZERO + + end if + + ! TODO: allocate anisotropic components, if present + if (ani > 0) then + + end if + + ! Initialise OMP locks + allocate(self % locks(self % nCells)) + do i = 1, self % nCells +#ifdef _OPENMP + call OMP_init_lock(self % locks(i)) +#endif + end do + + end subroutine init + + !! + !! Overwrite the active length + !! + subroutine setActiveLength(self, lengthPerIt) + class(arraysRR), intent(inout) :: self + real(defReal), intent(in) :: lengthPerIt + + self % lengthPerIt = lengthPerIt + + end subroutine setActiveLength + + !! + !! Initialise the adjoint source and update nuclear data. + !! For now, assumes the adjoint is for global variance reduction. + !! + subroutine initAdjoint(self) + class(arraysRR), intent(inout) :: self + integer(shortInt) :: cIdx + logical(defBool) :: doLinear + integer(shortInt), save :: i, g + real(defFlt), dimension(matSize), save :: invM + real(defFlt), save :: xMom, yMom, zMom + !$omp threadprivate(i, g, invM, xMom, yMom, zMom) + + doLinear = .false. + invM = 0.0_defFlt + + call self % xsData % setAdjointXS() + + if (.not. allocated(self % fixedSource)) then + allocate(self % fixedSource(size(self % scalarFlux))) + end if + self % fixedSource = 0.0_defFlt + + if ((self % simulationType == linearIso) .or. & + (self % simulationType == linearAni)) then + doLinear = .true. + if (.not. allocated(self % fixedX)) then + allocate(self % fixedX(size(self % scalarFlux))) + allocate(self % fixedY(size(self % scalarFlux))) + allocate(self % fixedZ(size(self % scalarFlux))) + end if + self % fixedX = 0.0_defFlt + self % fixedY = 0.0_defFlt + self % fixedZ = 0.0_defFlt + end if + + ! Create fixed source from the flux scores + ! Presently assumes the response of interest is global flux + !$omp parallel do + do cIdx = 1, self % nCells + + if (.not. self % wasFound(cIdx)) cycle + if (doLinear) invM = self % invertMatrix(cIdx) + + do g = 1, self % nG + + i = (cIdx - 1) * self % nG + g + + ! Check for inordinately small flux values. + ! Note, these can have arbitrarily low magnitude. + ! Maybe should be something more robust. + if (self % fluxScores(1, i) == ZERO) cycle + self % fixedSource(i) = real(ONE / self % fluxScores(1, i), defFlt) + + ! Linear source treatment relies on performing a Taylor expansion + ! of q' = 1/phi = 1/(phi_0 + ) + ! = 1/phi_0 - 1/phi^2_0 * + if (doLinear .and. (self % fixedSource(i) > 0)) then + self % fixedX(i) = invM(xx) * xMom + invM(xy) * yMom + invM(xz) * zMom + self % fixedY(i) = invM(xy) * xMom + invM(yy) * yMom + invM(yz) * zMom + self % fixedZ(i) = invM(xz) * xMom + invM(yz) * yMom + invM(zz) * zMom + + self % fixedX(i) = -self % fixedX(i) * self % fixedSource(i) ** 2 + self % fixedY(i) = -self % fixedY(i) * self % fixedSource(i) ** 2 + self % fixedZ(i) = -self % fixedZ(i) * self % fixedSource(i) ** 2 + + end if + + end do + + end do + !$omp end parallel do + + ! Reinitialise arrays to be used during transport + self % scalarFlux = ZERO + self % prevFlux = ZERO + self % fluxScores = ZERO + self % source = 0.0_defFlt + + ! Ideally we would have a way of reusing the volume estimators + ! No compact ideas at the moment, so these will simply be reinitialised + self % volumeTracks = ZERO + self % allVolumeTracks = ZERO + self % volume = ZERO + + if (doLinear) then + self % scalarX = ZERO + self % scalarY = ZERO + self % scalarZ = ZERO + self % prevX = ZERO + self % prevY = ZERO + self % prevZ = ZERO + self % sourceX = 0.0_defFlt + self % sourceY = 0.0_defFlt + self % sourceZ = 0.0_defFlt + self % momMat = ZERO + self % momTracks = ZERO + self % centroid = ZERO + self % centroidTracks = ZERO + self % xScores = ZERO + self % yScores = ZERO + self % zScores = ZERO + end if + + end subroutine initAdjoint + + !! + !! Initialises fixed sources to be used in the simulation. + !! Takes a dictionary containing names of materials in the geometry and + !! source strengths in each energy group and places these in the appropriate + !! elements of the fixed source vector. + !! + !! Also sets source material identities for future use with uncollided calculations. + !! + subroutine initialiseFixedSource(self, dict) + class(arraysRR), intent(inout) :: self + class(dictionary), intent(inout) :: dict + character(nameLen),dimension(:), allocatable :: names + real(defReal), dimension(:), allocatable :: sourceStrength + integer(shortInt) :: i, nSource, cIdx + integer(shortInt), save :: g, matIdx, idx, id + logical(defBool) :: found + character(nameLen) :: sourceName + character(nameLen), save :: localName + character(100), parameter :: Here = 'initialiseFixedSource (arraysRR_class.f90)' + !$omp threadprivate(matIdx, localName, idx, g, id) + + call dict % keys(names) + + nSource = size(names) + + ! Use for uncollided flux sampling + allocate(self % sourceIdx(nSource)) + + ! Cycle through entries of the dictionary + do i = 1, nSource + + sourceName = names(i) + call dict % get(sourceStrength, sourceName) + + ! Ensure correct number of energy groups + if (size(sourceStrength) /= self % nG) call fatalError(Here,'Source '//sourceName//& + ' has '//numToChar(size(sourceStrength))//' groups rather than '//numToChar(self % nG)) + + ! Make sure that the source corresponds to a material present in the geometry + found = .false. + !$omp parallel do schedule(static) + do cIdx = 1, self % nCells + + id = cIdx + matIdx = self % geom % geom % graph % getMatFromUID(id) + localName = self % XSData % getName(matIdx) + + if (localName == sourceName) then + + if (.not. found) then + !$omp critical + self % sourceIdx(i) = matIdx + !$omp end critical + end if + + found = .true. + do g = 1, self % nG + idx = (cIdx - 1) * self % nG + g + self % fixedSource(idx) = real(sourceStrength(g),defFlt) + end do + + end if + + end do + !$omp end parallel do + + if (.not. found) call fatalError(Here,'The source '//trim(sourceName)//' does not correspond to '//& + 'any material found in the geometry.') + + end do + + end subroutine initialiseFixedSource + + !! + !! Return a pointer to the flux vector for a given cell + !! + subroutine getFluxPointer(self, cIdx, fluxVec) + class(arraysRR), intent(in), target :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), dimension(:), pointer, intent(out) :: fluxVec + integer(shortInt) :: baseIdx1, baseIdx2 + + baseIdx1 = self % nG * (cIdx - 1) + 1 + baseIdx2 = self % nG * cIdx + fluxVec => self % scalarFlux(baseIdx1:baseIdx2) + + end subroutine getFluxPointer + + !! + !! Return a pointer to the flux spatial moment vectors for a given cell + !! + subroutine getFluxXYZPointers(self, cIdx, xVec, yVec, zVec) + class(arraysRR), intent(in), target :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), dimension(:), pointer, intent(out) :: xVec + real(defReal), dimension(:), pointer, intent(out) :: yVec + real(defReal), dimension(:), pointer, intent(out) :: zVec + integer(shortInt) :: baseIdx1, baseIdx2 + + baseIdx1 = self % nG * (cIdx - 1) + 1 + baseIdx2 = self % nG * cIdx + xVec => self % scalarX(baseIdx1:baseIdx2) + yVec => self % scalarY(baseIdx1:baseIdx2) + zVec => self % scalarZ(baseIdx1:baseIdx2) + + end subroutine getFluxXYZPointers + + !! + !! Return a pointer to the nuclear data object + !! + function getDataPointer(self) result(dataPtr) + class(arraysRR), intent(in), target :: self + class(dataRR), pointer :: dataPtr + + dataPtr => self % XSData + + end function getDataPointer + + !! + !! Return a pointer to the geometry object + !! + function getGeomPointer(self) result(geomPtr) + class(arraysRR), intent(in), target :: self + class(geometryStd), pointer :: geomPtr + + geomPtr => self % geom + + end function getGeomPointer + + !! + !! Return a pointer to the source vector for a given cell + !! + subroutine getSourcePointer(self, cIdx, sourceVec) + class(arraysRR), intent(in), target :: self + integer(shortInt), intent(in) :: cIdx + real(defFlt), dimension(:), pointer, intent(out) :: sourceVec + integer(shortInt) :: baseIdx1, baseIdx2 + + baseIdx1 = self % nG * (cIdx - 1) + 1 + baseIdx2 = self % nG * cIdx + sourceVec => self % source(baseIdx1:baseIdx2) + + end subroutine getSourcePointer + + !! + !! Return pointers to the source gradient vectors for a given cell + !! + subroutine getSourceXYZPointers(self, cIdx, xVec, yVec, zVec) + class(arraysRR), intent(in), target :: self + integer(shortInt), intent(in) :: cIdx + real(defFlt), dimension(:), pointer, intent(out) :: xVec + real(defFlt), dimension(:), pointer, intent(out) :: yVec + real(defFlt), dimension(:), pointer, intent(out) :: zVec + integer(shortInt) :: baseIdx1, baseIdx2 + + baseIdx1 = self % nG * (cIdx - 1) + 1 + baseIdx2 = self % nG * cIdx + xVec => self % sourceX(baseIdx1:baseIdx2) + yVec => self % sourceY(baseIdx1:baseIdx2) + zVec => self % sourceZ(baseIdx1:baseIdx2) + + end subroutine getSourceXYZPointers + + !! + !! Return source value given cell and group + !! + elemental function getSource(self, cIdx, g) result(src) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + integer(shortInt), intent(in) :: g + real(defFlt) :: src + + src = self % source(self % nG * (cIdx - 1) + g) + + end function getSource + + !! + !! Return fixed source value given cell and group + !! + elemental function getFixedSource(self, cIdx, g) result(src) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + integer(shortInt), intent(in) :: g + real(defFlt) :: src + + if (allocated(self % fixedSource)) then + src = self % fixedSource(self % nG * (cIdx - 1) + g) + else + src = 0.0_defFlt + end if + + end function getFixedSource + + !! + !! Return previous flux value given cell and group + !! + elemental function getPrevFlux(self, cIdx, g) result(flux) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + integer(shortInt), intent(in) :: g + real(defReal) :: flux + + flux = self % prevFlux(self % nG * (cIdx - 1) + g) + + end function getPrevFlux + + !! + !! Return final flux value given cell and group + !! + elemental function getFluxScore(self, cIdx, g) result(flux) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + integer(shortInt), intent(in) :: g + real(defReal) :: flux + + flux = self % fluxScores(1, self % nG * (cIdx - 1) + g) + + end function getFluxScore + + !! + !! Return final flux standard deviation given cell and group + !! Will return square of flux scores if called before finaliseFluxScores + !! + elemental function getFluxSD(self, cIdx, g) result(flux) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + integer(shortInt), intent(in) :: g + real(defReal) :: flux + + flux = self % fluxScores(2, self % nG * (cIdx - 1) + g) + + end function getFluxSD + + !! + !! Return final flux moment values given cell and group + !! + pure function getFluxMoments(self, cIdx, g) result(flux) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + integer(shortInt), intent(in) :: g + real(defReal), dimension(3) :: flux + integer(shortInt) :: idx + + idx = self % nG * (cIdx - 1) + g + flux(1) = self % xScores(1, idx) + flux(2) = self % yScores(1, idx) + flux(3) = self % zScores(1, idx) + + end function getFluxMoments + + !! + !! Return final flux moment standard deviations given cell and group + !! Will return square of moment scores if called before finaliseFluxScores + !! + pure function getFluxMomentSDs(self, cIdx, g) result(fluxSD) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + integer(shortInt), intent(in) :: g + real(defReal), dimension(3) :: fluxSD + integer(shortInt) :: idx + + idx = self % nG * (cIdx - 1) + g + fluxSD(1) = self % xScores(2, idx) + fluxSD(2) = self % yScores(2, idx) + fluxSD(3) = self % zScores(2, idx) + + end function getFluxMomentSDs + + !! + !! Return volume given cell ID + !! + elemental function getVolume(self, cIdx) result(vol) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + real(defReal) :: vol + + vol = self % volume(cIdx) + + end function getVolume + + !! + !! Return cell position given cell ID + !! + pure function getCellPos(self, cIdx) result(pos) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), dimension(nDim) :: pos + + pos = self % cellPos(1:nDim, cIdx) + + end function getCellPos + + !! + !! Return cell centroid given cell ID + !! + pure function getCentroid(self, cIdx) result(cent) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), dimension(nDim) :: cent + integer(shortInt) :: idx0, idx1 + + idx0 = nDim * (cIdx - 1) + 1 + idx1 = nDim * cIdx + cent = self % centroid(idx0:idx1) + + end function getCentroid + + !! + !! Return moment matrix given cell ID + !! + pure function getMomentMatrix(self, cIdx) result(mat) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), dimension(matSize) :: mat + integer(shortInt) :: idx0, idx1 + + idx0 = matSize * (cIdx - 1) + 1 + idx1 = matSize * cIdx + mat = self % momMat(idx0:idx1) + + end function getMomentMatrix + + !! + !! Return the simulation type + !! + function getSimulationType(self) result(simType) + class(arraysRR), intent(in) :: self + integer(shortInt) :: simType + + simType = self % simulationType + + end function getSimulationType + + !! + !! Increment the local volume estimate in cell cIdx. + !! Assumes this is being called inside a lock for thread privacy. + !! + subroutine incrementVolume(self, cIdx, length) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), intent(in) :: length + + self % volumeTracks(cIdx) = self % volumeTracks(cIdx) + length + + end subroutine incrementVolume + + !! + !! Increment the local centroid estimate in cell cIdx. + !! rL is the tracklength-weighted centroid + !! Assumes this is being called inside a lock for thread privacy. + !! + subroutine incrementCentroid(self, cIdx, rL) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), dimension(nDim), intent(in) :: rL + integer(shortInt) :: idx0, idx1 + + idx0 = nDim * (cIdx - 1) + 1 + idx1 = nDim * cIdx + self % centroidTracks(idx0:idx1) = self % centroidTracks(idx0:idx1) + rL + + end subroutine incrementCentroid + + !! + !! Increment the local moment matrix estimate in cell cIdx. + !! mat is the tracklength-weighted matrix + !! Assumes this is being called inside a lock for thread privacy. + !! + subroutine incrementMoments(self, cIdx, mat) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), dimension(matSize), intent(in) :: mat + integer(shortInt) :: idx0, idx1 + + idx0 = matSize * (cIdx - 1) + 1 + idx1 = matSize * cIdx + self % momTracks(idx0:idx1) = self % momTracks(idx0:idx1) + mat + + end subroutine incrementMoments + + !! + !! Check if a cell has been hit + !! + elemental function wasHit(self, cIdx) result (hit) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + logical(defBool) :: hit + + hit = (self % cellHit(cIdx) == 1) + + end function wasHit + + !! + !! Hit a cell. + !! Should only be called in a lock. + !! + subroutine hitCell(self, cIdx) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + + self % cellHit(cIdx) = 1 + self % cellTotalHit(cIdx) = self % cellTotalHit(cIdx) + 1 + + end subroutine hitCell + + !! + !! Return the cell hit rate for the given iteration + !! Also accumulate to average hit rate. + !! + !! Only averages after 20 iterations to account for + !! requiring several iterations to determine which cells + !! are present in the geometry. + !! + function getCellHitRate(self, it) result(hitRate) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + integer(shortInt) :: totalHit, realCells + real(defReal) :: hitRate + + ! Reset averages after iteration 20 + if (it == 21) then + self % averageHit = ZERO + self % iterations = 0 + end if + + totalHit = sum(self % cellHit) + if (it > 20) then + realCells = count(self % cellTotalHit > 0) + else + realCells = self % nCells + end if + hitRate = real(totalHit,defReal) / realCells + + self % averageHit = self % averageHit + hitRate + self % iterations = self % iterations + 1 + + end function getCellHitRate + + !! + !! Return the simulation average cell hit rate + !! + function getAverageHitRate(self) result(hitRate) + class(arraysRR), intent(in) :: self + real(defReal) :: hitRate + + hitRate = self % averageHit / self % iterations + + end function getAverageHitRate + + !! + !! Wipe cell hits + !! + subroutine wipeCellHits(self) + class(arraysRR), intent(inout) :: self + + self % cellHit = 0 + + end subroutine wipeCellHits + + !! + !! Has a cell ever been found? + !! + elemental function wasFound(self, cIdx) result(found) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + logical(defBool) :: found + + found = (self % cellTotalHit(cIdx) > 0) + + end function wasFound + + !! + !! Note that a new cell has been found + !! + subroutine newFound(self, cIdx, r) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + real(defReal), dimension(3), intent(in) :: r + + ! Remove critical if this is to go in the lock + !$omp critical + self % cellPos(:,cIdx) = r + !$omp end critical + + end subroutine newFound + + !! + !! Return number of energy groups used + !! + elemental function getNG(self) result(nG) + class(arraysRR), intent(in) :: self + integer(shortInt) :: nG + + nG = self % nG + + end function getNG + + !! + !! Check if a cell has an inhomogeneous source + !! + elemental function hasFixedSource(self, cIdx) result (hasSrc) + class(arraysRR), intent(in) :: self + integer(shortInt), intent(in) :: cIdx + logical(defBool) :: hasSrc + integer(shortInt) :: idx1, idx2 + + if (allocated(self % fixedSource)) then + idx1 = self % nG * (cIdx - 1) + 1 + idx2 = self % nG * cIdx + ! Take an absolute value in case of (possibly desirable?) negative sources + hasSrc = any(abs(self % fixedSource(idx1:idx2)) > 0.0_defFlt) + else + hasSrc = .false. + end if + + end function hasFixedSource + + !! + !! Set the OMP lock in a given cell + !! + subroutine setLock(self, cIdx) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + +#ifdef _OPENMP + call OMP_set_lock(self % locks(cIdx)) +#endif + + end subroutine setLock + + !! + !! Unset the OMP lock in a given cell + !! + subroutine unsetLock(self, cIdx) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + +#ifdef _OPENMP + call OMP_unset_lock(self % locks(cIdx)) +#endif + + end subroutine unsetLock + + !! + !! Calls appropriate normalise flux and volume subroutines + !! + subroutine normaliseFluxAndVolume(self, it) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + character(100), parameter :: Here = 'normaliseFluxAndVolume (arraysRR_class.f90)' + + select case(self % simulationType) + case(flatIso) + call self % normaliseFluxAndVolumeFlatIso(it) + case(linearIso) + call self % normaliseFluxAndVolumeLinearIso(it) + case default + call fatalError(Here,'Unsupported simulation type requested') + end select + + end subroutine normaliseFluxAndVolume + + !! + !! Normalise flux and volume by total track length and increments + !! the flux by the neutron source + !! + subroutine normaliseFluxAndVolumeFlatIso(self, it) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + real(defReal) :: norm, normIt + real(defReal), save :: vol, volAve, volNaive, D + real(defFlt), save :: sigGG, tot + real(defFlt), dimension(:), pointer, save :: total + integer(shortInt), save :: g, matIdx, idx + integer(shortInt) :: cIdx + logical(defBool), save :: hit, isSrc, smallCell + character(100), parameter :: Here = 'normaliseFluxAndVolumeFlatIso (arraysRR_class.f90)' + !$omp threadprivate(total, vol, idx, g, matIdx, sigGG, D, hit, isSrc, volAve, volNaive, tot, smallCell) + + norm = ONE / self % lengthPerIt + normIt = ONE / (self % lengthPerIt * it) + + !$omp parallel do + cellLoop: do cIdx = 1, self % nCells + matIdx = self % geom % geom % graph % getMatFromUID(cIdx) + + hit = self % wasHit(cIdx) + isSrc = self % hasFixedSource(cIdx) + + ! Is the cell hit frequently? + smallCell = (real(self % cellTotalHit(cIdx) / it, defReal) < 1.5) + + !! Compute various volume types + ! Actual integral volume + self % allVolumeTracks(cIdx) = self % allVolumeTracks(cIdx) + & + self % volumeTracks(cIdx) + self % volume(cIdx) = self % allVolumeTracks(cIdx) * normIt + volAve = self % volume(cIdx) + ! Cycle-wise volume + volNaive = self % volumeTracks(cIdx) * norm + + ! Decide volume to use + select case(self % volPolicy) + case(simAverage) + vol = volAve + case(naive) + vol = volNaive + case(hybrid) + if (isSrc) then + vol = volNaive + else + vol = volAve + end if + case default + call fatalError(Here,'Unsupported volume handling requested') + end select + + if (smallCell) vol = volNaive + + ! Reset cycle-wise estimator + self % volumeTracks(cIdx) = ZERO + + call self % XSData % getTotalPointer(matIdx, total) + + groupLoop: do g = 1, self % nG + + idx = self % nG * (cIdx - 1) + g + tot = total(g) + + ! Route for non-void materials + if (matIdx <= self % XSData % getNMat() .and. tot > 0) then + if (hit) then + + ! Can hit a cell but with a tiny volume, such that + ! things break a bit - would rather remove this arbitrary + ! check in future + if (vol < volume_tolerance) then + self % scalarFlux(idx) = ZERO + cycle groupLoop + end if + + self % scalarFlux(idx) = self % scalarFlux(idx) * norm + self % scalarFlux(idx) = self % scalarFlux(idx) / (vol * tot) + + ! Presumes non-zero total XS + sigGG = self % XSData % getScatterXS(matIdx, g, g) + if ((sigGG < 0) .and. (total(g) > 0)) then + D = -real(self % rho * sigGG / tot, defReal) + else + D = ZERO + end if + + self % scalarFlux(idx) = (self % scalarFlux(idx) + self % source(idx) / tot & + + D * self % prevFlux(idx) ) / (1 + D) + + else + + ! Decide flux treatment to use on missing a cell + select case(self % missPolicy) + case(srcPolicy) + self % scalarFlux(idx) = self % source(idx) / tot + case(prevPolicy) + self % scalarFlux(idx) = self % prevFlux(idx) + case(hybrid) + if (isSrc) then + self % scalarFlux(idx) = self % prevFlux(idx) + else + self % scalarFlux(idx) = self % source(idx) / tot + end if + case default + call fatalError(Here,'Unsupported miss handling requested') + end select + + end if + + ! Alternatively, handle unidentified/void regions + else + + if (vol < volume_tolerance) then + self % scalarFlux(idx) = ZERO + cycle groupLoop + end if + + if (hit) then + self % scalarFlux(idx) = self % scalarFlux(idx) * norm / vol + else + self % scalarFlux(idx) = self % prevFlux(idx) + end if + end if + + end do groupLoop + + end do cellLoop + !$omp end parallel do + + end subroutine normaliseFluxAndVolumeFlatIso + + !! + !! Normalise flux and volume by total track length and increments + !! the flux by the neutron source for linear isotropic sources + !! + subroutine normaliseFluxAndVolumeLinearIso(self, it) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + real(defReal) :: norm, normVol + real(defReal), save :: vol, invVol, volNaive, volAve, norm_V + real(defFlt), save :: D, sigGG + real(defFlt), dimension(:), pointer, save :: total + integer(shortInt) :: cIdx + integer(shortInt), save :: g, matIdx, idx, dIdx, mIdx + logical(defBool), save :: hit, isSrc, smallCell + character(100), parameter :: Here = 'normaliseFluxAndVolumeLinearIso (arraysRR_class.f90)' + !$omp threadprivate(total, vol, idx, mIdx, dIdx, g, matIdx, invVol, norm_V, D, sigGG, hit, isSrc, volNaive, volAve, smallCell) + + norm = ONE / self % lengthPerIt + normVol = ONE / (self % lengthPerIt * it) + + + !$omp parallel do schedule(static) + do cIdx = 1, self % nCells + matIdx = self % geom % geom % graph % getMatFromUID(cIdx) + dIdx = (cIdx - 1) * nDim + mIdx = (cIdx - 1) * matSize + + hit = self % wasHit(cIdx) + isSrc = self % hasFixedSource(cIdx) + ! Is the cell hit frequently? + smallCell = (real(self % cellTotalHit(cIdx) / it, defReal) < 1.5) + + ! Compute various volume types + ! Actual integral volume + self % allVolumeTracks(cIdx) = self % allVolumeTracks(cIdx) + & + self % volumeTracks(cIdx) + self % volume(cIdx) = self % allVolumeTracks(cIdx) * normVol + volAve = self % volume(cIdx) + ! Iteration-wise volume + volNaive = self % volumeTracks(cIdx) * norm + + ! Decide volume to use + select case(self % volPolicy) + case(naive) + vol = volNaive + norm_V = ONE / self % volumeTracks(cIdx) + case(simAverage) + vol = volAve + norm_V = it / self % allVolumeTracks(cIdx) + case(hybrid) + if (isSrc) then + vol = volNaive + norm_V = ONE / self % volumeTracks(cIdx) + else + vol = volAve + norm_V = it / self % allVolumeTracks(cIdx) + end if + case default + call fatalError(Here,'Unsupported volume handling requested') + end select + + if (smallCell) then + vol = volNaive + norm_V = ONE / self % volumeTracks(cIdx) + end if + + ! Reset cycle-wise estimator + self % volumeTracks(cIdx) = ZERO + + ! Update geometric information provided volume has been visited + if (self % allVolumeTracks(cIdx) > ZERO) then + + invVol = ONE / self % allVolumeTracks(cIdx) + + ! Update centroids + self % centroid(dIdx + x) = self % centroidTracks(dIdx + x) * invVol + self % centroid(dIdx + y) = self % centroidTracks(dIdx + y) * invVol + self % centroid(dIdx + z) = self % centroidTracks(dIdx + z) * invVol + + ! Update spatial moments + self % momMat(mIdx + xx) = self % momTracks(mIdx + xx) * invVol + self % momMat(mIdx + xy) = self % momTracks(mIdx + xy) * invVol + self % momMat(mIdx + xz) = self % momTracks(mIdx + xz) * invVol + self % momMat(mIdx + yy) = self % momTracks(mIdx + yy) * invVol + self % momMat(mIdx + yz) = self % momTracks(mIdx + yz) * invVol + self % momMat(mIdx + zz) = self % momTracks(mIdx + zz) * invVol + + end if + + call self % XSData % getTotalPointer(matIdx, total) + + groupLoop: do g = 1, self % nG + + idx = self % nG * (cIdx - 1) + g + + + if (matIdx <= self % XSData % getNMat() .and. total(g) > 0) then + if (hit) then + + ! Can hit a cell but with a tiny volume, such that + ! things break a bit - would rather remove this arbitrary + ! check in future + if (vol < volume_tolerance) then + self % scalarFlux(idx) = ZERO + self % scalarX(idx) = ZERO + self % scalarY(idx) = ZERO + self % scalarZ(idx) = ZERO + cycle groupLoop + end if + + self % scalarFlux(idx) = self % scalarFlux(idx) * norm_V / total(g) + self % scalarX(idx) = self % scalarX(idx) * norm_V / total(g) + self % scalarY(idx) = self % scalarY(idx) * norm_V / total(g) + self % scalarZ(idx) = self % scalarZ(idx) * norm_V / total(g) + + ! Apply the standard MoC post-sweep treatment and + ! stabilisation for negative XSs + ! Presumes non-zero total XS + sigGG = self % XSData % getScatterXS(matIdx, g, g) + if (sigGG < 0) then + D = -self % rho * sigGG / total(g) + else + D = 0.0_defFlt + end if + + self % scalarFlux(idx) = (self % scalarFlux(idx) + self % source(idx)/total(g) & + + D * self % prevFlux(idx) ) / (1 + D) + + else + ! Decide flux treatment to use + associate(mat => self % momMat((mIdx + 1):(mIdx + matSize))) + select case(self % missPolicy) + ! Note: this is policy to use the source, not policy for hitting a fixed source + case(srcPolicy) + self % scalarFlux(idx) = self % source(idx) / total(g) + ! OPENMC SETS MOMENTS TO ZERO + !self % scalarX(idx) = 0.0_defFlt + !self % scalarY(idx) = 0.0_defFlt + !self % scalarZ(idx) = 0.0_defFlt + ! Need to multiply source gradients by moment matrix + self % scalarX(idx) = real(mat(xx) *self % sourceX(idx) + & + mat(xy) * self % sourceY(idx) + mat(xz) * self % sourceZ(idx),defFlt)/ total(g) + self % scalarY(idx) = real(mat(xy) *self % sourceX(idx) + & + mat(yy) * self % sourceY(idx) + mat(yz) * self % sourceZ(idx),defFlt)/ total(g) + self % scalarZ(idx) = real(mat(xz) *self % sourceX(idx) + & + mat(yz) * self % sourceY(idx) + mat(zz) * self % sourceZ(idx),defFlt)/ total(g) + case(prevPolicy) + self % scalarFlux(idx) = self % prevFlux(idx) + self % scalarX(idx) = self % prevX(idx) + self % scalarY(idx) = self % prevY(idx) + self % scalarZ(idx) = self % prevZ(idx) + case(hybrid) + if (isSrc) then + self % scalarFlux(idx) = self % prevFlux(idx) + self % scalarX(idx) = self % prevX(idx) + self % scalarY(idx) = self % prevY(idx) + self % scalarZ(idx) = self % prevZ(idx) + else + self % scalarFlux(idx) = self % source(idx) / total(g) + ! OPENMC SETS MOMENTS TO ZERO + !self % scalarX(idx) = 0.0_defFlt + !self % scalarY(idx) = 0.0_defFlt + !self % scalarZ(idx) = 0.0_defFlt + ! Need to multiply source gradients by moment matrix + self % scalarX(idx) = real(mat(xx) *self % sourceX(idx) + & + mat(xy) * self % sourceY(idx) + mat(xz) * self % sourceZ(idx),defFlt)/ total(g) + self % scalarY(idx) = real(mat(xy) *self % sourceX(idx) + & + mat(yy) * self % sourceY(idx) + mat(yz) * self % sourceZ(idx),defFlt)/ total(g) + self % scalarZ(idx) = real(mat(xz) *self % sourceX(idx) + & + mat(yz) * self % sourceY(idx) + mat(zz) * self % sourceZ(idx),defFlt)/ total(g) + end if + case default + call fatalError(Here,'Unsupported miss handling requested') + end select + end associate + end if + + else + + ! Apply void treatment + if (vol < volume_tolerance) then + self % scalarFlux(idx) = ZERO + self % scalarX(idx) = ZERO + self % scalarY(idx) = ZERO + self % scalarZ(idx) = ZERO + cycle groupLoop + end if + + if (hit) then + self % scalarFlux(idx) = self % scalarFlux(idx) * norm / vol + self % scalarX(idx) = ZERO + self % scalarY(idx) = ZERO + self % scalarZ(idx) = ZERO + else + self % scalarFlux(idx) = self % prevFlux(idx) + self % scalarX(idx) = ZERO + self % scalarY(idx) = ZERO + self % scalarZ(idx) = ZERO + end if + + end if + + ! For stability while still accumulating geometric info + if (it < 10) then + self % scalarX(idx) = ZERO + self % scalarY(idx) = ZERO + self % scalarZ(idx) = ZERO + end if + + end do groupLoop + + end do + !$omp end parallel do + + end subroutine normaliseFluxAndVolumeLinearIso + + !! + !! Normalise flux and volume by total track length and increments + !! the flux by the neutron source for flat anisotropic sources + !! + subroutine normaliseFluxAndVolumeFlatAni(self, it) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + + end subroutine normaliseFluxAndVolumeFlatAni + + !! + !! Normalise flux and volume by total track length and increments + !! the flux by the neutron source for Linear sources with flat + !! anisotropic sources + !! + subroutine normaliseFluxAndVolumeLIFA(self, it) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + + end subroutine normaliseFluxAndVolumeLIFA + + !! + !! Update all sources given a prevFlux + !! This nesting allows using combined OMP + SIMD + !! + subroutine updateSource(self, ONE_KEFF) + class(arraysRR), intent(inout) :: self + real(defReal), intent(in) :: ONE_KEFF + real(defFlt) :: ONE_K + integer(shortInt) :: cIdx + character(100), parameter :: Here = 'updateSource (arraysRR_class.f90)' + + ONE_K = real(ONE_KEFF, defFlt) + + select case(self % simulationType) + case(flatIso) + !$omp parallel do + do cIdx = 1, self % nCells + call self % sourceUpdateKernelFlatIso(cIdx, ONE_K) + end do + !$omp end parallel do + case(linearIso) + !$omp parallel do + do cIdx = 1, self % nCells + call self % sourceUpdateKernelLinearIso(cIdx, ONE_K) + end do + !$omp end parallel do + case default + call fatalError(Here,'Unsupported simulation type requested') + end select + + end subroutine updateSource + + !! + !! Kernel to update sources given a cell index + !! + subroutine sourceUpdateKernelFlatIso(self, cIdx, ONE_KEFF) + class(arraysRR), target, intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + real(defFlt), intent(in) :: ONE_KEFF + real(defFlt) :: scatter, fission + real(defFlt), dimension(self % nG) :: fluxFlt + real(defFlt), dimension(:), pointer :: nuFission, chi, scatterXS, scatterVec + integer(shortInt) :: matIdx, g, gIn, baseIdx, idx, sIdx1, sIdx2 + + ! Identify material + matIdx = self % geom % geom % graph % getMatFromUID(cIdx) + + ! Guard against void cells + if (matIdx > self % XSData % getNMat()) then + baseIdx = self % nG * (cIdx - 1) + do g = 1, self % nG + idx = baseIdx + g + self % source(idx) = 0.0_defFlt + if (allocated(self % fixedSource)) then + self % source(idx) = self % source(idx) + self % fixedSource(idx) + end if + end do + return + end if + + ! Obtain XSs + call self % XSData % getProdPointers(matIdx, nuFission, scatterXS, chi) + + baseIdx = self % nG * (cIdx - 1) + fluxFlt = real(self % prevFlux((baseIdx + 1):(baseIdx + self % nG)), defFlt) + + ! Calculate fission source + fission = 0.0_defFlt + !$omp simd reduction(+:fission) + do gIn = 1, self % nG + fission = fission + fluxFlt(gIn) * nuFission(gIn) + end do + fission = fission * ONE_KEFF + + do g = 1, self % nG + + sIdx1 = self % nG * (g - 1) + 1 + sIdx2 = self % nG * g + scatterVec => scatterXS(sIdx1:sIdx2) + + ! Calculate scattering source + scatter = 0.0_defFlt + !$omp simd reduction(+:scatter) + do gIn = 1, self % nG + scatter = scatter + fluxFlt(gIn) * scatterVec(gIn) + end do + + ! Output index + idx = baseIdx + g + + self % source(idx) = chi(g) * fission + scatter + if (allocated(self % fixedSource)) then + self % source(idx) = self % source(idx) + self % fixedSource(idx) + end if + + end do + + end subroutine sourceUpdateKernelFlatIso + + !! + !! Kernel to update sources given a cell index for linear sources + !! with isotropic scattering + !! + subroutine sourceUpdateKernelLinearIso(self, cIdx, ONE_KEFF) + class(arraysRR), target, intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + real(defFlt), intent(in) :: ONE_KEFF + real(defFlt) :: scatter, xScatter, yScatter, zScatter, & + fission, xFission, yFission, zFission, & + xSource, ySource, zSource + real(defFlt), dimension(matSize) :: invM + real(defFlt), dimension(self % nG) :: fluxFlt, xFlt, yFlt, zFlt + real(defFlt), dimension(:), pointer :: nuFission, chi, scatterXS, scatterVec + integer(shortInt) :: matIdx, g, gIn, baseIdx, idx, sIdx1, sIdx2 + + ! Invert moment matrix + invM = self % invertMatrix(cIdx) + + ! Identify material + matIdx = self % geom % geom % graph % getMatFromUID(cIdx) + + ! Guard against void cells + if (matIdx > self % XSData % getNMat()) then + baseIdx = self % nG * (cIdx - 1) + do g = 1, self % nG + idx = baseIdx + g + self % source(idx) = 0.0_defFlt + if (allocated(self % fixedSource)) then + self % source(idx) = self % source(idx) + self % fixedSource(idx) + end if + self % sourceX(idx) = 0.0_defFlt + self % sourceY(idx) = 0.0_defFlt + self % sourceZ(idx) = 0.0_defFlt + end do + return + end if + + ! Obtain XSs + call self % XSData % getProdPointers(matIdx, nuFission, scatterXS, chi) + + baseIdx = self % nG * (cIdx - 1) + fluxFlt = real(self % prevFlux((baseIdx + 1):(baseIdx + self % nG)), defFlt) + xFlt = real(self % prevX((baseIdx + 1):(baseIdx + self % nG)), defFlt) + yFlt = real(self % prevY((baseIdx + 1):(baseIdx + self % nG)), defFlt) + zFlt = real(self % prevZ((baseIdx + 1):(baseIdx + self % nG)), defFlt) + + ! Calculate fission source + fission = 0.0_defFlt + xFission = 0.0_defFlt + yFission = 0.0_defFlt + zFission = 0.0_defFlt + + !$omp simd reduction(+:fission, xFission, yFission, zFission) + do gIn = 1, self % nG + fission = fission + fluxFlt(gIn) * nuFission(gIn) + xFission = xFission + xFlt(gIn) * nuFission(gIn) + yFission = yFission + yFlt(gIn) * nuFission(gIn) + zFission = zFission + zFlt(gIn) * nuFission(gIn) + end do + fission = fission * ONE_KEFF + xFission = xFission * ONE_KEFF + yFission = yFission * ONE_KEFF + zFission = zFission * ONE_KEFF + + !call self % XSData % getTotalPointer(matIdx, total) + do g = 1, self % nG + + sIdx1 = self % nG * (g - 1) + 1 + sIdx2 = self % nG * g + scatterVec => scatterXS(sIdx1:sIdx2) + + ! Calculate scattering source + scatter = 0.0_defFlt + xScatter = 0.0_defFlt + yScatter = 0.0_defFlt + zScatter = 0.0_defFlt + !$omp simd reduction(+:scatter, xScatter, yScatter, zScatter) + do gIn = 1, self % nG + scatter = scatter + fluxFlt(gIn) * scatterVec(gIn) + xScatter = xScatter + xFlt(gIn) * scatterVec(gIn) + yScatter = yScatter + yFlt(gIn) * scatterVec(gIn) + zScatter = zScatter + zFlt(gIn) * scatterVec(gIn) + end do + + ! Output index + idx = baseIdx + g + + self % source(idx) = chi(g) * fission + scatter + if (allocated(self % fixedSource)) then + self % source(idx) = self % source(idx) + self % fixedSource(idx) + end if + + xSource = chi(g) * xFission + xScatter + ySource = chi(g) * yFission + yScatter + zSource = chi(g) * zFission + zScatter + + if (allocated(self % fixedX)) then + xSource = xSource + self % fixedX(idx) + ySource = ySource + self % fixedY(idx) + zSource = zSource + self % fixedZ(idx) + end if + + ! Calculate source gradients by inverting the moment matrix + self % sourceX(idx) = invM(xx) * xSource + & + invM(xy) * ySource + invM(xz) * zSource + self % sourceY(idx) = invM(xy) * xSource + & + invM(yy) * ySource + invM(yz) * zSource + self % sourceZ(idx) = invM(xz) * xSource + & + invM(yz) * ySource + invM(zz) * zSource + + end do + + end subroutine sourceUpdateKernelLinearIso + + !! + !! Kernel to update sources given a cell index for flat sources + !! with anisotropic scattering + !! + subroutine sourceUpdateKernelFlatAni(self, cIdx, ONE_KEFF) + class(arraysRR), target, intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + real(defFlt), intent(in) :: ONE_KEFF + + end subroutine sourceUpdateKernelFlatAni + + !! + !! Kernel to update sources given a cell index for linear sources + !! with flat anisotropic scattering + !! + subroutine sourceUpdateKernelLIFA(self, cIdx, ONE_KEFF) + class(arraysRR), target, intent(inout) :: self + integer(shortInt), intent(in) :: cIdx + real(defFlt), intent(in) :: ONE_KEFF + + end subroutine sourceUpdateKernelLIFA + + !! + !! Inverts the spatial moment matrix for use in linear source calculations. + !! + function invertMatrix(self, cIdx) result(invM) + class(arraysRR), target, intent(in) :: self + integer(shortInt), intent(in) :: cIdx + real(defFlt), dimension(matSize) :: invM + integer(shortInt) :: condX, condY, condZ, inversionTest + real(defReal) :: det + real(defFlt) :: one_det + + associate(momVec => self % momMat(((cIdx - 1) * matSize + 1):(cIdx * matSize))) + + ! Pre-invert the moment matrix + ! Need to check for poor conditioning by evaluating the + ! diagonal elements of the matrix + condX = 0 + condY = 0 + condZ = 0 + + ! Trying out simpler matrix test + if (momVec(xx) > condition_tolerance) condX = 1 + if (momVec(yy) > condition_tolerance) condY = 1 + if (momVec(zz) > condition_tolerance) condZ = 1 + ! Significantly stabilises 2D linear source problems. Z moments can vary wildly. + if (self % set2D) condZ = 0 + + ! Map conditions to test variable + inversionTest = condX * 4 + condY * 2 + condZ + invM = 0.0_defFlt + + select case(inversionTest) + case(invertXYZ) + det = momVec(xx) * (momVec(yy) * momVec(zz) - momVec(yz) * momVec(yz)) & + - momVec(yy) * momVec(xz) * momVec(xz) & + - momVec(zz) * momVec(xy) * momVec(xy) & + + 2 * momVec(xy) * momVec(xz) * momVec(yz) + invM(xx) = real(momVec(yy) * momVec(zz) - momVec(yz) * momVec(yz),defFlt) + invM(xy) = real(momVec(xz) * momVec(yz) - momVec(xy) * momVec(zz),defFlt) + invM(xz) = real(momVec(xy) * momVec(yz) - momVec(yy) * momVec(xz),defFlt) + invM(yy) = real(momVec(xx) * momVec(zz) - momVec(xz) * momVec(xz),defFlt) + invM(yz) = real(momVec(xy) * momVec(xz) - momVec(xx) * momVec(yz),defFlt) + invM(zz) = real(momVec(xx) * momVec(yy) - momVec(xy) * momVec(xy),defFlt) + + case(invertYZ) + det = momVec(yy) * momVec(zz) - momVec(yz) * momVec(yz) + invM(yy) = real(momVec(zz),defFlt) + invM(yz) = real(-momVec(yz),defFlt) + invM(zz) = real(momVec(yy),defFlt) + + case(invertXY) + det = momVec(xx) * momVec(yy) - momVec(xy) * momVec(xy) + invM(xx) = real(momVec(yy),defFlt) + invM(xy) = real(-momVec(xy),defFlt) + invM(yy) = real(momVec(xx),defFlt) + + case(invertXZ) + det = momVec(xx) * momVec(zz) - momVec(xz) * momVec(xz) + invM(xx) = real(momVec(zz),defFlt) + invM(xz) = real(-momVec(xz),defFlt) + invM(zz) = real(momVec(xx),defFlt) + + case(invertX) + det = momVec(xx) + invM(xx) = 1.0_defFlt + + case(invertY) + det = momVec(yy) + invM(yy) = 1.0_defFlt + + case(invertZ) + det = momVec(zz) + invM(zz) = 1.0_defFlt + + case default + det = ONE + end select + + one_det = real(ONE/det, defFlt) + invM = invM * one_det + + ! Check for zero determinant + if (abs(det) < det_tolerance) invM = 0.0_defFlt + + end associate + + end function invertMatrix + + !! + !! Calculate keff + !! Wraps the main kernel call to allow for OMP + SIMD (thanks Fortran) + !! + function calculateKeff(self, k0) result(k1) + class(arraysRR), intent(in) :: self + real(defReal), intent(in) :: k0 + real(defReal) :: k1 + integer(shortInt) :: cIdx + real(defReal) :: fissTotal, prevFissTotal + real(defReal), save :: fissLocal, prevFissLocal + character(100), parameter :: Here = 'calculateKeff (arraysRR_class.f90)' + !$omp threadprivate (fissLocal, prevFissLocal) + + fissTotal = ZERO + prevFissTotal = ZERO + !$omp parallel do reduction(+:fissTotal, prevFissTotal) + do cIdx = 1, self % nCells + call self % calculateKeffKernel(cIdx, fissLocal, prevFissLocal) + fissTotal = fissTotal + fissLocal + prevFissTotal = prevFissTotal + prevFissLocal + end do + !$omp end parallel do + + k1 = k0 * fissTotal / prevFissTotal + if ((k1 <= 0) .or. (k1 > 5)) call fatalError(Here, 'Unphysical keff: '//numToChar(k1)) + if (k1 /= k1) call fatalError(Here, 'NaN keff') + + end function calculateKeff + + !! + !! Calculate keff for a single cell + !! + subroutine calculateKeffKernel(self, cIdx, fissionRate, prevFissionRate) + class(arraysRR), target, intent(in) :: self + integer(shortInt), intent (in) :: cIdx + real(defReal), intent(out) :: fissionRate, prevFissionRate + real(defReal) :: vol + integer(shortInt) :: g, matIdx + real(defFlt), dimension(:), pointer :: nuSigmaF + real(defReal), dimension(:), pointer :: flux, prevFlux + + fissionRate = ZERO + prevFissionRate = ZERO + + ! Identify material + matIdx = self % geom % geom % graph % getMatFromUID(cIdx) + + ! Check whether to continue in this cell + if (matIdx > self % XSData % getNMat()) return + if (.not. self % XSData % isFissile(matIdx)) return + if (.not. self % wasFound(cIdx)) return + vol = self % volume(cIdx) + if (vol < volume_tolerance) return + + call self % XSData % getNuFissPointer(matIdx, nuSigmaF) + flux => self % scalarFlux((self % nG * (cIdx - 1) + 1):(self % nG * cIdx)) + prevFlux => self % prevFlux((self % nG * (cIdx - 1) + 1):(self % nG * cIdx)) + + !$omp simd reduction(+: fissionRate, prevFissionRate) + do g = 1, self % nG + fissionRate = fissionRate + real(flux(g) * nuSigmaF(g), defReal) + prevFissionRate = prevFissionRate + real(prevFlux(g) * nuSigmaF(g), defReal) + end do + + fissionRate = fissionRate * vol + prevFissionRate = prevFissionRate * vol + + end subroutine calculateKeffKernel + + !! + !! Zero the previous-step flux + !! + subroutine zeroPrevFlux(self) + class(arraysRR), intent(inout) :: self + character(100), parameter :: Here = 'zeroPrevFlux (arraysRR_class.f90)' + + if (allocated(self % prevFlux)) then + self % prevFlux = ZERO + else + call fatalError(Here,'prevFlux has not been initialised') + end if + + end subroutine zeroPrevFlux + + !! + !! Reset fluxes + !! + subroutine resetFluxes(self) + class(arraysRR), intent(inout) :: self + character(100), parameter :: Here = 'resetFluxes (arraysRR_class.f90)' + + select case(self % simulationType) + case(flatIso) + call self % resetFluxesFlatIso() + case(linearIso) + call self % resetFluxesLinearIso() + case default + call fatalError(Here,'Unsupported simulation type requested') + end select + + end subroutine resetFluxes + + !! + !! Sets prevFlux to scalarFlux and zero's scalarFlux + !! + subroutine resetFluxesFlatIso(self) + class(arraysRR), intent(inout) :: self + integer(shortInt) :: idx + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % prevFlux(idx) = self % scalarFlux(idx) + self % scalarFlux(idx) = ZERO + end do + !$omp end parallel do + + end subroutine resetFluxesFlatIso + + !! + !! Sets prevFlux to scalarFlux and zero's scalarFlux + !! for linear sources with isotropic scattering + !! + subroutine resetFluxesLinearIso(self) + class(arraysRR), intent(inout) :: self + integer(shortInt) :: idx + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % prevFlux(idx) = self % scalarFlux(idx) + self % scalarFlux(idx) = ZERO + end do + !$omp end parallel do + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % prevX(idx) = self % scalarX(idx) + self % scalarX(idx) = ZERO + end do + !$omp end parallel do + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % prevY(idx) = self % scalarY(idx) + self % scalarY(idx) = ZERO + end do + !$omp end parallel do + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % prevZ(idx) = self % scalarZ(idx) + self % scalarZ(idx) = ZERO + end do + !$omp end parallel do + + end subroutine resetFluxesLinearIso + + !! + !! Sets prevFlux to scalarFlux and zero's scalarFlux + !! for flat sources with anisotropic scattering + !! TODO: add additional vectors of interest + !! + subroutine resetFluxesFlatAni(self) + class(arraysRR), intent(inout) :: self + integer(shortInt) :: idx + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % prevFlux(idx) = self % scalarFlux(idx) + self % scalarFlux(idx) = ZERO + end do + !$omp end parallel do + + end subroutine resetFluxesFlatAni + + !! + !! Sets prevFlux to scalarFlux and zero's scalarFlux + !! for linear sources with flat anisotropic scattering + !! TODO: add additional vectors of interest + !! + subroutine resetFluxesLIFA(self) + class(arraysRR), intent(inout) :: self + integer(shortInt) :: idx + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % prevFlux(idx) = self % scalarFlux(idx) + self % scalarFlux(idx) = ZERO + end do + !$omp end parallel do + + end subroutine resetFluxesLIFA + + !! + !! Accumulate flux scores for stats + !! + subroutine accumulateFluxScores(self) + class(arraysRR), intent(inout) :: self + character(100), parameter :: Here = 'accumulateFLuxScores (arraysRR_class.f90)' + + select case(self % simulationType) + case(flatIso, flatAni) + call self % accumulateFluxScoresFlat() + case(linearIso, linearAni) + call self % accumulateFluxScoresLinear() + case default + call fatalError(Here,'Unsupported simulation type requested') + end select + + end subroutine accumulateFluxScores + + !! + !! Accumulate flux scores for stats + !! + subroutine accumulateFluxScoresFlat(self) + class(arraysRR), intent(inout) :: self + real(defReal), save :: flux + integer(shortInt) :: idx + !$omp threadprivate(flux) + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + flux = self % scalarFlux(idx) + self % fluxScores(1, idx) = self % fluxScores(1, idx) + flux + self % fluxScores(2, idx) = self % fluxScores(2, idx) + flux * flux + end do + !$omp end parallel do + + end subroutine accumulateFluxScoresFlat + + !! + !! Accumulate flux scores for stats + !! Includes linear components + !! + subroutine accumulateFluxScoresLinear(self) + class(arraysRR), intent(inout) :: self + real(defReal), save :: flux + integer(shortInt) :: idx + !$omp threadprivate(flux) + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + flux = self % scalarFlux(idx) + self % fluxScores(1, idx) = self % fluxScores(1, idx) + flux + self % fluxScores(2, idx) = self % fluxScores(2, idx) + flux * flux + end do + !$omp end parallel do + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + flux = self % scalarX(idx) + self % xScores(1, idx) = self % xScores(1, idx) + flux + self % xScores(2, idx) = self % xScores(2, idx) + flux * flux + end do + !$omp end parallel do + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + flux = self % scalarY(idx) + self % yScores(1, idx) = self % yScores(1, idx) + flux + self % yScores(2, idx) = self % yScores(2, idx) + flux * flux + end do + !$omp end parallel do + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + flux = self % scalarZ(idx) + self % zScores(1, idx) = self % zScores(1, idx) + flux + self % zScores(2, idx) = self % zScores(2, idx) + flux * flux + end do + !$omp end parallel do + + end subroutine accumulateFluxScoresLinear + + !! + !! Tallies flux-related results, using an input tallyAdmin. + !! Allows for use of MC tally machinery with RR, although limited + !! to relatively simple estimators. + !! + !! Loops over all phase space points, contributing each to tallies. + !! + !! Assumes the cycle will be ended afterwards. + !! + subroutine tallyResults(self, tally) + class(arraysRR), intent(in) :: self + type(tallyAdmin), pointer, intent(inout) :: tally + type(particle), save :: p + real(defReal), save :: vol + real(defReal), dimension(3), save :: pos + integer(shortInt), save :: g, matIdx + real(defReal), dimension(:), pointer, save :: fluxVec + integer(shortInt) :: i + !$omp threadprivate(p, vol, pos, g, matIdx, fluxVec) + + !$omp parallel + call p % build([-INFINITY, -INFINITY, -INFINITY], [ONE, ZERO, ZERO], 1, ZERO, ZERO) + !$omp end parallel + + !$omp parallel do + do i = 1, self % nCells + + vol = self % getVolume(i) + pos = self % getCellPos(i) + call p % teleport(pos) + + call self % getFluxPointer(i, fluxVec) + matIdx = self % geom % geom % graph % getMatFromUID(i) + p % coords % matIdx = matIdx + + do g = 1, self % nG + + ! The weight should be flux * V, which, for a single score in a tally + ! will produce SigmaX * flux * V or volume-integrated reaction rate. + p % w = fluxVec(g) * vol + p % G = g + + call tally % reportInColl(p, .false.) + + end do + + end do + !$omp end parallel do + + end subroutine tallyResults + + !! + !! Finalise results + !! + subroutine finaliseFluxScores(self, it) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + character(100), parameter :: Here = 'finaliseFluxScores (arraysRR_class.f90)' + + select case(self % simulationType) + case(flatIso, flatAni) + call self % finaliseFluxScoresFlat(it) + case(linearIso, linearAni) + call self % finaliseFluxScoresLinear(it) + case default + call fatalError(Here,'Unsupported simulation type requested') + end select + + end subroutine finaliseFluxScores + + !! + !! Finalise flux scores for stats + !! + subroutine finaliseFluxScoresFlat(self,it) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + integer(shortInt) :: idx + real(defReal) :: N1, Nm1 + + if (it /= 1) then + Nm1 = 1.0_defReal/(it - 1) + else + Nm1 = 1.0_defReal + end if + N1 = 1.0_defReal/it + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % fluxScores(1, idx) = self % fluxScores(1, idx) * N1 + self % fluxScores(2, idx) = self % fluxScores(2, idx) * N1 + self % fluxScores(2, idx) = Nm1 * (self % fluxScores(2, idx) - & + self % fluxScores(1, idx) * self % fluxScores(1, idx)) + if (self % fluxScores(2, idx) <= ZERO) then + self % fluxScores(2, idx) = ZERO + else + self % fluxScores(2, idx) = sqrt(self % fluxScores(2, idx)) + end if + end do + !$omp end parallel do + + end subroutine finaliseFluxScoresFlat + + !! + !! Finalise flux scores for stats + !! Includes linear components + !! + subroutine finaliseFluxScoresLinear(self,it) + class(arraysRR), intent(inout) :: self + integer(shortInt), intent(in) :: it + integer(shortInt) :: idx + real(defReal) :: N1, Nm1 + + if (it /= 1) then + Nm1 = 1.0_defReal/(it - 1) + else + Nm1 = 1.0_defReal + end if + N1 = 1.0_defReal/it + + !$omp parallel do schedule(static) + do idx = 1, size(self % scalarFlux) + self % fluxScores(1, idx) = self % fluxScores(1, idx) * N1 + self % fluxScores(2, idx) = self % fluxScores(2, idx) * N1 + self % fluxScores(2, idx) = Nm1 * (self % fluxScores(2, idx) - & + self % fluxScores(1, idx) * self % fluxScores(1, idx)) + if (self % fluxScores(2, idx) <= ZERO) then + self % fluxScores(2, idx) = ZERO + else + self % fluxScores(2, idx) = sqrt(self % fluxScores(2, idx)) + end if + + self % xScores(1, idx) = self % xScores(1, idx) * N1 + self % xScores(2, idx) = self % xScores(2, idx) * N1 + self % xScores(2, idx) = Nm1 * (self % xScores(2, idx) - & + self % xScores(1, idx) * self % xScores(1, idx)) + if (self % xScores(2, idx) <= ZERO) then + self % xScores(2, idx) = ZERO + else + self % xScores(2, idx) = sqrt(self % xScores(2, idx)) + end if + + self % yScores(1, idx) = self % yScores(1, idx) * N1 + self % yScores(2, idx) = self % yScores(2, idx) * N1 + self % yScores(2, idx) = Nm1 * (self % yScores(2, idx) - & + self % yScores(1, idx) * self % yScores(1, idx)) + if (self % yScores(2, idx) <= ZERO) then + self % yScores(2, idx) = ZERO + else + self % yScores(2, idx) = sqrt(self % yScores(2, idx)) + end if + + self % zScores(1, idx) = self % zScores(1, idx) * N1 + self % zScores(2, idx) = self % zScores(2, idx) * N1 + self % zScores(2, idx) = Nm1 * (self % zScores(2, idx) - & + self % zScores(1, idx) * self % zScores(1, idx)) + if (self % zScores(2, idx) <= ZERO) then + self % zScores(2, idx) = ZERO + else + self % zScores(2, idx) = sqrt(self % zScores(2, idx)) + end if + end do + !$omp end parallel do + + end subroutine finaliseFluxScoresLinear + + !! + !! Send all arrays of interest to VTK output + !! + subroutine outputToVTK(self, viz) + class(arraysRR), intent(in) :: self + class(visualiser), intent(inout) :: viz + real(defReal), dimension(:), allocatable :: resVec + character(nameLen) :: name + integer(shortInt) :: cIdx, g + + allocate(resVec(self % nCells)) + + ! Output all fluxes (assuming finalisation of scores happened) + do g = 1, self % nG + name = 'flux_g'//numToChar(g) + !$omp parallel do schedule(static) + do cIdx = 1, self % nCells + resVec(cIdx) = self % getFluxScore(cIdx,g) + end do + !$omp end parallel do + call viz % addVTKData(resVec,name) + end do + + ! Output all flux uncertainties + do g = 1, self % nG + name = 'std_g'//numToChar(g) + !$omp parallel do schedule(static) + do cIdx = 1, self % nCells + resVec(cIdx) = self % getFluxSD(cIdx,g) /self % getFluxScore(cIdx,g) + end do + !$omp end parallel do + call viz % addVTKData(resVec,name) + end do + + ! Output final iteration sources + do g = 1, self % nG + name = 'source_'//numToChar(g) + !$omp parallel do schedule(static) + do cIdx = 1, self % nCells + resVec(cIdx) = real(self % getSource(cIdx,g),defReal) + end do + !$omp end parallel do + call viz % addVTKData(resVec,name) + end do + + if (allocated(self % fixedSource)) then + do g = 1, self % nG + name = 'fixedSource_'//numToChar(g) + !$omp parallel do schedule(static) + do cIdx = 1, self % nCells + resVec(cIdx) = real(self % getFixedSource(cIdx,g),defReal) + end do + !$omp end parallel do + call viz % addVTKData(resVec,name) + end do + end if + + ! Output final volume estimates + name = 'volume' + !$omp parallel do schedule(static) + do cIdx = 1, self % nCells + resVec(cIdx) = self % volume(cIdx) * self % totalVolume + end do + !$omp end parallel do + call viz % addVTKData(resVec,name) + + ! Output material IDs + name = 'material' + !$omp parallel do schedule(static) + do cIdx = 1, self % nCells + resVec(cIdx) = self % geom % geom % graph % getMatFromUID(cIdx) + end do + !$omp end parallel do + call viz % addVTKData(resVec,name) + + call viz % finaliseVTK() + + end subroutine outputToVTK + + !! + !! Output fluxes at given points + !! + subroutine outputPointFluxes(self, out, points, names) + class(arraysRR), intent(in) :: self + class(outputFile), intent(inout) :: out + real(defReal), dimension(:,:), intent(in) :: points + character(nameLen), dimension(:), intent(in) :: names + integer(shortInt) :: i + character(nameLen) :: name + real(defReal), dimension(self % nG) :: flux, fluxSD + character(100), parameter :: Here = 'outputPointFluxes (arraysRR_class.f90)' + + name = 'pointFlux' + call out % startBlock(name) + + ! Ensure points and names have the correction dimensions + if (size(points,1) /= 3) call fatalError(Here, 'Points are not 3D.') + if (size(points,2) /= size(names)) call fatalError(Here, & + 'Different numbers of sample points to sample names.') + + do i = 1, size(names) + + call out % startArray(names(i), [self % nG]) + call self % getFluxAtAPoint(points(:, i), flux, fluxSD) + call out % addResult(flux, fluxSD) + call out % endArray() + + end do + call out % endBlock() + + end subroutine outputPointFluxes + + !! + !! Returns the flux vector at a point in space + !! + subroutine getFluxAtAPoint(self, r, flux, fluxSD) + class(arraysRR), intent(in) :: self + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(self % nG), intent(out) :: flux + real(defReal), dimension(self % nG), intent(out) :: fluxSD + integer(shortInt) :: g, matIdx, cIdx, i + real(defReal), dimension(3) :: mom, momSD, centroid, fluxGrad + real(defFlt), dimension(matSize) :: invM + + ! Identify cell at the given point + call self % geom % whatIsAt(matIdx, cIdx, r) + + if (cIdx > 0) then + do g = 1, self % nG + + flux(g) = self % getFluxScore(cIdx, g) + fluxSD(g) = self % getFluxSD(cIdx, g) + + ! Include linear moments if available + if ((self % simulationType == linearIso) .or. & + (self % simulationType == linearAni)) then + + fluxSD(g) = fluxSD(g) * fluxSD(g) + + mom = self % getFluxMoments(cIdx, g) + momSD = self % getFluxMomentSDs(cIdx, g) + centroid = self % getCentroid(cIdx) + invM = self % invertMatrix(cIdx) + + ! Get flux gradients + fluxGrad(x) = real(invM(xx) * mom(x) + invM(xy) * mom(y) + invM(xz) * mom(z), defReal) + fluxGrad(y) = real(invM(xy) * mom(x) + invM(yy) * mom(y) + invM(yz) * mom(z), defReal) + fluxGrad(z) = real(invM(xz) * mom(x) + invM(yz) * mom(y) + invM(zz) * mom(z), defReal) + + ! Note this will not correctly estimate uncertainty as moments are covariant + do i = 1, 3 + flux(g) = flux(g) + fluxGrad(i) * (r(i) - centroid(i)) + ! Not sure exactly how to propagate uncertainties - need to do some maths + fluxSD(g) = fluxSD(g) + momSD(i)**2 * (r(i) - centroid(i))**2 + end do + + if (fluxSD(g) > ZERO) fluxSD(g) = sqrt(fluxSD(g)) + + end if + + end do + + else + print *,'WARNING: No cell found at position '//numToChar(r) + flux = -ONE + fluxSD = -ONE + end if + + end subroutine getFluxAtAPoint + + !! + !! Return to uninitialised state + !! + subroutine kill(self) + class(arraysRR), intent(inout) :: self + integer(shortInt) :: i + + ! Clean standard contents + if(allocated(self % scalarFlux)) deallocate(self % scalarFlux) + if(allocated(self % prevFlux)) deallocate(self % prevFlux) + if(allocated(self % fluxScores)) deallocate(self % fluxScores) + if(allocated(self % source)) deallocate(self % source) + if(allocated(self % fixedSource)) deallocate(self % fixedSource) + if(allocated(self % sourceIdx)) deallocate(self % sourceIdx) + if(allocated(self % volumeTracks)) deallocate(self % volumeTracks) + if(allocated(self % volume)) deallocate(self % volume) + if(allocated(self % cellHit)) deallocate(self % cellHit) + if(allocated(self % cellTotalHit)) deallocate(self % cellTotalHit) + if(allocated(self % cellPos)) deallocate(self % cellPos) + + ! Clean LS contents + if(allocated(self % scalarX)) deallocate(self % scalarX) + if(allocated(self % scalarX)) deallocate(self % scalarY) + if(allocated(self % scalarX)) deallocate(self % scalarZ) + if(allocated(self % prevX)) deallocate(self % prevX) + if(allocated(self % prevY)) deallocate(self % prevY) + if(allocated(self % prevZ)) deallocate(self % prevZ) + if(allocated(self % sourceX)) deallocate(self % sourceX) + if(allocated(self % sourceY)) deallocate(self % sourceY) + if(allocated(self % sourceZ)) deallocate(self % sourceZ) + if(allocated(self % momMat)) deallocate(self % momMat) + if(allocated(self % momTracks)) deallocate(self % momTracks) + if(allocated(self % centroid)) deallocate(self % centroid) + if(allocated(self % centroidTracks)) deallocate(self % centroidTracks) + if(allocated(self % xScores)) deallocate(self % xScores) + if(allocated(self % yScores)) deallocate(self % yScores) + if(allocated(self % zScores)) deallocate(self % zScores) + + if(allocated(self % locks)) then + do i = 1, self % nCells +#ifdef _OPENMP + call OMP_destroy_lock(self % locks(i)) +#endif + end do + deallocate(self % locks) + end if + + self % geom => null() + call self % XSData % kill() + self % nG = 0 + self % nCells = 0 + self % lengthPerIt = ZERO + self % rho = 0.0_defFlt + self % simulationType = 0 + self % ani = 0 + self % totalVolume = ONE + self % averageHit = ZERO + self % iterations = 0 + self % volPolicy = hybrid + self % missPolicy = hybrid + self % set2D = .false. + + end subroutine kill + +end module arraysRR_class diff --git a/RandomRayObjects/constantsRR.f90 b/RandomRayObjects/constantsRR.f90 new file mode 100644 index 000000000..195302a20 --- /dev/null +++ b/RandomRayObjects/constantsRR.f90 @@ -0,0 +1,43 @@ +module constantsRR + + use numPrecision + + implicit none + + ! Parameters for volume/no-hit policy + integer(shortInt), parameter :: hybrid = 3, srcPolicy = 1, prevPolicy = 2, & + naive = 2, simAverage = 1 + + ! Parameters to identify the simulation type + integer(shortInt), parameter, public :: flatIso = 1, linearIso = 2, flatAni = 3, linearAni = 4 + + ! Parameter for when to skip a tiny volume + real(defReal), parameter, public :: volume_tolerance = 1.0E-12 + + ! Parameter for when to ignore components of spatial moment matrices + ! or when the matrix is poorly conditioned + real(defReal), parameter, public :: condition_tolerance = 1.0E-6, & + det_tolerance = 1.0E-8 + + ! Parameters for indexing into matrices and spatial moments with linear sources + integer(shortInt), parameter :: x = 1, y = 2, z = 3, nDim = 3, & + xx = 1, xy = 2, xz = 3, & + yy = 4, yz = 5, zz = 6, & + matSize = 6 + + ! Parameters for deciding how to invert the moment matrix + integer(shortInt), parameter :: invertXYZ = 7, invertXY = 6, & + invertXZ = 5, invertYZ = 3, & + invertX = 4, invertY = 2, & + invertZ = 1 + + ! Convenient arithmetic parameters + real(defFlt), parameter :: one_two = real(HALF,defFlt), & + two_three = real(2.0_defFlt/3.0_defFlt,defFlt) + + real(defReal), parameter :: one_twelve = ONE / 12 + + +contains + +end module constantsRR diff --git a/RandomRayObjects/dataRR_class.f90 b/RandomRayObjects/dataRR_class.f90 new file mode 100644 index 000000000..a0edb1c4c --- /dev/null +++ b/RandomRayObjects/dataRR_class.f90 @@ -0,0 +1,597 @@ +module dataRR_class + + use numPrecision + use universalVariables + use rng_class, only : RNG + use genericProcedures, only : fatalError, numToChar + + ! Nuclear Data + use materialMenu_mod, only : mm_nMat => nMat, mm_matName => matName + use materialHandle_inter, only : materialHandle + use baseMgNeutronDatabase_class, only : baseMgNeutronDatabase + use baseMgNeutronMaterial_class, only : baseMgNeutronMaterial, baseMgNeutronMaterial_CptrCast + + implicit none + private + + !! + !! Nuclear data in a random ray-friendly format. + !! + !! Stores data and provides access in a manner which is more performant + !! than is done for MC MG data at present. + !! + !! TODO: Add kinetic data and higher-order scattering matrices + !! + type, public :: dataRR + private + ! Components + integer(shortInt) :: nG = 0 + integer(shortInt) :: nG2 = 0 + integer(shortInt) :: nMat = 0 + + ! Data space - absorb all nuclear data for speed + real(defFlt), dimension(:), allocatable :: sigmaT + real(defFlt), dimension(:), allocatable :: nuSigmaF + real(defFlt), dimension(:), allocatable :: sigmaF + real(defFlt), dimension(:), allocatable :: sigmaS + real(defFlt), dimension(:), allocatable :: chi + logical(defBool), dimension(:), allocatable :: fissile + character(nameLen), dimension(:), allocatable :: names + + ! Optional kinetic data + logical(defBool) :: doKinetics = .false. + integer(shortInt) :: nP = 0 + real(defFlt), dimension(:), allocatable :: chiD + real(defFlt), dimension(:), allocatable :: chiP + real(defFlt), dimension(:), allocatable :: beta + real(defFlt), dimension(:), allocatable :: invSpeed + + ! Optional higher-order scattering matrices up to P3 + real(defFlt), dimension(:), allocatable :: sigmaS1 + real(defFlt), dimension(:), allocatable :: sigmaS2 + real(defFlt), dimension(:), allocatable :: sigmaS3 + + contains + + procedure :: init + procedure :: setAdjointXS + procedure :: display + procedure :: materialName + procedure :: kill + + ! TODO: add an XS update procedure, e.g., given multiphysics + ! TODO: add full handling of kinetic data + ! TODO: add full handling of higher-order anisotropy + + ! Access procedures + procedure :: getProdPointers + !procedure :: getAllPointers + procedure :: getTotalPointer + procedure :: getNuFissPointer + procedure :: getChiPointer + procedure :: getScatterPointer + procedure :: getScatterVecPointer + procedure :: getTotalXS + procedure :: getFissionXS + procedure :: getScatterXS + procedure :: getNG + procedure :: getNMat + procedure :: getNPrec + procedure :: getName + procedure :: getIdxFromName + procedure :: isFissile + + ! Private procedures + procedure, private :: getIdxs + procedure, private :: getScatterIdxs + !procedure, private :: getKineticIdxs + + + end type dataRR + +contains + + !! + !! Initialise necessary nuclear data. + !! Can optionally include kinetic parameters. + !! + subroutine init(self, db, doKinetics, loud) + class(dataRR), intent(inout) :: self + class(baseMgNeutronDatabase),pointer, intent(in) :: db + logical(defBool), intent(in) :: doKinetics + logical(defBool), intent(in) :: loud + integer(shortInt) :: g, g1, m, matP1, aniOrder + type(RNG) :: rand + logical(defBool) :: fiss, negScat + class(baseMgNeutronMaterial), pointer :: mat + class(materialHandle), pointer :: matPtr + real(defFlt) :: sig + character(100), parameter :: Here = 'init (dataRR_class.f90)' + + self % doKinetics = doKinetics + + ! Store number of energy groups for convenience + self % nG = db % nGroups() + self % nG2 = self % nG * self % nG + + ! Initialise local nuclear data + ! Allocate nMat + 1 materials to catch void and undefined materials + ! TODO: clean nuclear database afterwards! It is no longer used + ! and takes up memory. + self % nMat = mm_nMat() + matP1 = self % nMat + 1 + allocate(self % sigmaT(matP1 * self % nG)) + self % sigmaT = 0.0_defFlt + allocate(self % nuSigmaF(matP1 * self % nG)) + self % nuSigmaF = 0.0_defFlt + allocate(self % sigmaF(matP1 * self % nG)) + self % sigmaF = 0.0_defFlt + allocate(self % chi(matP1 * self % nG)) + self % chi = 0.0_defFlt + allocate(self % sigmaS(matP1 * self % nG * self % nG)) + self % sigmaS = 0.0_defFlt + allocate(self % fissile(matP1)) + self % fissile = .false. + allocate(self % names(matP1)) + self % names = 'unnamed' + + ! Create a dummy RNG to satisfy the mgDatabase access interface + call rand % init(1_longInt) + + if (loud) print *,'Initialising random ray nuclear data' + do m = 1, self % nMat + matPtr => db % getMaterial(m) + mat => baseMgNeutronMaterial_CptrCast(matPtr) + fiss = .false. + do g = 1, self % nG + self % sigmaT(self % nG * (m - 1) + g) = real(mat % getTotalXS(g, rand),defFlt) + self % nuSigmaF(self % nG * (m - 1) + g) = real(mat % getNuFissionXS(g, rand),defFlt) + self % sigmaF(self % nG * (m - 1) + g) = real(mat % getFissionXS(g, rand),defFlt) + if (self % nuSigmaF(self % nG * (m - 1) + g) > 0) fiss = .true. + self % chi(self % nG * (m - 1) + g) = real(mat % getChi(g, rand),defFlt) + ! Include scattering multiplicity + do g1 = 1, self % nG + self % sigmaS(self % nG * self % nG * (m - 1) + self % nG * (g - 1) + g1) = & + real(mat % getScatterXS(g1, g, rand) * mat % scatter % prod(g, g1) , defFlt) + end do + end do + self % fissile(m) = fiss + self % names(m) = mm_matName(m) + end do + + ! Check whethere any sigmaT's are zero or negative. + ! Also check whether any negative scattering matrix diagonals occur. + if (loud) print *,'Checking cross sections' + negScat = .false. + do m = 1, self % nMat + do g = 1, self % nG + sig = self % sigmaT(self % nG * (m - 1) + g) + if (sig <= 0.0_defFlt) then + call fatalError(Here, 'Dubious cross section in material '// self % names(m)//& + ' in group '//numToChar(g)//': '//numToChar(real(sig,defReal))) + end if + sig = self % sigmaS(self % nG * self % nG * (m - 1) + self % nG * (g - 1) + g) + if (sig < 0.0_defFlt) negScat = .true. + end do + end do + + if (negScat .and. loud) then + print *,'Warning: some scattering cross sections are negative. Consider diagonal stabilisation' + end if + + ! Initialise data necessary for kinetic/noise calculations + if (self % doKinetics) then + if (loud) print *,'Including kinetic data' + call fatalError(Here,'Kinetic data not yet supported') + + end if + + ! Initialise higher-order scattering matrices + ! TODO: read anisotropy order from database + aniOrder = 0 + if (aniOrder > 0) then + if (loud) print *,'Including anisotropic scattering data' + call fatalError(Here,'Anisotropy not yet supported') + + end if + + end subroutine init + + !! + !! Change cross sections for adjoints simulations: + !! - swap chi and nuSigmaF + !! - transpose scattering matrices + !! + subroutine setAdjointXS(self) + class(dataRR), intent(inout) :: self + integer(shortInt) :: g, g1, m + real(defFlt), dimension(:), allocatable :: buffer + + ! Swap chi and nuSigmaF + allocate(buffer(self % nMat * self % nG)) + buffer = self % chi + self % chi = self % nuSigmaF + self % nuSigmaF = self % chi + deallocate(buffer) + + ! Transpose scattering matrix + allocate(buffer(self % nMat * self % nG * self % nG)) + buffer = self % sigmaS + + do m = 1, self % nMat + do g = 1, self % nG + do g1 = 1, self % nG + self % sigmaS(self % nG * self % nG * (m - 1) + self % nG * (g1 - 1) + g) = & + buffer(self % nG * self % nG * (m - 1) + self % nG * (g - 1) + g1) + end do + end do + end do + + ! TODO: apply the same treatment to anisotropic scattering matrices + + end subroutine setAdjointXS + + !! + !! Display contents of the class + !! + subroutine display(self) + class(dataRR), intent(in) :: self + + print *,'Number of group: '//numToChar(self % nG) + print *,'Number of materials: '//numToChar(self % nMat) + if (allocated(self % names)) then + print *,'Material names: '//self % names + else + print *,'Material names not allocated' + end if + if (allocated(self % sigmaT)) print *,'Total XS: '//numToChar(real(self % sigmaT,defReal)) + if (allocated(self % nuSigmaF)) print *,'NuSigmaF XS: '//numToChar(real(self % nuSigmaF,defReal)) + if (allocated(self % sigmaF)) print *,'SigmaF XS: '//numToChar(real(self % sigmaF,defReal)) + if (allocated(self % sigmaS)) print *,'SigmaS XS: '//numToChar(real(self % sigmaS,defReal)) + if (allocated(self % chi)) print *,'Chi: '//numToChar(real(self % chi,defReal)) + + end subroutine display + + !! + !! Return the name of a given material + !! + function materialName(self, matIdx) result(matName) + class(dataRR), intent(in) :: self + integer(shortInt), intent(in) :: matIdx + character(nameLen) :: matName + character(100), parameter :: Here = 'materialName (dataRR_class.f90)' + + if ((matIdx > 0) .and. (matIdx <= self % nMat + 1)) then + matName = self % names(matIdx) + else + call fatalError(Here, 'Invalid material index: '//numToChar(matIdx)) + end if + + end function materialName + + !! + !! Calculate the lower and upper indices for accessing the XS array + !! (excluding scattering and kinetic data) + !! + pure subroutine getIdxs(self, matIdx, idx1, idx2) + class(dataRR), intent(in) :: self + integer(shortInt), intent(in) :: matIdx + integer(shortInt), intent(out) :: idx1, idx2 + + idx1 = (matIdx - 1) * self % nG + 1 + idx2 = matIdx * self % nG + + end subroutine getIdxs + + !! + !! Calculate the lower and upper indices for accessing the scattering XS array + !! + pure subroutine getScatterIdxs(self, matIdx, idx1, idx2) + class(dataRR), intent(in) :: self + integer(shortInt), intent(in) :: matIdx + integer(shortInt), intent(out) :: idx1, idx2 + integer(shortInt) :: mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = self % nMat + end if + + idx1 = (matIdx - 1) * self % nG2 + 1 + idx2 = matIdx * self % nG2 + + end subroutine getScatterIdxs + + !! + !! Return if a material is fissile + !! + elemental function isFissile(self, matIdx) result(isFiss) + class(dataRR), intent(in) :: self + integer(shortInt), intent(in) :: matIdx + logical(defBool) :: isFiss + integer(shortInt) :: mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + isFiss = self % fissile(mIdx) + + end function isFissile + + !! + !! Return the number of groups + !! + elemental function getNG(self) result(nG) + class(dataRR), intent(in) :: self + integer(shortInt) :: nG + + nG = self % nG + + end function getNG + + !! + !! Return the number of materials + !! + elemental function getNMat(self) result(nM) + class(dataRR), intent(in) :: self + integer(shortInt) :: nM + + nM = self % nMat + + end function getNMat + + !! + !! Return the number of precursors + !! + elemental function getNPrec(self) result(nP) + class(dataRR), intent(in) :: self + integer(shortInt) :: nP + + nP = self % nP + + end function getNPrec + + !! + !! Return the name of a given material + !! + elemental function getName(self, matIdx) result(matName) + class(dataRR), intent(in) :: self + integer(shortInt), intent(in) :: matIdx + integer(shortInt) :: mIdx + character(nameLen) :: matName + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + matName = self % names(mIdx) + + end function getName + + !! + !! Return the index of a material given its name + !! + elemental function getIdxFromName(self, matName) result(matIdx) + class(dataRR), intent(in) :: self + character(nameLen), intent(in) :: matName + integer(shortInt) :: matIdx + + do matIdx = 1, self % nMat + if (self % names(matIdx) == matName) return + end do + matIdx = -1 + + end function getIdxFromName + + !! + !! Get scatter pointer + !! + subroutine getScatterPointer(self, matIdx, sigS) + class(dataRR), target, intent(in) :: self + integer(shortInt), intent(in) :: matIdx + real(defFlt), dimension(:), pointer, intent(out) :: sigS + integer(shortInt) :: idx1, idx2, mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + call self % getScatterIdxs(mIdx, idx1, idx2) + sigS => self % sigmaS(idx1:idx2) + + end subroutine getScatterPointer + + !! + !! Get scatter vector pointer + !! + subroutine getScatterVecPointer(self, matIdx, gOut, sigS) + class(dataRR), target, intent(in) :: self + integer(shortInt), intent(in) :: matIdx + integer(shortInt), intent(in) :: gOut + real(defFlt), dimension(:), pointer, intent(out) :: sigS + integer(shortInt) :: idx1, idx2, mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + idx1 = (matIdx - 1) * self % nG2 + (gOut - 1) * self % nG + 1 + idx2 = (matIdx - 1) * self % nG2 + gOut * self % nG + sigS => self % sigmaS(idx1:idx2) + + end subroutine getScatterVecPointer + + + !! + !! Get chi pointer + !! + subroutine getChiPointer(self, matIdx, chi) + class(dataRR), target, intent(in) :: self + integer(shortInt), intent(in) :: matIdx + real(defFlt), dimension(:), pointer, intent(out) :: chi + integer(shortInt) :: idx1, idx2, mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + call self % getIdxs(mIdx, idx1, idx2) + chi => self % chi(idx1:idx2) + + end subroutine getChiPointer + + !! + !! Return pointers to all commonly used XSs for neutron production + !! This is done for a given material, across all energies + !! + subroutine getProdPointers(self, matIdx, nuSigF, sigS, chi) + class(dataRR), target, intent(in) :: self + integer(shortInt), intent(in) :: matIdx + real(defFlt), dimension(:), pointer, intent(out) :: nuSigF, sigS, chi + integer(shortInt) :: idx1, idx2, idx1s, idx2s, mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + call self % getIdxs(mIdx, idx1, idx2) + call self % getScatterIdxs(mIdx, idx1s, idx2s) + nuSigF => self % nuSigmaF(idx1:idx2) + chi => self % chi(idx1:idx2) + sigS => self % sigmaS(idx1s:idx2s) + + end subroutine getProdPointers + + !! + !! Return pointers to only the total XS + !! This is done for a given material, across all energies + !! + subroutine getTotalPointer(self, matIdx, sigT) + class(dataRR), target, intent(in) :: self + integer(shortInt), intent(in) :: matIdx + real(defFlt), dimension(:), pointer, intent(out) :: sigT + integer(shortInt) :: idx1, idx2, mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + call self % getIdxs(mIdx, idx1, idx2) + sigT => self % sigmaT(idx1:idx2) + + end subroutine getTotalPointer + + !! + !! Return pointers to only the nuFission XS + !! This is done for a given material, across all energies + !! + subroutine getNuFissPointer(self, matIdx, nuFiss) + class(dataRR), target, intent(in) :: self + integer(shortInt), intent(in) :: matIdx + real(defFlt), dimension(:), pointer, intent(out) :: nuFiss + integer(shortInt) :: idx1, idx2, mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + call self % getIdxs(mIdx, idx1, idx2) + nuFiss => self % nuSigmaF(idx1:idx2) + + end subroutine getNuFissPointer + + !! + !! Return total XS in a given material and group + !! + elemental function getTotalXS(self, matIdx, g) result(sigT) + class(dataRR), intent(in) :: self + integer(shortInt), intent(in) :: matIdx, g + real(defFlt) :: sigT + integer(shortInt) :: mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + sigT = self % sigmaT((mIdx - 1) * self % nG + g) + + end function getTotalXS + + !! + !! Return fission XS in a given material and group + !! + elemental function getFissionXS(self, matIdx, g) result(sigF) + class(dataRR), intent(in) :: self + integer(shortInt), intent(in) :: matIdx, g + real(defFlt) :: sigF + integer(shortInt) :: mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + sigF = self % sigmaF((mIdx - 1) * self % nG + g) + + end function getFissionXS + + !! + !! Return scatter XS in a given material, ingoing group, and outgoing group + !! + elemental function getScatterXS(self, matIdx, gIn, gOut) result(sigS) + class(dataRR), intent(in) :: self + integer(shortInt), intent(in) :: matIdx, gIn, gOut + real(defFlt) :: sigS + integer(shortInt) :: mIdx + + if (matIdx > self % nMat) then + mIdx = self % nMat + 1 + else + mIdx = matIdx + end if + sigS = self % sigmaS((mIdx - 1) * self % nG2 + self % nG * (gIn - 1) + gOut) + + end function getScatterXS + + + !! + !! Return to uninitialised state + !! + subroutine kill(self) + class(dataRR), intent(inout) :: self + + ! Clean contents + self % nG = 0 + self % nG2 = 0 + self % nMat = 0 + self % nP = 0 + self % doKinetics = .false. + if(allocated(self % sigmaT)) deallocate(self % sigmaT) + if(allocated(self % sigmaS)) deallocate(self % sigmaS) + if(allocated(self % nuSigmaF)) deallocate(self % nuSigmaF) + if(allocated(self % sigmaF)) deallocate(self % sigmaF) + if(allocated(self % chi)) deallocate(self % chi) + if(allocated(self % fissile)) deallocate(self % fissile) + if(allocated(self % names)) deallocate(self % names) + if(allocated(self % chiD)) deallocate(self % chiD) + if(allocated(self % chiP)) deallocate(self % chiP) + if(allocated(self % beta)) deallocate(self % beta) + if(allocated(self % invSpeed)) deallocate(self % invSpeed) + if(allocated(self % sigmaS1)) deallocate(self % sigmaS1) + if(allocated(self % sigmaS2)) deallocate(self % sigmaS2) + if(allocated(self % sigmaS3)) deallocate(self % sigmaS3) + + end subroutine kill + +end module dataRR_class diff --git a/RandomRayObjects/mathsRR_func.f90 b/RandomRayObjects/mathsRR_func.f90 new file mode 100644 index 000000000..ca6f4b6b2 --- /dev/null +++ b/RandomRayObjects/mathsRR_func.f90 @@ -0,0 +1,174 @@ +module mathsRR_func + + !! + !! This module contains maths used in random ray. + !! First it has a function for efficiently computing an exponential + !! for use in MoC implementations using a rational approximation. + !! I believe this originates from the M&C 2019 publication: + !! "Adding a third level of parallelism to OpenMOC" + !! + !! TODO: Add functions for efficient spherical harmonics evaluation. + !! + + use numPrecision + use genericProcedures, only : fatalError + + implicit none + private + + public :: expF1, expF1Tau, expG, expG2 + + ! Numerator coefficients in F1 rational approximation + real(defFlt), parameter :: c1n = -1.0000013559236386308, c2n = 0.23151368626911062025,& + c3n = -0.061481916409314966140, c4n = 0.0098619906458127653020, c5n = -0.0012629460503540849940, & + c6n = 0.00010360973791574984608, c7n = -0.000013276571933735820960 + + ! Denominator coefficients in F1 rational approximation + real(defFlt), parameter :: c0d = 1.0_defFlt, c1d = -0.73151337729389001396, c2d = 0.26058381273536471371, & + c3d = -0.059892419041316836940, c4d = 0.0099070188241094279067, c5d = -0.0012623388962473160860, & + c6d = 0.00010361277635498731388, c7d = -0.000013276569500666698498 + + ! Numerator coefficients in G rational approximation + real(defFlt), parameter :: d0n = 0.5, d1n = 0.176558112351595, d2n = 0.04041584305811143, & + d3n = 0.006178333902037397, d4n = 0.0006429894635552992 , d5n = 0.00006064409107557148 + + ! Denominator coefficients in G rational approximation + real(defFlt), parameter :: d0d = 1.0, d1d = 0.6864462055546078, d2d = 0.2263358514260129, & + d3d = 0.04721469893686252, d4d = 0.006883236664917246, d5d = 0.0007036272419147752 , d6d = 0.00006064409107557148 + + ! Coefficients for numerator in G2 rational approximation + real(defFlt), parameter :: g1n = -0.08335775885589858, g2n = -0.003603942303847604, & + g3n = 0.0037673183263550827, g4n = 0.00001124183494990467, g5n = 0.00016837426505799449 + + ! Coefficients for denominator in G2 rational approximation + real(defFlt), parameter :: g1d = 0.7454048371823628, g2d = 0.23794300531408347, & + g3d = 0.05367250964303789, g4d = 0.006125197988351906, g5d = 0.0010102514456857377 + +contains + + !! + !! Computes x = [1 - exp(-tau)]/tau for use in MoC calcs + !! Tau is the optical distance. + !! F1 is a common name in MoC literature + !! + elemental function expF1(tau) result(x) + real(defFlt), intent(in) :: tau + real(defFlt) :: x + real(defFlt) :: den, num + + x = -tau + den = c7d + den = den * x + c6d + den = den * x + c5d + den = den * x + c4d + den = den * x + c3d + den = den * x + c2d + den = den * x + c1d + den = den * x + c0d + + num = c7n + num = num * x + c6n + num = num * x + c5n + num = num * x + c4n + num = num * x + c3n + num = num * x + c2n + num = num * x + c1n + ! Reintroduce this to give 1-exp(-tau) + !num = num * x + !x = num / den + + x = -num / den + + end function expF1 + + !! + !! Computes x = [1 - exp(-tau)] = F1*tau for use in MoC calcs + !! Tau is the optical distance. + !! F1 is a common name in MoC literature + !! + elemental function expF1Tau(tau) result(x) + real(defFlt), intent(in) :: tau + real(defFlt) :: x + real(defFlt) :: den, num + + x = -tau + den = c7d + den = den * x + c6d + den = den * x + c5d + den = den * x + c4d + den = den * x + c3d + den = den * x + c2d + den = den * x + c1d + den = den * x + c0d + + num = c7n + num = num * x + c6n + num = num * x + c5n + num = num * x + c4n + num = num * x + c3n + num = num * x + c2n + num = num * x + c1n + num = num * x + x = num / den + + end function expF1Tau + + !! + !! Computes y = 1/x-(1-exp(-x))/x**2 using a 5/6th order rational approximation. + !! From OpenMOC. + !! Commonly referred to as G in MoC literature. Used to compute other exponentials. + !! + elemental function expG(tau) result(x) + real(defFlt), intent(in) :: tau + real(defFlt) :: x + real(defFlt) :: den, num + + x = tau + + den = d6d * x + d5d + den = den * x + d4d + den = den * x + d3d + den = den * x + d2d + den = den * x + d1d + den = den * x + d0d + + num = d5n * x + d4n + num = num * x + d3n + num = num * x + d2n + num = num * x + d1n + num = num * x + d0n + + x = num / den + + end function expG + + !! + !! Computes y = 2/3 - (1 + 2/x) * (1/x + 0.5 - (1 + 1/x) * (1-exp(-x)) / x) + !! using a 5/5th order rational approximation, + !! From OpenMoC. + !! + elemental function expG2(tau) result(x) + real(defFlt), intent(in) :: tau + real(defFlt) :: x + real(defFlt) :: den, num + + x = tau + + num = g5n*x + g4n + num = num*x + g3n + num = num*x + g2n + num = num*x + g1n + num = num*x + + ! Calculate denominator + den = g5d*x + g4d + den = den*x + g3d + den = den*x + g2d + den = den*x + g1d + den = den*x + 1.0_defFlt + + x = num / den + + end function expG2 + +end module mathsRR_func diff --git a/RandomRayObjects/rayHandling_func.f90 b/RandomRayObjects/rayHandling_func.f90 new file mode 100644 index 000000000..2940a8d4e --- /dev/null +++ b/RandomRayObjects/rayHandling_func.f90 @@ -0,0 +1,627 @@ +module rayHandling_func + + use numPrecision + use universalVariables + use constantsRR + use genericProcedures, only : fatalError, numToChar, rotateVector + use dictionary_class, only : dictionary + use rng_class, only : RNG + + ! Geometry + use coord_class, only : coordList + use geometry_inter, only : distCache + use geometryStd_class, only : geometryStd + + ! Random ray modules + use arraysRR_class, only : arraysRR + use dataRR_class, only : dataRR + use mathsRR_func, only : expF1, expF1Tau, expG, expG2 + + ! Random ray - or a standard particle + use particle_class, only : ray => particle + + implicit none + private + + !! + !! Set of functions and subroutines to handle everything to do with rays + !! in random ray + !! + !! TODO: add uncollided sweep and volume tracing + !! + public :: initialiseRay + public :: transportSweep + private :: moveRay + private :: checkRayLength + private :: transportSweepFlatIso + private :: transportSweepLinearIso + private :: transportSweepLIFA + private :: transportSweepFlatAni + +contains + + subroutine initialiseRay(r, arrays) + type(ray), intent(inout) :: r + class(arraysRR), pointer, intent(in) :: arrays + class(geometryStd), pointer :: geom + real(defReal) :: mu, phi + real(defReal), dimension(6) :: b + real(defReal), dimension(3) :: lb, ub, u, rand3, x + integer(shortInt) :: i, matIdx, cIdx + character(100), parameter :: Here = 'initialiseRay (rayHandling_func.f90)' + + geom => arrays % getGeomPointer() + + i = 0 + mu = TWO * r % pRNG % get() - ONE + phi = TWO_PI * r % pRNG % get() + u = rotateVector([ONE, ZERO, ZERO], mu, phi) + + b = geom % bounds() + lb = b(1:3) + ub = b(4:6) + + rejection : do + rand3(1) = r % pRNG % get() + rand3(2) = r % pRNG % get() + rand3(3) = r % pRNG % get() + x = lb + (ub - lb) * rand3 + + ! Exit if point is inside the geometry + call geom % whatIsAt(matIdx, cIdx, x, u) + if (matIdx /= OUTSIDE_MAT) exit rejection + + i = i + 1 + if (i > 5000) then + call fatalError(Here, 'Infinite loop when searching for ray start in the geometry.') + end if + end do rejection + + ! Place in the geometry & process the ray + call r % build(x, u, 1, ONE) + call geom % placeCoord(r % coords) + + if (.not. arrays % wasFound(cIdx)) call arrays % newFound(cIdx, x) + + end subroutine initialiseRay + + !! + !! Move ray across a cell, into the next + !! Use distance caching or standard ray tracing + !! Distance caching seems a little bit more unstable + !! due to FP error accumulation, but is faster. + !! This can be fixed by resetting the cache after X number + !! of distance calculations. + !! + subroutine moveRay(r, doCache, ints, geom, length, event, cache, hitVacuum) + type(ray), intent(inout) :: r + logical(defBool), intent(in) :: doCache + integer(longInt), intent(inout) :: ints + class(geometryStd), pointer, intent(in) :: geom + real(defReal), intent(inout) :: length + integer(shortInt), intent(out) :: event + type(distCache), intent(inout) :: cache + logical(defBool), intent(out) :: hitVacuum + + if (doCache) then + if (mod(ints,20_longInt) == 0) cache % lvl = 0 + call geom % moveRay_withCache(r % coords, length, event, cache, hitVacuum) + else + call geom % moveRay_noCache(r % coords, length, event, hitVacuum) + end if + ints = ints + 1 + + end subroutine moveRay + + !! + !! Set maximum flight distance and ensure ray is active + !! + subroutine checkRayLength(totalLength, dead, termination, activeRay, length) + real(defReal), intent(in) :: totalLength + real(defReal), intent(in) :: dead + real(defReal), intent(in) :: termination + logical(defBool), intent(inout) :: activeRay + real(defReal), intent(out) :: length + + if (totalLength >= dead) then + length = termination - totalLength + activeRay = .true. + else + length = dead - totalLength + end if + + end subroutine checkRayLength + + !! + !! Moves ray through geometry, updating angular flux and + !! scoring scalar flux and volume. + !! Records the number of integrations/ray movements. + !! + subroutine transportSweep(r, ints, nG, doCache, dead, termination, arrays) + type(ray), intent(inout) :: r + integer(longInt), intent(out) :: ints + integer(shortInt), intent(in) :: nG + logical(defBool), intent(in) :: doCache + real(defReal), intent(in) :: dead + real(defReal), intent(in) :: termination + class(arraysRR), pointer, intent(inout) :: arrays + integer(shortInt) :: simType + character(100), parameter :: Here = 'transportSweep (rayHandling_func.f90)' + + simType = arrays % getSimulationType() + + select case(simType) + case (flatIso) + call transportSweepFlatIso(r, ints, nG, doCache, dead, termination, arrays) + case (linearIso) + call transportSweepLinearIso(r, ints, nG, doCache, dead, termination, arrays) + case (flatAni) + call transportSweepFlatAni(r, ints, nG, doCache, dead, termination, arrays) + case (linearAni) + call transportSweepLIFA(r, ints, nG, doCache, dead, termination, arrays) + case default + call fatalError(Here,'Unsupported simulation type') + end select + + end subroutine transportSweep + + !! + !! Transport sweep for flat isotropic sources + !! + subroutine transportSweepFlatIso(r, ints, nG, doCache, dead, termination, arrays) + type(ray), intent(inout) :: r + integer(longInt), intent(out) :: ints + integer(shortInt), intent(in) :: nG + logical(defBool), intent(in) :: doCache + real(defReal), intent(in) :: dead + real(defReal), intent(in) :: termination + class(arraysRR), pointer, intent(in) :: arrays + class(dataRR), pointer :: XSData + class(geometryStd), pointer :: geom + integer(shortInt) :: matIdx, g, cIdx, event, matIdx0 + real(defReal) :: totalLength, length + logical(defBool) :: activeRay, hitVacuum + type(distCache) :: cache + real(defFlt) :: lenFlt, len_2 + real(defFlt), dimension(nG) :: attenuate, delta, angular, tau, inc + real(defFlt), pointer, dimension(:) :: source, total + real(defReal), pointer, dimension(:) :: scalar + + XSData => arrays % getDataPointer() + geom => arrays % getGeomPointer() + + ! Set initial angular flux to angle average of cell source + cIdx = r % coords % uniqueID + matIdx = r % coords % matIdx + call XSData % getTotalPointer(matIdx, total) + + ! Catch for regions with voids + ! Assumes these are defined as 'void' + ! TODO: Use a more robust criterion, as for branching later + if (matIdx <= XSData % getNMat()) then + do g = 1, nG + if (total(g) > 1.0E-6_defFlt) then + angular(g) = arrays % getSource(cIdx,g) / total(g) + else + angular(g) = real(arrays % getPrevFlux(cIdx, g), defFlt) + end if + end do + else + do g = 1, nG + !angular(g) = real(arrays % getPrevFlux(cIdx, g), defFlt) + angular(g) = 0.0_defFlt + end do + end if + + ints = 0 + matIdx0 = matIdx + totalLength = ZERO + activeRay = .false. + do while (totalLength < termination) + + ! Get material and cell the ray is moving through + matIdx = r % coords % matIdx + cIdx = r % coords % uniqueID + if (matIdx0 /= matIdx) then + matIdx0 = matIdx + + ! Cache total cross section + call XSData % getTotalPointer(matIdx, total) + end if + + ! Set maximum flight distance and ensure ray is active + call checkRayLength(totalLength, dead, termination, activeRay, length) + + ! Move ray + call moveRay(r, doCache, ints, geom, length, event, cache, hitVacuum) + totalLength = totalLength + length + + ! Set new cell's position. Use half distance across cell + ! to try and avoid FP error + if (.not. arrays % wasFound(cIdx)) then + call arrays % newFound(cIdx, r % rGlobal() - length * HALF * r % dirGlobal()) + end if + + lenFlt = real(length,defFlt) + call arrays % getSourcePointer(cIdx, source) + + ! Branch for voids etc + ! TODO: Should use a better branching criterion. Maybe create it in data? + ! Standard route + if (matIdx <= XSData % getNMat()) then + + !$omp simd + do g = 1, nG + tau(g) = total(g) * lenFlt + end do + + !$omp simd + do g = 1, nG + attenuate(g) = lenFlt * expF1(tau(g)) + delta(g) = (total(g) * angular(g) - source(g)) * attenuate(g) + angular(g) = angular(g) - delta(g) + end do + + ! Accumulate to scalar flux + if (activeRay) then + + call arrays % setLock(cIdx) + call arrays % getFluxPointer(cIdx, scalar) + !$omp simd + do g = 1, nG + scalar(g) = scalar(g) + delta(g) + end do + call arrays % incrementVolume(cIdx, length) + call arrays % hitCell(cIdx) + call arrays % unsetLock(cIdx) + + end if + + ! Route for void materials + else + + ! Accumulate to scalar flux + if (activeRay) then + + len_2 = lenFlt * one_two + !$omp simd + do g = 1, nG + inc(g) = lenFlt * (angular(g) + source(g) * len_2) + end do + + call arrays % setLock(cIdx) + call arrays % getFluxPointer(cIdx, scalar) + !$omp simd + do g = 1, nG + scalar(g) = scalar(g) + inc(g) + end do + call arrays % incrementVolume(cIdx, length) + call arrays % hitCell(cIdx) + call arrays % unsetLock(cIdx) + + end if + + !$omp simd + do g = 1, nG + angular(g) = angular(g) + source(g) * lenFlt + end do + + end if + + ! Check for a vacuum hit + if (hitVacuum) then + !$omp simd + do g = 1, nG + angular(g) = 0.0_defFlt + end do + end if + + end do + + end subroutine transportSweepFlatIso + + !! + !! Transport sweep for linear isotropic sources + !! + subroutine transportSweepLinearIso(r, ints, nG, doCache, dead, termination, arrays) + type(ray), intent(inout) :: r + integer(longInt), intent(out) :: ints + integer(shortInt), intent(in) :: nG + logical(defBool), intent(in) :: doCache + real(defReal), intent(in) :: dead + real(defReal), intent(in) :: termination + class(arraysRR), pointer, intent(inout) :: arrays + class(dataRR), pointer :: XSData + class(geometryStd), pointer :: geom + integer(shortInt) :: matIdx, g, cIdx, event, matIdx0 + real(defReal) :: totalLength, length, len2_12 + real(defReal), dimension(nDim) :: mid, r0, rC, mu0, rNorm + real(defReal), dimension(matSize) :: matScore + logical(defBool) :: activeRay, hitVacuum + type(distCache) :: cache + real(defFlt) :: lenFlt, lenFlt2_2, len_2 + real(defFlt), dimension(nDim) :: muFlt, r0NormFlt, rNormFlt + real(defFlt), dimension(nG) :: delta, angular, tau, flatQ, gradQ, & + F1, F2, angular0, G0, G1, G2, H, & + xInc, yInc, zInc, inc + real(defFlt), pointer, dimension(:) :: source, total, sourceX, sourceY, sourceZ + real(defReal), pointer, dimension(:) :: scalar, scalarX, scalarY, scalarZ + character(100), parameter :: Here = 'transportSweepLinearIso (rayHandling_func.f90)' + + XSData => arrays % getDataPointer() + geom => arrays % getGeomPointer() + + ! Set initial angular flux to angle average of cell source + cIdx = r % coords % uniqueID + matIdx = r % coords % matIdx + call XSData % getTotalPointer(matIdx, total) + + ! Catch for regions with voids + ! Assumes these are defined as 'void' + ! TODO: Use a more robust criterion, as for branching later + if (matIdx <= XSData % getNMat()) then + do g = 1, nG + angular(g) = arrays % getSource(cIdx,g) / total(g) + end do + else + do g = 1, nG + angular(g) = 0.0_defFlt + end do + end if + + ints = 0 + matIdx0 = matIdx + totalLength = ZERO + activeRay = .false. + do while (totalLength < termination) + + ! Get ray entry position and direction for LS calculations + r0 = r % rGlobal() + mu0 = r % dirGlobal() + muFlt = real(mu0,defFlt) + + ! Get material and cell the ray is moving through + matIdx = r % coords % matIdx + cIdx = r % coords % uniqueID + if (matIdx0 /= matIdx) then + matIdx0 = matIdx + + ! Cache total cross section + call XSData % getTotalPointer(matIdx, total) + end if + + ! Set maximum flight distance and ensure ray is active + call checkRayLength(totalLength, dead, termination, activeRay, length) + + ! Move ray + call moveRay(r, doCache, ints, geom, length, event, cache, hitVacuum) + totalLength = totalLength + length + + ! Calculate the track centre + rC = r0 + length * HALF * mu0 + + ! Set new cell's position + if (.not. arrays % wasFound(cIdx)) call arrays % newFound(cIdx, rC) + + ! Compute the track centroid and entry point in local co-ordinates + ! Convert to floats for speed + ! If region is rarely visited, use ray's halfway point as centroid + ! Prevents numerical trouble + if (arrays % getVolume(cIdx) > ZERO) then + mid = arrays % getCentroid(cIdx) + rNorm = rC - mid + rNormFlt = real(rNorm,defFlt) + r0NormFlt = real(r0 - mid,defFlt) + else + rNorm = ZERO + rNormFlt = 0.0_defFlt + r0NormFlt = -real(HALF * mu0 * length,defFlt) + end if + + call arrays % getSourcePointer(cIdx, source) + call arrays % getSourceXYZPointers(cIdx, sourceX, sourceY, sourceZ) + + ! Calculate source terms + !$omp simd aligned(sourceX, sourceY, sourceZ) + do g = 1, nG + flatQ(g) = rNormFlt(x) * sourceX(g) + flatQ(g) = flatQ(g) + rNormFlt(y) * sourceY(g) + flatQ(g) = flatQ(g) + rNormFlt(z) * sourceZ(g) + flatQ(g) = flatQ(g) + source(g) + + gradQ(g) = muFlt(x) * sourceX(g) + gradQ(g) = gradQ(g) + muFlt(y) * sourceY(g) + gradQ(g) = gradQ(g) + muFlt(z) * sourceZ(g) + end do + + lenFlt = real(length,defFlt) + lenFlt2_2 = lenFlt * lenFlt * one_two + + ! Branch for voids etc + ! TODO: Should use a better branching criterion. Maybe create it in data? + ! Standard route + if (matIdx <= XSData % getNMat()) then + + ! Compute exponentials necessary for angular flux update + !$omp simd + do g = 1, nG + tau(g) = total(g) * lenFlt + end do + + !$omp simd + do g = 1, nG + G0(g) = expG(tau(g)) + end do + + !$omp simd + do g = 1, nG + F1(g) = 1.0_defFlt - tau(g) * G0(g) + end do + + !$omp simd + do g = 1, nG + F2(g) = 2.0_defFlt * G0(g) - F1(g) + end do + + !$omp simd + do g = 1, nG + delta(g) = (tau(g) * angular(g) - lenFlt * flatQ(g)) * F1(g) & + - gradQ(g) * F2(g) * lenFlt2_2 + end do + + ! Create an intermediate flux variable for use in LS scores + !$omp simd + do g = 1, nG + angular0(g) = angular(g) + end do + + !$omp simd + do g = 1, nG + angular(g) = angular(g) - delta(g) + end do + + ! Accumulate to scalar flux + if (activeRay) then + + ! Precompute geometric info to keep it out of the lock + len2_12 = length * length * one_twelve + matScore(xx) = length * (rNorm(x) * rNorm(x) + mu0(x) * mu0(x) * len2_12) + matScore(xy) = length * (rNorm(x) * rNorm(y) + mu0(x) * mu0(y) * len2_12) + matScore(xz) = length * (rNorm(x) * rNorm(z) + mu0(x) * mu0(z) * len2_12) + matScore(yy) = length * (rNorm(y) * rNorm(y) + mu0(y) * mu0(y) * len2_12) + matScore(yz) = length * (rNorm(y) * rNorm(z) + mu0(y) * mu0(z) * len2_12) + matScore(zz) = length * (rNorm(z) * rNorm(z) + mu0(z) * mu0(z) * len2_12) + rC = rC * length + + ! Compute necessary exponentials outside of the lock + ! Follows those in Gunow + + !$omp simd + do g = 1, nG + H(g) = F1(g) - G0(g) + end do + + !$omp simd + do g = 1, nG + G1(g) = one_two - H(g) + end do + + !$omp simd + do g = 1, nG + G2(g) = expG2(tau(g)) + end do + + ! Make some more condensed variables to help vectorisation + !$omp simd + do g = 1, nG + G1(g) = G1(g) * flatQ(g) * lenFlt + G2(g) = G2(g) * gradQ(g) * lenFlt2_2 + H(g) = H(g) * angular0(g) * tau(g) + H(g) = (G1(g) + G2(g) + H(g)) * lenFlt + flatQ(g) = flatQ(g) * lenFlt + delta(g) + end do + + !$omp simd + do g = 1, nG + xInc(g) = r0NormFlt(x) * flatQ(g) + muFlt(x) * H(g) + yInc(g) = r0NormFlt(y) * flatQ(g) + muFlt(y) * H(g) + zInc(g) = r0NormFlt(z) * flatQ(g) + muFlt(z) * H(g) + end do + + call arrays % setLock(cIdx) + + call arrays % getFluxPointer(cIdx, scalar) + call arrays % getFluxXYZPointers(cIdx, scalarX, scalarY, scalarZ) + + ! Update flux moments + !$omp simd aligned(scalar, scalarX, scalarY, scalarZ) + do g = 1, nG + scalar(g) = scalar(g) + delta(g) + scalarX(g) = scalarX(g) + xInc(g) + scalarY(g) = scalarY(g) + yInc(g) + scalarZ(g) = scalarZ(g) + zInc(g) + end do + + call arrays % incrementVolume(cIdx, length) + call arrays % incrementCentroid(cIdx, rC) + call arrays % incrementMoments(cIdx, matScore) + call arrays % hitCell(cIdx) + + call arrays % unsetLock(cIdx) + + end if + + ! Handle void cells. Assume flat source. + ! Does not accumulate geometric info. + else + + ! Accumulate to scalar flux + if (activeRay) then + + len_2 = lenFlt * one_two + !$omp simd + do g = 1, nG + inc(g) = lenFlt * (angular(g) + source(g) * len_2) + end do + + call arrays % setLock(cIdx) + call arrays % getFluxPointer(cIdx, scalar) + !$omp simd + do g = 1, nG + scalar(g) = scalar(g) + inc(g) + end do + call arrays % incrementVolume(cIdx, length) + call arrays % hitCell(cIdx) + call arrays % unsetLock(cIdx) + + end if + + !$omp simd + do g = 1, nG + angular(g) = angular(g) + source(g) * lenFlt + end do + + end if + + ! Check for a vacuum hit + if (hitVacuum) then + !$omp simd + do g = 1, nG + angular(g) = 0.0_defFlt + end do + end if + + end do + + end subroutine transportSweepLinearIso + + !! + !! Transport sweep for LIFA sources + !! + subroutine transportSweepLIFA(r, ints, nG, doCache, dead, termination, arrays) + type(ray), intent(inout) :: r + integer(longInt), intent(out) :: ints + integer(shortInt), intent(in) :: nG + logical(defBool), intent(in) :: doCache + real(defReal), intent(in) :: dead + real(defReal), intent(in) :: termination + class(arraysRR), pointer, intent(inout) :: arrays + + end subroutine transportSweepLIFA + + !! + !! Transport sweep for flat aniisotropic sources + !! + subroutine transportSweepFlatAni(r, ints, nG, doCache, dead, termination, arrays) + type(ray), intent(inout) :: r + integer(longInt), intent(out) :: ints + integer(shortInt), intent(in) :: nG + logical(defBool), intent(in) :: doCache + real(defReal), intent(in) :: dead + real(defReal), intent(in) :: termination + class(arraysRR), pointer, intent(inout) :: arrays + + end subroutine transportSweepFlatAni + + +end module rayHandling_func diff --git a/SharedModules/CMakeLists.txt b/SharedModules/CMakeLists.txt index 2a8baa4ce..e145825af 100644 --- a/SharedModules/CMakeLists.txt +++ b/SharedModules/CMakeLists.txt @@ -9,6 +9,7 @@ add_sources( ./genericProcedures.f90 ./grid_class.f90 ./energyGrid_class.f90 ./statisticalTests_func.f90 + ./exponentialRA_func.f90 ./timer_mod.f90 ./charLib_func.f90 ./openmp_func.f90 @@ -19,6 +20,7 @@ add_unit_tests( ./Tests/grid_test.f90 ./Tests/energyGrid_test.f90 ./Tests/sort_test.f90 ./Tests/statisticalTests_test.f90 + ./Tests/exponentialRA_test.f90 ./Tests/hashFunctions_test.f90 ./Tests/timer_test.f90 ./Tests/conversions_test.f90 diff --git a/SharedModules/Tests/exponentialRA_test.f90 b/SharedModules/Tests/exponentialRA_test.f90 new file mode 100644 index 000000000..6a5ace4dc --- /dev/null +++ b/SharedModules/Tests/exponentialRA_test.f90 @@ -0,0 +1,54 @@ +module exponentialRA_test + + use numPrecision + use exponentialRA_func, only : exponential + use fUnit + + implicit none + +contains + + !! + !! Test exponential rational approximation on a few values + !! ExponentialRA evaluated (1 - exp(-x)) + !! This is compared against the analytic equivalent + !! +@Test + subroutine testExponentialRA() + real(defFlt) :: x, res, resRA + real(defFlt), parameter :: tol = 1E-5 + + x = 0.5 + res = 1.0_defFlt - exp(-x) + resRA = exponential(x) + + @assertEqual(res, resRA, tol) + + x = 0.2_defFlt + res = 1.0_defFlt - exp(-x) + resRA = exponential(x) + + @assertEqual(res, resRA, tol) + + x = 0.03_defFlt + res = 1.0_defFlt - exp(-x) + resRA = exponential(x) + + @assertEqual(res, resRA, tol) + + x = 3.0_defFlt + res = 1.0_defFlt - exp(-x) + resRA = exponential(x) + + @assertEqual(res, resRA, tol) + + + x = 0.0001_defFlt + res = 1.0_defFlt - exp(-x) + resRA = exponential(x) + + @assertEqual(res, resRA, tol) + end subroutine testExponentialRA + + +end module exponentialRA_test diff --git a/SharedModules/exponentialRA_func.f90 b/SharedModules/exponentialRA_func.f90 new file mode 100644 index 000000000..a2fdcc155 --- /dev/null +++ b/SharedModules/exponentialRA_func.f90 @@ -0,0 +1,63 @@ +module exponentialRA_func + !! This module contains a function for efficiently computing an exponential + !! for use in MoC implementations. RA stands for rational approximation. + !! This is based on the implementation given in Minray: + !! github.com/jtramm/minray/blob/master/cpu_srce/flux_attenuation_kernel.c + !! I believe this originates from the M&C 2019 publication: + !! "Adding a third level of parallelism to OpenMOC" + !! + + use numPrecision + use genericProcedures, only : fatalError + + implicit none + private + + public :: exponential + + ! Numerator coefficients in rational approximation + real(defFlt), parameter :: c1n = -1.0000013559236386308, c2n = 0.23151368626911062025,& + c3n = -0.061481916409314966140, c4n = 0.0098619906458127653020, c5n = -0.0012629460503540849940, & + c6n = 0.00010360973791574984608, c7n = -0.000013276571933735820960 + + ! Denominator coefficients in rational approximation + real(defFlt), parameter :: c0d = ONE, c1d = -0.73151337729389001396, c2d = 0.26058381273536471371, & + c3d = -0.059892419041316836940, c4d = 0.0099070188241094279067, c5d = -0.0012623388962473160860, & + c6d = 0.00010361277635498731388, c7d = -0.000013276569500666698498 + +contains + + !! + !! Computes x = 1 - exp(-tau) for use in MoC calcs + !! Tau is the optical distance + !! + elemental function exponential(tau) result(x) + real(defFlt), intent(in) :: tau + real(defFlt) :: x + real(defFlt) :: den, num + + x = -tau + den = c7d + den = den * x + c6d + den = den * x + c5d + den = den * x + c4d + den = den * x + c3d + den = den * x + c2d + den = den * x + c1d + den = den * x + c0d + + num = c7n + num = num * x + c6n + num = num * x + c5n + num = num * x + c4n + num = num * x + c3n + num = num * x + c2n + num = num * x + c1n + num = num * x + + x = num / den + + end function exponential + + +end module exponentialRA_func diff --git a/SharedModules/numPrecision.f90 b/SharedModules/numPrecision.f90 index dfed315e5..cfabf9a03 100644 --- a/SharedModules/numPrecision.f90 +++ b/SharedModules/numPrecision.f90 @@ -3,6 +3,7 @@ module numPrecision private ! Variables Kind and Length parameters integer, public, parameter :: defReal = 8, & + defFlt = 4, & shortInt = 4, & longInt = 8, & defBool = 4, & @@ -19,9 +20,11 @@ module numPrecision ZERO = 0._defReal, & ONE = 1.0_defReal, & TWO = 2.0_defReal, & - TWO_PI = TWO * PI, & - SQRT_PI = sqrt(PI), & - HALF = 0.5_defReal + TWO_PI = TWO * PI, & + HALF = 0.5_defReal,& + FOUR_PI = TWO * TWO_PI, & + ONE_FOUR_PI = ONE /(FOUR_PI), & + SQRT_PI = sqrt(PI) real(defReal), public, parameter :: floatTol = 1.0e-12 !*** Should be replaced real(defReal), public, parameter :: FP_REL_TOL = 1.0e-7_defReal diff --git a/Tallies/TallyClerks/CMakeLists.txt b/Tallies/TallyClerks/CMakeLists.txt index 65c25255a..724d0cbbd 100644 --- a/Tallies/TallyClerks/CMakeLists.txt +++ b/Tallies/TallyClerks/CMakeLists.txt @@ -11,6 +11,7 @@ add_sources(./tallyClerk_inter.f90 ./dancoffBellClerk_class.f90 ./shannonEntropyClerk_class.f90 ./centreOfMassClerk_class.f90 + ./rayClerk_class.f90 ./mgXsClerk_class.f90 ) diff --git a/Tallies/TallyClerks/rayClerk_class.f90 b/Tallies/TallyClerks/rayClerk_class.f90 new file mode 100644 index 000000000..58390c08f --- /dev/null +++ b/Tallies/TallyClerks/rayClerk_class.f90 @@ -0,0 +1,289 @@ +module rayClerk_class + + use numPrecision + use tallyCodes + use universalVariables + use genericProcedures, only : fatalError + use dictionary_class, only : dictionary + use particle_class, only : particle, particleState + use outputFile_class, only : outputFile + use scoreMemory_class, only : scoreMemory + use tallyClerk_inter, only : tallyClerk, kill_super => kill + + ! Nuclear Data interface + use nuclearDatabase_inter, only : nuclearDatabase + + ! Tally Filters + use tallyFilter_inter, only : tallyFilter + use tallyFilterFactory_func, only : new_tallyFilter + + ! Tally Maps + use tallyMap_inter, only : tallyMap + use tallyMapFactory_func, only : new_tallyMap + + ! Tally Responses + use tallyResponseSlot_class, only : tallyResponseSlot + + implicit none + private + + !! + !! Estimator of reaction rates used with random ray calculations. + !! Takes a scalar flux produced at a point in space/energy and + !! produces reaction rates. + !! + !! Private Members: + !! filter -> Space to store tally Filter + !! map -> Space to store tally Map + !! response -> Array of responses + !! width -> Number of responses (# of result bins for each map position) + !! + !! Interface + !! tallyClerk Interface + !! + !! SAMPLE DICTIOANRY INPUT: + !! + !! myRayClerk { + !! type rayClerk; + !! # filter { } # + !! # map { } # + !! response (resName1 #resName2 ... #) + !! resName1 { } + !! #resNamew { run-time procedures + procedure :: reportInColl + + ! Output procedures + procedure :: display + procedure :: print + + end type rayClerk + +contains + + !! + !! Initialise clerk from dictionary and name + !! + !! See tallyClerk_inter for details + !! + subroutine init(self, dict, name) + class(rayClerk), intent(inout) :: self + class(dictionary), intent(in) :: dict + character(nameLen), intent(in) :: name + character(nameLen),dimension(:),allocatable :: responseNames + integer(shortInt) :: i + + ! Assign name + call self % setName(name) + + ! Load filetr + if( dict % isPresent('filter')) then + call new_tallyFilter(self % filter, dict % getDictPtr('filter')) + end if + + ! Load map + if( dict % isPresent('map')) then + call new_tallyMap(self % map, dict % getDictPtr('map')) + end if + + ! Get names of response dictionaries + call dict % get(responseNames,'response') + + ! Load responses + allocate(self % response(size(responseNames))) + do i=1, size(responseNames) + call self % response(i) % init(dict % getDictPtr( responseNames(i) )) + end do + + ! Set width + self % width = size(responseNames) + + end subroutine init + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(rayClerk), intent(inout) :: self + + ! Superclass + call kill_super(self) + + ! Kill and deallocate filter + if (allocated(self % filter)) then + deallocate(self % filter) + end if + + ! Kill and deallocate map + if (allocated(self % map)) then + call self % map % kill() + deallocate(self % map) + end if + + ! Kill and deallocate responses + if (allocated(self % response)) then + deallocate(self % response) + end if + + self % width = 0 + + end subroutine kill + + !! + !! Returns array of codes that represent diffrent reports + !! + !! See tallyClerk_inter for details + !! + function validReports(self) result(validCodes) + class(rayClerk),intent(in) :: self + integer(shortInt),dimension(:),allocatable :: validCodes + + validCodes = [inColl_CODE] + + end function validReports + + !! + !! Return memory size of the clerk + !! + !! See tallyClerk_inter for details + !! + elemental function getSize(self) result(S) + class(rayClerk), intent(in) :: self + integer(shortInt) :: S + + S = size(self % response) + if(allocated(self % map)) S = S * self % map % bins(0) + + end function getSize + + !! + !! Process incoming collision report + !! + !! See tallyClerk_inter for details + !! + subroutine reportInColl(self, p, xsData, mem, virtual) + class(rayClerk), intent(inout) :: self + class(particle), intent(in) :: p + class(nuclearDatabase), intent(inout) :: xsData + type(scoreMemory), intent(inout) :: mem + logical(defBool), intent(in) :: virtual + type(particleState) :: state + integer(shortInt) :: binIdx, i + integer(longInt) :: addr + real(defReal) :: scoreVal, flux + character(100), parameter :: Here = 'reportInColl (rayClerk_class.f90)' + + ! Ignores virtual collision flag + + ! Get current particle state + state = p + + ! Check if within filter + if (allocated(self % filter)) then + if (self % filter % isFail(state)) return + end if + + ! Find bin index + if (allocated(self % map)) then + binIdx = self % map % map(state) + else + binIdx = 1 + end if + + ! Return if invalid bin index + if (binIdx == 0) return + + ! Particle weight is assumed to be flux * volume + flux = p % w + + ! Calculate bin address + addr = self % getMemAddress() + self % width * (binIdx - 1) - 1 + + ! Append all bins + do i = 1, self % width + scoreVal = self % response(i) % get(p, xsData) * flux + call mem % score(scoreVal, addr + i) + + end do + + end subroutine reportInColl + + !! + !! Display convergence progress on the console + !! + !! See tallyClerk_inter for details + !! + subroutine display(self, mem) + class(rayClerk), intent(in) :: self + type(scoreMemory), intent(in) :: mem + + print *, 'rayClerk does not support display yet' + + end subroutine display + + !! + !! Write contents of the clerk to output file + !! + !! See tallyClerk_inter for details + !! + subroutine print(self, outFile, mem) + class(rayClerk), intent(in) :: self + class(outputFile), intent(inout) :: outFile + type(scoreMemory), intent(in) :: mem + real(defReal) :: val, std + integer(shortInt) :: i + integer(shortInt),dimension(:),allocatable :: resArrayShape + character(nameLen) :: name + + ! Begin block + call outFile % startBlock(self % getName()) + + ! If collision clerk has map print map information + if (allocated(self % map)) then + call self % map % print(outFile) + end if + + ! Write results. + ! Get shape of result array + if (allocated(self % map)) then + resArrayShape = [size(self % response), self % map % binArrayShape()] + else + resArrayShape = [size(self % response)] + end if + + ! Start array + name ='Res' + call outFile % startArray(name, resArrayShape) + + ! Print results to the file + do i = 1, product(resArrayShape) + call mem % getResult(val, std, self % getMemAddress() - 1 + i) + call outFile % addResult(val,std) + + end do + + call outFile % endArray() + call outFile % endBlock() + + end subroutine print + +end module rayClerk_class diff --git a/Tallies/TallyClerks/tallyClerkFactory_func.f90 b/Tallies/TallyClerks/tallyClerkFactory_func.f90 index f1277fa47..cabf60dab 100644 --- a/Tallies/TallyClerks/tallyClerkFactory_func.f90 +++ b/Tallies/TallyClerks/tallyClerkFactory_func.f90 @@ -18,6 +18,7 @@ module tallyClerkFactory_func use shannonEntropyClerk_class, only : shannonEntropyClerk use centreOfMassClerk_class, only : centreOfMassClerk use mgXsClerk_class, only : mgXsClerk + use rayClerk_class, only : rayClerk implicit none private @@ -37,6 +38,7 @@ module tallyClerkFactory_func 'shannonEntropyClerk ',& 'centreOfMassClerk ',& 'dancoffBellClerk ',& + 'rayClerk ',& 'mgXsClerk '] contains @@ -87,6 +89,9 @@ subroutine new_tallyClerk(new, dict, name) case('centreOfMassClerk') allocate(centreOfMassClerk :: new) + case('rayClerk') + allocate(rayClerk :: new) + case('mgXsClerk') allocate(mgXsClerk :: new) diff --git a/Visualisation/VTK/outputVTK_class.f90 b/Visualisation/VTK/outputVTK_class.f90 index a7c691bfe..acac05d39 100644 --- a/Visualisation/VTK/outputVTK_class.f90 +++ b/Visualisation/VTK/outputVTK_class.f90 @@ -48,14 +48,14 @@ module outputVTK_class type, public :: outputVTK logical(defBool), private :: legacy = .TRUE. integer(shortInt), dimension(2), private :: version = [3,0] - real(defReal), dimension(3), private :: corner - real(defReal), dimension(3), private :: width - integer(shortInt), dimension(3), private :: nVox - integer(shortInt), private :: nCells - integer(shortInt), private :: nOutput - real(defReal), dimension(:,:,:,:), allocatable, private :: values - character(nameLen), dimension(:), allocatable, private :: dataName - logical(defBool), dimension(:), allocatable, private :: dataReal + real(defReal), dimension(3) :: corner + real(defReal), dimension(3) :: width + integer(shortInt), dimension(3) :: nVox + integer(shortInt) :: nCells + integer(shortInt) :: nOutput + real(defReal), dimension(:,:,:,:), allocatable :: values + character(nameLen), dimension(:), allocatable :: dataName + logical(defBool), dimension(:), allocatable :: dataReal contains procedure :: init generic :: addData => addDataInt,& @@ -278,7 +278,8 @@ subroutine output(self, name) write(file,'(A)') 'DATASET STRUCTURED_POINTS' write(file,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ',self % nVox(1),' ',self % nVox(2),' ',self % nVox(3) write(file,'(A,F0.3,A,F0.3,A,F0.3)') 'ORIGIN ',self % corner(1),' ',self % corner(2),' ',self % corner(3) - write(file,'(A,F0.3,A,F0.3,A,F0.3)') 'SPACING ',self % width(1),' ',self % width(2),' ',self % width(3) + write(file,'(A,F0.3,A,F0.3,A,F0.3)') 'SPACING ',self % width(1)/self % nVox(1),' ',self % width(2)/self % nVox(2),& + ' ',self % width(3) / self % nVox(3) write(file,'(A,I0)') 'POINT_DATA ',self % nCells ! Output dataset attributes - begins with POINT_DATA or CELL_DATA followed by number of cells/points @@ -294,7 +295,7 @@ subroutine output(self, name) write(file,'(A)') 'LOOKUP_TABLE default' if (self % dataReal(l)) then - write(file,'(F0.3)') self % values(l,:,:,:) + write(file,'(F0.6)') self % values(l,:,:,:) else write(file,'(I0)') int(self % values(l,:,:,:),shortInt) endif diff --git a/Visualisation/visualiser_class.f90 b/Visualisation/visualiser_class.f90 index 44fa1f280..e3363efe5 100644 --- a/Visualisation/visualiser_class.f90 +++ b/Visualisation/visualiser_class.f90 @@ -29,9 +29,12 @@ module visualiser_class !! vizDict -> dictionary containing visualisations to be generated !! !! Interface: - !! init -> initialises visualiser - !! makeViz -> constructs requested visualisations - !! kill -> cleans up visualiser + !! init -> initialises visualiser + !! makeViz -> constructs requested visualisations + !! kill -> cleans up visualiser + !! initVTK -> initialise a VTK file for later data addition + !! addVTKData -> Add a VTK field to a file + !! finaliseVTK -> Conclude writing to a VTK and output !! !! Sample dictionary input: !! viz{ @@ -46,12 +49,16 @@ module visualiser_class character(nameLen), private :: name class(geometry), pointer, private :: geom => null() type(dictionary), private :: vizDict + type(outputVTK), private :: vtk contains procedure :: init procedure :: makeViz procedure :: kill procedure, private :: makeVTK procedure, private :: makeBmpImg + procedure :: initVTK + procedure :: addVTKData + procedure :: finaliseVTK end type contains @@ -70,14 +77,19 @@ module visualiser_class !! Result: !! Initialised visualiser !! - subroutine init(self, geom, vizDict) - class(visualiser), intent(inout) :: self - class(geometry), pointer, intent(inout) :: geom - class(dictionary), intent(in) :: vizDict - character(:), allocatable :: string + subroutine init(self, geom, vizDict, str) + class(visualiser), intent(inout) :: self + class(geometry), pointer, intent(inout) :: geom + class(dictionary), intent(in) :: vizDict + character(nameLen), intent(in), optional :: str + character(:), allocatable :: string ! Obtain file name - call getInputFile(string) + if (present(str)) then + string = str + else + call getInputFile(string) + end if self % name = string ! Point to geometry @@ -173,9 +185,12 @@ subroutine makeVTK(self, dict) ! Obtain geometry data call dict % get(corner, 'corner') call dict % get(width, 'width') - center = corner + width/TWO call dict % get(nVox, 'vox') + ! Avoid uninitialised warning + allocate(center(size(corner))) + center = corner + width/TWO + if (size(corner) /= 3) then call fatalError(here,'Voxel plot requires corner to have 3 values') endif @@ -198,6 +213,17 @@ subroutine makeVTK(self, dict) end subroutine makeVTK + !! + !! Output an already constructed VTK and clean up + !! + subroutine finaliseVTK(self) + class(visualiser), intent(inout) :: self + + call self % vtk % output(self % name) + !call self % vtk % kill() + + end subroutine finaliseVTK + !! !! Generate a BMP slice image of the geometry !! @@ -395,5 +421,124 @@ elemental function uniqueIDColour(uniqueID) result(colour) end function uniqueIDColour + !! + !! Initialise a VTK output with data addition after + !! + !! Creates the VTK file corresponding to the contents of vizDict but does not + !! output it. Allows more complex fields to be plotted, e.g., based on results. + !! Accepts the first VTK dictionary it finds. + !! + !! VTK dictionary is the standard dictionary used above. + !! + !! TODO: VTK output is placed in a input filename appended by '.vtk' extension. + !! This prevents multiple VTK visualistions (due to overriding). Might also become + !! weird for input files with extension e.g. 'input.dat'. + !! DEMAND USER TO GIVE OUTPUT NAME + !! + subroutine initVTK(self) + class(visualiser), intent(inout) :: self + character(nameLen),dimension(:), allocatable :: keysArr + integer(shortInt) :: i + character(nameLen) :: vizType + logical(defBool) :: vtkFound + class(dictionary), pointer :: dict + integer(shortInt), dimension(:,:,:), allocatable:: voxelMat + real(defReal), dimension(3) :: corner ! corner of the mesh + real(defReal), dimension(3) :: center ! center of the mesh + real(defReal), dimension(3) :: width ! corner of the mesh + real(defReal), dimension(:), allocatable :: temp ! temporary vector + integer(shortInt), dimension(:), allocatable :: nVox ! number of mesh voxels + character(nameLen) :: what + character(nameLen) :: here ='initVTK (visualiser_class.f90)' + + ! Loop through each sub-dictionary and generate visualisation + ! (if the visualisation method is available) + call self % vizDict % keys(keysArr,'dict') + vtkFound = .FALSE. + do i=1,size(keysArr) + dict => self % vizDict % getDictPtr(keysArr(i)) + call dict % get(vizType,'type') + if (vizType == 'vtk') then + vtkFound = .TRUE. + exit + end if + end do + + if (.NOT. vtkFound) call fatalError(Here,'No VTK data provided in dictionary') + + call self % vtk % init(dict) + + ! Identify whether plotting 'material' or 'cellID' + call dict % getOrDefault(what, 'what', 'material') + + ! Obtain geometry data + call dict % get(temp, 'corner') + if (size(temp) /= 3) then + call fatalError(Here, "'center' must have size 3. Has: "//numToChar(size(temp))) + end if + corner = temp + + call dict % get(temp, 'width') + if (size(temp) /= 3) then + call fatalError(Here, "'width' must have size 3. Has: "//numToChar(size(temp))) + end if + width = temp + + center = corner + width/TWO + call dict % get(nVox, 'vox') + + if (size(corner) /= 3) then + call fatalError(here,'Voxel plot requires corner to have 3 values') + end if + if (size(width) /= 3) then + call fatalError(here,'Voxel plot requires width to have 3 values') + end if + if (size(nVox) /= 3) then + call fatalError(here,'Voxel plot requires vox to have 3 values') + end if + allocate(voxelMat(nVox(1), nVox(2), nVox(3))) + + ! Have geometry obtain data + call self % geom % voxelPlot(voxelMat, center, what, width) + + ! VTK data set will use 'what' variable as a name + call self % vtk % addData(voxelMat, what) + + end subroutine initVTK + + !! + !! Add additional data to a VTK file based on an array of values. + !! The array index will correspond to either the material or uniqueID at + !! a given position in the geometry. + !! + !! Assumes the VTK has already been initialised and uses the first VTK + !! set of values, i.e., index 1, to check which values to add. + !! + subroutine addVTKData(self,dataArray, dataName) + class(visualiser), intent(inout) :: self + real(defReal), dimension(:), intent(in) :: dataArray + character(nameLen), intent(in) :: dataName + integer(shortInt) :: i + integer(shortInt), save :: j, k + real(defReal), dimension(:,:,:), allocatable :: values + integer(shortInt), dimension(3) :: nVox + !$omp threadprivate(j, k) + + nVox = self % vtk % nVox + allocate(values(nVox(1),nVox(2),nVox(3))) + !$omp parallel do schedule(static) + do i = 1, self % vtk % nVox(1) + do j = 1, self % vtk % nVox(2) + do k = 1, self % vtk % nVox(3) + values(i,j,k) = dataArray(int(self % vtk % values(1,i,j,k))) + end do + end do + end do + !$omp end parallel do + + call self % vtk % addDataReal(values, dataName) + + end subroutine addVTKData + end module visualiser_class diff --git a/docs/User Manual.rst b/docs/User Manual.rst index 85cd8a672..3f1300d81 100644 --- a/docs/User Manual.rst +++ b/docs/User Manual.rst @@ -143,6 +143,134 @@ Example: :: geometry { } nuclearData { } +randomRayPhysicsPackage +####################### + +randomRayPhysicsPackage, used for k-eigenvalue random ray calculations. +Necessarily a multigroup calculation. + +* pop: number of rays used per cycle +* active: number of active cycles +* inactive: number of inactive cycles +* dead: dead length of each ray [cm] +* termination: total ray length [cm] +* volPolicy (*optional*): determines how volumes are estimated in different parts of + the geometry. 1 corresponds to the simulation-average volume estimator. + 2 corresponds to the naive/cycle-wise volume estimator. 3 corresponds to + the hybrid volume estimator, using 1 in all regions except those with + inhomogeneous sources. 3 is the default option. +* missPolicy (*optional*): determines how misses are handled in different parts of the + geometry. 1 corresponds to setting the local flux equal to the source divided + by SigmaT. 2 corresponds to setting the local flux equal to the previous + iteration flux estimate. 3 is a hybrid, using the source/SigmaT treatment + in all regions except those with an inhomogeneous source. 3 is the default option. +* rho (*optional*): a stabilisation factor for when diagonal elements of the scattering + matrix are negative. The larger the value of rho, the more stable, but + convergence may be slowed significantly. A value of 1 removes any possible + negative sources. +* lin (*optional*): a logical flag to switch linear sources on. Off by default. Can allow + significant mesh coarsening for the same accuracy. +* 2d (*optional*): a logical flag to tell the simulation that the calculation is + essentially 2D. This can greatly stabilise linear source calculations in 2D systems. + Default is off, i.e., 3D. +* plot (*optional*): provided there is a VTK output in the visualiser, outputs most + information to be viewed in paraview. May add signficant runtime to the + finalisation of the calculation for large simulations. The VTK output + should have ``what`` set to ``uniqueID``. +* cache (*optional*): flag to switch on distance caching. Can significantly accelerate + few group random ray calculations. Off by default. +* keff (*optional*): initial guess value of keff. +* XSdata: keyword to the name of the nuclearDataHandle used +* seed (*optional*): initial seed for the pseudo random number generator +* outputFile (*optional*, default = 'output'): name of the output file +* outputFormat (*optional*, default = ``asciiMATLAB``): type of output file. + Choices are ``asciiMATLAB`` and ``asciiJSON`` + +Example: :: + + type randomRayPhysicsPackage; + pop 4000; + active 800; + inactive 600; + dead 20; + termination 220; + rho 0.6; + lin 0; + XSdata mgData; + seed -244654; + outputFile C5G7; + outputFormat asciiJSON; + + tally { } + geometry { } + nuclearData { } + +fixedSourceRRPhysicsPackage +########################### + +fixedSourceRRPhysicsPackage, used for fixed/external source random ray calculations. +Necessarily a multigroup calculation. Sources are isotropic material sources. +There can be as many unique sources as materials in the calculation. + +* pop: number of rays used per cycle +* active: number of active cycles +* inactive: number of inactive cycles +* dead: dead length of each ray [cm] +* termination: total ray length [cm] +* volPolicy (*optional*): determines how volumes are estimated in different parts of + the geometry. 1 corresponds to the simulation-average volume estimator. + 2 corresponds to the naive/cycle-wise volume estimator. 3 corresponds to + the hybrid volume estimator, using 1 in all regions except those with + inhomogeneous sources. 3 is the default option. +* missPolicy (*optional*): determines how misses are handled in different parts of the + geometry. 1 corresponds to setting the local flux equal to the source divided + by SigmaT. 2 corresponds to setting the local flux equal to the previous + iteration flux estimate. 3 is a hybrid, using the source/SigmaT treatment + in all regions except those with an inhomogeneous source. 3 is the default option. +* rho (*optional*): a stabilisation factor for when diagonal elements of the scattering + matrix are negative. The larger the value of rho, the more stable, but + convergence may be slowed significantly. A value of 1 removes any possible + negative sources. +* lin (*optional*): a logical flag to switch linear sources on. Off by default. Can allow + significant mesh coarsening for the same accuracy. +* 2d (*optional*): a logical flag to tell the simulation that the calculation is + essentially 2D. This can greatly stabilise linear source calculations in 2D systems. + Default is off, i.e., 3D. +* plot (*optional*): provided there is a VTK output in the visualiser, outputs most + information to be viewed in paraview. May add signficant runtime to the + finalisation of the calculation for large simulations. The VTK output + should have ``what`` set to ``uniqueID``. +* cache (*optional*): flag to switch on distance caching. Can significantly accelerate + few group random ray calculations. Off by default. +* keff (*optional*): Scaling factor for fission. Does not change during the calculation. Default 1. +* XSdata: keyword to the name of the nuclearDataHandle used +* seed (*optional*): initial seed for the pseudo random number generator +* outputFile (*optional*, default = 'output'): name of the output file +* outputFormat (*optional*, default = ``asciiMATLAB``): type of output file. + Choices are ``asciiMATLAB`` and ``asciiJSON`` +* source: a dictionary containing the name of each source material (corresponding to those in the + database) followed by a list of strengths in each energy group. + +Example: :: + + type fixedSourceRRPhysicsPackage; + pop 4000; + active 800; + inactive 600; + dead 20; + termination 220; + rho 0.6; + lin 0; + XSdata mgData; + seed -244654; + outputFile dogLeg; + outputFormat asciiJSON; + source { mySourceMat (3.2 0.0 1.6);} + + tally { } + geometry { } + nuclearData { } + vizPhysicsPackage ################# @@ -656,6 +784,30 @@ Example: :: uni3 { id 3; type pinUniverse; radii (0.2 1.0 1.1 1.3 0.0); fills (u<1> fuel void clad coolant); } +* azimPinUniverse, composed of infinite co-centred cylinders, divided azimuthally. + Can have either all radial regions with the same number of azimuthal divisions or else + each with its own number of divisions. All azimuthal divisions must be a multiple of 4. + For now, all fills in the same radial region but different azimuthal regions must be identical. + + - radii: array containing the radii of the co-centred cylinders. There + must be an entry equal to 0.0, which corresponds to the outermost + layer, which is infinite. [cm] + - naz: number of azimuthal divisions, imposed uniformly across all radial regions. + - nazR: number of azimuthal divisions varying by radial region. Given as a list. Mutually + exclusive with ``naz``. + - fills: array containing the names or ids of what is inside each cylindrical + shell. The order of the fills must correspond to the order of the corresponding + radii. An entry can be a material name, the keyword ``void``, or a ``u``, + where ``id`` is the id of a defined universe + - origin (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the + origin of the universe. [cm] + - rotation (*optional*, default = (0.0 0.0 0.0)): (x y z) array with the + rotation angles in degrees applied to the universe. [°] + +Example: :: + + uni3 { id 3; type pinUniverse; radii (0.2 1.0 1.1 1.3 0.0); fills (u<1> fuel void clad coolant); } + * latUniverse, cartesian lattice of constant pitch - shape: (x y z) array of integers, stating the numbers of x, y and z @@ -1119,6 +1271,18 @@ Example: :: fissionMat { type simpleFMClerk; map { } } } +* rayClerk, for estimating fluxes and reaction rates using random ray. Has only been tested + with macroResponse and fluxResponse. Can map over space, energy group, and material. Uses + the centroid of cells obtained during random ray transport, so spatial maps should be used + with some caution. + + - response: defines which response function has to be used for this tally. Note + that more than one response can be defined per each tally + - map (*optional*): contains a dictionary with the ``tallyMap`` definition, + that defines the domains of integration of each tally + - filter (*optional*): can filter out particles with certain properties, + preventing them from scoring results. Filters have not been tested with rayClerk. + Tally Responses ###############