From 2f18b62bc23a02d2b8c7083dfc53deeee3367847 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 12 Nov 2021 11:37:57 +0000 Subject: [PATCH 001/373] Duplicated 'mgNeutronData' changed all 'Neutron' to 'IMC', removed all references to fission --- NuclearData/mgIMCData/CMakeLists.txt | 8 + .../Tests/baseMgNeutronDatabase_iTest.f90 | 303 ++++++++++++++ .../baseMgIMC/baseMgIMCDatabase_class.f90 | 374 ++++++++++++++++++ .../baseMgIMC/baseMgIMCMaterial_class.f90 | 299 ++++++++++++++ NuclearData/mgIMCData/mgIMCDatabase_inter.f90 | 51 +++ NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 142 +++++++ 6 files changed, 1177 insertions(+) create mode 100644 NuclearData/mgIMCData/CMakeLists.txt create mode 100644 NuclearData/mgIMCData/baseMgIMC/Tests/baseMgNeutronDatabase_iTest.f90 create mode 100644 NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 create mode 100644 NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 create mode 100644 NuclearData/mgIMCData/mgIMCDatabase_inter.f90 create mode 100644 NuclearData/mgIMCData/mgIMCMaterial_inter.f90 diff --git a/NuclearData/mgIMCData/CMakeLists.txt b/NuclearData/mgIMCData/CMakeLists.txt new file mode 100644 index 000000000..04d7a738f --- /dev/null +++ b/NuclearData/mgIMCData/CMakeLists.txt @@ -0,0 +1,8 @@ +# Add source files for compilation +add_sources(./mgNeutronMaterial_inter.f90 + ./mgNeutronDatabase_inter.f90 + ./baseMgNeutron/baseMgNeutronMaterial_class.f90 + ./baseMgNeutron/baseMgNeutronDatabase_class.f90) + +# Add tests +add_integration_tests(./baseMgNeutron/Tests/baseMgNeutronDatabase_iTest.f90) \ No newline at end of file diff --git a/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgNeutronDatabase_iTest.f90 b/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgNeutronDatabase_iTest.f90 new file mode 100644 index 000000000..13aa797d0 --- /dev/null +++ b/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgNeutronDatabase_iTest.f90 @@ -0,0 +1,303 @@ +module baseMgNeutronDatabase_iTest + + use numPrecision + use endfConstants + use pFUnit_mod + use dictionary_class, only : dictionary + use dictParser_func, only : charToDict + use particle_class, only : particle + + ! Nuclear Data Objects & Interfaces + use baseMgNeutronDatabase_class, only : baseMgNeutronDatabase, baseMgNeutronDatabase_CptrCast, & + baseMgNeutronDatabase_TptrCast + use baseMgNeutronMaterial_class, only : baseMgNeutronMaterial, baseMgNeutronMaterial_CptrCast, & + baseMgNeutronMaterial_TptrCast + use fissionMG_class, only : fissionMG, fissionMG_TptrCast + use multiScatterMG_class, only : multiScatterMG, multiScatterMG_CptrCast, & + multiScatterMG_TptrCast + use multiScatterP1MG_class, only : multiScatterP1MG, multiScatterP1MG_TptrCast + use materialMenu_mod, only : mm_init => init, mm_kill => kill + use nuclearDatabase_inter, only : nuclearDatabase + use materialHandle_inter, only : materialHandle + use nuclideHandle_inter, only : nuclideHandle + use neutronXsPackages_class, only : neutronMacroXSs + use reactionHandle_inter, only : reactionHandle + + + + implicit none + + ! Material definitions + character(*),parameter :: MAT_INPUT_STR = " & + mat1 { temp 273; & + composition { & + 1001.03 5.028E-02; & + 8016.03 2.505E-02; & + } & + xsFile ./IntegrationTestFiles/mgMat1; & + } & + mat2 { temp 1; & + composition { & + 92233.03 2.286E-02; & + 8016.03 4.572E-02; & + } & + xsFile ./IntegrationTestFiles/mgMat2; & + }" + + +contains + + !! + !! Monster test to build and verify data in baseMgNeutronDatabase with P0 scattering + !! +@Test + subroutine testBaseMgNeutronDatabaseWithP0() + type(baseMgNeutronDatabase), target :: database + class(nuclearDatabase), pointer :: data_ptr + type(dictionary) :: databaseDef + type(dictionary) :: matMenuDict + type(particle) :: p + type(neutronMacroXSs) :: xss + type(baseMgNeutronMaterial),pointer :: mat + class(baseMgNeutronMaterial),pointer :: matClass + class(reactionHandle), pointer :: reac + real(defReal),parameter :: TOL = 1.0E-6_defReal + + + data_ptr => database + + ! Load materialMenu + call charToDict(matMenuDict, MAT_INPUT_STR) + call mm_init(matMenuDict ) + + ! Build database + call databaseDef % init(1) + call databaseDef % store('PN','P0') + call database % init(databaseDef, data_ptr, silent = .true.) + call database % activate([1]) + + ! Varify number of groups + @assertEqual(4, database % nGroups()) + + ! Test getting Transport XS + p % G = 1 + @assertEqual(2.1_defReal, database % getTransMatXS(p, 1), TOL) + + ! Test getting Total XS + p % G = 1 + @assertEqual(3.1_defReal, database % getTotalMatXS(p, 2), TOL) + + p % G = 3 + @assertEqual(6.0_defReal, database % getTotalMatXS(p, 1), TOL) + + ! Test getting Majorant + p % G = 1 + @assertEqual(2.1_defReal, database % getMajorantXS(p), TOL) + + + ! Get a material and verify macroXSS + mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(2)) + @assertTrue(associated(mat), "Type Ptr Cast has failed") + call mat % getMacroXSs(xss, 1, p % pRNG) + + ! Check that is fissile + @assertTrue(mat % isFissile(), "Is not fissile but should") + + @assertEqual(3.1_defReal, xss % total, TOL) + @assertEqual(ZERO, xss % elasticScatter, TOL) + @assertEqual(1.1_defReal, xss % inelasticScatter, TOL) + @assertEqual(1.0_defReal, xss % capture, TOL) + @assertEqual(1.0_defReal, xss % fission, TOL) + @assertEqual(2.3_defReal, xss % nuFission, TOL) + + matClass => baseMgNeutronMaterial_CptrCast(database % getMaterial(1)) + @assertTrue(associated(matClass), "Type Ptr Cast has failed") + call matClass % getMacroXSs(xss, 4, p % pRNG) + + @assertFalse(matClass % isFissile(), "Is fissile but should not") + + @assertEqual(7.1_defReal, xss % total, TOL) + @assertEqual(ZERO, xss % elasticScatter, TOL) + @assertEqual(3.1_defReal, xss % inelasticScatter, TOL) + @assertEqual(4.0_defReal, xss % capture, TOL) + @assertEqual(0.0_defReal, xss % fission, TOL) + @assertEqual(0.0_defReal, xss % nuFission, TOL) + + ! Get some invalid Materials + mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(0)) + @assertFalse(associated(mat)) + + mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(-2)) + @assertFalse(associated(mat)) + + mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(3)) + @assertFalse(associated(mat)) + + ! Get Fission reaction and verify type + reac => fissionMG_TptrCast(database % getReaction(macroFission, 1)) + @assertFalse(associated(reac), "Pointer for the mission reaction is not null") + + reac => fissionMG_TptrCast(database % getReaction(macroFission, 2)) + @assertTrue(associated(reac), "Pointer fission reaction is wrong type or null") + + ! Get Scattering reaction and verify type + reac => multiScatterMG_TptrCast(database % getReaction(macroIEScatter, 1)) + @assertTrue(associated(reac), "Wrong type of scattering reaction") + + ! Get some invalid reactions + reac => database % getReaction(anyScatter, 0) + @assertFalse(associated(reac)) + + reac => database % getReaction(anyScatter, -1) + @assertFalse(associated(reac)) + + reac => database % getReaction(anyScatter, 3) + @assertFalse(associated(reac)) + + reac => database % getReaction(anyCapture, 1) + @assertFalse(associated(reac)) + + ! **** Note that anyFission is not present ! + reac => database % getReaction(anyFission, 2) + @assertFalse(associated(reac)) + + ! Test getting nuclide + @assertFalse(associated(database % getNuclide(1))) + + ! Clean up + call database % kill() + call mm_kill() + call matMenuDict % kill() + call databaseDef % kill() + + end subroutine testBaseMgNeutronDatabaseWithP0 + + !! + !! Monster test to build and verify data in baseMgNeutronDatabase with P1 scattering + !! *Copy and pasted from the above with only the type of scattering changed + !! +@Test + subroutine testBaseMgNeutronDatabaseWithP1() + type(baseMgNeutronDatabase), target :: database + class(nuclearDatabase), pointer :: data_ptr + type(dictionary) :: databaseDef + type(dictionary) :: matMenuDict + type(particle) :: p + type(neutronMacroXSs) :: xss + type(baseMgNeutronMaterial),pointer :: mat + class(baseMgNeutronMaterial),pointer :: matClass + class(reactionHandle), pointer :: reac + real(defReal),parameter :: TOL = 1.0E-6_defReal + + + data_ptr => database + + ! Load materialMenu + call charToDict(matMenuDict, MAT_INPUT_STR) + call mm_init(matMenuDict ) + + ! Build database + call databaseDef % init(1) + call databaseDef % store('PN','P1') + call database % init(databaseDef, data_ptr, silent = .true.) + call database % activate([1]) + + ! Varify number of groups + @assertEqual(4, database % nGroups()) + + ! Test getting Transport XS + p % G = 1 + @assertEqual(2.1_defReal, database % getTransMatXS(p, 1), TOL) + + ! Test getting Total XS + p % G = 1 + @assertEqual(3.1_defReal, database % getTotalMatXS(p, 2), TOL) + + p % G = 3 + @assertEqual(6.0_defReal, database % getTotalMatXS(p, 1), TOL) + + ! Test getting Majorant + p % G = 1 + @assertEqual(2.1_defReal, database % getMajorantXS(p), TOL) + + + ! Get a material and verify macroXSS + mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(2)) + @assertTrue(associated(mat), "Type Ptr Cast has failed") + call mat % getMacroXSs(xss, 1, p % pRNG) + + ! Check that is fissile + @assertTrue(mat % isFissile(), "Is not fissile but should") + + @assertEqual(3.1_defReal, xss % total, TOL) + @assertEqual(ZERO, xss % elasticScatter, TOL) + @assertEqual(1.1_defReal, xss % inelasticScatter, TOL) + @assertEqual(1.0_defReal, xss % capture, TOL) + @assertEqual(1.0_defReal, xss % fission, TOL) + @assertEqual(2.3_defReal, xss % nuFission, TOL) + + matClass => baseMgNeutronMaterial_CptrCast(database % getMaterial(1)) + @assertTrue(associated(matClass), "Type Ptr Cast has failed") + call matClass % getMacroXSs(xss, 4, p % pRNG) + + @assertFalse(matClass % isFissile(), "Is fissile but should not") + + @assertEqual(7.1_defReal, xss % total, TOL) + @assertEqual(ZERO, xss % elasticScatter, TOL) + @assertEqual(3.1_defReal, xss % inelasticScatter, TOL) + @assertEqual(4.0_defReal, xss % capture, TOL) + @assertEqual(0.0_defReal, xss % fission, TOL) + @assertEqual(0.0_defReal, xss % nuFission, TOL) + + ! Get some invalid Materials + mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(0)) + @assertFalse(associated(mat)) + + mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(-2)) + @assertFalse(associated(mat)) + + mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(3)) + @assertFalse(associated(mat)) + + ! Get Fission reaction and verify type + reac => fissionMG_TptrCast(database % getReaction(macroFission, 1)) + @assertFalse(associated(reac), "Pointer for the mission reaction is not null") + + reac => fissionMG_TptrCast(database % getReaction(macroFission, 2)) + @assertTrue(associated(reac), "Pointer fission reaction is wrong type or null") + + ! Get Scattering reaction and verify type + reac => multiScatterP1MG_TptrCast(database % getReaction(macroIEScatter, 1)) + @assertTrue(associated(reac), "Wrong type of scattering reaction") + + ! Get some invalid reactions + reac => database % getReaction(anyScatter, 0) + @assertFalse(associated(reac)) + + reac => database % getReaction(anyScatter, -1) + @assertFalse(associated(reac)) + + reac => database % getReaction(anyScatter, 3) + @assertFalse(associated(reac)) + + reac => database % getReaction(anyCapture, 1) + @assertFalse(associated(reac)) + + ! **** Note that anyFission is not present ! + reac => database % getReaction(anyFission, 2) + @assertFalse(associated(reac)) + + ! Test getting nuclide + @assertFalse(associated(database % getNuclide(1))) + + ! Clean up + call database % kill() + call mm_kill() + call matMenuDict % kill() + call databaseDef % kill() + + end subroutine testBaseMgNeutronDatabaseWithP1 + + + +end module baseMgNeutronDatabase_iTest diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 new file mode 100644 index 000000000..103e8e23f --- /dev/null +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -0,0 +1,374 @@ +module baseMgIMCDatabase_class + + use numPrecision + use endfConstants + use genericProcedures, only : fatalError, numToChar + use particle_class, only : particle + use charMap_class, only : charMap + use dictionary_class, only : dictionary + use dictParser_func, only : fileToDict + + ! Nuclear Data Interfaces + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase + use materialHandle_inter, only : materialHandle + use nuclideHandle_inter, only : nuclideHandle + use reactionHandle_inter, only : reactionHandle + use materialMenu_mod, only : materialItem, mm_getMatPtr => getMatPtr, mm_nMat => nMat, & + mm_nameMap => nameMap + + ! baseMgIMC Objects + use baseMgIMCMaterial_class, only : baseMgIMCMaterial + + implicit none + private + + !! + !! Public Pointer Cast + !! + public :: baseMgIMCDatabase_TptrCast + public :: baseMgIMCDatabase_CptrCast + + !! + !! Basic type of MG nuclear Data for neutrons + !! + !! All materials in aproblem are baseMgMaterials. See its documentation for + !! details on how the physics is handled + !! + !! Public Members: + !! mats -> array containing all defined materials (by matIdx) + !! activeMats -> list of matIdxs of materials active in the problem + !! + !! Interface: + !! nuclearDatabase interface + !! + type, public, extends(mgIMCDatabase) :: baseMgIMCDatabase + type(baseMgIMCMaterial), dimension(:), pointer :: mats => null() + integer(shortInt), dimension(:), allocatable :: activeMats + integer(shortInt) :: nG = 0 + + contains + ! Superclass Interface + procedure :: getTransMatXS + procedure :: getTotalMatXS + procedure :: getMajorantXS + procedure :: matNamesMap + procedure :: getMaterial + procedure :: getNuclide + procedure :: getReaction + procedure :: kill + procedure :: init + procedure :: activate + + ! Local interface + procedure :: nGroups + + end type baseMgIMCDatabase + +contains + + !! + !! Get Transport XS given a particle + !! + !! See nuclearDatabase documentation for details + !! + !! Note: + !! DOES NOT check if particle is MG. Will refer to G in the particle and give error + !! if the value is invalid + !! + !! Sample input dictionary: + !! nucData { + !! type baseMgIMCDatabase; + !! PN P0; // or P1 + !! } + !! + function getTransMatXS(self, p, matIdx) result(xs) + class(baseMgIMCDatabase), intent(inout) :: self + class(particle), intent(in) :: p + integer(shortInt), intent(in) :: matIdx + real(defReal) :: xs + + xs = self % getTotalMatXS(p, matIdx) + + end function getTransMatXS + + !! + !! Get Total XS given a particle + !! + !! See nuclearDatabase documentation for details + !! + !! Note: + !! DOES NOT check if particle is MG. Will refer to G in the particle and give error + !! if the value is invalid + !! + function getTotalMatXS(self, p, matIdx) result(xs) + class(baseMgIMCDatabase), intent(inout) :: self + class(particle), intent(in) :: p + integer(shortInt), intent(in) :: matIdx + real(defReal) :: xs + + xs = self % mats(matIdx) % getTotalXS(p % G, p % pRNG) + + end function getTotalMatXS + + !! + !! Get Majorant XS given a particle + !! + !! See nuclearDatabase documentation for details + !! + !! Note: + !! DOES NOT check if particle is MG. Will refer to G in the particle and give error + !! if the value is invalid + !! + function getMajorantXS(self, p) result(xs) + class(baseMgIMCDatabase), intent(inout) :: self + class(particle), intent(in) :: p + real(defReal) :: xs + integer(shortInt) :: i, idx + + xs = ZERO + do i=1,size(self % activeMats) + idx = self % activeMats(i) + xs = max(xs, self % getTotalMatXS(p, idx)) + end do + + end function getMajorantXS + + !! + !! Return pointer to material names map + !! + !! See nuclearDatabase documentation for details + !! + function matNamesMap(self) result(map) + class(baseMgIMCDatabase), intent(in) :: self + type(charMap), pointer :: map + + map => mm_nameMap + + end function matNamesMap + + !! + !! Return pointer to a material in the database + !! + !! See nuclearDatabase documentation for details + !! + function getMaterial(self, matIdx) result(mat) + class(baseMgIMCDatabase), intent(in) :: self + integer(shortInt), intent(in) :: matIdx + class(materialHandle), pointer :: mat + + if(matIdx < 1 .or. matIdx > size(self % mats)) then + mat => null() + else + mat => self % mats(matIdx) + end if + + end function getMaterial + + !! + !! Return pointer to a nuclide in the database + !! + !! See nuclearDatabase documentation for details + !! + !! Note: + !! This database has no nucldie. Returns NULL always! + !! + function getNuclide(self, nucIdx) result(nuc) + class(baseMgIMCDatabase), intent(in) :: self + integer(shortInt), intent(in) :: nucIdx + class(nuclideHandle), pointer :: nuc + + nuc => null() + + end function getNuclide + + !! + !! Return pointer to a reaction + !! + !! See nuclearDatabase documentation for details + !! + function getReaction(self, MT, idx) result(reac) + class(baseMgIMCDatabase), intent(in) :: self + integer(shortInt), intent(in) :: MT + integer(shortInt), intent(in) :: idx + class(reactionHandle), pointer :: reac + + ! Catch Invalid index + if(idx < 1 .or. idx > size(self % mats)) then + reac => null() + return + end if + + ! Select correct reaction + select case(MT) + + case(macroIEScatter) + reac => self % mats(idx) % scatter + + case default + reac => null() + + end select + + end function getReaction + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(baseMgIMCDatabase), intent(inout) :: self + + if(associated(self % mats)) then + call self % mats % kill() + deallocate(self % mats) + end if + + if(allocated(self % activeMats)) deallocate (self % activeMats) + self % nG = 0 + + end subroutine kill + + !! + !! Initialise Database from dictionary and pointer to self + !! + !! See nuclearDatabase documentation for details + !! + subroutine init(self, dict, ptr, silent) + class(baseMgIMCDatabase), target,intent(inout) :: self + class(dictionary), intent(in) :: dict + class(nuclearDatabase), pointer,intent(in) :: ptr + logical(defBool), intent(in), optional :: silent + logical(defBool) :: loud + integer(shortInt) :: i, nMat + type(materialItem), pointer :: matDef + character(pathLen) :: path + character(nameLen) :: scatterKey + type(dictionary) :: tempDict + character(100), parameter :: Here = 'init (baseMgIMCDatabase_class.f90)' + + ! Prevent reallocations + call self % kill() + + ! Set build console output flag + if(present(silent)) then + loud = .not.silent + else + loud = .true. + end if + + ! Find number of materials and allocate space + nMat = mm_nMat() + + allocate(self % mats(nMat)) + + ! Read scatterKey + call dict % get(scatterKey, 'PN') + + ! Build materials + do i=1,nMat + ! Get Path to the xsFile + matDef => mm_getMatPtr(i) + call matDef % extraInfo % get(path,'xsFile') + + ! Print status + if(loud) then + print '(A)', "Building material: " // trim(matDef % name) // " From: " // trim(path) + end if + + ! Load dictionary + call fileToDict(tempDict, path) + call self % mats(i) % init(tempDict, scatterKey) + + end do + + ! Load and verify number of groups + self % nG = self % mats(1) % nGroups() + do i=2,nMat + if(self % nG /= self % mats(i) % nGroups()) then + call fatalError(Here,'Inconsistant # of groups in materials in matIdx'//numToChar(i)) + end if + end do + + end subroutine init + + !! + !! Activate this nuclearDatabase + !! + !! See nuclearDatabase documentation for details + !! + subroutine activate(self, activeMat) + class(baseMgIMCDatabase), intent(inout) :: self + integer(shortInt), dimension(:), intent(in) :: activeMat + + if(allocated(self % activeMats)) deallocate(self % activeMats) + self % activeMats = activeMat + + end subroutine activate + + !! + !! Return number of energy groups in this database + !! + !! Args: + !! None + !! + !! Errors: + !! None + !! + pure function nGroups(self) result(nG) + class(baseMgIMCDatabase), intent(in) :: self + integer(shortInt) :: nG + + nG = self % nG + + end function nGroups + + !! + !! Cast nuclearDatabase pointer to baseMgIMCDatabase type pointer + !! + !! Args: + !! source [in] -> source pointer of class nuclearDatabase + !! + !! Result: + !! Null if source is not of baseMgIMCDatabase type + !! Target points to source if source is baseMgIMCDatabasetype + !! + pure function baseMgIMCDatabase_TptrCast(source) result(ptr) + class(nuclearDatabase), pointer, intent(in) :: source + type(baseMgIMCDatabase), pointer :: ptr + + select type(source) + type is(baseMgIMCDatabase) + ptr => source + + class default + ptr => null() + end select + + end function baseMgIMCDatabase_TptrCast + + !! + !! Cast nuclearDatabase pointer to baseMgIMCDatabase class pointer + !! + !! Args: + !! source [in] -> source pointer of class nuclearDatabase + !! + !! Result: + !! Null if source is not of baseMgIMCDatabase class + !! Target points to source if source is baseMgIMCDatabase class + !! + pure function baseMgIMCDatabase_CptrCast(source) result(ptr) + class(nuclearDatabase), pointer, intent(in) :: source + class(baseMgIMCDatabase), pointer :: ptr + + select type(source) + class is(baseMgIMCDatabase) + ptr => source + + class default + ptr => null() + end select + + end function baseMgIMCDatabase_CptrCast + + +end module baseMgIMCDatabase_class diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 new file mode 100644 index 000000000..17f632a34 --- /dev/null +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -0,0 +1,299 @@ +module baseMgIMCMaterial_class + + use numPrecision + use endfConstants + use genericProcedures, only : fatalError, numToChar + use RNG_class, only : RNG + use dictionary_class, only : dictionary + use dictDeck_class, only : dictDeck + + ! Nuclear Data Interfaces + use materialHandle_inter, only : materialHandle + use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill + use neutronXSPackages_class, only : neutronMacroXSs + + ! Reaction objects + use reactionMG_inter, only : reactionMG + use multiScatterMG_class, only : multiScatterMG + use multiScatterP1MG_class, only : multiScatterP1MG + + implicit none + private + + !! + !! Public Pointer Cast + !! + public :: baseMgIMCMaterial_TptrCast + public :: baseMgIMCMaterial_CptrCast + + ! Public data location parameters + ! Use them if accessing data entries directly + integer(shortInt), parameter, public :: TOTAL_XS = 1 + integer(shortInt), parameter, public :: IESCATTER_XS = 2 + integer(shortInt), parameter, public :: CAPTURE_XS = 3 + + !! + !! Basic type of MG material data + !! + !! Stores MG data in a table. + !! Scattering reactions are lumped into single multiplicative scattering, + !! which is stored as INELASTIC scatering in macroXSs package! After all it is inelastic in + !! the sense that outgoing group can change. Diffrent types of multiplicative scattering can be + !! build. See doc of "init" procedure for details. + !! + !! Public members: + !! data -> Rank 2 array with all XSs data + !! + !! Interface: + !! materialHandle interface + !! mgIMCMaterial interface + !! init -> initialise Basic MG Material from dictionary and config keyword + !! nGroups -> returns number of energy groups + !! + !! Note: + !! Order of "data" array is: data(XS_type, Group #) + !! Dictionary with data must contain following entries: + !! -> numberOfGroups + !! -> capture [nGx1] + !! -> scatteringMultiplicity [nGxnG] + !! -> P0 [nGxnG] + !! Optional entries: + !! -> nu [nGx1] + !! -> chi [nGx1] + !! -> P# [nGxnG] + !! + type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial + real(defReal),dimension(:,:), allocatable :: data + class(multiScatterMG), allocatable :: scatter + + contains + ! Superclass procedures + procedure :: kill + procedure :: getMacroXSs_byG + procedure :: getTotalXS + + ! Local procedures + procedure :: init + procedure :: nGroups + + end type baseMgIMCMaterial + +contains + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(baseMgIMCMaterial), intent(inout) :: self + + ! Call superclass procedure + call kill_super(self) + + ! Kill local content + if(allocated(self % data)) deallocate(self % data) + if(allocated(self % scatter)) deallocate(self % scatter) + + end subroutine kill + + !! + !! Load Macroscopic XSs into the provided package for a given group index G + !! + !! See mgIMCMaterial documentation for more details + !! + subroutine getMacroXSs_byG(self, xss, G, rand) + class(baseMgIMCMaterial), intent(in) :: self + type(neutronMacroXSs), intent(out) :: xss + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + character(100), parameter :: Here = ' getMacroXSs (baseMgIMCMaterial_class.f90)' + + ! Verify bounds + if(G < 1 .or. self % nGroups() < G) then + call fatalError(Here,'Invalid group number: '//numToChar(G)// & + ' Data has only: ' // numToChar(self % nGroups())) + end if + + ! Get XSs + xss % total = self % data(TOTAL_XS, G) + xss % elasticScatter = ZERO + xss % inelasticScatter = self % data(IESCATTER_XS, G) + xss % capture = self % data(CAPTURE_XS, G) + + + end subroutine getMacroXSs_byG + + !! + !! Return Total XSs for energy group G + !! + !! See mgIMCMaterial documentationfor details + !! + function getTotalXS(self, G, rand) result(xs) + class(baseMgIMCMaterial), intent(in) :: self + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + real(defReal) :: xs + character(100), parameter :: Here = ' getTotalXS (baseMgIMCMaterial_class.f90)' + + ! Verify bounds + 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(TOTAL_XS, G) + + end function getTotalXS + + + !! + !! Initialise Base MG IMC Material fromdictionary + !! + !! Args: + !! dict [in] -> Input dictionary with all required XSs + !! scatterKey [in] -> String with keyword to choose approperiate multiplicative scatering + !! type + !! Errors: + !! FatalError if scatteKey is invalid + !! FatalError if data in dictionary is invalid (inconsistant # of groups; + !! -ve entries in P0 XSs) + !! + !! Note: + !! Some time in the future scattering MG reaction objects will have factory. For now + !! the factory is hardcoded into this procedure. Not the best solution but is fine at this + !! stage. The following scatterKey are supported: + !! -> P0 + !! -> P1 + !! + subroutine init(self, dict, scatterKey) + class(baseMgIMCMaterial), intent(inout) :: self + class(dictionary),target, intent(in) :: dict + character(nameLen), intent(in) :: scatterKey + integer(shortInt) :: nG, N, i + real(defReal), dimension(:), allocatable :: temp + type(dictDeck) :: deck + character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' + + + ! Read number of groups + call dict % get(nG, 'numberOfGroups') + if(nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) + + + ! Build scattering reaction + ! Prepare input deck + deck % dict => dict + + ! Choose Scattering type + select case(scatterKey) + case ('P0') + allocate( multiScatterMG :: self % scatter) + + case ('P1') + allocate( multiScatterP1MG :: self % scatter) + + case default + call fatalError(Here,'scatterKey: '//trim(scatterKey)//'is wrong. Must be P0 or P1') + + end select + + ! Initialise + call self % scatter % init(deck, macroAllScatter) + + + ! Allocate space for data + N = 3 + allocate(self % data(N, nG)) + + ! Load cross sections + call dict % get(temp, 'capture') + if(size(temp) /= nG) then + call fatalError(Here,'Capture XSs have wong size. Must be: ' & + // numToChar(nG)//' is '//numToChar(size(temp))) + end if + self % data(CAPTURE_XS,:) = temp + + ! Extract values of scattering XS + if(size(self % scatter % scatterXSs) /= nG) then + call fatalError(Here, 'Somthing went wrong. Inconsistant # of groups in material and reaction& + &. Clearly programming error.') + end if + self % data(IESCATTER_XS,:) = self % scatter % scatterXSs + + + ! Calculate total XS + do i =1,nG + self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) + end do + end subroutine init + + !! + !! Return number of energy groups + !! + !! Args: + !! None + !! + !! Errors: + !! None + !! + pure function nGroups(self) result(nG) + class(baseMgIMCMaterial), intent(in) :: self + integer(shortInt) :: nG + + if(allocated(self % data)) then + nG = size(self % data,2) + else + nG = 0 + end if + + end function nGroups + + !! + !! Cast materialHandle pointer to baseMgIMCMaterial type pointer + !! + !! Args: + !! source [in] -> source pointer of class materialHandle + !! + !! Result: + !! Null if source is not of baseMgIMCMaterial type + !! Target points to source if source is baseMgIMCMaterialtype + !! + pure function baseMgIMCMaterial_TptrCast(source) result(ptr) + class(materialHandle), pointer, intent(in) :: source + type(baseMgIMCMaterial), pointer :: ptr + + select type(source) + type is(baseMgIMCMaterial) + ptr => source + + class default + ptr => null() + end select + + end function baseMgIMCMaterial_TptrCast + + !! + !! Cast materialHandle pointer to baseMgIMCMaterial class pointer + !! + !! Args: + !! source [in] -> source pointer of class materialHandle + !! + !! Result: + !! Null if source is not of baseMgIMCMaterial class + !! Target points to source if source is baseMgIMCMaterial class + !! + pure function baseMgIMCMaterial_CptrCast(source) result(ptr) + class(materialHandle), pointer, intent(in) :: source + class(baseMgIMCMaterial), pointer :: ptr + + select type(source) + class is(baseMgIMCMaterial) + ptr => source + + class default + ptr => null() + end select + + end function baseMgIMCMaterial_CptrCast + + +end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 new file mode 100644 index 000000000..1afa16526 --- /dev/null +++ b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 @@ -0,0 +1,51 @@ +module mgIMCDatabase_inter + + ! Nuclear Data Interfaces & Objects + use nuclearDatabase_inter, only : nuclearDatabase + + implicit none + private + + !! + !! Public Pointer Cast + !! + public :: mgIMCDatabase_CptrCast + + !! + !! An abstract class that groups all MG IMC Data objects + !! + !! It does nothing, It adds nothing, + !! It just provides a common superclass for related classes + !! + type, public, abstract, extends(nuclearDatabase) :: mgIMCDatabase + + end type mgIMCDatabase + +contains + + !! + !! Cast nuclearDatabase pointer to mgIMCDatabase class pointer + !! + !! Args: + !! source [in] -> source pointer of class nuclearDatabase + !! + !! Result: + !! Null if source is not of mgIMCDatabase class + !! Target points to source if source is mgIMCDatabase class + !! + pure function mgIMCDatabase_CptrCast(source) result(ptr) + class(nuclearDatabase), pointer, intent(in) :: source + class(mgIMCDatabase), pointer :: ptr + + select type(source) + class is(mgIMCDatabase) + ptr => source + + class default + ptr => null() + end select + + end function mgIMCDatabase_CptrCast + + +end module mgIMCDatabase_inter diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 new file mode 100644 index 000000000..b66a1d9c2 --- /dev/null +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -0,0 +1,142 @@ +module mgIMCMaterial_inter + + use numPrecision + use genericProcedures, only : fatalError + use RNG_class, only : RNG + use particle_class, only : particle + + ! Nuclear Data Handles + use materialHandle_inter, only : materialHandle + use neutronMaterial_inter, only : neutronMaterial + use neutronXsPackages_class, only : neutronMacroXSs + + implicit none + private + + !! + !! Public Pointer Cast + !! + public :: mgIMCMaterial_CptrCast + + !! + !! Extendable procedures is subclasses + !! + public :: kill + + !! + !! Abstract interface for all MG neutron Materials + !! + !! + !! Interface: + !! materialHandle interface + !! neutroNMaterial interface + !! getMacroXSs -> Get macroscopic XSs directly from group number and RNG + !! + type, public, abstract, extends(neutronMaterial) :: mgIMCMaterial + private + + contains + ! Superclass procedures + procedure :: kill + generic :: getMacroXSs => getMacroXSs_byG + procedure :: getMacroXSs_byP + + ! Local procedures + procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG + procedure(getTotalXS), deferred :: getTotalXS + procedure :: isFissile + procedure :: set + + end type mgIMCMaterial + + + + abstract interface + + !! + !! Return Macroscopic XSs for the material + !! + !! Args: + !! xss [out] -> Cross section package to store the data + !! G [in] -> Requested energy group + !! rand [inout] -> Random Number Generator + !! + !! Errors: + !! fatalError if G is out-of-bounds for the stored data + !! + subroutine getMacroXSs_byG(self, xss, G, rand) + import :: mgIMCMaterial, neutronMacroXSs, shortInt, RNG + class(mgIMCMaterial), intent(in) :: self + type(neutronMacroXSs), intent(out) :: xss + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + end subroutine getMacroXSs_byG + + !! + !! Return Macroscopic Total XS for the material + !! + !! Args: + !! G [in] -> Requested energygroup + !! rand [inout] -> Random number generator + !! + !! Errors: + !! fatalError if G is out-of-bounds for the stored data + !! + function getTotalXS(self, G, rand) result(xs) + import :: mgIMCMaterial, defReal, shortInt, RNG + class(mgIMCMaterial), intent(in) :: self + integer(shortInt), intent(in) :: G + class(RNG), intent(inout) :: rand + real(defReal) :: xs + end function getTotalXS + end interface + + + +contains + + !! + !! Return Macroscopic XSs for the material given particle + !! + !! See neutronMaterial_inter for details + !! + subroutine getMacroXSs_byP(self, xss, p) + class(mgIMCMaterial), intent(in) :: self + type(neutronMacroXSs), intent(out) :: xss + class(particle), intent(in) :: p + character(100), parameter :: Here = 'getMacroXSs_byP (mgIMCMateerial_inter.f90)' + + if( p % isMG) then + call self % getMacroXSs(xss, p % G, p % pRNG) + + else + call fatalError(Here, 'CE particle was given to MG data') + + end if + end subroutine getMacroXSs_byP + + !! + !! Cast materialHandle pointer to mgIMCMaterial pointer + !! + !! Args: + !! source [in] -> source pointer of class materialHandle + !! + !! Result: + !! Null is source is not of ceIMCMaterial + !! Pointer to source if source is ceIMCMaterial class + !! + pure function mgIMCMaterial_CptrCast(source) result(ptr) + class(materialHandle), pointer, intent(in) :: source + class(mgIMCMaterial), pointer :: ptr + + select type(source) + class is(mgIMCMaterial) + ptr => source + + class default + ptr => null() + end select + + end function mgIMCMaterial_CptrCast + +end module mgIMCMaterial_inter From 0d87bc3173af44797b20e01e85c50e08210ff043 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 15 Dec 2021 18:13:47 +0000 Subject: [PATCH 002/373] Restarted IMC NucData folder and renamed Neutron to IMC --- NuclearData/CMakeLists.txt | 1 + NuclearData/mgIMCData/CMakeLists.txt | 10 +-- ..._iTest.f90 => baseMgIMCDatabase_iTest.f90} | 62 ++++++++--------- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 11 ++- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 55 +++++++++++++-- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 68 ++++++++++++++++--- 6 files changed, 154 insertions(+), 53 deletions(-) rename NuclearData/mgIMCData/baseMgIMC/Tests/{baseMgNeutronDatabase_iTest.f90 => baseMgIMCDatabase_iTest.f90} (82%) diff --git a/NuclearData/CMakeLists.txt b/NuclearData/CMakeLists.txt index 2173bdef1..240acbbd4 100644 --- a/NuclearData/CMakeLists.txt +++ b/NuclearData/CMakeLists.txt @@ -1,5 +1,6 @@ add_subdirectory(ceNeutronData) add_subdirectory(mgNeutronData) +add_subdirectory(mgIMCData) add_subdirectory(testNeutronData) add_subdirectory(xsPackages) add_subdirectory(emissionENDF) diff --git a/NuclearData/mgIMCData/CMakeLists.txt b/NuclearData/mgIMCData/CMakeLists.txt index 04d7a738f..dd219aafc 100644 --- a/NuclearData/mgIMCData/CMakeLists.txt +++ b/NuclearData/mgIMCData/CMakeLists.txt @@ -1,8 +1,8 @@ # Add source files for compilation -add_sources(./mgNeutronMaterial_inter.f90 - ./mgNeutronDatabase_inter.f90 - ./baseMgNeutron/baseMgNeutronMaterial_class.f90 - ./baseMgNeutron/baseMgNeutronDatabase_class.f90) +add_sources(./mgIMCMaterial_inter.f90 + ./mgIMCDatabase_inter.f90 + ./baseMgIMC/baseMgIMCMaterial_class.f90 + ./baseMgIMC/baseMgIMCDatabase_class.f90) # Add tests -add_integration_tests(./baseMgNeutron/Tests/baseMgNeutronDatabase_iTest.f90) \ No newline at end of file +#add_integration_tests(./baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90) diff --git a/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgNeutronDatabase_iTest.f90 b/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90 similarity index 82% rename from NuclearData/mgIMCData/baseMgIMC/Tests/baseMgNeutronDatabase_iTest.f90 rename to NuclearData/mgIMCData/baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90 index 13aa797d0..f05c5bea0 100644 --- a/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgNeutronDatabase_iTest.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90 @@ -1,4 +1,4 @@ -module baseMgNeutronDatabase_iTest +module baseMgIMCDatabase_iTest use numPrecision use endfConstants @@ -8,10 +8,10 @@ module baseMgNeutronDatabase_iTest use particle_class, only : particle ! Nuclear Data Objects & Interfaces - use baseMgNeutronDatabase_class, only : baseMgNeutronDatabase, baseMgNeutronDatabase_CptrCast, & - baseMgNeutronDatabase_TptrCast - use baseMgNeutronMaterial_class, only : baseMgNeutronMaterial, baseMgNeutronMaterial_CptrCast, & - baseMgNeutronMaterial_TptrCast + use baseMgIMCDatabase_class, only : baseMgIMCDatabase, baseMgIMCDatabase_CptrCast, & + baseMgIMCDatabase_TptrCast + use baseMgIMCMaterial_class, only : baseMgIMCMaterial, baseMgIMCMaterial_CptrCast, & + baseMgIMCMaterial_TptrCast use fissionMG_class, only : fissionMG, fissionMG_TptrCast use multiScatterMG_class, only : multiScatterMG, multiScatterMG_CptrCast, & multiScatterMG_TptrCast @@ -20,7 +20,7 @@ module baseMgNeutronDatabase_iTest use nuclearDatabase_inter, only : nuclearDatabase use materialHandle_inter, only : materialHandle use nuclideHandle_inter, only : nuclideHandle - use neutronXsPackages_class, only : neutronMacroXSs + use IMCXsPackages_class, only : IMCMacroXSs use reactionHandle_inter, only : reactionHandle @@ -48,18 +48,18 @@ module baseMgNeutronDatabase_iTest contains !! - !! Monster test to build and verify data in baseMgNeutronDatabase with P0 scattering + !! Monster test to build and verify data in baseMgIMCDatabase with P0 scattering !! @Test - subroutine testBaseMgNeutronDatabaseWithP0() - type(baseMgNeutronDatabase), target :: database + subroutine testBaseMgIMCDatabaseWithP0() + type(baseMgIMCDatabase), target :: database class(nuclearDatabase), pointer :: data_ptr type(dictionary) :: databaseDef type(dictionary) :: matMenuDict type(particle) :: p - type(neutronMacroXSs) :: xss - type(baseMgNeutronMaterial),pointer :: mat - class(baseMgNeutronMaterial),pointer :: matClass + type(IMCMacroXSs) :: xss + type(baseMgIMCMaterial),pointer :: mat + class(baseMgIMCMaterial),pointer :: matClass class(reactionHandle), pointer :: reac real(defReal),parameter :: TOL = 1.0E-6_defReal @@ -96,7 +96,7 @@ subroutine testBaseMgNeutronDatabaseWithP0() ! Get a material and verify macroXSS - mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(2)) + mat => baseMgIMCMaterial_TptrCast(database % getMaterial(2)) @assertTrue(associated(mat), "Type Ptr Cast has failed") call mat % getMacroXSs(xss, 1, p % pRNG) @@ -110,7 +110,7 @@ subroutine testBaseMgNeutronDatabaseWithP0() @assertEqual(1.0_defReal, xss % fission, TOL) @assertEqual(2.3_defReal, xss % nuFission, TOL) - matClass => baseMgNeutronMaterial_CptrCast(database % getMaterial(1)) + matClass => baseMgIMCMaterial_CptrCast(database % getMaterial(1)) @assertTrue(associated(matClass), "Type Ptr Cast has failed") call matClass % getMacroXSs(xss, 4, p % pRNG) @@ -124,13 +124,13 @@ subroutine testBaseMgNeutronDatabaseWithP0() @assertEqual(0.0_defReal, xss % nuFission, TOL) ! Get some invalid Materials - mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(0)) + mat => baseMgIMCMaterial_TptrCast(database % getMaterial(0)) @assertFalse(associated(mat)) - mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(-2)) + mat => baseMgIMCMaterial_TptrCast(database % getMaterial(-2)) @assertFalse(associated(mat)) - mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(3)) + mat => baseMgIMCMaterial_TptrCast(database % getMaterial(3)) @assertFalse(associated(mat)) ! Get Fission reaction and verify type @@ -170,22 +170,22 @@ subroutine testBaseMgNeutronDatabaseWithP0() call matMenuDict % kill() call databaseDef % kill() - end subroutine testBaseMgNeutronDatabaseWithP0 + end subroutine testBaseMgIMCDatabaseWithP0 !! - !! Monster test to build and verify data in baseMgNeutronDatabase with P1 scattering + !! Monster test to build and verify data in baseMgIMCDatabase with P1 scattering !! *Copy and pasted from the above with only the type of scattering changed !! @Test - subroutine testBaseMgNeutronDatabaseWithP1() - type(baseMgNeutronDatabase), target :: database + subroutine testBaseMgIMCDatabaseWithP1() + type(baseMgIMCDatabase), target :: database class(nuclearDatabase), pointer :: data_ptr type(dictionary) :: databaseDef type(dictionary) :: matMenuDict type(particle) :: p - type(neutronMacroXSs) :: xss - type(baseMgNeutronMaterial),pointer :: mat - class(baseMgNeutronMaterial),pointer :: matClass + type(IMCMacroXSs) :: xss + type(baseMgIMCMaterial),pointer :: mat + class(baseMgIMCMaterial),pointer :: matClass class(reactionHandle), pointer :: reac real(defReal),parameter :: TOL = 1.0E-6_defReal @@ -222,7 +222,7 @@ subroutine testBaseMgNeutronDatabaseWithP1() ! Get a material and verify macroXSS - mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(2)) + mat => baseMgIMCMaterial_TptrCast(database % getMaterial(2)) @assertTrue(associated(mat), "Type Ptr Cast has failed") call mat % getMacroXSs(xss, 1, p % pRNG) @@ -236,7 +236,7 @@ subroutine testBaseMgNeutronDatabaseWithP1() @assertEqual(1.0_defReal, xss % fission, TOL) @assertEqual(2.3_defReal, xss % nuFission, TOL) - matClass => baseMgNeutronMaterial_CptrCast(database % getMaterial(1)) + matClass => baseMgIMCMaterial_CptrCast(database % getMaterial(1)) @assertTrue(associated(matClass), "Type Ptr Cast has failed") call matClass % getMacroXSs(xss, 4, p % pRNG) @@ -250,13 +250,13 @@ subroutine testBaseMgNeutronDatabaseWithP1() @assertEqual(0.0_defReal, xss % nuFission, TOL) ! Get some invalid Materials - mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(0)) + mat => baseMgIMCMaterial_TptrCast(database % getMaterial(0)) @assertFalse(associated(mat)) - mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(-2)) + mat => baseMgIMCMaterial_TptrCast(database % getMaterial(-2)) @assertFalse(associated(mat)) - mat => baseMgNeutronMaterial_TptrCast(database % getMaterial(3)) + mat => baseMgIMCMaterial_TptrCast(database % getMaterial(3)) @assertFalse(associated(mat)) ! Get Fission reaction and verify type @@ -296,8 +296,8 @@ subroutine testBaseMgNeutronDatabaseWithP1() call matMenuDict % kill() call databaseDef % kill() - end subroutine testBaseMgNeutronDatabaseWithP1 + end subroutine testBaseMgIMCDatabaseWithP1 -end module baseMgNeutronDatabase_iTest +end module baseMgIMCDatabase_iTest diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 103e8e23f..3aae1bfb2 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -30,7 +30,7 @@ module baseMgIMCDatabase_class public :: baseMgIMCDatabase_CptrCast !! - !! Basic type of MG nuclear Data for neutrons + !! Basic type of MG nuclear Data for IMCs !! !! All materials in aproblem are baseMgMaterials. See its documentation for !! details on how the physics is handled @@ -201,7 +201,14 @@ function getReaction(self, MT, idx) result(reac) ! Select correct reaction select case(MT) - + case(macroFission) + ! Point to null if material is not fissile + if (self % mats(idx) % isFissile()) then + reac => self % mats(idx) % fission + else + reac => null() + end if + case(macroIEScatter) reac => self % mats(idx) % scatter diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 17f632a34..b1ca6f734 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -10,10 +10,11 @@ module baseMgIMCMaterial_class ! Nuclear Data Interfaces use materialHandle_inter, only : materialHandle use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill - use neutronXSPackages_class, only : neutronMacroXSs + use IMCXSPackages_class, only : IMCMacroXSs ! Reaction objects use reactionMG_inter, only : reactionMG + use fissionMG_class, only : fissionMG use multiScatterMG_class, only : multiScatterMG use multiScatterP1MG_class, only : multiScatterP1MG @@ -31,12 +32,15 @@ module baseMgIMCMaterial_class integer(shortInt), parameter, public :: TOTAL_XS = 1 integer(shortInt), parameter, public :: IESCATTER_XS = 2 integer(shortInt), parameter, public :: CAPTURE_XS = 3 + integer(shortInt), parameter, public :: FISSION_XS = 4 + integer(shortInt), parameter, public :: NU_FISSION = 5 !! !! Basic type of MG material data !! !! Stores MG data in a table. - !! Scattering reactions are lumped into single multiplicative scattering, + !! Fission is treated as a seperate reaction + !! All other scattering reactions are lumped into single multiplicative scattering, !! which is stored as INELASTIC scatering in macroXSs package! After all it is inelastic in !! the sense that outgoing group can change. Diffrent types of multiplicative scattering can be !! build. See doc of "init" procedure for details. @@ -58,6 +62,7 @@ module baseMgIMCMaterial_class !! -> scatteringMultiplicity [nGxnG] !! -> P0 [nGxnG] !! Optional entries: + !! -> fission [nGx1] !! -> nu [nGx1] !! -> chi [nGx1] !! -> P# [nGxnG] @@ -65,6 +70,7 @@ module baseMgIMCMaterial_class type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data class(multiScatterMG), allocatable :: scatter + type(fissionMG), allocatable :: fission contains ! Superclass procedures @@ -92,6 +98,7 @@ elemental subroutine kill(self) ! Kill local content if(allocated(self % data)) deallocate(self % data) if(allocated(self % scatter)) deallocate(self % scatter) + if(allocated(self % fission)) deallocate(self % fission) end subroutine kill @@ -102,7 +109,7 @@ end subroutine kill !! subroutine getMacroXSs_byG(self, xss, G, rand) class(baseMgIMCMaterial), intent(in) :: self - type(neutronMacroXSs), intent(out) :: xss + type(IMCMacroXSs), intent(out) :: xss integer(shortInt), intent(in) :: G class(RNG), intent(inout) :: rand character(100), parameter :: Here = ' getMacroXSs (baseMgIMCMaterial_class.f90)' @@ -119,6 +126,13 @@ subroutine getMacroXSs_byG(self, xss, G, rand) xss % inelasticScatter = self % data(IESCATTER_XS, G) xss % capture = self % data(CAPTURE_XS, G) + if(self % isFissile()) then + xss % fission = self % data(FISSION_XS, G) + xss % nuFission = self % data(NU_FISSION, G) + else + xss % fission = ZERO + xss % nuFission = ZERO + end if end subroutine getMacroXSs_byG @@ -178,6 +192,8 @@ subroutine init(self, dict, scatterKey) call dict % get(nG, 'numberOfGroups') if(nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) + ! Set fissile flag + call self % set(fissile = dict % isPresent('fission')) ! Build scattering reaction ! Prepare input deck @@ -199,9 +215,17 @@ subroutine init(self, dict, scatterKey) ! Initialise call self % scatter % init(deck, macroAllScatter) + ! Deal with fission + if(self % isFissile()) allocate(self % fission) + if(self % isFissile()) call self % fission % init(deck, macroFission) ! Allocate space for data - N = 3 + if(self % isFissile()) then + N = 5 + else + N = 3 + end if + allocate(self % data(N, nG)) ! Load cross sections @@ -219,10 +243,31 @@ subroutine init(self, dict, scatterKey) end if self % data(IESCATTER_XS,:) = self % scatter % scatterXSs + ! Load Fission-data + if( self % isFissile()) then + ! Load Fission + call dict % get(temp, 'fission') + if(size(temp) /= nG) then + call fatalError(Here,'Fission XSs have wong size. Must be: ' & + // numToChar(nG)//' is '//numToChar(size(temp))) + end if + self % data(FISSION_XS,:) = temp + + ! Calculate nuFission + call dict % get(temp, 'nu') + if(size(temp) /= nG) then + call fatalError(Here,'Nu vector has wong size. Must be: ' & + // numToChar(nG)//' is '//numToChar(size(temp))) + end if + self % data(NU_FISSION,:) = temp * self % data(FISSION_XS,:) + end if ! Calculate total XS do i =1,nG - self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) + self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) + if(self % isFissile()) then + self % data(TOTAL_XS, i) = self % data(TOTAL_XS, i) + self % data(FISSION_XS, i) + end if end do end subroutine init diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index b66a1d9c2..64fc3e796 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -7,8 +7,8 @@ module mgIMCMaterial_inter ! Nuclear Data Handles use materialHandle_inter, only : materialHandle - use neutronMaterial_inter, only : neutronMaterial - use neutronXsPackages_class, only : neutronMacroXSs + use IMCMaterial_inter, only : IMCMaterial + use IMCXsPackages_class, only : IMCMacroXSs implicit none private @@ -24,16 +24,20 @@ module mgIMCMaterial_inter public :: kill !! - !! Abstract interface for all MG neutron Materials - !! + !! Abstract interface for all MG IMC Materials + !! + !! Private Members: + !! fissile -> flag set to .true. if material is fissile !! !! Interface: !! materialHandle interface !! neutroNMaterial interface - !! getMacroXSs -> Get macroscopic XSs directly from group number and RNG + !! getMacroXSs -> Get macroscopic XSs directly from group number and RNG + !! set -> Sets fissile flag !! - type, public, abstract, extends(neutronMaterial) :: mgIMCMaterial + type, public, abstract, extends(IMCMaterial) :: mgIMCMaterial private + logical(defBool) :: fissile = .false. contains ! Superclass procedures @@ -65,9 +69,9 @@ module mgIMCMaterial_inter !! fatalError if G is out-of-bounds for the stored data !! subroutine getMacroXSs_byG(self, xss, G, rand) - import :: mgIMCMaterial, neutronMacroXSs, shortInt, RNG + import :: mgIMCMaterial, IMCMacroXSs, shortInt, RNG class(mgIMCMaterial), intent(in) :: self - type(neutronMacroXSs), intent(out) :: xss + type(IMCMacroXSs), intent(out) :: xss integer(shortInt), intent(in) :: G class(RNG), intent(inout) :: rand end subroutine getMacroXSs_byG @@ -98,11 +102,11 @@ end function getTotalXS !! !! Return Macroscopic XSs for the material given particle !! - !! See neutronMaterial_inter for details + !! See IMCMaterial_inter for details !! subroutine getMacroXSs_byP(self, xss, p) class(mgIMCMaterial), intent(in) :: self - type(neutronMacroXSs), intent(out) :: xss + type(IMCMacroXSs), intent(out) :: xss class(particle), intent(in) :: p character(100), parameter :: Here = 'getMacroXSs_byP (mgIMCMateerial_inter.f90)' @@ -115,6 +119,50 @@ subroutine getMacroXSs_byP(self, xss, p) end if end subroutine getMacroXSs_byP + !! + !! Return .true. if the MG material is fissile + !! + !! Args: + !! None + !! + !! Errors: + !! None + !! + elemental function isFissile(self) result(isIt) + class(mgIMCMaterial), intent(in) :: self + logical(defBool) :: isIt + + isIt = self % fissile + + end function isFissile + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(mgIMCMaterial), intent(inout) :: self + + self % fissile = .false. + + end subroutine kill + + !! + !! Set fissile flag + !! + !! All arguments are optional. Use with keyword association e.g. + !! call mat % set( fissile = .true.) + !! + !! Args: + !! fissile [in] -> flag indicating whether fission data is present + !! + subroutine set(self, fissile) + class(mgIMCMaterial), intent(inout) :: self + logical(defBool), intent(in), optional :: fissile + + if(present(fissile)) self % fissile = fissile + + end subroutine set + !! !! Cast materialHandle pointer to mgIMCMaterial pointer !! From e2ce04cd6d89d26b75f5556cffc00ba94b7410d6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 15 Dec 2021 18:46:50 +0000 Subject: [PATCH 003/373] Added more files required to begin IMC coding --- CMakeLists.txt | 5 + NuclearData/IMCMaterial_inter.f90 | 101 +++++++ .../xsPackages/IMCXsPackages_class.f90 | 284 ++++++++++++++++++ 3 files changed, 390 insertions(+) create mode 100644 NuclearData/IMCMaterial_inter.f90 create mode 100644 NuclearData/xsPackages/IMCXsPackages_class.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 56da50c36..442bb4a1a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -64,6 +64,9 @@ list(APPEND CMAKE_PREFIX_PATH $ENV{LAPACK_INSTALL}) find_package(LAPACK REQUIRED ) message(STATUS ${LAPACK_LIBRARIES}) +set(BLAS_LIBS /home/ajb343/BLAS/BLAS-3.10.0/Build) +find_package(BLAS REQUIRED) + # Dependencies for BUILD_TESTS if (BUILD_TESTS) # FIND PYTHON INTERPRETER @@ -105,6 +108,8 @@ add_subdirectory(UserInterface) add_subdirectory(PhysicsPackages) add_subdirectory(DataStructures) +#add_subdirectory(BlackBody) + #################################################################################################### # Compile SCONE static library diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 new file mode 100644 index 000000000..a175ff050 --- /dev/null +++ b/NuclearData/IMCMaterial_inter.f90 @@ -0,0 +1,101 @@ +module IMCMaterial_inter + + use numPrecision + use particle_class, only : particle + + ! Nuclear Data Interfaces + use materialHandle_inter, only : materialHandle + use IMCXsPackages_class, only : IMCMacroXSs + + implicit none + private + + !! + !! Public Pointer Cast + !! + public :: IMCMaterial_CptrCast + + !! + !! Abstract interface far all IMC Materials (CE and MG) + !! + !! It was created to expose access to some key information in the context of + !! tallying where one is not interested whether MG or CE data is used + !! + !! Interface: + !! materialHandle interface + !! isFissle -> Return true if material is fissile + !! getMacroXSs -> Return Macroscopic XSs given particle with energy data + !! + type, public, abstract, extends(materialHandle) :: IMCMaterial + private + contains + generic :: getMacroXSs => getMacroXSs_byP + procedure(isFissile), deferred :: isFissile + procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP + end type IMCMaterial + + abstract interface + !! + !! Return .true. if the MG material is fissile + !! + !! Args: + !! None + !! + !! Errors: + !! None + !! + elemental function isFissile(self) result(isIt) + import :: IMCMaterial, defBool + class(IMCMaterial), intent(in) :: self + logical(defBool) :: isIt + end function isFissile + + !! + !! Return Macroscopic XSs for the material given particle + !! + !! Args: + !! xss [out] -> Cross section package to store the data + !! p [in] -> Particle that provides energy or energy group + !! + !! Errors: + !! fatalError if energy value/group is outside bounds + !! fatalError if MG particle is given to CE data and vice versa + !! + subroutine getMacroXSs_byP(self, xss, p) + import :: IMCMaterial, particle, IMCMacroXSs + class(IMCMaterial), intent(in) :: self + type(IMCMacroXSs), intent(out) :: xss + class(particle), intent(in) :: p + end subroutine getMacroXSs_byP + + end interface + +contains + + + !! + !! Cast materialHandle pointer to IMCMaterial pointer + !! + !! Args: + !! source [in] -> source pointer of class materialHandle + !! + !! Result: + !! Null is source is not of IMCMaterial + !! Pointer to source if source is IMCMaterial class + !! + pure function IMCMaterial_CptrCast(source) result(ptr) + class(materialHandle), pointer, intent(in) :: source + class(IMCMaterial), pointer :: ptr + + select type(source) + class is(IMCMaterial) + ptr => source + + class default + ptr => null() + end select + + end function IMCMaterial_CptrCast + + +end module IMCMaterial_inter diff --git a/NuclearData/xsPackages/IMCXsPackages_class.f90 b/NuclearData/xsPackages/IMCXsPackages_class.f90 new file mode 100644 index 000000000..e01d23e98 --- /dev/null +++ b/NuclearData/xsPackages/IMCXsPackages_class.f90 @@ -0,0 +1,284 @@ +!! +!! This module brakes standard rules +!! It contains a library of XS Packages for IMC particle type +!! +!! +module IMCXsPackages_class + + use numPrecision + use endfConstants + + implicit none + private + + !! + !! IMC MACROscopic Reaction XSS + !! + !! Public Members: + !! total -> total Cross-Section [1/cm] + !! elasticScatter -> sum of MT=2 elastic IMC scattering [1/cm] + !! inelasticScatter -> sum of all IMC producing reaction that are not elastic scattering + !! or fission. [1/cm] + !! capture -> sum of all reactions without secendary IMCs excluding fission [1/cm] + !! fission -> total Fission MT=18 Cross-section [1/cm] + !! nuFission -> total average IMC production Cross-section [1/cm] + !! + !! Interface: + !! clean -> Set all XSs to 0.0 + !! add -> Add a nuclide microscopic XSs to macroscopic + !! get -> Return XS by MT number + !! + type, public :: IMCMacroXSs + real(defReal) :: total = ZERO + real(defReal) :: elasticScatter = ZERO + real(defReal) :: inelasticScatter = ZERO + real(defReal) :: capture = ZERO + real(defReal) :: fission = ZERO + real(defReal) :: nuFission = ZERO + contains + procedure :: clean => clean_IMCMacroXSs + procedure :: add => add_IMCMacroXSs + procedure :: get + procedure :: invert => invert_macroXSs + end type IMCMacroXSs + + + !! + !! IMC microscopic Reaction XSS + !! + !! Public Members: + !! total -> total Cross-Section [barn] + !! elasticScatter -> MT=2 elastic IMC scattering [barn] + !! inelasticScatter -> all IMC producing reaction that are not elastic scattering + !! or fission. [barn] + !! capture -> all reactions without secendary IMCs excluding fission [barn] + !! fission -> total Fission MT=18 Cross-section [barn] + !! nuFission -> total average IMC production Cross-section [barn] + !! + type, public :: IMCMicroXSs + real(defReal) :: total = ZERO + real(defReal) :: elasticScatter = ZERO + real(defReal) :: inelasticScatter = ZERO + real(defReal) :: capture = ZERO + real(defReal) :: fission = ZERO + real(defReal) :: nuFission = ZERO + contains + procedure :: invert => invert_microXSs + end type IMCMicroXSs + +contains + + !! + !! Clean IMC MacroXSs + !! + !! Sets all XSs to 0.0 + !! + !! Args: + !! None + !! + !! Errors: + !! None + !! + elemental subroutine clean_IMCMacroXSs(self) + class(IMCMacroXSs), intent(inout) :: self + + self % total = ZERO + self % elasticScatter = ZERO + self % inelasticScatter = ZERO + self % capture = ZERO + self % fission = ZERO + self % nuFission = ZERO + + end subroutine clean_IMCMacroXSs + + !! + !! Add nuclide XSs on Macroscopic XSs + !! + !! Takes microscopic XSs * density and adds them to IMCMacroXSs + !! + !! Args: + !! micro [in] -> microscopic XSs + !! dens [in] -> nuclide density in [1/barn/cm] + !! + !! Errors: + !! None + !! + elemental subroutine add_IMCMacroXSs(self, micro, dens) + class(IMCMacroXSs), intent(inout) :: self + type(IMCMicroXSs), intent(in) :: micro + real(defReal), intent(in) :: dens + + self % total = self % total + dens * micro % total + self % elasticScatter = self % elasticScatter + dens * micro % elasticScatter + self % inelasticScatter = self % inelasticScatter + dens * micro % inelasticScatter + self % capture = self % capture + dens * micro % capture + self % fission = self % fission + dens * micro % fission + self % nuFission = self % nuFission + dens * micro % nuFission + + end subroutine add_IMCMacroXSs + + !! + !! Return XSs by MT number + !! + !! Args: + !! MT [in] -> Requested MT number + !! + !! Result: + !! Value of the XS + !! + !! Errors: + !! Returns 0.0 for invalid MT + !! + elemental function get(self, MT) result(xs) + class(IMCMacroXSs), intent(in) :: self + integer(shortInt), intent(in) :: MT + real(defReal) :: xs + + select case(MT) + case(macroTotal) + xs = self % total + + case(macroCapture) + xs = self % capture + + case(macroEscatter) + xs = self % elasticScatter + + case(macroFission) + xs = self % fission + + case(macroNuFission) + xs = self % nuFission + + case(macroAbsorbtion) + xs = self % fission + self % capture + + case default + xs = ZERO + + end select + + end function get + + !! + !! Use a real r in <0;1> to sample reaction from Macroscopic XSs + !! + !! This function might be common thus is type-bound procedure for conveniance + !! + !! Args: + !! r [in] -> Real number in <1;0> + !! + !! Result: + !! One of the Macroscopic MT numbers + !! elasticScatter = macroEscatter + !! inelasticScatter = macroIEscatter + !! capture = macroCapture + !! fission = macroFission + !! + !! Errors:: + !! If r < 0 then returns macroEscatter + !! If r > 1 then returns macroFission + !! + elemental function invert_macroXSs(self, r) result(MT) + class(IMCMacroXSs), intent(in) :: self + real(defReal), intent(in) :: r + integer(shortInt) :: MT + real(defReal) :: xs + integer(shortInt) :: C + + ! Elastic Scattering + C = 1 + xs = self % total * r - self % elasticScatter + if (xs > ZERO) C = C + 1 + + ! Inelastic Scattering + xs = xs - self % inelasticScatter + if(xs > ZERO) C = C + 1 + + ! Capture + xs = xs - self % capture + if(xs > ZERO) C = C + 1 + + ! Choose MT number + select case(C) + case(1) + MT = macroEScatter + + case(2) + MT = macroIEscatter + + case(3) + MT = macroCapture + + case(4) + MT = macroFission + + case default ! Should never happen -> Avoid compiler error and return nonsense number + MT = huge(C) + + end select + + end function invert_macroXSs + + + !! + !! Use a real r in <0;1> to sample reaction from Microscopic XSs + !! + !! This function involves a bit of code so is written for conviniance + !! + !! Args: + !! r [in] -> Real number in <0;1> + !! + !! Result: + !! MT number of the reaction: + !! elastic scatter = N_N_elastic + !! inelastic scatter = N_N_inelastic + !! capture = N_diasp + !! fission = N_FISSION + !! + !! Errors: + !! If r < 0 then returns N_N_elastic + !! if r > 1 then returns N_FISSION + !! + elemental function invert_microXSs(self, r) result(MT) + class(IMCMicroXSs), intent(in) :: self + real(defReal), intent(in) :: r + integer(shortInt) :: MT + real(defReal) :: xs + integer(shortInt) :: C + + ! Elastic Scattering + C = 1 + xs = self % total * r - self % elasticScatter + if (xs > ZERO) C = C + 1 + + ! Inelastic Scattering + xs = xs - self % inelasticScatter + if(xs > ZERO) C = C + 1 + + ! Capture + xs = xs - self % capture + if(xs > ZERO) C = C + 1 + + ! Choose MT number + select case(C) + case(1) + MT = N_N_elastic + + case(2) + MT = N_N_inelastic + + case(3) + MT = N_disap + + case(4) + MT = N_fission + + case default ! Should never happen -> Avoid compiler error and return nonsense number + MT = huge(C) + end select + + end function invert_microXSs + + +end module IMCXsPackages_class From 6cc6407ca4b9a59369a1c73f5ad62383dd1cbd9e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 16 Dec 2021 14:05:49 +0000 Subject: [PATCH 004/373] Allowed baseMgIMCDatabase to be accepted into input file --- NuclearData/nuclearDataReg_mod.f90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index d1f47dc72..6bc2b9dc9 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -74,6 +74,9 @@ module nuclearDataReg_mod ! Neutron MG use baseMgNeutronDatabase_class, only : baseMgNeutronDatabase + ! IMC MG + use baseMgIMCDatabase_class, only : baseMgIMCDatabase + implicit none private @@ -113,6 +116,7 @@ module nuclearDataReg_mod character(nameLen), dimension(*), parameter :: AVAILABLE_NUCLEAR_DATABASES = & ['aceNeutronDatabase ', & 'baseMgNeutronDatabase ', & + 'baseMgIMCDatabase ', & 'aceNeutronDatabaseUni ', & 'aceNeutronDatabaseUniIdx'] @@ -576,6 +580,9 @@ subroutine new_nuclearDatabase(database, type) case('baseMgNeutronDatabase') allocate(baseMgNeutronDatabase :: database) + case('baseMgIMCDatabase') + allocate(baseMgIMCDatabase :: database) + case('aceNeutronDatabaseUni') allocate(aceNeutronDatabaseUni :: database) From 6683f34588dc307a19264301c6f1b2610353dcd6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 17:16:40 +0000 Subject: [PATCH 005/373] Fixed error in end function --- NuclearData/nuclearDataReg_mod.f90 | 49 ++++++++++++++++++++++++++++-- 1 file changed, 47 insertions(+), 2 deletions(-) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index 6bc2b9dc9..8c49a6a93 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -13,6 +13,7 @@ !! Available ND TYPES: !! CE_NEUTRON !! MG_NEUTRON +!! MG_IMC !! !! Private members: !! databases -> Array with defined databases (name, definition, @@ -102,6 +103,7 @@ module nuclearDataReg_mod public :: kill public :: getNeutronCE public :: getNeutronMG + public :: getIMCMG public :: get public :: getMatNames @@ -130,6 +132,9 @@ module nuclearDataReg_mod class(mgNeutronDatabase), pointer :: active_mgNeutron => null() integer(shortInt) :: activeIdx_mgNeutron = 0 + class(mgIMCDatabase), pointer :: active_mgIMC => null() + integer(shortInt) :: activeIdx_mgIMC = 0 + contains !! @@ -326,6 +331,13 @@ subroutine activate(type, name, activeMat, silent) call fatalError(Here,trim(name)//' is not database for MG neutrons') end if + case(P_IMC_MG) + activeIdx_mgIMC = idx + active_mgIMC => mgIMCDatabase_CptrCast(ptr) + if(.not.associated(active_mgIMC)) then + call fatalError(Here,trim(name)//' is not database for MG IMC') + end if + case default call fatalError(Here,'Unrecognised type of data to activate. Check parameters. Got: '//& numToChar(type)) @@ -361,11 +373,18 @@ subroutine display() if(idx /= 0) activeName = databases(idx) % name print '(A)', " MG NEUTRON DATA: " // trim(activeName) + ! MG IMC + activename = 'NONE' + idx = activeIdx_mgIMC + if(idx /= 0) activeName = databases(idx) % name + print '(A)', " MG IMC DATA: " // trim(activeName) + ! INACTIVE DATABASES print '(A)', "INACTIVE DATABASES:" do idx=1,size(databases) if(idx == activeIdx_mgNeutron) cycle if(idx == activeIdx_ceNeutron) cycle + if(idx == activeIdx_mgIMC) cycle end do print '(A)',repeat('\/',30) @@ -401,6 +420,10 @@ subroutine kill() activeIdx_mgNeutron = 0 active_mgNeutron => null() + ! MG IMC + activeIdx_mgMC = 0 + active_mgIMC => null() + end subroutine kill !! @@ -423,13 +446,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 @@ -441,6 +464,25 @@ function getNeutronMG() result(ptr) end function getNeutronMG + !! + !! Return pointer to an active IMC MG Database + !! + !! Args: + !! None + !! + !! Result: + !! mgIMCDatabase class pointer + !! + !! Errors: + !! If there is no active database returns NULL ptr + !! + function getIMCMG() result(ptr) + class(mgIMCDatabase), pointer :: ptr + + ptr => active_mgIMC + + end function getIMCMG + !! !! Return pointer to an active Nuclear Database given particle type !! @@ -467,6 +509,9 @@ function get_byType(type, where) result(ptr) case(P_NEUTRON_MG) ptr => getNeutronMG() + case(P_IMC_MG) + ptr => getIMCMG() + case default ptr => null() end select From d96dd27b7001e045528d9251e4d7c2d61425b900 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 17:24:15 +0000 Subject: [PATCH 006/373] Added missing USE statement --- NuclearData/nuclearDataReg_mod.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index 8c49a6a93..4e1a1b517 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -63,6 +63,7 @@ module nuclearDataReg_mod use nuclearDatabase_inter, only : nuclearDatabase use ceNeutronDatabase_inter, only : ceNeutronDatabase, ceNeutronDatabase_CptrCast use mgNeutronDatabase_inter, only : mgNeutronDatabase, mgNeutronDatabase_CptrCast + use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast use materialMenu_mod, only : mm_init => init, mm_kill => kill, mm_nMat => nMat,& mm_nameMap => nameMap From eb2559456ffa8484785c23ab9d478eeeef107383 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 19:31:43 +0000 Subject: [PATCH 007/373] Created IMCMaterial_inter to attempt to use IMC nuclear database --- NuclearData/CMakeLists.txt | 1 + NuclearData/IMCMaterial_inter.f90 | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/NuclearData/CMakeLists.txt b/NuclearData/CMakeLists.txt index 240acbbd4..70825ae18 100644 --- a/NuclearData/CMakeLists.txt +++ b/NuclearData/CMakeLists.txt @@ -12,6 +12,7 @@ add_sources(./nuclearDatabase_inter.f90 ./materialMenu_mod.f90 ./nuclearDataReg_mod.f90 ./neutronMaterial_inter.f90 + ./IMCMaterial_inter.f90 ./Reactions/reactionHandle_inter.f90 ./Reactions/uncorrelatedReactionCE_inter.f90 ./Reactions/reactionMG_inter.f90 diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index a175ff050..d1f7a579a 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -5,7 +5,7 @@ module IMCMaterial_inter ! Nuclear Data Interfaces use materialHandle_inter, only : materialHandle - use IMCXsPackages_class, only : IMCMacroXSs + use IMCXsPackages_class, only : IMCMacroXSs implicit none private From 04ff651d66adad84492693ada39df12654f3035b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 19:35:25 +0000 Subject: [PATCH 008/373] Changed file paths for selected input files --- InputFiles/JEZ | 12 ++++++++---- InputFiles/POPSY | 2 +- InputFiles/SCONE_Inf | 2 +- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/InputFiles/JEZ b/InputFiles/JEZ index 1f0ad50bc..3951a946d 100644 --- a/InputFiles/JEZ +++ b/InputFiles/JEZ @@ -1,8 +1,12 @@ type eigenPhysicsPackage; -pop 200000; -active 500; -inactive 20; +pop 10; +active 5; +inactive 2; + +//pop 200000; +//active 500; +//inactive 20; XSdata ceData; dataType ce; @@ -61,7 +65,7 @@ geometry { nuclearData { handles { - ceData { type aceNeutronDatabase; aceLibrary /home/mak60/myACE/JEF311.aceXS;} + ceData { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} } diff --git a/InputFiles/POPSY b/InputFiles/POPSY index 7e899df5a..5f738dccd 100644 --- a/InputFiles/POPSY +++ b/InputFiles/POPSY @@ -69,7 +69,7 @@ geometry { nuclearData { handles { - ce { type aceNeutronDatabase; aceLibrary /home/mak60/myACE/JEF311.aceXS;} + ce { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} } diff --git a/InputFiles/SCONE_Inf b/InputFiles/SCONE_Inf index 3bbf151d6..873cd955b 100644 --- a/InputFiles/SCONE_Inf +++ b/InputFiles/SCONE_Inf @@ -57,7 +57,7 @@ geometry { nuclearData { handles { - ce { type aceNeutronDatabase; aceLibrary /home/mak60/Cases/U235_Compr/XSDAT/JEF311.aceXS;} + ce { type aceNeutronDatabase; aceLibrary /home/ajb343/Cases/U235_Compr/XSDAT/JEF311.aceXS;} mg { type baseMgNeutronDatabase; PN P0;} } From 6460576a2d209bc46db70e2d34e8bf9a8849c591 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 19:36:48 +0000 Subject: [PATCH 009/373] Created new CollisionProcessors class for IMC - not yet working --- .../CollisionProcessors/CMakeLists.txt | 5 +- .../CollisionProcessors/IMCMGstd_class.f90 | 276 ++++++++++++++++++ .../collisionProcessorFactory_func.f90 | 8 +- 3 files changed, 286 insertions(+), 3 deletions(-) create mode 100644 CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 diff --git a/CollisionOperator/CollisionProcessors/CMakeLists.txt b/CollisionOperator/CollisionProcessors/CMakeLists.txt index ee923a0ed..3f50ec0fa 100644 --- a/CollisionOperator/CollisionProcessors/CMakeLists.txt +++ b/CollisionOperator/CollisionProcessors/CMakeLists.txt @@ -2,5 +2,6 @@ add_sources( ./collisionProcessor_inter.f90 ./collisionProcessorFactory_func.f90 ./neutronCEstd_class.f90 - ./neutronCEimp_class.f90 - ./neutronMGstd_class.f90) + ./neutronCEimp_class.f90 + ./neutronMGstd_class.f90 + ./IMCMGstd_class.f90) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 new file mode 100644 index 000000000..76a8c84d3 --- /dev/null +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -0,0 +1,276 @@ +module IMCMGstd_class + + use numPrecision + use endfConstants + use genericProcedures, only : fatalError, rotateVector, numToChar + use dictionary_class, only : dictionary + use RNG_class, only : RNG + + ! Particle types + use particle_class, only : particle, particleState, printType, P_NEUTRON + use particleDungeon_class, only : particleDungeon + + ! Abstract interface + use collisionProcessor_inter, only : collisionProcessor, collisionData ,init_super => init + + ! Nuclear Data Interface + use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase + use mgIMCMaterial_inter, only : mgIMCMaterial, mgIMCMaterial_CptrCast + use reactionHandle_inter, only : reactionHandle + use multiScatterMG_class, only : multiScatterMG, multiScatterMG_CptrCast + use fissionMG_class, only : fissionMG, fissionMG_TptrCast + + ! Cross section packages + use neutronXsPackages_class, only : neutronMacroXSs + + + ! Nuclear Data + !use nuclearData_inter, only : nuclearData + !use perMaterialNuclearDataMG_inter, only : perMaterialNuclearDataMG + + ! Cross-section packages to interface with nuclear data + !use xsMacroSet_class, only : xsMacroSet, xsMacroSet_ptr + + implicit none + private + + !! + !! Standard (default) scalar collision processor for MG IMCs + !! -> Preforms implicit fission site generation + !! -> Preforms analog capture + !! -> Treats fission as capture (only implicit generation of 2nd-ary IMCs) + !! -> Does not create secondary non-IMC projectiles + !! + !! Settings: + !! NONE + !! + !! Sample dictionary input: + !! collProcName { + !! type IMCMGstd; + !! } + !! + type, public, extends(collisionProcessor) :: IMCMGstd + private + class(mgIMCDatabase), pointer, public :: xsData => null() + class(mgIMCMaterial), pointer, public :: mat => null() + contains + ! Initialisation procedure + procedure :: init + + ! Implementation of customisable procedures + procedure :: sampleCollision + procedure :: implicit + procedure :: elastic + procedure :: inelastic + procedure :: capture + procedure :: fission + procedure :: cutoffs + end type IMCMGstd + +contains + + !! + !! Initialise from dictionary + !! + subroutine init(self, dict) + class(IMCMGstd), intent(inout) :: self + class(dictionary), intent(in) :: dict + character(100), parameter :: Here = 'init (IMCMGstd_class.f90)' + + ! Call superclass + call init_super(self, dict) + + end subroutine init + + !! + !! Samples collision without any implicit treatment + !! + subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) + class(IMCMGstd), intent(inout) :: self + class(particle), intent(inout) :: p + type(collisionData), intent(inout) :: collDat + class(particleDungeon),intent(inout) :: thisCycle + class(particleDungeon),intent(inout) :: nextCycle + type(neutronMacroXSs) :: macroXSs + real(defReal) :: r + character(100),parameter :: Here =' sampleCollision (IMCMGstd_class.f90)' + + ! Verify that particle is MG NEUTRON + if( .not. p % isMG .or. p % type /= P_NEUTRON) then + call fatalError(Here, 'Supports only MG NEUTRON. Was given CE '//printType(p % type)) + end if + + ! Verify and load nuclear data pointer + self % xsData => ndReg_getIMCMG() + if(.not.associated(self % xsData)) call fatalError(Here, "Failed to get active database for MG IMC") + + ! Get and verify material pointer + self % mat => mgIMCMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) + if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG IMC Material") + + ! Select Main reaction channel + call self % mat % getMacroXSs(macroXSs, p % G, p % pRNG) + r = p % pRNG % get() + + collDat % MT = macroXSs % invert(r) + + end subroutine sampleCollision + + !! + !! Preform implicit treatment + !! + subroutine implicit(self, p, collDat, thisCycle, nextCycle) + class(IMCMGstd), intent(inout) :: self + class(particle), intent(inout) :: p + type(collisionData), intent(inout) :: collDat + class(particleDungeon),intent(inout) :: thisCycle + class(particleDungeon),intent(inout) :: nextCycle + type(neutronMacroXSs) :: macroXSs + type(fissionMG),pointer :: fission + type(particleState) :: pTemp + real(defReal),dimension(3) :: r, dir + integer(shortInt) :: G_out, n, i + real(defReal) :: wgt, w0, rand1, mu, phi + real(defReal) :: sig_tot, k_eff, sig_nufiss + character(100),parameter :: Here = 'implicit (IMCMGstd_class.f90)' + + if ( self % mat % isFissile()) then + ! Obtain required data + wgt = p % w ! Current weight + w0 = p % preHistory % wgt ! Starting weight + k_eff = p % k_eff ! k_eff for normalisation + rand1 = p % pRNG % get() ! Random number to sample sites + + call self % mat % getMacroXSs(macroXSs, p % G, p % pRNG) + + sig_tot = macroXSs % total + sig_nuFiss = macroXSs % nuFission + + ! Sample number of fission sites generated + !n = int(wgt * sig_nuFiss/(sig_tot*k_eff) + r1, shortInt) + n = int(abs( (wgt * sig_nuFiss) / (w0 * sig_tot * k_eff)) + rand1, shortInt) + + ! Shortcut if no particles were samples + if (n < 1) return + + ! Get Fission reaction object + fission => fissionMG_TptrCast( self % xsData % getReaction(macroFission, collDat % matIdx)) + if (.not.associated(fission)) call fatalError(Here, 'Failed to getrive fissionMG reaction object') + + ! Store new sites in the next cycle dungeon + wgt = sign(w0, wgt) + r = p % rGlobal() + + do i=1,n + call fission % sampleOut(mu, phi, G_out, p % G, p % pRNG) + dir = rotateVector(p % dirGlobal(), mu, phi) + + ! Copy extra detail from parent particle (i.e. time, flags ect.) + pTemp = p + + ! Overwrite position, direction, energy group and weight + pTemp % r = r + pTemp % dir = dir + pTemp % G = G_out + pTemp % wgt = wgt + + call nextCycle % detain(pTemp) + end do + end if + + end subroutine implicit + + !! + !! Elastic Scattering + !! + subroutine elastic(self, p , collDat, thisCycle, nextCycle) + class(IMCMGstd), intent(inout) :: self + class(particle), intent(inout) :: p + type(collisionData), intent(inout) :: collDat + class(particleDungeon),intent(inout) :: thisCycle + class(particleDungeon),intent(inout) :: nextCycle + + ! Do nothing. Should not be called + + end subroutine elastic + + !! + !! Preform scattering + !! + subroutine inelastic(self, p, collDat, thisCycle, nextCycle) + class(IMCMGstd), intent(inout) :: self + class(particle), intent(inout) :: p + type(collisionData), intent(inout) :: collDat + class(particleDungeon),intent(inout) :: thisCycle + class(particleDungeon),intent(inout) :: nextCycle + class(multiScatterMG),pointer :: scatter + integer(shortInt) :: G_out ! Post-collision energy group + real(defReal) :: phi ! Azimuthal scatter angle + real(defReal) :: w_mul ! Weight multiplier + character(100),parameter :: Here = "inelastic (IMCMGstd_class.f90)" + + ! Assign MT number + collDat % MT = macroIEscatter + + ! Get Scatter object + scatter => multiScatterMG_CptrCast( self % xsData % getReaction(macroIEscatter, collDat % matIdx)) + if(.not.associated(scatter)) call fatalError(Here, "Failed to get scattering reaction object for MG IMC") + + ! Sample Mu and G_out + call scatter % sampleOut(collDat % muL, phi, G_out, p % G, p % pRNG) + + ! Read scattering multiplicity + w_mul = scatter % production(p % G, G_out) + + ! Update IMC state + p % G = G_out + p % w = p % w * w_mul + call p % rotate(collDat % muL, phi) + + end subroutine inelastic + + !! + !! Preform capture + !! + subroutine capture(self, p, collDat, thisCycle, nextCycle) + class(IMCMGstd), intent(inout) :: self + class(particle), intent(inout) :: p + type(collisionData), intent(inout) :: collDat + class(particleDungeon),intent(inout) :: thisCycle + class(particleDungeon),intent(inout) :: nextCycle + + p % isDead = .true. + + end subroutine capture + + !! + !! Preform fission + !! + subroutine fission(self, p, collDat, thisCycle, nextCycle) + class(IMCMGstd), intent(inout) :: self + class(particle), intent(inout) :: p + type(collisionData), intent(inout) :: collDat + class(particleDungeon),intent(inout) :: thisCycle + class(particleDungeon),intent(inout) :: nextCycle + + p % isDead = .true. + + end subroutine fission + + !! + !! Applay cutoffs or post-collision implicit treatment + !! + subroutine cutoffs(self, p, collDat, thisCycle, nextCycle) + class(IMCMGstd), intent(inout) :: self + class(particle), intent(inout) :: p + type(collisionData), intent(inout) :: collDat + class(particleDungeon),intent(inout) :: thisCycle + class(particleDungeon),intent(inout) :: nextCycle + + ! Do nothing + + end subroutine cutoffs + +end module IMCMGstd_class diff --git a/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 b/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 index 3f190f3a4..ce45809e7 100644 --- a/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 +++ b/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 @@ -11,6 +11,7 @@ module collisionProcessorFactory_func use neutronCEstd_class, only : neutronCEstd use neutronCEimp_class, only : neutronCEimp use neutronMGstd_class, only : neutronMGstd + use IMCMGstd_class, only : IMCMGstd implicit none private @@ -24,7 +25,8 @@ module collisionProcessorFactory_func ! For now it is necessary to adjust trailing blanks so all enteries have the same length character(nameLen),dimension(*),parameter :: AVALIBLE_collisionProcessors = [ 'neutronCEstd',& 'neutronCEimp',& - 'neutronMGstd'] + 'neutronMGstd',& + 'IMCMGstd '] contains @@ -59,6 +61,10 @@ subroutine new_collisionProcessor(new,dict) allocate(neutronMGstd :: new) call new % init(dict) + case('IMCMGstd') + allocate(IMCMGstd :: new) + call new % init(dict) + !*** NEW COLLISION PROCESSOR TEMPLATE ***! !case('') ! allocate( :: new) From 8d0c6af5f60f2de8d5589f00b712e3adc8f0d2a0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 19:39:09 +0000 Subject: [PATCH 010/373] Added temperature as a property to baseMgIMCMaterial_class --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index b1ca6f734..d2e57fc5d 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -9,8 +9,8 @@ module baseMgIMCMaterial_class ! Nuclear Data Interfaces use materialHandle_inter, only : materialHandle - use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill - use IMCXSPackages_class, only : IMCMacroXSs + use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill + use IMCXSPackages_class, only : IMCMacroXSs ! Reaction objects use reactionMG_inter, only : reactionMG @@ -71,6 +71,7 @@ module baseMgIMCMaterial_class real(defReal),dimension(:,:), allocatable :: data class(multiScatterMG), allocatable :: scatter type(fissionMG), allocatable :: fission + real(defReal), allocatable :: temperature contains ! Superclass procedures @@ -96,9 +97,10 @@ elemental subroutine kill(self) call kill_super(self) ! Kill local content - if(allocated(self % data)) deallocate(self % data) - if(allocated(self % scatter)) deallocate(self % scatter) - if(allocated(self % fission)) deallocate(self % fission) + if(allocated(self % data)) deallocate(self % data) + if(allocated(self % scatter)) deallocate(self % scatter) + if(allocated(self % fission)) deallocate(self % fission) + if(allocated(self % temperature)) deallocate(self % temperature) end subroutine kill @@ -142,7 +144,7 @@ end subroutine getMacroXSs_byG !! See mgIMCMaterial documentationfor details !! function getTotalXS(self, G, rand) result(xs) - class(baseMgIMCMaterial), intent(in) :: self + class(baseMgIMCMaterial), intent(in) :: self integer(shortInt), intent(in) :: G class(RNG), intent(inout) :: rand real(defReal) :: xs @@ -179,7 +181,7 @@ end function getTotalXS !! -> P1 !! subroutine init(self, dict, scatterKey) - class(baseMgIMCMaterial), intent(inout) :: self + class(baseMgIMCMaterial), intent(inout) :: self class(dictionary),target, intent(in) :: dict character(nameLen), intent(in) :: scatterKey integer(shortInt) :: nG, N, i @@ -269,6 +271,9 @@ subroutine init(self, dict, scatterKey) self % data(TOTAL_XS, i) = self % data(TOTAL_XS, i) + self % data(FISSION_XS, i) end if end do + + allocate(self % temperature) + end subroutine init !! From 677b4ffffd1067cb5f5021aaa1fbe3180c29e7d4 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 19:42:17 +0000 Subject: [PATCH 011/373] Cleaned up and added file for compilation --- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 2 +- NuclearData/xsPackages/CMakeLists.txt | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 64fc3e796..cfa443ba6 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -7,7 +7,7 @@ module mgIMCMaterial_inter ! Nuclear Data Handles use materialHandle_inter, only : materialHandle - use IMCMaterial_inter, only : IMCMaterial + use IMCMaterial_inter, only : IMCMaterial use IMCXsPackages_class, only : IMCMacroXSs implicit none diff --git a/NuclearData/xsPackages/CMakeLists.txt b/NuclearData/xsPackages/CMakeLists.txt index 0c91759d9..4993681e3 100644 --- a/NuclearData/xsPackages/CMakeLists.txt +++ b/NuclearData/xsPackages/CMakeLists.txt @@ -1 +1,2 @@ -add_sources(./neutronXsPackages_class.f90) \ No newline at end of file +add_sources(./neutronXsPackages_class.f90 + ./IMCXsPackages_class.f90) From f37dcaf5581339407c00a67fd73b8b8e73cbc4c2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 19:44:28 +0000 Subject: [PATCH 012/373] Defined new particle type P_IMC_MG - currently does nothing --- NuclearData/nuclearDataReg_mod.f90 | 4 ++-- ParticleObjects/particle_class.f90 | 2 +- SharedModules/universalVariables.f90 | 3 ++- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index 4e1a1b517..c0b70b65a 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -54,7 +54,7 @@ module nuclearDataReg_mod use numPrecision - use universalVariables, only : P_NEUTRON_CE, P_NEUTRON_MG + use universalVariables, only : P_NEUTRON_CE, P_NEUTRON_MG, P_IMC_MG use genericProcedures, only : fatalError, numToChar, printParticleType use charMap_class, only : charMap use dictionary_class, only : dictionary @@ -422,7 +422,7 @@ subroutine kill() active_mgNeutron => null() ! MG IMC - activeIdx_mgMC = 0 + activeIdx_mgIMC = 0 active_mgIMC => null() end subroutine kill diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index e88bd73d6..ad0e302f1 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -404,7 +404,7 @@ end function matIdx !! None !! !! Result: - !! P_NEUTRON_CE, P_NEUTRON_MG + !! P_NEUTRON_CE, P_NEUTRON_MG, P_IMC_MG !! !! Errors: !! None diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index fbad35b32..4dc80f14f 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -57,7 +57,8 @@ module universalVariables ! Particle Type Enumeration integer(shortInt), parameter :: P_NEUTRON_CE = 1, & - P_NEUTRON_MG = 2 + P_NEUTRON_MG = 2, & + P_IMC_MG = 3 ! Search error codes integer(shortInt), parameter :: valueOutsideArray = -1,& From 0bead6dae70798dd64219c3f37df397e0f4a3fba Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 17 Dec 2021 19:45:06 +0000 Subject: [PATCH 013/373] Created new input file for running changes --- InputFiles/IMCTest | 102 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 102 insertions(+) create mode 100644 InputFiles/IMCTest diff --git a/InputFiles/IMCTest b/InputFiles/IMCTest new file mode 100644 index 000000000..9274f7672 --- /dev/null +++ b/InputFiles/IMCTest @@ -0,0 +1,102 @@ +//type fixedSourcePhysicsPackage; +type eigenPhysicsPackage; + +pop 30; +active 10; +inactive 5; +cycles 10; + +XSdata mg; +dataType mg; + + +collisionOperator { + neutronMG {type neutronMGstd;} + } + +transportOperator { type transportOperatorDT; + } + + +//source { +// type pointSource; +// r (0 0 0); +// particle photon; +// E 14.1; +//} + +inactiveTally { + } + +activeTally { + norm fiss; + normVal 100; + fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + flux { type collisionClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + response (flux); flux {type fluxResponse;} + } + } + +tally { + display (k-eff); + norm fiss; + normVal 100.0; + k-eff { type keffAnalogClerk;} + fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + flux { type collisionClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + response (flux); flux {type fluxResponse;} + } + } + +geometry { + type geometryStd; + boundary (0 0 0 0 0 0); + graph {type shrunk;} + + surfaces + { + squareBound { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 6.3849; } + } + cells {} + universes + { + + root + { + id 1; + type rootUniverse; + border 1; + fill fuel; + } + } +} + +nuclearData { + + handles { + //ce { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + fuel { + temp 273; + composition { + 94239.03 0.037047; + 94240.03 0.0017512; + 94241.03 0.00011674; + 31000.03 0.0013752; + } + xsFile ./XS/URRa_2_1_XSS; + } + +} + +} + + + From 2d025aa00a195f4f03a9b2cfb877cb6531684b15 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 18:57:16 +0000 Subject: [PATCH 014/373] Updated to use IMCXsPackages_class --- CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 76a8c84d3..08977d555 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -23,7 +23,7 @@ module IMCMGstd_class use fissionMG_class, only : fissionMG, fissionMG_TptrCast ! Cross section packages - use neutronXsPackages_class, only : neutronMacroXSs + use IMCXsPackages_class, only : IMCMacroXSs ! Nuclear Data @@ -93,7 +93,7 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - type(neutronMacroXSs) :: macroXSs + type(IMCMacroXSs) :: macroXSs real(defReal) :: r character(100),parameter :: Here =' sampleCollision (IMCMGstd_class.f90)' @@ -127,7 +127,7 @@ subroutine implicit(self, p, collDat, thisCycle, nextCycle) type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - type(neutronMacroXSs) :: macroXSs + type(IMCMacroXSs) :: macroXSs type(fissionMG),pointer :: fission type(particleState) :: pTemp real(defReal),dimension(3) :: r, dir From 16fef0468648264cc2b9df7f9ff60a89b4b1d1b6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 19:14:18 +0000 Subject: [PATCH 015/373] Temporarily redirected P_NEUTRON_MG to use IMC database to use in input file --- NuclearData/nuclearDataReg_mod.f90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index c0b70b65a..7999ca972 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -326,14 +326,14 @@ subroutine activate(type, name, activeMat, silent) end if case(P_NEUTRON_MG) - activeIdx_mgNeutron = idx - active_mgNeutron => mgNeutronDatabase_CptrCast(ptr) - if(.not.associated(active_mgNeutron)) then - call fatalError(Here,trim(name)//' is not database for MG neutrons') - end if - - case(P_IMC_MG) - activeIdx_mgIMC = idx + ! activeIdx_mgNeutron = idx + ! active_mgNeutron => mgNeutronDatabase_CptrCast(ptr) + ! if(.not.associated(active_mgNeutron)) then + ! call fatalError(Here,trim(name)//' is not database for MG neutrons') + ! end if + + !case(P_IMC_MG) + activeIdx_mgIMC = idx ! Redirecting this to use mgIMCDatabase until figured out particle types active_mgIMC => mgIMCDatabase_CptrCast(ptr) if(.not.associated(active_mgIMC)) then call fatalError(Here,trim(name)//' is not database for MG IMC') @@ -508,10 +508,10 @@ function get_byType(type, where) result(ptr) ptr => getNeutronCE() case(P_NEUTRON_MG) - ptr => getNeutronMG() + ! ptr => getNeutronMG() - case(P_IMC_MG) - ptr => getIMCMG() + !case(P_IMC_MG) + ptr => getIMCMG() ! Redirecting this to use IMC until figured out particle types case default ptr => null() From 260123a99c11fcf67d0335901123acb0d25b5375 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 19:15:31 +0000 Subject: [PATCH 016/373] Changed test input file to use IMCMGstd collision operator --- InputFiles/IMCTest | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/InputFiles/IMCTest b/InputFiles/IMCTest index 9274f7672..502cc8e4a 100644 --- a/InputFiles/IMCTest +++ b/InputFiles/IMCTest @@ -11,7 +11,7 @@ dataType mg; collisionOperator { - neutronMG {type neutronMGstd;} + IMCMG {type IMCMGstd;} } transportOperator { type transportOperatorDT; From fdccb6b94213159f6a3b946907f523b18e68b99a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 21:06:35 +0000 Subject: [PATCH 017/373] Commented out fission attributes and procedures from relevant modules --- .../CollisionProcessors/IMCMGstd_class.f90 | 72 ++++++++--------- NuclearData/IMCMaterial_inter.f90 | 12 +-- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 14 ++-- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 78 +++++++++---------- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 28 +++---- 5 files changed, 102 insertions(+), 102 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 08977d555..5c9c8b076 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -20,7 +20,7 @@ module IMCMGstd_class use mgIMCMaterial_inter, only : mgIMCMaterial, mgIMCMaterial_CptrCast use reactionHandle_inter, only : reactionHandle use multiScatterMG_class, only : multiScatterMG, multiScatterMG_CptrCast - use fissionMG_class, only : fissionMG, fissionMG_TptrCast + !use fissionMG_class, only : fissionMG, fissionMG_TptrCast ! Cross section packages use IMCXsPackages_class, only : IMCMacroXSs @@ -98,7 +98,7 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) character(100),parameter :: Here =' sampleCollision (IMCMGstd_class.f90)' ! Verify that particle is MG NEUTRON - if( .not. p % isMG .or. p % type /= P_NEUTRON) then + if( .not. p % isMG .or. p % type /= P_NEUTRON) then ! (not yet integrated new particle type) call fatalError(Here, 'Supports only MG NEUTRON. Was given CE '//printType(p % type)) end if @@ -128,7 +128,7 @@ subroutine implicit(self, p, collDat, thisCycle, nextCycle) class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle type(IMCMacroXSs) :: macroXSs - type(fissionMG),pointer :: fission + !type(fissionMG),pointer :: fission type(particleState) :: pTemp real(defReal),dimension(3) :: r, dir integer(shortInt) :: G_out, n, i @@ -136,49 +136,49 @@ subroutine implicit(self, p, collDat, thisCycle, nextCycle) real(defReal) :: sig_tot, k_eff, sig_nufiss character(100),parameter :: Here = 'implicit (IMCMGstd_class.f90)' - if ( self % mat % isFissile()) then + !if ( self % mat % isFissile()) then ! Obtain required data - wgt = p % w ! Current weight - w0 = p % preHistory % wgt ! Starting weight - k_eff = p % k_eff ! k_eff for normalisation - rand1 = p % pRNG % get() ! Random number to sample sites + ! wgt = p % w ! Current weight + ! w0 = p % preHistory % wgt ! Starting weight + ! k_eff = p % k_eff ! k_eff for normalisation + ! rand1 = p % pRNG % get() ! Random number to sample sites - call self % mat % getMacroXSs(macroXSs, p % G, p % pRNG) + ! call self % mat % getMacroXSs(macroXSs, p % G, p % pRNG) - sig_tot = macroXSs % total - sig_nuFiss = macroXSs % nuFission + ! sig_tot = macroXSs % total + ! sig_nuFiss = macroXSs % nuFission - ! Sample number of fission sites generated - !n = int(wgt * sig_nuFiss/(sig_tot*k_eff) + r1, shortInt) - n = int(abs( (wgt * sig_nuFiss) / (w0 * sig_tot * k_eff)) + rand1, shortInt) + ! ! Sample number of fission sites generated + ! !n = int(wgt * sig_nuFiss/(sig_tot*k_eff) + r1, shortInt) + ! n = int(abs( (wgt * sig_nuFiss) / (w0 * sig_tot * k_eff)) + rand1, shortInt) - ! Shortcut if no particles were samples - if (n < 1) return + ! ! Shortcut if no particles were samples + ! if (n < 1) return - ! Get Fission reaction object - fission => fissionMG_TptrCast( self % xsData % getReaction(macroFission, collDat % matIdx)) - if (.not.associated(fission)) call fatalError(Here, 'Failed to getrive fissionMG reaction object') + ! ! Get Fission reaction object + ! fission => fissionMG_TptrCast( self % xsData % getReaction(macroFission, collDat % matIdx)) + ! if (.not.associated(fission)) call fatalError(Here, 'Failed to getrive fissionMG reaction object') - ! Store new sites in the next cycle dungeon - wgt = sign(w0, wgt) - r = p % rGlobal() + ! ! Store new sites in the next cycle dungeon + ! wgt = sign(w0, wgt) + ! r = p % rGlobal() - do i=1,n - call fission % sampleOut(mu, phi, G_out, p % G, p % pRNG) - dir = rotateVector(p % dirGlobal(), mu, phi) + ! do i=1,n + ! call fission % sampleOut(mu, phi, G_out, p % G, p % pRNG) + ! dir = rotateVector(p % dirGlobal(), mu, phi) - ! Copy extra detail from parent particle (i.e. time, flags ect.) - pTemp = p + ! ! Copy extra detail from parent particle (i.e. time, flags ect.) + ! pTemp = p - ! Overwrite position, direction, energy group and weight - pTemp % r = r - pTemp % dir = dir - pTemp % G = G_out - pTemp % wgt = wgt + ! ! Overwrite position, direction, energy group and weight + ! pTemp % r = r + ! pTemp % dir = dir + ! pTemp % G = G_out + ! pTemp % wgt = wgt - call nextCycle % detain(pTemp) - end do - end if + ! call nextCycle % detain(pTemp) + ! end do + !end if end subroutine implicit @@ -255,7 +255,7 @@ subroutine fission(self, p, collDat, thisCycle, nextCycle) class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - p % isDead = .true. + ! p % isDead = .true. end subroutine fission diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index d1f7a579a..6224230eb 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -30,7 +30,7 @@ module IMCMaterial_inter private contains generic :: getMacroXSs => getMacroXSs_byP - procedure(isFissile), deferred :: isFissile + !procedure(isFissile), deferred :: isFissile procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP end type IMCMaterial @@ -44,11 +44,11 @@ module IMCMaterial_inter !! Errors: !! None !! - elemental function isFissile(self) result(isIt) - import :: IMCMaterial, defBool - class(IMCMaterial), intent(in) :: self - logical(defBool) :: isIt - end function isFissile + !elemental function isFissile(self) result(isIt) + ! import :: IMCMaterial, defBool + ! class(IMCMaterial), intent(in) :: self + ! logical(defBool) :: isIt + !end function isFissile !! !! Return Macroscopic XSs for the material given particle diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 3aae1bfb2..8ba6eef18 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -201,13 +201,13 @@ function getReaction(self, MT, idx) result(reac) ! Select correct reaction select case(MT) - case(macroFission) - ! Point to null if material is not fissile - if (self % mats(idx) % isFissile()) then - reac => self % mats(idx) % fission - else - reac => null() - end if + !case(macroFission) + ! ! Point to null if material is not fissile + ! if (self % mats(idx) % isFissile()) then + ! reac => self % mats(idx) % fission + ! else + ! reac => null() + ! end if case(macroIEScatter) reac => self % mats(idx) % scatter diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index d2e57fc5d..77f47a955 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -14,7 +14,7 @@ module baseMgIMCMaterial_class ! Reaction objects use reactionMG_inter, only : reactionMG - use fissionMG_class, only : fissionMG + !use fissionMG_class, only : fissionMG use multiScatterMG_class, only : multiScatterMG use multiScatterP1MG_class, only : multiScatterP1MG @@ -32,8 +32,8 @@ module baseMgIMCMaterial_class integer(shortInt), parameter, public :: TOTAL_XS = 1 integer(shortInt), parameter, public :: IESCATTER_XS = 2 integer(shortInt), parameter, public :: CAPTURE_XS = 3 - integer(shortInt), parameter, public :: FISSION_XS = 4 - integer(shortInt), parameter, public :: NU_FISSION = 5 + !integer(shortInt), parameter, public :: FISSION_XS = 4 + !integer(shortInt), parameter, public :: NU_FISSION = 5 !! !! Basic type of MG material data @@ -70,7 +70,7 @@ module baseMgIMCMaterial_class type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data class(multiScatterMG), allocatable :: scatter - type(fissionMG), allocatable :: fission + !type(fissionMG), allocatable :: fission real(defReal), allocatable :: temperature contains @@ -99,7 +99,7 @@ elemental subroutine kill(self) ! Kill local content if(allocated(self % data)) deallocate(self % data) if(allocated(self % scatter)) deallocate(self % scatter) - if(allocated(self % fission)) deallocate(self % fission) + !if(allocated(self % fission)) deallocate(self % fission) if(allocated(self % temperature)) deallocate(self % temperature) end subroutine kill @@ -128,13 +128,13 @@ subroutine getMacroXSs_byG(self, xss, G, rand) xss % inelasticScatter = self % data(IESCATTER_XS, G) xss % capture = self % data(CAPTURE_XS, G) - if(self % isFissile()) then - xss % fission = self % data(FISSION_XS, G) - xss % nuFission = self % data(NU_FISSION, G) - else - xss % fission = ZERO - xss % nuFission = ZERO - end if + !if(self % isFissile()) then + ! xss % fission = self % data(FISSION_XS, G) + ! xss % nuFission = self % data(NU_FISSION, G) + !else + ! xss % fission = ZERO + ! xss % nuFission = ZERO + !end if end subroutine getMacroXSs_byG @@ -195,7 +195,7 @@ subroutine init(self, dict, scatterKey) if(nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) ! Set fissile flag - call self % set(fissile = dict % isPresent('fission')) + !call self % set(fissile = dict % isPresent('fission')) ! Build scattering reaction ! Prepare input deck @@ -218,15 +218,15 @@ subroutine init(self, dict, scatterKey) call self % scatter % init(deck, macroAllScatter) ! Deal with fission - if(self % isFissile()) allocate(self % fission) - if(self % isFissile()) call self % fission % init(deck, macroFission) + !if(self % isFissile()) allocate(self % fission) + !if(self % isFissile()) call self % fission % init(deck, macroFission) ! Allocate space for data - if(self % isFissile()) then - N = 5 - else + !if(self % isFissile()) then + ! N = 5 + !else N = 3 - end if + !end if allocate(self % data(N, nG)) @@ -246,30 +246,30 @@ subroutine init(self, dict, scatterKey) self % data(IESCATTER_XS,:) = self % scatter % scatterXSs ! Load Fission-data - if( self % isFissile()) then - ! Load Fission - call dict % get(temp, 'fission') - if(size(temp) /= nG) then - call fatalError(Here,'Fission XSs have wong size. Must be: ' & - // numToChar(nG)//' is '//numToChar(size(temp))) - end if - self % data(FISSION_XS,:) = temp - - ! Calculate nuFission - call dict % get(temp, 'nu') - if(size(temp) /= nG) then - call fatalError(Here,'Nu vector has wong size. Must be: ' & - // numToChar(nG)//' is '//numToChar(size(temp))) - end if - self % data(NU_FISSION,:) = temp * self % data(FISSION_XS,:) - end if + !if( self % isFissile()) then + ! ! Load Fission + ! call dict % get(temp, 'fission') + ! if(size(temp) /= nG) then + ! call fatalError(Here,'Fission XSs have wong size. Must be: ' & + ! // numToChar(nG)//' is '//numToChar(size(temp))) + ! end if + ! self % data(FISSION_XS,:) = temp + + ! ! Calculate nuFission + ! call dict % get(temp, 'nu') + ! if(size(temp) /= nG) then + ! call fatalError(Here,'Nu vector has wong size. Must be: ' & + ! // numToChar(nG)//' is '//numToChar(size(temp))) + ! end if + ! self % data(NU_FISSION,:) = temp * self % data(FISSION_XS,:) + !end if ! Calculate total XS do i =1,nG self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) - if(self % isFissile()) then - self % data(TOTAL_XS, i) = self % data(TOTAL_XS, i) + self % data(FISSION_XS, i) - end if + !if(self % isFissile()) then + ! self % data(TOTAL_XS, i) = self % data(TOTAL_XS, i) + self % data(FISSION_XS, i) + !end if end do allocate(self % temperature) diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index cfa443ba6..edf75b3e5 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -37,7 +37,7 @@ module mgIMCMaterial_inter !! type, public, abstract, extends(IMCMaterial) :: mgIMCMaterial private - logical(defBool) :: fissile = .false. + !logical(defBool) :: fissile = .false. contains ! Superclass procedures @@ -48,8 +48,8 @@ module mgIMCMaterial_inter ! Local procedures procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG procedure(getTotalXS), deferred :: getTotalXS - procedure :: isFissile - procedure :: set + !procedure :: isFissile + !procedure :: set end type mgIMCMaterial @@ -128,13 +128,13 @@ end subroutine getMacroXSs_byP !! Errors: !! None !! - elemental function isFissile(self) result(isIt) - class(mgIMCMaterial), intent(in) :: self - logical(defBool) :: isIt + !elemental function isFissile(self) result(isIt) + ! class(mgIMCMaterial), intent(in) :: self + ! logical(defBool) :: isIt - isIt = self % fissile + ! isIt = self % fissile - end function isFissile + !end function isFissile !! !! Return to uninitialised state @@ -142,7 +142,7 @@ end function isFissile elemental subroutine kill(self) class(mgIMCMaterial), intent(inout) :: self - self % fissile = .false. + !self % fissile = .false. end subroutine kill @@ -155,13 +155,13 @@ end subroutine kill !! Args: !! fissile [in] -> flag indicating whether fission data is present !! - subroutine set(self, fissile) - class(mgIMCMaterial), intent(inout) :: self - logical(defBool), intent(in), optional :: fissile + !subroutine set(self, fissile) + ! class(mgIMCMaterial), intent(inout) :: self + ! logical(defBool), intent(in), optional :: fissile - if(present(fissile)) self % fissile = fissile + ! if(present(fissile)) self % fissile = fissile - end subroutine set + !end subroutine set !! !! Cast materialHandle pointer to mgIMCMaterial pointer From a883b4d73e0847744c9f550a161ed0434d81e84f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 21:37:41 +0000 Subject: [PATCH 018/373] Added support for P_PHOTON_MG --- CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 | 8 ++++---- CollisionOperator/collisionOperator_class.f90 | 5 +++++ SharedModules/universalVariables.f90 | 2 +- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 5c9c8b076..502cbf565 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -7,7 +7,7 @@ module IMCMGstd_class use RNG_class, only : RNG ! Particle types - use particle_class, only : particle, particleState, printType, P_NEUTRON + use particle_class, only : particle, particleState, printType, P_PHOTON use particleDungeon_class, only : particleDungeon ! Abstract interface @@ -97,9 +97,9 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) real(defReal) :: r character(100),parameter :: Here =' sampleCollision (IMCMGstd_class.f90)' - ! Verify that particle is MG NEUTRON - if( .not. p % isMG .or. p % type /= P_NEUTRON) then ! (not yet integrated new particle type) - call fatalError(Here, 'Supports only MG NEUTRON. Was given CE '//printType(p % type)) + ! Verify that particle is MG PHOTON + if( .not. p % isMG .or. p % type /= P_PHOTON) then + call fatalError(Here, 'Supports only MG PHOTON. Was given NEUTRON and/or CE '//printType(p % type)) end if ! Verify and load nuclear data pointer diff --git a/CollisionOperator/collisionOperator_class.f90 b/CollisionOperator/collisionOperator_class.f90 index 07ee57a49..7c548a830 100644 --- a/CollisionOperator/collisionOperator_class.f90 +++ b/CollisionOperator/collisionOperator_class.f90 @@ -83,6 +83,11 @@ subroutine init(self, dict) self % lookupTable(P_MG, P_NEUTRON) = 2 end if + if(dict % isPresent('photonMG')) then + call new_collisionProcessor(self % physicsTable(3) % proc, dict % getDictPtr('photonMG')) + self % lookupTable(P_MG, P_PHOTON) = 3 + end if + end subroutine init !! diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index 4dc80f14f..183b48efc 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -58,7 +58,7 @@ module universalVariables ! Particle Type Enumeration integer(shortInt), parameter :: P_NEUTRON_CE = 1, & P_NEUTRON_MG = 2, & - P_IMC_MG = 3 + P_PHOTON_MG = 3 ! Search error codes integer(shortInt), parameter :: valueOutsideArray = -1,& From 36cf449f3a052ab5f593fda74dacda1c6df788d4 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 21:39:00 +0000 Subject: [PATCH 019/373] Changed references of P_IMC_MG to P_PHOTON_MG --- NuclearData/nuclearDataReg_mod.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index 7999ca972..1fa370c63 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -54,7 +54,7 @@ module nuclearDataReg_mod use numPrecision - use universalVariables, only : P_NEUTRON_CE, P_NEUTRON_MG, P_IMC_MG + use universalVariables, only : P_NEUTRON_CE, P_NEUTRON_MG, P_PHOTON_MG use genericProcedures, only : fatalError, numToChar, printParticleType use charMap_class, only : charMap use dictionary_class, only : dictionary @@ -332,8 +332,8 @@ subroutine activate(type, name, activeMat, silent) ! call fatalError(Here,trim(name)//' is not database for MG neutrons') ! end if - !case(P_IMC_MG) - activeIdx_mgIMC = idx ! Redirecting this to use mgIMCDatabase until figured out particle types + !case(P_PHOTON_MG) + activeIdx_mgIMC = idx ! Redirecting this until figured out why neutrons are being used active_mgIMC => mgIMCDatabase_CptrCast(ptr) if(.not.associated(active_mgIMC)) then call fatalError(Here,trim(name)//' is not database for MG IMC') @@ -510,8 +510,8 @@ function get_byType(type, where) result(ptr) case(P_NEUTRON_MG) ! ptr => getNeutronMG() - !case(P_IMC_MG) - ptr => getIMCMG() ! Redirecting this to use IMC until figured out particle types + !case(P_PHOTON_MG) + ptr => getIMCMG() ! Redirecting this until figured out why neutrons are being used case default ptr => null() From 68d8488133599184dbea6b48ad30412e9d34e38b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 21:40:43 +0000 Subject: [PATCH 020/373] Changed IMCTest input file to fixed source calculation and using correct collision operator --- InputFiles/IMCTest | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/InputFiles/IMCTest b/InputFiles/IMCTest index 502cc8e4a..891983029 100644 --- a/InputFiles/IMCTest +++ b/InputFiles/IMCTest @@ -1,5 +1,5 @@ -//type fixedSourcePhysicsPackage; -type eigenPhysicsPackage; +type fixedSourcePhysicsPackage; +//type eigenPhysicsPackage; pop 30; active 10; @@ -11,27 +11,27 @@ dataType mg; collisionOperator { - IMCMG {type IMCMGstd;} + photonMG {type IMCMGstd;} } transportOperator { type transportOperatorDT; } -//source { -// type pointSource; -// r (0 0 0); -// particle photon; -// E 14.1; -//} +source { + type pointSource; + r (0 0 0); + particle photon; + G 1; +} inactiveTally { } activeTally { - norm fiss; + //norm fiss; normVal 100; - fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} flux { type collisionClerk; map { type energyMap; grid log; min 0.001; max 20; N 300;} response (flux); flux {type fluxResponse;} @@ -40,10 +40,10 @@ activeTally { tally { display (k-eff); - norm fiss; + //norm fiss; normVal 100.0; k-eff { type keffAnalogClerk;} - fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} flux { type collisionClerk; map { type energyMap; grid log; min 0.001; max 20; N 300;} response (flux); flux {type fluxResponse;} From f5abd645ed07420342b21a557dcc3418708a2ad2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 22:12:14 +0000 Subject: [PATCH 021/373] Removed fission comments, cleaned up code to make more aesthetic --- .../CollisionProcessors/IMCMGstd_class.f90 | 77 ++++--------------- NuclearData/IMCMaterial_inter.f90 | 24 +----- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 33 ++++---- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 56 +------------- NuclearData/mgIMCData/mgIMCDatabase_inter.f90 | 2 +- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 57 ++------------ NuclearData/nuclearDataReg_mod.f90 | 4 +- 7 files changed, 44 insertions(+), 209 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 502cbf565..3bea11809 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -20,10 +20,9 @@ module IMCMGstd_class use mgIMCMaterial_inter, only : mgIMCMaterial, mgIMCMaterial_CptrCast use reactionHandle_inter, only : reactionHandle use multiScatterMG_class, only : multiScatterMG, multiScatterMG_CptrCast - !use fissionMG_class, only : fissionMG, fissionMG_TptrCast ! Cross section packages - use IMCXsPackages_class, only : IMCMacroXSs + use IMCXsPackages_class, only : IMCMacroXSs ! Nuclear Data @@ -75,7 +74,7 @@ module IMCMGstd_class !! Initialise from dictionary !! subroutine init(self, dict) - class(IMCMGstd), intent(inout) :: self + class(IMCMGstd), intent(inout) :: self class(dictionary), intent(in) :: dict character(100), parameter :: Here = 'init (IMCMGstd_class.f90)' @@ -88,12 +87,12 @@ end subroutine init !! Samples collision without any implicit treatment !! subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) - class(IMCMGstd), intent(inout) :: self + class(IMCMGstd), intent(inout) :: self class(particle), intent(inout) :: p type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - type(IMCMacroXSs) :: macroXSs + type(IMCMacroXSs) :: macroXSs real(defReal) :: r character(100),parameter :: Here =' sampleCollision (IMCMGstd_class.f90)' @@ -122,63 +121,13 @@ end subroutine sampleCollision !! Preform implicit treatment !! subroutine implicit(self, p, collDat, thisCycle, nextCycle) - class(IMCMGstd), intent(inout) :: self + class(IMCMGstd), intent(inout) :: self class(particle), intent(inout) :: p type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - type(IMCMacroXSs) :: macroXSs - !type(fissionMG),pointer :: fission - type(particleState) :: pTemp - real(defReal),dimension(3) :: r, dir - integer(shortInt) :: G_out, n, i - real(defReal) :: wgt, w0, rand1, mu, phi - real(defReal) :: sig_tot, k_eff, sig_nufiss - character(100),parameter :: Here = 'implicit (IMCMGstd_class.f90)' - - !if ( self % mat % isFissile()) then - ! Obtain required data - ! wgt = p % w ! Current weight - ! w0 = p % preHistory % wgt ! Starting weight - ! k_eff = p % k_eff ! k_eff for normalisation - ! rand1 = p % pRNG % get() ! Random number to sample sites - - ! call self % mat % getMacroXSs(macroXSs, p % G, p % pRNG) - - ! sig_tot = macroXSs % total - ! sig_nuFiss = macroXSs % nuFission - - ! ! Sample number of fission sites generated - ! !n = int(wgt * sig_nuFiss/(sig_tot*k_eff) + r1, shortInt) - ! n = int(abs( (wgt * sig_nuFiss) / (w0 * sig_tot * k_eff)) + rand1, shortInt) - - ! ! Shortcut if no particles were samples - ! if (n < 1) return - - ! ! Get Fission reaction object - ! fission => fissionMG_TptrCast( self % xsData % getReaction(macroFission, collDat % matIdx)) - ! if (.not.associated(fission)) call fatalError(Here, 'Failed to getrive fissionMG reaction object') - - ! ! Store new sites in the next cycle dungeon - ! wgt = sign(w0, wgt) - ! r = p % rGlobal() - - ! do i=1,n - ! call fission % sampleOut(mu, phi, G_out, p % G, p % pRNG) - ! dir = rotateVector(p % dirGlobal(), mu, phi) - - ! ! Copy extra detail from parent particle (i.e. time, flags ect.) - ! pTemp = p - - ! ! Overwrite position, direction, energy group and weight - ! pTemp % r = r - ! pTemp % dir = dir - ! pTemp % G = G_out - ! pTemp % wgt = wgt - - ! call nextCycle % detain(pTemp) - ! end do - !end if + + ! Do nothing. Should not be called end subroutine implicit @@ -186,7 +135,7 @@ end subroutine implicit !! Elastic Scattering !! subroutine elastic(self, p , collDat, thisCycle, nextCycle) - class(IMCMGstd), intent(inout) :: self + class(IMCMGstd), intent(inout) :: self class(particle), intent(inout) :: p type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle @@ -200,7 +149,7 @@ end subroutine elastic !! Preform scattering !! subroutine inelastic(self, p, collDat, thisCycle, nextCycle) - class(IMCMGstd), intent(inout) :: self + class(IMCMGstd), intent(inout) :: self class(particle), intent(inout) :: p type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle @@ -235,7 +184,7 @@ end subroutine inelastic !! Preform capture !! subroutine capture(self, p, collDat, thisCycle, nextCycle) - class(IMCMGstd), intent(inout) :: self + class(IMCMGstd), intent(inout) :: self class(particle), intent(inout) :: p type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle @@ -249,13 +198,13 @@ end subroutine capture !! Preform fission !! subroutine fission(self, p, collDat, thisCycle, nextCycle) - class(IMCMGstd), intent(inout) :: self + class(IMCMGstd), intent(inout) :: self class(particle), intent(inout) :: p type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - ! p % isDead = .true. + ! Do nothing. Should not be called end subroutine fission @@ -263,7 +212,7 @@ end subroutine fission !! Applay cutoffs or post-collision implicit treatment !! subroutine cutoffs(self, p, collDat, thisCycle, nextCycle) - class(IMCMGstd), intent(inout) :: self + class(IMCMGstd), intent(inout) :: self class(particle), intent(inout) :: p type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 6224230eb..858fd3004 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -22,33 +22,17 @@ module IMCMaterial_inter !! tallying where one is not interested whether MG or CE data is used !! !! Interface: - !! materialHandle interface - !! isFissle -> Return true if material is fissile + !! materialHandle interface !! getMacroXSs -> Return Macroscopic XSs given particle with energy data !! type, public, abstract, extends(materialHandle) :: IMCMaterial private contains generic :: getMacroXSs => getMacroXSs_byP - !procedure(isFissile), deferred :: isFissile procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP end type IMCMaterial abstract interface - !! - !! Return .true. if the MG material is fissile - !! - !! Args: - !! None - !! - !! Errors: - !! None - !! - !elemental function isFissile(self) result(isIt) - ! import :: IMCMaterial, defBool - ! class(IMCMaterial), intent(in) :: self - ! logical(defBool) :: isIt - !end function isFissile !! !! Return Macroscopic XSs for the material given particle @@ -63,8 +47,8 @@ module IMCMaterial_inter !! subroutine getMacroXSs_byP(self, xss, p) import :: IMCMaterial, particle, IMCMacroXSs - class(IMCMaterial), intent(in) :: self - type(IMCMacroXSs), intent(out) :: xss + class(IMCMaterial), intent(in) :: self + type(IMCMacroXSs), intent(out) :: xss class(particle), intent(in) :: p end subroutine getMacroXSs_byP @@ -85,7 +69,7 @@ end subroutine getMacroXSs_byP !! pure function IMCMaterial_CptrCast(source) result(ptr) class(materialHandle), pointer, intent(in) :: source - class(IMCMaterial), pointer :: ptr + class(IMCMaterial), pointer :: ptr select type(source) class is(IMCMaterial) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 8ba6eef18..5ca565d7e 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -10,7 +10,7 @@ module baseMgIMCDatabase_class ! Nuclear Data Interfaces use nuclearDatabase_inter, only : nuclearDatabase - use mgIMCDatabase_inter, only : mgIMCDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase use materialHandle_inter, only : materialHandle use nuclideHandle_inter, only : nuclideHandle use reactionHandle_inter, only : reactionHandle @@ -43,7 +43,7 @@ module baseMgIMCDatabase_class !! nuclearDatabase interface !! type, public, extends(mgIMCDatabase) :: baseMgIMCDatabase - type(baseMgIMCMaterial), dimension(:), pointer :: mats => null() + type(baseMgIMCMaterial), dimension(:), pointer :: mats => null() integer(shortInt), dimension(:), allocatable :: activeMats integer(shortInt) :: nG = 0 @@ -83,7 +83,7 @@ module baseMgIMCDatabase_class !! } !! function getTransMatXS(self, p, matIdx) result(xs) - class(baseMgIMCDatabase), intent(inout) :: self + class(baseMgIMCDatabase), intent(inout) :: self class(particle), intent(in) :: p integer(shortInt), intent(in) :: matIdx real(defReal) :: xs @@ -102,7 +102,7 @@ end function getTransMatXS !! if the value is invalid !! function getTotalMatXS(self, p, matIdx) result(xs) - class(baseMgIMCDatabase), intent(inout) :: self + class(baseMgIMCDatabase), intent(inout) :: self class(particle), intent(in) :: p integer(shortInt), intent(in) :: matIdx real(defReal) :: xs @@ -121,7 +121,7 @@ end function getTotalMatXS !! if the value is invalid !! function getMajorantXS(self, p) result(xs) - class(baseMgIMCDatabase), intent(inout) :: self + class(baseMgIMCDatabase), intent(inout) :: self class(particle), intent(in) :: p real(defReal) :: xs integer(shortInt) :: i, idx @@ -140,7 +140,7 @@ end function getMajorantXS !! See nuclearDatabase documentation for details !! function matNamesMap(self) result(map) - class(baseMgIMCDatabase), intent(in) :: self + class(baseMgIMCDatabase), intent(in) :: self type(charMap), pointer :: map map => mm_nameMap @@ -153,7 +153,7 @@ end function matNamesMap !! See nuclearDatabase documentation for details !! function getMaterial(self, matIdx) result(mat) - class(baseMgIMCDatabase), intent(in) :: self + class(baseMgIMCDatabase), intent(in) :: self integer(shortInt), intent(in) :: matIdx class(materialHandle), pointer :: mat @@ -174,7 +174,7 @@ end function getMaterial !! This database has no nucldie. Returns NULL always! !! function getNuclide(self, nucIdx) result(nuc) - class(baseMgIMCDatabase), intent(in) :: self + class(baseMgIMCDatabase), intent(in) :: self integer(shortInt), intent(in) :: nucIdx class(nuclideHandle), pointer :: nuc @@ -188,7 +188,7 @@ end function getNuclide !! See nuclearDatabase documentation for details !! function getReaction(self, MT, idx) result(reac) - class(baseMgIMCDatabase), intent(in) :: self + class(baseMgIMCDatabase), intent(in) :: self integer(shortInt), intent(in) :: MT integer(shortInt), intent(in) :: idx class(reactionHandle), pointer :: reac @@ -201,13 +201,6 @@ function getReaction(self, MT, idx) result(reac) ! Select correct reaction select case(MT) - !case(macroFission) - ! ! Point to null if material is not fissile - ! if (self % mats(idx) % isFissile()) then - ! reac => self % mats(idx) % fission - ! else - ! reac => null() - ! end if case(macroIEScatter) reac => self % mats(idx) % scatter @@ -241,7 +234,7 @@ end subroutine kill !! See nuclearDatabase documentation for details !! subroutine init(self, dict, ptr, silent) - class(baseMgIMCDatabase), target,intent(inout) :: self + class(baseMgIMCDatabase), target,intent(inout) :: self class(dictionary), intent(in) :: dict class(nuclearDatabase), pointer,intent(in) :: ptr logical(defBool), intent(in), optional :: silent @@ -322,7 +315,7 @@ end subroutine activate !! None !! pure function nGroups(self) result(nG) - class(baseMgIMCDatabase), intent(in) :: self + class(baseMgIMCDatabase), intent(in) :: self integer(shortInt) :: nG nG = self % nG @@ -341,7 +334,7 @@ end function nGroups !! pure function baseMgIMCDatabase_TptrCast(source) result(ptr) class(nuclearDatabase), pointer, intent(in) :: source - type(baseMgIMCDatabase), pointer :: ptr + type(baseMgIMCDatabase), pointer :: ptr select type(source) type is(baseMgIMCDatabase) @@ -365,7 +358,7 @@ end function baseMgIMCDatabase_TptrCast !! pure function baseMgIMCDatabase_CptrCast(source) result(ptr) class(nuclearDatabase), pointer, intent(in) :: source - class(baseMgIMCDatabase), pointer :: ptr + class(baseMgIMCDatabase), pointer :: ptr select type(source) class is(baseMgIMCDatabase) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 77f47a955..417f2a750 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -14,7 +14,6 @@ module baseMgIMCMaterial_class ! Reaction objects use reactionMG_inter, only : reactionMG - !use fissionMG_class, only : fissionMG use multiScatterMG_class, only : multiScatterMG use multiScatterP1MG_class, only : multiScatterP1MG @@ -32,14 +31,11 @@ module baseMgIMCMaterial_class integer(shortInt), parameter, public :: TOTAL_XS = 1 integer(shortInt), parameter, public :: IESCATTER_XS = 2 integer(shortInt), parameter, public :: CAPTURE_XS = 3 - !integer(shortInt), parameter, public :: FISSION_XS = 4 - !integer(shortInt), parameter, public :: NU_FISSION = 5 !! !! Basic type of MG material data !! !! Stores MG data in a table. - !! Fission is treated as a seperate reaction !! All other scattering reactions are lumped into single multiplicative scattering, !! which is stored as INELASTIC scatering in macroXSs package! After all it is inelastic in !! the sense that outgoing group can change. Diffrent types of multiplicative scattering can be @@ -62,7 +58,6 @@ module baseMgIMCMaterial_class !! -> scatteringMultiplicity [nGxnG] !! -> P0 [nGxnG] !! Optional entries: - !! -> fission [nGx1] !! -> nu [nGx1] !! -> chi [nGx1] !! -> P# [nGxnG] @@ -70,7 +65,6 @@ module baseMgIMCMaterial_class type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data class(multiScatterMG), allocatable :: scatter - !type(fissionMG), allocatable :: fission real(defReal), allocatable :: temperature contains @@ -99,7 +93,6 @@ elemental subroutine kill(self) ! Kill local content if(allocated(self % data)) deallocate(self % data) if(allocated(self % scatter)) deallocate(self % scatter) - !if(allocated(self % fission)) deallocate(self % fission) if(allocated(self % temperature)) deallocate(self % temperature) end subroutine kill @@ -110,8 +103,8 @@ end subroutine kill !! See mgIMCMaterial documentation for more details !! subroutine getMacroXSs_byG(self, xss, G, rand) - class(baseMgIMCMaterial), intent(in) :: self - type(IMCMacroXSs), intent(out) :: xss + class(baseMgIMCMaterial), intent(in) :: self + type(IMCMacroXSs), intent(out) :: xss integer(shortInt), intent(in) :: G class(RNG), intent(inout) :: rand character(100), parameter :: Here = ' getMacroXSs (baseMgIMCMaterial_class.f90)' @@ -128,14 +121,6 @@ subroutine getMacroXSs_byG(self, xss, G, rand) xss % inelasticScatter = self % data(IESCATTER_XS, G) xss % capture = self % data(CAPTURE_XS, G) - !if(self % isFissile()) then - ! xss % fission = self % data(FISSION_XS, G) - ! xss % nuFission = self % data(NU_FISSION, G) - !else - ! xss % fission = ZERO - ! xss % nuFission = ZERO - !end if - end subroutine getMacroXSs_byG !! @@ -194,9 +179,6 @@ subroutine init(self, dict, scatterKey) call dict % get(nG, 'numberOfGroups') if(nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) - ! Set fissile flag - !call self % set(fissile = dict % isPresent('fission')) - ! Build scattering reaction ! Prepare input deck deck % dict => dict @@ -217,16 +199,8 @@ subroutine init(self, dict, scatterKey) ! Initialise call self % scatter % init(deck, macroAllScatter) - ! Deal with fission - !if(self % isFissile()) allocate(self % fission) - !if(self % isFissile()) call self % fission % init(deck, macroFission) - ! Allocate space for data - !if(self % isFissile()) then - ! N = 5 - !else - N = 3 - !end if + N = 3 allocate(self % data(N, nG)) @@ -245,31 +219,9 @@ subroutine init(self, dict, scatterKey) end if self % data(IESCATTER_XS,:) = self % scatter % scatterXSs - ! Load Fission-data - !if( self % isFissile()) then - ! ! Load Fission - ! call dict % get(temp, 'fission') - ! if(size(temp) /= nG) then - ! call fatalError(Here,'Fission XSs have wong size. Must be: ' & - ! // numToChar(nG)//' is '//numToChar(size(temp))) - ! end if - ! self % data(FISSION_XS,:) = temp - - ! ! Calculate nuFission - ! call dict % get(temp, 'nu') - ! if(size(temp) /= nG) then - ! call fatalError(Here,'Nu vector has wong size. Must be: ' & - ! // numToChar(nG)//' is '//numToChar(size(temp))) - ! end if - ! self % data(NU_FISSION,:) = temp * self % data(FISSION_XS,:) - !end if - ! Calculate total XS do i =1,nG self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) - !if(self % isFissile()) then - ! self % data(TOTAL_XS, i) = self % data(TOTAL_XS, i) + self % data(FISSION_XS, i) - !end if end do allocate(self % temperature) @@ -286,7 +238,7 @@ end subroutine init !! None !! pure function nGroups(self) result(nG) - class(baseMgIMCMaterial), intent(in) :: self + class(baseMgIMCMaterial), intent(in) :: self integer(shortInt) :: nG if(allocated(self % data)) then diff --git a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 index 1afa16526..73d4cbcca 100644 --- a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 @@ -35,7 +35,7 @@ module mgIMCDatabase_inter !! pure function mgIMCDatabase_CptrCast(source) result(ptr) class(nuclearDatabase), pointer, intent(in) :: source - class(mgIMCDatabase), pointer :: ptr + class(mgIMCDatabase), pointer :: ptr select type(source) class is(mgIMCDatabase) diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index edf75b3e5..15c5843ed 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -8,7 +8,7 @@ module mgIMCMaterial_inter ! Nuclear Data Handles use materialHandle_inter, only : materialHandle use IMCMaterial_inter, only : IMCMaterial - use IMCXsPackages_class, only : IMCMacroXSs + use IMCXsPackages_class, only : IMCMacroXSs implicit none private @@ -26,18 +26,13 @@ module mgIMCMaterial_inter !! !! Abstract interface for all MG IMC Materials !! - !! Private Members: - !! fissile -> flag set to .true. if material is fissile - !! !! Interface: !! materialHandle interface !! neutroNMaterial interface !! getMacroXSs -> Get macroscopic XSs directly from group number and RNG - !! set -> Sets fissile flag !! type, public, abstract, extends(IMCMaterial) :: mgIMCMaterial private - !logical(defBool) :: fissile = .false. contains ! Superclass procedures @@ -48,8 +43,6 @@ module mgIMCMaterial_inter ! Local procedures procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG procedure(getTotalXS), deferred :: getTotalXS - !procedure :: isFissile - !procedure :: set end type mgIMCMaterial @@ -70,8 +63,8 @@ module mgIMCMaterial_inter !! subroutine getMacroXSs_byG(self, xss, G, rand) import :: mgIMCMaterial, IMCMacroXSs, shortInt, RNG - class(mgIMCMaterial), intent(in) :: self - type(IMCMacroXSs), intent(out) :: xss + class(mgIMCMaterial), intent(in) :: self + type(IMCMacroXSs), intent(out) :: xss integer(shortInt), intent(in) :: G class(RNG), intent(inout) :: rand end subroutine getMacroXSs_byG @@ -88,7 +81,7 @@ end subroutine getMacroXSs_byG !! function getTotalXS(self, G, rand) result(xs) import :: mgIMCMaterial, defReal, shortInt, RNG - class(mgIMCMaterial), intent(in) :: self + class(mgIMCMaterial), intent(in) :: self integer(shortInt), intent(in) :: G class(RNG), intent(inout) :: rand real(defReal) :: xs @@ -105,8 +98,8 @@ end function getTotalXS !! See IMCMaterial_inter for details !! subroutine getMacroXSs_byP(self, xss, p) - class(mgIMCMaterial), intent(in) :: self - type(IMCMacroXSs), intent(out) :: xss + class(mgIMCMaterial), intent(in) :: self + type(IMCMacroXSs), intent(out) :: xss class(particle), intent(in) :: p character(100), parameter :: Here = 'getMacroXSs_byP (mgIMCMateerial_inter.f90)' @@ -119,50 +112,14 @@ subroutine getMacroXSs_byP(self, xss, p) end if end subroutine getMacroXSs_byP - !! - !! Return .true. if the MG material is fissile - !! - !! Args: - !! None - !! - !! Errors: - !! None - !! - !elemental function isFissile(self) result(isIt) - ! class(mgIMCMaterial), intent(in) :: self - ! logical(defBool) :: isIt - - ! isIt = self % fissile - - !end function isFissile - !! !! Return to uninitialised state !! elemental subroutine kill(self) class(mgIMCMaterial), intent(inout) :: self - !self % fissile = .false. - end subroutine kill - !! - !! Set fissile flag - !! - !! All arguments are optional. Use with keyword association e.g. - !! call mat % set( fissile = .true.) - !! - !! Args: - !! fissile [in] -> flag indicating whether fission data is present - !! - !subroutine set(self, fissile) - ! class(mgIMCMaterial), intent(inout) :: self - ! logical(defBool), intent(in), optional :: fissile - - ! if(present(fissile)) self % fissile = fissile - - !end subroutine set - !! !! Cast materialHandle pointer to mgIMCMaterial pointer !! @@ -175,7 +132,7 @@ end subroutine kill !! pure function mgIMCMaterial_CptrCast(source) result(ptr) class(materialHandle), pointer, intent(in) :: source - class(mgIMCMaterial), pointer :: ptr + class(mgIMCMaterial), pointer :: ptr select type(source) class is(mgIMCMaterial) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index 1fa370c63..478afc9dc 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -13,7 +13,7 @@ !! Available ND TYPES: !! CE_NEUTRON !! MG_NEUTRON -!! MG_IMC +!! MG_PHOTON !! !! Private members: !! databases -> Array with defined databases (name, definition, @@ -76,7 +76,7 @@ module nuclearDataReg_mod ! Neutron MG use baseMgNeutronDatabase_class, only : baseMgNeutronDatabase - ! IMC MG + ! Photon MG use baseMgIMCDatabase_class, only : baseMgIMCDatabase implicit none From 2234b720b938ef39435bb6a5ee730765a12b404a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 20 Dec 2021 22:15:28 +0000 Subject: [PATCH 022/373] Moved IMCTest input file to main directory for ease while testing --- InputFiles/IMCTest => IMCTest | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) rename InputFiles/IMCTest => IMCTest (97%) diff --git a/InputFiles/IMCTest b/IMCTest similarity index 97% rename from InputFiles/IMCTest rename to IMCTest index 891983029..32b579526 100644 --- a/InputFiles/IMCTest +++ b/IMCTest @@ -91,7 +91,7 @@ nuclearData { 94241.03 0.00011674; 31000.03 0.0013752; } - xsFile ./XS/URRa_2_1_XSS; + xsFile ./InputFiles/XS/URRa_2_1_XSS; } } From 6433cb9111d642cebb15fd25201886e536175813 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 21 Dec 2021 00:10:19 +0000 Subject: [PATCH 023/373] Created new physics package for IMC - slight modification of fixed source --- PhysicsPackages/CMakeLists.txt | 3 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 355 ++++++++++++++++++ .../physicsPackageFactory_func.f90 | 19 +- 3 files changed, 367 insertions(+), 10 deletions(-) create mode 100644 PhysicsPackages/IMCPhysicsPackage_class.f90 diff --git a/PhysicsPackages/CMakeLists.txt b/PhysicsPackages/CMakeLists.txt index a1db7a1f4..bb1993929 100644 --- a/PhysicsPackages/CMakeLists.txt +++ b/PhysicsPackages/CMakeLists.txt @@ -3,7 +3,8 @@ add_sources( ./physicsPackage_inter.f90 ./physicsPackageFactory_func.f90 ./eigenPhysicsPackage_class.f90 - ./fixedSourcePhysicsPackage_class.f90 + ./fixedSourcePhysicsPackage_class.f90 + ./IMCPhysicsPackage_class.f90 ./vizPhysicsPackage_class.f90 ./rayVolPhysicsPackage_class.f90 ) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 new file mode 100644 index 000000000..25b080c84 --- /dev/null +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -0,0 +1,355 @@ +module IMCPhysicsPackage_class + + use numPrecision + use universalVariables + use endfConstants + use genericProcedures, only : fatalError, printFishLineR, numToChar, rotateVector + use hashFunctions_func, only : FNV_1 + use dictionary_class, only : dictionary + use outputFile_class, only : outputFile + + ! Timers + use timer_mod, only : registerTimer, timerStart, timerStop, & + timerTime, timerReset, secToChar + + ! Particle classes and Random number generator + use particle_class, only : particle, P_PHOTON + use particleDungeon_class, only : particleDungeon + use source_inter, only : source + use RNG_class, only : RNG + + ! Physics package interface + use physicsPackage_inter, only : physicsPackage + + ! Geometry + use geometry_inter, only : geometry + use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & + gr_geomIdx => geomIdx + + ! Nuclear Data + use materialMenu_mod, only : mm_nMat => nMat + use nuclearDataReg_mod, only : ndReg_init => init ,& + ndReg_activate => activate ,& + ndReg_display => display, & + ndReg_kill => kill, & + ndReg_get => get ,& + ndReg_getMatNames => getMatNames + use nuclearDatabase_inter, only : nuclearDatabase + use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast + use mgIMCMaterial_inter, only : mgIMCMaterial + + ! Operators + use collisionOperator_class, only : collisionOperator + use transportOperator_inter, only : transportOperator + + ! Tallies + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + + ! Factories + use transportOperatorFactory_func, only : new_transportOperator + use sourceFactory_func, only : new_source + + implicit none + private + + !! + !! Physics Package for IMC calculations + !! + type, public,extends(physicsPackage) :: IMCPhysicsPackage + private + ! Building blocks + class(nuclearDatabase), pointer :: nucData => null() + class(geometry), pointer :: geom => null() + integer(shortInt) :: geomIdx = 0 + type(collisionOperator) :: collOp + class(transportOperator), allocatable :: transOp + class(RNG), pointer :: pRNG => null() + type(tallyAdmin),pointer :: tally => null() + + ! Settings + integer(shortInt) :: N_cycles + integer(shortInt) :: pop + character(pathLen) :: outputFile + character(nameLen) :: outputFormat + integer(shortInt) :: printSource = 0 + integer(shortInt) :: particleType + + ! Calculation components + type(particleDungeon), pointer :: thisCycle => null() + class(source), allocatable :: IMCSource + + ! Timer bins + integer(shortInt) :: timerMain + real (defReal) :: CPU_time_start + real (defReal) :: CPU_time_end + + contains + procedure :: init + procedure :: printSettings + procedure :: cycles + procedure :: collectResults + procedure :: run + procedure :: kill + + end type IMCPhysicsPackage + +contains + + subroutine run(self) + class(IMCPhysicsPackage), intent(inout) :: self + + print *, repeat("<>",50) + print *, "/\/\ IMC CALCULATION /\/\" + + call self % cycles(self % tally, self % N_cycles) + call self % collectResults() + + print * + print *, "\/\/ END OF IMC CALCULATION \/\/" + print * + end subroutine + + !! + !! + !! + subroutine cycles(self, tally, N_cycles) + class(IMCPhysicsPackage), intent(inout) :: self + type(tallyAdmin), pointer,intent(inout) :: tally + integer(shortInt), intent(in) :: N_cycles + integer(shortInt) :: i, N + type(particle) :: p + real(defReal) :: elapsed_T, end_T, T_toEnd + character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' + + N = self % pop + + ! Attach nuclear data and RNG to particle + p % pRNG => self % pRNG + p % k_eff = ONE + p % geomIdx = self % geomIdx + + ! Reset and start timer + call timerReset(self % timerMain) + call timerStart(self % timerMain) + + do i=1,N_cycles + + ! Send start of cycle report + call self % IMCSource % generate(self % thisCycle, N, p % pRNG) + if(self % printSource == 1) then + call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + end if + + call tally % reportCycleStart(self % thisCycle) + + gen: do + ! Obtain paticle from dungeon + call self % thisCycle % release(p) + call self % geom % placeCoord(p % coords) + + ! Save state + call p % savePreHistory() + + ! Transport particle untill its death + history: do + call self % transOp % transport(p, tally, self % thisCycle, self % thisCycle) + if(p % isDead) exit history + + call self % collOp % collide(p, tally, self % thisCycle, self % thisCycle) + if(p % isDead) exit history + end do history + + if( self % thisCycle % isEmpty()) exit gen + end do gen + + ! Send end of cycle report + call tally % reportCycleEnd(self % thisCycle) + + ! Calculate times + call timerStop(self % timerMain) + elapsed_T = timerTime(self % timerMain) + + ! Predict time to end + end_T = real(N_cycles,defReal) * elapsed_T / i + 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() + end do + end subroutine cycles + + !! + !! Print calculation results to file + !! + subroutine collectResults(self) + class(IMCPhysicsPackage), intent(inout) :: self + type(outputFile) :: out + character(nameLen) :: name + + call out % init(self % outputFormat) + + name = 'seed' + call out % printValue(self % pRNG % getSeed(),name) + + name = 'pop' + call out % printValue(self % pop,name) + + name = 'Source_batches' + call out % printValue(self % N_cycles,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 = 'Transport_time' + call out % printValue(timerTime(self % timerMain),name) + + ! Print tally + call self % tally % print(out) + + call out % writeToFile(self % outputFile) + + end subroutine collectResults + + + !! + !! Initialise from individual components and dictionaries for source and tally + !! + subroutine init(self, dict) + class(IMCPhysicsPackage), intent(inout) :: self + class(dictionary), intent(inout) :: dict + class(dictionary),pointer :: tempDict + integer(shortInt) :: seed_temp + integer(longInt) :: seed + character(10) :: time + character(8) :: date + character(:),allocatable :: string + character(nameLen) :: nucData, energy, geomName + type(outputFile) :: test_out + integer(shortInt) :: i + character(100), parameter :: Here ='init (IMCPhysicsPackage_class.f90)' + + call cpu_time(self % CPU_time_start) + + ! Read calculation settings + call dict % get( self % pop,'pop') + call dict % get( self % N_cycles,'cycles') + call dict % get( nucData, 'XSdata') + call dict % get( energy, 'dataType') + + ! Process type of data + select case(energy) + case('mg') + self % particleType = P_PHOTON_MG + !case('ce') + ! self % particleType = P_PHOTON_CE + case default + call fatalError(Here,"dataType must be 'mg' or 'ce'.") + end select + + ! 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) + + ! Register timer + self % timerMain = registerTimer('transportTime') + + ! Initialise RNG + allocate(self % pRNG) + + ! *** It is a bit silly but dictionary cannot store longInt for now + ! so seeds are limited to 32 bits (can be -ve) + 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 % pRNG % init(seed) + + ! Read whether to print particle source per cycle + call dict % getOrDefault(self % printSource, 'printSource', 0) + + ! Build Nuclear Data + call ndReg_init(dict % getDictPtr("nuclearData")) + + ! Build geometry + tempDict => dict % getDictPtr('geometry') + geomName = 'IMCGeom' + call gr_addGeom(geomName, tempDict) + 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()) + self % nucData => ndReg_get(self % particleType) + + ! Read particle source definition + tempDict => dict % getDictPtr('source') + call new_source(self % IMCSource, tempDict, self % geom) + + ! Build collision operator + tempDict => dict % getDictPtr('collisionOperator') + call self % collOp % init(tempDict) + + ! Build transport operator + tempDict => dict % getDictPtr('transportOperator') + call new_transportOperator(self % transOp, tempDict) + + ! Initialise tally Admin + tempDict => dict % getDictPtr('tally') + allocate(self % tally) + call self % tally % init(tempDict) + + ! Size particle dungeon + allocate(self % thisCycle) + call self % thisCycle % init(3 * self % pop) + + call self % printSettings() + + end subroutine init + + !! + !! Deallocate memory + !! + subroutine kill(self) + class(IMCPhysicsPackage), intent(inout) :: self + + ! TODO: This subroutine + + end subroutine kill + + !! + !! Print settings of the physics package + !! + subroutine printSettings(self) + class(IMCPhysicsPackage), intent(in) :: self + + print *, repeat("<>",50) + print *, "/\/\ IMC CALCULATION /\/\" + print *, "Source batches: ", numToChar(self % N_cycles) + print *, "Population per batch: ", numToChar(self % pop) + print *, "Initial RNG Seed: ", numToChar(self % pRNG % getSeed()) + print * + print *, repeat("<>",50) + end subroutine printSettings + +end module IMCPhysicsPackage_class diff --git a/PhysicsPackages/physicsPackageFactory_func.f90 b/PhysicsPackages/physicsPackageFactory_func.f90 index 9cda76b06..5d82bddbb 100644 --- a/PhysicsPackages/physicsPackageFactory_func.f90 +++ b/PhysicsPackages/physicsPackageFactory_func.f90 @@ -15,7 +15,7 @@ module physicsPackageFactory_func use fixedSourcePhysicsPackage_class, only : fixedSourcePhysicsPackage use vizPhysicsPackage_class, only : vizPhysicsPackage use rayVolPhysicsPackage_class, only : rayVolPhysicsPackage -! use dynamPhysicsPackage_class, only : dynamPhysicsPackage + use IMCPhysicsPackage_class, only : IMCPhysicsPackage implicit none private @@ -27,6 +27,7 @@ module physicsPackageFactory_func ! For now it is necessary to adjust trailing blanks so all enteries have the same length character(nameLen),dimension(*),parameter :: AVAILABLE_physicsPackages = [ 'eigenPhysicsPackage ',& 'fixedSourcePhysicsPackage',& + 'IMCPhysicsPackage ',& 'vizPhysicsPackage ',& 'rayVolPhysicsPackage '] @@ -70,14 +71,14 @@ function new_physicsPackage(dict) result(new) type is (fixedSourcePhysicsPackage) call new % init(dict) end select -! -! case('dynamPhysicsPackage') -! ! Allocate and initialise -! allocate( dynamPhysicsPackage :: new) -! select type(new) -! type is (dynamPhysicsPackage) -! call new % init(dict) -! end select + + case('IMCPhysicsPackage') + ! Allocate and initialise + allocate( IMCPhysicsPackage :: new) + select type(new) + type is (IMCPhysicsPackage) + call new % init(dict) + end select case('vizPhysicsPackage') From dd21105c1bd3ecdcb378a9b1ef870702a600bc95 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 21 Dec 2021 00:17:42 +0000 Subject: [PATCH 024/373] Hijacked particle class to change default particle to photon - Will later try to integrate into standard particle_class without breaking neutron calculations --- ParticleObjects/particle_class.f90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index ad0e302f1..2c59bb401 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -31,7 +31,7 @@ module particle_class !! E -> Energy of the particle [MeV] !! G -> Energy Group of the particle !! isMG -> True if particle uses MG data - !! type -> Physical Type of the particle (NEUTRON, PHOTON etc.) + !! type -> Physical Type of the particle (PHOTON, PHOTON etc.) !! time -> Position in time of the particle [s] !! matIdx -> material Index in which particle is present !! cellIdx -> Cell Index at the lowest level in which particle is present @@ -49,7 +49,7 @@ module particle_class real(defReal) :: E = ZERO ! Energy integer(shortInt) :: G = 0 ! Energy group logical(defBool) :: isMG = .false. ! Is neutron multi-group - integer(shortInt) :: type = P_NEUTRON ! Particle physical type + integer(shortInt) :: type = P_PHOTON ! Particle physical type real(defReal) :: time = ZERO ! Particle time position integer(shortInt) :: matIdx = -1 ! Material index where particle is integer(shortInt) :: cellIdx = -1 ! Cell idx at the lowest coord level @@ -177,7 +177,7 @@ module particle_class !! w -> particle weight !! Optional arguments: !! t -> particle time (default = 0.0) - !! type-> particle type (default = P_NEUTRON) + !! type-> particle type (default = P_PHOTON) !! pure subroutine buildCE(self, r, dir, E, w, t, type) class(particle), intent(inout) :: self @@ -205,7 +205,7 @@ pure subroutine buildCE(self, r, dir, E, w, t, type) if(present(type)) then self % type = type else - self % type = P_NEUTRON + self % type = P_PHOTON end if end subroutine buildCE @@ -219,7 +219,7 @@ end subroutine buildCE !! w -> particle weight !! Optional arguments: !! t -> particle time (default = 0.0) - !! type-> particle type (default = P_NEUTRON) + !! type-> particle type (default = P_PHOTON) !! subroutine buildMG(self, r, dir, G, w, t, type) class(particle), intent(inout) :: self @@ -247,7 +247,7 @@ subroutine buildMG(self, r, dir, G, w, t, type) if(present(type)) then self % type = type else - self % type = P_NEUTRON + self % type = P_PHOTON end if end subroutine buildMG @@ -404,7 +404,7 @@ end function matIdx !! None !! !! Result: - !! P_NEUTRON_CE, P_NEUTRON_MG, P_IMC_MG + !! P_PHOTON_CE, P_PHOTON_MG, P_IMC_MG !! !! Errors: !! None @@ -414,9 +414,9 @@ pure function getType(self) result(type) integer(shortInt) :: type if (self % isMG) then - type = P_NEUTRON_MG + type = P_PHOTON_MG else - type = P_NEUTRON_CE + !type = P_PHOTON_CE end if end function getType @@ -688,7 +688,7 @@ elemental subroutine kill_particleState(self) self % E = ZERO self % G = 0 self % isMG = .false. - self % type = P_NEUTRON + self % type = P_PHOTON self % time = ZERO self % matIdx = -1 self % cellIdx = -1 @@ -711,7 +711,7 @@ elemental function verifyType(type) result(isValid) isValid = .false. ! Check against particles types - isValid = isValid .or. type == P_NEUTRON + isValid = isValid .or. type == P_PHOTON isValid = isValid .or. type == P_PHOTON end function verifyType From af772db88ad1c25e8dbe2d21ce964727cac785f5 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 21 Dec 2021 00:18:50 +0000 Subject: [PATCH 025/373] Undone temporary bypass of particle type so now recognises photons correctly, can now run input file correctly --- NuclearData/nuclearDataReg_mod.f90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index 478afc9dc..f439218c3 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -326,14 +326,14 @@ subroutine activate(type, name, activeMat, silent) end if case(P_NEUTRON_MG) - ! activeIdx_mgNeutron = idx - ! active_mgNeutron => mgNeutronDatabase_CptrCast(ptr) - ! if(.not.associated(active_mgNeutron)) then - ! call fatalError(Here,trim(name)//' is not database for MG neutrons') - ! end if - - !case(P_PHOTON_MG) - activeIdx_mgIMC = idx ! Redirecting this until figured out why neutrons are being used + activeIdx_mgNeutron = idx + active_mgNeutron => mgNeutronDatabase_CptrCast(ptr) + if(.not.associated(active_mgNeutron)) then + call fatalError(Here,trim(name)//' is not database for MG neutrons') + end if + + case(P_PHOTON_MG) + activeIdx_mgIMC = idx active_mgIMC => mgIMCDatabase_CptrCast(ptr) if(.not.associated(active_mgIMC)) then call fatalError(Here,trim(name)//' is not database for MG IMC') @@ -508,10 +508,10 @@ function get_byType(type, where) result(ptr) ptr => getNeutronCE() case(P_NEUTRON_MG) - ! ptr => getNeutronMG() + ptr => getNeutronMG() - !case(P_PHOTON_MG) - ptr => getIMCMG() ! Redirecting this until figured out why neutrons are being used + case(P_PHOTON_MG) + ptr => getIMCMG() case default ptr => null() From d97490ccb7d5d2d74eaa7865acac320008ddec89 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 21 Dec 2021 00:20:22 +0000 Subject: [PATCH 026/373] Changed input file to IMCPhysicsPackage calculation --- IMCTest | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/IMCTest b/IMCTest index 32b579526..1ad9243e7 100644 --- a/IMCTest +++ b/IMCTest @@ -1,6 +1,8 @@ -type fixedSourcePhysicsPackage; +//type fixedSourcePhysicsPackage; //type eigenPhysicsPackage; +type IMCPhysicsPackage; + pop 30; active 10; inactive 5; @@ -14,7 +16,8 @@ collisionOperator { photonMG {type IMCMGstd;} } -transportOperator { type transportOperatorDT; +transportOperator { + type transportOperatorDT; } From 73bc6d740767fe906d6dc51aeecf3090de15e9d4 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 23 Dec 2021 14:17:59 +0000 Subject: [PATCH 027/373] Created subroutine 'updateTemp', to allow material temperature to be changed at each timestep --- NuclearData/IMCMaterial_inter.f90 | 12 ++++++++++ .../baseMgIMC/baseMgIMCMaterial_class.f90 | 23 ++++++++++++++++--- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 13 +++++++++++ 3 files changed, 45 insertions(+), 3 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 858fd3004..0e1f4bf1f 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -30,6 +30,7 @@ module IMCMaterial_inter contains generic :: getMacroXSs => getMacroXSs_byP procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP + procedure(updateTemp), deferred :: updateTemp end type IMCMaterial abstract interface @@ -52,6 +53,17 @@ subroutine getMacroXSs_byP(self, xss, p) class(particle), intent(in) :: p end subroutine getMacroXSs_byP + !! + !! Update material temperature at each time step + !! + !! Args: + !! None + !! + subroutine updateTemp(self) + import :: IMCMaterial + class(IMCMaterial), intent(inout) :: self + end subroutine updateTemp + end interface contains diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 417f2a750..600057ca1 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -65,7 +65,7 @@ module baseMgIMCMaterial_class type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data class(multiScatterMG), allocatable :: scatter - real(defReal), allocatable :: temperature + real(defReal) :: T contains ! Superclass procedures @@ -76,6 +76,7 @@ module baseMgIMCMaterial_class ! Local procedures procedure :: init procedure :: nGroups + procedure :: updateTemp end type baseMgIMCMaterial @@ -93,7 +94,6 @@ elemental subroutine kill(self) ! Kill local content if(allocated(self % data)) deallocate(self % data) if(allocated(self % scatter)) deallocate(self % scatter) - if(allocated(self % temperature)) deallocate(self % temperature) end subroutine kill @@ -224,7 +224,9 @@ subroutine init(self, dict, scatterKey) self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) end do - allocate(self % temperature) + self % T = 298 + + print *, self % T end subroutine init @@ -297,5 +299,20 @@ pure function baseMgIMCMaterial_CptrCast(source) result(ptr) end function baseMgIMCMaterial_CptrCast + !! + !! Update material temperature at each time step + !! + !! Args: + !! None + !! + subroutine updateTemp(self) + class(baseMgIMCMaterial),intent(inout) :: self + + self % T = self % T + 1 + + print *, self % T + + end subroutine updateTemp + end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 15c5843ed..40e34c2ec 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -43,6 +43,7 @@ module mgIMCMaterial_inter ! Local procedures procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG procedure(getTotalXS), deferred :: getTotalXS + procedure(updateTemp), deferred :: updateTemp end type mgIMCMaterial @@ -86,6 +87,18 @@ function getTotalXS(self, G, rand) result(xs) class(RNG), intent(inout) :: rand real(defReal) :: xs end function getTotalXS + + !! + !! Update material temperature at each time step + !! + !! Args: + !! None + !! + subroutine updateTemp(self) + import :: mgIMCMaterial + class(mgIMCMaterial), intent(inout) :: self + end subroutine updateTemp + end interface From 641841ce40c8f3794f8ee204241af49c85f45990 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 23 Dec 2021 14:25:32 +0000 Subject: [PATCH 028/373] Call updateTemp subroutine in each cycle (will later be timesteps) to check that subroutine works --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 25b080c84..6318acefc 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -120,6 +120,7 @@ subroutine cycles(self, tally, N_cycles) integer(shortInt) :: i, N type(particle) :: p real(defReal) :: elapsed_T, end_T, T_toEnd + class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' N = self % pop @@ -174,7 +175,10 @@ subroutine cycles(self, tally, N_cycles) end_T = real(N_cycles,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) + call mat % updateTemp() + ! Display progress call printFishLineR(i) print * From 086f636c37165c3a19ed7fc255dbb45ed6e4e5bf Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 23 Dec 2021 14:30:25 +0000 Subject: [PATCH 029/373] Removed fission from IMCXsPackages_class --- .../xsPackages/IMCXsPackages_class.f90 | 42 +++---------------- 1 file changed, 6 insertions(+), 36 deletions(-) diff --git a/NuclearData/xsPackages/IMCXsPackages_class.f90 b/NuclearData/xsPackages/IMCXsPackages_class.f90 index e01d23e98..e3c3f7850 100644 --- a/NuclearData/xsPackages/IMCXsPackages_class.f90 +++ b/NuclearData/xsPackages/IMCXsPackages_class.f90 @@ -17,11 +17,8 @@ module IMCXsPackages_class !! Public Members: !! total -> total Cross-Section [1/cm] !! elasticScatter -> sum of MT=2 elastic IMC scattering [1/cm] - !! inelasticScatter -> sum of all IMC producing reaction that are not elastic scattering - !! or fission. [1/cm] - !! capture -> sum of all reactions without secendary IMCs excluding fission [1/cm] - !! fission -> total Fission MT=18 Cross-section [1/cm] - !! nuFission -> total average IMC production Cross-section [1/cm] + !! inelasticScatter -> sum of all IMC producing reaction that are not elastic scattering [1/cm] + !! capture -> sum of all reactions without secondary photons [1/cm] !! !! Interface: !! clean -> Set all XSs to 0.0 @@ -33,8 +30,6 @@ module IMCXsPackages_class real(defReal) :: elasticScatter = ZERO real(defReal) :: inelasticScatter = ZERO real(defReal) :: capture = ZERO - real(defReal) :: fission = ZERO - real(defReal) :: nuFission = ZERO contains procedure :: clean => clean_IMCMacroXSs procedure :: add => add_IMCMacroXSs @@ -49,19 +44,14 @@ module IMCXsPackages_class !! Public Members: !! total -> total Cross-Section [barn] !! elasticScatter -> MT=2 elastic IMC scattering [barn] - !! inelasticScatter -> all IMC producing reaction that are not elastic scattering - !! or fission. [barn] - !! capture -> all reactions without secendary IMCs excluding fission [barn] - !! fission -> total Fission MT=18 Cross-section [barn] - !! nuFission -> total average IMC production Cross-section [barn] + !! inelasticScatter -> all photon producing reaction that are not elastic scattering [barn] + !! capture -> all reactions without secendary photons [barn] !! type, public :: IMCMicroXSs real(defReal) :: total = ZERO real(defReal) :: elasticScatter = ZERO real(defReal) :: inelasticScatter = ZERO real(defReal) :: capture = ZERO - real(defReal) :: fission = ZERO - real(defReal) :: nuFission = ZERO contains procedure :: invert => invert_microXSs end type IMCMicroXSs @@ -86,8 +76,6 @@ elemental subroutine clean_IMCMacroXSs(self) self % elasticScatter = ZERO self % inelasticScatter = ZERO self % capture = ZERO - self % fission = ZERO - self % nuFission = ZERO end subroutine clean_IMCMacroXSs @@ -112,8 +100,6 @@ elemental subroutine add_IMCMacroXSs(self, micro, dens) self % elasticScatter = self % elasticScatter + dens * micro % elasticScatter self % inelasticScatter = self % inelasticScatter + dens * micro % inelasticScatter self % capture = self % capture + dens * micro % capture - self % fission = self % fission + dens * micro % fission - self % nuFission = self % nuFission + dens * micro % nuFission end subroutine add_IMCMacroXSs @@ -144,14 +130,8 @@ elemental function get(self, MT) result(xs) case(macroEscatter) xs = self % elasticScatter - case(macroFission) - xs = self % fission - - case(macroNuFission) - xs = self % nuFission - - case(macroAbsorbtion) - xs = self % fission + self % capture + !case(macroAbsorbtion) + ! xs = self % fission + self % capture case default xs = ZERO @@ -173,11 +153,9 @@ end function get !! elasticScatter = macroEscatter !! inelasticScatter = macroIEscatter !! capture = macroCapture - !! fission = macroFission !! !! Errors:: !! If r < 0 then returns macroEscatter - !! If r > 1 then returns macroFission !! elemental function invert_macroXSs(self, r) result(MT) class(IMCMacroXSs), intent(in) :: self @@ -210,9 +188,6 @@ elemental function invert_macroXSs(self, r) result(MT) case(3) MT = macroCapture - case(4) - MT = macroFission - case default ! Should never happen -> Avoid compiler error and return nonsense number MT = huge(C) @@ -234,11 +209,9 @@ end function invert_macroXSs !! elastic scatter = N_N_elastic !! inelastic scatter = N_N_inelastic !! capture = N_diasp - !! fission = N_FISSION !! !! Errors: !! If r < 0 then returns N_N_elastic - !! if r > 1 then returns N_FISSION !! elemental function invert_microXSs(self, r) result(MT) class(IMCMicroXSs), intent(in) :: self @@ -271,9 +244,6 @@ elemental function invert_microXSs(self, r) result(MT) case(3) MT = N_disap - case(4) - MT = N_fission - case default ! Should never happen -> Avoid compiler error and return nonsense number MT = huge(C) end select From dfc2ca568b118d7908e54208f4d89daa41cf569b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 23 Dec 2021 14:57:55 +0000 Subject: [PATCH 030/373] Prints updated temperature in nicer way --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 2 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 600057ca1..d38f90002 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -310,7 +310,7 @@ subroutine updateTemp(self) self % T = self % T + 1 - print *, self % T + print *, "Updated material temperature:", int(self % T), "K" end subroutine updateTemp diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 6318acefc..9235c25d8 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -177,11 +177,13 @@ subroutine cycles(self, tally, N_cycles) mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - call mat % updateTemp() + !call mat % updateTemp() ! Display progress call printFishLineR(i) print * + call mat % updateTemp() + print * print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) print *, 'Pop: ', numToChar(self % pop) print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) From d2dbca2d80beb2eade8d07411b81b36b720d549b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 24 Dec 2021 16:29:14 +0000 Subject: [PATCH 031/373] Fixed temporary changes to particle_class so can now be used for both photons and neutrons --- ParticleObjects/particle_class.f90 | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index 2c59bb401..edad2b01e 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -1,5 +1,6 @@ module particle_class + use numPrecision use universalVariables use genericProcedures @@ -31,7 +32,7 @@ module particle_class !! E -> Energy of the particle [MeV] !! G -> Energy Group of the particle !! isMG -> True if particle uses MG data - !! type -> Physical Type of the particle (PHOTON, PHOTON etc.) + !! type -> Physical Type of the particle (NEUTRON, PHOTON etc.) !! time -> Position in time of the particle [s] !! matIdx -> material Index in which particle is present !! cellIdx -> Cell Index at the lowest level in which particle is present @@ -49,7 +50,7 @@ module particle_class real(defReal) :: E = ZERO ! Energy integer(shortInt) :: G = 0 ! Energy group logical(defBool) :: isMG = .false. ! Is neutron multi-group - integer(shortInt) :: type = P_PHOTON ! Particle physical type + integer(shortInt) :: type = P_NEUTRON ! Particle physical type real(defReal) :: time = ZERO ! Particle time position integer(shortInt) :: matIdx = -1 ! Material index where particle is integer(shortInt) :: cellIdx = -1 ! Cell idx at the lowest coord level @@ -177,7 +178,7 @@ module particle_class !! w -> particle weight !! Optional arguments: !! t -> particle time (default = 0.0) - !! type-> particle type (default = P_PHOTON) + !! type-> particle type (default = P_NEUTRON) !! pure subroutine buildCE(self, r, dir, E, w, t, type) class(particle), intent(inout) :: self @@ -205,7 +206,7 @@ pure subroutine buildCE(self, r, dir, E, w, t, type) if(present(type)) then self % type = type else - self % type = P_PHOTON + self % type = P_NEUTRON end if end subroutine buildCE @@ -219,7 +220,7 @@ end subroutine buildCE !! w -> particle weight !! Optional arguments: !! t -> particle time (default = 0.0) - !! type-> particle type (default = P_PHOTON) + !! type-> particle type (default = P_NEUTRON) !! subroutine buildMG(self, r, dir, G, w, t, type) class(particle), intent(inout) :: self @@ -247,7 +248,7 @@ subroutine buildMG(self, r, dir, G, w, t, type) if(present(type)) then self % type = type else - self % type = P_PHOTON + self % type = P_NEUTRON end if end subroutine buildMG @@ -404,7 +405,7 @@ end function matIdx !! None !! !! Result: - !! P_PHOTON_CE, P_PHOTON_MG, P_IMC_MG + !! P_NEUTRON_CE, P_NEUTRON_MG, P_PHOTON_MG !! !! Errors: !! None @@ -413,10 +414,12 @@ pure function getType(self) result(type) class(particle), intent(in) :: self integer(shortInt) :: type - if (self % isMG) then + if (self % type == P_PHOTON) then type = P_PHOTON_MG + else if (self % isMG) then + type = P_NEUTRON_MG else - !type = P_PHOTON_CE + type = P_NEUTRON_CE end if end function getType @@ -688,7 +691,7 @@ elemental subroutine kill_particleState(self) self % E = ZERO self % G = 0 self % isMG = .false. - self % type = P_PHOTON + self % type = P_NEUTRON self % time = ZERO self % matIdx = -1 self % cellIdx = -1 @@ -711,7 +714,7 @@ elemental function verifyType(type) result(isValid) isValid = .false. ! Check against particles types - isValid = isValid .or. type == P_PHOTON + isValid = isValid .or. type == P_NEUTRON isValid = isValid .or. type == P_PHOTON end function verifyType From 94ebe676921f78098ac84a9ceddd2ed1976507ee Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 24 Dec 2021 16:45:37 +0000 Subject: [PATCH 032/373] Created new transport operator for IMC, currently unchanged so functions exactly the same as transportOperatorDT --- IMCTest | 2 +- TransportOperator/CMakeLists.txt | 1 + .../transportOperatorFactory_func.f90 | 14 ++- .../transportOperatorIMC_class.f90 | 86 +++++++++++++++++++ 4 files changed, 98 insertions(+), 5 deletions(-) create mode 100644 TransportOperator/transportOperatorIMC_class.f90 diff --git a/IMCTest b/IMCTest index 1ad9243e7..d149d77fa 100644 --- a/IMCTest +++ b/IMCTest @@ -17,7 +17,7 @@ collisionOperator { } transportOperator { - type transportOperatorDT; + type transportOperatorIMC; } diff --git a/TransportOperator/CMakeLists.txt b/TransportOperator/CMakeLists.txt index 2d71564c0..86a811b76 100644 --- a/TransportOperator/CMakeLists.txt +++ b/TransportOperator/CMakeLists.txt @@ -2,6 +2,7 @@ add_sources(./transportOperator_inter.f90 ./transportOperatorFactory_func.f90 ./transportOperatorDT_class.f90 + ./transportOperatorIMC_class.f90 # ./transportOperatorDynamicDT_class.f90 ./transportOperatorST_class.f90 ./transportOperatorHT_class.f90) diff --git a/TransportOperator/transportOperatorFactory_func.f90 b/TransportOperator/transportOperatorFactory_func.f90 index 67b821f95..d82ea7006 100644 --- a/TransportOperator/transportOperatorFactory_func.f90 +++ b/TransportOperator/transportOperatorFactory_func.f90 @@ -12,6 +12,7 @@ module transportOperatorFactory_func use transportOperatorST_class, only : transportOperatorST use transportOperatorDT_class, only : transportOperatorDT use transportOperatorHT_class, only : transportOperatorHT + use transportOperatorIMC_class, only : transportOperatorIMC !use transportOperatorDynamicDT_class, only : transportOperatorDynamicDT implicit none @@ -22,9 +23,10 @@ module transportOperatorFactory_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 :: AVALIBLE_transportOps = [ 'transportOperatorST', & - 'transportOperatorDT', & - 'transportOperatorHT']!, & + character(nameLen),dimension(*),parameter :: AVALIBLE_transportOps = [ 'transportOperatorST ', & + 'transportOperatorDT ', & + 'transportOperatorHT ', & + 'transportOperatorIMC']!, & ! 'dynamicTranspOperDT'] public :: new_transportOperator @@ -46,7 +48,7 @@ subroutine new_transportOperator(new, dict) ! Obtain string that specifies type to be built call dict % get(type,'type') - ! Allocate approperiate subclass of transportOperator + ! Allocate appropriate subclass of transportOperator ! *** ADD CASE STATEMENT FOR A NEW TRANSPORT OPERATOR BELOW ***! select case(type) case('transportOperatorST') @@ -61,6 +63,10 @@ subroutine new_transportOperator(new, dict) allocate( transportOperatorHT :: new) call new % init(dict) + case('transportOperatorIMC') + allocate( transportOperatorIMC :: new) + call new % init(dict) + ! case('dynamicTranspOperDT') ! allocate( transportOperatorDynamicDT :: new) ! call new % init(dict, geom) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 new file mode 100644 index 000000000..6c76601d5 --- /dev/null +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -0,0 +1,86 @@ +!! +!! Transport operator for implicit Monte Carlo tracking +!! +module transportOperatorIMC_class + use numPrecision + use universalVariables + + use genericProcedures, only : fatalError, numToChar + use particle_class, only : particle + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use rng_class, only : rng + + ! Superclass + use transportOperator_inter, only : transportOperator + + ! Geometry interfaces + use geometry_inter, only : geometry + + ! Tally interface + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + + ! Nuclear data interfaces + use nuclearDatabase_inter, only : nuclearDatabase + + implicit none + private + + !! + !! Transport operator that moves a particle with IMC tracking + !! + type, public, extends(transportOperator) :: transportOperatorIMC + contains + procedure :: transit => imcTracking + end type transportOperatorIMC + +contains + + subroutine imcTracking(self, p, tally, thisCycle, nextCycle) + class(transportOperatorIMC), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon), intent(inout) :: thisCycle + class(particleDungeon), intent(inout) :: nextCycle + real(defReal) :: majorant_inv, sigmaT, distance + character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' + + ! Get majornat XS inverse: 1/Sigma_majorant + majorant_inv = ONE / self % xsData % getMajorantXS(p) + + IMCLoop:do + distance = -log( p% pRNG % get() ) * majorant_inv + + ! Move partice in the geometry + call self % geom % teleport(p % coords, distance) + + ! If particle has leaked exit + if (p % matIdx() == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + return + end if + + ! Check for void + if( p % matIdx() == VOID_MAT) cycle IMCLoop + + ! Obtain the local cross-section + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Protect Against Sillines + !if( sigmaT*majorant_inv < ZERO .or. ONE < sigmaT*majorant_inv) then + ! call fatalError(Here, "TotalXS/MajorantXS is silly: "//numToChar(sigmaT*majorant_inv)) + !end if + + ! Roll RNG to determine if the collision is real or virtual + ! Exit the loop if the collision is real + if (p % pRNG % get() < sigmaT*majorant_inv) exit IMCLoop + + end do IMCLoop + + call tally % reportTrans(p) + end subroutine imcTracking + + +end module transportOperatorIMC_class From 6623e5b1efe9c9014281c681f613be737347ded2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 24 Dec 2021 16:47:11 +0000 Subject: [PATCH 033/373] Removed unnecessary print statement --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index d38f90002..4487e19e1 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -226,8 +226,6 @@ subroutine init(self, dict, scatterKey) self % T = 298 - print *, self % T - end subroutine init !! From fd1f13e9f685efb2ecf2339748c249cc837ab29c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 24 Dec 2021 18:36:54 +0000 Subject: [PATCH 034/373] Added time step size and time step number, and function to calculate time - but currently gives compiler error when trying to use this module in transport operator??? --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 9235c25d8..e62a68a9d 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -51,6 +51,7 @@ module IMCPhysicsPackage_class use sourceFactory_func, only : new_source implicit none + private !! @@ -69,6 +70,7 @@ module IMCPhysicsPackage_class ! Settings integer(shortInt) :: N_cycles + real(defReal) :: timeStepSize integer(shortInt) :: pop character(pathLen) :: outputFile character(nameLen) :: outputFormat @@ -78,6 +80,7 @@ module IMCPhysicsPackage_class ! Calculation components type(particleDungeon), pointer :: thisCycle => null() class(source), allocatable :: IMCSource + integer(shortInt) :: nTimeStep ! Timer bins integer(shortInt) :: timerMain @@ -91,6 +94,7 @@ module IMCPhysicsPackage_class procedure :: collectResults procedure :: run procedure :: kill + !procedure :: endOfStepTime end type IMCPhysicsPackage @@ -144,6 +148,8 @@ subroutine cycles(self, tally, N_cycles) call tally % reportCycleStart(self % thisCycle) + self % nTimeStep = i + gen: do ! Obtain paticle from dungeon call self % thisCycle % release(p) @@ -152,7 +158,7 @@ subroutine cycles(self, tally, N_cycles) ! Save state call p % savePreHistory() - ! Transport particle untill its death + ! Transport particle until its death history: do call self % transOp % transport(p, tally, self % thisCycle, self % thisCycle) if(p % isDead) exit history @@ -249,6 +255,7 @@ subroutine init(self, dict) ! Read calculation settings call dict % get( self % pop,'pop') call dict % get( self % N_cycles,'cycles') + call dict % get( self % timeStepSize,'timeStepSize') call dict % get( nucData, 'XSdata') call dict % get( energy, 'dataType') @@ -358,4 +365,15 @@ subroutine printSettings(self) print *, repeat("<>",50) end subroutine printSettings + !! + !! Return time at end of current time step + !! + function endOfStepTime(self) result(time) + implicit none + class(IMCPhysicsPackage), intent(in) :: self + real(defReal) :: time + + time = self % timeStepSize * self % nTimeStep + end function endOfStepTime + end module IMCPhysicsPackage_class From 8720568b8f4c3e8afcdf0330476da1f0d3c4c3fb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 24 Dec 2021 18:42:26 +0000 Subject: [PATCH 035/373] Added dTime, dGeom and dColl variables to particle tracking - need to figure out why compiler error is occuring when importing endOfStepTime function from IMCPhysicsPackage_class --- TransportOperator/transportOperatorIMC_class.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 6c76601d5..bfacbd4bc 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -24,6 +24,8 @@ module transportOperatorIMC_class ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase + !use IMCPhysicsPackage_class, only : endOfStepTime ! Gives compiler error????? + implicit none private @@ -44,8 +46,12 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) class(particleDungeon), intent(inout) :: thisCycle class(particleDungeon), intent(inout) :: nextCycle real(defReal) :: majorant_inv, sigmaT, distance + real(defReal) :: dTime, dGeom, dColl character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' + !dTime = lightSpeed * (timeStep * thisCycle % nTimeStep - p % time) + !dTime = lightSpeed * (endOfStepTime() - p % time) + ! Get majornat XS inverse: 1/Sigma_majorant majorant_inv = ONE / self % xsData % getMajorantXS(p) From c009e04c7a35de511cbc5dcaef0d7d5e1d708eeb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 24 Dec 2021 18:45:13 +0000 Subject: [PATCH 036/373] Added timeStepSize to input file --- IMCTest | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/IMCTest b/IMCTest index d149d77fa..f36663604 100644 --- a/IMCTest +++ b/IMCTest @@ -3,10 +3,9 @@ type IMCPhysicsPackage; -pop 30; -active 10; -inactive 5; -cycles 10; +pop 30; +cycles 10; +timeStepSize 1; XSdata mg; dataType mg; From 9bf4816e5d4d4c44b18535502be9a442e8c92db7 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 24 Dec 2021 19:04:31 +0000 Subject: [PATCH 037/373] Used particle dungeon class to store time instead of function call from transport operator to get around compiler error --- IMCTest | 4 ++-- ParticleObjects/particleDungeon_class.f90 | 6 ++++-- PhysicsPackages/IMCPhysicsPackage_class.f90 | 19 +++++++++---------- .../transportOperatorIMC_class.f90 | 5 +---- 4 files changed, 16 insertions(+), 18 deletions(-) diff --git a/IMCTest b/IMCTest index f36663604..e19dfd9f9 100644 --- a/IMCTest +++ b/IMCTest @@ -3,9 +3,9 @@ type IMCPhysicsPackage; -pop 30; +pop 3; cycles 10; -timeStepSize 1; +timeStepSize 0.0000001; XSdata mg; dataType mg; diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 27f1aa72f..44823afd7 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -56,8 +56,10 @@ module particleDungeon_class !! type, public :: particleDungeon private - real(defReal),public :: k_eff = ONE ! k-eff for fission site generation rate normalisation - integer(shortInt) :: pop = 0 ! Current population size of the dungeon + real(defReal),public :: k_eff = ONE ! k-eff for fission site generation rate normalisation + integer(shortInt) :: pop = 0 ! Current population size of the dungeon + !integer(shortInt),public :: nTimeStep ! Current time step - Only used in IMC calculations + real(defreal),public :: endOfStepTime ! Time at end of current time step - only used in IMC calculations ! Storage space type(particleState), dimension(:), allocatable :: prisoners diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index e62a68a9d..cbf3c759c 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -80,7 +80,7 @@ module IMCPhysicsPackage_class ! Calculation components type(particleDungeon), pointer :: thisCycle => null() class(source), allocatable :: IMCSource - integer(shortInt) :: nTimeStep + !integer(shortInt) :: nTimeStep ! Timer bins integer(shortInt) :: timerMain @@ -94,7 +94,6 @@ module IMCPhysicsPackage_class procedure :: collectResults procedure :: run procedure :: kill - !procedure :: endOfStepTime end type IMCPhysicsPackage @@ -148,7 +147,7 @@ subroutine cycles(self, tally, N_cycles) call tally % reportCycleStart(self % thisCycle) - self % nTimeStep = i + self % thisCycle % endOfStepTime = i * self % timeStepSize gen: do ! Obtain paticle from dungeon @@ -368,12 +367,12 @@ end subroutine printSettings !! !! Return time at end of current time step !! - function endOfStepTime(self) result(time) - implicit none - class(IMCPhysicsPackage), intent(in) :: self - real(defReal) :: time - - time = self % timeStepSize * self % nTimeStep - end function endOfStepTime + !function endOfStepTime(self) result(time) + ! implicit none + ! class(IMCPhysicsPackage), intent(in) :: self + ! real(defReal) :: time + ! + ! time = self % timeStepSize * self % nTimeStep + !end function endOfStepTime end module IMCPhysicsPackage_class diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index bfacbd4bc..a53e382cd 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -24,8 +24,6 @@ module transportOperatorIMC_class ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase - !use IMCPhysicsPackage_class, only : endOfStepTime ! Gives compiler error????? - implicit none private @@ -49,8 +47,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) real(defReal) :: dTime, dGeom, dColl character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' - !dTime = lightSpeed * (timeStep * thisCycle % nTimeStep - p % time) - !dTime = lightSpeed * (endOfStepTime() - p % time) + dTime = lightSpeed * (thisCycle % endOfStepTime - p % time) ! Get majornat XS inverse: 1/Sigma_majorant majorant_inv = ONE / self % xsData % getMajorantXS(p) From a6b0b2c76dfc101edbcfea85b689f7b6bf62d88d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 26 Dec 2021 15:05:51 +0000 Subject: [PATCH 038/373] Sample distance to next collision --- .../transportOperatorIMC_class.f90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index a53e382cd..5e249bd79 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -45,14 +45,26 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) class(particleDungeon), intent(inout) :: nextCycle real(defReal) :: majorant_inv, sigmaT, distance real(defReal) :: dTime, dGeom, dColl - character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' - - dTime = lightSpeed * (thisCycle % endOfStepTime - p % time) + character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' ! Get majornat XS inverse: 1/Sigma_majorant majorant_inv = ONE / self % xsData % getMajorantXS(p) IMCLoop:do + + ! Obtain the local cross-section + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Find distance to time boundary + dTime = lightSpeed * (thisCycle % endOfStepTime - p % time) + ! Find distance to cell boundary + ! dGeom = + ! Sample distance to collision + dColl = -log( p % pRNG % get() ) / sigmaT + + !print *, 'dTime =',dTime + !print *, 'dColl =',dColl + distance = -log( p% pRNG % get() ) * majorant_inv ! Move partice in the geometry From 44d8a83ad911b3babef779797994e087340ebf5c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 26 Dec 2021 16:38:34 +0000 Subject: [PATCH 039/373] Find distance to geometry boundary (potentially better function that does this??) and choose lowest distance out of dTime, dGeom and dColl --- IMCTest | 4 ++-- .../transportOperatorIMC_class.f90 | 24 ++++++++++++++++--- 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/IMCTest b/IMCTest index e19dfd9f9..df1d90c3d 100644 --- a/IMCTest +++ b/IMCTest @@ -5,7 +5,7 @@ type IMCPhysicsPackage; pop 3; cycles 10; -timeStepSize 0.0000001; +timeStepSize 0.000000000002; XSdata mg; dataType mg; @@ -59,7 +59,7 @@ geometry { surfaces { - squareBound { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 6.3849; } + squareBound { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 1; } } cells {} universes diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 5e249bd79..1c9e1bae2 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -10,6 +10,7 @@ module transportOperatorIMC_class use particleDungeon_class, only : particleDungeon use dictionary_class, only : dictionary use rng_class, only : rng + use coord_class, only : coordList ! Superclass use transportOperator_inter, only : transportOperator @@ -45,6 +46,8 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) class(particleDungeon), intent(inout) :: nextCycle real(defReal) :: majorant_inv, sigmaT, distance real(defReal) :: dTime, dGeom, dColl + integer(shortInt) :: event + type(coordList) :: p_coords character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' ! Get majornat XS inverse: 1/Sigma_majorant @@ -57,13 +60,28 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Find distance to time boundary dTime = lightSpeed * (thisCycle % endOfStepTime - p % time) + ! Find distance to cell boundary - ! dGeom = + dGeom = 1000000 + p_coords = p % coords + call self % geom % move_noCache(p % coords, dGeom, event) ! Better way to do this? + p % coords = p_coords + ! Sample distance to collision dColl = -log( p % pRNG % get() ) / sigmaT - !print *, 'dTime =',dTime - !print *, 'dColl =',dColl + + ! Find lowest value + if ( dTime < dGeom .and. dTime < dColl) then + print *, 'Time' + else if ( dGeom < dColl ) then + print *, 'Geom' + else + print *, 'Coll' + end if + + !print *, 'dTime =', dTime, 'dGeom =', dGeom, 'dColl =', dColl + distance = -log( p% pRNG % get() ) * majorant_inv From 4fc38f6ab2b6cc18bb866554df1507a48b79c20f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 27 Dec 2021 13:51:43 +0000 Subject: [PATCH 040/373] Changed approach in transport operator to use delta tracking instead of surface tracking, added code to move particle to time boundary --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 4 ++ Tallies/tallyCodes.f90 | 3 +- .../transportOperatorIMC_class.f90 | 47 ++++++------------- 3 files changed, 21 insertions(+), 33 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index cbf3c759c..f9fee894c 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -161,6 +161,10 @@ subroutine cycles(self, tally, N_cycles) history: do call self % transOp % transport(p, tally, self % thisCycle, self % thisCycle) if(p % isDead) exit history + + if(p % fate == TIME_FATE) then + ! Store particle for use in next time step + end if call self % collOp % collide(p, tally, self % thisCycle, self % thisCycle) if(p % isDead) exit history diff --git a/Tallies/tallyCodes.f90 b/Tallies/tallyCodes.f90 index 44f7bac69..518696c20 100644 --- a/Tallies/tallyCodes.f90 +++ b/Tallies/tallyCodes.f90 @@ -22,6 +22,7 @@ module tallyCodes integer(shortInt),parameter,public :: abs_FATE = 5000 ,& leak_FATE = 5001 ,& lost_FATE = 5002 ,& - aged_FATE = 5003 + aged_FATE = 5003 ,& + time_FATE = 5004 end module tallyCodes diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 1c9e1bae2..49dcdb134 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -1,5 +1,5 @@ !! -!! Transport operator for implicit Monte Carlo tracking +!! Transport operator for implicit Monte Carlo scheme using delta tracking !! module transportOperatorIMC_class use numPrecision @@ -10,7 +10,6 @@ module transportOperatorIMC_class use particleDungeon_class, only : particleDungeon use dictionary_class, only : dictionary use rng_class, only : rng - use coord_class, only : coordList ! Superclass use transportOperator_inter, only : transportOperator @@ -44,10 +43,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) type(tallyAdmin), intent(inout) :: tally class(particleDungeon), intent(inout) :: thisCycle class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: majorant_inv, sigmaT, distance - real(defReal) :: dTime, dGeom, dColl - integer(shortInt) :: event - type(coordList) :: p_coords + real(defReal) :: majorant_inv, sigmaT, dTime, dColl character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' ! Get majornat XS inverse: 1/Sigma_majorant @@ -55,39 +51,24 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) IMCLoop:do - ! Obtain the local cross-section - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - ! Find distance to time boundary dTime = lightSpeed * (thisCycle % endOfStepTime - p % time) - ! Find distance to cell boundary - dGeom = 1000000 - p_coords = p % coords - call self % geom % move_noCache(p % coords, dGeom, event) ! Better way to do this? - p % coords = p_coords - - ! Sample distance to collision - dColl = -log( p % pRNG % get() ) / sigmaT - + ! Sample distance to move particle before potential collision + dColl = -log( p% pRNG % get() ) * majorant_inv - ! Find lowest value - if ( dTime < dGeom .and. dTime < dColl) then - print *, 'Time' - else if ( dGeom < dColl ) then - print *, 'Geom' + ! Determine which distance to move particle + if (dColl < dTime) then + ! Move partice to potential collision location + call self % geom % teleport(p % coords, dColl) + p % time = p % time + dColl / lightSpeed else - print *, 'Coll' + ! Move particle to end of time step location + call self % geom % teleport(p % coords, dTime) + p % fate = TIME_FATE + p % time = endOfStepTime end if - !print *, 'dTime =', dTime, 'dGeom =', dGeom, 'dColl =', dColl - - - distance = -log( p% pRNG % get() ) * majorant_inv - - ! Move partice in the geometry - call self % geom % teleport(p % coords, distance) - ! If particle has leaked exit if (p % matIdx() == OUTSIDE_FILL) then p % fate = LEAK_FATE @@ -95,6 +76,8 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) return end if + if (p % fate == TIME_FATE) exit IMCLoop + ! Check for void if( p % matIdx() == VOID_MAT) cycle IMCLoop From 0107a6370d64a2202a883cd11baac585fc7fbfc6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 27 Dec 2021 13:56:00 +0000 Subject: [PATCH 041/373] Fixed error --- TransportOperator/transportOperatorIMC_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 49dcdb134..2cbc1b5a7 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -66,7 +66,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Move particle to end of time step location call self % geom % teleport(p % coords, dTime) p % fate = TIME_FATE - p % time = endOfStepTime + p % time = thisCycle % endOfStepTime end if ! If particle has leaked exit From 745b3e50a93107e79a158c3fcf24b6af771eb075 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 30 Dec 2021 23:05:34 +0000 Subject: [PATCH 042/373] Detain particles that reach end of time step and use temp dungeon to recover in next time step. Potentially worth writing subroutine in dungeon class to combine 2 dungeons, would eliminate need for temporary dungeon. Currently favours early cycles because yet to generate source particles at correct time. --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 31 ++++++++++++++++++--- 1 file changed, 27 insertions(+), 4 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index f9fee894c..8f4f22cd6 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -79,6 +79,8 @@ module IMCPhysicsPackage_class ! Calculation components type(particleDungeon), pointer :: thisCycle => null() + type(particleDungeon), pointer :: nextCycle => null() + type(particleDungeon), pointer :: tempDungeon => null() class(source), allocatable :: IMCSource !integer(shortInt) :: nTimeStep @@ -139,6 +141,10 @@ subroutine cycles(self, tally, N_cycles) do i=1,N_cycles + ! Store photons remaining from previous cycle + self % tempDungeon = self % nextCycle + call self % nextCycle % cleanPop() + ! Send start of cycle report call self % IMCSource % generate(self % thisCycle, N, p % pRNG) if(self % printSource == 1) then @@ -147,7 +153,8 @@ subroutine cycles(self, tally, N_cycles) call tally % reportCycleStart(self % thisCycle) - self % thisCycle % endOfStepTime = i * self % timeStepSize + self % thisCycle % endOfStepTime = i * self % timeStepSize + self % tempDungeon % endOfStepTime = i * self % timeStepSize gen: do ! Obtain paticle from dungeon @@ -159,18 +166,30 @@ subroutine cycles(self, tally, N_cycles) ! Transport particle until its death history: do - call self % transOp % transport(p, tally, self % thisCycle, self % thisCycle) + call self % transOp % transport(p, tally, self % thisCycle, self % nextCycle) if(p % isDead) exit history if(p % fate == TIME_FATE) then ! Store particle for use in next time step + call self % nextCycle % detain(p) + exit history end if - call self % collOp % collide(p, tally, self % thisCycle, self % thisCycle) + call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) if(p % isDead) exit history + end do history - if( self % thisCycle % isEmpty()) exit gen + ! When both dungeons empty, exit + if( self % thisCycle % isEmpty() .and. self % tempDungeon % isEmpty()) exit gen + + ! When source dungeon is emptied, switch to using particles remaining from previous cycle + if( self % thisCycle % isEmpty()) then + print *, "THIS CYCLE EMPTIED OF SOURCE >>> SWITCHING TO CENSUS PARTICLES" + self % thisCycle = self % tempDungeon + call self % tempDungeon % cleanPop() + end if + end do gen ! Send end of cycle report @@ -338,6 +357,10 @@ subroutine init(self, dict) ! Size particle dungeon allocate(self % thisCycle) call self % thisCycle % init(3 * self % pop) + allocate(self % nextCycle) + call self % nextCycle % init(3 * self % pop) + allocate(self % tempDungeon) + call self % tempDungeon % init(3 * self % pop) call self % printSettings() From 7873f97faf1bd53bf4843e559b2192f957229c29 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 30 Dec 2021 23:30:06 +0000 Subject: [PATCH 043/373] Added note to look into pointer vs allocatable in more detail, in this case either seems to work --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 8f4f22cd6..b43765c11 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -78,9 +78,9 @@ module IMCPhysicsPackage_class integer(shortInt) :: particleType ! Calculation components - type(particleDungeon), pointer :: thisCycle => null() - type(particleDungeon), pointer :: nextCycle => null() - type(particleDungeon), pointer :: tempDungeon => null() + type(particleDungeon), allocatable :: thisCycle! => null() Other physics packages use pointers here + type(particleDungeon), allocatable :: nextCycle! => null() - Need to read up more to figure out correct usage + type(particleDungeon), allocatable :: tempDungeon! => null() e.g. using = instead of => for pointers class(source), allocatable :: IMCSource !integer(shortInt) :: nTimeStep From 3a476e271adaa3e13091b2c556466593ba0fad9a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 8 Jan 2022 15:31:42 +0000 Subject: [PATCH 044/373] Added function to return the equilibrium radiation energy density U_r --- NuclearData/IMCMaterial_inter.f90 | 10 ++++++++++ .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 13 +++++++++++++ NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 10 ++++++++++ SharedModules/universalVariables.f90 | 5 ++++- 4 files changed, 37 insertions(+), 1 deletion(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 0e1f4bf1f..e55347c8a 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -31,6 +31,7 @@ module IMCMaterial_inter generic :: getMacroXSs => getMacroXSs_byP procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP procedure(updateTemp), deferred :: updateTemp + procedure(getRadEnergy), deferred :: getRadEnergy end type IMCMaterial abstract interface @@ -64,6 +65,15 @@ subroutine updateTemp(self) class(IMCMaterial), intent(inout) :: self end subroutine updateTemp + !! + !! Return the equilibrium radiation energy density, U_r + !! + function getRadEnergy(self) result(radEnergy) + import :: IMCMaterial, defReal + class(IMCMaterial), intent(inout) :: self + real(defReal) :: radEnergy + end function getRadEnergy + end interface contains diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 4487e19e1..182653c3b 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -2,6 +2,7 @@ module baseMgIMCMaterial_class use numPrecision use endfConstants + use universalVariables use genericProcedures, only : fatalError, numToChar use RNG_class, only : RNG use dictionary_class, only : dictionary @@ -77,6 +78,7 @@ module baseMgIMCMaterial_class procedure :: init procedure :: nGroups procedure :: updateTemp + procedure :: getRadEnergy end type baseMgIMCMaterial @@ -312,5 +314,16 @@ subroutine updateTemp(self) end subroutine updateTemp + !! + !! Return the equilibrium radiation energy density, U_r + !! + function getRadEnergy(self) result(radEnergy) + class(baseMgIMCMaterial),intent(inout) :: self + real(defReal) :: radEnergy + + radEnergy = radiationConstant * (self % T)**4 + + end function getRadEnergy + end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 40e34c2ec..4cc69c38f 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -44,6 +44,7 @@ module mgIMCMaterial_inter procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG procedure(getTotalXS), deferred :: getTotalXS procedure(updateTemp), deferred :: updateTemp + procedure(getRadEnergy), deferred :: getRadEnergy end type mgIMCMaterial @@ -99,6 +100,15 @@ subroutine updateTemp(self) class(mgIMCMaterial), intent(inout) :: self end subroutine updateTemp + !! + !! Return the equilibrium radiation energy density, U_r + !! + function getRadEnergy(self) result(radEnergy) + import :: mgIMCMaterial, defReal + class(mgIMCMaterial), intent(inout) :: self + real(defReal) :: radEnergy + end function getRadEnergy + end interface diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index 183b48efc..f111d29a0 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -69,9 +69,12 @@ module universalVariables ! Physical constants real(defReal), parameter :: neutronMass = 939.5654133_defReal, & ! Neutron mass in MeV/c^2 lightSpeed = 2.99792458e10_defReal, & ! Light speed in cm/s - energyPerFission = 200.0_defReal ! MeV + energyPerFission = 200.0_defReal, & ! MeV + radiationConstant = 0.01372_defReal ! GJ/(cm^3 keV^4) ! Unit conversion real(defReal), parameter :: joulesPerMeV = 1.60218e-13 ! Convert MeV to J + !real(defReal) :: timeStepSize + end module universalVariables From 5b929760595abed99eedbf5e925edcc016b9dbbd Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 8 Jan 2022 15:34:51 +0000 Subject: [PATCH 045/373] Changed timeStepSize to be in universalVariables instead of tied to phys package, began work on particle sourcing (very unfinished) --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 16 +++++++++++----- SharedModules/universalVariables.f90 | 2 +- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index b43765c11..dc080665d 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -70,7 +70,7 @@ module IMCPhysicsPackage_class ! Settings integer(shortInt) :: N_cycles - real(defReal) :: timeStepSize + !real(defReal) :: timeStepSize integer(shortInt) :: pop character(pathLen) :: outputFile character(nameLen) :: outputFormat @@ -125,6 +125,7 @@ subroutine cycles(self, tally, N_cycles) integer(shortInt) :: i, N type(particle) :: p real(defReal) :: elapsed_T, end_T, T_toEnd + real(defReal) :: fleck, emittedRad class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' @@ -145,6 +146,12 @@ subroutine cycles(self, tally, N_cycles) self % tempDungeon = self % nextCycle call self % nextCycle % cleanPop() + ! Calculate fleck factor + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) + fleck = 1/(1+1*1*lightSpeed*timeStepSize) ! Incomplete, need to add alpha and sigma_p + emittedRad = lightSpeed*timeStepSize*fleck*(mat % getRadEnergy()) ! Incomplete, need to * Volume of zone + print *, emittedRad + ! Send start of cycle report call self % IMCSource % generate(self % thisCycle, N, p % pRNG) if(self % printSource == 1) then @@ -153,8 +160,8 @@ subroutine cycles(self, tally, N_cycles) call tally % reportCycleStart(self % thisCycle) - self % thisCycle % endOfStepTime = i * self % timeStepSize - self % tempDungeon % endOfStepTime = i * self % timeStepSize + self % thisCycle % endOfStepTime = i * timeStepSize + self % tempDungeon % endOfStepTime = i * timeStepSize gen: do ! Obtain paticle from dungeon @@ -203,7 +210,6 @@ subroutine cycles(self, tally, N_cycles) end_T = real(N_cycles,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) !call mat % updateTemp() @@ -277,7 +283,7 @@ subroutine init(self, dict) ! Read calculation settings call dict % get( self % pop,'pop') call dict % get( self % N_cycles,'cycles') - call dict % get( self % timeStepSize,'timeStepSize') + call dict % get( timeStepSize,'timeStepSize') call dict % get( nucData, 'XSdata') call dict % get( energy, 'dataType') diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index f111d29a0..93e30710d 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -75,6 +75,6 @@ module universalVariables ! Unit conversion real(defReal), parameter :: joulesPerMeV = 1.60218e-13 ! Convert MeV to J - !real(defReal) :: timeStepSize + real(defReal) :: timeStepSize end module universalVariables From 5c260273176bb9b49eddc19b24cf71e33a425d18 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 8 Jan 2022 17:45:54 +0000 Subject: [PATCH 046/373] Created new source type for radiation emitted from material --- ParticleObjects/Source/CMakeLists.txt | 1 + ParticleObjects/Source/IMCSource_class.f90 | 172 ++++++++++++++++++ ParticleObjects/Source/sourceFactory_func.f90 | 8 +- 3 files changed, 180 insertions(+), 1 deletion(-) create mode 100644 ParticleObjects/Source/IMCSource_class.f90 diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index 601c905be..3309bd4ba 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -4,4 +4,5 @@ add_sources( source_inter.f90 sourceFactory_func.f90 pointSource_class.f90 fissionSource_class.f90 + IMCSource_class.f90 ) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 new file mode 100644 index 000000000..164b4d8ac --- /dev/null +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -0,0 +1,172 @@ +module IMCSource_class + + use numPrecision + use endfConstants + use universalVariables + use genericProcedures, only : fatalError, rotateVector + use dictionary_class, only : dictionary + use RNG_class, only : RNG + + use particle_class, only : particleState, P_NEUTRON + use source_inter, only : source, kill_super => kill + + use geometry_inter, only : geometry + use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast + use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase + + implicit none + private + + !! + !! IMC Source from distributed fission sites + !! + !! Places fission sites uniformly in regions with fissile material. + !! Spectrum of the fission IMC is such as if it fission was caused by incdent + !! IMC with CE energy E or MG with group G. + !! Angular distribution is isotropic. + !! + !! Private members: + !! isMG -> is the source multi-group? (default = .false.) + !! bottom -> Bottom corner (x_min, y_min, z_min) + !! top -> Top corner (x_max, y_max, z_max) + !! E -> Fission site energy [MeV] (default = 1.0E-6) + !! G -> Fission site Group (default = 1) + !! + !! Interface: + !! source_inter Interface + !! + !! Sample Dictionary Input: + !! fission { + !! type imcSource; + !! #data MG; # + !! #E 15.0; # + !! #G 7; # + !! } + !! + type, public,extends(source) :: imcSource + private + logical(defBool) :: isMG = .true. + real(defReal), dimension(3) :: bottom = ZERO + real(defReal), dimension(3) :: top = ZERO + real(defReal) :: E = ZERO + integer(shortInt) :: G = 0 + contains + procedure :: init + procedure :: sampleParticle + procedure :: kill + end type imcSource + +contains + + !! + !! Initialise IMC Source + !! + !! See source_inter for details + !! + subroutine init(self, dict, geom) + class(imcSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + character(nameLen) :: type + real(defReal), dimension(6) :: bounds + character(100), parameter :: Here = 'init (imcSource_class.f90)' + + ! Provide geometry info to source + self % geom => geom + + ! Select Required fission group/energy + call dict % getOrDefault(self % E, 'E', 1.0E-6_defReal) + call dict % getOrDefault(self % G, 'G', 1) + + ! Set bounding region + bounds = self % geom % bounds() + self % bottom = bounds(1:3) + self % top = bounds(4:6) + + end subroutine init + + !! + !! Sample particle's phase space co-ordinates + !! + !! See source_inter for details + !! + function sampleParticle(self, rand) result(p) + class(imcSource), intent(inout) :: self + class(RNG), intent(inout) :: rand + type(particleState) :: p + class(nuclearDatabase), pointer :: nucData + class(IMCMaterial), pointer :: mat + real(defReal), dimension(3) :: r, rand3 + real(defReal) :: mu, phi, E_out, E_up, E_down + integer(shortInt) :: matIdx, uniqueID, nucIdx, i, G_out + character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' + + ! Get pointer to appropriate nuclear database + nucData => ndReg_getIMCMG() + if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') + + i = 0 + rejection : do + ! Protect against infinite loop + i = i +1 + if ( i > 200) then + call fatalError(Here, 'Infinite loop in sampling of fission sites. Please check that& + & defined volume contains fissile material.') + end if + + ! Sample Position + rand3(1) = rand % get() + rand3(2) = rand % get() + rand3(3) = rand % get() + r = (self % top - self % bottom) * rand3 + self % bottom + + ! Find material under position + call self % geom % whatIsAt(matIdx, uniqueID, r) + + ! Reject if there is no material + if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle rejection + + mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) + if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") + + ! Assign basic phase-space coordinates + p % matIdx = matIdx + p % uniqueID = uniqueID + p % wgt = ONE + p % time = ZERO + p % type = P_PHOTON_MG + p % r = r + + ! Set Energy + + + ! Set Time + p % time = rand % get() * timeStepSize ! + Start of time step time + + + ! Exit the loop + exit rejection + + end do rejection + + end function sampleParticle + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(imcSource), intent(inout) :: self + + call kill_super(self) + + self % isMG = .true. + self % bottom = ZERO + self % top = ZERO + self % E = ZERO + self % G = 0 + + end subroutine kill + +end module IMCSource_class diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index b4e15c429..eb0976475 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -10,6 +10,7 @@ module sourceFactory_func ! source implementations use pointSource_class, only : pointSource use fissionSource_class, only : fissionSource + use IMCSource_class, only : imcSource ! geometry use geometry_inter, only : geometry @@ -25,7 +26,8 @@ module sourceFactory_func ! NOTE: ! For now it is necessary to adjust trailing blanks so all entries have the same length character(nameLen),dimension(*),parameter :: AVAILABLE_sources = [ 'pointSource ',& - 'fissionSource'] + 'fissionSource',& + 'imcSource '] contains @@ -57,6 +59,10 @@ subroutine new_source(new, dict, geom) allocate(fissionSource :: new) call new % init(dict, geom) + case('imcSource') + allocate(imcSource :: new) + call new % init(dict, geom) + !*** NEW SOURCE TEMPLATE ***! !case('') ! allocate( :: new) From 19f0c42ba5e66930ac09b8d3a01f5d18712b5a7f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 8 Jan 2022 23:26:42 +0000 Subject: [PATCH 047/373] Now calculate energy to be emitted in each time step within material class --- NuclearData/IMCMaterial_inter.f90 | 8 ++++---- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 16 +++++++++------- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 8 ++++---- 3 files changed, 17 insertions(+), 15 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index e55347c8a..190df9507 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -31,7 +31,7 @@ module IMCMaterial_inter generic :: getMacroXSs => getMacroXSs_byP procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP procedure(updateTemp), deferred :: updateTemp - procedure(getRadEnergy), deferred :: getRadEnergy + procedure(getEmittedRad), deferred :: getEmittedRad end type IMCMaterial abstract interface @@ -68,11 +68,11 @@ end subroutine updateTemp !! !! Return the equilibrium radiation energy density, U_r !! - function getRadEnergy(self) result(radEnergy) + function getEmittedRad(self) result(emittedRad) import :: IMCMaterial, defReal class(IMCMaterial), intent(inout) :: self - real(defReal) :: radEnergy - end function getRadEnergy + real(defReal) :: emittedRad + end function getEmittedRad end interface diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 182653c3b..10c4efe68 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -78,7 +78,7 @@ module baseMgIMCMaterial_class procedure :: init procedure :: nGroups procedure :: updateTemp - procedure :: getRadEnergy + procedure :: getEmittedRad end type baseMgIMCMaterial @@ -306,10 +306,9 @@ end function baseMgIMCMaterial_CptrCast !! None !! subroutine updateTemp(self) - class(baseMgIMCMaterial),intent(inout) :: self + class(baseMgIMCMaterial),intent(inout) :: self self % T = self % T + 1 - print *, "Updated material temperature:", int(self % T), "K" end subroutine updateTemp @@ -317,13 +316,16 @@ end subroutine updateTemp !! !! Return the equilibrium radiation energy density, U_r !! - function getRadEnergy(self) result(radEnergy) + function getEmittedRad(self) result(emittedRad) class(baseMgIMCMaterial),intent(inout) :: self - real(defReal) :: radEnergy + real(defReal) :: U_r, fleck, emittedRad + + U_r = radiationConstant * (self % T)**4 - radEnergy = radiationConstant * (self % T)**4 + fleck = 1/(1+1*1*lightSpeed*timeStepSize) ! Incomplete, need to add alpha and sigma_p + emittedRad = lightSpeed*timeStepSize*fleck*U_r ! Incomplete, need to * Volume of zone - end function getRadEnergy + end function getEmittedRad end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 4cc69c38f..7ebad5f5c 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -44,7 +44,7 @@ module mgIMCMaterial_inter procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG procedure(getTotalXS), deferred :: getTotalXS procedure(updateTemp), deferred :: updateTemp - procedure(getRadEnergy), deferred :: getRadEnergy + procedure(getEmittedRad), deferred :: getEmittedRad end type mgIMCMaterial @@ -103,11 +103,11 @@ end subroutine updateTemp !! !! Return the equilibrium radiation energy density, U_r !! - function getRadEnergy(self) result(radEnergy) + function getEmittedRad(self) result(emittedRad) import :: mgIMCMaterial, defReal class(mgIMCMaterial), intent(inout) :: self - real(defReal) :: radEnergy - end function getRadEnergy + real(defReal) :: emittedRad + end function getEmittedRad end interface From 2fd865b8d77592a952f2589343d35a6b2e28dd48 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 8 Jan 2022 23:30:55 +0000 Subject: [PATCH 048/373] Sources new particles emitted from material. Needs modification to work with geometry - currently only simple single region case --- ParticleObjects/Source/IMCSource_class.f90 | 34 ++++++++++++---------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 164b4d8ac..8b126d076 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -7,7 +7,7 @@ module IMCSource_class use dictionary_class, only : dictionary use RNG_class, only : RNG - use particle_class, only : particleState, P_NEUTRON + use particle_class, only : particleState, P_PHOTON use source_inter, only : source, kill_super => kill use geometry_inter, only : geometry @@ -66,7 +66,7 @@ module IMCSource_class !! See source_inter for details !! subroutine init(self, dict, geom) - class(imcSource), intent(inout) :: self + class(imcSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom character(nameLen) :: type @@ -76,10 +76,6 @@ subroutine init(self, dict, geom) ! Provide geometry info to source self % geom => geom - ! Select Required fission group/energy - call dict % getOrDefault(self % E, 'E', 1.0E-6_defReal) - call dict % getOrDefault(self % G, 'G', 1) - ! Set bounding region bounds = self % geom % bounds() self % bottom = bounds(1:3) @@ -93,14 +89,14 @@ end subroutine init !! See source_inter for details !! function sampleParticle(self, rand) result(p) - class(imcSource), intent(inout) :: self + class(imcSource), intent(inout) :: self class(RNG), intent(inout) :: rand type(particleState) :: p class(nuclearDatabase), pointer :: nucData - class(IMCMaterial), pointer :: mat - real(defReal), dimension(3) :: r, rand3 - real(defReal) :: mu, phi, E_out, E_up, E_down - integer(shortInt) :: matIdx, uniqueID, nucIdx, i, G_out + class(IMCMaterial), pointer :: mat + real(defReal), dimension(3) :: r, rand3, dir + real(defReal) :: mu, phi + integer(shortInt) :: matIdx, uniqueID, nucIdx, i character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' ! Get pointer to appropriate nuclear database @@ -128,20 +124,28 @@ function sampleParticle(self, rand) result(p) ! Reject if there is no material if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle rejection - mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) + mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) ! Currently will only work as intended with 1 cell if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") + ! Sample Direction - chosen uniformly inside unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + ! Assign basic phase-space coordinates p % matIdx = matIdx p % uniqueID = uniqueID p % wgt = ONE p % time = ZERO - p % type = P_PHOTON_MG + p % type = P_PHOTON p % r = r + p % dir = dir ! Set Energy - - + p % E = mat % getEmittedRad() / 5 ! Currently fixed at 5 particles for simplicity + ! Set Time p % time = rand % get() * timeStepSize ! + Start of time step time From 74323498346976f1a041b6a06785cdef19227acd Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 8 Jan 2022 23:32:43 +0000 Subject: [PATCH 049/373] Particles now emitted from material. Actual numbers not yet correct. Also need to add back external source --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 34 ++++++++++----------- 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index dc080665d..e3ab1ea65 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -72,6 +72,7 @@ module IMCPhysicsPackage_class integer(shortInt) :: N_cycles !real(defReal) :: timeStepSize integer(shortInt) :: pop + integer(shortInt) :: inputPop ! Stores pop given in input file for use in particle weightings character(pathLen) :: outputFile character(nameLen) :: outputFormat integer(shortInt) :: printSource = 0 @@ -81,6 +82,7 @@ module IMCPhysicsPackage_class type(particleDungeon), allocatable :: thisCycle! => null() Other physics packages use pointers here type(particleDungeon), allocatable :: nextCycle! => null() - Need to read up more to figure out correct usage type(particleDungeon), allocatable :: tempDungeon! => null() e.g. using = instead of => for pointers + class(source), allocatable :: inputSource class(source), allocatable :: IMCSource !integer(shortInt) :: nTimeStep @@ -125,7 +127,6 @@ subroutine cycles(self, tally, N_cycles) integer(shortInt) :: i, N type(particle) :: p real(defReal) :: elapsed_T, end_T, T_toEnd - real(defReal) :: fleck, emittedRad class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' @@ -146,14 +147,13 @@ subroutine cycles(self, tally, N_cycles) self % tempDungeon = self % nextCycle call self % nextCycle % cleanPop() - ! Calculate fleck factor - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - fleck = 1/(1+1*1*lightSpeed*timeStepSize) ! Incomplete, need to add alpha and sigma_p - emittedRad = lightSpeed*timeStepSize*fleck*(mat % getRadEnergy()) ! Incomplete, need to * Volume of zone - print *, emittedRad + ! Generate IMC source + call self % IMCSource % generate(self % thisCycle, 5, p % pRNG) ! Currently 5 particles for simplicity, change weighting in IMCSource_class when altering + + call self % thisCycle % printToFile() ! Send start of cycle report - call self % IMCSource % generate(self % thisCycle, N, p % pRNG) + call self % inputSource % generate(self % thisCycle, N, p % pRNG) if(self % printSource == 1) then call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) end if @@ -168,6 +168,9 @@ subroutine cycles(self, tally, N_cycles) call self % thisCycle % release(p) call self % geom % placeCoord(p % coords) + !! Source produces samples particle time within timestep, add current time to get absolute time + !p % time = p % time + i * timeStepSize + ! Save state call p % savePreHistory() @@ -211,6 +214,7 @@ subroutine cycles(self, tally, N_cycles) T_toEnd = max(ZERO, end_T - elapsed_T) + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) !call mat % updateTemp() ! Display progress @@ -281,12 +285,14 @@ subroutine init(self, dict) call cpu_time(self % CPU_time_start) ! Read calculation settings - call dict % get( self % pop,'pop') + call dict % get( self % inputPop,'pop') call dict % get( self % N_cycles,'cycles') call dict % get( timeStepSize,'timeStepSize') call dict % get( nucData, 'XSdata') call dict % get( energy, 'dataType') + self % pop = self % inputPop + ! Process type of data select case(energy) case('mg') @@ -345,6 +351,8 @@ subroutine init(self, dict) ! Read particle source definition tempDict => dict % getDictPtr('source') + call new_source(self % inputSource, tempDict, self % geom) + tempDict => dict % getDictPtr('imcSource') call new_source(self % IMCSource, tempDict, self % geom) ! Build collision operator @@ -397,15 +405,5 @@ subroutine printSettings(self) print *, repeat("<>",50) end subroutine printSettings - !! - !! Return time at end of current time step - !! - !function endOfStepTime(self) result(time) - ! implicit none - ! class(IMCPhysicsPackage), intent(in) :: self - ! real(defReal) :: time - ! - ! time = self % timeStepSize * self % nTimeStep - !end function endOfStepTime end module IMCPhysicsPackage_class From 220223f4365c44baf293d5c2fb4ee9bcf3306143 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 8 Jan 2022 23:36:07 +0000 Subject: [PATCH 050/373] Removed unused variable --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index e3ab1ea65..918e1e7e6 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -72,7 +72,6 @@ module IMCPhysicsPackage_class integer(shortInt) :: N_cycles !real(defReal) :: timeStepSize integer(shortInt) :: pop - integer(shortInt) :: inputPop ! Stores pop given in input file for use in particle weightings character(pathLen) :: outputFile character(nameLen) :: outputFormat integer(shortInt) :: printSource = 0 @@ -285,14 +284,12 @@ subroutine init(self, dict) call cpu_time(self % CPU_time_start) ! Read calculation settings - call dict % get( self % inputPop,'pop') + call dict % get( self % pop,'pop') call dict % get( self % N_cycles,'cycles') call dict % get( timeStepSize,'timeStepSize') call dict % get( nucData, 'XSdata') call dict % get( energy, 'dataType') - self % pop = self % inputPop - ! Process type of data select case(energy) case('mg') From 71a0cefd17dfa17f01417bdb96d0126da9146e46 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 8 Jan 2022 23:46:40 +0000 Subject: [PATCH 051/373] *IMPORTANT CHANGE* Changed particle time to be time within timestep rather than absolute time, should give same functionality but a lot less messy --- IMCTest | 4 +++- ParticleObjects/Source/IMCSource_class.f90 | 2 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 3 --- TransportOperator/transportOperatorIMC_class.f90 | 4 ++-- 4 files changed, 6 insertions(+), 7 deletions(-) diff --git a/IMCTest b/IMCTest index df1d90c3d..2fcfb58da 100644 --- a/IMCTest +++ b/IMCTest @@ -5,7 +5,7 @@ type IMCPhysicsPackage; pop 3; cycles 10; -timeStepSize 0.000000000002; +timeStepSize 0.00000000002; XSdata mg; dataType mg; @@ -27,6 +27,8 @@ source { G 1; } +imcSource { type imcSource; } + inactiveTally { } diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 8b126d076..586617be3 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -147,7 +147,7 @@ function sampleParticle(self, rand) result(p) p % E = mat % getEmittedRad() / 5 ! Currently fixed at 5 particles for simplicity ! Set Time - p % time = rand % get() * timeStepSize ! + Start of time step time + p % time = rand % get() * timeStepSize ! Exit the loop diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 918e1e7e6..2abef95d7 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -159,9 +159,6 @@ subroutine cycles(self, tally, N_cycles) call tally % reportCycleStart(self % thisCycle) - self % thisCycle % endOfStepTime = i * timeStepSize - self % tempDungeon % endOfStepTime = i * timeStepSize - gen: do ! Obtain paticle from dungeon call self % thisCycle % release(p) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 2cbc1b5a7..cedce42b0 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -52,7 +52,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) IMCLoop:do ! Find distance to time boundary - dTime = lightSpeed * (thisCycle % endOfStepTime - p % time) + dTime = lightSpeed * (timeStepSize - p % time) ! Sample distance to move particle before potential collision dColl = -log( p% pRNG % get() ) * majorant_inv @@ -66,7 +66,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Move particle to end of time step location call self % geom % teleport(p % coords, dTime) p % fate = TIME_FATE - p % time = thisCycle % endOfStepTime + p % time = ZERO end if ! If particle has leaked exit From e813806716788b637103c356c109f010958b4338 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 9 Jan 2022 00:09:40 +0000 Subject: [PATCH 052/373] Temporarily fixed error caused by a few missing lines in source class. Commented lines in physics package which shouldn't be running --- IMCTest | 2 +- ParticleObjects/Source/IMCSource_class.f90 | 4 ++++ PhysicsPackages/IMCPhysicsPackage_class.f90 | 10 +++++----- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/IMCTest b/IMCTest index 2fcfb58da..450587c43 100644 --- a/IMCTest +++ b/IMCTest @@ -5,7 +5,7 @@ type IMCPhysicsPackage; pop 3; cycles 10; -timeStepSize 0.00000000002; +timeStepSize 0.00000000003; XSdata mg; dataType mg; diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 586617be3..5865971d0 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -76,6 +76,8 @@ subroutine init(self, dict, geom) ! Provide geometry info to source self % geom => geom + call dict % getOrDefault(self % G, 'G', 1) + ! Set bounding region bounds = self % geom % bounds() self % bottom = bounds(1:3) @@ -142,6 +144,8 @@ function sampleParticle(self, rand) result(p) p % type = P_PHOTON p % r = r p % dir = dir + p % G = self % G + p % isMG = .true. ! Set Energy p % E = mat % getEmittedRad() / 5 ! Currently fixed at 5 particles for simplicity diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 2abef95d7..2d21926a6 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -149,13 +149,13 @@ subroutine cycles(self, tally, N_cycles) ! Generate IMC source call self % IMCSource % generate(self % thisCycle, 5, p % pRNG) ! Currently 5 particles for simplicity, change weighting in IMCSource_class when altering - call self % thisCycle % printToFile() + !call self % thisCycle % printToFile() ! Send start of cycle report - call self % inputSource % generate(self % thisCycle, N, p % pRNG) - if(self % printSource == 1) then - call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) - end if + !call self % inputSource % generate(self % thisCycle, N, p % pRNG) + !if(self % printSource == 1) then + ! call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + !end if call tally % reportCycleStart(self % thisCycle) From 04c23bc2459dd2d5cbc13894c24a9d2ca7ec01fa Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 9 Jan 2022 11:53:46 +0000 Subject: [PATCH 053/373] Fixed source to update p % wgt instead of p % E, and now takes number of particles as an input from input file --- IMCTest | 5 ++++- ParticleObjects/Source/IMCSource_class.f90 | 9 ++++++--- PhysicsPackages/IMCPhysicsPackage_class.f90 | 6 +++--- 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/IMCTest b/IMCTest index 450587c43..ae2a53ba6 100644 --- a/IMCTest +++ b/IMCTest @@ -27,7 +27,10 @@ source { G 1; } -imcSource { type imcSource; } +imcSource { + type imcSource; + nParticles 1; + } inactiveTally { } diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 5865971d0..7bf261972 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -52,6 +52,7 @@ module IMCSource_class real(defReal), dimension(3) :: top = ZERO real(defReal) :: E = ZERO integer(shortInt) :: G = 0 + integer(shortInt) :: nParticles = 10 contains procedure :: init procedure :: sampleParticle @@ -77,6 +78,7 @@ subroutine init(self, dict, geom) self % geom => geom call dict % getOrDefault(self % G, 'G', 1) + call dict % getOrDefault(self % nParticles, 'nParticles', 10) ! Set bounding region bounds = self % geom % bounds() @@ -139,7 +141,7 @@ function sampleParticle(self, rand) result(p) ! Assign basic phase-space coordinates p % matIdx = matIdx p % uniqueID = uniqueID - p % wgt = ONE + !p % wgt = ONE p % time = ZERO p % type = P_PHOTON p % r = r @@ -147,8 +149,8 @@ function sampleParticle(self, rand) result(p) p % G = self % G p % isMG = .true. - ! Set Energy - p % E = mat % getEmittedRad() / 5 ! Currently fixed at 5 particles for simplicity + ! Set Weight + p % wgt = mat % getEmittedRad() / self % nParticles ! Set Time p % time = rand % get() * timeStepSize @@ -174,6 +176,7 @@ elemental subroutine kill(self) self % top = ZERO self % E = ZERO self % G = 0 + self % nParticles = 10 end subroutine kill diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 2d21926a6..4cb4614c1 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -70,12 +70,12 @@ module IMCPhysicsPackage_class ! Settings integer(shortInt) :: N_cycles - !real(defReal) :: timeStepSize integer(shortInt) :: pop character(pathLen) :: outputFile character(nameLen) :: outputFormat integer(shortInt) :: printSource = 0 integer(shortInt) :: particleType + integer(shortInt) :: imcSourceN ! Calculation components type(particleDungeon), allocatable :: thisCycle! => null() Other physics packages use pointers here @@ -83,7 +83,6 @@ module IMCPhysicsPackage_class type(particleDungeon), allocatable :: tempDungeon! => null() e.g. using = instead of => for pointers class(source), allocatable :: inputSource class(source), allocatable :: IMCSource - !integer(shortInt) :: nTimeStep ! Timer bins integer(shortInt) :: timerMain @@ -147,7 +146,7 @@ subroutine cycles(self, tally, N_cycles) call self % nextCycle % cleanPop() ! Generate IMC source - call self % IMCSource % generate(self % thisCycle, 5, p % pRNG) ! Currently 5 particles for simplicity, change weighting in IMCSource_class when altering + call self % IMCSource % generate(self % thisCycle, self % imcSourceN, p % pRNG) !call self % thisCycle % printToFile() @@ -348,6 +347,7 @@ subroutine init(self, dict) call new_source(self % inputSource, tempDict, self % geom) tempDict => dict % getDictPtr('imcSource') call new_source(self % IMCSource, tempDict, self % geom) + call tempDict % get(self % imcSourceN, 'nParticles') ! Build collision operator tempDict => dict % getDictPtr('collisionOperator') From b4c3670b03f474876dac0113f41c0e56eb6c2640 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 15 Jan 2022 12:40:37 +0000 Subject: [PATCH 054/373] Reset particle fate --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 4cb4614c1..33c7c4b23 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -176,6 +176,7 @@ subroutine cycles(self, tally, N_cycles) if(p % fate == TIME_FATE) then ! Store particle for use in next time step + p % fate = 0 call self % nextCycle % detain(p) exit history end if From 956d55399dc077346b60cd6c5d7dfb464dfaaa09 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 28 Jan 2022 18:37:54 +0000 Subject: [PATCH 055/373] Added way to append sources to make dungeons less complicated --- IMCTest | 8 +++--- ParticleObjects/Source/source_inter.f90 | 29 +++++++++++++++++++++ PhysicsPackages/IMCPhysicsPackage_class.f90 | 25 ++++++------------ 3 files changed, 41 insertions(+), 21 deletions(-) diff --git a/IMCTest b/IMCTest index ae2a53ba6..5c80dbb87 100644 --- a/IMCTest +++ b/IMCTest @@ -3,9 +3,9 @@ type IMCPhysicsPackage; -pop 3; +pop 5; cycles 10; -timeStepSize 0.00000000003; +timeStepSize 0.00000000005; XSdata mg; dataType mg; @@ -24,12 +24,12 @@ source { type pointSource; r (0 0 0); particle photon; - G 1; + G 2; } imcSource { type imcSource; - nParticles 1; + nParticles 5; } inactiveTally { diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index 7db9175d9..dca1186c0 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -37,6 +37,7 @@ module source_inter class(geometry), pointer, public :: geom => null() contains procedure, non_overridable :: generate + procedure, non_overridable :: append procedure(sampleParticle), deferred :: sampleParticle procedure(init), deferred :: init procedure(kill), deferred :: kill @@ -112,6 +113,34 @@ subroutine generate(self, dungeon, n, rand) end subroutine generate + !! Generate particles to populate a particleDungeon without overriding + !! particles already present + !! + !! Adds to a particle dungeon n particles, sampled + !! from the corresponding source distributions + !! + !! Args: + !! dungeon [inout] -> particle dungeon to be populated + !! n [in] -> number of particles to place in dungeon + !! + !! Result: + !! A dungeon populated with n particles sampled from the source + !! + subroutine append(self, dungeon, n, rand) + class(source), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: n + class(RNG), intent(inout) :: rand + integer(shortInt) :: i + + ! Generate n particles to populate dungeon + do i = 1, n + call dungeon % detain(self % sampleParticle(rand)) + end do + + end subroutine append + + !! !! Return to uninitialised state !! diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 33c7c4b23..19c005e9f 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -79,8 +79,7 @@ module IMCPhysicsPackage_class ! Calculation components type(particleDungeon), allocatable :: thisCycle! => null() Other physics packages use pointers here - type(particleDungeon), allocatable :: nextCycle! => null() - Need to read up more to figure out correct usage - type(particleDungeon), allocatable :: tempDungeon! => null() e.g. using = instead of => for pointers + type(particleDungeon), allocatable :: nextCycle! => null() - Need to read up more to figure out correct usage e.g. using = instead of => for pointers class(source), allocatable :: inputSource class(source), allocatable :: IMCSource @@ -142,13 +141,14 @@ subroutine cycles(self, tally, N_cycles) do i=1,N_cycles ! Store photons remaining from previous cycle - self % tempDungeon = self % nextCycle + self % thisCycle = self % nextCycle call self % nextCycle % cleanPop() ! Generate IMC source - call self % IMCSource % generate(self % thisCycle, self % imcSourceN, p % pRNG) + call self % IMCSource % append(self % thisCycle, self % imcSourceN, p % pRNG) - !call self % thisCycle % printToFile() + ! Generate from input source + call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) ! Send start of cycle report !call self % inputSource % generate(self % thisCycle, N, p % pRNG) @@ -187,14 +187,7 @@ subroutine cycles(self, tally, N_cycles) end do history ! When both dungeons empty, exit - if( self % thisCycle % isEmpty() .and. self % tempDungeon % isEmpty()) exit gen - - ! When source dungeon is emptied, switch to using particles remaining from previous cycle - if( self % thisCycle % isEmpty()) then - print *, "THIS CYCLE EMPTIED OF SOURCE >>> SWITCHING TO CENSUS PARTICLES" - self % thisCycle = self % tempDungeon - call self % tempDungeon % cleanPop() - end if + if( self % thisCycle % isEmpty() ) exit gen end do gen @@ -365,11 +358,9 @@ subroutine init(self, dict) ! Size particle dungeon allocate(self % thisCycle) - call self % thisCycle % init(3 * self % pop) + call self % thisCycle % init(15 * self % pop) allocate(self % nextCycle) - call self % nextCycle % init(3 * self % pop) - allocate(self % tempDungeon) - call self % tempDungeon % init(3 * self % pop) + call self % nextCycle % init(10 * self % pop) call self % printSettings() From c7604893387740e0d51d49c5d4198921618a4adc Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 30 Jan 2022 13:30:25 +0000 Subject: [PATCH 056/373] Wrote subroutine to print dungeon's particle properties to screen for debugging --- ParticleObjects/particleDungeon_class.f90 | 55 +++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 44823afd7..b6584fd50 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -87,6 +87,7 @@ module particleDungeon_class procedure :: popWeight procedure :: setSize procedure :: printToFile + procedure :: printToScreen ! Private procedures procedure, private :: detain_particle @@ -440,4 +441,58 @@ subroutine printToFile(self, name) end subroutine printToFile + subroutine printToScreen(self, prop, nMax) + class(particleDungeon), intent(in) :: self + character(*), intent(in) :: prop + integer(shortInt), intent(in) :: nMax + integer(shortInt) :: i,iMax + character(100), parameter :: Here = 'printToScreen (particleDungeon_class.f90)' + + character(nameLen), dimension(*), parameter :: AVAILABLE_props = [ 'r ',& + 'dir ',& + 'E ',& + 'G ',& + 'time' ] + + print *, 'Number in dungeon =', self % pop + + iMax = min(nMax, self % pop) + + print *, '** **',prop,'** **' + + select case(prop) + case('r') + do i = 1, nMax + print *, i,numToChar(self % prisoners(i) % r) + end do + + case('dir') + do i = 1, nMax + print *, i,numToChar(self % prisoners(i) % dir) + end do + + case('E') + do i = 1, nMax + print *, i,numToChar(self % prisoners(i) % E) + end do + + case('G') + do i = 1, nMax + print *, i,numToChar(self % prisoners(i) % G) + end do + + case('time') + do i = 1, nMax + print *, i,numToChar(self % prisoners(i) % time) + end do + + case default + print *, AVAILABLE_props + call fatalError(Here, 'Unrecognised particle property : ' // trim(prop)) + + end select + + end subroutine printToScreen + + end module particleDungeon_class From 876c2a10cfcd4fdd157ef950ce405e8566539796 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 30 Jan 2022 13:53:17 +0000 Subject: [PATCH 057/373] Added subroutine description --- ParticleObjects/particleDungeon_class.f90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index b6584fd50..77f64283b 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -441,6 +441,16 @@ subroutine printToFile(self, name) end subroutine printToFile + !! + !! Prints given property of particles to screen + !! + !! Args: + !! prop [in] -> Particle property to be displayed + !! nMax [in] -> Maximum number of particles displayed + !! + !! Errors: + !! fatalError if prop is invalid + !! subroutine printToScreen(self, prop, nMax) class(particleDungeon), intent(in) :: self character(*), intent(in) :: prop @@ -456,10 +466,12 @@ subroutine printToScreen(self, prop, nMax) print *, 'Number in dungeon =', self % pop + ! Number of particles to be printed iMax = min(nMax, self % pop) print *, '** **',prop,'** **' + ! Print for each particle select case(prop) case('r') do i = 1, nMax From e0f855b1a54888b9440277e5da624879234a86d1 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 30 Jan 2022 14:05:41 +0000 Subject: [PATCH 058/373] Was accidentally using wrong variable, fixed --- ParticleObjects/particleDungeon_class.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 77f64283b..a241f3235 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -474,27 +474,27 @@ subroutine printToScreen(self, prop, nMax) ! Print for each particle select case(prop) case('r') - do i = 1, nMax + do i = 1, iMax print *, i,numToChar(self % prisoners(i) % r) end do case('dir') - do i = 1, nMax + do i = 1, iMax print *, i,numToChar(self % prisoners(i) % dir) end do case('E') - do i = 1, nMax + do i = 1, iMax print *, i,numToChar(self % prisoners(i) % E) end do case('G') - do i = 1, nMax + do i = 1, iMax print *, i,numToChar(self % prisoners(i) % G) end do case('time') - do i = 1, nMax + do i = 1, iMax print *, i,numToChar(self % prisoners(i) % time) end do From ed6c2b59f2cffc64ac23090f3ebcc5709d385b84 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 30 Jan 2022 14:25:38 +0000 Subject: [PATCH 059/373] Removed use of universal variable timeStepSize in physics package, sources and transport operator, but still in material --- ParticleObjects/Source/IMCSource_class.f90 | 5 ----- ParticleObjects/Source/pointSource_class.f90 | 2 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 19 +++++++++++++++---- .../transportOperatorIMC_class.f90 | 11 +++++++---- 4 files changed, 23 insertions(+), 14 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 7bf261972..567e353bf 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -141,7 +141,6 @@ function sampleParticle(self, rand) result(p) ! Assign basic phase-space coordinates p % matIdx = matIdx p % uniqueID = uniqueID - !p % wgt = ONE p % time = ZERO p % type = P_PHOTON p % r = r @@ -152,10 +151,6 @@ function sampleParticle(self, rand) result(p) ! Set Weight p % wgt = mat % getEmittedRad() / self % nParticles - ! Set Time - p % time = rand % get() * timeStepSize - - ! Exit the loop exit rejection diff --git a/ParticleObjects/Source/pointSource_class.f90 b/ParticleObjects/Source/pointSource_class.f90 index 6f10fffa2..5b33694ab 100644 --- a/ParticleObjects/Source/pointSource_class.f90 +++ b/ParticleObjects/Source/pointSource_class.f90 @@ -1,7 +1,7 @@ module pointSource_class use numPrecision - use universalVariables, only : OUTSIDE_MAT + use universalVariables use genericProcedures, only : fatalError use particle_class, only : particleState, P_NEUTRON, P_PHOTON use dictionary_class, only : dictionary diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 19c005e9f..140136e84 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -71,6 +71,7 @@ module IMCPhysicsPackage_class ! Settings integer(shortInt) :: N_cycles integer(shortInt) :: pop + real(defReal) :: deltaT character(pathLen) :: outputFile character(nameLen) :: outputFormat integer(shortInt) :: printSource = 0 @@ -131,7 +132,7 @@ subroutine cycles(self, tally, N_cycles) ! Attach nuclear data and RNG to particle p % pRNG => self % pRNG - p % k_eff = ONE + p % timeMax = self % deltaT p % geomIdx = self % geomIdx ! Reset and start timer @@ -150,6 +151,8 @@ subroutine cycles(self, tally, N_cycles) ! Generate from input source call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) + call self % thisCycle % printToScreen('time', 20) + ! Send start of cycle report !call self % inputSource % generate(self % thisCycle, N, p % pRNG) !if(self % printSource == 1) then @@ -163,8 +166,14 @@ subroutine cycles(self, tally, N_cycles) call self % thisCycle % release(p) call self % geom % placeCoord(p % coords) - !! Source produces samples particle time within timestep, add current time to get absolute time - !p % time = p % time + i * timeStepSize + ! Assign particle time + if( p % time /= self % deltaT ) then + ! If particle has just been sourced, t = 0 so sample uniformly within timestep + p % time = p % pRNG % get() * self % deltaT + else + ! If particle survived previous time step, reset time to 0 + p % time = 0 + end if ! Save state call p % savePreHistory() @@ -186,7 +195,7 @@ subroutine cycles(self, tally, N_cycles) end do history - ! When both dungeons empty, exit + ! When dungeon is empty, exit if( self % thisCycle % isEmpty() ) exit gen end do gen @@ -280,6 +289,8 @@ subroutine init(self, dict) call dict % get( nucData, 'XSdata') call dict % get( energy, 'dataType') + self % deltaT = timeStepSize + ! Process type of data select case(energy) case('mg') diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index cedce42b0..f5177183c 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -52,10 +52,10 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) IMCLoop:do ! Find distance to time boundary - dTime = lightSpeed * (timeStepSize - p % time) + dTime = lightSpeed * (p % timeMax - p % time) ! Sample distance to move particle before potential collision - dColl = -log( p% pRNG % get() ) * majorant_inv + dColl = -log( p% pRNG % get() ) * majorant_inv * 0.8 ! Determine which distance to move particle if (dColl < dTime) then @@ -66,7 +66,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Move particle to end of time step location call self % geom % teleport(p % coords, dTime) p % fate = TIME_FATE - p % time = ZERO + p % time = p % timeMax end if ! If particle has leaked exit @@ -91,7 +91,10 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Roll RNG to determine if the collision is real or virtual ! Exit the loop if the collision is real - if (p % pRNG % get() < sigmaT*majorant_inv) exit IMCLoop + if (p % pRNG % get() < sigmaT*majorant_inv) then + p % isDead = .true. + exit IMCLoop + end if end do IMCLoop From 3881e6138ad6e0bbf991d6f62847ed1ecfde8559 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 30 Jan 2022 16:04:57 +0000 Subject: [PATCH 060/373] Changed material classes and functions to use time step differently, now no need for timeStepSize in universal_variables --- NuclearData/IMCMaterial_inter.f90 | 9 ++++---- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 21 ++++++++++++------- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 9 ++++---- PhysicsPackages/IMCPhysicsPackage_class.f90 | 8 +++---- SharedModules/universalVariables.f90 | 2 -- 5 files changed, 26 insertions(+), 23 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 190df9507..d68fd58c4 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -30,7 +30,7 @@ module IMCMaterial_inter contains generic :: getMacroXSs => getMacroXSs_byP procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP - procedure(updateTemp), deferred :: updateTemp + procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad end type IMCMaterial @@ -60,10 +60,11 @@ end subroutine getMacroXSs_byP !! Args: !! None !! - subroutine updateTemp(self) - import :: IMCMaterial + subroutine updateMat(self, deltaT) + import :: IMCMaterial, defReal class(IMCMaterial), intent(inout) :: self - end subroutine updateTemp + real(defReal), intent(in) :: deltaT + end subroutine updateMat !! !! Return the equilibrium radiation energy density, U_r diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 10c4efe68..fd648cf6b 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -67,6 +67,8 @@ module baseMgIMCMaterial_class real(defReal),dimension(:,:), allocatable :: data class(multiScatterMG), allocatable :: scatter real(defReal) :: T + real(defReal) :: fleck + real(defReal) :: deltaT contains ! Superclass procedures @@ -77,7 +79,7 @@ module baseMgIMCMaterial_class ! Local procedures procedure :: init procedure :: nGroups - procedure :: updateTemp + procedure :: updateMat procedure :: getEmittedRad end type baseMgIMCMaterial @@ -300,30 +302,33 @@ pure function baseMgIMCMaterial_CptrCast(source) result(ptr) end function baseMgIMCMaterial_CptrCast !! - !! Update material temperature at each time step + !! Update material properties at each time step !! !! Args: - !! None + !! delta T [in] -> Time step size !! - subroutine updateTemp(self) + subroutine updateMat(self, deltaT) class(baseMgIMCMaterial),intent(inout) :: self + real(defReal), intent(in) :: deltaT self % T = self % T + 1 print *, "Updated material temperature:", int(self % T), "K" - end subroutine updateTemp + self % fleck = 1/(1+1*1*lightSpeed*deltaT) ! Incomplete, need to add alpha and sigma_p + self % deltaT = deltaT ! Store deltaT in material class for use in getEmittedRad, need to consider if possible to call updateMat before first cycle to set initially as getEmittedRad needs fleck and deltaT at start + + end subroutine updateMat !! !! Return the equilibrium radiation energy density, U_r !! function getEmittedRad(self) result(emittedRad) class(baseMgIMCMaterial),intent(inout) :: self - real(defReal) :: U_r, fleck, emittedRad + real(defReal) :: U_r, emittedRad U_r = radiationConstant * (self % T)**4 - fleck = 1/(1+1*1*lightSpeed*timeStepSize) ! Incomplete, need to add alpha and sigma_p - emittedRad = lightSpeed*timeStepSize*fleck*U_r ! Incomplete, need to * Volume of zone + emittedRad = lightSpeed* self % deltaT * self % fleck *U_r ! Incomplete, need to * Volume of zone end function getEmittedRad diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 7ebad5f5c..6c434560b 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -43,7 +43,7 @@ module mgIMCMaterial_inter ! Local procedures procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG procedure(getTotalXS), deferred :: getTotalXS - procedure(updateTemp), deferred :: updateTemp + procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad end type mgIMCMaterial @@ -95,10 +95,11 @@ end function getTotalXS !! Args: !! None !! - subroutine updateTemp(self) - import :: mgIMCMaterial + subroutine updateMat(self, deltaT) + import :: mgIMCMaterial, defReal class(mgIMCMaterial), intent(inout) :: self - end subroutine updateTemp + real(defReal), intent(in) :: deltaT + end subroutine updateMat !! !! Return the equilibrium radiation energy density, U_r diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 140136e84..473f70cec 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -213,12 +213,12 @@ subroutine cycles(self, tally, N_cycles) mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - !call mat % updateTemp() + !call mat % updateMat(self % deltaT) ! Display progress call printFishLineR(i) print * - call mat % updateTemp() + call mat % updateMat(self % deltaT) print * print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) print *, 'Pop: ', numToChar(self % pop) @@ -285,12 +285,10 @@ subroutine init(self, dict) ! Read calculation settings call dict % get( self % pop,'pop') call dict % get( self % N_cycles,'cycles') - call dict % get( timeStepSize,'timeStepSize') + call dict % get( self % deltaT,'timeStepSize') call dict % get( nucData, 'XSdata') call dict % get( energy, 'dataType') - self % deltaT = timeStepSize - ! Process type of data select case(energy) case('mg') diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index 93e30710d..a3136bdf5 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -75,6 +75,4 @@ module universalVariables ! Unit conversion real(defReal), parameter :: joulesPerMeV = 1.60218e-13 ! Convert MeV to J - real(defReal) :: timeStepSize - end module universalVariables From d47d9928486efe579d48d9ea88f96e29b8f5aa91 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 30 Jan 2022 16:09:26 +0000 Subject: [PATCH 061/373] Fixed some temporary changes that shouldn't have stayed --- TransportOperator/transportOperatorIMC_class.f90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index f5177183c..91a9d0b63 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -55,7 +55,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) dTime = lightSpeed * (p % timeMax - p % time) ! Sample distance to move particle before potential collision - dColl = -log( p% pRNG % get() ) * majorant_inv * 0.8 + dColl = -log( p% pRNG % get() ) * majorant_inv ! Determine which distance to move particle if (dColl < dTime) then @@ -91,10 +91,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Roll RNG to determine if the collision is real or virtual ! Exit the loop if the collision is real - if (p % pRNG % get() < sigmaT*majorant_inv) then - p % isDead = .true. - exit IMCLoop - end if + if (p % pRNG % get() < sigmaT*majorant_inv) exit IMCLoop end do IMCLoop From 95276e18593be25aab1c6a9de5ebd7390b4bf1bb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Jan 2022 17:16:17 +0000 Subject: [PATCH 062/373] Added if statement, currently does nothing --- .../CollisionProcessors/IMCMGstd_class.f90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 3bea11809..e39f526bb 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -36,11 +36,7 @@ module IMCMGstd_class private !! - !! Standard (default) scalar collision processor for MG IMCs - !! -> Preforms implicit fission site generation - !! -> Preforms analog capture - !! -> Treats fission as capture (only implicit generation of 2nd-ary IMCs) - !! -> Does not create secondary non-IMC projectiles + !! Standard (default) scalar collision processor for MG IMC !! !! Settings: !! NONE @@ -113,6 +109,14 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) call self % mat % getMacroXSs(macroXSs, p % G, p % pRNG) r = p % pRNG % get() + !if( r < self % mat % fleck ) then + ! Effective absoprtion + + !else + ! Effective scattering + + !end if + collDat % MT = macroXSs % invert(r) end subroutine sampleCollision From cb82405ea93c1fd181f9b78b94aa7649fa014488 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Jan 2022 17:17:09 +0000 Subject: [PATCH 063/373] Created new tally, done lots of fiddling, not yet working --- IMCTest | 16 +++++--- PhysicsPackages/IMCPhysicsPackage_class.f90 | 41 ++++++++++++++++++- Tallies/TallyClerks/CMakeLists.txt | 1 + .../TallyClerks/tallyClerkFactory_func.f90 | 8 +++- 4 files changed, 57 insertions(+), 9 deletions(-) diff --git a/IMCTest b/IMCTest index 5c80dbb87..d681d1a66 100644 --- a/IMCTest +++ b/IMCTest @@ -46,15 +46,19 @@ activeTally { } tally { - display (k-eff); + //display (imcWeight); //norm fiss; normVal 100.0; - k-eff { type keffAnalogClerk;} + //k-eff { type keffAnalogClerk; response (flux); flux {type fluxResponse;} } //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} - flux { type collisionClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - response (flux); flux {type fluxResponse;} - } + //flux { type collisionClerk; + // map { type energyMap; grid log; min 0.001; max 20; N 300;} + // response (flux); flux {type fluxResponse;} + // } + imcWeight { type imcWeightClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + //response (imc); imc {type fluxResponse;} + } } geometry { diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 473f70cec..a2f64894b 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -45,6 +45,8 @@ module IMCPhysicsPackage_class ! Tallies use tallyCodes use tallyAdmin_class, only : tallyAdmin + use tallyResult_class, only : tallyResult, tallyResultEmpty + use imcWeightClerk_class, only : imcWeightResult ! Factories use transportOperatorFactory_func, only : new_transportOperator @@ -67,6 +69,7 @@ module IMCPhysicsPackage_class class(transportOperator), allocatable :: transOp class(RNG), pointer :: pRNG => null() type(tallyAdmin),pointer :: tally => null() + type(tallyAdmin),pointer :: imcWeightAtch => null() ! Settings integer(shortInt) :: N_cycles @@ -107,7 +110,7 @@ subroutine run(self) print *, repeat("<>",50) print *, "/\/\ IMC CALCULATION /\/\" - call self % cycles(self % tally, self % N_cycles) + call self % cycles(self % tally, self % imcWeightAtch, self % N_cycles) call self % collectResults() print * @@ -118,15 +121,17 @@ subroutine run(self) !! !! !! - subroutine cycles(self, tally, N_cycles) + subroutine cycles(self, tally, tallyAtch, N_cycles) class(IMCPhysicsPackage), intent(inout) :: self type(tallyAdmin), pointer,intent(inout) :: tally + type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_cycles integer(shortInt) :: i, N type(particle) :: p real(defReal) :: elapsed_T, end_T, T_toEnd class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' + class(tallyResult), allocatable :: tallyRes N = self % pop @@ -198,6 +203,24 @@ subroutine cycles(self, tally, N_cycles) ! When dungeon is empty, exit if( self % thisCycle % isEmpty() ) exit gen + call tallyAtch % getResult(tallyRes, 'imcWeightClerk') + + select type(tallyRes) + class is(imcWeightResult) + print *, 'YAY' + + class is(tallyResult) + print *, 'tallyResult' + + class is(tallyResultEmpty) + print *, 'tallyResultEmpty' + + class default + call fatalError(Here, 'Invalid result has been returned') + end select + !print *, tallyRes % imcWeight(1) + !call tally % display() + end do gen ! Send end of cycle report @@ -270,6 +293,7 @@ subroutine init(self, dict) class(IMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict class(dictionary),pointer :: tempDict + type(dictionary) :: locDict1, locDict2 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -365,6 +389,19 @@ subroutine init(self, dict) allocate(self % tally) call self % tally % init(tempDict) + ! Initialise imcWeight tally attachment + call locDict1 % init(2) + call locDict2 % init(2) + + call locDict2 % store('type','imcWeightClerk') + call locDict1 % store('imcWeight', locDict2) + call locDict1 % store('display',['imcWeight']) + + allocate(self % imcWeightAtch) + call self % imcWeightAtch % init(locDict1) + + call self % tally % push(self % imcWeightAtch) + ! Size particle dungeon allocate(self % thisCycle) call self % thisCycle % init(15 * self % pop) diff --git a/Tallies/TallyClerks/CMakeLists.txt b/Tallies/TallyClerks/CMakeLists.txt index 28e980962..c655d28da 100644 --- a/Tallies/TallyClerks/CMakeLists.txt +++ b/Tallies/TallyClerks/CMakeLists.txt @@ -10,6 +10,7 @@ add_sources(./tallyClerk_inter.f90 ./dancoffBellClerk_class.f90 ./shannonEntropyClerk_class.f90 ./centreOfMassClerk_class.f90 + ./imcWeightClerk_class.f90 ) add_unit_tests(./Tests/collisionClerk_test.f90 diff --git a/Tallies/TallyClerks/tallyClerkFactory_func.f90 b/Tallies/TallyClerks/tallyClerkFactory_func.f90 index 4502f1400..e0355df58 100644 --- a/Tallies/TallyClerks/tallyClerkFactory_func.f90 +++ b/Tallies/TallyClerks/tallyClerkFactory_func.f90 @@ -16,6 +16,7 @@ module tallyClerkFactory_func use dancoffBellClerk_class, only : dancoffBellClerk use shannonEntropyClerk_class, only : shannonEntropyClerk use centreOfMassClerk_class, only : centreOfMassClerk + use imcWeightClerk_class, only : imcWeightClerk implicit none private @@ -34,7 +35,8 @@ module tallyClerkFactory_func 'simpleFMClerk ',& 'shannonEntropyClerk',& 'centreOfMassClerk ',& - 'dancoffBellClerk '] + 'dancoffBellClerk ',& + 'imcWeightClerk ' ] contains @@ -90,6 +92,10 @@ subroutine new_tallyClerk(new, dict, name) allocate(centreOfMassClerk :: new) call new % init(dict, name) + case('imcWeightClerk') + allocate(imcWeightClerk :: new) + call new % init(dict, name) + !*** NEW TALLY MAP TEMPLATE ***! !case('') ! allocate( :: new) From efd4337818277f7a9aa7cdf68233e4dadcede7e6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Jan 2022 18:40:22 +0000 Subject: [PATCH 064/373] Added new tally clerk --- Tallies/TallyClerks/imcWeightClerk_class.f90 | 310 +++++++++++++++++++ 1 file changed, 310 insertions(+) create mode 100644 Tallies/TallyClerks/imcWeightClerk_class.f90 diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 new file mode 100644 index 000000000..4018f48ef --- /dev/null +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -0,0 +1,310 @@ +module imcWeightClerk_class + + use numPrecision + use tallyCodes + 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 + + use tallyResult_class, only : tallyResult, tallyResultEmpty + use scoreMemory_class, only : scoreMemory + + + implicit none + private + + !! + !! Colision estimator of reaction rates + !! Calculates flux weighted integral from collisions + !! + !! 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: + !! + !! myImcWeightClerk { + !! type imcWeightClerk; + !! # filter { } # + !! # map { } # + !! response (resName1 #resName2 ... #) + !! resName1 { } + !! #resNamew { run-time procedures + procedure :: reportInColl + + ! Output procedures + procedure :: display + procedure :: print + procedure :: getResult + + end type imcWeightClerk + + type,public, extends(tallyResult) :: imcWeightResult + real(defReal) :: imcWeight = ZERO + end type imcWeightResult + +contains + + !! + !! Initialise clerk from dictionary and name + !! + !! See tallyClerk_inter for details + !! + subroutine init(self, dict, name) + class(imcWeightClerk), 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 filter + 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(imcWeightClerk), 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(imcWeightClerk),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(imcWeightClerk), intent(in) :: self + integer(shortInt) :: S + + S = 1 !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) + class(imcWeightClerk), intent(inout) :: self + class(particle), intent(in) :: p + class(nuclearDatabase), intent(inout) :: xsData + type(scoreMemory), intent(inout) :: mem + type(particleState) :: state + integer(shortInt) :: binIdx, i + integer(longInt) :: adrr + real(defReal) :: scoreVal, flx + character(100), parameter :: Here =' reportInColl (imcWeightClerk_class.f90)' + + ! 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 + + ! Calculate bin address + adrr = self % getMemAddress()! + self % width * (binIdx -1) - 1 + print *, adrr + ! Append all bins + !do i=1,self % width + scoreVal = p % w + !print *, 'Scoring:',scoreVal + call mem % score(scoreVal, adrr)! + i) + + !end do + + end subroutine reportInColl + + !! + !! Display convergance progress on the console + !! + !! See tallyClerk_inter for details + !! + subroutine display(self, mem) + class(imcWeightClerk), intent(in) :: self + type(scoreMemory), intent(in) :: mem + + print *, 'imcWeightClerk 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(imcWeightClerk), 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 imcWeight 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 + + !! + !! Return result for interaction with Physics Package + !! from the clerk in the slot + !! + !! See tallyClerk_inter for details + !! + pure subroutine getResult(self, res, mem) + class(imcWeightClerk), intent(in) :: self + class(tallyResult), allocatable, intent(inout) :: res + type(scoreMemory), intent(in) :: mem + real(defReal) :: w, STD + + ! Get result value + call mem % getResult(w, STD, self % getMemAddress()) + + allocate(res, source = imcWeightResult(w)) + + end subroutine getResult + +end module imcWeightClerk_class From ac3f13df36024a68af9f789ebfea4127f3844d2d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Jan 2022 19:01:20 +0000 Subject: [PATCH 065/373] Recording something but who knows what... --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 23 ++++++++++---------- Tallies/TallyClerks/imcWeightClerk_class.f90 | 3 +-- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index a2f64894b..c255e64f9 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -45,7 +45,7 @@ module IMCPhysicsPackage_class ! Tallies use tallyCodes use tallyAdmin_class, only : tallyAdmin - use tallyResult_class, only : tallyResult, tallyResultEmpty + use tallyResult_class, only : tallyResult use imcWeightClerk_class, only : imcWeightResult ! Factories @@ -128,7 +128,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) integer(shortInt), intent(in) :: N_cycles integer(shortInt) :: i, N type(particle) :: p - real(defReal) :: elapsed_T, end_T, T_toEnd + real(defReal) :: elapsed_T, end_T, T_toEnd, test class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes @@ -156,7 +156,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Generate from input source call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) - call self % thisCycle % printToScreen('time', 20) + !call self % thisCycle % printToScreen('time', 20) ! Send start of cycle report !call self % inputSource % generate(self % thisCycle, N, p % pRNG) @@ -196,6 +196,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end if call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) + !call tallyAtch % getResult(tallyRes, 'imcWeight') + !test = tallyRes % imcWeight + !print *, test if(p % isDead) exit history end do history @@ -203,22 +206,18 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! When dungeon is empty, exit if( self % thisCycle % isEmpty() ) exit gen - call tallyAtch % getResult(tallyRes, 'imcWeightClerk') + call tallyAtch % getResult(tallyRes, 'imcWeight') select type(tallyRes) class is(imcWeightResult) - print *, 'YAY' - - class is(tallyResult) - print *, 'tallyResult' - - class is(tallyResultEmpty) - print *, 'tallyResultEmpty' + test = tallyRes % imcWeight + print *, test class default call fatalError(Here, 'Invalid result has been returned') end select - !print *, tallyRes % imcWeight(1) + + !print *, tallyRes % imcWeight (1) !call tally % display() end do gen diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 index 4018f48ef..4c7c4c291 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -218,11 +218,10 @@ subroutine reportInColl(self, p, xsData, mem) ! Calculate bin address adrr = self % getMemAddress()! + self % width * (binIdx -1) - 1 - print *, adrr ! Append all bins !do i=1,self % width scoreVal = p % w - !print *, 'Scoring:',scoreVal + print *, 'Scoring:',scoreVal call mem % score(scoreVal, adrr)! + i) !end do From af7cd465f03934565acba337a1ffe078e3d53d89 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Jan 2022 22:01:29 +0000 Subject: [PATCH 066/373] Created subroutine to reset tally score, but for some reason still being normalised --- IMCTest | 10 +++--- PhysicsPackages/IMCPhysicsPackage_class.f90 | 35 ++++++++++---------- Tallies/TallyClerks/imcWeightClerk_class.f90 | 18 +++++----- Tallies/scoreMemory_class.f90 | 14 ++++++++ Tallies/tallyAdmin_class.f90 | 28 ++++++++++++++++ 5 files changed, 75 insertions(+), 30 deletions(-) diff --git a/IMCTest b/IMCTest index d681d1a66..c22569c0b 100644 --- a/IMCTest +++ b/IMCTest @@ -37,7 +37,7 @@ inactiveTally { activeTally { //norm fiss; - normVal 100; + //normVal 100; //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} flux { type collisionClerk; map { type energyMap; grid log; min 0.001; max 20; N 300;} @@ -48,13 +48,13 @@ activeTally { tally { //display (imcWeight); //norm fiss; - normVal 100.0; + //normVal 100.0; //k-eff { type keffAnalogClerk; response (flux); flux {type fluxResponse;} } //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} //flux { type collisionClerk; - // map { type energyMap; grid log; min 0.001; max 20; N 300;} - // response (flux); flux {type fluxResponse;} - // } + // map { type energyMap; grid log; min 0.001; max 20; N 300;} + // response (flux); flux {type fluxResponse;} + // } imcWeight { type imcWeightClerk; map { type energyMap; grid log; min 0.001; max 20; N 300;} //response (imc); imc {type fluxResponse;} diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index c255e64f9..17183444c 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -144,6 +144,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call timerReset(self % timerMain) call timerStart(self % timerMain) + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) + call mat % updateMat(self % deltaT) + do i=1,N_cycles ! Store photons remaining from previous cycle @@ -183,6 +186,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Save state call p % savePreHistory() + print *, ' NEW PARTICLE Weight:', p % w + ! Transport particle until its death history: do call self % transOp % transport(p, tally, self % thisCycle, self % nextCycle) @@ -196,9 +201,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end if call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) - !call tallyAtch % getResult(tallyRes, 'imcWeight') - !test = tallyRes % imcWeight - !print *, test + if(p % isDead) exit history end do history @@ -206,20 +209,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! When dungeon is empty, exit if( self % thisCycle % isEmpty() ) exit gen - call tallyAtch % getResult(tallyRes, 'imcWeight') - - select type(tallyRes) - class is(imcWeightResult) - test = tallyRes % imcWeight - print *, test - - class default - call fatalError(Here, 'Invalid result has been returned') - end select - - !print *, tallyRes % imcWeight (1) - !call tally % display() - end do gen ! Send end of cycle report @@ -233,6 +222,18 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end_T = real(N_cycles,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) + call tallyAtch % getResult(tallyRes, 'imcWeight') + + select type(tallyRes) + class is(imcWeightResult) + test = tallyRes % imcWeight + print *, ' TALLY:',test + + class default + call fatalError(Here, 'Invalid result has been returned') + end select + + call tallyAtch % reset('imcWeight') mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) !call mat % updateMat(self % deltaT) diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 index 4c7c4c291..cd841a0ec 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -72,7 +72,7 @@ module imcWeightClerk_class procedure :: getSize ! File reports and check status -> run-time procedures - procedure :: reportInColl + procedure :: reportHist ! Output procedures procedure :: display @@ -164,7 +164,7 @@ function validReports(self) result(validCodes) class(imcWeightClerk),intent(in) :: self integer(shortInt),dimension(:),allocatable :: validCodes - validCodes = [inColl_CODE] + validCodes = [hist_CODE] end function validReports @@ -187,7 +187,7 @@ end function getSize !! !! See tallyClerk_inter for details !! - subroutine reportInColl(self, p, xsData, mem) + subroutine reportHist(self, p, xsData, mem) class(imcWeightClerk), intent(inout) :: self class(particle), intent(in) :: p class(nuclearDatabase), intent(inout) :: xsData @@ -196,7 +196,7 @@ subroutine reportInColl(self, p, xsData, mem) integer(shortInt) :: binIdx, i integer(longInt) :: adrr real(defReal) :: scoreVal, flx - character(100), parameter :: Here =' reportInColl (imcWeightClerk_class.f90)' + character(100), parameter :: Here =' reportHist (imcWeightClerk_class.f90)' ! Get current particle state state = p @@ -220,13 +220,15 @@ subroutine reportInColl(self, p, xsData, mem) adrr = self % getMemAddress()! + self % width * (binIdx -1) - 1 ! Append all bins !do i=1,self % width - scoreVal = p % w - print *, 'Scoring:',scoreVal - call mem % score(scoreVal, adrr)! + i) + if( p % isDead ) then + scoreVal = p % w + print *, 'Scoring:',scoreVal + call mem % score(scoreVal, adrr)! + i) + end if !end do - end subroutine reportInColl + end subroutine reportHist !! !! Display convergance progress on the console diff --git a/Tallies/scoreMemory_class.f90 b/Tallies/scoreMemory_class.f90 index 4feca8430..bff206b60 100644 --- a/Tallies/scoreMemory_class.f90 +++ b/Tallies/scoreMemory_class.f90 @@ -93,6 +93,7 @@ module scoreMemory_class procedure :: closeBin procedure :: lastCycle procedure :: getBatchSize + procedure :: reset ! Private procedures procedure, private :: score_defReal @@ -415,4 +416,17 @@ elemental function getScore(self, idx) result (score) end function getScore + !! + !! + !! + subroutine reset(self,idx) + class(scoreMemory), intent(inout) :: self + integer(longInt), intent(in) :: idx + + self % bins(idx, :) = ZERO + print *, size(self % bins, 1) + print *, size(self % bins, 2) + + end subroutine reset + end module scoreMemory_class diff --git a/Tallies/tallyAdmin_class.f90 b/Tallies/tallyAdmin_class.f90 index 9c39d14eb..feef46940 100644 --- a/Tallies/tallyAdmin_class.f90 +++ b/Tallies/tallyAdmin_class.f90 @@ -137,6 +137,7 @@ module tallyAdmin_class ! Interaction procedures procedure :: getResult + procedure :: reset ! Display procedures procedure :: display @@ -741,6 +742,33 @@ pure subroutine getResult(self, res, name) end subroutine getResult + !! + !! Resets tally clerk count to 0 + !! + subroutine reset(self, name) + class(tallyAdmin),intent(inout) :: self + character(*), intent(in) :: name + character(nameLen) :: name_loc + integer(shortInt) :: idx + integer(shortInt),parameter :: NOT_PRESENT = -3 + integer(longInt) :: addr + character(100),parameter :: Here='reset (tallyAdmin_class.f90)' + + name_loc = name + + idx = self % clerksNameMap % getOrDefault(name_loc, NOT_PRESENT) + + if(idx == NOT_PRESENT) then + call fatalError(Here, 'Tally clerk not present') + end if + + addr = self % tallyClerks(idx) % getMemAddress() + + call self % mem % reset(addr) + + end subroutine reset + + !! !! Append sorrting array identified with the code with tallyClerk idx !! From c72fd3bc0eba6e5aa5cca8c039a90b5a0e4a0897 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 4 Feb 2022 15:59:56 +0000 Subject: [PATCH 067/373] Removed print statements --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 4 ++-- Tallies/TallyClerks/imcWeightClerk_class.f90 | 1 - Tallies/scoreMemory_class.f90 | 2 -- 3 files changed, 2 insertions(+), 5 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 17183444c..6d248fc2e 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -186,7 +186,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Save state call p % savePreHistory() - print *, ' NEW PARTICLE Weight:', p % w + !print *, ' NEW PARTICLE Weight:', p % w ! Transport particle until its death history: do @@ -227,7 +227,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) select type(tallyRes) class is(imcWeightResult) test = tallyRes % imcWeight - print *, ' TALLY:',test + !print *, ' TALLY:',test*i class default call fatalError(Here, 'Invalid result has been returned') diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 index cd841a0ec..4969977ae 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -222,7 +222,6 @@ subroutine reportHist(self, p, xsData, mem) !do i=1,self % width if( p % isDead ) then scoreVal = p % w - print *, 'Scoring:',scoreVal call mem % score(scoreVal, adrr)! + i) end if diff --git a/Tallies/scoreMemory_class.f90 b/Tallies/scoreMemory_class.f90 index bff206b60..972ab9e13 100644 --- a/Tallies/scoreMemory_class.f90 +++ b/Tallies/scoreMemory_class.f90 @@ -424,8 +424,6 @@ subroutine reset(self,idx) integer(longInt), intent(in) :: idx self % bins(idx, :) = ZERO - print *, size(self % bins, 1) - print *, size(self % bins, 2) end subroutine reset From 19a241a73b5eecdcff7be83c7861b1048f2b2f8d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 4 Feb 2022 16:00:39 +0000 Subject: [PATCH 068/373] Wrote function to return Fleck factor --- NuclearData/IMCMaterial_inter.f90 | 10 ++++++++++ .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 12 ++++++++++++ NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 11 +++++++++++ 3 files changed, 33 insertions(+) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index d68fd58c4..9f2733814 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -32,6 +32,7 @@ module IMCMaterial_inter procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad + procedure(getFleck), deferred :: getFleck end type IMCMaterial abstract interface @@ -75,6 +76,15 @@ function getEmittedRad(self) result(emittedRad) real(defReal) :: emittedRad end function getEmittedRad + !! + !! Get Fleck factor of material + !! + function getFleck(self) result(fleck) + import :: IMCMaterial, defReal + class(IMCMaterial), intent(in) :: self + real(defReal) :: fleck + end function getFleck + end interface contains diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index fd648cf6b..fa4ec2be6 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -81,6 +81,7 @@ module baseMgIMCMaterial_class procedure :: nGroups procedure :: updateMat procedure :: getEmittedRad + procedure :: getFleck end type baseMgIMCMaterial @@ -332,5 +333,16 @@ function getEmittedRad(self) result(emittedRad) end function getEmittedRad + !! + !! Return the fleck factor of the material + !! + function getFleck(self) result(fleck) + class(baseMgIMCMaterial),intent(in) :: self + real(defReal) :: fleck + + fleck = self % fleck + + end function getFleck + end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 6c434560b..006c0bb1b 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -45,6 +45,7 @@ module mgIMCMaterial_inter procedure(getTotalXS), deferred :: getTotalXS procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad + procedure(getFleck), deferred :: getFleck end type mgIMCMaterial @@ -110,6 +111,16 @@ function getEmittedRad(self) result(emittedRad) real(defReal) :: emittedRad end function getEmittedRad + !! + !! Return Fleck factor + !! + function getFleck(self) result(fleck) + import :: mgIMCMaterial, defReal + class(mgIMCMaterial), intent(in) :: self + real(defReal) :: fleck + end function getFleck + + end interface From 92a6b4929a97c2f0eb95ca356d59b9533b9bed71 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 4 Feb 2022 16:01:15 +0000 Subject: [PATCH 069/373] Started modifying collision processor to give call required collisions --- .../CollisionProcessors/IMCMGstd_class.f90 | 20 ++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index e39f526bb..a7e5cf542 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -89,7 +89,7 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle type(IMCMacroXSs) :: macroXSs - real(defReal) :: r + real(defReal) :: r, fleck character(100),parameter :: Here =' sampleCollision (IMCMGstd_class.f90)' ! Verify that particle is MG PHOTON @@ -109,15 +109,17 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) call self % mat % getMacroXSs(macroXSs, p % G, p % pRNG) r = p % pRNG % get() - !if( r < self % mat % fleck ) then - ! Effective absoprtion + fleck = self % mat % getFleck() - !else + if( r < fleck ) then + ! Effective absoprtion + collDat % MT = macroCapture + else ! Effective scattering + collDat % MT = macroIEScatter + end if - !end if - - collDat % MT = macroXSs % invert(r) + !collDat % MT = macroXSs % invert(r) end subroutine sampleCollision @@ -165,7 +167,7 @@ subroutine inelastic(self, p, collDat, thisCycle, nextCycle) character(100),parameter :: Here = "inelastic (IMCMGstd_class.f90)" ! Assign MT number - collDat % MT = macroIEscatter + collDat % MT = macroIEScatter ! Get Scatter object scatter => multiScatterMG_CptrCast( self % xsData % getReaction(macroIEscatter, collDat % matIdx)) @@ -177,7 +179,7 @@ subroutine inelastic(self, p, collDat, thisCycle, nextCycle) ! Read scattering multiplicity w_mul = scatter % production(p % G, G_out) - ! Update IMC state + ! Update photon state p % G = G_out p % w = p % w * w_mul call p % rotate(collDat % muL, phi) From 89e4394fd8bc3015f3e9eea0eb97e960a96ffc2e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 9 Feb 2022 18:44:57 +0000 Subject: [PATCH 070/373] Allow planck opacity to be read fom data file. Later need to allow for different zones and for temperature variation --- IMCTest | 2 +- InputFiles/XS/imcData | 22 +++++++++++++++++++ .../baseMgIMC/baseMgIMCMaterial_class.f90 | 9 +++++++- 3 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 InputFiles/XS/imcData diff --git a/IMCTest b/IMCTest index c22569c0b..e376dd7ca 100644 --- a/IMCTest +++ b/IMCTest @@ -102,7 +102,7 @@ nuclearData { 94241.03 0.00011674; 31000.03 0.0013752; } - xsFile ./InputFiles/XS/URRa_2_1_XSS; + xsFile ./InputFiles/XS/imcData; } } diff --git a/InputFiles/XS/imcData b/InputFiles/XS/imcData new file mode 100644 index 000000000..ae1a516ab --- /dev/null +++ b/InputFiles/XS/imcData @@ -0,0 +1,22 @@ +// This XSS are for a URR-2-1-IN/SL Benchamrk Problem +// Source: A. Sood, R. A. Forster, and D. K. Parsons, +// ‘Analytical Benchmark Test Set For Criticality Code Verification’ +// + +numberOfGroups 2; + +capture (0.0010046 0.025788); + +scatteringMultiplicity ( +1.0 1.0 +1.0 1.0 ); + +P0 ( + 0.62568 0.029227 + 0.0 2.443830 +); + +sigmaP ( + 0.5 +); + diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index fa4ec2be6..547f365e2 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -69,6 +69,7 @@ module baseMgIMCMaterial_class real(defReal) :: T real(defReal) :: fleck real(defReal) :: deltaT + real(defReal) :: sigmaP contains ! Superclass procedures @@ -229,8 +230,14 @@ subroutine init(self, dict, scatterKey) self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) end do + ! Set initial temperature self % T = 298 + ! Set Planck opacity + call dict % get(temp, 'sigmaP') + + self % sigmaP = temp(1) + end subroutine init !! @@ -315,7 +322,7 @@ subroutine updateMat(self, deltaT) self % T = self % T + 1 print *, "Updated material temperature:", int(self % T), "K" - self % fleck = 1/(1+1*1*lightSpeed*deltaT) ! Incomplete, need to add alpha and sigma_p + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha self % deltaT = deltaT ! Store deltaT in material class for use in getEmittedRad, need to consider if possible to call updateMat before first cycle to set initially as getEmittedRad needs fleck and deltaT at start end subroutine updateMat From e88ec464cdb478243c77b92624b1f7f1122a3777 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Feb 2022 15:29:15 +0000 Subject: [PATCH 071/373] Added material internal energy --- NuclearData/IMCMaterial_inter.f90 | 4 ++-- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 10 +++++++--- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 4 ++-- PhysicsPackages/IMCPhysicsPackage_class.f90 | 18 ++++++++++-------- 4 files changed, 21 insertions(+), 15 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 9f2733814..7d3250b5c 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -61,10 +61,10 @@ end subroutine getMacroXSs_byP !! Args: !! None !! - subroutine updateMat(self, deltaT) + subroutine updateMat(self, deltaT, tallyEnergy) import :: IMCMaterial, defReal class(IMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: deltaT + real(defReal), intent(in) :: deltaT, tallyEnergy end subroutine updateMat !! diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 547f365e2..91cda9f62 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -70,6 +70,7 @@ module baseMgIMCMaterial_class real(defReal) :: fleck real(defReal) :: deltaT real(defReal) :: sigmaP + real(defReal) :: matEnergy contains ! Superclass procedures @@ -230,8 +231,9 @@ subroutine init(self, dict, scatterKey) self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) end do - ! Set initial temperature + ! Set initial temperature and energy self % T = 298 + self % matEnergy = 100 ! Set Planck opacity call dict % get(temp, 'sigmaP') @@ -315,13 +317,15 @@ end function baseMgIMCMaterial_CptrCast !! Args: !! delta T [in] -> Time step size !! - subroutine updateMat(self, deltaT) + subroutine updateMat(self, deltaT, tallyEnergy) class(baseMgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT + real(defReal), intent(in) :: deltaT, tallyEnergy self % T = self % T + 1 print *, "Updated material temperature:", int(self % T), "K" + self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha self % deltaT = deltaT ! Store deltaT in material class for use in getEmittedRad, need to consider if possible to call updateMat before first cycle to set initially as getEmittedRad needs fleck and deltaT at start diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 006c0bb1b..264238025 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -96,10 +96,10 @@ end function getTotalXS !! Args: !! None !! - subroutine updateMat(self, deltaT) + subroutine updateMat(self, deltaT, tallyEnergy) import :: mgIMCMaterial, defReal class(mgIMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: deltaT + real(defReal), intent(in) :: deltaT, tallyEnergy end subroutine updateMat !! diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 6d248fc2e..07f209ca6 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -128,7 +128,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) integer(shortInt), intent(in) :: N_cycles integer(shortInt) :: i, N type(particle) :: p - real(defReal) :: elapsed_T, end_T, T_toEnd, test + real(defReal) :: elapsed_T, end_T, T_toEnd, tallyEnergy class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes @@ -145,7 +145,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call timerStart(self % timerMain) mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - call mat % updateMat(self % deltaT) + call mat % updateMat(self % deltaT, ZERO) do i=1,N_cycles @@ -222,26 +222,28 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end_T = real(N_cycles,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) + ! Obtain energy deposited in zone from tally call tallyAtch % getResult(tallyRes, 'imcWeight') select type(tallyRes) class is(imcWeightResult) - test = tallyRes % imcWeight - !print *, ' TALLY:',test*i + tallyEnergy = tallyRes % imcWeight class default call fatalError(Here, 'Invalid result has been returned') end select + ! Update material properties + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) + call mat % updateMat(self % deltaT, tallyEnergy) + + ! Reset tally for next cycle call tallyAtch % reset('imcWeight') - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - !call mat % updateMat(self % deltaT) - ! Display progress call printFishLineR(i) print * - call mat % updateMat(self % deltaT) + !call mat % updateMat(self % deltaT) print * print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) print *, 'Pop: ', numToChar(self % pop) From eaae1f68457005b29cf9efddf46e6b7fd27dde7c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Feb 2022 15:30:17 +0000 Subject: [PATCH 072/373] Temporarily multiplying by i for normalisation --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 07f209ca6..1fa345200 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -227,8 +227,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) select type(tallyRes) class is(imcWeightResult) - tallyEnergy = tallyRes % imcWeight - + tallyEnergy = tallyRes % imcWeight * i class default call fatalError(Here, 'Invalid result has been returned') end select From 1250e57870f781e373f228da140432270eb0fb70 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Feb 2022 22:15:27 +0000 Subject: [PATCH 073/373] Created module for polynomial functions, wrote integrate and NR solve procedures --- SharedModules/CMakeLists.txt | 5 +- SharedModules/poly_func.f90 | 130 +++++++++++++++++++++++++++++++++++ 2 files changed, 133 insertions(+), 2 deletions(-) create mode 100644 SharedModules/poly_func.f90 diff --git a/SharedModules/CMakeLists.txt b/SharedModules/CMakeLists.txt index 8f4cd8c27..790cb96d0 100644 --- a/SharedModules/CMakeLists.txt +++ b/SharedModules/CMakeLists.txt @@ -11,7 +11,8 @@ add_sources( ./genericProcedures.f90 ./energyGrid_class.f90 ./statisticalTests_func.f90 ./timer_mod.f90 - ./charLib_func.f90) + ./charLib_func.f90 + ./poly_func.f90) add_unit_tests( ./Tests/grid_test.f90 ./Tests/energyGrid_test.f90 @@ -21,4 +22,4 @@ add_unit_tests( ./Tests/grid_test.f90 ./Tests/timer_test.f90 ./Tests/conversions_test.f90 ./Tests/charLib_test.f90) - \ No newline at end of file + diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 new file mode 100644 index 000000000..a92708941 --- /dev/null +++ b/SharedModules/poly_func.f90 @@ -0,0 +1,130 @@ +module poly_func + + use universalVariables + use numPrecision + use genericProcedures + + implicit none + + !! Module to perform operations on simple polynomials + !! Polynomials are given as a 1D array containing n coefficients followed by n exponents + !! + !! Interface: + !! poly_integrate -> Update exponents and coefficients to integrate polynomial + !! - Currently gives error for input exponent of -1 + !! poly_solve -> Solves polynomial using Newton-Raphson method + !! + + contains + + !! + !! Integrates a simple polynomial given coefficients and exponents + !! + !! Args: + !! equation -> 1D array of n coefficients followed by n exponents + !! + !! Errors: + !! Input array size is not divisible by 2 + !! Exponent of -1 is integrated + !! + subroutine poly_integrate(equation) + real(defReal), dimension(:), intent(inout) :: equation + integer(shortInt) :: n, i + character(100), parameter :: Here = "poly_integrate (poly_func.f90)" + + ! Check that array is of even size + if( modulo(size(equation), 2) /= 0 ) then + call fatalError(Here, "Array size must be divisible by 2") + end if + + n = size(equation) / 2 + + ! Integrate + do i=1, n + ! Update exponents + equation(i+n) = equation(i+n) + 1 + if( equation(i+n) == 0 ) then + call fatalError(Here, "Integrating exponent of -1, currently not yet supported") + end if + ! Update coefficients + equation(i) = equation(i) / equation(i+n) + end do + + end subroutine poly_integrate + + + !! + !! Use Newton-Raphspon method to solve polynomial with m terms + !! + !! Args: + !! equation -> + !! derivative -> + !! x0 -> + !! const -> For f(x) = const, if not given then solves f(x) = 0 + !! + !! Errors: + !! equation and derivative are different sizes + !! Input array sizes are not divisible by 2 + !! + function poly_solve(equation, derivative, x0, const) result(x) + real(defReal), dimension(:), intent(in) :: equation + real(defReal), dimension(:), intent(in) :: derivative + real(defReal), intent(in) :: x0 + real(defReal), intent(in), optional :: const + real(defReal) :: x, x_old, f, f_dash, c + integer(shortInt) :: i, j, m + character(100), parameter :: Here = "poly_solve (poly_func.f90)" + + ! Check that input arrays are of same size + if( size(equation) /= size(derivative) ) then + call fatalError(Here, "Equation and Derivative array inputs are of different sizes") + end if + + ! Check that array is of even size + if( modulo(size(equation), 2) /= 0 ) then + call fatalError(Here, "Array size must be divisible by 2") + end if + + x = x0 + m = size(equation) / 2 + + ! If no constant present then solving f(x) = 0 + if( present(const) ) then + c = const + else + c = 0 + end if + + ! Iterate + i = 0 + iterate: do + ! Store x for convergence check + x_old = x + + ! Calculate f(x) and f'(x) + f = -c + f_dash = 0 + do j=1,m + f = f + equation(j) * x ** equation(j+m) + f_dash = f_dash + derivative(j) * x ** derivative(j+m) + end do + + ! Update x + x = x - f / f_dash + + ! Check for convergence + if( x == x_old ) exit iterate + + ! Call error if not converged + if( i >= 1000 ) then + call fatalError(Here, "Solution has not converged after 1000 iterations") + end if + + ! Increase counter + i = i+1 + + end do iterate + + end function poly_solve + +end module poly_func From 9e9bd23bddc2c948b8b1d3447ff2ce334859eefc Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Feb 2022 22:16:58 +0000 Subject: [PATCH 074/373] Read heat capacity equation from XS input file. Integrate and solve to update temperature --- InputFiles/XS/imcData | 5 +++ .../baseMgIMC/baseMgIMCMaterial_class.f90 | 37 ++++++++++++++----- 2 files changed, 33 insertions(+), 9 deletions(-) diff --git a/InputFiles/XS/imcData b/InputFiles/XS/imcData index ae1a516ab..49cca4fc3 100644 --- a/InputFiles/XS/imcData +++ b/InputFiles/XS/imcData @@ -20,3 +20,8 @@ sigmaP ( 0.5 ); +cv ( + 3.0 1.5 7.0 + 1.0 2.0 6.0 +); + diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 91cda9f62..ec9b82368 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -7,6 +7,7 @@ module baseMgIMCMaterial_class use RNG_class, only : RNG use dictionary_class, only : dictionary use dictDeck_class, only : dictDeck + use poly_func ! Nuclear Data Interfaces use materialHandle_inter, only : materialHandle @@ -65,12 +66,9 @@ module baseMgIMCMaterial_class !! type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data + real(defReal),dimension(:), allocatable :: cv, updateEqn class(multiScatterMG), allocatable :: scatter - real(defReal) :: T - real(defReal) :: fleck - real(defReal) :: deltaT - real(defReal) :: sigmaP - real(defReal) :: matEnergy + real(defReal) :: T, fleck, deltaT, sigmaP, matEnergy, volume contains ! Superclass procedures @@ -237,9 +235,19 @@ subroutine init(self, dict, scatterKey) ! Set Planck opacity call dict % get(temp, 'sigmaP') - self % sigmaP = temp(1) + ! Read heat capacity equation + call dict % get(temp, 'cv') + self % cv = temp + + ! Build update equation + call poly_integrate(temp) + self % updateEqn = temp + + ! Set volume -- Not yet set up, for now just set arbitrarily + self % volume = pi + end subroutine init !! @@ -320,15 +328,26 @@ end function baseMgIMCMaterial_CptrCast subroutine updateMat(self, deltaT, tallyEnergy) class(baseMgIMCMaterial),intent(inout) :: self real(defReal), intent(in) :: deltaT, tallyEnergy + real(defReal) :: energy + character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" - self % T = self % T + 1 - print *, "Updated material temperature:", int(self % T), "K" - + ! Update material internal energy self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy + energy = self % matEnergy / self % volume + + ! Update material temperature + self % T = poly_solve(self % updateEqn, self % cv, self % T, energy) + print *, 'T_new =', self % T + + if( self % T < 0 ) then + call fatalError(Here, "Temperature is negative") + end if + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha self % deltaT = deltaT ! Store deltaT in material class for use in getEmittedRad, need to consider if possible to call updateMat before first cycle to set initially as getEmittedRad needs fleck and deltaT at start + end subroutine updateMat !! From 77cd995456443893a3376d7baac69501d8d274a3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Feb 2022 22:22:42 +0000 Subject: [PATCH 075/373] Changed convergence check to be within tol --- SharedModules/poly_func.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index a92708941..026431e93 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -71,7 +71,7 @@ function poly_solve(equation, derivative, x0, const) result(x) real(defReal), dimension(:), intent(in) :: derivative real(defReal), intent(in) :: x0 real(defReal), intent(in), optional :: const - real(defReal) :: x, x_old, f, f_dash, c + real(defReal) :: x, x_old, f, f_dash, c, tol integer(shortInt) :: i, j, m character(100), parameter :: Here = "poly_solve (poly_func.f90)" @@ -113,7 +113,8 @@ function poly_solve(equation, derivative, x0, const) result(x) x = x - f / f_dash ! Check for convergence - if( x == x_old ) exit iterate + tol = 0.0000000001 + if( x > (1-tol)*x_old .and. x < (1+tol)*x_old ) exit iterate ! Call error if not converged if( i >= 1000 ) then From 04f934efc7c3d7363997b9259d0d4e60e6694225 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Feb 2022 23:02:12 +0000 Subject: [PATCH 076/373] Wrote poly_eval to evaluate a function value at a point --- SharedModules/poly_func.f90 | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index 026431e93..004c01f87 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -128,4 +128,35 @@ function poly_solve(equation, derivative, x0, const) result(x) end function poly_solve + !! + !! Gives output value y for y = f(x) + !! + !! Args: + !! f -> Array defining polynomial + !! x -> Point at which to evaluate + !! + function poly_eval(f, x) result(y) + real(defReal), dimension(:), intent(in) :: f + real(defReal), intent(in) :: x + real(defReal) :: y + integer(shortInt) :: n, i + character(100), parameter :: Here = "poly_eval (poly_func.f90)" + + ! Check that array is of even size + if( modulo(size(f), 2) /= 0 ) then + call fatalError(Here, "Array size must be divisible by 2") + end if + + n = size(f) / 2 + + y = 0 + do i=1,n + y = y + f(i) * x ** f(i+n) + end do + + end function poly_eval + + + + end module poly_func From 24cdbe5e37dc533a8fc4b755faf021b58fb03381 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Feb 2022 23:03:44 +0000 Subject: [PATCH 077/373] Wrote initProps to store timestep in mat class and to calculate initial energy, took deltaT out of updateMat args --- NuclearData/IMCMaterial_inter.f90 | 20 +++++++++++-- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 29 +++++++++++++++---- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 19 ++++++++++-- PhysicsPackages/IMCPhysicsPackage_class.f90 | 4 +-- 4 files changed, 61 insertions(+), 11 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 7d3250b5c..254bc71b8 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -33,6 +33,7 @@ module IMCMaterial_inter procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck + procedure(initProps), deferred :: initProps end type IMCMaterial abstract interface @@ -61,10 +62,10 @@ end subroutine getMacroXSs_byP !! Args: !! None !! - subroutine updateMat(self, deltaT, tallyEnergy) + subroutine updateMat(self, tallyEnergy) import :: IMCMaterial, defReal class(IMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: deltaT, tallyEnergy + real(defReal), intent(in) :: tallyEnergy end subroutine updateMat !! @@ -85,6 +86,21 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck + !! + !! Store deltaT in material class and set initial material properties + !! + !! Can be called from physics package with required arguments, as init does not have access + !! to deltaT + !! + !! Args: + !! deltaT -> Time step size + !! + subroutine initProps(self, deltaT) + import :: IMCMaterial, defReal + class(IMCMaterial),intent(inout) :: self + real(defReal), intent(in) :: deltaT + end subroutine initProps + end interface contains diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index ec9b82368..5e5ea9c51 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -82,6 +82,7 @@ module baseMgIMCMaterial_class procedure :: updateMat procedure :: getEmittedRad procedure :: getFleck + procedure :: initProps end type baseMgIMCMaterial @@ -325,9 +326,9 @@ end function baseMgIMCMaterial_CptrCast !! Args: !! delta T [in] -> Time step size !! - subroutine updateMat(self, deltaT, tallyEnergy) + subroutine updateMat(self, tallyEnergy) class(baseMgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT, tallyEnergy + real(defReal), intent(in) :: tallyEnergy real(defReal) :: energy character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" @@ -335,6 +336,7 @@ subroutine updateMat(self, deltaT, tallyEnergy) self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy energy = self % matEnergy / self % volume + print *, energy ! Update material temperature self % T = poly_solve(self % updateEqn, self % cv, self % T, energy) @@ -344,9 +346,7 @@ subroutine updateMat(self, deltaT, tallyEnergy) call fatalError(Here, "Temperature is negative") end if - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha - self % deltaT = deltaT ! Store deltaT in material class for use in getEmittedRad, need to consider if possible to call updateMat before first cycle to set initially as getEmittedRad needs fleck and deltaT at start - + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT) ! Incomplete, need to add alpha end subroutine updateMat @@ -374,5 +374,24 @@ function getFleck(self) result(fleck) end function getFleck + !! + !! Store deltaT in material class and set initial material properties + !! + !! Can be called from physics package with required arguments, as init does not have access + !! to deltaT + !! + !! Args: + !! deltaT -> Time step size + !! + subroutine initProps(self, deltaT) + class(baseMgIMCMaterial),intent(inout) :: self + real(defReal), intent(in) :: deltaT + + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha + self % deltaT = deltaT + + self % matEnergy = poly_eval(self % updateEqn, self % T) + + end subroutine initProps end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 264238025..a8e055545 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -46,6 +46,7 @@ module mgIMCMaterial_inter procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck + procedure(initProps), deferred :: initProps end type mgIMCMaterial @@ -96,10 +97,10 @@ end function getTotalXS !! Args: !! None !! - subroutine updateMat(self, deltaT, tallyEnergy) + subroutine updateMat(self, tallyEnergy) import :: mgIMCMaterial, defReal class(mgIMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: deltaT, tallyEnergy + real(defReal), intent(in) :: tallyEnergy end subroutine updateMat !! @@ -120,6 +121,20 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck + !! + !! Store deltaT in material class and set initial material properties + !! + !! Can be called from physics package with required arguments, as init does not have access + !! to deltaT + !! + !! Args: + !! deltaT -> Time step size + !! + subroutine initProps(self, deltaT) + import :: mgIMCMaterial, defReal + class(mgIMCMaterial),intent(inout) :: self + real(defReal), intent(in) :: deltaT + end subroutine initProps end interface diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 1fa345200..87e2ca96f 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -145,7 +145,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call timerStart(self % timerMain) mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - call mat % updateMat(self % deltaT, ZERO) + call mat % initProps(self % deltaT) do i=1,N_cycles @@ -234,7 +234,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Update material properties mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - call mat % updateMat(self % deltaT, tallyEnergy) + call mat % updateMat(tallyEnergy) ! Reset tally for next cycle call tallyAtch % reset('imcWeight') From c79a6d095bce0300f3a9c5cfb30fe5d0f95f395b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 11 Feb 2022 15:51:20 +0000 Subject: [PATCH 078/373] Fixed material update equation, had been ignoring integration constant. Updated description of poly_integrate to make clear that it is performing indefinite integration --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 30 ++++++++++++++----- SharedModules/poly_func.f90 | 6 ++-- 2 files changed, 25 insertions(+), 11 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 5e5ea9c51..e71558ccd 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -329,17 +329,33 @@ end function baseMgIMCMaterial_CptrCast subroutine updateMat(self, tallyEnergy) class(baseMgIMCMaterial),intent(inout) :: self real(defReal), intent(in) :: tallyEnergy - real(defReal) :: energy + real(defReal) :: energy, const character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" + ! Update material internal energy + print *, "matEnergy =", self % matEnergy + print *, "emittedRad =", self % getEmittedRad() + print *, "tallyEnergy =", tallyEnergy + + ! Store previous material internal energy density, U_{m,n}/V + const = self % matEnergy / self % volume + ! Update material internal energy self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy + ! New material internal energy density, U_{m,n+1}/V energy = self % matEnergy / self % volume - print *, energy - - ! Update material temperature - self % T = poly_solve(self % updateEqn, self % cv, self % T, energy) + + !! Integration of dUm/dT = cv gives equation to be solved for T_{n+1}: + !! + !! f(T_{n+1}) = U_{m,n+1} - U_{m,n} + f(T_n) + !! + !! where f(T) is the indefinite integral of cv (stored in self % updateEqn) + !! + const = energy - const + poly_eval(self % updateEqn, self % T) + + ! Update material temperature by solving f(T_{n+1}) = const + self % T = poly_solve(self % updateEqn, self % cv, self % T, const) print *, 'T_new =', self % T if( self % T < 0 ) then @@ -351,7 +367,7 @@ subroutine updateMat(self, tallyEnergy) end subroutine updateMat !! - !! Return the equilibrium radiation energy density, U_r + !! Return the energy to be emitted during time step, E_r !! function getEmittedRad(self) result(emittedRad) class(baseMgIMCMaterial),intent(inout) :: self @@ -359,7 +375,7 @@ function getEmittedRad(self) result(emittedRad) U_r = radiationConstant * (self % T)**4 - emittedRad = lightSpeed* self % deltaT * self % fleck *U_r ! Incomplete, need to * Volume of zone + emittedRad = lightSpeed * self % deltaT * self % sigmaP * self % fleck * U_r * self % volume end function getEmittedRad diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index 004c01f87..316a008eb 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -18,7 +18,8 @@ module poly_func contains !! - !! Integrates a simple polynomial given coefficients and exponents + !! Integrates a simple polynomial given coefficients and exponents, + !! returning indefinite integral !! !! Args: !! equation -> 1D array of n coefficients followed by n exponents @@ -156,7 +157,4 @@ function poly_eval(f, x) result(y) end function poly_eval - - - end module poly_func From 696167a3f8339ca01b74724a92e13a89769d7839 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 11 Feb 2022 15:57:27 +0000 Subject: [PATCH 079/373] Removed normalisation of tallies by resetting batch number --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 3 ++- Tallies/scoreMemory_class.f90 | 4 +++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 87e2ca96f..c9c46f14c 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -227,7 +227,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) select type(tallyRes) class is(imcWeightResult) - tallyEnergy = tallyRes % imcWeight * i + tallyEnergy = tallyRes % imcWeight + print *, "Tally =", tallyEnergy class default call fatalError(Here, 'Invalid result has been returned') end select diff --git a/Tallies/scoreMemory_class.f90 b/Tallies/scoreMemory_class.f90 index 972ab9e13..cd7d43524 100644 --- a/Tallies/scoreMemory_class.f90 +++ b/Tallies/scoreMemory_class.f90 @@ -257,7 +257,6 @@ subroutine closeCycle(self, normFactor) ! Increment Cycle Counter self % cycles = self % cycles + 1 - if(mod(self % cycles, self % batchSize) == 0) then ! Close Batch ! Normalise scores self % bins(:,BIN) = self % bins(:,BIN) * normFactor @@ -425,6 +424,9 @@ subroutine reset(self,idx) self % bins(idx, :) = ZERO + self % cycles = 0 + self % batchN = 0 + end subroutine reset end module scoreMemory_class From 2dd6937bac86659dfbc4adea80efe7e6f830230b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 13 Feb 2022 16:55:19 +0000 Subject: [PATCH 080/373] Fixed error which would fail convergence check for negative solutions --- SharedModules/poly_func.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index 316a008eb..daf449cf0 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -115,7 +115,7 @@ function poly_solve(equation, derivative, x0, const) result(x) ! Check for convergence tol = 0.0000000001 - if( x > (1-tol)*x_old .and. x < (1+tol)*x_old ) exit iterate + if( abs(x) > (1-tol)*abs(x_old) .and. abs(x) < (1+tol)*abs(x_old) ) exit iterate ! Call error if not converged if( i >= 1000 ) then From 81498a214af6b5df8fb47d102b26289206818d49 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 13 Feb 2022 17:27:36 +0000 Subject: [PATCH 081/373] Made source in input file optional - can now just use material photon source --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index c9c46f14c..7839f67ad 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -80,6 +80,7 @@ module IMCPhysicsPackage_class integer(shortInt) :: printSource = 0 integer(shortInt) :: particleType integer(shortInt) :: imcSourceN + logical(defBool) :: sourceGiven = .false. ! Calculation components type(particleDungeon), allocatable :: thisCycle! => null() Other physics packages use pointers here @@ -157,7 +158,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call self % IMCSource % append(self % thisCycle, self % imcSourceN, p % pRNG) ! Generate from input source - call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) + if( self % sourceGiven ) then + call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) + end if !call self % thisCycle % printToScreen('time', 20) @@ -228,7 +231,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) select type(tallyRes) class is(imcWeightResult) tallyEnergy = tallyRes % imcWeight - print *, "Tally =", tallyEnergy class default call fatalError(Here, 'Invalid result has been returned') end select @@ -372,8 +374,11 @@ subroutine init(self, dict) self % nucData => ndReg_get(self % particleType) ! Read particle source definition - tempDict => dict % getDictPtr('source') - call new_source(self % inputSource, tempDict, self % geom) + if( dict % isPresent('source') ) then + tempDict => dict % getDictPtr('source') + call new_source(self % inputSource, tempDict, self % geom) + self % sourceGiven = .true. + end if tempDict => dict % getDictPtr('imcSource') call new_source(self % IMCSource, tempDict, self % geom) call tempDict % get(self % imcSourceN, 'nParticles') From 67b436922cc7045bce48e0158ffd3fd74bf7234a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 22 Feb 2022 14:26:12 +0000 Subject: [PATCH 082/373] Improved printToScreen subroutine --- ParticleObjects/particleDungeon_class.f90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index a241f3235..1c6e480d3 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -462,42 +462,49 @@ subroutine printToScreen(self, prop, nMax) 'dir ',& 'E ',& 'G ',& - 'time' ] + 'time',& + 'pop ' ] print *, 'Number in dungeon =', self % pop ! Number of particles to be printed iMax = min(nMax, self % pop) - print *, '** **',prop,'** **' - ! Print for each particle select case(prop) case('r') + print *, '** ** Position ** **' do i = 1, iMax print *, i,numToChar(self % prisoners(i) % r) end do case('dir') + print *, '** ** Direction ** **' do i = 1, iMax print *, i,numToChar(self % prisoners(i) % dir) end do case('E') + print *, '** ** Energy ** **' do i = 1, iMax print *, i,numToChar(self % prisoners(i) % E) end do case('G') + print *, '** ** Group ** **' do i = 1, iMax print *, i,numToChar(self % prisoners(i) % G) end do case('time') + print *, '** ** Time ** **' do i = 1, iMax print *, i,numToChar(self % prisoners(i) % time) end do + case('pop') + ! Do nothing, pop already printed above + case default print *, AVAILABLE_props call fatalError(Here, 'Unrecognised particle property : ' // trim(prop)) From dd4920b115c8483e3bfde61cf0d30ad0facdc501 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 22 Feb 2022 14:27:32 +0000 Subject: [PATCH 083/373] Stopped energy being tallied when particles leak outside geometry --- Tallies/TallyClerks/imcWeightClerk_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 index 4969977ae..ee510a676 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -220,7 +220,7 @@ subroutine reportHist(self, p, xsData, mem) adrr = self % getMemAddress()! + self % width * (binIdx -1) - 1 ! Append all bins !do i=1,self % width - if( p % isDead ) then + if( p % isDead .and. p % fate /= LEAK_FATE ) then scoreVal = p % w call mem % score(scoreVal, adrr)! + i) end if From bbc82b1cdee8d48cc45258613ce40da6d066eda0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 25 Feb 2022 16:48:45 +0000 Subject: [PATCH 084/373] Started creating benchmark test cases, still in progress --- benchmarkIMCTest | 113 ++++++++++++++++++++++++++++++++++++++++++++++ benchmarkIMCTest2 | 113 ++++++++++++++++++++++++++++++++++++++++++++++ imcBenchmarkData | 26 +++++++++++ imcBenchmarkData2 | 26 +++++++++++ 4 files changed, 278 insertions(+) create mode 100644 benchmarkIMCTest create mode 100644 benchmarkIMCTest2 create mode 100644 imcBenchmarkData create mode 100644 imcBenchmarkData2 diff --git a/benchmarkIMCTest b/benchmarkIMCTest new file mode 100644 index 000000000..5cc4f6d48 --- /dev/null +++ b/benchmarkIMCTest @@ -0,0 +1,113 @@ +//type fixedSourcePhysicsPackage; +//type eigenPhysicsPackage; + +type IMCPhysicsPackage; + +pop 10000; +cycles 10; +timeStepSize 1; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + + +//source { +// type pointSource; +// r (0 0 0); +// particle photon; +// G 2; +//} + +imcSource { + type imcSource; + nParticles 10000; + } + +inactiveTally { + } + +activeTally { + //norm fiss; + //normVal 100; + //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + flux { type collisionClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + response (flux); flux {type fluxResponse;} + } + } + +tally { + //display (imcWeight); + //norm fiss; + //normVal 100.0; + //k-eff { type keffAnalogClerk; response (flux); flux {type fluxResponse;} } + //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + //flux { type collisionClerk; + // map { type energyMap; grid log; min 0.001; max 20; N 300;} + // response (flux); flux {type fluxResponse;} + // } + imcWeight { type imcWeightClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + //response (imc); imc {type fluxResponse;} + } + } + +geometry { + type geometryStd; + boundary (1 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } + } + cells {} + universes + { + + root + { + id 1; + type rootUniverse; + border 1; + fill fuel; + } + } +} + +nuclearData { + + handles { + //ce { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + fuel { + temp 273; + composition { + 94239.03 0.037047; + 94240.03 0.0017512; + 94241.03 0.00011674; + 31000.03 0.0013752; + } + xsFile ./imcBenchmarkData; //./InputFiles/XS/imcData; //./imcBenchmarkData; + } + +} + +} + + + diff --git a/benchmarkIMCTest2 b/benchmarkIMCTest2 new file mode 100644 index 000000000..0c96d52d9 --- /dev/null +++ b/benchmarkIMCTest2 @@ -0,0 +1,113 @@ +//type fixedSourcePhysicsPackage; +//type eigenPhysicsPackage; + +type IMCPhysicsPackage; + +pop 100; +cycles 1000; +timeStepSize 0.01; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + + +//source { +// type pointSource; +// r (0 0 0); +// particle photon; +// G 2; +//} + +imcSource { + type imcSource; + nParticles 100; + } + +inactiveTally { + } + +activeTally { + //norm fiss; + //normVal 100; + //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + flux { type collisionClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + response (flux); flux {type fluxResponse;} + } + } + +tally { + //display (imcWeight); + //norm fiss; + //normVal 100.0; + //k-eff { type keffAnalogClerk; response (flux); flux {type fluxResponse;} } + //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + //flux { type collisionClerk; + // map { type energyMap; grid log; min 0.001; max 20; N 300;} + // response (flux); flux {type fluxResponse;} + // } + imcWeight { type imcWeightClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + //response (imc); imc {type fluxResponse;} + } + } + +geometry { + type geometryStd; + boundary (1 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } + } + cells {} + universes + { + + root + { + id 1; + type rootUniverse; + border 1; + fill fuel; + } + } +} + +nuclearData { + + handles { + //ce { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + fuel { + temp 273; + composition { + 94239.03 0.037047; + 94240.03 0.0017512; + 94241.03 0.00011674; + 31000.03 0.0013752; + } + xsFile ./imcBenchmarkData2; //./InputFiles/XS/imcData; //./imcBenchmarkData; + } + +} + +} + + + diff --git a/imcBenchmarkData b/imcBenchmarkData new file mode 100644 index 000000000..b9bbc3a1a --- /dev/null +++ b/imcBenchmarkData @@ -0,0 +1,26 @@ +// This XSS are for a URR-2-1-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 (10046); + +scatteringMultiplicity ( +0.0 +); + +P0 ( + 1 +); + +sigmaP ( + 1.0 +); + +cv ( + 4.0 + 3.0 +); + diff --git a/imcBenchmarkData2 b/imcBenchmarkData2 new file mode 100644 index 000000000..b3414b93e --- /dev/null +++ b/imcBenchmarkData2 @@ -0,0 +1,26 @@ +// This XSS are for a URR-2-1-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.0010046); + +scatteringMultiplicity ( +1.0 +); + +P0 ( + 0.62568 +); + +sigmaP ( + 10.0 +); + +cv ( + 1.0 + 0.0 +); + From 0ea3a1b986a478184c2ee8089e681797c9750d07 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 27 Feb 2022 17:39:39 +0000 Subject: [PATCH 085/373] Allowed printToScreen to print cumulative sum of dungeon particle properties --- ParticleObjects/particleDungeon_class.f90 | 110 ++++++++++++++++------ 1 file changed, 83 insertions(+), 27 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 1c6e480d3..e1bbabd46 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -451,56 +451,112 @@ end subroutine printToFile !! Errors: !! fatalError if prop is invalid !! - subroutine printToScreen(self, prop, nMax) - class(particleDungeon), intent(in) :: self - character(*), intent(in) :: prop - integer(shortInt), intent(in) :: nMax - integer(shortInt) :: i,iMax + subroutine printToScreen(self, prop, nMax, total) + class(particleDungeon), intent(in) :: self + character(*), intent(in) :: prop + integer(shortInt), intent(in) :: nMax + integer(shortInt) :: i,iMax + logical(defBool), intent(in), optional :: total + logical(defBool) :: totBool = .false. + real(defReal) :: totSum character(100), parameter :: Here = 'printToScreen (particleDungeon_class.f90)' character(nameLen), dimension(*), parameter :: AVAILABLE_props = [ 'r ',& 'dir ',& 'E ',& 'G ',& + 'wgt ',& 'time',& - 'pop ' ] + 'pop '] + + ! Reset sum variable + totSum = 0 print *, 'Number in dungeon =', self % pop ! Number of particles to be printed iMax = min(nMax, self % pop) - ! Print for each particle + ! Print for each particle unless otherwise specified + if( present(total) ) totBool = total + + ! Print desired quantities select case(prop) case('r') - print *, '** ** Position ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % r) - end do + if( totBool .eqv. .false. ) then + print *, '** ** Position ** **' + ! Print for each particle + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % r) + end do + else + call fatalError(Here, 'p % r is not a scalar quantity') + end if case('dir') - print *, '** ** Direction ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % dir) - end do + if( totBool .eqv. .false. ) then + print *, '** ** Direction ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % dir) + end do + else + call fatalError(Here, 'p % dir is not a scalar quantity') + end if case('E') - print *, '** ** Energy ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % E) - end do + if( totBool .eqv. .false. ) then + print *, '** ** Energy ** **' + ! Print for each particle + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % E) + end do + else + ! Sum for each particle + do i = 1, self % pop + totSum = totSum + self % prisoners(i) % E + end do + ! Print total + print *, 'Cumulative sum of p % E = ', totSum + end if case('G') - print *, '** ** Group ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % G) - end do + if( totBool .eqv. .false. ) then + print *, '** ** Group ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % G) + end do + else + do i = 1, self % pop + totSum = totSum + self % prisoners(i) % G + end do + print *, 'Cumulative sum of p % G = ', totSum + end if + + case('wgt') + if( totBool .eqv. .false. ) then + print *, '** ** Weight ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % wgt) + end do + else + do i = 1, self % pop + totSum = totSum + self % prisoners(i) % wgt + end do + print *, 'Cumulative sum of p % wgt = ', totSum + end if case('time') - print *, '** ** Time ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % time) - end do + if( totBool .eqv. .false. ) then + print *, '** ** Time ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % time) + end do + else + do i = 1, self % pop + totSum = totSum + self % prisoners(i) % time + end do + print *, 'Cumulative sum of p % time = ', totSum + end if case('pop') ! Do nothing, pop already printed above From 96470c9f45e6e6108062461d1936b1c9cccb990a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 3 Mar 2022 22:26:37 +0000 Subject: [PATCH 086/373] Changing files for testing --- benchmarkIMCTest | 10 +++++++--- imcBenchmarkData | 6 +++--- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/benchmarkIMCTest b/benchmarkIMCTest index 5cc4f6d48..095b2832d 100644 --- a/benchmarkIMCTest +++ b/benchmarkIMCTest @@ -3,8 +3,8 @@ type IMCPhysicsPackage; -pop 10000; -cycles 10; +pop 20000; +cycles 20; timeStepSize 1; XSdata mg; @@ -26,10 +26,14 @@ transportOperator { // particle photon; // G 2; //} +//source { + // type imcSource; + //nParticles 1000; +//} imcSource { type imcSource; - nParticles 10000; + nParticles 20000; } inactiveTally { diff --git a/imcBenchmarkData b/imcBenchmarkData index b9bbc3a1a..f2292bcac 100644 --- a/imcBenchmarkData +++ b/imcBenchmarkData @@ -5,14 +5,14 @@ numberOfGroups 1; -capture (10046); +capture (1.0); scatteringMultiplicity ( -0.0 + 0.0 ); P0 ( - 1 + 0.0 ); sigmaP ( From d421f36adef4f1de1b4599b61459453d6ea3e8ac Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 3 Mar 2022 22:34:19 +0000 Subject: [PATCH 087/373] Changed scattering to be isotropic, code/comments needs tidying up --- .../CollisionProcessors/IMCMGstd_class.f90 | 27 +++++++++++++------ 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index a7e5cf542..d25bbe50f 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -162,27 +162,38 @@ subroutine inelastic(self, p, collDat, thisCycle, nextCycle) class(particleDungeon),intent(inout) :: nextCycle class(multiScatterMG),pointer :: scatter integer(shortInt) :: G_out ! Post-collision energy group - real(defReal) :: phi ! Azimuthal scatter angle + real(defReal) :: phi, mu ! Azimuthal scatter angle real(defReal) :: w_mul ! Weight multiplier + real(defReal), dimension(3) :: dir character(100),parameter :: Here = "inelastic (IMCMGstd_class.f90)" ! Assign MT number collDat % MT = macroIEScatter ! Get Scatter object - scatter => multiScatterMG_CptrCast( self % xsData % getReaction(macroIEscatter, collDat % matIdx)) - if(.not.associated(scatter)) call fatalError(Here, "Failed to get scattering reaction object for MG IMC") + !scatter => multiScatterMG_CptrCast( self % xsData % getReaction(macroIEscatter, collDat % matIdx)) + !if(.not.associated(scatter)) call fatalError(Here, "Failed to get scattering reaction object for MG IMC") ! Sample Mu and G_out - call scatter % sampleOut(collDat % muL, phi, G_out, p % G, p % pRNG) + !call scatter % sampleOut(collDat % muL, phi, G_out, p % G, p % pRNG) ! Read scattering multiplicity - w_mul = scatter % production(p % G, G_out) + !w_mul = scatter % production(p % G, G_out) ! Update photon state - p % G = G_out - p % w = p % w * w_mul - call p % rotate(collDat % muL, phi) + !p % G = G_out + !p % w = p % w * w_mul + !call p % rotate(collDat % muL, phi) + + ! Sample Direction - chosen uniformly inside unit sphere + mu = 2 * p % pRNG % get() - 1 + phi = p % pRNG % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + + !p % coords % dir = dir + call p % rotate(mu, phi) end subroutine inelastic From c28dd62438d368265cf853999850b59e8e098a99 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 8 Mar 2022 15:31:30 +0000 Subject: [PATCH 088/373] Wrote test for poly_func module --- SharedModules/CMakeLists.txt | 3 +- SharedModules/Tests/poly_func_test.f90 | 46 ++++++++++++++++++++++++++ SharedModules/poly_func.f90 | 2 ++ 3 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 SharedModules/Tests/poly_func_test.f90 diff --git a/SharedModules/CMakeLists.txt b/SharedModules/CMakeLists.txt index 790cb96d0..059b5f437 100644 --- a/SharedModules/CMakeLists.txt +++ b/SharedModules/CMakeLists.txt @@ -21,5 +21,6 @@ add_unit_tests( ./Tests/grid_test.f90 ./Tests/hashFunctions_test.f90 ./Tests/timer_test.f90 ./Tests/conversions_test.f90 - ./Tests/charLib_test.f90) + ./Tests/charLib_test.f90 + ./Tests/poly_func_test.f90) diff --git a/SharedModules/Tests/poly_func_test.f90 b/SharedModules/Tests/poly_func_test.f90 new file mode 100644 index 000000000..ef845e70f --- /dev/null +++ b/SharedModules/Tests/poly_func_test.f90 @@ -0,0 +1,46 @@ +module poly_func_test + use numPrecision + use poly_func, only : poly_integrate, poly_eval, poly_solve + use pFUnit_mod + + implicit none + +contains + +@Test + subroutine testPoly() + real(defReal), dimension(6) :: poly1, poly2, poly3, poly4 + real(defReal) :: x1, x2 + real(defReal) :: tol = 1.0E-4_defReal + + ! Test array + poly1(:) = [23.20_defReal, 1.59_defReal, 0.12_defReal, & + 10.02_defReal, 0.06_defReal, 8.03_defReal ] + + ! Analytical integral + poly2(:) = [2.10526_defReal, 1.5_defReal, 0.013289_defReal, & + 11.02_defReal, 1.06_defReal, 9.03_defReal ] + + ! Integrate using poly_integrate + poly3 = poly1 + call poly_integrate(poly3) + + ! Check + @assertEqual(poly3,poly2,tol) + + ! Evaluate using poly_eval + x1 = poly_eval(poly1, 1.074_defReal) + + ! Check + @assertEqual(x1,49.2504_defReal,tol) + + ! Solve poly2 = 1 using poly_solve, using x0 = 10 + x2 = poly_solve(poly2, poly1, 10.0_defReal, 1.0_defReal) + + ! Check + @assertEqual(x2,0.66643669_defReal,tol) + + end subroutine testPoly + + +end module poly_func_test diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index daf449cf0..62955f62f 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -14,6 +14,8 @@ module poly_func !! - Currently gives error for input exponent of -1 !! poly_solve -> Solves polynomial using Newton-Raphson method !! + !! poly_eval -> Evaluates polynomial at given value + !! contains From 79d5df87777aabcfcd6d8f62288c1b6e98059a7b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 8 Mar 2022 17:51:19 +0000 Subject: [PATCH 089/373] Added support for multiple regions to IMC source, still needs a bit of work --- ParticleObjects/Source/IMCSource_class.f90 | 22 +++++++++--- ParticleObjects/Source/source_inter.f90 | 40 +++++++++++++++++++++- 2 files changed, 57 insertions(+), 5 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 567e353bf..ece578f97 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -8,6 +8,7 @@ module IMCSource_class use RNG_class, only : RNG use particle_class, only : particleState, P_PHOTON + use particleDungeon_class, only : particleDungeon use source_inter, only : source, kill_super => kill use geometry_inter, only : geometry @@ -15,6 +16,7 @@ module IMCSource_class use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG use nuclearDatabase_inter, only : nuclearDatabase use mgIMCDatabase_inter, only : mgIMCDatabase + use materialMenu_mod, only : MMnMat => nMat implicit none private @@ -72,6 +74,7 @@ subroutine init(self, dict, geom) class(geometry), pointer, intent(in) :: geom character(nameLen) :: type real(defReal), dimension(6) :: bounds + integer(shortInt) :: i, n character(100), parameter :: Here = 'init (imcSource_class.f90)' ! Provide geometry info to source @@ -85,6 +88,13 @@ subroutine init(self, dict, geom) self % bottom = bounds(1:3) self % top = bounds(4:6) + ! Initialise array to store numbers of particles + n = MMnMat() + allocate( self % matPops(n) ) + do i=1, n + self % matPops(i) = 0 + end do + end subroutine init !! @@ -128,7 +138,8 @@ function sampleParticle(self, rand) result(p) ! Reject if there is no material if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle rejection - mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) ! Currently will only work as intended with 1 cell + ! Point to material + mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") ! Sample Direction - chosen uniformly inside unit sphere @@ -148,9 +159,12 @@ function sampleParticle(self, rand) result(p) p % G = self % G p % isMG = .true. - ! Set Weight - p % wgt = mat % getEmittedRad() / self % nParticles - + ! Set weight to be equal to total emitted radiation from material + p % wgt = mat % getEmittedRad() + + ! Increase counter of number of particles in material in order to normalise later + self % matPops(matIdx) = self % matPops(matIdx) + 1 + ! Exit the loop exit rejection diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index dca1186c0..d01653fe5 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -1,7 +1,7 @@ module source_inter use numPrecision - use particle_class, only : particleState + use particle_class, only : particle, particleState use particleDungeon_class, only : particleDungeon use dictionary_class, only : dictionary use RNG_class, only : RNG @@ -35,9 +35,11 @@ module source_inter type, public,abstract :: source private class(geometry), pointer, public :: geom => null() + integer(shortInt), dimension(:), allocatable, public :: matPops contains procedure, non_overridable :: generate procedure, non_overridable :: append + procedure, non_overridable :: appendIMC procedure(sampleParticle), deferred :: sampleParticle procedure(init), deferred :: init procedure(kill), deferred :: kill @@ -113,6 +115,7 @@ subroutine generate(self, dungeon, n, rand) end subroutine generate + !! !! Generate particles to populate a particleDungeon without overriding !! particles already present !! @@ -140,6 +143,41 @@ subroutine append(self, dungeon, n, rand) end subroutine append + !! + !! + !! + subroutine appendIMC(self, dungeon, n, rand) + class(source), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + type(particleDungeon) :: tempDungeon + type(particle) :: p + integer(shortInt), intent(in) :: n + class(RNG), intent(inout) :: rand + integer(shortInt) :: i + real(defReal) :: normFactor + + ! Reset particle population counters + do i = 1, size( self % matPops ) + self % matPops(i) = 0 + end do + + ! Set temporary dungeon size + call tempDungeon % setSize(n) + + ! Generate n particles to populate temporary dungeon + do i = 1, n + call tempDungeon % detain(self % sampleParticle(rand)) + end do + + ! Loop through again and add to input dungeon, normalising energies based on material + do i = 1, n + call tempDungeon % release(p) + ! Normalise + normFactor = self % matPops( p % matIdx() ) + p % w = p % w / normFactor + end do + + end subroutine appendIMC !! !! Return to uninitialised state From 3d2460f892483f750050efcfb760a92f2c2c0f62 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Mar 2022 16:13:42 +0000 Subject: [PATCH 090/373] Fixed issue with source --- ParticleObjects/Source/source_inter.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index d01653fe5..d36fcbdcb 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -166,7 +166,7 @@ subroutine appendIMC(self, dungeon, n, rand) ! Generate n particles to populate temporary dungeon do i = 1, n - call tempDungeon % detain(self % sampleParticle(rand)) + call tempDungeon % replace(self % sampleParticle(rand), i) end do ! Loop through again and add to input dungeon, normalising energies based on material @@ -175,6 +175,7 @@ subroutine appendIMC(self, dungeon, n, rand) ! Normalise normFactor = self % matPops( p % matIdx() ) p % w = p % w / normFactor + call dungeon % detain(p) end do end subroutine appendIMC From c781a6aad2859c8a335f40a241beec339d5aac31 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 10 Mar 2022 16:14:27 +0000 Subject: [PATCH 091/373] Updated printToScreen to also be able to print matIdx --- ParticleObjects/particleDungeon_class.f90 | 26 +++++++++++++++++------ 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index e1bbabd46..2a1955535 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -461,13 +461,14 @@ subroutine printToScreen(self, prop, nMax, total) real(defReal) :: totSum character(100), parameter :: Here = 'printToScreen (particleDungeon_class.f90)' - character(nameLen), dimension(*), parameter :: AVAILABLE_props = [ 'r ',& - 'dir ',& - 'E ',& - 'G ',& - 'wgt ',& - 'time',& - 'pop '] + character(nameLen), dimension(*), parameter :: AVAILABLE_props = [ 'r ',& + 'dir ',& + 'matIdx',& + 'E ',& + 'G ',& + 'wgt ',& + 'time ',& + 'pop '] ! Reset sum variable totSum = 0 @@ -503,6 +504,17 @@ subroutine printToScreen(self, prop, nMax, total) call fatalError(Here, 'p % dir is not a scalar quantity') end if + case('matIdx') + if( totBool .eqv. .false. ) then + print *, '** ** matIdx ** **' + ! Print for each particle + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % matIdx) + end do + else + call fatalError(Here, 'p % matIdx not suitable for cumulative sum') + end if + case('E') if( totBool .eqv. .false. ) then print *, '** ** Energy ** **' From 96fc0d92ae8a3107521bfb1ac98eaa4ebba842c9 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 12 Mar 2022 17:41:44 +0000 Subject: [PATCH 092/373] Various changes to make material particle emmision work correctly with multiple material regions, still need to change energy deposition tallies --- NuclearData/IMCMaterial_inter.f90 | 4 +- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 35 +++++++++++------ NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 4 +- ParticleObjects/Source/source_inter.f90 | 31 ++++++++++++++- PhysicsPackages/IMCPhysicsPackage_class.f90 | 39 +++++++++++-------- 5 files changed, 80 insertions(+), 33 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 254bc71b8..46556239a 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -95,10 +95,10 @@ end function getFleck !! Args: !! deltaT -> Time step size !! - subroutine initProps(self, deltaT) + subroutine initProps(self, deltaT, T) import :: IMCMaterial, defReal class(IMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT + real(defReal), intent(in) :: deltaT, T end subroutine initProps end interface diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index e71558ccd..fdc1772b9 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -176,7 +176,7 @@ subroutine init(self, dict, scatterKey) class(dictionary),target, intent(in) :: dict character(nameLen), intent(in) :: scatterKey integer(shortInt) :: nG, N, i - real(defReal), dimension(:), allocatable :: temp + real(defReal), dimension(:), allocatable :: temp, temp2 type(dictDeck) :: deck character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' @@ -231,12 +231,12 @@ subroutine init(self, dict, scatterKey) end do ! Set initial temperature and energy - self % T = 298 - self % matEnergy = 100 + !self % T = 298 + !self % matEnergy = 1000 ! Set Planck opacity - call dict % get(temp, 'sigmaP') - self % sigmaP = temp(1) + call dict % get(temp2, 'sigmaP') + self % sigmaP = temp2(1) ! Read heat capacity equation call dict % get(temp, 'cv') @@ -247,7 +247,7 @@ subroutine init(self, dict, scatterKey) self % updateEqn = temp ! Set volume -- Not yet set up, for now just set arbitrarily - self % volume = pi + self % volume = pi end subroutine init @@ -332,8 +332,8 @@ subroutine updateMat(self, tallyEnergy) real(defReal) :: energy, const character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" - ! Update material internal energy - print *, "matEnergy =", self % matEnergy + ! Print energies + print *, "matEnergy at start of timestep =", self % matEnergy print *, "emittedRad =", self % getEmittedRad() print *, "tallyEnergy =", tallyEnergy @@ -343,6 +343,9 @@ subroutine updateMat(self, tallyEnergy) ! Update material internal energy self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy + ! Print energy + print *, "matEnergy at end of timestep =", self % matEnergy + ! New material internal energy density, U_{m,n+1}/V energy = self % matEnergy / self % volume @@ -352,10 +355,10 @@ subroutine updateMat(self, tallyEnergy) !! !! where f(T) is the indefinite integral of cv (stored in self % updateEqn) !! - const = energy - const + poly_eval(self % updateEqn, self % T) + !const = energy - const + poly_eval(self % updateEqn, self % T) ! Update material temperature by solving f(T_{n+1}) = const - self % T = poly_solve(self % updateEqn, self % cv, self % T, const) + self % T = poly_solve(self % updateEqn, self % cv, self % T, energy) !! Using energy and const give save result, const not necessary print *, 'T_new =', self % T if( self % T < 0 ) then @@ -364,6 +367,12 @@ subroutine updateMat(self, tallyEnergy) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT) ! Incomplete, need to add alpha + !print *, 'fleck =', self % fleck + !print *, 'a =', radiationConstant + !print *, 'c =', lightSpeed + !print *, 'V =', self % volume + !print *, 'sigmaP=', self % sigmaP + end subroutine updateMat !! @@ -399,13 +408,15 @@ end function getFleck !! Args: !! deltaT -> Time step size !! - subroutine initProps(self, deltaT) + subroutine initProps(self, deltaT, T) class(baseMgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT + real(defReal), intent(in) :: deltaT, T self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha self % deltaT = deltaT + !self % matEnergy = poly_eval(self % updateEqn, self % T) + self % T = T self % matEnergy = poly_eval(self % updateEqn, self % T) end subroutine initProps diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index a8e055545..7206eb6db 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -130,10 +130,10 @@ end function getFleck !! Args: !! deltaT -> Time step size !! - subroutine initProps(self, deltaT) + subroutine initProps(self, deltaT, T) import :: mgIMCMaterial, defReal class(mgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT + real(defReal), intent(in) :: deltaT, T end subroutine initProps end interface diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index d36fcbdcb..f247d5040 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -6,6 +6,7 @@ module source_inter use dictionary_class, only : dictionary use RNG_class, only : RNG use geometry_inter, only : geometry + use genericProcedures, only : fatalError implicit none private @@ -144,7 +145,19 @@ subroutine append(self, dungeon, n, rand) end subroutine append !! + !! Generate n particles to populate a particleDungeon without overriding + !! particles already present. Unlike 'append' subroutine above, this is + !! specific to IMCSource_class and is needed for multiregion functionality, + !! the number of particles sampled in each matIdx is tallied and used to normalise + !! each particle weight, so that the total energy emitted in each region is as + !! required !! + !! Args: + !! dungeon [inout] -> particle dungeon to be populated + !! n [in] -> number of particles to place in dungeon + !! + !! Result: + !! A dungeon populated with n particles sampled from the source !! subroutine appendIMC(self, dungeon, n, rand) class(source), intent(inout) :: self @@ -155,6 +168,7 @@ subroutine appendIMC(self, dungeon, n, rand) class(RNG), intent(inout) :: rand integer(shortInt) :: i real(defReal) :: normFactor + character(100), parameter :: Here = "appendIMC (source_inter.f90)" ! Reset particle population counters do i = 1, size( self % matPops ) @@ -169,13 +183,28 @@ subroutine appendIMC(self, dungeon, n, rand) call tempDungeon % replace(self % sampleParticle(rand), i) end do + ! Call error if any region contains no generated particles + if ( minval(self % matPops) == 0 ) then + ! Currently will lead to energy imbalance as mat energy will be reduced by emittedRad but + ! no particles will be carrying it, possible to modify code to maintain energy balance + call fatalError(Here, "Not all regions emitted particles, use more particles") + end if + ! Loop through again and add to input dungeon, normalising energies based on material do i = 1, n + call tempDungeon % release(p) + + ! Place inside geometry to set matIdx, for some reason resets when released from dungeon + call self % geom % placeCoord( p % coords ) + ! Normalise - normFactor = self % matPops( p % matIdx() ) + normFactor = self % matPops( p % coords % matIdx ) p % w = p % w / normFactor + + ! Add to input dungeon call dungeon % detain(p) + end do end subroutine appendIMC diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 7839f67ad..d66122ba8 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -27,7 +27,8 @@ module IMCPhysicsPackage_class gr_geomIdx => geomIdx ! Nuclear Data - use materialMenu_mod, only : mm_nMat => nMat + use materialMenu_mod, only : mm_nMat => nMat ,& + mm_matName => matName use nuclearDataReg_mod, only : ndReg_init => init ,& ndReg_activate => activate ,& ndReg_display => display, & @@ -127,7 +128,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_cycles - integer(shortInt) :: i, N + integer(shortInt) :: i, j, N type(particle) :: p real(defReal) :: elapsed_T, end_T, T_toEnd, tallyEnergy class(IMCMaterial), pointer :: mat @@ -145,8 +146,17 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call timerReset(self % timerMain) call timerStart(self % timerMain) - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - call mat % initProps(self % deltaT) + ! Attach initial properties to material classes + do j=1, mm_nMat() + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + call mat % initProps(self % deltaT, ONE*j) + print *, mm_matName(j) + end do + + ! Generate initial source distribution + if( self % sourceGiven ) then + call self % inputSource % generate(self % nextCycle, self % imcSourceN, p % pRNG) + end if do i=1,N_cycles @@ -155,20 +165,16 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call self % nextCycle % cleanPop() ! Generate IMC source - call self % IMCSource % append(self % thisCycle, self % imcSourceN, p % pRNG) + call self % IMCSource % appendIMC(self % thisCycle, self % imcSourceN, p % pRNG) ! Generate from input source if( self % sourceGiven ) then call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) end if - !call self % thisCycle % printToScreen('time', 20) - - ! Send start of cycle report - !call self % inputSource % generate(self % thisCycle, N, p % pRNG) - !if(self % printSource == 1) then - ! call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) - !end if + if(self % printSource == 1) then + call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + end if call tally % reportCycleStart(self % thisCycle) @@ -189,8 +195,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Save state call p % savePreHistory() - !print *, ' NEW PARTICLE Weight:', p % w - ! Transport particle until its death history: do call self % transOp % transport(p, tally, self % thisCycle, self % nextCycle) @@ -236,8 +240,11 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end select ! Update material properties - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(1)) - call mat % updateMat(tallyEnergy) + do j=1, mm_nMat() + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + print *, "Material update: ", mm_matName(j) + call mat % updateMat(tallyEnergy) + end do ! Reset tally for next cycle call tallyAtch % reset('imcWeight') From 3af1eb248deb8177c6a02426bb8713b3840e82ff Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 12 Mar 2022 17:45:41 +0000 Subject: [PATCH 093/373] Made output more readable --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index d66122ba8..fbe7a9aab 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -242,9 +242,11 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Update material properties do j=1, mm_nMat() mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + print *, '' print *, "Material update: ", mm_matName(j) call mat % updateMat(tallyEnergy) end do + print *, '' ! Reset tally for next cycle call tallyAtch % reset('imcWeight') From 419fb259f7e2453d9a9fc416be5a27b3de6662d0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 12 Mar 2022 17:48:47 +0000 Subject: [PATCH 094/373] Moved material update printouts below source batch title --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index fbe7a9aab..d82af5d0d 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -239,15 +239,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call fatalError(Here, 'Invalid result has been returned') end select - ! Update material properties - do j=1, mm_nMat() - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - print *, '' - print *, "Material update: ", mm_matName(j) - call mat % updateMat(tallyEnergy) - end do - print *, '' - ! Reset tally for next cycle call tallyAtch % reset('imcWeight') @@ -262,6 +253,16 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) print *, 'End time: ', trim(secToChar(end_T)) print *, 'Time to end: ', trim(secToChar(T_toEnd)) call tally % display() + + ! Update material properties + do j=1, mm_nMat() + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + print * + print *, "Material update: ", mm_matName(j) + call mat % updateMat(tallyEnergy) + end do + print * + end do end subroutine cycles From 107e598b2bb9704084caf7f3799b75f0b450945b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 12 Mar 2022 17:53:40 +0000 Subject: [PATCH 095/373] Also prints out T_old --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index fdc1772b9..824fe0847 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -333,6 +333,7 @@ subroutine updateMat(self, tallyEnergy) character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" ! Print energies + print *, "T_old =", self % T print *, "matEnergy at start of timestep =", self % matEnergy print *, "emittedRad =", self % getEmittedRad() print *, "tallyEnergy =", tallyEnergy From 1331525780193182f3b261e9868ea7bc23eb267d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 16 Mar 2022 16:49:48 +0000 Subject: [PATCH 096/373] Changed energy tallies to work with multiple materials, all code should now be functional but need to test energy balances etc. and allow different mats to have different cv equations and sigmas --- IMCTest | 88 +++++++------------- InputFiles/XS/imcData | 17 ++-- PhysicsPackages/IMCPhysicsPackage_class.f90 | 61 +++++++++----- Tallies/TallyClerks/imcWeightClerk_class.f90 | 36 +++++--- Tallies/tallyAdmin_class.f90 | 9 ++ 5 files changed, 112 insertions(+), 99 deletions(-) diff --git a/IMCTest b/IMCTest index e376dd7ca..ce34e09ce 100644 --- a/IMCTest +++ b/IMCTest @@ -3,9 +3,9 @@ type IMCPhysicsPackage; -pop 5; -cycles 10; -timeStepSize 0.00000000005; +pop 10000; +cycles 5; +timeStepSize 0.1; XSdata mg; dataType mg; @@ -20,45 +20,26 @@ transportOperator { } -source { - type pointSource; - r (0 0 0); - particle photon; - G 2; -} +//source { + // type pointSource; + // r (0 0 0); + // particle photon; + // G 1; +//} imcSource { type imcSource; - nParticles 5; + nParticles 10000; } -inactiveTally { - } - -activeTally { - //norm fiss; - //normVal 100; - //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} - flux { type collisionClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - response (flux); flux {type fluxResponse;} - } - } - -tally { - //display (imcWeight); - //norm fiss; - //normVal 100.0; - //k-eff { type keffAnalogClerk; response (flux); flux {type fluxResponse;} } - //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} - //flux { type collisionClerk; - // map { type energyMap; grid log; min 0.001; max 20; N 300;} - // response (flux); flux {type fluxResponse;} - // } - imcWeight { type imcWeightClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - //response (imc); imc {type fluxResponse;} - } +inactiveTally {} + +activeTally {} + +tally { + //imcWeight { type imcWeightClerk; + // map { type materialMap; materials ( mat1 mat2 ); } + // } } geometry { @@ -68,19 +49,18 @@ geometry { surfaces { - squareBound { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 1; } + inner { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 1; } + outer { id 2; type sphere; origin ( 0.0 0.0 0.0); radius 1.26; } + } + cells + { + inner_cell { id 1; type simpleCell; surfaces (-1); filltype mat; material mat1; } + outer_cell { id 2; type simpleCell; surfaces ( 1); filltype mat; material mat2; } } - cells {} universes { - - root - { - id 1; - type rootUniverse; - border 1; - fill fuel; - } + root { id 1; type rootUniverse; border 2; fill u<2>; } + cell { id 2; type cellUniverse; cells ( 1 2 ); } } } @@ -94,16 +74,12 @@ nuclearData { materials { - fuel { + mat1 { temp 273; - composition { - 94239.03 0.037047; - 94240.03 0.0017512; - 94241.03 0.00011674; - 31000.03 0.0013752; - } - xsFile ./InputFiles/XS/imcData; - } + composition {} + xsFile ./InputFiles/XS/imcData; + } + mat2 { temp 273; composition {} xsFile ./InputFiles/XS/imcData; } } diff --git a/InputFiles/XS/imcData b/InputFiles/XS/imcData index 49cca4fc3..e7c63a1a9 100644 --- a/InputFiles/XS/imcData +++ b/InputFiles/XS/imcData @@ -3,25 +3,24 @@ // ‘Analytical Benchmark Test Set For Criticality Code Verification’ // -numberOfGroups 2; +numberOfGroups 1; -capture (0.0010046 0.025788); +capture (1.0); scatteringMultiplicity ( -1.0 1.0 -1.0 1.0 ); +0.0 +); P0 ( - 0.62568 0.029227 - 0.0 2.443830 + 0.0 ); sigmaP ( - 0.5 + 1.0 ); cv ( - 3.0 1.5 7.0 - 1.0 2.0 6.0 + 4.0 + 3.0 ); diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index d82af5d0d..6a2e3e40b 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -82,6 +82,7 @@ module IMCPhysicsPackage_class integer(shortInt) :: particleType integer(shortInt) :: imcSourceN logical(defBool) :: sourceGiven = .false. + integer(shortInt) :: nMat ! Calculation components type(particleDungeon), allocatable :: thisCycle! => null() Other physics packages use pointers here @@ -130,7 +131,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) integer(shortInt), intent(in) :: N_cycles integer(shortInt) :: i, j, N type(particle) :: p - real(defReal) :: elapsed_T, end_T, T_toEnd, tallyEnergy + real(defReal) :: elapsed_T, end_T, T_toEnd + real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes @@ -147,12 +149,14 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call timerStart(self % timerMain) ! Attach initial properties to material classes - do j=1, mm_nMat() + do j=1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) call mat % initProps(self % deltaT, ONE*j) print *, mm_matName(j) end do + allocate(tallyEnergy(self % nMat)) + ! Generate initial source distribution if( self % sourceGiven ) then call self % inputSource % generate(self % nextCycle, self % imcSourceN, p % pRNG) @@ -229,23 +233,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end_T = real(N_cycles,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) - ! Obtain energy deposited in zone from tally - call tallyAtch % getResult(tallyRes, 'imcWeight') - - select type(tallyRes) - class is(imcWeightResult) - tallyEnergy = tallyRes % imcWeight - class default - call fatalError(Here, 'Invalid result has been returned') - end select - - ! Reset tally for next cycle - call tallyAtch % reset('imcWeight') - ! Display progress call printFishLineR(i) print * - !call mat % updateMat(self % deltaT) print * print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) print *, 'Pop: ', numToChar(self % pop) @@ -254,16 +244,32 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) print *, 'Time to end: ', trim(secToChar(T_toEnd)) call tally % display() + ! Obtain energy deposition tally results + call tallyAtch % getResult(tallyRes, 'imcWeight') + + select type(tallyRes) + class is(imcWeightResult) + do j = 1, self % nMat + tallyEnergy(j) = tallyRes % imcWeight(j) + end do + class default + call fatalError(Here, 'Invalid result has been returned') + end select + ! Update material properties - do j=1, mm_nMat() + do j = 1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) print * print *, "Material update: ", mm_matName(j) - call mat % updateMat(tallyEnergy) + call mat % updateMat(tallyEnergy(j)) end do print * + ! Reset tally for next cycle + call tallyAtch % reset('imcWeight') + end do + end subroutine cycles !! @@ -307,7 +313,7 @@ subroutine init(self, dict) class(IMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict class(dictionary),pointer :: tempDict - type(dictionary) :: locDict1, locDict2 + type(dictionary) :: locDict1, locDict2, locDict3 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -316,6 +322,7 @@ subroutine init(self, dict) character(nameLen) :: nucData, energy, geomName type(outputFile) :: test_out integer(shortInt) :: i + character(nameLen), dimension(:), allocatable :: mats character(100), parameter :: Here ='init (IMCPhysicsPackage_class.f90)' call cpu_time(self % CPU_time_start) @@ -406,13 +413,25 @@ subroutine init(self, dict) allocate(self % tally) call self % tally % init(tempDict) + ! Store number of materials + self % nMat = mm_nMat() + + ! Create array of material names + allocate(mats(self % nMat)) + do i=1, self % nMat + mats(i) = mm_matName(i) + end do + ! Initialise imcWeight tally attachment - call locDict1 % init(2) + call locDict1 % init(1) call locDict2 % init(2) + call locDict3 % init(2) + call locDict3 % store('type','materialMap') + call locDict3 % store('materials', [mats]) call locDict2 % store('type','imcWeightClerk') + call locDict2 % store('map', locDict3) call locDict1 % store('imcWeight', locDict2) - call locDict1 % store('display',['imcWeight']) allocate(self % imcWeightAtch) call self % imcWeightAtch % init(locDict1) diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 index ee510a676..cd594139c 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -11,6 +11,7 @@ module imcWeightClerk_class ! Nuclear Data interface use nuclearDatabase_inter, only : nuclearDatabase + use materialMenu_mod, only : mm_nMat => nMat ! Tally Filters use tallyFilter_inter, only : tallyFilter @@ -19,6 +20,7 @@ module imcWeightClerk_class ! Tally Maps use tallyMap_inter, only : tallyMap use tallyMapFactory_func, only : new_tallyMap + use materialMap_class, only : materialMap ! Tally Responses use tallyResponseSlot_class, only : tallyResponseSlot @@ -61,8 +63,9 @@ module imcWeightClerk_class class(tallyMap), allocatable :: map type(tallyResponseSlot),dimension(:),allocatable :: response - ! Usefull data + ! Useful data integer(shortInt) :: width = 0 + integer(shortInt) :: nMat contains ! Procedures used during build @@ -81,8 +84,8 @@ module imcWeightClerk_class end type imcWeightClerk - type,public, extends(tallyResult) :: imcWeightResult - real(defReal) :: imcWeight = ZERO + type,public, extends(tallyResult) :: imcWeightResult + real(defReal), dimension(:), allocatable :: imcWeight end type imcWeightResult contains @@ -112,6 +115,9 @@ subroutine init(self, dict, name) call new_tallyMap(self % map, dict % getDictPtr('map')) end if + ! Store number of materials + self % nMat = mm_nMat() + ! Get names of response dictionaries !call dict % get(responseNames,'response') @@ -210,23 +216,21 @@ subroutine reportHist(self, p, xsData, mem) if(allocated(self % map)) then binIdx = self % map % map(state) else - binIdx = 1 + binIdx = 1 !p % matIdx() end if ! Return if invalid bin index if (binIdx == 0) return ! Calculate bin address - adrr = self % getMemAddress()! + self % width * (binIdx -1) - 1 - ! Append all bins - !do i=1,self % width + adrr = self % getMemAddress() + binIdx - 1 + + ! Append to required bin if( p % isDead .and. p % fate /= LEAK_FATE ) then scoreVal = p % w - call mem % score(scoreVal, adrr)! + i) + call mem % score(scoreVal, adrr) end if - !end do - end subroutine reportHist !! @@ -298,10 +302,16 @@ pure subroutine getResult(self, res, mem) class(imcWeightClerk), intent(in) :: self class(tallyResult), allocatable, intent(inout) :: res type(scoreMemory), intent(in) :: mem - real(defReal) :: w, STD + real(defReal), dimension(:), allocatable :: w + integer(shortInt) :: i, N + + N = self % nMat + allocate( w(N) ) - ! Get result value - call mem % getResult(w, STD, self % getMemAddress()) + ! Get result value for each material + do i = 1, N + call mem % getResult(w(i), self % getMemAddress()+i-1) + end do allocate(res, source = imcWeightResult(w)) diff --git a/Tallies/tallyAdmin_class.f90 b/Tallies/tallyAdmin_class.f90 index feef46940..fabcf8e4b 100644 --- a/Tallies/tallyAdmin_class.f90 +++ b/Tallies/tallyAdmin_class.f90 @@ -17,6 +17,7 @@ module tallyAdmin_class ! Nuclear Data Interface use nuclearDataReg_mod, only : ndReg_get => get use nuclearDatabase_inter, only : nuclearDatabase + use materialMenu_mod, only : mm_nMat => nMat implicit none private @@ -752,6 +753,7 @@ subroutine reset(self, name) integer(shortInt) :: idx integer(shortInt),parameter :: NOT_PRESENT = -3 integer(longInt) :: addr + integer(shortInt) :: i character(100),parameter :: Here='reset (tallyAdmin_class.f90)' name_loc = name @@ -766,6 +768,13 @@ subroutine reset(self, name) call self % mem % reset(addr) + ! If IMCWeight, reset for each material - probably a better way to do this but fine for now + if ( name == 'imcWeight' ) then + do i = 1, mm_nMat()-1 + call self % mem % reset(addr+i) + end do + end if + end subroutine reset From 9c3617afa8df503ec743f136dfa81b07ffd84acb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 16 Mar 2022 20:14:50 +0000 Subject: [PATCH 097/373] Now initialises with temperatures from input file --- NuclearData/materialMenu_mod.f90 | 28 +++++++++++++++++++++ PhysicsPackages/IMCPhysicsPackage_class.f90 | 6 ++--- 2 files changed, 31 insertions(+), 3 deletions(-) diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index b22c022e8..98be8f7e0 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -16,6 +16,7 @@ !! getMatPtr -> Return pointer to a detailed material information (materialItem) !! nMat -> Return number of materials !! matName -> Return material Name given Index +!! matTemp -> Return material Temperature given Index !! matIdx -> Return material Index given Name !! module materialMenu_mod @@ -105,6 +106,7 @@ module materialMenu_mod public :: getMatPtr public :: nMat public :: matName + public :: matTemp public :: matIdx contains @@ -214,6 +216,32 @@ function matName(idx) result(name) end function matName + !! + !! Return starting temperature of materal given index + !! + !! Args: + !! idx [in] -> Material Index + !! + !! Result: + !! Temperature of material as given in input file + !! + !! Erorrs: + !! If idx is -ve or larger then number of defined materials + !! 0 is returned as its temperature + !! + function matTemp(idx) result(temp) + integer(shortInt), intent(in) :: idx + real(defReal) :: temp + + if( idx <= 0 .or. nMat() < idx) then + temp = 0 + + else + temp = materialDefs(idx) % T + end if + + end function matTemp + !! !! Return material index Given Name !! diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 6a2e3e40b..4cdf0bf35 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -28,7 +28,8 @@ module IMCPhysicsPackage_class ! Nuclear Data use materialMenu_mod, only : mm_nMat => nMat ,& - mm_matName => matName + mm_matName => matName ,& + mm_matTemp => matTemp use nuclearDataReg_mod, only : ndReg_init => init ,& ndReg_activate => activate ,& ndReg_display => display, & @@ -151,8 +152,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Attach initial properties to material classes do j=1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - call mat % initProps(self % deltaT, ONE*j) - print *, mm_matName(j) + call mat % initProps(self % deltaT, mm_matTemp(j)) end do allocate(tallyEnergy(self % nMat)) From 899e19e80371a3d26ae966d7c89423a21e4873ce Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 16 Mar 2022 20:36:41 +0000 Subject: [PATCH 098/373] Now put volume of material zone in input file so that volumes are correctly calculated, reaches thermal equilibrium nicely --- IMCTest | 19 ++++++------ NuclearData/IMCMaterial_inter.f90 | 4 +-- NuclearData/materialMenu_mod.f90 | 31 +++++++++++++++++++ .../baseMgIMC/baseMgIMCMaterial_class.f90 | 15 +++++---- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 4 +-- PhysicsPackages/IMCPhysicsPackage_class.f90 | 5 +-- 6 files changed, 56 insertions(+), 22 deletions(-) diff --git a/IMCTest b/IMCTest index ce34e09ce..b1896eeb4 100644 --- a/IMCTest +++ b/IMCTest @@ -3,8 +3,8 @@ type IMCPhysicsPackage; -pop 10000; -cycles 5; +pop 20000; +cycles 100; timeStepSize 0.1; XSdata mg; @@ -37,20 +37,18 @@ inactiveTally {} activeTally {} tally { - //imcWeight { type imcWeightClerk; - // map { type materialMap; materials ( mat1 mat2 ); } - // } } geometry { type geometryStd; - boundary (0 0 0 0 0 0); + boundary (1 1 1 1 1 1); graph {type shrunk;} surfaces { inner { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 1; } - outer { id 2; type sphere; origin ( 0.0 0.0 0.0); radius 1.26; } + outer { id 2; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1 1 1); } + //outer { id 2; type sphere; origin ( 0.0 0.0 0.0); radius 1.26; } } cells { @@ -75,11 +73,12 @@ nuclearData { materials { mat1 { - temp 273; + temp 1; composition {} - xsFile ./InputFiles/XS/imcData; + xsFile ./InputFiles/XS/imcData; + volume 4.18879; } - mat2 { temp 273; composition {} xsFile ./InputFiles/XS/imcData; } + mat2 { temp 5; composition {} xsFile ./InputFiles/XS/imcData; volume 3.81121; } } diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 46556239a..28ad1c155 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -95,10 +95,10 @@ end function getFleck !! Args: !! deltaT -> Time step size !! - subroutine initProps(self, deltaT, T) + subroutine initProps(self, deltaT, T, V) import :: IMCMaterial, defReal class(IMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT, T + real(defReal), intent(in) :: deltaT, T, V end subroutine initProps end interface diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index 98be8f7e0..9e5371f57 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -17,6 +17,7 @@ !! nMat -> Return number of materials !! matName -> Return material Name given Index !! matTemp -> Return material Temperature given Index +!! matVol -> Return material Volume given Index !! matIdx -> Return material Index given Name !! module materialMenu_mod @@ -63,6 +64,7 @@ module materialMenu_mod !! name -> name of material !! matIdx -> material index of the material !! T -> material temperature [K] + !! V -> volume of material zone, currently used in IMC calculations !! dens -> vector of densities [1/barn/cm] !! nuclides -> associated vector of nuclide types !! extraInfo -> dictionary with extra keywords @@ -87,6 +89,7 @@ module materialMenu_mod character(nameLen) :: name = '' integer(shortInt) :: matIdx = 0 real(defReal) :: T = ZERO + real(defReal) :: V = ZERO real(defReal),dimension(:),allocatable :: dens type(nuclideInfo),dimension(:),allocatable :: nuclides type(dictionary) :: extraInfo @@ -107,6 +110,7 @@ module materialMenu_mod public :: nMat public :: matName public :: matTemp + public :: matVol public :: matIdx contains @@ -242,6 +246,32 @@ function matTemp(idx) result(temp) end function matTemp + !! + !! Return volume of materal given index + !! + !! Args: + !! idx [in] -> Material Index + !! + !! Result: + !! Volume of material as given in input file + !! + !! Erorrs: + !! If idx is -ve or larger then number of defined materials + !! 0 is returned as its volume + !! + function matVol(idx) result(vol) + integer(shortInt), intent(in) :: idx + real(defReal) :: vol + + if( idx <= 0 .or. nMat() < idx) then + vol = 0 + + else + vol = materialDefs(idx) % V + end if + + end function matVol + !! !! Return material index Given Name !! @@ -290,6 +320,7 @@ subroutine init_materialItem(self, name, dict) ! Load easy components c self % name = name call dict % get(self % T,'temp') + call dict % getOrDefault(self % V, 'volume', ZERO) ! Get composition dictionary and load composition compDict => dict % getDictPtr('composition') diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 824fe0847..133302caf 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -246,9 +246,6 @@ subroutine init(self, dict, scatterKey) call poly_integrate(temp) self % updateEqn = temp - ! Set volume -- Not yet set up, for now just set arbitrarily - self % volume = pi - end subroutine init !! @@ -409,14 +406,20 @@ end function getFleck !! Args: !! deltaT -> Time step size !! - subroutine initProps(self, deltaT, T) + !! Errors: + !! fatalError if material volume <= 0 + !! + subroutine initProps(self, deltaT, T, V) class(baseMgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT, T + real(defReal), intent(in) :: deltaT, T, V + character(100), parameter :: Here = 'initProps (baseMgIMCMaterial_class.f90)' self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha self % deltaT = deltaT + self % volume = V + + if(self % volume <= 0) call fatalError(Here, 'Invalid material volume given') - !self % matEnergy = poly_eval(self % updateEqn, self % T) self % T = T self % matEnergy = poly_eval(self % updateEqn, self % T) diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 7206eb6db..13d13ac44 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -130,10 +130,10 @@ end function getFleck !! Args: !! deltaT -> Time step size !! - subroutine initProps(self, deltaT, T) + subroutine initProps(self, deltaT, T, V) import :: mgIMCMaterial, defReal class(mgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT, T + real(defReal), intent(in) :: deltaT, T, V end subroutine initProps end interface diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 4cdf0bf35..17a6b2e05 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -29,7 +29,8 @@ module IMCPhysicsPackage_class ! Nuclear Data use materialMenu_mod, only : mm_nMat => nMat ,& mm_matName => matName ,& - mm_matTemp => matTemp + mm_matTemp => matTemp ,& + mm_matVol => matVol use nuclearDataReg_mod, only : ndReg_init => init ,& ndReg_activate => activate ,& ndReg_display => display, & @@ -152,7 +153,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Attach initial properties to material classes do j=1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - call mat % initProps(self % deltaT, mm_matTemp(j)) + call mat % initProps(self % deltaT, mm_matTemp(j), mm_matVol(j)) end do allocate(tallyEnergy(self % nMat)) From 51c18a42f66ae34d16541d4c49fc51fc42d25433 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Mar 2022 20:50:49 +0000 Subject: [PATCH 099/373] Updated error description when too many particles are sampled --- ParticleObjects/Source/IMCSource_class.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index ece578f97..d09ffa2ec 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -122,8 +122,8 @@ function sampleParticle(self, rand) result(p) ! Protect against infinite loop i = i +1 if ( i > 200) then - call fatalError(Here, 'Infinite loop in sampling of fission sites. Please check that& - & defined volume contains fissile material.') + call fatalError(Here, '200 particles in a row sampled in void or outside material.& + & Check that geometry is as intended') end if ! Sample Position From 6ab822f8c2612de68b4bcbd57868b3f3df82a936 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Mar 2022 21:09:47 +0000 Subject: [PATCH 100/373] Tidied up some test files --- InputFiles/IMC/dataFiles/imcData | 26 ++++++++ InputFiles/IMC/infiniteRegion | 101 +++++++++++++++++++++++++++++++ InputFiles/IMC/output.m | 7 +++ InputFiles/IMC/sphereInCube | 80 ++++++++++++++++++++++++ InputFiles/IMC/touchingCubes | 89 +++++++++++++++++++++++++++ 5 files changed, 303 insertions(+) create mode 100644 InputFiles/IMC/dataFiles/imcData create mode 100644 InputFiles/IMC/infiniteRegion create mode 100644 InputFiles/IMC/output.m create mode 100644 InputFiles/IMC/sphereInCube create mode 100644 InputFiles/IMC/touchingCubes diff --git a/InputFiles/IMC/dataFiles/imcData b/InputFiles/IMC/dataFiles/imcData new file mode 100644 index 000000000..e7c63a1a9 --- /dev/null +++ b/InputFiles/IMC/dataFiles/imcData @@ -0,0 +1,26 @@ +// This XSS are for a URR-2-1-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 (1.0); + +scatteringMultiplicity ( +0.0 +); + +P0 ( + 0.0 +); + +sigmaP ( + 1.0 +); + +cv ( + 4.0 + 3.0 +); + diff --git a/InputFiles/IMC/infiniteRegion b/InputFiles/IMC/infiniteRegion new file mode 100644 index 000000000..38ab857bf --- /dev/null +++ b/InputFiles/IMC/infiniteRegion @@ -0,0 +1,101 @@ + +type IMCPhysicsPackage; + +pop 20000; +cycles 20; +timeStepSize 1; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + + +//source { +// type pointSource; +// r (0 0 0); +// particle photon; +// G 2; +//} +//source { + // type imcSource; + //nParticles 1000; +//} + +imcSource { + type imcSource; + nParticles 20000; + } + +inactiveTally { + } + +activeTally { + //norm fiss; + //normVal 100; + //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} + flux { type collisionClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + response (flux); flux {type fluxResponse;} + } + } + +tally { + imcWeight { type imcWeightClerk; + map { type energyMap; grid log; min 0.001; max 20; N 300;} + //response (imc); imc {type fluxResponse;} + } + } + +geometry { + type geometryStd; + boundary (1 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } + } + cells {} + universes + { + + root + { + id 1; + type rootUniverse; + border 1; + fill mat; + } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat { + temp 1; + composition {} + xsFile ./dataFiles/imcData; + volume 1; + } + +} + +} + + + diff --git a/InputFiles/IMC/output.m b/InputFiles/IMC/output.m new file mode 100644 index 000000000..cd67a83cf --- /dev/null +++ b/InputFiles/IMC/output.m @@ -0,0 +1,7 @@ +seed = -826255877; +pop = 10000; +Source_batches = 200; +Total_CPU_Time = 3.31190E+00; +Transport_time = 3.27185E+00; +batchSize = 1; + diff --git a/InputFiles/IMC/sphereInCube b/InputFiles/IMC/sphereInCube new file mode 100644 index 000000000..1527a0826 --- /dev/null +++ b/InputFiles/IMC/sphereInCube @@ -0,0 +1,80 @@ + +type IMCPhysicsPackage; + +pop 20000; +cycles 100; +timeStepSize 0.1; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + +imcSource { + type imcSource; + nParticles 10000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (1 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + inner { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 1; } + outer { id 2; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1 1 1); } + } + cells + { + inner_cell { id 1; type simpleCell; surfaces (-1); filltype mat; material mat1; } + outer_cell { id 2; type simpleCell; surfaces ( 1); filltype mat; material mat2; } + } + universes + { + root { id 1; type rootUniverse; border 2; fill u<2>; } + cell { id 2; type cellUniverse; cells ( 1 2 ); } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat1 { + temp 1; + composition {} + xsFile ./dataFiles/imcData; + volume 4.18879; + } + mat2 { + temp 5; + composition {} + xsFile ./dataFiles/imcData; + volume 3.81121; } + +} + +} + + + diff --git a/InputFiles/IMC/touchingCubes b/InputFiles/IMC/touchingCubes new file mode 100644 index 000000000..e35682110 --- /dev/null +++ b/InputFiles/IMC/touchingCubes @@ -0,0 +1,89 @@ + +type IMCPhysicsPackage; + +pop 10000; +cycles 200; +timeStepSize 1; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + + +//source { + // type pointSource; + // r (0 0 0); + // particle photon; + // G 1; +//} + +imcSource { + type imcSource; + nParticles 5000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (1 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + sep { id 1; type xPlane; x0 0.0; } + outer { id 2; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1 0.5 0.5); } + } + cells + { + cell1 { id 1; type simpleCell; surfaces (-1); filltype mat; material mat1; } + cell2 { id 2; type simpleCell; surfaces ( 1); filltype mat; material mat2; } + } + universes + { + root { id 1; type rootUniverse; border 2; fill u<2>; } + cell { id 2; type cellUniverse; cells ( 1 2 ); } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat1 { + temp 1; + composition {} + xsFile ./dataFiles/imcData; + volume 1; + } + mat2 { + temp 0.0000001; + composition {} + xsFile ./dataFiles/imcData; + volume 1; + } + +} + +} + + + From c86cf99295a5f06250577a19ce88333cea7bd8f3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 13 May 2022 15:01:11 +0100 Subject: [PATCH 101/373] Changed data file to use sigmaP instead of capture for consistency --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 4 +- benchmarkIMCTest | 117 ------------------ 2 files changed, 2 insertions(+), 119 deletions(-) delete mode 100644 benchmarkIMCTest diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 133302caf..3f79c778c 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -210,8 +210,8 @@ subroutine init(self, dict, scatterKey) allocate(self % data(N, nG)) - ! Load cross sections - call dict % get(temp, 'capture') + ! Load cross sections - Loads 'sigmaP' in place of 'capture' so that existing functions to get cross section instead get sigmaP + call dict % get(temp, 'sigmaP') if(size(temp) /= nG) then call fatalError(Here,'Capture XSs have wong size. Must be: ' & // numToChar(nG)//' is '//numToChar(size(temp))) diff --git a/benchmarkIMCTest b/benchmarkIMCTest deleted file mode 100644 index 095b2832d..000000000 --- a/benchmarkIMCTest +++ /dev/null @@ -1,117 +0,0 @@ -//type fixedSourcePhysicsPackage; -//type eigenPhysicsPackage; - -type IMCPhysicsPackage; - -pop 20000; -cycles 20; -timeStepSize 1; - -XSdata mg; -dataType mg; - - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorIMC; - } - - -//source { -// type pointSource; -// r (0 0 0); -// particle photon; -// G 2; -//} -//source { - // type imcSource; - //nParticles 1000; -//} - -imcSource { - type imcSource; - nParticles 20000; - } - -inactiveTally { - } - -activeTally { - //norm fiss; - //normVal 100; - //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} - flux { type collisionClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - response (flux); flux {type fluxResponse;} - } - } - -tally { - //display (imcWeight); - //norm fiss; - //normVal 100.0; - //k-eff { type keffAnalogClerk; response (flux); flux {type fluxResponse;} } - //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} - //flux { type collisionClerk; - // map { type energyMap; grid log; min 0.001; max 20; N 300;} - // response (flux); flux {type fluxResponse;} - // } - imcWeight { type imcWeightClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - //response (imc); imc {type fluxResponse;} - } - } - -geometry { - type geometryStd; - boundary (1 1 1 1 1 1); - graph {type shrunk;} - - surfaces - { - squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } - } - cells {} - universes - { - - root - { - id 1; - type rootUniverse; - border 1; - fill fuel; - } - } -} - -nuclearData { - - handles { - //ce { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} - mg { type baseMgIMCDatabase; PN P0;} - } - - - materials { - - fuel { - temp 273; - composition { - 94239.03 0.037047; - 94240.03 0.0017512; - 94241.03 0.00011674; - 31000.03 0.0013752; - } - xsFile ./imcBenchmarkData; //./InputFiles/XS/imcData; //./imcBenchmarkData; - } - -} - -} - - - From 86376c8fe674f25377abb60d38f6b74584defddb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 25 May 2022 18:17:57 +0100 Subject: [PATCH 102/373] Created surface source class for black body - very simple and low functionality at the moment --- InputFiles/IMC/bbSurface | 85 +++++ ParticleObjects/Source/CMakeLists.txt | 1 + ParticleObjects/Source/configSource_inter.f90 | 3 +- ParticleObjects/Source/sourceFactory_func.f90 | 8 +- ParticleObjects/Source/source_inter.f90 | 4 +- .../Source/surfaceSource_class.f90 | 298 ++++++++++++++++++ 6 files changed, 395 insertions(+), 4 deletions(-) create mode 100644 InputFiles/IMC/bbSurface create mode 100644 ParticleObjects/Source/surfaceSource_class.f90 diff --git a/InputFiles/IMC/bbSurface b/InputFiles/IMC/bbSurface new file mode 100644 index 000000000..8d9ee474a --- /dev/null +++ b/InputFiles/IMC/bbSurface @@ -0,0 +1,85 @@ + +type IMCPhysicsPackage; + +pop 10000; +cycles 30; +timeStepSize 1; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + + +source { + type surfaceSource; + shape square; + size 1; + axis x; + pos 0; + T 1; + nParticles 10000; + dir 1; + deltat 1; + particle photon; +} + +imcSource { + type imcSource; + nParticles 10000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (0 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + box { id 1; type box; origin ( 0.5 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } + } + + cells {} + + universes + { + root { id 1; type rootUniverse; border 1; fill mat; } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat { + temp 0.00001; + composition {} + xsFile ./dataFiles/imcData; + volume 1; + } + +} + +} + + + diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index 3309bd4ba..29ea31784 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -5,4 +5,5 @@ add_sources( source_inter.f90 pointSource_class.f90 fissionSource_class.f90 IMCSource_class.f90 + surfaceSource_class.f90 ) diff --git a/ParticleObjects/Source/configSource_inter.f90 b/ParticleObjects/Source/configSource_inter.f90 index 968dd0dbe..7c14be07d 100644 --- a/ParticleObjects/Source/configSource_inter.f90 +++ b/ParticleObjects/Source/configSource_inter.f90 @@ -134,7 +134,8 @@ function sampleParticle(self, rand) result(p) call self % sampleEnergyAngle(p, rand) call self % sampleEnergy(p, rand) p % time = ZERO - p % wgt = ONE + + if (p % wgt == ZERO) p % wgt = ONE end function sampleParticle diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index eb0976475..f06846fea 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -11,6 +11,7 @@ module sourceFactory_func use pointSource_class, only : pointSource use fissionSource_class, only : fissionSource use IMCSource_class, only : imcSource + use surfaceSource_class, only : surfaceSource ! geometry use geometry_inter, only : geometry @@ -27,7 +28,8 @@ module sourceFactory_func ! For now it is necessary to adjust trailing blanks so all entries have the same length character(nameLen),dimension(*),parameter :: AVAILABLE_sources = [ 'pointSource ',& 'fissionSource',& - 'imcSource '] + 'imcSource ',& + 'surfaceSource'] contains @@ -63,6 +65,10 @@ subroutine new_source(new, dict, geom) allocate(imcSource :: new) call new % init(dict, geom) + case('surfaceSource') + allocate(surfaceSource :: new) + call new % init(dict, geom) + !*** NEW SOURCE TEMPLATE ***! !case('') ! allocate( :: new) diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index f247d5040..6b48c1197 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -147,8 +147,8 @@ end subroutine append !! !! Generate n particles to populate a particleDungeon without overriding !! particles already present. Unlike 'append' subroutine above, this is - !! specific to IMCSource_class and is needed for multiregion functionality, - !! the number of particles sampled in each matIdx is tallied and used to normalise + !! specific to IMCSource_class and is needed for multiregion functionality. + !! The number of particles sampled in each matIdx is tallied and used to normalise !! each particle weight, so that the total energy emitted in each region is as !! required !! diff --git a/ParticleObjects/Source/surfaceSource_class.f90 b/ParticleObjects/Source/surfaceSource_class.f90 new file mode 100644 index 000000000..0f92a964f --- /dev/null +++ b/ParticleObjects/Source/surfaceSource_class.f90 @@ -0,0 +1,298 @@ +module surfaceSource_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError + use particle_class, only : particleState, P_NEUTRON, P_PHOTON + use dictionary_class, only : dictionary + use configSource_inter, only : configSource, kill_super => kill + use geometry_inter, only : geometry + use RNG_class, only : RNG + + implicit none + private + + !! + !! Class describing point-like particle sources + !! + !! Generates a mono-energetic, mono-directional or isotropic particle + !! source from a single point in space, with particles of a single type + !! + !! Private members: + !! r -> source position + !! dir -> optional source direction + !! particleType -> source particle type + !! isMG -> is the source multi-group? + !! isIsotropic -> is the source isotropic? + !! + !! Interface: + !! init -> initialise point source + !! sampleType -> set particle type + !! samplePosition -> set particle position + !! sampleEnergy -> set particle energy + !! sampleEnergyAngle -> sample particle angle + !! kill -> terminate source + !! + !! Sample Dictionary Input: + !! source { + !! type surfaceSource; + !! shape circle ! circle or square; + !! size 5; ! radius(circle) or side length(square) + !! axis x; ! axis normal to shape + !! pos 0; ! distance along axis to place plane + !! T 1; ! temperature of source boundary + !! nParticles 100; ! Number of particles emitted per time step, for now has to be the same as IMC source if used in IMC calculation + !! particle photon; + !! #dir 1; # ! Positive or negative to indicate direction along axis + !! deltat 1; ! Just until properly implemented + !! } + !! + type, public,extends(configSource) :: surfaceSource + private + real(defReal),dimension(3) :: r = ZERO + real(defReal) :: dir = ZERO + real(defReal) :: surfSize = ZERO + real(defReal) :: area = ZERO + integer(shortInt) :: particleType = P_PHOTON + logical(defBool) :: isMG = .true. + logical(defBool) :: isIsotropic = .false. + integer(shortInt) :: planeShape = 0 ! 0 => square, 1 => circle + integer(shortInt) :: axis = 1 ! 1 => x, 2 => y, 3 => z + real(defReal) :: T = ZERO + integer(shortInt) :: nParticles = ZERO + real(defReal) :: deltaT = ZERO + contains + procedure :: init + procedure :: sampleType + procedure :: samplePosition + procedure :: sampleEnergy + procedure :: sampleEnergyAngle + procedure :: kill + end type surfaceSource + +contains + + !! + !! Initialise from dictionary + !! + !! See source_inter for details + !! + !! Errors: + !! - error if an unrecognised particle type is provided + !! - error if source is not inside geometry + !! - error if either direction or position have more than 3 components + !! - error if both CE and MG is specified + !! - error if neither energy type is specified + !! + subroutine init(self, dict, geom) + class(surfaceSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + character(30) :: type, tempName + integer(shortInt) :: matIdx, uniqueID + logical(defBool) :: isCE, isMG + real(defReal) :: temp !,dimension(:),allocatable :: temp + character(100), parameter :: Here = 'init (surfaceSource_class.f90)' + + ! Provide geometry info to source + self % geom => geom + + ! Identify which particle is used in the source + ! Presently limited to neutron and photon + call dict % getOrDefault(type, 'particle' ,'photon') + select case(type) + case('neutron') + self % particleType = P_NEUTRON + + case('photon') + self % particleType = P_PHOTON + + case default + call fatalError(Here, 'Unrecognised particle type') + + end select + + ! Get position of surface along axis + call dict % get(temp, 'pos') + + ! Get axis and assign axis position + call dict % getOrDefault(tempName, 'axis', 'x') + select case(tempName) + case('x') + self % r(1) = temp + self % axis = 1 + case('y') + self % r(2) = temp + self % axis = 2 + case('z') + self % r(3) = temp + self % axis = 3 + case default + call fatalError(Here, 'Unrecognised axis, may onlt be x, y or z') + end select + + ! Get size of boundary surface + call dict % get(self % surfSize, 'size') + + ! Get shape and area of boundary surface + call dict % get(tempName, 'shape') + if (tempName == 'square') then + self % planeShape = 0 + self % area = self % surfSize**2 + else if (tempName == 'circle') then + self % planeShape = 1 + self % area = pi * self % surfSize**2 + else + call fatalError(Here, 'Shape must be "square" or "circle"') + end if + + ! Determine if dir is positive or negative along given axis + ! If equal to 0, emit from both sides + self % isIsotropic = .not. dict % isPresent('dir') + if (.not. self % isIsotropic) then + + call dict % get(temp, 'dir') + + if (temp == 0) then + self % dir = 0 + else + ! Set equal to +1 or -1 + self % dir = temp/abs(temp) + end if + + end if + + call dict % get(self % T, 'T') + call dict % get(self % nParticles, 'nParticles') + call dict % get(self % deltat, 'deltat') + + end subroutine init + + !! + !! Provide particle type + !! + !! See configSource_inter for details. + !! + subroutine sampleType(self, p, rand) + class(surfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + + p % type = self % particleType + + end subroutine sampleType + + !! + !! Provide particle position + !! + !! See configSource_inter for details. + !! + subroutine samplePosition(self, p, rand) + class(surfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal), dimension(3) :: prevPos + real(defReal) :: r1, r2, rad, theta + + if ( self % planeShape == 0 ) then ! Square + + prevPos = self % r + + ! Set new x, y and z coords + self % r(1) = rand % get() * self % surfSize/2 + self % r(2) = rand % get() * self % surfSize/2 + self % r(3) = rand % get() * self % surfSize/2 + ! Leave position along normal axis unchanged + self % r(self % axis) = prevPos(self % axis) + + else ! Circle + rad = rand % get() * self % surfSize + theta = rand % get() * 2 * pi + + r1 = rad * cos(theta) + r2 = rad * sin(theta) + + if(self % axis == 1) then ! Set y and z + self % r(2) = r1 + self % r(3) = r2 + else if(self % axis == 2) then ! Set x and z + self % r(1) = r1 + self % r(3) = r2 + else ! Set x and y + self % r(1) = r1 + self % r(2) = r2 + end if + + end if + + p % r = self % r + + end subroutine samplePosition + + !! + !! Provide angle or sample if isotropic + !! + !! See configSource_inter for details. + !! + !! Only isotropic/fixed direction. Does not sample energy. + !! + subroutine sampleEnergyAngle(self, p, rand) + class(surfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: r, phi, theta + + r = rand % get() + phi = TWO_PI * r + r = rand % get() + theta = acos(1 - TWO * r) + p % dir = [cos(phi) * sin(theta), sin(phi) * sin(theta), cos(theta)] + + ! If dir not equal to zero, adjust so that particles are travelling in correct direction + if (self % dir /= 0) then + p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir + end if + + end subroutine sampleEnergyAngle + + !! + !! Provide particle energy + !! + !! See configSource_inter for details. + !! + subroutine sampleEnergy(self, p, rand) + class(surfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: num + + num = radiationConstant * lightSpeed * self % deltat * self % T**4 * self % area + p % wgt = num / (4 * self % nParticles) + + ! If dir = 0 then emit in both directions => double total energy + if (self % dir == 0) p % wgt = 2*p % wgt + + p % isMG = .true. + p % G = 1 + + end subroutine sampleEnergy + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(surfaceSource), intent(inout) :: self + + ! Kill superclass + call kill_super(self) + + ! Kill local components + self % r = ZERO + self % dir = ZERO + self % particleType = P_PHOTON + self % isMG = .true. + self % isIsotropic = .false. + + end subroutine kill + +end module surfaceSource_class From 8987cc208bf045e27fcd52013bcc7430b81e64ef Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 8 Jul 2022 15:17:48 +0100 Subject: [PATCH 103/373] Cleaned up some code, changed a few bits to make more sense --- NuclearData/IMCMaterial_inter.f90 | 29 +++-- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 102 +++++++++++------- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 27 ++++- PhysicsPackages/IMCPhysicsPackage_class.f90 | 44 ++++++-- 4 files changed, 144 insertions(+), 58 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 28ad1c155..fbfa7eecb 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -2,6 +2,7 @@ module IMCMaterial_inter use numPrecision use particle_class, only : particle + use RNG_class, only : RNG ! Nuclear Data Interfaces use materialHandle_inter, only : materialHandle @@ -34,6 +35,8 @@ module IMCMaterial_inter procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck procedure(initProps), deferred :: initProps + procedure(isBlackBody), deferred :: isBlackBody + procedure(getTemp), deferred :: getTemp end type IMCMaterial abstract interface @@ -62,18 +65,20 @@ end subroutine getMacroXSs_byP !! Args: !! None !! - subroutine updateMat(self, tallyEnergy) - import :: IMCMaterial, defReal - class(IMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: tallyEnergy + subroutine updateMat(self, tallyEnergy, printUpdate) + import :: IMCMaterial, defReal, defBool + class(IMCMaterial), intent(inout) :: self + real(defReal), intent(in) :: tallyEnergy + logical(defBool), intent(in), optional :: printUpdate end subroutine updateMat !! !! Return the equilibrium radiation energy density, U_r !! function getEmittedRad(self) result(emittedRad) - import :: IMCMaterial, defReal + import :: IMCMaterial, defReal, RNG class(IMCMaterial), intent(inout) :: self + !class(RNG), intent(inout) :: rand real(defReal) :: emittedRad end function getEmittedRad @@ -83,7 +88,7 @@ end function getEmittedRad function getFleck(self) result(fleck) import :: IMCMaterial, defReal class(IMCMaterial), intent(in) :: self - real(defReal) :: fleck + real(defReal) :: fleck end function getFleck !! @@ -101,6 +106,18 @@ subroutine initProps(self, deltaT, T, V) real(defReal), intent(in) :: deltaT, T, V end subroutine initProps + function isBlackBody(self) result(bool) + import :: IMCMaterial, defReal, defBool + class(IMCMaterial), intent(inout) :: self + logical(defBool) :: bool + end function isBlackBody + + function getTemp(self) result(temp) + import :: IMCMaterial, defReal + class(IMCMaterial), intent(inout) :: self + real(defReal) :: temp + end function getTemp + end interface contains diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 3f79c778c..655048c84 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -66,7 +66,7 @@ module baseMgIMCMaterial_class !! type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data - real(defReal),dimension(:), allocatable :: cv, updateEqn + real(defReal),dimension(:), allocatable :: cv, updateEqn, sigmaEqn class(multiScatterMG), allocatable :: scatter real(defReal) :: T, fleck, deltaT, sigmaP, matEnergy, volume @@ -83,6 +83,8 @@ module baseMgIMCMaterial_class procedure :: getEmittedRad procedure :: getFleck procedure :: initProps + procedure :: isBlackBody + procedure :: getTemp end type baseMgIMCMaterial @@ -176,7 +178,7 @@ subroutine init(self, dict, scatterKey) class(dictionary),target, intent(in) :: dict character(nameLen), intent(in) :: scatterKey integer(shortInt) :: nG, N, i - real(defReal), dimension(:), allocatable :: temp, temp2 + real(defReal), dimension(:), allocatable :: temp type(dictDeck) :: deck character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' @@ -210,14 +212,6 @@ subroutine init(self, dict, scatterKey) allocate(self % data(N, nG)) - ! Load cross sections - Loads 'sigmaP' in place of 'capture' so that existing functions to get cross section instead get sigmaP - call dict % get(temp, 'sigmaP') - if(size(temp) /= nG) then - call fatalError(Here,'Capture XSs have wong size. Must be: ' & - // numToChar(nG)//' is '//numToChar(size(temp))) - end if - self % data(CAPTURE_XS,:) = temp - ! Extract values of scattering XS if(size(self % scatter % scatterXSs) /= nG) then call fatalError(Here, 'Somthing went wrong. Inconsistant # of groups in material and reaction& @@ -230,13 +224,9 @@ subroutine init(self, dict, scatterKey) self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) end do - ! Set initial temperature and energy - !self % T = 298 - !self % matEnergy = 1000 - - ! Set Planck opacity - call dict % get(temp2, 'sigmaP') - self % sigmaP = temp2(1) + ! Read Planck opacity equation + call dict % get(temp, 'sigmaP') + self % sigmaEqn = temp ! Read heat capacity equation call dict % get(temp, 'cv') @@ -323,29 +313,31 @@ end function baseMgIMCMaterial_CptrCast !! Args: !! delta T [in] -> Time step size !! - subroutine updateMat(self, tallyEnergy) + subroutine updateMat(self, tallyEnergy, printUpdate) class(baseMgIMCMaterial),intent(inout) :: self real(defReal), intent(in) :: tallyEnergy - real(defReal) :: energy, const + logical(defBool), intent(in), optional :: printUpdate + real(defReal) :: energyDens, prev character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" - ! Print energies - print *, "T_old =", self % T - print *, "matEnergy at start of timestep =", self % matEnergy - print *, "emittedRad =", self % getEmittedRad() - print *, "tallyEnergy =", tallyEnergy + ! Print current properties + if (present(printUpdate)) then + if (printUpdate .eqv. .True.) then + print *, " T_old = ", self % T + print *, " matEnergy at start of timestep =", self % matEnergy + print *, " emittedRad = ", self % getEmittedRad() + print *, " tallyEnergy = ", tallyEnergy + end if + end if ! Store previous material internal energy density, U_{m,n}/V - const = self % matEnergy / self % volume + prev = self % matEnergy / self % volume ! Update material internal energy self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy - ! Print energy - print *, "matEnergy at end of timestep =", self % matEnergy - ! New material internal energy density, U_{m,n+1}/V - energy = self % matEnergy / self % volume + energyDens = self % matEnergy / self % volume !! Integration of dUm/dT = cv gives equation to be solved for T_{n+1}: !! @@ -356,8 +348,24 @@ subroutine updateMat(self, tallyEnergy) !const = energy - const + poly_eval(self % updateEqn, self % T) ! Update material temperature by solving f(T_{n+1}) = const - self % T = poly_solve(self % updateEqn, self % cv, self % T, energy) !! Using energy and const give save result, const not necessary - print *, 'T_new =', self % T + if ( energyDens /= prev ) then + self % T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) !! Using energy and const give save result, const not necessary + end if + + ! Print updated properties + if (present(printUpdate)) then + if(printUpdate .eqv. .True.) then + print *, " matEnergy at end of timestep = ", self % matEnergy + print *, " T_new = ", self % T + end if + end if + + + ! Update sigmaP + self % sigmaP = poly_eval(self % sigmaEqn, self % T) + ! Also need these lines because cross section functions still use this instead of sigmaP + self % data(CAPTURE_XS,:) = self % sigmaP + self % data(TOTAL_XS,:) = self % sigmaP if( self % T < 0 ) then call fatalError(Here, "Temperature is negative") @@ -365,11 +373,11 @@ subroutine updateMat(self, tallyEnergy) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT) ! Incomplete, need to add alpha - !print *, 'fleck =', self % fleck + !print *, 'fleck_new =', self % fleck !print *, 'a =', radiationConstant !print *, 'c =', lightSpeed !print *, 'V =', self % volume - !print *, 'sigmaP=', self % sigmaP + !print *, 'sigmaP_new =', self % sigmaP end subroutine updateMat @@ -414,15 +422,35 @@ subroutine initProps(self, deltaT, T, V) real(defReal), intent(in) :: deltaT, T, V character(100), parameter :: Here = 'initProps (baseMgIMCMaterial_class.f90)' - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha - self % deltaT = deltaT self % volume = V - if(self % volume <= 0) call fatalError(Here, 'Invalid material volume given') self % T = T - self % matEnergy = poly_eval(self % updateEqn, self % T) + self % matEnergy = poly_eval(self % updateEqn, self % T) * self % volume + + self % sigmaP = poly_eval(self % sigmaEqn, self % T) + self % data(CAPTURE_XS,:) = self % sigmaP + self % data(TOTAL_XS,:) = self % sigmaP + + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha + self % deltaT = deltaT end subroutine initProps + function isBlackBody(self) result(bool) + class(baseMgIMCMaterial), intent(inout) :: self + logical(defBool) :: bool + + ! Incomplete + + end function isBlackBody + + function getTemp(self) result(temp) + class(baseMgIMCMaterial), intent(inout) :: self + real(defReal) :: temp + + temp = self % T + + end function getTemp + end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 13d13ac44..7aacbd352 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -47,6 +47,8 @@ module mgIMCMaterial_inter procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck procedure(initProps), deferred :: initProps + procedure(isBlackBody), deferred :: isBlackBody + procedure(getTemp), deferred :: getTemp end type mgIMCMaterial @@ -97,18 +99,20 @@ end function getTotalXS !! Args: !! None !! - subroutine updateMat(self, tallyEnergy) - import :: mgIMCMaterial, defReal - class(mgIMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: tallyEnergy + subroutine updateMat(self, tallyEnergy, printUpdate) + import :: mgIMCMaterial, defReal, defBool + class(mgIMCMaterial), intent(inout) :: self + real(defReal), intent(in) :: tallyEnergy + logical(defBool), intent(in), optional :: printUpdate end subroutine updateMat !! !! Return the equilibrium radiation energy density, U_r !! function getEmittedRad(self) result(emittedRad) - import :: mgIMCMaterial, defReal + import :: mgIMCMaterial, defReal, RNG class(mgIMCMaterial), intent(inout) :: self + !class(RNG), intent(inout) :: rand real(defReal) :: emittedRad end function getEmittedRad @@ -136,6 +140,19 @@ subroutine initProps(self, deltaT, T, V) real(defReal), intent(in) :: deltaT, T, V end subroutine initProps + function isBlackBody(self) result(bool) + import :: mgIMCMaterial, defReal, defBool + class(mgIMCMaterial), intent(inout) :: self + logical(defBool) :: bool + end function isBlackBody + + function getTemp(self) result(temp) + import :: mgIMCMaterial, defReal + class(mgIMCMaterial), intent(inout) :: self + real(defReal) :: temp + end function getTemp + + end interface diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 17a6b2e05..62d25cd3e 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -133,12 +133,22 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) integer(shortInt), intent(in) :: N_cycles integer(shortInt) :: i, j, N type(particle) :: p - real(defReal) :: elapsed_T, end_T, T_toEnd + real(defReal) :: elapsed_T, end_T, T_toEnd, sumT real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat + logical(defBool) :: printUpdates character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes + ! Set whether or not to print energy and temperature updates of each material + ! Printed from updateMat (baseMgIMCMaterial_class.f90), 7 lines of text + ! per material so recommend to only print when low number of materials + if (self % nMat <= 5) then + printUpdates = .True. + else + printUpdates = .False. + end if + N = self % pop ! Attach nuclear data and RNG to particle @@ -159,9 +169,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) allocate(tallyEnergy(self % nMat)) ! Generate initial source distribution - if( self % sourceGiven ) then - call self % inputSource % generate(self % nextCycle, self % imcSourceN, p % pRNG) - end if + !if( self % sourceGiven ) then + ! call self % inputSource % generate(self % nextCycle, self % imcSourceN, p % pRNG) + !end if do i=1,N_cycles @@ -169,8 +179,18 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) self % thisCycle = self % nextCycle call self % nextCycle % cleanPop() - ! Generate IMC source - call self % IMCSource % appendIMC(self % thisCycle, self % imcSourceN, p % pRNG) + + ! Check that there are regions of non-zero temperature by summing mat temperatures + sumT = 0 + do j=1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + sumT = sumT + mat % getTemp() + end do + + ! Generate IMC source, only if there are regions with non-zero temperature + if(sumT > 0) then + call self % IMCSource % appendIMC(self % thisCycle, self % imcSourceN, p % pRNG) + end if ! Generate from input source if( self % sourceGiven ) then @@ -239,7 +259,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) print * print * print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) - print *, 'Pop: ', numToChar(self % pop) + print *, 'Pop: ', numToChar(self % nextCycle % getSize()) print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) print *, 'End time: ', trim(secToChar(end_T)) print *, 'Time to end: ', trim(secToChar(T_toEnd)) @@ -260,15 +280,19 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Update material properties do j = 1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - print * - print *, "Material update: ", mm_matName(j) - call mat % updateMat(tallyEnergy(j)) + if (printUpdates .eqv. .True.) then + print * + print *, "Material update: ", mm_matName(j) + end if + call mat % updateMat(tallyEnergy(j), printUpdates) end do print * ! Reset tally for next cycle call tallyAtch % reset('imcWeight') + print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_cycles) + end do end subroutine cycles From bec7b2c5a7f29fe94da35b1a6257400821957e78 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 8 Jul 2022 15:41:56 +0100 Subject: [PATCH 104/373] Cleaned up Input File folder --- IMCTest | 88 ----- .../IMC/{ => MarshakWave}/dataFiles/imcData | 9 +- InputFiles/IMC/MarshakWave/marshakWave128 | 364 ++++++++++++++++++ InputFiles/IMC/MarshakWave/marshakWave16 | 122 ++++++ InputFiles/IMC/MarshakWave/marshakWave32 | 156 ++++++++ InputFiles/IMC/MarshakWave/marshakWave64 | 226 +++++++++++ InputFiles/IMC/MarshakWave/marshakWave8 | 106 +++++ InputFiles/IMC/SimpleCases/3region | 103 +++++ InputFiles/IMC/SimpleCases/dataFiles/imcData | 27 ++ InputFiles/IMC/SimpleCases/dataFiles/imcData2 | 27 ++ .../IMC/{ => SimpleCases}/infiniteRegion | 22 +- InputFiles/IMC/{ => SimpleCases}/sphereInCube | 4 +- .../IMC/{ => SimpleCases}/touchingCubes | 10 +- InputFiles/IMC/bbSurface | 85 ---- InputFiles/IMC/output.m | 7 - InputFiles/XS/imcData | 1 + 16 files changed, 1149 insertions(+), 208 deletions(-) delete mode 100644 IMCTest rename InputFiles/IMC/{ => MarshakWave}/dataFiles/imcData (90%) create mode 100644 InputFiles/IMC/MarshakWave/marshakWave128 create mode 100644 InputFiles/IMC/MarshakWave/marshakWave16 create mode 100644 InputFiles/IMC/MarshakWave/marshakWave32 create mode 100644 InputFiles/IMC/MarshakWave/marshakWave64 create mode 100644 InputFiles/IMC/MarshakWave/marshakWave8 create mode 100644 InputFiles/IMC/SimpleCases/3region create mode 100644 InputFiles/IMC/SimpleCases/dataFiles/imcData create mode 100644 InputFiles/IMC/SimpleCases/dataFiles/imcData2 rename InputFiles/IMC/{ => SimpleCases}/infiniteRegion (85%) rename InputFiles/IMC/{ => SimpleCases}/sphereInCube (96%) rename InputFiles/IMC/{ => SimpleCases}/touchingCubes (91%) delete mode 100644 InputFiles/IMC/bbSurface delete mode 100644 InputFiles/IMC/output.m diff --git a/IMCTest b/IMCTest deleted file mode 100644 index b1896eeb4..000000000 --- a/IMCTest +++ /dev/null @@ -1,88 +0,0 @@ -//type fixedSourcePhysicsPackage; -//type eigenPhysicsPackage; - -type IMCPhysicsPackage; - -pop 20000; -cycles 100; -timeStepSize 0.1; - -XSdata mg; -dataType mg; - - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorIMC; - } - - -//source { - // type pointSource; - // r (0 0 0); - // particle photon; - // G 1; -//} - -imcSource { - type imcSource; - nParticles 10000; - } - -inactiveTally {} - -activeTally {} - -tally { - } - -geometry { - type geometryStd; - boundary (1 1 1 1 1 1); - graph {type shrunk;} - - surfaces - { - inner { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 1; } - outer { id 2; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1 1 1); } - //outer { id 2; type sphere; origin ( 0.0 0.0 0.0); radius 1.26; } - } - cells - { - inner_cell { id 1; type simpleCell; surfaces (-1); filltype mat; material mat1; } - outer_cell { id 2; type simpleCell; surfaces ( 1); filltype mat; material mat2; } - } - universes - { - root { id 1; type rootUniverse; border 2; fill u<2>; } - cell { id 2; type cellUniverse; cells ( 1 2 ); } - } -} - -nuclearData { - - handles { - //ce { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} - mg { type baseMgIMCDatabase; PN P0;} - } - - - materials { - - mat1 { - temp 1; - composition {} - xsFile ./InputFiles/XS/imcData; - volume 4.18879; - } - mat2 { temp 5; composition {} xsFile ./InputFiles/XS/imcData; volume 3.81121; } - -} - -} - - - diff --git a/InputFiles/IMC/dataFiles/imcData b/InputFiles/IMC/MarshakWave/dataFiles/imcData similarity index 90% rename from InputFiles/IMC/dataFiles/imcData rename to InputFiles/IMC/MarshakWave/dataFiles/imcData index e7c63a1a9..8cdb4ac41 100644 --- a/InputFiles/IMC/dataFiles/imcData +++ b/InputFiles/IMC/MarshakWave/dataFiles/imcData @@ -5,7 +5,7 @@ numberOfGroups 1; -capture (1.0); +capture (0.0); scatteringMultiplicity ( 0.0 @@ -16,11 +16,12 @@ P0 ( ); sigmaP ( - 1.0 + 1 + 0 ); cv ( - 4.0 - 3.0 + 4 + 3 ); diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 new file mode 100644 index 000000000..14d8f3be3 --- /dev/null +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -0,0 +1,364 @@ + +type IMCPhysicsPackage; + +pop 200000; +cycles 10000; +timeStepSize 0.05; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + +source { + type surfaceSource; + shape square; + size 1; + axis x; + pos -2; + T 1; + nParticles 5000; + dir 1; + deltat 0.05; + particle photon; +} + +imcSource { + type imcSource; + nParticles 5000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (0 0 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } + } + + cells + { + } + universes + { + root { id 1000; type rootUniverse; border 1; fill u<2000>; } + + lat { id 2000; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (0.03125 1.0 1.0); + shape (128 1 1); + padMat void; + map ( 1 2 3 4 5 6 7 8 9 10 + 11 12 13 14 15 16 17 18 19 20 + 21 22 23 24 25 26 27 28 29 30 + 31 32 33 34 35 36 37 38 39 40 + 41 42 43 44 45 46 47 48 49 50 + 51 52 53 54 55 56 57 58 59 60 + 61 62 63 64 65 66 67 68 69 70 + 71 72 73 74 75 76 77 78 79 80 + 81 82 83 84 85 86 87 88 89 90 + 91 92 93 94 95 96 97 98 99 100 + 101 102 103 104 105 106 107 108 109 110 + 111 112 113 114 115 116 117 118 119 120 + 121 122 123 124 125 126 127 128); + } + + zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } + zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } + zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } + zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } + zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } + zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } + zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } + zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } + zone9 { id 9; type pinUniverse; radii (0.0); fills (mat9); } + zone10 { id 10; type pinUniverse; radii (0.0); fills (mat10); } + zone11 { id 11; type pinUniverse; radii (0.0); fills (mat11); } + zone12 { id 12; type pinUniverse; radii (0.0); fills (mat12); } + zone13 { id 13; type pinUniverse; radii (0.0); fills (mat13); } + zone14 { id 14; type pinUniverse; radii (0.0); fills (mat14); } + zone15 { id 15; type pinUniverse; radii (0.0); fills (mat15); } + zone16 { id 16; type pinUniverse; radii (0.0); fills (mat16); } + zone17 { id 17; type pinUniverse; radii (0.0); fills (mat17); } + zone18 { id 18; type pinUniverse; radii (0.0); fills (mat18); } + zone19 { id 19; type pinUniverse; radii (0.0); fills (mat19); } + zone20 { id 20; type pinUniverse; radii (0.0); fills (mat20); } + zone21 { id 21; type pinUniverse; radii (0.0); fills (mat21); } + zone22 { id 22; type pinUniverse; radii (0.0); fills (mat22); } + zone23 { id 23; type pinUniverse; radii (0.0); fills (mat23); } + zone24 { id 24; type pinUniverse; radii (0.0); fills (mat24); } + zone25 { id 25; type pinUniverse; radii (0.0); fills (mat25); } + zone26 { id 26; type pinUniverse; radii (0.0); fills (mat26); } + zone27 { id 27; type pinUniverse; radii (0.0); fills (mat27); } + zone28 { id 28; type pinUniverse; radii (0.0); fills (mat28); } + zone29 { id 29; type pinUniverse; radii (0.0); fills (mat29); } + zone30 { id 30; type pinUniverse; radii (0.0); fills (mat30); } + zone31 { id 31; type pinUniverse; radii (0.0); fills (mat31); } + zone32 { id 32; type pinUniverse; radii (0.0); fills (mat32); } + + zone33 { id 33; type pinUniverse; radii (0.0); fills (mat33); } + zone34 { id 34; type pinUniverse; radii (0.0); fills (mat34); } + zone35 { id 35; type pinUniverse; radii (0.0); fills (mat35); } + zone36 { id 36; type pinUniverse; radii (0.0); fills (mat36); } + zone37 { id 37; type pinUniverse; radii (0.0); fills (mat37); } + zone38 { id 38; type pinUniverse; radii (0.0); fills (mat38); } + zone39 { id 39; type pinUniverse; radii (0.0); fills (mat39); } + zone40 { id 40; type pinUniverse; radii (0.0); fills (mat40); } + zone41 { id 41; type pinUniverse; radii (0.0); fills (mat41); } + zone42 { id 42; type pinUniverse; radii (0.0); fills (mat42); } + zone43 { id 43; type pinUniverse; radii (0.0); fills (mat43); } + zone44 { id 44; type pinUniverse; radii (0.0); fills (mat44); } + zone45 { id 45; type pinUniverse; radii (0.0); fills (mat45); } + zone46 { id 46; type pinUniverse; radii (0.0); fills (mat46); } + zone47 { id 47; type pinUniverse; radii (0.0); fills (mat47); } + zone48 { id 48; type pinUniverse; radii (0.0); fills (mat48); } + zone49 { id 49; type pinUniverse; radii (0.0); fills (mat49); } + zone50 { id 50; type pinUniverse; radii (0.0); fills (mat50); } + zone51 { id 51; type pinUniverse; radii (0.0); fills (mat51); } + zone52 { id 52; type pinUniverse; radii (0.0); fills (mat52); } + zone53 { id 53; type pinUniverse; radii (0.0); fills (mat53); } + zone54 { id 54; type pinUniverse; radii (0.0); fills (mat54); } + zone55 { id 55; type pinUniverse; radii (0.0); fills (mat55); } + zone56 { id 56; type pinUniverse; radii (0.0); fills (mat56); } + zone57 { id 57; type pinUniverse; radii (0.0); fills (mat57); } + zone58 { id 58; type pinUniverse; radii (0.0); fills (mat58); } + zone59 { id 59; type pinUniverse; radii (0.0); fills (mat59); } + zone60 { id 60; type pinUniverse; radii (0.0); fills (mat60); } + zone61 { id 61; type pinUniverse; radii (0.0); fills (mat61); } + zone62 { id 62; type pinUniverse; radii (0.0); fills (mat62); } + zone63 { id 63; type pinUniverse; radii (0.0); fills (mat63); } + zone64 { id 64; type pinUniverse; radii (0.0); fills (mat64); } + + zone65 { id 65; type pinUniverse; radii (0.0); fills (mat65); } + zone66 { id 66; type pinUniverse; radii (0.0); fills (mat66); } + zone67 { id 67; type pinUniverse; radii (0.0); fills (mat67); } + zone68 { id 68; type pinUniverse; radii (0.0); fills (mat68); } + zone69 { id 69; type pinUniverse; radii (0.0); fills (mat69); } + zone70 { id 70; type pinUniverse; radii (0.0); fills (mat70); } + zone71 { id 71; type pinUniverse; radii (0.0); fills (mat71); } + zone72 { id 72; type pinUniverse; radii (0.0); fills (mat72); } + zone73 { id 73; type pinUniverse; radii (0.0); fills (mat73); } + zone74 { id 74; type pinUniverse; radii (0.0); fills (mat74); } + zone75 { id 75; type pinUniverse; radii (0.0); fills (mat75); } + zone76 { id 76; type pinUniverse; radii (0.0); fills (mat76); } + zone77 { id 77; type pinUniverse; radii (0.0); fills (mat77); } + zone78 { id 78; type pinUniverse; radii (0.0); fills (mat78); } + zone79 { id 79; type pinUniverse; radii (0.0); fills (mat79); } + zone80 { id 80; type pinUniverse; radii (0.0); fills (mat80); } + zone81 { id 81; type pinUniverse; radii (0.0); fills (mat81); } + zone82 { id 82; type pinUniverse; radii (0.0); fills (mat82); } + zone83 { id 83; type pinUniverse; radii (0.0); fills (mat83); } + zone84 { id 84; type pinUniverse; radii (0.0); fills (mat84); } + zone85 { id 85; type pinUniverse; radii (0.0); fills (mat85); } + zone86 { id 86; type pinUniverse; radii (0.0); fills (mat86); } + zone87 { id 87; type pinUniverse; radii (0.0); fills (mat87); } + zone88 { id 88; type pinUniverse; radii (0.0); fills (mat88); } + zone89 { id 89; type pinUniverse; radii (0.0); fills (mat89); } + zone90 { id 90; type pinUniverse; radii (0.0); fills (mat90); } + zone91 { id 91; type pinUniverse; radii (0.0); fills (mat91); } + zone92 { id 92; type pinUniverse; radii (0.0); fills (mat92); } + zone93 { id 93; type pinUniverse; radii (0.0); fills (mat93); } + zone94 { id 94; type pinUniverse; radii (0.0); fills (mat94); } + zone95 { id 95; type pinUniverse; radii (0.0); fills (mat95); } + zone96 { id 96; type pinUniverse; radii (0.0); fills (mat96); } + + zone97 { id 97; type pinUniverse; radii (0.0); fills (mat97); } + zone98 { id 98; type pinUniverse; radii (0.0); fills (mat98); } + zone99 { id 99; type pinUniverse; radii (0.0); fills (mat99); } + zone100 { id 100; type pinUniverse; radii (0.0); fills (mat100); } + zone101 { id 101; type pinUniverse; radii (0.0); fills (mat101); } + zone102 { id 102; type pinUniverse; radii (0.0); fills (mat102); } + zone103 { id 103; type pinUniverse; radii (0.0); fills (mat103); } + zone104 { id 104; type pinUniverse; radii (0.0); fills (mat104); } + zone105 { id 105; type pinUniverse; radii (0.0); fills (mat105); } + zone106 { id 106; type pinUniverse; radii (0.0); fills (mat106); } + zone107 { id 107; type pinUniverse; radii (0.0); fills (mat107); } + zone108 { id 108; type pinUniverse; radii (0.0); fills (mat108); } + zone109 { id 109; type pinUniverse; radii (0.0); fills (mat109); } + zone110 { id 110; type pinUniverse; radii (0.0); fills (mat110); } + zone111 { id 111; type pinUniverse; radii (0.0); fills (mat111); } + zone112 { id 112; type pinUniverse; radii (0.0); fills (mat112); } + zone113 { id 113; type pinUniverse; radii (0.0); fills (mat113); } + zone114 { id 114; type pinUniverse; radii (0.0); fills (mat114); } + zone115 { id 115; type pinUniverse; radii (0.0); fills (mat115); } + zone116 { id 116; type pinUniverse; radii (0.0); fills (mat116); } + zone117 { id 117; type pinUniverse; radii (0.0); fills (mat117); } + zone118 { id 118; type pinUniverse; radii (0.0); fills (mat118); } + zone119 { id 119; type pinUniverse; radii (0.0); fills (mat119); } + zone120 { id 120; type pinUniverse; radii (0.0); fills (mat120); } + zone121 { id 121; type pinUniverse; radii (0.0); fills (mat121); } + zone122 { id 122; type pinUniverse; radii (0.0); fills (mat122); } + zone123 { id 123; type pinUniverse; radii (0.0); fills (mat123); } + zone124 { id 124; type pinUniverse; radii (0.0); fills (mat124); } + zone125 { id 125; type pinUniverse; radii (0.0); fills (mat125); } + zone126 { id 126; type pinUniverse; radii (0.0); fills (mat126); } + zone127 { id 127; type pinUniverse; radii (0.0); fills (mat127); } + zone128 { id 128; type pinUniverse; radii (0.0); fills (mat128); } + + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat17 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat18 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat19 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat20 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat21 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat22 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat23 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat24 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat25 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat26 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat27 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat28 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat29 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat31 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat32 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + + mat33 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat34 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat35 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat36 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat37 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat38 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat39 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat40 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat41 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat42 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat43 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat44 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat45 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat46 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat47 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat48 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat49 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat50 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat51 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat52 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat53 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat54 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat55 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat56 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat57 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat58 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat59 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat60 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat61 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat62 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat63 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat64 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + + mat65 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat66 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat67 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat68 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat69 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat70 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat71 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat72 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat73 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat74 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat75 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat76 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat77 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat78 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat79 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat80 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat81 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat82 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat83 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat84 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat85 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat86 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat87 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat88 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat89 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat90 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat91 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat92 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat93 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat94 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat95 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat96 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + + mat97 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat98 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat99 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat100 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat101 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat102 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat103 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat104 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat105 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat106 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat107 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat108 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat109 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat110 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat111 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat112 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat113 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat114 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat115 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat116 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat117 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat118 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat119 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat120 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat121 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat122 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat123 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat124 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat125 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat126 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat127 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat128 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + + } + +} + + + diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 new file mode 100644 index 000000000..5f1b1da0f --- /dev/null +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -0,0 +1,122 @@ + +type IMCPhysicsPackage; + +pop 200000; +cycles 10000; +timeStepSize 0.05; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + +source { + type surfaceSource; + shape square; + size 1; + axis x; + pos -2; + T 1; + nParticles 5000; + dir 1; + deltat 0.05; + particle photon; +} + +imcSource { + type imcSource; + nParticles 5000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (0 0 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } + } + + cells + { + } + universes + { + root { id 100; type rootUniverse; border 1; fill u<200>; } + + lat { id 200; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (0.25 1.0 1.0); + shape (16 1 1); + padMat void; + map ( 1 2 3 4 5 6 7 8 9 10 + 11 12 13 14 15 16); + } + + zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } + zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } + zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } + zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } + zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } + zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } + zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } + zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } + zone9 { id 9; type pinUniverse; radii (0.0); fills (mat9); } + zone10 { id 10; type pinUniverse; radii (0.0); fills (mat10); } + zone11 { id 11; type pinUniverse; radii (0.0); fills (mat11); } + zone12 { id 12; type pinUniverse; radii (0.0); fills (mat12); } + zone13 { id 13; type pinUniverse; radii (0.0); fills (mat13); } + zone14 { id 14; type pinUniverse; radii (0.0); fills (mat14); } + zone15 { id 15; type pinUniverse; radii (0.0); fills (mat15); } + zone16 { id 16; type pinUniverse; radii (0.0); fills (mat16); } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + + } + +} + + + diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 new file mode 100644 index 000000000..20652180a --- /dev/null +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -0,0 +1,156 @@ + +type IMCPhysicsPackage; + +pop 200000; +cycles 10000; +timeStepSize 0.05; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + +source { + type surfaceSource; + shape square; + size 1; + axis x; + pos -2; + T 1; + nParticles 5000; + dir 1; + deltat 0.05; + particle photon; +} + +imcSource { + type imcSource; + nParticles 5000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (0 0 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } + } + + cells + { + } + universes + { + root { id 100; type rootUniverse; border 1; fill u<200>; } + + lat { id 200; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (0.125 1.0 1.0); + shape (32 1 1); + padMat void; + map ( 1 2 3 4 5 6 7 8 9 10 + 11 12 13 14 15 16 17 18 19 20 + 21 22 23 24 25 26 27 28 29 30 + 31 32); + } + + zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } + zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } + zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } + zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } + zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } + zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } + zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } + zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } + zone9 { id 9; type pinUniverse; radii (0.0); fills (mat9); } + zone10 { id 10; type pinUniverse; radii (0.0); fills (mat10); } + zone11 { id 11; type pinUniverse; radii (0.0); fills (mat11); } + zone12 { id 12; type pinUniverse; radii (0.0); fills (mat12); } + zone13 { id 13; type pinUniverse; radii (0.0); fills (mat13); } + zone14 { id 14; type pinUniverse; radii (0.0); fills (mat14); } + zone15 { id 15; type pinUniverse; radii (0.0); fills (mat15); } + zone16 { id 16; type pinUniverse; radii (0.0); fills (mat16); } + zone17 { id 17; type pinUniverse; radii (0.0); fills (mat17); } + zone18 { id 18; type pinUniverse; radii (0.0); fills (mat18); } + zone19 { id 19; type pinUniverse; radii (0.0); fills (mat19); } + zone20 { id 20; type pinUniverse; radii (0.0); fills (mat20); } + zone21 { id 21; type pinUniverse; radii (0.0); fills (mat21); } + zone22 { id 22; type pinUniverse; radii (0.0); fills (mat22); } + zone23 { id 23; type pinUniverse; radii (0.0); fills (mat23); } + zone24 { id 24; type pinUniverse; radii (0.0); fills (mat24); } + zone25 { id 25; type pinUniverse; radii (0.0); fills (mat25); } + zone26 { id 26; type pinUniverse; radii (0.0); fills (mat26); } + zone27 { id 27; type pinUniverse; radii (0.0); fills (mat27); } + zone28 { id 28; type pinUniverse; radii (0.0); fills (mat28); } + zone29 { id 29; type pinUniverse; radii (0.0); fills (mat29); } + zone30 { id 30; type pinUniverse; radii (0.0); fills (mat30); } + zone31 { id 31; type pinUniverse; radii (0.0); fills (mat31); } + zone32 { id 32; type pinUniverse; radii (0.0); fills (mat32); } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat17 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat18 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat19 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat20 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat21 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat22 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat23 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat24 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat25 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat26 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat27 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat28 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat29 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat31 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat32 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + + } + +} + + + diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 new file mode 100644 index 000000000..520d65974 --- /dev/null +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -0,0 +1,226 @@ + +type IMCPhysicsPackage; + +pop 200000; +cycles 10000; +timeStepSize 0.05; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + +source { + type surfaceSource; + shape square; + size 1; + axis x; + pos -2; + T 1; + nParticles 5000; + dir 1; + deltat 0.05; + particle photon; +} + +imcSource { + type imcSource; + nParticles 5000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (0 0 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } + } + + cells + { + } + universes + { + root { id 100; type rootUniverse; border 1; fill u<200>; } + + lat { id 200; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (0.0625 1.0 1.0); + shape (64 1 1); + padMat void; + map ( 1 2 3 4 5 6 7 8 9 10 + 11 12 13 14 15 16 17 18 19 20 + 21 22 23 24 25 26 27 28 29 30 + 31 32 33 34 35 36 37 38 39 40 + 41 42 43 44 45 46 47 48 49 50 + 51 52 53 54 55 56 57 58 59 60 + 61 62 63 64); + } + + zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } + zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } + zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } + zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } + zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } + zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } + zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } + zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } + zone9 { id 9; type pinUniverse; radii (0.0); fills (mat9); } + zone10 { id 10; type pinUniverse; radii (0.0); fills (mat10); } + zone11 { id 11; type pinUniverse; radii (0.0); fills (mat11); } + zone12 { id 12; type pinUniverse; radii (0.0); fills (mat12); } + zone13 { id 13; type pinUniverse; radii (0.0); fills (mat13); } + zone14 { id 14; type pinUniverse; radii (0.0); fills (mat14); } + zone15 { id 15; type pinUniverse; radii (0.0); fills (mat15); } + zone16 { id 16; type pinUniverse; radii (0.0); fills (mat16); } + zone17 { id 17; type pinUniverse; radii (0.0); fills (mat17); } + zone18 { id 18; type pinUniverse; radii (0.0); fills (mat18); } + zone19 { id 19; type pinUniverse; radii (0.0); fills (mat19); } + zone20 { id 20; type pinUniverse; radii (0.0); fills (mat20); } + zone21 { id 21; type pinUniverse; radii (0.0); fills (mat21); } + zone22 { id 22; type pinUniverse; radii (0.0); fills (mat22); } + zone23 { id 23; type pinUniverse; radii (0.0); fills (mat23); } + zone24 { id 24; type pinUniverse; radii (0.0); fills (mat24); } + zone25 { id 25; type pinUniverse; radii (0.0); fills (mat25); } + zone26 { id 26; type pinUniverse; radii (0.0); fills (mat26); } + zone27 { id 27; type pinUniverse; radii (0.0); fills (mat27); } + zone28 { id 28; type pinUniverse; radii (0.0); fills (mat28); } + zone29 { id 29; type pinUniverse; radii (0.0); fills (mat29); } + zone30 { id 30; type pinUniverse; radii (0.0); fills (mat30); } + zone31 { id 31; type pinUniverse; radii (0.0); fills (mat31); } + zone32 { id 32; type pinUniverse; radii (0.0); fills (mat32); } + + zone33 { id 33; type pinUniverse; radii (0.0); fills (mat33); } + zone34 { id 34; type pinUniverse; radii (0.0); fills (mat34); } + zone35 { id 35; type pinUniverse; radii (0.0); fills (mat35); } + zone36 { id 36; type pinUniverse; radii (0.0); fills (mat36); } + zone37 { id 37; type pinUniverse; radii (0.0); fills (mat37); } + zone38 { id 38; type pinUniverse; radii (0.0); fills (mat38); } + zone39 { id 39; type pinUniverse; radii (0.0); fills (mat39); } + zone40 { id 40; type pinUniverse; radii (0.0); fills (mat40); } + zone41 { id 41; type pinUniverse; radii (0.0); fills (mat41); } + zone42 { id 42; type pinUniverse; radii (0.0); fills (mat42); } + zone43 { id 43; type pinUniverse; radii (0.0); fills (mat43); } + zone44 { id 44; type pinUniverse; radii (0.0); fills (mat44); } + zone45 { id 45; type pinUniverse; radii (0.0); fills (mat45); } + zone46 { id 46; type pinUniverse; radii (0.0); fills (mat46); } + zone47 { id 47; type pinUniverse; radii (0.0); fills (mat47); } + zone48 { id 48; type pinUniverse; radii (0.0); fills (mat48); } + zone49 { id 49; type pinUniverse; radii (0.0); fills (mat49); } + zone50 { id 50; type pinUniverse; radii (0.0); fills (mat50); } + zone51 { id 51; type pinUniverse; radii (0.0); fills (mat51); } + zone52 { id 52; type pinUniverse; radii (0.0); fills (mat52); } + zone53 { id 53; type pinUniverse; radii (0.0); fills (mat53); } + zone54 { id 54; type pinUniverse; radii (0.0); fills (mat54); } + zone55 { id 55; type pinUniverse; radii (0.0); fills (mat55); } + zone56 { id 56; type pinUniverse; radii (0.0); fills (mat56); } + zone57 { id 57; type pinUniverse; radii (0.0); fills (mat57); } + zone58 { id 58; type pinUniverse; radii (0.0); fills (mat58); } + zone59 { id 59; type pinUniverse; radii (0.0); fills (mat59); } + zone60 { id 60; type pinUniverse; radii (0.0); fills (mat60); } + zone61 { id 61; type pinUniverse; radii (0.0); fills (mat61); } + zone62 { id 62; type pinUniverse; radii (0.0); fills (mat62); } + zone63 { id 63; type pinUniverse; radii (0.0); fills (mat63); } + zone64 { id 64; type pinUniverse; radii (0.0); fills (mat64); } + + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat17 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat18 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat19 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat20 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat21 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat22 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat23 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat24 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat25 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat26 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat27 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat28 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat29 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat31 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat32 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + + mat33 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat34 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat35 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat36 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat37 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat38 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat39 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat40 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat41 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat42 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat43 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat44 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat45 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat46 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat47 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat48 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat49 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat50 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat51 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat52 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat53 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat54 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat55 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat56 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat57 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat58 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat59 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat60 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat61 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat62 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat63 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat64 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + + } + +} + + + diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 new file mode 100644 index 000000000..03189cf79 --- /dev/null +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -0,0 +1,106 @@ + +type IMCPhysicsPackage; + +pop 200000; +cycles 10000; +timeStepSize 0.05; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + +source { + type surfaceSource; + shape square; + size 1; + axis x; + pos -2; + T 1; + nParticles 5000; + dir 1; + deltat 0.05; + particle photon; +} + +imcSource { + type imcSource; + nParticles 5000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (0 0 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } + } + + cells + { + } + universes + { + root { id 100; type rootUniverse; border 1; fill u<200>; } + + lat { id 200; + type latUniverse; + origin (0.0 0.0 0.0); + pitch (0.5 1.0 1.0); + shape (8 1 1); + padMat void; + map ( 1 2 3 4 5 6 7 8); + + } + + zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } + zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } + zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } + zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } + zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } + zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } + zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } + zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + + } + +} + + + diff --git a/InputFiles/IMC/SimpleCases/3region b/InputFiles/IMC/SimpleCases/3region new file mode 100644 index 000000000..6a6b81f28 --- /dev/null +++ b/InputFiles/IMC/SimpleCases/3region @@ -0,0 +1,103 @@ + +type IMCPhysicsPackage; + +pop 200000; +cycles 51; +timeStepSize 0.1; + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + +//source { +// type surfaceSource; +// shape square; +// size 1; +// axis x; +// pos -1.5; +// T 1; +// nParticles 20000; +// dir 1; +// deltat 0.1; +// particle photon; +//} + +imcSource { + type imcSource; + nParticles 50000; + } + +inactiveTally {} + +activeTally {} + +tally { + } + +geometry { + type geometryStd; + boundary (1 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + sep1 { id 1; type xPlane; x0 -0.5; } + sep2 { id 2; type xPlane; x0 0.5; } + outer { id 3; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1.5 0.5 0.5); } + } + cells + { + cell1 { id 1; type simpleCell; surfaces ( -1); filltype mat; material mat1; } + cell2 { id 2; type simpleCell; surfaces (1 -2); filltype mat; material mat2; } + cell3 { id 3; type simpleCell; surfaces ( 2); filltype mat; material mat3; } + } + universes + { + root { id 1; type rootUniverse; border 3; fill u<2>; } + cell { id 2; type cellUniverse; cells ( 1 2 3); } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + + materials { + + mat1 { + temp 1; + composition {} + xsFile ./dataFiles/imcData; + volume 1; + } + mat2 { + temp 0; + composition {} + xsFile ./dataFiles/imcData; + volume 1; + } + mat3 { + temp 0; + composition {} + xsFile ./dataFiles/imcData; + volume 1; + } + + +} + +} + + + diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData b/InputFiles/IMC/SimpleCases/dataFiles/imcData new file mode 100644 index 000000000..8cdb4ac41 --- /dev/null +++ b/InputFiles/IMC/SimpleCases/dataFiles/imcData @@ -0,0 +1,27 @@ +// This XSS are for a URR-2-1-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.0); + +scatteringMultiplicity ( +0.0 +); + +P0 ( + 0.0 +); + +sigmaP ( + 1 + 0 +); + +cv ( + 4 + 3 +); + diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 new file mode 100644 index 000000000..684a60187 --- /dev/null +++ b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 @@ -0,0 +1,27 @@ +// This XSS are for a URR-2-1-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.0); + +scatteringMultiplicity ( +0.0 +); + +P0 ( + 0.0 +); + +sigmaP ( + 1.0 + 0.0 +); + +cv ( + 4.0 3.0 + 3.0 2.0 +); + diff --git a/InputFiles/IMC/infiniteRegion b/InputFiles/IMC/SimpleCases/infiniteRegion similarity index 85% rename from InputFiles/IMC/infiniteRegion rename to InputFiles/IMC/SimpleCases/infiniteRegion index 38ab857bf..4a827291e 100644 --- a/InputFiles/IMC/infiniteRegion +++ b/InputFiles/IMC/SimpleCases/infiniteRegion @@ -1,9 +1,9 @@ type IMCPhysicsPackage; -pop 20000; -cycles 20; -timeStepSize 1; +pop 1000000; +cycles 50; +timeStepSize 0.01; XSdata mg; dataType mg; @@ -17,21 +17,9 @@ transportOperator { type transportOperatorIMC; } - -//source { -// type pointSource; -// r (0 0 0); -// particle photon; -// G 2; -//} -//source { - // type imcSource; - //nParticles 1000; -//} - imcSource { type imcSource; - nParticles 20000; + nParticles 100000; } inactiveTally { @@ -87,7 +75,7 @@ nuclearData { materials { mat { - temp 1; + temp 1; composition {} xsFile ./dataFiles/imcData; volume 1; diff --git a/InputFiles/IMC/sphereInCube b/InputFiles/IMC/SimpleCases/sphereInCube similarity index 96% rename from InputFiles/IMC/sphereInCube rename to InputFiles/IMC/SimpleCases/sphereInCube index 1527a0826..14ee38aee 100644 --- a/InputFiles/IMC/sphereInCube +++ b/InputFiles/IMC/SimpleCases/sphereInCube @@ -2,7 +2,7 @@ type IMCPhysicsPackage; pop 20000; -cycles 100; +cycles 500; timeStepSize 0.1; XSdata mg; @@ -19,7 +19,7 @@ transportOperator { imcSource { type imcSource; - nParticles 10000; + nParticles 100; } inactiveTally {} diff --git a/InputFiles/IMC/touchingCubes b/InputFiles/IMC/SimpleCases/touchingCubes similarity index 91% rename from InputFiles/IMC/touchingCubes rename to InputFiles/IMC/SimpleCases/touchingCubes index e35682110..782ea7994 100644 --- a/InputFiles/IMC/touchingCubes +++ b/InputFiles/IMC/SimpleCases/touchingCubes @@ -1,8 +1,8 @@ type IMCPhysicsPackage; -pop 10000; -cycles 200; +pop 50000; +cycles 31; timeStepSize 1; XSdata mg; @@ -27,7 +27,7 @@ transportOperator { imcSource { type imcSource; - nParticles 5000; + nParticles 50000; } inactiveTally {} @@ -75,9 +75,9 @@ nuclearData { volume 1; } mat2 { - temp 0.0000001; + temp 0; composition {} - xsFile ./dataFiles/imcData; + xsFile ./dataFiles/imcData2; volume 1; } diff --git a/InputFiles/IMC/bbSurface b/InputFiles/IMC/bbSurface deleted file mode 100644 index 8d9ee474a..000000000 --- a/InputFiles/IMC/bbSurface +++ /dev/null @@ -1,85 +0,0 @@ - -type IMCPhysicsPackage; - -pop 10000; -cycles 30; -timeStepSize 1; - -XSdata mg; -dataType mg; - - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorIMC; - } - - -source { - type surfaceSource; - shape square; - size 1; - axis x; - pos 0; - T 1; - nParticles 10000; - dir 1; - deltat 1; - particle photon; -} - -imcSource { - type imcSource; - nParticles 10000; - } - -inactiveTally {} - -activeTally {} - -tally { - } - -geometry { - type geometryStd; - boundary (0 1 1 1 1 1); - graph {type shrunk;} - - surfaces - { - box { id 1; type box; origin ( 0.5 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } - } - - cells {} - - universes - { - root { id 1; type rootUniverse; border 1; fill mat; } - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; PN P0;} - } - - - materials { - - mat { - temp 0.00001; - composition {} - xsFile ./dataFiles/imcData; - volume 1; - } - -} - -} - - - diff --git a/InputFiles/IMC/output.m b/InputFiles/IMC/output.m deleted file mode 100644 index cd67a83cf..000000000 --- a/InputFiles/IMC/output.m +++ /dev/null @@ -1,7 +0,0 @@ -seed = -826255877; -pop = 10000; -Source_batches = 200; -Total_CPU_Time = 3.31190E+00; -Transport_time = 3.27185E+00; -batchSize = 1; - diff --git a/InputFiles/XS/imcData b/InputFiles/XS/imcData index e7c63a1a9..c063d0a06 100644 --- a/InputFiles/XS/imcData +++ b/InputFiles/XS/imcData @@ -17,6 +17,7 @@ P0 ( sigmaP ( 1.0 + 0.0 ); cv ( From 1fc376fe016c4e7dc9de579143bc31d7b67e0306 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 17 Jul 2022 15:04:09 +0100 Subject: [PATCH 105/373] Changed subroutine description --- NuclearData/IMCMaterial_inter.f90 | 14 +++++-------- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 21 +++++++------------ NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 14 +++++-------- 3 files changed, 18 insertions(+), 31 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index fbfa7eecb..c369f544b 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -35,7 +35,6 @@ module IMCMaterial_inter procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck procedure(initProps), deferred :: initProps - procedure(isBlackBody), deferred :: isBlackBody procedure(getTemp), deferred :: getTemp end type IMCMaterial @@ -60,10 +59,13 @@ subroutine getMacroXSs_byP(self, xss, p) end subroutine getMacroXSs_byP !! - !! Update material temperature at each time step + !! Update material properties at each time step + !! First update energy using simple balance, then solve for temperature, + !! then update temperature-dependent properties !! !! Args: - !! None + !! tallyEnergy [in] -> Energy absorbed into material + !! printUpdate [in, optional] -> Bool, if true then will print updates to screen !! subroutine updateMat(self, tallyEnergy, printUpdate) import :: IMCMaterial, defReal, defBool @@ -106,12 +108,6 @@ subroutine initProps(self, deltaT, T, V) real(defReal), intent(in) :: deltaT, T, V end subroutine initProps - function isBlackBody(self) result(bool) - import :: IMCMaterial, defReal, defBool - class(IMCMaterial), intent(inout) :: self - logical(defBool) :: bool - end function isBlackBody - function getTemp(self) result(temp) import :: IMCMaterial, defReal class(IMCMaterial), intent(inout) :: self diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 655048c84..9be386ada 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -83,7 +83,6 @@ module baseMgIMCMaterial_class procedure :: getEmittedRad procedure :: getFleck procedure :: initProps - procedure :: isBlackBody procedure :: getTemp end type baseMgIMCMaterial @@ -309,9 +308,12 @@ end function baseMgIMCMaterial_CptrCast !! !! Update material properties at each time step + !! First update energy using simple balance, then solve for temperature, + !! then update temperature-dependent properties !! !! Args: - !! delta T [in] -> Time step size + !! tallyEnergy [in] -> Energy absorbed into material + !! printUpdate [in, optional] -> Bool, if true then will print updates to screen !! subroutine updateMat(self, tallyEnergy, printUpdate) class(baseMgIMCMaterial),intent(inout) :: self @@ -338,7 +340,7 @@ subroutine updateMat(self, tallyEnergy, printUpdate) ! New material internal energy density, U_{m,n+1}/V energyDens = self % matEnergy / self % volume - + !! Integration of dUm/dT = cv gives equation to be solved for T_{n+1}: !! !! f(T_{n+1}) = U_{m,n+1} - U_{m,n} + f(T_n) @@ -349,7 +351,7 @@ subroutine updateMat(self, tallyEnergy, printUpdate) ! Update material temperature by solving f(T_{n+1}) = const if ( energyDens /= prev ) then - self % T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) !! Using energy and const give save result, const not necessary + self % T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) end if ! Print updated properties @@ -363,7 +365,7 @@ subroutine updateMat(self, tallyEnergy, printUpdate) ! Update sigmaP self % sigmaP = poly_eval(self % sigmaEqn, self % T) - ! Also need these lines because cross section functions still use this instead of sigmaP + ! Also need these lines because cross section functions use this instead of sigmaP self % data(CAPTURE_XS,:) = self % sigmaP self % data(TOTAL_XS,:) = self % sigmaP @@ -432,18 +434,11 @@ subroutine initProps(self, deltaT, T, V) self % data(CAPTURE_XS,:) = self % sigmaP self % data(TOTAL_XS,:) = self % sigmaP - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) ! Incomplete, need to add alpha + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) self % deltaT = deltaT end subroutine initProps - function isBlackBody(self) result(bool) - class(baseMgIMCMaterial), intent(inout) :: self - logical(defBool) :: bool - - ! Incomplete - - end function isBlackBody function getTemp(self) result(temp) class(baseMgIMCMaterial), intent(inout) :: self diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 7aacbd352..a91ff90d1 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -47,7 +47,6 @@ module mgIMCMaterial_inter procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck procedure(initProps), deferred :: initProps - procedure(isBlackBody), deferred :: isBlackBody procedure(getTemp), deferred :: getTemp end type mgIMCMaterial @@ -94,10 +93,13 @@ function getTotalXS(self, G, rand) result(xs) end function getTotalXS !! - !! Update material temperature at each time step + !! Update material properties at each time step + !! First update energy using simple balance, then solve for temperature, + !! then update temperature-dependent properties !! !! Args: - !! None + !! tallyEnergy [in] -> Energy absorbed into material + !! printUpdate [in, optional] -> Bool, if true then will print updates to screen !! subroutine updateMat(self, tallyEnergy, printUpdate) import :: mgIMCMaterial, defReal, defBool @@ -140,12 +142,6 @@ subroutine initProps(self, deltaT, T, V) real(defReal), intent(in) :: deltaT, T, V end subroutine initProps - function isBlackBody(self) result(bool) - import :: mgIMCMaterial, defReal, defBool - class(mgIMCMaterial), intent(inout) :: self - logical(defBool) :: bool - end function isBlackBody - function getTemp(self) result(temp) import :: mgIMCMaterial, defReal class(mgIMCMaterial), intent(inout) :: self From 71a49e1c8e86b4a56c7096d31c0f7dc95be38ebe Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 17 Jul 2022 15:08:05 +0100 Subject: [PATCH 106/373] Added line to imrpove convergence chances, changed some comments --- SharedModules/poly_func.f90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index 62955f62f..031d9339f 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -60,13 +60,13 @@ end subroutine poly_integrate !! Use Newton-Raphspon method to solve polynomial with m terms !! !! Args: - !! equation -> - !! derivative -> - !! x0 -> + !! equation -> 1D array of n coefficients followed by m exponents + !! derivative -> 1D array of n coefficients followed by m exponents + !! x0 -> Starting guess !! const -> For f(x) = const, if not given then solves f(x) = 0 !! !! Errors: - !! equation and derivative are different sizes + !! Equation and derivative are different sizes !! Input array sizes are not divisible by 2 !! function poly_solve(equation, derivative, x0, const) result(x) @@ -91,6 +91,9 @@ function poly_solve(equation, derivative, x0, const) result(x) x = x0 m = size(equation) / 2 + ! May not converge if x0 = 0 + if ( x == 0 ) x = 0.0000001 + ! If no constant present then solving f(x) = 0 if( present(const) ) then c = const From 0e386d8f74130c27e1c6f0d4625164dd6d03b5ca Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 17 Jul 2022 15:10:21 +0100 Subject: [PATCH 107/373] Added function to return size of particle dungeon --- ParticleObjects/particleDungeon_class.f90 | 25 +++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 2a1955535..05c901081 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -58,7 +58,6 @@ module particleDungeon_class private real(defReal),public :: k_eff = ONE ! k-eff for fission site generation rate normalisation integer(shortInt) :: pop = 0 ! Current population size of the dungeon - !integer(shortInt),public :: nTimeStep ! Current time step - Only used in IMC calculations real(defreal),public :: endOfStepTime ! Time at end of current time step - only used in IMC calculations ! Storage space @@ -88,6 +87,7 @@ module particleDungeon_class procedure :: setSize procedure :: printToFile procedure :: printToScreen + procedure :: getSize ! Private procedures procedure, private :: detain_particle @@ -426,14 +426,15 @@ subroutine printToFile(self, name) integer(shortInt) :: i filename = trim(name)//'.txt' - open(unit = 10, file = filename, status = 'new') + open(unit = 10, file = filename) ! Print out each particle co-ordinate do i = 1, self % pop - write(10,'(8A)') numToChar(self % prisoners(i) % r), & - numToChar(self % prisoners(i) % dir), & - numToChar(self % prisoners(i) % E), & - numToChar(self % prisoners(i) % G) + write(10,'(8A)') numToChar(self % prisoners(i) % r)!, & + !numToChar(self % prisoners(i) % dir), & + !numToChar(self % prisoners(i) % E), & + !numToChar(self % prisoners(i) % G), & + !numToChar(self % prisoners(i) % matIdx) end do ! Close the file @@ -555,6 +556,7 @@ subroutine printToScreen(self, prop, nMax, total) totSum = totSum + self % prisoners(i) % wgt end do print *, 'Cumulative sum of p % wgt = ', totSum + write(12, *) totSum end if case('time') @@ -580,6 +582,17 @@ subroutine printToScreen(self, prop, nMax, total) end select end subroutine printToScreen + + !! + !! Return number of particles in dungeon + !! + function getSize(self) result(n) + class(particleDungeon), intent(in) :: self + integer(shortInt) :: n + + n = self % pop + + end function getSize end module particleDungeon_class From 9d0f44bf74247f7494bf6fa4bcff766fe33723d5 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 17 Jul 2022 15:13:21 +0100 Subject: [PATCH 108/373] Cleaned up folders --- benchmarkIMCTest2 | 113 ---------------------------------------------- imcBenchmarkData | 26 ----------- imcBenchmarkData2 | 26 ----------- 3 files changed, 165 deletions(-) delete mode 100644 benchmarkIMCTest2 delete mode 100644 imcBenchmarkData delete mode 100644 imcBenchmarkData2 diff --git a/benchmarkIMCTest2 b/benchmarkIMCTest2 deleted file mode 100644 index 0c96d52d9..000000000 --- a/benchmarkIMCTest2 +++ /dev/null @@ -1,113 +0,0 @@ -//type fixedSourcePhysicsPackage; -//type eigenPhysicsPackage; - -type IMCPhysicsPackage; - -pop 100; -cycles 1000; -timeStepSize 0.01; - -XSdata mg; -dataType mg; - - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorIMC; - } - - -//source { -// type pointSource; -// r (0 0 0); -// particle photon; -// G 2; -//} - -imcSource { - type imcSource; - nParticles 100; - } - -inactiveTally { - } - -activeTally { - //norm fiss; - //normVal 100; - //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} - flux { type collisionClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - response (flux); flux {type fluxResponse;} - } - } - -tally { - //display (imcWeight); - //norm fiss; - //normVal 100.0; - //k-eff { type keffAnalogClerk; response (flux); flux {type fluxResponse;} } - //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} - //flux { type collisionClerk; - // map { type energyMap; grid log; min 0.001; max 20; N 300;} - // response (flux); flux {type fluxResponse;} - // } - imcWeight { type imcWeightClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - //response (imc); imc {type fluxResponse;} - } - } - -geometry { - type geometryStd; - boundary (1 1 1 1 1 1); - graph {type shrunk;} - - surfaces - { - squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } - } - cells {} - universes - { - - root - { - id 1; - type rootUniverse; - border 1; - fill fuel; - } - } -} - -nuclearData { - - handles { - //ce { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} - mg { type baseMgIMCDatabase; PN P0;} - } - - - materials { - - fuel { - temp 273; - composition { - 94239.03 0.037047; - 94240.03 0.0017512; - 94241.03 0.00011674; - 31000.03 0.0013752; - } - xsFile ./imcBenchmarkData2; //./InputFiles/XS/imcData; //./imcBenchmarkData; - } - -} - -} - - - diff --git a/imcBenchmarkData b/imcBenchmarkData deleted file mode 100644 index f2292bcac..000000000 --- a/imcBenchmarkData +++ /dev/null @@ -1,26 +0,0 @@ -// This XSS are for a URR-2-1-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 (1.0); - -scatteringMultiplicity ( - 0.0 -); - -P0 ( - 0.0 -); - -sigmaP ( - 1.0 -); - -cv ( - 4.0 - 3.0 -); - diff --git a/imcBenchmarkData2 b/imcBenchmarkData2 deleted file mode 100644 index b3414b93e..000000000 --- a/imcBenchmarkData2 +++ /dev/null @@ -1,26 +0,0 @@ -// This XSS are for a URR-2-1-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.0010046); - -scatteringMultiplicity ( -1.0 -); - -P0 ( - 0.62568 -); - -sigmaP ( - 10.0 -); - -cv ( - 1.0 - 0.0 -); - From 6028b02373f386c4ee6478c6e2751698845a7f91 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 17 Jul 2022 15:17:03 +0100 Subject: [PATCH 109/373] Made changes to not sample particles in areas of 0 temperature --- ParticleObjects/Source/IMCSource_class.f90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index d09ffa2ec..6a66d0200 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -109,8 +109,8 @@ function sampleParticle(self, rand) result(p) class(nuclearDatabase), pointer :: nucData class(IMCMaterial), pointer :: mat real(defReal), dimension(3) :: r, rand3, dir - real(defReal) :: mu, phi - integer(shortInt) :: matIdx, uniqueID, nucIdx, i + real(defReal) :: mu, phi, i + integer(shortInt) :: matIdx, uniqueID, nucIdx character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' ! Get pointer to appropriate nuclear database @@ -120,7 +120,7 @@ function sampleParticle(self, rand) result(p) i = 0 rejection : do ! Protect against infinite loop - i = i +1 + i = i + 1 if ( i > 200) then call fatalError(Here, '200 particles in a row sampled in void or outside material.& & Check that geometry is as intended') @@ -162,6 +162,13 @@ function sampleParticle(self, rand) result(p) ! Set weight to be equal to total emitted radiation from material p % wgt = mat % getEmittedRad() + ! Don't sample particles from areas of 0 temperature + if( p % wgt == 0 ) then + self % matPops(matIdx) = 1 ! Set to 1 to avoid error in appendIMC (source_inter.f90) + i = i - 0.9 ! To allow more attempts if large regions with 0 temp + cycle rejection + end if + ! Increase counter of number of particles in material in order to normalise later self % matPops(matIdx) = self % matPops(matIdx) + 1 From 436413a2840a5b4c69639ded7b282d4d079d84fc Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 24 Jul 2022 19:06:47 +0100 Subject: [PATCH 110/373] Added some function descriptions --- Tallies/TallyClerks/imcWeightClerk_class.f90 | 16 +++------------- Tallies/scoreMemory_class.f90 | 7 +++++-- Tallies/tallyAdmin_class.f90 | 1 + 3 files changed, 9 insertions(+), 15 deletions(-) diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 index cd594139c..f713e4034 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -33,8 +33,7 @@ module imcWeightClerk_class private !! - !! Colision estimator of reaction rates - !! Calculates flux weighted integral from collisions + !! Record energy weight of particles absorbed in collisions !! !! Private Members: !! filter -> Space to store tally Filter @@ -45,16 +44,7 @@ module imcWeightClerk_class !! Interface !! tallyClerk Interface !! - !! SAMPLE DICTIOANRY INPUT: - !! - !! myImcWeightClerk { - !! type imcWeightClerk; - !! # filter { } # - !! # map { } # - !! response (resName1 #resName2 ... #) - !! resName1 { } - !! #resNamew { Call "display" on all Clerks registered to display !! isConverged -> Return .true. if all convergance targets have been reached !! print -> Prints results to an output file object + !! reset -> Resets tally clerk count to 0 !! !! SAMPLE DICTIOANRY INPUT: !! From 343b9cd8ce5da2af15ce7f5ec11f7a0df9d259f0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 24 Jul 2022 21:03:34 +0100 Subject: [PATCH 111/373] Added more function descriptions and comments --- .../CollisionProcessors/IMCMGstd_class.f90 | 29 +++++++------------ ParticleObjects/Source/IMCSource_class.f90 | 20 +++++-------- ParticleObjects/Source/source_inter.f90 | 12 ++++++-- .../Source/surfaceSource_class.f90 | 19 ++++++++---- ParticleObjects/particleDungeon_class.f90 | 8 +++-- 5 files changed, 47 insertions(+), 41 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index d25bbe50f..565113744 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -37,6 +37,7 @@ module IMCMGstd_class !! !! Standard (default) scalar collision processor for MG IMC + !! Determines type of collision as either absorption or effective scattering !! !! Settings: !! NONE @@ -80,7 +81,13 @@ subroutine init(self, dict) end subroutine init !! - !! Samples collision without any implicit treatment + !! Samples collision + !! + !! Absorption with probability equal to fleck factor, otherwise + !! effective scattering + !! + !! Physical scattering is omitted as in reference paper "Four Decades of Implicit Monte Carlo" + !! (Allan B Wollaber) but may be included later if desired !! subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) class(IMCMGstd), intent(inout) :: self @@ -152,7 +159,8 @@ subroutine elastic(self, p , collDat, thisCycle, nextCycle) end subroutine elastic !! - !! Preform scattering + !! Preform scattering - Currently this is for effective scattering, and energy weights + !! are unchanged (so is actually elastic) !! subroutine inelastic(self, p, collDat, thisCycle, nextCycle) class(IMCMGstd), intent(inout) :: self @@ -168,22 +176,7 @@ subroutine inelastic(self, p, collDat, thisCycle, nextCycle) character(100),parameter :: Here = "inelastic (IMCMGstd_class.f90)" ! Assign MT number - collDat % MT = macroIEScatter - - ! Get Scatter object - !scatter => multiScatterMG_CptrCast( self % xsData % getReaction(macroIEscatter, collDat % matIdx)) - !if(.not.associated(scatter)) call fatalError(Here, "Failed to get scattering reaction object for MG IMC") - - ! Sample Mu and G_out - !call scatter % sampleOut(collDat % muL, phi, G_out, p % G, p % pRNG) - - ! Read scattering multiplicity - !w_mul = scatter % production(p % G, G_out) - - ! Update photon state - !p % G = G_out - !p % w = p % w * w_mul - !call p % rotate(collDat % muL, phi) + collDat % MT = macroIEScatter ! Sample Direction - chosen uniformly inside unit sphere mu = 2 * p % pRNG % get() - 1 diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 6a66d0200..f4f0ad75b 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -22,11 +22,8 @@ module IMCSource_class private !! - !! IMC Source from distributed fission sites + !! IMC Source for uniform generation of photons within material regions !! - !! Places fission sites uniformly in regions with fissile material. - !! Spectrum of the fission IMC is such as if it fission was caused by incdent - !! IMC with CE energy E or MG with group G. !! Angular distribution is isotropic. !! !! Private members: @@ -39,13 +36,7 @@ module IMCSource_class !! Interface: !! source_inter Interface !! - !! Sample Dictionary Input: - !! fission { - !! type imcSource; - !! #data MG; # - !! #E 15.0; # - !! #G 7; # - !! } + !! Initiated in IMC physics package, does not need to appear in input file !! type, public,extends(source) :: imcSource private @@ -109,6 +100,7 @@ function sampleParticle(self, rand) result(p) class(nuclearDatabase), pointer :: nucData class(IMCMaterial), pointer :: mat real(defReal), dimension(3) :: r, rand3, dir + ! Here, i is a float to allow more precise control of loop real(defReal) :: mu, phi, i integer(shortInt) :: matIdx, uniqueID, nucIdx character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' @@ -117,6 +109,8 @@ function sampleParticle(self, rand) result(p) nucData => ndReg_getIMCMG() if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') + ! Position is sampled by taking a random point from within geometry bounding box + ! If in valid material, position is accepted i = 0 rejection : do ! Protect against infinite loop @@ -160,12 +154,14 @@ function sampleParticle(self, rand) result(p) p % isMG = .true. ! Set weight to be equal to total emitted radiation from material + ! This weight is then normalised later - see appendIMC (source_inter.f90) + ! There may be more intuitive ways to do this, but works well for now p % wgt = mat % getEmittedRad() ! Don't sample particles from areas of 0 temperature if( p % wgt == 0 ) then self % matPops(matIdx) = 1 ! Set to 1 to avoid error in appendIMC (source_inter.f90) - i = i - 0.9 ! To allow more attempts if large regions with 0 temp + i = i - 0.9 ! To allow more attempts if large regions with 0 temp cycle rejection end if diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index 6b48c1197..fb7783cf0 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -30,6 +30,8 @@ module source_inter !! Interface: !! init -> initialise the source !! generate -> generate particles to fill a dungeon + !! append -> generate new particles to add to an existing dungeon + !! appendIMC -> generate particles for uniform IMC material source !! sampleParticle -> sample particles from the corresponding distributions !! kill -> clean up the source !! @@ -126,6 +128,7 @@ end subroutine generate !! Args: !! dungeon [inout] -> particle dungeon to be populated !! n [in] -> number of particles to place in dungeon + !! rand [inout] -> particle RNG object !! !! Result: !! A dungeon populated with n particles sampled from the source @@ -155,6 +158,7 @@ end subroutine append !! Args: !! dungeon [inout] -> particle dungeon to be populated !! n [in] -> number of particles to place in dungeon + !! rand [inout] -> particle RNG object !! !! Result: !! A dungeon populated with n particles sampled from the source @@ -183,10 +187,12 @@ subroutine appendIMC(self, dungeon, n, rand) call tempDungeon % replace(self % sampleParticle(rand), i) end do - ! Call error if any region contains no generated particles + ! Call error if any region contains no generated particles (due to small regions and/or + ! not enough particles used), needed for now as otherwise will lead to energy imbalance + ! as mat energy will be reduced by emittedRad but no particles will be carrying it + ! Note that matProps is set to 1 in IMCsource.f90 if region is of 0 temperature to avoid + ! this error for such a case if ( minval(self % matPops) == 0 ) then - ! Currently will lead to energy imbalance as mat energy will be reduced by emittedRad but - ! no particles will be carrying it, possible to modify code to maintain energy balance call fatalError(Here, "Not all regions emitted particles, use more particles") end if diff --git a/ParticleObjects/Source/surfaceSource_class.f90 b/ParticleObjects/Source/surfaceSource_class.f90 index 0f92a964f..d9a88911d 100644 --- a/ParticleObjects/Source/surfaceSource_class.f90 +++ b/ParticleObjects/Source/surfaceSource_class.f90 @@ -13,10 +13,13 @@ module surfaceSource_class private !! - !! Class describing point-like particle sources - !! - !! Generates a mono-energetic, mono-directional or isotropic particle - !! source from a single point in space, with particles of a single type + !! Generates a source representing a black body surface + !! Put together quite quickly so very specific in use and not perfect + !! - Currently only allows a circle or square aligned on x y or z axis, with + !! a certain radius or side length + !! - Requires deltat and nParticles in input file to be the same as specified elsewhere + !! in file, can change to not require these inputs with some more thought + !! - May still contain unnecessary lines of code copied from pointSource_class.f90 !! !! Private members: !! r -> source position @@ -41,10 +44,11 @@ module surfaceSource_class !! axis x; ! axis normal to shape !! pos 0; ! distance along axis to place plane !! T 1; ! temperature of source boundary - !! nParticles 100; ! Number of particles emitted per time step, for now has to be the same as IMC source if used in IMC calculation + !! nParticles 100; ! Number of particles emitted per time step, for now has to be + !! the same as IMC source if used in IMC calculation !! particle photon; !! #dir 1; # ! Positive or negative to indicate direction along axis - !! deltat 1; ! Just until properly implemented + !! deltat 1; ! Currently needed as IMC time step size !! } !! type, public,extends(configSource) :: surfaceSource @@ -258,6 +262,9 @@ end subroutine sampleEnergyAngle !! !! Provide particle energy !! + !! Sampled as a black body surface, see "Four Decades of Implicit Monte Carlo", + !! Allan B Wollaber, p.24-25 + !! !! See configSource_inter for details. !! subroutine sampleEnergy(self, p, rand) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 05c901081..2cd886ea7 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -49,6 +49,8 @@ module particleDungeon_class !! does not take ununiform weight of particles into account !! setSize(n) -> sizes dungeon to have n dummy particles for ease of overwriting !! printToFile(name) -> prints population in ASCII format to file "name" + !! printToScreen(prop,nMax,total) -> prints property to screen for up to nMax particles + !! getSize() -> returns number of particles in dungeon !! !! Build procedures: !! init(maxSize) -> allocate space to store maximum of maxSize particles @@ -446,8 +448,10 @@ end subroutine printToFile !! Prints given property of particles to screen !! !! Args: - !! prop [in] -> Particle property to be displayed - !! nMax [in] -> Maximum number of particles displayed + !! prop [in] -> Particle property to be displayed + !! nMax [in] -> Maximum number of particles displayed + !! total [in] -> Optional, if True then sum contributions of particles + !! and print for total !! !! Errors: !! fatalError if prop is invalid From d3b9214117acc6e18c52a8351acd626680e035e3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 24 Jul 2022 21:14:13 +0100 Subject: [PATCH 112/373] A few small changes --- NuclearData/xsPackages/IMCXsPackages_class.f90 | 1 + PhysicsPackages/IMCPhysicsPackage_class.f90 | 8 +++++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/NuclearData/xsPackages/IMCXsPackages_class.f90 b/NuclearData/xsPackages/IMCXsPackages_class.f90 index e3c3f7850..23b16c044 100644 --- a/NuclearData/xsPackages/IMCXsPackages_class.f90 +++ b/NuclearData/xsPackages/IMCXsPackages_class.f90 @@ -2,6 +2,7 @@ !! This module brakes standard rules !! It contains a library of XS Packages for IMC particle type !! +!! Pretty much a copy of neutronXsPackages_class, may contain unnecessary lines !! module IMCXsPackages_class diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 62d25cd3e..ce7ba01ee 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -87,8 +87,10 @@ module IMCPhysicsPackage_class integer(shortInt) :: nMat ! Calculation components - type(particleDungeon), allocatable :: thisCycle! => null() Other physics packages use pointers here - type(particleDungeon), allocatable :: nextCycle! => null() - Need to read up more to figure out correct usage e.g. using = instead of => for pointers + type(particleDungeon), allocatable :: thisCycle + type(particleDungeon), allocatable :: nextCycle + ! Note that other physics packages used pointers for these particleDungeons ( => null() ) + ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed class(source), allocatable :: inputSource class(source), allocatable :: IMCSource @@ -124,7 +126,7 @@ subroutine run(self) end subroutine !! - !! + !! Run cycles for calculation !! subroutine cycles(self, tally, tallyAtch, N_cycles) class(IMCPhysicsPackage), intent(inout) :: self From da51f86422d48a62b3fe89c5233ed88157d735a1 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 24 Jul 2022 21:30:03 +0100 Subject: [PATCH 113/373] Fixed incorrect comment line --- ParticleObjects/Source/IMCSource_class.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index f4f0ad75b..d23bb1974 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -36,7 +36,8 @@ module IMCSource_class !! Interface: !! source_inter Interface !! - !! Initiated in IMC physics package, does not need to appear in input file + !! SAMPLE INPUT: + !! imcSource { type IMCSource; nParticles 100; } !! type, public,extends(source) :: imcSource private From 03eae23a93219e347179dc5b43a76079abc39289 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 24 Jul 2022 22:56:24 +0100 Subject: [PATCH 114/373] Slight changes to comments --- ParticleObjects/Source/surfaceSource_class.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/ParticleObjects/Source/surfaceSource_class.f90 b/ParticleObjects/Source/surfaceSource_class.f90 index d9a88911d..b5567cc15 100644 --- a/ParticleObjects/Source/surfaceSource_class.f90 +++ b/ParticleObjects/Source/surfaceSource_class.f90 @@ -41,14 +41,15 @@ module surfaceSource_class !! type surfaceSource; !! shape circle ! circle or square; !! size 5; ! radius(circle) or side length(square) - !! axis x; ! axis normal to shape + !! axis x; ! axis normal to planar shape !! pos 0; ! distance along axis to place plane !! T 1; ! temperature of source boundary !! nParticles 100; ! Number of particles emitted per time step, for now has to be !! the same as IMC source if used in IMC calculation !! particle photon; !! #dir 1; # ! Positive or negative to indicate direction along axis - !! deltat 1; ! Currently needed as IMC time step size + !! If 0 then emit in both directions + !! deltat 1; ! Currently needed to be the same as IMC time step size !! } !! type, public,extends(configSource) :: surfaceSource From 4d2503c01e21b04acbf80e24ca10558d08339aad Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 24 Jul 2022 22:57:06 +0100 Subject: [PATCH 115/373] Created sample input file to explain certain settings --- InputFiles/IMC/Sample/imcSampleInput | 122 +++++++++++++++++++++++++++ InputFiles/IMC/Sample/imcSampleMat | 38 +++++++++ 2 files changed, 160 insertions(+) create mode 100644 InputFiles/IMC/Sample/imcSampleInput create mode 100644 InputFiles/IMC/Sample/imcSampleMat diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput new file mode 100644 index 000000000..39a8c7ef4 --- /dev/null +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -0,0 +1,122 @@ +// +// Intended as a sample/tutorial input file for calculations using IMC physics +// package, to detail settings that differ to other calculation types +// + + +type IMCPhysicsPackage; + +pop 1000; + // For now this determines the maximum size of particle dungeons, physics package sets + // thisCycle as 15*pop and nextCycle as 10*pop + // Very abitrary and non-optimal, would benefit from a simple change such that dungeon size is + // increased automatically to accommodate required no. of particles + // Runtime is very dependent on this value, should not be set too large + // Actual number of of particles emitted in each time step is set in imcSource dictionary + +cycles 50; + // The number of time steps to be used in the calculation + // Still called cycles in many functions and subroutines to avoid breaking other + // calculation types + +timeStepSize 0.1; + // The time step size for the calculation + + +XSdata mg; +dataType mg; + + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorIMC; + } + +imcSource { + type imcSource; + nParticles 500; + // imcSource is required by physics package, nParticles is the number of + // particles emitted from material as radiation within each time step. + // Needs to be lower than 'pop' (see above), depending on time step size + // and material properties may need to be several orders of magnitude lower + // Increasing will give higher accuracy but longer runtime + } + + +// No tallies are required for calculation, but empty dictionaries must be given + +inactiveTally { + } + +activeTally { + } + +tally { + } + + +// Geometry is as in all other calculation types. +// Here a simple infinite region is given (a perfectly reflected 1x1x1 cube) + +geometry { + type geometryStd; + boundary (1 1 1 1 1 1); + graph {type shrunk;} + + surfaces { + squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } + } + + cells { + } + + universes { + root { id 1; type rootUniverse; border 1; fill mat; } + } +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; PN P0;} + } + + // Dictionary containing all materials used in geometry + // If desired to have spatial temperature variation, split geometry (above) + // into desired cells and set each cell fill as a DIFFERENT material + // (e.g. mat1, mat2, mat3, ...) then define all materials here. Even if each + // each mat input is identical (even including data file), a unique material object + // will be created allowing for a unique temperature evolution. + + materials { + + // Example: mat + mat { + + temp 1; + // Initial temperature of material (will change as calculation progresses). + + composition {} + // Empty dictionary required for composition. + + xsFile ./imcSampleMat; + // Location of material data file containing material properties. + + volume 1; + // Total volume that this material occupies, for now need to calculate by hand + // and enter here. May be room to make this automatic in the future. + + } + + // Example 2: mat2 + //mat2 { temp 1; composition {} xssFile ./imcSampleMat2; volume 1 } + +} + +} + + + diff --git a/InputFiles/IMC/Sample/imcSampleMat b/InputFiles/IMC/Sample/imcSampleMat new file mode 100644 index 000000000..0a936419f --- /dev/null +++ b/InputFiles/IMC/Sample/imcSampleMat @@ -0,0 +1,38 @@ +// +// Sample material data file for IMC calculations +// + + +numberOfGroups 1; + + // For now the following 3 settings are required at 0, just due to the way that + // some of the cross section functions work the same as other calculation types +capture (0.0); +scatteringMultiplicity (0.0); +P0 (0.0); + + // Set polynomial temperature-dependent Planck opacity for the material. + // Currently have only considered the grey case, if using a frequency dependent opacity + // then this would need to be changed to a more complex input. + // Input should be a 1D array of coefficients followed by exponents, with any polynomial + // length allowed + // e.g. Here, sigmaP = 1 + 2T +sigmaP ( + 1 2 // Coefficients + 0 1 // Exponents +); + + // Set temperature-dependent specific heat capacity of the material. + // Same format as above. + // Currently cannot have an exponent of exactly -1, as cv is integrated simply by adding 1 to + // exponents an have not yet allowed T^(-1) to integrate to ln(T). + // After integration, solved by Newton-Raphson solver. Some choices of cv may not converge, + // and some will give negative energies and temperatures. Unsure if this is due to some + // numerical oversight in the way the calculation is done or if these are just unphysical + // choices. + // e.g. Here, cv = 4T^3 - 2T + T^(-0.5) +cv ( + 4 -2 1 // Coefficients + 3 1 -0.5 // Exponents +); + From 578d87606fccd7c406fc42122c588e26084c2cbb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 2 Sep 2022 12:40:38 +0100 Subject: [PATCH 116/373] Test commit for github --- InputFiles/IMC/SimpleCases/infiniteRegion | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/InputFiles/IMC/SimpleCases/infiniteRegion b/InputFiles/IMC/SimpleCases/infiniteRegion index 4a827291e..03eea937a 100644 --- a/InputFiles/IMC/SimpleCases/infiniteRegion +++ b/InputFiles/IMC/SimpleCases/infiniteRegion @@ -82,7 +82,7 @@ nuclearData { } } - + } From 3e76371b7452129a5c54dc53f58f719d74e7c029 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 2 Sep 2022 18:15:00 +0100 Subject: [PATCH 117/373] Split updateMat subroutine into IMC and ISMC --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 64 ++++++++++++++----- SharedModules/universalVariables.f90 | 13 +++- 2 files changed, 59 insertions(+), 18 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 9be386ada..964544068 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -69,6 +69,7 @@ module baseMgIMCMaterial_class real(defReal),dimension(:), allocatable :: cv, updateEqn, sigmaEqn class(multiScatterMG), allocatable :: scatter real(defReal) :: T, fleck, deltaT, sigmaP, matEnergy, volume + integer(shortInt) :: calcType contains ! Superclass procedures @@ -80,6 +81,8 @@ module baseMgIMCMaterial_class procedure :: init procedure :: nGroups procedure :: updateMat + procedure :: updateMatIMC + procedure :: updateMatISMC procedure :: getEmittedRad procedure :: getFleck procedure :: initProps @@ -319,7 +322,6 @@ subroutine updateMat(self, tallyEnergy, printUpdate) class(baseMgIMCMaterial),intent(inout) :: self real(defReal), intent(in) :: tallyEnergy logical(defBool), intent(in), optional :: printUpdate - real(defReal) :: energyDens, prev character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" ! Print current properties @@ -332,6 +334,38 @@ subroutine updateMat(self, tallyEnergy, printUpdate) end if end if + select case (self % calcType) + + case(IMC) + call self % updateMatIMC(tallyEnergy) + + case(ISMC) + call self % updateMatISMC(tallyEnergy) + + case default + call fatalError(Here, "Invalid calculation type") + + end select + + ! Print updated properties + if (present(printUpdate)) then + if(printUpdate .eqv. .True.) then + print *, " matEnergy at end of timestep = ", self % matEnergy + print *, " T_new = ", self % T + end if + end if + + end subroutine updateMat + + !! + !! Material update for IMC calculation + !! + subroutine updateMatIMC(self, tallyEnergy) + class(baseMgIMCMaterial), intent(inout) :: self + real(defReal), intent(in) :: tallyEnergy + real(defReal) :: energyDens, prev + character(100), parameter :: Here = "updateMatIMC (baseMgIMCMaterial_class.f90)" + ! Store previous material internal energy density, U_{m,n}/V prev = self % matEnergy / self % volume @@ -354,15 +388,6 @@ subroutine updateMat(self, tallyEnergy, printUpdate) self % T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) end if - ! Print updated properties - if (present(printUpdate)) then - if(printUpdate .eqv. .True.) then - print *, " matEnergy at end of timestep = ", self % matEnergy - print *, " T_new = ", self % T - end if - end if - - ! Update sigmaP self % sigmaP = poly_eval(self % sigmaEqn, self % T) ! Also need these lines because cross section functions use this instead of sigmaP @@ -375,13 +400,18 @@ subroutine updateMat(self, tallyEnergy, printUpdate) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT) ! Incomplete, need to add alpha - !print *, 'fleck_new =', self % fleck - !print *, 'a =', radiationConstant - !print *, 'c =', lightSpeed - !print *, 'V =', self % volume - !print *, 'sigmaP_new =', self % sigmaP + end subroutine updateMatIMC + + !! + !! Material update for ISMC calculation + !! + subroutine updateMatISMC(self, tallyEnergy) + class(baseMgIMCMaterial), intent(inout) :: self + real(defReal), intent(in) :: tallyEnergy + + + end subroutine updateMatISMC - end subroutine updateMat !! !! Return the energy to be emitted during time step, E_r @@ -437,6 +467,8 @@ subroutine initProps(self, deltaT, T, V) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) self % deltaT = deltaT + self % calcType = IMC + end subroutine initProps diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index a3136bdf5..da6b349ee 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -60,6 +60,10 @@ module universalVariables P_NEUTRON_MG = 2, & P_PHOTON_MG = 3 + ! IMC Calculation Type + integer(shortInt), parameter :: IMC = 1, & + ISMC = 2 + ! Search error codes integer(shortInt), parameter :: valueOutsideArray = -1,& tooManyIter = -2,& @@ -68,9 +72,14 @@ module universalVariables ! Physical constants real(defReal), parameter :: neutronMass = 939.5654133_defReal, & ! Neutron mass in MeV/c^2 - lightSpeed = 2.99792458e10_defReal, & ! Light speed in cm/s + lightSpeed = ONE, & + !lightSpeed = 2.99792458e10_defReal, & ! Light speed in cm/s energyPerFission = 200.0_defReal, & ! MeV - radiationConstant = 0.01372_defReal ! GJ/(cm^3 keV^4) + radiationConstant = ONE, & + !radiationConstant = 0.01372_defReal, & ! GJ/(cm^3 keV^4) + !radiationConstant = 7.5657e-10_defReal, & ! J/(cm^3 K^-4) + planckConst = 6.62607015e-30_defReal, & ! cm^2 kg/s + boltzmannConst = 1.380649e-19_defReal ! cm^2 kg s^-2 K^-1 ! Unit conversion real(defReal), parameter :: joulesPerMeV = 1.60218e-13 ! Convert MeV to J From 4ac1300fec3f24f0a3d99687bfab4cd34df19348 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 2 Sep 2022 19:07:42 +0100 Subject: [PATCH 118/373] Simplified code for IMC calculation, and began code for ISMC --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 79 ++++++++++++------- 1 file changed, 52 insertions(+), 27 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 964544068..280248e7e 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -81,13 +81,16 @@ module baseMgIMCMaterial_class procedure :: init procedure :: nGroups procedure :: updateMat - procedure :: updateMatIMC - procedure :: updateMatISMC procedure :: getEmittedRad procedure :: getFleck procedure :: initProps procedure :: getTemp + procedure, private :: updateMatIMC + procedure, private :: updateMatISMC + procedure, private :: tempFromEnergy + procedure, private :: sigmaFromTemp + end type baseMgIMCMaterial contains @@ -363,42 +366,22 @@ end subroutine updateMat subroutine updateMatIMC(self, tallyEnergy) class(baseMgIMCMaterial), intent(inout) :: self real(defReal), intent(in) :: tallyEnergy - real(defReal) :: energyDens, prev character(100), parameter :: Here = "updateMatIMC (baseMgIMCMaterial_class.f90)" - ! Store previous material internal energy density, U_{m,n}/V - prev = self % matEnergy / self % volume - ! Update material internal energy self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy - ! New material internal energy density, U_{m,n+1}/V - energyDens = self % matEnergy / self % volume - - !! Integration of dUm/dT = cv gives equation to be solved for T_{n+1}: - !! - !! f(T_{n+1}) = U_{m,n+1} - U_{m,n} + f(T_n) - !! - !! where f(T) is the indefinite integral of cv (stored in self % updateEqn) - !! - !const = energy - const + poly_eval(self % updateEqn, self % T) - - ! Update material temperature by solving f(T_{n+1}) = const - if ( energyDens /= prev ) then - self % T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) - end if + ! Update material temperature + self % T = self % tempFromEnergy() ! Update sigmaP - self % sigmaP = poly_eval(self % sigmaEqn, self % T) - ! Also need these lines because cross section functions use this instead of sigmaP - self % data(CAPTURE_XS,:) = self % sigmaP - self % data(TOTAL_XS,:) = self % sigmaP + call self % sigmaFromTemp if( self % T < 0 ) then call fatalError(Here, "Temperature is negative") end if - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT) ! Incomplete, need to add alpha + self % fleck = 1 / (1 + 1*self % sigmaP*lightSpeed*self % deltaT) ! Incomplete, need to add alpha end subroutine updateMatIMC @@ -408,16 +391,58 @@ end subroutine updateMatIMC subroutine updateMatISMC(self, tallyEnergy) class(baseMgIMCMaterial), intent(inout) :: self real(defReal), intent(in) :: tallyEnergy + real(defReal) :: beta, eta, zeta + ! Update material internal energy + self % matEnergy = tallyEnergy + + ! Update material temperature + self % T = self % tempFromEnergy() + + ! Update ISMC equivalent of fleck factor + beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + eta = radiationConstant * self % T**4 / self % matEnergy + zeta = beta - eta + self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) + + ! Update sigmaP + call self % sigmaFromTemp end subroutine updateMatISMC + !! + !! Calculate the temperature of material from internal energy + !! + function tempFromEnergy(self) result(T) + class(baseMgIMCMaterial), intent(inout) :: self + real(defReal) :: T, energyDens + + energyDens = self % matEnergy / self % volume + T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) + + end function tempFromEnergy + + !! + !! Calculate sigmaP from current temp + !! + subroutine sigmaFromTemp(self) + class(baseMgIMCMaterial), intent(inout) :: self + real(defReal) :: sigma + + self % sigmaP = poly_eval(self % sigmaEqn, self % T) + + ! Also need these lines because cross section functions use this instead of sigmaP for now + self % data(CAPTURE_XS,:) = self % sigmaP + self % data(TOTAL_XS,:) = self % sigmaP + + end subroutine sigmaFromTemp + !! !! Return the energy to be emitted during time step, E_r !! function getEmittedRad(self) result(emittedRad) - class(baseMgIMCMaterial),intent(inout) :: self + class(baseMgIMCMaterial), intent(inout) :: self real(defReal) :: U_r, emittedRad U_r = radiationConstant * (self % T)**4 From 588249885ec4e2620d5512c0f9c1b6849cc580c4 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 3 Sep 2022 12:57:06 +0100 Subject: [PATCH 119/373] Removed changes to existing input files --- InputFiles/JEZ | 12 ++++-------- InputFiles/POPSY | 2 +- InputFiles/SCONE_Inf | 2 +- 3 files changed, 6 insertions(+), 10 deletions(-) diff --git a/InputFiles/JEZ b/InputFiles/JEZ index 3951a946d..1f0ad50bc 100644 --- a/InputFiles/JEZ +++ b/InputFiles/JEZ @@ -1,12 +1,8 @@ type eigenPhysicsPackage; -pop 10; -active 5; -inactive 2; - -//pop 200000; -//active 500; -//inactive 20; +pop 200000; +active 500; +inactive 20; XSdata ceData; dataType ce; @@ -65,7 +61,7 @@ geometry { nuclearData { handles { - ceData { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} + ceData { type aceNeutronDatabase; aceLibrary /home/mak60/myACE/JEF311.aceXS;} } diff --git a/InputFiles/POPSY b/InputFiles/POPSY index 5f738dccd..7e899df5a 100644 --- a/InputFiles/POPSY +++ b/InputFiles/POPSY @@ -69,7 +69,7 @@ geometry { nuclearData { handles { - ce { type aceNeutronDatabase; aceLibrary /home/ajb343/myACE/JEF311.aceXS;} + ce { type aceNeutronDatabase; aceLibrary /home/mak60/myACE/JEF311.aceXS;} } diff --git a/InputFiles/SCONE_Inf b/InputFiles/SCONE_Inf index 873cd955b..3bbf151d6 100644 --- a/InputFiles/SCONE_Inf +++ b/InputFiles/SCONE_Inf @@ -57,7 +57,7 @@ geometry { nuclearData { handles { - ce { type aceNeutronDatabase; aceLibrary /home/ajb343/Cases/U235_Compr/XSDAT/JEF311.aceXS;} + ce { type aceNeutronDatabase; aceLibrary /home/mak60/Cases/U235_Compr/XSDAT/JEF311.aceXS;} mg { type baseMgNeutronDatabase; PN P0;} } From 3539bd19007396d7b9372c2fb89fb74a5745cf03 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 5 Sep 2022 14:46:53 +0100 Subject: [PATCH 120/373] Fixed tab, added error calls --- CollisionOperator/CollisionProcessors/CMakeLists.txt | 2 +- .../CollisionProcessors/IMCMGstd_class.f90 | 10 +++++++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/CMakeLists.txt b/CollisionOperator/CollisionProcessors/CMakeLists.txt index 3f50ec0fa..463788d8d 100644 --- a/CollisionOperator/CollisionProcessors/CMakeLists.txt +++ b/CollisionOperator/CollisionProcessors/CMakeLists.txt @@ -2,6 +2,6 @@ add_sources( ./collisionProcessor_inter.f90 ./collisionProcessorFactory_func.f90 ./neutronCEstd_class.f90 - ./neutronCEimp_class.f90 + ./neutronCEimp_class.f90 ./neutronMGstd_class.f90 ./IMCMGstd_class.f90) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 565113744..a7c88a1fb 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -126,8 +126,6 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) collDat % MT = macroIEScatter end if - !collDat % MT = macroXSs % invert(r) - end subroutine sampleCollision !! @@ -140,7 +138,7 @@ subroutine implicit(self, p, collDat, thisCycle, nextCycle) class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - ! Do nothing. Should not be called + ! Do nothing. end subroutine implicit @@ -153,9 +151,12 @@ subroutine elastic(self, p , collDat, thisCycle, nextCycle) type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle + character(100), parameter :: Here = 'elastic (IMCMGstd_class.f90)' ! Do nothing. Should not be called + call fatalError(Here, "elastic subroutine should not be called") + end subroutine elastic !! @@ -213,9 +214,12 @@ subroutine fission(self, p, collDat, thisCycle, nextCycle) type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle + character(100), parameter :: Here = 'fission (IMCMGstd_class.f90)' ! Do nothing. Should not be called + call fatalError(Here, "elastic subroutine should not be called") + end subroutine fission !! From bcc2b9037ab1b3c7337d6105fb0a5a362f7d5bcc Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 5 Sep 2022 14:50:12 +0100 Subject: [PATCH 121/373] Deleted unnecessary lines for pull request --- SharedModules/universalVariables.f90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index da6b349ee..84e28d2d3 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -72,12 +72,9 @@ module universalVariables ! Physical constants real(defReal), parameter :: neutronMass = 939.5654133_defReal, & ! Neutron mass in MeV/c^2 - lightSpeed = ONE, & - !lightSpeed = 2.99792458e10_defReal, & ! Light speed in cm/s + lightSpeed = 2.99792458e10_defReal, & ! Light speed in cm/s energyPerFission = 200.0_defReal, & ! MeV - radiationConstant = ONE, & - !radiationConstant = 0.01372_defReal, & ! GJ/(cm^3 keV^4) - !radiationConstant = 7.5657e-10_defReal, & ! J/(cm^3 K^-4) + radiationConstant = 0.01372_defReal, & ! GJ/(cm^3 keV^4) planckConst = 6.62607015e-30_defReal, & ! cm^2 kg/s boltzmannConst = 1.380649e-19_defReal ! cm^2 kg s^-2 K^-1 From 03806e54dd6362d75fbd1ba02a336808c99f1ab3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 6 Sep 2022 13:52:53 +0100 Subject: [PATCH 122/373] Subroutine to set type of calculation for material. Moved material initialisation in Physics Package --- NuclearData/IMCMaterial_inter.f90 | 19 +++++++++++++++++- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 20 +++++++++++++++++++ NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 17 ++++++++++++++++ PhysicsPackages/IMCPhysicsPackage_class.f90 | 16 ++++++++------- 4 files changed, 64 insertions(+), 8 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index c369f544b..3ecc4b0b5 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -36,6 +36,8 @@ module IMCMaterial_inter procedure(getFleck), deferred :: getFleck procedure(initProps), deferred :: initProps procedure(getTemp), deferred :: getTemp + procedure(setType), deferred :: setType + end type IMCMaterial abstract interface @@ -114,6 +116,22 @@ function getTemp(self) result(temp) real(defReal) :: temp end function getTemp + !! + !! Set the calculation type to be used + !! + !! Current options: + !! IMC + !! ISMC + !! + !! Errors: + !! Unrecognised option + !! + subroutine setType(self, calcType) + import :: IMCMaterial, shortInt + class(IMCMaterial), intent(inout) :: self + integer(shortInt), intent(in) :: calcType + end subroutine setType + end interface contains @@ -143,5 +161,4 @@ pure function IMCMaterial_CptrCast(source) result(ptr) end function IMCMaterial_CptrCast - end module IMCMaterial_inter diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 280248e7e..adda4b36b 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -85,6 +85,7 @@ module baseMgIMCMaterial_class procedure :: getFleck procedure :: initProps procedure :: getTemp + procedure :: setType procedure, private :: updateMatIMC procedure, private :: updateMatISMC @@ -505,4 +506,23 @@ function getTemp(self) result(temp) end function getTemp + !! + !! Set the calculation type to be used + !! + !! Current options: + !! IMC + !! ISMC + !! + !! Errors: + !! Unrecognised option + !! + subroutine setType(self, calcType) + class(baseMgIMCMaterial), intent(inout) :: self + integer(shortInt), intent(in) :: calcType + character(100), parameter :: Here = 'setType (baseMgIMCMaterial_class.f90)' + + self % calcType = calcType + + end subroutine setType + end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index a91ff90d1..52ea57e0a 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -48,6 +48,7 @@ module mgIMCMaterial_inter procedure(getFleck), deferred :: getFleck procedure(initProps), deferred :: initProps procedure(getTemp), deferred :: getTemp + procedure(setType), deferred :: setType end type mgIMCMaterial @@ -148,6 +149,22 @@ function getTemp(self) result(temp) real(defReal) :: temp end function getTemp + !! + !! Set the calculation type to be used + !! + !! Current options: + !! IMC + !! ISMC + !! + !! Errors: + !! Unrecognised option + !! + subroutine setType(self, calcType) + import :: mgIMCMaterial, shortInt + class(mgIMCMaterial), intent(inout) :: self + integer(shortInt), intent(in) :: calcType + end subroutine setType + end interface diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index ce7ba01ee..7d2de3358 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -162,12 +162,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call timerReset(self % timerMain) call timerStart(self % timerMain) - ! Attach initial properties to material classes - do j=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - call mat % initProps(self % deltaT, mm_matTemp(j), mm_matVol(j)) - end do - allocate(tallyEnergy(self % nMat)) ! Generate initial source distribution @@ -348,8 +342,9 @@ subroutine init(self, dict) character(:),allocatable :: string character(nameLen) :: nucData, energy, geomName type(outputFile) :: test_out - integer(shortInt) :: i + integer(shortInt) :: i, j character(nameLen), dimension(:), allocatable :: mats + class(IMCMaterial), pointer :: mat character(100), parameter :: Here ='init (IMCPhysicsPackage_class.f90)' call cpu_time(self % CPU_time_start) @@ -449,6 +444,13 @@ subroutine init(self, dict) mats(i) = mm_matName(i) end do + ! Attach initial properties to material classes + do j=1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + call mat % initProps(self % deltaT, mm_matTemp(j), mm_matVol(j)) + call mat % setType(IMC) + end do + ! Initialise imcWeight tally attachment call locDict1 % init(1) call locDict2 % init(2) From ae19e002478baf5cc4b6babba446ad542d31d23c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 6 Sep 2022 14:03:04 +0100 Subject: [PATCH 123/373] New physics package for ISMC --- PhysicsPackages/CMakeLists.txt | 1 + PhysicsPackages/ISMCPhysicsPackage_class.f90 | 506 ++++++++++++++++++ .../physicsPackageFactory_func.f90 | 9 + 3 files changed, 516 insertions(+) create mode 100644 PhysicsPackages/ISMCPhysicsPackage_class.f90 diff --git a/PhysicsPackages/CMakeLists.txt b/PhysicsPackages/CMakeLists.txt index bb1993929..ae12a73c4 100644 --- a/PhysicsPackages/CMakeLists.txt +++ b/PhysicsPackages/CMakeLists.txt @@ -5,6 +5,7 @@ add_sources( ./physicsPackage_inter.f90 ./eigenPhysicsPackage_class.f90 ./fixedSourcePhysicsPackage_class.f90 ./IMCPhysicsPackage_class.f90 + ./ISMCPhysicsPackage_class.f90 ./vizPhysicsPackage_class.f90 ./rayVolPhysicsPackage_class.f90 ) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 new file mode 100644 index 000000000..de9cd0a86 --- /dev/null +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -0,0 +1,506 @@ +module ISMCPhysicsPackage_class + + use numPrecision + use universalVariables + use endfConstants + use genericProcedures, only : fatalError, printFishLineR, numToChar, rotateVector + use hashFunctions_func, only : FNV_1 + use dictionary_class, only : dictionary + use outputFile_class, only : outputFile + + ! Timers + use timer_mod, only : registerTimer, timerStart, timerStop, & + timerTime, timerReset, secToChar + + ! Particle classes and Random number generator + use particle_class, only : particle, P_PHOTON + use particleDungeon_class, only : particleDungeon + use source_inter, only : source + use RNG_class, only : RNG + + ! Physics package interface + use physicsPackage_inter, only : physicsPackage + + ! Geometry + use geometry_inter, only : geometry + use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & + gr_geomIdx => geomIdx + + ! Nuclear Data + use materialMenu_mod, only : mm_nMat => nMat ,& + mm_matName => matName ,& + mm_matTemp => matTemp ,& + mm_matVol => matVol + use nuclearDataReg_mod, only : ndReg_init => init ,& + ndReg_activate => activate ,& + ndReg_display => display, & + ndReg_kill => kill, & + ndReg_get => get ,& + ndReg_getMatNames => getMatNames + use nuclearDatabase_inter, only : nuclearDatabase + use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast + use mgIMCMaterial_inter, only : mgIMCMaterial + + ! Operators + use collisionOperator_class, only : collisionOperator + use transportOperator_inter, only : transportOperator + + ! Tallies + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + use tallyResult_class, only : tallyResult + use imcWeightClerk_class, only : imcWeightResult + + ! Factories + use transportOperatorFactory_func, only : new_transportOperator + use sourceFactory_func, only : new_source + + implicit none + + private + + !! + !! Physics Package for ISMC calculations + !! + type, public,extends(physicsPackage) :: ISMCPhysicsPackage + private + ! Building blocks + class(nuclearDatabase), pointer :: nucData => null() + class(geometry), pointer :: geom => null() + integer(shortInt) :: geomIdx = 0 + type(collisionOperator) :: collOp + class(transportOperator), allocatable :: transOp + class(RNG), pointer :: pRNG => null() + type(tallyAdmin),pointer :: tally => null() + type(tallyAdmin),pointer :: imcWeightAtch => null() + + ! Settings + integer(shortInt) :: N_cycles + integer(shortInt) :: pop + real(defReal) :: deltaT + character(pathLen) :: outputFile + character(nameLen) :: outputFormat + integer(shortInt) :: printSource = 0 + integer(shortInt) :: particleType + integer(shortInt) :: imcSourceN + logical(defBool) :: sourceGiven = .false. + integer(shortInt) :: nMat + + ! Calculation components + type(particleDungeon), allocatable :: thisCycle + type(particleDungeon), allocatable :: nextCycle + ! Note that other physics packages used pointers for these particleDungeons ( => null() ) + ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed + class(source), allocatable :: inputSource + class(source), allocatable :: IMCSource + + ! Timer bins + integer(shortInt) :: timerMain + real (defReal) :: CPU_time_start + real (defReal) :: CPU_time_end + + contains + procedure :: init + procedure :: printSettings + procedure :: cycles + procedure :: collectResults + procedure :: run + procedure :: kill + + end type ISMCPhysicsPackage + +contains + + subroutine run(self) + class(ISMCPhysicsPackage), intent(inout) :: self + + print *, repeat("<>",50) + print *, "/\/\ ISMC CALCULATION /\/\" + + call self % cycles(self % tally, self % imcWeightAtch, self % N_cycles) + call self % collectResults() + + print * + print *, "\/\/ END OF ISMC CALCULATION \/\/" + print * + end subroutine + + !! + !! Run cycles for calculation + !! + subroutine cycles(self, tally, tallyAtch, N_cycles) + class(ISMCPhysicsPackage), intent(inout) :: self + type(tallyAdmin), pointer,intent(inout) :: tally + type(tallyAdmin), pointer,intent(inout) :: tallyAtch + integer(shortInt), intent(in) :: N_cycles + integer(shortInt) :: i, j, N + type(particle) :: p + real(defReal) :: elapsed_T, end_T, T_toEnd, sumT + real(defReal), dimension(:), allocatable :: tallyEnergy + class(IMCMaterial), pointer :: mat + logical(defBool) :: printUpdates + character(100),parameter :: Here ='cycles (ISMCPhysicsPackage_class.f90)' + class(tallyResult), allocatable :: tallyRes + + ! Set whether or not to print energy and temperature updates of each material + ! Printed from updateMat (baseMgIMCMaterial_class.f90), 7 lines of text + ! per material so recommend to only print when low number of materials + if (self % nMat <= 5) then + printUpdates = .True. + else + printUpdates = .False. + end if + + N = self % pop + + ! Attach nuclear data and RNG to particle + p % pRNG => self % pRNG + p % timeMax = self % deltaT + p % geomIdx = self % geomIdx + + ! Reset and start timer + call timerReset(self % timerMain) + call timerStart(self % timerMain) + + allocate(tallyEnergy(self % nMat)) + + ! Generate initial source distribution + !if( self % sourceGiven ) then + ! call self % inputSource % generate(self % nextCycle, self % imcSourceN, p % pRNG) + !end if + + do i=1,N_cycles + + ! Store photons remaining from previous cycle + self % thisCycle = self % nextCycle + call self % nextCycle % cleanPop() + + + ! Check that there are regions of non-zero temperature by summing mat temperatures + sumT = 0 + do j=1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + sumT = sumT + mat % getTemp() + end do + + ! Generate ISMC source, only if there are regions with non-zero temperature + if(sumT > 0) then + call self % IMCSource % appendIMC(self % thisCycle, self % imcSourceN, p % pRNG) + end if + + ! Generate from input source + if( self % sourceGiven ) then + call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) + end if + + if(self % printSource == 1) then + call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + end if + + call tally % reportCycleStart(self % thisCycle) + + gen: do + ! Obtain paticle from dungeon + call self % thisCycle % release(p) + call self % geom % placeCoord(p % coords) + + ! Assign particle time + if( p % time /= self % deltaT ) then + ! If particle has just been sourced, t = 0 so sample uniformly within timestep + p % time = p % pRNG % get() * self % deltaT + else + ! If particle survived previous time step, reset time to 0 + p % time = 0 + end if + + ! Save state + call p % savePreHistory() + + ! Transport particle until its death + history: do + call self % transOp % transport(p, tally, self % thisCycle, self % nextCycle) + if(p % isDead) exit history + + if(p % fate == TIME_FATE) then + ! Store particle for use in next time step + p % fate = 0 + call self % nextCycle % detain(p) + exit history + end if + + call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) + + if(p % isDead) exit history + + end do history + + ! When dungeon is empty, exit + if( self % thisCycle % isEmpty() ) exit gen + + end do gen + + ! Send end of cycle report + call tally % reportCycleEnd(self % thisCycle) + + ! Calculate times + call timerStop(self % timerMain) + elapsed_T = timerTime(self % timerMain) + + ! Predict time to end + end_T = real(N_cycles,defReal) * elapsed_T / i + T_toEnd = max(ZERO, end_T - elapsed_T) + + ! Display progress + call printFishLineR(i) + print * + print * + print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) + print *, 'Pop: ', numToChar(self % nextCycle % getSize()) + 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() + + ! Obtain energy deposition tally results + call tallyAtch % getResult(tallyRes, 'imcWeight') + + select type(tallyRes) + class is(imcWeightResult) + do j = 1, self % nMat + tallyEnergy(j) = tallyRes % imcWeight(j) + end do + class default + call fatalError(Here, 'Invalid result has been returned') + end select + + ! Update material properties + do j = 1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + if (printUpdates .eqv. .True.) then + print * + print *, "Material update: ", mm_matName(j) + end if + call mat % updateMat(tallyEnergy(j), printUpdates) + end do + print * + + ! Reset tally for next cycle + call tallyAtch % reset('imcWeight') + + print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_cycles) + + end do + + end subroutine cycles + + !! + !! Print calculation results to file + !! + subroutine collectResults(self) + class(ISMCPhysicsPackage), intent(inout) :: self + type(outputFile) :: out + character(nameLen) :: name + + call out % init(self % outputFormat) + + name = 'seed' + call out % printValue(self % pRNG % getSeed(),name) + + name = 'pop' + call out % printValue(self % pop,name) + + name = 'Source_batches' + call out % printValue(self % N_cycles,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 = 'Transport_time' + call out % printValue(timerTime(self % timerMain),name) + + ! Print tally + call self % tally % print(out) + + call out % writeToFile(self % outputFile) + + end subroutine collectResults + + + !! + !! Initialise from individual components and dictionaries for source and tally + !! + subroutine init(self, dict) + class(ISMCPhysicsPackage), intent(inout) :: self + class(dictionary), intent(inout) :: dict + class(dictionary),pointer :: tempDict + type(dictionary) :: locDict1, locDict2, locDict3 + integer(shortInt) :: seed_temp + integer(longInt) :: seed + character(10) :: time + character(8) :: date + character(:),allocatable :: string + character(nameLen) :: nucData, energy, geomName + type(outputFile) :: test_out + integer(shortInt) :: i, j + character(nameLen), dimension(:), allocatable :: mats + class(IMCMaterial), pointer :: mat + character(100), parameter :: Here ='init (ISMCPhysicsPackage_class.f90)' + + call cpu_time(self % CPU_time_start) + + ! Read calculation settings + call dict % get( self % pop,'pop') + call dict % get( self % N_cycles,'cycles') + call dict % get( self % deltaT,'timeStepSize') + call dict % get( nucData, 'XSdata') + call dict % get( energy, 'dataType') + + ! Process type of data + select case(energy) + case('mg') + self % particleType = P_PHOTON_MG + !case('ce') + ! self % particleType = P_PHOTON_CE + case default + call fatalError(Here,"dataType must be 'mg' or 'ce'.") + end select + + ! 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) + + ! Register timer + self % timerMain = registerTimer('transportTime') + + ! Initialise RNG + allocate(self % pRNG) + + ! *** It is a bit silly but dictionary cannot store longInt for now + ! so seeds are limited to 32 bits (can be -ve) + 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 % pRNG % init(seed) + + ! Read whether to print particle source per cycle + call dict % getOrDefault(self % printSource, 'printSource', 0) + + ! Build Nuclear Data + call ndReg_init(dict % getDictPtr("nuclearData")) + + ! Build geometry + tempDict => dict % getDictPtr('geometry') + geomName = 'ISMCGeom' + call gr_addGeom(geomName, tempDict) + 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()) + self % nucData => ndReg_get(self % particleType) + + ! Read particle source definition + if( dict % isPresent('source') ) then + tempDict => dict % getDictPtr('source') + call new_source(self % inputSource, tempDict, self % geom) + self % sourceGiven = .true. + end if + tempDict => dict % getDictPtr('imcSource') + call new_source(self % IMCSource, tempDict, self % geom) + call tempDict % get(self % imcSourceN, 'nParticles') + + ! Build collision operator + tempDict => dict % getDictPtr('collisionOperator') + call self % collOp % init(tempDict) + + ! Build transport operator + tempDict => dict % getDictPtr('transportOperator') + call new_transportOperator(self % transOp, tempDict) + + ! Initialise tally Admin + tempDict => dict % getDictPtr('tally') + allocate(self % tally) + call self % tally % init(tempDict) + + ! Store number of materials + self % nMat = mm_nMat() + + ! Create array of material names + allocate(mats(self % nMat)) + do i=1, self % nMat + mats(i) = mm_matName(i) + end do + + ! Attach initial properties to material classes + do j=1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + call mat % initProps(self % deltaT, mm_matTemp(j), mm_matVol(j)) + call mat % setType(ISMC) + end do + + ! Initialise imcWeight tally attachment + call locDict1 % init(1) + call locDict2 % init(2) + call locDict3 % init(2) + + call locDict3 % store('type','materialMap') + call locDict3 % store('materials', [mats]) + call locDict2 % store('type','imcWeightClerk') + call locDict2 % store('map', locDict3) + call locDict1 % store('imcWeight', locDict2) + + allocate(self % imcWeightAtch) + call self % imcWeightAtch % init(locDict1) + + call self % tally % push(self % imcWeightAtch) + + ! Size particle dungeon + allocate(self % thisCycle) + call self % thisCycle % init(15 * self % pop) + allocate(self % nextCycle) + call self % nextCycle % init(10 * self % pop) + + call self % printSettings() + + end subroutine init + + !! + !! Deallocate memory + !! + subroutine kill(self) + class(ISMCPhysicsPackage), intent(inout) :: self + + ! TODO: This subroutine + + end subroutine kill + + !! + !! Print settings of the physics package + !! + subroutine printSettings(self) + class(ISMCPhysicsPackage), intent(in) :: self + + print *, repeat("<>",50) + print *, "/\/\ ISMC CALCULATION /\/\" + print *, "Source batches: ", numToChar(self % N_cycles) + print *, "Population per batch: ", numToChar(self % pop) + print *, "Initial RNG Seed: ", numToChar(self % pRNG % getSeed()) + print * + print *, repeat("<>",50) + end subroutine printSettings + + +end module ISMCPhysicsPackage_class diff --git a/PhysicsPackages/physicsPackageFactory_func.f90 b/PhysicsPackages/physicsPackageFactory_func.f90 index 5d82bddbb..f44bd5e32 100644 --- a/PhysicsPackages/physicsPackageFactory_func.f90 +++ b/PhysicsPackages/physicsPackageFactory_func.f90 @@ -16,6 +16,7 @@ module physicsPackageFactory_func use vizPhysicsPackage_class, only : vizPhysicsPackage use rayVolPhysicsPackage_class, only : rayVolPhysicsPackage use IMCPhysicsPackage_class, only : IMCPhysicsPackage + use ISMCPhysicsPackage_class, only : ISMCPhysicsPackage implicit none private @@ -28,6 +29,7 @@ module physicsPackageFactory_func character(nameLen),dimension(*),parameter :: AVAILABLE_physicsPackages = [ 'eigenPhysicsPackage ',& 'fixedSourcePhysicsPackage',& 'IMCPhysicsPackage ',& + 'ISMCPhysicsPackage ',& 'vizPhysicsPackage ',& 'rayVolPhysicsPackage '] @@ -80,6 +82,13 @@ function new_physicsPackage(dict) result(new) call new % init(dict) end select + case('ISMCPhysicsPackage') + ! Allocate and initialise + allocate( ISMCPhysicsPackage :: new) + select type(new) + type is (ISMCPhysicsPackage) + call new % init(dict) + end select case('vizPhysicsPackage') ! Allocate and initialise From bb6476c8df832b14542c6f98768bef9472f9098b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 6 Sep 2022 18:52:51 +0100 Subject: [PATCH 124/373] Function to return energy density --- NuclearData/IMCMaterial_inter.f90 | 10 ++++++++++ .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 12 ++++++++++++ NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 10 ++++++++++ 3 files changed, 32 insertions(+) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 3ecc4b0b5..3d0129ad9 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -36,6 +36,7 @@ module IMCMaterial_inter procedure(getFleck), deferred :: getFleck procedure(initProps), deferred :: initProps procedure(getTemp), deferred :: getTemp + procedure(getEnergyDens), deferred :: getEnergyDens procedure(setType), deferred :: setType end type IMCMaterial @@ -116,6 +117,15 @@ function getTemp(self) result(temp) real(defReal) :: temp end function getTemp + !! + !! Return energy per unit volume of material + !! + function getEnergyDens(self) result(energyDens) + import :: IMCMaterial, defReal + class(IMCMaterial), intent(inout) :: self + real(defReal) :: energyDens + end function getEnergyDens + !! !! Set the calculation type to be used !! diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index adda4b36b..918d9c7bd 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -85,6 +85,7 @@ module baseMgIMCMaterial_class procedure :: getFleck procedure :: initProps procedure :: getTemp + procedure :: getEnergyDens procedure :: setType procedure, private :: updateMatIMC @@ -506,6 +507,17 @@ function getTemp(self) result(temp) end function getTemp + !! + !! Return energy per unit volume of material + !! + function getEnergyDens(self) result(energyDens) + class(baseMgIMCMaterial), intent(inout) :: self + real(defReal) :: energyDens + + energyDens = poly_eval(self % updateEqn, self % T) + + end function getEnergyDens + !! !! Set the calculation type to be used !! diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 52ea57e0a..b5656fbd2 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -48,6 +48,7 @@ module mgIMCMaterial_inter procedure(getFleck), deferred :: getFleck procedure(initProps), deferred :: initProps procedure(getTemp), deferred :: getTemp + procedure(getEnergyDens), deferred :: getEnergyDens procedure(setType), deferred :: setType end type mgIMCMaterial @@ -149,6 +150,15 @@ function getTemp(self) result(temp) real(defReal) :: temp end function getTemp + !! + !! Return energy per unit volume of material + !! + function getEnergyDens(self) result(energyDens) + import :: mgIMCMaterial, defReal + class(mgIMCMaterial), intent(inout) :: self + real(defReal) :: energyDens + end function getEnergyDens + !! !! Set the calculation type to be used !! From 40b3f23b3105e1f1d792f1b6a2799c59823e17cb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 6 Sep 2022 18:53:19 +0100 Subject: [PATCH 125/373] New source module for ISMC (work in progress) --- ParticleObjects/Source/CMakeLists.txt | 5 +- ParticleObjects/Source/ISMCSource_class.f90 | 199 ++++++++++++++++++++ 2 files changed, 202 insertions(+), 2 deletions(-) create mode 100644 ParticleObjects/Source/ISMCSource_class.f90 diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index 29ea31784..8bf535d0c 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -1,9 +1,10 @@ # Add Source Files to the global list add_sources( source_inter.f90 configSource_inter.f90 - sourceFactory_func.f90 - pointSource_class.f90 + sourceFactory_func.f90 + pointSource_class.f90 fissionSource_class.f90 IMCSource_class.f90 + ISMCSource_class.f90 surfaceSource_class.f90 ) diff --git a/ParticleObjects/Source/ISMCSource_class.f90 b/ParticleObjects/Source/ISMCSource_class.f90 new file mode 100644 index 000000000..25a8b393f --- /dev/null +++ b/ParticleObjects/Source/ISMCSource_class.f90 @@ -0,0 +1,199 @@ +module ISMCSource_class + + use numPrecision + use endfConstants + use universalVariables + use genericProcedures, only : fatalError, rotateVector + use dictionary_class, only : dictionary + use RNG_class, only : RNG + + use particle_class, only : particleState, P_PHOTON + use particleDungeon_class, only : particleDungeon + use source_inter, only : source, kill_super => kill + + use geometry_inter, only : geometry + use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast + use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase + use materialMenu_mod, only : MMnMat => nMat + + implicit none + private + + !! + !! ISMC Source for uniform generation of photons within material regions + !! + !! Angular distribution is isotropic. + !! + !! Private members: + !! isMG -> is the source multi-group? (default = .false.) + !! bottom -> Bottom corner (x_min, y_min, z_min) + !! top -> Top corner (x_max, y_max, z_max) + !! E -> Fission site energy [MeV] (default = 1.0E-6) + !! G -> Fission site Group (default = 1) + !! + !! Interface: + !! source_inter Interface + !! + !! SAMPLE INPUT: + !! ismcSource { type ISMCSource; nParticles 100; } + !! + type, public,extends(source) :: imcSource + private + logical(defBool) :: isMG = .true. + real(defReal), dimension(3) :: bottom = ZERO + real(defReal), dimension(3) :: top = ZERO + real(defReal) :: E = ZERO + integer(shortInt) :: G = 0 + integer(shortInt) :: nParticles = 10 + real(defReal) :: boundingVol = ZERO + contains + procedure :: init + procedure :: sampleParticle + procedure :: kill + end type imcSource + +contains + + !! + !! Initialise IMC Source + !! + !! See source_inter for details + !! + subroutine init(self, dict, geom) + class(imcSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + character(nameLen) :: type + real(defReal), dimension(6) :: bounds + real(defReal), dimension(3) :: boundSize + integer(shortInt) :: i, n + character(100), parameter :: Here = 'init (imcSource_class.f90)' + + ! Provide geometry info to source + self % geom => geom + + call dict % getOrDefault(self % G, 'G', 1) + call dict % getOrDefault(self % nParticles, 'nParticles', 10) + + ! Set bounding region + bounds = self % geom % bounds() + self % bottom = bounds(1:3) + self % top = bounds(4:6) + + ! Calculate volume of bounding region + boundSize = self % top - self % bottom + self % boundingVol = boundSize(1) * boundSize(2) * boundSize(3) + +! ! Initialise array to store numbers of particles +! n = MMnMat() +! allocate( self % matPops(n) ) +! do i=1, n +! self % matPops(i) = 0 +! end do + + end subroutine init + + !! + !! Sample particle's phase space co-ordinates + !! + !! See source_inter for details + !! + function sampleParticle(self, rand) result(p) + class(imcSource), intent(inout) :: self + class(RNG), intent(inout) :: rand + type(particleState) :: p + class(nuclearDatabase), pointer :: nucData + class(IMCMaterial), pointer :: mat + real(defReal), dimension(3) :: r, rand3, dir + ! Here, i is a float to allow more precise control of loop + real(defReal) :: mu, phi, i + integer(shortInt) :: matIdx, uniqueID, nucIdx + character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' + + ! Get pointer to appropriate nuclear database + nucData => ndReg_getIMCMG() + if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') + + ! Position is sampled by taking a random point from within geometry bounding box + ! If in valid material, position is accepted + i = 0 + rejection : do + ! Protect against infinite loop + i = i + 1 + if ( i > 200) then + call fatalError(Here, '200 particles in a row sampled in void or outside material.& + & Check that geometry is as intended') + end if + + ! Sample Position + rand3(1) = rand % get() + rand3(2) = rand % get() + rand3(3) = rand % get() + r = (self % top - self % bottom) * rand3 + self % bottom + + ! Find material under position + call self % geom % whatIsAt(matIdx, uniqueID, r) + + ! Reject if there is no material + if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle rejection + + ! Point to material + mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) + if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") + + ! Sample Direction - chosen uniformly inside unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + + ! Assign basic phase-space coordinates + p % matIdx = matIdx + p % uniqueID = uniqueID + p % time = ZERO + p % type = P_PHOTON + p % r = r + p % dir = dir + p % G = self % G + p % isMG = .true. + + p % wgt = mat % getEnergyDens() * self % boundingVol / self % nParticles + +! ! Don't sample particles from areas of 0 temperature +! if( p % wgt == 0 ) then +! self % matPops(matIdx) = 1 ! Set to 1 to avoid error in appendIMC (source_inter.f90) +! i = i - 0.9 ! To allow more attempts if large regions with 0 temp +! cycle rejection +! end if + +! ! Increase counter of number of particles in material in order to normalise later +! self % matPops(matIdx) = self % matPops(matIdx) + 1 + + ! Exit the loop + exit rejection + + end do rejection + + end function sampleParticle + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(imcSource), intent(inout) :: self + + !call kill_super(self) + + self % isMG = .true. + self % bottom = ZERO + self % top = ZERO + self % E = ZERO + self % G = 0 + self % nParticles = 10 + + end subroutine kill + +end module ISMCSource_class From e449c1e8b1635663c4cf38fb7569476b6c2b86d3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 6 Sep 2022 19:15:58 +0100 Subject: [PATCH 126/373] More source work --- ParticleObjects/Source/ISMCSource_class.f90 | 25 ++++---- ParticleObjects/Source/sourceFactory_func.f90 | 6 ++ PhysicsPackages/ISMCPhysicsPackage_class.f90 | 57 ++++++++++--------- 3 files changed, 47 insertions(+), 41 deletions(-) diff --git a/ParticleObjects/Source/ISMCSource_class.f90 b/ParticleObjects/Source/ISMCSource_class.f90 index 25a8b393f..875f13b5e 100644 --- a/ParticleObjects/Source/ISMCSource_class.f90 +++ b/ParticleObjects/Source/ISMCSource_class.f90 @@ -36,23 +36,20 @@ module ISMCSource_class !! Interface: !! source_inter Interface !! - !! SAMPLE INPUT: - !! ismcSource { type ISMCSource; nParticles 100; } - !! - type, public,extends(source) :: imcSource + type, public,extends(source) :: ismcSource private logical(defBool) :: isMG = .true. real(defReal), dimension(3) :: bottom = ZERO real(defReal), dimension(3) :: top = ZERO real(defReal) :: E = ZERO integer(shortInt) :: G = 0 - integer(shortInt) :: nParticles = 10 + integer(shortInt) :: N = 10 real(defReal) :: boundingVol = ZERO contains procedure :: init procedure :: sampleParticle procedure :: kill - end type imcSource + end type ismcSource contains @@ -62,20 +59,20 @@ module ISMCSource_class !! See source_inter for details !! subroutine init(self, dict, geom) - class(imcSource), intent(inout) :: self + class(ismcSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom character(nameLen) :: type real(defReal), dimension(6) :: bounds real(defReal), dimension(3) :: boundSize integer(shortInt) :: i, n - character(100), parameter :: Here = 'init (imcSource_class.f90)' + character(100), parameter :: Here = 'init (ismcSource_class.f90)' ! Provide geometry info to source self % geom => geom call dict % getOrDefault(self % G, 'G', 1) - call dict % getOrDefault(self % nParticles, 'nParticles', 10) + call dict % getOrDefault(self % N, 'N', 10) ! Set bounding region bounds = self % geom % bounds() @@ -101,7 +98,7 @@ end subroutine init !! See source_inter for details !! function sampleParticle(self, rand) result(p) - class(imcSource), intent(inout) :: self + class(ismcSource), intent(inout) :: self class(RNG), intent(inout) :: rand type(particleState) :: p class(nuclearDatabase), pointer :: nucData @@ -110,7 +107,7 @@ function sampleParticle(self, rand) result(p) ! Here, i is a float to allow more precise control of loop real(defReal) :: mu, phi, i integer(shortInt) :: matIdx, uniqueID, nucIdx - character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' + character(100), parameter :: Here = 'sampleParticle (ismcSource_class.f90)' ! Get pointer to appropriate nuclear database nucData => ndReg_getIMCMG() @@ -160,7 +157,7 @@ function sampleParticle(self, rand) result(p) p % G = self % G p % isMG = .true. - p % wgt = mat % getEnergyDens() * self % boundingVol / self % nParticles + p % wgt = mat % getEnergyDens() * self % boundingVol / self % N ! ! Don't sample particles from areas of 0 temperature ! if( p % wgt == 0 ) then @@ -183,7 +180,7 @@ end function sampleParticle !! Return to uninitialised state !! elemental subroutine kill(self) - class(imcSource), intent(inout) :: self + class(ismcSource), intent(inout) :: self !call kill_super(self) @@ -192,7 +189,7 @@ elemental subroutine kill(self) self % top = ZERO self % E = ZERO self % G = 0 - self % nParticles = 10 + self % N = 10 end subroutine kill diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index f06846fea..655e42fb6 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -11,6 +11,7 @@ module sourceFactory_func use pointSource_class, only : pointSource use fissionSource_class, only : fissionSource use IMCSource_class, only : imcSource + use ISMCSource_class, only : ismcSource use surfaceSource_class, only : surfaceSource ! geometry @@ -29,6 +30,7 @@ module sourceFactory_func character(nameLen),dimension(*),parameter :: AVAILABLE_sources = [ 'pointSource ',& 'fissionSource',& 'imcSource ',& + 'ismcSource ',& 'surfaceSource'] contains @@ -65,6 +67,10 @@ subroutine new_source(new, dict, geom) allocate(imcSource :: new) call new % init(dict, geom) + case('ismcSource') + allocate(ismcSource :: new) + call new % init(dict, geom) + case('surfaceSource') allocate(surfaceSource :: new) call new % init(dict, geom) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index de9cd0a86..81899bc51 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -92,7 +92,7 @@ module ISMCPhysicsPackage_class ! Note that other physics packages used pointers for these particleDungeons ( => null() ) ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed class(source), allocatable :: inputSource - class(source), allocatable :: IMCSource + class(source), allocatable :: ISMCSource ! Timer bins integer(shortInt) :: timerMain @@ -177,25 +177,25 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Check that there are regions of non-zero temperature by summing mat temperatures - sumT = 0 - do j=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - sumT = sumT + mat % getTemp() - end do + !sumT = 0 + !do j=1, self % nMat + ! mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + ! sumT = sumT + mat % getTemp() + !end do ! Generate ISMC source, only if there are regions with non-zero temperature - if(sumT > 0) then - call self % IMCSource % appendIMC(self % thisCycle, self % imcSourceN, p % pRNG) - end if + !if(sumT > 0) then + ! call self % ISMCSource % appendIMC(self % thisCycle, self % imcSourceN, p % pRNG) + !end if ! Generate from input source - if( self % sourceGiven ) then - call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) - end if + !if( self % sourceGiven ) then + ! call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) + !end if - if(self % printSource == 1) then - call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) - end if + !if(self % printSource == 1) then + ! call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + !end if call tally % reportCycleStart(self % thisCycle) @@ -334,7 +334,7 @@ subroutine init(self, dict) class(ISMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict class(dictionary),pointer :: tempDict - type(dictionary) :: locDict1, locDict2, locDict3 + type(dictionary) :: locDict1, locDict2, locDict3, locDict4 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -418,9 +418,12 @@ subroutine init(self, dict) call new_source(self % inputSource, tempDict, self % geom) self % sourceGiven = .true. end if - tempDict => dict % getDictPtr('imcSource') - call new_source(self % IMCSource, tempDict, self % geom) - call tempDict % get(self % imcSourceN, 'nParticles') + + ! Initialise ISMC source + call locDict1 % init(2) + call locDict1 % store('type', 'ismcSource') + call locDict1 % store('N', self % pop) + call new_source(self % ISMCSource, locDict1, self % geom) ! Build collision operator tempDict => dict % getDictPtr('collisionOperator') @@ -452,18 +455,18 @@ subroutine init(self, dict) end do ! Initialise imcWeight tally attachment - call locDict1 % init(1) - call locDict2 % init(2) + call locDict2 % init(1) call locDict3 % init(2) + call locDict4 % init(2) - call locDict3 % store('type','materialMap') - call locDict3 % store('materials', [mats]) - call locDict2 % store('type','imcWeightClerk') - call locDict2 % store('map', locDict3) - call locDict1 % store('imcWeight', locDict2) + call locDict4 % store('type','materialMap') + call locDict4 % store('materials', [mats]) + call locDict3 % store('type','imcWeightClerk') + call locDict3 % store('map', locDict4) + call locDict2 % store('imcWeight', locDict3) allocate(self % imcWeightAtch) - call self % imcWeightAtch % init(locDict1) + call self % imcWeightAtch % init(locDict2) call self % tally % push(self % imcWeightAtch) From 9bfef0c3e91bcc48d2432dfce555d9588e343f6b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 7 Sep 2022 13:50:49 +0100 Subject: [PATCH 127/373] Introduced new type of particle for material photons --- NuclearData/nuclearDataReg_mod.f90 | 6 ++++- ParticleObjects/Source/ISMCSource_class.f90 | 4 ++-- ParticleObjects/particle_class.f90 | 26 +++++++++++++++------ 3 files changed, 26 insertions(+), 10 deletions(-) diff --git a/NuclearData/nuclearDataReg_mod.f90 b/NuclearData/nuclearDataReg_mod.f90 index f439218c3..bfbbc7bc9 100644 --- a/NuclearData/nuclearDataReg_mod.f90 +++ b/NuclearData/nuclearDataReg_mod.f90 @@ -54,7 +54,7 @@ module nuclearDataReg_mod use numPrecision - use universalVariables, only : P_NEUTRON_CE, P_NEUTRON_MG, P_PHOTON_MG + use universalVariables, only : P_NEUTRON_CE, P_NEUTRON_MG, P_PHOTON_MG, P_MATERIAL_MG use genericProcedures, only : fatalError, numToChar, printParticleType use charMap_class, only : charMap use dictionary_class, only : dictionary @@ -513,6 +513,10 @@ function get_byType(type, where) result(ptr) case(P_PHOTON_MG) ptr => getIMCMG() + case(P_MATERIAL_MG) + ! Currently only used for ISMC so point to same database + ptr => getIMCMG() + case default ptr => null() end select diff --git a/ParticleObjects/Source/ISMCSource_class.f90 b/ParticleObjects/Source/ISMCSource_class.f90 index 875f13b5e..ef16dcd72 100644 --- a/ParticleObjects/Source/ISMCSource_class.f90 +++ b/ParticleObjects/Source/ISMCSource_class.f90 @@ -7,7 +7,7 @@ module ISMCSource_class use dictionary_class, only : dictionary use RNG_class, only : RNG - use particle_class, only : particleState, P_PHOTON + use particle_class, only : particleState, P_MATERIAL use particleDungeon_class, only : particleDungeon use source_inter, only : source, kill_super => kill @@ -151,7 +151,7 @@ function sampleParticle(self, rand) result(p) p % matIdx = matIdx p % uniqueID = uniqueID p % time = ZERO - p % type = P_PHOTON + p % type = P_MATERIAL p % r = r p % dir = dir p % G = self % G diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index edad2b01e..c4f79a7d6 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -13,8 +13,9 @@ module particle_class !! !! Particle types paramethers !! - integer(shortInt), parameter,public :: P_NEUTRON = 1,& - P_PHOTON = 2 + integer(shortInt), parameter,public :: P_NEUTRON = 1,& + P_PHOTON = 2,& + P_MATERIAL = 3 !! !! Public particle type procedures @@ -405,7 +406,7 @@ end function matIdx !! None !! !! Result: - !! P_NEUTRON_CE, P_NEUTRON_MG, P_PHOTON_MG + !! P_NEUTRON_CE, P_NEUTRON_MG, P_PHOTON_MG, P_MATERIAL_MG !! !! Errors: !! None @@ -414,12 +415,19 @@ pure function getType(self) result(type) class(particle), intent(in) :: self integer(shortInt) :: type - if (self % type == P_PHOTON) then + if (self % type == P_NEUTRON) then + if (self % isMG) then + type = P_NEUTRON_MG + else + type = P_NEUTRON_CE + end if + + else if (self % type == P_PHOTON) then type = P_PHOTON_MG - else if (self % isMG) then - type = P_NEUTRON_MG + else - type = P_NEUTRON_CE + type = P_MATERIAL_MG + end if end function getType @@ -716,6 +724,7 @@ elemental function verifyType(type) result(isValid) ! Check against particles types isValid = isValid .or. type == P_NEUTRON isValid = isValid .or. type == P_PHOTON + isValid = isValid .or. type == P_MATERIAL end function verifyType @@ -733,6 +742,9 @@ pure function printType(type) result(name) case(P_PHOTON) name = 'Photon' + case(P_MATERIAL) + name = 'Material' + case default name = 'INVALID PARTICLE TYPE' From e14d168d7a15dba2511c517a15c8329bb9df26ac Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 7 Sep 2022 13:51:52 +0100 Subject: [PATCH 128/373] Missed file for commit --- SharedModules/universalVariables.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index da6b349ee..e181143f5 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -56,9 +56,10 @@ module universalVariables Z_AXIS = 3 ! Particle Type Enumeration - integer(shortInt), parameter :: P_NEUTRON_CE = 1, & - P_NEUTRON_MG = 2, & - P_PHOTON_MG = 3 + integer(shortInt), parameter :: P_NEUTRON_CE = 1, & + P_NEUTRON_MG = 2, & + P_PHOTON_MG = 3, & + P_MATERIAL_MG = 4 ! IMC Calculation Type integer(shortInt), parameter :: IMC = 1, & From 10387b583d9ae9df0c6c35d08a8408cc35488e8d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 7 Sep 2022 13:52:33 +0100 Subject: [PATCH 129/373] Transforms material particles into radiation photons --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 19 ++++++--- .../transportOperatorIMC_class.f90 | 39 ++++++++++++++++++- 2 files changed, 50 insertions(+), 8 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 81899bc51..bee18166a 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -89,6 +89,7 @@ module ISMCPhysicsPackage_class ! Calculation components type(particleDungeon), allocatable :: thisCycle type(particleDungeon), allocatable :: nextCycle + type(particleDungeon), allocatable :: matPhotons ! Note that other physics packages used pointers for these particleDungeons ( => null() ) ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed class(source), allocatable :: inputSource @@ -169,6 +170,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! call self % inputSource % generate(self % nextCycle, self % imcSourceN, p % pRNG) !end if + ! Generate initial material photons + call self % ISMCSource % generate(self % matPhotons, self % pop, p % pRNG) + do i=1,N_cycles ! Store photons remaining from previous cycle @@ -201,7 +205,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) gen: do ! Obtain paticle from dungeon - call self % thisCycle % release(p) + call self % matPhotons % release(p) call self % geom % placeCoord(p % coords) ! Assign particle time @@ -228,9 +232,10 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) exit history end if - call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) - - if(p % isDead) exit history + if (p % type == P_PHOTON) then + call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) + if(p % isDead) exit history + end if end do history @@ -472,9 +477,11 @@ subroutine init(self, dict) ! Size particle dungeon allocate(self % thisCycle) - call self % thisCycle % init(15 * self % pop) + call self % thisCycle % init(self % pop) allocate(self % nextCycle) - call self % nextCycle % init(10 * self % pop) + call self % nextCycle % init(self % pop) + allocate(self % matPhotons) + call self % matPhotons % init(self % pop) call self % printSettings() diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 91a9d0b63..340edcdb9 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -32,7 +32,8 @@ module transportOperatorIMC_class !! type, public, extends(transportOperator) :: transportOperatorIMC contains - procedure :: transit => imcTracking + procedure :: transit => imcTracking + procedure, private :: materialTransform end type transportOperatorIMC contains @@ -51,11 +52,17 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) IMCLoop:do + ! Deal with material particles, only relevant for ISMC + if(p % getType() == P_MATERIAL_MG) then + call self % materialTransform(p) + if(p % fate == TIME_FATE) exit IMCLoop + end if + ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) ! Sample distance to move particle before potential collision - dColl = -log( p% pRNG % get() ) * majorant_inv + dColl = -log( p % pRNG % get() ) * majorant_inv ! Determine which distance to move particle if (dColl < dTime) then @@ -99,4 +106,32 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) end subroutine imcTracking + !! + !! Transform material particles into radiation photons with + !! probability per unit time of c*sigma_a*fleck*eta + !! + !! Used only for ISMC, not for standard IMC + !! + subroutine materialTransform(self, p) + class(transportOperatorIMC), intent(inout) :: self + class(particle), intent(inout) :: p + character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' + + ! Confirm that time = 0 + !if (p % time .ne. 0) call fatalError(Here, 'Material particle should have time = 0') + + ! Sample time to transform into radiation photon + p % time = -log( p % pRNG % get() ) !! Placeholder eqn. + + ! Exit loop if particle remains material until end of time step + if (p % time >= p % timeMax) then + p % fate = TIME_FATE + p % time = p % timeMax + else + p % type = P_PHOTON_MG + end if + + end subroutine materialTransform + + end module transportOperatorIMC_class From 4a1755a784b3510e605c718e0cfda3d3e1243c7f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 8 Sep 2022 12:19:52 +0100 Subject: [PATCH 130/373] More work on dungeons, and work on tally --- .../CollisionProcessors/IMCMGstd_class.f90 | 2 +- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 45 +++++++++---------- Tallies/TallyClerks/imcWeightClerk_class.f90 | 4 +- .../transportOperatorIMC_class.f90 | 17 ++++--- 4 files changed, 35 insertions(+), 33 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 565113744..2b981f740 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -101,7 +101,7 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) ! Verify that particle is MG PHOTON if( .not. p % isMG .or. p % type /= P_PHOTON) then - call fatalError(Here, 'Supports only MG PHOTON. Was given NEUTRON and/or CE '//printType(p % type)) + call fatalError(Here, 'Supports only MG PHOTON. Was given NEUTRON or MATERIAL and/or CE '//printType(p % type)) end if ! Verify and load nuclear data pointer diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index bee18166a..7a503f32c 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -13,7 +13,7 @@ module ISMCPhysicsPackage_class timerTime, timerReset, secToChar ! Particle classes and Random number generator - use particle_class, only : particle, P_PHOTON + use particle_class, only : particle, P_PHOTON, P_MATERIAL use particleDungeon_class, only : particleDungeon use source_inter, only : source use RNG_class, only : RNG @@ -165,13 +165,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) allocate(tallyEnergy(self % nMat)) - ! Generate initial source distribution - !if( self % sourceGiven ) then - ! call self % inputSource % generate(self % nextCycle, self % imcSourceN, p % pRNG) - !end if - ! Generate initial material photons - call self % ISMCSource % generate(self % matPhotons, self % pop, p % pRNG) + call self % ISMCSource % generate(self % nextCycle, self % pop, p % pRNG) do i=1,N_cycles @@ -179,19 +174,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) self % thisCycle = self % nextCycle call self % nextCycle % cleanPop() - - ! Check that there are regions of non-zero temperature by summing mat temperatures - !sumT = 0 - !do j=1, self % nMat - ! mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - ! sumT = sumT + mat % getTemp() - !end do - - ! Generate ISMC source, only if there are regions with non-zero temperature - !if(sumT > 0) then - ! call self % ISMCSource % appendIMC(self % thisCycle, self % imcSourceN, p % pRNG) - !end if - ! Generate from input source !if( self % sourceGiven ) then ! call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) @@ -205,7 +187,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) gen: do ! Obtain paticle from dungeon - call self % matPhotons % release(p) + call self % thisCycle % release(p) call self % geom % placeCoord(p % coords) ! Assign particle time @@ -222,6 +204,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Transport particle until its death history: do + call self % transOp % transport(p, tally, self % thisCycle, self % nextCycle) if(p % isDead) exit history @@ -232,15 +215,27 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) exit history end if - if (p % type == P_PHOTON) then - call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) - if(p % isDead) exit history + if (p % type == P_MATERIAL) then + call fatalError(Here, 'Material particle should not undergo collision') + end if + + call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) + + ! If absorbed, transform into material + if(p % isDead) then + p % isDead = .false. + p % fate = 0 + p % type = P_MATERIAL + call self % nextCycle % detain(p) + exit history end if end do history ! When dungeon is empty, exit - if( self % thisCycle % isEmpty() ) exit gen + if( self % thisCycle % isEmpty() ) then + exit gen + end if end do gen diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 index f713e4034..ff937521a 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -4,7 +4,7 @@ module imcWeightClerk_class use tallyCodes use genericProcedures, only : fatalError use dictionary_class, only : dictionary - use particle_class, only : particle, particleState + use particle_class, only : particle, particleState, P_MATERIAL use outputFile_class, only : outputFile use scoreMemory_class, only : scoreMemory use tallyClerk_inter, only : tallyClerk, kill_super => kill @@ -216,7 +216,7 @@ subroutine reportHist(self, p, xsData, mem) adrr = self % getMemAddress() + binIdx - 1 ! Append to required bin - if( p % isDead .and. p % fate /= LEAK_FATE ) then + if( p % isDead .and. p % fate /= LEAK_FATE .or. p % type == P_MATERIAL) then scoreVal = p % w call mem % score(scoreVal, adrr) end if diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 340edcdb9..0f9063f79 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -6,7 +6,7 @@ module transportOperatorIMC_class use universalVariables use genericProcedures, only : fatalError, numToChar - use particle_class, only : particle + use particle_class, only : particle, P_PHOTON use particleDungeon_class, only : particleDungeon use dictionary_class, only : dictionary use rng_class, only : rng @@ -48,16 +48,20 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' ! Get majornat XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getMajorantXS(p) + !majorant_inv = ONE / self % xsData % getMajorantXS(p) IMCLoop:do ! Deal with material particles, only relevant for ISMC if(p % getType() == P_MATERIAL_MG) then - call self % materialTransform(p) + call self % materialTransform(p, tally) if(p % fate == TIME_FATE) exit IMCLoop end if + if(p % getType() .ne. P_PHOTON_MG) call fatalError(Here, 'Particle is not MG Photon') + + majorant_inv = ONE / self % xsData % getMajorantXS(p) + ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) @@ -112,9 +116,10 @@ end subroutine imcTracking !! !! Used only for ISMC, not for standard IMC !! - subroutine materialTransform(self, p) + subroutine materialTransform(self, p, tally) class(transportOperatorIMC), intent(inout) :: self class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' ! Confirm that time = 0 @@ -127,8 +132,10 @@ subroutine materialTransform(self, p) if (p % time >= p % timeMax) then p % fate = TIME_FATE p % time = p % timeMax + ! Tally energy for next temperature calculation + call tally % reportHist(p) else - p % type = P_PHOTON_MG + p % type = P_PHOTON end if end subroutine materialTransform From 2633281256500da8d5c7e4aef2c3b2c405fb8ce6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 8 Sep 2022 13:13:58 +0100 Subject: [PATCH 131/373] Obtain fleck and eta within transport operator --- NuclearData/IMCMaterial_inter.f90 | 12 +++ .../baseMgIMC/baseMgIMCMaterial_class.f90 | 78 ++++++++++++------- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 12 +++ .../transportOperatorIMC_class.f90 | 13 +++- 4 files changed, 87 insertions(+), 28 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 3d0129ad9..d6c436938 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -34,6 +34,7 @@ module IMCMaterial_inter procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck + procedure(getEta), deferred :: getEta procedure(initProps), deferred :: initProps procedure(getTemp), deferred :: getTemp procedure(getEnergyDens), deferred :: getEnergyDens @@ -96,6 +97,17 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck + !! + !! Return eta = aT**4/U_m + !! + !! Currently only used in transportOperatorIMC_class.f90 for ISMC calculations + !! + function getEta(self) result(eta) + import :: IMCMaterial, defReal + class(IMCMaterial),intent(in) :: self + real(defReal) :: eta + end function getEta + !! !! Store deltaT in material class and set initial material properties !! diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 918d9c7bd..685992ec8 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -68,7 +68,7 @@ module baseMgIMCMaterial_class real(defReal),dimension(:,:), allocatable :: data real(defReal),dimension(:), allocatable :: cv, updateEqn, sigmaEqn class(multiScatterMG), allocatable :: scatter - real(defReal) :: T, fleck, deltaT, sigmaP, matEnergy, volume + real(defReal) :: T, fleck, eta, deltaT, sigmaP, matEnergy, volume integer(shortInt) :: calcType contains @@ -83,6 +83,7 @@ module baseMgIMCMaterial_class procedure :: updateMat procedure :: getEmittedRad procedure :: getFleck + procedure :: getEta procedure :: initProps procedure :: getTemp procedure :: getEnergyDens @@ -329,47 +330,40 @@ subroutine updateMat(self, tallyEnergy, printUpdate) logical(defBool), intent(in), optional :: printUpdate character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" - ! Print current properties - if (present(printUpdate)) then - if (printUpdate .eqv. .True.) then - print *, " T_old = ", self % T - print *, " matEnergy at start of timestep =", self % matEnergy - print *, " emittedRad = ", self % getEmittedRad() - print *, " tallyEnergy = ", tallyEnergy - end if - end if - select case (self % calcType) case(IMC) - call self % updateMatIMC(tallyEnergy) + call self % updateMatIMC(tallyEnergy, printUpdate) case(ISMC) - call self % updateMatISMC(tallyEnergy) + call self % updateMatISMC(tallyEnergy, printUpdate) case default call fatalError(Here, "Invalid calculation type") end select - ! Print updated properties - if (present(printUpdate)) then - if(printUpdate .eqv. .True.) then - print *, " matEnergy at end of timestep = ", self % matEnergy - print *, " T_new = ", self % T - end if - end if - end subroutine updateMat !! !! Material update for IMC calculation !! - subroutine updateMatIMC(self, tallyEnergy) + subroutine updateMatIMC(self, tallyEnergy, printUpdate) class(baseMgIMCMaterial), intent(inout) :: self real(defReal), intent(in) :: tallyEnergy + logical(defBool), intent(in), optional :: printUpdate character(100), parameter :: Here = "updateMatIMC (baseMgIMCMaterial_class.f90)" + ! Print current properties + if (present(printUpdate)) then + if (printUpdate .eqv. .True.) then + print *, " T_old = ", self % T + print *, " matEnergy at start of timestep =", self % matEnergy + print *, " emittedRad = ", self % getEmittedRad() + print *, " tallyEnergy = ", tallyEnergy + end if + end if + ! Update material internal energy self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy @@ -385,15 +379,24 @@ subroutine updateMatIMC(self, tallyEnergy) self % fleck = 1 / (1 + 1*self % sigmaP*lightSpeed*self % deltaT) ! Incomplete, need to add alpha + ! Print updated properties + if (present(printUpdate)) then + if(printUpdate .eqv. .True.) then + print *, " matEnergy at end of timestep = ", self % matEnergy + print *, " T_new = ", self % T + end if + end if + end subroutine updateMatIMC !! !! Material update for ISMC calculation !! - subroutine updateMatISMC(self, tallyEnergy) + subroutine updateMatISMC(self, tallyEnergy, printUpdate) class(baseMgIMCMaterial), intent(inout) :: self real(defReal), intent(in) :: tallyEnergy - real(defReal) :: beta, eta, zeta + real(defReal) :: beta, zeta + logical(defBool), intent(in), optional :: printUpdate ! Update material internal energy self % matEnergy = tallyEnergy @@ -403,13 +406,21 @@ subroutine updateMatISMC(self, tallyEnergy) ! Update ISMC equivalent of fleck factor beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) - eta = radiationConstant * self % T**4 / self % matEnergy - zeta = beta - eta + self % eta = radiationConstant * self % T**4 / self % matEnergy + zeta = beta - self % eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) ! Update sigmaP call self % sigmaFromTemp + ! Print updated properties + if (present(printUpdate)) then + if(printUpdate .eqv. .True.) then + print *, " matEnergy at end of timestep = ", self % matEnergy + print *, " T_new = ", self % T + end if + end if + end subroutine updateMatISMC !! @@ -464,6 +475,19 @@ function getFleck(self) result(fleck) end function getFleck + !! + !! Return eta = aT**4/U_m + !! + !! Currently only used in transportOperatorIMC_class.f90 for ISMC calculations + !! + function getEta(self) result(eta) + class(baseMgIMCMaterial),intent(in) :: self + real(defReal) :: eta + + eta = self % eta + + end function getEta + !! !! Store deltaT in material class and set initial material properties !! @@ -494,7 +518,7 @@ subroutine initProps(self, deltaT, T, V) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) self % deltaT = deltaT - self % calcType = IMC + self % eta = 1 end subroutine initProps diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index b5656fbd2..726179262 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -46,6 +46,7 @@ module mgIMCMaterial_inter procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck + procedure(getEta), deferred :: getEta procedure(initProps), deferred :: initProps procedure(getTemp), deferred :: getTemp procedure(getEnergyDens), deferred :: getEnergyDens @@ -129,6 +130,17 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck + !! + !! Return eta = aT**4/U_m + !! + !! Currently only used in transportOperatorIMC_class.f90 for ISMC calculations + !! + function getEta(self) result(eta) + import :: mgIMCMaterial, defReal + class(mgIMCMaterial),intent(in) :: self + real(defReal) :: eta + end function getEta + !! !! Store deltaT in material class and set initial material properties !! diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 0f9063f79..84ea5999c 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -23,6 +23,7 @@ module transportOperatorIMC_class ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCMaterial_inter, only : mgIMCMaterial, mgIMCMaterial_CptrCast implicit none private @@ -31,6 +32,7 @@ module transportOperatorIMC_class !! Transport operator that moves a particle with IMC tracking !! type, public, extends(transportOperator) :: transportOperatorIMC + class(mgIMCMaterial), pointer, public :: mat => null() contains procedure :: transit => imcTracking procedure, private :: materialTransform @@ -120,13 +122,22 @@ subroutine materialTransform(self, p, tally) class(transportOperatorIMC), intent(inout) :: self class(particle), intent(inout) :: p type(tallyAdmin), intent(inout) :: tally + real(defReal) :: sigmaT, fleck, eta character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' ! Confirm that time = 0 !if (p % time .ne. 0) call fatalError(Here, 'Material particle should have time = 0') + ! Get and verify material pointer + self % mat => mgIMCMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) + if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG IMC Material") + + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) !! Should be sigma_a, may need changing when sorting out cross-sections + fleck = self % mat % getFleck() + eta = self % mat % getEta() + ! Sample time to transform into radiation photon - p % time = -log( p % pRNG % get() ) !! Placeholder eqn. + p % time = -log(p % pRNG % get()) / (sigmaT*fleck*eta*lightSpeed) ! Exit loop if particle remains material until end of time step if (p % time >= p % timeMax) then From a3b2141276147be0d6392e94c22b8e8dc60e6eb9 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 8 Sep 2022 19:36:14 +0100 Subject: [PATCH 132/373] Wrote subroutine to reduce size of dungeon without teleportaion error (hopefully) --- ParticleObjects/particleDungeon_class.f90 | 69 +++++++++++++++++++++++ 1 file changed, 69 insertions(+) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 2cd886ea7..cb710637f 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -83,6 +83,7 @@ module particleDungeon_class procedure :: isEmpty procedure :: normWeight procedure :: normSize + procedure :: reduceSize procedure :: cleanPop procedure :: popSize procedure :: popWeight @@ -347,6 +348,74 @@ subroutine normSize(self,N,rand) end subroutine normSize + !! + !! Reduce size of particle dungeon to a size N, while maintaining total weight + !! and reducing teleportation error + !! + !! Rather than simply calling normSize(N) followed by normWeight(prevWeight), this + !! subroutine combines 2 random particles of the same type into a single particle, + !! with a new position based on a weighted average of the previous positions + !! + !! Finding the nearest particle would be better but much more computationally intensive, + !! may be doable in parallel + !! + subroutine reduceSize(self, N, rand) + class(particleDungeon), intent(inout) :: self + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + integer(shortInt) :: excessP, randIdx1, randIdx2, loops + type(particle) :: p1, p2 + real(defReal), dimension(3) :: rNew + character(100), parameter :: Here =' normSize (particleDungeon_class.f90)' + + ! Protect against invalid N + if( N > self % pop) then + call fatalError(Here,'Requested size: '//numToChar(N) //& + 'is greather then max size: '//numToChar(size(self % prisoners))) + else if ( N <= 0 ) then + call fatalError(Here,'Requested size: '//numToChar(N) //' is not +ve') + end if + + ! Calculate excess particles to be removed + excessP = self % pop - N + + reduce:do + + ! Obtain random particles from dungeon + randIdx1 = nint(rand % get() * self % pop) + p1 = self % prisoners(randIdx1) + + ! Obtain random particle of the same type + sample:do + loops = 0 + randIdx2 = nint(rand % get() * self % pop) + p2 = self % prisoners(randIdx2) + if(p2 % type == p1 % type) exit sample + ! Protect against infinite loop + if(loops >= self % pop) call fatalError(Here, 'Only single particle found of type ' & + //numToChar(type)) + loops = loops + 1 + end do sample + + ! Combine positions and weights + rNew = (p1 % rGlobal()*p1 % w+p2 % rGlobal()*p2 % w) / (p1 % w+p2 % w) + call p1 % teleport(rNew) + p1 % w = p1 % w + p2 % w + self % prisoners(randIdx1) = p1 + + ! Overwrite p2 and reduce size + call self % replace(self % prisoners(self % pop), randIdx2) + self % pop = self % pop - 1 + + if(self % pop == N) exit reduce + + if(self % pop < N) call fatalError(Here, 'Uh oh, dungeon size somehow went below target') + + end do reduce + + end subroutine reduceSize + + !! !! Kill or particles in the dungeon !! From 2eb43b86c4c59c44eb7485eb8ef93313580d088c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 15 Sep 2022 14:46:19 +0100 Subject: [PATCH 133/373] Changed data file to be correct --- InputFiles/IMC/MarshakWave/dataFiles/imcData | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/dataFiles/imcData b/InputFiles/IMC/MarshakWave/dataFiles/imcData index 8cdb4ac41..6c158e94b 100644 --- a/InputFiles/IMC/MarshakWave/dataFiles/imcData +++ b/InputFiles/IMC/MarshakWave/dataFiles/imcData @@ -16,12 +16,12 @@ P0 ( ); sigmaP ( - 1 - 0 + 10 + -3 ); cv ( - 4 - 3 + 7.14 + 0 ); From 2e7452436cc06b528479093a926df297152dbfc7 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 15 Sep 2022 14:51:36 +0100 Subject: [PATCH 134/373] Various changes including adding limit option for max number of particles --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 42 +++++++++++++++----- 1 file changed, 32 insertions(+), 10 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 7a503f32c..7c1a849a3 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -77,6 +77,7 @@ module ISMCPhysicsPackage_class ! Settings integer(shortInt) :: N_cycles integer(shortInt) :: pop + integer(shortInt) :: limit real(defReal) :: deltaT character(pathLen) :: outputFile character(nameLen) :: outputFormat @@ -146,14 +147,12 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Set whether or not to print energy and temperature updates of each material ! Printed from updateMat (baseMgIMCMaterial_class.f90), 7 lines of text ! per material so recommend to only print when low number of materials - if (self % nMat <= 5) then + if (self % nMat <= 8) then printUpdates = .True. else printUpdates = .False. end if - N = self % pop - ! Attach nuclear data and RNG to particle p % pRNG => self % pRNG p % timeMax = self % deltaT @@ -168,16 +167,32 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Generate initial material photons call self % ISMCSource % generate(self % nextCycle, self % pop, p % pRNG) + open(unit = 10, file = 'particles.txt') + do i=1,N_cycles + N = 0 + ! Store photons remaining from previous cycle self % thisCycle = self % nextCycle call self % nextCycle % cleanPop() + !call self % thisCycle % printToFile('particles') + !write(10, '(8A)') '0.0 0.0 0.0 0.0' + + call self % thisCycle % printToScreen('wgt', 10, .true.) + ! Generate from input source - !if( self % sourceGiven ) then - ! call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) - !end if + if( self % sourceGiven ) then + + ! Reduce size of dungeon if dungeon will overflow + if( self % thisCycle % popSize() + self % pop > self % limit) then + call self % thisCycle % reduceSize(self % limit - self % pop, p % pRNG) + end if + + call self % inputSource % append(self % thisCycle, self % pop, p % pRNG) + + end if !if(self % printSource == 1) then ! call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) @@ -190,6 +205,10 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call self % thisCycle % release(p) call self % geom % placeCoord(p % coords) + if( p % type == P_MATERIAL ) then + N = N+1 + end if + ! Assign particle time if( p % time /= self % deltaT ) then ! If particle has just been sourced, t = 0 so sample uniformly within timestep @@ -250,6 +269,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end_T = real(N_cycles,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) + print *, "Number of material photons at start of time step = ", N + ! Display progress call printFishLineR(i) print * @@ -291,6 +312,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end do + close(10) + end subroutine cycles !! @@ -351,6 +374,7 @@ subroutine init(self, dict) ! Read calculation settings call dict % get( self % pop,'pop') + call dict % getOrDefault( self % limit, 'limit', self % pop) call dict % get( self % N_cycles,'cycles') call dict % get( self % deltaT,'timeStepSize') call dict % get( nucData, 'XSdata') @@ -472,11 +496,9 @@ subroutine init(self, dict) ! Size particle dungeon allocate(self % thisCycle) - call self % thisCycle % init(self % pop) + call self % thisCycle % init(self % limit) allocate(self % nextCycle) - call self % nextCycle % init(self % pop) - allocate(self % matPhotons) - call self % matPhotons % init(self % pop) + call self % nextCycle % init(self % limit) call self % printSettings() From f23559598e1b29d603eff25d000245209018b379 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 16 Sep 2022 13:25:12 +0100 Subject: [PATCH 135/373] Resample direction when mat transforms to rad --- TransportOperator/transportOperatorIMC_class.f90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 84ea5999c..2a20a6645 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -122,7 +122,8 @@ subroutine materialTransform(self, p, tally) class(transportOperatorIMC), intent(inout) :: self class(particle), intent(inout) :: p type(tallyAdmin), intent(inout) :: tally - real(defReal) :: sigmaT, fleck, eta + real(defReal) :: sigmaT, fleck, eta, mu, phi + real(defReal), dimension(3) :: dir character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' ! Confirm that time = 0 @@ -147,6 +148,13 @@ subroutine materialTransform(self, p, tally) call tally % reportHist(p) else p % type = P_PHOTON + ! Resample direction + mu = 2 * p % pRNG % get() - 1 + phi = p % pRNG % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + call p % point(dir) end if end subroutine materialTransform From 84fdce709761022a4f77bba7608c7ee06b8b7446 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 16 Sep 2022 13:26:04 +0100 Subject: [PATCH 136/373] Changes to reduce subroutine --- ParticleObjects/particleDungeon_class.f90 | 44 +++++++++++++++-------- 1 file changed, 30 insertions(+), 14 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index cb710637f..341a2a3b3 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -314,7 +314,7 @@ subroutine normSize(self,N,rand) class(RNG), intent(inout) :: rand integer(shortInt) :: excessP integer(shortInt) :: i, idx - character(100), parameter :: Here =' normSize (particleDungeon_class.f90)' + character(100), parameter :: Here = 'normSize (particleDungeon_class.f90)' ! Protect against invalid N if( N > size(self % prisoners)) then @@ -363,10 +363,13 @@ subroutine reduceSize(self, N, rand) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand - integer(shortInt) :: excessP, randIdx1, randIdx2, loops + integer(shortInt) :: excessP, randIdx1, randIdx2, loops, loops2 type(particle) :: p1, p2 - real(defReal), dimension(3) :: rNew - character(100), parameter :: Here =' normSize (particleDungeon_class.f90)' + real(defReal), dimension(3) :: rNew, r1, r2 + logical(defBool) :: distanceTest = .true. + character(100), parameter :: Here ='reduceSize (particleDungeon_class.f90)' + + print *, "REDUCE", self % pop, N ! Protect against invalid N if( N > self % pop) then @@ -379,22 +382,34 @@ subroutine reduceSize(self, N, rand) ! Calculate excess particles to be removed excessP = self % pop - N + ! Protect against infinite loop + loops = 0 + reduce:do + loops = loops + 1 + if(loops >= 50*self % pop) call fatalError(Here, 'Potentially infinite loop') + ! Obtain random particles from dungeon randIdx1 = nint(rand % get() * self % pop) p1 = self % prisoners(randIdx1) + r1 = p1 % rGlobal() ! Obtain random particle of the same type + loops2 = 0 sample:do - loops = 0 - randIdx2 = nint(rand % get() * self % pop) + randIdx2 = ceiling(rand % get() * self % pop) p2 = self % prisoners(randIdx2) - if(p2 % type == p1 % type) exit sample - ! Protect against infinite loop - if(loops >= self % pop) call fatalError(Here, 'Only single particle found of type ' & - //numToChar(type)) - loops = loops + 1 + r2 = p2 % rGlobal() + !if(abs(r1(1) - r2(1)) <= 0.01) then + ! distanceTest = .true. + !else + ! distanceTest = .false. + !end if + if(p2 % type == p1 % type .and. p1 % matIdx() == p2 % matIdx()) exit sample !distanceTest .eqv. .true.) exit sample + ! If too many samples of different type, resample p1 + if(loops2 >= 0.05*self % pop) cycle reduce + loops2 = loops2 + 1 end do sample ! Combine positions and weights @@ -497,11 +512,12 @@ subroutine printToFile(self, name) integer(shortInt) :: i filename = trim(name)//'.txt' - open(unit = 10, file = filename) + !open(unit = 10, file = filename) ! Print out each particle co-ordinate do i = 1, self % pop - write(10,'(8A)') numToChar(self % prisoners(i) % r)!, & + write(10,'(8A)') numToChar(self % prisoners(i) % r), & + ' ', numToChar(self % prisoners(i) % type)!, & !numToChar(self % prisoners(i) % dir), & !numToChar(self % prisoners(i) % E), & !numToChar(self % prisoners(i) % G), & @@ -509,7 +525,7 @@ subroutine printToFile(self, name) end do ! Close the file - close(10) + !close(10) end subroutine printToFile From 17ad8891da7009eebdb111bf9ed0dabff9566a2f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 14:12:33 +0100 Subject: [PATCH 137/373] Photons that transform into materials can transform back into photons within same timestep --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 2 ++ PhysicsPackages/ISMCPhysicsPackage_class.f90 | 16 +++++++++------- TransportOperator/transportOperatorIMC_class.f90 | 2 +- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 685992ec8..d36423cc1 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -401,6 +401,8 @@ subroutine updateMatISMC(self, tallyEnergy, printUpdate) ! Update material internal energy self % matEnergy = tallyEnergy + !if(self % matEnergy <= 0.3) self % matEnergy = 0.3 + ! Update material temperature self % T = self % tempFromEnergy() diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 7c1a849a3..0483a7516 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -177,8 +177,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) self % thisCycle = self % nextCycle call self % nextCycle % cleanPop() - !call self % thisCycle % printToFile('particles') - !write(10, '(8A)') '0.0 0.0 0.0 0.0' call self % thisCycle % printToScreen('wgt', 10, .true.) @@ -210,12 +208,12 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end if ! Assign particle time - if( p % time /= self % deltaT ) then + if( p % type /= P_MATERIAL .and. p % time /= self % deltaT ) then ! If particle has just been sourced, t = 0 so sample uniformly within timestep p % time = p % pRNG % get() * self % deltaT else ! If particle survived previous time step, reset time to 0 - p % time = 0 + p % time = ZERO end if ! Save state @@ -225,7 +223,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) history: do call self % transOp % transport(p, tally, self % thisCycle, self % nextCycle) - if(p % isDead) exit history + if(p % fate == LEAK_FATE) exit history if(p % fate == TIME_FATE) then ! Store particle for use in next time step @@ -245,8 +243,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) p % isDead = .false. p % fate = 0 p % type = P_MATERIAL - call self % nextCycle % detain(p) - exit history + !call self % nextCycle % detain(p) + !exit history + cycle history end if end do history @@ -310,6 +309,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_cycles) + !call self % nextCycle % printToFile('particles') + !write(10, '(8A)') '0.0 0.0 0.0 0.0' + end do close(10) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 2a20a6645..0e46c3d42 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -138,7 +138,7 @@ subroutine materialTransform(self, p, tally) eta = self % mat % getEta() ! Sample time to transform into radiation photon - p % time = -log(p % pRNG % get()) / (sigmaT*fleck*eta*lightSpeed) + p % time = p % time - log(p % pRNG % get()) / (sigmaT*fleck*eta*lightSpeed) ! Exit loop if particle remains material until end of time step if (p % time >= p % timeMax) then From ff37a75ae046b8b20ff37f15bf4e23d3aed78f47 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 14:29:39 +0100 Subject: [PATCH 138/373] Changes for pull request --- .../CollisionProcessors/IMCMGstd_class.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index a7c88a1fb..721dad50f 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -129,7 +129,7 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) end subroutine sampleCollision !! - !! Preform implicit treatment + !! Perform implicit treatment !! subroutine implicit(self, p, collDat, thisCycle, nextCycle) class(IMCMGstd), intent(inout) :: self @@ -155,12 +155,12 @@ subroutine elastic(self, p , collDat, thisCycle, nextCycle) ! Do nothing. Should not be called - call fatalError(Here, "elastic subroutine should not be called") + call fatalError(Here, "Elastic subroutine should not be called") end subroutine elastic !! - !! Preform scattering - Currently this is for effective scattering, and energy weights + !! Perform scattering - Currently this is for effective scattering, and energy weights !! are unchanged (so is actually elastic) !! subroutine inelastic(self, p, collDat, thisCycle, nextCycle) @@ -192,7 +192,7 @@ subroutine inelastic(self, p, collDat, thisCycle, nextCycle) end subroutine inelastic !! - !! Preform capture + !! Perform capture !! subroutine capture(self, p, collDat, thisCycle, nextCycle) class(IMCMGstd), intent(inout) :: self @@ -206,7 +206,7 @@ subroutine capture(self, p, collDat, thisCycle, nextCycle) end subroutine capture !! - !! Preform fission + !! Perform fission !! subroutine fission(self, p, collDat, thisCycle, nextCycle) class(IMCMGstd), intent(inout) :: self @@ -218,12 +218,12 @@ subroutine fission(self, p, collDat, thisCycle, nextCycle) ! Do nothing. Should not be called - call fatalError(Here, "elastic subroutine should not be called") + call fatalError(Here, "Fission subroutine should not be called") end subroutine fission !! - !! Applay cutoffs or post-collision implicit treatment + !! Apply cutoffs or post-collision implicit treatment !! subroutine cutoffs(self, p, collDat, thisCycle, nextCycle) class(IMCMGstd), intent(inout) :: self From 5f19626e4fa1339227797d6ec7d2444702c9d366 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 14:30:44 +0100 Subject: [PATCH 139/373] Changes to input files as suggested in pull request --- InputFiles/IMC/MarshakWave/dataFiles/imcData | 12 +++------ InputFiles/IMC/Sample/imcSampleInput | 2 +- InputFiles/IMC/SimpleCases/dataFiles/imcData | 4 --- InputFiles/IMC/SimpleCases/dataFiles/imcData2 | 4 --- InputFiles/XS/imcData | 27 ------------------- 5 files changed, 5 insertions(+), 44 deletions(-) delete mode 100644 InputFiles/XS/imcData diff --git a/InputFiles/IMC/MarshakWave/dataFiles/imcData b/InputFiles/IMC/MarshakWave/dataFiles/imcData index 8cdb4ac41..f5ff053e0 100644 --- a/InputFiles/IMC/MarshakWave/dataFiles/imcData +++ b/InputFiles/IMC/MarshakWave/dataFiles/imcData @@ -1,7 +1,3 @@ -// This XSS are for a URR-2-1-IN/SL Benchamrk Problem -// Source: A. Sood, R. A. Forster, and D. K. Parsons, -// ‘Analytical Benchmark Test Set For Criticality Code Verification’ -// numberOfGroups 1; @@ -16,12 +12,12 @@ P0 ( ); sigmaP ( - 1 - 0 + 10 + -3 ); cv ( - 4 - 3 + 7.14 + 0 ); diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput index 39a8c7ef4..9e2231d1e 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -20,7 +20,7 @@ cycles 50; // calculation types timeStepSize 0.1; - // The time step size for the calculation + // The time step size for the calculation in seconds XSdata mg; diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData b/InputFiles/IMC/SimpleCases/dataFiles/imcData index 8cdb4ac41..f7faacf36 100644 --- a/InputFiles/IMC/SimpleCases/dataFiles/imcData +++ b/InputFiles/IMC/SimpleCases/dataFiles/imcData @@ -1,7 +1,3 @@ -// This XSS are for a URR-2-1-IN/SL Benchamrk Problem -// Source: A. Sood, R. A. Forster, and D. K. Parsons, -// ‘Analytical Benchmark Test Set For Criticality Code Verification’ -// numberOfGroups 1; diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 index 684a60187..94e80c4f7 100644 --- a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 +++ b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 @@ -1,7 +1,3 @@ -// This XSS are for a URR-2-1-IN/SL Benchamrk Problem -// Source: A. Sood, R. A. Forster, and D. K. Parsons, -// ‘Analytical Benchmark Test Set For Criticality Code Verification’ -// numberOfGroups 1; diff --git a/InputFiles/XS/imcData b/InputFiles/XS/imcData deleted file mode 100644 index c063d0a06..000000000 --- a/InputFiles/XS/imcData +++ /dev/null @@ -1,27 +0,0 @@ -// This XSS are for a URR-2-1-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 (1.0); - -scatteringMultiplicity ( -0.0 -); - -P0 ( - 0.0 -); - -sigmaP ( - 1.0 - 0.0 -); - -cv ( - 4.0 - 3.0 -); - From 5437eb32ae2bae3cdc80e6a3a0b9af6f41b570e8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 14:56:08 +0100 Subject: [PATCH 140/373] Fixed a few inconsistencies --- NuclearData/IMCMaterial_inter.f90 | 6 +++--- .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 8 +++++--- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 4 ++-- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index c369f544b..add81a405 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -108,10 +108,10 @@ subroutine initProps(self, deltaT, T, V) real(defReal), intent(in) :: deltaT, T, V end subroutine initProps - function getTemp(self) result(temp) + function getTemp(self) result(T) import :: IMCMaterial, defReal class(IMCMaterial), intent(inout) :: self - real(defReal) :: temp + real(defReal) :: T end function getTemp end interface @@ -126,7 +126,7 @@ end function getTemp !! source [in] -> source pointer of class materialHandle !! !! Result: - !! Null is source is not of IMCMaterial + !! Null if source is not of IMCMaterial !! Pointer to source if source is IMCMaterial class !! pure function IMCMaterial_CptrCast(source) result(ptr) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 280248e7e..9d2e1d5d4 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -470,6 +470,8 @@ end function getFleck !! !! Args: !! deltaT -> Time step size + !! T -> Initial temperature + !! V -> Material volume !! !! Errors: !! fatalError if material volume <= 0 @@ -497,11 +499,11 @@ subroutine initProps(self, deltaT, T, V) end subroutine initProps - function getTemp(self) result(temp) + function getTemp(self) result(T) class(baseMgIMCMaterial), intent(inout) :: self - real(defReal) :: temp + real(defReal) :: T - temp = self % T + T = self % T end function getTemp diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index a91ff90d1..a7fa27ad7 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -142,10 +142,10 @@ subroutine initProps(self, deltaT, T, V) real(defReal), intent(in) :: deltaT, T, V end subroutine initProps - function getTemp(self) result(temp) + function getTemp(self) result(T) import :: mgIMCMaterial, defReal class(mgIMCMaterial), intent(inout) :: self - real(defReal) :: temp + real(defReal) :: T end function getTemp From 6296c184c20cd0f95f9ea950ed04eea9d46d9e37 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 18:33:21 +0100 Subject: [PATCH 141/373] Various changes to materialMenu_mod --- NuclearData/materialMenu_mod.f90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index 9e5371f57..744b75851 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -64,7 +64,7 @@ module materialMenu_mod !! name -> name of material !! matIdx -> material index of the material !! T -> material temperature [K] - !! V -> volume of material zone, currently used in IMC calculations + !! V -> volume of material zone [cm3] !! dens -> vector of densities [1/barn/cm] !! nuclides -> associated vector of nuclide types !! extraInfo -> dictionary with extra keywords @@ -203,7 +203,7 @@ end subroutine display !! Result: !! nameLen long character with material name !! - !! Erorrs: + !! Errors: !! If idx is -ve or larger then number of defined materials !! Empty string '' is returned as its name !! @@ -221,7 +221,7 @@ function matName(idx) result(name) end function matName !! - !! Return starting temperature of materal given index + !! Return starting temperature of material given index !! !! Args: !! idx [in] -> Material Index @@ -229,19 +229,18 @@ end function matName !! Result: !! Temperature of material as given in input file !! - !! Erorrs: + !! Errors: !! If idx is -ve or larger then number of defined materials - !! 0 is returned as its temperature + !! then -1 is returned as its temperature !! - function matTemp(idx) result(temp) + function matTemp(idx) result(T) integer(shortInt), intent(in) :: idx - real(defReal) :: temp - - if( idx <= 0 .or. nMat() < idx) then - temp = 0 + real(defReal) :: T + if(idx <= 0 .or. nMat() < idx) then + T = -ONE else - temp = materialDefs(idx) % T + T = materialDefs(idx) % T end if end function matTemp @@ -257,15 +256,14 @@ end function matTemp !! !! Erorrs: !! If idx is -ve or larger then number of defined materials - !! 0 is returned as its volume + !! then -1 is returned as its volume !! function matVol(idx) result(vol) integer(shortInt), intent(in) :: idx real(defReal) :: vol if( idx <= 0 .or. nMat() < idx) then - vol = 0 - + vol = -ONE else vol = materialDefs(idx) % V end if From 204e4399126b40cee53346a8dba49848b53b596b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 18:34:18 +0100 Subject: [PATCH 142/373] Fixed spelling --- NuclearData/materialMenu_mod.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index 744b75851..25db59e62 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -246,7 +246,7 @@ function matTemp(idx) result(T) end function matTemp !! - !! Return volume of materal given index + !! Return volume of material given index !! !! Args: !! idx [in] -> Material Index @@ -254,7 +254,7 @@ end function matTemp !! Result: !! Volume of material as given in input file !! - !! Erorrs: + !! Errors: !! If idx is -ve or larger then number of defined materials !! then -1 is returned as its volume !! From 301e9f7c9aeb8d315d01d2b7227ebce80248332b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 18:38:32 +0100 Subject: [PATCH 143/373] Deleted unnecessary comments --- NuclearData/IMCMaterial_inter.f90 | 1 - NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 | 6 ------ 2 files changed, 7 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index add81a405..d803afaa3 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -80,7 +80,6 @@ end subroutine updateMat function getEmittedRad(self) result(emittedRad) import :: IMCMaterial, defReal, RNG class(IMCMaterial), intent(inout) :: self - !class(RNG), intent(inout) :: rand real(defReal) :: emittedRad end function getEmittedRad diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 5ca565d7e..9ff920d3d 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -76,12 +76,6 @@ module baseMgIMCDatabase_class !! DOES NOT check if particle is MG. Will refer to G in the particle and give error !! if the value is invalid !! - !! Sample input dictionary: - !! nucData { - !! type baseMgIMCDatabase; - !! PN P0; // or P1 - !! } - !! function getTransMatXS(self, p, matIdx) result(xs) class(baseMgIMCDatabase), intent(inout) :: self class(particle), intent(in) :: p From 70482fe175918df508b65467e6f99e02c1c5813a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 19:00:53 +0100 Subject: [PATCH 144/373] No longer require IMCSource in input file. Can specify 'limit' to size particle dungeons --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 42 +++++++++++---------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index ce7ba01ee..531b511a7 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -77,12 +77,12 @@ module IMCPhysicsPackage_class ! Settings integer(shortInt) :: N_cycles integer(shortInt) :: pop + integer(shortInt) :: limit real(defReal) :: deltaT character(pathLen) :: outputFile character(nameLen) :: outputFormat integer(shortInt) :: printSource = 0 integer(shortInt) :: particleType - integer(shortInt) :: imcSourceN logical(defBool) :: sourceGiven = .false. integer(shortInt) :: nMat @@ -133,7 +133,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_cycles - integer(shortInt) :: i, j, N + integer(shortInt) :: i, j type(particle) :: p real(defReal) :: elapsed_T, end_T, T_toEnd, sumT real(defReal), dimension(:), allocatable :: tallyEnergy @@ -151,8 +151,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) printUpdates = .False. end if - N = self % pop - ! Attach nuclear data and RNG to particle p % pRNG => self % pRNG p % timeMax = self % deltaT @@ -191,12 +189,12 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Generate IMC source, only if there are regions with non-zero temperature if(sumT > 0) then - call self % IMCSource % appendIMC(self % thisCycle, self % imcSourceN, p % pRNG) + call self % IMCSource % appendIMC(self % thisCycle, self % pop, p % pRNG) end if ! Generate from input source if( self % sourceGiven ) then - call self % inputSource % append(self % thisCycle, self % imcSourceN, p % pRNG) + call self % inputSource % append(self % thisCycle, self % pop, p % pRNG) end if if(self % printSource == 1) then @@ -340,7 +338,7 @@ subroutine init(self, dict) class(IMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict class(dictionary),pointer :: tempDict - type(dictionary) :: locDict1, locDict2, locDict3 + type(dictionary) :: locDict1, locDict2, locDict3, locDict4 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -356,6 +354,7 @@ subroutine init(self, dict) ! Read calculation settings call dict % get( self % pop,'pop') + call dict % getOrDefault( self % limit, 'limit', self % pop) call dict % get( self % N_cycles,'cycles') call dict % get( self % deltaT,'timeStepSize') call dict % get( nucData, 'XSdata') @@ -423,9 +422,12 @@ subroutine init(self, dict) call new_source(self % inputSource, tempDict, self % geom) self % sourceGiven = .true. end if - tempDict => dict % getDictPtr('imcSource') - call new_source(self % IMCSource, tempDict, self % geom) - call tempDict % get(self % imcSourceN, 'nParticles') + + ! Initialise ISMC source + call locDict1 % init(2) + call locDict1 % store('type', 'imcSource') + call locDict1 % store('nParticles', self % pop) + call new_source(self % IMCSource, locDict1, self % geom) ! Build collision operator tempDict => dict % getDictPtr('collisionOperator') @@ -450,26 +452,26 @@ subroutine init(self, dict) end do ! Initialise imcWeight tally attachment - call locDict1 % init(1) - call locDict2 % init(2) + call locDict2 % init(1) call locDict3 % init(2) + call locDict4 % init(2) - call locDict3 % store('type','materialMap') - call locDict3 % store('materials', [mats]) - call locDict2 % store('type','imcWeightClerk') - call locDict2 % store('map', locDict3) - call locDict1 % store('imcWeight', locDict2) + call locDict4 % store('type','materialMap') + call locDict4 % store('materials', [mats]) + call locDict3 % store('type','imcWeightClerk') + call locDict3 % store('map', locDict4) + call locDict2 % store('imcWeight', locDict3) allocate(self % imcWeightAtch) - call self % imcWeightAtch % init(locDict1) + call self % imcWeightAtch % init(locDict2) call self % tally % push(self % imcWeightAtch) ! Size particle dungeon allocate(self % thisCycle) - call self % thisCycle % init(15 * self % pop) + call self % thisCycle % init(self % limit) allocate(self % nextCycle) - call self % nextCycle % init(10 * self % pop) + call self % nextCycle % init(self % limit) call self % printSettings() From ba4c526204ea4a99955ec72a09941b67972e96b1 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 19:01:43 +0100 Subject: [PATCH 145/373] Removed old lines --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 531b511a7..050e8947a 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -168,11 +168,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) allocate(tallyEnergy(self % nMat)) - ! Generate initial source distribution - !if( self % sourceGiven ) then - ! call self % inputSource % generate(self % nextCycle, self % imcSourceN, p % pRNG) - !end if - do i=1,N_cycles ! Store photons remaining from previous cycle From 9f876b9a8db054e6a2638937a4cdb5ee82cb937f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 17 Sep 2022 19:08:11 +0100 Subject: [PATCH 146/373] Changed comment --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 050e8947a..7f1058a6f 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -462,7 +462,7 @@ subroutine init(self, dict) call self % tally % push(self % imcWeightAtch) - ! Size particle dungeon + ! Size particle dungeons allocate(self % thisCycle) call self % thisCycle % init(self % limit) allocate(self % nextCycle) From d7662e90b13da49369d2e03d30ee3b200dd8b7d6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 18 Sep 2022 12:53:05 +0100 Subject: [PATCH 147/373] Changed input files to no longer have imcSource --- InputFiles/IMC/MarshakWave/marshakWave128 | 10 +++----- InputFiles/IMC/MarshakWave/marshakWave16 | 10 +++----- InputFiles/IMC/MarshakWave/marshakWave32 | 10 +++----- InputFiles/IMC/MarshakWave/marshakWave64 | 10 +++----- InputFiles/IMC/MarshakWave/marshakWave8 | 10 +++----- InputFiles/IMC/Sample/imcSampleInput | 31 ++++++++--------------- InputFiles/IMC/SimpleCases/3region | 27 ++++---------------- InputFiles/IMC/SimpleCases/infiniteRegion | 10 +++----- InputFiles/IMC/SimpleCases/sphereInCube | 8 ++---- InputFiles/IMC/SimpleCases/touchingCubes | 16 ++---------- 10 files changed, 38 insertions(+), 104 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index 14d8f3be3..c890af8c9 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 200000; +pop 500; +limit 20000 cycles 10000; timeStepSize 0.05; @@ -24,17 +25,12 @@ source { axis x; pos -2; T 1; - nParticles 5000; + nParticles 500; dir 1; deltat 0.05; particle photon; } -imcSource { - type imcSource; - nParticles 5000; - } - inactiveTally {} activeTally {} diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 index 5f1b1da0f..ea2ae42c8 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave16 +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 200000; +pop 500; +limit 200000; cycles 10000; timeStepSize 0.05; @@ -24,17 +25,12 @@ source { axis x; pos -2; T 1; - nParticles 5000; + nParticles 500; dir 1; deltat 0.05; particle photon; } -imcSource { - type imcSource; - nParticles 5000; - } - inactiveTally {} activeTally {} diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 20652180a..638dbc86f 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 200000; +pop 500; +limit 20000; cycles 10000; timeStepSize 0.05; @@ -24,17 +25,12 @@ source { axis x; pos -2; T 1; - nParticles 5000; + nParticles 500; dir 1; deltat 0.05; particle photon; } -imcSource { - type imcSource; - nParticles 5000; - } - inactiveTally {} activeTally {} diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 520d65974..5bf333cd6 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 200000; +pop 500; +limit 20000 cycles 10000; timeStepSize 0.05; @@ -24,17 +25,12 @@ source { axis x; pos -2; T 1; - nParticles 5000; + nParticles 500; dir 1; deltat 0.05; particle photon; } -imcSource { - type imcSource; - nParticles 5000; - } - inactiveTally {} activeTally {} diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 index 03189cf79..86f1382d6 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave8 +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 200000; +pop 500; +limit 200000; cycles 10000; timeStepSize 0.05; @@ -24,17 +25,12 @@ source { axis x; pos -2; T 1; - nParticles 5000; + nParticles 500; dir 1; deltat 0.05; particle photon; } -imcSource { - type imcSource; - nParticles 5000; - } - inactiveTally {} activeTally {} diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput index 9e2231d1e..ffb25c465 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -7,12 +7,14 @@ type IMCPhysicsPackage; pop 1000; - // For now this determines the maximum size of particle dungeons, physics package sets - // thisCycle as 15*pop and nextCycle as 10*pop - // Very abitrary and non-optimal, would benefit from a simple change such that dungeon size is - // increased automatically to accommodate required no. of particles - // Runtime is very dependent on this value, should not be set too large - // Actual number of of particles emitted in each time step is set in imcSource dictionary + // Total number of particles to be emitted during each time step from material. If an additional + // source is given, this is also the number of particles emitted from that source. + +limit 10000; + // Sets the maximum size of particle dungeons. Typically needs to be around 10*pop, and may be + // significantly higher for certain problems. Runtime is very dependent on this value so should + // not be set arbitrarily large. Would benefit from a change such that dungeon size is increased + // automatically without needing to set a limit. cycles 50; // The number of time steps to be used in the calculation @@ -29,27 +31,16 @@ dataType mg; collisionOperator { photonMG {type IMCMGstd;} - } + } transportOperator { type transportOperatorIMC; - } - -imcSource { - type imcSource; - nParticles 500; - // imcSource is required by physics package, nParticles is the number of - // particles emitted from material as radiation within each time step. - // Needs to be lower than 'pop' (see above), depending on time step size - // and material properties may need to be several orders of magnitude lower - // Increasing will give higher accuracy but longer runtime - } - + } // No tallies are required for calculation, but empty dictionaries must be given inactiveTally { - } + } activeTally { } diff --git a/InputFiles/IMC/SimpleCases/3region b/InputFiles/IMC/SimpleCases/3region index 6a6b81f28..7a58ffc82 100644 --- a/InputFiles/IMC/SimpleCases/3region +++ b/InputFiles/IMC/SimpleCases/3region @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 200000; +pop 5000; +limit 100000; cycles 51; timeStepSize 0.1; @@ -15,25 +16,7 @@ collisionOperator { transportOperator { type transportOperatorIMC; - } - -//source { -// type surfaceSource; -// shape square; -// size 1; -// axis x; -// pos -1.5; -// T 1; -// nParticles 20000; -// dir 1; -// deltat 0.1; -// particle photon; -//} - -imcSource { - type imcSource; - nParticles 50000; - } + } inactiveTally {} @@ -82,13 +65,13 @@ nuclearData { volume 1; } mat2 { - temp 0; + temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 1; } mat3 { - temp 0; + temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 1; diff --git a/InputFiles/IMC/SimpleCases/infiniteRegion b/InputFiles/IMC/SimpleCases/infiniteRegion index 03eea937a..c88ba296f 100644 --- a/InputFiles/IMC/SimpleCases/infiniteRegion +++ b/InputFiles/IMC/SimpleCases/infiniteRegion @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 1000000; +pop 1000; +limit 100000; cycles 50; timeStepSize 0.01; @@ -15,12 +16,7 @@ collisionOperator { transportOperator { type transportOperatorIMC; - } - -imcSource { - type imcSource; - nParticles 100000; - } + } inactiveTally { } diff --git a/InputFiles/IMC/SimpleCases/sphereInCube b/InputFiles/IMC/SimpleCases/sphereInCube index 14ee38aee..f25dface4 100644 --- a/InputFiles/IMC/SimpleCases/sphereInCube +++ b/InputFiles/IMC/SimpleCases/sphereInCube @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 20000; +pop 100; +limit 2000; cycles 500; timeStepSize 0.1; @@ -17,11 +18,6 @@ transportOperator { type transportOperatorIMC; } -imcSource { - type imcSource; - nParticles 100; - } - inactiveTally {} activeTally {} diff --git a/InputFiles/IMC/SimpleCases/touchingCubes b/InputFiles/IMC/SimpleCases/touchingCubes index 782ea7994..68e81b3ff 100644 --- a/InputFiles/IMC/SimpleCases/touchingCubes +++ b/InputFiles/IMC/SimpleCases/touchingCubes @@ -1,7 +1,8 @@ type IMCPhysicsPackage; -pop 50000; +pop 5000; +limit 20000; cycles 31; timeStepSize 1; @@ -17,19 +18,6 @@ transportOperator { type transportOperatorIMC; } - -//source { - // type pointSource; - // r (0 0 0); - // particle photon; - // G 1; -//} - -imcSource { - type imcSource; - nParticles 50000; - } - inactiveTally {} activeTally {} From 607004d37fbe6241cbee9a3c8c878f1e91c07782 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 20 Sep 2022 13:15:08 +0100 Subject: [PATCH 148/373] A few minor changes to comments --- CMakeLists.txt | 2 -- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 17 +++++++++++++++-- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 442bb4a1a..d64127ce8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -108,8 +108,6 @@ add_subdirectory(UserInterface) add_subdirectory(PhysicsPackages) add_subdirectory(DataStructures) -#add_subdirectory(BlackBody) - #################################################################################################### # Compile SCONE static library diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 9d2e1d5d4..3bbc4282f 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -51,6 +51,12 @@ module baseMgIMCMaterial_class !! mgIMCMaterial interface !! init -> initialise Basic MG Material from dictionary and config keyword !! nGroups -> returns number of energy groups + !! updateMat -> update material properties as required for IMC calculation + !! getEmittedRad -> returns the radiation to be emitted in current timestep + !! getFleck -> returns current material Fleck factor + !! initProps -> attach initial properties to material, seperate to init (for now) as uses quantities + !! from physics package e.g. time step size which are not available to init + !! getTemp -> returns current material temperature !! !! Note: !! Order of "data" array is: data(XS_type, Group #) @@ -66,9 +72,16 @@ module baseMgIMCMaterial_class !! type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data - real(defReal),dimension(:), allocatable :: cv, updateEqn, sigmaEqn + real(defReal),dimension(:), allocatable :: cv + real(defReal),dimension(:), allocatable :: updateEqn + real(defReal),dimension(:), allocatable :: sigmaEqn class(multiScatterMG), allocatable :: scatter - real(defReal) :: T, fleck, deltaT, sigmaP, matEnergy, volume + real(defReal) :: T + real(defReal) :: fleck + real(defReal) :: deltaT + real(defReal) :: sigmaP + real(defReal) :: matEnergy + real(defReal) :: volume integer(shortInt) :: calcType contains From 0e2eea1cdc0ed2b9de729b7c7be12fe3ea0d00f6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 25 Sep 2022 12:23:32 +0100 Subject: [PATCH 149/373] Deleted unnecessary input file lines --- InputFiles/IMC/MarshakWave/marshakWave128 | 4 ---- InputFiles/IMC/MarshakWave/marshakWave16 | 4 ---- InputFiles/IMC/MarshakWave/marshakWave32 | 4 ---- InputFiles/IMC/MarshakWave/marshakWave64 | 4 ---- InputFiles/IMC/MarshakWave/marshakWave8 | 4 ---- InputFiles/IMC/Sample/imcSampleInput | 11 ++--------- InputFiles/IMC/SimpleCases/3region | 4 ---- InputFiles/IMC/SimpleCases/infiniteRegion | 17 ----------------- InputFiles/IMC/SimpleCases/sphereInCube | 4 ---- InputFiles/IMC/SimpleCases/touchingCubes | 4 ---- 10 files changed, 2 insertions(+), 58 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index c890af8c9..65c9abfae 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -31,10 +31,6 @@ source { particle photon; } -inactiveTally {} - -activeTally {} - tally { } diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 index ea2ae42c8..ac394fe9b 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave16 +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -31,10 +31,6 @@ source { particle photon; } -inactiveTally {} - -activeTally {} - tally { } diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 638dbc86f..7a8de318b 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -31,10 +31,6 @@ source { particle photon; } -inactiveTally {} - -activeTally {} - tally { } diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 5bf333cd6..d388b34be 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -31,10 +31,6 @@ source { particle photon; } -inactiveTally {} - -activeTally {} - tally { } diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 index 86f1382d6..9118ca4d5 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave8 +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -31,10 +31,6 @@ source { particle photon; } -inactiveTally {} - -activeTally {} - tally { } diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput index ffb25c465..b2cb9be22 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -37,14 +37,7 @@ transportOperator { type transportOperatorIMC; } -// No tallies are required for calculation, but empty dictionaries must be given - -inactiveTally { - } - -activeTally { - } - +// No tallies are required for calculation, but empty dictionary must be given tally { } @@ -88,7 +81,7 @@ nuclearData { mat { temp 1; - // Initial temperature of material (will change as calculation progresses). + // Initial temperature of material in keV. composition {} // Empty dictionary required for composition. diff --git a/InputFiles/IMC/SimpleCases/3region b/InputFiles/IMC/SimpleCases/3region index 7a58ffc82..d2c4b79d3 100644 --- a/InputFiles/IMC/SimpleCases/3region +++ b/InputFiles/IMC/SimpleCases/3region @@ -18,10 +18,6 @@ transportOperator { type transportOperatorIMC; } -inactiveTally {} - -activeTally {} - tally { } diff --git a/InputFiles/IMC/SimpleCases/infiniteRegion b/InputFiles/IMC/SimpleCases/infiniteRegion index c88ba296f..28b25d162 100644 --- a/InputFiles/IMC/SimpleCases/infiniteRegion +++ b/InputFiles/IMC/SimpleCases/infiniteRegion @@ -18,24 +18,7 @@ transportOperator { type transportOperatorIMC; } -inactiveTally { - } - -activeTally { - //norm fiss; - //normVal 100; - //fiss { type collisionClerk; response (fiss); fiss {type macroResponse; MT -6;}} - flux { type collisionClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - response (flux); flux {type fluxResponse;} - } - } - tally { - imcWeight { type imcWeightClerk; - map { type energyMap; grid log; min 0.001; max 20; N 300;} - //response (imc); imc {type fluxResponse;} - } } geometry { diff --git a/InputFiles/IMC/SimpleCases/sphereInCube b/InputFiles/IMC/SimpleCases/sphereInCube index f25dface4..903716602 100644 --- a/InputFiles/IMC/SimpleCases/sphereInCube +++ b/InputFiles/IMC/SimpleCases/sphereInCube @@ -18,10 +18,6 @@ transportOperator { type transportOperatorIMC; } -inactiveTally {} - -activeTally {} - tally { } diff --git a/InputFiles/IMC/SimpleCases/touchingCubes b/InputFiles/IMC/SimpleCases/touchingCubes index 68e81b3ff..8c9cf799e 100644 --- a/InputFiles/IMC/SimpleCases/touchingCubes +++ b/InputFiles/IMC/SimpleCases/touchingCubes @@ -18,10 +18,6 @@ transportOperator { type transportOperatorIMC; } -inactiveTally {} - -activeTally {} - tally { } From e31b4da6f1731470a7c81051b6a40ca57ab19240 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 26 Sep 2022 18:48:13 +0100 Subject: [PATCH 150/373] Added planck opacity --- .../xsPackages/IMCXsPackages_class.f90 | 71 ++++++++++--------- 1 file changed, 39 insertions(+), 32 deletions(-) diff --git a/NuclearData/xsPackages/IMCXsPackages_class.f90 b/NuclearData/xsPackages/IMCXsPackages_class.f90 index 23b16c044..a03bc0452 100644 --- a/NuclearData/xsPackages/IMCXsPackages_class.f90 +++ b/NuclearData/xsPackages/IMCXsPackages_class.f90 @@ -31,6 +31,7 @@ module IMCXsPackages_class real(defReal) :: elasticScatter = ZERO real(defReal) :: inelasticScatter = ZERO real(defReal) :: capture = ZERO + real(defReal) :: planck = ZERO contains procedure :: clean => clean_IMCMacroXSs procedure :: add => add_IMCMacroXSs @@ -53,8 +54,9 @@ module IMCXsPackages_class real(defReal) :: elasticScatter = ZERO real(defReal) :: inelasticScatter = ZERO real(defReal) :: capture = ZERO + real(defReal) :: planck = ZERO contains - procedure :: invert => invert_microXSs + !procedure :: invert => invert_microXSs end type IMCMicroXSs contains @@ -77,6 +79,7 @@ elemental subroutine clean_IMCMacroXSs(self) self % elasticScatter = ZERO self % inelasticScatter = ZERO self % capture = ZERO + self % planck = ZERO end subroutine clean_IMCMacroXSs @@ -95,12 +98,13 @@ end subroutine clean_IMCMacroXSs elemental subroutine add_IMCMacroXSs(self, micro, dens) class(IMCMacroXSs), intent(inout) :: self type(IMCMicroXSs), intent(in) :: micro - real(defReal), intent(in) :: dens + real(defReal), intent(in) :: dens self % total = self % total + dens * micro % total self % elasticScatter = self % elasticScatter + dens * micro % elasticScatter self % inelasticScatter = self % inelasticScatter + dens * micro % inelasticScatter self % capture = self % capture + dens * micro % capture + self % planck = self % planck + dens * micro % planck end subroutine add_IMCMacroXSs @@ -118,8 +122,8 @@ end subroutine add_IMCMacroXSs !! elemental function get(self, MT) result(xs) class(IMCMacroXSs), intent(in) :: self - integer(shortInt), intent(in) :: MT - real(defReal) :: xs + integer(shortInt), intent(in) :: MT + real(defReal) :: xs select case(MT) case(macroTotal) @@ -131,6 +135,9 @@ elemental function get(self, MT) result(xs) case(macroEscatter) xs = self % elasticScatter + case(macroPlanck) + xs = self % planck + !case(macroAbsorbtion) ! xs = self % fission + self % capture @@ -214,42 +221,42 @@ end function invert_macroXSs !! Errors: !! If r < 0 then returns N_N_elastic !! - elemental function invert_microXSs(self, r) result(MT) - class(IMCMicroXSs), intent(in) :: self - real(defReal), intent(in) :: r - integer(shortInt) :: MT - real(defReal) :: xs - integer(shortInt) :: C + !elemental function invert_microXSs(self, r) result(MT) + ! class(IMCMicroXSs), intent(in) :: self + ! real(defReal), intent(in) :: r + ! integer(shortInt) :: MT + ! real(defReal) :: xs + ! integer(shortInt) :: C - ! Elastic Scattering - C = 1 - xs = self % total * r - self % elasticScatter - if (xs > ZERO) C = C + 1 + ! ! Elastic Scattering + ! C = 1 + ! xs = self % total * r - self % elasticScatter + ! if (xs > ZERO) C = C + 1 - ! Inelastic Scattering - xs = xs - self % inelasticScatter - if(xs > ZERO) C = C + 1 + ! ! Inelastic Scattering + ! xs = xs - self % inelasticScatter + ! if(xs > ZERO) C = C + 1 - ! Capture - xs = xs - self % capture - if(xs > ZERO) C = C + 1 + ! ! Capture + ! xs = xs - self % capture + ! if(xs > ZERO) C = C + 1 - ! Choose MT number - select case(C) - case(1) - MT = N_N_elastic + ! ! Choose MT number + ! select case(C) + ! case(1) + ! MT = N_N_elastic - case(2) - MT = N_N_inelastic + ! case(2) + ! MT = N_N_inelastic - case(3) - MT = N_disap + ! case(3) + ! MT = N_disap - case default ! Should never happen -> Avoid compiler error and return nonsense number - MT = huge(C) - end select + ! case default ! Should never happen -> Avoid compiler error and return nonsense number + ! MT = huge(C) + ! end select - end function invert_microXSs + !end function invert_microXSs end module IMCXsPackages_class From 542689682f925ac715bb3662543e4c10b8cff173 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 26 Sep 2022 19:13:20 +0100 Subject: [PATCH 151/373] Removed unnecessary lines --- .../CollisionProcessors/IMCMGstd_class.f90 | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 721dad50f..705a3c92e 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -21,17 +21,6 @@ module IMCMGstd_class use reactionHandle_inter, only : reactionHandle use multiScatterMG_class, only : multiScatterMG, multiScatterMG_CptrCast - ! Cross section packages - use IMCXsPackages_class, only : IMCMacroXSs - - - ! Nuclear Data - !use nuclearData_inter, only : nuclearData - !use perMaterialNuclearDataMG_inter, only : perMaterialNuclearDataMG - - ! Cross-section packages to interface with nuclear data - !use xsMacroSet_class, only : xsMacroSet, xsMacroSet_ptr - implicit none private @@ -95,7 +84,6 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - type(IMCMacroXSs) :: macroXSs real(defReal) :: r, fleck character(100),parameter :: Here =' sampleCollision (IMCMGstd_class.f90)' @@ -112,8 +100,6 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) self % mat => mgIMCMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG IMC Material") - ! Select Main reaction channel - call self % mat % getMacroXSs(macroXSs, p % G, p % pRNG) r = p % pRNG % get() fleck = self % mat % getFleck() From 47141208ab1b1e73a716618512c7eddefa6eacce Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 26 Sep 2022 19:17:54 +0100 Subject: [PATCH 152/373] Various changes to cross-section data handling, still a few issues to sort out --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 44 +++-- .../xsPackages/IMCXsPackages_class.f90 | 171 +----------------- SharedModules/endfConstants.f90 | 1 + 3 files changed, 30 insertions(+), 186 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 3bbc4282f..52394b713 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -33,6 +33,7 @@ module baseMgIMCMaterial_class integer(shortInt), parameter, public :: TOTAL_XS = 1 integer(shortInt), parameter, public :: IESCATTER_XS = 2 integer(shortInt), parameter, public :: CAPTURE_XS = 3 + integer(shortInt), parameter, public :: PLANCK_XS = 4 !! !! Basic type of MG material data @@ -74,7 +75,9 @@ module baseMgIMCMaterial_class real(defReal),dimension(:,:), allocatable :: data real(defReal),dimension(:), allocatable :: cv real(defReal),dimension(:), allocatable :: updateEqn - real(defReal),dimension(:), allocatable :: sigmaEqn + real(defReal),dimension(:), allocatable :: absEqn + real(defReal),dimension(:), allocatable :: scattEqn + real(defReal),dimension(:), allocatable :: planckEqn class(multiScatterMG), allocatable :: scatter real(defReal) :: T real(defReal) :: fleck @@ -146,6 +149,7 @@ subroutine getMacroXSs_byG(self, xss, G, rand) xss % elasticScatter = ZERO xss % inelasticScatter = self % data(IESCATTER_XS, G) xss % capture = self % data(CAPTURE_XS, G) + xss % planck = self % data(PLANCK_XS, G) end subroutine getMacroXSs_byG @@ -237,14 +241,15 @@ subroutine init(self, dict, scatterKey) end if self % data(IESCATTER_XS,:) = self % scatter % scatterXSs - ! Calculate total XS - do i =1,nG - self % data(TOTAL_XS, i) = self % data(IESCATTER_XS, i) + self % data(CAPTURE_XS, i) - end do + ! Read opacity equations + call dict % get(temp, 'sigmaA') + self % absEqn = temp + call dict % get(temp, 'sigmaS') + self % scattEqn = temp - ! Read Planck opacity equation - call dict % get(temp, 'sigmaP') - self % sigmaEqn = temp + ! Build planck opacity equation + ! For grey case, sigmaP = sigmaA. Will become more complicated for frequency-dependent case + self % planckEqn = self % absEqn ! Read heat capacity equation call dict % get(temp, 'cv') @@ -387,8 +392,8 @@ subroutine updateMatIMC(self, tallyEnergy) ! Update material temperature self % T = self % tempFromEnergy() - ! Update sigmaP - call self % sigmaFromTemp + ! Update sigma + call self % sigmaFromTemp() if( self % T < 0 ) then call fatalError(Here, "Temperature is negative") @@ -418,8 +423,8 @@ subroutine updateMatISMC(self, tallyEnergy) zeta = beta - eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) - ! Update sigmaP - call self % sigmaFromTemp + ! Update sigma + call self % sigmaFromTemp() end subroutine updateMatISMC @@ -436,17 +441,18 @@ function tempFromEnergy(self) result(T) end function tempFromEnergy !! - !! Calculate sigmaP from current temp + !! Calculate sigma from current temp !! subroutine sigmaFromTemp(self) class(baseMgIMCMaterial), intent(inout) :: self real(defReal) :: sigma - self % sigmaP = poly_eval(self % sigmaEqn, self % T) + self % sigmaP = poly_eval(self % planckEqn, self % T) - ! Also need these lines because cross section functions use this instead of sigmaP for now - self % data(CAPTURE_XS,:) = self % sigmaP - self % data(TOTAL_XS,:) = self % sigmaP + self % data(CAPTURE_XS,:) = poly_eval(self % absEqn, self % T) + self % data(IESCATTER_XS,:) = poly_eval(self % scattEqn, self % T) + self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) + self % data(PLANCK_XS,:) = poly_eval(self % planckEqn, self % T) end subroutine sigmaFromTemp @@ -500,9 +506,7 @@ subroutine initProps(self, deltaT, T, V) self % T = T self % matEnergy = poly_eval(self % updateEqn, self % T) * self % volume - self % sigmaP = poly_eval(self % sigmaEqn, self % T) - self % data(CAPTURE_XS,:) = self % sigmaP - self % data(TOTAL_XS,:) = self % sigmaP + call self % sigmaFromTemp() self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) self % deltaT = deltaT diff --git a/NuclearData/xsPackages/IMCXsPackages_class.f90 b/NuclearData/xsPackages/IMCXsPackages_class.f90 index a03bc0452..f124a160d 100644 --- a/NuclearData/xsPackages/IMCXsPackages_class.f90 +++ b/NuclearData/xsPackages/IMCXsPackages_class.f90 @@ -16,14 +16,14 @@ module IMCXsPackages_class !! IMC MACROscopic Reaction XSS !! !! Public Members: - !! total -> total Cross-Section [1/cm] + !! total -> total opacity [1/cm] !! elasticScatter -> sum of MT=2 elastic IMC scattering [1/cm] !! inelasticScatter -> sum of all IMC producing reaction that are not elastic scattering [1/cm] !! capture -> sum of all reactions without secondary photons [1/cm] + !! planck -> frequency-normalised planck opacity of mateirial [1/cm] !! !! Interface: !! clean -> Set all XSs to 0.0 - !! add -> Add a nuclide microscopic XSs to macroscopic !! get -> Return XS by MT number !! type, public :: IMCMacroXSs @@ -33,32 +33,10 @@ module IMCXsPackages_class real(defReal) :: capture = ZERO real(defReal) :: planck = ZERO contains - procedure :: clean => clean_IMCMacroXSs - procedure :: add => add_IMCMacroXSs + procedure :: clean procedure :: get - procedure :: invert => invert_macroXSs end type IMCMacroXSs - - !! - !! IMC microscopic Reaction XSS - !! - !! Public Members: - !! total -> total Cross-Section [barn] - !! elasticScatter -> MT=2 elastic IMC scattering [barn] - !! inelasticScatter -> all photon producing reaction that are not elastic scattering [barn] - !! capture -> all reactions without secendary photons [barn] - !! - type, public :: IMCMicroXSs - real(defReal) :: total = ZERO - real(defReal) :: elasticScatter = ZERO - real(defReal) :: inelasticScatter = ZERO - real(defReal) :: capture = ZERO - real(defReal) :: planck = ZERO - contains - !procedure :: invert => invert_microXSs - end type IMCMicroXSs - contains !! @@ -72,7 +50,7 @@ module IMCXsPackages_class !! Errors: !! None !! - elemental subroutine clean_IMCMacroXSs(self) + elemental subroutine clean(self) class(IMCMacroXSs), intent(inout) :: self self % total = ZERO @@ -81,32 +59,7 @@ elemental subroutine clean_IMCMacroXSs(self) self % capture = ZERO self % planck = ZERO - end subroutine clean_IMCMacroXSs - - !! - !! Add nuclide XSs on Macroscopic XSs - !! - !! Takes microscopic XSs * density and adds them to IMCMacroXSs - !! - !! Args: - !! micro [in] -> microscopic XSs - !! dens [in] -> nuclide density in [1/barn/cm] - !! - !! Errors: - !! None - !! - elemental subroutine add_IMCMacroXSs(self, micro, dens) - class(IMCMacroXSs), intent(inout) :: self - type(IMCMicroXSs), intent(in) :: micro - real(defReal), intent(in) :: dens - - self % total = self % total + dens * micro % total - self % elasticScatter = self % elasticScatter + dens * micro % elasticScatter - self % inelasticScatter = self % inelasticScatter + dens * micro % inelasticScatter - self % capture = self % capture + dens * micro % capture - self % planck = self % planck + dens * micro % planck - - end subroutine add_IMCMacroXSs + end subroutine clean !! !! Return XSs by MT number @@ -138,9 +91,6 @@ elemental function get(self, MT) result(xs) case(macroPlanck) xs = self % planck - !case(macroAbsorbtion) - ! xs = self % fission + self % capture - case default xs = ZERO @@ -148,115 +98,4 @@ elemental function get(self, MT) result(xs) end function get - !! - !! Use a real r in <0;1> to sample reaction from Macroscopic XSs - !! - !! This function might be common thus is type-bound procedure for conveniance - !! - !! Args: - !! r [in] -> Real number in <1;0> - !! - !! Result: - !! One of the Macroscopic MT numbers - !! elasticScatter = macroEscatter - !! inelasticScatter = macroIEscatter - !! capture = macroCapture - !! - !! Errors:: - !! If r < 0 then returns macroEscatter - !! - elemental function invert_macroXSs(self, r) result(MT) - class(IMCMacroXSs), intent(in) :: self - real(defReal), intent(in) :: r - integer(shortInt) :: MT - real(defReal) :: xs - integer(shortInt) :: C - - ! Elastic Scattering - C = 1 - xs = self % total * r - self % elasticScatter - if (xs > ZERO) C = C + 1 - - ! Inelastic Scattering - xs = xs - self % inelasticScatter - if(xs > ZERO) C = C + 1 - - ! Capture - xs = xs - self % capture - if(xs > ZERO) C = C + 1 - - ! Choose MT number - select case(C) - case(1) - MT = macroEScatter - - case(2) - MT = macroIEscatter - - case(3) - MT = macroCapture - - case default ! Should never happen -> Avoid compiler error and return nonsense number - MT = huge(C) - - end select - - end function invert_macroXSs - - - !! - !! Use a real r in <0;1> to sample reaction from Microscopic XSs - !! - !! This function involves a bit of code so is written for conviniance - !! - !! Args: - !! r [in] -> Real number in <0;1> - !! - !! Result: - !! MT number of the reaction: - !! elastic scatter = N_N_elastic - !! inelastic scatter = N_N_inelastic - !! capture = N_diasp - !! - !! Errors: - !! If r < 0 then returns N_N_elastic - !! - !elemental function invert_microXSs(self, r) result(MT) - ! class(IMCMicroXSs), intent(in) :: self - ! real(defReal), intent(in) :: r - ! integer(shortInt) :: MT - ! real(defReal) :: xs - ! integer(shortInt) :: C - - ! ! Elastic Scattering - ! C = 1 - ! xs = self % total * r - self % elasticScatter - ! if (xs > ZERO) C = C + 1 - - ! ! Inelastic Scattering - ! xs = xs - self % inelasticScatter - ! if(xs > ZERO) C = C + 1 - - ! ! Capture - ! xs = xs - self % capture - ! if(xs > ZERO) C = C + 1 - - ! ! Choose MT number - ! select case(C) - ! case(1) - ! MT = N_N_elastic - - ! case(2) - ! MT = N_N_inelastic - - ! case(3) - ! MT = N_disap - - ! case default ! Should never happen -> Avoid compiler error and return nonsense number - ! MT = huge(C) - ! end select - - !end function invert_microXSs - - end module IMCXsPackages_class diff --git a/SharedModules/endfConstants.f90 b/SharedModules/endfConstants.f90 index 088ea6094..38b4f134c 100644 --- a/SharedModules/endfConstants.f90 +++ b/SharedModules/endfConstants.f90 @@ -103,6 +103,7 @@ module endfConstants ! List of Macro MT numbers for macroscopic XSs. Unique to SCONE (not from Serpent) integer(shortInt), parameter :: macroAllScatter = -20 ,& macroAbsorbtion = -21 ,& + macroPlanck = -22 ,& noInteraction = -901 From 22cc3a7bee24cb374bdb06c32a0e583abb6a44d6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 27 Sep 2022 13:29:45 +0100 Subject: [PATCH 153/373] Fixed typo --- NuclearData/nuclearDatabase_inter.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NuclearData/nuclearDatabase_inter.f90 b/NuclearData/nuclearDatabase_inter.f90 index 0c123df8d..3eaff28f2 100644 --- a/NuclearData/nuclearDatabase_inter.f90 +++ b/NuclearData/nuclearDatabase_inter.f90 @@ -225,7 +225,7 @@ end function getNuclide !! if MT < 0 then reaction is associated with material: idx -> matIdx !! if MT > 0 then reaction is associated with nuclide: idx -> nucIdx !! - !! NOTE: This function can be used to enquire abou the presence of data. If the data is + !! NOTE: This function can be used to enquire about the presence of data. If the data is !! not present null() pointer is always returned! !! !! Args: From a4498a4b7ff47b25c617533eaadc5bb7c84ab8e5 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 27 Sep 2022 13:36:25 +0100 Subject: [PATCH 154/373] Stripped away a lot of unnecessary scattering elements --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 24 +------- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 57 +------------------ 2 files changed, 5 insertions(+), 76 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 9ff920d3d..29cae764c 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -186,23 +186,9 @@ function getReaction(self, MT, idx) result(reac) integer(shortInt), intent(in) :: MT integer(shortInt), intent(in) :: idx class(reactionHandle), pointer :: reac + character(100), parameter :: Here = 'getReaction (baseMgIMCDatabase_class.f90)' - ! Catch Invalid index - if(idx < 1 .or. idx > size(self % mats)) then - reac => null() - return - end if - - ! Select correct reaction - select case(MT) - - case(macroIEScatter) - reac => self % mats(idx) % scatter - - case default - reac => null() - - end select + call fatalError(Here, "Pointless function call") end function getReaction @@ -236,7 +222,6 @@ subroutine init(self, dict, ptr, silent) integer(shortInt) :: i, nMat type(materialItem), pointer :: matDef character(pathLen) :: path - character(nameLen) :: scatterKey type(dictionary) :: tempDict character(100), parameter :: Here = 'init (baseMgIMCDatabase_class.f90)' @@ -255,9 +240,6 @@ subroutine init(self, dict, ptr, silent) allocate(self % mats(nMat)) - ! Read scatterKey - call dict % get(scatterKey, 'PN') - ! Build materials do i=1,nMat ! Get Path to the xsFile @@ -271,7 +253,7 @@ subroutine init(self, dict, ptr, silent) ! Load dictionary call fileToDict(tempDict, path) - call self % mats(i) % init(tempDict, scatterKey) + call self % mats(i) % init(tempDict) end do diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 52394b713..574c80f5d 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -6,7 +6,6 @@ module baseMgIMCMaterial_class use genericProcedures, only : fatalError, numToChar use RNG_class, only : RNG use dictionary_class, only : dictionary - use dictDeck_class, only : dictDeck use poly_func ! Nuclear Data Interfaces @@ -14,11 +13,6 @@ module baseMgIMCMaterial_class use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill use IMCXSPackages_class, only : IMCMacroXSs - ! Reaction objects - use reactionMG_inter, only : reactionMG - use multiScatterMG_class, only : multiScatterMG - use multiScatterP1MG_class, only : multiScatterP1MG - implicit none private @@ -63,13 +57,6 @@ module baseMgIMCMaterial_class !! Order of "data" array is: data(XS_type, Group #) !! Dictionary with data must contain following entries: !! -> numberOfGroups - !! -> capture [nGx1] - !! -> scatteringMultiplicity [nGxnG] - !! -> P0 [nGxnG] - !! Optional entries: - !! -> nu [nGx1] - !! -> chi [nGx1] - !! -> P# [nGxnG] !! type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data @@ -78,7 +65,6 @@ module baseMgIMCMaterial_class real(defReal),dimension(:), allocatable :: absEqn real(defReal),dimension(:), allocatable :: scattEqn real(defReal),dimension(:), allocatable :: planckEqn - class(multiScatterMG), allocatable :: scatter real(defReal) :: T real(defReal) :: fleck real(defReal) :: deltaT @@ -122,7 +108,6 @@ elemental subroutine kill(self) ! Kill local content if(allocated(self % data)) deallocate(self % data) - if(allocated(self % scatter)) deallocate(self % scatter) end subroutine kill @@ -181,27 +166,16 @@ end function getTotalXS !! !! Args: !! dict [in] -> Input dictionary with all required XSs - !! scatterKey [in] -> String with keyword to choose approperiate multiplicative scatering - !! type + !! !! Errors: - !! FatalError if scatteKey is invalid !! FatalError if data in dictionary is invalid (inconsistant # of groups; !! -ve entries in P0 XSs) !! - !! Note: - !! Some time in the future scattering MG reaction objects will have factory. For now - !! the factory is hardcoded into this procedure. Not the best solution but is fine at this - !! stage. The following scatterKey are supported: - !! -> P0 - !! -> P1 - !! - subroutine init(self, dict, scatterKey) + subroutine init(self, dict) class(baseMgIMCMaterial), intent(inout) :: self class(dictionary),target, intent(in) :: dict - character(nameLen), intent(in) :: scatterKey integer(shortInt) :: nG, N, i real(defReal), dimension(:), allocatable :: temp - type(dictDeck) :: deck character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' @@ -209,38 +183,11 @@ subroutine init(self, dict, scatterKey) call dict % get(nG, 'numberOfGroups') if(nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) - ! Build scattering reaction - ! Prepare input deck - deck % dict => dict - - ! Choose Scattering type - select case(scatterKey) - case ('P0') - allocate( multiScatterMG :: self % scatter) - - case ('P1') - allocate( multiScatterP1MG :: self % scatter) - - case default - call fatalError(Here,'scatterKey: '//trim(scatterKey)//'is wrong. Must be P0 or P1') - - end select - - ! Initialise - call self % scatter % init(deck, macroAllScatter) - ! Allocate space for data N = 3 allocate(self % data(N, nG)) - ! Extract values of scattering XS - if(size(self % scatter % scatterXSs) /= nG) then - call fatalError(Here, 'Somthing went wrong. Inconsistant # of groups in material and reaction& - &. Clearly programming error.') - end if - self % data(IESCATTER_XS,:) = self % scatter % scatterXSs - ! Read opacity equations call dict % get(temp, 'sigmaA') self % absEqn = temp From df4cc475b888ccf01f25739a17b8a8f2c90032e3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 27 Sep 2022 19:28:45 +0100 Subject: [PATCH 155/373] Lots of changes to get rid of annoying initProps subroutine. T and V now supplied to mat_class automatically, and deltaT obtained from materialMenu_mod --- NuclearData/IMCMaterial_inter.f90 | 15 ---- NuclearData/materialMenu_mod.f90 | 39 ++++++++--- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 10 ++- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 68 ++++++------------- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 15 ---- PhysicsPackages/IMCPhysicsPackage_class.f90 | 14 ++-- 6 files changed, 65 insertions(+), 96 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index d803afaa3..862b05a62 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -34,7 +34,6 @@ module IMCMaterial_inter procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck - procedure(initProps), deferred :: initProps procedure(getTemp), deferred :: getTemp end type IMCMaterial @@ -92,20 +91,6 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck - !! - !! Store deltaT in material class and set initial material properties - !! - !! Can be called from physics package with required arguments, as init does not have access - !! to deltaT - !! - !! Args: - !! deltaT -> Time step size - !! - subroutine initProps(self, deltaT, T, V) - import :: IMCMaterial, defReal - class(IMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT, T, V - end subroutine initProps function getTemp(self) result(T) import :: IMCMaterial, defReal diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index 25db59e62..e9af3042c 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -10,15 +10,16 @@ !! nameMap -> Map that maps material name to matIdx !! !! Interface: -!! init -> Load material definitions from a dictionary -!! kill -> Return to uninitialised state -!! display -> Display information about all defined materials to console -!! getMatPtr -> Return pointer to a detailed material information (materialItem) -!! nMat -> Return number of materials -!! matName -> Return material Name given Index -!! matTemp -> Return material Temperature given Index -!! matVol -> Return material Volume given Index -!! matIdx -> Return material Index given Name +!! init -> Load material definitions from a dictionary +!! kill -> Return to uninitialised state +!! display -> Display information about all defined materials to console +!! getMatPtr -> Return pointer to a detailed material information (materialItem) +!! nMat -> Return number of materials +!! matName -> Return material Name given Index +!! matTemp -> Return material Temperature given Index +!! matVol -> Return material Volume given Index +!! matIdx -> Return material Index given Name +!! setTimeStep -> Set size of time step !! module materialMenu_mod @@ -102,6 +103,7 @@ module materialMenu_mod !! MODULE COMPONENTS type(materialItem),dimension(:),allocatable,target,public :: materialDefs type(charMap),target,public :: nameMap + real(defReal), public :: timeStepSize = ZERO public :: init public :: kill @@ -112,6 +114,7 @@ module materialMenu_mod public :: matTemp public :: matVol public :: matIdx + public :: setTimeStep contains @@ -130,7 +133,7 @@ subroutine init(dict) integer(shortInt) :: i character(nameLen) :: temp - ! Clean whatever may be alrady present + ! Clean whatever may be already present call kill() ! Load all material names @@ -290,6 +293,21 @@ function matIdx(name) result(idx) end function matIdx + !! + !! Set time step + !! + !! Used by IMC and ISMC physics packages to provide material objects with time step size + !! + !! Args: + !! dt [in] -> time step size [s] + !! + subroutine setTimeStep(dt) + real(defReal), intent(in) :: dt + + timeStepSize = dt + + end subroutine setTimeStep + !!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! TYPE PROCEDURES !!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -352,6 +370,7 @@ subroutine kill_materialItem(self) self % name = '' self % matIdx = 0 self % T = ZERO + self % V = ZERO ! Deallocate allocatable components if(allocated(self % dens)) deallocate(self % dens) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 29cae764c..e0d6fc83b 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -188,6 +188,7 @@ function getReaction(self, MT, idx) result(reac) class(reactionHandle), pointer :: reac character(100), parameter :: Here = 'getReaction (baseMgIMCDatabase_class.f90)' + reac => null() call fatalError(Here, "Pointless function call") end function getReaction @@ -224,7 +225,7 @@ subroutine init(self, dict, ptr, silent) character(pathLen) :: path type(dictionary) :: tempDict character(100), parameter :: Here = 'init (baseMgIMCDatabase_class.f90)' - + ! Prevent reallocations call self % kill() @@ -242,6 +243,7 @@ subroutine init(self, dict, ptr, silent) ! Build materials do i=1,nMat + ! Get Path to the xsFile matDef => mm_getMatPtr(i) call matDef % extraInfo % get(path,'xsFile') @@ -253,6 +255,12 @@ subroutine init(self, dict, ptr, silent) ! Load dictionary call fileToDict(tempDict, path) + + ! Add temperature and volume into dictionary + call tempDict % store('T', matDef % T) + call tempDict % store('V', matdef % V) + + ! Initialise material call self % mats(i) % init(tempDict) end do diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 574c80f5d..8ef30d2bc 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -12,6 +12,7 @@ module baseMgIMCMaterial_class use materialHandle_inter, only : materialHandle use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill use IMCXSPackages_class, only : IMCMacroXSs + use materialMenu_mod, only : timeStepSize implicit none private @@ -49,8 +50,6 @@ module baseMgIMCMaterial_class !! updateMat -> update material properties as required for IMC calculation !! getEmittedRad -> returns the radiation to be emitted in current timestep !! getFleck -> returns current material Fleck factor - !! initProps -> attach initial properties to material, seperate to init (for now) as uses quantities - !! from physics package e.g. time step size which are not available to init !! getTemp -> returns current material temperature !! !! Note: @@ -70,7 +69,7 @@ module baseMgIMCMaterial_class real(defReal) :: deltaT real(defReal) :: sigmaP real(defReal) :: matEnergy - real(defReal) :: volume + real(defReal) :: V integer(shortInt) :: calcType contains @@ -85,7 +84,6 @@ module baseMgIMCMaterial_class procedure :: updateMat procedure :: getEmittedRad procedure :: getFleck - procedure :: initProps procedure :: getTemp procedure, private :: updateMatIMC @@ -107,7 +105,7 @@ elemental subroutine kill(self) call kill_super(self) ! Kill local content - if(allocated(self % data)) deallocate(self % data) + if(allocated(self % data)) deallocate(self % data) end subroutine kill @@ -174,20 +172,21 @@ end function getTotalXS subroutine init(self, dict) class(baseMgIMCMaterial), intent(inout) :: self class(dictionary),target, intent(in) :: dict - integer(shortInt) :: nG, N, i + integer(shortInt) :: nG, N real(defReal), dimension(:), allocatable :: temp character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' - ! Read number of groups call dict % get(nG, 'numberOfGroups') if(nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) ! Allocate space for data - N = 3 - + N = 4 allocate(self % data(N, nG)) + ! Store time step size + self % deltaT = timeStepSize + ! Read opacity equations call dict % get(temp, 'sigmaA') self % absEqn = temp @@ -206,6 +205,18 @@ subroutine init(self, dict) call poly_integrate(temp) self % updateEqn = temp + ! Read initial temperature and volume + call dict % get(self % T, 'T') + call dict % get(self % V, 'V') + + ! Calculate initial opacities, energy and Fleck factor + call self % sigmaFromTemp() + self % matEnergy = poly_eval(self % updateEqn, self % T) * self % V + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT) + + ! Set calculation type (will support ISMC in the future) + self % calcType = IMC + end subroutine init !! @@ -382,7 +393,7 @@ function tempFromEnergy(self) result(T) class(baseMgIMCMaterial), intent(inout) :: self real(defReal) :: T, energyDens - energyDens = self % matEnergy / self % volume + energyDens = self % matEnergy / self % V T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) end function tempFromEnergy @@ -392,7 +403,6 @@ end function tempFromEnergy !! subroutine sigmaFromTemp(self) class(baseMgIMCMaterial), intent(inout) :: self - real(defReal) :: sigma self % sigmaP = poly_eval(self % planckEqn, self % T) @@ -413,7 +423,7 @@ function getEmittedRad(self) result(emittedRad) U_r = radiationConstant * (self % T)**4 - emittedRad = lightSpeed * self % deltaT * self % sigmaP * self % fleck * U_r * self % volume + emittedRad = lightSpeed * self % deltaT * self % sigmaP * self % fleck * U_r * self % V end function getEmittedRad @@ -428,40 +438,6 @@ function getFleck(self) result(fleck) end function getFleck - !! - !! Store deltaT in material class and set initial material properties - !! - !! Can be called from physics package with required arguments, as init does not have access - !! to deltaT - !! - !! Args: - !! deltaT -> Time step size - !! T -> Initial temperature - !! V -> Material volume - !! - !! Errors: - !! fatalError if material volume <= 0 - !! - subroutine initProps(self, deltaT, T, V) - class(baseMgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT, T, V - character(100), parameter :: Here = 'initProps (baseMgIMCMaterial_class.f90)' - - self % volume = V - if(self % volume <= 0) call fatalError(Here, 'Invalid material volume given') - - self % T = T - self % matEnergy = poly_eval(self % updateEqn, self % T) * self % volume - - call self % sigmaFromTemp() - - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*deltaT) - self % deltaT = deltaT - - self % calcType = IMC - - end subroutine initProps - function getTemp(self) result(T) class(baseMgIMCMaterial), intent(inout) :: self diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index a7fa27ad7..daa03e18b 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -46,7 +46,6 @@ module mgIMCMaterial_inter procedure(updateMat), deferred :: updateMat procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck - procedure(initProps), deferred :: initProps procedure(getTemp), deferred :: getTemp end type mgIMCMaterial @@ -127,20 +126,6 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck - !! - !! Store deltaT in material class and set initial material properties - !! - !! Can be called from physics package with required arguments, as init does not have access - !! to deltaT - !! - !! Args: - !! deltaT -> Time step size - !! - subroutine initProps(self, deltaT, T, V) - import :: mgIMCMaterial, defReal - class(mgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: deltaT, T, V - end subroutine initProps function getTemp(self) result(T) import :: mgIMCMaterial, defReal diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 7f1058a6f..a0fc4cfc3 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -29,8 +29,7 @@ module IMCPhysicsPackage_class ! Nuclear Data use materialMenu_mod, only : mm_nMat => nMat ,& mm_matName => matName ,& - mm_matTemp => matTemp ,& - mm_matVol => matVol + mm_setTimeStep => setTimeStep use nuclearDataReg_mod, only : ndReg_init => init ,& ndReg_activate => activate ,& ndReg_display => display, & @@ -160,12 +159,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call timerReset(self % timerMain) call timerStart(self % timerMain) - ! Attach initial properties to material classes - do j=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - call mat % initProps(self % deltaT, mm_matTemp(j), mm_matVol(j)) - end do - allocate(tallyEnergy(self % nMat)) do i=1,N_cycles @@ -397,6 +390,9 @@ subroutine init(self, dict) ! Read whether to print particle source per cycle call dict % getOrDefault(self % printSource, 'printSource', 0) + ! Provide materialMenuMod with time step size + call mm_setTimeStep(self % deltaT) + ! Build Nuclear Data call ndReg_init(dict % getDictPtr("nuclearData")) @@ -418,7 +414,7 @@ subroutine init(self, dict) self % sourceGiven = .true. end if - ! Initialise ISMC source + ! Initialise IMC source call locDict1 % init(2) call locDict1 % store('type', 'imcSource') call locDict1 % store('nParticles', self % pop) From dd3f222a01f01f20dbcd1b9785dabd67411842ec Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Sep 2022 15:12:09 +0100 Subject: [PATCH 156/373] Changed input files to new opacity inputs and removing some scattering terms --- InputFiles/IMC/MarshakWave/dataFiles/imcData | 17 +++----- InputFiles/IMC/MarshakWave/marshakWave128 | 2 +- InputFiles/IMC/MarshakWave/marshakWave16 | 2 +- InputFiles/IMC/MarshakWave/marshakWave32 | 2 +- InputFiles/IMC/MarshakWave/marshakWave64 | 2 +- InputFiles/IMC/MarshakWave/marshakWave8 | 2 +- InputFiles/IMC/Sample/imcSampleInput | 18 ++++---- InputFiles/IMC/Sample/imcSampleMat | 17 ++++---- InputFiles/IMC/SimpleCases/3region | 2 +- InputFiles/IMC/SimpleCases/dataFiles/imcData | 15 +++---- InputFiles/IMC/SimpleCases/dataFiles/imcData2 | 13 ++---- InputFiles/IMC/SimpleCases/infiniteRegion | 2 +- InputFiles/IMC/SimpleCases/sphereInCube | 2 +- InputFiles/IMC/SimpleCases/touchingCubes | 4 +- bitbucket-pipelines.yml | 43 ------------------- 15 files changed, 43 insertions(+), 100 deletions(-) delete mode 100644 bitbucket-pipelines.yml diff --git a/InputFiles/IMC/MarshakWave/dataFiles/imcData b/InputFiles/IMC/MarshakWave/dataFiles/imcData index f5ff053e0..a768438a6 100644 --- a/InputFiles/IMC/MarshakWave/dataFiles/imcData +++ b/InputFiles/IMC/MarshakWave/dataFiles/imcData @@ -1,21 +1,16 @@ numberOfGroups 1; -capture (0.0); - -scatteringMultiplicity ( -0.0 -); - -P0 ( - 0.0 -); - -sigmaP ( +sigmaA ( 10 -3 ); +sigmaS ( + 0 + 0 +); + cv ( 7.14 0 diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index 65c9abfae..5469a1f40 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -210,7 +210,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 index ac394fe9b..eb9fe50bf 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave16 +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -83,7 +83,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 7a8de318b..630faf229 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -101,7 +101,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index d388b34be..174276cb4 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -138,7 +138,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 index 9118ca4d5..d5bf847c2 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave8 +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -75,7 +75,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput index b2cb9be22..8bb090767 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -65,15 +65,15 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } // Dictionary containing all materials used in geometry - // If desired to have spatial temperature variation, split geometry (above) - // into desired cells and set each cell fill as a DIFFERENT material - // (e.g. mat1, mat2, mat3, ...) then define all materials here. Even if each - // each mat input is identical (even including data file), a unique material object - // will be created allowing for a unique temperature evolution. + // If desired to have spatial temperature variation, split geometry (above) into desired cells + // and set each cell fill as a DIFFERENT material (e.g. mat1, mat2, mat3, ...) then define + // all materials here. Even if each each mat input is identical, a unique material object + // will be created allowing for a unique temperature evolution. The same xsFile may be used + // for different materials if desired. materials { @@ -81,7 +81,7 @@ nuclearData { mat { temp 1; - // Initial temperature of material in keV. + // Initial temperature of material [keV]. composition {} // Empty dictionary required for composition. @@ -90,13 +90,13 @@ nuclearData { // Location of material data file containing material properties. volume 1; - // Total volume that this material occupies, for now need to calculate by hand + // Total volume that this material occupies [cm3], for now need to calculate by hand // and enter here. May be room to make this automatic in the future. } // Example 2: mat2 - //mat2 { temp 1; composition {} xssFile ./imcSampleMat2; volume 1 } + //mat2 { temp 1; composition {} xsFile ./imcSampleMat2; volume 1 } } diff --git a/InputFiles/IMC/Sample/imcSampleMat b/InputFiles/IMC/Sample/imcSampleMat index 0a936419f..d36a8b73b 100644 --- a/InputFiles/IMC/Sample/imcSampleMat +++ b/InputFiles/IMC/Sample/imcSampleMat @@ -5,23 +5,24 @@ numberOfGroups 1; - // For now the following 3 settings are required at 0, just due to the way that - // some of the cross section functions work the same as other calculation types -capture (0.0); -scatteringMultiplicity (0.0); -P0 (0.0); - // Set polynomial temperature-dependent Planck opacity for the material. + // Set polynomial temperature-dependent opacities for the material. // Currently have only considered the grey case, if using a frequency dependent opacity // then this would need to be changed to a more complex input. // Input should be a 1D array of coefficients followed by exponents, with any polynomial // length allowed - // e.g. Here, sigmaP = 1 + 2T -sigmaP ( + // e.g. Here, sigmaA = 1 + 2T + +sigmaA ( // Absorption opacity 1 2 // Coefficients 0 1 // Exponents ); +sigmaS ( // Scattering opacity + 0 + 0 +); + // Set temperature-dependent specific heat capacity of the material. // Same format as above. // Currently cannot have an exponent of exactly -1, as cv is integrated simply by adding 1 to diff --git a/InputFiles/IMC/SimpleCases/3region b/InputFiles/IMC/SimpleCases/3region index d2c4b79d3..6f5bdb8c6 100644 --- a/InputFiles/IMC/SimpleCases/3region +++ b/InputFiles/IMC/SimpleCases/3region @@ -48,7 +48,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData b/InputFiles/IMC/SimpleCases/dataFiles/imcData index f7faacf36..78c551fa5 100644 --- a/InputFiles/IMC/SimpleCases/dataFiles/imcData +++ b/InputFiles/IMC/SimpleCases/dataFiles/imcData @@ -1,18 +1,13 @@ numberOfGroups 1; -capture (0.0); - -scatteringMultiplicity ( -0.0 -); - -P0 ( - 0.0 +sigmaA ( + 1 + 0 ); -sigmaP ( - 1 +sigmaS ( + 0 0 ); diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 index 94e80c4f7..40c4cd084 100644 --- a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 +++ b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 @@ -1,18 +1,13 @@ numberOfGroups 1; -capture (0.0); - -scatteringMultiplicity ( -0.0 -); - -P0 ( +sigmaA ( + 1.0 0.0 ); -sigmaP ( - 1.0 +sigmaS ( + 0.0 0.0 ); diff --git a/InputFiles/IMC/SimpleCases/infiniteRegion b/InputFiles/IMC/SimpleCases/infiniteRegion index 28b25d162..3a371dccf 100644 --- a/InputFiles/IMC/SimpleCases/infiniteRegion +++ b/InputFiles/IMC/SimpleCases/infiniteRegion @@ -47,7 +47,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/InputFiles/IMC/SimpleCases/sphereInCube b/InputFiles/IMC/SimpleCases/sphereInCube index 903716602..efcc93c60 100644 --- a/InputFiles/IMC/SimpleCases/sphereInCube +++ b/InputFiles/IMC/SimpleCases/sphereInCube @@ -46,7 +46,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/InputFiles/IMC/SimpleCases/touchingCubes b/InputFiles/IMC/SimpleCases/touchingCubes index 8c9cf799e..9e84c3117 100644 --- a/InputFiles/IMC/SimpleCases/touchingCubes +++ b/InputFiles/IMC/SimpleCases/touchingCubes @@ -3,7 +3,7 @@ type IMCPhysicsPackage; pop 5000; limit 20000; -cycles 31; +cycles 51; timeStepSize 1; XSdata mg; @@ -46,7 +46,7 @@ geometry { nuclearData { handles { - mg { type baseMgIMCDatabase; PN P0;} + mg { type baseMgIMCDatabase; } } diff --git a/bitbucket-pipelines.yml b/bitbucket-pipelines.yml deleted file mode 100644 index 965a332d0..000000000 --- a/bitbucket-pipelines.yml +++ /dev/null @@ -1,43 +0,0 @@ -# This Contains instructions for automated build and test of SCONE -# Only use spaces to indent your .yml configuration. -# ----- -pipelines: - custom: - tests: - - step: - name: gfortran-6 - image: mikolajkowalski/ubuntu-pfunit:6 - script: # Will execute the following commands - - ./scripts/install_scone.sh - - ./scripts/run_tests.sh - - step: - name: gfortran-7 - image: mikolajkowalski/ubuntu-pfunit:7 - script: # Will execute the following commands - - ./scripts/install_scone.sh - - ./scripts/run_tests.sh - - step: - name: gfortran-8 - image: mikolajkowalski/ubuntu-pfunit:8 - script: # Will execute the following commands - - ./scripts/install_scone.sh - - ./scripts/run_tests.sh -# - step: -# name: gfortran-9 -# image: mikolajkowalski/ubuntu-pfunit:9 -# script: # Will execute the following commands -# - ./scripts/install_scone.sh -# - ./scripts/run_tests.sh - cream_test: - - step: - name: Python-3.6 - image: python:3.6-slim - script: - - ./scripts/install_cream.sh - - ./scripts/test_cream.sh - - step: - name: Python-3.7 - image: python:3.7-slim - script: - - ./scripts/install_cream.sh - - ./scripts/test_cream.sh From 6552e34e507cea74b52d4e243407898ca42b7f16 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Sep 2022 15:32:47 +0100 Subject: [PATCH 157/373] Added option to change alpha setting --- InputFiles/IMC/Sample/imcSampleMat | 5 +++++ .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 12 ++++++++---- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/InputFiles/IMC/Sample/imcSampleMat b/InputFiles/IMC/Sample/imcSampleMat index d36a8b73b..d71cc4895 100644 --- a/InputFiles/IMC/Sample/imcSampleMat +++ b/InputFiles/IMC/Sample/imcSampleMat @@ -5,6 +5,9 @@ numberOfGroups 1; +alpha = 1; + // Optional setting of alpha used in calculation of fleck factor. If not given, alpha is set at 1. + // Set polynomial temperature-dependent opacities for the material. // Currently have only considered the grey case, if using a frequency dependent opacity @@ -23,6 +26,7 @@ sigmaS ( // Scattering opacity 0 ); + // Set temperature-dependent specific heat capacity of the material. // Same format as above. // Currently cannot have an exponent of exactly -1, as cv is integrated simply by adding 1 to @@ -32,6 +36,7 @@ sigmaS ( // Scattering opacity // numerical oversight in the way the calculation is done or if these are just unphysical // choices. // e.g. Here, cv = 4T^3 - 2T + T^(-0.5) + cv ( 4 -2 1 // Coefficients 3 1 -0.5 // Exponents diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 8ef30d2bc..4b5086140 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -65,11 +65,12 @@ module baseMgIMCMaterial_class real(defReal),dimension(:), allocatable :: scattEqn real(defReal),dimension(:), allocatable :: planckEqn real(defReal) :: T + real(defReal) :: V real(defReal) :: fleck + real(defReal) :: alpha real(defReal) :: deltaT real(defReal) :: sigmaP real(defReal) :: matEnergy - real(defReal) :: V integer(shortInt) :: calcType contains @@ -184,8 +185,9 @@ subroutine init(self, dict) N = 4 allocate(self % data(N, nG)) - ! Store time step size + ! Store time step size and alpha settings self % deltaT = timeStepSize + call dict % getOrDefault(self % alpha, 'alpha', ONE) ! Read opacity equations call dict % get(temp, 'sigmaA') @@ -212,7 +214,9 @@ subroutine init(self, dict) ! Calculate initial opacities, energy and Fleck factor call self % sigmaFromTemp() self % matEnergy = poly_eval(self % updateEqn, self % T) * self % V - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT) + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT*self % alpha) + + print *, 'AAAA', self % alpha, self % fleck ! Set calculation type (will support ISMC in the future) self % calcType = IMC @@ -357,7 +361,7 @@ subroutine updateMatIMC(self, tallyEnergy) call fatalError(Here, "Temperature is negative") end if - self % fleck = 1 / (1 + 1*self % sigmaP*lightSpeed*self % deltaT) ! Incomplete, need to add alpha + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT*self % alpha) end subroutine updateMatIMC From 9284f3312b6ab570d7559ef6efaa0de2a3b71281 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Sep 2022 16:37:16 +0100 Subject: [PATCH 158/373] Moved effective scattering into elastic instead of inelastic, as currently enegry-weights are unchanged during the collision --- .../CollisionProcessors/IMCMGstd_class.f90 | 41 ++++++++----------- 1 file changed, 18 insertions(+), 23 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 705a3c92e..a86b2525e 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -19,7 +19,6 @@ module IMCMGstd_class use mgIMCDatabase_inter, only : mgIMCDatabase use mgIMCMaterial_inter, only : mgIMCMaterial, mgIMCMaterial_CptrCast use reactionHandle_inter, only : reactionHandle - use multiScatterMG_class, only : multiScatterMG, multiScatterMG_CptrCast implicit none private @@ -109,7 +108,7 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) collDat % MT = macroCapture else ! Effective scattering - collDat % MT = macroIEScatter + collDat % MT = macroAllScatter end if end subroutine sampleCollision @@ -129,7 +128,7 @@ subroutine implicit(self, p, collDat, thisCycle, nextCycle) end subroutine implicit !! - !! Elastic Scattering + !! Effective scattering - currently only elastic (constant energy-weight) !! subroutine elastic(self, p , collDat, thisCycle, nextCycle) class(IMCMGstd), intent(inout) :: self @@ -137,17 +136,27 @@ subroutine elastic(self, p , collDat, thisCycle, nextCycle) type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle + real(defReal) :: phi, mu + real(defReal), dimension(3) :: dir character(100), parameter :: Here = 'elastic (IMCMGstd_class.f90)' - ! Do nothing. Should not be called + ! Assign MT number + collDat % MT = macroAllScatter + + ! Sample Direction - chosen uniformly inside unit sphere + mu = 2 * p % pRNG % get() - 1 + phi = p % pRNG % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) - call fatalError(Here, "Elastic subroutine should not be called") + !p % coords % dir = dir + call p % rotate(mu, phi) end subroutine elastic !! - !! Perform scattering - Currently this is for effective scattering, and energy weights - !! are unchanged (so is actually elastic) + !! Inelastic scattering - Not currently supported !! subroutine inelastic(self, p, collDat, thisCycle, nextCycle) class(IMCMGstd), intent(inout) :: self @@ -155,25 +164,11 @@ subroutine inelastic(self, p, collDat, thisCycle, nextCycle) type(collisionData), intent(inout) :: collDat class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - class(multiScatterMG),pointer :: scatter - integer(shortInt) :: G_out ! Post-collision energy group - real(defReal) :: phi, mu ! Azimuthal scatter angle - real(defReal) :: w_mul ! Weight multiplier - real(defReal), dimension(3) :: dir character(100),parameter :: Here = "inelastic (IMCMGstd_class.f90)" - ! Assign MT number - collDat % MT = macroIEScatter - - ! Sample Direction - chosen uniformly inside unit sphere - mu = 2 * p % pRNG % get() - 1 - phi = p % pRNG % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) + ! Do nothing. Should not be called - !p % coords % dir = dir - call p % rotate(mu, phi) + call fatalError(Here, "Inelastic subroutine should not be called") end subroutine inelastic From 7d8184a9d139df06690a536d1116db3c52d15248 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Sep 2022 19:01:11 +0100 Subject: [PATCH 159/373] Allowed collision processor to infer calculation type without needing an entirely new processor --- .../CollisionProcessors/IMCMGstd_class.f90 | 16 ++++++++++++++-- .../collisionProcessorFactory_func.f90 | 9 ++++++++- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 13 +++---------- 3 files changed, 25 insertions(+), 13 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 89f2fe3c7..10756cf76 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -2,12 +2,13 @@ module IMCMGstd_class use numPrecision use endfConstants + use universalVariables, only : IMC, ISMC use genericProcedures, only : fatalError, rotateVector, numToChar use dictionary_class, only : dictionary use RNG_class, only : RNG ! Particle types - use particle_class, only : particle, particleState, printType, P_PHOTON + use particle_class, only : particle, particleState, printType, P_PHOTON, P_MATERIAL use particleDungeon_class, only : particleDungeon ! Abstract interface @@ -39,6 +40,7 @@ module IMCMGstd_class private class(mgIMCDatabase), pointer, public :: xsData => null() class(mgIMCMaterial), pointer, public :: mat => null() + integer(shortInt) :: calcType contains ! Initialisation procedure procedure :: init @@ -61,8 +63,14 @@ module IMCMGstd_class subroutine init(self, dict) class(IMCMGstd), intent(inout) :: self class(dictionary), intent(in) :: dict + character(nameLen) :: calcType character(100), parameter :: Here = 'init (IMCMGstd_class.f90)' + ! Set calculation type + self % calcType = IMC + call dict % get(calcType, 'type') + if(calcType == 'ISMCMGstd') self % calcType = ISMC + ! Call superclass call init_super(self, dict) @@ -182,7 +190,11 @@ subroutine capture(self, p, collDat, thisCycle, nextCycle) class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - p % isDead = .true. + if(self % calcType == IMC) then + p % isDead = .true. + else + p % type = P_MATERIAL + end if end subroutine capture diff --git a/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 b/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 index ce45809e7..6384d7b6f 100644 --- a/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 +++ b/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 @@ -26,7 +26,8 @@ module collisionProcessorFactory_func character(nameLen),dimension(*),parameter :: AVALIBLE_collisionProcessors = [ 'neutronCEstd',& 'neutronCEimp',& 'neutronMGstd',& - 'IMCMGstd '] + 'IMCMGstd ',& + 'ISMCMGstd '] contains @@ -65,6 +66,12 @@ subroutine new_collisionProcessor(new,dict) allocate(IMCMGstd :: new) call new % init(dict) + case('ISMCMGstd') + ! Collisions are very similar for IMC and ISMC so both use the same processor + ! Having this as a separate case allows this processor to tell the difference + allocate(IMCMGstd :: new) + call new % init(dict) + !*** NEW COLLISION PROCESSOR TEMPLATE ***! !case('') ! allocate( :: new) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index c724a9ca5..f286c95a1 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -237,15 +237,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) - ! If absorbed, transform into material - if(p % isDead) then - p % isDead = .false. - p % fate = 0 - p % type = P_MATERIAL - !call self % nextCycle % detain(p) - !exit history - cycle history - end if + if(p % isDead) call fatalError(Here, 'Particle should not be dead, check that collision & + operator is of type "ISMCMGstd"') end do history @@ -475,7 +468,7 @@ subroutine init(self, dict) mats(i) = mm_matName(i) end do - ! Attach initial properties to material classes + ! Set calculation type for material objects do j=1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) call mat % setType(ISMC) From 71be74badd82aba3a553f32762870cc7c4e172eb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Sep 2022 19:01:35 +0100 Subject: [PATCH 160/373] Change missed from merge --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 25d4205eb..6fc78214a 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -443,13 +443,6 @@ subroutine init(self, dict) mats(i) = mm_matName(i) end do - ! Attach initial properties to material classes - do j=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - call mat % initProps(self % deltaT, mm_matTemp(j), mm_matVol(j)) - call mat % setType(IMC) - end do - ! Initialise imcWeight tally attachment call locDict2 % init(1) call locDict3 % init(2) From b66c975b309f83303fb6820057a471668969d27d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Sep 2022 19:01:53 +0100 Subject: [PATCH 161/373] Removed unnecessary lines --- ParticleObjects/Source/ISMCSource_class.f90 | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/ParticleObjects/Source/ISMCSource_class.f90 b/ParticleObjects/Source/ISMCSource_class.f90 index ef16dcd72..0d0009c3d 100644 --- a/ParticleObjects/Source/ISMCSource_class.f90 +++ b/ParticleObjects/Source/ISMCSource_class.f90 @@ -81,14 +81,7 @@ subroutine init(self, dict, geom) ! Calculate volume of bounding region boundSize = self % top - self % bottom - self % boundingVol = boundSize(1) * boundSize(2) * boundSize(3) - -! ! Initialise array to store numbers of particles -! n = MMnMat() -! allocate( self % matPops(n) ) -! do i=1, n -! self % matPops(i) = 0 -! end do + self % boundingVol = boundSize(1) * boundSize(2) * boundSize(3) end subroutine init @@ -159,16 +152,6 @@ function sampleParticle(self, rand) result(p) p % wgt = mat % getEnergyDens() * self % boundingVol / self % N -! ! Don't sample particles from areas of 0 temperature -! if( p % wgt == 0 ) then -! self % matPops(matIdx) = 1 ! Set to 1 to avoid error in appendIMC (source_inter.f90) -! i = i - 0.9 ! To allow more attempts if large regions with 0 temp -! cycle rejection -! end if - -! ! Increase counter of number of particles in material in order to normalise later -! self % matPops(matIdx) = self % matPops(matIdx) + 1 - ! Exit the loop exit rejection From 02acd37aabc05a189a8faa2ebeebca9c946ae471 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Sep 2022 19:03:09 +0100 Subject: [PATCH 162/373] Correctly calculates initial properties for ISMC --- .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index f14967185..c29cb0984 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -220,8 +220,6 @@ subroutine init(self, dict) self % matEnergy = poly_eval(self % updateEqn, self % T) * self % V self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT*self % alpha) - print *, 'AAAA', self % alpha, self % fleck - ! Set calculation type (will support ISMC in the future) self % calcType = IMC @@ -503,10 +501,21 @@ end function getEnergyDens subroutine setType(self, calcType) class(baseMgIMCMaterial), intent(inout) :: self integer(shortInt), intent(in) :: calcType + real(defReal) :: beta, zeta character(100), parameter :: Here = 'setType (baseMgIMCMaterial_class.f90)' + if(calcType /= IMC .and. calcType /= ISMC) call fatalError(Here, 'Invalid calculation type') + self % calcType = calcType + ! If ISMC, recalculate Fleck + if(self % calcType == ISMC) then + beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + self % eta = radiationConstant * self % T**4 / self % matEnergy + zeta = beta - self % eta + self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) + end if + end subroutine setType end module baseMgIMCMaterial_class From 66e9087665c59283cf04d5c44cf0732fd967433c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Sep 2022 19:04:58 +0100 Subject: [PATCH 163/373] Deleted print line --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 4b5086140..7cfea4ed9 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -216,8 +216,6 @@ subroutine init(self, dict) self % matEnergy = poly_eval(self % updateEqn, self % T) * self % V self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT*self % alpha) - print *, 'AAAA', self % alpha, self % fleck - ! Set calculation type (will support ISMC in the future) self % calcType = IMC From bd5b81c3c109cd83c18241f357287efe0d501052 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 29 Sep 2022 17:18:02 +0100 Subject: [PATCH 164/373] Trying out a way to limit particle numbers --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 22 +++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index a0fc4cfc3..e7fa6c8ef 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -132,7 +132,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_cycles - integer(shortInt) :: i, j + integer(shortInt) :: i, j, N type(particle) :: p real(defReal) :: elapsed_T, end_T, T_toEnd, sumT real(defReal), dimension(:), allocatable :: tallyEnergy @@ -177,7 +177,13 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Generate IMC source, only if there are regions with non-zero temperature if(sumT > 0) then - call self % IMCSource % appendIMC(self % thisCycle, self % pop, p % pRNG) + ! Select number of particles to generate + N = self % pop + if(N + self % thisCycle % getSize() > self % limit) then + N = self % limit - self % thisCycle % getSize() - self % nMat - 1 + end if + ! Add to particle dungeon + call self % IMCSource % appendIMC(self % thisCycle, N, p % pRNG) end if ! Generate from input source @@ -341,12 +347,12 @@ subroutine init(self, dict) call cpu_time(self % CPU_time_start) ! Read calculation settings - call dict % get( self % pop,'pop') - call dict % getOrDefault( self % limit, 'limit', self % pop) - call dict % get( self % N_cycles,'cycles') - call dict % get( self % deltaT,'timeStepSize') - call dict % get( nucData, 'XSdata') - call dict % get( energy, 'dataType') + call dict % get(self % pop,'pop') + call dict % get(self % limit, 'limit') + call dict % get(self % N_cycles,'cycles') + call dict % get(self % deltaT,'timeStepSize') + call dict % get(nucData, 'XSdata') + call dict % get(energy, 'dataType') ! Process type of data select case(energy) From 9fadc5a03b1ca434d20bf6f4fa9110dd3b51c2d3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 29 Sep 2022 17:22:43 +0100 Subject: [PATCH 165/373] Comment on particle weight assignment --- ParticleObjects/Source/ISMCSource_class.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/ParticleObjects/Source/ISMCSource_class.f90 b/ParticleObjects/Source/ISMCSource_class.f90 index 0d0009c3d..e2736ade2 100644 --- a/ParticleObjects/Source/ISMCSource_class.f90 +++ b/ParticleObjects/Source/ISMCSource_class.f90 @@ -150,6 +150,7 @@ function sampleParticle(self, rand) result(p) p % G = self % G p % isMG = .true. + ! Set weight to be (energy per unit volume) * (volume per particle) p % wgt = mat % getEnergyDens() * self % boundingVol / self % N ! Exit the loop From 5aabe3700b2f8cc8a3c0402cef48437b564dfc61 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 30 Sep 2022 13:21:45 +0100 Subject: [PATCH 166/373] Small change with source numbers, not finished --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index e7fa6c8ef..d314ede9d 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -167,7 +167,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) self % thisCycle = self % nextCycle call self % nextCycle % cleanPop() - ! Check that there are regions of non-zero temperature by summing mat temperatures sumT = 0 do j=1, self % nMat @@ -180,8 +179,10 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Select number of particles to generate N = self % pop if(N + self % thisCycle % getSize() > self % limit) then + ! Fleck and Cummings IMC Paper, eqn 4.11 N = self % limit - self % thisCycle % getSize() - self % nMat - 1 end if + if(self % sourceGiven) N = N/2 ! Add to particle dungeon call self % IMCSource % appendIMC(self % thisCycle, N, p % pRNG) end if From f87d747f48a7c0353ca1a48622d086be65db733e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 4 Oct 2022 13:44:03 +0100 Subject: [PATCH 167/373] Removed appendIMC subroutine, instead put in IMCSource_class by overriding append --- ParticleObjects/Source/IMCSource_class.f90 | 96 ++++++++++++++++++--- ParticleObjects/Source/source_inter.f90 | 84 ++---------------- PhysicsPackages/IMCPhysicsPackage_class.f90 | 10 +-- 3 files changed, 94 insertions(+), 96 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index d23bb1974..8989cc1a1 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -7,7 +7,7 @@ module IMCSource_class use dictionary_class, only : dictionary use RNG_class, only : RNG - use particle_class, only : particleState, P_PHOTON + use particle_class, only : particle, particleState, P_PHOTON use particleDungeon_class, only : particleDungeon use source_inter, only : source, kill_super => kill @@ -37,18 +37,19 @@ module IMCSource_class !! source_inter Interface !! !! SAMPLE INPUT: - !! imcSource { type IMCSource; nParticles 100; } + !! imcSource { type IMCSource; } !! type, public,extends(source) :: imcSource private - logical(defBool) :: isMG = .true. - real(defReal), dimension(3) :: bottom = ZERO - real(defReal), dimension(3) :: top = ZERO - real(defReal) :: E = ZERO - integer(shortInt) :: G = 0 - integer(shortInt) :: nParticles = 10 + logical(defBool) :: isMG = .true. + real(defReal), dimension(3) :: bottom = ZERO + real(defReal), dimension(3) :: top = ZERO + real(defReal) :: E = ZERO + integer(shortInt) :: G = 0 + integer(shortInt), dimension(:), allocatable :: matPops contains procedure :: init + procedure :: append procedure :: sampleParticle procedure :: kill end type imcSource @@ -64,7 +65,6 @@ subroutine init(self, dict, geom) class(imcSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom - character(nameLen) :: type real(defReal), dimension(6) :: bounds integer(shortInt) :: i, n character(100), parameter :: Here = 'init (imcSource_class.f90)' @@ -73,7 +73,6 @@ subroutine init(self, dict, geom) self % geom => geom call dict % getOrDefault(self % G, 'G', 1) - call dict % getOrDefault(self % nParticles, 'nParticles', 10) ! Set bounding region bounds = self % geom % bounds() @@ -82,13 +81,83 @@ subroutine init(self, dict, geom) ! Initialise array to store numbers of particles n = MMnMat() - allocate( self % matPops(n) ) + allocate(self % matPops(n)) do i=1, n self % matPops(i) = 0 end do end subroutine init + !! + !! Generate n particles to add to a particleDungeon without overriding + !! particles already present. More complex than superclass 'append' subroutine, + !! needed for multiregion functionality. + !! + !! The number of particles sampled in each matIdx is recorded and used to normalise + !! each particle weight, so that the total energy emitted in each region is as + !! required + !! + !! Args: + !! dungeon [inout] -> particle dungeon to be added to + !! n [in] -> number of particles to place in dungeon + !! rand [inout] -> particle RNG object + !! + !! Result: + !! A dungeon populated with n particles sampled from the source, plus particles + !! already present in dungeon + !! + subroutine append(self, dungeon, N, rand) + class(imcSource), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + type(particleDungeon) :: tempDungeon + type(particle) :: p + integer(shortInt) :: i + real(defReal) :: normFactor + character(100), parameter :: Here = "appendIMC (IMCSource_class.f90)" + + ! Reset particle population counters + do i = 1, size( self % matPops ) + self % matPops(i) = 0 + end do + + ! Set temporary dungeon size + call tempDungeon % setSize(n) + + ! Generate n particles to populate temporary dungeon + do i = 1, n + call tempDungeon % replace(self % sampleParticle(rand), i) + end do + + ! Call error if any region contains no generated particles (due to small regions and/or + ! not enough particles used), needed for now as otherwise will lead to energy imbalance + ! as mat energy will be reduced by emittedRad but no particles will be carrying it + ! Note that matPops is set to 1 in sample_particle if region is of 0 temperature to avoid + ! this error for such a case + if ( minval(self % matPops) == 0 ) then + call fatalError(Here, "Not all regions emitted particles, use more particles") + end if + + ! Loop through again and add to input dungeon, normalising energies based on material + do i = 1, n + + call tempDungeon % release(p) + + ! Place inside geometry to set matIdx, for some reason resets when released from dungeon + call self % geom % placeCoord( p % coords ) + + ! Normalise + normFactor = self % matPops( p % coords % matIdx ) + p % w = p % w / normFactor + + ! Add to input dungeon + call dungeon % detain(p) + + end do + + end subroutine append + !! !! Sample particle's phase space co-ordinates !! @@ -103,7 +172,7 @@ function sampleParticle(self, rand) result(p) real(defReal), dimension(3) :: r, rand3, dir ! Here, i is a float to allow more precise control of loop real(defReal) :: mu, phi, i - integer(shortInt) :: matIdx, uniqueID, nucIdx + integer(shortInt) :: matIdx, uniqueID character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' ! Get pointer to appropriate nuclear database @@ -161,7 +230,7 @@ function sampleParticle(self, rand) result(p) ! Don't sample particles from areas of 0 temperature if( p % wgt == 0 ) then - self % matPops(matIdx) = 1 ! Set to 1 to avoid error in appendIMC (source_inter.f90) + self % matPops(matIdx) = 1 ! Set to 1 to avoid error in append subroutine i = i - 0.9 ! To allow more attempts if large regions with 0 temp cycle rejection end if @@ -189,7 +258,6 @@ elemental subroutine kill(self) self % top = ZERO self % E = ZERO self % G = 0 - self % nParticles = 10 end subroutine kill diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index fb7783cf0..29fdda1a6 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -6,7 +6,7 @@ module source_inter use dictionary_class, only : dictionary use RNG_class, only : RNG use geometry_inter, only : geometry - use genericProcedures, only : fatalError + use genericProcedures, only : fatalError implicit none private @@ -31,18 +31,15 @@ module source_inter !! init -> initialise the source !! generate -> generate particles to fill a dungeon !! append -> generate new particles to add to an existing dungeon - !! appendIMC -> generate particles for uniform IMC material source !! sampleParticle -> sample particles from the corresponding distributions !! kill -> clean up the source !! type, public,abstract :: source private class(geometry), pointer, public :: geom => null() - integer(shortInt), dimension(:), allocatable, public :: matPops contains - procedure, non_overridable :: generate - procedure, non_overridable :: append - procedure, non_overridable :: appendIMC + procedure :: generate + procedure :: append procedure(sampleParticle), deferred :: sampleParticle procedure(init), deferred :: init procedure(kill), deferred :: kill @@ -119,19 +116,20 @@ subroutine generate(self, dungeon, n, rand) end subroutine generate !! - !! Generate particles to populate a particleDungeon without overriding + !! Generate particles to add to a particleDungeon without overriding !! particles already present !! !! Adds to a particle dungeon n particles, sampled !! from the corresponding source distributions !! !! Args: - !! dungeon [inout] -> particle dungeon to be populated + !! dungeon [inout] -> particle dungeon to be added to !! n [in] -> number of particles to place in dungeon !! rand [inout] -> particle RNG object !! !! Result: - !! A dungeon populated with n particles sampled from the source + !! A dungeon populated with n particles sampled from the source, plus + !! particles already present in dungeon !! subroutine append(self, dungeon, n, rand) class(source), intent(inout) :: self @@ -147,74 +145,6 @@ subroutine append(self, dungeon, n, rand) end subroutine append - !! - !! Generate n particles to populate a particleDungeon without overriding - !! particles already present. Unlike 'append' subroutine above, this is - !! specific to IMCSource_class and is needed for multiregion functionality. - !! The number of particles sampled in each matIdx is tallied and used to normalise - !! each particle weight, so that the total energy emitted in each region is as - !! required - !! - !! Args: - !! dungeon [inout] -> particle dungeon to be populated - !! n [in] -> number of particles to place in dungeon - !! rand [inout] -> particle RNG object - !! - !! Result: - !! A dungeon populated with n particles sampled from the source - !! - subroutine appendIMC(self, dungeon, n, rand) - class(source), intent(inout) :: self - type(particleDungeon), intent(inout) :: dungeon - type(particleDungeon) :: tempDungeon - type(particle) :: p - integer(shortInt), intent(in) :: n - class(RNG), intent(inout) :: rand - integer(shortInt) :: i - real(defReal) :: normFactor - character(100), parameter :: Here = "appendIMC (source_inter.f90)" - - ! Reset particle population counters - do i = 1, size( self % matPops ) - self % matPops(i) = 0 - end do - - ! Set temporary dungeon size - call tempDungeon % setSize(n) - - ! Generate n particles to populate temporary dungeon - do i = 1, n - call tempDungeon % replace(self % sampleParticle(rand), i) - end do - - ! Call error if any region contains no generated particles (due to small regions and/or - ! not enough particles used), needed for now as otherwise will lead to energy imbalance - ! as mat energy will be reduced by emittedRad but no particles will be carrying it - ! Note that matProps is set to 1 in IMCsource.f90 if region is of 0 temperature to avoid - ! this error for such a case - if ( minval(self % matPops) == 0 ) then - call fatalError(Here, "Not all regions emitted particles, use more particles") - end if - - ! Loop through again and add to input dungeon, normalising energies based on material - do i = 1, n - - call tempDungeon % release(p) - - ! Place inside geometry to set matIdx, for some reason resets when released from dungeon - call self % geom % placeCoord( p % coords ) - - ! Normalise - normFactor = self % matPops( p % coords % matIdx ) - p % w = p % w / normFactor - - ! Add to input dungeon - call dungeon % detain(p) - - end do - - end subroutine appendIMC - !! !! Return to uninitialised state !! diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index d314ede9d..78f66a062 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -174,22 +174,23 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) sumT = sumT + mat % getTemp() end do + N = self % pop + ! Generate IMC source, only if there are regions with non-zero temperature if(sumT > 0) then ! Select number of particles to generate - N = self % pop if(N + self % thisCycle % getSize() > self % limit) then ! Fleck and Cummings IMC Paper, eqn 4.11 N = self % limit - self % thisCycle % getSize() - self % nMat - 1 end if if(self % sourceGiven) N = N/2 ! Add to particle dungeon - call self % IMCSource % appendIMC(self % thisCycle, N, p % pRNG) + call self % IMCSource % append(self % thisCycle, N, p % pRNG) end if ! Generate from input source if( self % sourceGiven ) then - call self % inputSource % append(self % thisCycle, self % pop, p % pRNG) + call self % inputSource % append(self % thisCycle, N, p % pRNG) end if if(self % printSource == 1) then @@ -422,9 +423,8 @@ subroutine init(self, dict) end if ! Initialise IMC source - call locDict1 % init(2) + call locDict1 % init(1) call locDict1 % store('type', 'imcSource') - call locDict1 % store('nParticles', self % pop) call new_source(self % IMCSource, locDict1, self % geom) ! Build collision operator From 3a6061156454bdb97f1b5cd2916476ee2213fae9 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 4 Oct 2022 14:44:50 +0100 Subject: [PATCH 168/373] Temporary change to avoid compiler error --- ParticleObjects/Source/surfaceSource_class.f90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/ParticleObjects/Source/surfaceSource_class.f90 b/ParticleObjects/Source/surfaceSource_class.f90 index b5567cc15..6e7bdaf8a 100644 --- a/ParticleObjects/Source/surfaceSource_class.f90 +++ b/ParticleObjects/Source/surfaceSource_class.f90 @@ -64,7 +64,6 @@ module surfaceSource_class integer(shortInt) :: planeShape = 0 ! 0 => square, 1 => circle integer(shortInt) :: axis = 1 ! 1 => x, 2 => y, 3 => z real(defReal) :: T = ZERO - integer(shortInt) :: nParticles = ZERO real(defReal) :: deltaT = ZERO contains procedure :: init @@ -168,7 +167,6 @@ subroutine init(self, dict, geom) end if call dict % get(self % T, 'T') - call dict % get(self % nParticles, 'nParticles') call dict % get(self % deltat, 'deltat') end subroutine init @@ -275,7 +273,7 @@ subroutine sampleEnergy(self, p, rand) real(defReal) :: num num = radiationConstant * lightSpeed * self % deltat * self % T**4 * self % area - p % wgt = num / (4 * self % nParticles) + p % wgt = num / (4)! * self % N) TODO: NEED TO ADD THIS BACK IN ! If dir = 0 then emit in both directions => double total energy if (self % dir == 0) p % wgt = 2*p % wgt From 29536761fa4b805aeaf322cc93116963398631ad Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 5 Oct 2022 13:11:55 +0100 Subject: [PATCH 169/373] Fixed comment --- ParticleObjects/Source/IMCSource_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 8989cc1a1..76d5d1be3 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -115,7 +115,7 @@ subroutine append(self, dungeon, N, rand) type(particle) :: p integer(shortInt) :: i real(defReal) :: normFactor - character(100), parameter :: Here = "appendIMC (IMCSource_class.f90)" + character(100), parameter :: Here = "append (IMCSource_class.f90)" ! Reset particle population counters do i = 1, size( self % matPops ) From 66121a0da08c0e8de0195521d550724be861910e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 5 Oct 2022 13:12:57 +0100 Subject: [PATCH 170/373] Changed surfaceSource to correctly read N --- .../Source/surfaceSource_class.f90 | 34 +++++++++++++++---- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/ParticleObjects/Source/surfaceSource_class.f90 b/ParticleObjects/Source/surfaceSource_class.f90 index 6e7bdaf8a..be2f8b423 100644 --- a/ParticleObjects/Source/surfaceSource_class.f90 +++ b/ParticleObjects/Source/surfaceSource_class.f90 @@ -2,12 +2,13 @@ module surfaceSource_class use numPrecision use universalVariables - use genericProcedures, only : fatalError - use particle_class, only : particleState, P_NEUTRON, P_PHOTON - use dictionary_class, only : dictionary - use configSource_inter, only : configSource, kill_super => kill - use geometry_inter, only : geometry - use RNG_class, only : RNG + use genericProcedures, only : fatalError + use particle_class, only : particleState, P_NEUTRON, P_PHOTON + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use configSource_inter, only : configSource, kill_super => kill + use geometry_inter, only : geometry + use RNG_class, only : RNG implicit none private @@ -65,8 +66,10 @@ module surfaceSource_class integer(shortInt) :: axis = 1 ! 1 => x, 2 => y, 3 => z real(defReal) :: T = ZERO real(defReal) :: deltaT = ZERO + integer(shortInt) :: N = 1 contains procedure :: init + procedure :: append procedure :: sampleType procedure :: samplePosition procedure :: sampleEnergy @@ -171,6 +174,23 @@ subroutine init(self, dict, geom) end subroutine init + subroutine append(self, dungeon, N, rand) + class(surfaceSource), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + integer(shortInt) :: i + character(100), parameter :: Here = 'append (surfaceSource_class.f90)' + + self % N = N + + ! Generate n particles to populate dungeon + do i = 1, N + call dungeon % detain(self % sampleParticle(rand)) + end do + + end subroutine append + !! !! Provide particle type !! @@ -273,7 +293,7 @@ subroutine sampleEnergy(self, p, rand) real(defReal) :: num num = radiationConstant * lightSpeed * self % deltat * self % T**4 * self % area - p % wgt = num / (4)! * self % N) TODO: NEED TO ADD THIS BACK IN + p % wgt = num / (4 * self % N) ! If dir = 0 then emit in both directions => double total energy if (self % dir == 0) p % wgt = 2*p % wgt From 4aa2c9314a4b96d301ba786515466aa1816bd9a8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 5 Oct 2022 13:28:55 +0100 Subject: [PATCH 171/373] Fixed incorrect position assignment --- ParticleObjects/Source/surfaceSource_class.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ParticleObjects/Source/surfaceSource_class.f90 b/ParticleObjects/Source/surfaceSource_class.f90 index be2f8b423..37f3028d5 100644 --- a/ParticleObjects/Source/surfaceSource_class.f90 +++ b/ParticleObjects/Source/surfaceSource_class.f90 @@ -222,9 +222,9 @@ subroutine samplePosition(self, p, rand) prevPos = self % r ! Set new x, y and z coords - self % r(1) = rand % get() * self % surfSize/2 - self % r(2) = rand % get() * self % surfSize/2 - self % r(3) = rand % get() * self % surfSize/2 + self % r(1) = (rand % get()-0.5) * self % surfSize + self % r(2) = (rand % get()-0.5) * self % surfSize + self % r(3) = (rand % get()-0.5) * self % surfSize ! Leave position along normal axis unchanged self % r(self % axis) = prevPos(self % axis) From ab6db49e06d2ac3153dac82fa056d5f75404f1f5 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 5 Oct 2022 13:50:19 +0100 Subject: [PATCH 172/373] Changed material to get time step from physics package call --- NuclearData/IMCMaterial_inter.f90 | 17 ++++++- NuclearData/materialMenu_mod.f90 | 18 ------- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 47 ++++++++++++++++--- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 17 ++++++- PhysicsPackages/IMCPhysicsPackage_class.f90 | 13 +++-- 5 files changed, 81 insertions(+), 31 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 862b05a62..7864083b4 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -35,6 +35,7 @@ module IMCMaterial_inter procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck procedure(getTemp), deferred :: getTemp + procedure(setTimeStep), deferred :: setTimeStep end type IMCMaterial abstract interface @@ -91,13 +92,27 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck - + !! + !! Get temperature of material + !! function getTemp(self) result(T) import :: IMCMaterial, defReal class(IMCMaterial), intent(inout) :: self real(defReal) :: T end function getTemp + !! + !! Provide material with time step size + !! + !! Args: + !! dt [in] -> time step size [s] + !! + subroutine setTimeStep(self, dt) + import :: IMCMaterial, defReal + class(IMCMaterial), intent(inout) :: self + real(defReal), intent(in) :: dt + end subroutine setTimeStep + end interface contains diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index e9af3042c..00d18c9f8 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -19,7 +19,6 @@ !! matTemp -> Return material Temperature given Index !! matVol -> Return material Volume given Index !! matIdx -> Return material Index given Name -!! setTimeStep -> Set size of time step !! module materialMenu_mod @@ -103,7 +102,6 @@ module materialMenu_mod !! MODULE COMPONENTS type(materialItem),dimension(:),allocatable,target,public :: materialDefs type(charMap),target,public :: nameMap - real(defReal), public :: timeStepSize = ZERO public :: init public :: kill @@ -114,7 +112,6 @@ module materialMenu_mod public :: matTemp public :: matVol public :: matIdx - public :: setTimeStep contains @@ -293,21 +290,6 @@ function matIdx(name) result(idx) end function matIdx - !! - !! Set time step - !! - !! Used by IMC and ISMC physics packages to provide material objects with time step size - !! - !! Args: - !! dt [in] -> time step size [s] - !! - subroutine setTimeStep(dt) - real(defReal), intent(in) :: dt - - timeStepSize = dt - - end subroutine setTimeStep - !!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! TYPE PROCEDURES !!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 7cfea4ed9..9a8b98d33 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -12,7 +12,6 @@ module baseMgIMCMaterial_class use materialHandle_inter, only : materialHandle use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill use IMCXSPackages_class, only : IMCMacroXSs - use materialMenu_mod, only : timeStepSize implicit none private @@ -86,6 +85,7 @@ module baseMgIMCMaterial_class procedure :: getEmittedRad procedure :: getFleck procedure :: getTemp + procedure :: setTimeStep procedure, private :: updateMatIMC procedure, private :: updateMatISMC @@ -185,8 +185,7 @@ subroutine init(self, dict) N = 4 allocate(self % data(N, nG)) - ! Store time step size and alpha settings - self % deltaT = timeStepSize + ! Store alpha setting call dict % getOrDefault(self % alpha, 'alpha', ONE) ! Read opacity equations @@ -211,16 +210,50 @@ subroutine init(self, dict) call dict % get(self % T, 'T') call dict % get(self % V, 'V') - ! Calculate initial opacities, energy and Fleck factor + ! Calculate initial opacities and energy call self % sigmaFromTemp() self % matEnergy = poly_eval(self % updateEqn, self % T) * self % V - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT*self % alpha) ! Set calculation type (will support ISMC in the future) self % calcType = IMC end subroutine init + + !! + !! Provide material with time step size + !! + !! Args: + !! dt [in] -> time step size [s] + !! + !! Errors: + !! fatalError if calculation type is invalid (valid options are IMC or ISMC) + !! + subroutine setTimeStep(self, dt) + class(baseMgIMCMaterial), intent(inout) :: self + real(defReal), intent(in) :: dt + real(defReal) :: beta, eta, zeta + character(100), parameter :: Here = 'setTimeStep (baseMgIMCMaterial_class.f90)' + + self % deltaT = dt + + ! Use time step size to calculate fleck factor + if(self % calcType == IMC) then + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT*self % alpha) + + else if(self % calcType == ISMC) then + beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + eta = radiationConstant * self % T**4 / self % matEnergy + zeta = beta - eta + self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) + + else + call fatalError(Here, 'Calculation type invalid or not set') + end if + + + end subroutine setTimeStep + !! !! Return number of energy groups !! @@ -440,7 +473,9 @@ function getFleck(self) result(fleck) end function getFleck - + !! + !! Get temperature of material + !! function getTemp(self) result(T) class(baseMgIMCMaterial), intent(inout) :: self real(defReal) :: T diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index daa03e18b..f167cf805 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -47,6 +47,7 @@ module mgIMCMaterial_inter procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck procedure(getTemp), deferred :: getTemp + procedure(setTimeStep), deferred :: setTimeStep end type mgIMCMaterial @@ -126,13 +127,27 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck - + !! + !! Get temperature of material + !! function getTemp(self) result(T) import :: mgIMCMaterial, defReal class(mgIMCMaterial), intent(inout) :: self real(defReal) :: T end function getTemp + !! + !! Provide material with time step size + !! + !! Args: + !! dt [in] -> time step size [s] + !! + subroutine setTimeStep(self, dt) + import :: mgIMCMaterial, defReal + class(mgIMCMaterial), intent(inout) :: self + real(defReal), intent(in) :: dt + end subroutine setTimeStep + end interface diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 78f66a062..aa33cdad2 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -28,8 +28,7 @@ module IMCPhysicsPackage_class ! Nuclear Data use materialMenu_mod, only : mm_nMat => nMat ,& - mm_matName => matName ,& - mm_setTimeStep => setTimeStep + mm_matName => matName use nuclearDataReg_mod, only : ndReg_init => init ,& ndReg_activate => activate ,& ndReg_display => display, & @@ -343,6 +342,7 @@ subroutine init(self, dict) character(nameLen) :: nucData, energy, geomName type(outputFile) :: test_out integer(shortInt) :: i + class(IMCMaterial), pointer :: mat character(nameLen), dimension(:), allocatable :: mats character(100), parameter :: Here ='init (IMCPhysicsPackage_class.f90)' @@ -398,9 +398,6 @@ subroutine init(self, dict) ! Read whether to print particle source per cycle call dict % getOrDefault(self % printSource, 'printSource', 0) - ! Provide materialMenuMod with time step size - call mm_setTimeStep(self % deltaT) - ! Build Nuclear Data call ndReg_init(dict % getDictPtr("nuclearData")) @@ -449,6 +446,12 @@ subroutine init(self, dict) mats(i) = mm_matName(i) end do + ! Provide each material with time step + do i=1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(i)) + call mat % setTimeStep(self % deltaT) + end do + ! Initialise imcWeight tally attachment call locDict2 % init(1) call locDict3 % init(2) From 8d4689ec9bf3de1c890c463e2ad0a6bc792637b8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 5 Oct 2022 18:40:29 +0100 Subject: [PATCH 173/373] Fixed major issue where total energy was being incorrectly used instead of energy density in certain equations --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 5545613ea..33c884d4d 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -70,6 +70,7 @@ module baseMgIMCMaterial_class real(defReal) :: deltaT real(defReal) :: sigmaP real(defReal) :: matEnergy + real(defReal) :: energyDens real(defReal) :: eta integer(shortInt) :: calcType @@ -216,7 +217,8 @@ subroutine init(self, dict) ! Calculate initial opacities and energy call self % sigmaFromTemp() - self % matEnergy = poly_eval(self % updateEqn, self % T) * self % V + self % energyDens = poly_eval(self % updateEqn, self % T) + self % matEnergy = self % energyDens * self % V ! Set calculation type (will support ISMC in the future) self % calcType = IMC @@ -247,7 +249,7 @@ subroutine setTimeStep(self, dt) else if(self % calcType == ISMC) then beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) - self % eta = radiationConstant * self % T**4 / self % matEnergy + self % eta = radiationConstant * self % T**4 / self % energyDens zeta = beta - self % eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) @@ -377,7 +379,8 @@ subroutine updateMatIMC(self, tallyEnergy, printUpdate) end if ! Update material internal energy - self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy + self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy + self % energyDens = self % matEnergy / self % V ! Update material temperature self % T = self % tempFromEnergy() @@ -411,7 +414,8 @@ subroutine updateMatISMC(self, tallyEnergy, printUpdate) logical(defBool), intent(in), optional :: printUpdate ! Update material internal energy - self % matEnergy = tallyEnergy + self % matEnergy = tallyEnergy + self % energyDens = self % matEnergy / self % V !if(self % matEnergy <= 0.3) self % matEnergy = 0.3 @@ -420,7 +424,7 @@ subroutine updateMatISMC(self, tallyEnergy, printUpdate) ! Update ISMC equivalent of fleck factor beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) - self % eta = radiationConstant * self % T**4 / self % matEnergy + self % eta = radiationConstant * self % T**4 / self % energyDens zeta = beta - self % eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) @@ -442,10 +446,9 @@ end subroutine updateMatISMC !! function tempFromEnergy(self) result(T) class(baseMgIMCMaterial), intent(inout) :: self - real(defReal) :: T, energyDens + real(defReal) :: T - energyDens = self % matEnergy / self % V - T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) + T = poly_solve(self % updateEqn, self % cv, self % T, self % energyDens) end function tempFromEnergy @@ -547,7 +550,7 @@ subroutine setType(self, calcType) ! If ISMC, recalculate Fleck if(self % calcType == ISMC) then beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) - self % eta = radiationConstant * self % T**4 / self % matEnergy + self % eta = radiationConstant * self % T**4 / self % energyDens zeta = beta - self % eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) end if From a0903d92e0f489c0922ebeec8bc95a96394b2650 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 6 Oct 2022 14:03:43 +0100 Subject: [PATCH 174/373] Removed a few comments --- TransportOperator/transportOperatorIMC_class.f90 | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 0e46c3d42..b23301ae4 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -50,7 +50,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' ! Get majornat XS inverse: 1/Sigma_majorant - !majorant_inv = ONE / self % xsData % getMajorantXS(p) + majorant_inv = ONE / self % xsData % getMajorantXS(p) IMCLoop:do @@ -62,8 +62,6 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) if(p % getType() .ne. P_PHOTON_MG) call fatalError(Here, 'Particle is not MG Photon') - majorant_inv = ONE / self % xsData % getMajorantXS(p) - ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) @@ -97,11 +95,6 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Obtain the local cross-section sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - ! Protect Against Sillines - !if( sigmaT*majorant_inv < ZERO .or. ONE < sigmaT*majorant_inv) then - ! call fatalError(Here, "TotalXS/MajorantXS is silly: "//numToChar(sigmaT*majorant_inv)) - !end if - ! Roll RNG to determine if the collision is real or virtual ! Exit the loop if the collision is real if (p % pRNG % get() < sigmaT*majorant_inv) exit IMCLoop @@ -109,6 +102,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) end do IMCLoop call tally % reportTrans(p) + end subroutine imcTracking From f3ef7ac281a6b5d243050c5375649dc77e6f0499 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 12:47:35 +0100 Subject: [PATCH 175/373] Changed to a use either DT or ST depending on opacities --- .../transportOperatorIMC_class.f90 | 140 +++++++++++++----- 1 file changed, 106 insertions(+), 34 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index b23301ae4..eee96f415 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -33,9 +33,12 @@ module transportOperatorIMC_class !! type, public, extends(transportOperator) :: transportOperatorIMC class(mgIMCMaterial), pointer, public :: mat => null() + real(defReal) :: majorant_inv contains procedure :: transit => imcTracking procedure, private :: materialTransform + procedure, private :: surfaceTracking + procedure, private :: deltaTracking end type transportOperatorIMC contains @@ -46,58 +49,55 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) type(tallyAdmin), intent(inout) :: tally class(particleDungeon), intent(inout) :: thisCycle class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: majorant_inv, sigmaT, dTime, dColl + real(defReal) :: sigmaT, dTime, dColl, dist + logical(defBool) :: finished character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' - ! Get majornat XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getMajorantXS(p) + finished = .false. + + ! Get majorant XS inverse: 1/Sigma_majorant + self % majorant_inv = ONE / self % xsData % getMajorantXS(p) + + ! Deal with material particles, only relevant for ISMC + if(p % getType() == P_MATERIAL_MG) then + call self % materialTransform(p, tally) + if(p % fate == TIME_FATE) return + end if IMCLoop:do - ! Deal with material particles, only relevant for ISMC - if(p % getType() == P_MATERIAL_MG) then - call self % materialTransform(p, tally) - if(p % fate == TIME_FATE) exit IMCLoop - end if + ! Check for errors + if (p % getType() /= P_PHOTON_MG) call fatalError(Here, 'Particle is not MG Photon') + if (p % time /= p % time) call fatalError(Here, 'Particle time is NaN') - if(p % getType() .ne. P_PHOTON_MG) call fatalError(Here, 'Particle is not MG Photon') + ! Obtain sigmaT + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) - ! Sample distance to move particle before potential collision - dColl = -log( p % pRNG % get() ) * majorant_inv + ! Sample distance to move particle before collision + dColl = -log( p % pRNG % get() ) / sigmaT - ! Determine which distance to move particle - if (dColl < dTime) then - ! Move partice to potential collision location - call self % geom % teleport(p % coords, dColl) - p % time = p % time + dColl / lightSpeed + ! Decide whether to use delta tracking or surface tracking + ! Vastly different opacities make delta tracking infeasable + if(sigmaT * self % majorant_inv > 0.3) then + ! Delta tracking + call self % deltaTracking(p, dTime, dColl, finished) else - ! Move particle to end of time step location - call self % geom % teleport(p % coords, dTime) - p % fate = TIME_FATE - p % time = p % timeMax + ! Surface tracking + call self % surfaceTracking(p, dTime, dColl, finished) end if - ! If particle has leaked exit + ! Check for particle leakage if (p % matIdx() == OUTSIDE_FILL) then p % fate = LEAK_FATE p % isDead = .true. - return + exit IMCLoop end if - if (p % fate == TIME_FATE) exit IMCLoop - - ! Check for void - if( p % matIdx() == VOID_MAT) cycle IMCLoop - - ! Obtain the local cross-section - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - - ! Roll RNG to determine if the collision is real or virtual - ! Exit the loop if the collision is real - if (p % pRNG % get() < sigmaT*majorant_inv) exit IMCLoop + ! Exit if transport is finished + if (finished .eqv. .true.) exit IMCLoop end do IMCLoop @@ -119,7 +119,7 @@ subroutine materialTransform(self, p, tally) real(defReal) :: sigmaT, fleck, eta, mu, phi real(defReal), dimension(3) :: dir character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' - + ! Confirm that time = 0 !if (p % time .ne. 0) call fatalError(Here, 'Material particle should have time = 0') @@ -134,6 +134,9 @@ subroutine materialTransform(self, p, tally) ! Sample time to transform into radiation photon p % time = p % time - log(p % pRNG % get()) / (sigmaT*fleck*eta*lightSpeed) + ! Deal with eta = 0 + if (p % time /= p % time) p % time = INF + ! Exit loop if particle remains material until end of time step if (p % time >= p % timeMax) then p % fate = TIME_FATE @@ -153,5 +156,74 @@ subroutine materialTransform(self, p, tally) end subroutine materialTransform + !! + !! Perform surface tracking + !! + subroutine surfaceTracking(self, p, dTime, dColl, finished) + class(transportOperatorIMC), intent(inout) :: self + class(particle), intent(inout) :: p + real(defReal), intent(in) :: dTime + real(defReal), intent(in) :: dColl + logical(defBool), intent(inout) :: finished + real(defReal) :: dist + integer(shortInt) :: event + character(100), parameter :: Here = 'surfaceTracking (transportOperatorIMC_class.f90)' + + dist = min(dTime, dColl) + + ! Move through geometry using minimum distance + call self % geom % move(p % coords, dist, event) + + p % time = p % time + dist / lightSpeed + + ! Check result of transport + if (dist == dTime) then + ! Time boundary + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') + p % fate = TIME_FATE + if (p % time /= p % timeMax) call fatalError(Here, 'Particle time is somehow incorrect') + p % time = p % timeMax + finished = .true. + else if (dist == dColl) then + ! Collision, increase time accordingly + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') + finished = .true. + end if + + end subroutine surfaceTracking + + !! + !! Perform delta tracking + !! + subroutine deltaTracking(self, p, dTime, dColl, finished) + class(transportOperatorIMC), intent(inout) :: self + class(particle), intent(inout) :: p + real(defReal), intent(in) :: dTime + real(defReal), intent(in) :: dColl + logical(defBool), intent(inout) :: finished + real(defReal) :: sigmaT + + ! Determine which distance to move particle + if (dColl < dTime) then + ! Move partice to potential collision location + call self % geom % teleport(p % coords, dColl) + p % time = p % time + dColl / lightSpeed + else + ! Move particle to end of time step location + call self % geom % teleport(p % coords, dTime) + p % fate = TIME_FATE + p % time = p % timeMax + finished = .true. + return + end if + + ! Obtain local cross-section + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Roll RNG to determine if the collision is real or virtual + ! Exit the loop if the collision is real + if (p % pRNG % get() < sigmaT * self % majorant_inv) finished = .true. + + end subroutine deltaTracking end module transportOperatorIMC_class From 582c67411182293d737700fd4974c5778f62d75f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 12:48:19 +0100 Subject: [PATCH 176/373] Dealt with a few numerical issues for 0 temperature regions --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 21 ++++++++++++------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 33c884d4d..8f93f04d5 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -252,6 +252,11 @@ subroutine setTimeStep(self, dt) self % eta = radiationConstant * self % T**4 / self % energyDens zeta = beta - self % eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) + ! Deal with 0 temperature - needs more consideration for certain cv + if (self % fleck /= self % fleck) then + self % eta = ZERO + self % fleck = ONE + end if else call fatalError(Here, 'Calculation type invalid or not set') @@ -428,6 +433,12 @@ subroutine updateMatISMC(self, tallyEnergy, printUpdate) zeta = beta - self % eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) + ! Deal with 0 temperature - needs more consideration for certain cv + if (self % fleck /= self % fleck) then + self % eta = ZERO + self % fleck = ONE + end if + ! Update sigma call self % sigmaFromTemp() @@ -439,6 +450,8 @@ subroutine updateMatISMC(self, tallyEnergy, printUpdate) end if end if + write(10, '(8A)') numToChar(self % T) + end subroutine updateMatISMC !! @@ -547,14 +560,6 @@ subroutine setType(self, calcType) self % calcType = calcType - ! If ISMC, recalculate Fleck - if(self % calcType == ISMC) then - beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) - self % eta = radiationConstant * self % T**4 / self % energyDens - zeta = beta - self % eta - self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) - end if - end subroutine setType end module baseMgIMCMaterial_class From 6018c45f6fc07b70f29ce15235182f3f58c8537f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 15:59:56 +0100 Subject: [PATCH 177/373] Added simple temperature output file for testing, may remove later --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 115a60654..f7b088285 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -165,10 +165,12 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Generate initial material photons call self % ISMCSource % generate(self % nextCycle, self % pop, p % pRNG) - open(unit = 10, file = 'particles.txt') + open(unit = 10, file = 'temps.txt') do i=1,N_cycles + write(10, '(8A)') numToChar(i) + N = 0 ! Store photons remaining from previous cycle From 934a91408a82cf9b1a7ab1eea210073d2638e443 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 16:24:35 +0100 Subject: [PATCH 178/373] Fixed error that was being called incorrectly --- TransportOperator/transportOperatorIMC_class.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index eee96f415..88afe0b2f 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -49,7 +49,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) type(tallyAdmin), intent(inout) :: tally class(particleDungeon), intent(inout) :: thisCycle class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: sigmaT, dTime, dColl, dist + real(defReal) :: sigmaT, dTime, dColl logical(defBool) :: finished character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' @@ -181,7 +181,7 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) ! Time boundary if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') p % fate = TIME_FATE - if (p % time /= p % timeMax) call fatalError(Here, 'Particle time is somehow incorrect') + if (abs(p % time - p % timeMax)>0.000001) call fatalError(Here, 'Particle time is somehow incorrect') p % time = p % timeMax finished = .true. else if (dist == dColl) then From 1112dc72a2e9f517206ad9b6c4496a7168535a27 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 16:26:12 +0100 Subject: [PATCH 179/373] Removed print line --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index f7b088285..2b18f9f94 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -177,9 +177,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) self % thisCycle = self % nextCycle call self % nextCycle % cleanPop() - - call self % thisCycle % printToScreen('wgt', 10, .true.) - ! Generate from input source if( self % sourceGiven ) then From 36e495f53e39fc221e4e2be06bf793530158a6f0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 16:41:48 +0100 Subject: [PATCH 180/373] Added check for 0 solution --- SharedModules/poly_func.f90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index 031d9339f..fbb07c03d 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -60,8 +60,8 @@ end subroutine poly_integrate !! Use Newton-Raphspon method to solve polynomial with m terms !! !! Args: - !! equation -> 1D array of n coefficients followed by m exponents - !! derivative -> 1D array of n coefficients followed by m exponents + !! equation -> 1D array of m coefficients followed by m exponents + !! derivative -> 1D array of m coefficients followed by m exponents !! x0 -> Starting guess !! const -> For f(x) = const, if not given then solves f(x) = 0 !! @@ -101,9 +101,16 @@ function poly_solve(equation, derivative, x0, const) result(x) c = 0 end if + ! Return 0 if f(x) = 0 and all exponents are non-zero + if (c == 0 .and. all(equation(m+1:2*m) /= 0)) then + x = 0 + return + end if + ! Iterate i = 0 iterate: do + ! Store x for convergence check x_old = x @@ -124,7 +131,7 @@ function poly_solve(equation, derivative, x0, const) result(x) ! Call error if not converged if( i >= 1000 ) then - call fatalError(Here, "Solution has not converged after 1000 iterations") + call fatalError(Here, "Solution has not converged after 1000 iterations,"//numToChar(x0)//','//numToChar(const)) end if ! Increase counter From 383853b0308dc22beaf034cfd06f2a195ca98885 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 16:42:59 +0100 Subject: [PATCH 181/373] Changed test for particle proximity, still needs work --- ParticleObjects/particleDungeon_class.f90 | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 341a2a3b3..7669f62ff 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -27,7 +27,7 @@ module particleDungeon_class !! Dungeon can work like stacks or arrays. Stack-like behaviour is not really thread safe !! so it can be utilised when collecting and processing secondary particles in history !! that should be processed during the course of one cycle. Array-like behaviour allows to - !! easily distribute particles among threads. As long as indices assign to diffrent threads + !! easily distribute particles among threads. As long as indices assign to different threads !! do not overlap, reading is thread-safe (I hope-MAK). !! !! @@ -401,12 +401,12 @@ subroutine reduceSize(self, N, rand) randIdx2 = ceiling(rand % get() * self % pop) p2 = self % prisoners(randIdx2) r2 = p2 % rGlobal() - !if(abs(r1(1) - r2(1)) <= 0.01) then - ! distanceTest = .true. - !else - ! distanceTest = .false. - !end if - if(p2 % type == p1 % type .and. p1 % matIdx() == p2 % matIdx()) exit sample !distanceTest .eqv. .true.) exit sample + if(abs(r1(1) - r2(1)) <= 0.005) then + distanceTest = .true. + else + distanceTest = .false. + end if + if(p2 % type == p1 % type .and. distanceTest .eqv. .true.) exit sample ! If too many samples of different type, resample p1 if(loops2 >= 0.05*self % pop) cycle reduce loops2 = loops2 + 1 @@ -645,7 +645,6 @@ subroutine printToScreen(self, prop, nMax, total) totSum = totSum + self % prisoners(i) % wgt end do print *, 'Cumulative sum of p % wgt = ', totSum - write(12, *) totSum end if case('time') From 2865cdf3678559d2b1d5596b9b157a900d71199f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 17:03:29 +0100 Subject: [PATCH 182/373] Fixed typo --- Geometry/Cells/cellShelf_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Geometry/Cells/cellShelf_class.f90 b/Geometry/Cells/cellShelf_class.f90 index 58e29c926..4a7a2e973 100644 --- a/Geometry/Cells/cellShelf_class.f90 +++ b/Geometry/Cells/cellShelf_class.f90 @@ -47,7 +47,7 @@ module cellShelf_class !! Interface: !! init -> Initialise from a dictionary & surfaceShelf !! getPtr -> Get pointer to a cell given by its index - !! getIdx -> Return index of a cell fivent its ID + !! getIdx -> Return index of a cell given its ID !! getID -> Return cell ID given its index !! getFill -> Return content of the cell. If -ve it is universe ID. If +ve it is matIdx. !! getSize -> Return the number of cells (max cellIdx) From 86cc1a39fd2ed1fed8a2451975aa3c052ac0d2c5 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Oct 2022 17:04:40 +0100 Subject: [PATCH 183/373] Fixed another typo --- Geometry/Cells/cellShelf_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Geometry/Cells/cellShelf_class.f90 b/Geometry/Cells/cellShelf_class.f90 index 4a7a2e973..2f556e3f9 100644 --- a/Geometry/Cells/cellShelf_class.f90 +++ b/Geometry/Cells/cellShelf_class.f90 @@ -53,7 +53,7 @@ module cellShelf_class !! getSize -> Return the number of cells (max cellIdx) !! kill -> Return to uninitialised state !! - !! NOTE: Becouse cells are stored as pointers, calling `kill` is crucial to prevent + !! NOTE: Because cells are stored as pointers, calling `kill` is crucial to prevent !! memory leaks. TODO: Add `final` procedure here ? !! type, public :: cellShelf From cd08dffbac002087810507b9266a21e28b419731 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 11 Oct 2022 14:46:45 +0100 Subject: [PATCH 184/373] Fixed particle leakage causing errors --- TransportOperator/transportOperatorIMC_class.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 88afe0b2f..2ca27d90c 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -217,6 +217,9 @@ subroutine deltaTracking(self, p, dTime, dColl, finished) return end if + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return + ! Obtain local cross-section sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) From 4a258bd5f7613ee0226cecaea1bf27139c49a71e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 12 Oct 2022 11:24:39 +0100 Subject: [PATCH 185/373] Fixed major issue where incorrect particles were being overridden when reducing size --- ParticleObjects/particleDungeon_class.f90 | 38 +++++++++++------------ 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 7669f62ff..cb926098d 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -204,7 +204,7 @@ subroutine replace_particle(self, p, idx) ! Protect agoinst out-of-bounds acces if( idx <= 0 .or. idx > self % pop ) then - call fatalError(Here,'Out of bounds acces with idx: '// numToChar(idx)// & + call fatalError(Here,'Out of bounds access with idx: '// numToChar(idx)// & ' with particle population of: '// numToChar(self % pop)) end if @@ -224,7 +224,7 @@ subroutine replace_particleState(self, p, idx) ! Protect agoinst out-of-bounds acces if( idx <= 0 .or. idx > self % pop ) then - call fatalError(Here,'Out of bounds acces with idx: '// numToChar(idx)// & + call fatalError(Here,'Out of bounds access with idx: '// numToChar(idx)// & ' with particle population of: '// numToChar(self % pop)) end if @@ -364,9 +364,9 @@ subroutine reduceSize(self, N, rand) integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand integer(shortInt) :: excessP, randIdx1, randIdx2, loops, loops2 - type(particle) :: p1, p2 - real(defReal), dimension(3) :: rNew, r1, r2 - logical(defBool) :: distanceTest = .true. + type(particle) :: p1, p2, p3 + real(defReal), dimension(3) :: rNew, r1, r2, r12 + real(defReal) :: dist character(100), parameter :: Here ='reduceSize (particleDungeon_class.f90)' print *, "REDUCE", self % pop, N @@ -391,36 +391,34 @@ subroutine reduceSize(self, N, rand) if(loops >= 50*self % pop) call fatalError(Here, 'Potentially infinite loop') ! Obtain random particles from dungeon - randIdx1 = nint(rand % get() * self % pop) - p1 = self % prisoners(randIdx1) + randIdx1 = ceiling(rand % get() * self % pop) + call self % copy(p1, randIdx1) r1 = p1 % rGlobal() ! Obtain random particle of the same type loops2 = 0 sample:do randIdx2 = ceiling(rand % get() * self % pop) - p2 = self % prisoners(randIdx2) + if (randIdx2 == randIdx1 .or. randIdx2 == self % pop) cycle sample + call self % copy(p2, randIdx2) r2 = p2 % rGlobal() - if(abs(r1(1) - r2(1)) <= 0.005) then - distanceTest = .true. - else - distanceTest = .false. - end if - if(p2 % type == p1 % type .and. distanceTest .eqv. .true.) exit sample - ! If too many samples of different type, resample p1 - if(loops2 >= 0.05*self % pop) cycle reduce + r12 = r2 - r1 + dist = sqrt(r12(1)**2 + r12(2)**2 + r12(3)**2) + if(p2 % type == p1 % type .and. dist <= 0.2 .and. r1(1) <= 0.5) exit sample + ! If too many failed samples, resample p1 + if(loops2 >= 0.5*self % pop) cycle reduce loops2 = loops2 + 1 end do sample ! Combine positions and weights - rNew = (p1 % rGlobal()*p1 % w+p2 % rGlobal()*p2 % w) / (p1 % w+p2 % w) + rNew = (r1*p1 % w + r2*p2 % w) / (p1 % w + p2 % w) call p1 % teleport(rNew) p1 % w = p1 % w + p2 % w - self % prisoners(randIdx1) = p1 + call self % replace(p1, randIdx1) ! Overwrite p2 and reduce size - call self % replace(self % prisoners(self % pop), randIdx2) - self % pop = self % pop - 1 + call self % release(p3) + call self % replace(p3, randIdx2) if(self % pop == N) exit reduce From 8b5e6a181c61e0d354f8d2a1b82bd8db3a00bd09 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 12 Oct 2022 11:30:40 +0100 Subject: [PATCH 186/373] Fixed ambiguity in if statement --- Tallies/TallyClerks/imcWeightClerk_class.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/imcWeightClerk_class.f90 index ff937521a..b038d0e32 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/imcWeightClerk_class.f90 @@ -216,9 +216,11 @@ subroutine reportHist(self, p, xsData, mem) adrr = self % getMemAddress() + binIdx - 1 ! Append to required bin - if( p % isDead .and. p % fate /= LEAK_FATE .or. p % type == P_MATERIAL) then - scoreVal = p % w - call mem % score(scoreVal, adrr) + if (p % isDead .or. p % type == P_MATERIAL) then + if (p % fate /= LEAK_FATE) then + scoreVal = p % w + call mem % score(scoreVal, adrr) + end if end if end subroutine reportHist From b910fcabaaf552caa3973b5a5f9c3d1760567e11 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 12 Oct 2022 15:29:04 +0100 Subject: [PATCH 187/373] New output file with particle populations in each material, may remove later --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 32 +++++++++++++------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 2b18f9f94..3e199f0a5 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -133,9 +133,10 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_cycles - integer(shortInt) :: i, j, N + integer(shortInt) :: i, j, matIdx + integer(shortInt), dimension(:), allocatable :: Nm, Np type(particle) :: p - real(defReal) :: elapsed_T, end_T, T_toEnd, sumT + real(defReal) :: elapsed_T, end_T, T_toEnd real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat logical(defBool) :: printUpdates @@ -166,12 +167,17 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call self % ISMCSource % generate(self % nextCycle, self % pop, p % pRNG) open(unit = 10, file = 'temps.txt') + open(unit = 11, file = 'pops.txt') + + allocate(Nm(self % nMat)) + allocate(Np(self % nMat)) do i=1,N_cycles write(10, '(8A)') numToChar(i) - N = 0 + Nm = 0 + Np = 0 ! Store photons remaining from previous cycle self % thisCycle = self % nextCycle @@ -200,10 +206,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call self % thisCycle % release(p) call self % geom % placeCoord(p % coords) - if( p % type == P_MATERIAL ) then - N = N+1 - end if - ! Assign particle time if( p % type /= P_MATERIAL .and. p % time /= self % deltaT ) then ! If particle has just been sourced, t = 0 so sample uniformly within timestep @@ -223,6 +225,15 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) if(p % fate == LEAK_FATE) exit history if(p % fate == TIME_FATE) then + if(p % type == P_PHOTON) then + matIdx = p % matIdx() + Np(matIdx) = Np(matIdx) + 1 + else if( p % type == P_MATERIAL ) then + matIdx = p % matIdx() + Nm(matIdx) = Nm(matIdx) + 1 + else + call fatalError(Here, 'Incorrect type') + end if ! Store particle for use in next time step p % fate = 0 call self % nextCycle % detain(p) @@ -258,8 +269,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end_T = real(N_cycles,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) - print *, "Number of material photons at start of time step = ", N - ! Display progress call printFishLineR(i) print * @@ -299,12 +308,13 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_cycles) - !call self % nextCycle % printToFile('particles') - !write(10, '(8A)') '0.0 0.0 0.0 0.0' + write(11, '(8A)') 'M', numToChar(Nm) + write(11, '(8A)') 'P', numToChar(Np) end do close(10) + close(11) end subroutine cycles From fcdf5547de5f3e495a59e90f3b78e6d115dd562a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 12 Oct 2022 17:30:21 +0100 Subject: [PATCH 188/373] Removed unused variable --- ParticleObjects/particleDungeon_class.f90 | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index cb926098d..14b04a573 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -363,7 +363,7 @@ subroutine reduceSize(self, N, rand) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand - integer(shortInt) :: excessP, randIdx1, randIdx2, loops, loops2 + integer(shortInt) :: randIdx1, randIdx2, loops, loops2 type(particle) :: p1, p2, p3 real(defReal), dimension(3) :: rNew, r1, r2, r12 real(defReal) :: dist @@ -372,16 +372,13 @@ subroutine reduceSize(self, N, rand) print *, "REDUCE", self % pop, N ! Protect against invalid N - if( N > self % pop) then + if(N > self % pop) then call fatalError(Here,'Requested size: '//numToChar(N) //& 'is greather then max size: '//numToChar(size(self % prisoners))) - else if ( N <= 0 ) then + else if (N <= 0) then call fatalError(Here,'Requested size: '//numToChar(N) //' is not +ve') end if - ! Calculate excess particles to be removed - excessP = self % pop - N - ! Protect against infinite loop loops = 0 @@ -404,9 +401,9 @@ subroutine reduceSize(self, N, rand) r2 = p2 % rGlobal() r12 = r2 - r1 dist = sqrt(r12(1)**2 + r12(2)**2 + r12(3)**2) - if(p2 % type == p1 % type .and. dist <= 0.2 .and. r1(1) <= 0.5) exit sample + if (p2 % type == p1 % type .and. dist <= 0.2 .and. r1(1) <= 0.5) exit sample ! If too many failed samples, resample p1 - if(loops2 >= 0.5*self % pop) cycle reduce + if (loops2 >= 0.5*self % pop) cycle reduce loops2 = loops2 + 1 end do sample From 961d2574df512139d93d7c391fa593e47a155191 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 14 Oct 2022 13:31:08 +0100 Subject: [PATCH 189/373] Changed a few commented lines, work in progress --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 3e199f0a5..1da75f50a 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -187,9 +187,11 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) if( self % sourceGiven ) then ! Reduce size of dungeon if dungeon will overflow - if( self % thisCycle % popSize() + self % pop > self % limit) then - call self % thisCycle % reduceSize(self % limit - self % pop, p % pRNG) - end if + !if( self % thisCycle % popSize() + self % pop > self % limit) then + ! call self % thisCycle % reduceSize2(self % limit - self % pop, self % nMat, self % geom, p % pRNG) + !end if + + !call self % thisCycle % reduceSize2(self % limit, self % nMat, self % geom, p % pRNG) call self % inputSource % append(self % thisCycle, self % pop, p % pRNG) @@ -308,8 +310,8 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_cycles) - write(11, '(8A)') 'M', numToChar(Nm) - write(11, '(8A)') 'P', numToChar(Np) + write(11, '(8A)') 'M ', numToChar(Nm) + write(11, '(8A)') 'P ', numToChar(Np) end do @@ -498,9 +500,9 @@ subroutine init(self, dict) ! Size particle dungeon allocate(self % thisCycle) - call self % thisCycle % init(self % limit) + call self % thisCycle % init(self % limit * self % nMat) allocate(self % nextCycle) - call self % nextCycle % init(self % limit) + call self % nextCycle % init(self % limit * self % nMat) call self % printSettings() From 8ac28857806f44034cb39de4f818dd8f28d28464 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 14 Oct 2022 13:32:02 +0100 Subject: [PATCH 190/373] Changed sampling of direction, work in progress --- .../Source/surfaceSource_class.f90 | 22 +++++++++++-------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/ParticleObjects/Source/surfaceSource_class.f90 b/ParticleObjects/Source/surfaceSource_class.f90 index 37f3028d5..a5c94b9e2 100644 --- a/ParticleObjects/Source/surfaceSource_class.f90 +++ b/ParticleObjects/Source/surfaceSource_class.f90 @@ -263,18 +263,22 @@ subroutine sampleEnergyAngle(self, p, rand) class(surfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal) :: r, phi, theta + real(defReal) :: phi, mu, theta - r = rand % get() - phi = TWO_PI * r - r = rand % get() - theta = acos(1 - TWO * r) - p % dir = [cos(phi) * sin(theta), sin(phi) * sin(theta), cos(theta)] + phi = TWO_PI * rand % get() + mu = sqrt(rand % get()) + !theta = acos(1 - TWO * r) + !p % dir = [cos(phi) * sin(theta), sin(phi) * sin(theta), cos(theta)] + + p % dir = [mu, sqrt(1-mu**2)*cos(phi), sqrt(1-mu**2)*sin(phi)] ! If dir not equal to zero, adjust so that particles are travelling in correct direction - if (self % dir /= 0) then - p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir - end if + !if (self % dir /= 0) then + ! p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir + !end if + + !p % dir = [0,0,0] + !p % dir(self % axis) = 1 end subroutine sampleEnergyAngle From 951a72a54601c503fce4b21f11fc7a1800224e6c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 15 Oct 2022 15:04:32 +0100 Subject: [PATCH 191/373] Added option for cutoff to be specified in input file dictionary --- .../transportOperatorIMC_class.f90 | 21 +++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 2ca27d90c..2a38da6c1 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -12,7 +12,7 @@ module transportOperatorIMC_class use rng_class, only : rng ! Superclass - use transportOperator_inter, only : transportOperator + use transportOperator_inter, only : transportOperator, init_super => init ! Geometry interfaces use geometry_inter, only : geometry @@ -34,8 +34,10 @@ module transportOperatorIMC_class type, public, extends(transportOperator) :: transportOperatorIMC class(mgIMCMaterial), pointer, public :: mat => null() real(defReal) :: majorant_inv + real(defReal) :: cutoff contains procedure :: transit => imcTracking + procedure :: init procedure, private :: materialTransform procedure, private :: surfaceTracking procedure, private :: deltaTracking @@ -81,7 +83,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Decide whether to use delta tracking or surface tracking ! Vastly different opacities make delta tracking infeasable - if(sigmaT * self % majorant_inv > 0.3) then + if(sigmaT * self % majorant_inv > self % cutoff) then ! Delta tracking call self % deltaTracking(p, dTime, dColl, finished) else @@ -229,4 +231,19 @@ subroutine deltaTracking(self, p, dTime, dColl, finished) end subroutine deltaTracking + !! + !! Provide transport operator with delta tracking/surface tracking cutoff + !! + subroutine init(self, dict) + class(transportOperatorIMC), intent(inout) :: self + class(dictionary), intent(in) :: dict + + ! Initialise superclass + call init_super(self, dict) + + ! Get cutoff value + call dict % getOrDefault(self % cutoff, 'cutoff', 0.3_defReal) + + end subroutine init + end module transportOperatorIMC_class From fa03598b298ed90a84c464d991ea4171c3a29562 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 16 Oct 2022 18:58:25 +0100 Subject: [PATCH 192/373] Trialling out new algorithm for making delta tracking more efficient, work in progress --- .../transportOperatorIMC_class.f90 | 167 +++++++++++++++++- 1 file changed, 162 insertions(+), 5 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 2a38da6c1..ec5888945 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -31,16 +31,25 @@ module transportOperatorIMC_class !! !! Transport operator that moves a particle with IMC tracking !! - type, public, extends(transportOperator) :: transportOperatorIMC - class(mgIMCMaterial), pointer, public :: mat => null() - real(defReal) :: majorant_inv - real(defReal) :: cutoff + type, public, extends(transportOperator) :: transportOperatorIMC + class(mgIMCMaterial), pointer, public :: mat => null() + real(defReal) :: majorant_inv + real(defReal) :: deltaT + real(defReal) :: cutoff + real(defReal), dimension(:), allocatable :: matMajs + real(defReal), dimension(:), allocatable :: ratios + integer(shortInt) :: majMapN = 0 + real(defReal), dimension(3) :: top = ZERO + real(defReal), dimension(3) :: bottom = ZERO + integer(shortInt) :: steps contains procedure :: transit => imcTracking procedure :: init + procedure :: buildMajMap procedure, private :: materialTransform procedure, private :: surfaceTracking procedure, private :: deltaTracking + procedure, private :: simpleParticle end type transportOperatorIMC contains @@ -231,19 +240,167 @@ subroutine deltaTracking(self, p, dTime, dColl, finished) end subroutine deltaTracking + !! + !! Generate particles and follow them to attempt to reduce majorant opacity seen by each cell. + !! + !! Particles sampled uniformly within geometry, with random directions, then incrementally moved + !! up to distance dTime. Moving increments are determined by the number of steps to be taken, + !! either given directly in input or calculated from dTime and a given cell lengthscale. + !! + !! Majorant of each cell is set to be the maximum opacity seen by any particle originating in + !! that cell. + !! + subroutine buildMajMap(self, rand, xsData) + class(transportOperatorIMC), intent(inout) :: self + class(RNG), intent(inout) :: rand + class(nuclearDatabase), intent(in), pointer :: xsData + type(particle) :: p + integer(shortInt) :: i, j, matIdx + real(defReal) :: mu, phi, dist, sigmaT1, sigmaT2 + logical(defBool) :: finished = .false. + real(defReal), dimension(8) :: sigmaList + + !sigmaList = 0 + + self % xsData => xsData + + self % matMajs = 0 + self % ratios = 0 + + dist = self % deltaT * lightSpeed / self % steps + + do i = 1, self % majMapN + + call self % simpleParticle(p, rand) + + matIdx = p % matIdx() + + ! Obtain cross section + sigmaT1 = self % xsData % getTransMatXS(p, matIdx) + self % matMajs(matIdx) = max(sigmaT1, self % matMajs(matIdx)) + + self % ratios (matIdx) = sigmaT1 + + ! Incrementally transport particle up to a distance dTime + do j = 1, self % steps + + call self % geom % teleport(p % coords, dist) + if (p % matIdx() == VOID_MAT .or. p % matIdx() == OUTSIDE_MAT) exit + + ! Find opacity at new location + sigmaT2 = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Increase majorant of start location to that of new location if greater + self % matMajs(matIdx) = max(sigmaT2, self % matMajs(matIdx)) + ! Increase majorant of new location to that of start location if greater + self % matMajs(p % matIdx()) = max(sigmaT1, self % matMajs(p % matIdx())) + + end do + + end do + + !print *, 'Local opacities:' + !print *, sigmaList + + print *, 'New Majorant Ratios:' + print *, self % ratios / self % matMajs + + end subroutine buildMajMap + + !! + !! Sample position for buildMajMap subroutine (see above) + !! Attach only necessary properties to particle: + !! + !! - Position, sampled uniformly within geometry + !! - Direction, uniformly from unit sphere + !! - Group = 1 to avoid error + !! + subroutine simpleParticle(self, p, rand) + class(transportOperatorIMC), intent(inout) :: self + type(particle), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: mu, phi + real(defReal), dimension(3) :: r, dir, rand3 + integer(shortInt) :: matIdx, uniqueID + + positionSample:do + ! Sample Position + rand3(1) = rand % get() + rand3(2) = rand % get() + rand3(3) = rand % get() + r = (self % top - self % bottom) * rand3 + self % bottom + + ! Find material under position + call self % geom % whatIsAt(matIdx, uniqueID, r) + + ! Reject if there is no material + if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle positionSample + exit positionSample + end do positionSample + + call p % coords % assignPosition(r) + + ! Sample Direction - chosen uniformly inside unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + call p % coords % assignDirection(dir) + + p % type = P_PHOTON + p % G = 1 + p % isMG = .true. + + call self % geom % placeCoord(p % coords) + + end subroutine simpleParticle + + !! !! Provide transport operator with delta tracking/surface tracking cutoff !! - subroutine init(self, dict) + subroutine init(self, dict, geom) class(transportOperatorIMC), intent(inout) :: self class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in), optional :: geom + class(dictionary), pointer :: tempDict + integer(shortInt) :: nMats + real(defReal), dimension(6) :: bounds + real(defReal) :: lengthScale ! Initialise superclass call init_super(self, dict) + self % geom => geom + + ! Get timestep size + call dict % get(self % deltaT, 'deltaT') + ! Get cutoff value call dict % getOrDefault(self % cutoff, 'cutoff', 0.3_defReal) + ! Get settings for majorant reduction subroutine + if (dict % isPresent('majMap')) then + tempDict => dict % getDictPtr('majMap') + call tempDict % get(self % majMapN, 'nParticles') + call tempDict % get(nMats, 'nMats') + + allocate(self % matMajs(nMats)) + allocate(self % ratios(nMats)) + + if (tempDict % isPresent('steps')) then + call tempDict % get(self % steps, 'steps') + else + call tempDict % get(lengthScale, 'lengthScale') + self % steps = ceiling(lightSpeed*self % deltaT/lengthScale) + end if + ! Set bounding region + bounds = self % geom % bounds() + self % bottom = bounds(1:3) + self % top = bounds(4:6) + end if + end subroutine init end module transportOperatorIMC_class From 2d3051a5af74a8f33f32c52ae0d64d0badcae5c7 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 16 Oct 2022 18:58:48 +0100 Subject: [PATCH 193/373] Working on subroutine to reduce particle populations, work in progress --- ParticleObjects/particleDungeon_class.f90 | 110 +++++++++++++++++++++- 1 file changed, 109 insertions(+), 1 deletion(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 14b04a573..d3fbf3490 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -2,8 +2,10 @@ module particleDungeon_class use numPrecision use genericProcedures, only : fatalError, numToChar - use particle_class, only : particle, particleState + use particle_class, only : particle, particleState, P_MATERIAL, P_PHOTON use RNG_class, only : RNG + use geometry_inter, only : geometry + use universalVariables, only : INF implicit none private @@ -84,6 +86,8 @@ module particleDungeon_class procedure :: normWeight procedure :: normSize procedure :: reduceSize + procedure :: reduceSize2 + procedure :: combine procedure :: cleanPop procedure :: popSize procedure :: popWeight @@ -425,6 +429,110 @@ subroutine reduceSize(self, N, rand) end subroutine reduceSize + !! + !! N = max in each cell + !! + subroutine reduceSize2(self, N, Nmats, geom, rand) + class(particleDungeon), intent(inout) :: self + integer(shortInt), intent(in) :: N + integer(shortInt), intent(in) :: Nmats + class(geometry), intent(inout) :: geom + class(RNG), intent(inout) :: rand + integer(shortInt) :: matIdx, pIdx, pIdx2, closeIdx, num + integer(shortInt) :: i, j, j_dec, k + integer(shortInt), dimension(:,:), allocatable :: idxArray + integer(shortInt), dimension(:), allocatable :: toKeep + real(defReal), dimension(3) :: r1, r2 + real(defReal) :: dist, minDist + character(100), parameter :: Here = 'reduceSize2 (particleDungeon_class.f90)' + + allocate(idxArray(self % pop+1, Nmats)) + idxArray = 0 + + ! Generate array with first row as N_particles in each mat, and subsequent rows + ! containing dungeon idx of each particle in that mat + do i = 1, self % pop + call geom % whatIsAt(matIdx, matIdx, self % prisoners(i) % r) + if (self % prisoners(i) % type == P_MATERIAL) then + matIdx = matIdx-1 + num = idxArray(1,matIdx) + 1 + idxArray(1,matIdx) = num + idxArray(num+1,matIdx) = i + else if (self % prisoners(i) % type /= P_PHOTON) then + call fatalError(Here,'Incorrect particle type') + end if + end do + + ! Determine which mats need populations reduced + do i = 1, Nmats + num = idxArray(1,i) + if (num > N) then + print *, 'Reducing mat '//numToChar(i)//' from '//numToChar(num)//' to '//numToChar(N) + allocate(toKeep(N)) + ! Sample particles to keep + do j = 1, N + toKeep(j) = idxArray(j+1,i) + end do + ! Loop through particles to be removed + do j = N+1, num + j_dec = num-j+N+1 + pIdx = idxArray(j_dec+1,i) + r1 = self % prisoners(pIdx) % r + ! Find closest particle in particles to keep + minDist = INF + do k = 1, N + pIdx2 = toKeep(k) + r2 = self % prisoners(pIdx2) % r - r1 + dist = sqrt(r2(1)**2 + r2(2)**2 + r2(3)**2) + if (dist < minDist) then + minDist = dist + closeIdx = pIdx2 + end if + end do + ! Combine particle with closest particle to keep + call self % combine(pIdx, closeIdx) + end do + deallocate(toKeep) + end if + end do + + deallocate(idxArray) + + end subroutine reduceSize2 + + !! + !! Combine two particles in the dungeon, and reduce dungeon size by 1 + !! + !! Particle at idx1 remains, and is moved to a position that is the energy-weighted average + !! of the two original positions. Its new energy is the sum of the two original energies. + !! To reduce dungeon size, particle at position self % pop is copied into position idx2. + !! + subroutine combine(self, idx1, idx2) + class(particleDungeon), intent(inout) :: self + integer(shortInt), intent(in) :: idx1 + integer(shortInt), intent(in) :: idx2 + type(particle) :: p1, p2, p3 + real(defReal), dimension(3) :: r1, r2, rNew + + ! Get initial particle data + call self % copy(p1, idx1) + call self % copy(p2, idx2) + r1 = p1 % rGlobal() + r2 = p2 % rGlobal() + + ! Move to new combined position + rNew = (r1*p1 % w + r2*p2 % w) / (p1 % w + p2 % w) + call p1 % teleport(rNew) + + ! Combine weights and overwrite particle + p1 % w = p1 % w + p2 % w + call self % replace(p1, idx1) + + ! Release top particle and place at idx2 + call self % release(p3) + if (idx2 /= self % pop) call self % replace(p3, idx2) + + end subroutine combine !! !! Kill or particles in the dungeon From ce96d8a7f3dbf43a5bfd36d1a061a165ef89dffd Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 17 Oct 2022 14:37:07 +0100 Subject: [PATCH 194/373] Changed tracking to use new majorants --- .../transportOperatorIMC_class.f90 | 22 ++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index ec5888945..dfb76842e 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -24,6 +24,7 @@ module transportOperatorIMC_class ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase use mgIMCMaterial_inter, only : mgIMCMaterial, mgIMCMaterial_CptrCast + use materialMenu_mod, only : mm_nMat => nMat implicit none private @@ -62,12 +63,13 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) class(particleDungeon), intent(inout) :: nextCycle real(defReal) :: sigmaT, dTime, dColl logical(defBool) :: finished + integer(shortInt) :: matIdx character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' finished = .false. - ! Get majorant XS inverse: 1/Sigma_majorant - self % majorant_inv = ONE / self % xsData % getMajorantXS(p) + !! Get majorant XS inverse: 1/Sigma_majorant + !self % majorant_inv = ONE / self % xsData % getMajorantXS(p) ! Deal with material particles, only relevant for ISMC if(p % getType() == P_MATERIAL_MG) then @@ -75,6 +77,13 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) if(p % fate == TIME_FATE) return end if + ! Get majorant for particle + if (allocated(self % matMajs)) then + self % majorant_inv = ONE / self % matMajs(p % matIdx()) + else + self % majorant_inv = ONE / self % xsData % getMajorantXS(p) + end if + IMCLoop:do ! Check for errors @@ -260,6 +269,8 @@ subroutine buildMajMap(self, rand, xsData) logical(defBool) :: finished = .false. real(defReal), dimension(8) :: sigmaList + if (.not. allocated(self % matMajs)) return + !sigmaList = 0 self % xsData => xsData @@ -302,8 +313,8 @@ subroutine buildMajMap(self, rand, xsData) !print *, 'Local opacities:' !print *, sigmaList - print *, 'New Majorant Ratios:' - print *, self % ratios / self % matMajs + !print *, 'New Majorant Ratios:' + !print *, self % ratios / self % matMajs end subroutine buildMajMap @@ -384,7 +395,8 @@ subroutine init(self, dict, geom) if (dict % isPresent('majMap')) then tempDict => dict % getDictPtr('majMap') call tempDict % get(self % majMapN, 'nParticles') - call tempDict % get(nMats, 'nMats') + nMats = mm_nMat() + !call tempDict % get(nMats, 'nMats') allocate(self % matMajs(nMats)) allocate(self % ratios(nMats)) From 53f9b22686aea2bd59d29383634b3025c66b319b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 17 Oct 2022 19:18:28 +0100 Subject: [PATCH 195/373] Changed to only test majorants once at the start of calculation, by storing connections between materials instead of storing opacities --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 11 ++- .../transportOperatorIMC_class.f90 | 68 +++++++++++++------ 2 files changed, 57 insertions(+), 22 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 1da75f50a..e31194cd3 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -172,6 +172,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) allocate(Nm(self % nMat)) allocate(Np(self % nMat)) + ! Build connections between materials + call self % transOp % buildMajMap(p % pRNG, self % nucData) + do i=1,N_cycles write(10, '(8A)') numToChar(i) @@ -203,6 +206,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call tally % reportCycleStart(self % thisCycle) + ! Update majorants for transport operator based + call self % transOp % updateMajorants(p % pRNG) + gen: do ! Obtain paticle from dungeon call self % thisCycle % release(p) @@ -426,7 +432,7 @@ subroutine init(self, dict) ! Read whether to print particle source per cycle call dict % getOrDefault(self % printSource, 'printSource', 0) - ! Build Nuclear Data + ! Build Nuclear Data call ndReg_init(dict % getDictPtr("nuclearData")) ! Build geometry @@ -459,7 +465,8 @@ subroutine init(self, dict) ! Build transport operator tempDict => dict % getDictPtr('transportOperator') - call new_transportOperator(self % transOp, tempDict) + call tempDict % store('deltaT', self % deltaT) + call new_transportOperator(self % transOp, tempDict, self % geom) ! Initialise tally Admin tempDict => dict % getDictPtr('tally') diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index dfb76842e..592b9f6be 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -38,7 +38,9 @@ module transportOperatorIMC_class real(defReal) :: deltaT real(defReal) :: cutoff real(defReal), dimension(:), allocatable :: matMajs + integer(shortInt), dimension(:,:), allocatable :: matConnections real(defReal), dimension(:), allocatable :: ratios + real(defReal), dimension(:), allocatable :: sigmaLocal integer(shortInt) :: majMapN = 0 real(defReal), dimension(3) :: top = ZERO real(defReal), dimension(3) :: bottom = ZERO @@ -47,6 +49,7 @@ module transportOperatorIMC_class procedure :: transit => imcTracking procedure :: init procedure :: buildMajMap + procedure :: updateMajorants procedure, private :: materialTransform procedure, private :: surfaceTracking procedure, private :: deltaTracking @@ -84,6 +87,8 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) self % majorant_inv = ONE / self % xsData % getMajorantXS(p) end if + matIdx = p % matIdx() + IMCLoop:do ! Check for errors @@ -265,19 +270,20 @@ subroutine buildMajMap(self, rand, xsData) class(nuclearDatabase), intent(in), pointer :: xsData type(particle) :: p integer(shortInt) :: i, j, matIdx - real(defReal) :: mu, phi, dist, sigmaT1, sigmaT2 + real(defReal) :: mu, phi, dist logical(defBool) :: finished = .false. - real(defReal), dimension(8) :: sigmaList if (.not. allocated(self % matMajs)) return - !sigmaList = 0 + if (.not. allocated(self % matConnections)) return self % xsData => xsData self % matMajs = 0 self % ratios = 0 + self % matConnections = 0 + dist = self % deltaT * lightSpeed / self % steps do i = 1, self % majMapN @@ -286,37 +292,56 @@ subroutine buildMajMap(self, rand, xsData) matIdx = p % matIdx() - ! Obtain cross section - sigmaT1 = self % xsData % getTransMatXS(p, matIdx) - self % matMajs(matIdx) = max(sigmaT1, self % matMajs(matIdx)) - - self % ratios (matIdx) = sigmaT1 - ! Incrementally transport particle up to a distance dTime do j = 1, self % steps call self % geom % teleport(p % coords, dist) if (p % matIdx() == VOID_MAT .or. p % matIdx() == OUTSIDE_MAT) exit - ! Find opacity at new location - sigmaT2 = self % xsData % getTransMatXS(p, p % matIdx()) - - ! Increase majorant of start location to that of new location if greater - self % matMajs(matIdx) = max(sigmaT2, self % matMajs(matIdx)) - ! Increase majorant of new location to that of start location if greater - self % matMajs(p % matIdx()) = max(sigmaT1, self % matMajs(p % matIdx())) + ! Update matConnections to signify a connection between starting mat and new mat + self % matConnections(matIdx, p % matIdx()) = 1 + self % matConnections(p % matIdx(), matIdx) = 1 end do end do + end subroutine buildMajMap + + subroutine updateMajorants(self, rand) + class(transportOperatorIMC), intent(inout) :: self + class(RNG), intent(inout) :: rand + integer(shortInt) :: i, G, nMats + character(100), parameter :: Here = 'updateMajorants (transportOperatorIMC_class.f90)' + + if (.not. allocated(self % matMajs)) return + + nMats = mm_nMat() + G = 1 ! Can easily be expanded to multiple groups later + self % sigmaLocal = 0 + + ! First, update array of local opacities + do i = 1, nMats + ! Get and verify material pointer for material i + self % mat => mgIMCMaterial_CptrCast(self % xsData % getMaterial(i)) + if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG IMC Material") + + ! Store opacity + self % sigmaLocal(i) = self % mat % getTotalXS(G, rand) + end do + + ! Now update majorants for each material + do i = 1, nMats + self % matMajs(i) = maxval(self % sigmaLocal * self % matConnections(i, 1:nMats)) + end do + !print *, 'Local opacities:' - !print *, sigmaList + !print *, self % sigmaLocal - !print *, 'New Majorant Ratios:' - !print *, self % ratios / self % matMajs + !print *, 'New majorants:' + !print *, self % matMajs - end subroutine buildMajMap + end subroutine updateMajorants !! !! Sample position for buildMajMap subroutine (see above) @@ -400,6 +425,9 @@ subroutine init(self, dict, geom) allocate(self % matMajs(nMats)) allocate(self % ratios(nMats)) + allocate(self % sigmaLocal(nMats)) + + allocate(self % matConnections(nMats, nMats)) if (tempDict % isPresent('steps')) then call tempDict % get(self % steps, 'steps') From 20984b6a7f3712935f824ab69435f4dbd8d7b3f0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 19 Oct 2022 13:38:09 +0100 Subject: [PATCH 196/373] Cleaned up files with comments and deletions --- .../transportOperatorIMC_class.f90 | 242 ++++++++++-------- TransportOperator/transportOperator_inter.f90 | 29 ++- 2 files changed, 160 insertions(+), 111 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 592b9f6be..1a257ecde 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -38,9 +38,8 @@ module transportOperatorIMC_class real(defReal) :: deltaT real(defReal) :: cutoff real(defReal), dimension(:), allocatable :: matMajs - integer(shortInt), dimension(:,:), allocatable :: matConnections - real(defReal), dimension(:), allocatable :: ratios real(defReal), dimension(:), allocatable :: sigmaLocal + integer(shortInt), dimension(:,:), allocatable :: matConnections integer(shortInt) :: majMapN = 0 real(defReal), dimension(3) :: top = ZERO real(defReal), dimension(3) :: bottom = ZERO @@ -66,14 +65,10 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) class(particleDungeon), intent(inout) :: nextCycle real(defReal) :: sigmaT, dTime, dColl logical(defBool) :: finished - integer(shortInt) :: matIdx character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' finished = .false. - !! Get majorant XS inverse: 1/Sigma_majorant - !self % majorant_inv = ONE / self % xsData % getMajorantXS(p) - ! Deal with material particles, only relevant for ISMC if(p % getType() == P_MATERIAL_MG) then call self % materialTransform(p, tally) @@ -87,8 +82,6 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) self % majorant_inv = ONE / self % xsData % getMajorantXS(p) end if - matIdx = p % matIdx() - IMCLoop:do ! Check for errors @@ -130,57 +123,6 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) end subroutine imcTracking - - !! - !! Transform material particles into radiation photons with - !! probability per unit time of c*sigma_a*fleck*eta - !! - !! Used only for ISMC, not for standard IMC - !! - subroutine materialTransform(self, p, tally) - class(transportOperatorIMC), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - real(defReal) :: sigmaT, fleck, eta, mu, phi - real(defReal), dimension(3) :: dir - character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' - - ! Confirm that time = 0 - !if (p % time .ne. 0) call fatalError(Here, 'Material particle should have time = 0') - - ! Get and verify material pointer - self % mat => mgIMCMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) - if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG IMC Material") - - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) !! Should be sigma_a, may need changing when sorting out cross-sections - fleck = self % mat % getFleck() - eta = self % mat % getEta() - - ! Sample time to transform into radiation photon - p % time = p % time - log(p % pRNG % get()) / (sigmaT*fleck*eta*lightSpeed) - - ! Deal with eta = 0 - if (p % time /= p % time) p % time = INF - - ! Exit loop if particle remains material until end of time step - if (p % time >= p % timeMax) then - p % fate = TIME_FATE - p % time = p % timeMax - ! Tally energy for next temperature calculation - call tally % reportHist(p) - else - p % type = P_PHOTON - ! Resample direction - mu = 2 * p % pRNG % get() - 1 - phi = p % pRNG % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) - call p % point(dir) - end if - - end subroutine materialTransform - !! !! Perform surface tracking !! @@ -254,6 +196,56 @@ subroutine deltaTracking(self, p, dTime, dColl, finished) end subroutine deltaTracking + !! + !! Transform material particles into radiation photons with + !! probability per unit time of c*sigma_a*fleck*eta + !! + !! Used only for ISMC, not for standard IMC + !! + subroutine materialTransform(self, p, tally) + class(transportOperatorIMC), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + real(defReal) :: sigmaT, fleck, eta, mu, phi + real(defReal), dimension(3) :: dir + character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' + + ! Confirm that time = 0 + !if (p % time .ne. 0) call fatalError(Here, 'Material particle should have time = 0') + + ! Get and verify material pointer + self % mat => mgIMCMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) + if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG IMC Material") + + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) !! Should be sigma_a, may need changing when sorting out cross-sections + fleck = self % mat % getFleck() + eta = self % mat % getEta() + + ! Sample time to transform into radiation photon + p % time = p % time - log(p % pRNG % get()) / (sigmaT*fleck*eta*lightSpeed) + + ! Deal with eta = 0 + if (p % time /= p % time) p % time = INF + + ! Exit loop if particle remains material until end of time step + if (p % time >= p % timeMax) then + p % fate = TIME_FATE + p % time = p % timeMax + ! Tally energy for next temperature calculation + call tally % reportHist(p) + else + p % type = P_PHOTON + ! Resample direction + mu = 2 * p % pRNG % get() - 1 + phi = p % pRNG % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + call p % point(dir) + end if + + end subroutine materialTransform + !! !! Generate particles and follow them to attempt to reduce majorant opacity seen by each cell. !! @@ -273,23 +265,22 @@ subroutine buildMajMap(self, rand, xsData) real(defReal) :: mu, phi, dist logical(defBool) :: finished = .false. + ! Check that subroutine should be called if (.not. allocated(self % matMajs)) return - if (.not. allocated(self % matConnections)) return - + ! Point to nuclear data, as otherwise cannot access until after first particle transport self % xsData => xsData - - self % matMajs = 0 - self % ratios = 0 + ! Reset array self % matConnections = 0 + ! Calculate distance increments dist = self % deltaT * lightSpeed / self % steps do i = 1, self % majMapN + ! Sample particle call self % simpleParticle(p, rand) - matIdx = p % matIdx() ! Incrementally transport particle up to a distance dTime @@ -308,17 +299,20 @@ subroutine buildMajMap(self, rand, xsData) end subroutine buildMajMap + !! + !! Update majorants for each region using material connections build up in buildMajMap subroutine + !! subroutine updateMajorants(self, rand) class(transportOperatorIMC), intent(inout) :: self class(RNG), intent(inout) :: rand integer(shortInt) :: i, G, nMats character(100), parameter :: Here = 'updateMajorants (transportOperatorIMC_class.f90)' + ! Check that subroutine should be called if (.not. allocated(self % matMajs)) return nMats = mm_nMat() - G = 1 ! Can easily be expanded to multiple groups later - self % sigmaLocal = 0 + G = 1 ! Can easily be extended to multiple groups later ! First, update array of local opacities do i = 1, nMats @@ -349,7 +343,8 @@ end subroutine updateMajorants !! !! - Position, sampled uniformly within geometry !! - Direction, uniformly from unit sphere - !! - Group = 1 to avoid error + !! - Type = P_PHOTON + !! - Group = 1, can easily extend to work with multiple groups another time !! subroutine simpleParticle(self, p, rand) class(transportOperatorIMC), intent(inout) :: self @@ -357,53 +352,73 @@ subroutine simpleParticle(self, p, rand) class(RNG), intent(inout) :: rand real(defReal) :: mu, phi real(defReal), dimension(3) :: r, dir, rand3 - integer(shortInt) :: matIdx, uniqueID + integer(shortInt) :: matIdx, uniqueID, loops - positionSample:do - ! Sample Position - rand3(1) = rand % get() - rand3(2) = rand % get() - rand3(3) = rand % get() - r = (self % top - self % bottom) * rand3 + self % bottom + ! Sample points randomly within geometry until valid material is found + loops = 0 + positionSample:do + ! Protect against infinite loop + loops = loops + 1 + if (loops >= 500) call fatalError(Here, '500 particles sampled in void or outside geometry') - ! Find material under position - call self % geom % whatIsAt(matIdx, uniqueID, r) + ! Sample position + rand3(1) = rand % get() + rand3(2) = rand % get() + rand3(3) = rand % get() + r = (self % top - self % bottom) * rand3 + self % bottom - ! Reject if there is no material - if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle positionSample - exit positionSample - end do positionSample + ! Find material under position + call self % geom % whatIsAt(matIdx, uniqueID, r) + + ! Reject if there is no material + if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle positionSample call p % coords % assignPosition(r) + exit positionSample - ! Sample Direction - chosen uniformly inside unit sphere - mu = 2 * rand % get() - 1 - phi = rand % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) - call p % coords % assignDirection(dir) + end do positionSample - p % type = P_PHOTON - p % G = 1 - p % isMG = .true. + ! Sample Direction - chosen uniformly inside unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + call p % coords % assignDirection(dir) - call self % geom % placeCoord(p % coords) + p % type = P_PHOTON + p % G = 1 + p % isMG = .true. - end subroutine simpleParticle + call self % geom % placeCoord(p % coords) + end subroutine simpleParticle !! - !! Provide transport operator with delta tracking/surface tracking cutoff + !! Get transport settings + !! + !! Sample dictionary input: + !! + !! transportOperator { + !! type transportOperatorIMC; + !! cutoff 0.5; + !! majMap { + !! nParticles 500; + !! steps 10; + !! } + !! } + !! + !! As an alternative to 'steps' can specify 'lengthScale' and then steps is calculated + !! automatically as steps = c*dt/lengthScale !! subroutine init(self, dict, geom) - class(transportOperatorIMC), intent(inout) :: self - class(dictionary), intent(in) :: dict + class(transportOperatorIMC), intent(inout) :: self + class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in), optional :: geom - class(dictionary), pointer :: tempDict - integer(shortInt) :: nMats - real(defReal), dimension(6) :: bounds - real(defReal) :: lengthScale + class(dictionary), pointer :: tempDict + integer(shortInt) :: nMats + real(defReal), dimension(6) :: bounds + real(defReal) :: lengthScale ! Initialise superclass call init_super(self, dict) @@ -416,18 +431,15 @@ subroutine init(self, dict, geom) ! Get cutoff value call dict % getOrDefault(self % cutoff, 'cutoff', 0.3_defReal) - ! Get settings for majorant reduction subroutine + ! Preparation for majorant reduction subroutine if (dict % isPresent('majMap')) then - tempDict => dict % getDictPtr('majMap') - call tempDict % get(self % majMapN, 'nParticles') - nMats = mm_nMat() - !call tempDict % get(nMats, 'nMats') - allocate(self % matMajs(nMats)) - allocate(self % ratios(nMats)) - allocate(self % sigmaLocal(nMats)) + if (self % cutoff == 0) call fatalError(Here, 'No need to use majorant map & + &without delta tracking') - allocate(self % matConnections(nMats, nMats)) + ! Get settings + tempDict => dict % getDictPtr('majMap') + call tempDict % get(self % majMapN, 'nParticles') if (tempDict % isPresent('steps')) then call tempDict % get(self % steps, 'steps') @@ -435,7 +447,17 @@ subroutine init(self, dict, geom) call tempDict % get(lengthScale, 'lengthScale') self % steps = ceiling(lightSpeed*self % deltaT/lengthScale) end if - ! Set bounding region + + nMats = mm_nMat() + + ! Allocate arrays + allocate(self % matMajs(nMats)) + allocate(self % sigmaLocal(nMats)) + allocate(self % matConnections(nMats, nMats)) + self % matMajs = 0 + self % sigmaLocal = 0 + + ! Set bounding region for particle sourcing bounds = self % geom % bounds() self % bottom = bounds(1:3) self % top = bounds(4:6) diff --git a/TransportOperator/transportOperator_inter.f90 b/TransportOperator/transportOperator_inter.f90 index 8d0e30e68..b527cb326 100644 --- a/TransportOperator/transportOperator_inter.f90 +++ b/TransportOperator/transportOperator_inter.f90 @@ -7,6 +7,7 @@ module transportOperator_inter use particle_class, only : particle use particleDungeon_class, only : particleDungeon use dictionary_class, only : dictionary + use RNG_class, only : RNG ! Geometry interfaces use geometryReg_mod, only : gr_geomPtr => geomPtr @@ -55,6 +56,8 @@ module transportOperator_inter ! Extentable initialisation and deconstruction procedure procedure :: init procedure :: kill + procedure :: buildMajMap + procedure :: updateMajorants ! Customisable deferred procedures procedure(transit), deferred :: transit @@ -120,9 +123,10 @@ end subroutine transport !! !! Initialise transport operator from dictionary and geometry !! - subroutine init(self, dict) + subroutine init(self, dict, geom) class(transportOperator), intent(inout) :: self class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in), optional :: geom ! Do nothing @@ -139,5 +143,28 @@ elemental subroutine kill(self) end subroutine kill + !! + !! Improve majorant estimates for each material. See transportOperatorIMC_class for details. + !! + subroutine buildMajMap(self, rand, xsData) + class(transportOperator), intent(inout) :: self + class(RNG), intent(inout) :: rand + class(nuclearDatabase), intent(in), pointer :: xsData + + ! Do nothing + + end subroutine buildMajMap + + !! + !! Update majorants for each region. See transportOperatorIMC_class for details. + !! + subroutine updateMajorants(self, rand) + class(transportOperator), intent(inout) :: self + class(RNG), intent(inout) :: rand + + ! Do nothing + + end subroutine updateMajorants + end module transportOperator_inter From 69cce0cac3f2f9c2855240b54c40b037c5cc9776 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 19 Oct 2022 14:13:45 +0100 Subject: [PATCH 197/373] Added missing parameters --- TransportOperator/transportOperatorIMC_class.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 1a257ecde..7f30b7d09 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -353,6 +353,7 @@ subroutine simpleParticle(self, p, rand) real(defReal) :: mu, phi real(defReal), dimension(3) :: r, dir, rand3 integer(shortInt) :: matIdx, uniqueID, loops + character(100), parameter :: Here = 'simpleParticle (transportOperatorIMC.f90)' ! Sample points randomly within geometry until valid material is found loops = 0 @@ -419,6 +420,7 @@ subroutine init(self, dict, geom) integer(shortInt) :: nMats real(defReal), dimension(6) :: bounds real(defReal) :: lengthScale + character(100), parameter :: Here = 'init (transportOperatorIMC.f90)' ! Initialise superclass call init_super(self, dict) From 4c597cf679582b32a0bc058c3e4089e7ca3c6d05 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 19 Oct 2022 14:47:45 +0100 Subject: [PATCH 198/373] Added a few new fatalErrors --- TransportOperator/transportOperatorIMC_class.f90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 7f30b7d09..b4306e653 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -91,6 +91,9 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Obtain sigmaT sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + if (sigmaT*self % majorant_inv > 1) call fatalError(Here, 'Sigma greater than majorant.& + & MajorantMap settings may have been chosen poorly.') + ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) @@ -134,7 +137,7 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) logical(defBool), intent(inout) :: finished real(defReal) :: dist integer(shortInt) :: event - character(100), parameter :: Here = 'surfaceTracking (transportOperatorIMC_class.f90)' + character(100), parameter :: Here = 'surfaceTracking (transportOperatorIMC_class.f90)' dist = min(dTime, dColl) @@ -169,6 +172,7 @@ subroutine deltaTracking(self, p, dTime, dColl, finished) real(defReal), intent(in) :: dColl logical(defBool), intent(inout) :: finished real(defReal) :: sigmaT + character(100), parameter :: Here = 'deltaTracking (transportOperatorIMC_class.f90)' ! Determine which distance to move particle if (dColl < dTime) then @@ -194,6 +198,10 @@ subroutine deltaTracking(self, p, dTime, dColl, finished) ! Exit the loop if the collision is real if (p % pRNG % get() < sigmaT * self % majorant_inv) finished = .true. + ! Protect against infinite loop + if (sigmaT * self % majorant_inv == 0) call fatalError(Here, '100 % virtual collision chance,& + & potentially infinite loop') + end subroutine deltaTracking !! @@ -436,9 +444,6 @@ subroutine init(self, dict, geom) ! Preparation for majorant reduction subroutine if (dict % isPresent('majMap')) then - if (self % cutoff == 0) call fatalError(Here, 'No need to use majorant map & - &without delta tracking') - ! Get settings tempDict => dict % getDictPtr('majMap') call tempDict % get(self % majMapN, 'nParticles') From b3b612dd131f8d889eb29786efa805edcf1e9179 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 27 Oct 2022 18:19:57 +0100 Subject: [PATCH 199/373] Cleaned up a few lines --- ParticleObjects/Source/ISMCSource_class.f90 | 7 +++---- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/ParticleObjects/Source/ISMCSource_class.f90 b/ParticleObjects/Source/ISMCSource_class.f90 index e2736ade2..4266a48c7 100644 --- a/ParticleObjects/Source/ISMCSource_class.f90 +++ b/ParticleObjects/Source/ISMCSource_class.f90 @@ -91,15 +91,14 @@ end subroutine init !! See source_inter for details !! function sampleParticle(self, rand) result(p) - class(ismcSource), intent(inout) :: self + class(ismcSource), intent(inout) :: self class(RNG), intent(inout) :: rand type(particleState) :: p class(nuclearDatabase), pointer :: nucData class(IMCMaterial), pointer :: mat real(defReal), dimension(3) :: r, rand3, dir - ! Here, i is a float to allow more precise control of loop - real(defReal) :: mu, phi, i - integer(shortInt) :: matIdx, uniqueID, nucIdx + real(defReal) :: mu, phi + integer(shortInt) :: i, matIdx, uniqueID, nucIdx character(100), parameter :: Here = 'sampleParticle (ismcSource_class.f90)' ! Get pointer to appropriate nuclear database diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index e31194cd3..c93a71219 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -206,7 +206,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call tally % reportCycleStart(self % thisCycle) - ! Update majorants for transport operator based + ! Update majorants for transport operator call self % transOp % updateMajorants(p % pRNG) gen: do From daca8d9e0b72660edb010bc42a17eedce50e3144 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 27 Oct 2022 18:22:37 +0100 Subject: [PATCH 200/373] Added geom as an optional input to init, for now needed for transportOperatorIMC_class --- TransportOperator/transportOperatorFactory_func.f90 | 8 ++++++-- TransportOperator/transportOperatorHT_class.f90 | 3 ++- TransportOperator/transportOperatorST_class.f90 | 3 ++- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/TransportOperator/transportOperatorFactory_func.f90 b/TransportOperator/transportOperatorFactory_func.f90 index d82ea7006..0a92289d8 100644 --- a/TransportOperator/transportOperatorFactory_func.f90 +++ b/TransportOperator/transportOperatorFactory_func.f90 @@ -15,6 +15,9 @@ module transportOperatorFactory_func use transportOperatorIMC_class, only : transportOperatorIMC !use transportOperatorDynamicDT_class, only : transportOperatorDynamicDT + ! Geometry interfaces + use geometry_inter, only : geometry + implicit none private @@ -37,9 +40,10 @@ module transportOperatorFactory_func !! Allocate new allocatable transportOperator to a specific type !! If new is allocated it deallocates it !! - subroutine new_transportOperator(new, dict) + subroutine new_transportOperator(new, dict, geom) class(transportOperator),allocatable, intent(inout):: new class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in), optional :: geom character(nameLen) :: type character(100),parameter :: Here = 'new_transportOperator (transportOperatorFactory_func.f90)' @@ -65,7 +69,7 @@ subroutine new_transportOperator(new, dict) case('transportOperatorIMC') allocate( transportOperatorIMC :: new) - call new % init(dict) + call new % init(dict, geom) ! case('dynamicTranspOperDT') ! allocate( transportOperatorDynamicDT :: new) diff --git a/TransportOperator/transportOperatorHT_class.f90 b/TransportOperator/transportOperatorHT_class.f90 index baa39a760..e2e2a8118 100644 --- a/TransportOperator/transportOperatorHT_class.f90 +++ b/TransportOperator/transportOperatorHT_class.f90 @@ -42,9 +42,10 @@ module transportOperatorHT_class contains - subroutine init(self, dict) + subroutine init(self, dict, geom) class(transportOperatorHT), intent(inout) :: self class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in), optional :: geom ! Initialise superclass call init_super(self, dict) diff --git a/TransportOperator/transportOperatorST_class.f90 b/TransportOperator/transportOperatorST_class.f90 index 282912c49..c4f42dd3f 100644 --- a/TransportOperator/transportOperatorST_class.f90 +++ b/TransportOperator/transportOperatorST_class.f90 @@ -101,9 +101,10 @@ end subroutine surfaceTracking !! !! See transportOperator_inter for details !! - subroutine init(self, dict) + subroutine init(self, dict, geom) class(transportOperatorST), intent(inout) :: self class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in), optional :: geom if (dict % isPresent('cache')) then call dict % get(self % cache, 'cache') From 5a40fe8a06902b1c944ab76dcbfb638ecede517c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 27 Oct 2022 18:23:44 +0100 Subject: [PATCH 201/373] Changed marshakWave64 to be used for ISMC calculations, will update all input files properly when finished coding and testing --- InputFiles/IMC/MarshakWave/marshakWave64 | 141 +++++++++++------------ 1 file changed, 70 insertions(+), 71 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 174276cb4..27019d6f6 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -1,8 +1,8 @@ -type IMCPhysicsPackage; +type ISMCPhysicsPackage; -pop 500; -limit 20000 +pop 80; +limit 1300; cycles 10000; timeStepSize 0.05; @@ -11,11 +11,11 @@ dataType mg; collisionOperator { - photonMG {type IMCMGstd;} + photonMG {type ISMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorIMC; cutoff 0.7; majMap { nParticles 5000; lengthScale 0.00625; } } source { @@ -25,7 +25,6 @@ source { axis x; pos -2; T 1; - nParticles 500; dir 1; deltat 0.05; particle photon; @@ -144,71 +143,71 @@ nuclearData { materials { - mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat17 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat18 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat19 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat20 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat21 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat22 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat23 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat24 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat25 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat26 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat27 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat28 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat29 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat31 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat32 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - - mat33 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat34 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat35 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat36 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat37 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat38 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat39 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat40 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat41 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat42 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat43 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat44 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat45 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat46 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat47 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat48 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat49 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat50 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat51 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat52 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat53 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat54 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat55 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat56 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat57 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat58 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat59 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat60 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat61 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat62 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat63 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat64 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat17 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat18 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat19 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat20 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat21 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat22 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat23 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat24 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat25 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat26 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat30 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + + mat33 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat34 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat35 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat36 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat37 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat38 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat39 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat40 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat41 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat42 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat43 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat44 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat45 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat46 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat47 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat48 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat49 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat50 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat51 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat52 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat53 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat54 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat55 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat56 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat57 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat58 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat59 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat60 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat61 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat62 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat63 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat64 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } } From 508fa48e90ee0676e67182cd113e0a89e19cbd41 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 28 Oct 2022 11:44:54 +0100 Subject: [PATCH 202/373] Changed inputs to capture and scatter instead of sigmaA and sigmaS --- InputFiles/IMC/MarshakWave/dataFiles/imcData | 4 ++-- InputFiles/IMC/Sample/imcSampleMat | 4 ++-- InputFiles/IMC/SimpleCases/dataFiles/imcData | 4 ++-- InputFiles/IMC/SimpleCases/dataFiles/imcData2 | 4 ++-- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/dataFiles/imcData b/InputFiles/IMC/MarshakWave/dataFiles/imcData index a768438a6..389b9eaa0 100644 --- a/InputFiles/IMC/MarshakWave/dataFiles/imcData +++ b/InputFiles/IMC/MarshakWave/dataFiles/imcData @@ -1,12 +1,12 @@ numberOfGroups 1; -sigmaA ( +capture ( 10 -3 ); -sigmaS ( +scatter ( 0 0 ); diff --git a/InputFiles/IMC/Sample/imcSampleMat b/InputFiles/IMC/Sample/imcSampleMat index d71cc4895..248608a6e 100644 --- a/InputFiles/IMC/Sample/imcSampleMat +++ b/InputFiles/IMC/Sample/imcSampleMat @@ -16,12 +16,12 @@ alpha = 1; // length allowed // e.g. Here, sigmaA = 1 + 2T -sigmaA ( // Absorption opacity +capture ( // Absorption opacity 1 2 // Coefficients 0 1 // Exponents ); -sigmaS ( // Scattering opacity +scatter ( // Scattering opacity 0 0 ); diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData b/InputFiles/IMC/SimpleCases/dataFiles/imcData index 78c551fa5..3e5ec6ed5 100644 --- a/InputFiles/IMC/SimpleCases/dataFiles/imcData +++ b/InputFiles/IMC/SimpleCases/dataFiles/imcData @@ -1,12 +1,12 @@ numberOfGroups 1; -sigmaA ( +capture ( 1 0 ); -sigmaS ( +scatter ( 0 0 ); diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 index 40c4cd084..0e7f39427 100644 --- a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 +++ b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 @@ -1,12 +1,12 @@ numberOfGroups 1; -sigmaA ( +capture ( 1.0 0.0 ); -sigmaS ( +scatter ( 0.0 0.0 ); diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 9a8b98d33..4bc4446bc 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -189,9 +189,9 @@ subroutine init(self, dict) call dict % getOrDefault(self % alpha, 'alpha', ONE) ! Read opacity equations - call dict % get(temp, 'sigmaA') + call dict % get(temp, 'capture') self % absEqn = temp - call dict % get(temp, 'sigmaS') + call dict % get(temp, 'scatter') self % scattEqn = temp ! Build planck opacity equation From 5f9e3bf3ce782dea51ae56e80695b43d6b8e9abc Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 28 Oct 2022 11:45:48 +0100 Subject: [PATCH 203/373] A few minor fixes --- ParticleObjects/Source/IMCSource_class.f90 | 2 +- ParticleObjects/Source/pointSource_class.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 76d5d1be3..ad08c8df7 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -27,7 +27,7 @@ module IMCSource_class !! Angular distribution is isotropic. !! !! Private members: - !! isMG -> is the source multi-group? (default = .false.) + !! isMG -> is the source multi-group? (default = .true.) !! bottom -> Bottom corner (x_min, y_min, z_min) !! top -> Top corner (x_max, y_max, z_max) !! E -> Fission site energy [MeV] (default = 1.0E-6) diff --git a/ParticleObjects/Source/pointSource_class.f90 b/ParticleObjects/Source/pointSource_class.f90 index 5b33694ab..6f10fffa2 100644 --- a/ParticleObjects/Source/pointSource_class.f90 +++ b/ParticleObjects/Source/pointSource_class.f90 @@ -1,7 +1,7 @@ module pointSource_class use numPrecision - use universalVariables + use universalVariables, only : OUTSIDE_MAT use genericProcedures, only : fatalError use particle_class, only : particleState, P_NEUTRON, P_PHOTON use dictionary_class, only : dictionary From d89d3e3aaa563c8ab9a1fa8608d906bbe3f3b6fa Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 28 Oct 2022 18:40:14 +0100 Subject: [PATCH 204/373] Deleted duplicated function --- ParticleObjects/particleDungeon_class.f90 | 17 +++-------------- 1 file changed, 3 insertions(+), 14 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 2cd886ea7..83f190d63 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -50,7 +50,8 @@ module particleDungeon_class !! setSize(n) -> sizes dungeon to have n dummy particles for ease of overwriting !! printToFile(name) -> prints population in ASCII format to file "name" !! printToScreen(prop,nMax,total) -> prints property to screen for up to nMax particles - !! getSize() -> returns number of particles in dungeon + !! popSize() -> returns number of particles in dungeon + !! popWeight() -> returns total population weight !! !! Build procedures: !! init(maxSize) -> allocate space to store maximum of maxSize particles @@ -89,7 +90,6 @@ module particleDungeon_class procedure :: setSize procedure :: printToFile procedure :: printToScreen - procedure :: getSize ! Private procedures procedure, private :: detain_particle @@ -358,7 +358,7 @@ pure subroutine cleanPop(self) end subroutine cleanPop !! - !! Returns number of neutrons in the dungeon + !! Returns number of particles in the dungeon !! function popSize(self) result(pop) class(particleDungeon), intent(in) :: self @@ -586,17 +586,6 @@ subroutine printToScreen(self, prop, nMax, total) end select end subroutine printToScreen - - !! - !! Return number of particles in dungeon - !! - function getSize(self) result(n) - class(particleDungeon), intent(in) :: self - integer(shortInt) :: n - - n = self % pop - - end function getSize end module particleDungeon_class From 8358b093a20cebb40cd88e66f461e024f44eb313 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 28 Oct 2022 18:48:39 +0100 Subject: [PATCH 205/373] Deleted option of printing sum of quantity, rarely useful except total weight which already has its own function --- ParticleObjects/particleDungeon_class.f90 | 115 +++++--------------- PhysicsPackages/IMCPhysicsPackage_class.f90 | 6 +- 2 files changed, 33 insertions(+), 88 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 83f190d63..ee84793c9 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -456,14 +456,11 @@ end subroutine printToFile !! Errors: !! fatalError if prop is invalid !! - subroutine printToScreen(self, prop, nMax, total) + subroutine printToScreen(self, prop, nMax) class(particleDungeon), intent(in) :: self character(*), intent(in) :: prop integer(shortInt), intent(in) :: nMax integer(shortInt) :: i,iMax - logical(defBool), intent(in), optional :: total - logical(defBool) :: totBool = .false. - real(defReal) :: totSum character(100), parameter :: Here = 'printToScreen (particleDungeon_class.f90)' character(nameLen), dimension(*), parameter :: AVAILABLE_props = [ 'r ',& @@ -475,106 +472,54 @@ subroutine printToScreen(self, prop, nMax, total) 'time ',& 'pop '] - ! Reset sum variable - totSum = 0 - print *, 'Number in dungeon =', self % pop ! Number of particles to be printed iMax = min(nMax, self % pop) - ! Print for each particle unless otherwise specified - if( present(total) ) totBool = total - ! Print desired quantities select case(prop) case('r') - if( totBool .eqv. .false. ) then - print *, '** ** Position ** **' - ! Print for each particle - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % r) - end do - else - call fatalError(Here, 'p % r is not a scalar quantity') - end if + print *, '** ** Position ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % r) + end do case('dir') - if( totBool .eqv. .false. ) then - print *, '** ** Direction ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % dir) - end do - else - call fatalError(Here, 'p % dir is not a scalar quantity') - end if + print *, '** ** Direction ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % dir) + end do case('matIdx') - if( totBool .eqv. .false. ) then - print *, '** ** matIdx ** **' - ! Print for each particle - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % matIdx) - end do - else - call fatalError(Here, 'p % matIdx not suitable for cumulative sum') - end if + print *, '** ** matIdx ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % matIdx) + end do case('E') - if( totBool .eqv. .false. ) then - print *, '** ** Energy ** **' - ! Print for each particle - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % E) - end do - else - ! Sum for each particle - do i = 1, self % pop - totSum = totSum + self % prisoners(i) % E - end do - ! Print total - print *, 'Cumulative sum of p % E = ', totSum - end if - + print *, '** ** Energy ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % E) + end do + case('G') - if( totBool .eqv. .false. ) then - print *, '** ** Group ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % G) - end do - else - do i = 1, self % pop - totSum = totSum + self % prisoners(i) % G - end do - print *, 'Cumulative sum of p % G = ', totSum - end if + print *, '** ** Group ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % G) + end do case('wgt') - if( totBool .eqv. .false. ) then - print *, '** ** Weight ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % wgt) - end do - else - do i = 1, self % pop - totSum = totSum + self % prisoners(i) % wgt - end do - print *, 'Cumulative sum of p % wgt = ', totSum - write(12, *) totSum - end if + print *, '** ** Weight ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % wgt) + end do case('time') - if( totBool .eqv. .false. ) then - print *, '** ** Time ** **' - do i = 1, iMax - print *, i,numToChar(self % prisoners(i) % time) - end do - else - do i = 1, self % pop - totSum = totSum + self % prisoners(i) % time - end do - print *, 'Cumulative sum of p % time = ', totSum - end if + print *, '** ** Time ** **' + do i = 1, iMax + print *, i,numToChar(self % prisoners(i) % time) + end do case('pop') ! Do nothing, pop already printed above diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index aa33cdad2..a43ba7c40 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -178,9 +178,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Generate IMC source, only if there are regions with non-zero temperature if(sumT > 0) then ! Select number of particles to generate - if(N + self % thisCycle % getSize() > self % limit) then + if(N + self % thisCycle % popSize() > self % limit) then ! Fleck and Cummings IMC Paper, eqn 4.11 - N = self % limit - self % thisCycle % getSize() - self % nMat - 1 + N = self % limit - self % thisCycle % popSize() - self % nMat - 1 end if if(self % sourceGiven) N = N/2 ! Add to particle dungeon @@ -254,7 +254,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) print * print * print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) - print *, 'Pop: ', numToChar(self % nextCycle % getSize()) + print *, 'Pop: ', numToChar(self % nextCycle % popSize()) print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) print *, 'End time: ', trim(secToChar(end_T)) print *, 'Time to end: ', trim(secToChar(T_toEnd)) From 6df714277f25fc4e4efd7e85a75dd0ec7eee800a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 28 Oct 2022 19:03:55 +0100 Subject: [PATCH 206/373] Reverted old change --- ParticleObjects/particleDungeon_class.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index ee84793c9..d1d2abfef 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -432,11 +432,11 @@ subroutine printToFile(self, name) ! Print out each particle co-ordinate do i = 1, self % pop - write(10,'(8A)') numToChar(self % prisoners(i) % r)!, & - !numToChar(self % prisoners(i) % dir), & - !numToChar(self % prisoners(i) % E), & - !numToChar(self % prisoners(i) % G), & - !numToChar(self % prisoners(i) % matIdx) + write(10,'(8A)') numToChar(self % prisoners(i) % r), & + numToChar(self % prisoners(i) % dir), & + numToChar(self % prisoners(i) % E), & + numToChar(self % prisoners(i) % G), & + numToChar(self % prisoners(i) % matIdx) end do ! Close the file From b8456e975d82e435ff525f5578ee55e13f910d6a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 28 Oct 2022 19:20:04 +0100 Subject: [PATCH 207/373] Changed particle type check function to be more robust --- ParticleObjects/particle_class.f90 | 22 +++++++++++++++------- SharedModules/universalVariables.f90 | 3 ++- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index edad2b01e..f9fa4bf37 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -399,7 +399,7 @@ pure function matIdx(self) result(Idx) end function matIdx !! - !! Return one of the particle Tpes defined in universal variables + !! Return one of the particle types defined in universal variables !! !! Args: !! None @@ -414,12 +414,20 @@ pure function getType(self) result(type) class(particle), intent(in) :: self integer(shortInt) :: type - if (self % type == P_PHOTON) then - type = P_PHOTON_MG - else if (self % isMG) then - type = P_NEUTRON_MG - else - type = P_NEUTRON_CE + ! Check for neutron + if (self % type == P_NEUTRON) then + if (self % isMg) then + type = P_NEUTRON_MG + else + type = P_NEUTRON_CE + end if + ! Check for photon + else if (self % type == P_PHOTON) then + if (self % isMg) then + type = P_PHOTON_MG + else + type = P_PHOTON_CE + end if end if end function getType diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index 84e28d2d3..8bfac8f4e 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -58,7 +58,8 @@ module universalVariables ! Particle Type Enumeration integer(shortInt), parameter :: P_NEUTRON_CE = 1, & P_NEUTRON_MG = 2, & - P_PHOTON_MG = 3 + P_PHOTON_CE = 3, & + P_PHOTON_MG = 4 ! IMC Calculation Type integer(shortInt), parameter :: IMC = 1, & From af11c3655c689bc03a606f4f07423d90dc09f6d2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 28 Oct 2022 19:24:32 +0100 Subject: [PATCH 208/373] Deleted tab --- PhysicsPackages/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PhysicsPackages/CMakeLists.txt b/PhysicsPackages/CMakeLists.txt index bb1993929..c7c10a675 100644 --- a/PhysicsPackages/CMakeLists.txt +++ b/PhysicsPackages/CMakeLists.txt @@ -3,7 +3,7 @@ add_sources( ./physicsPackage_inter.f90 ./physicsPackageFactory_func.f90 ./eigenPhysicsPackage_class.f90 - ./fixedSourcePhysicsPackage_class.f90 + ./fixedSourcePhysicsPackage_class.f90 ./IMCPhysicsPackage_class.f90 ./vizPhysicsPackage_class.f90 ./rayVolPhysicsPackage_class.f90 From 202d108af9d5d9ba7f00f8c6b01018619f638b49 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Oct 2022 11:34:25 +0000 Subject: [PATCH 209/373] Changed particle time to absolute time rather than time within timestep --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index a43ba7c40..ffa0f9918 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -151,7 +151,6 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Attach nuclear data and RNG to particle p % pRNG => self % pRNG - p % timeMax = self % deltaT p % geomIdx = self % geomIdx ! Reset and start timer @@ -204,12 +203,13 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call self % geom % placeCoord(p % coords) ! Assign particle time - if( p % time /= self % deltaT ) then + p % timeMax = self % deltaT * i + if( p % time /= self % deltaT*(i-1) ) then ! If particle has just been sourced, t = 0 so sample uniformly within timestep - p % time = p % pRNG % get() * self % deltaT + p % time = (p % pRNG % get() + i-1) * self % deltaT else - ! If particle survived previous time step, reset time to 0 - p % time = 0 + ! If particle survived previous time step, reset time + p % time = self % deltaT * (i-1) end if ! Save state From 2717925b644dd666bd93c380686b3473015f0588 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Oct 2022 11:37:43 +0000 Subject: [PATCH 210/373] Deleted unneccessary property --- ParticleObjects/particleDungeon_class.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index d1d2abfef..4cc233c7b 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -61,7 +61,6 @@ module particleDungeon_class private real(defReal),public :: k_eff = ONE ! k-eff for fission site generation rate normalisation integer(shortInt) :: pop = 0 ! Current population size of the dungeon - real(defreal),public :: endOfStepTime ! Time at end of current time step - only used in IMC calculations ! Storage space type(particleState), dimension(:), allocatable :: prisoners From 53c7b9747a3f33533845c3c84d022fd0f821537c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Oct 2022 11:52:29 +0000 Subject: [PATCH 211/373] Added option for turning on and off printing of material updates, and to print only a smaller number of material updates --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index ffa0f9918..0a228a8e5 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -83,6 +83,7 @@ module IMCPhysicsPackage_class integer(shortInt) :: particleType logical(defBool) :: sourceGiven = .false. integer(shortInt) :: nMat + integer(shortInt) :: printUpdates ! Calculation components type(particleDungeon), allocatable :: thisCycle @@ -136,19 +137,9 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) real(defReal) :: elapsed_T, end_T, T_toEnd, sumT real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat - logical(defBool) :: printUpdates character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes - ! Set whether or not to print energy and temperature updates of each material - ! Printed from updateMat (baseMgIMCMaterial_class.f90), 7 lines of text - ! per material so recommend to only print when low number of materials - if (self % nMat <= 5) then - printUpdates = .True. - else - printUpdates = .False. - end if - ! Attach nuclear data and RNG to particle p % pRNG => self % pRNG p % geomIdx = self % geomIdx @@ -275,11 +266,13 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Update material properties do j = 1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - if (printUpdates .eqv. .True.) then + if (j <= self % printUpdates) then print * print *, "Material update: ", mm_matName(j) + call mat % updateMat(tallyEnergy(j), .true.) + else + call mat % updateMat(tallyEnergy(j), .false.) end if - call mat % updateMat(tallyEnergy(j), printUpdates) end do print * @@ -355,6 +348,7 @@ subroutine init(self, dict) call dict % get(self % deltaT,'timeStepSize') call dict % get(nucData, 'XSdata') call dict % get(energy, 'dataType') + call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) ! Process type of data select case(energy) From 1d6f1ca491612efa7266a8227a3b9b294003c690 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Oct 2022 12:27:41 +0000 Subject: [PATCH 212/373] Changed a lot of IMC physics package to say 'steps' instead of 'cycles' --- InputFiles/IMC/MarshakWave/marshakWave128 | 4 +- InputFiles/IMC/MarshakWave/marshakWave16 | 4 +- InputFiles/IMC/MarshakWave/marshakWave32 | 4 +- InputFiles/IMC/MarshakWave/marshakWave64 | 4 +- InputFiles/IMC/MarshakWave/marshakWave8 | 4 +- InputFiles/IMC/Sample/imcSampleInput | 4 +- InputFiles/IMC/SimpleCases/3region | 4 +- InputFiles/IMC/SimpleCases/infiniteRegion | 6 +- InputFiles/IMC/SimpleCases/sphereInCube | 2 +- InputFiles/IMC/SimpleCases/touchingCubes | 2 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 80 ++++++++++----------- 11 files changed, 58 insertions(+), 60 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index 5469a1f40..d1275c8ea 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -2,8 +2,8 @@ type IMCPhysicsPackage; pop 500; -limit 20000 -cycles 10000; +limit 5000; +steps 10000; timeStepSize 0.05; XSdata mg; diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 index eb9fe50bf..c77ce78c7 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave16 +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -2,8 +2,8 @@ type IMCPhysicsPackage; pop 500; -limit 200000; -cycles 10000; +limit 5000; +steps 10000; timeStepSize 0.05; XSdata mg; diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 630faf229..0aeb69c1c 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -2,8 +2,8 @@ type IMCPhysicsPackage; pop 500; -limit 20000; -cycles 10000; +limit 5000; +steps 10000; timeStepSize 0.05; XSdata mg; diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 174276cb4..b2adc8411 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -2,8 +2,8 @@ type IMCPhysicsPackage; pop 500; -limit 20000 -cycles 10000; +limit 5000; +steps 10000; timeStepSize 0.05; XSdata mg; diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 index d5bf847c2..31055316a 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave8 +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -2,8 +2,8 @@ type IMCPhysicsPackage; pop 500; -limit 200000; -cycles 10000; +limit 5000; +steps 10000; timeStepSize 0.05; XSdata mg; diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput index 8bb090767..4446c0491 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -16,10 +16,8 @@ limit 10000; // not be set arbitrarily large. Would benefit from a change such that dungeon size is increased // automatically without needing to set a limit. -cycles 50; +steps 50; // The number of time steps to be used in the calculation - // Still called cycles in many functions and subroutines to avoid breaking other - // calculation types timeStepSize 0.1; // The time step size for the calculation in seconds diff --git a/InputFiles/IMC/SimpleCases/3region b/InputFiles/IMC/SimpleCases/3region index 6f5bdb8c6..7726243a3 100644 --- a/InputFiles/IMC/SimpleCases/3region +++ b/InputFiles/IMC/SimpleCases/3region @@ -2,8 +2,8 @@ type IMCPhysicsPackage; pop 5000; -limit 100000; -cycles 51; +limit 20000; +steps 50; timeStepSize 0.1; XSdata mg; diff --git a/InputFiles/IMC/SimpleCases/infiniteRegion b/InputFiles/IMC/SimpleCases/infiniteRegion index 3a371dccf..5cd634c15 100644 --- a/InputFiles/IMC/SimpleCases/infiniteRegion +++ b/InputFiles/IMC/SimpleCases/infiniteRegion @@ -1,9 +1,9 @@ type IMCPhysicsPackage; -pop 1000; -limit 100000; -cycles 50; +pop 5000; +limit 20000; +steps 50; timeStepSize 0.01; XSdata mg; diff --git a/InputFiles/IMC/SimpleCases/sphereInCube b/InputFiles/IMC/SimpleCases/sphereInCube index efcc93c60..01fe736a8 100644 --- a/InputFiles/IMC/SimpleCases/sphereInCube +++ b/InputFiles/IMC/SimpleCases/sphereInCube @@ -3,7 +3,7 @@ type IMCPhysicsPackage; pop 100; limit 2000; -cycles 500; +steps 500; timeStepSize 0.1; XSdata mg; diff --git a/InputFiles/IMC/SimpleCases/touchingCubes b/InputFiles/IMC/SimpleCases/touchingCubes index 9e84c3117..41e0fe7a0 100644 --- a/InputFiles/IMC/SimpleCases/touchingCubes +++ b/InputFiles/IMC/SimpleCases/touchingCubes @@ -3,7 +3,7 @@ type IMCPhysicsPackage; pop 5000; limit 20000; -cycles 51; +steps 50; timeStepSize 1; XSdata mg; diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 0a228a8e5..8c33e1a2c 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -73,7 +73,7 @@ module IMCPhysicsPackage_class type(tallyAdmin),pointer :: imcWeightAtch => null() ! Settings - integer(shortInt) :: N_cycles + integer(shortInt) :: N_steps integer(shortInt) :: pop integer(shortInt) :: limit real(defReal) :: deltaT @@ -86,8 +86,8 @@ module IMCPhysicsPackage_class integer(shortInt) :: printUpdates ! Calculation components - type(particleDungeon), allocatable :: thisCycle - type(particleDungeon), allocatable :: nextCycle + type(particleDungeon), allocatable :: thisStep + type(particleDungeon), allocatable :: nextStep ! Note that other physics packages used pointers for these particleDungeons ( => null() ) ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed class(source), allocatable :: inputSource @@ -101,7 +101,7 @@ module IMCPhysicsPackage_class contains procedure :: init procedure :: printSettings - procedure :: cycles + procedure :: steps procedure :: collectResults procedure :: run procedure :: kill @@ -116,7 +116,7 @@ subroutine run(self) print *, repeat("<>",50) print *, "/\/\ IMC CALCULATION /\/\" - call self % cycles(self % tally, self % imcWeightAtch, self % N_cycles) + call self % steps(self % tally, self % imcWeightAtch, self % N_steps) call self % collectResults() print * @@ -125,19 +125,19 @@ subroutine run(self) end subroutine !! - !! Run cycles for calculation + !! Run steps for calculation !! - subroutine cycles(self, tally, tallyAtch, N_cycles) + subroutine steps(self, tally, tallyAtch, N_steps) class(IMCPhysicsPackage), intent(inout) :: self type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch - integer(shortInt), intent(in) :: N_cycles + integer(shortInt), intent(in) :: N_steps integer(shortInt) :: i, j, N type(particle) :: p real(defReal) :: elapsed_T, end_T, T_toEnd, sumT real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat - character(100),parameter :: Here ='cycles (IMCPhysicsPackage_class.f90)' + character(100),parameter :: Here ='steps (IMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes ! Attach nuclear data and RNG to particle @@ -150,11 +150,11 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) allocate(tallyEnergy(self % nMat)) - do i=1,N_cycles + do i=1,N_steps - ! Store photons remaining from previous cycle - self % thisCycle = self % nextCycle - call self % nextCycle % cleanPop() + ! Store photons remaining from previous time step + self % thisStep = self % nextStep + call self % nextStep % cleanPop() ! Check that there are regions of non-zero temperature by summing mat temperatures sumT = 0 @@ -168,29 +168,29 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Generate IMC source, only if there are regions with non-zero temperature if(sumT > 0) then ! Select number of particles to generate - if(N + self % thisCycle % popSize() > self % limit) then + if(N + self % thisStep % popSize() > self % limit) then ! Fleck and Cummings IMC Paper, eqn 4.11 - N = self % limit - self % thisCycle % popSize() - self % nMat - 1 + N = self % limit - self % thisStep % popSize() - self % nMat - 1 end if if(self % sourceGiven) N = N/2 ! Add to particle dungeon - call self % IMCSource % append(self % thisCycle, N, p % pRNG) + call self % IMCSource % append(self % thisStep, N, p % pRNG) end if ! Generate from input source if( self % sourceGiven ) then - call self % inputSource % append(self % thisCycle, N, p % pRNG) + call self % inputSource % append(self % thisStep, N, p % pRNG) end if if(self % printSource == 1) then - call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) end if - call tally % reportCycleStart(self % thisCycle) + call tally % reportCycleStart(self % thisStep) gen: do ! Obtain paticle from dungeon - call self % thisCycle % release(p) + call self % thisStep % release(p) call self % geom % placeCoord(p % coords) ! Assign particle time @@ -208,44 +208,44 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Transport particle until its death history: do - call self % transOp % transport(p, tally, self % thisCycle, self % nextCycle) + call self % transOp % transport(p, tally, self % thisStep, self % nextStep) if(p % isDead) exit history if(p % fate == TIME_FATE) then ! Store particle for use in next time step p % fate = 0 - call self % nextCycle % detain(p) + call self % nextStep % detain(p) exit history end if - call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) + call self % collOp % collide(p, tally, self % thisStep, self % nextStep) if(p % isDead) exit history end do history ! When dungeon is empty, exit - if( self % thisCycle % isEmpty() ) exit gen + if (self % thisStep % isEmpty()) exit gen end do gen - ! Send end of cycle report - call tally % reportCycleEnd(self % thisCycle) + ! Send end of time step report + call tally % reportCycleEnd(self % thisStep) ! Calculate times call timerStop(self % timerMain) elapsed_T = timerTime(self % timerMain) ! Predict time to end - end_T = real(N_cycles,defReal) * elapsed_T / i + end_T = real(N_steps,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) ! Display progress call printFishLineR(i) print * print * - print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) - print *, 'Pop: ', numToChar(self % nextCycle % popSize()) + print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_steps) + print *, 'Pop: ', numToChar(self % nextStep % popSize()) print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) print *, 'End time: ', trim(secToChar(end_T)) print *, 'Time to end: ', trim(secToChar(T_toEnd)) @@ -276,14 +276,14 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end do print * - ! Reset tally for next cycle + ! Reset tally for next time step call tallyAtch % reset('imcWeight') - print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_cycles) + print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_steps) end do - end subroutine cycles + end subroutine steps !! !! Print calculation results to file @@ -302,7 +302,7 @@ subroutine collectResults(self) call out % printValue(self % pop,name) name = 'Source_batches' - call out % printValue(self % N_cycles,name) + call out % printValue(self % N_steps,name) call cpu_time(self % CPU_time_end) name = 'Total_CPU_Time' @@ -344,7 +344,7 @@ subroutine init(self, dict) ! Read calculation settings call dict % get(self % pop,'pop') call dict % get(self % limit, 'limit') - call dict % get(self % N_cycles,'cycles') + call dict % get(self % N_steps,'steps') call dict % get(self % deltaT,'timeStepSize') call dict % get(nucData, 'XSdata') call dict % get(energy, 'dataType') @@ -389,7 +389,7 @@ subroutine init(self, dict) seed = seed_temp call self % pRNG % init(seed) - ! Read whether to print particle source per cycle + ! Read whether to print particle source each time step call dict % getOrDefault(self % printSource, 'printSource', 0) ! Build Nuclear Data @@ -463,10 +463,10 @@ subroutine init(self, dict) call self % tally % push(self % imcWeightAtch) ! Size particle dungeons - allocate(self % thisCycle) - call self % thisCycle % init(self % limit) - allocate(self % nextCycle) - call self % nextCycle % init(self % limit) + allocate(self % thisStep) + call self % thisStep % init(self % limit) + allocate(self % nextStep) + call self % nextStep % init(self % limit) call self % printSettings() @@ -490,7 +490,7 @@ subroutine printSettings(self) print *, repeat("<>",50) print *, "/\/\ IMC CALCULATION /\/\" - print *, "Source batches: ", numToChar(self % N_cycles) + print *, "Source batches: ", numToChar(self % N_steps) print *, "Population per batch: ", numToChar(self % pop) print *, "Initial RNG Seed: ", numToChar(self % pRNG % getSeed()) print * From 7f4298d0a3107757c69e18391b348282c1c582b1 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Oct 2022 14:50:34 +0000 Subject: [PATCH 213/373] Deleted some unneccessary lines and moved files in line --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 16 +++------------- Tallies/TallyClerks/CMakeLists.txt | 8 ++++---- 2 files changed, 7 insertions(+), 17 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 8c33e1a2c..bbd477976 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -332,7 +332,7 @@ subroutine init(self, dict) character(10) :: time character(8) :: date character(:),allocatable :: string - character(nameLen) :: nucData, energy, geomName + character(nameLen) :: nucData, geomName type(outputFile) :: test_out integer(shortInt) :: i class(IMCMaterial), pointer :: mat @@ -346,19 +346,9 @@ subroutine init(self, dict) call dict % get(self % limit, 'limit') call dict % get(self % N_steps,'steps') call dict % get(self % deltaT,'timeStepSize') - call dict % get(nucData, 'XSdata') - call dict % get(energy, 'dataType') call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) - - ! Process type of data - select case(energy) - case('mg') - self % particleType = P_PHOTON_MG - !case('ce') - ! self % particleType = P_PHOTON_CE - case default - call fatalError(Here,"dataType must be 'mg' or 'ce'.") - end select + self % particleType = P_PHOTON_MG + nucData = 'mg' ! Read outputfile path call dict % getOrDefault(self % outputFile,'outputFile','./output') diff --git a/Tallies/TallyClerks/CMakeLists.txt b/Tallies/TallyClerks/CMakeLists.txt index c655d28da..3cf6c97fd 100644 --- a/Tallies/TallyClerks/CMakeLists.txt +++ b/Tallies/TallyClerks/CMakeLists.txt @@ -8,15 +8,15 @@ add_sources(./tallyClerk_inter.f90 ./keffImplicitClerk_class.f90 ./simpleFMClerk_class.f90 ./dancoffBellClerk_class.f90 - ./shannonEntropyClerk_class.f90 - ./centreOfMassClerk_class.f90 - ./imcWeightClerk_class.f90 + ./shannonEntropyClerk_class.f90 + ./centreOfMassClerk_class.f90 + ./imcWeightClerk_class.f90 ) add_unit_tests(./Tests/collisionClerk_test.f90 ./Tests/trackClerk_test.f90 ./Tests/keffAnalogClerk_test.f90 ./Tests/keffImplicitClerk_test.f90 - ./Tests/shannonEntropyClerk_test.f90 + ./Tests/shannonEntropyClerk_test.f90 ./Tests/simpleFMClerk_test.f90 ) From d496d249e32c2a7ce437e049e7e034921d62c220 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Oct 2022 14:53:04 +0000 Subject: [PATCH 214/373] Changed TIME_FATE to AGED_FATE --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 2 +- TransportOperator/transportOperatorIMC_class.f90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index bbd477976..452108135 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -211,7 +211,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) call self % transOp % transport(p, tally, self % thisStep, self % nextStep) if(p % isDead) exit history - if(p % fate == TIME_FATE) then + if(p % fate == AGED_FATE) then ! Store particle for use in next time step p % fate = 0 call self % nextStep % detain(p) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 91a9d0b63..954929f57 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -65,7 +65,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) else ! Move particle to end of time step location call self % geom % teleport(p % coords, dTime) - p % fate = TIME_FATE + p % fate = AGED_FATE p % time = p % timeMax end if @@ -76,7 +76,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) return end if - if (p % fate == TIME_FATE) exit IMCLoop + if (p % fate == AGED_FATE) exit IMCLoop ! Check for void if( p % matIdx() == VOID_MAT) cycle IMCLoop From 81bc8bfac8951df6c142239ba7c6f55c285d34e9 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Oct 2022 15:11:16 +0000 Subject: [PATCH 215/373] Updated some comments --- ParticleObjects/Source/IMCSource_class.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index ad08c8df7..2ec9f7b66 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -27,11 +27,12 @@ module IMCSource_class !! Angular distribution is isotropic. !! !! Private members: - !! isMG -> is the source multi-group? (default = .true.) - !! bottom -> Bottom corner (x_min, y_min, z_min) - !! top -> Top corner (x_max, y_max, z_max) - !! E -> Fission site energy [MeV] (default = 1.0E-6) - !! G -> Fission site Group (default = 1) + !! isMG -> is the source multi-group? (default = .true.) + !! bottom -> Bottom corner (x_min, y_min, z_min) + !! top -> Top corner (x_max, y_max, z_max) + !! G -> Group (default = 1) + !! matPops -> Array to store the number of particles sampled in each material for + !! normalisation of weight !! !! Interface: !! source_inter Interface @@ -44,7 +45,6 @@ module IMCSource_class logical(defBool) :: isMG = .true. real(defReal), dimension(3) :: bottom = ZERO real(defReal), dimension(3) :: top = ZERO - real(defReal) :: E = ZERO integer(shortInt) :: G = 0 integer(shortInt), dimension(:), allocatable :: matPops contains @@ -256,7 +256,6 @@ elemental subroutine kill(self) self % isMG = .true. self % bottom = ZERO self % top = ZERO - self % E = ZERO self % G = 0 end subroutine kill From 505c619ae13121bba247155876a52183a277e861 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 31 Oct 2022 16:34:03 +0000 Subject: [PATCH 216/373] Changed dungeons in physics package from allocatable to pointer --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 452108135..aaeb02c5c 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -86,10 +86,9 @@ module IMCPhysicsPackage_class integer(shortInt) :: printUpdates ! Calculation components - type(particleDungeon), allocatable :: thisStep - type(particleDungeon), allocatable :: nextStep - ! Note that other physics packages used pointers for these particleDungeons ( => null() ) - ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed + type(particleDungeon), pointer :: thisStep => null() + type(particleDungeon), pointer :: nextStep => null() + type(particleDungeon), pointer :: temp_dungeon => null() class(source), allocatable :: inputSource class(source), allocatable :: IMCSource @@ -152,8 +151,10 @@ subroutine steps(self, tally, tallyAtch, N_steps) do i=1,N_steps - ! Store photons remaining from previous time step - self % thisStep = self % nextStep + ! Swap dungeons to store photons remaining from previous time step + self % temp_dungeon => self % nextStep + self % nextStep => self % thisStep + self % thisStep => self % temp_dungeon call self % nextStep % cleanPop() ! Check that there are regions of non-zero temperature by summing mat temperatures From 1ddc09cdc4030d859d5ef9a3dd31a3cd45086634 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 2 Nov 2022 13:41:57 +0000 Subject: [PATCH 217/373] Added missing line to increase particle time --- TransportOperator/transportOperatorIMC_class.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index b4306e653..4e4b87ac0 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -157,6 +157,7 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) else if (dist == dColl) then ! Collision, increase time accordingly if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') + p % time = p % time + dColl/lightSpeed finished = .true. end if From 6ecc45b1e8e84d09a1196cf06bfabc745126d35c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 2 Nov 2022 14:22:26 +0000 Subject: [PATCH 218/373] Lots of changes to transport operator to make it more general. Also now uses HT instead of just DT --- ParticleObjects/particle_class.f90 | 23 +++ TransportOperator/CMakeLists.txt | 4 +- .../transportOperatorFactory_func.f90 | 14 +- .../transportOperatorIMC_class.f90 | 102 ---------- .../transportOperatorTimeHT_class.f90 | 192 ++++++++++++++++++ 5 files changed, 227 insertions(+), 108 deletions(-) delete mode 100644 TransportOperator/transportOperatorIMC_class.f90 create mode 100644 TransportOperator/transportOperatorTimeHT_class.f90 diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index f9fa4bf37..52e252864 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -136,6 +136,7 @@ module particle_class procedure :: getUniIdx procedure :: matIdx procedure, non_overridable :: getType + procedure :: getSpeed ! Operations on coordinates procedure :: moveGlobal @@ -432,6 +433,28 @@ pure function getType(self) result(type) end function getType + !! + !! Return speed of particle + !! + !! Args: + !! None + !! + !! Errors: + !! Currently returns lightSpeed for P_PHOTONs and gives error otherwise + !! + function getSpeed(self) result(speed) + class(particle), intent(in) :: self + real(defReal) :: speed + character(100), parameter :: Here = 'getSpeed (particle_class.f90)' + + if (self % type == P_PHOTON) then + speed = lightSpeed + else + call fatalError(Here, "Not yet coded to provide speed for neutrons") + end if + + end function getSpeed + !!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! Particle operations on coordinates procedures !!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> diff --git a/TransportOperator/CMakeLists.txt b/TransportOperator/CMakeLists.txt index 86a811b76..5f32aec72 100644 --- a/TransportOperator/CMakeLists.txt +++ b/TransportOperator/CMakeLists.txt @@ -2,7 +2,7 @@ add_sources(./transportOperator_inter.f90 ./transportOperatorFactory_func.f90 ./transportOperatorDT_class.f90 - ./transportOperatorIMC_class.f90 # ./transportOperatorDynamicDT_class.f90 ./transportOperatorST_class.f90 - ./transportOperatorHT_class.f90) + ./transportOperatorHT_class.f90 + ./transportOperatorTimeHT_class.f90) diff --git a/TransportOperator/transportOperatorFactory_func.f90 b/TransportOperator/transportOperatorFactory_func.f90 index d82ea7006..73a426fc9 100644 --- a/TransportOperator/transportOperatorFactory_func.f90 +++ b/TransportOperator/transportOperatorFactory_func.f90 @@ -13,6 +13,7 @@ module transportOperatorFactory_func use transportOperatorDT_class, only : transportOperatorDT use transportOperatorHT_class, only : transportOperatorHT use transportOperatorIMC_class, only : transportOperatorIMC + use transportOperatorTimeHT_class, only : transportOperatorTimeHT !use transportOperatorDynamicDT_class, only : transportOperatorDynamicDT implicit none @@ -23,10 +24,11 @@ module transportOperatorFactory_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 :: AVALIBLE_transportOps = [ 'transportOperatorST ', & - 'transportOperatorDT ', & - 'transportOperatorHT ', & - 'transportOperatorIMC']!, & + character(nameLen),dimension(*),parameter :: AVALIBLE_transportOps = [ 'transportOperatorST ', & + 'transportOperatorDT ', & + 'transportOperatorHT ', & + 'transportOperatorIMC ', & + 'transportOperatorTimeHT']!, & ! 'dynamicTranspOperDT'] public :: new_transportOperator @@ -67,6 +69,10 @@ subroutine new_transportOperator(new, dict) allocate( transportOperatorIMC :: new) call new % init(dict) + case('transportOperatorTimeHT') + allocate( transportOperatorTimeHT :: new) + call new % init(dict) + ! case('dynamicTranspOperDT') ! allocate( transportOperatorDynamicDT :: new) ! call new % init(dict, geom) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 deleted file mode 100644 index 954929f57..000000000 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ /dev/null @@ -1,102 +0,0 @@ -!! -!! Transport operator for implicit Monte Carlo scheme using delta tracking -!! -module transportOperatorIMC_class - use numPrecision - use universalVariables - - use genericProcedures, only : fatalError, numToChar - use particle_class, only : particle - use particleDungeon_class, only : particleDungeon - use dictionary_class, only : dictionary - use rng_class, only : rng - - ! Superclass - use transportOperator_inter, only : transportOperator - - ! Geometry interfaces - use geometry_inter, only : geometry - - ! Tally interface - use tallyCodes - use tallyAdmin_class, only : tallyAdmin - - ! Nuclear data interfaces - use nuclearDatabase_inter, only : nuclearDatabase - - implicit none - private - - !! - !! Transport operator that moves a particle with IMC tracking - !! - type, public, extends(transportOperator) :: transportOperatorIMC - contains - procedure :: transit => imcTracking - end type transportOperatorIMC - -contains - - subroutine imcTracking(self, p, tally, thisCycle, nextCycle) - class(transportOperatorIMC), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - class(particleDungeon), intent(inout) :: thisCycle - class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: majorant_inv, sigmaT, dTime, dColl - character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' - - ! Get majornat XS inverse: 1/Sigma_majorant - majorant_inv = ONE / self % xsData % getMajorantXS(p) - - IMCLoop:do - - ! Find distance to time boundary - dTime = lightSpeed * (p % timeMax - p % time) - - ! Sample distance to move particle before potential collision - dColl = -log( p% pRNG % get() ) * majorant_inv - - ! Determine which distance to move particle - if (dColl < dTime) then - ! Move partice to potential collision location - call self % geom % teleport(p % coords, dColl) - p % time = p % time + dColl / lightSpeed - else - ! Move particle to end of time step location - call self % geom % teleport(p % coords, dTime) - p % fate = AGED_FATE - p % time = p % timeMax - end if - - ! If particle has leaked exit - if (p % matIdx() == OUTSIDE_FILL) then - p % fate = LEAK_FATE - p % isDead = .true. - return - end if - - if (p % fate == AGED_FATE) exit IMCLoop - - ! Check for void - if( p % matIdx() == VOID_MAT) cycle IMCLoop - - ! Obtain the local cross-section - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - - ! Protect Against Sillines - !if( sigmaT*majorant_inv < ZERO .or. ONE < sigmaT*majorant_inv) then - ! call fatalError(Here, "TotalXS/MajorantXS is silly: "//numToChar(sigmaT*majorant_inv)) - !end if - - ! Roll RNG to determine if the collision is real or virtual - ! Exit the loop if the collision is real - if (p % pRNG % get() < sigmaT*majorant_inv) exit IMCLoop - - end do IMCLoop - - call tally % reportTrans(p) - end subroutine imcTracking - - -end module transportOperatorIMC_class diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 new file mode 100644 index 000000000..bb27c0293 --- /dev/null +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -0,0 +1,192 @@ +!! +!! Transport operator time-dependent problems using a hybrid of delta tracking and surface tracking +!! +module transportOperatorTimeHT_class + use numPrecision + use universalVariables + + use genericProcedures, only : fatalError, numToChar + use particle_class, only : particle, P_PHOTON + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use rng_class, only : rng + + ! Superclass + use transportOperator_inter, only : transportOperator, init_super => init + + ! Tally interface + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + + ! Nuclear data interfaces + use nuclearDatabase_inter, only : nuclearDatabase + + implicit none + private + + !! + !! Transport operator that moves a particle with using hybrid tracking, up to a time boundary + !! + type, public, extends(transportOperator) :: transportOperatorTimeHT + real(defReal) :: majorant_inv + real(defReal) :: deltaT + real(defReal) :: cutoff + contains + procedure :: transit => timeTracking + procedure :: init + procedure, private :: surfaceTracking + procedure, private :: deltaTracking + end type transportOperatorTimeHT + +contains + + subroutine timeTracking(self, p, tally, thisCycle, nextCycle) + class(transportOperatorTimeHT), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon), intent(inout) :: thisCycle + class(particleDungeon), intent(inout) :: nextCycle + real(defReal) :: sigmaT, dTime, dColl + logical(defBool) :: finished + integer(shortInt) :: matIdx + character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' + + finished = .false. + + ! Get majorant XS inverse: 1/Sigma_majorant + self % majorant_inv = ONE / self % xsData % getMajorantXS(p) + + trackingLoop:do + + ! Check for errors + if (p % time /= p % time) call fatalError(Here, 'Particle time is NaN') + + ! Obtain sigmaT + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Find distance to time boundary + dTime = p % getSpeed() * (p % timeMax - p % time) + + ! Sample distance to move particle before collision + dColl = -log( p % pRNG % get() ) / sigmaT + + ! Decide whether to use delta tracking or surface tracking + ! Vastly different opacities make delta tracking infeasable + if(sigmaT * self % majorant_inv > self % cutoff) then + ! Delta tracking + call self % deltaTracking(p, dTime, dColl, finished) + else + ! Surface tracking + call self % surfaceTracking(p, dTime, dColl, finished) + end if + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + exit trackingLoop + end if + + ! Exit if transport is finished + if (finished .eqv. .true.) exit trackingLoop + + end do trackingLoop + + call tally % reportTrans(p) + + end subroutine timeTracking + + !! + !! Perform surface tracking + !! + subroutine surfaceTracking(self, p, dTime, dColl, finished) + class(transportOperatorTimeHT), intent(inout) :: self + class(particle), intent(inout) :: p + real(defReal), intent(in) :: dTime + real(defReal), intent(in) :: dColl + logical(defBool), intent(inout) :: finished + real(defReal) :: dist + integer(shortInt) :: event + character(100), parameter :: Here = 'surfaceTracking (transportOperatorTimeHT_class.f90)' + + dist = min(dTime, dColl) + + ! Move through geometry using minimum distance + call self % geom % move(p % coords, dist, event) + + p % time = p % time + dist / p % getSpeed() + + ! Check result of transport + if (dist == dTime) then + ! Time boundary + if (event /= COLL_EV) call fatalError(Here, 'Moving dTime should result in COLL_EV') + p % fate = AGED_FATE + if (abs(p % time - p % timeMax) > 0.000001) call fatalError(Here, 'Particle time incorrect?') + p % time = p % timeMax + finished = .true. + else if (dist == dColl) then + ! Collision, increase time accordingly + if (event /= COLL_EV) call fatalError(Here, 'Moving dColl should result in COLL_EV') + p % time = p % time + dColl / p % getSpeed() + finished = .true. + end if + + end subroutine surfaceTracking + + !! + !! Perform delta tracking + !! + subroutine deltaTracking(self, p, dTime, dColl, finished) + class(transportOperatorTimeHT), intent(inout) :: self + class(particle), intent(inout) :: p + real(defReal), intent(in) :: dTime + real(defReal), intent(in) :: dColl + logical(defBool), intent(inout) :: finished + real(defReal) :: sigmaT + + ! Determine which distance to move particle + if (dColl < dTime) then + ! Move partice to potential collision location + call self % geom % teleport(p % coords, dColl) + p % time = p % time + dColl / p % getSpeed() + else + ! Move particle to end of time step location + call self % geom % teleport(p % coords, dTime) + p % fate = AGED_FATE + p % time = p % timeMax + finished = .true. + return + end if + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return + + ! Obtain local cross-section + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Roll RNG to determine if the collision is real or virtual + ! Exit the loop if the collision is real + if (p % pRNG % get() < sigmaT * self % majorant_inv) finished = .true. + + end subroutine deltaTracking + + !! + !! Provide transport operator with delta tracking/surface tracking cutoff + !! + subroutine init(self, dict) + class(transportOperatorTimeHT), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(dictionary), pointer :: tempDict + integer(shortInt) :: nMats + real(defReal), dimension(6) :: bounds + real(defReal) :: lengthScale + + ! Initialise superclass + call init_super(self, dict) + + ! Get cutoff value + call dict % getOrDefault(self % cutoff, 'cutoff', 0.3_defReal) + + end subroutine init + +end module transportOperatorTimeHT_class From 07c6aacf3049397c4dd8114a0fa8087119f5507a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 2 Nov 2022 14:31:50 +0000 Subject: [PATCH 219/373] Changed cutoff to be consistent with transportOperatorHT_class, and deleted reference to transportOperatorIMC in factory func. --- TransportOperator/transportOperatorFactory_func.f90 | 6 ------ TransportOperator/transportOperatorTimeHT_class.f90 | 6 ++++-- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/TransportOperator/transportOperatorFactory_func.f90 b/TransportOperator/transportOperatorFactory_func.f90 index 73a426fc9..2949c2956 100644 --- a/TransportOperator/transportOperatorFactory_func.f90 +++ b/TransportOperator/transportOperatorFactory_func.f90 @@ -12,7 +12,6 @@ module transportOperatorFactory_func use transportOperatorST_class, only : transportOperatorST use transportOperatorDT_class, only : transportOperatorDT use transportOperatorHT_class, only : transportOperatorHT - use transportOperatorIMC_class, only : transportOperatorIMC use transportOperatorTimeHT_class, only : transportOperatorTimeHT !use transportOperatorDynamicDT_class, only : transportOperatorDynamicDT @@ -27,7 +26,6 @@ module transportOperatorFactory_func character(nameLen),dimension(*),parameter :: AVALIBLE_transportOps = [ 'transportOperatorST ', & 'transportOperatorDT ', & 'transportOperatorHT ', & - 'transportOperatorIMC ', & 'transportOperatorTimeHT']!, & ! 'dynamicTranspOperDT'] @@ -65,10 +63,6 @@ subroutine new_transportOperator(new, dict) allocate( transportOperatorHT :: new) call new % init(dict) - case('transportOperatorIMC') - allocate( transportOperatorIMC :: new) - call new % init(dict) - case('transportOperatorTimeHT') allocate( transportOperatorTimeHT :: new) call new % init(dict) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index bb27c0293..e0bbda447 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -72,7 +72,7 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) ! Decide whether to use delta tracking or surface tracking ! Vastly different opacities make delta tracking infeasable - if(sigmaT * self % majorant_inv > self % cutoff) then + if(sigmaT * self % majorant_inv > ONE - self % cutoff) then ! Delta tracking call self % deltaTracking(p, dTime, dColl, finished) else @@ -173,6 +173,8 @@ end subroutine deltaTracking !! !! Provide transport operator with delta tracking/surface tracking cutoff !! + !! Cutoff of 1 gives exclusively delta tracking, cutoff of 0 gives exclusively surface tracking + !! subroutine init(self, dict) class(transportOperatorTimeHT), intent(inout) :: self class(dictionary), intent(in) :: dict @@ -185,7 +187,7 @@ subroutine init(self, dict) call init_super(self, dict) ! Get cutoff value - call dict % getOrDefault(self % cutoff, 'cutoff', 0.3_defReal) + call dict % getOrDefault(self % cutoff, 'cutoff', 0.7_defReal) end subroutine init From 4ccf587a437aa51fb21d7482486580847daa39c7 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 2 Nov 2022 18:55:48 +0000 Subject: [PATCH 220/373] Deleted test file which was never meant to exist --- .../Tests/baseMgIMCDatabase_iTest.f90 | 303 ------------------ 1 file changed, 303 deletions(-) delete mode 100644 NuclearData/mgIMCData/baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90 diff --git a/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90 b/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90 deleted file mode 100644 index f05c5bea0..000000000 --- a/NuclearData/mgIMCData/baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90 +++ /dev/null @@ -1,303 +0,0 @@ -module baseMgIMCDatabase_iTest - - use numPrecision - use endfConstants - use pFUnit_mod - use dictionary_class, only : dictionary - use dictParser_func, only : charToDict - use particle_class, only : particle - - ! Nuclear Data Objects & Interfaces - use baseMgIMCDatabase_class, only : baseMgIMCDatabase, baseMgIMCDatabase_CptrCast, & - baseMgIMCDatabase_TptrCast - use baseMgIMCMaterial_class, only : baseMgIMCMaterial, baseMgIMCMaterial_CptrCast, & - baseMgIMCMaterial_TptrCast - use fissionMG_class, only : fissionMG, fissionMG_TptrCast - use multiScatterMG_class, only : multiScatterMG, multiScatterMG_CptrCast, & - multiScatterMG_TptrCast - use multiScatterP1MG_class, only : multiScatterP1MG, multiScatterP1MG_TptrCast - use materialMenu_mod, only : mm_init => init, mm_kill => kill - use nuclearDatabase_inter, only : nuclearDatabase - use materialHandle_inter, only : materialHandle - use nuclideHandle_inter, only : nuclideHandle - use IMCXsPackages_class, only : IMCMacroXSs - use reactionHandle_inter, only : reactionHandle - - - - implicit none - - ! Material definitions - character(*),parameter :: MAT_INPUT_STR = " & - mat1 { temp 273; & - composition { & - 1001.03 5.028E-02; & - 8016.03 2.505E-02; & - } & - xsFile ./IntegrationTestFiles/mgMat1; & - } & - mat2 { temp 1; & - composition { & - 92233.03 2.286E-02; & - 8016.03 4.572E-02; & - } & - xsFile ./IntegrationTestFiles/mgMat2; & - }" - - -contains - - !! - !! Monster test to build and verify data in baseMgIMCDatabase with P0 scattering - !! -@Test - subroutine testBaseMgIMCDatabaseWithP0() - type(baseMgIMCDatabase), target :: database - class(nuclearDatabase), pointer :: data_ptr - type(dictionary) :: databaseDef - type(dictionary) :: matMenuDict - type(particle) :: p - type(IMCMacroXSs) :: xss - type(baseMgIMCMaterial),pointer :: mat - class(baseMgIMCMaterial),pointer :: matClass - class(reactionHandle), pointer :: reac - real(defReal),parameter :: TOL = 1.0E-6_defReal - - - data_ptr => database - - ! Load materialMenu - call charToDict(matMenuDict, MAT_INPUT_STR) - call mm_init(matMenuDict ) - - ! Build database - call databaseDef % init(1) - call databaseDef % store('PN','P0') - call database % init(databaseDef, data_ptr, silent = .true.) - call database % activate([1]) - - ! Varify number of groups - @assertEqual(4, database % nGroups()) - - ! Test getting Transport XS - p % G = 1 - @assertEqual(2.1_defReal, database % getTransMatXS(p, 1), TOL) - - ! Test getting Total XS - p % G = 1 - @assertEqual(3.1_defReal, database % getTotalMatXS(p, 2), TOL) - - p % G = 3 - @assertEqual(6.0_defReal, database % getTotalMatXS(p, 1), TOL) - - ! Test getting Majorant - p % G = 1 - @assertEqual(2.1_defReal, database % getMajorantXS(p), TOL) - - - ! Get a material and verify macroXSS - mat => baseMgIMCMaterial_TptrCast(database % getMaterial(2)) - @assertTrue(associated(mat), "Type Ptr Cast has failed") - call mat % getMacroXSs(xss, 1, p % pRNG) - - ! Check that is fissile - @assertTrue(mat % isFissile(), "Is not fissile but should") - - @assertEqual(3.1_defReal, xss % total, TOL) - @assertEqual(ZERO, xss % elasticScatter, TOL) - @assertEqual(1.1_defReal, xss % inelasticScatter, TOL) - @assertEqual(1.0_defReal, xss % capture, TOL) - @assertEqual(1.0_defReal, xss % fission, TOL) - @assertEqual(2.3_defReal, xss % nuFission, TOL) - - matClass => baseMgIMCMaterial_CptrCast(database % getMaterial(1)) - @assertTrue(associated(matClass), "Type Ptr Cast has failed") - call matClass % getMacroXSs(xss, 4, p % pRNG) - - @assertFalse(matClass % isFissile(), "Is fissile but should not") - - @assertEqual(7.1_defReal, xss % total, TOL) - @assertEqual(ZERO, xss % elasticScatter, TOL) - @assertEqual(3.1_defReal, xss % inelasticScatter, TOL) - @assertEqual(4.0_defReal, xss % capture, TOL) - @assertEqual(0.0_defReal, xss % fission, TOL) - @assertEqual(0.0_defReal, xss % nuFission, TOL) - - ! Get some invalid Materials - mat => baseMgIMCMaterial_TptrCast(database % getMaterial(0)) - @assertFalse(associated(mat)) - - mat => baseMgIMCMaterial_TptrCast(database % getMaterial(-2)) - @assertFalse(associated(mat)) - - mat => baseMgIMCMaterial_TptrCast(database % getMaterial(3)) - @assertFalse(associated(mat)) - - ! Get Fission reaction and verify type - reac => fissionMG_TptrCast(database % getReaction(macroFission, 1)) - @assertFalse(associated(reac), "Pointer for the mission reaction is not null") - - reac => fissionMG_TptrCast(database % getReaction(macroFission, 2)) - @assertTrue(associated(reac), "Pointer fission reaction is wrong type or null") - - ! Get Scattering reaction and verify type - reac => multiScatterMG_TptrCast(database % getReaction(macroIEScatter, 1)) - @assertTrue(associated(reac), "Wrong type of scattering reaction") - - ! Get some invalid reactions - reac => database % getReaction(anyScatter, 0) - @assertFalse(associated(reac)) - - reac => database % getReaction(anyScatter, -1) - @assertFalse(associated(reac)) - - reac => database % getReaction(anyScatter, 3) - @assertFalse(associated(reac)) - - reac => database % getReaction(anyCapture, 1) - @assertFalse(associated(reac)) - - ! **** Note that anyFission is not present ! - reac => database % getReaction(anyFission, 2) - @assertFalse(associated(reac)) - - ! Test getting nuclide - @assertFalse(associated(database % getNuclide(1))) - - ! Clean up - call database % kill() - call mm_kill() - call matMenuDict % kill() - call databaseDef % kill() - - end subroutine testBaseMgIMCDatabaseWithP0 - - !! - !! Monster test to build and verify data in baseMgIMCDatabase with P1 scattering - !! *Copy and pasted from the above with only the type of scattering changed - !! -@Test - subroutine testBaseMgIMCDatabaseWithP1() - type(baseMgIMCDatabase), target :: database - class(nuclearDatabase), pointer :: data_ptr - type(dictionary) :: databaseDef - type(dictionary) :: matMenuDict - type(particle) :: p - type(IMCMacroXSs) :: xss - type(baseMgIMCMaterial),pointer :: mat - class(baseMgIMCMaterial),pointer :: matClass - class(reactionHandle), pointer :: reac - real(defReal),parameter :: TOL = 1.0E-6_defReal - - - data_ptr => database - - ! Load materialMenu - call charToDict(matMenuDict, MAT_INPUT_STR) - call mm_init(matMenuDict ) - - ! Build database - call databaseDef % init(1) - call databaseDef % store('PN','P1') - call database % init(databaseDef, data_ptr, silent = .true.) - call database % activate([1]) - - ! Varify number of groups - @assertEqual(4, database % nGroups()) - - ! Test getting Transport XS - p % G = 1 - @assertEqual(2.1_defReal, database % getTransMatXS(p, 1), TOL) - - ! Test getting Total XS - p % G = 1 - @assertEqual(3.1_defReal, database % getTotalMatXS(p, 2), TOL) - - p % G = 3 - @assertEqual(6.0_defReal, database % getTotalMatXS(p, 1), TOL) - - ! Test getting Majorant - p % G = 1 - @assertEqual(2.1_defReal, database % getMajorantXS(p), TOL) - - - ! Get a material and verify macroXSS - mat => baseMgIMCMaterial_TptrCast(database % getMaterial(2)) - @assertTrue(associated(mat), "Type Ptr Cast has failed") - call mat % getMacroXSs(xss, 1, p % pRNG) - - ! Check that is fissile - @assertTrue(mat % isFissile(), "Is not fissile but should") - - @assertEqual(3.1_defReal, xss % total, TOL) - @assertEqual(ZERO, xss % elasticScatter, TOL) - @assertEqual(1.1_defReal, xss % inelasticScatter, TOL) - @assertEqual(1.0_defReal, xss % capture, TOL) - @assertEqual(1.0_defReal, xss % fission, TOL) - @assertEqual(2.3_defReal, xss % nuFission, TOL) - - matClass => baseMgIMCMaterial_CptrCast(database % getMaterial(1)) - @assertTrue(associated(matClass), "Type Ptr Cast has failed") - call matClass % getMacroXSs(xss, 4, p % pRNG) - - @assertFalse(matClass % isFissile(), "Is fissile but should not") - - @assertEqual(7.1_defReal, xss % total, TOL) - @assertEqual(ZERO, xss % elasticScatter, TOL) - @assertEqual(3.1_defReal, xss % inelasticScatter, TOL) - @assertEqual(4.0_defReal, xss % capture, TOL) - @assertEqual(0.0_defReal, xss % fission, TOL) - @assertEqual(0.0_defReal, xss % nuFission, TOL) - - ! Get some invalid Materials - mat => baseMgIMCMaterial_TptrCast(database % getMaterial(0)) - @assertFalse(associated(mat)) - - mat => baseMgIMCMaterial_TptrCast(database % getMaterial(-2)) - @assertFalse(associated(mat)) - - mat => baseMgIMCMaterial_TptrCast(database % getMaterial(3)) - @assertFalse(associated(mat)) - - ! Get Fission reaction and verify type - reac => fissionMG_TptrCast(database % getReaction(macroFission, 1)) - @assertFalse(associated(reac), "Pointer for the mission reaction is not null") - - reac => fissionMG_TptrCast(database % getReaction(macroFission, 2)) - @assertTrue(associated(reac), "Pointer fission reaction is wrong type or null") - - ! Get Scattering reaction and verify type - reac => multiScatterP1MG_TptrCast(database % getReaction(macroIEScatter, 1)) - @assertTrue(associated(reac), "Wrong type of scattering reaction") - - ! Get some invalid reactions - reac => database % getReaction(anyScatter, 0) - @assertFalse(associated(reac)) - - reac => database % getReaction(anyScatter, -1) - @assertFalse(associated(reac)) - - reac => database % getReaction(anyScatter, 3) - @assertFalse(associated(reac)) - - reac => database % getReaction(anyCapture, 1) - @assertFalse(associated(reac)) - - ! **** Note that anyFission is not present ! - reac => database % getReaction(anyFission, 2) - @assertFalse(associated(reac)) - - ! Test getting nuclide - @assertFalse(associated(database % getNuclide(1))) - - ! Clean up - call database % kill() - call mm_kill() - call matMenuDict % kill() - call databaseDef % kill() - - end subroutine testBaseMgIMCDatabaseWithP1 - - - -end module baseMgIMCDatabase_iTest From 5a223d945b9e7501dfcb86e1bc94177c4a433db7 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 3 Nov 2022 13:54:56 +0000 Subject: [PATCH 221/373] Changed cycles to steps and dungeons to pointers to be in line with IMCPhysicsPackage --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 95 +++++++++----------- 1 file changed, 44 insertions(+), 51 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 56d9cdd47..91e9616ab 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -73,7 +73,7 @@ module ISMCPhysicsPackage_class type(tallyAdmin),pointer :: imcWeightAtch => null() ! Settings - integer(shortInt) :: N_cycles + integer(shortInt) :: N_steps integer(shortInt) :: pop integer(shortInt) :: limit real(defReal) :: deltaT @@ -86,8 +86,9 @@ module ISMCPhysicsPackage_class integer(shortInt) :: nMat ! Calculation components - type(particleDungeon), allocatable :: thisCycle - type(particleDungeon), allocatable :: nextCycle + type(particleDungeon), pointer :: thisStep => null() + type(particleDungeon), pointer :: nextStep => null() + type(particleDungeon), pointer :: temp_dungeon => null() type(particleDungeon), allocatable :: matPhotons ! Note that other physics packages used pointers for these particleDungeons ( => null() ) ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed @@ -102,7 +103,7 @@ module ISMCPhysicsPackage_class contains procedure :: init procedure :: printSettings - procedure :: cycles + procedure :: steps procedure :: collectResults procedure :: run procedure :: kill @@ -117,7 +118,7 @@ subroutine run(self) print *, repeat("<>",50) print *, "/\/\ ISMC CALCULATION /\/\" - call self % cycles(self % tally, self % imcWeightAtch, self % N_cycles) + call self % steps(self % tally, self % imcWeightAtch, self % N_steps) call self % collectResults() print * @@ -126,13 +127,13 @@ subroutine run(self) end subroutine !! - !! Run cycles for calculation + !! Run steps for calculation !! - subroutine cycles(self, tally, tallyAtch, N_cycles) + subroutine steps(self, tally, tallyAtch, N_steps) class(ISMCPhysicsPackage), intent(inout) :: self type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch - integer(shortInt), intent(in) :: N_cycles + integer(shortInt), intent(in) :: N_steps integer(shortInt) :: i, j, matIdx integer(shortInt), dimension(:), allocatable :: Nm, Np type(particle) :: p @@ -140,7 +141,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat logical(defBool) :: printUpdates - character(100),parameter :: Here ='cycles (ISMCPhysicsPackage_class.f90)' + character(100),parameter :: Here ='steps (ISMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes ! Set whether or not to print energy and temperature updates of each material @@ -164,7 +165,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) allocate(tallyEnergy(self % nMat)) ! Generate initial material photons - call self % ISMCSource % generate(self % nextCycle, self % pop, p % pRNG) + call self % ISMCSource % generate(self % nextStep, self % pop, p % pRNG) open(unit = 10, file = 'temps.txt') open(unit = 11, file = 'pops.txt') @@ -175,43 +176,45 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Build connections between materials call self % transOp % buildMajMap(p % pRNG, self % nucData) - do i=1,N_cycles + do i=1,N_steps write(10, '(8A)') numToChar(i) Nm = 0 Np = 0 - ! Store photons remaining from previous cycle - self % thisCycle = self % nextCycle - call self % nextCycle % cleanPop() + ! Swap dungeons to store photons remaining from previous time step + self % temp_dungeon => self % nextStep + self % nextStep => self % thisStep + self % thisStep => self % temp_dungeon + call self % nextStep % cleanPop() ! Generate from input source if( self % sourceGiven ) then ! Reduce size of dungeon if dungeon will overflow - !if( self % thisCycle % popSize() + self % pop > self % limit) then - ! call self % thisCycle % reduceSize2(self % limit - self % pop, self % nMat, self % geom, p % pRNG) + !if( self % thisStep % popSize() + self % pop > self % limit) then + ! call self % thisStep % reduceSize2(self % limit - self % pop, self % nMat, self % geom, p % pRNG) !end if - !call self % thisCycle % reduceSize2(self % limit, self % nMat, self % geom, p % pRNG) + !call self % thisStep % reduceSize2(self % limit, self % nMat, self % geom, p % pRNG) - call self % inputSource % append(self % thisCycle, self % pop, p % pRNG) + call self % inputSource % append(self % thisStep, self % pop, p % pRNG) end if !if(self % printSource == 1) then - ! call self % thisCycle % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + ! call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) !end if - call tally % reportCycleStart(self % thisCycle) + call tally % reportCycleStart(self % thisStep) ! Update majorants for transport operator call self % transOp % updateMajorants(p % pRNG) gen: do ! Obtain paticle from dungeon - call self % thisCycle % release(p) + call self % thisStep % release(p) call self % geom % placeCoord(p % coords) ! Assign particle time @@ -229,7 +232,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Transport particle until its death history: do - call self % transOp % transport(p, tally, self % thisCycle, self % nextCycle) + call self % transOp % transport(p, tally, self % thisStep, self % nextStep) if(p % fate == LEAK_FATE) exit history if(p % fate == TIME_FATE) then @@ -244,7 +247,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end if ! Store particle for use in next time step p % fate = 0 - call self % nextCycle % detain(p) + call self % nextStep % detain(p) exit history end if @@ -252,7 +255,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) call fatalError(Here, 'Material particle should not undergo collision') end if - call self % collOp % collide(p, tally, self % thisCycle, self % nextCycle) + call self % collOp % collide(p, tally, self % thisStep, self % nextStep) if(p % isDead) call fatalError(Here, 'Particle should not be dead, check that collision & &operator is of type "ISMCMGstd"') @@ -260,29 +263,29 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) end do history ! When dungeon is empty, exit - if( self % thisCycle % isEmpty() ) then + if( self % thisStep % isEmpty() ) then exit gen end if end do gen ! Send end of cycle report - call tally % reportCycleEnd(self % thisCycle) + call tally % reportCycleEnd(self % thisStep) ! Calculate times call timerStop(self % timerMain) elapsed_T = timerTime(self % timerMain) ! Predict time to end - end_T = real(N_cycles,defReal) * elapsed_T / i + end_T = real(N_steps,defReal) * elapsed_T / i T_toEnd = max(ZERO, end_T - elapsed_T) ! Display progress call printFishLineR(i) print * print * - print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_cycles) - print *, 'Pop: ', numToChar(self % nextCycle % popSize()) + print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_steps) + print *, 'Pop: ', numToChar(self % nextStep % popSize()) print *, 'Elapsed time: ', trim(secToChar(elapsed_T)) print *, 'End time: ', trim(secToChar(end_T)) print *, 'Time to end: ', trim(secToChar(T_toEnd)) @@ -314,7 +317,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) ! Reset tally for next cycle call tallyAtch % reset('imcWeight') - print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_cycles) + print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_steps) write(11, '(8A)') 'M ', numToChar(Nm) write(11, '(8A)') 'P ', numToChar(Np) @@ -324,7 +327,7 @@ subroutine cycles(self, tally, tallyAtch, N_cycles) close(10) close(11) - end subroutine cycles + end subroutine steps !! !! Print calculation results to file @@ -343,7 +346,7 @@ subroutine collectResults(self) call out % printValue(self % pop,name) name = 'Source_batches' - call out % printValue(self % N_cycles,name) + call out % printValue(self % N_steps,name) call cpu_time(self % CPU_time_end) name = 'Total_CPU_Time' @@ -373,7 +376,7 @@ subroutine init(self, dict) character(10) :: time character(8) :: date character(:),allocatable :: string - character(nameLen) :: nucData, energy, geomName + character(nameLen) :: nucData, geomName type(outputFile) :: test_out integer(shortInt) :: i character(nameLen), dimension(:), allocatable :: mats @@ -385,20 +388,10 @@ subroutine init(self, dict) ! Read calculation settings call dict % get( self % pop,'pop') call dict % getOrDefault( self % limit, 'limit', self % pop) - call dict % get( self % N_cycles,'cycles') + call dict % get( self % N_steps,'steps') call dict % get( self % deltaT,'timeStepSize') - call dict % get( nucData, 'XSdata') - call dict % get( energy, 'dataType') - - ! Process type of data - select case(energy) - case('mg') - self % particleType = P_PHOTON_MG - !case('ce') - ! self % particleType = P_PHOTON_CE - case default - call fatalError(Here,"dataType must be 'mg' or 'ce'.") - end select + self % particleType = P_PHOTON_MG + nucData = 'mg' ! Read outputfile path call dict % getOrDefault(self % outputFile,'outputFile','./output') @@ -506,10 +499,10 @@ subroutine init(self, dict) call self % tally % push(self % imcWeightAtch) ! Size particle dungeon - allocate(self % thisCycle) - call self % thisCycle % init(self % limit * self % nMat) - allocate(self % nextCycle) - call self % nextCycle % init(self % limit * self % nMat) + allocate(self % thisStep) + call self % thisStep % init(self % limit * self % nMat) + allocate(self % nextStep) + call self % nextStep % init(self % limit * self % nMat) call self % printSettings() @@ -533,7 +526,7 @@ subroutine printSettings(self) print *, repeat("<>",50) print *, "/\/\ ISMC CALCULATION /\/\" - print *, "Source batches: ", numToChar(self % N_cycles) + print *, "Source batches: ", numToChar(self % N_steps) print *, "Population per batch: ", numToChar(self % pop) print *, "Initial RNG Seed: ", numToChar(self % pRNG % getSeed()) print * From e2c56fe90632c5dd28cae93510ddfb9387b13337 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 3 Nov 2022 14:43:15 +0000 Subject: [PATCH 222/373] Changed particle time to absolute time to be consistent with IMCPhysicsPackage --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 26 ++++++++++++++------ 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 91e9616ab..238e8a0fb 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -155,7 +155,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Attach nuclear data and RNG to particle p % pRNG => self % pRNG - p % timeMax = self % deltaT p % geomIdx = self % geomIdx ! Reset and start timer @@ -212,18 +211,29 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Update majorants for transport operator call self % transOp % updateMajorants(p % pRNG) + ! Assign new maximum particle time + p % timeMax = self % deltaT * i + gen: do ! Obtain paticle from dungeon call self % thisStep % release(p) call self % geom % placeCoord(p % coords) - ! Assign particle time - if( p % type /= P_MATERIAL .and. p % time /= self % deltaT ) then - ! If particle has just been sourced, t = 0 so sample uniformly within timestep - p % time = p % pRNG % get() * self % deltaT - else - ! If particle survived previous time step, reset time to 0 - p % time = ZERO + ! Check particle type + if (p % getType() /= P_PHOTON_MG .and. p % getType() /= P_MATERIAL_MG) then + call fatalError(Here, 'Particle is not of type P_PHOTON_MG or P_MATERIAL_MG') + end if + + ! For newly sourced particles, sample time uniformly within time step + if (p % time == ZERO) then + p % time = (p % pRNG % get() + i-1) * self % deltaT + end if + + ! Check for time errors + if (p % time >= p % timeMax .or. p % time < self % deltaT*(i-1)) then + call fatalError(Here, 'Particle time is not within timestep bounds') + else if (p % time /= p % time) then + call fatalError(Here, 'Particle time is NaN') end if ! Save state From 48d3ec591a294b8a6486419e328d0ae736560085 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 3 Nov 2022 14:49:50 +0000 Subject: [PATCH 223/373] A few changes to the way that particle time is sampled and some new error calls --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 24 +++++++++++++++------ 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index aaeb02c5c..333ff8d29 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -189,19 +189,29 @@ subroutine steps(self, tally, tallyAtch, N_steps) call tally % reportCycleStart(self % thisStep) + ! Assign new maximum particle time + p % timeMax = self % deltaT * i + gen: do ! Obtain paticle from dungeon call self % thisStep % release(p) call self % geom % placeCoord(p % coords) - ! Assign particle time - p % timeMax = self % deltaT * i - if( p % time /= self % deltaT*(i-1) ) then - ! If particle has just been sourced, t = 0 so sample uniformly within timestep + ! Check particle type + if (p % getType() /= P_PHOTON_MG) then + call fatalError(Here, 'Particle is not of type P_PHOTON_MG') + end if + + ! For newly sourced particles, sample time uniformly within time step + if (p % time == ZERO) then p % time = (p % pRNG % get() + i-1) * self % deltaT - else - ! If particle survived previous time step, reset time - p % time = self % deltaT * (i-1) + end if + + ! Check for time errors + if (p % time >= p % timeMax .or. p % time < self % deltaT*(i-1)) then + call fatalError(Here, 'Particle time is not within timestep bounds') + else if (p % time /= p % time) then + call fatalError(Here, 'Particle time is NaN') end if ! Save state From 91cb1a3dbf9faf943eb90cc1d75189dd0aeddc90 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 3 Nov 2022 14:56:54 +0000 Subject: [PATCH 224/373] Changes to transport operator for consistency with other modules --- .../transportOperatorIMC_class.f90 | 24 ++++++++++--------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 4e4b87ac0..374a4ff0f 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -43,7 +43,7 @@ module transportOperatorIMC_class integer(shortInt) :: majMapN = 0 real(defReal), dimension(3) :: top = ZERO real(defReal), dimension(3) :: bottom = ZERO - integer(shortInt) :: steps + integer(shortInt) :: pSteps contains procedure :: transit => imcTracking procedure :: init @@ -102,7 +102,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Decide whether to use delta tracking or surface tracking ! Vastly different opacities make delta tracking infeasable - if(sigmaT * self % majorant_inv > self % cutoff) then + if(sigmaT * self % majorant_inv > ONE - self % cutoff) then ! Delta tracking call self % deltaTracking(p, dTime, dColl, finished) else @@ -284,7 +284,7 @@ subroutine buildMajMap(self, rand, xsData) self % matConnections = 0 ! Calculate distance increments - dist = self % deltaT * lightSpeed / self % steps + dist = self % deltaT * lightSpeed / self % pSteps do i = 1, self % majMapN @@ -293,7 +293,7 @@ subroutine buildMajMap(self, rand, xsData) matIdx = p % matIdx() ! Incrementally transport particle up to a distance dTime - do j = 1, self % steps + do j = 1, self % pSteps call self % geom % teleport(p % coords, dist) if (p % matIdx() == VOID_MAT .or. p % matIdx() == OUTSIDE_MAT) exit @@ -414,12 +414,14 @@ end subroutine simpleParticle !! cutoff 0.5; !! majMap { !! nParticles 500; - !! steps 10; + !! pSteps 10; !! } !! } !! - !! As an alternative to 'steps' can specify 'lengthScale' and then steps is calculated - !! automatically as steps = c*dt/lengthScale + !! Cutoff of 1 gives exclusively delta tracking, cutoff of 0 gives exclusively surface tracking + !! + !! As an alternative to 'pSteps' can specify 'lengthScale' and then steps is calculated + !! automatically as pSteps = c*dt/lengthScale !! subroutine init(self, dict, geom) class(transportOperatorIMC), intent(inout) :: self @@ -440,7 +442,7 @@ subroutine init(self, dict, geom) call dict % get(self % deltaT, 'deltaT') ! Get cutoff value - call dict % getOrDefault(self % cutoff, 'cutoff', 0.3_defReal) + call dict % getOrDefault(self % cutoff, 'cutoff', 0.7_defReal) ! Preparation for majorant reduction subroutine if (dict % isPresent('majMap')) then @@ -449,11 +451,11 @@ subroutine init(self, dict, geom) tempDict => dict % getDictPtr('majMap') call tempDict % get(self % majMapN, 'nParticles') - if (tempDict % isPresent('steps')) then - call tempDict % get(self % steps, 'steps') + if (tempDict % isPresent('pSteps')) then + call tempDict % get(self % pSteps, 'pSteps') else call tempDict % get(lengthScale, 'lengthScale') - self % steps = ceiling(lightSpeed*self % deltaT/lengthScale) + self % pSteps = ceiling(lightSpeed*self % deltaT/lengthScale) end if nMats = mm_nMat() From bc3a1c16c26cbe9b06b18327fb5a6250f8cc80d2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 12 Nov 2022 12:23:22 +0000 Subject: [PATCH 225/373] Made notes of a few errors that are occuring. Yet to figure out solutions, but don't seem to be having an effect on results. Just concerning that sometimes weird things happen. --- .../transportOperatorIMC_class.f90 | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 374a4ff0f..964c6621e 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -65,6 +65,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) class(particleDungeon), intent(inout) :: nextCycle real(defReal) :: sigmaT, dTime, dColl logical(defBool) :: finished + integer(shortInt) :: idx character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' finished = .false. @@ -117,6 +118,18 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) exit IMCLoop end if + ! TODO + ! Experiencing an issue where p % matIdx() returns 1 when it should be 0 (OUTSIDE_FILL) + ! self % geom % whatIsAt correctly gives 0 + ! Also a related issue, this was occurring even more frequently when bounds were set to + ! fully reflective, so no particles should even reach OUTSIDE_FILL in the first place + call self % geom % whatIsAt(idx, idx, p % coords % lvl(1) % r) + if (idx == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + exit IMCLoop + end if + ! Exit if transport is finished if (finished .eqv. .true.) exit IMCLoop @@ -154,11 +167,20 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) if (abs(p % time - p % timeMax)>0.000001) call fatalError(Here, 'Particle time is somehow incorrect') p % time = p % timeMax finished = .true. + + !TODO Called quickly when running marshakWave: + !if (p % coords % lvl(1) % r(1) < -2) call fatalError(Here, 'ERROR IN DTIME') + else if (dist == dColl) then ! Collision, increase time accordingly if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') p % time = p % time + dColl/lightSpeed finished = .true. + + !TODO Never called when running marshakWave: + !if (p % coords % lvl(1) % r(1) < -2) call fatalError(Here, 'ERROR IN DCOLL') + !TODO No idea yet why this works differently for dTime or dColl + end if end subroutine surfaceTracking From 1fa6c40cdca5f37bb90460ba658e8498c1da2f15 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 12 Nov 2022 12:24:28 +0000 Subject: [PATCH 226/373] Changed marshakWave64 to new settings, will change other input files when all is working correctly --- InputFiles/IMC/MarshakWave/marshakWave64 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 27019d6f6..9a7a341c7 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -3,8 +3,9 @@ type ISMCPhysicsPackage; pop 80; limit 1300; -cycles 10000; +steps 10000; timeStepSize 0.05; +printUpdates 8; XSdata mg; dataType mg; From 30973b84405b10a38a3041862a423d6ae113ce13 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 12 Nov 2022 14:26:08 +0000 Subject: [PATCH 227/373] Working on subroutine to reduce particle populations, unfinished but getting there --- ParticleObjects/particleDungeon_class.f90 | 70 +++++++++++++++++++---- ParticleObjects/particle_class.f90 | 12 ++++ 2 files changed, 72 insertions(+), 10 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 557d6b08d..db8f1f068 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -87,6 +87,7 @@ module particleDungeon_class procedure :: normSize procedure :: reduceSize procedure :: reduceSize2 + procedure :: reduceSize3 procedure :: combine procedure :: cleanPop procedure :: popSize @@ -431,29 +432,29 @@ end subroutine reduceSize !! !! N = max in each cell !! - subroutine reduceSize2(self, N, Nmats, geom, rand) + subroutine reduceSize2(self, N, Nmats, geom, rand, idxArray, toKeep) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: N integer(shortInt), intent(in) :: Nmats class(geometry), intent(inout) :: geom class(RNG), intent(inout) :: rand + integer(shortInt), dimension(:,:), pointer, intent(inout) :: idxArray + integer(shortInt), dimension(:), pointer, intent(inout) :: toKeep integer(shortInt) :: matIdx, pIdx, pIdx2, closeIdx, num integer(shortInt) :: i, j, j_dec, k - integer(shortInt), dimension(:,:), allocatable :: idxArray - integer(shortInt), dimension(:), allocatable :: toKeep real(defReal), dimension(3) :: r1, r2 real(defReal) :: dist, minDist character(100), parameter :: Here = 'reduceSize2 (particleDungeon_class.f90)' - allocate(idxArray(self % pop+1, Nmats)) idxArray = 0 + toKeep = 0 ! Generate array with first row as N_particles in each mat, and subsequent rows ! containing dungeon idx of each particle in that mat do i = 1, self % pop - call geom % whatIsAt(matIdx, matIdx, self % prisoners(i) % r) + !call geom % whatIsAt(matIdx, matIdx, self % prisoners(i) % r) if (self % prisoners(i) % type == P_MATERIAL) then - matIdx = matIdx-1 + matIdx = self % prisoners(i) % matIdx num = idxArray(1,matIdx) + 1 idxArray(1,matIdx) = num idxArray(num+1,matIdx) = i @@ -467,7 +468,6 @@ subroutine reduceSize2(self, N, Nmats, geom, rand) num = idxArray(1,i) if (num > N) then print *, 'Reducing mat '//numToChar(i)//' from '//numToChar(num)//' to '//numToChar(N) - allocate(toKeep(N)) ! Sample particles to keep do j = 1, N toKeep(j) = idxArray(j+1,i) @@ -491,14 +491,64 @@ subroutine reduceSize2(self, N, Nmats, geom, rand) ! Combine particle with closest particle to keep call self % combine(pIdx, closeIdx) end do - deallocate(toKeep) end if end do - deallocate(idxArray) - end subroutine reduceSize2 + + subroutine reduceSize3(self, N, Nmats, idxArray, toKeep) + class(particleDungeon), intent(inout) :: self + integer(shortInt), intent(in) :: N + integer(shortInt), intent(in) :: Nmats + integer(shortInt), dimension(:), intent(in), pointer :: idxArray + integer(shortInt) :: i, j, idxKeep, idxRemove + real(defReal), dimension(3) :: r + real(defReal) :: minDist + + + ! Store particle matIdx in array for easy access + idxArray = 0 + idxArray(1:self % pop) = self % prisoners(1:self % pop) % matIdx + + ! Only consider material particles + idxArray = idxArray * merge(1, 0, self % prisoners(1:self % pop) % type == P_MATERIAL) + + do i=1, Nmats + + ! Determine if population needs to be reduced + if (count(idxArray==i) > N) then + ! Select particles to keep + toKeep = same size as idxArray + toKeep = 0 for not in mat, 1 for keeping and 2 for removing + end if + + reduce:do + ! Exit if material population does not need to be reduced + if (count(toKeep == 2) > 0) exit reduce + + ! Select particle to be removed + idxRemove = findloc(toKeep, 2, 1) + r = self % prisoners(idxRemove) % r + + ! Find minimum distance to a particle being kept + minDist = INF + do j = 1, self % pop + if (toKeep(j) == 1) minDist = min(minDist, self % prisoners(j) % getDistance(r)) + end do + idxKeep = findloc(self % prisoners(1:self % pop), minDist, 1) + + ! Combine particles + call self % combine(idxKeep, idxRemove) + + end do reduce + + end do + + + end subroutine reduceSize3 + + !! !! Combine two particles in the dungeon, and reduce dungeon size by 1 !! diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index ffb0ab45e..cf25cf168 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -62,6 +62,7 @@ module particle_class procedure :: display => display_particleState procedure :: fromParticle => particleState_fromParticle procedure :: kill => kill_particleState + procedure :: getDistance ! Would be good to move this from particleState to particle at some point ! Private procedures procedure,private :: equal_particleState @@ -736,6 +737,17 @@ elemental subroutine kill_particleState(self) end subroutine kill_particleState + !! + !! Returns distance of a particle to a given point + !! + function getDistance(self, r) result(dist) + class(particleState), intent(inout) :: self + real(defReal), intent(in) :: r + real(defReal) :: dist + + dist = (self % r(1) - r(1))**2 + (self % r(2) - r(2))**2 + (self % r(3) - r(3))**2 + + end function getDistance !!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! Misc Procedures From 74b3471efa86b1e14f06be73728f7eb5a84d6095 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 12 Nov 2022 19:08:55 +0000 Subject: [PATCH 228/373] More work on dungeon, not yet finished --- ParticleObjects/particleDungeon_class.f90 | 39 ++++++++++++++++------- ParticleObjects/particle_class.f90 | 6 ++-- 2 files changed, 30 insertions(+), 15 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index db8f1f068..1e4b15f5c 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -496,19 +496,31 @@ subroutine reduceSize2(self, N, Nmats, geom, rand, idxArray, toKeep) end subroutine reduceSize2 - - subroutine reduceSize3(self, N, Nmats, idxArray, toKeep) + !! + !! + !! + !! Args: + !! N => Maximum number of particles in each region + !! Nmats => Number of material regions + !! emptyArray => Pointer to an array of size (2, system limit) to avoid allocating every time + !! + subroutine reduceSize3(self, N, Nmats, emptyArray) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: N integer(shortInt), intent(in) :: Nmats - integer(shortInt), dimension(:), intent(in), pointer :: idxArray + integer(shortInt), dimension(:,:), intent(in), pointer :: emptyArray + !integer(shortInt), dimension(:), intent(in), pointer :: toKeep + integer(shortInt), dimension(:), pointer :: idxArray, toKeep integer(shortInt) :: i, j, idxKeep, idxRemove real(defReal), dimension(3) :: r real(defReal) :: minDist + ! Initialise arrays and pointers + emptyArray = 0 + idxArray => emptyArray(1, 1:size(emptyArray,1)) + toKeep => emptyArray(2, 1:size(emptyArray,1)) ! Store particle matIdx in array for easy access - idxArray = 0 idxArray(1:self % pop) = self % prisoners(1:self % pop) % matIdx ! Only consider material particles @@ -517,24 +529,27 @@ subroutine reduceSize3(self, N, Nmats, idxArray, toKeep) do i=1, Nmats ! Determine if population needs to be reduced - if (count(idxArray==i) > N) then - ! Select particles to keep - toKeep = same size as idxArray - toKeep = 0 for not in mat, 1 for keeping and 2 for removing + if (count(idxArray == i) > N) then + ! Set toKeep array to be 1 for mat particles in material i and 0 otherwise + toKeep = merge(1, 0, idxArray == i) + do j=1, N + ! Select particles being kept and increase flag from 1 to 2 + toKeep(findloc(toKeep, 1, 1)) = 2 + end do end if reduce:do ! Exit if material population does not need to be reduced - if (count(toKeep == 2) > 0) exit reduce + if (count(toKeep == 1) > 0) exit reduce ! Select particle to be removed - idxRemove = findloc(toKeep, 2, 1) + idxRemove = findloc(toKeep, 1, 1) r = self % prisoners(idxRemove) % r ! Find minimum distance to a particle being kept minDist = INF - do j = 1, self % pop - if (toKeep(j) == 1) minDist = min(minDist, self % prisoners(j) % getDistance(r)) + do j=1, size(toKeep) + if (toKeep(j) == 2) minDist = min(minDist, self % prisoners(j) % getDistance(r)) end do idxKeep = findloc(self % prisoners(1:self % pop), minDist, 1) diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index cf25cf168..b34b155c0 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -741,9 +741,9 @@ end subroutine kill_particleState !! Returns distance of a particle to a given point !! function getDistance(self, r) result(dist) - class(particleState), intent(inout) :: self - real(defReal), intent(in) :: r - real(defReal) :: dist + class(particleState), intent(in) :: self + real(defReal), dimension(3), intent(in) :: r + real(defReal) :: dist dist = (self % r(1) - r(1))**2 + (self % r(2) - r(2))**2 + (self % r(3) - r(3))**2 From 1e05eec01392312d35705fb08119c7b3ad55a68d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 13 Nov 2022 13:00:37 +0000 Subject: [PATCH 229/373] More particle dungeon work --- ParticleObjects/particleDungeon_class.f90 | 96 +++++++++++++++----- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 16 ++-- 2 files changed, 80 insertions(+), 32 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 1e4b15f5c..9623d5f9f 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -1,7 +1,7 @@ module particleDungeon_class use numPrecision - use genericProcedures, only : fatalError, numToChar + use genericProcedures, only : fatalError, numToChar, linFind use particle_class, only : particle, particleState, P_MATERIAL, P_PHOTON use RNG_class, only : RNG use geometry_inter, only : geometry @@ -89,6 +89,7 @@ module particleDungeon_class procedure :: reduceSize2 procedure :: reduceSize3 procedure :: combine + procedure :: deleteParticle procedure :: cleanPop procedure :: popSize procedure :: popWeight @@ -501,24 +502,24 @@ end subroutine reduceSize2 !! !! Args: !! N => Maximum number of particles in each region - !! Nmats => Number of material regions !! emptyArray => Pointer to an array of size (2, system limit) to avoid allocating every time !! - subroutine reduceSize3(self, N, Nmats, emptyArray) - class(particleDungeon), intent(inout) :: self - integer(shortInt), intent(in) :: N - integer(shortInt), intent(in) :: Nmats + subroutine reduceSize3(self, N, emptyArray) + class(particleDungeon), intent(inout) :: self + integer(shortInt), intent(in) :: N integer(shortInt), dimension(:,:), intent(in), pointer :: emptyArray - !integer(shortInt), dimension(:), intent(in), pointer :: toKeep - integer(shortInt), dimension(:), pointer :: idxArray, toKeep - integer(shortInt) :: i, j, idxKeep, idxRemove - real(defReal), dimension(3) :: r - real(defReal) :: minDist + integer(shortInt), dimension(:), pointer :: idxArray, toKeep, toRemove + integer(shortInt) :: i, j, idx, idxKeep, idxRemove + real(defReal), dimension(3) :: r + real(defReal) :: dist, minDist + + print *, 'START OF REDUCE: ', self % pop ! Initialise arrays and pointers emptyArray = 0 - idxArray => emptyArray(1, 1:size(emptyArray,1)) - toKeep => emptyArray(2, 1:size(emptyArray,1)) + idxArray => emptyArray(1, 1:size(emptyArray,2)) + toKeep => emptyArray(2, 1:size(emptyArray,2)) + toRemove => emptyArray(3, 1:size(emptyArray,2)) ! Store particle matIdx in array for easy access idxArray(1:self % pop) = self % prisoners(1:self % pop) % matIdx @@ -526,40 +527,67 @@ subroutine reduceSize3(self, N, Nmats, emptyArray) ! Only consider material particles idxArray = idxArray * merge(1, 0, self % prisoners(1:self % pop) % type == P_MATERIAL) - do i=1, Nmats + do i=1, maxVal(idxArray) + + ! Set toKeep array to be 1 for mat particles in material i and 0 otherwise + toKeep = merge(1, 0, idxArray == i) + +! print *, 'Material:', i +! print *, 'Starting Pop:', sum(toKeep) ! Determine if population needs to be reduced - if (count(idxArray == i) > N) then - ! Set toKeep array to be 1 for mat particles in material i and 0 otherwise - toKeep = merge(1, 0, idxArray == i) + if (sum(toKeep) > N) then do j=1, N ! Select particles being kept and increase flag from 1 to 2 - toKeep(findloc(toKeep, 1, 1)) = 2 + idx = linFind(toKeep, 1) + toKeep(idx) = 2 end do + else + ! Increase flags to 2 if no reduction is necessary + toKeep = toKeep * 2 end if reduce:do ! Exit if material population does not need to be reduced - if (count(toKeep == 1) > 0) exit reduce + if (count(toKeep == 1) == 0) exit reduce ! Select particle to be removed - idxRemove = findloc(toKeep, 1, 1) + idxRemove = linFind(toKeep, 1) r = self % prisoners(idxRemove) % r ! Find minimum distance to a particle being kept minDist = INF do j=1, size(toKeep) - if (toKeep(j) == 2) minDist = min(minDist, self % prisoners(j) % getDistance(r)) + dist = self % prisoners(j) % getDistance(r) + if (toKeep(j) == 2 .and. dist < minDist) then + minDist = dist + idxKeep = j + end if end do - idxKeep = findloc(self % prisoners(1:self % pop), minDist, 1) + + !print *, 'keep: ', idxKeep, 'remove: ', idxRemove ! Combine particles call self % combine(idxKeep, idxRemove) + ! Store idxRemove for deletion later + toRemove(idxRemove) = 1 + + ! Remove from toKeep + toKeep(idxRemove) = 0 + end do reduce end do + ! Delete particles starting from highest index + do i=1, size(toRemove) + idx = size(toRemove)-i+1 + !print *, 'Pop: ', self % pop, 'Index: ', idx, 'Flag: ', toRemove(idx) + if (toRemove(idx) == 1) call self % deleteParticle(idx) + end do + + print *, 'END OF REDUCE: ', self % pop end subroutine reduceSize3 @@ -593,11 +621,31 @@ subroutine combine(self, idx1, idx2) call self % replace(p1, idx1) ! Release top particle and place at idx2 - call self % release(p3) - if (idx2 /= self % pop) call self % replace(p3, idx2) + !call self % release(p3) + !if (idx2 /= self % pop) call self % replace(p3, idx2) end subroutine combine + !! + !! Deletes particle at idx by releasing top particle and copying into position idx, + !! overwriting particle to be deleted + !! + !! Args: + !! idx => index of particle to be deleted + !! + subroutine deleteParticle(self, idx) + class(particleDungeon), intent(inout) :: self + integer(shortInt), intent(in) :: idx + type(particle) :: p + + ! Release particle at top of dungeon + call self % release(p) + + ! Copy into position of particle to be deleted + if (idx /= self % pop + 1) call self % replace(p, idx) + + end subroutine deleteParticle + !! !! Kill or particles in the dungeon !! diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 238e8a0fb..0999a9332 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -94,6 +94,7 @@ module ISMCPhysicsPackage_class ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed class(source), allocatable :: inputSource class(source), allocatable :: ISMCSource + integer(shortInt), dimension(:,:), pointer :: emptyArray => null() ! Timer bins integer(shortInt) :: timerMain @@ -191,13 +192,10 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Generate from input source if( self % sourceGiven ) then - ! Reduce size of dungeon if dungeon will overflow - !if( self % thisStep % popSize() + self % pop > self % limit) then - ! call self % thisStep % reduceSize2(self % limit - self % pop, self % nMat, self % geom, p % pRNG) - !end if - - !call self % thisStep % reduceSize2(self % limit, self % nMat, self % geom, p % pRNG) + ! Limit number of particles in each zone + !call self % thisStep % reduceSize3(self % limit, self % emptyArray) + ! Generate new particles call self % inputSource % append(self % thisStep, self % pop, p % pRNG) end if @@ -510,9 +508,11 @@ subroutine init(self, dict) ! Size particle dungeon allocate(self % thisStep) - call self % thisStep % init(self % limit * self % nMat) + call self % thisStep % init(self % limit * self % nMat *2) allocate(self % nextStep) - call self % nextStep % init(self % limit * self % nMat) + call self % nextStep % init(self % limit * self % nMat *2) + + allocate(self % emptyArray(3, self % limit * self % nMat * 2)) call self % printSettings() From 985d5edcee52703b5e5f9683b35e6032fca28c59 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 13 Nov 2022 13:15:29 +0000 Subject: [PATCH 230/373] Changed names of subroutines --- ParticleObjects/particleDungeon_class.f90 | 14 ++++++-------- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 2 +- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 9623d5f9f..cb47df473 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -86,8 +86,6 @@ module particleDungeon_class procedure :: normWeight procedure :: normSize procedure :: reduceSize - procedure :: reduceSize2 - procedure :: reduceSize3 procedure :: combine procedure :: deleteParticle procedure :: cleanPop @@ -364,7 +362,7 @@ end subroutine normSize !! Finding the nearest particle would be better but much more computationally intensive, !! may be doable in parallel !! - subroutine reduceSize(self, N, rand) + subroutine reduceSizeOLD(self, N, rand) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand @@ -428,12 +426,12 @@ subroutine reduceSize(self, N, rand) end do reduce - end subroutine reduceSize + end subroutine reduceSizeOLD !! !! N = max in each cell !! - subroutine reduceSize2(self, N, Nmats, geom, rand, idxArray, toKeep) + subroutine reduceSizeOLD2(self, N, Nmats, geom, rand, idxArray, toKeep) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: N integer(shortInt), intent(in) :: Nmats @@ -495,7 +493,7 @@ subroutine reduceSize2(self, N, Nmats, geom, rand, idxArray, toKeep) end if end do - end subroutine reduceSize2 + end subroutine reduceSizeOLD2 !! !! @@ -504,7 +502,7 @@ end subroutine reduceSize2 !! N => Maximum number of particles in each region !! emptyArray => Pointer to an array of size (2, system limit) to avoid allocating every time !! - subroutine reduceSize3(self, N, emptyArray) + subroutine reduceSize(self, N, emptyArray) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: N integer(shortInt), dimension(:,:), intent(in), pointer :: emptyArray @@ -589,7 +587,7 @@ subroutine reduceSize3(self, N, emptyArray) print *, 'END OF REDUCE: ', self % pop - end subroutine reduceSize3 + end subroutine reduceSize !! diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 0999a9332..8aea9ba8d 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -193,7 +193,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) if( self % sourceGiven ) then ! Limit number of particles in each zone - !call self % thisStep % reduceSize3(self % limit, self % emptyArray) + !call self % thisStep % reduceSize(self % limit, self % emptyArray) ! Generate new particles call self % inputSource % append(self % thisStep, self % pop, p % pRNG) From 878854670d4276c96f3aebd40ae554f2db6bcbd1 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 13 Nov 2022 14:02:07 +0000 Subject: [PATCH 231/373] Temporary fix to a very weird issue, not yet sure of the cause --- TransportOperator/transportOperatorTimeHT_class.f90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index e0bbda447..f32227c5c 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -87,6 +87,18 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) exit trackingLoop end if + ! TODO + ! Experiencing an issue where p % matIdx() returns 1 when it should be 0 (OUTSIDE_FILL) + ! self % geom % whatIsAt correctly gives 0 + ! Also a related issue, this was occurring even more frequently when bounds were set to + ! fully reflective, so no particles should even reach OUTSIDE_FILL in the first place + call self % geom % whatIsAt(matIdx, matIdx, p % coords % lvl(1) % r) + if (matIdx == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + exit trackingLoop + end if + ! Exit if transport is finished if (finished .eqv. .true.) exit trackingLoop From 69814ae9d86049c42f5558401aa3c16d6e3961f8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 14 Nov 2022 12:04:47 +0000 Subject: [PATCH 232/373] Added option to specifiy how many material updates are printed --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 8aea9ba8d..6d0c6b6a7 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -84,6 +84,7 @@ module ISMCPhysicsPackage_class integer(shortInt) :: imcSourceN logical(defBool) :: sourceGiven = .false. integer(shortInt) :: nMat + integer(shortint) :: printUpdates ! Calculation components type(particleDungeon), pointer :: thisStep => null() @@ -141,19 +142,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) real(defReal) :: elapsed_T, end_T, T_toEnd real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat - logical(defBool) :: printUpdates character(100),parameter :: Here ='steps (ISMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes - ! Set whether or not to print energy and temperature updates of each material - ! Printed from updateMat (baseMgIMCMaterial_class.f90), 7 lines of text - ! per material so recommend to only print when low number of materials - if (self % nMat <= 8) then - printUpdates = .True. - else - printUpdates = .False. - end if - ! Attach nuclear data and RNG to particle p % pRNG => self % pRNG p % geomIdx = self % geomIdx @@ -314,11 +305,13 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Update material properties do j = 1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - if (printUpdates .eqv. .True.) then + if (j <= self % printUpdates) then print * print *, "Material update: ", mm_matName(j) + call mat % updateMat(tallyEnergy(j), .true.) + else + call mat % updateMat(tallyEnergy(j), .false.) end if - call mat % updateMat(tallyEnergy(j), printUpdates) end do print * @@ -398,6 +391,7 @@ subroutine init(self, dict) call dict % getOrDefault( self % limit, 'limit', self % pop) call dict % get( self % N_steps,'steps') call dict % get( self % deltaT,'timeStepSize') + call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) self % particleType = P_PHOTON_MG nucData = 'mg' From 11d8436e9d2818faa383b60aad30d95f803d69b0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 14 Nov 2022 18:44:26 +0000 Subject: [PATCH 233/373] Removed incorrect line that was throwing off particle times and giving wrong results --- TransportOperator/transportOperatorIMC_class.f90 | 3 +-- TransportOperator/transportOperatorTimeHT_class.f90 | 1 - 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 964c6621e..f76d84aa5 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -174,7 +174,6 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) else if (dist == dColl) then ! Collision, increase time accordingly if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') - p % time = p % time + dColl/lightSpeed finished = .true. !TODO Never called when running marshakWave: @@ -255,7 +254,7 @@ subroutine materialTransform(self, p, tally) ! Sample time to transform into radiation photon p % time = p % time - log(p % pRNG % get()) / (sigmaT*fleck*eta*lightSpeed) - ! Deal with eta = 0 + ! Deal with eta = 0 causing NaN if (p % time /= p % time) p % time = INF ! Exit loop if particle remains material until end of time step diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 9fc975a21..3d2223e54 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -130,7 +130,6 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) else if (dist == dColl) then ! Collision, increase time accordingly if (event /= COLL_EV) call fatalError(Here, 'Moving dColl should result in COLL_EV') - p % time = p % time + dColl / p % getSpeed() finished = .true. end if From e8e6f2dd46ae9aaa6cf0cc6fb8ef338fad4b668f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 14 Nov 2022 18:45:54 +0000 Subject: [PATCH 234/373] Removed duplicated line that was increasing particle time too much and giving wrong results --- TransportOperator/transportOperatorTimeHT_class.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index f32227c5c..e35376d93 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -139,7 +139,6 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) else if (dist == dColl) then ! Collision, increase time accordingly if (event /= COLL_EV) call fatalError(Here, 'Moving dColl should result in COLL_EV') - p % time = p % time + dColl / p % getSpeed() finished = .true. end if From 736c89203ad893342269d90f77dfa2d6148efabf Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 11:40:18 +0000 Subject: [PATCH 235/373] Deleted old code, added comments and docs, moved getDistance from particle_class to genericProcedures --- ParticleObjects/particleDungeon_class.f90 | 232 +++++----------------- ParticleObjects/particle_class.f90 | 13 -- SharedModules/genericProcedures.f90 | 12 ++ 3 files changed, 65 insertions(+), 192 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index cb47df473..5784169d1 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -1,7 +1,7 @@ module particleDungeon_class use numPrecision - use genericProcedures, only : fatalError, numToChar, linFind + use genericProcedures, only : fatalError, numToChar, linFind, getDistance use particle_class, only : particle, particleState, P_MATERIAL, P_PHOTON use RNG_class, only : RNG use geometry_inter, only : geometry @@ -35,7 +35,7 @@ module particleDungeon_class !! !! INTERFACE: !! Stack-like interface: - !! detain(particle) -> adda a particle to the top + !! detain(particle) -> add a a particle to the top !! release(particle) -> removes a particle from the top. Sets p % isDead = .false. !! !! Array-like interface: @@ -44,20 +44,25 @@ module particleDungeon_class !! get(i) -> function returns particle state at index i !! !! Misc procedures: - !! isEmpty() -> returns .true. if there are no more particles - !! cleanPop() -> kill or prisoners - !! normWeight(totWgt)-> normalise dungeon population so its total weight is totWgt - !! normSize(N) -> normalise dungeon population so it contains N particles - !! does not take ununiform weight of particles into account - !! setSize(n) -> sizes dungeon to have n dummy particles for ease of overwriting - !! printToFile(name) -> prints population in ASCII format to file "name" + !! isEmpty() -> returns .true. if there are no more particles + !! cleanPop() -> kill or prisoners + !! normWeight(totWgt) -> normalise dungeon population so its total weight is totWgt + !! normSize(N) -> normalise dungeon population so it contains N particles + !! does not take nonuniform weight of particles into account + !! reduceSize(N,arr) -> reduce size of dungeon by combining particles such that a max of + !! N particles are present in each material + !! combine(idx1,idx2) -> combine 2 particles by summing their weight and moving to a weight- + !! averaged position + !! deleteParticle(idx) -> deletes particle at idx and reduces dungeon size by 1 + !! setSize(n) -> sizes dungeon to have n dummy particles for ease of overwriting + !! printToFile(name) -> prints population in ASCII format to file "name" !! printToScreen(prop,nMax,total) -> prints property to screen for up to nMax particles - !! popSize() -> returns number of particles in dungeon - !! popWeight() -> returns total population weight + !! popSize() -> returns number of particles in dungeon + !! popWeight() -> returns total population weight !! !! Build procedures: - !! init(maxSize) -> allocate space to store maximum of maxSize particles - !! kill() -> return to uninitialised state + !! init(maxSize) -> allocate space to store maximum of maxSize particles + !! kill() -> return to uninitialised state !! type, public :: particleDungeon private @@ -352,166 +357,27 @@ subroutine normSize(self,N,rand) end subroutine normSize !! - !! Reduce size of particle dungeon to a size N, while maintaining total weight - !! and reducing teleportation error - !! - !! Rather than simply calling normSize(N) followed by normWeight(prevWeight), this - !! subroutine combines 2 random particles of the same type into a single particle, - !! with a new position based on a weighted average of the previous positions - !! - !! Finding the nearest particle would be better but much more computationally intensive, - !! may be doable in parallel - !! - subroutine reduceSizeOLD(self, N, rand) - class(particleDungeon), intent(inout) :: self - integer(shortInt), intent(in) :: N - class(RNG), intent(inout) :: rand - integer(shortInt) :: randIdx1, randIdx2, loops, loops2 - type(particle) :: p1, p2, p3 - real(defReal), dimension(3) :: rNew, r1, r2, r12 - real(defReal) :: dist - character(100), parameter :: Here ='reduceSize (particleDungeon_class.f90)' - - print *, "REDUCE", self % pop, N - - ! Protect against invalid N - if(N > self % pop) then - call fatalError(Here,'Requested size: '//numToChar(N) //& - 'is greather then max size: '//numToChar(size(self % prisoners))) - else if (N <= 0) then - call fatalError(Here,'Requested size: '//numToChar(N) //' is not +ve') - end if - - ! Protect against infinite loop - loops = 0 - - reduce:do - - loops = loops + 1 - if(loops >= 50*self % pop) call fatalError(Here, 'Potentially infinite loop') - - ! Obtain random particles from dungeon - randIdx1 = ceiling(rand % get() * self % pop) - call self % copy(p1, randIdx1) - r1 = p1 % rGlobal() - - ! Obtain random particle of the same type - loops2 = 0 - sample:do - randIdx2 = ceiling(rand % get() * self % pop) - if (randIdx2 == randIdx1 .or. randIdx2 == self % pop) cycle sample - call self % copy(p2, randIdx2) - r2 = p2 % rGlobal() - r12 = r2 - r1 - dist = sqrt(r12(1)**2 + r12(2)**2 + r12(3)**2) - if (p2 % type == p1 % type .and. dist <= 0.2 .and. r1(1) <= 0.5) exit sample - ! If too many failed samples, resample p1 - if (loops2 >= 0.5*self % pop) cycle reduce - loops2 = loops2 + 1 - end do sample - - ! Combine positions and weights - rNew = (r1*p1 % w + r2*p2 % w) / (p1 % w + p2 % w) - call p1 % teleport(rNew) - p1 % w = p1 % w + p2 % w - call self % replace(p1, randIdx1) - - ! Overwrite p2 and reduce size - call self % release(p3) - call self % replace(p3, randIdx2) - - if(self % pop == N) exit reduce - - if(self % pop < N) call fatalError(Here, 'Uh oh, dungeon size somehow went below target') - - end do reduce - - end subroutine reduceSizeOLD - - !! - !! N = max in each cell - !! - subroutine reduceSizeOLD2(self, N, Nmats, geom, rand, idxArray, toKeep) - class(particleDungeon), intent(inout) :: self - integer(shortInt), intent(in) :: N - integer(shortInt), intent(in) :: Nmats - class(geometry), intent(inout) :: geom - class(RNG), intent(inout) :: rand - integer(shortInt), dimension(:,:), pointer, intent(inout) :: idxArray - integer(shortInt), dimension(:), pointer, intent(inout) :: toKeep - integer(shortInt) :: matIdx, pIdx, pIdx2, closeIdx, num - integer(shortInt) :: i, j, j_dec, k - real(defReal), dimension(3) :: r1, r2 - real(defReal) :: dist, minDist - character(100), parameter :: Here = 'reduceSize2 (particleDungeon_class.f90)' - - idxArray = 0 - toKeep = 0 - - ! Generate array with first row as N_particles in each mat, and subsequent rows - ! containing dungeon idx of each particle in that mat - do i = 1, self % pop - !call geom % whatIsAt(matIdx, matIdx, self % prisoners(i) % r) - if (self % prisoners(i) % type == P_MATERIAL) then - matIdx = self % prisoners(i) % matIdx - num = idxArray(1,matIdx) + 1 - idxArray(1,matIdx) = num - idxArray(num+1,matIdx) = i - else if (self % prisoners(i) % type /= P_PHOTON) then - call fatalError(Here,'Incorrect particle type') - end if - end do - - ! Determine which mats need populations reduced - do i = 1, Nmats - num = idxArray(1,i) - if (num > N) then - print *, 'Reducing mat '//numToChar(i)//' from '//numToChar(num)//' to '//numToChar(N) - ! Sample particles to keep - do j = 1, N - toKeep(j) = idxArray(j+1,i) - end do - ! Loop through particles to be removed - do j = N+1, num - j_dec = num-j+N+1 - pIdx = idxArray(j_dec+1,i) - r1 = self % prisoners(pIdx) % r - ! Find closest particle in particles to keep - minDist = INF - do k = 1, N - pIdx2 = toKeep(k) - r2 = self % prisoners(pIdx2) % r - r1 - dist = sqrt(r2(1)**2 + r2(2)**2 + r2(3)**2) - if (dist < minDist) then - minDist = dist - closeIdx = pIdx2 - end if - end do - ! Combine particle with closest particle to keep - call self % combine(pIdx, closeIdx) - end do - end if - end do - - end subroutine reduceSizeOLD2 - - !! - !! + !! Combines particles such that the max population in any region is N, based on algorithm + !! proposed by Elad Steinberg and Shay I. Heizler, A New Discrete Implicit Monte Carlo Scheme + !! for Simulating Radiative Transfer Problems (2022). Currently chooses particles to keep as the + !! first ones found, Steinberg and Heizler suggest choosing using a weighted-probability, can be + !! improved to do this in the future if necessary. !! !! Args: - !! N => Maximum number of particles in each region - !! emptyArray => Pointer to an array of size (2, system limit) to avoid allocating every time + !! N [in] -> Maximum number of particles in each region + !! emptyArray [in] -> Pointer to array of size (3, system limit) to avoid allocating every time !! subroutine reduceSize(self, N, emptyArray) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: N integer(shortInt), dimension(:,:), intent(in), pointer :: emptyArray integer(shortInt), dimension(:), pointer :: idxArray, toKeep, toRemove - integer(shortInt) :: i, j, idx, idxKeep, idxRemove + integer(shortInt) :: i, j, idx, idxKeep, idxRemove, pop real(defReal), dimension(3) :: r real(defReal) :: dist, minDist - print *, 'START OF REDUCE: ', self % pop + ! Store initial population + pop = self % pop ! Initialise arrays and pointers emptyArray = 0 @@ -527,12 +393,14 @@ subroutine reduceSize(self, N, emptyArray) do i=1, maxVal(idxArray) + ! Manipulate toKeep to be as follows: + ! 0 -> Either not in material i, or not of type P_MATERIAL + ! 1 -> In material i, P_MATERIAL, to be removed + ! 2 -> In material i, P_MATERIAL, to be kept + ! Set toKeep array to be 1 for mat particles in material i and 0 otherwise toKeep = merge(1, 0, idxArray == i) -! print *, 'Material:', i -! print *, 'Starting Pop:', sum(toKeep) - ! Determine if population needs to be reduced if (sum(toKeep) > N) then do j=1, N @@ -556,15 +424,15 @@ subroutine reduceSize(self, N, emptyArray) ! Find minimum distance to a particle being kept minDist = INF do j=1, size(toKeep) - dist = self % prisoners(j) % getDistance(r) - if (toKeep(j) == 2 .and. dist < minDist) then + if (toKeep(j) == 2) then + dist = getDistance(r, self % prisoners(j) % r) + if (dist < minDist) then minDist = dist idxKeep = j + end if end if end do - !print *, 'keep: ', idxKeep, 'remove: ', idxRemove - ! Combine particles call self % combine(idxKeep, idxRemove) @@ -581,21 +449,31 @@ subroutine reduceSize(self, N, emptyArray) ! Delete particles starting from highest index do i=1, size(toRemove) idx = size(toRemove)-i+1 - !print *, 'Pop: ', self % pop, 'Index: ', idx, 'Flag: ', toRemove(idx) if (toRemove(idx) == 1) call self % deleteParticle(idx) end do - print *, 'END OF REDUCE: ', self % pop + ! Print reduction + if (self % pop /= pop) then + print * + print *, 'Reduced dungeon size from '//numToChar(pop)//' to '//numToChar(self % pop) + print * + end if end subroutine reduceSize !! - !! Combine two particles in the dungeon, and reduce dungeon size by 1 + !! Combine two particles in the dungeon by summing their weight and moving to a weighted- + !! average position. Direction is unchanged. !! - !! Particle at idx1 remains, and is moved to a position that is the energy-weighted average + !! Particle at idx1 is moved to a position that is the energy-weighted average !! of the two original positions. Its new energy is the sum of the two original energies. - !! To reduce dungeon size, particle at position self % pop is copied into position idx2. + !! + !! Particle at idx2 remains unchanged. To delete, call self % deleteParticle(idx2) afterwards. + !! + !! Args: + !! idx1 [in] -> Index of 1st particle, will be overridden + !! idx2 [in] -> Index of 2nd particle, will be kept unchanged !! subroutine combine(self, idx1, idx2) class(particleDungeon), intent(inout) :: self @@ -618,10 +496,6 @@ subroutine combine(self, idx1, idx2) p1 % w = p1 % w + p2 % w call self % replace(p1, idx1) - ! Release top particle and place at idx2 - !call self % release(p3) - !if (idx2 /= self % pop) call self % replace(p3, idx2) - end subroutine combine !! @@ -629,7 +503,7 @@ end subroutine combine !! overwriting particle to be deleted !! !! Args: - !! idx => index of particle to be deleted + !! idx [in] -> index of particle to be deleted !! subroutine deleteParticle(self, idx) class(particleDungeon), intent(inout) :: self diff --git a/ParticleObjects/particle_class.f90 b/ParticleObjects/particle_class.f90 index b34b155c0..abb6572fb 100644 --- a/ParticleObjects/particle_class.f90 +++ b/ParticleObjects/particle_class.f90 @@ -62,7 +62,6 @@ module particle_class procedure :: display => display_particleState procedure :: fromParticle => particleState_fromParticle procedure :: kill => kill_particleState - procedure :: getDistance ! Would be good to move this from particleState to particle at some point ! Private procedures procedure,private :: equal_particleState @@ -737,18 +736,6 @@ elemental subroutine kill_particleState(self) end subroutine kill_particleState - !! - !! Returns distance of a particle to a given point - !! - function getDistance(self, r) result(dist) - class(particleState), intent(in) :: self - real(defReal), dimension(3), intent(in) :: r - real(defReal) :: dist - - dist = (self % r(1) - r(1))**2 + (self % r(2) - r(2))**2 + (self % r(3) - r(3))**2 - - end function getDistance - !!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! Misc Procedures !!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> diff --git a/SharedModules/genericProcedures.f90 b/SharedModules/genericProcedures.f90 index ce1ccfca4..e1fea0496 100644 --- a/SharedModules/genericProcedures.f90 +++ b/SharedModules/genericProcedures.f90 @@ -1501,4 +1501,16 @@ subroutine printFishLineR(offset) end subroutine printFishLineR + !! + !! Returns the euclidean distance between two 3D points + !! + function getDistance(r1, r2) result(dist) + real(defReal), dimension(3), intent(in) :: r1 + real(defReal), dimension(3), intent(in) :: r2 + real(defReal) :: dist + + dist = (r2(1) - r1(1))**2 + (r2(2) - r1(2))**2 + (r2(3) - r1(3))**2 + + end function getDistance + end module genericProcedures From d04b9b4f22a91fd1efd77d6db60e5b262c1ca1f6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 11:42:28 +0000 Subject: [PATCH 236/373] Reduces size accordingly, and added new error for particle times --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 6d0c6b6a7..d20c0c763 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -184,7 +184,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) if( self % sourceGiven ) then ! Limit number of particles in each zone - !call self % thisStep % reduceSize(self % limit, self % emptyArray) + call self % thisStep % reduceSize(self % limit, self % emptyArray) ! Generate new particles call self % inputSource % append(self % thisStep, self % pop, p % pRNG) @@ -214,7 +214,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) end if ! For newly sourced particles, sample time uniformly within time step - if (p % time == ZERO) then + if (p % time /= ZERO .and. p % time /= self % deltaT*(i-1)) then + call fatalError(Here, 'Particle released from dungeon has incorrect time') + else if (p % time == ZERO) then p % time = (p % pRNG % get() + i-1) * self % deltaT end if From 3c32fdcc043b5c81899a577f6d60b5a54a1a74b6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 12:07:29 +0000 Subject: [PATCH 237/373] Removed notes about an error that were caused by previously duplicated line for increasing particle time --- TransportOperator/transportOperatorIMC_class.f90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index f76d84aa5..918f15b1a 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -168,18 +168,10 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) p % time = p % timeMax finished = .true. - !TODO Called quickly when running marshakWave: - !if (p % coords % lvl(1) % r(1) < -2) call fatalError(Here, 'ERROR IN DTIME') - else if (dist == dColl) then ! Collision, increase time accordingly if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') finished = .true. - - !TODO Never called when running marshakWave: - !if (p % coords % lvl(1) % r(1) < -2) call fatalError(Here, 'ERROR IN DCOLL') - !TODO No idea yet why this works differently for dTime or dColl - end if end subroutine surfaceTracking From 1b8a5f8bc9866819dbeca3f34938a1e278c158eb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 14:39:53 +0000 Subject: [PATCH 238/373] Changed TIME_FATE to AGED_FATE --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 2 +- TransportOperator/transportOperatorIMC_class.f90 | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index d20c0c763..c8fe51abf 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -236,7 +236,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) call self % transOp % transport(p, tally, self % thisStep, self % nextStep) if(p % fate == LEAK_FATE) exit history - if(p % fate == TIME_FATE) then + if(p % fate == AGED_FATE) then if(p % type == P_PHOTON) then matIdx = p % matIdx() Np(matIdx) = Np(matIdx) + 1 diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 918f15b1a..63c0c1e2b 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -73,7 +73,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Deal with material particles, only relevant for ISMC if(p % getType() == P_MATERIAL_MG) then call self % materialTransform(p, tally) - if(p % fate == TIME_FATE) return + if(p % fate == AGED_FATE) return end if ! Get majorant for particle @@ -163,7 +163,7 @@ subroutine surfaceTracking(self, p, dTime, dColl, finished) if (dist == dTime) then ! Time boundary if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') - p % fate = TIME_FATE + p % fate = AGED_FATE if (abs(p % time - p % timeMax)>0.000001) call fatalError(Here, 'Particle time is somehow incorrect') p % time = p % timeMax finished = .true. @@ -196,7 +196,7 @@ subroutine deltaTracking(self, p, dTime, dColl, finished) else ! Move particle to end of time step location call self % geom % teleport(p % coords, dTime) - p % fate = TIME_FATE + p % fate = AGED_FATE p % time = p % timeMax finished = .true. return @@ -251,7 +251,7 @@ subroutine materialTransform(self, p, tally) ! Exit loop if particle remains material until end of time step if (p % time >= p % timeMax) then - p % fate = TIME_FATE + p % fate = AGED_FATE p % time = p % timeMax ! Tally energy for next temperature calculation call tally % reportHist(p) @@ -285,7 +285,6 @@ subroutine buildMajMap(self, rand, xsData) type(particle) :: p integer(shortInt) :: i, j, matIdx real(defReal) :: mu, phi, dist - logical(defBool) :: finished = .false. ! Check that subroutine should be called if (.not. allocated(self % matMajs)) return From dcfd46e0856ffd0da43fa963b4203925e804b5be Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 17:57:40 +0000 Subject: [PATCH 239/373] Changed a lot. Had made a mistake where DT was using sigmaLocal instead of sigmaMaj for calculating distance, so fixed that. But there were a lot of weird issues going on and I couldn't quite figure out why. Changed the loops to be inside DT and ST subroutines, rather than in the selection subroutine, and this seems to have solved all problems. Must have been missing something simple when I was reselecting the tracking type multiple times for the same particle that caused problems. MajMap now not working properly, need to investigate. --- .../transportOperatorIMC_class.f90 | 191 +++++++++--------- 1 file changed, 93 insertions(+), 98 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 63c0c1e2b..58e08417c 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -64,12 +64,9 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) class(particleDungeon), intent(inout) :: thisCycle class(particleDungeon), intent(inout) :: nextCycle real(defReal) :: sigmaT, dTime, dColl - logical(defBool) :: finished - integer(shortInt) :: idx + integer(shortInt) :: idx, uniqueId character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' - finished = .false. - ! Deal with material particles, only relevant for ISMC if(p % getType() == P_MATERIAL_MG) then call self % materialTransform(p, tally) @@ -83,57 +80,32 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) self % majorant_inv = ONE / self % xsData % getMajorantXS(p) end if - IMCLoop:do - - ! Check for errors - if (p % getType() /= P_PHOTON_MG) call fatalError(Here, 'Particle is not MG Photon') - if (p % time /= p % time) call fatalError(Here, 'Particle time is NaN') - - ! Obtain sigmaT - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - - if (sigmaT*self % majorant_inv > 1) call fatalError(Here, 'Sigma greater than majorant.& - & MajorantMap settings may have been chosen poorly.') - - ! Find distance to time boundary - dTime = lightSpeed * (p % timeMax - p % time) - - ! Sample distance to move particle before collision - dColl = -log( p % pRNG % get() ) / sigmaT + ! Check for errors + if (p % getType() /= P_PHOTON_MG) call fatalError(Here, 'Particle is not MG Photon') + if (p % time /= p % time) call fatalError(Here, 'Particle time is NaN') - ! Decide whether to use delta tracking or surface tracking - ! Vastly different opacities make delta tracking infeasable - if(sigmaT * self % majorant_inv > ONE - self % cutoff) then - ! Delta tracking - call self % deltaTracking(p, dTime, dColl, finished) - else - ! Surface tracking - call self % surfaceTracking(p, dTime, dColl, finished) - end if - - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) then - p % fate = LEAK_FATE - p % isDead = .true. - exit IMCLoop - end if + ! Obtain sigmaT + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - ! TODO - ! Experiencing an issue where p % matIdx() returns 1 when it should be 0 (OUTSIDE_FILL) - ! self % geom % whatIsAt correctly gives 0 - ! Also a related issue, this was occurring even more frequently when bounds were set to - ! fully reflective, so no particles should even reach OUTSIDE_FILL in the first place - call self % geom % whatIsAt(idx, idx, p % coords % lvl(1) % r) - if (idx == OUTSIDE_FILL) then - p % fate = LEAK_FATE - p % isDead = .true. - exit IMCLoop - end if + if (sigmaT*self % majorant_inv > 1) call fatalError(Here, 'Sigma greater than majorant.& + & MajorantMap settings may have been chosen poorly.') - ! Exit if transport is finished - if (finished .eqv. .true.) exit IMCLoop + ! Decide whether to use delta tracking or surface tracking + ! Vastly different opacities make delta tracking infeasable + if(sigmaT * self % majorant_inv >= ONE - self % cutoff) then + ! Delta tracking + call self % deltaTracking(p) + else + ! Surface tracking + call self % surfaceTracking(p) + end if - end do IMCLoop + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + return + end if call tally % reportTrans(p) @@ -142,79 +114,102 @@ end subroutine imcTracking !! !! Perform surface tracking !! - subroutine surfaceTracking(self, p, dTime, dColl, finished) + subroutine surfaceTracking(self, p) class(transportOperatorIMC), intent(inout) :: self class(particle), intent(inout) :: p - real(defReal), intent(in) :: dTime - real(defReal), intent(in) :: dColl - logical(defBool), intent(inout) :: finished - real(defReal) :: dist + real(defReal) :: dTime + real(defReal) :: dColl + real(defReal) :: dist, sigmaT integer(shortInt) :: event character(100), parameter :: Here = 'surfaceTracking (transportOperatorIMC_class.f90)' - dist = min(dTime, dColl) + STLoop:do - ! Move through geometry using minimum distance - call self % geom % move(p % coords, dist, event) + ! Find distance to time boundary + dTime = lightSpeed * (p % timeMax - p % time) - p % time = p % time + dist / lightSpeed + ! Sample distance to collision + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + dColl = -log( p % pRNG % get() ) / sigmaT - ! Check result of transport - if (dist == dTime) then - ! Time boundary - if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') - p % fate = AGED_FATE - if (abs(p % time - p % timeMax)>0.000001) call fatalError(Here, 'Particle time is somehow incorrect') - p % time = p % timeMax - finished = .true. + ! Choose minimum distance + dist = min(dTime, dColl) - else if (dist == dColl) then - ! Collision, increase time accordingly - if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') - finished = .true. - end if + ! Move through geometry using minimum distance + call self % geom % move(p % coords, dist, event) + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return + + ! Increase time based on distance moved + p % time = p % time + dist / lightSpeed + + ! Check result of transport + if (dist == dTime) then + ! Time boundary + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') + p % fate = AGED_FATE + if (abs(p % time - p % timeMax)>0.000001) call fatalError(Here, 'Particle time is somehow incorrect') + p % time = p % timeMax + exit STLoop + + else if (dist == dColl) then + ! Collision, increase time accordingly + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV after moving dTime') + exit STLoop + + end if + + end do STLoop end subroutine surfaceTracking !! !! Perform delta tracking !! - subroutine deltaTracking(self, p, dTime, dColl, finished) + subroutine deltaTracking(self, p) class(transportOperatorIMC), intent(inout) :: self class(particle), intent(inout) :: p - real(defReal), intent(in) :: dTime - real(defReal), intent(in) :: dColl - logical(defBool), intent(inout) :: finished + real(defReal) :: dTime + real(defReal) :: dColl real(defReal) :: sigmaT character(100), parameter :: Here = 'deltaTracking (transportOperatorIMC_class.f90)' - ! Determine which distance to move particle - if (dColl < dTime) then - ! Move partice to potential collision location + DTLoop:do + + ! Find distance to time boundary + dTime = lightSpeed * (p % timeMax - p % time) + + ! Sample distance to collision + dColl = -log( p % pRNG % get() ) * self % majorant_inv + + ! If dTime < dColl, move to end of time step location + if (dTime < dColl) then + call self % geom % teleport(p % coords, dColl) + p % fate = AGED_FATE + p % time = p % timeMax + exit DTLoop + end if + + ! Otherwise, move to potential collision location call self % geom % teleport(p % coords, dColl) p % time = p % time + dColl / lightSpeed - else - ! Move particle to end of time step location - call self % geom % teleport(p % coords, dTime) - p % fate = AGED_FATE - p % time = p % timeMax - finished = .true. - return - end if - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) return + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return - ! Obtain local cross-section - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + ! Obtain local cross-section + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Roll RNG to determine if the collision is real or virtual + ! Exit the loop if the collision is real + if (p % pRNG % get() < sigmaT * self % majorant_inv) exit DTLoop - ! Roll RNG to determine if the collision is real or virtual - ! Exit the loop if the collision is real - if (p % pRNG % get() < sigmaT * self % majorant_inv) finished = .true. + ! Protect against infinite loop + if (sigmaT * self % majorant_inv == 0) call fatalError(Here, '100 % virtual collision chance,& + & potentially infinite loop') - ! Protect against infinite loop - if (sigmaT * self % majorant_inv == 0) call fatalError(Here, '100 % virtual collision chance,& - & potentially infinite loop') + end do DTLoop end subroutine deltaTracking From dad5b42678daf4554c78dd154d623cb50a84293a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 18:22:58 +0000 Subject: [PATCH 240/373] Same changes as in ISMC branch. Fixed a few things and then moved loops into ST and DT subroutines, instead of in selection subroutine, which fixed a lot of weird issues. --- .../transportOperatorTimeHT_class.f90 | 198 +++++++++--------- 1 file changed, 95 insertions(+), 103 deletions(-) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index e35376d93..184e27d1e 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -46,63 +46,33 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) type(tallyAdmin), intent(inout) :: tally class(particleDungeon), intent(inout) :: thisCycle class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: sigmaT, dTime, dColl - logical(defBool) :: finished - integer(shortInt) :: matIdx + real(defReal) :: sigmaT character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' - finished = .false. - ! Get majorant XS inverse: 1/Sigma_majorant self % majorant_inv = ONE / self % xsData % getMajorantXS(p) - trackingLoop:do - - ! Check for errors - if (p % time /= p % time) call fatalError(Here, 'Particle time is NaN') - - ! Obtain sigmaT - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - - ! Find distance to time boundary - dTime = p % getSpeed() * (p % timeMax - p % time) - - ! Sample distance to move particle before collision - dColl = -log( p % pRNG % get() ) / sigmaT - - ! Decide whether to use delta tracking or surface tracking - ! Vastly different opacities make delta tracking infeasable - if(sigmaT * self % majorant_inv > ONE - self % cutoff) then - ! Delta tracking - call self % deltaTracking(p, dTime, dColl, finished) - else - ! Surface tracking - call self % surfaceTracking(p, dTime, dColl, finished) - end if - - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) then - p % fate = LEAK_FATE - p % isDead = .true. - exit trackingLoop - end if + ! Check for errors + if (p % time /= p % time) call fatalError(Here, 'Particle time is NaN') - ! TODO - ! Experiencing an issue where p % matIdx() returns 1 when it should be 0 (OUTSIDE_FILL) - ! self % geom % whatIsAt correctly gives 0 - ! Also a related issue, this was occurring even more frequently when bounds were set to - ! fully reflective, so no particles should even reach OUTSIDE_FILL in the first place - call self % geom % whatIsAt(matIdx, matIdx, p % coords % lvl(1) % r) - if (matIdx == OUTSIDE_FILL) then - p % fate = LEAK_FATE - p % isDead = .true. - exit trackingLoop - end if + ! Obtain sigmaT + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - ! Exit if transport is finished - if (finished .eqv. .true.) exit trackingLoop + ! Decide whether to use delta tracking or surface tracking + ! Vastly different opacities make delta tracking infeasable + if(sigmaT * self % majorant_inv > ONE - self % cutoff) then + ! Delta tracking + call self % deltaTracking(p) + else + ! Surface tracking + call self % surfaceTracking(p) + end if - end do trackingLoop + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + end if call tally % reportTrans(p) @@ -111,73 +81,99 @@ end subroutine timeTracking !! !! Perform surface tracking !! - subroutine surfaceTracking(self, p, dTime, dColl, finished) + subroutine surfaceTracking(self, p) class(transportOperatorTimeHT), intent(inout) :: self class(particle), intent(inout) :: p - real(defReal), intent(in) :: dTime - real(defReal), intent(in) :: dColl - logical(defBool), intent(inout) :: finished - real(defReal) :: dist + real(defReal) :: dTime, dColl, dist, sigmaT integer(shortInt) :: event character(100), parameter :: Here = 'surfaceTracking (transportOperatorTimeHT_class.f90)' - dist = min(dTime, dColl) - - ! Move through geometry using minimum distance - call self % geom % move(p % coords, dist, event) - - p % time = p % time + dist / p % getSpeed() - - ! Check result of transport - if (dist == dTime) then - ! Time boundary - if (event /= COLL_EV) call fatalError(Here, 'Moving dTime should result in COLL_EV') - p % fate = AGED_FATE - if (abs(p % time - p % timeMax) > 0.000001) call fatalError(Here, 'Particle time incorrect?') - p % time = p % timeMax - finished = .true. - else if (dist == dColl) then - ! Collision, increase time accordingly - if (event /= COLL_EV) call fatalError(Here, 'Moving dColl should result in COLL_EV') - finished = .true. - end if + STLoop:do + + ! Find distance to time boundary + dTime = lightSpeed * (p % timeMax - p % time) + + ! Sample distance to collision + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + dColl = -log( p % pRNG % get() ) / sigmaT + + ! Choose minimum distance + dist = min(dTime, dColl) + + ! Move through geometry using minimum distance + call self % geom % move(p % coords, dist, event) + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return + + ! Increase time based on distance moved + p % time = p % time + dist / lightSpeed + + ! Check result of transport + if (dist == dTime) then + ! Time boundary + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV & + &after moving dTime') + p % fate = AGED_FATE + p % time = p % timeMax + exit STLoop + + else if (dist == dColl) then + ! Collision, increase time accordingly + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV & + &after moving dTime') + exit STLoop + + end if + + end do STLoop end subroutine surfaceTracking !! !! Perform delta tracking !! - subroutine deltaTracking(self, p, dTime, dColl, finished) + subroutine deltaTracking(self, p) class(transportOperatorTimeHT), intent(inout) :: self class(particle), intent(inout) :: p - real(defReal), intent(in) :: dTime - real(defReal), intent(in) :: dColl - logical(defBool), intent(inout) :: finished - real(defReal) :: sigmaT - - ! Determine which distance to move particle - if (dColl < dTime) then - ! Move partice to potential collision location + real(defReal) :: dTime, dColl, sigmaT + character(100), parameter :: Here = 'deltaTracking (transportOperatorTimeHT_class.f90)' + + DTLoop:do + + ! Find distance to time boundary + dTime = lightSpeed * (p % timeMax - p % time) + + ! Sample distance to collision + dColl = -log( p % pRNG % get() ) * self % majorant_inv + + ! If dTime < dColl, move to end of time step location + if (dTime < dColl) then + call self % geom % teleport(p % coords, dColl) + p % fate = AGED_FATE + p % time = p % timeMax + exit DTLoop + end if + + ! Otherwise, move to potential collision location call self % geom % teleport(p % coords, dColl) - p % time = p % time + dColl / p % getSpeed() - else - ! Move particle to end of time step location - call self % geom % teleport(p % coords, dTime) - p % fate = AGED_FATE - p % time = p % timeMax - finished = .true. - return - end if + p % time = p % time + dColl / lightSpeed - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) return + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return - ! Obtain local cross-section - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + ! Obtain local cross-section + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Roll RNG to determine if the collision is real or virtual + ! Exit the loop if the collision is real + if (p % pRNG % get() < sigmaT * self % majorant_inv) exit DTLoop + + ! Protect against infinite loop + if (sigmaT*self % majorant_inv == 0) call fatalError(Here, '100 % virtual collision chance, & + &potentially infinite loop') - ! Roll RNG to determine if the collision is real or virtual - ! Exit the loop if the collision is real - if (p % pRNG % get() < sigmaT * self % majorant_inv) finished = .true. + end do DTLoop end subroutine deltaTracking @@ -189,10 +185,6 @@ end subroutine deltaTracking subroutine init(self, dict) class(transportOperatorTimeHT), intent(inout) :: self class(dictionary), intent(in) :: dict - class(dictionary), pointer :: tempDict - integer(shortInt) :: nMats - real(defReal), dimension(6) :: bounds - real(defReal) :: lengthScale ! Initialise superclass call init_super(self, dict) From 271fd053030ef84b4f568f9467b05ed88b43e7c1 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 18:58:32 +0000 Subject: [PATCH 241/373] Added argument to init and moved a few declarations to be in line --- TransportOperator/transportOperatorIMC_class.f90 | 8 ++++---- TransportOperator/transportOperatorTimeHT_class.f90 | 8 ++++++-- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 58e08417c..b2e6e6b4f 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -117,8 +117,8 @@ end subroutine imcTracking subroutine surfaceTracking(self, p) class(transportOperatorIMC), intent(inout) :: self class(particle), intent(inout) :: p - real(defReal) :: dTime - real(defReal) :: dColl + real(defReal) :: dTime + real(defReal) :: dColl real(defReal) :: dist, sigmaT integer(shortInt) :: event character(100), parameter :: Here = 'surfaceTracking (transportOperatorIMC_class.f90)' @@ -170,8 +170,8 @@ end subroutine surfaceTracking subroutine deltaTracking(self, p) class(transportOperatorIMC), intent(inout) :: self class(particle), intent(inout) :: p - real(defReal) :: dTime - real(defReal) :: dColl + real(defReal) :: dTime + real(defReal) :: dColl real(defReal) :: sigmaT character(100), parameter :: Here = 'deltaTracking (transportOperatorIMC_class.f90)' diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 184e27d1e..ac330741d 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -14,6 +14,9 @@ module transportOperatorTimeHT_class ! Superclass use transportOperator_inter, only : transportOperator, init_super => init + ! Geometry interfaces + use geometry_inter, only : geometry + ! Tally interface use tallyCodes use tallyAdmin_class, only : tallyAdmin @@ -182,9 +185,10 @@ end subroutine deltaTracking !! !! Cutoff of 1 gives exclusively delta tracking, cutoff of 0 gives exclusively surface tracking !! - subroutine init(self, dict) + subroutine init(self, dict, geom) class(transportOperatorTimeHT), intent(inout) :: self - class(dictionary), intent(in) :: dict + class(dictionary), intent(in) :: dict + class(geometry), intent(in), optional :: geom ! Initialise superclass call init_super(self, dict) From 17433b9a35f0f8f4e173cc0e02892dc409ad9910 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 18:59:15 +0000 Subject: [PATCH 242/373] Moved some variables to be in line --- TransportOperator/transportOperatorTimeHT_class.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 184e27d1e..da95248b8 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -42,11 +42,11 @@ module transportOperatorTimeHT_class subroutine timeTracking(self, p, tally, thisCycle, nextCycle) class(transportOperatorTimeHT), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - class(particleDungeon), intent(inout) :: thisCycle - class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: sigmaT + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon), intent(inout) :: thisCycle + class(particleDungeon), intent(inout) :: nextCycle + real(defReal) :: sigmaT character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' ! Get majorant XS inverse: 1/Sigma_majorant @@ -184,7 +184,7 @@ end subroutine deltaTracking !! subroutine init(self, dict) class(transportOperatorTimeHT), intent(inout) :: self - class(dictionary), intent(in) :: dict + class(dictionary), intent(in) :: dict ! Initialise superclass call init_super(self, dict) From 6394942d12f7d1abe2668f60a0f70afe52278540 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 15 Nov 2022 19:03:39 +0000 Subject: [PATCH 243/373] Removed some unused variables --- TransportOperator/transportOperatorIMC_class.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index b2e6e6b4f..17235323e 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -63,8 +63,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) type(tallyAdmin), intent(inout) :: tally class(particleDungeon), intent(inout) :: thisCycle class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: sigmaT, dTime, dColl - integer(shortInt) :: idx, uniqueId + real(defReal) :: sigmaT character(100), parameter :: Here = 'IMCTracking (transportOperatorIMC_class.f90)' ! Deal with material particles, only relevant for ISMC @@ -279,7 +278,7 @@ subroutine buildMajMap(self, rand, xsData) class(nuclearDatabase), intent(in), pointer :: xsData type(particle) :: p integer(shortInt) :: i, j, matIdx - real(defReal) :: mu, phi, dist + real(defReal) :: dist ! Check that subroutine should be called if (.not. allocated(self % matMajs)) return From 0d2bb9b4944b30bf0361e28d61f9fe896132ee33 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Nov 2022 11:32:33 +0000 Subject: [PATCH 244/373] A few changes to work with VOID_MAT --- TransportOperator/transportOperatorIMC_class.f90 | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 17235323e..0b4b20632 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -91,7 +91,7 @@ subroutine imcTracking(self, p, tally, thisCycle, nextCycle) ! Decide whether to use delta tracking or surface tracking ! Vastly different opacities make delta tracking infeasable - if(sigmaT * self % majorant_inv >= ONE - self % cutoff) then + if(sigmaT * self % majorant_inv > ONE - self % cutoff .or. self % cutoff == ONE) then ! Delta tracking call self % deltaTracking(p) else @@ -128,8 +128,12 @@ subroutine surfaceTracking(self, p) dTime = lightSpeed * (p % timeMax - p % time) ! Sample distance to collision - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - dColl = -log( p % pRNG % get() ) / sigmaT + if (p % matIdx() == VOID_MAT) then + dColl = INF + else + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + dColl = -log( p % pRNG % get() ) / sigmaT + end if ! Choose minimum distance dist = min(dTime, dColl) @@ -180,7 +184,11 @@ subroutine deltaTracking(self, p) dTime = lightSpeed * (p % timeMax - p % time) ! Sample distance to collision - dColl = -log( p % pRNG % get() ) * self % majorant_inv + if (p % matIdx() == VOID_MAT) then + dColl = INF + else + dColl = -log( p % pRNG % get() ) * self % majorant_inv + end if ! If dTime < dColl, move to end of time step location if (dTime < dColl) then From 132ed4b161f4f21a0e2430b317a0c14ffb99af17 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Nov 2022 12:02:11 +0000 Subject: [PATCH 245/373] Renamed surfaceSource_class to bbSurfaceSource_class : --- ParticleObjects/Source/CMakeLists.txt | 6 ++-- ...ce_class.f90 => bbSurfaceSource_class.f90} | 28 +++++++++---------- ParticleObjects/Source/sourceFactory_func.f90 | 20 ++++++------- 3 files changed, 27 insertions(+), 27 deletions(-) rename ParticleObjects/Source/{surfaceSource_class.f90 => bbSurfaceSource_class.f90} (93%) diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index 29ea31784..dcb7ce818 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -1,9 +1,9 @@ # Add Source Files to the global list add_sources( source_inter.f90 configSource_inter.f90 - sourceFactory_func.f90 - pointSource_class.f90 + sourceFactory_func.f90 + pointSource_class.f90 fissionSource_class.f90 IMCSource_class.f90 - surfaceSource_class.f90 + bbSurfaceSource_class.f90 ) diff --git a/ParticleObjects/Source/surfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 similarity index 93% rename from ParticleObjects/Source/surfaceSource_class.f90 rename to ParticleObjects/Source/bbSurfaceSource_class.f90 index 37f3028d5..7124cd77a 100644 --- a/ParticleObjects/Source/surfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -1,4 +1,4 @@ -module surfaceSource_class +module bbSurfaceSource_class use numPrecision use universalVariables @@ -39,7 +39,7 @@ module surfaceSource_class !! !! Sample Dictionary Input: !! source { - !! type surfaceSource; + !! type bbSurfaceSource; !! shape circle ! circle or square; !! size 5; ! radius(circle) or side length(square) !! axis x; ! axis normal to planar shape @@ -53,7 +53,7 @@ module surfaceSource_class !! deltat 1; ! Currently needed to be the same as IMC time step size !! } !! - type, public,extends(configSource) :: surfaceSource + type, public,extends(configSource) :: bbSurfaceSource private real(defReal),dimension(3) :: r = ZERO real(defReal) :: dir = ZERO @@ -75,7 +75,7 @@ module surfaceSource_class procedure :: sampleEnergy procedure :: sampleEnergyAngle procedure :: kill - end type surfaceSource + end type bbSurfaceSource contains @@ -92,14 +92,14 @@ module surfaceSource_class !! - error if neither energy type is specified !! subroutine init(self, dict, geom) - class(surfaceSource), intent(inout) :: self + class(bbSurfaceSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom character(30) :: type, tempName integer(shortInt) :: matIdx, uniqueID logical(defBool) :: isCE, isMG real(defReal) :: temp !,dimension(:),allocatable :: temp - character(100), parameter :: Here = 'init (surfaceSource_class.f90)' + character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' ! Provide geometry info to source self % geom => geom @@ -175,12 +175,12 @@ subroutine init(self, dict, geom) end subroutine init subroutine append(self, dungeon, N, rand) - class(surfaceSource), intent(inout) :: self + class(bbSurfaceSource), intent(inout) :: self type(particleDungeon), intent(inout) :: dungeon integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand integer(shortInt) :: i - character(100), parameter :: Here = 'append (surfaceSource_class.f90)' + character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' self % N = N @@ -197,7 +197,7 @@ end subroutine append !! See configSource_inter for details. !! subroutine sampleType(self, p, rand) - class(surfaceSource), intent(inout) :: self + class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand @@ -211,7 +211,7 @@ end subroutine sampleType !! See configSource_inter for details. !! subroutine samplePosition(self, p, rand) - class(surfaceSource), intent(inout) :: self + class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand real(defReal), dimension(3) :: prevPos @@ -260,7 +260,7 @@ end subroutine samplePosition !! Only isotropic/fixed direction. Does not sample energy. !! subroutine sampleEnergyAngle(self, p, rand) - class(surfaceSource), intent(inout) :: self + class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand real(defReal) :: r, phi, theta @@ -287,7 +287,7 @@ end subroutine sampleEnergyAngle !! See configSource_inter for details. !! subroutine sampleEnergy(self, p, rand) - class(surfaceSource), intent(inout) :: self + class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand real(defReal) :: num @@ -307,7 +307,7 @@ end subroutine sampleEnergy !! Return to uninitialised state !! elemental subroutine kill(self) - class(surfaceSource), intent(inout) :: self + class(bbSurfaceSource), intent(inout) :: self ! Kill superclass call kill_super(self) @@ -321,4 +321,4 @@ elemental subroutine kill(self) end subroutine kill -end module surfaceSource_class +end module bbSurfaceSource_class diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index f06846fea..91c7ec6d3 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -8,10 +8,10 @@ module sourceFactory_func use source_inter, only : source ! source implementations - use pointSource_class, only : pointSource - use fissionSource_class, only : fissionSource - use IMCSource_class, only : imcSource - use surfaceSource_class, only : surfaceSource + use pointSource_class, only : pointSource + use fissionSource_class, only : fissionSource + use IMCSource_class, only : imcSource + use bbSurfaceSource_class, only : bbSurfaceSource ! geometry use geometry_inter, only : geometry @@ -26,10 +26,10 @@ module sourceFactory_func ! It is printed if type was unrecognised ! NOTE: ! For now it is necessary to adjust trailing blanks so all entries have the same length - character(nameLen),dimension(*),parameter :: AVAILABLE_sources = [ 'pointSource ',& - 'fissionSource',& - 'imcSource ',& - 'surfaceSource'] + character(nameLen),dimension(*),parameter :: AVAILABLE_sources = [ 'pointSource ',& + 'fissionSource ',& + 'imcSource ',& + 'bbSurfaceSource'] contains @@ -65,8 +65,8 @@ subroutine new_source(new, dict, geom) allocate(imcSource :: new) call new % init(dict, geom) - case('surfaceSource') - allocate(surfaceSource :: new) + case('bbSurfaceSource') + allocate(bbSurfaceSource :: new) call new % init(dict, geom) !*** NEW SOURCE TEMPLATE ***! From 310bad56c6f8db68d5e0bd27cb3cebabf68df754 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Nov 2022 12:08:18 +0000 Subject: [PATCH 246/373] Source no longer requires timestep in the input dictionary, instead is automatically added in the physics package --- ParticleObjects/Source/bbSurfaceSource_class.f90 | 8 +++----- PhysicsPackages/IMCPhysicsPackage_class.f90 | 1 + 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 7124cd77a..357d1cfb5 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -18,8 +18,6 @@ module bbSurfaceSource_class !! Put together quite quickly so very specific in use and not perfect !! - Currently only allows a circle or square aligned on x y or z axis, with !! a certain radius or side length - !! - Requires deltat and nParticles in input file to be the same as specified elsewhere - !! in file, can change to not require these inputs with some more thought !! - May still contain unnecessary lines of code copied from pointSource_class.f90 !! !! Private members: @@ -98,7 +96,7 @@ subroutine init(self, dict, geom) character(30) :: type, tempName integer(shortInt) :: matIdx, uniqueID logical(defBool) :: isCE, isMG - real(defReal) :: temp !,dimension(:),allocatable :: temp + real(defReal) :: temp character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' ! Provide geometry info to source @@ -170,7 +168,7 @@ subroutine init(self, dict, geom) end if call dict % get(self % T, 'T') - call dict % get(self % deltat, 'deltat') + call dict % get(self % deltaT, 'deltaT') end subroutine init @@ -292,7 +290,7 @@ subroutine sampleEnergy(self, p, rand) class(RNG), intent(inout) :: rand real(defReal) :: num - num = radiationConstant * lightSpeed * self % deltat * self % T**4 * self % area + num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * self % area p % wgt = num / (4 * self % N) ! If dir = 0 then emit in both directions => double total energy diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 333ff8d29..542cdbcfe 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -410,6 +410,7 @@ subroutine init(self, dict) ! Read particle source definition if( dict % isPresent('source') ) then tempDict => dict % getDictPtr('source') + call tempDict % store('deltaT', self % deltaT) call new_source(self % inputSource, tempDict, self % geom) self % sourceGiven = .true. end if From 90c18a4fb87e9e1688055e89e24b73ec23d69a40 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Nov 2022 12:17:14 +0000 Subject: [PATCH 247/373] Changed input files to reflect new settings --- InputFiles/IMC/MarshakWave/marshakWave128 | 9 ++------- InputFiles/IMC/MarshakWave/marshakWave16 | 9 ++------- InputFiles/IMC/MarshakWave/marshakWave32 | 9 ++------- InputFiles/IMC/MarshakWave/marshakWave64 | 9 ++------- InputFiles/IMC/MarshakWave/marshakWave8 | 9 ++------- InputFiles/IMC/Sample/imcSampleInput | 15 ++++++--------- InputFiles/IMC/SimpleCases/3region | 7 ++----- InputFiles/IMC/SimpleCases/infiniteRegion | 7 ++----- InputFiles/IMC/SimpleCases/sphereInCube | 7 ++----- InputFiles/IMC/SimpleCases/touchingCubes | 7 ++----- 10 files changed, 24 insertions(+), 64 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index d1275c8ea..ab66f232d 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -5,17 +5,14 @@ pop 500; limit 5000; steps 10000; timeStepSize 0.05; - -XSdata mg; -dataType mg; - +printUpdates 4; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } source { @@ -25,9 +22,7 @@ source { axis x; pos -2; T 1; - nParticles 500; dir 1; - deltat 0.05; particle photon; } diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 index c77ce78c7..87997a3fe 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave16 +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -5,17 +5,14 @@ pop 500; limit 5000; steps 10000; timeStepSize 0.05; - -XSdata mg; -dataType mg; - +printUpdates 4; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } source { @@ -25,9 +22,7 @@ source { axis x; pos -2; T 1; - nParticles 500; dir 1; - deltat 0.05; particle photon; } diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 0aeb69c1c..95032589b 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -5,17 +5,14 @@ pop 500; limit 5000; steps 10000; timeStepSize 0.05; - -XSdata mg; -dataType mg; - +printUpdates 4; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } source { @@ -25,9 +22,7 @@ source { axis x; pos -2; T 1; - nParticles 500; dir 1; - deltat 0.05; particle photon; } diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index b2adc8411..580624556 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -5,17 +5,14 @@ pop 500; limit 5000; steps 10000; timeStepSize 0.05; - -XSdata mg; -dataType mg; - +printUpdates 4; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } source { @@ -25,9 +22,7 @@ source { axis x; pos -2; T 1; - nParticles 500; dir 1; - deltat 0.05; particle photon; } diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 index 31055316a..f6d5dfafa 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave8 +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -5,17 +5,14 @@ pop 500; limit 5000; steps 10000; timeStepSize 0.05; - -XSdata mg; -dataType mg; - +printUpdates 8; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } source { @@ -25,9 +22,7 @@ source { axis x; pos -2; T 1; - nParticles 500; dir 1; - deltat 0.05; particle photon; } diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput index 4446c0491..67649f333 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -11,10 +11,8 @@ pop 1000; // source is given, this is also the number of particles emitted from that source. limit 10000; - // Sets the maximum size of particle dungeons. Typically needs to be around 10*pop, and may be - // significantly higher for certain problems. Runtime is very dependent on this value so should - // not be set arbitrarily large. Would benefit from a change such that dungeon size is increased - // automatically without needing to set a limit. + // Sets the maximum size of particle dungeons. Runtime is very dependent on this value so should + // not be set arbitrarily large. steps 50; // The number of time steps to be used in the calculation @@ -22,17 +20,16 @@ steps 50; timeStepSize 0.1; // The time step size for the calculation in seconds - -XSdata mg; -dataType mg; - +printUpdates 1; + // The number maximum number of material updates to print to screen. If 0, no updates will be + // printed. collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; cutoff 0.7; } // No tallies are required for calculation, but empty dictionary must be given diff --git a/InputFiles/IMC/SimpleCases/3region b/InputFiles/IMC/SimpleCases/3region index 7726243a3..4a17874b1 100644 --- a/InputFiles/IMC/SimpleCases/3region +++ b/InputFiles/IMC/SimpleCases/3region @@ -5,17 +5,14 @@ pop 5000; limit 20000; steps 50; timeStepSize 0.1; - -XSdata mg; -dataType mg; - +printUpdates 3; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } tally { diff --git a/InputFiles/IMC/SimpleCases/infiniteRegion b/InputFiles/IMC/SimpleCases/infiniteRegion index 5cd634c15..5ec1dde1c 100644 --- a/InputFiles/IMC/SimpleCases/infiniteRegion +++ b/InputFiles/IMC/SimpleCases/infiniteRegion @@ -5,17 +5,14 @@ pop 5000; limit 20000; steps 50; timeStepSize 0.01; - -XSdata mg; -dataType mg; - +printUpdates 1; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } tally { diff --git a/InputFiles/IMC/SimpleCases/sphereInCube b/InputFiles/IMC/SimpleCases/sphereInCube index 01fe736a8..556e53737 100644 --- a/InputFiles/IMC/SimpleCases/sphereInCube +++ b/InputFiles/IMC/SimpleCases/sphereInCube @@ -5,17 +5,14 @@ pop 100; limit 2000; steps 500; timeStepSize 0.1; - -XSdata mg; -dataType mg; - +printUpdates 2; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } tally { diff --git a/InputFiles/IMC/SimpleCases/touchingCubes b/InputFiles/IMC/SimpleCases/touchingCubes index 41e0fe7a0..3cfbfa1fb 100644 --- a/InputFiles/IMC/SimpleCases/touchingCubes +++ b/InputFiles/IMC/SimpleCases/touchingCubes @@ -5,17 +5,14 @@ pop 5000; limit 20000; steps 50; timeStepSize 1; - -XSdata mg; -dataType mg; - +printUpdates 2; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; + type transportOperatorTimeHT; } tally { From 91cfe070515430c3c1ec4e62d289d53b220e08b9 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Nov 2022 13:06:39 +0000 Subject: [PATCH 248/373] Big simplification to IMC material source, now samples particles only from a given matIdx --- ParticleObjects/Source/IMCSource_class.f90 | 139 ++++++------------ .../Source/bbSurfaceSource_class.f90 | 15 +- ParticleObjects/Source/source_inter.f90 | 15 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 4 +- 4 files changed, 65 insertions(+), 108 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 2ec9f7b66..b39730e4e 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -16,13 +16,12 @@ module IMCSource_class use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG use nuclearDatabase_inter, only : nuclearDatabase use mgIMCDatabase_inter, only : mgIMCDatabase - use materialMenu_mod, only : MMnMat => nMat implicit none private !! - !! IMC Source for uniform generation of photons within material regions + !! IMC Source for uniform generation of photons within a material !! !! Angular distribution is isotropic. !! @@ -31,8 +30,8 @@ module IMCSource_class !! bottom -> Bottom corner (x_min, y_min, z_min) !! top -> Top corner (x_max, y_max, z_max) !! G -> Group (default = 1) - !! matPops -> Array to store the number of particles sampled in each material for - !! normalisation of weight + !! N -> number of particles being generated, used to normalise weight in sampleParticle + !! matIdx -> index of material to be sampled from !! !! Interface: !! source_inter Interface @@ -46,7 +45,8 @@ module IMCSource_class real(defReal), dimension(3) :: bottom = ZERO real(defReal), dimension(3) :: top = ZERO integer(shortInt) :: G = 0 - integer(shortInt), dimension(:), allocatable :: matPops + integer(shortInt) :: N + integer(shortInt) :: matIdx contains procedure :: init procedure :: append @@ -66,7 +66,7 @@ subroutine init(self, dict, geom) class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom real(defReal), dimension(6) :: bounds - integer(shortInt) :: i, n + integer(shortInt) :: i character(100), parameter :: Here = 'init (imcSource_class.f90)' ! Provide geometry info to source @@ -79,81 +79,44 @@ subroutine init(self, dict, geom) self % bottom = bounds(1:3) self % top = bounds(4:6) - ! Initialise array to store numbers of particles - n = MMnMat() - allocate(self % matPops(n)) - do i=1, n - self % matPops(i) = 0 - end do - end subroutine init !! - !! Generate n particles to add to a particleDungeon without overriding - !! particles already present. More complex than superclass 'append' subroutine, - !! needed for multiregion functionality. - !! - !! The number of particles sampled in each matIdx is recorded and used to normalise - !! each particle weight, so that the total energy emitted in each region is as - !! required + !! Generate N particles from material matIdx to add to a particleDungeon without overriding + !! particles already present. !! !! Args: !! dungeon [inout] -> particle dungeon to be added to !! n [in] -> number of particles to place in dungeon !! rand [inout] -> particle RNG object + !! matIdx [in] -> index of material to sample from !! !! Result: - !! A dungeon populated with n particles sampled from the source, plus particles + !! A dungeon populated with N particles sampled from the source, plus particles !! already present in dungeon !! - subroutine append(self, dungeon, N, rand) - class(imcSource), intent(inout) :: self - type(particleDungeon), intent(inout) :: dungeon - integer(shortInt), intent(in) :: N - class(RNG), intent(inout) :: rand - type(particleDungeon) :: tempDungeon - type(particle) :: p - integer(shortInt) :: i - real(defReal) :: normFactor - character(100), parameter :: Here = "append (IMCSource_class.f90)" - - ! Reset particle population counters - do i = 1, size( self % matPops ) - self % matPops(i) = 0 - end do - - ! Set temporary dungeon size - call tempDungeon % setSize(n) - - ! Generate n particles to populate temporary dungeon - do i = 1, n - call tempDungeon % replace(self % sampleParticle(rand), i) - end do - - ! Call error if any region contains no generated particles (due to small regions and/or - ! not enough particles used), needed for now as otherwise will lead to energy imbalance - ! as mat energy will be reduced by emittedRad but no particles will be carrying it - ! Note that matPops is set to 1 in sample_particle if region is of 0 temperature to avoid - ! this error for such a case - if ( minval(self % matPops) == 0 ) then - call fatalError(Here, "Not all regions emitted particles, use more particles") - end if - - ! Loop through again and add to input dungeon, normalising energies based on material - do i = 1, n - - call tempDungeon % release(p) - - ! Place inside geometry to set matIdx, for some reason resets when released from dungeon - call self % geom % placeCoord( p % coords ) - - ! Normalise - normFactor = self % matPops( p % coords % matIdx ) - p % w = p % w / normFactor - - ! Add to input dungeon - call dungeon % detain(p) - + subroutine append(self, dungeon, N, rand, matIdx) + class(imcSource), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + integer(shortInt), intent(in), optional :: matIdx + type(particleDungeon) :: tempDungeon + type(particle) :: p + integer(shortInt) :: i + real(defReal) :: normFactor + character(100), parameter :: Here = "append (IMCSource_class.f90)" + + ! Assert that optional argument matIdx is in fact present + if (.not. present(matIdx)) call fatalError(Here, 'matIdx must be provided for IMC source') + + ! Store inputs for use by sampleParticle subroutine + self % N = N + self % matIdx = matIdx + + ! Add N particles to dungeon + do i=1, N + call dungeon % detain(self % sampleParticle(rand)) end do end subroutine append @@ -170,9 +133,8 @@ function sampleParticle(self, rand) result(p) class(nuclearDatabase), pointer :: nucData class(IMCMaterial), pointer :: mat real(defReal), dimension(3) :: r, rand3, dir - ! Here, i is a float to allow more precise control of loop - real(defReal) :: mu, phi, i - integer(shortInt) :: matIdx, uniqueID + real(defReal) :: mu, phi + integer(shortInt) :: i, matIdx, uniqueID character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' ! Get pointer to appropriate nuclear database @@ -180,14 +142,15 @@ function sampleParticle(self, rand) result(p) if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') ! Position is sampled by taking a random point from within geometry bounding box - ! If in valid material, position is accepted + ! If in correct material, position is accepted i = 0 + rejection : do + ! Protect against infinite loop - i = i + 1 - if ( i > 200) then - call fatalError(Here, '200 particles in a row sampled in void or outside material.& - & Check that geometry is as intended') + i = i+1 + if (i > 10000) then + call fatalError(Here, '10,000 failed samples in rejection sampling loop') end if ! Sample Position @@ -199,14 +162,14 @@ function sampleParticle(self, rand) result(p) ! Find material under position call self % geom % whatIsAt(matIdx, uniqueID, r) - ! Reject if there is no material - if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle rejection + ! Reject if not in desired material + if (matIdx /= self % matIdx) cycle rejection ! Point to material mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") - ! Sample Direction - chosen uniformly inside unit sphere + ! Sample direction - chosen uniformly inside unit sphere mu = 2 * rand % get() - 1 phi = rand % get() * 2*pi dir(1) = mu @@ -223,20 +186,8 @@ function sampleParticle(self, rand) result(p) p % G = self % G p % isMG = .true. - ! Set weight to be equal to total emitted radiation from material - ! This weight is then normalised later - see appendIMC (source_inter.f90) - ! There may be more intuitive ways to do this, but works well for now - p % wgt = mat % getEmittedRad() - - ! Don't sample particles from areas of 0 temperature - if( p % wgt == 0 ) then - self % matPops(matIdx) = 1 ! Set to 1 to avoid error in append subroutine - i = i - 0.9 ! To allow more attempts if large regions with 0 temp - cycle rejection - end if - - ! Increase counter of number of particles in material in order to normalise later - self % matPops(matIdx) = self % matPops(matIdx) + 1 + ! Set weight + p % wgt = mat % getEmittedRad() / self % N ! Exit the loop exit rejection diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 357d1cfb5..fcbba9a52 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -172,13 +172,14 @@ subroutine init(self, dict, geom) end subroutine init - subroutine append(self, dungeon, N, rand) - class(bbSurfaceSource), intent(inout) :: self - type(particleDungeon), intent(inout) :: dungeon - integer(shortInt), intent(in) :: N - class(RNG), intent(inout) :: rand - integer(shortInt) :: i - character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' + subroutine append(self, dungeon, N, rand, matIdx) + class(bbSurfaceSource), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + integer(shortInt), intent(in), optional :: matIdx + integer(shortInt) :: i + character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' self % N = N diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index 29fdda1a6..49ebe0120 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -126,17 +126,20 @@ end subroutine generate !! dungeon [inout] -> particle dungeon to be added to !! n [in] -> number of particles to place in dungeon !! rand [inout] -> particle RNG object + !! matIdx [in] -> optional unused argument, here so that subclasses can override to + !! select matIdx to sample from !! !! Result: !! A dungeon populated with n particles sampled from the source, plus !! particles already present in dungeon !! - subroutine append(self, dungeon, n, rand) - class(source), intent(inout) :: self - type(particleDungeon), intent(inout) :: dungeon - integer(shortInt), intent(in) :: n - class(RNG), intent(inout) :: rand - integer(shortInt) :: i + subroutine append(self, dungeon, n, rand, matIdx) + class(source), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: n + class(RNG), intent(inout) :: rand + integer(shortInt), intent(in), optional :: matIdx + integer(shortInt) :: i ! Generate n particles to populate dungeon do i = 1, n diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 542cdbcfe..7747b1436 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -175,7 +175,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) end if if(self % sourceGiven) N = N/2 ! Add to particle dungeon - call self % IMCSource % append(self % thisStep, N, p % pRNG) + do j=1, self % nMat + call self % IMCSource % append(self % thisStep, int(N/self % nMat), p % pRNG, j) + end do end if ! Generate from input source From 8801682ccf3bd2d8cc8677719aa0a161ad04d937 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Nov 2022 13:09:16 +0000 Subject: [PATCH 249/373] Changed marshak input files to use new name for bbSurfaceSource --- InputFiles/IMC/MarshakWave/marshakWave128 | 2 +- InputFiles/IMC/MarshakWave/marshakWave16 | 2 +- InputFiles/IMC/MarshakWave/marshakWave32 | 2 +- InputFiles/IMC/MarshakWave/marshakWave64 | 6 +++--- InputFiles/IMC/MarshakWave/marshakWave8 | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index ab66f232d..4cc945fb5 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -16,7 +16,7 @@ transportOperator { } source { - type surfaceSource; + type bbSurfaceSource; shape square; size 1; axis x; diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 index 87997a3fe..0092475a5 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave16 +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -16,7 +16,7 @@ transportOperator { } source { - type surfaceSource; + type bbSurfaceSource; shape square; size 1; axis x; diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 95032589b..2acef0a81 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -16,7 +16,7 @@ transportOperator { } source { - type surfaceSource; + type bbSurfaceSource; shape square; size 1; axis x; diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 580624556..34fca0ac1 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -1,8 +1,8 @@ type IMCPhysicsPackage; -pop 500; -limit 5000; +pop 200; +limit 10000; steps 10000; timeStepSize 0.05; printUpdates 4; @@ -16,7 +16,7 @@ transportOperator { } source { - type surfaceSource; + type bbSurfaceSource; shape square; size 1; axis x; diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 index f6d5dfafa..45a7c878c 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave8 +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -16,7 +16,7 @@ transportOperator { } source { - type surfaceSource; + type bbSurfaceSource; shape square; size 1; axis x; From ffc4871186291c71b78885e7d56afd3e344c8505 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 17 Nov 2022 14:12:06 +0000 Subject: [PATCH 250/373] N particles from material and N particles from source are now given indiviually in input files --- .../Source/bbSurfaceSource_class.f90 | 12 +++---- PhysicsPackages/IMCPhysicsPackage_class.f90 | 36 ++++++++----------- 2 files changed, 21 insertions(+), 27 deletions(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index fcbba9a52..a56f3ef6e 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -43,12 +43,10 @@ module bbSurfaceSource_class !! axis x; ! axis normal to planar shape !! pos 0; ! distance along axis to place plane !! T 1; ! temperature of source boundary - !! nParticles 100; ! Number of particles emitted per time step, for now has to be - !! the same as IMC source if used in IMC calculation !! particle photon; - !! #dir 1; # ! Positive or negative to indicate direction along axis + !! # dir 1; # ! Positive or negative to indicate direction along axis !! If 0 then emit in both directions - !! deltat 1; ! Currently needed to be the same as IMC time step size + !! # N 100; # ! Number of particles, only used if call to append subroutine uses N=0 !! } !! type, public,extends(configSource) :: bbSurfaceSource @@ -169,6 +167,7 @@ subroutine init(self, dict, geom) call dict % get(self % T, 'T') call dict % get(self % deltaT, 'deltaT') + call dict % getOrDefault(self % N, 'N', 1) end subroutine init @@ -181,10 +180,11 @@ subroutine append(self, dungeon, N, rand, matIdx) integer(shortInt) :: i character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' - self % N = N + ! Set number to generate. Using 0 in function call will use N from input dictionary + if (N /= 0) self % N = N ! Generate n particles to populate dungeon - do i = 1, N + do i = 1, self % N call dungeon % detain(self % sampleParticle(rand)) end do diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 7747b1436..51b81c701 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -133,7 +133,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) integer(shortInt), intent(in) :: N_steps integer(shortInt) :: i, j, N type(particle) :: p - real(defReal) :: elapsed_T, end_T, T_toEnd, sumT + real(defReal) :: elapsed_T, end_T, T_toEnd real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='steps (IMCPhysicsPackage_class.f90)' @@ -157,32 +157,26 @@ subroutine steps(self, tally, tallyAtch, N_steps) self % thisStep => self % temp_dungeon call self % nextStep % cleanPop() - ! Check that there are regions of non-zero temperature by summing mat temperatures - sumT = 0 - do j=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - sumT = sumT + mat % getTemp() - end do - + ! Select number of particles to generate - for now this is an equal number from each zone N = self % pop + if(N + self % thisStep % popSize() > self % limit) then + ! Fleck and Cummings IMC Paper, eqn 4.11 + N = self % limit - self % thisStep % popSize() - self % nMat - 1 + end if + N = int(N/self % nMat) + if (N == 0) N = 1 - ! Generate IMC source, only if there are regions with non-zero temperature - if(sumT > 0) then - ! Select number of particles to generate - if(N + self % thisStep % popSize() > self % limit) then - ! Fleck and Cummings IMC Paper, eqn 4.11 - N = self % limit - self % thisStep % popSize() - self % nMat - 1 + ! Add to particle dungeon + do j=1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + if (mat % getTemp() > 0) then + call self % IMCSource % append(self % thisStep, N, p % pRNG, j) end if - if(self % sourceGiven) N = N/2 - ! Add to particle dungeon - do j=1, self % nMat - call self % IMCSource % append(self % thisStep, int(N/self % nMat), p % pRNG, j) - end do - end if + end do ! Generate from input source if( self % sourceGiven ) then - call self % inputSource % append(self % thisStep, N, p % pRNG) + call self % inputSource % append(self % thisStep, 0, p % pRNG) end if if(self % printSource == 1) then From 12f5d08089845de142c879d3ea6e1fc718799494 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 20 Nov 2022 13:06:14 +0000 Subject: [PATCH 251/373] Changed temperatures for MW64 --- InputFiles/IMC/MarshakWave/marshakWave64 | 137 ++++++++++++----------- 1 file changed, 69 insertions(+), 68 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 34fca0ac1..61f7e6021 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -1,11 +1,11 @@ type IMCPhysicsPackage; -pop 200; -limit 10000; -steps 10000; +pop 64; +limit 320; +steps 2000; timeStepSize 0.05; -printUpdates 4; +printUpdates 32; collisionOperator { photonMG {type IMCMGstd;} @@ -24,6 +24,7 @@ source { T 1; dir 1; particle photon; + N 20; } tally { @@ -139,71 +140,71 @@ nuclearData { materials { - mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat17 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat18 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat19 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat20 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat21 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat22 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat23 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat24 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat25 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat26 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat27 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat28 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat29 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat17 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat18 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat19 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat20 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat21 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat22 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat23 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat24 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat25 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat26 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat31 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat32 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - - mat33 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat34 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat35 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat36 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat37 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat38 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat39 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat40 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat41 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat42 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat43 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat44 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat45 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat46 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat47 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat48 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat49 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat50 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat51 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat52 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat53 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat54 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat55 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat56 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat57 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat58 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat59 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat60 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat61 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat62 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat63 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat64 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + + mat33 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat34 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat35 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat36 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat37 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat38 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat39 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat40 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat41 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat42 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat43 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat44 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat45 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat46 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat47 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat48 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat49 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat50 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat51 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat52 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat53 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat54 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat55 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat56 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat57 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat58 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat59 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat60 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat61 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat62 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat63 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat64 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } } From 5c2320995ca67a23e5e39d93b207a48871c97868 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 23 Nov 2022 11:18:49 +0000 Subject: [PATCH 252/373] Fixed typo --- Tallies/TallyResponses/tallyResponse_inter.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Tallies/TallyResponses/tallyResponse_inter.f90 b/Tallies/TallyResponses/tallyResponse_inter.f90 index 314d6c0e0..d677b100d 100644 --- a/Tallies/TallyResponses/tallyResponse_inter.f90 +++ b/Tallies/TallyResponses/tallyResponse_inter.f90 @@ -21,10 +21,10 @@ module tallyResponse_inter !! !! Interface: !! init -> Initialise - !! get -> Get velue of the response + !! get -> Get value of the response !! kill -> Return to uninitialised state !! - type, public,abstract :: tallyResponse + type, public, abstract :: tallyResponse private contains From 21ba9226363c81622653b5d4063d85a84647bdb3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 23 Nov 2022 15:33:53 +0000 Subject: [PATCH 253/373] Changed weightResponse_class to also work with IMCMaterial --- Tallies/TallyResponses/weightResponse_class.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Tallies/TallyResponses/weightResponse_class.f90 b/Tallies/TallyResponses/weightResponse_class.f90 index e007e20dd..87c599564 100644 --- a/Tallies/TallyResponses/weightResponse_class.f90 +++ b/Tallies/TallyResponses/weightResponse_class.f90 @@ -4,12 +4,14 @@ module weightResponse_class use endfConstants use genericProcedures, only : fatalError, numToChar use dictionary_class, only : dictionary - use particle_class, only : particle, P_NEUTRON + use particle_class, only : particle use tallyResponse_inter, only : tallyResponse ! Nuclear Data interfaces use nuclearDatabase_inter, only : nuclearDatabase - use neutronMaterial_inter, only : neutronMaterial, neutronMaterial_CptrCast + use materialHandle_inter, only : materialHandle + use neutronMaterial_inter, only : neutronMaterial_CptrCast + use imcMaterial_inter, only : IMCMaterial_CptrCast implicit none private @@ -70,17 +72,15 @@ function get(self, p, xsData) result(val) class(particle), intent(in) :: p class(nuclearDatabase), intent(inout) :: xsData real(defReal) :: val - class(neutronMaterial), pointer :: mat + class(materialHandle), pointer :: mat val = ZERO - ! Return 0.0 if particle is not neutron - if(p % type /= P_NEUTRON) return - ! Get pointer to active material data mat => neutronMaterial_CptrCast(xsData % getMaterial(p % matIdx())) + if(.not.associated(mat)) mat => IMCMaterial_CptrCast(xsData % getMaterial(p % matIdx())) - ! Return if material is not a neutronMaterial + ! Return if material is not a neutronMaterial or IMCMaterial if(.not.associated(mat)) return if (self % moment == 0) then From ae088722a76c607f8451dfe775c9eed5ecae4840 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 23 Nov 2022 15:39:32 +0000 Subject: [PATCH 254/373] Deleted imcWeightClerk and made new clerk to tally absorptions, quite similar to collisionClerk_class --- Tallies/TallyClerks/CMakeLists.txt | 2 +- ...rk_class.f90 => absorptionClerk_class.f90} | 100 ++++++++++-------- .../TallyClerks/tallyClerkFactory_func.f90 | 8 +- 3 files changed, 61 insertions(+), 49 deletions(-) rename Tallies/TallyClerks/{imcWeightClerk_class.f90 => absorptionClerk_class.f90} (75%) diff --git a/Tallies/TallyClerks/CMakeLists.txt b/Tallies/TallyClerks/CMakeLists.txt index 3cf6c97fd..ac133ea16 100644 --- a/Tallies/TallyClerks/CMakeLists.txt +++ b/Tallies/TallyClerks/CMakeLists.txt @@ -10,7 +10,7 @@ add_sources(./tallyClerk_inter.f90 ./dancoffBellClerk_class.f90 ./shannonEntropyClerk_class.f90 ./centreOfMassClerk_class.f90 - ./imcWeightClerk_class.f90 + ./absorptionClerk_class.f90 ) add_unit_tests(./Tests/collisionClerk_test.f90 diff --git a/Tallies/TallyClerks/imcWeightClerk_class.f90 b/Tallies/TallyClerks/absorptionClerk_class.f90 similarity index 75% rename from Tallies/TallyClerks/imcWeightClerk_class.f90 rename to Tallies/TallyClerks/absorptionClerk_class.f90 index f713e4034..9426b63bf 100644 --- a/Tallies/TallyClerks/imcWeightClerk_class.f90 +++ b/Tallies/TallyClerks/absorptionClerk_class.f90 @@ -1,4 +1,4 @@ -module imcWeightClerk_class +module absorptionClerk_class use numPrecision use tallyCodes @@ -11,7 +11,6 @@ module imcWeightClerk_class ! Nuclear Data interface use nuclearDatabase_inter, only : nuclearDatabase - use materialMenu_mod, only : mm_nMat => nMat ! Tally Filters use tallyFilter_inter, only : tallyFilter @@ -20,20 +19,19 @@ module imcWeightClerk_class ! Tally Maps use tallyMap_inter, only : tallyMap use tallyMapFactory_func, only : new_tallyMap - use materialMap_class, only : materialMap ! Tally Responses use tallyResponseSlot_class, only : tallyResponseSlot - use tallyResult_class, only : tallyResult, tallyResultEmpty - use scoreMemory_class, only : scoreMemory + use tallyResult_class, only : tallyResult, tallyResultEmpty implicit none private !! - !! Record energy weight of particles absorbed in collisions + !! Colision estimator of reaction rates + !! Calculates flux weighted integral from collisions !! !! Private Members: !! filter -> Space to store tally Filter @@ -44,18 +42,26 @@ module imcWeightClerk_class !! Interface !! tallyClerk Interface !! - !! Initialised in IMC physics package and so not required in input file + !! SAMPLE DICTIOANRY INPUT: + !! + !! myAbsorptionClerk { + !! type absorptionClerk; + !! # filter { } # + !! # map { } # + !! response (resName1 #resName2 ... #) + !! resName1 { } + !! #resNamew { Date: Wed, 23 Nov 2022 15:40:09 +0000 Subject: [PATCH 255/373] Simplified reset subroutine --- Tallies/tallyAdmin_class.f90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/Tallies/tallyAdmin_class.f90 b/Tallies/tallyAdmin_class.f90 index 5b3f0e75a..e27f6ee5e 100644 --- a/Tallies/tallyAdmin_class.f90 +++ b/Tallies/tallyAdmin_class.f90 @@ -754,7 +754,7 @@ subroutine reset(self, name) integer(shortInt) :: idx integer(shortInt),parameter :: NOT_PRESENT = -3 integer(longInt) :: addr - integer(shortInt) :: i + integer(shortInt) :: i, width character(100),parameter :: Here='reset (tallyAdmin_class.f90)' name_loc = name @@ -766,15 +766,11 @@ subroutine reset(self, name) end if addr = self % tallyClerks(idx) % getMemAddress() + width = self % tallyClerks(idx) % getSize() - call self % mem % reset(addr) - - ! If IMCWeight, reset for each material - probably a better way to do this but fine for now - if ( name == 'imcWeight' ) then - do i = 1, mm_nMat()-1 - call self % mem % reset(addr+i) - end do - end if + do i = 1, width + call self % mem % reset(addr+i-1) + end do end subroutine reset From 3a957f60c0538f1e66f931adbadd53630e623232 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 23 Nov 2022 15:41:46 +0000 Subject: [PATCH 256/373] Changed physics package to automatically work with new clerk --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 26 ++++++++++++--------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 51b81c701..a317bfe2d 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -47,7 +47,7 @@ module IMCPhysicsPackage_class use tallyCodes use tallyAdmin_class, only : tallyAdmin use tallyResult_class, only : tallyResult - use imcWeightClerk_class, only : imcWeightResult + use absorptionClerk_class, only : absClerkResult ! Factories use transportOperatorFactory_func, only : new_transportOperator @@ -217,7 +217,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) history: do call self % transOp % transport(p, tally, self % thisStep, self % nextStep) if(p % isDead) exit history - + if(p % fate == AGED_FATE) then ! Store particle for use in next time step p % fate = 0 @@ -259,15 +259,15 @@ subroutine steps(self, tally, tallyAtch, N_steps) call tally % display() ! Obtain energy deposition tally results - call tallyAtch % getResult(tallyRes, 'imcWeight') + call tallyAtch % getResult(tallyRes, 'imcWeightTally') select type(tallyRes) - class is(imcWeightResult) + class is(absClerkResult) do j = 1, self % nMat - tallyEnergy(j) = tallyRes % imcWeight(j) + tallyEnergy(j) = tallyRes % clerkResults(j) end do class default - call fatalError(Here, 'Invalid result has been returned') + call fatalError(Here, 'Tally result class should be absClerkResult') end select ! Update material properties @@ -284,7 +284,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) print * ! Reset tally for next time step - call tallyAtch % reset('imcWeight') + call tallyAtch % reset('imcWeightTally') print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_steps) @@ -333,7 +333,7 @@ subroutine init(self, dict) class(IMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict class(dictionary),pointer :: tempDict - type(dictionary) :: locDict1, locDict2, locDict3, locDict4 + type(dictionary) :: locDict1, locDict2, locDict3, locDict4, locDict5 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -446,14 +446,18 @@ subroutine init(self, dict) ! Initialise imcWeight tally attachment call locDict2 % init(1) - call locDict3 % init(2) + call locDict3 % init(4) call locDict4 % init(2) + call locDict5 % init(1) + call locDict5 % store('type', 'weightResponse') call locDict4 % store('type','materialMap') call locDict4 % store('materials', [mats]) - call locDict3 % store('type','imcWeightClerk') + call locDict3 % store('response', ['imcWeightResponse']) + call locDict3 % store('imcWeightResponse', locDict5) + call locDict3 % store('type','absorptionClerk') call locDict3 % store('map', locDict4) - call locDict2 % store('imcWeight', locDict3) + call locDict2 % store('imcWeightTally', locDict3) allocate(self % imcWeightAtch) call self % imcWeightAtch % init(locDict2) From b714486517d741f110be70bf0788a6f01b482f73 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 23 Nov 2022 15:42:29 +0000 Subject: [PATCH 257/373] Fixed a few typos --- Tallies/TallyClerks/collisionClerk_class.f90 | 4 ++-- Tallies/TallyClerks/tallyClerk_inter.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Tallies/TallyClerks/collisionClerk_class.f90 b/Tallies/TallyClerks/collisionClerk_class.f90 index 53182c009..ef7f8a7a1 100644 --- a/Tallies/TallyClerks/collisionClerk_class.f90 +++ b/Tallies/TallyClerks/collisionClerk_class.f90 @@ -57,7 +57,7 @@ module collisionClerk_class class(tallyMap), allocatable :: map type(tallyResponseSlot),dimension(:),allocatable :: response - ! Usefull data + ! Useful data integer(shortInt) :: width = 0 contains @@ -93,7 +93,7 @@ subroutine init(self, dict, name) ! Assign name call self % setName(name) - ! Load filetr + ! Load filter if( dict % isPresent('filter')) then call new_tallyFilter(self % filter, dict % getDictPtr('filter')) end if diff --git a/Tallies/TallyClerks/tallyClerk_inter.f90 b/Tallies/TallyClerks/tallyClerk_inter.f90 index 4b4da83ed..6bc80b975 100644 --- a/Tallies/TallyClerks/tallyClerk_inter.f90 +++ b/Tallies/TallyClerks/tallyClerk_inter.f90 @@ -47,7 +47,7 @@ module tallyClerk_inter !! Interface: !! init -> Initialise Clerk from a dictionary !! kill -> Return to Uninitialised State - !! validReports -> Returns array of integers with tallyCodes of reports that the clark requires + !! validReports -> Returns array of integers with tallyCodes of reports that the clerk requires !! getSize -> Return size required by Clerk on ScoreMemory !! setMemAddress -> Setter for "memAddress" member !! getMemAddress -> Getter for "memAddress" member From 2d4907c826fd418d4b2989741b16eec345283bda Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 23 Nov 2022 15:43:46 +0000 Subject: [PATCH 258/373] Deleted reference to material menu mod --- Tallies/tallyAdmin_class.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/Tallies/tallyAdmin_class.f90 b/Tallies/tallyAdmin_class.f90 index e27f6ee5e..544d51549 100644 --- a/Tallies/tallyAdmin_class.f90 +++ b/Tallies/tallyAdmin_class.f90 @@ -17,7 +17,6 @@ module tallyAdmin_class ! Nuclear Data Interface use nuclearDataReg_mod, only : ndReg_get => get use nuclearDatabase_inter, only : nuclearDatabase - use materialMenu_mod, only : mm_nMat => nMat implicit none private From c2bc146da87dc60beae1dc5edc4e1a89afa54de9 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 23 Nov 2022 16:10:49 +0000 Subject: [PATCH 259/373] Changed ISMC Physics package to work with new tally --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 22 ++++++++++++-------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index c8fe51abf..08a92e4f2 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -47,7 +47,7 @@ module ISMCPhysicsPackage_class use tallyCodes use tallyAdmin_class, only : tallyAdmin use tallyResult_class, only : tallyResult - use imcWeightClerk_class, only : imcWeightResult + use absorptionClerk_class, only : absClerkResult ! Factories use transportOperatorFactory_func, only : new_transportOperator @@ -293,15 +293,15 @@ subroutine steps(self, tally, tallyAtch, N_steps) call tally % display() ! Obtain energy deposition tally results - call tallyAtch % getResult(tallyRes, 'imcWeight') + call tallyAtch % getResult(tallyRes, 'imcWeightTally') select type(tallyRes) - class is(imcWeightResult) + class is(absClerkResult) do j = 1, self % nMat - tallyEnergy(j) = tallyRes % imcWeight(j) + tallyEnergy(j) = tallyRes % clerkResults(j) end do class default - call fatalError(Here, 'Invalid result has been returned') + call fatalError(Here, 'Tally result class should be absClerkResult') end select ! Update material properties @@ -318,7 +318,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) print * ! Reset tally for next cycle - call tallyAtch % reset('imcWeight') + call tallyAtch % reset('imcWeightTally') print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_steps) @@ -373,7 +373,7 @@ subroutine init(self, dict) class(ISMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict class(dictionary),pointer :: tempDict - type(dictionary) :: locDict1, locDict2, locDict3, locDict4 + type(dictionary) :: locDict1, locDict2, locDict3, locDict4, locDict5 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -488,12 +488,16 @@ subroutine init(self, dict) ! Initialise imcWeight tally attachment call locDict2 % init(1) - call locDict3 % init(2) + call locDict3 % init(4) call locDict4 % init(2) + call locDict5 % init(1) + call locDict5 % store('type', 'weightResponse') call locDict4 % store('type','materialMap') call locDict4 % store('materials', [mats]) - call locDict3 % store('type','imcWeightClerk') + call locDict3 % store('response', ['imcWeightResponse']) + call locDict3 % store('imcWeightResponse', locDict5) + call locDict3 % store('type','absorptionClerk') call locDict3 % store('map', locDict4) call locDict2 % store('imcWeight', locDict3) From d3870feed3061e9dd3aec0db0bfe996e59947e0e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 23 Nov 2022 16:15:33 +0000 Subject: [PATCH 260/373] Another change to bring ISMC phys package in line with IMC PP --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 08a92e4f2..f06ae3879 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -446,6 +446,7 @@ subroutine init(self, dict) ! Read particle source definition if( dict % isPresent('source') ) then tempDict => dict % getDictPtr('source') + call tempDict % store('deltaT', self % deltaT) call new_source(self % inputSource, tempDict, self % geom) self % sourceGiven = .true. end if From e3f5d28b2c740018c6f50fc88261f2cd3da92f63 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 24 Nov 2022 15:51:20 +0000 Subject: [PATCH 261/373] Changed a logical expression to a different order, was evaluating strangely before --- Tallies/TallyClerks/absorptionClerk_class.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Tallies/TallyClerks/absorptionClerk_class.f90 b/Tallies/TallyClerks/absorptionClerk_class.f90 index f01d6ddd4..bdf14860b 100644 --- a/Tallies/TallyClerks/absorptionClerk_class.f90 +++ b/Tallies/TallyClerks/absorptionClerk_class.f90 @@ -2,6 +2,7 @@ module absorptionClerk_class use numPrecision use tallyCodes + use universalVariables, only : P_MATERIAL_MG use genericProcedures, only : fatalError use dictionary_class, only : dictionary use particle_class, only : particle, particleState, P_MATERIAL @@ -202,8 +203,8 @@ subroutine reportHist(self, p, xsData, mem) ! Get current particle state state = p - if( p % fate == LEAK_FATE ) return - if( p % isDead .eqv. .false. .and. p % type /= P_MATERIAL) then + if (p % fate == LEAK_FATE) return + if (p % getType() /= P_MATERIAL_MG .and. .not. p % isDead) then call fatalError(Here, 'Particle is still alive') end if From d3d935a3496441ab495aea714bd9c838d4d66aa8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 24 Nov 2022 16:04:36 +0000 Subject: [PATCH 262/373] Fixed incorrect tally name --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index f06ae3879..4f9fadc0a 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -500,7 +500,7 @@ subroutine init(self, dict) call locDict3 % store('imcWeightResponse', locDict5) call locDict3 % store('type','absorptionClerk') call locDict3 % store('map', locDict4) - call locDict2 % store('imcWeight', locDict3) + call locDict2 % store('imcWeightTally', locDict3) allocate(self % imcWeightAtch) call self % imcWeightAtch % init(locDict2) From 0400d24130bb59e50dfbe0c2b4fbd572715c1ac2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 24 Nov 2022 18:48:33 +0000 Subject: [PATCH 263/373] Removed a few unneeded lines and comments --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 2 -- SharedModules/poly_func.f90 | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 2fa310195..7c5057757 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -422,8 +422,6 @@ subroutine updateMatISMC(self, tallyEnergy, printUpdate) self % matEnergy = tallyEnergy self % energyDens = self % matEnergy / self % V - !if(self % matEnergy <= 0.3) self % matEnergy = 0.3 - ! Update material temperature self % T = self % tempFromEnergy() diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index fbb07c03d..09ba31b0d 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -131,7 +131,7 @@ function poly_solve(equation, derivative, x0, const) result(x) ! Call error if not converged if( i >= 1000 ) then - call fatalError(Here, "Solution has not converged after 1000 iterations,"//numToChar(x0)//','//numToChar(const)) + call fatalError(Here, "Solution has not converged after 1000 iterations") end if ! Increase counter From abb6d89aaff72204dbe4079f201460225372dfed Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 24 Nov 2022 18:50:41 +0000 Subject: [PATCH 264/373] Added workaround for issue where an infinite cross section (due to 0 energy) gives NaN as a tally --- Tallies/TallyClerks/absorptionClerk_class.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Tallies/TallyClerks/absorptionClerk_class.f90 b/Tallies/TallyClerks/absorptionClerk_class.f90 index bdf14860b..65e0d4b46 100644 --- a/Tallies/TallyClerks/absorptionClerk_class.f90 +++ b/Tallies/TallyClerks/absorptionClerk_class.f90 @@ -231,7 +231,11 @@ subroutine reportHist(self, p, xsData, mem) ! Append all bins do i=1,self % width - scoreVal = self % response(i) % get(p, xsData) * p % w *flx + scoreVal = self % response(i) % get(p, xsData) * p % w * flx + ! Deal with infinite cross sections - may not be the right solution for generality + if (scoreVal /= scoreVal) then + scoreVal = p % w + end if call mem % score(scoreVal, adrr + i) end do From 57af01989d0fb75d62bf478a60e921b74b439ac2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 24 Nov 2022 18:53:35 +0000 Subject: [PATCH 265/373] Added a way to switch from DT to ST mid calculation. Also fixed error where dColl was being used instead of dTime. --- TransportOperator/transportOperatorIMC_class.f90 | 11 +++++++---- TransportOperator/transportOperatorTimeHT_class.f90 | 2 +- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 0b4b20632..937a6c15b 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -192,7 +192,7 @@ subroutine deltaTracking(self, p) ! If dTime < dColl, move to end of time step location if (dTime < dColl) then - call self % geom % teleport(p % coords, dColl) + call self % geom % teleport(p % coords, dTime) p % fate = AGED_FATE p % time = p % timeMax exit DTLoop @@ -216,6 +216,12 @@ subroutine deltaTracking(self, p) if (sigmaT * self % majorant_inv == 0) call fatalError(Here, '100 % virtual collision chance,& & potentially infinite loop') + ! Switch to ST if particle moves into a region where delta tracking is no longer feasible + if (sigmaT * self % majorant_inv < ONE - self % cutoff) then + call self % surfaceTracking(p) + return + end if + end do DTLoop end subroutine deltaTracking @@ -234,9 +240,6 @@ subroutine materialTransform(self, p, tally) real(defReal), dimension(3) :: dir character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' - ! Confirm that time = 0 - !if (p % time .ne. 0) call fatalError(Here, 'Material particle should have time = 0') - ! Get and verify material pointer self % mat => mgIMCMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG IMC Material") diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 3335d9794..f23f9db1c 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -152,7 +152,7 @@ subroutine deltaTracking(self, p) ! If dTime < dColl, move to end of time step location if (dTime < dColl) then - call self % geom % teleport(p % coords, dColl) + call self % geom % teleport(p % coords, dTime) p % fate = AGED_FATE p % time = p % timeMax exit DTLoop From eb707d977a7ec7d8a1f2c5799a28df550b46249b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 24 Nov 2022 18:55:57 +0000 Subject: [PATCH 266/373] Fixed error where dColl was being used instead of dTime in DT. Silly me. --- TransportOperator/transportOperatorTimeHT_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index da95248b8..590e51acb 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -149,7 +149,7 @@ subroutine deltaTracking(self, p) ! If dTime < dColl, move to end of time step location if (dTime < dColl) then - call self % geom % teleport(p % coords, dColl) + call self % geom % teleport(p % coords, dTime) p % fate = AGED_FATE p % time = p % timeMax exit DTLoop From 322019419721350a1c49f17fe2f7a0c0573186db Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 24 Nov 2022 19:25:55 +0000 Subject: [PATCH 267/373] Changed source to use numer of particles in input file instead of given in PP --- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 4f9fadc0a..1916aa921 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -187,7 +187,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) call self % thisStep % reduceSize(self % limit, self % emptyArray) ! Generate new particles - call self % inputSource % append(self % thisStep, self % pop, p % pRNG) + call self % inputSource % append(self % thisStep, 0, p % pRNG) end if From 76381c8adb303fc17379aafd8129619ed5352b5b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 28 Nov 2022 21:46:03 +0000 Subject: [PATCH 268/373] Some input file changes during testing --- InputFiles/IMC/MarshakWave/marshakWave128 | 267 +++++++++++----------- InputFiles/IMC/MarshakWave/marshakWave64 | 8 +- 2 files changed, 138 insertions(+), 137 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index 4cc945fb5..0ad5e67ed 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -1,18 +1,18 @@ -type IMCPhysicsPackage; +type ISMCPhysicsPackage; -pop 500; -limit 5000; +pop 1000; +limit 1000; steps 10000; timeStepSize 0.05; printUpdates 4; collisionOperator { - photonMG {type IMCMGstd;} + photonMG {type ISMCMGstd;} } transportOperator { - type transportOperatorTimeHT; + type transportOperatorIMC; cutoff 0.9; //majMap { nParticles 10000; lengthScale 0.01; } } source { @@ -24,6 +24,7 @@ source { T 1; dir 1; particle photon; + N 100; } tally { @@ -211,137 +212,137 @@ nuclearData { materials { - mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat17 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat18 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat19 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat20 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat21 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat22 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat23 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat24 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat25 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat26 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat27 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat28 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat29 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat31 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat32 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat17 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat18 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat19 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat20 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat21 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat22 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat23 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat24 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat25 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat26 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat30 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat33 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat34 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat35 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat36 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat37 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat38 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat39 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat40 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat41 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat42 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat43 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat44 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat45 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat46 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat47 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat48 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat49 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat50 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat51 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat52 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat53 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat54 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat55 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat56 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat57 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat58 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat59 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat60 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat61 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat62 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat63 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat64 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat33 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat34 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat35 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat36 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat37 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat38 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat39 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat40 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat41 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat42 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat43 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat44 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat45 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat46 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat47 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat48 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat49 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat50 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat51 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat52 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat53 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat54 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat55 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat56 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat57 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat58 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat59 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat60 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat61 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat62 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat63 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat64 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat65 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat66 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat67 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat68 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat69 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat70 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat71 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat72 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat73 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat74 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat75 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat76 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat77 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat78 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat79 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat80 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat81 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat82 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat83 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat84 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat85 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat86 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat87 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat88 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat89 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat90 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat91 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat92 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat93 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat94 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat95 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat96 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat65 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat66 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat67 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat68 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat69 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat70 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat71 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat72 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat73 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat74 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat75 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat76 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat77 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat78 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat79 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat80 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat81 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat82 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat83 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat84 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat85 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat86 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat87 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat88 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat89 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat90 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat91 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat92 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat93 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat94 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat95 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat96 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat97 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat98 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat99 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat100 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat101 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat102 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat103 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat104 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat105 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat106 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat107 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat108 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat109 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat110 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat111 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat112 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat113 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat114 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat115 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat116 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat117 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat118 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat119 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat120 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat121 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat122 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat123 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat124 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat125 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat126 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat127 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat128 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat97 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat98 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat99 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat100 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat101 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat102 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat103 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat104 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat105 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat106 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat107 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat108 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat109 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat110 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat111 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat112 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat113 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat114 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat115 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat116 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat117 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat118 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat119 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat120 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat121 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat122 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat123 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat124 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat125 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat126 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat127 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat128 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index d1402485b..6b427c685 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -1,8 +1,8 @@ type ISMCPhysicsPackage; -pop 80; -limit 1300; +pop 800; +limit 1600; steps 10000; timeStepSize 0.05; printUpdates 8; @@ -13,7 +13,7 @@ collisionOperator { } transportOperator { - type transportOperatorIMC; cutoff 0.7; majMap { nParticles 5000; lengthScale 0.00625; } + type transportOperatorIMC; cutoff 0.9; //majMap { nParticles 5000; lengthScale 0.00625; } } source { @@ -25,7 +25,7 @@ source { T 1; dir 1; particle photon; - N 20; + N 40; } tally { From 9dac7cf23d6b2d6cd88032495e7e02ae6a94d21e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 29 Nov 2022 10:54:58 +0000 Subject: [PATCH 269/373] Fix to input file --- InputFiles/IMC/MarshakWave/marshakWave64 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 61f7e6021..4f60e7d50 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -2,8 +2,8 @@ type IMCPhysicsPackage; pop 64; -limit 320; -steps 2000; +limit 1000; +steps 10000; timeStepSize 0.05; printUpdates 32; @@ -24,7 +24,7 @@ source { T 1; dir 1; particle photon; - N 20; + N 40; } tally { @@ -169,7 +169,7 @@ nuclearData { mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } + mat30 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } From 9a9da31e7f038ab073a29e53ccaee2e215049580 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 29 Nov 2022 15:59:12 +0000 Subject: [PATCH 270/373] A few minor changes --- .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 10 +++++----- TransportOperator/transportOperatorIMC_class.f90 | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 7c5057757..fa1c35987 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -255,7 +255,7 @@ subroutine setTimeStep(self, dt) ! Deal with 0 temperature - needs more consideration for certain cv if (self % fleck /= self % fleck) then self % eta = ZERO - self % fleck = ONE + self % fleck = 0.70414 end if else @@ -425,6 +425,9 @@ subroutine updateMatISMC(self, tallyEnergy, printUpdate) ! Update material temperature self % T = self % tempFromEnergy() + ! Update sigma + call self % sigmaFromTemp() + ! Update ISMC equivalent of fleck factor beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) self % eta = radiationConstant * self % T**4 / self % energyDens @@ -434,12 +437,9 @@ subroutine updateMatISMC(self, tallyEnergy, printUpdate) ! Deal with 0 temperature - needs more consideration for certain cv if (self % fleck /= self % fleck) then self % eta = ZERO - self % fleck = ONE + self % fleck = 0.70414 end if - ! Update sigma - call self % sigmaFromTemp() - ! Print updated properties if (present(printUpdate)) then if(printUpdate .eqv. .True.) then diff --git a/TransportOperator/transportOperatorIMC_class.f90 b/TransportOperator/transportOperatorIMC_class.f90 index 937a6c15b..95ce041b8 100644 --- a/TransportOperator/transportOperatorIMC_class.f90 +++ b/TransportOperator/transportOperatorIMC_class.f90 @@ -252,7 +252,7 @@ subroutine materialTransform(self, p, tally) p % time = p % time - log(p % pRNG % get()) / (sigmaT*fleck*eta*lightSpeed) ! Deal with eta = 0 causing NaN - if (p % time /= p % time) p % time = INF + if (p % time /= p % time) p % time = p % time -log(p % pRNG % get()) / (1.400*fleck*lightSpeed) ! Exit loop if particle remains material until end of time step if (p % time >= p % timeMax) then From 9ca94385813337ed7bf49c2c5529e843850d6e41 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 29 Nov 2022 16:46:55 +0000 Subject: [PATCH 271/373] Changed particle generation to be proportional to energy, and open a new output file for storing temps --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 29 ++++++++++++++++----- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index a317bfe2d..2b0954f60 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -131,9 +131,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_steps - integer(shortInt) :: i, j, N + integer(shortInt) :: i, j, N, Ntemp type(particle) :: p - real(defReal) :: elapsed_T, end_T, T_toEnd + real(defReal) :: elapsed_T, end_T, T_toEnd, totEnergy real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='steps (IMCPhysicsPackage_class.f90)' @@ -149,28 +149,41 @@ subroutine steps(self, tally, tallyAtch, N_steps) allocate(tallyEnergy(self % nMat)) + open(unit = 10, file = 'temps.txt') + do i=1,N_steps + write(10, '(8A)') numToChar(i) + ! Swap dungeons to store photons remaining from previous time step self % temp_dungeon => self % nextStep self % nextStep => self % thisStep self % thisStep => self % temp_dungeon call self % nextStep % cleanPop() - ! Select number of particles to generate - for now this is an equal number from each zone + ! Select total number of particles to generate from material emission N = self % pop - if(N + self % thisStep % popSize() > self % limit) then + if (N + self % thisStep % popSize() > self % limit) then ! Fleck and Cummings IMC Paper, eqn 4.11 N = self % limit - self % thisStep % popSize() - self % nMat - 1 end if - N = int(N/self % nMat) - if (N == 0) N = 1 + + ! Find total energy to be emitted + totEnergy = 0 + do j=1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + totEnergy = totEnergy + mat % getEmittedRad() + end do ! Add to particle dungeon do j=1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) if (mat % getTemp() > 0) then - call self % IMCSource % append(self % thisStep, N, p % pRNG, j) + ! Choose particle numbers in proportion to zone energy + Ntemp = int(N * mat % getEmittedRad() / totEnergy) + ! Enforce at least 1 particle + if (Ntemp == 0) Ntemp = 1 + call self % IMCSource % append(self % thisStep, Ntemp, p % pRNG, j) end if end do @@ -290,6 +303,8 @@ subroutine steps(self, tally, tallyAtch, N_steps) end do + close(10) + end subroutine steps !! From 88a30c951ad26c9a4ea157d3d2d645dd5cdbb2c2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 29 Nov 2022 16:50:06 +0000 Subject: [PATCH 272/373] Added new term to fleck factor, think it may have been wrong before which was giving correct results but horrible runtimes --- .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 4bc4446bc..fa21bcee0 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -239,7 +239,8 @@ subroutine setTimeStep(self, dt) ! Use time step size to calculate fleck factor if(self % calcType == IMC) then - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT*self % alpha) + beta = 4*radiationConstant* self % T **4 / poly_eval(self % cv, self % T) + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) else if(self % calcType == ISMC) then beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) @@ -377,6 +378,7 @@ end subroutine updateMat subroutine updateMatIMC(self, tallyEnergy) class(baseMgIMCMaterial), intent(inout) :: self real(defReal), intent(in) :: tallyEnergy + real(defReal) :: beta character(100), parameter :: Here = "updateMatIMC (baseMgIMCMaterial_class.f90)" ! Update material internal energy @@ -392,7 +394,11 @@ subroutine updateMatIMC(self, tallyEnergy) call fatalError(Here, "Temperature is negative") end if - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*self % deltaT*self % alpha) + beta = 4*radiationConstant* self % T **4 / poly_eval(self % cv, self % T) + + self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) + + write(10, '(8A)') numToChar(self % T) end subroutine updateMatIMC From 0d57c89c7c022978024623bd32fe1e183ee9c1fb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 29 Nov 2022 17:31:41 +0000 Subject: [PATCH 273/373] Changes to input files --- InputFiles/IMC/MarshakWave/marshakWave16 | 43 ++++++++++++------------ InputFiles/IMC/MarshakWave/marshakWave64 | 14 ++++---- 2 files changed, 29 insertions(+), 28 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 index 0092475a5..feef5d7a6 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave16 +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -1,10 +1,10 @@ type IMCPhysicsPackage; -pop 500; -limit 5000; -steps 10000; -timeStepSize 0.05; +pop 16000; +limit 320000; +steps 1000; +timeStepSize 0.5; printUpdates 4; collisionOperator { @@ -12,7 +12,7 @@ collisionOperator { } transportOperator { - type transportOperatorTimeHT; + type transportOperatorTimeHT; cutoff 0.0; } source { @@ -24,6 +24,7 @@ source { T 1; dir 1; particle photon; + N 1000; } tally { @@ -84,22 +85,22 @@ nuclearData { materials { - mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } + mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index 4f60e7d50..a51cdd2f9 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -1,18 +1,18 @@ type IMCPhysicsPackage; -pop 64; -limit 1000; -steps 10000; -timeStepSize 0.05; -printUpdates 32; +pop 64000; +limit 2560000; +steps 1000; +timeStepSize 0.5; +printUpdates 4; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorTimeHT; + type transportOperatorTimeHT; cutoff 0.0; } source { @@ -24,7 +24,7 @@ source { T 1; dir 1; particle photon; - N 40; + N 500; } tally { From 48a366dfd68e30bf454cd16a894aaf375b2e5620 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 1 Dec 2022 12:34:48 +0000 Subject: [PATCH 274/373] Added some commented lines to for using transportOperatorIMC in this branch --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 2b0954f60..c70634c6c 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -151,6 +151,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) open(unit = 10, file = 'temps.txt') + ! Build connections between materials + !call self % transOp % buildMajMap(p % pRNG, self % nucData) + do i=1,N_steps write(10, '(8A)') numToChar(i) @@ -198,6 +201,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) call tally % reportCycleStart(self % thisStep) + ! Update majorants for transport operator + !call self % transOp % updateMajorants(p % pRNG) + ! Assign new maximum particle time p % timeMax = self % deltaT * i @@ -437,7 +443,7 @@ subroutine init(self, dict) ! Build transport operator tempDict => dict % getDictPtr('transportOperator') - call new_transportOperator(self % transOp, tempDict) + call new_transportOperator(self % transOp, tempDict, self % geom) ! Initialise tally Admin tempDict => dict % getDictPtr('tally') From 1dfd41c720798fe9b29ff9963121c4924637bda0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 1 Dec 2022 18:25:06 +0000 Subject: [PATCH 275/373] Moved a couple of lines to get rid of duplicated line and fixed incorrect exponent --- .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index fa21bcee0..d8d74cbd5 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -237,16 +237,16 @@ subroutine setTimeStep(self, dt) self % deltaT = dt + beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + ! Use time step size to calculate fleck factor if(self % calcType == IMC) then - beta = 4*radiationConstant* self % T **4 / poly_eval(self % cv, self % T) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) else if(self % calcType == ISMC) then - beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) eta = radiationConstant * self % T**4 / self % matEnergy zeta = beta - eta - self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) + self % fleck = 1/(1 + zeta*self % sigmaP*lightSpeed*self % deltaT) else call fatalError(Here, 'Calculation type invalid or not set') @@ -394,7 +394,7 @@ subroutine updateMatIMC(self, tallyEnergy) call fatalError(Here, "Temperature is negative") end if - beta = 4*radiationConstant* self % T **4 / poly_eval(self % cv, self % T) + beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) From 64da15aeeee62093e22c7b812cc8dae40348420f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 1 Dec 2022 18:30:07 +0000 Subject: [PATCH 276/373] Added comment --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 2b0954f60..be1868181 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -149,6 +149,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) allocate(tallyEnergy(self % nMat)) + ! Create temps.txt file for easy access to results open(unit = 10, file = 'temps.txt') do i=1,N_steps From 8b2ce72b85713625fa3daa6617ce2d024d85d50a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 23 Dec 2022 14:25:28 +0000 Subject: [PATCH 277/373] Changed comments and errors, moved things in line, and added sampleWeight subroutine for clarity --- .../Source/bbSurfaceSource_class.f90 | 78 ++++++++++++------- ParticleObjects/Source/configSource_inter.f90 | 17 +++- 2 files changed, 65 insertions(+), 30 deletions(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index a56f3ef6e..9c02b87c6 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -70,6 +70,7 @@ module bbSurfaceSource_class procedure :: samplePosition procedure :: sampleEnergy procedure :: sampleEnergyAngle + procedure :: sampleWeight procedure :: kill end type bbSurfaceSource @@ -82,19 +83,17 @@ module bbSurfaceSource_class !! !! Errors: !! - error if an unrecognised particle type is provided - !! - error if source is not inside geometry - !! - error if either direction or position have more than 3 components - !! - error if both CE and MG is specified - !! - error if neither energy type is specified + !! - error if an axis other than x, y, or z is given + !! - error if shape is not square or circle !! subroutine init(self, dict, geom) - class(bbSurfaceSource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - character(30) :: type, tempName - integer(shortInt) :: matIdx, uniqueID - logical(defBool) :: isCE, isMG - real(defReal) :: temp + class(bbSurfaceSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + character(30) :: type, tempName + integer(shortInt) :: matIdx, uniqueID + logical(defBool) :: isCE, isMG + real(defReal) :: temp character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' ! Provide geometry info to source @@ -131,7 +130,7 @@ subroutine init(self, dict, geom) self % r(3) = temp self % axis = 3 case default - call fatalError(Here, 'Unrecognised axis, may onlt be x, y or z') + call fatalError(Here, 'Unrecognised axis, may only be x, y or z') end select ! Get size of boundary surface @@ -171,6 +170,13 @@ subroutine init(self, dict, geom) end subroutine init + !! + !! Add particles to given dungeon + !! + !! See source_inter for details + !! + !! If N is given as 0, then N is instead taken from the input dictionary defining this source + !! subroutine append(self, dungeon, N, rand, matIdx) class(bbSurfaceSource), intent(inout) :: self type(particleDungeon), intent(inout) :: dungeon @@ -210,11 +216,11 @@ end subroutine sampleType !! See configSource_inter for details. !! subroutine samplePosition(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - real(defReal), dimension(3) :: prevPos - real(defReal) :: r1, r2, rad, theta + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal), dimension(3) :: prevPos + real(defReal) :: r1, r2, rad, theta if ( self % planeShape == 0 ) then ! Square @@ -259,10 +265,10 @@ end subroutine samplePosition !! Only isotropic/fixed direction. Does not sample energy. !! subroutine sampleEnergyAngle(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - real(defReal) :: r, phi, theta + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: r, phi, theta r = rand % get() phi = TWO_PI * r @@ -272,24 +278,40 @@ subroutine sampleEnergyAngle(self, p, rand) ! If dir not equal to zero, adjust so that particles are travelling in correct direction if (self % dir /= 0) then - p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir + p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir end if end subroutine sampleEnergyAngle !! - !! Provide particle energy + !! Provide particle energy, currently only a single group + !! + !! See configSource_inter for details. + !! + subroutine sampleEnergy(self, p, rand) + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: num + + p % isMG = .true. + p % G = 1 + + end subroutine sampleEnergy + + !! + !! Provide particle energy-weight !! !! Sampled as a black body surface, see "Four Decades of Implicit Monte Carlo", !! Allan B Wollaber, p.24-25 !! !! See configSource_inter for details. !! - subroutine sampleEnergy(self, p, rand) + subroutine sampleWeight(self, p, rand) class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - real(defReal) :: num + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: num num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * self % area p % wgt = num / (4 * self % N) @@ -300,7 +322,7 @@ subroutine sampleEnergy(self, p, rand) p % isMG = .true. p % G = 1 - end subroutine sampleEnergy + end subroutine sampleWeight !! !! Return to uninitialised state diff --git a/ParticleObjects/Source/configSource_inter.f90 b/ParticleObjects/Source/configSource_inter.f90 index 7c14be07d..6aa274c80 100644 --- a/ParticleObjects/Source/configSource_inter.f90 +++ b/ParticleObjects/Source/configSource_inter.f90 @@ -32,6 +32,7 @@ module configSource_inter contains procedure :: sampleParticle + procedure :: sampleWeight procedure(sampleType), deferred :: sampleType procedure(samplePosition), deferred :: samplePosition procedure(sampleEnergy), deferred :: sampleEnergy @@ -133,12 +134,24 @@ function sampleParticle(self, rand) result(p) call self % samplePosition(p, rand) call self % sampleEnergyAngle(p, rand) call self % sampleEnergy(p, rand) + call self % sampleWeight(p, rand) p % time = ZERO - if (p % wgt == ZERO) p % wgt = ONE - end function sampleParticle + !! + !! Set particle's weight to 1. + !! Can be overriden in subclasses if needed. + !! + subroutine sampleWeight(self, p, rand) + class(configSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + + p % wgt = ONE + + end subroutine sampleWeight + !! !! Return to uninitialised state !! From 83624c6a20d5a26b525c3dcc97652579bd97e01c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 23 Dec 2022 14:32:02 +0000 Subject: [PATCH 278/373] Changed a few lines of comments --- InputFiles/IMC/Sample/imcSampleInput | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput index 67649f333..c9621c625 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -7,8 +7,9 @@ type IMCPhysicsPackage; pop 1000; - // Total number of particles to be emitted during each time step from material. If an additional - // source is given, this is also the number of particles emitted from that source. + // Maximum total number of particles to be emitted during each time step from all material. + // This number is split between material regions based on the energy they are emitting and is + // reduced if limit is going to be reached. limit 10000; // Sets the maximum size of particle dungeons. Runtime is very dependent on this value so should From 35ef100f3047f563e5fbcd36bef7841eec47fba3 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 23 Dec 2022 17:28:13 +0000 Subject: [PATCH 279/373] Changed temperatures to be correct --- InputFiles/IMC/MarshakWave/marshakWave128 | 265 +++++++++++----------- InputFiles/IMC/MarshakWave/marshakWave32 | 64 +++--- InputFiles/IMC/MarshakWave/marshakWave8 | 16 +- 3 files changed, 173 insertions(+), 172 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index 4cc945fb5..0536f5074 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -1,10 +1,10 @@ type IMCPhysicsPackage; -pop 500; -limit 5000; -steps 10000; -timeStepSize 0.05; +pop 12800; +limit 204800; +steps 1000; +timeStepSize 0.5; printUpdates 4; collisionOperator { @@ -24,6 +24,7 @@ source { T 1; dir 1; particle photon; + N 1000; } tally { @@ -211,137 +212,137 @@ nuclearData { materials { - mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat17 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat18 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat19 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat20 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat21 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat22 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat23 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat24 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat25 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat26 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat27 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat28 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat29 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat31 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat32 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat17 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat18 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat19 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat20 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat21 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat22 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat23 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat24 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat25 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat26 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat30 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat33 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat34 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat35 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat36 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat37 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat38 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat39 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat40 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat41 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat42 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat43 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat44 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat45 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat46 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat47 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat48 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat49 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat50 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat51 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat52 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat53 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat54 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat55 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat56 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat57 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat58 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat59 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat60 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat61 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat62 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat63 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat64 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat33 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat34 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat35 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat36 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat37 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat38 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat39 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat40 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat41 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat42 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat43 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat44 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat45 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat46 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat47 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat48 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat49 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat50 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat51 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat52 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat53 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat54 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat55 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat56 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat57 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat58 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat59 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat60 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat61 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat62 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat63 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat64 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat65 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat66 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat67 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat68 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat69 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat70 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat71 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat72 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat73 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat74 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat75 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat76 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat77 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat78 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat79 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat80 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat81 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat82 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat83 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat84 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat85 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat86 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat87 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat88 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat89 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat90 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat91 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat92 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat93 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat94 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat95 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat96 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat65 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat66 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat67 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat68 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat69 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat70 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat71 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat72 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat73 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat74 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat75 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat76 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat77 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat78 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat79 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat80 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat81 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat82 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat83 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat84 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat85 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat86 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat87 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat88 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat89 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat90 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat91 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat92 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat93 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat94 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat95 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat96 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat97 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat98 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat99 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat100 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat101 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat102 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat103 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat104 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat105 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat106 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat107 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat108 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat109 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat110 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat111 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat112 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat113 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat114 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat115 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat116 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat117 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat118 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat119 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat120 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat121 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat122 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat123 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat124 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat125 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat126 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat127 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat128 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat97 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat98 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat99 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat100 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat101 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat102 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat103 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat104 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat105 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat106 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat107 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat108 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat109 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat110 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat111 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat112 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat113 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat114 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat115 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat116 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat117 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat118 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat119 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat120 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat121 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat122 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat123 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat124 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat125 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat126 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat127 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } + mat128 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 2acef0a81..54d335252 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -102,38 +102,38 @@ nuclearData { materials { - mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat9 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat10 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat11 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat12 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat13 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat14 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat15 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat16 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat17 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat18 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat19 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat20 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat21 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat22 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat23 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat24 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat25 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat26 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat27 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat28 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat29 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat30 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat31 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat32 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat17 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat18 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat19 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat20 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat21 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat22 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat23 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat24 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat25 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat26 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat30 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } + mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 index 45a7c878c..3396e5d6c 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave8 +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -76,14 +76,14 @@ nuclearData { materials { - mat1 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat2 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat3 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat4 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat5 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat6 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat7 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat8 { temp 0.1; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } + mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } } From d9d2216710279bacbc7057ce7bdbf786c0b362fb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 23 Dec 2022 18:49:54 +0000 Subject: [PATCH 280/373] Fixed incorrect exponent --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index d8d74cbd5..e14576f02 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -237,7 +237,7 @@ subroutine setTimeStep(self, dt) self % deltaT = dt - beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + beta = 4 * radiationConstant * self % T**4 / poly_eval(self % cv, self % T) ! Use time step size to calculate fleck factor if(self % calcType == IMC) then @@ -394,7 +394,7 @@ subroutine updateMatIMC(self, tallyEnergy) call fatalError(Here, "Temperature is negative") end if - beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + beta = 4 * radiationConstant * self % T**4 / poly_eval(self % cv, self % T) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) @@ -417,7 +417,7 @@ subroutine updateMatISMC(self, tallyEnergy) self % T = self % tempFromEnergy() ! Update ISMC equivalent of fleck factor - beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + beta = 4*radiationConstant * self % T**4 / poly_eval(self % cv, self % T) eta = radiationConstant * self % T**4 / self % matEnergy zeta = beta - eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) From caf864b6ed924061ac7e42e5cf48016c9e7e3b4d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 26 Dec 2022 13:56:19 +0000 Subject: [PATCH 281/373] Fixed equation --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index ada33bdc8..25b4669bf 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -245,7 +245,7 @@ subroutine setTimeStep(self, dt) ! Use time step size to calculate fleck factor if(self % calcType == IMC) then - beta = 4*radiationConstant* self % T **4 / poly_eval(self % cv, self % T) + beta = 4*radiationConstant* self % T **3 / poly_eval(self % cv, self % T) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) else if(self % calcType == ISMC) then @@ -399,7 +399,7 @@ subroutine updateMatIMC(self, tallyEnergy, printUpdate) call fatalError(Here, "Temperature is negative") end if - beta = 4*radiationConstant* self % T **4 / poly_eval(self % cv, self % T) + beta = 4*radiationConstant* self % T **3 / poly_eval(self % cv, self % T) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) From 3cfaaba88b87fa1d00f53df0529e686e8d08edd8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 26 Dec 2022 16:51:18 +0000 Subject: [PATCH 282/373] Fixed equation --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index e14576f02..d8d74cbd5 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -237,7 +237,7 @@ subroutine setTimeStep(self, dt) self % deltaT = dt - beta = 4 * radiationConstant * self % T**4 / poly_eval(self % cv, self % T) + beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) ! Use time step size to calculate fleck factor if(self % calcType == IMC) then @@ -394,7 +394,7 @@ subroutine updateMatIMC(self, tallyEnergy) call fatalError(Here, "Temperature is negative") end if - beta = 4 * radiationConstant * self % T**4 / poly_eval(self % cv, self % T) + beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) @@ -417,7 +417,7 @@ subroutine updateMatISMC(self, tallyEnergy) self % T = self % tempFromEnergy() ! Update ISMC equivalent of fleck factor - beta = 4*radiationConstant * self % T**4 / poly_eval(self % cv, self % T) + beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) eta = radiationConstant * self % T**4 / self % matEnergy zeta = beta - eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) From c985e410dfd9d0c6df167e1856bfbffa8dbc4bb2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 26 Dec 2022 16:52:07 +0000 Subject: [PATCH 283/373] Temporary changes to input file numbers --- InputFiles/IMC/MarshakWave/marshakWave128 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index 0536f5074..f052b69d8 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -1,10 +1,10 @@ type IMCPhysicsPackage; -pop 12800; -limit 204800; -steps 1000; -timeStepSize 0.5; +pop 10000; +limit 200000; +steps 10000; +timeStepSize 0.05; printUpdates 4; collisionOperator { @@ -12,7 +12,7 @@ collisionOperator { } transportOperator { - type transportOperatorTimeHT; + type transportOperatorTimeHT; cutoff 0.9; } source { @@ -24,7 +24,7 @@ source { T 1; dir 1; particle photon; - N 1000; + N 200; } tally { From daab741ed9cfd6cf7e027e83faf551a4f74d9ed8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 26 Dec 2022 16:54:20 +0000 Subject: [PATCH 284/373] Temporary change to number in input file --- InputFiles/IMC/MarshakWave/marshakWave128 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index 0ad5e67ed..7f3b8431f 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -1,8 +1,8 @@ type ISMCPhysicsPackage; -pop 1000; -limit 1000; +pop 10000; +limit 200000; steps 10000; timeStepSize 0.05; printUpdates 4; @@ -12,7 +12,7 @@ collisionOperator { } transportOperator { - type transportOperatorIMC; cutoff 0.9; //majMap { nParticles 10000; lengthScale 0.01; } + type transportOperatorIMC; cutoff 0.9; } source { @@ -24,7 +24,7 @@ source { T 1; dir 1; particle photon; - N 100; + N 200; } tally { From cbacacaa446f2501f784ff8884e39527f00c657a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 26 Dec 2022 16:57:07 +0000 Subject: [PATCH 285/373] Another temporary change --- InputFiles/IMC/MarshakWave/marshakWave128 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index 7f3b8431f..79253e1d0 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -1,18 +1,18 @@ -type ISMCPhysicsPackage; +type IMCPhysicsPackage; pop 10000; limit 200000; -steps 10000; +steps 1000; timeStepSize 0.05; printUpdates 4; collisionOperator { - photonMG {type ISMCMGstd;} + photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorIMC; cutoff 0.9; + type transportOperatorTimeHT; cutoff 0.9; } source { From 06bfeab5ae6af2fd6942953728c24344384c5887 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 27 Dec 2022 14:09:07 +0000 Subject: [PATCH 286/373] Fixed particle direction sampling, had an older version committed --- .../Source/bbSurfaceSource_class.f90 | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 9c02b87c6..e87dd74f5 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -268,19 +268,19 @@ subroutine sampleEnergyAngle(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal) :: r, phi, theta + real(defReal) :: phi, mu - r = rand % get() - phi = TWO_PI * r - r = rand % get() - theta = acos(1 - TWO * r) - p % dir = [cos(phi) * sin(theta), sin(phi) * sin(theta), cos(theta)] + phi = TWO_PI * rand % get() + mu = sqrt(rand % get()) + + p % dir = [mu, sqrt(1-mu**2)*cos(phi), sqrt(1-mu**2)*sin(phi)] ! If dir not equal to zero, adjust so that particles are travelling in correct direction if (self % dir /= 0) then - p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir + p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir end if + end subroutine sampleEnergyAngle !! @@ -319,9 +319,6 @@ subroutine sampleWeight(self, p, rand) ! If dir = 0 then emit in both directions => double total energy if (self % dir == 0) p % wgt = 2*p % wgt - p % isMG = .true. - p % G = 1 - end subroutine sampleWeight !! From b3d14ef0806ede6fe9155f97cba4b61d7c7d6c2b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 30 Dec 2022 12:21:27 +0000 Subject: [PATCH 287/373] Change to mat class to be similar to other branch --- .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 25b4669bf..746a83718 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -243,13 +243,13 @@ subroutine setTimeStep(self, dt) self % deltaT = dt + beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + ! Use time step size to calculate fleck factor if(self % calcType == IMC) then - beta = 4*radiationConstant* self % T **3 / poly_eval(self % cv, self % T) - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) + self % fleck = 1/(1+self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) else if(self % calcType == ISMC) then - beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) self % eta = radiationConstant * self % T**4 / self % energyDens zeta = beta - self % eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) @@ -263,7 +263,6 @@ subroutine setTimeStep(self, dt) call fatalError(Here, 'Calculation type invalid or not set') end if - end subroutine setTimeStep !! @@ -399,7 +398,7 @@ subroutine updateMatIMC(self, tallyEnergy, printUpdate) call fatalError(Here, "Temperature is negative") end if - beta = 4*radiationConstant* self % T **3 / poly_eval(self % cv, self % T) + beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) From 0777e7f31cf1a71f5973bbfd7734a829cc517477 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 5 Jan 2023 13:40:58 +0000 Subject: [PATCH 288/373] Made PP mostly parallel, and changed to only output temps at end of simulation rather than every time step --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 2 - PhysicsPackages/IMCPhysicsPackage_class.f90 | 62 +++++++++++++------ 2 files changed, 42 insertions(+), 22 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index d8d74cbd5..55b0f3744 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -398,8 +398,6 @@ subroutine updateMatIMC(self, tallyEnergy) self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) - write(10, '(8A)') numToChar(self % T) - end subroutine updateMatIMC !! diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index be1868181..62b05d6aa 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -131,31 +131,35 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_steps - integer(shortInt) :: i, j, N, Ntemp - type(particle) :: p + integer(shortInt) :: i, j, N, Ntemp, num, nParticles + type(particle), save :: p real(defReal) :: elapsed_T, end_T, T_toEnd, totEnergy real(defReal), dimension(:), allocatable :: tallyEnergy - class(IMCMaterial), pointer :: mat + class(IMCMaterial), pointer, save :: mat character(100),parameter :: Here ='steps (IMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes + type(collisionOperator), save :: collOp + class(transportOperator), allocatable, save :: transOp + type(RNG), target, save :: pRNG + !$omp threadprivate(p, collOp, transOp, pRNG, mat) - ! Attach nuclear data and RNG to particle - p % pRNG => self % pRNG + !$omp parallel p % geomIdx = self % geomIdx + ! Create a collision + transport operator which can be made thread private + collOp = self % collOp + transOp = self % transOp + + !$omp end parallel + ! Reset and start timer call timerReset(self % timerMain) call timerStart(self % timerMain) allocate(tallyEnergy(self % nMat)) - ! Create temps.txt file for easy access to results - open(unit = 10, file = 'temps.txt') - do i=1,N_steps - write(10, '(8A)') numToChar(i) - ! Swap dungeons to store photons remaining from previous time step self % temp_dungeon => self % nextStep self % nextStep => self % thisStep @@ -184,13 +188,13 @@ subroutine steps(self, tally, tallyAtch, N_steps) Ntemp = int(N * mat % getEmittedRad() / totEnergy) ! Enforce at least 1 particle if (Ntemp == 0) Ntemp = 1 - call self % IMCSource % append(self % thisStep, Ntemp, p % pRNG, j) + call self % IMCSource % append(self % thisStep, Ntemp, self % pRNG, j) end if end do ! Generate from input source if( self % sourceGiven ) then - call self % inputSource % append(self % thisStep, 0, p % pRNG) + call self % inputSource % append(self % thisStep, 0, self % pRNG) end if if(self % printSource == 1) then @@ -199,10 +203,16 @@ subroutine steps(self, tally, tallyAtch, N_steps) call tally % reportCycleStart(self % thisStep) - ! Assign new maximum particle time - p % timeMax = self % deltaT * i + nParticles = self % thisStep % popSize() + + !$omp parallel do schedule(dynamic) + gen: do num = 1, nParticles + + ! Create RNG which can be thread private + pRNG = self % pRNG + p % pRNG => pRNG + call p % pRNG % stride(num) - gen: do ! Obtain paticle from dungeon call self % thisStep % release(p) call self % geom % placeCoord(p % coords) @@ -212,6 +222,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) call fatalError(Here, 'Particle is not of type P_PHOTON_MG') end if + ! Assign maximum particle time + p % timeMax = self % deltaT * i + ! For newly sourced particles, sample time uniformly within time step if (p % time == ZERO) then p % time = (p % pRNG % get() + i-1) * self % deltaT @@ -229,7 +242,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Transport particle until its death history: do - call self % transOp % transport(p, tally, self % thisStep, self % nextStep) + call transOp % transport(p, tally, self % thisStep, self % nextStep) if(p % isDead) exit history if(p % fate == AGED_FATE) then @@ -239,16 +252,17 @@ subroutine steps(self, tally, tallyAtch, N_steps) exit history end if - call self % collOp % collide(p, tally, self % thisStep, self % nextStep) + call collOp % collide(p, tally, self % thisStep, self % nextStep) if(p % isDead) exit history end do history - ! When dungeon is empty, exit - if (self % thisStep % isEmpty()) exit gen - end do gen + !$omp end parallel do + + ! Update RNG + call self % pRNG % stride(nParticles) ! Send end of time step report call tally % reportCycleEnd(self % thisStep) @@ -285,6 +299,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) end select ! Update material properties + !$omp parallel do do j = 1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) if (j <= self % printUpdates) then @@ -295,6 +310,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) call mat % updateMat(tallyEnergy(j), .false.) end if end do + !$omp end parallel do print * ! Reset tally for next time step @@ -304,6 +320,12 @@ subroutine steps(self, tally, tallyAtch, N_steps) end do + ! Output final mat temperatures + open(unit = 10, file = 'temps.txt') + do j = 1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + write(10, '(8A)') numToChar(mat % getTemp()) + end do close(10) end subroutine steps From 88a83cc581da8e82b79f0288ae2ecaf384eedcd2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 5 Jan 2023 14:29:24 +0000 Subject: [PATCH 289/373] Made IMC material source parallel --- ParticleObjects/Source/IMCSource_class.f90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index b39730e4e..d40efbb52 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -101,10 +101,10 @@ subroutine append(self, dungeon, N, rand, matIdx) integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand integer(shortInt), intent(in), optional :: matIdx - type(particleDungeon) :: tempDungeon type(particle) :: p integer(shortInt) :: i real(defReal) :: normFactor + type(RNG) :: pRand character(100), parameter :: Here = "append (IMCSource_class.f90)" ! Assert that optional argument matIdx is in fact present @@ -115,9 +115,15 @@ subroutine append(self, dungeon, N, rand, matIdx) self % matIdx = matIdx ! Add N particles to dungeon + !$omp parallel + pRand = rand + !$omp do private(pRand) do i=1, N - call dungeon % detain(self % sampleParticle(rand)) + call pRand % stride(i) + call dungeon % detain(self % sampleParticle(pRand)) end do + !$omp end do + !$omp end parallel end subroutine append From 1c1e58373e698e02875e02bbf9fd6fde25a3581c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 6 Jan 2023 12:46:15 +0000 Subject: [PATCH 290/373] Tried to add parallel for bbSurfaceSource but for some reason can't get it to work, so left commented for now --- .../Source/bbSurfaceSource_class.f90 | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index e87dd74f5..3b23846f0 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -184,12 +184,27 @@ subroutine append(self, dungeon, N, rand, matIdx) class(RNG), intent(inout) :: rand integer(shortInt), intent(in), optional :: matIdx integer(shortInt) :: i + type(RNG) :: pRand character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' ! Set number to generate. Using 0 in function call will use N from input dictionary if (N /= 0) self % N = N - ! Generate n particles to populate dungeon + +! TODO Parallel for some reason isn't working here, even though changes are the same as IMCSource ??? + + ! Generate N particles to populate dungeon +! !$omp parallel +! pRand = rand +! !$omp do private(pRand) +! do i = 1, self % N +! call pRand % stride(i) +! call dungeon % detain(self % sampleParticle(pRand)) +! end do +! !$omp end do +! !$omp end parallel + + do i = 1, self % N call dungeon % detain(self % sampleParticle(rand)) end do From c78a3aa2f941c304480a8a2f7d755cb73f7ca108 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 7 Jan 2023 12:06:36 +0000 Subject: [PATCH 291/373] Changed to only print temperature, most of the other things printed weren't very useful, and done out of parallel loop as order was being changed --- PhysicsPackages/IMCPhysicsPackage_class.f90 | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 62b05d6aa..a79395c63 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -302,22 +302,21 @@ subroutine steps(self, tally, tallyAtch, N_steps) !$omp parallel do do j = 1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - if (j <= self % printUpdates) then - print * - print *, "Material update: ", mm_matName(j) - call mat % updateMat(tallyEnergy(j), .true.) - else - call mat % updateMat(tallyEnergy(j), .false.) - end if + call mat % updateMat(tallyEnergy(j), .false.) end do !$omp end parallel do print * + ! Print material updates if requested + do j = 1, self % printUpdates + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + print *, ' '//mm_matName(j), numToChar(mat % getTemp()) + end do + print * + ! Reset tally for next time step call tallyAtch % reset('imcWeightTally') - print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_steps) - end do ! Output final mat temperatures From a2cf72bd0f71ffd5f9cb4325eb8783dacb6f7cc7 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 7 Jan 2023 14:10:23 +0000 Subject: [PATCH 292/373] Experimenting with an overlaid geometry grid for hybrid tracking --- Geometry/CMakeLists.txt | 1 + Geometry/geomGrid_class.f90 | 200 ++++++++++++++++++++ Geometry/geometryReg_mod.f90 | 4 + PhysicsPackages/IMCPhysicsPackage_class.f90 | 21 +- 4 files changed, 222 insertions(+), 4 deletions(-) create mode 100644 Geometry/geomGrid_class.f90 diff --git a/Geometry/CMakeLists.txt b/Geometry/CMakeLists.txt index 162a061c6..c14b5d2b6 100644 --- a/Geometry/CMakeLists.txt +++ b/Geometry/CMakeLists.txt @@ -8,6 +8,7 @@ add_sources( ./csg_class.f90 ./geomGraph_class.f90 ./geometry_inter.f90 ./geometryStd_class.f90 + ./geomGrid_class.f90 ./geometryReg_mod.f90 ) diff --git a/Geometry/geomGrid_class.f90 b/Geometry/geomGrid_class.f90 new file mode 100644 index 000000000..67d6c90a5 --- /dev/null +++ b/Geometry/geomGrid_class.f90 @@ -0,0 +1,200 @@ +module geomGrid_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError + use dictionary_class, only : dictionary + use charMap_class, only : charMap + use coord_class, only : coordList + use geometry_inter, only : geometry, distCache + use csg_class, only : csg + use universe_inter, only : universe + + type, public, extends(geometry) :: geomGrid + type(csg) :: geom + + contains + ! Superclass procedures + procedure :: init + procedure :: kill + procedure :: placeCoord + procedure :: whatIsAt + procedure :: bounds + procedure :: move_noCache + procedure :: move_withCache + procedure :: moveGlobal + procedure :: teleport + procedure :: activeMats + + procedure, private :: closestDist + + end type geomGrid + +contains + + !! + !! Initialise geometry + !! + !! See geometry_inter for details + !! + subroutine init(self, dict, mats, silent) + class(geomGrid), intent(inout) :: self + class(dictionary), intent(in) :: dict + type(charMap), intent(in) :: mats + logical(defBool), optional, intent(in) :: silent + logical(defBool) :: loud + + ! Build the representation + call self % geom % init(dict, mats, silent) + + end subroutine init + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(geomGrid), intent(inout) :: self + + call self % geom % kill() + + end subroutine kill + + !! + !! Simply returns distance to closest surface in maxDist variable + !! + !! Unlike in geometryStd, here we do not move particle at all + !! + subroutine move_noCache(self, coords, maxDist, event) + class(geomGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + integer(shortInt) :: surfIdx, lvl + character(100), parameter :: Here = 'move_noCache (geomGrid_class.f90)' + + call self % closestDist(maxDist, surfIdx, lvl, coords) + + end subroutine move_noCache + + !! + !! Return distance to the closest surface + !! + !! Searches through all geometry levels. In addition to distance return level + !! and surfIdx for crossing surface + !! + !! Args: + !! dist [out] -> Value of closest distance + !! surfIdx [out] -> Surface index for the crossing returned from the universe + !! lvl [out] -> Level at which crossing is closest + !! coords [in] -> Current coordinates of a particle + !! + subroutine closestDist(self, dist, surfIdx, lvl, coords) + class(geomGrid), intent(in) :: self + real(defReal), intent(out) :: dist + integer(shortInt), intent(out) :: surfIdx + integer(shortInt), intent(out) :: lvl + type(coordList), intent(in) :: coords + integer(shortInt) :: l, test_idx + real(defReal) :: test_dist + class(universe), pointer :: uni + + dist = INF + surfIdx = 0 + lvl = 0 + do l = 1, coords % nesting + ! Get universe + uni => self % geom % unis % getPtr_fast(coords % lvl(l) % uniIdx) + + ! Find distance + call uni % distance(test_dist, test_idx, coords % lvl(l)) + + ! Save distance, surfIdx & level coresponding to shortest distance + ! Take FP precision into account + if ((dist - test_dist) >= dist * FP_REL_TOL) then + dist = test_dist + surfIdx = test_idx + lvl = l + end if + + end do + + end subroutine closestDist + + + !! + !! Unused superclass procedures + !! + + subroutine placeCoord(self, coords) + class(geomGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + character(100), parameter :: Here = 'placeCoord (geomGrid_class.f90)' + + call fatalError(Here, "Should not be called") + + end subroutine placeCoord + + subroutine whatIsAt(self, matIdx, uniqueID, r, u) + class(geomGrid), intent(in) :: self + integer(shortInt), intent(out) :: matIdx + integer(shortInt), intent(out) :: uniqueID + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(3), optional, intent(in) :: u + character(100), parameter :: Here = 'whatIsAt (geomGrid_class.f90)' + + call fatalError(Here, "Should not be called") + + end subroutine whatIsAt + + function bounds(self) + class(geomGrid), intent(in) :: self + real(defReal), dimension(6) :: bounds + character(100), parameter :: Here = 'bounds (geomGrid_class.f90)' + + call fatalError(Here, "Should not be called") + + end function bounds + + subroutine move_withCache(self, coords, maxDist, event, cache) + class(geomGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + type(distCache), intent(inout) :: cache + character(100), parameter :: Here = 'move_withCache (geomGrid_class.f90)' + + call fatalError(Here, "Should not be called") + + end subroutine move_withCache + + subroutine moveGlobal(self, coords, maxDist, event) + class(geomGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + character(100), parameter :: Here = 'moveGlobal (geomGrid_class.f90)' + + call fatalError(Here, "Should not be called") + + end subroutine moveGlobal + + subroutine teleport(self, coords, dist) + class(geomGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(in) :: dist + character(100), parameter :: Here = 'teleport (geomGrid_class.f90)' + + call fatalError(Here, "Should not be called") + + end subroutine teleport + + function activeMats(self) result(matList) + class(geomGrid), intent(in) :: self + integer(shortInt), dimension(:), allocatable :: matList + character(100), parameter :: Here = 'activeMats (geomGrid_class.f90)' + + call fatalError(Here, "Should not be called") + + end function activeMats + +end module geomGrid_class diff --git a/Geometry/geometryReg_mod.f90 b/Geometry/geometryReg_mod.f90 index d1ea1aa7e..971ae4cbb 100644 --- a/Geometry/geometryReg_mod.f90 +++ b/Geometry/geometryReg_mod.f90 @@ -38,6 +38,7 @@ module geometryReg_mod ! Geometry use geometry_inter, only : geometry use geometryStd_class, only : geometryStd + use geomGrid_class, only : geomGrid ! Fields use field_inter, only : field @@ -348,6 +349,9 @@ subroutine new_geometry(geom, dict, mats, silent) case ('geometryStd') allocate(geometryStd :: geom) + case ('geomGrid') + allocate(geomGrid :: geom) + case default print '(A)', 'AVAILABLE GEOMETRIES' print '(A)', AVAILABLE_GEOMETRIES diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index a79395c63..dcd1f5e2e 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -63,8 +63,9 @@ module IMCPhysicsPackage_class type, public,extends(physicsPackage) :: IMCPhysicsPackage private ! Building blocks - class(nuclearDatabase), pointer :: nucData => null() - class(geometry), pointer :: geom => null() + class(nuclearDatabase), pointer :: nucData => null() + class(geometry), pointer :: geom => null() + class(geometry), pointer :: geomAtch => null() integer(shortInt) :: geomIdx = 0 type(collisionOperator) :: collOp class(transportOperator), allocatable :: transOp @@ -140,8 +141,10 @@ subroutine steps(self, tally, tallyAtch, N_steps) class(tallyResult), allocatable :: tallyRes type(collisionOperator), save :: collOp class(transportOperator), allocatable, save :: transOp - type(RNG), target, save :: pRNG - !$omp threadprivate(p, collOp, transOp, pRNG, mat) + type(RNG), target, save :: pRNG + real(defReal), save :: dist + integer(shortInt) :: event + !$omp threadprivate(p, collOp, transOp, pRNG, mat, dist) !$omp parallel p % geomIdx = self % geomIdx @@ -240,6 +243,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Save state call p % savePreHistory() +call self % geomAtch % move(p % coords, dist, event) +print *, dist + ! Transport particle until its death history: do call transOp % transport(p, tally, self % thisStep, self % nextStep) @@ -436,6 +442,13 @@ subroutine init(self, dict) self % geomIdx = gr_geomIdx(geomName) self % geom => gr_geomPtr(self % geomIdx) + if (dict % isPresent('geometryAtch')) then + tempDict => dict % getDictPtr('geometryAtch') + geomName = 'GridGeom' + call gr_addGeom(geomName, tempDict) + self % geomAtch => gr_geomPtr(gr_geomIdx(geomName)) + end if + ! Activate Nuclear Data *** All materials are active call ndReg_activate(self % particleType, nucData, self % geom % activeMats()) self % nucData => ndReg_get(self % particleType) From 21e71d89bcc038e4c09d2ec810085610a07f89ed Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 11 Jan 2023 14:34:20 +0000 Subject: [PATCH 293/373] Working on new class for a simple grid overlaid on geometry for hybrid tracking --- Geometry/simpleGrid_class.f90 | 275 ++++++++++++++++++++++++++++++++++ 1 file changed, 275 insertions(+) create mode 100644 Geometry/simpleGrid_class.f90 diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 new file mode 100644 index 000000000..d8c85f0c3 --- /dev/null +++ b/Geometry/simpleGrid_class.f90 @@ -0,0 +1,275 @@ +module simpleGrid_class + + use numPrecision + use universalVariables, only : surface_tol + use genericProcedures, only : fatalError, numToChar + use dictionary_class, only : dictionary + use geometry_inter, only : geometry + use dynArray_class, only : dynIntArray + use nuclearDatabase_inter, only : nuclearDatabase + use particle_class, only : particle + + !! + !! + !! + type, private :: gridCell + integer(shortInt), dimension(:), allocatable :: mats + real(defReal) :: majorant + + end type gridCell + + !! + !! As in latUniverse_class, idx is 1 in bottom X, Y & Z corner. + !! It increases first with X then Y and lastly Z. + !! + !! sizeN -> array [nx, ny, nz], the dimensions of the grid + !! dx -> array [dx, dy, dz], the discretisation in each direction + !! bounds -> [x_min, y_min, z_min, z_max, y_max, z_max] as in geometry_inter + !! + type, public :: grid + class(geometry), pointer :: mainGeom => null() + class(nuclearDatabase), pointer :: xsData => null() + integer(shortInt), dimension(:), allocatable :: sizeN + integer(shortInt), dimension(3) :: dx = 0 + real(defReal), dimension(6) :: bounds + type(gridCell), dimension(:), allocatable :: gridCells + + contains + procedure :: init + !procedure :: kill + procedure :: getDistance + procedure :: get + procedure :: storeMats + procedure :: update + + end type grid + + + + +contains + + subroutine init(self, dict, geom, xsData) + class(grid), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), intent(in), pointer :: geom + class(nuclearDatabase), intent(in), pointer :: xsData + integer(shortInt) :: N + integer(shortInt), dimension(:), allocatable :: searchN + + ! Store pointer to main geometry and data + self % mainGeom => geom + self % xsData => xsData + + ! Store settings + call dict % get(self % sizeN, 'dimensions') + call dict % get(searchN, 'searchN') + + ! Get bounds of grid and calculate discretisations + self % bounds = geom % bounds() + self % dx(1) = (self % bounds(4) - self % bounds(1)) / self % sizeN(1) + self % dx(2) = (self % bounds(5) - self % bounds(2)) / self % sizeN(2) + self % dx(3) = (self % bounds(6) - self % bounds(3)) / self % sizeN(3) + + ! Allocate space for cells + N = self % sizeN(1) * self % sizeN(2) * self % sizeN(3) + allocate(self % gridCells(N)) + + ! Find material idxs present in each cell + call self % storeMats(searchN) + + end subroutine init + + + !! + !! May have issues with non-box geometry root universe surface with reflective boundary + !! + function getDistance(self, r, u) result(dist) + class(grid), intent(in) :: self + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(3), intent(in) :: u + real(defReal) :: dist + real(defReal), dimension(3) :: point, corner, ratio + character(100), parameter :: Here = 'getDistance (simpleGrid_class.f90)' + + ! Calculate position in grid + point = r / self % dx + + ! Round each dimension either up or down depending on which boundary will be hit + do i = 1, 3 + if (u(i) >= 0) then + corner(i) = ceiling(point(i)) + else + corner(i) = floor(point(i)) + end if + ! Adjust if starting position was on boundary + if (corner(i) == point(i)) then + corner(i) = corner(i) + sign(ONE, u(i)) + end if + end do + + ! Convert back to spatial coordinates - this is now the coordinates of the corner being travelled towards + corner = corner * self % dx + + ! Determine which axis boundary will be hit first + ratio = (corner - r) / u + + dist = minval(ratio) + + if (dist <= ZERO) call fatalError(Here, 'Distance invalid: '//numToChar(dist)) + + end function getDistance + + + !! + !! Returns value of grid cell at position + !! + function get(self, r, u) result(val) + class(grid), intent(in) :: self + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(3), intent(in) :: u + real(defReal) :: val + integer(shortInt), dimension(3) :: corner + character(100), parameter :: Here = 'get (simpleGrid_class.f90)' + + ! Get grid cell bottom corner + corner = floor(r) + do i = 1, 3 + if (corner(i) == r(i) .and. u(i) < 0) then + ! Adjust for point starting on cell boundary + corner(i) = corner(i) - 1 + end if + end do + + ! Adjust for bottom corner starting at 1 + corner = corner + 1 + + ! Get grid cell idx + idx = get_idx(corner, self % sizeN) + if (idx == 0) call fatalError(Here, 'Point is outside lattice') + + val = self % gridCells(idx) % majorant + + end function get + + !! + !! + !! + subroutine storeMats(self, searchN) + class(grid), intent(inout) :: self + integer(shortInt), dimension(3), intent(in) :: searchN + real(defReal), dimension(3) :: searchRes + integer(shortInt) :: i, j, k, l, matIdx, id + real(defReal), dimension(3) :: corner, r + type(dynIntArray) :: mats + + ! Calculate distance between search points + searchRes = self % dx / (searchN + 1) + + ! Loop through grid cells + do i = 1, size(self % gridCells) + + ! Get cell lower corner + corner = self % dx * (get_ijk(i, self % sizeN) - 1) + + ! Loop through search locations + do j = 1, searchN(1) + do k = 1, searchN(2) + do l = 1, searchN(3) + ! Find matIdx at search location + r = corner + [j, k, l] * searchRes + call self % mainGeom % whatIsAt(matIdx, id, r) + + ! Add to array if not already present + if (mats % isPresent(matIdx)) then + ! Do nothing + else + call mats % add(matIdx) + end if + + end do + end do + end do + + ! Store matIdx data in grid cell + self % gridCells(i) % mats = mats % expose() + + end do + + end subroutine storeMats + + !! + !! + !! + subroutine update(self) + class(grid), intent(inout) :: self + integer(shortInt) :: i, j, matIdx + real(defReal) :: sigmaT + class(particle), allocatable :: p + + ! Loop through grid cells + do i = 1, size(self % gridCells) + ! Reset majorant + self % gridCells(i) % majorant = ZERO + + do j = 1, size(self % gridCells(i) % mats) + ! Get opacity of each material + matIdx = self % gridCells(i) % mats(j) + sigmaT = self % xsData % getTransMatXS(p, matIdx) + + ! Update majorant if required + if (sigmaT > self % gridCells(i) % majorant) self % gridCells(i) % majorant = sigmaT + + end do + + end do + + end subroutine update + + + + !! + !! Generate ijk from localID and shape + !! + !! Args: + !! localID [in] -> Local id of the cell between 1 and product(sizeN) + !! sizeN [in] -> Number of cells in each cardinal direction x, y & z + !! + !! Result: + !! Array ijk which has integer position in each cardinal direction + !! + pure function get_ijk(localID, sizeN) result(ijk) + integer(shortInt), intent(in) :: localID + integer(shortInt), dimension(3), intent(in) :: sizeN + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: temp, base + + temp = localID - 1 + + base = temp / sizeN(1) + ijk(1) = temp - sizeN(1) * base + 1 + + temp = base + base = temp / sizeN(2) + ijk(2) = temp - sizeN(2) * base + 1 + + ijk(3) = base + 1 + + end function get_ijk + + + pure function get_idx(ijk, sizeN) result(idx) + integer(shortInt), dimension(3), intent(in) :: ijk + integer(shortInt), dimension(3), intent(in) :: sizeN + integer(shortInt) :: idx + + if (any(ijk <= 0 .or. ijk > sizeN)) then ! Point is outside lattice + idx = 0 + else + idx = ijk(1) + sizeN(1) * (ijk(2)-1 + sizeN(2) * (ijk(3)-1)) + end if + + end function get_idx + + +end module simpleGrid_class From 400c7b4147ccf1f535cbf093784194739347e04e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 11 Jan 2023 17:34:02 +0000 Subject: [PATCH 294/373] Various fixes --- Geometry/simpleGrid_class.f90 | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index d8c85f0c3..6d72dd7cc 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -30,23 +30,21 @@ module simpleGrid_class class(geometry), pointer :: mainGeom => null() class(nuclearDatabase), pointer :: xsData => null() integer(shortInt), dimension(:), allocatable :: sizeN - integer(shortInt), dimension(3) :: dx = 0 + real(defReal), dimension(3) :: dx = 0 real(defReal), dimension(6) :: bounds + real(defReal), dimension(3) :: corner type(gridCell), dimension(:), allocatable :: gridCells contains procedure :: init !procedure :: kill procedure :: getDistance - procedure :: get + procedure :: getValue procedure :: storeMats procedure :: update end type grid - - - contains subroutine init(self, dict, geom, xsData) @@ -67,10 +65,13 @@ subroutine init(self, dict, geom, xsData) ! Get bounds of grid and calculate discretisations self % bounds = geom % bounds() + self % dx(1) = (self % bounds(4) - self % bounds(1)) / self % sizeN(1) self % dx(2) = (self % bounds(5) - self % bounds(2)) / self % sizeN(2) self % dx(3) = (self % bounds(6) - self % bounds(3)) / self % sizeN(3) + self % corner = [self % bounds(1), self % bounds(2), self % bounds(3)] + ! Allocate space for cells N = self % sizeN(1) * self % sizeN(2) * self % sizeN(3) allocate(self % gridCells(N)) @@ -89,11 +90,12 @@ function getDistance(self, r, u) result(dist) real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: dist - real(defReal), dimension(3) :: point, corner, ratio + real(defReal), dimension(3) :: rbar, point, corner, ratio character(100), parameter :: Here = 'getDistance (simpleGrid_class.f90)' ! Calculate position in grid - point = r / self % dx + rbar = r - self % corner + point = rbar / self % dx ! Round each dimension either up or down depending on which boundary will be hit do i = 1, 3 @@ -112,7 +114,7 @@ function getDistance(self, r, u) result(dist) corner = corner * self % dx ! Determine which axis boundary will be hit first - ratio = (corner - r) / u + ratio = (corner - rbar) / u dist = minval(ratio) @@ -124,18 +126,20 @@ end function getDistance !! !! Returns value of grid cell at position !! - function get(self, r, u) result(val) + function getValue(self, r, u) result(val) class(grid), intent(in) :: self real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: val + real(defReal), dimension(3) :: rbar integer(shortInt), dimension(3) :: corner character(100), parameter :: Here = 'get (simpleGrid_class.f90)' ! Get grid cell bottom corner - corner = floor(r) + rbar = r - self % corner + corner = floor(rbar) do i = 1, 3 - if (corner(i) == r(i) .and. u(i) < 0) then + if (corner(i) == rbar(i) .and. u(i) < 0) then ! Adjust for point starting on cell boundary corner(i) = corner(i) - 1 end if @@ -150,7 +154,7 @@ function get(self, r, u) result(val) val = self % gridCells(idx) % majorant - end function get + end function getValue !! !! @@ -207,6 +211,9 @@ subroutine update(self) real(defReal) :: sigmaT class(particle), allocatable :: p + allocate(p) + p % G = 1 + ! Loop through grid cells do i = 1, size(self % gridCells) ! Reset majorant @@ -271,5 +278,4 @@ pure function get_idx(ijk, sizeN) result(idx) end function get_idx - end module simpleGrid_class From d5cb42965788f490ca33825209e9f9dcd1c331c4 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 11 Jan 2023 18:56:27 +0000 Subject: [PATCH 295/373] Changed some names and fixed a few oversights --- Geometry/simpleGrid_class.f90 | 41 ++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index 6d72dd7cc..6f8481d6c 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -26,7 +26,7 @@ module simpleGrid_class !! dx -> array [dx, dy, dz], the discretisation in each direction !! bounds -> [x_min, y_min, z_min, z_max, y_max, z_max] as in geometry_inter !! - type, public :: grid + type, public :: simpleGrid class(geometry), pointer :: mainGeom => null() class(nuclearDatabase), pointer :: xsData => null() integer(shortInt), dimension(:), allocatable :: sizeN @@ -43,12 +43,12 @@ module simpleGrid_class procedure :: storeMats procedure :: update - end type grid + end type simpleGrid contains subroutine init(self, dict, geom, xsData) - class(grid), intent(inout) :: self + class(simpleGrid), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), intent(in), pointer :: geom class(nuclearDatabase), intent(in), pointer :: xsData @@ -86,7 +86,7 @@ end subroutine init !! May have issues with non-box geometry root universe surface with reflective boundary !! function getDistance(self, r, u) result(dist) - class(grid), intent(in) :: self + class(simpleGrid), intent(in) :: self real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: dist @@ -127,13 +127,13 @@ end function getDistance !! Returns value of grid cell at position !! function getValue(self, r, u) result(val) - class(grid), intent(in) :: self + class(simpleGrid), intent(in) :: self real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: val real(defReal), dimension(3) :: rbar integer(shortInt), dimension(3) :: corner - character(100), parameter :: Here = 'get (simpleGrid_class.f90)' + character(100), parameter :: Here = 'getValue (simpleGrid_class.f90)' ! Get grid cell bottom corner rbar = r - self % corner @@ -150,17 +150,19 @@ function getValue(self, r, u) result(val) ! Get grid cell idx idx = get_idx(corner, self % sizeN) - if (idx == 0) call fatalError(Here, 'Point is outside lattice') + if (idx == 0) call fatalError(Here, 'Point is outside lattice: '//numToChar(r)) val = self % gridCells(idx) % majorant + if (val <= ZERO) call fatalError(Here, 'Invalid majorant: '//numToChar(val)) + end function getValue !! !! !! subroutine storeMats(self, searchN) - class(grid), intent(inout) :: self + class(simpleGrid), intent(inout) :: self integer(shortInt), dimension(3), intent(in) :: searchN real(defReal), dimension(3) :: searchRes integer(shortInt) :: i, j, k, l, matIdx, id @@ -174,7 +176,7 @@ subroutine storeMats(self, searchN) do i = 1, size(self % gridCells) ! Get cell lower corner - corner = self % dx * (get_ijk(i, self % sizeN) - 1) + corner = self % corner + self % dx * (get_ijk(i, self % sizeN) - 1) ! Loop through search locations do j = 1, searchN(1) @@ -197,6 +199,7 @@ subroutine storeMats(self, searchN) ! Store matIdx data in grid cell self % gridCells(i) % mats = mats % expose() + call mats % kill() end do @@ -206,10 +209,10 @@ end subroutine storeMats !! !! subroutine update(self) - class(grid), intent(inout) :: self - integer(shortInt) :: i, j, matIdx - real(defReal) :: sigmaT - class(particle), allocatable :: p + class(simpleGrid), intent(inout) :: self + integer(shortInt) :: i, j, matIdx + real(defReal) :: sigmaT + class(particle), allocatable :: p allocate(p) p % G = 1 @@ -222,13 +225,15 @@ subroutine update(self) do j = 1, size(self % gridCells(i) % mats) ! Get opacity of each material matIdx = self % gridCells(i) % mats(j) - sigmaT = self % xsData % getTransMatXS(p, matIdx) - - ! Update majorant if required - if (sigmaT > self % gridCells(i) % majorant) self % gridCells(i) % majorant = sigmaT + if (matIdx /= 0) then + sigmaT = self % xsData % getTransMatXS(p, matIdx) + ! Update majorant if required + if (sigmaT > self % gridCells(i) % majorant) self % gridCells(i) % majorant = sigmaT + end if end do - +!print *, 'mats: ', self % gridCells(i) % mats +!print *, 'maj: ', self % gridCells(i) % majorant end do end subroutine update From 69a4827b58a4fba9a888a12e6a7ec153905be594 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 11 Jan 2023 18:57:38 +0000 Subject: [PATCH 296/373] Changes to transport operator to use new grid --- .../transportOperatorFactory_func.f90 | 11 ++++-- .../transportOperatorHT_class.f90 | 4 ++- .../transportOperatorST_class.f90 | 4 ++- .../transportOperatorTimeHT_class.f90 | 36 +++++++++++++++---- TransportOperator/transportOperator_inter.f90 | 11 ++++-- 5 files changed, 53 insertions(+), 13 deletions(-) diff --git a/TransportOperator/transportOperatorFactory_func.f90 b/TransportOperator/transportOperatorFactory_func.f90 index 2949c2956..824f3763e 100644 --- a/TransportOperator/transportOperatorFactory_func.f90 +++ b/TransportOperator/transportOperatorFactory_func.f90 @@ -7,6 +7,8 @@ module transportOperatorFactory_func use genericProcedures, only : fatalError use dictionary_class, only : dictionary + use simpleGrid_class, only : simpleGrid + ! Transport Operators use transportOperator_inter, only : transportOperator use transportOperatorST_class, only : transportOperatorST @@ -37,9 +39,10 @@ module transportOperatorFactory_func !! Allocate new allocatable transportOperator to a specific type !! If new is allocated it deallocates it !! - subroutine new_transportOperator(new, dict) + subroutine new_transportOperator(new, dict, grid) class(transportOperator),allocatable, intent(inout):: new class(dictionary), intent(in) :: dict + class(simpleGrid), intent(in), pointer, optional :: grid character(nameLen) :: type character(100),parameter :: Here = 'new_transportOperator (transportOperatorFactory_func.f90)' @@ -65,7 +68,11 @@ subroutine new_transportOperator(new, dict) case('transportOperatorTimeHT') allocate( transportOperatorTimeHT :: new) - call new % init(dict) + if (present(grid)) then + call new % init(dict, grid) + else + call new % init(dict) + end if ! case('dynamicTranspOperDT') ! allocate( transportOperatorDynamicDT :: new) diff --git a/TransportOperator/transportOperatorHT_class.f90 b/TransportOperator/transportOperatorHT_class.f90 index baa39a760..a893af0c8 100644 --- a/TransportOperator/transportOperatorHT_class.f90 +++ b/TransportOperator/transportOperatorHT_class.f90 @@ -20,6 +20,7 @@ module transportOperatorHT_class ! Geometry interfaces use geometry_inter, only : geometry + use simpleGrid_class, only : simpleGrid ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase @@ -42,9 +43,10 @@ module transportOperatorHT_class contains - subroutine init(self, dict) + subroutine init(self, dict, grid) class(transportOperatorHT), intent(inout) :: self class(dictionary), intent(in) :: dict + class(simpleGrid), intent(in), pointer, optional :: grid ! Initialise superclass call init_super(self, dict) diff --git a/TransportOperator/transportOperatorST_class.f90 b/TransportOperator/transportOperatorST_class.f90 index 282912c49..feba3d5b8 100644 --- a/TransportOperator/transportOperatorST_class.f90 +++ b/TransportOperator/transportOperatorST_class.f90 @@ -16,6 +16,7 @@ module transportOperatorST_class ! Geometry interfaces use geometry_inter, only : geometry, distCache + use simpleGrid_class, only : simpleGrid ! Tally interface use tallyCodes @@ -101,9 +102,10 @@ end subroutine surfaceTracking !! !! See transportOperator_inter for details !! - subroutine init(self, dict) + subroutine init(self, dict, grid) class(transportOperatorST), intent(inout) :: self class(dictionary), intent(in) :: dict + class(simpleGrid), intent(in), pointer, optional :: grid if (dict % isPresent('cache')) then call dict % get(self % cache, 'cache') diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 590e51acb..900397433 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -21,6 +21,9 @@ module transportOperatorTimeHT_class ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase + ! Geometry interfaces + use simpleGrid_class, only : simpleGrid + implicit none private @@ -50,7 +53,11 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' ! Get majorant XS inverse: 1/Sigma_majorant - self % majorant_inv = ONE / self % xsData % getMajorantXS(p) + if (associated(self % grid)) then + self % majorant_inv = ONE / self % grid % getValue(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + else + self % majorant_inv = ONE / self % xsData % getMajorantXS(p) + end if ! Check for errors if (p % time /= p % time) call fatalError(Here, 'Particle time is NaN') @@ -136,19 +143,32 @@ end subroutine surfaceTracking subroutine deltaTracking(self, p) class(transportOperatorTimeHT), intent(inout) :: self class(particle), intent(inout) :: p - real(defReal) :: dTime, dColl, sigmaT + real(defReal) :: dTime, dColl, dGrid, sigmaT character(100), parameter :: Here = 'deltaTracking (transportOperatorTimeHT_class.f90)' + dColl = ZERO + dGrid = INF + if (associated(self % grid)) dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + DTLoop:do + dGrid = dGrid - dColl + ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) ! Sample distance to collision dColl = -log( p % pRNG % get() ) * self % majorant_inv + if (dGrid < dTime .and. dGrid < dColl) then + call self % geom % teleport(p % coords, dGrid) + p % time = p % time + dGrid / lightSpeed + self % majorant_inv = ONE / self % grid % getValue(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + cycle DTLoop + ! If dTime < dColl, move to end of time step location - if (dTime < dColl) then + else if (dTime < dColl) then call self % geom % teleport(p % coords, dTime) p % fate = AGED_FATE p % time = p % timeMax @@ -182,9 +202,10 @@ end subroutine deltaTracking !! !! Cutoff of 1 gives exclusively delta tracking, cutoff of 0 gives exclusively surface tracking !! - subroutine init(self, dict) - class(transportOperatorTimeHT), intent(inout) :: self - class(dictionary), intent(in) :: dict + subroutine init(self, dict, grid) + class(transportOperatorTimeHT), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(simpleGrid), intent(in), pointer, optional :: grid ! Initialise superclass call init_super(self, dict) @@ -192,6 +213,9 @@ subroutine init(self, dict) ! Get cutoff value call dict % getOrDefault(self % cutoff, 'cutoff', 0.7_defReal) + ! Store grid pointer + if (present(grid)) self % grid => grid + end subroutine init end module transportOperatorTimeHT_class diff --git a/TransportOperator/transportOperator_inter.f90 b/TransportOperator/transportOperator_inter.f90 index 8d0e30e68..5f864533c 100644 --- a/TransportOperator/transportOperator_inter.f90 +++ b/TransportOperator/transportOperator_inter.f90 @@ -11,6 +11,7 @@ module transportOperator_inter ! Geometry interfaces use geometryReg_mod, only : gr_geomPtr => geomPtr use geometry_inter, only : geometry + use simpleGrid_class, only : simpleGrid ! Tally interface use tallyAdmin_class, only : tallyAdmin @@ -48,6 +49,9 @@ module transportOperator_inter !! Geometry pointer -> public so it can be used by subclasses (protected member) class(geometry), pointer :: geom => null() + !! Pointer to grid for improved hybrid tracking, currently only used in TOTimeHT_class + class(simpleGrid), pointer :: grid => null() + contains ! Public interface procedure, non_overridable :: transport @@ -120,9 +124,10 @@ end subroutine transport !! !! Initialise transport operator from dictionary and geometry !! - subroutine init(self, dict) - class(transportOperator), intent(inout) :: self - class(dictionary), intent(in) :: dict + subroutine init(self, dict, grid) + class(transportOperator), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(simpleGrid), intent(in), pointer, optional :: grid ! Do nothing From 0ec9e8c0d669d06fc4cf5148d5833b6d46a1af2a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 11 Jan 2023 19:00:26 +0000 Subject: [PATCH 297/373] Added isPresent check to dynamicArray class and some changes to PP --- DataStructures/dynArray_class.f90 | 17 ++++++++++++ PhysicsPackages/IMCPhysicsPackage_class.f90 | 29 ++++++++++----------- 2 files changed, 31 insertions(+), 15 deletions(-) diff --git a/DataStructures/dynArray_class.f90 b/DataStructures/dynArray_class.f90 index 09a648cf9..8b7884e67 100644 --- a/DataStructures/dynArray_class.f90 +++ b/DataStructures/dynArray_class.f90 @@ -34,6 +34,7 @@ module dynArray_class procedure :: pop => pop_shortInt procedure :: empty => empty_shortInt procedure :: kill => kill_shortInt + procedure :: isPresent => isPresent_shortInt ! Private procedures @@ -248,4 +249,20 @@ pure subroutine kill_shortInt(self) end subroutine kill_shortInt + !! + !! Checks if item is present in array + !! + pure function isPresent_shortInt(self, item) result(isPresent) + class(dynIntArray), intent(in) :: self + integer(shortInt), intent(in) :: item + logical(defBool) :: isPresent + + isPresent = .false. + + if (self % mySize == 0) return + + if (any(self % array == item)) isPresent = .true. + + end function isPresent_shortInt + end module dynArray_class diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index dcd1f5e2e..a8177eff9 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -25,6 +25,7 @@ module IMCPhysicsPackage_class use geometry_inter, only : geometry use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & gr_geomIdx => geomIdx + use simpleGrid_class, only : simpleGrid ! Nuclear Data use materialMenu_mod, only : mm_nMat => nMat ,& @@ -65,7 +66,7 @@ module IMCPhysicsPackage_class ! Building blocks class(nuclearDatabase), pointer :: nucData => null() class(geometry), pointer :: geom => null() - class(geometry), pointer :: geomAtch => null() + class(simpleGrid), pointer :: grid => null() integer(shortInt) :: geomIdx = 0 type(collisionOperator) :: collOp class(transportOperator), allocatable :: transOp @@ -142,9 +143,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(collisionOperator), save :: collOp class(transportOperator), allocatable, save :: transOp type(RNG), target, save :: pRNG - real(defReal), save :: dist - integer(shortInt) :: event - !$omp threadprivate(p, collOp, transOp, pRNG, mat, dist) + !$omp threadprivate(p, collOp, transOp, pRNG, mat) !$omp parallel p % geomIdx = self % geomIdx @@ -163,6 +162,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) do i=1,N_steps + ! Update grid values if grid is in use + if (associated(self % grid)) call self % grid % update() + ! Swap dungeons to store photons remaining from previous time step self % temp_dungeon => self % nextStep self % nextStep => self % thisStep @@ -243,9 +245,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Save state call p % savePreHistory() -call self % geomAtch % move(p % coords, dist, event) -print *, dist - ! Transport particle until its death history: do call transOp % transport(p, tally, self % thisStep, self % nextStep) @@ -442,17 +441,17 @@ subroutine init(self, dict) self % geomIdx = gr_geomIdx(geomName) self % geom => gr_geomPtr(self % geomIdx) - if (dict % isPresent('geometryAtch')) then - tempDict => dict % getDictPtr('geometryAtch') - geomName = 'GridGeom' - call gr_addGeom(geomName, tempDict) - self % geomAtch => gr_geomPtr(gr_geomIdx(geomName)) - end if - ! Activate Nuclear Data *** All materials are active call ndReg_activate(self % particleType, nucData, self % geom % activeMats()) self % nucData => ndReg_get(self % particleType) + ! Initialise grid for hybrid tracking + if (dict % isPresent('grid')) then + tempDict => dict % getDictPtr('grid') + allocate(self % grid) + call self % grid % init(tempDict, self % geom, self % nucData) + end if + ! Read particle source definition if( dict % isPresent('source') ) then tempDict => dict % getDictPtr('source') @@ -472,7 +471,7 @@ subroutine init(self, dict) ! Build transport operator tempDict => dict % getDictPtr('transportOperator') - call new_transportOperator(self % transOp, tempDict) + call new_transportOperator(self % transOp, tempDict, self % grid) ! Initialise tally Admin tempDict => dict % getDictPtr('tally') From 09f2ae795204fd6545573232304cd2865276c3af Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 12 Jan 2023 19:00:20 +0000 Subject: [PATCH 298/373] Fixes to some issues on grid cell boundaries --- Geometry/CMakeLists.txt | 2 +- Geometry/simpleGrid_class.f90 | 31 ++++++++++++++++--- .../transportOperatorTimeHT_class.f90 | 1 + 3 files changed, 28 insertions(+), 6 deletions(-) diff --git a/Geometry/CMakeLists.txt b/Geometry/CMakeLists.txt index c14b5d2b6..f41422f66 100644 --- a/Geometry/CMakeLists.txt +++ b/Geometry/CMakeLists.txt @@ -8,8 +8,8 @@ add_sources( ./csg_class.f90 ./geomGraph_class.f90 ./geometry_inter.f90 ./geometryStd_class.f90 - ./geomGrid_class.f90 ./geometryReg_mod.f90 + ./simpleGrid_class.f90 ) add_unit_tests( ./Tests/geomGraph_test.f90 diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index 6f8481d6c..f57baa966 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -105,7 +105,7 @@ function getDistance(self, r, u) result(dist) corner(i) = floor(point(i)) end if ! Adjust if starting position was on boundary - if (corner(i) == point(i)) then + if (abs(corner(i) - point(i)) < surface_tol) then corner(i) = corner(i) + sign(ONE, u(i)) end if end do @@ -118,7 +118,11 @@ function getDistance(self, r, u) result(dist) dist = minval(ratio) - if (dist <= ZERO) call fatalError(Here, 'Distance invalid: '//numToChar(dist)) + if (dist <= ZERO) then + print *, 'r', r + print *, 'u', u + call fatalError(Here, 'Distance invalid: '//numToChar(dist)) + end if end function getDistance @@ -136,7 +140,7 @@ function getValue(self, r, u) result(val) character(100), parameter :: Here = 'getValue (simpleGrid_class.f90)' ! Get grid cell bottom corner - rbar = r - self % corner + rbar = reposition(r, self % bounds) - self % corner corner = floor(rbar) do i = 1, 3 if (corner(i) == rbar(i) .and. u(i) < 0) then @@ -150,7 +154,7 @@ function getValue(self, r, u) result(val) ! Get grid cell idx idx = get_idx(corner, self % sizeN) - if (idx == 0) call fatalError(Here, 'Point is outside lattice: '//numToChar(r)) + if (idx == 0) call fatalError(Here, 'Point is outside grid: '//numToChar(r)) val = self % gridCells(idx) % majorant @@ -275,7 +279,7 @@ pure function get_idx(ijk, sizeN) result(idx) integer(shortInt), dimension(3), intent(in) :: sizeN integer(shortInt) :: idx - if (any(ijk <= 0 .or. ijk > sizeN)) then ! Point is outside lattice + if (any(ijk <= 0 .or. ijk > sizeN)) then ! Point is outside grid idx = 0 else idx = ijk(1) + sizeN(1) * (ijk(2)-1 + sizeN(2) * (ijk(3)-1)) @@ -283,4 +287,21 @@ pure function get_idx(ijk, sizeN) result(idx) end function get_idx + + function reposition(r, bounds) result(rNew) + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(6), intent(in) :: bounds + real(defReal), dimension(3) :: rNew + integer(shortInt) :: i + + rNew = r + + do i = 1, 3 + if (r(i) < bounds(i) .and. r(i) > bounds(i)-surface_tol) rNew(i) = bounds(i) + if (r(i) > bounds(i+3) .and. r(i) < bounds(i+3)+surface_tol) rNew(i) = bounds(i+3) + end do + + end function reposition + + end module simpleGrid_class diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 900397433..4ad34f359 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -163,6 +163,7 @@ subroutine deltaTracking(self, p) if (dGrid < dTime .and. dGrid < dColl) then call self % geom % teleport(p % coords, dGrid) p % time = p % time + dGrid / lightSpeed + if (p % matIdx() == OUTSIDE_FILL) return self % majorant_inv = ONE / self % grid % getValue(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) cycle DTLoop From f0e2d84714a8c71e19c91c9486aa7629536db39b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 15 Jan 2023 21:13:29 +0000 Subject: [PATCH 299/373] Changed the way some things are calculated, took inspiration from latUniverse_class, made the whole file very messy so needs cleaning up --- Geometry/simpleGrid_class.f90 | 164 ++++++++++++++++++++++++++-------- 1 file changed, 129 insertions(+), 35 deletions(-) diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index f57baa966..a40fad92c 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -1,7 +1,7 @@ module simpleGrid_class use numPrecision - use universalVariables, only : surface_tol + use universalVariables, only : SURF_TOL use genericProcedures, only : fatalError, numToChar use dictionary_class, only : dictionary use geometry_inter, only : geometry @@ -33,6 +33,7 @@ module simpleGrid_class real(defReal), dimension(3) :: dx = 0 real(defReal), dimension(6) :: bounds real(defReal), dimension(3) :: corner + real(defReal), dimension(3) :: a_bar type(gridCell), dimension(:), allocatable :: gridCells contains @@ -71,6 +72,7 @@ subroutine init(self, dict, geom, xsData) self % dx(3) = (self % bounds(6) - self % bounds(3)) / self % sizeN(3) self % corner = [self % bounds(1), self % bounds(2), self % bounds(3)] + self % a_bar = self % dx * HALF - SURF_TOL ! Allocate space for cells N = self % sizeN(1) * self % sizeN(2) * self % sizeN(3) @@ -90,33 +92,54 @@ function getDistance(self, r, u) result(dist) real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: dist - real(defReal), dimension(3) :: rbar, point, corner, ratio + real(defReal), dimension(3) :: rbar, low, high !, point, corner, ratio character(100), parameter :: Here = 'getDistance (simpleGrid_class.f90)' - ! Calculate position in grid + ! Calculate position from grid corner rbar = r - self % corner - point = rbar / self % dx + if (any(rbar < -SURF_TOL)) call fatalError(Here, 'Point is outside grid geometry') !TODO only checks bottom for now - ! Round each dimension either up or down depending on which boundary will be hit + ! Write as a fraction across cell + rbar = rbar / self % dx + rbar = rbar - floor(rbar) + + ! Account for surface tolerance + low = SURF_TOL / self % dx + high = ONE - low do i = 1, 3 - if (u(i) >= 0) then - corner(i) = ceiling(point(i)) - else - corner(i) = floor(point(i)) - end if - ! Adjust if starting position was on boundary - if (abs(corner(i) - point(i)) < surface_tol) then - corner(i) = corner(i) + sign(ONE, u(i)) - end if + if (rbar(i) < low(i) .and. u(i) < ZERO) rbar(i) = ONE + if (rbar(i) > high(i) .and. u(i) > ZERO) rbar(i) = ZERO end do - ! Convert back to spatial coordinates - this is now the coordinates of the corner being travelled towards - corner = corner * self % dx + ! Distance to centre plus distance from centre to required boundary + rbar = (HALF - rbar + sign(HALF, u)) * self % dx + dist = minval(rbar / u) - ! Determine which axis boundary will be hit first - ratio = (corner - rbar) / u - dist = minval(ratio) + + ! Round each dimension either up or down depending on which boundary will be hit +! do i = 1, 3 +! if (u(i) >= 0) then +! ! Round each dimension either up or down depending on which boundary will be hit +! do i = 1, 3 +! if (u(i) >= 0) then +! corner(i) = ceiling(point(i)) +! else +! corner(i) = floor(point(i)) +! end if +! ! Adjust if starting position was on boundary +! if (abs(corner(i) - point(i)) < SURF_TOL) then +! corner(i) = corner(i) + sign(ONE, u(i)) +! end if +! end do + +! ! Convert back to spatial coordinates - this is now the coordinates of the corner being travelled towards +! corner = corner * self % dx + +! ! Determine which axis boundary will be hit first +! ratio = (corner - rbar) / u + +! dist = minval(ratio) if (dist <= ZERO) then print *, 'r', r @@ -135,26 +158,65 @@ function getValue(self, r, u) result(val) real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: val - real(defReal), dimension(3) :: rbar - integer(shortInt), dimension(3) :: corner + real(defReal), dimension(3) :: r_bar + integer(shortInt), dimension(3) :: corner, ijk + integer(shortInt) :: i, idx character(100), parameter :: Here = 'getValue (simpleGrid_class.f90)' - ! Get grid cell bottom corner - rbar = reposition(r, self % bounds) - self % corner - corner = floor(rbar) + +! rbar = r - self % corner + + + ! Find lattice location in x,y&z + ijk = floor((r - self % corner) / self % dx) + 1 + + ! Get position wrt middle of the lattice cell + r_bar = r - self % corner - ijk * self % dx + HALF * self % dx + + ! Check if position is within surface tolerance + ! If it is, push it to next cell do i = 1, 3 - if (corner(i) == rbar(i) .and. u(i) < 0) then - ! Adjust for point starting on cell boundary - corner(i) = corner(i) - 1 + if (abs(r_bar(i)) > self % a_bar(i) .and. r_bar(i)*u(i) > ZERO) then + + ! Select increment. Ternary expression + if (u(i) < ZERO) then + inc = -1 + else + inc = 1 + end if + + ijk(i) = ijk(i) + inc + end if end do - ! Adjust for bottom corner starting at 1 - corner = corner + 1 + ! Set localID & cellIdx + if (any(ijk <= 0 .or. ijk > self % sizeN)) then ! Point is outside grid + call fatalError(Here, 'Point is outside grid') + + else + idx = ijk(1) + self % sizeN(1) * (ijk(2)-1 + self % sizeN(2) * (ijk(3)-1)) + + end if - ! Get grid cell idx - idx = get_idx(corner, self % sizeN) - if (idx == 0) call fatalError(Here, 'Point is outside grid: '//numToChar(r)) + + +! ! Get grid cell bottom corner +! rbar = reposition(r, self % bounds) - self % corner +! corner = floor(rbar) +! do i = 1, 3 +! if (corner(i) == rbar(i) .and. u(i) < 0) then +! ! Adjust for point starting on cell boundary +! corner(i) = corner(i) - 1 +! end if +! end do +! +! ! Adjust for bottom corner starting at 1 +! corner = corner + 1 +! +! ! Get grid cell idx +! idx = get_idx(corner, self % sizeN) +! if (idx == 0) call fatalError(Here, 'Point is outside grid: '//numToChar(r)) val = self % gridCells(idx) % majorant @@ -287,7 +349,9 @@ pure function get_idx(ijk, sizeN) result(idx) end function get_idx - + !! + !! Adjustment for surface tolerance used by getValue subroutine + !! function reposition(r, bounds) result(rNew) real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(6), intent(in) :: bounds @@ -297,11 +361,41 @@ function reposition(r, bounds) result(rNew) rNew = r do i = 1, 3 - if (r(i) < bounds(i) .and. r(i) > bounds(i)-surface_tol) rNew(i) = bounds(i) - if (r(i) > bounds(i+3) .and. r(i) < bounds(i+3)+surface_tol) rNew(i) = bounds(i+3) + if (r(i) < bounds(i) .and. r(i) > bounds(i) -SURF_TOL) rNew(i) = bounds(i) + if (r(i) > bounds(i+3) .and. r(i) < bounds(i+3)+SURF_TOL) rNew(i) = bounds(i+3) end do + ! TODO Boundaries between cells rather than just edge of grid + end function reposition + !! + !! Adjustment for surface tolerance used by getDistance function. + !! Able to be simpler than repositionLoc as only consider position within cell + !! rather than within grid. + !! + !! Args: + !! r [inout] -> position as a fraction of distance across cell, 0 < r(i), < 1 + !! u [in] -> direction + !! dx [in] -> grid resolution + !! +! subroutine repositionDist(rbar, u, dx) +! real(defReal), dimension(3), intent(inout) :: rbar +! real(defReal), dimension(3), intent(in) :: u +! real(defReal), dimension(3), intent(in) :: dx +! real(defReal), dimension(3) :: low, high +! integer(shortInt) :: i +! +! ! Calculate cut-offs +! low = SURF_TOL / dx +! high = ONE - low +! +! ! Change position if needed +! do i = 1, 3 +! if (rbar(i) < low(i) .and. u(i) < ZERO) rbar(i) = ONE +! if (rbar(i) > high(i) .and. u(i) > ZERO) rbar(i) = ZERO +! end do +! +! end subroutine repositionDist end module simpleGrid_class From 22ae4c0edca1b39595dd7cc9668388383aca27d5 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 15 Jan 2023 21:14:11 +0000 Subject: [PATCH 300/373] Deleted reference to older prototype file --- Geometry/geometryReg_mod.f90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Geometry/geometryReg_mod.f90 b/Geometry/geometryReg_mod.f90 index 971ae4cbb..d1ea1aa7e 100644 --- a/Geometry/geometryReg_mod.f90 +++ b/Geometry/geometryReg_mod.f90 @@ -38,7 +38,6 @@ module geometryReg_mod ! Geometry use geometry_inter, only : geometry use geometryStd_class, only : geometryStd - use geomGrid_class, only : geomGrid ! Fields use field_inter, only : field @@ -349,9 +348,6 @@ subroutine new_geometry(geom, dict, mats, silent) case ('geometryStd') allocate(geometryStd :: geom) - case ('geomGrid') - allocate(geomGrid :: geom) - case default print '(A)', 'AVAILABLE GEOMETRIES' print '(A)', AVAILABLE_GEOMETRIES From b876a4a41d67628e13f60335406ad71435a0df04 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 16 Jan 2023 11:43:39 +0000 Subject: [PATCH 301/373] Added parallel loop to subroutine --- Geometry/simpleGrid_class.f90 | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index a40fad92c..186239a1c 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -115,6 +115,7 @@ function getDistance(self, r, u) result(dist) rbar = (HALF - rbar + sign(HALF, u)) * self % dx dist = minval(rbar / u) + if (dist <= ZERO) call fatalError(Here, 'Distance invalid: '//numToChar(dist)) ! Round each dimension either up or down depending on which boundary will be hit @@ -141,11 +142,6 @@ function getDistance(self, r, u) result(dist) ! dist = minval(ratio) - if (dist <= ZERO) then - print *, 'r', r - print *, 'u', u - call fatalError(Here, 'Distance invalid: '//numToChar(dist)) - end if end function getDistance @@ -163,10 +159,6 @@ function getValue(self, r, u) result(val) integer(shortInt) :: i, idx character(100), parameter :: Here = 'getValue (simpleGrid_class.f90)' - -! rbar = r - self % corner - - ! Find lattice location in x,y&z ijk = floor((r - self % corner) / self % dx) + 1 @@ -276,13 +268,16 @@ end subroutine storeMats !! subroutine update(self) class(simpleGrid), intent(inout) :: self - integer(shortInt) :: i, j, matIdx - real(defReal) :: sigmaT + integer(shortInt) :: i + integer(shortInt), save :: j, matIdx + real(defReal), save :: sigmaT class(particle), allocatable :: p + !$omp threadprivate(j, matIdx) allocate(p) p % G = 1 + !$omp parallel do ! Loop through grid cells do i = 1, size(self % gridCells) ! Reset majorant @@ -298,9 +293,8 @@ subroutine update(self) end if end do -!print *, 'mats: ', self % gridCells(i) % mats -!print *, 'maj: ', self % gridCells(i) % majorant end do + !$omp end parallel do end subroutine update From a781c7fa29922273c3eae82dad8b998812efa750 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 16 Jan 2023 11:45:23 +0000 Subject: [PATCH 302/373] Deleted old file and changed trans op to be able to switch form delta to surface tracking --- Geometry/geomGrid_class.f90 | 200 ------------------ .../transportOperatorTimeHT_class.f90 | 25 ++- 2 files changed, 18 insertions(+), 207 deletions(-) delete mode 100644 Geometry/geomGrid_class.f90 diff --git a/Geometry/geomGrid_class.f90 b/Geometry/geomGrid_class.f90 deleted file mode 100644 index 67d6c90a5..000000000 --- a/Geometry/geomGrid_class.f90 +++ /dev/null @@ -1,200 +0,0 @@ -module geomGrid_class - - use numPrecision - use universalVariables - use genericProcedures, only : fatalError - use dictionary_class, only : dictionary - use charMap_class, only : charMap - use coord_class, only : coordList - use geometry_inter, only : geometry, distCache - use csg_class, only : csg - use universe_inter, only : universe - - type, public, extends(geometry) :: geomGrid - type(csg) :: geom - - contains - ! Superclass procedures - procedure :: init - procedure :: kill - procedure :: placeCoord - procedure :: whatIsAt - procedure :: bounds - procedure :: move_noCache - procedure :: move_withCache - procedure :: moveGlobal - procedure :: teleport - procedure :: activeMats - - procedure, private :: closestDist - - end type geomGrid - -contains - - !! - !! Initialise geometry - !! - !! See geometry_inter for details - !! - subroutine init(self, dict, mats, silent) - class(geomGrid), intent(inout) :: self - class(dictionary), intent(in) :: dict - type(charMap), intent(in) :: mats - logical(defBool), optional, intent(in) :: silent - logical(defBool) :: loud - - ! Build the representation - call self % geom % init(dict, mats, silent) - - end subroutine init - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(geomGrid), intent(inout) :: self - - call self % geom % kill() - - end subroutine kill - - !! - !! Simply returns distance to closest surface in maxDist variable - !! - !! Unlike in geometryStd, here we do not move particle at all - !! - subroutine move_noCache(self, coords, maxDist, event) - class(geomGrid), intent(in) :: self - type(coordList), intent(inout) :: coords - real(defReal), intent(inout) :: maxDist - integer(shortInt), intent(out) :: event - integer(shortInt) :: surfIdx, lvl - character(100), parameter :: Here = 'move_noCache (geomGrid_class.f90)' - - call self % closestDist(maxDist, surfIdx, lvl, coords) - - end subroutine move_noCache - - !! - !! Return distance to the closest surface - !! - !! Searches through all geometry levels. In addition to distance return level - !! and surfIdx for crossing surface - !! - !! Args: - !! dist [out] -> Value of closest distance - !! surfIdx [out] -> Surface index for the crossing returned from the universe - !! lvl [out] -> Level at which crossing is closest - !! coords [in] -> Current coordinates of a particle - !! - subroutine closestDist(self, dist, surfIdx, lvl, coords) - class(geomGrid), intent(in) :: self - real(defReal), intent(out) :: dist - integer(shortInt), intent(out) :: surfIdx - integer(shortInt), intent(out) :: lvl - type(coordList), intent(in) :: coords - integer(shortInt) :: l, test_idx - real(defReal) :: test_dist - class(universe), pointer :: uni - - dist = INF - surfIdx = 0 - lvl = 0 - do l = 1, coords % nesting - ! Get universe - uni => self % geom % unis % getPtr_fast(coords % lvl(l) % uniIdx) - - ! Find distance - call uni % distance(test_dist, test_idx, coords % lvl(l)) - - ! Save distance, surfIdx & level coresponding to shortest distance - ! Take FP precision into account - if ((dist - test_dist) >= dist * FP_REL_TOL) then - dist = test_dist - surfIdx = test_idx - lvl = l - end if - - end do - - end subroutine closestDist - - - !! - !! Unused superclass procedures - !! - - subroutine placeCoord(self, coords) - class(geomGrid), intent(in) :: self - type(coordList), intent(inout) :: coords - character(100), parameter :: Here = 'placeCoord (geomGrid_class.f90)' - - call fatalError(Here, "Should not be called") - - end subroutine placeCoord - - subroutine whatIsAt(self, matIdx, uniqueID, r, u) - class(geomGrid), intent(in) :: self - integer(shortInt), intent(out) :: matIdx - integer(shortInt), intent(out) :: uniqueID - real(defReal), dimension(3), intent(in) :: r - real(defReal), dimension(3), optional, intent(in) :: u - character(100), parameter :: Here = 'whatIsAt (geomGrid_class.f90)' - - call fatalError(Here, "Should not be called") - - end subroutine whatIsAt - - function bounds(self) - class(geomGrid), intent(in) :: self - real(defReal), dimension(6) :: bounds - character(100), parameter :: Here = 'bounds (geomGrid_class.f90)' - - call fatalError(Here, "Should not be called") - - end function bounds - - subroutine move_withCache(self, coords, maxDist, event, cache) - class(geomGrid), intent(in) :: self - type(coordList), intent(inout) :: coords - real(defReal), intent(inout) :: maxDist - integer(shortInt), intent(out) :: event - type(distCache), intent(inout) :: cache - character(100), parameter :: Here = 'move_withCache (geomGrid_class.f90)' - - call fatalError(Here, "Should not be called") - - end subroutine move_withCache - - subroutine moveGlobal(self, coords, maxDist, event) - class(geomGrid), intent(in) :: self - type(coordList), intent(inout) :: coords - real(defReal), intent(inout) :: maxDist - integer(shortInt), intent(out) :: event - character(100), parameter :: Here = 'moveGlobal (geomGrid_class.f90)' - - call fatalError(Here, "Should not be called") - - end subroutine moveGlobal - - subroutine teleport(self, coords, dist) - class(geomGrid), intent(in) :: self - type(coordList), intent(inout) :: coords - real(defReal), intent(in) :: dist - character(100), parameter :: Here = 'teleport (geomGrid_class.f90)' - - call fatalError(Here, "Should not be called") - - end subroutine teleport - - function activeMats(self) result(matList) - class(geomGrid), intent(in) :: self - integer(shortInt), dimension(:), allocatable :: matList - character(100), parameter :: Here = 'activeMats (geomGrid_class.f90)' - - call fatalError(Here, "Should not be called") - - end function activeMats - -end module geomGrid_class diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 4ad34f359..34c64ed53 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -67,13 +67,15 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) ! Decide whether to use delta tracking or surface tracking ! Vastly different opacities make delta tracking infeasable - if(sigmaT * self % majorant_inv > ONE - self % cutoff) then - ! Delta tracking - call self % deltaTracking(p) - else - ! Surface tracking - call self % surfaceTracking(p) - end if +! if(sigmaT * self % majorant_inv > ONE - self % cutoff) then +! ! Delta tracking +! call self % deltaTracking(p) +! else +! ! Surface tracking +! call self % surfaceTracking(p) +! end if + + call self % deltaTracking(p) ! Check for particle leakage if (p % matIdx() == OUTSIDE_FILL) then @@ -152,6 +154,15 @@ subroutine deltaTracking(self, p) DTLoop:do + ! Switch to surface tracking if delta tracking is infeasible + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + if(sigmaT * self % majorant_inv < ONE - self % cutoff) then + ! Surface tracking + call self % surfaceTracking(p) + return + end if + + ! Update distance to grid dGrid = dGrid - dColl ! Find distance to time boundary From 36f424b197ce486e060564676160e1fe710239ad Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 16 Jan 2023 11:46:36 +0000 Subject: [PATCH 303/373] Temporary changes to input files while testing --- InputFiles/IMC/MarshakWave/marshakWave128 | 4 +++- InputFiles/IMC/MarshakWave/marshakWave32 | 11 +++++++---- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index f052b69d8..58b6a30c1 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -3,7 +3,7 @@ type IMCPhysicsPackage; pop 10000; limit 200000; -steps 10000; +steps 1000; timeStepSize 0.05; printUpdates 4; @@ -30,6 +30,8 @@ source { tally { } +grid { dimensions (25 1 1); searchN (1000 1 1); } + geometry { type geometryStd; boundary (0 0 1 1 1 1); diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 54d335252..b07c754ee 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -1,10 +1,10 @@ type IMCPhysicsPackage; -pop 500; -limit 5000; -steps 10000; -timeStepSize 0.05; +pop 10000; +limit 50000; +steps 500; +timeStepSize 0.5; printUpdates 4; collisionOperator { @@ -24,11 +24,14 @@ source { T 1; dir 1; particle photon; + N 1000; } tally { } +//grid { dimensions (10 1 1); searchN (100 1 1); } + geometry { type geometryStd; boundary (0 0 1 1 1 1); From 9048a0e6b42ab4279715b2ae204f3c6971135461 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 16 Jan 2023 13:30:55 +0000 Subject: [PATCH 304/373] Avoid reobtaining sigmaT unnecessarily --- .../transportOperatorTimeHT_class.f90 | 36 +++++++++---------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 34c64ed53..e024e66ad 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -67,15 +67,13 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) ! Decide whether to use delta tracking or surface tracking ! Vastly different opacities make delta tracking infeasable -! if(sigmaT * self % majorant_inv > ONE - self % cutoff) then -! ! Delta tracking -! call self % deltaTracking(p) -! else -! ! Surface tracking -! call self % surfaceTracking(p) -! end if - - call self % deltaTracking(p) + if(sigmaT * self % majorant_inv > ONE - self % cutoff) then + ! Delta tracking + call self % deltaTracking(p) + else + ! Surface tracking + call self % surfaceTracking(p) + end if ! Check for particle leakage if (p % matIdx() == OUTSIDE_FILL) then @@ -150,18 +148,12 @@ subroutine deltaTracking(self, p) dColl = ZERO dGrid = INF - if (associated(self % grid)) dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + if (associated(self % grid)) then + dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + end if DTLoop:do - ! Switch to surface tracking if delta tracking is infeasible - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - if(sigmaT * self % majorant_inv < ONE - self % cutoff) then - ! Surface tracking - call self % surfaceTracking(p) - return - end if - ! Update distance to grid dGrid = dGrid - dColl @@ -171,6 +163,7 @@ subroutine deltaTracking(self, p) ! Sample distance to collision dColl = -log( p % pRNG % get() ) * self % majorant_inv + ! Check if grid cell changes - only passes if grid is allocated, otherwise dGrid = INF if (dGrid < dTime .and. dGrid < dColl) then call self % geom % teleport(p % coords, dGrid) p % time = p % time + dGrid / lightSpeed @@ -201,6 +194,13 @@ subroutine deltaTracking(self, p) ! Exit the loop if the collision is real if (p % pRNG % get() < sigmaT * self % majorant_inv) exit DTLoop + ! Switch to surface tracking if delta tracking is infeasible + if(sigmaT * self % majorant_inv < ONE - self % cutoff) then + call self % surfaceTracking(p) + ! Exit after surface tracking + return + end if + ! Protect against infinite loop if (sigmaT*self % majorant_inv == 0) call fatalError(Here, '100 % virtual collision chance, & &potentially infinite loop') From 988e257a4308c1643225d91dbfc659189922507b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 16 Jan 2023 17:42:08 +0000 Subject: [PATCH 305/373] Renamed variables to be consistent with latUniverse --- Geometry/simpleGrid_class.f90 | 64 +++++++++++++++++------------------ 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index 186239a1c..d2b660adf 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -23,14 +23,14 @@ module simpleGrid_class !! It increases first with X then Y and lastly Z. !! !! sizeN -> array [nx, ny, nz], the dimensions of the grid - !! dx -> array [dx, dy, dz], the discretisation in each direction + !! pitch -> array [dx, dy, dz], the discretisation in each direction !! bounds -> [x_min, y_min, z_min, z_max, y_max, z_max] as in geometry_inter !! type, public :: simpleGrid class(geometry), pointer :: mainGeom => null() class(nuclearDatabase), pointer :: xsData => null() integer(shortInt), dimension(:), allocatable :: sizeN - real(defReal), dimension(3) :: dx = 0 + real(defReal), dimension(3) :: pitch = 0 real(defReal), dimension(6) :: bounds real(defReal), dimension(3) :: corner real(defReal), dimension(3) :: a_bar @@ -67,12 +67,12 @@ subroutine init(self, dict, geom, xsData) ! Get bounds of grid and calculate discretisations self % bounds = geom % bounds() - self % dx(1) = (self % bounds(4) - self % bounds(1)) / self % sizeN(1) - self % dx(2) = (self % bounds(5) - self % bounds(2)) / self % sizeN(2) - self % dx(3) = (self % bounds(6) - self % bounds(3)) / self % sizeN(3) + self % pitch(1) = (self % bounds(4) - self % bounds(1)) / self % sizeN(1) + self % pitch(2) = (self % bounds(5) - self % bounds(2)) / self % sizeN(2) + self % pitch(3) = (self % bounds(6) - self % bounds(3)) / self % sizeN(3) self % corner = [self % bounds(1), self % bounds(2), self % bounds(3)] - self % a_bar = self % dx * HALF - SURF_TOL + self % a_bar = self % pitch * HALF - SURF_TOL ! Allocate space for cells N = self % sizeN(1) * self % sizeN(2) * self % sizeN(3) @@ -92,28 +92,28 @@ function getDistance(self, r, u) result(dist) real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: dist - real(defReal), dimension(3) :: rbar, low, high !, point, corner, ratio + real(defReal), dimension(3) :: r_bar, low, high !, point, corner, ratio character(100), parameter :: Here = 'getDistance (simpleGrid_class.f90)' ! Calculate position from grid corner - rbar = r - self % corner - if (any(rbar < -SURF_TOL)) call fatalError(Here, 'Point is outside grid geometry') !TODO only checks bottom for now + r_bar = r - self % corner + if (any(r_bar < -SURF_TOL)) call fatalError(Here, 'Point is outside grid geometry') !TODO only checks bottom for now ! Write as a fraction across cell - rbar = rbar / self % dx - rbar = rbar - floor(rbar) + r_bar = r_bar / self % pitch + r_bar = r_bar - floor(r_bar) ! Account for surface tolerance - low = SURF_TOL / self % dx + low = SURF_TOL / self % pitch high = ONE - low do i = 1, 3 - if (rbar(i) < low(i) .and. u(i) < ZERO) rbar(i) = ONE - if (rbar(i) > high(i) .and. u(i) > ZERO) rbar(i) = ZERO + if (r_bar(i) < low(i) .and. u(i) < ZERO) r_bar(i) = ONE + if (r_bar(i) > high(i) .and. u(i) > ZERO) r_bar(i) = ZERO end do ! Distance to centre plus distance from centre to required boundary - rbar = (HALF - rbar + sign(HALF, u)) * self % dx - dist = minval(rbar / u) + r_bar = (HALF - r_bar + sign(HALF, u)) * self % pitch + dist = minval(r_bar / u) if (dist <= ZERO) call fatalError(Here, 'Distance invalid: '//numToChar(dist)) @@ -135,10 +135,10 @@ function getDistance(self, r, u) result(dist) ! end do ! ! Convert back to spatial coordinates - this is now the coordinates of the corner being travelled towards -! corner = corner * self % dx +! corner = corner * self % pitch ! ! Determine which axis boundary will be hit first -! ratio = (corner - rbar) / u +! ratio = (corner - r_bar) / u ! dist = minval(ratio) @@ -160,10 +160,10 @@ function getValue(self, r, u) result(val) character(100), parameter :: Here = 'getValue (simpleGrid_class.f90)' ! Find lattice location in x,y&z - ijk = floor((r - self % corner) / self % dx) + 1 + ijk = floor((r - self % corner) / self % pitch) + 1 ! Get position wrt middle of the lattice cell - r_bar = r - self % corner - ijk * self % dx + HALF * self % dx + r_bar = r - self % corner - ijk * self % pitch + HALF * self % pitch ! Check if position is within surface tolerance ! If it is, push it to next cell @@ -194,10 +194,10 @@ function getValue(self, r, u) result(val) ! ! Get grid cell bottom corner -! rbar = reposition(r, self % bounds) - self % corner -! corner = floor(rbar) +! r_bar = reposition(r, self % bounds) - self % corner +! corner = floor(r_bar) ! do i = 1, 3 -! if (corner(i) == rbar(i) .and. u(i) < 0) then +! if (corner(i) == r_bar(i) .and. u(i) < 0) then ! ! Adjust for point starting on cell boundary ! corner(i) = corner(i) - 1 ! end if @@ -228,13 +228,13 @@ subroutine storeMats(self, searchN) type(dynIntArray) :: mats ! Calculate distance between search points - searchRes = self % dx / (searchN + 1) + searchRes = self % pitch / (searchN + 1) ! Loop through grid cells do i = 1, size(self % gridCells) ! Get cell lower corner - corner = self % corner + self % dx * (get_ijk(i, self % sizeN) - 1) + corner = self % corner + self % pitch * (get_ijk(i, self % sizeN) - 1) ! Loop through search locations do j = 1, searchN(1) @@ -371,23 +371,23 @@ end function reposition !! Args: !! r [inout] -> position as a fraction of distance across cell, 0 < r(i), < 1 !! u [in] -> direction - !! dx [in] -> grid resolution + !! pitch [in] -> grid resolution !! -! subroutine repositionDist(rbar, u, dx) -! real(defReal), dimension(3), intent(inout) :: rbar +! subroutine repositionDist(r_bar, u, pitch) +! real(defReal), dimension(3), intent(inout) :: r_bar ! real(defReal), dimension(3), intent(in) :: u -! real(defReal), dimension(3), intent(in) :: dx +! real(defReal), dimension(3), intent(in) :: pitch ! real(defReal), dimension(3) :: low, high ! integer(shortInt) :: i ! ! ! Calculate cut-offs -! low = SURF_TOL / dx +! low = SURF_TOL / pitch ! high = ONE - low ! ! ! Change position if needed ! do i = 1, 3 -! if (rbar(i) < low(i) .and. u(i) < ZERO) rbar(i) = ONE -! if (rbar(i) > high(i) .and. u(i) > ZERO) rbar(i) = ZERO +! if (r_bar(i) < low(i) .and. u(i) < ZERO) r_bar(i) = ONE +! if (r_bar(i) > high(i) .and. u(i) > ZERO) r_bar(i) = ZERO ! end do ! ! end subroutine repositionDist From ae4ebad7631ae709deb03672349de9c54d533e3d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 17 Jan 2023 15:50:35 +0000 Subject: [PATCH 306/373] Changed an oversight that prevented from working in parallel --- .../Source/bbSurfaceSource_class.f90 | 34 ++++++------------- 1 file changed, 11 insertions(+), 23 deletions(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 3b23846f0..3ff7ecbc1 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -190,24 +190,16 @@ subroutine append(self, dungeon, N, rand, matIdx) ! Set number to generate. Using 0 in function call will use N from input dictionary if (N /= 0) self % N = N - -! TODO Parallel for some reason isn't working here, even though changes are the same as IMCSource ??? - ! Generate N particles to populate dungeon -! !$omp parallel -! pRand = rand -! !$omp do private(pRand) -! do i = 1, self % N -! call pRand % stride(i) -! call dungeon % detain(self % sampleParticle(pRand)) -! end do -! !$omp end do -! !$omp end parallel - - + !$omp parallel + pRand = rand + !$omp do private(pRand) do i = 1, self % N - call dungeon % detain(self % sampleParticle(rand)) + call pRand % stride(i) + call dungeon % detain(self % sampleParticle(pRand)) end do + !$omp end do + !$omp end parallel end subroutine append @@ -234,19 +226,15 @@ subroutine samplePosition(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal), dimension(3) :: prevPos + integer(shortInt) :: i real(defReal) :: r1, r2, rad, theta if ( self % planeShape == 0 ) then ! Square - prevPos = self % r - ! Set new x, y and z coords - self % r(1) = (rand % get()-0.5) * self % surfSize - self % r(2) = (rand % get()-0.5) * self % surfSize - self % r(3) = (rand % get()-0.5) * self % surfSize - ! Leave position along normal axis unchanged - self % r(self % axis) = prevPos(self % axis) + do i = 1, 3 + if (i /= self % axis) self % r(i) = (rand % get()-0.5) * self % surfSize + end do else ! Circle rad = rand % get() * self % surfSize From 182b37e28601b574f502674b0605a789799a6a0f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 17 Jan 2023 18:00:24 +0000 Subject: [PATCH 307/373] Redid a lot of bbSurfaceSource --- .../Source/bbSurfaceSource_class.f90 | 244 +++++++----------- 1 file changed, 100 insertions(+), 144 deletions(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 3ff7ecbc1..ce12c9008 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -2,7 +2,7 @@ module bbSurfaceSource_class use numPrecision use universalVariables - use genericProcedures, only : fatalError + use genericProcedures, only : fatalError, numToChar use particle_class, only : particleState, P_NEUTRON, P_PHOTON use particleDungeon_class, only : particleDungeon use dictionary_class, only : dictionary @@ -15,54 +15,46 @@ module bbSurfaceSource_class !! !! Generates a source representing a black body surface - !! Put together quite quickly so very specific in use and not perfect - !! - Currently only allows a circle or square aligned on x y or z axis, with - !! a certain radius or side length - !! - May still contain unnecessary lines of code copied from pointSource_class.f90 !! !! Private members: - !! r -> source position - !! dir -> optional source direction - !! particleType -> source particle type - !! isMG -> is the source multi-group? - !! isIsotropic -> is the source isotropic? + !! r -> bottom corner of source + !! dr -> size of surface, will be 0 in one dimension + !! dir -> direction of dominant movement: [1,0,0], [-1,0,0], [0,1,0], etc. + !! particleType -> source particle type (photon) + !! isMG -> is the source multi-group? (yes) !! !! Interface: !! init -> initialise point source + !! append -> source particles and add to existing dungeon !! sampleType -> set particle type !! samplePosition -> set particle position - !! sampleEnergy -> set particle energy !! sampleEnergyAngle -> sample particle angle + !! sampleEnergy -> set particle energy (isMG = .true., G = 1) + !! sampleWeight -> set particle energy-weight !! kill -> terminate source !! !! Sample Dictionary Input: !! source { !! type bbSurfaceSource; - !! shape circle ! circle or square; - !! size 5; ! radius(circle) or side length(square) - !! axis x; ! axis normal to planar shape - !! pos 0; ! distance along axis to place plane - !! T 1; ! temperature of source boundary - !! particle photon; - !! # dir 1; # ! Positive or negative to indicate direction along axis - !! If 0 then emit in both directions - !! # N 100; # ! Number of particles, only used if call to append subroutine uses N=0 + !! r (x_min x_max y_min y_max z_min z_max); -> Position bounds of surface + !! -> min and max must be equal in one dimension + !! #dir -1; -> optional, negative will reverse direction in dominant axis + !! -> defaults to positive + !! temp 1; -> temperature of the black body source + !! #deltaT 0.05; -> time step size, automatically added to dictionary in IMCPhysicsPackage_class.f90 + !! N 100; -> number of particles per time step, only used if append is called with N = 0 !! } !! type, public,extends(configSource) :: bbSurfaceSource private - real(defReal),dimension(3) :: r = ZERO - real(defReal) :: dir = ZERO - real(defReal) :: surfSize = ZERO - real(defReal) :: area = ZERO - integer(shortInt) :: particleType = P_PHOTON - logical(defBool) :: isMG = .true. - logical(defBool) :: isIsotropic = .false. - integer(shortInt) :: planeShape = 0 ! 0 => square, 1 => circle - integer(shortInt) :: axis = 1 ! 1 => x, 2 => y, 3 => z - real(defReal) :: T = ZERO - real(defReal) :: deltaT = ZERO - integer(shortInt) :: N = 1 + real(defReal), dimension(3) :: r = ZERO + real(defReal), dimension(3) :: dr = ZERO + integer(shortInt), dimension(3) :: dir = ZERO + integer(shortInt) :: particleType = P_PHOTON + logical(defBool) :: isMG = .true. + real(defReal) :: T = ZERO + real(defReal) :: deltaT = ZERO + integer(shortInt) :: N = 0 contains procedure :: init procedure :: append @@ -87,85 +79,45 @@ module bbSurfaceSource_class !! - error if shape is not square or circle !! subroutine init(self, dict, geom) - class(bbSurfaceSource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - character(30) :: type, tempName - integer(shortInt) :: matIdx, uniqueID - logical(defBool) :: isCE, isMG - real(defReal) :: temp + class(bbSurfaceSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + character(30) :: type, tempName + integer(shortInt) :: matIdx, uniqueID + logical(defBool) :: isCE, isMG + real(defReal), dimension(:), allocatable :: temp + integer(shortInt) :: i, dir character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' ! Provide geometry info to source self % geom => geom - ! Identify which particle is used in the source - ! Presently limited to neutron and photon - call dict % getOrDefault(type, 'particle' ,'photon') - select case(type) - case('neutron') - self % particleType = P_NEUTRON - - case('photon') - self % particleType = P_PHOTON - - case default - call fatalError(Here, 'Unrecognised particle type') - - end select - - ! Get position of surface along axis - call dict % get(temp, 'pos') - - ! Get axis and assign axis position - call dict % getOrDefault(tempName, 'axis', 'x') - select case(tempName) - case('x') - self % r(1) = temp - self % axis = 1 - case('y') - self % r(2) = temp - self % axis = 2 - case('z') - self % r(3) = temp - self % axis = 3 - case default - call fatalError(Here, 'Unrecognised axis, may only be x, y or z') - end select - - ! Get size of boundary surface - call dict % get(self % surfSize, 'size') - - ! Get shape and area of boundary surface - call dict % get(tempName, 'shape') - if (tempName == 'square') then - self % planeShape = 0 - self % area = self % surfSize**2 - else if (tempName == 'circle') then - self % planeShape = 1 - self % area = pi * self % surfSize**2 - else - call fatalError(Here, 'Shape must be "square" or "circle"') - end if - - ! Determine if dir is positive or negative along given axis - ! If equal to 0, emit from both sides - self % isIsotropic = .not. dict % isPresent('dir') - if (.not. self % isIsotropic) then - - call dict % get(temp, 'dir') + ! Provide particle type + self % particleType = P_PHOTON - if (temp == 0) then - self % dir = 0 - else - ! Set equal to +1 or -1 - self % dir = temp/abs(temp) - end if + ! Get and check position vector + call dict % get(temp, 'r') + if (size(temp) /= 6) call fatalError(Here, 'r should be of size 6') + do i = 1, 3 + ! Store x_min, y_min, z_min + self % r(i) = temp(2*i-1) + ! Store dx, dy, dz + self % dr(i) = temp(2*i) - temp(2*i-1) + ! Check for compatible min and max + if (self % dr(i) < 0) call fatalError(Here, 'Min > Max along direction '//numToChar(i)) + end do + ! Check that exactly one normal axis is present + if (count(self % dr == 0) /= 1) call fatalError(Here, 'No clearly defined axis extracted') - end if + ! Get primary direction + call dict % getOrDefault(dir, 'dir', 1) + do i = 1, 3 + if (self % dr(i) == 0) self % dir(i) = sign(1, dir) + end do - call dict % get(self % T, 'T') - call dict % get(self % deltaT, 'deltaT') + ! Get remaining information + call dict % get(self % T, 'temp') + call dict % get(self % deltaT, 'deltaT') ! Automatically added to dict in IMC physics package call dict % getOrDefault(self % N, 'N', 1) end subroutine init @@ -176,6 +128,7 @@ end subroutine init !! See source_inter for details !! !! If N is given as 0, then N is instead taken from the input dictionary defining this source + !! to allow PP to have control over particle numbers !! subroutine append(self, dungeon, N, rand, matIdx) class(bbSurfaceSource), intent(inout) :: self @@ -189,6 +142,7 @@ subroutine append(self, dungeon, N, rand, matIdx) ! Set number to generate. Using 0 in function call will use N from input dictionary if (N /= 0) self % N = N + ! TODO change so that this override is only temporary, so that can be called with 0 again later ! Generate N particles to populate dungeon !$omp parallel @@ -227,62 +181,60 @@ subroutine samplePosition(self, p, rand) class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand integer(shortInt) :: i - real(defReal) :: r1, r2, rad, theta - - if ( self % planeShape == 0 ) then ! Square - - ! Set new x, y and z coords - do i = 1, 3 - if (i /= self % axis) self % r(i) = (rand % get()-0.5) * self % surfSize - end do - - else ! Circle - rad = rand % get() * self % surfSize - theta = rand % get() * 2 * pi - - r1 = rad * cos(theta) - r2 = rad * sin(theta) + real(defReal), dimension(3) :: r - if(self % axis == 1) then ! Set y and z - self % r(2) = r1 - self % r(3) = r2 - else if(self % axis == 2) then ! Set x and z - self % r(1) = r1 - self % r(3) = r2 - else ! Set x and y - self % r(1) = r1 - self % r(2) = r2 - end if - - end if + ! Set new x, y and z coords + do i = 1, 3 + r(i) = (self % dr(i)) * rand % get() + self % r(i) + end do - p % r = self % r + ! Assign to particle + p % r = r end subroutine samplePosition !! - !! Provide angle or sample if isotropic + !! Sample angle !! !! See configSource_inter for details. !! - !! Only isotropic/fixed direction. Does not sample energy. - !! subroutine sampleEnergyAngle(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand + real(defReal), dimension(3) :: dir real(defReal) :: phi, mu + character(100), parameter :: Here = 'sampleEnergyAngle (bbSurfaceSource_class.f90)' + ! Sample required phi and mu phi = TWO_PI * rand % get() mu = sqrt(rand % get()) - p % dir = [mu, sqrt(1-mu**2)*cos(phi), sqrt(1-mu**2)*sin(phi)] + ! Choose direction based on dominant direction given in self % dir + if (self % dir(1) == 1) then ! Positive x + dir = [ mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] + + else if (self % dir(1) == -1) then ! Negative x + dir = [-mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] + + else if (self % dir(2) == 1) then ! Positive y + dir = [sqrt(1-mu*mu)*sin(phi), mu, sqrt(1-mu*mu)*cos(phi)] + + else if (self % dir(2) == -1) then ! Negative y + dir = [sqrt(1-mu*mu)*sin(phi), -mu, sqrt(1-mu*mu)*cos(phi)] - ! If dir not equal to zero, adjust so that particles are travelling in correct direction - if (self % dir /= 0) then - p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir + else if (self % dir(3) == 1) then ! Positive z + dir = [sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi), mu] + + else if (self % dir(3) == -1) then ! Negative z + dir = [sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi), -mu] + + else + call fatalError(Here, 'Invalid direction vector') end if + ! Assign to particle + p % dir = dir end subroutine sampleEnergyAngle @@ -314,13 +266,14 @@ subroutine sampleWeight(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal) :: num + real(defReal) :: area, num - num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * self % area - p % wgt = num / (4 * self % N) + ! Calculate surface area of source + area = product(self % dr, self % dr /= ZERO) - ! If dir = 0 then emit in both directions => double total energy - if (self % dir == 0) p % wgt = 2*p % wgt + ! Calculate energy weight per particle + num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * area + p % wgt = num / (4 * self % N) end subroutine sampleWeight @@ -335,10 +288,13 @@ elemental subroutine kill(self) ! Kill local components self % r = ZERO + self % dr = ZERO self % dir = ZERO self % particleType = P_PHOTON self % isMG = .true. - self % isIsotropic = .false. + self % T = ZERO + self % deltaT = ZERO + self % N = ZERO end subroutine kill From 7600fc26d2c97336b2cbcc4f5d5846aac1d8357c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 23 Jan 2023 12:21:32 +0000 Subject: [PATCH 308/373] Fixed issue causing incorrect dGrid after cycle DTLoop, and added note to check later --- TransportOperator/transportOperatorTimeHT_class.f90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index e024e66ad..931e1c757 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -146,7 +146,6 @@ subroutine deltaTracking(self, p) real(defReal) :: dTime, dColl, dGrid, sigmaT character(100), parameter :: Here = 'deltaTracking (transportOperatorTimeHT_class.f90)' - dColl = ZERO dGrid = INF if (associated(self % grid)) then dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) @@ -154,9 +153,6 @@ subroutine deltaTracking(self, p) DTLoop:do - ! Update distance to grid - dGrid = dGrid - dColl - ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) @@ -167,7 +163,7 @@ subroutine deltaTracking(self, p) if (dGrid < dTime .and. dGrid < dColl) then call self % geom % teleport(p % coords, dGrid) p % time = p % time + dGrid / lightSpeed - if (p % matIdx() == OUTSIDE_FILL) return + if (p % matIdx() == OUTSIDE_FILL) return ! TODO Check that this check doesn't pass if particle is reflected on universe boundary self % majorant_inv = ONE / self % grid % getValue(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) cycle DTLoop @@ -205,6 +201,9 @@ subroutine deltaTracking(self, p) if (sigmaT*self % majorant_inv == 0) call fatalError(Here, '100 % virtual collision chance, & &potentially infinite loop') + ! Update distance to next grid cell + dGrid = dGrid - dColl + end do DTLoop end subroutine deltaTracking From 73f33fc26ff54428ce62ae1f81c245fe170d250a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 25 Jan 2023 13:38:38 +0000 Subject: [PATCH 309/373] Fixed grammar --- TransportOperator/transportOperatorTimeHT_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 931e1c757..052e33a71 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -1,5 +1,5 @@ !! -!! Transport operator time-dependent problems using a hybrid of delta tracking and surface tracking +!! Transport operator for time-dependent problems using a hybrid of delta tracking and surface tracking !! module transportOperatorTimeHT_class use numPrecision From c73bf3627f37de404c4b0cb615f927cc715ad6fc Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 27 Jan 2023 12:53:39 +0000 Subject: [PATCH 310/373] Fixed issue causing isPresent to be incorrect due to checking elements that shouldn't be in array --- DataStructures/dynArray_class.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DataStructures/dynArray_class.f90 b/DataStructures/dynArray_class.f90 index 8b7884e67..4913bc7e6 100644 --- a/DataStructures/dynArray_class.f90 +++ b/DataStructures/dynArray_class.f90 @@ -259,9 +259,10 @@ pure function isPresent_shortInt(self, item) result(isPresent) isPresent = .false. + ! Return false if array is empty if (self % mySize == 0) return - if (any(self % array == item)) isPresent = .true. + if (any(self % array(1:self % mySize) == item)) isPresent = .true. end function isPresent_shortInt From 08f0b1eabecf8def40f5e05dfe267eff50c132c0 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 28 Jan 2023 17:26:17 +0000 Subject: [PATCH 311/373] Increases distance by surface tolerance, not sure yet if this is actually necessary --- Geometry/simpleGrid_class.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index d2b660adf..43cb560fc 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -117,6 +117,9 @@ function getDistance(self, r, u) result(dist) if (dist <= ZERO) call fatalError(Here, 'Distance invalid: '//numToChar(dist)) + ! Increase by surface tolerance to ensure that boundary conditions are correctly applied + dist = dist + SURF_TOL + ! Round each dimension either up or down depending on which boundary will be hit ! do i = 1, 3 From 08fa1f3356ab327e8d079513000cea795fae2804 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 2 Feb 2023 16:52:44 +0000 Subject: [PATCH 312/373] Removed calulcation type from universal variables and put into material class instead --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 4 ++++ SharedModules/universalVariables.f90 | 4 ---- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index d8d74cbd5..d7a210768 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -29,6 +29,10 @@ module baseMgIMCMaterial_class integer(shortInt), parameter, public :: CAPTURE_XS = 3 integer(shortInt), parameter, public :: PLANCK_XS = 4 + ! IMC Calculation Type + integer(shortInt), parameter, public :: IMC = 1 + integer(shortInt), parameter, public :: ISMC = 2 + !! !! Basic type of MG material data !! diff --git a/SharedModules/universalVariables.f90 b/SharedModules/universalVariables.f90 index 8bfac8f4e..43dd78fde 100644 --- a/SharedModules/universalVariables.f90 +++ b/SharedModules/universalVariables.f90 @@ -61,10 +61,6 @@ module universalVariables P_PHOTON_CE = 3, & P_PHOTON_MG = 4 - ! IMC Calculation Type - integer(shortInt), parameter :: IMC = 1, & - ISMC = 2 - ! Search error codes integer(shortInt), parameter :: valueOutsideArray = -1,& tooManyIter = -2,& From e5efe0b3e964eb4bd789e8a03660f383a73b852c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 2 Feb 2023 17:57:58 +0000 Subject: [PATCH 313/373] Changed input files to work with changes to source class --- InputFiles/IMC/MarshakWave/marshakWave128 | 12 +++--------- InputFiles/IMC/MarshakWave/marshakWave16 | 12 +++--------- InputFiles/IMC/MarshakWave/marshakWave32 | 21 ++++++++------------- InputFiles/IMC/MarshakWave/marshakWave64 | 12 +++--------- InputFiles/IMC/MarshakWave/marshakWave8 | 11 +++-------- InputFiles/IMC/Sample/imcSampleInput | 3 ++- 6 files changed, 22 insertions(+), 49 deletions(-) diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/marshakWave128 index f052b69d8..970335df5 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave128 +++ b/InputFiles/IMC/MarshakWave/marshakWave128 @@ -1,3 +1,5 @@ +// Marshak wave simulation using 128 equal spatial regions +// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** type IMCPhysicsPackage; @@ -16,15 +18,7 @@ transportOperator { } source { - type bbSurfaceSource; - shape square; - size 1; - axis x; - pos -2; - T 1; - dir 1; - particle photon; - N 200; + type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; } tally { diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/marshakWave16 index feef5d7a6..6d4abf262 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave16 +++ b/InputFiles/IMC/MarshakWave/marshakWave16 @@ -1,3 +1,5 @@ +// Marshak wave simulation using 16 equal spatial regions +// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** type IMCPhysicsPackage; @@ -16,15 +18,7 @@ transportOperator { } source { - type bbSurfaceSource; - shape square; - size 1; - axis x; - pos -2; - T 1; - dir 1; - particle photon; - N 1000; + type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; } tally { diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/marshakWave32 index 54d335252..2bc79b385 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave32 +++ b/InputFiles/IMC/MarshakWave/marshakWave32 @@ -1,11 +1,13 @@ +// Marshak wave simulation using 32 equal spatial regions +// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** type IMCPhysicsPackage; -pop 500; -limit 5000; -steps 10000; -timeStepSize 0.05; -printUpdates 4; +pop 5000; +limit 50000; +steps 1000; +timeStepSize 0.5; +printUpdates 12; collisionOperator { photonMG {type IMCMGstd;} @@ -16,14 +18,7 @@ transportOperator { } source { - type bbSurfaceSource; - shape square; - size 1; - axis x; - pos -2; - T 1; - dir 1; - particle photon; + type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; } tally { diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/marshakWave64 index a51cdd2f9..3e8e7ee29 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave64 +++ b/InputFiles/IMC/MarshakWave/marshakWave64 @@ -1,3 +1,5 @@ +// Marshak wave simulation using 64 equal spatial regions +// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** type IMCPhysicsPackage; @@ -16,15 +18,7 @@ transportOperator { } source { - type bbSurfaceSource; - shape square; - size 1; - axis x; - pos -2; - T 1; - dir 1; - particle photon; - N 500; + type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; } tally { diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/marshakWave8 index 3396e5d6c..76aaf57e1 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave8 +++ b/InputFiles/IMC/MarshakWave/marshakWave8 @@ -1,3 +1,5 @@ +// Marshak wave simulation using 8 equal spatial regions +// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** type IMCPhysicsPackage; @@ -16,14 +18,7 @@ transportOperator { } source { - type bbSurfaceSource; - shape square; - size 1; - axis x; - pos -2; - T 1; - dir 1; - particle photon; + type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; } tally { diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/Sample/imcSampleInput index c9621c625..3a2cead93 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/Sample/imcSampleInput @@ -2,7 +2,8 @@ // Intended as a sample/tutorial input file for calculations using IMC physics // package, to detail settings that differ to other calculation types // - +// Note that a lot of the input files in this branch require lightSpeed and radiationConstant both +// to be changed to ONE in universalVariables before compiling type IMCPhysicsPackage; From 23d486b4b7cfad5e06cb4d72cbbe59aac24eb62e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 7 Feb 2023 18:44:38 +0000 Subject: [PATCH 314/373] New module for splitting geometry into a uniform grid to avoid having to write horrendous input files manually --- Geometry/CMakeLists.txt | 1 + Geometry/discretiseGeom_class.f90 | 219 ++++++++++++++++++++++++++++++ NuclearData/materialMenu_mod.f90 | 19 +++ 3 files changed, 239 insertions(+) create mode 100644 Geometry/discretiseGeom_class.f90 diff --git a/Geometry/CMakeLists.txt b/Geometry/CMakeLists.txt index f41422f66..27761d6b9 100644 --- a/Geometry/CMakeLists.txt +++ b/Geometry/CMakeLists.txt @@ -10,6 +10,7 @@ add_sources( ./csg_class.f90 ./geometryStd_class.f90 ./geometryReg_mod.f90 ./simpleGrid_class.f90 + ./discretiseGeom_class.f90 ) add_unit_tests( ./Tests/geomGraph_test.f90 diff --git a/Geometry/discretiseGeom_class.f90 b/Geometry/discretiseGeom_class.f90 new file mode 100644 index 000000000..b015553df --- /dev/null +++ b/Geometry/discretiseGeom_class.f90 @@ -0,0 +1,219 @@ +!! +!! Module to help with simplify the process of writing input files, specifically aimed at IMC but +!! may be useful for other applications if needed +!! +module discretiseGeom_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError, numToChar + use dictionary_class, only : dictionary + use dictParser_func, only : fileToDict + + ! Geometry + use geometry_inter, only : geometry + use geometryReg_mod, only : gr_geomPtr => geomPtr, & + gr_addGeom => addGeom, & + gr_geomIdx => geomIdx, & + gr_kill => kill + ! Nuclear Data + use materialMenu_mod, only : mm_matTemp => matTemp ,& + mm_matFile => matFile + use nuclearDataReg_mod, only : ndReg_init => init ,& + ndReg_activate => activate ,& + ndReg_kill => kill, & + ndReg_get => get + use nuclearDatabase_inter, only : nuclearDatabase + + +contains + + !! + !! Initialises geometry and nuclear database given in input file, and uses this as a baseline to + !! write new geometry and nuclear data dictionaries by splitting the input geometry into a + !! uniform grid. Makes new text files 'newGeom.txt' and 'newData.txt'. + !! + !! New geometry is a lattice universe, with each lattice cell containing the same material at its + !! centre in the initial input geometry, but with each cell initialising a new instance of this + !! material object, allowing for spatial temperature variation. + !! + !! For N lattice cells, will write to files N instances of: + !! In newGeom.txt => pj { id j; type pinUniverse; radii (0); fills (mj); } + !! In newData.txt => mj { temp ...; composition {} xsFile ./.../...; volume ...; } + !! (filled in with correct data for underlying material) + !! + !! In future, might be able to somehow modify the way that geometry and materials are built such + !! that separate instances of each mat are not needed + !! + !! Sample input: + !! dicretise { dimensions (10 1 1); } + !! + !! Args: + !! dict [in] -> Input file dictionary + !! newGeom [out] -> dictionary containing new geometry input + !! newData [out] -> dictionary containing new nuclear database input + !! + !! Errors: + !! TODO + !! + subroutine discretise(dict, newGeom, newData) + class(dictionary), intent(in) :: dict + type(dictionary), intent(out) :: newGeom + type(dictionary), intent(out) :: newData + class(dictionary), pointer :: tempDict + class(geometry), pointer :: inputGeom + class(nuclearDatabase), pointer :: inputNucData + character(nameLen) :: dataName, geomName + integer(shortInt), dimension(:), allocatable :: sizeN + integer(shortInt), dimension(3) :: ijk + real(defReal), dimension(6) :: bounds + real(defReal), dimension(3) :: pitch, corner, r + integer(shortInt) :: N, rootID, latID, geomIdx, inputGeomIdx, matIdx, uniqueId, i + real(defReal) :: volume + character(100), parameter :: Here = 'discretise (discretiseGeom_class.f90)' + + ! Get discretisation settings + tempDict => dict % getDictPtr('discretise') + call tempDict % get(sizeN, 'dimensions') + + ! Build Nuclear Data using input + call ndReg_init(dict % getDictPtr("nuclearData")) + + ! Build geometry using input + tempDict => dict % getDictPtr('geometry') + geomName = 'inputGeom' + call gr_addGeom(geomName, tempDict) + inputGeomIdx = gr_geomIdx(geomName) + inputGeom => gr_geomPtr(inputGeomIdx) + + ! Activate input Nuclear Data + dataName = 'mg' + call ndReg_activate(P_PHOTON_MG, dataName, inputGeom % activeMats()) + inputNucData => ndReg_get(P_PHOTON_MG) + + ! Get bounds, pitch and lower corner + bounds = inputGeom % bounds() + do i = 1, 3 + pitch(i) = (bounds(i+3)-bounds(i))/sizeN(i) + corner(i) = bounds(i) + end do + ! Calculate volume of each cell and number of cells + volume = pitch(1) * pitch(2) * pitch(3) + N = sizeN(1) * sizeN(2) * sizeN(3) + + ! Create files for materials and geometry + open(unit = 21, file = 'newGeom.txt') + open(unit = 22, file = 'newData.txt') + + + ! Write geometry settings - TODO obtain this from input file automatically + write (21, '(8A)') 'type geometryStd;'//new_line('A')//'boundary (0 0 1 1 1 1);'& + &//new_line('A')//'graph {type shrunk;}' + write (21, '(8A)') 'surfaces { outer { id 1; type box; origin (0 0 0); halfwidth (2 0.5 0.5);}}' + write (21, '(8A)') 'cells {}'//new_line('A')//'universes {' + rootID = N + 1 + latID = N + 2 + write (21, '(8A)') 'root { id '//numToChar(rootID)//'; type rootUniverse; border 1; & + &fill u<'//numToChar(latID)//'>; }'//new_line('A') + + ! Write material settings - TODO obtain this from input file automatically + write (22, '(8A)') 'handles {mg {type baseMgIMCDatabase;}}'//new_line('A')//'materials {' + + + ! Write lattice input + write(21, '(8A)') 'lattice { id '//numToChar(latID)//'; type latUniverse; origin (0 0 0); pitch ('//& + &numToChar(pitch)//'); shape ('//numToChar(sizeN)//'); padMat void;'& + &//new_line('A')//'map (' + do i = 1, N + write(21, '(8A)') numToChar(i) + end do + + write(21, '(8A)') '); }'//new_line('A') + + + ! Write pin universes and materials + do i = 1, N + + ! Get location in centre of lattice cell + ijk = get_ijk(i, sizeN) + r = corner + pitch * (ijk - HALF) + + ! Get matIdx from input geometry + call inputGeom % whatIsAt(matIdx, uniqueId, r) + + ! Pin universe for void and outside mat + if (matIdx == VOID_MAT) then + write(21, '(8A)') 'p'//numToChar(i)//' { id '//numToChar(i)//'; type pinUniverse; & + &radii (0); fills (void); }' + + else if (matIdx == OUTSIDE_MAT) then + write(21, '(8A)') 'p'//numToChar(i)//' { id '//numToChar(i)//'; type pinUniverse; & + &radii (0); fills (outside); }' + + ! User-defined materials + else + ! Pin universe + write(21, '(8A)') 'p'//numToChar(i)//' { id '//numToChar(i)//'; type pinUniverse; & + &radii (0); fills (m'//numToChar(i)//'); }' + + ! Material + write(22, '(8A)') 'm'//numToChar(i)//' { temp '//numToChar(mm_matTemp(matIdx))//'; & + &composition {} xsFile '//trim(mm_matFile(matIdx))//'; volume '//numToChar(volume)//'; }' + + end if + + end do + + ! Write closing brackets for dictionaries + write (21, '(8A)') '}' + write (22, '(8A)') '}' + + ! Kill input geom and nuclear database + call inputGeom % kill() + call inputNucData % kill() + call gr_kill() + call ndReg_kill() + + close(21) + close(22) + + ! Create geometry and nuclear database from new files + + call fileToDict(newData, './newData.txt') + call fileToDict(newGeom, './newGeom.txt') + + end subroutine discretise + + + + !! + !! Generate ijk from localID and shape + !! + !! Args: + !! localID [in] -> Local id of the cell between 1 and product(sizeN) + !! sizeN [in] -> Number of cells in each cardinal direction x, y & z + !! + !! Result: + !! Array ijk which has integer position in each cardinal direction + !! + pure function get_ijk(localID, sizeN) result(ijk) + integer(shortInt), intent(in) :: localID + integer(shortInt), dimension(3), intent(in) :: sizeN + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: temp, base + + temp = localID - 1 + + base = temp / sizeN(1) + ijk(1) = temp - sizeN(1) * base + 1 + + temp = base + base = temp / sizeN(2) + ijk(2) = temp - sizeN(2) * base + 1 + + ijk(3) = base + 1 + + end function get_ijk + + +end module discretiseGeom_class diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index fb49dfbea..36d69f7b0 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -18,6 +18,7 @@ !! matName -> Return material Name given Index !! matTemp -> Return material Temperature given Index !! matVol -> Return material Volume given Index +!! matFile -> Return file path to material data given matIdx !! matIdx -> Return material Index given Name !! module materialMenu_mod @@ -118,6 +119,7 @@ module materialMenu_mod public :: matName public :: matTemp public :: matVol + public :: matFile public :: matIdx contains @@ -277,6 +279,23 @@ function matVol(idx) result(vol) end function matVol + !! + !! Return file path to material XS data given index + !! + !! Args: + !! idx [in] -> Material index + !! + !! Result: + !! Path to file + !! + function matFile(idx) result(path) + integer(shortInt), intent(in) :: idx + character(pathLen) :: path + + call materialDefs(idx) % extraInfo % get(path,'xsFile') + + end function matFile + !! !! Return material index Given Name !! From b4a130184f566a2ed2cc1d23bee2af010143e511 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 7 Feb 2023 18:46:38 +0000 Subject: [PATCH 315/373] Changed PP to work with new module, can be cleaned up a lot by removing some repeated code. Also increased rejection sampling limit for sourcing, need to do something better for sourcing with large numbers of materials --- ParticleObjects/Source/IMCSource_class.f90 | 4 ++-- PhysicsPackages/IMCPhysicsPackage_class.f90 | 26 +++++++++++++++++++++ 2 files changed, 28 insertions(+), 2 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index d40efbb52..f74c9f0ca 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -155,8 +155,8 @@ function sampleParticle(self, rand) result(p) ! Protect against infinite loop i = i+1 - if (i > 10000) then - call fatalError(Here, '10,000 failed samples in rejection sampling loop') + if (i > 100000) then + call fatalError(Here, '100,000 failed samples in rejection sampling loop') end if ! Sample Position diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index a8177eff9..cb7ecc929 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -26,6 +26,7 @@ module IMCPhysicsPackage_class use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & gr_geomIdx => geomIdx use simpleGrid_class, only : simpleGrid + use discretiseGeom_class, only : discretise ! Nuclear Data use materialMenu_mod, only : mm_nMat => nMat ,& @@ -386,6 +387,7 @@ subroutine init(self, dict) integer(shortInt) :: i class(IMCMaterial), pointer :: mat character(nameLen), dimension(:), allocatable :: mats +type(dictionary) :: newGeom, newData character(100), parameter :: Here ='init (IMCPhysicsPackage_class.f90)' call cpu_time(self % CPU_time_start) @@ -431,6 +433,25 @@ subroutine init(self, dict) ! Read whether to print particle source each time step call dict % getOrDefault(self % printSource, 'printSource', 0) + ! Automatically split geometry into a uniform grid + if (dict % isPresent('discretise')) then + call discretise(dict, newGeom, newData) + + ! Build Nuclear Data + call ndReg_init(newData) + + ! Build geometry + geomName = 'IMCGeom' + call gr_addGeom(geomName, newGeom) + 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()) + self % nucData => ndReg_get(self % particleType) + + else + ! Build Nuclear Data call ndReg_init(dict % getDictPtr("nuclearData")) @@ -445,6 +466,10 @@ subroutine init(self, dict) call ndReg_activate(self % particleType, nucData, self % geom % activeMats()) self % nucData => ndReg_get(self % particleType) + end if + + + ! Initialise grid for hybrid tracking if (dict % isPresent('grid')) then tempDict => dict % getDictPtr('grid') @@ -480,6 +505,7 @@ subroutine init(self, dict) ! Store number of materials self % nMat = mm_nMat() + self % printUpdates = min(self % printUpdates, self % nMat) ! Create array of material names allocate(mats(self % nMat)) From b2209424cbde26422448e1feb7a435a4226b3a0a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 8 Feb 2023 18:40:04 +0000 Subject: [PATCH 316/373] Allowed IMCSource to sample particles using dimensions of lattice when using discretiseGeom_class, otherwise rejection sampling was taking far too long for large number of mats --- ParticleObjects/Source/IMCSource_class.f90 | 160 ++++++++++++++++---- PhysicsPackages/IMCPhysicsPackage_class.f90 | 23 ++- 2 files changed, 148 insertions(+), 35 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index f74c9f0ca..66c38a6fb 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -44,13 +44,18 @@ module IMCSource_class logical(defBool) :: isMG = .true. real(defReal), dimension(3) :: bottom = ZERO real(defReal), dimension(3) :: top = ZERO + real(defReal), dimension(3) :: latPitch = ZERO + integer(shortInt), dimension(:), allocatable :: latSizeN integer(shortInt) :: G = 0 integer(shortInt) :: N integer(shortInt) :: matIdx + real(defReal), dimension(6) :: matBounds = ZERO contains procedure :: init procedure :: append procedure :: sampleParticle + procedure :: samplePosRej + procedure :: samplePosLat procedure :: kill end type imcSource @@ -79,6 +84,13 @@ subroutine init(self, dict, geom) self % bottom = bounds(1:3) self % top = bounds(4:6) + ! Store lattice dimensions for use in position sampling if using a large lattice + ! sizeN automatically added to dict in IMCPhysicsPackage if needed + if (dict % isPresent('sizeN')) then + call dict % get(self % latSizeN, 'sizeN') + self % latPitch = (self % top - self % bottom) / self % latSizeN + end if + end subroutine init !! @@ -103,6 +115,7 @@ subroutine append(self, dungeon, N, rand, matIdx) integer(shortInt), intent(in), optional :: matIdx type(particle) :: p integer(shortInt) :: i + integer(shortInt), dimension(3) :: ijk real(defReal) :: normFactor type(RNG) :: pRand character(100), parameter :: Here = "append (IMCSource_class.f90)" @@ -114,6 +127,16 @@ subroutine append(self, dungeon, N, rand, matIdx) self % N = N self % matIdx = matIdx + ! For a large number of materials (large lattice using discretiseGeom_class) rejection + ! sampling is too slow, so calculate bounding box of material + if (self % latPitch(1) /= 0) then + ijk = get_ijk(matIdx, self % latSizeN) + do i=1, 3 + self % matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bottom(i) + self % matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bottom(i) + end do + end if + ! Add N particles to dungeon !$omp parallel pRand = rand @@ -138,7 +161,7 @@ function sampleParticle(self, rand) result(p) type(particleState) :: p class(nuclearDatabase), pointer :: nucData class(IMCMaterial), pointer :: mat - real(defReal), dimension(3) :: r, rand3, dir + real(defReal), dimension(3) :: r, dir real(defReal) :: mu, phi integer(shortInt) :: i, matIdx, uniqueID character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' @@ -147,16 +170,61 @@ function sampleParticle(self, rand) result(p) nucData => ndReg_getIMCMG() if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') - ! Position is sampled by taking a random point from within geometry bounding box - ! If in correct material, position is accepted + ! Choose position sampling method + if (self % latPitch(1) == ZERO) then + call self % samplePosRej(r, matIdx, rand) + else + call self % samplePosLat(r, matIdx, rand) + end if + + ! Point to material + mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) + if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") + + ! Sample direction - chosen uniformly inside unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + + ! Assign basic phase-space coordinates + p % matIdx = matIdx + p % uniqueID = uniqueID + p % time = ZERO + p % type = P_PHOTON + p % r = r + p % dir = dir + p % G = self % G + p % isMG = .true. + + ! Set weight + p % wgt = mat % getEmittedRad() / self % N + + end function sampleParticle + + + !! + !! Position is sampled by taking a random point from within geometry bounding box + !! If in correct material, position is accepted + !! + subroutine samplePosRej(self, r, matIdx, rand) + class(imcSource), intent(inout) :: self + real(defReal), dimension(3), intent(out) :: r + integer(shortInt), intent(out) :: matIdx + class(RNG), intent(inout) :: rand + integer(shortInt) :: i, uniqueID + real(defReal), dimension(3) :: rand3 + character(100), parameter :: Here = 'samplePosRej (IMCSource_class.f90)' + i = 0 - rejection : do + rejectionLoop : do ! Protect against infinite loop i = i+1 - if (i > 100000) then - call fatalError(Here, '100,000 failed samples in rejection sampling loop') + if (i > 10000) then + call fatalError(Here, '10,000 failed samples in rejection sampling loop') end if ! Sample Position @@ -168,39 +236,36 @@ function sampleParticle(self, rand) result(p) ! Find material under position call self % geom % whatIsAt(matIdx, uniqueID, r) - ! Reject if not in desired material - if (matIdx /= self % matIdx) cycle rejection + ! Exit if in desired material + if (matIdx == self % matIdx) exit rejectionLoop - ! Point to material - mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) - if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") + end do rejectionLoop - ! Sample direction - chosen uniformly inside unit sphere - mu = 2 * rand % get() - 1 - phi = rand % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) + end subroutine samplePosRej - ! Assign basic phase-space coordinates - p % matIdx = matIdx - p % uniqueID = uniqueID - p % time = ZERO - p % type = P_PHOTON - p % r = r - p % dir = dir - p % G = self % G - p % isMG = .true. + !! + !! Sample position without using a rejection sampling method, by calculating the material bounds. + !! + !! Requires geometry to be a uniform lattice, so currently only called when discretiseGeom_class + !! is used to create inputs. + !! + subroutine samplePosLat(self, r, matIdx, rand) + class(imcSource), intent(inout) :: self + real(defReal), dimension(3), intent(out) :: r + integer(shortInt), intent(out) :: matIdx + class(RNG), intent(inout) :: rand + integer(shortInt) :: i, uniqueID + character(100), parameter :: Here = 'samplePosLat (IMCSource_class.f90)' - ! Set weight - p % wgt = mat % getEmittedRad() / self % N + do i=1, 3 + r(i) = self % matBounds(i) + rand % get() * (self % matBounds(i+3) - self % matBounds(i)) + end do - ! Exit the loop - exit rejection + call self % geom % whatIsAt(matIdx, uniqueID, r) - end do rejection + if (matIdx /= self % matIdx) call fatalError(Here, 'Incorrect material') - end function sampleParticle + end subroutine samplePosLat !! !! Return to uninitialised state @@ -217,4 +282,35 @@ elemental subroutine kill(self) end subroutine kill + + !! + !! Generate ijk from localID and shape + !! + !! Args: + !! localID [in] -> Local id of the cell between 1 and product(sizeN) + !! sizeN [in] -> Number of cells in each cardinal direction x, y & z + !! + !! Result: + !! Array ijk which has integer position in each cardinal direction + !! + pure function get_ijk(localID, sizeN) result(ijk) + integer(shortInt), intent(in) :: localID + integer(shortInt), dimension(3), intent(in) :: sizeN + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: temp, base + + temp = localID - 1 + + base = temp / sizeN(1) + ijk(1) = temp - sizeN(1) * base + 1 + + temp = base + base = temp / sizeN(2) + ijk(2) = temp - sizeN(2) * base + 1 + + ijk(3) = base + 1 + + end function get_ijk + + end module IMCSource_class diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index cb7ecc929..370e1c58d 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -194,7 +194,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) Ntemp = int(N * mat % getEmittedRad() / totEnergy) ! Enforce at least 1 particle if (Ntemp == 0) Ntemp = 1 + call self % IMCSource % append(self % thisStep, Ntemp, self % pRNG, j) + end if end do @@ -387,7 +389,8 @@ subroutine init(self, dict) integer(shortInt) :: i class(IMCMaterial), pointer :: mat character(nameLen), dimension(:), allocatable :: mats -type(dictionary) :: newGeom, newData + integer(shortInt), dimension(:), allocatable :: latSizeN + type(dictionary) :: newGeom, newData character(100), parameter :: Here ='init (IMCPhysicsPackage_class.f90)' call cpu_time(self % CPU_time_start) @@ -435,6 +438,12 @@ subroutine init(self, dict) ! Automatically split geometry into a uniform grid if (dict % isPresent('discretise')) then + + ! Store dimensions of lattice + tempDict => dict % getDictPtr('discretise') + call tempDict % get(latSizeN, 'dimensions') + + ! Create new input call discretise(dict, newGeom, newData) ! Build Nuclear Data @@ -450,6 +459,9 @@ subroutine init(self, dict) call ndReg_activate(self % particleType, nucData, self % geom % activeMats()) self % nucData => ndReg_get(self % particleType) + call newGeom % kill() + call newData % kill() + else ! Build Nuclear Data @@ -486,7 +498,13 @@ subroutine init(self, dict) end if ! Initialise IMC source - call locDict1 % init(1) + if (dict % isPresent('discretise')) then + ! Store size of lattice to avoid rejection sampling loop in source + call locDict1 % init(2) + call locDict1 % store('sizeN', latSizeN) + else + call locDict1 % init(1) + end if call locDict1 % store('type', 'imcSource') call new_source(self % IMCSource, locDict1, self % geom) @@ -574,5 +592,4 @@ subroutine printSettings(self) print *, repeat("<>",50) end subroutine printSettings - end module IMCPhysicsPackage_class From 6007c938d76830df102df3d199ec52bb3278f930 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 9 Feb 2023 17:35:11 +0000 Subject: [PATCH 317/373] Removed unused variables and a few other small changes --- ParticleObjects/Source/IMCSource_class.f90 | 23 +++++++++++----------- 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 66c38a6fb..fe42ded2d 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -71,7 +71,6 @@ subroutine init(self, dict, geom) class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom real(defReal), dimension(6) :: bounds - integer(shortInt) :: i character(100), parameter :: Here = 'init (imcSource_class.f90)' ! Provide geometry info to source @@ -113,10 +112,8 @@ subroutine append(self, dungeon, N, rand, matIdx) integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand integer(shortInt), intent(in), optional :: matIdx - type(particle) :: p integer(shortInt) :: i integer(shortInt), dimension(3) :: ijk - real(defReal) :: normFactor type(RNG) :: pRand character(100), parameter :: Here = "append (IMCSource_class.f90)" @@ -163,7 +160,7 @@ function sampleParticle(self, rand) result(p) class(IMCMaterial), pointer :: mat real(defReal), dimension(3) :: r, dir real(defReal) :: mu, phi - integer(shortInt) :: i, matIdx, uniqueID + integer(shortInt) :: matIdx, uniqueID character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' ! Get pointer to appropriate nuclear database @@ -172,9 +169,9 @@ function sampleParticle(self, rand) result(p) ! Choose position sampling method if (self % latPitch(1) == ZERO) then - call self % samplePosRej(r, matIdx, rand) + call self % samplePosRej(r, matIdx, uniqueID, rand) else - call self % samplePosLat(r, matIdx, rand) + call self % samplePosLat(r, matIdx, uniqueID, rand) end if ! Point to material @@ -208,12 +205,13 @@ end function sampleParticle !! Position is sampled by taking a random point from within geometry bounding box !! If in correct material, position is accepted !! - subroutine samplePosRej(self, r, matIdx, rand) + subroutine samplePosRej(self, r, matIdx, uniqueID, rand) class(imcSource), intent(inout) :: self real(defReal), dimension(3), intent(out) :: r integer(shortInt), intent(out) :: matIdx + integer(shortInt), intent(out) :: uniqueID class(RNG), intent(inout) :: rand - integer(shortInt) :: i, uniqueID + integer(shortInt) :: i real(defReal), dimension(3) :: rand3 character(100), parameter :: Here = 'samplePosRej (IMCSource_class.f90)' @@ -249,16 +247,17 @@ end subroutine samplePosRej !! Requires geometry to be a uniform lattice, so currently only called when discretiseGeom_class !! is used to create inputs. !! - subroutine samplePosLat(self, r, matIdx, rand) + subroutine samplePosLat(self, r, matIdx, uniqueID, rand) class(imcSource), intent(inout) :: self real(defReal), dimension(3), intent(out) :: r integer(shortInt), intent(out) :: matIdx - class(RNG), intent(inout) :: rand - integer(shortInt) :: i, uniqueID + integer(shortInt), intent(out) :: uniqueID + class(RNG), intent(inout) :: rand + integer(shortInt) :: i character(100), parameter :: Here = 'samplePosLat (IMCSource_class.f90)' do i=1, 3 - r(i) = self % matBounds(i) + rand % get() * (self % matBounds(i+3) - self % matBounds(i)) + r(i) = self % matBounds(i) + rand % get() * (self % matBounds(i+3) - self % matBounds(i) - SURF_TOL) + SURF_TOL end do call self % geom % whatIsAt(matIdx, uniqueID, r) From 559dce9df5672552c840552549b1c6d491127255 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 10 Feb 2023 12:04:10 +0000 Subject: [PATCH 318/373] Lots of changes to make file a bit nicer looking and easier to follow --- Geometry/discretiseGeom_class.f90 | 174 +++++++++++++++++++++--------- 1 file changed, 121 insertions(+), 53 deletions(-) diff --git a/Geometry/discretiseGeom_class.f90 b/Geometry/discretiseGeom_class.f90 index b015553df..f017e17c7 100644 --- a/Geometry/discretiseGeom_class.f90 +++ b/Geometry/discretiseGeom_class.f90 @@ -25,6 +25,10 @@ module discretiseGeom_class ndReg_get => get use nuclearDatabase_inter, only : nuclearDatabase + ! Useful variables + class(geometry), pointer :: inputGeom + class(nuclearDatabase), pointer :: inputNucData + integer(shortInt), dimension(:), allocatable :: sizeN contains @@ -54,27 +58,21 @@ module discretiseGeom_class !! newData [out] -> dictionary containing new nuclear database input !! !! Errors: - !! TODO + !! invalid input dimensions !! subroutine discretise(dict, newGeom, newData) class(dictionary), intent(in) :: dict type(dictionary), intent(out) :: newGeom type(dictionary), intent(out) :: newData class(dictionary), pointer :: tempDict - class(geometry), pointer :: inputGeom - class(nuclearDatabase), pointer :: inputNucData character(nameLen) :: dataName, geomName - integer(shortInt), dimension(:), allocatable :: sizeN - integer(shortInt), dimension(3) :: ijk - real(defReal), dimension(6) :: bounds - real(defReal), dimension(3) :: pitch, corner, r - integer(shortInt) :: N, rootID, latID, geomIdx, inputGeomIdx, matIdx, uniqueId, i - real(defReal) :: volume + integer(shortInt) :: inputGeomIdx character(100), parameter :: Here = 'discretise (discretiseGeom_class.f90)' ! Get discretisation settings tempDict => dict % getDictPtr('discretise') call tempDict % get(sizeN, 'dimensions') + if (any(sizeN <= 0)) call fatalError(Here, 'Invalid dimensions given') ! Build Nuclear Data using input call ndReg_init(dict % getDictPtr("nuclearData")) @@ -91,37 +89,120 @@ subroutine discretise(dict, newGeom, newData) call ndReg_activate(P_PHOTON_MG, dataName, inputGeom % activeMats()) inputNucData => ndReg_get(P_PHOTON_MG) - ! Get bounds, pitch and lower corner + ! Create files for materials and geometry + open(unit = 21, file = 'newGeom.txt') + open(unit = 22, file = 'newData.txt') + + ! Write required information to files + call writeToFiles(tempDict) + + close(21) + close(22) + + ! Kill input geom and nuclear database + call inputGeom % kill() + call inputNucData % kill() + call gr_kill() + call ndReg_kill() + + ! Create geometry and nuclear database from new files + call fileToDict(newData, './newData.txt') + call fileToDict(newGeom, './newGeom.txt') + + end subroutine discretise + + !! + !! Automatically write required information to files in the following format: + !! + !! newGeom.txt: + !! type geometryStd; + !! boundary (...); + !! graph {type shrunk;} + !! surfaces { outer {id 1; type box; origin (...); halfwidth (...);}} + !! cells {} + !! universes { + !! root {id rootID; type rootUniverse; border 1; fill u;} + !! lattice {id latID; type latUniverse; origin (0 0 0); pitch (...); shape (nx ny nz); padMat void; + !! map ( + !! 1 + !! 2 + !! . + !! . + !! . + !! nx*ny*nz); } + !! p1 {id 1; type pinUniverse; radii (0); fills (m1);} + !! p2 {id 2; type pinUniverse; radii (0); fills (m2);} + !! . + !! . + !! . + !! pN {id N; type pinUniverse; radii (0); fills (mN);} } + !! + !! newData.txt: + !! handles {mg {type baseMgIMCDatabase;}} + !! materials { + !! m1 {temp ...; composition {} xsFile ./...; volume ...;} + !! m2 {temp ...; composition {} xsFile ./...; volume ...;} + !! . + !! . + !! . + !! mN {temp ...; compositino {} xsFile ./...; volume ...;} } + !! + !! + !! Args: + !! dict [in] -> geometry input dictionary + !! + subroutine writeToFiles(dict) + class(dictionary), intent(in), pointer :: dict + character(nameLen) :: geomType, graphType + integer(shortInt), dimension(:), allocatable :: boundary + class(dictionary), pointer :: tempDict + real(defReal) :: volume + real(defReal), dimension(3) :: origin, halfwidth, pitch, corner, r + real(defReal), dimension(6) :: bounds + integer(shortInt) :: i, N, rootID, latID, matIdx, uniqueID + integer(shortInt), dimension(3) :: ijk + + ! Get bounds, pitch and lower corner bounds = inputGeom % bounds() do i = 1, 3 - pitch(i) = (bounds(i+3)-bounds(i))/sizeN(i) + pitch(i) = (bounds(i+3)-bounds(i)) / sizeN(i) corner(i) = bounds(i) end do + ! Calculate volume of each cell and number of cells volume = pitch(1) * pitch(2) * pitch(3) N = sizeN(1) * sizeN(2) * sizeN(3) - ! Create files for materials and geometry - open(unit = 21, file = 'newGeom.txt') - open(unit = 22, file = 'newData.txt') - + ! Get geometry settings from input file + call dict % get(geomType, 'type') + call dict % get(boundary, 'boundary') + tempDict => dict % getDictPtr('graph') + call tempDict % get(graphType, 'type') + + ! Write to new file + write (21, '(8A)') 'type '//trim(geomType)//';'//new_line('A')//& + &'boundary ('//numToChar(boundary)//');'//new_line('A')//& + &'graph {type '//trim(graphType)//';}' + + ! Construct outer boundary surface based on input geometry bounds + ! Will likely cause problems if input outer surface is not a box + do i=1, 3 + origin(i) = (bounds(i+3) + bounds(i)) / 2 + halfwidth(i) = (bounds(i+3) - bounds(i)) / 2 + end do + write (21, '(8A)') 'surfaces { outer {id 1; type box; origin ('//numToChar(origin)//'); & + &halfwidth ('//numToChar(halfwidth)//');}}' - ! Write geometry settings - TODO obtain this from input file automatically - write (21, '(8A)') 'type geometryStd;'//new_line('A')//'boundary (0 0 1 1 1 1);'& - &//new_line('A')//'graph {type shrunk;}' - write (21, '(8A)') 'surfaces { outer { id 1; type box; origin (0 0 0); halfwidth (2 0.5 0.5);}}' - write (21, '(8A)') 'cells {}'//new_line('A')//'universes {' + ! Empty cell dictionary and construct root universe rootID = N + 1 latID = N + 2 - write (21, '(8A)') 'root { id '//numToChar(rootID)//'; type rootUniverse; border 1; & - &fill u<'//numToChar(latID)//'>; }'//new_line('A') - - ! Write material settings - TODO obtain this from input file automatically - write (22, '(8A)') 'handles {mg {type baseMgIMCDatabase;}}'//new_line('A')//'materials {' - + write (21, '(8A)') 'cells {}'//new_line('A')//& + &'universes {'//new_line('A')//& + &'root {id '//numToChar(rootID)//'; type rootUniverse; border 1; & + &fill u<'//numToChar(latID)//'>;}' ! Write lattice input - write(21, '(8A)') 'lattice { id '//numToChar(latID)//'; type latUniverse; origin (0 0 0); pitch ('//& + write(21, '(8A)') 'lattice {id '//numToChar(latID)//'; type latUniverse; origin (0 0 0); pitch ('//& &numToChar(pitch)//'); shape ('//numToChar(sizeN)//'); padMat void;'& &//new_line('A')//'map (' do i = 1, N @@ -131,6 +212,10 @@ subroutine discretise(dict, newGeom, newData) write(21, '(8A)') '); }'//new_line('A') + ! Write material settings - TODO obtain this from input file automatically? + write (22, '(8A)') 'handles {mg {type baseMgIMCDatabase;}}'//new_line('A')//'materials {' + + ! Write pin universes and materials do i = 1, N @@ -143,48 +228,31 @@ subroutine discretise(dict, newGeom, newData) ! Pin universe for void and outside mat if (matIdx == VOID_MAT) then - write(21, '(8A)') 'p'//numToChar(i)//' { id '//numToChar(i)//'; type pinUniverse; & - &radii (0); fills (void); }' + write(21, '(8A)') 'p'//numToChar(i)//' {id '//numToChar(i)//'; type pinUniverse; & + &radii (0); fills (void);}' else if (matIdx == OUTSIDE_MAT) then - write(21, '(8A)') 'p'//numToChar(i)//' { id '//numToChar(i)//'; type pinUniverse; & - &radii (0); fills (outside); }' + write(21, '(8A)') 'p'//numToChar(i)//' {id '//numToChar(i)//'; type pinUniverse; & + &radii (0); fills (outside);}' ! User-defined materials else ! Pin universe - write(21, '(8A)') 'p'//numToChar(i)//' { id '//numToChar(i)//'; type pinUniverse; & - &radii (0); fills (m'//numToChar(i)//'); }' + write(21, '(8A)') 'p'//numToChar(i)//' {id '//numToChar(i)//'; type pinUniverse; & + &radii (0); fills (m'//numToChar(i)//');}' ! Material - write(22, '(8A)') 'm'//numToChar(i)//' { temp '//numToChar(mm_matTemp(matIdx))//'; & - &composition {} xsFile '//trim(mm_matFile(matIdx))//'; volume '//numToChar(volume)//'; }' + write(22, '(8A)') 'm'//numToChar(i)//' {temp '//numToChar(mm_matTemp(matIdx))//'; & + &composition {} xsFile '//trim(mm_matFile(matIdx))//'; volume '//numToChar(volume)//';}' end if - end do ! Write closing brackets for dictionaries write (21, '(8A)') '}' write (22, '(8A)') '}' - ! Kill input geom and nuclear database - call inputGeom % kill() - call inputNucData % kill() - call gr_kill() - call ndReg_kill() - - close(21) - close(22) - - ! Create geometry and nuclear database from new files - - call fileToDict(newData, './newData.txt') - call fileToDict(newGeom, './newGeom.txt') - - end subroutine discretise - - + end subroutine writeToFiles !! !! Generate ijk from localID and shape From 3750e4a13e6f80cdcd9dffda5df31cca8abf6b11 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 10 Feb 2023 12:04:59 +0000 Subject: [PATCH 319/373] Moved around input files --- InputFiles/IMC/MarshakWave/marshakWave | 46 +++++++++++++++++++ .../{dataFiles/imcData => nucDataMW} | 0 .../MarshakWave/oldInputs/dataFiles/imcData | 18 ++++++++ .../{ => oldInputs}/marshakWave128 | 0 .../MarshakWave/{ => oldInputs}/marshakWave16 | 0 .../MarshakWave/{ => oldInputs}/marshakWave32 | 0 .../MarshakWave/{ => oldInputs}/marshakWave64 | 0 .../MarshakWave/{ => oldInputs}/marshakWave8 | 0 8 files changed, 64 insertions(+) create mode 100644 InputFiles/IMC/MarshakWave/marshakWave rename InputFiles/IMC/MarshakWave/{dataFiles/imcData => nucDataMW} (100%) create mode 100644 InputFiles/IMC/MarshakWave/oldInputs/dataFiles/imcData rename InputFiles/IMC/MarshakWave/{ => oldInputs}/marshakWave128 (100%) rename InputFiles/IMC/MarshakWave/{ => oldInputs}/marshakWave16 (100%) rename InputFiles/IMC/MarshakWave/{ => oldInputs}/marshakWave32 (100%) rename InputFiles/IMC/MarshakWave/{ => oldInputs}/marshakWave64 (100%) rename InputFiles/IMC/MarshakWave/{ => oldInputs}/marshakWave8 (100%) diff --git a/InputFiles/IMC/MarshakWave/marshakWave b/InputFiles/IMC/MarshakWave/marshakWave new file mode 100644 index 000000000..4336d0ee5 --- /dev/null +++ b/InputFiles/IMC/MarshakWave/marshakWave @@ -0,0 +1,46 @@ +// Marshak wave IMC benchmark +// Requires lightSpeed and radiation constant set to ONE in universalVariables + +type IMCPhysicsPackage; + +pop 1000000; +limit 2500000; +steps 10; +timeStepSize 0.5; +printUpdates 20; + +collisionOperator { photonMG {type IMCMGstd;} } + +transportOperator { + type transportOperatorTimeHT; cutoff 0.8; + } + +tally {} + +// Black body surface source +source { type bbSurfaceSource; shape square; size 1; axis x; pos -2; T 1; dir 1; particle photon; N 10000; } + +// Spatial discretisation +discretise { dimensions (500 1 1); } + +// Overlaid grid for hybrid tracking +grid { dimensions (50 1 1); searchN (1000 1 1); } + +geometry { + type geometryStd; + boundary (0 0 1 1 1 1); + graph {type shrunk;} + + surfaces { outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); }} + cells {} + universes { root { id 100; type rootUniverse; border 1; fill mat1; }} +} + +nuclearData { + handles { mg { type baseMgIMCDatabase; }} + + materials { mat1 { temp 0.01; composition {} xsFile ./nucDataMW; }} +} + + + diff --git a/InputFiles/IMC/MarshakWave/dataFiles/imcData b/InputFiles/IMC/MarshakWave/nucDataMW similarity index 100% rename from InputFiles/IMC/MarshakWave/dataFiles/imcData rename to InputFiles/IMC/MarshakWave/nucDataMW diff --git a/InputFiles/IMC/MarshakWave/oldInputs/dataFiles/imcData b/InputFiles/IMC/MarshakWave/oldInputs/dataFiles/imcData new file mode 100644 index 000000000..389b9eaa0 --- /dev/null +++ b/InputFiles/IMC/MarshakWave/oldInputs/dataFiles/imcData @@ -0,0 +1,18 @@ + +numberOfGroups 1; + +capture ( + 10 + -3 +); + +scatter ( + 0 + 0 +); + +cv ( + 7.14 + 0 +); + diff --git a/InputFiles/IMC/MarshakWave/marshakWave128 b/InputFiles/IMC/MarshakWave/oldInputs/marshakWave128 similarity index 100% rename from InputFiles/IMC/MarshakWave/marshakWave128 rename to InputFiles/IMC/MarshakWave/oldInputs/marshakWave128 diff --git a/InputFiles/IMC/MarshakWave/marshakWave16 b/InputFiles/IMC/MarshakWave/oldInputs/marshakWave16 similarity index 100% rename from InputFiles/IMC/MarshakWave/marshakWave16 rename to InputFiles/IMC/MarshakWave/oldInputs/marshakWave16 diff --git a/InputFiles/IMC/MarshakWave/marshakWave32 b/InputFiles/IMC/MarshakWave/oldInputs/marshakWave32 similarity index 100% rename from InputFiles/IMC/MarshakWave/marshakWave32 rename to InputFiles/IMC/MarshakWave/oldInputs/marshakWave32 diff --git a/InputFiles/IMC/MarshakWave/marshakWave64 b/InputFiles/IMC/MarshakWave/oldInputs/marshakWave64 similarity index 100% rename from InputFiles/IMC/MarshakWave/marshakWave64 rename to InputFiles/IMC/MarshakWave/oldInputs/marshakWave64 diff --git a/InputFiles/IMC/MarshakWave/marshakWave8 b/InputFiles/IMC/MarshakWave/oldInputs/marshakWave8 similarity index 100% rename from InputFiles/IMC/MarshakWave/marshakWave8 rename to InputFiles/IMC/MarshakWave/oldInputs/marshakWave8 From f3bfa31e1d2f93cc35e522b7471b085a28777cd8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 14 Mar 2023 16:07:14 +0000 Subject: [PATCH 320/373] A couple of changes for when void is present in geometry --- Geometry/simpleGrid_class.f90 | 2 +- .../mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index 43cb560fc..45ecc0d95 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -215,7 +215,7 @@ function getValue(self, r, u) result(val) val = self % gridCells(idx) % majorant - if (val <= ZERO) call fatalError(Here, 'Invalid majorant: '//numToChar(val)) + if (val < ZERO) call fatalError(Here, 'Invalid majorant: '//numToChar(val)) end function getValue diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index e0d6fc83b..508b42fe8 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -101,7 +101,13 @@ function getTotalMatXS(self, p, matIdx) result(xs) integer(shortInt), intent(in) :: matIdx real(defReal) :: xs - xs = self % mats(matIdx) % getTotalXS(p % G, p % pRNG) + ! TODO: Added this check to try to avoid error with void mat, but somehow still leads to + ! segmentation error in nGroups (baseMgIMCMaterial_class.f90) when void regions are present + if (matIdx == 0) then + xs = ZERO + else + xs = self % mats(matIdx) % getTotalXS(p % G, p % pRNG) + end if end function getTotalMatXS From 64cba5ea149aea606db8a05a7f892754f208974a Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 14 Mar 2023 16:15:29 +0000 Subject: [PATCH 321/373] Changes to how material bounds are calculated in source to (hopefully) work when void regions are present --- ParticleObjects/Source/IMCSource_class.f90 | 48 +++++++++++++++++----- 1 file changed, 38 insertions(+), 10 deletions(-) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index fe42ded2d..99f91596d 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -16,6 +16,7 @@ module IMCSource_class use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG use nuclearDatabase_inter, only : nuclearDatabase use mgIMCDatabase_inter, only : mgIMCDatabase + use materialMenu_mod, only : mm_matName => matName implicit none private @@ -54,8 +55,9 @@ module IMCSource_class procedure :: init procedure :: append procedure :: sampleParticle - procedure :: samplePosRej - procedure :: samplePosLat + procedure, private :: samplePosRej + procedure, private :: samplePosLat + procedure, private :: getMatBounds procedure :: kill end type imcSource @@ -113,7 +115,6 @@ subroutine append(self, dungeon, N, rand, matIdx) class(RNG), intent(inout) :: rand integer(shortInt), intent(in), optional :: matIdx integer(shortInt) :: i - integer(shortInt), dimension(3) :: ijk type(RNG) :: pRand character(100), parameter :: Here = "append (IMCSource_class.f90)" @@ -127,11 +128,8 @@ subroutine append(self, dungeon, N, rand, matIdx) ! For a large number of materials (large lattice using discretiseGeom_class) rejection ! sampling is too slow, so calculate bounding box of material if (self % latPitch(1) /= 0) then - ijk = get_ijk(matIdx, self % latSizeN) - do i=1, 3 - self % matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bottom(i) - self % matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bottom(i) - end do + ! Get material bounds + call self % getMatBounds(matIdx, self % matBounds) end if ! Add N particles to dungeon @@ -262,10 +260,40 @@ subroutine samplePosLat(self, r, matIdx, uniqueID, rand) call self % geom % whatIsAt(matIdx, uniqueID, r) - if (matIdx /= self % matIdx) call fatalError(Here, 'Incorrect material') - end subroutine samplePosLat + !! + !! Get location of material in lattice for position sampling + !! + !! Args: + !! matIdx [in] -> matIdx for which to calculate bounds + !! matBounds [out] -> boundary of lattice cell, [xmin,ymin,zmin,xmax,ymax,zmax] + !! + !! TODO: + !! Would be nice to have most of this in a geometry module + !! + subroutine getMatBounds(self, matIdx, matBounds) + class(imcSource), intent(inout) :: self + integer(shortInt), intent(in) :: matIdx + real(defReal), dimension(6), intent(out) :: matBounds + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: latIdx, i + character(nameLen) :: matName + character(100), parameter :: Here = 'getMatBounds (imcSourceClass.f90)' + + ! Extract lattice position from mat name (e.g. "m106 -> 106") + matName = mm_matName(matIdx) + read (matName(2:), '(I10)') latIdx + + ! Set bounds of lattice cell containing matIdx + ijk = get_ijk(latIdx, self % latSizeN) + do i=1, 3 + matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bottom(i) + matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bottom(i) + end do + + end subroutine getMatBounds + !! !! Return to uninitialised state !! From 3d2c6f4fed4761b321f360ca4bdcf503ac4bd06c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 14 Mar 2023 16:16:34 +0000 Subject: [PATCH 322/373] Input file for hohlraum benchmark, not yet using correct units --- hohlraum | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) create mode 100644 hohlraum diff --git a/hohlraum b/hohlraum new file mode 100644 index 000000000..fcf2df2c5 --- /dev/null +++ b/hohlraum @@ -0,0 +1,103 @@ + +type IMCPhysicsPackage; + +pop 2000000; +limit 20000000; +steps 100; +timeStepSize 0.2; +printUpdates 20; + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorTimeHT; cutoff 0.9; + } + +source { + type bbSurfaceSource; + shape square; + size 1; + axis x; + pos -0.5; + T 1; + dir 1; + particle photon; + N 20000; +} + +viz { vizDict { type vtk; corner (-0.5 -0.5 -0.5); width (1 1 1); vox (20 20 1); } } + +tally { + } + +grid { dimensions (20 20 1); searchN (10 10 1); } + +discretise { dimensions (200 200 1); } + +geometry { + type geometryStd; + boundary (0 0 0 0 0 0); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } + xPlane1 { id 2; type xPlane; x0 -0.45; } + xPlane2 { id 3; type xPlane; x0 -0.25; } + xPlane3 { id 4; type xPlane; x0 0.25; } + xPlane4 { id 5; type xPlane; x0 0.45; } + yPlane1 { id 6; type yPlane; y0 -0.45; } + yPlane2 { id 7; type yPlane; y0 -0.25; } + yPlane3 { id 8; type yPlane; y0 0.25; } + yPlane4 { id 9; type yPlane; y0 0.45; } + } + + cells { + // Top mat + cell1 { id 1; type simpleCell; surfaces (9); filltype mat; material mat1; } + // Bottom mat + cell2 { id 2; type simpleCell; surfaces (-6); filltype mat; material mat1; } + // Right side mat + cell3 { id 3; type simpleCell; surfaces (5 6 -9); filltype mat; material mat1; } + // Left side mat + cell4 { id 4; type simpleCell; surfaces (-2 7 -8); filltype mat; material mat1; } + // Centre mat + cell5 { id 5; type simpleCell; surfaces (3 -4 7 -8); filltype mat; material mat1; } + // Top void + cell6 { id 6; type simpleCell; surfaces (8 -9 -5); filltype mat; material mat2; } + // Bottom void + cell7 { id 7; type simpleCell; surfaces (6 -7 -5); filltype mat; material mat2; } + // Right void + cell8 { id 8; type simpleCell; surfaces (7 -8 4 -5); filltype mat; material mat2; } + // Left void + cell9 { id 9; type simpleCell; surfaces (7 -8 2 -3); filltype mat; material mat2; } + } + + universes + { + root { id 1; type rootUniverse; border 1; fill u<2>; } + cells { id 2; type cellUniverse; cells (1 2 3 4 5 6 7 8 9); } + } + +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; } + } + + + materials { + + mat1 { temp 0.01; composition {} xsFile ./dataFiles/hohlraumData; } + mat2 { temp 1; composition {} xsFile ./dataFiles/voidData; } + + } + +} + + + From 9d04f44f530705368b3d02e8c807029a3f83fc62 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 21 Mar 2023 13:29:52 +0000 Subject: [PATCH 323/373] Lots of changes to make transop more readable. Also moved grid into transop instead of physics package --- Geometry/simpleGrid_class.f90 | 17 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 26 +-- .../transportOperatorFactory_func.f90 | 11 +- .../transportOperatorHT_class.f90 | 4 +- .../transportOperatorST_class.f90 | 4 +- .../transportOperatorTimeHT_class.f90 | 208 ++++++++++++------ TransportOperator/transportOperator_inter.f90 | 7 +- 7 files changed, 167 insertions(+), 110 deletions(-) diff --git a/Geometry/simpleGrid_class.f90 b/Geometry/simpleGrid_class.f90 index 45ecc0d95..6171fc6d9 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/Geometry/simpleGrid_class.f90 @@ -1,7 +1,7 @@ module simpleGrid_class use numPrecision - use universalVariables, only : SURF_TOL + use universalVariables, only : SURF_TOL, P_PHOTON_MG use genericProcedures, only : fatalError, numToChar use dictionary_class, only : dictionary use geometry_inter, only : geometry @@ -9,6 +9,9 @@ module simpleGrid_class use nuclearDatabase_inter, only : nuclearDatabase use particle_class, only : particle + use geometryReg_mod, only : gr_geomPtr => geomPtr + use nuclearDataReg_mod, only : ndReg_get => get + !! !! !! @@ -51,21 +54,23 @@ module simpleGrid_class subroutine init(self, dict, geom, xsData) class(simpleGrid), intent(inout) :: self class(dictionary), intent(in) :: dict - class(geometry), intent(in), pointer :: geom - class(nuclearDatabase), intent(in), pointer :: xsData + class(geometry), intent(in), pointer, optional :: geom + class(nuclearDatabase), intent(in), pointer, optional :: xsData integer(shortInt) :: N integer(shortInt), dimension(:), allocatable :: searchN ! Store pointer to main geometry and data - self % mainGeom => geom - self % xsData => xsData +! self % mainGeom => geom +! self % xsData => xsData + self % xsData => ndReg_get(P_PHOTON_MG) ! TODO: not an ideal way to do this but fine temporarily + self % mainGeom => gr_geomPtr(1) ! Store settings call dict % get(self % sizeN, 'dimensions') call dict % get(searchN, 'searchN') ! Get bounds of grid and calculate discretisations - self % bounds = geom % bounds() + self % bounds = self % mainGeom % bounds() self % pitch(1) = (self % bounds(4) - self % bounds(1)) / self % sizeN(1) self % pitch(2) = (self % bounds(5) - self % bounds(2)) / self % sizeN(2) diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 370e1c58d..c697f2bdb 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -25,7 +25,6 @@ module IMCPhysicsPackage_class use geometry_inter, only : geometry use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & gr_geomIdx => geomIdx - use simpleGrid_class, only : simpleGrid use discretiseGeom_class, only : discretise ! Nuclear Data @@ -67,7 +66,6 @@ module IMCPhysicsPackage_class ! Building blocks class(nuclearDatabase), pointer :: nucData => null() class(geometry), pointer :: geom => null() - class(simpleGrid), pointer :: grid => null() integer(shortInt) :: geomIdx = 0 type(collisionOperator) :: collOp class(transportOperator), allocatable :: transOp @@ -135,6 +133,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_steps integer(shortInt) :: i, j, N, Ntemp, num, nParticles +!integer(shortInt) :: thisStepPop type(particle), save :: p real(defReal) :: elapsed_T, end_T, T_toEnd, totEnergy real(defReal), dimension(:), allocatable :: tallyEnergy @@ -146,6 +145,8 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(RNG), target, save :: pRNG !$omp threadprivate(p, collOp, transOp, pRNG, mat) +!open(unit=11, file='times.txt') + !$omp parallel p % geomIdx = self % geomIdx @@ -163,9 +164,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) do i=1,N_steps - ! Update grid values if grid is in use - if (associated(self % grid)) call self % grid % update() - ! Swap dungeons to store photons remaining from previous time step self % temp_dungeon => self % nextStep self % nextStep => self % thisStep @@ -205,6 +203,8 @@ subroutine steps(self, tally, tallyAtch, N_steps) call self % inputSource % append(self % thisStep, 0, self % pRNG) end if +!thisStepPop = self % thisStep % popSize() + if(self % printSource == 1) then call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) end if @@ -294,6 +294,8 @@ subroutine steps(self, tally, tallyAtch, N_steps) print *, 'Time to end: ', trim(secToChar(T_toEnd)) call tally % display() +!write(11, '(8A)') numToChar(elapsed_T * self % limit / thisStepPop) + ! Obtain energy deposition tally results call tallyAtch % getResult(tallyRes, 'imcWeightTally') @@ -334,6 +336,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) write(10, '(8A)') numToChar(mat % getTemp()) end do close(10) +!close(11) end subroutine steps @@ -377,7 +380,7 @@ end subroutine collectResults subroutine init(self, dict) class(IMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict - class(dictionary),pointer :: tempDict + class(dictionary), pointer :: tempdict type(dictionary) :: locDict1, locDict2, locDict3, locDict4, locDict5 integer(shortInt) :: seed_temp integer(longInt) :: seed @@ -480,15 +483,6 @@ subroutine init(self, dict) end if - - - ! Initialise grid for hybrid tracking - if (dict % isPresent('grid')) then - tempDict => dict % getDictPtr('grid') - allocate(self % grid) - call self % grid % init(tempDict, self % geom, self % nucData) - end if - ! Read particle source definition if( dict % isPresent('source') ) then tempDict => dict % getDictPtr('source') @@ -514,7 +508,7 @@ subroutine init(self, dict) ! Build transport operator tempDict => dict % getDictPtr('transportOperator') - call new_transportOperator(self % transOp, tempDict, self % grid) + call new_transportOperator(self % transOp, tempDict) ! Initialise tally Admin tempDict => dict % getDictPtr('tally') diff --git a/TransportOperator/transportOperatorFactory_func.f90 b/TransportOperator/transportOperatorFactory_func.f90 index 824f3763e..2949c2956 100644 --- a/TransportOperator/transportOperatorFactory_func.f90 +++ b/TransportOperator/transportOperatorFactory_func.f90 @@ -7,8 +7,6 @@ module transportOperatorFactory_func use genericProcedures, only : fatalError use dictionary_class, only : dictionary - use simpleGrid_class, only : simpleGrid - ! Transport Operators use transportOperator_inter, only : transportOperator use transportOperatorST_class, only : transportOperatorST @@ -39,10 +37,9 @@ module transportOperatorFactory_func !! Allocate new allocatable transportOperator to a specific type !! If new is allocated it deallocates it !! - subroutine new_transportOperator(new, dict, grid) + subroutine new_transportOperator(new, dict) class(transportOperator),allocatable, intent(inout):: new class(dictionary), intent(in) :: dict - class(simpleGrid), intent(in), pointer, optional :: grid character(nameLen) :: type character(100),parameter :: Here = 'new_transportOperator (transportOperatorFactory_func.f90)' @@ -68,11 +65,7 @@ subroutine new_transportOperator(new, dict, grid) case('transportOperatorTimeHT') allocate( transportOperatorTimeHT :: new) - if (present(grid)) then - call new % init(dict, grid) - else - call new % init(dict) - end if + call new % init(dict) ! case('dynamicTranspOperDT') ! allocate( transportOperatorDynamicDT :: new) diff --git a/TransportOperator/transportOperatorHT_class.f90 b/TransportOperator/transportOperatorHT_class.f90 index a893af0c8..baa39a760 100644 --- a/TransportOperator/transportOperatorHT_class.f90 +++ b/TransportOperator/transportOperatorHT_class.f90 @@ -20,7 +20,6 @@ module transportOperatorHT_class ! Geometry interfaces use geometry_inter, only : geometry - use simpleGrid_class, only : simpleGrid ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase @@ -43,10 +42,9 @@ module transportOperatorHT_class contains - subroutine init(self, dict, grid) + subroutine init(self, dict) class(transportOperatorHT), intent(inout) :: self class(dictionary), intent(in) :: dict - class(simpleGrid), intent(in), pointer, optional :: grid ! Initialise superclass call init_super(self, dict) diff --git a/TransportOperator/transportOperatorST_class.f90 b/TransportOperator/transportOperatorST_class.f90 index feba3d5b8..282912c49 100644 --- a/TransportOperator/transportOperatorST_class.f90 +++ b/TransportOperator/transportOperatorST_class.f90 @@ -16,7 +16,6 @@ module transportOperatorST_class ! Geometry interfaces use geometry_inter, only : geometry, distCache - use simpleGrid_class, only : simpleGrid ! Tally interface use tallyCodes @@ -102,10 +101,9 @@ end subroutine surfaceTracking !! !! See transportOperator_inter for details !! - subroutine init(self, dict, grid) + subroutine init(self, dict) class(transportOperatorST), intent(inout) :: self class(dictionary), intent(in) :: dict - class(simpleGrid), intent(in), pointer, optional :: grid if (dict % isPresent('cache')) then call dict % get(self % cache, 'cache') diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 052e33a71..ca71a29c9 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -27,18 +27,29 @@ module transportOperatorTimeHT_class implicit none private + !! + !! Tracking method + !! + integer(shortInt), parameter :: HT = 1 ! Hybrid tracking + integer(shortInt), parameter :: GT = 2 ! Grid tracking + integer(shortInt), parameter :: ST = 3 ! Surface tracking + integer(shortInt), parameter :: DT = 4 ! Delta tracking + !! !! Transport operator that moves a particle with using hybrid tracking, up to a time boundary !! type, public, extends(transportOperator) :: transportOperatorTimeHT - real(defReal) :: majorant_inv real(defReal) :: deltaT real(defReal) :: cutoff + integer(shortInt) :: method + real(defReal) :: timeMax + class(simpleGrid), pointer :: grid => null() contains procedure :: transit => timeTracking procedure :: init procedure, private :: surfaceTracking procedure, private :: deltaTracking + procedure, private :: getMajInv end type transportOperatorTimeHT contains @@ -52,28 +63,34 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) real(defReal) :: sigmaT character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' - ! Get majorant XS inverse: 1/Sigma_majorant - if (associated(self % grid)) then - self % majorant_inv = ONE / self % grid % getValue(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) - else - self % majorant_inv = ONE / self % xsData % getMajorantXS(p) - end if + ! Select action based on specified method + select case (self % method) + + ! Hybrid Tracking + case (HT) + call self % deltaTracking(p) + + ! Grid tracking + case (GT) + ! Update grid majorants at the start of new time step + if (p % timeMax /= self % timeMax) then + call self % grid % update() ! TODO: currently being called in every parallel thread, + ! only needs to be called once + self % timeMax = p % timeMax + end if + call self % deltaTracking(p) + + ! Surface Tracking + case (ST) + call self % surfaceTracking(p) - ! Check for errors - if (p % time /= p % time) call fatalError(Here, 'Particle time is NaN') + ! Delta Tracking + case (DT) + call self % deltaTracking(p) - ! Obtain sigmaT - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + case default - ! Decide whether to use delta tracking or surface tracking - ! Vastly different opacities make delta tracking infeasable - if(sigmaT * self % majorant_inv > ONE - self % cutoff) then - ! Delta tracking - call self % deltaTracking(p) - else - ! Surface tracking - call self % surfaceTracking(p) - end if + end select ! Check for particle leakage if (p % matIdx() == OUTSIDE_FILL) then @@ -133,99 +150,156 @@ subroutine surfaceTracking(self, p) end if + + ! TODO: Option to switch back to DT? + + end do STLoop end subroutine surfaceTracking !! - !! Perform delta tracking + !! Perform delta tracking - option to switch to surface tracking for HT and GT methods !! subroutine deltaTracking(self, p) class(transportOperatorTimeHT), intent(inout) :: self class(particle), intent(inout) :: p - real(defReal) :: dTime, dColl, dGrid, sigmaT + real(defReal) :: dTime, dColl, dGrid, sigmaT, majorant_inv, dist character(100), parameter :: Here = 'deltaTracking (transportOperatorTimeHT_class.f90)' - dGrid = INF - if (associated(self % grid)) then + ! Get majorant and grid crossing distance if required + majorant_inv = self % getMajInv(p) + if (self % method == GT) then dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + else + dGrid = INF end if + ! Get initial opacity + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + DTLoop:do + ! Switch to ST if required + if (self % method /= DT) then + if (sigmaT * majorant_inv < ONE - self % cutoff) then + call self % surfaceTracking(p) + return + end if + end if + ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) ! Sample distance to collision - dColl = -log( p % pRNG % get() ) * self % majorant_inv - - ! Check if grid cell changes - only passes if grid is allocated, otherwise dGrid = INF - if (dGrid < dTime .and. dGrid < dColl) then - call self % geom % teleport(p % coords, dGrid) - p % time = p % time + dGrid / lightSpeed - if (p % matIdx() == OUTSIDE_FILL) return ! TODO Check that this check doesn't pass if particle is reflected on universe boundary - self % majorant_inv = ONE / self % grid % getValue(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + dColl = -log( p % pRNG % get() ) * majorant_inv + + ! Select particle by minimum distance + dist = min(dColl, dTime, dGrid) + call self % geom % teleport(p % coords, dist) + p % time = p % time + dist / lightSpeed + + ! Exit in the case of particle leakage + if (p % matIdx() == OUTSIDE_FILL) then + return + end if + + ! Act based on distance moved + if (dist == dGrid) then + ! Update values and cycle loop + majorant_inv = self % getMajInv(p) dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) cycle DTLoop - ! If dTime < dColl, move to end of time step location - else if (dTime < dColl) then - call self % geom % teleport(p % coords, dTime) + else if (dist == dTime) then + ! Update particle fate and exit p % fate = AGED_FATE - p % time = p % timeMax + if (p % time /= p % timeMax) call fatalError(Here, 'Mismatching particle times') exit DTLoop - end if - ! Otherwise, move to potential collision location - call self % geom % teleport(p % coords, dColl) - p % time = p % time + dColl / lightSpeed + else ! Dist == dColl + ! Check for real or virtual collision + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + if (p % pRNG % get() < sigmaT * majorant_inv) exit DTLoop + ! Protect against infinite loop + if (sigmaT * majorant_inv == 0) call fatalError(Here, '100% virtual collision probability') + ! Update grid distance + dGrid = dGrid - dColl - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) return - - ! Obtain local cross-section - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + end if - ! Roll RNG to determine if the collision is real or virtual - ! Exit the loop if the collision is real - if (p % pRNG % get() < sigmaT * self % majorant_inv) exit DTLoop + end do DTLoop - ! Switch to surface tracking if delta tracking is infeasible - if(sigmaT * self % majorant_inv < ONE - self % cutoff) then - call self % surfaceTracking(p) - ! Exit after surface tracking - return - end if + end subroutine deltaTracking - ! Protect against infinite loop - if (sigmaT*self % majorant_inv == 0) call fatalError(Here, '100 % virtual collision chance, & - &potentially infinite loop') + !! + !! + !! + function getMajInv(self, p) result (maj_inv) + class(transportOperatorTimeHT), intent(in) :: self + class(particle), intent(in) :: p + real(defReal) :: maj_inv - ! Update distance to next grid cell - dGrid = dGrid - dColl + if (self % method == GT) then + maj_inv = ONE / self % grid % getValue(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) + else + maj_inv = ONE / self % xsData % getMajorantXS(p) + end if - end do DTLoop + end function getMajInv - end subroutine deltaTracking !! !! Provide transport operator with delta tracking/surface tracking cutoff !! !! Cutoff of 1 gives exclusively delta tracking, cutoff of 0 gives exclusively surface tracking !! - subroutine init(self, dict, grid) + subroutine init(self, dict) class(transportOperatorTimeHT), intent(inout) :: self class(dictionary), intent(in) :: dict - class(simpleGrid), intent(in), pointer, optional :: grid +! class(simpleGrid), intent(in), pointer, optional :: grid + character(nameLen) :: method + class(dictionary),pointer :: tempdict + character(100), parameter :: Here = "init (transportOperatorTimeHT_class.f90)" ! Initialise superclass call init_super(self, dict) - ! Get cutoff value - call dict % getOrDefault(self % cutoff, 'cutoff', 0.7_defReal) + ! Get tracking method + call dict % getOrDefault(method, 'method', 'HT') + + select case (method) + + ! Hybrid tracking + case ('HT') + self % method = HT + ! Get cutoff value + call dict % get(self % cutoff, 'cutoff') + + ! Grid tracking + case ('GT') + self % method = GT + ! Get cutoff value + call dict % get(self % cutoff, 'cutoff') + + ! Initialise grid for hybrid tracking + tempDict => dict % getDictPtr('grid') + allocate(self % grid) + call self % grid % init(tempDict) + + ! Surface tracking + case ('ST') + self % method = ST + + ! Delta tracking + case ('DT') + self % method = DT + + case default + call fatalError(Here, 'Invalid tracking method given. Must be HT, ST or DT.') - ! Store grid pointer - if (present(grid)) self % grid => grid + end select end subroutine init diff --git a/TransportOperator/transportOperator_inter.f90 b/TransportOperator/transportOperator_inter.f90 index 5f864533c..e45ac37ef 100644 --- a/TransportOperator/transportOperator_inter.f90 +++ b/TransportOperator/transportOperator_inter.f90 @@ -11,7 +11,6 @@ module transportOperator_inter ! Geometry interfaces use geometryReg_mod, only : gr_geomPtr => geomPtr use geometry_inter, only : geometry - use simpleGrid_class, only : simpleGrid ! Tally interface use tallyAdmin_class, only : tallyAdmin @@ -49,9 +48,6 @@ module transportOperator_inter !! Geometry pointer -> public so it can be used by subclasses (protected member) class(geometry), pointer :: geom => null() - !! Pointer to grid for improved hybrid tracking, currently only used in TOTimeHT_class - class(simpleGrid), pointer :: grid => null() - contains ! Public interface procedure, non_overridable :: transport @@ -124,10 +120,9 @@ end subroutine transport !! !! Initialise transport operator from dictionary and geometry !! - subroutine init(self, dict, grid) + subroutine init(self, dict) class(transportOperator), intent(inout) :: self class(dictionary), intent(in) :: dict - class(simpleGrid), intent(in), pointer, optional :: grid ! Do nothing From cbfed02d50aab567dd90c56033a1e38ab0f71180 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 23 Mar 2023 14:00:29 +0000 Subject: [PATCH 324/373] Correctly return 0 when searching for void mat xs --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 508b42fe8..4c5c84cb4 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -2,6 +2,7 @@ module baseMgIMCDatabase_class use numPrecision use endfConstants + use universalVariables, only : VOID_MAT use genericProcedures, only : fatalError, numToChar use particle_class, only : particle use charMap_class, only : charMap @@ -103,7 +104,7 @@ function getTotalMatXS(self, p, matIdx) result(xs) ! TODO: Added this check to try to avoid error with void mat, but somehow still leads to ! segmentation error in nGroups (baseMgIMCMaterial_class.f90) when void regions are present - if (matIdx == 0) then + if (matIdx == VOID_MAT) then xs = ZERO else xs = self % mats(matIdx) % getTotalXS(p % G, p % pRNG) From 942eecb6262cf783bcf017259dd7af670fbab7c8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 23 Mar 2023 14:12:03 +0000 Subject: [PATCH 325/373] Moved grid into TO_inter to allow PP to access it to update it, fixes being updated multiple times when using multiple threads --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 2 - PhysicsPackages/IMCPhysicsPackage_class.f90 | 6 ++- .../transportOperatorTimeHT_class.f90 | 43 +++---------------- TransportOperator/transportOperator_inter.f90 | 4 ++ 4 files changed, 16 insertions(+), 39 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 4c5c84cb4..cc54f4f83 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -102,8 +102,6 @@ function getTotalMatXS(self, p, matIdx) result(xs) integer(shortInt), intent(in) :: matIdx real(defReal) :: xs - ! TODO: Added this check to try to avoid error with void mat, but somehow still leads to - ! segmentation error in nGroups (baseMgIMCMaterial_class.f90) when void regions are present if (matIdx == VOID_MAT) then xs = ZERO else diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index c697f2bdb..7679d86e0 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -164,6 +164,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) do i=1,N_steps + ! Update tracking grid if needed by transport operator + if (associated(self % transOp % grid)) call self % transOp % grid % update() + ! Swap dungeons to store photons remaining from previous time step self % temp_dungeon => self % nextStep self % nextStep => self % thisStep @@ -333,7 +336,8 @@ subroutine steps(self, tally, tallyAtch, N_steps) open(unit = 10, file = 'temps.txt') do j = 1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - write(10, '(8A)') numToChar(mat % getTemp()) + !write(10, '(8A)') numToChar(mat % getTemp()) + write(10, '(8A)') mm_matName(j), numToChar(mat % getTemp()) end do close(10) !close(11) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index ca71a29c9..839fff388 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -21,9 +21,6 @@ module transportOperatorTimeHT_class ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase - ! Geometry interfaces - use simpleGrid_class, only : simpleGrid - implicit none private @@ -42,8 +39,6 @@ module transportOperatorTimeHT_class real(defReal) :: deltaT real(defReal) :: cutoff integer(shortInt) :: method - real(defReal) :: timeMax - class(simpleGrid), pointer :: grid => null() contains procedure :: transit => timeTracking procedure :: init @@ -63,34 +58,12 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) real(defReal) :: sigmaT character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' - ! Select action based on specified method - select case (self % method) - - ! Hybrid Tracking - case (HT) - call self % deltaTracking(p) - - ! Grid tracking - case (GT) - ! Update grid majorants at the start of new time step - if (p % timeMax /= self % timeMax) then - call self % grid % update() ! TODO: currently being called in every parallel thread, - ! only needs to be called once - self % timeMax = p % timeMax - end if - call self % deltaTracking(p) - - ! Surface Tracking - case (ST) - call self % surfaceTracking(p) - - ! Delta Tracking - case (DT) - call self % deltaTracking(p) - - case default - - end select + ! Select action based on specified method - HT and GT start with DT but can switch to ST + if (self % method == ST) then + call self % surfaceTracking(p) + else + call self % deltaTracking(p) + end if ! Check for particle leakage if (p % matIdx() == OUTSIDE_FILL) then @@ -215,15 +188,13 @@ subroutine deltaTracking(self, p) else if (dist == dTime) then ! Update particle fate and exit p % fate = AGED_FATE - if (p % time /= p % timeMax) call fatalError(Here, 'Mismatching particle times') + p % time = p % timeMax exit DTLoop else ! Dist == dColl ! Check for real or virtual collision sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) if (p % pRNG % get() < sigmaT * majorant_inv) exit DTLoop - ! Protect against infinite loop - if (sigmaT * majorant_inv == 0) call fatalError(Here, '100% virtual collision probability') ! Update grid distance dGrid = dGrid - dColl diff --git a/TransportOperator/transportOperator_inter.f90 b/TransportOperator/transportOperator_inter.f90 index e45ac37ef..dbb152339 100644 --- a/TransportOperator/transportOperator_inter.f90 +++ b/TransportOperator/transportOperator_inter.f90 @@ -19,6 +19,8 @@ module transportOperator_inter use nuclearDataReg_mod, only : ndReg_get => get use nuclearDatabase_inter, only : nuclearDatabase + ! Geometry interfaces + use simpleGrid_class, only : simpleGrid implicit none @@ -48,6 +50,8 @@ module transportOperator_inter !! Geometry pointer -> public so it can be used by subclasses (protected member) class(geometry), pointer :: geom => null() + class(simpleGrid), pointer :: grid => null() + contains ! Public interface procedure, non_overridable :: transport From 06016ef0b91d5bbbcb35e41c744849112de78c40 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 24 Mar 2023 14:25:01 +0000 Subject: [PATCH 326/373] Updated bbSurfaceSource to be on track with main implicitMC branch. Fixed error in hohlraum input where wrong geom boundaries were used --- .../Source/bbSurfaceSource_class.f90 | 273 +++++++----------- hohlraum | 32 +- 2 files changed, 125 insertions(+), 180 deletions(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 3b23846f0..4483d511e 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -2,7 +2,7 @@ module bbSurfaceSource_class use numPrecision use universalVariables - use genericProcedures, only : fatalError + use genericProcedures, only : fatalError, numToChar use particle_class, only : particleState, P_NEUTRON, P_PHOTON use particleDungeon_class, only : particleDungeon use dictionary_class, only : dictionary @@ -15,54 +15,46 @@ module bbSurfaceSource_class !! !! Generates a source representing a black body surface - !! Put together quite quickly so very specific in use and not perfect - !! - Currently only allows a circle or square aligned on x y or z axis, with - !! a certain radius or side length - !! - May still contain unnecessary lines of code copied from pointSource_class.f90 !! !! Private members: - !! r -> source position - !! dir -> optional source direction - !! particleType -> source particle type - !! isMG -> is the source multi-group? - !! isIsotropic -> is the source isotropic? + !! r -> bottom corner of source + !! dr -> size of surface, will be 0 in one dimension + !! dir -> direction of dominant movement: [1,0,0], [-1,0,0], [0,1,0], etc. + !! particleType -> source particle type (photon) + !! isMG -> is the source multi-group? (yes) !! !! Interface: !! init -> initialise point source + !! append -> source particles and add to existing dungeon !! sampleType -> set particle type !! samplePosition -> set particle position - !! sampleEnergy -> set particle energy !! sampleEnergyAngle -> sample particle angle + !! sampleEnergy -> set particle energy (isMG = .true., G = 1) + !! sampleWeight -> set particle energy-weight !! kill -> terminate source !! !! Sample Dictionary Input: !! source { !! type bbSurfaceSource; - !! shape circle ! circle or square; - !! size 5; ! radius(circle) or side length(square) - !! axis x; ! axis normal to planar shape - !! pos 0; ! distance along axis to place plane - !! T 1; ! temperature of source boundary - !! particle photon; - !! # dir 1; # ! Positive or negative to indicate direction along axis - !! If 0 then emit in both directions - !! # N 100; # ! Number of particles, only used if call to append subroutine uses N=0 + !! r (x_min x_max y_min y_max z_min z_max); -> Position bounds of surface + !! -> min and max must be equal in one dimension + !! #dir -1; -> optional, negative will reverse direction in dominant axis + !! -> defaults to positive + !! temp 1; -> temperature of the black body source + !! #deltaT 0.05; -> time step size, automatically added to dictionary in IMCPhysicsPackage_class.f90 + !! N 100; -> number of particles per time step, only used if append is called with N = 0 !! } !! type, public,extends(configSource) :: bbSurfaceSource private - real(defReal),dimension(3) :: r = ZERO - real(defReal) :: dir = ZERO - real(defReal) :: surfSize = ZERO - real(defReal) :: area = ZERO - integer(shortInt) :: particleType = P_PHOTON - logical(defBool) :: isMG = .true. - logical(defBool) :: isIsotropic = .false. - integer(shortInt) :: planeShape = 0 ! 0 => square, 1 => circle - integer(shortInt) :: axis = 1 ! 1 => x, 2 => y, 3 => z - real(defReal) :: T = ZERO - real(defReal) :: deltaT = ZERO - integer(shortInt) :: N = 1 + real(defReal), dimension(3) :: r = ZERO + real(defReal), dimension(3) :: dr = ZERO + integer(shortInt), dimension(3) :: dir = ZERO + integer(shortInt) :: particleType = P_PHOTON + logical(defBool) :: isMG = .true. + real(defReal) :: T = ZERO + real(defReal) :: deltaT = ZERO + integer(shortInt) :: N = 0 contains procedure :: init procedure :: append @@ -87,85 +79,48 @@ module bbSurfaceSource_class !! - error if shape is not square or circle !! subroutine init(self, dict, geom) - class(bbSurfaceSource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - character(30) :: type, tempName - integer(shortInt) :: matIdx, uniqueID - logical(defBool) :: isCE, isMG - real(defReal) :: temp + class(bbSurfaceSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + character(30) :: type, tempName + integer(shortInt) :: matIdx, uniqueID + logical(defBool) :: isCE, isMG + real(defReal), dimension(:), allocatable :: temp + integer(shortInt) :: i, dir character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' ! Provide geometry info to source self % geom => geom - ! Identify which particle is used in the source - ! Presently limited to neutron and photon - call dict % getOrDefault(type, 'particle' ,'photon') - select case(type) - case('neutron') - self % particleType = P_NEUTRON - - case('photon') - self % particleType = P_PHOTON - - case default - call fatalError(Here, 'Unrecognised particle type') - - end select - - ! Get position of surface along axis - call dict % get(temp, 'pos') - - ! Get axis and assign axis position - call dict % getOrDefault(tempName, 'axis', 'x') - select case(tempName) - case('x') - self % r(1) = temp - self % axis = 1 - case('y') - self % r(2) = temp - self % axis = 2 - case('z') - self % r(3) = temp - self % axis = 3 - case default - call fatalError(Here, 'Unrecognised axis, may only be x, y or z') - end select - - ! Get size of boundary surface - call dict % get(self % surfSize, 'size') - - ! Get shape and area of boundary surface - call dict % get(tempName, 'shape') - if (tempName == 'square') then - self % planeShape = 0 - self % area = self % surfSize**2 - else if (tempName == 'circle') then - self % planeShape = 1 - self % area = pi * self % surfSize**2 - else - call fatalError(Here, 'Shape must be "square" or "circle"') - end if - - ! Determine if dir is positive or negative along given axis - ! If equal to 0, emit from both sides - self % isIsotropic = .not. dict % isPresent('dir') - if (.not. self % isIsotropic) then + ! Provide particle type + self % particleType = P_PHOTON - call dict % get(temp, 'dir') + ! Get and check position vector + call dict % get(temp, 'r') + if (size(temp) /= 6) call fatalError(Here, 'r should be of size 6') + do i = 1, 3 + ! Store x_min, y_min, z_min + self % r(i) = temp(2*i-1) + ! Store dx, dy, dz + self % dr(i) = temp(2*i) - temp(2*i-1) + ! Check for compatible min and max + if (self % dr(i) < 0) call fatalError(Here, 'Min > Max along direction '//numToChar(i)) + end do + ! Check that exactly one normal axis is present + if (count(self % dr == 0) /= 1) call fatalError(Here, 'No clearly defined axis extracted') - if (temp == 0) then - self % dir = 0 - else - ! Set equal to +1 or -1 - self % dir = temp/abs(temp) - end if + ! Get primary direction + call dict % getOrDefault(dir, 'dir', 1) + do i = 1, 3 + if (self % dr(i) == 0) self % dir(i) = sign(1, dir) + end do - end if + ! Move by 2*SURF_TOL to ensure sourcing in correct material + self % r = self % r + 2*SURF_TOL*self % dir - call dict % get(self % T, 'T') - call dict % get(self % deltaT, 'deltaT') + ! Get remaining information + call dict % get(self % T, 'temp') + call dict % get(self % deltaT, 'deltaT') ! Automatically added to dict in IMC physics package call dict % getOrDefault(self % N, 'N', 1) end subroutine init @@ -176,6 +131,7 @@ end subroutine init !! See source_inter for details !! !! If N is given as 0, then N is instead taken from the input dictionary defining this source + !! to allow PP to have control over particle numbers !! subroutine append(self, dungeon, N, rand, matIdx) class(bbSurfaceSource), intent(inout) :: self @@ -189,25 +145,18 @@ subroutine append(self, dungeon, N, rand, matIdx) ! Set number to generate. Using 0 in function call will use N from input dictionary if (N /= 0) self % N = N - - -! TODO Parallel for some reason isn't working here, even though changes are the same as IMCSource ??? + ! TODO change so that this override is only temporary, so that can be called with 0 again later ! Generate N particles to populate dungeon -! !$omp parallel -! pRand = rand -! !$omp do private(pRand) -! do i = 1, self % N -! call pRand % stride(i) -! call dungeon % detain(self % sampleParticle(pRand)) -! end do -! !$omp end do -! !$omp end parallel - - + !$omp parallel + pRand = rand + !$omp do private(pRand) do i = 1, self % N - call dungeon % detain(self % sampleParticle(rand)) + call pRand % stride(i) + call dungeon % detain(self % sampleParticle(pRand)) end do + !$omp end do + !$omp end parallel end subroutine append @@ -234,67 +183,61 @@ subroutine samplePosition(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal), dimension(3) :: prevPos - real(defReal) :: r1, r2, rad, theta - - if ( self % planeShape == 0 ) then ! Square - - prevPos = self % r - - ! Set new x, y and z coords - self % r(1) = (rand % get()-0.5) * self % surfSize - self % r(2) = (rand % get()-0.5) * self % surfSize - self % r(3) = (rand % get()-0.5) * self % surfSize - ! Leave position along normal axis unchanged - self % r(self % axis) = prevPos(self % axis) - - else ! Circle - rad = rand % get() * self % surfSize - theta = rand % get() * 2 * pi - - r1 = rad * cos(theta) - r2 = rad * sin(theta) - - if(self % axis == 1) then ! Set y and z - self % r(2) = r1 - self % r(3) = r2 - else if(self % axis == 2) then ! Set x and z - self % r(1) = r1 - self % r(3) = r2 - else ! Set x and y - self % r(1) = r1 - self % r(2) = r2 - end if + integer(shortInt) :: i + real(defReal), dimension(3) :: r - end if + ! Set new x, y and z coords + do i = 1, 3 + r(i) = (self % dr(i)) * rand % get() + self % r(i) + end do - p % r = self % r + ! Assign to particle + p % r = r end subroutine samplePosition !! - !! Provide angle or sample if isotropic + !! Sample angle !! !! See configSource_inter for details. !! - !! Only isotropic/fixed direction. Does not sample energy. - !! subroutine sampleEnergyAngle(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand + real(defReal), dimension(3) :: dir real(defReal) :: phi, mu + character(100), parameter :: Here = 'sampleEnergyAngle (bbSurfaceSource_class.f90)' + ! Sample required phi and mu phi = TWO_PI * rand % get() mu = sqrt(rand % get()) - p % dir = [mu, sqrt(1-mu**2)*cos(phi), sqrt(1-mu**2)*sin(phi)] + ! Choose direction based on dominant direction given in self % dir + if (self % dir(1) == 1) then ! Positive x + dir = [ mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] + + else if (self % dir(1) == -1) then ! Negative x + dir = [-mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] + + else if (self % dir(2) == 1) then ! Positive y + dir = [sqrt(1-mu*mu)*sin(phi), mu, sqrt(1-mu*mu)*cos(phi)] + + else if (self % dir(2) == -1) then ! Negative y + dir = [sqrt(1-mu*mu)*sin(phi), -mu, sqrt(1-mu*mu)*cos(phi)] - ! If dir not equal to zero, adjust so that particles are travelling in correct direction - if (self % dir /= 0) then - p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir + else if (self % dir(3) == 1) then ! Positive z + dir = [sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi), mu] + + else if (self % dir(3) == -1) then ! Negative z + dir = [sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi), -mu] + + else + call fatalError(Here, 'Invalid direction vector') end if + ! Assign to particle + p % dir = dir end subroutine sampleEnergyAngle @@ -326,13 +269,14 @@ subroutine sampleWeight(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal) :: num + real(defReal) :: area, num - num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * self % area - p % wgt = num / (4 * self % N) + ! Calculate surface area of source + area = product(self % dr, self % dr /= ZERO) - ! If dir = 0 then emit in both directions => double total energy - if (self % dir == 0) p % wgt = 2*p % wgt + ! Calculate energy weight per particle + num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * area + p % wgt = num / (4 * self % N) end subroutine sampleWeight @@ -347,10 +291,13 @@ elemental subroutine kill(self) ! Kill local components self % r = ZERO + self % dr = ZERO self % dir = ZERO self % particleType = P_PHOTON self % isMG = .true. - self % isIsotropic = .false. + self % T = ZERO + self % deltaT = ZERO + self % N = ZERO end subroutine kill diff --git a/hohlraum b/hohlraum index fcf2df2c5..254241a6a 100644 --- a/hohlraum +++ b/hohlraum @@ -4,7 +4,7 @@ type IMCPhysicsPackage; pop 2000000; limit 20000000; steps 100; -timeStepSize 0.2; +timeStepSize 0.00000000001; printUpdates 20; collisionOperator { @@ -12,18 +12,16 @@ collisionOperator { } transportOperator { - type transportOperatorTimeHT; cutoff 0.9; + type transportOperatorTimeHT; + method GT; + cutoff 0.9; + grid { dimensions (20 20 1); searchN (10 10 1); } } source { type bbSurfaceSource; - shape square; - size 1; - axis x; - pos -0.5; - T 1; - dir 1; - particle photon; + r (-0.5 -0.5 -0.5 0.5 -0.5 0.5); + temp 1; N 20000; } @@ -32,13 +30,13 @@ viz { vizDict { type vtk; corner (-0.5 -0.5 -0.5); width (1 1 1); vox (20 20 1); tally { } -grid { dimensions (20 20 1); searchN (10 10 1); } +//grid { dimensions (20 20 1); searchN (10 10 1); } discretise { dimensions (200 200 1); } geometry { type geometryStd; - boundary (0 0 0 0 0 0); + boundary (0 0 0 0 1 1); graph {type shrunk;} surfaces @@ -66,13 +64,13 @@ geometry { // Centre mat cell5 { id 5; type simpleCell; surfaces (3 -4 7 -8); filltype mat; material mat1; } // Top void - cell6 { id 6; type simpleCell; surfaces (8 -9 -5); filltype mat; material mat2; } + cell6 { id 6; type simpleCell; surfaces (8 -9 -5); filltype mat; material void; } // Bottom void - cell7 { id 7; type simpleCell; surfaces (6 -7 -5); filltype mat; material mat2; } + cell7 { id 7; type simpleCell; surfaces (6 -7 -5); filltype mat; material void; } // Right void - cell8 { id 8; type simpleCell; surfaces (7 -8 4 -5); filltype mat; material mat2; } + cell8 { id 8; type simpleCell; surfaces (7 -8 4 -5); filltype mat; material void; } // Left void - cell9 { id 9; type simpleCell; surfaces (7 -8 2 -3); filltype mat; material mat2; } + cell9 { id 9; type simpleCell; surfaces (7 -8 2 -3); filltype mat; material void; } } universes @@ -92,8 +90,8 @@ nuclearData { materials { - mat1 { temp 0.01; composition {} xsFile ./dataFiles/hohlraumData; } - mat2 { temp 1; composition {} xsFile ./dataFiles/voidData; } + mat1 { temp 0.000000001; composition {} xsFile ./dataFiles/hohlraumData; } +// mat2 { temp 1; composition {} xsFile ./dataFiles/voidData; } } From 354d517ef66b9949f3d748185d23956b5b57e054 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 25 Mar 2023 12:46:09 +0000 Subject: [PATCH 327/373] A few minor changes --- .../mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 10 +++++++++- SharedModules/poly_func.f90 | 4 ++-- hohlraum | 7 ++----- 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 55b0f3744..2c94f1000 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -381,6 +381,9 @@ subroutine updateMatIMC(self, tallyEnergy) real(defReal) :: beta character(100), parameter :: Here = "updateMatIMC (baseMgIMCMaterial_class.f90)" + ! Return if no energy change + if (self % getEmittedRad() == tallyEnergy) return + ! Update material internal energy self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy @@ -433,7 +436,12 @@ function tempFromEnergy(self) result(T) real(defReal) :: T, energyDens energyDens = self % matEnergy / self % V - T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) + + if (energyDens == 0) then + T = 0 + else + T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) + end if end function tempFromEnergy diff --git a/SharedModules/poly_func.f90 b/SharedModules/poly_func.f90 index 031d9339f..166f32f69 100644 --- a/SharedModules/poly_func.f90 +++ b/SharedModules/poly_func.f90 @@ -119,11 +119,11 @@ function poly_solve(equation, derivative, x0, const) result(x) x = x - f / f_dash ! Check for convergence - tol = 0.0000000001 + tol = 0.000000000001 if( abs(x) > (1-tol)*abs(x_old) .and. abs(x) < (1+tol)*abs(x_old) ) exit iterate ! Call error if not converged - if( i >= 1000 ) then + if( i >= 10000 ) then call fatalError(Here, "Solution has not converged after 1000 iterations") end if diff --git a/hohlraum b/hohlraum index 254241a6a..c003966e9 100644 --- a/hohlraum +++ b/hohlraum @@ -5,7 +5,7 @@ pop 2000000; limit 20000000; steps 100; timeStepSize 0.00000000001; -printUpdates 20; +printUpdates 0; collisionOperator { photonMG {type IMCMGstd;} @@ -13,7 +13,7 @@ collisionOperator { transportOperator { type transportOperatorTimeHT; - method GT; + method ST; cutoff 0.9; grid { dimensions (20 20 1); searchN (10 10 1); } } @@ -30,8 +30,6 @@ viz { vizDict { type vtk; corner (-0.5 -0.5 -0.5); width (1 1 1); vox (20 20 1); tally { } -//grid { dimensions (20 20 1); searchN (10 10 1); } - discretise { dimensions (200 200 1); } geometry { @@ -91,7 +89,6 @@ nuclearData { materials { mat1 { temp 0.000000001; composition {} xsFile ./dataFiles/hohlraumData; } -// mat2 { temp 1; composition {} xsFile ./dataFiles/voidData; } } From 03aeaad543ca11bcbd21be10dda49a7994022526 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 15 May 2023 14:21:17 +0100 Subject: [PATCH 328/373] Moved around some lines to make more logical, added some comments --- .../transportOperatorTimeHT_class.f90 | 49 +++++++++++-------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 839fff388..cd78f63d5 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -123,10 +123,6 @@ subroutine surfaceTracking(self, p) end if - - ! TODO: Option to switch back to DT? - - end do STLoop end subroutine surfaceTracking @@ -142,25 +138,25 @@ subroutine deltaTracking(self, p) ! Get majorant and grid crossing distance if required majorant_inv = self % getMajInv(p) + + ! Get initial opacity + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + ! Check if surface tracking is needed, avoiding unnecessary grid calculations + if (sigmaT * majorant_inv < ONE - self % cutoff) then + call self % surfaceTracking(p) + return + end if + + ! Calculate initial distance to grid if (self % method == GT) then dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) else dGrid = INF end if - ! Get initial opacity - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - DTLoop:do - ! Switch to ST if required - if (self % method /= DT) then - if (sigmaT * majorant_inv < ONE - self % cutoff) then - call self % surfaceTracking(p) - return - end if - end if - ! Find distance to time boundary dTime = lightSpeed * (p % timeMax - p % time) @@ -172,10 +168,8 @@ subroutine deltaTracking(self, p) call self % geom % teleport(p % coords, dist) p % time = p % time + dist / lightSpeed - ! Exit in the case of particle leakage - if (p % matIdx() == OUTSIDE_FILL) then - return - end if + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return ! Act based on distance moved if (dist == dGrid) then @@ -200,12 +194,26 @@ subroutine deltaTracking(self, p) end if + ! Switch to surface tracking if needed + if (sigmaT * majorant_inv < ONE - self % cutoff) then + call self % surfaceTracking(p) + return + end if + + end do DTLoop end subroutine deltaTracking !! + !! Return the inverse majorant opacity + !! For DT or HT this will be constant, for GT this will be dependent on position + !! + !! Args: + !! p [in] -> particle !! + !! Result: + !! maj_inv -> 1 / majorant opacity !! function getMajInv(self, p) result (maj_inv) class(transportOperatorTimeHT), intent(in) :: self @@ -220,7 +228,6 @@ function getMajInv(self, p) result (maj_inv) end function getMajInv - !! !! Provide transport operator with delta tracking/surface tracking cutoff !! @@ -229,7 +236,6 @@ end function getMajInv subroutine init(self, dict) class(transportOperatorTimeHT), intent(inout) :: self class(dictionary), intent(in) :: dict -! class(simpleGrid), intent(in), pointer, optional :: grid character(nameLen) :: method class(dictionary),pointer :: tempdict character(100), parameter :: Here = "init (transportOperatorTimeHT_class.f90)" @@ -266,6 +272,7 @@ subroutine init(self, dict) ! Delta tracking case ('DT') self % method = DT + self % cutoff = ONE case default call fatalError(Here, 'Invalid tracking method given. Must be HT, ST or DT.') From 2f6b5ff3c5a2ddb9c1145160333c64bc59b18950 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 15 May 2023 16:51:53 +0100 Subject: [PATCH 329/373] Renamed simpleGrid to trackingGrid and put it into transport operator folder --- Geometry/CMakeLists.txt | 1 - TransportOperator/CMakeLists.txt | 3 +- .../Grid/trackingGrid_class.f90 | 30 +++++++++---------- TransportOperator/transportOperator_inter.f90 | 4 +-- 4 files changed, 19 insertions(+), 19 deletions(-) rename Geometry/simpleGrid_class.f90 => TransportOperator/Grid/trackingGrid_class.f90 (94%) diff --git a/Geometry/CMakeLists.txt b/Geometry/CMakeLists.txt index 27761d6b9..f459c0965 100644 --- a/Geometry/CMakeLists.txt +++ b/Geometry/CMakeLists.txt @@ -9,7 +9,6 @@ add_sources( ./csg_class.f90 ./geometry_inter.f90 ./geometryStd_class.f90 ./geometryReg_mod.f90 - ./simpleGrid_class.f90 ./discretiseGeom_class.f90 ) diff --git a/TransportOperator/CMakeLists.txt b/TransportOperator/CMakeLists.txt index 5f32aec72..259e709e5 100644 --- a/TransportOperator/CMakeLists.txt +++ b/TransportOperator/CMakeLists.txt @@ -5,4 +5,5 @@ add_sources(./transportOperator_inter.f90 # ./transportOperatorDynamicDT_class.f90 ./transportOperatorST_class.f90 ./transportOperatorHT_class.f90 - ./transportOperatorTimeHT_class.f90) + ./transportOperatorTimeHT_class.f90 + ./Grid/trackingGrid_class.f90) diff --git a/Geometry/simpleGrid_class.f90 b/TransportOperator/Grid/trackingGrid_class.f90 similarity index 94% rename from Geometry/simpleGrid_class.f90 rename to TransportOperator/Grid/trackingGrid_class.f90 index 6171fc6d9..1aa84c0c3 100644 --- a/Geometry/simpleGrid_class.f90 +++ b/TransportOperator/Grid/trackingGrid_class.f90 @@ -1,4 +1,4 @@ -module simpleGrid_class +module trackingGrid_class use numPrecision use universalVariables, only : SURF_TOL, P_PHOTON_MG @@ -29,7 +29,7 @@ module simpleGrid_class !! pitch -> array [dx, dy, dz], the discretisation in each direction !! bounds -> [x_min, y_min, z_min, z_max, y_max, z_max] as in geometry_inter !! - type, public :: simpleGrid + type, public :: trackingGrid class(geometry), pointer :: mainGeom => null() class(nuclearDatabase), pointer :: xsData => null() integer(shortInt), dimension(:), allocatable :: sizeN @@ -47,12 +47,12 @@ module simpleGrid_class procedure :: storeMats procedure :: update - end type simpleGrid + end type trackingGrid contains subroutine init(self, dict, geom, xsData) - class(simpleGrid), intent(inout) :: self + class(trackingGrid), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), intent(in), pointer, optional :: geom class(nuclearDatabase), intent(in), pointer, optional :: xsData @@ -93,12 +93,12 @@ end subroutine init !! May have issues with non-box geometry root universe surface with reflective boundary !! function getDistance(self, r, u) result(dist) - class(simpleGrid), intent(in) :: self + class(trackingGrid), intent(in) :: self real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: dist real(defReal), dimension(3) :: r_bar, low, high !, point, corner, ratio - character(100), parameter :: Here = 'getDistance (simpleGrid_class.f90)' + character(100), parameter :: Here = 'getDistance (trackingGrid_class.f90)' ! Calculate position from grid corner r_bar = r - self % corner @@ -158,14 +158,14 @@ end function getDistance !! Returns value of grid cell at position !! function getValue(self, r, u) result(val) - class(simpleGrid), intent(in) :: self + class(trackingGrid), intent(in) :: self real(defReal), dimension(3), intent(in) :: r real(defReal), dimension(3), intent(in) :: u real(defReal) :: val real(defReal), dimension(3) :: r_bar integer(shortInt), dimension(3) :: corner, ijk integer(shortInt) :: i, idx - character(100), parameter :: Here = 'getValue (simpleGrid_class.f90)' + character(100), parameter :: Here = 'getValue (trackingGrid_class.f90)' ! Find lattice location in x,y&z ijk = floor((r - self % corner) / self % pitch) + 1 @@ -228,7 +228,7 @@ end function getValue !! !! subroutine storeMats(self, searchN) - class(simpleGrid), intent(inout) :: self + class(trackingGrid), intent(inout) :: self integer(shortInt), dimension(3), intent(in) :: searchN real(defReal), dimension(3) :: searchRes integer(shortInt) :: i, j, k, l, matIdx, id @@ -275,11 +275,11 @@ end subroutine storeMats !! !! subroutine update(self) - class(simpleGrid), intent(inout) :: self - integer(shortInt) :: i - integer(shortInt), save :: j, matIdx - real(defReal), save :: sigmaT - class(particle), allocatable :: p + class(trackingGrid), intent(inout) :: self + integer(shortInt) :: i + integer(shortInt), save :: j, matIdx + real(defReal), save :: sigmaT + class(particle), allocatable :: p !$omp threadprivate(j, matIdx) allocate(p) @@ -400,4 +400,4 @@ end function reposition ! ! end subroutine repositionDist -end module simpleGrid_class +end module trackingGrid_class diff --git a/TransportOperator/transportOperator_inter.f90 b/TransportOperator/transportOperator_inter.f90 index dbb152339..b47712343 100644 --- a/TransportOperator/transportOperator_inter.f90 +++ b/TransportOperator/transportOperator_inter.f90 @@ -20,7 +20,7 @@ module transportOperator_inter use nuclearDatabase_inter, only : nuclearDatabase ! Geometry interfaces - use simpleGrid_class, only : simpleGrid + use trackingGrid_class, only : trackingGrid implicit none @@ -50,7 +50,7 @@ module transportOperator_inter !! Geometry pointer -> public so it can be used by subclasses (protected member) class(geometry), pointer :: geom => null() - class(simpleGrid), pointer :: grid => null() + class(trackingGrid), pointer :: grid => null() contains ! Public interface From c97cf53ffb326eb55f41a77ddf7b9b5b982e96bf Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 17 May 2023 11:59:47 +0100 Subject: [PATCH 330/373] Reorganised some input files --- InputFiles/IMC/DataFiles/hohlraumData | 22 +++++++++++++++++++ .../nucDataMW => DataFiles/marshakData} | 0 .../imcSampleMat => DataFiles/sampleData} | 0 hohlraum => InputFiles/IMC/hohlraum | 2 +- InputFiles/IMC/{MarshakWave => }/marshakWave | 4 ++-- .../oldInputs/dataFiles/imcData | 0 .../oldInputs/marshakWave128 | 0 .../{MarshakWave => }/oldInputs/marshakWave16 | 0 .../{MarshakWave => }/oldInputs/marshakWave32 | 0 .../{MarshakWave => }/oldInputs/marshakWave64 | 0 .../{MarshakWave => }/oldInputs/marshakWave8 | 0 .../{Sample/imcSampleInput => sampleInput} | 4 ++-- 12 files changed, 27 insertions(+), 5 deletions(-) create mode 100644 InputFiles/IMC/DataFiles/hohlraumData rename InputFiles/IMC/{MarshakWave/nucDataMW => DataFiles/marshakData} (100%) rename InputFiles/IMC/{Sample/imcSampleMat => DataFiles/sampleData} (100%) rename hohlraum => InputFiles/IMC/hohlraum (97%) rename InputFiles/IMC/{MarshakWave => }/marshakWave (83%) rename InputFiles/IMC/{MarshakWave => }/oldInputs/dataFiles/imcData (100%) rename InputFiles/IMC/{MarshakWave => }/oldInputs/marshakWave128 (100%) rename InputFiles/IMC/{MarshakWave => }/oldInputs/marshakWave16 (100%) rename InputFiles/IMC/{MarshakWave => }/oldInputs/marshakWave32 (100%) rename InputFiles/IMC/{MarshakWave => }/oldInputs/marshakWave64 (100%) rename InputFiles/IMC/{MarshakWave => }/oldInputs/marshakWave8 (100%) rename InputFiles/IMC/{Sample/imcSampleInput => sampleInput} (95%) diff --git a/InputFiles/IMC/DataFiles/hohlraumData b/InputFiles/IMC/DataFiles/hohlraumData new file mode 100644 index 000000000..1cdf6c285 --- /dev/null +++ b/InputFiles/IMC/DataFiles/hohlraumData @@ -0,0 +1,22 @@ +// This XSS are for a URR-2-1-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 ( + 100 + -3 +); + +scatter ( + 0 + 0 +); + +cv ( + 0.3 //3.00026706e15 + 0 +); + diff --git a/InputFiles/IMC/MarshakWave/nucDataMW b/InputFiles/IMC/DataFiles/marshakData similarity index 100% rename from InputFiles/IMC/MarshakWave/nucDataMW rename to InputFiles/IMC/DataFiles/marshakData diff --git a/InputFiles/IMC/Sample/imcSampleMat b/InputFiles/IMC/DataFiles/sampleData similarity index 100% rename from InputFiles/IMC/Sample/imcSampleMat rename to InputFiles/IMC/DataFiles/sampleData diff --git a/hohlraum b/InputFiles/IMC/hohlraum similarity index 97% rename from hohlraum rename to InputFiles/IMC/hohlraum index c003966e9..2f0b180e4 100644 --- a/hohlraum +++ b/InputFiles/IMC/hohlraum @@ -88,7 +88,7 @@ nuclearData { materials { - mat1 { temp 0.000000001; composition {} xsFile ./dataFiles/hohlraumData; } + mat1 { temp 0.000000001; composition {} xsFile ./DataFiles/hohlraumData; } } diff --git a/InputFiles/IMC/MarshakWave/marshakWave b/InputFiles/IMC/marshakWave similarity index 83% rename from InputFiles/IMC/MarshakWave/marshakWave rename to InputFiles/IMC/marshakWave index 4336d0ee5..55e0667d6 100644 --- a/InputFiles/IMC/MarshakWave/marshakWave +++ b/InputFiles/IMC/marshakWave @@ -18,7 +18,7 @@ transportOperator { tally {} // Black body surface source -source { type bbSurfaceSource; shape square; size 1; axis x; pos -2; T 1; dir 1; particle photon; N 10000; } +source { type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 10000; } // Spatial discretisation discretise { dimensions (500 1 1); } @@ -39,7 +39,7 @@ geometry { nuclearData { handles { mg { type baseMgIMCDatabase; }} - materials { mat1 { temp 0.01; composition {} xsFile ./nucDataMW; }} + materials { mat1 { temp 0.01; composition {} xsFile ./DataFiles/marshakData; }} } diff --git a/InputFiles/IMC/MarshakWave/oldInputs/dataFiles/imcData b/InputFiles/IMC/oldInputs/dataFiles/imcData similarity index 100% rename from InputFiles/IMC/MarshakWave/oldInputs/dataFiles/imcData rename to InputFiles/IMC/oldInputs/dataFiles/imcData diff --git a/InputFiles/IMC/MarshakWave/oldInputs/marshakWave128 b/InputFiles/IMC/oldInputs/marshakWave128 similarity index 100% rename from InputFiles/IMC/MarshakWave/oldInputs/marshakWave128 rename to InputFiles/IMC/oldInputs/marshakWave128 diff --git a/InputFiles/IMC/MarshakWave/oldInputs/marshakWave16 b/InputFiles/IMC/oldInputs/marshakWave16 similarity index 100% rename from InputFiles/IMC/MarshakWave/oldInputs/marshakWave16 rename to InputFiles/IMC/oldInputs/marshakWave16 diff --git a/InputFiles/IMC/MarshakWave/oldInputs/marshakWave32 b/InputFiles/IMC/oldInputs/marshakWave32 similarity index 100% rename from InputFiles/IMC/MarshakWave/oldInputs/marshakWave32 rename to InputFiles/IMC/oldInputs/marshakWave32 diff --git a/InputFiles/IMC/MarshakWave/oldInputs/marshakWave64 b/InputFiles/IMC/oldInputs/marshakWave64 similarity index 100% rename from InputFiles/IMC/MarshakWave/oldInputs/marshakWave64 rename to InputFiles/IMC/oldInputs/marshakWave64 diff --git a/InputFiles/IMC/MarshakWave/oldInputs/marshakWave8 b/InputFiles/IMC/oldInputs/marshakWave8 similarity index 100% rename from InputFiles/IMC/MarshakWave/oldInputs/marshakWave8 rename to InputFiles/IMC/oldInputs/marshakWave8 diff --git a/InputFiles/IMC/Sample/imcSampleInput b/InputFiles/IMC/sampleInput similarity index 95% rename from InputFiles/IMC/Sample/imcSampleInput rename to InputFiles/IMC/sampleInput index c9621c625..686976ddd 100644 --- a/InputFiles/IMC/Sample/imcSampleInput +++ b/InputFiles/IMC/sampleInput @@ -82,7 +82,7 @@ nuclearData { composition {} // Empty dictionary required for composition. - xsFile ./imcSampleMat; + xsFile ./DataFiles/sampleData; // Location of material data file containing material properties. volume 1; @@ -92,7 +92,7 @@ nuclearData { } // Example 2: mat2 - //mat2 { temp 1; composition {} xsFile ./imcSampleMat2; volume 1 } + //mat2 { temp 1; composition {} xsFile ./DataFiles/sampleData2; volume 1 } } From 4fbb6088af2038bb806f28a9023c185b05d5224c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 21 May 2023 17:31:47 +0100 Subject: [PATCH 331/373] Cleaned up a lot of PP by moving some material-related things into mgIMCDatabase --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 63 +++++++++++++++ NuclearData/mgIMCData/mgIMCDatabase_inter.f90 | 39 ++++++++++ PhysicsPackages/IMCPhysicsPackage_class.f90 | 78 ++++++------------- TransportOperator/Grid/trackingGrid_class.f90 | 4 +- 4 files changed, 127 insertions(+), 57 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index cc54f4f83..ab1c42be4 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -57,6 +57,9 @@ module baseMgIMCDatabase_class procedure :: getMaterial procedure :: getNuclide procedure :: getReaction + procedure :: getTotalEnergy + procedure :: updateProperties + procedure :: setTimeStep procedure :: kill procedure :: init procedure :: activate @@ -198,6 +201,66 @@ function getReaction(self, MT, idx) result(reac) end function getReaction + !! + !! Return total energy to be emitted during current time step + !! + function getTotalEnergy(self) result(energy) + class(baseMgIMCDatabase), intent(in) :: self + real(defReal) :: energy + integer(shortInt) :: i + + energy = 0 + + do i=1, size(self % mats) + energy = energy + self % mats(i) % getEmittedRad() + end do + + end function getTotalEnergy + + !! + !! Update material properties based on energy absorbed during the time step + !! + subroutine updateProperties(self, tallyEnergy, printUpdates) + class(baseMgIMCDatabase), intent(inout) :: self + real(defReal), dimension(:), intent(in) :: tallyEnergy + integer(shortInt), intent(in) :: printUpdates + integer(shortInt) :: i + character(100), parameter :: Here = 'updateProperties (baseMgIMCDatabase_class.f90)' + + ! Check for valid inputs + if (size(tallyEnergy) /= size(self % mats)) call fatalError(Here, & + &'Energy tally array must have size nMats') + if (printUpdates > size(self % mats)) call fatalError(Here, & + &'printUpdates must be <= nMats') + + ! Update mats to be printed (if any) + do i = 1, printUpdates + call self % mats(i) % updateMat(tallyEnergy(i), .true.) + end do + + ! Update remaining mats + !$omp parallel do + do i = (printUpdates+1), size(tallyEnergy) + call self % mats(i) % updateMat(tallyEnergy(i)) + end do + !$omp end parallel do + + end subroutine updateProperties + + !! + !! Provide each material with time step to calculate initial fleck factor + !! + subroutine setTimeStep(self, deltaT) + class(baseMgIMCDatabase), intent(inout) :: self + real(defReal), intent(in) :: deltaT + integer(shortInt) :: i + + do i=1, size(self % mats) + call self % mats(i) % setTimeStep(deltaT) + end do + + end subroutine setTimeStep + !! !! Return to uninitialised state !! diff --git a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 index 73d4cbcca..2873274ef 100644 --- a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 @@ -1,5 +1,7 @@ module mgIMCDatabase_inter + use numPrecision + ! Nuclear Data Interfaces & Objects use nuclearDatabase_inter, only : nuclearDatabase @@ -19,8 +21,45 @@ module mgIMCDatabase_inter !! type, public, abstract, extends(nuclearDatabase) :: mgIMCDatabase + contains + procedure(getTotalEnergy), deferred :: getTotalEnergy + procedure(updateProperties), deferred :: updateProperties + procedure(setTimeStep), deferred :: setTimeStep + end type mgIMCDatabase + abstract interface + + !! + !! Return total energy to be emitted during current time step + !! + function getTotalEnergy(self) result(energy) + import :: mgIMCDatabase, defReal + class(mgIMCDatabase), intent(in) :: self + real(defReal) :: energy + end function getTotalEnergy + + !! + !! Update material properties based on energy absorbed during the time step + !! + subroutine updateProperties(self, tallyEnergy, printUpdates) + import mgIMCDatabase, defReal, shortInt + class(mgIMCDatabase), intent(inout) :: self + real(defReal), dimension(:), intent(in) :: tallyEnergy + integer(shortInt), intent(in) :: printUpdates + end subroutine updateProperties + + !! + !! Provide each material with time step to calculate initial fleck factor + !! + subroutine setTimeStep(self, deltaT) + import mgIMCDatabase, defReal + class(mgIMCDatabase), intent(inout) :: self + real(defReal), intent(in) :: deltaT + end subroutine setTimeStep + + end interface + contains !! diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 7679d86e0..8fb1b2917 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -37,6 +37,7 @@ module IMCPhysicsPackage_class ndReg_get => get ,& ndReg_getMatNames => getMatNames use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast use mgIMCMaterial_inter, only : mgIMCMaterial @@ -64,7 +65,8 @@ module IMCPhysicsPackage_class type, public,extends(physicsPackage) :: IMCPhysicsPackage private ! Building blocks - class(nuclearDatabase), pointer :: nucData => null() +! class(nuclearDatabase), pointer :: nucData => null() + class(mgIMCDatabase), pointer :: nucData => null() class(geometry), pointer :: geom => null() integer(shortInt) :: geomIdx = 0 type(collisionOperator) :: collOp @@ -133,7 +135,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_steps integer(shortInt) :: i, j, N, Ntemp, num, nParticles -!integer(shortInt) :: thisStepPop type(particle), save :: p real(defReal) :: elapsed_T, end_T, T_toEnd, totEnergy real(defReal), dimension(:), allocatable :: tallyEnergy @@ -145,8 +146,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(RNG), target, save :: pRNG !$omp threadprivate(p, collOp, transOp, pRNG, mat) -!open(unit=11, file='times.txt') - !$omp parallel p % geomIdx = self % geomIdx @@ -181,11 +180,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) end if ! Find total energy to be emitted - totEnergy = 0 - do j=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - totEnergy = totEnergy + mat % getEmittedRad() - end do + totEnergy = self % nucData % getTotalEnergy() ! Add to particle dungeon do j=1, self % nMat @@ -206,8 +201,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) call self % inputSource % append(self % thisStep, 0, self % pRNG) end if -!thisStepPop = self % thisStep % popSize() - if(self % printSource == 1) then call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) end if @@ -297,8 +290,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) print *, 'Time to end: ', trim(secToChar(T_toEnd)) call tally % display() -!write(11, '(8A)') numToChar(elapsed_T * self % limit / thisStepPop) - ! Obtain energy deposition tally results call tallyAtch % getResult(tallyRes, 'imcWeightTally') @@ -312,20 +303,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) end select ! Update material properties - !$omp parallel do - do j = 1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - call mat % updateMat(tallyEnergy(j), .false.) - end do - !$omp end parallel do - print * - - ! Print material updates if requested - do j = 1, self % printUpdates - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - print *, ' '//mm_matName(j), numToChar(mat % getTemp()) - end do - print * + call self % nucData % updateProperties(tallyEnergy, self % printUpdates) ! Reset tally for next time step call tallyAtch % reset('imcWeightTally') @@ -340,7 +318,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) write(10, '(8A)') mm_matName(j), numToChar(mat % getTemp()) end do close(10) -!close(11) end subroutine steps @@ -384,7 +361,7 @@ end subroutine collectResults subroutine init(self, dict) class(IMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict - class(dictionary), pointer :: tempdict + class(dictionary), pointer :: tempDict, geomDict, dataDict type(dictionary) :: locDict1, locDict2, locDict3, locDict4, locDict5 integer(shortInt) :: seed_temp integer(longInt) :: seed @@ -397,7 +374,7 @@ subroutine init(self, dict) class(IMCMaterial), pointer :: mat character(nameLen), dimension(:), allocatable :: mats integer(shortInt), dimension(:), allocatable :: latSizeN - type(dictionary) :: newGeom, newData + type(dictionary),target :: newGeom, newData character(100), parameter :: Here ='init (IMCPhysicsPackage_class.f90)' call cpu_time(self % CPU_time_start) @@ -453,39 +430,30 @@ subroutine init(self, dict) ! Create new input call discretise(dict, newGeom, newData) - ! Build Nuclear Data - call ndReg_init(newData) - - ! Build geometry - geomName = 'IMCGeom' - call gr_addGeom(geomName, newGeom) - 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()) - self % nucData => ndReg_get(self % particleType) - - call newGeom % kill() - call newData % kill() + geomDict => newGeom + dataDict => newData else + geomDict => dict % getDictPtr("geometry") + dataDict => dict % getDictPtr("nuclearData") + + end if ! Build Nuclear Data - call ndReg_init(dict % getDictPtr("nuclearData")) + call ndReg_init(dataDict) ! Build geometry - tempDict => dict % getDictPtr('geometry') geomName = 'IMCGeom' - call gr_addGeom(geomName, tempDict) + call gr_addGeom(geomName, geomDict) 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()) - self % nucData => ndReg_get(self % particleType) + self % nucData => mgIMCDatabase_CptrCast(ndReg_get(self % particleType)) - end if + call newGeom % kill() + call newData % kill() ! Read particle source definition if( dict % isPresent('source') ) then @@ -519,6 +487,9 @@ subroutine init(self, dict) allocate(self % tally) call self % tally % init(tempDict) + ! Provide materials with time step + call self % nucData % setTimeStep(self % deltaT) + ! Store number of materials self % nMat = mm_nMat() self % printUpdates = min(self % printUpdates, self % nMat) @@ -529,11 +500,8 @@ subroutine init(self, dict) mats(i) = mm_matName(i) end do - ! Provide each material with time step - do i=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(i)) - call mat % setTimeStep(self % deltaT) - end do + ! Provide materials with time step + call self % nucData % setTimeStep(self % deltaT) ! Initialise imcWeight tally attachment call locDict2 % init(1) diff --git a/TransportOperator/Grid/trackingGrid_class.f90 b/TransportOperator/Grid/trackingGrid_class.f90 index 1aa84c0c3..aa9a4a4de 100644 --- a/TransportOperator/Grid/trackingGrid_class.f90 +++ b/TransportOperator/Grid/trackingGrid_class.f90 @@ -231,7 +231,7 @@ subroutine storeMats(self, searchN) class(trackingGrid), intent(inout) :: self integer(shortInt), dimension(3), intent(in) :: searchN real(defReal), dimension(3) :: searchRes - integer(shortInt) :: i, j, k, l, matIdx, id + integer(shortInt) :: i, j, k, l, matIdx, uniqueID real(defReal), dimension(3) :: corner, r type(dynIntArray) :: mats @@ -250,7 +250,7 @@ subroutine storeMats(self, searchN) do l = 1, searchN(3) ! Find matIdx at search location r = corner + [j, k, l] * searchRes - call self % mainGeom % whatIsAt(matIdx, id, r) + call self % mainGeom % whatIsAt(matIdx, uniqueID, r) ! Add to array if not already present if (mats % isPresent(matIdx)) then From a066e465b6fa3d49d069b353c579ef1e3a00ba15 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 22 May 2023 16:20:39 +0100 Subject: [PATCH 332/373] Redid most of IMCSource_class, including removing some sourcing calculations from PP. Still need to add a parallel loop --- Geometry/Universes/latUniverse_class.f90 | 12 + Geometry/geometryStd_class.f90 | 39 +++ Geometry/geometry_inter.f90 | 13 + .../baseMgIMC/baseMgIMCDatabase_class.f90 | 26 +- NuclearData/mgIMCData/mgIMCDatabase_inter.f90 | 19 +- ParticleObjects/Source/IMCSource_class.f90 | 301 +++++++++--------- .../Source/bbSurfaceSource_class.f90 | 3 +- ParticleObjects/Source/source_inter.f90 | 11 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 32 +- 9 files changed, 256 insertions(+), 200 deletions(-) diff --git a/Geometry/Universes/latUniverse_class.f90 b/Geometry/Universes/latUniverse_class.f90 index 798ebd9d8..a970a93c8 100644 --- a/Geometry/Universes/latUniverse_class.f90 +++ b/Geometry/Universes/latUniverse_class.f90 @@ -90,6 +90,7 @@ module latUniverse_class procedure :: distance procedure :: cross procedure :: cellOffset + procedure :: getSizeN end type latUniverse contains @@ -364,6 +365,17 @@ function cellOffset(self, coords) result (offset) end function cellOffset + !! + !! Return dimensions of lattice + !! + function getSizeN(self) result(sizeN) + class(latUniverse), intent(in) :: self + integer(shortInt), dimension(3) :: sizeN + + sizeN = self % sizeN + + end function getSizeN + !! !! Return to uninitialised state !! diff --git a/Geometry/geometryStd_class.f90 b/Geometry/geometryStd_class.f90 index 09e59eee0..06ccf5c54 100644 --- a/Geometry/geometryStd_class.f90 +++ b/Geometry/geometryStd_class.f90 @@ -9,6 +9,7 @@ module geometryStd_class use geometry_inter, only : geometry, distCache use csg_class, only : csg use universe_inter, only : universe + use latUniverse_class, only : latUniverse use surface_inter, only : surface ! Nuclear Data @@ -57,6 +58,7 @@ module geometryStd_class procedure :: moveGlobal procedure :: teleport procedure :: activeMats + procedure :: latSizeN ! Private procedures procedure, private :: diveToMat @@ -572,5 +574,42 @@ subroutine closestDist_cache(self, dist, surfIdx, lvl, coords, cache) end do end subroutine closestDist_cache + !! + !! Return dimensions of latUniverse + !! + !! fatalError if no latUniverse found, if there are multiple then it will return dimensions + !! of the first one found, which may not be what is wanted + !! + function latSizeN(self) result(sizeN) + class(geometryStd), intent(in) :: self + integer(shortInt), dimension(3) :: sizeN + integer(shortInt) :: i + class(universe), pointer :: uni + class(latUniverse), pointer :: latUni + character(100), parameter :: Here = 'latSizeN (geometryStd_class.f90)' + + ! Search for latUniverse + do i=1, self % geom % unis % getSize() + + uni => self % geom % unis % getPtr(i) + + select type(uni) + class is(latUniverse) + latUni => uni + exit + + class default + latUni => null() + + end select + end do + + if (.not. associated(latUni)) call fatalError(Here, 'Lattice universe not found') + + ! Find lattice dimensions + sizeN = latUni % getSizeN() + + end function latSizeN + end module geometryStd_class diff --git a/Geometry/geometry_inter.f90 b/Geometry/geometry_inter.f90 index 973007549..eb4370248 100644 --- a/Geometry/geometry_inter.f90 +++ b/Geometry/geometry_inter.f90 @@ -43,6 +43,7 @@ module geometry_inter procedure(moveGlobal), deferred :: moveGlobal procedure(teleport), deferred :: teleport procedure(activeMats), deferred :: activeMats + procedure(latSizeN), deferred :: latSizeN ! Common procedures procedure :: slicePlot @@ -262,6 +263,18 @@ function activeMats(self) result(matList) integer(shortInt), dimension(:), allocatable :: matList end function activeMats + !! + !! Return dimensions of latUniverse + !! + !! fatalError if no latUniverse found, if there are multiple then it will return dimensions + !! of the first one found, which may not be what is wanted + !! + function latSizeN(self) result(sizeN) + import geometry, shortInt + class(geometry), intent(in) :: self + integer(shortInt), dimension(3) :: sizeN + end function latSizeN + end interface contains diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index ab1c42be4..30cc86171 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -57,7 +57,7 @@ module baseMgIMCDatabase_class procedure :: getMaterial procedure :: getNuclide procedure :: getReaction - procedure :: getTotalEnergy + procedure :: getEmittedRad procedure :: updateProperties procedure :: setTimeStep procedure :: kill @@ -202,20 +202,32 @@ function getReaction(self, MT, idx) result(reac) end function getReaction !! - !! Return total energy to be emitted during current time step + !! Return energy to be emitted during current time step !! - function getTotalEnergy(self) result(energy) - class(baseMgIMCDatabase), intent(in) :: self - real(defReal) :: energy - integer(shortInt) :: i + !! Args: + !! matIdx [in] [optional] -> If provided, return the energy to be emitted from only matIdx + !! Otherwise, return total energy to be emitted from all mats + !! + function getEmittedRad(self, matIdx) result(energy) + class(baseMgIMCDatabase), intent(in) :: self + integer(shortInt), intent(in), optional :: matIdx + real(defReal) :: energy + integer(shortInt) :: i + + ! If matIdx provided, return radiation emitted from only that material + if (present(matIdx)) then + energy = self % mats(matIdx) % getEmittedRad() + return + end if + ! Otherwise, return total energy emitted from all materials energy = 0 do i=1, size(self % mats) energy = energy + self % mats(i) % getEmittedRad() end do - end function getTotalEnergy + end function getEmittedRad !! !! Update material properties based on energy absorbed during the time step diff --git a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 index 2873274ef..e771c51f6 100644 --- a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 @@ -22,7 +22,7 @@ module mgIMCDatabase_inter type, public, abstract, extends(nuclearDatabase) :: mgIMCDatabase contains - procedure(getTotalEnergy), deferred :: getTotalEnergy + procedure(getEmittedRad), deferred :: getEmittedRad procedure(updateProperties), deferred :: updateProperties procedure(setTimeStep), deferred :: setTimeStep @@ -31,13 +31,18 @@ module mgIMCDatabase_inter abstract interface !! - !! Return total energy to be emitted during current time step + !! Return energy to be emitted during current time step !! - function getTotalEnergy(self) result(energy) - import :: mgIMCDatabase, defReal - class(mgIMCDatabase), intent(in) :: self - real(defReal) :: energy - end function getTotalEnergy + !! Args: + !! matIdx [in] [optional] -> If provided, return the energy to be emitted from only matIdx + !! Otherwise, return total energy to be emitted from all mats + !! + function getEmittedRad(self, matIdx) result(energy) + import :: mgIMCDatabase, shortInt, defReal + class(mgIMCDatabase), intent(in) :: self + integer(shortInt), intent(in), optional :: matIdx + real(defReal) :: energy + end function getEmittedRad !! !! Update material properties based on energy absorbed during the time step diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 99f91596d..4143a602b 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -16,11 +16,13 @@ module IMCSource_class use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG use nuclearDatabase_inter, only : nuclearDatabase use mgIMCDatabase_inter, only : mgIMCDatabase - use materialMenu_mod, only : mm_matName => matName + use materialMenu_mod, only : mm_nMat => nMat implicit none private + integer(shortInt), parameter :: REJ = 1, FAST = 2 + !! !! IMC Source for uniform generation of photons within a material !! @@ -31,8 +33,6 @@ module IMCSource_class !! bottom -> Bottom corner (x_min, y_min, z_min) !! top -> Top corner (x_max, y_max, z_max) !! G -> Group (default = 1) - !! N -> number of particles being generated, used to normalise weight in sampleParticle - !! matIdx -> index of material to be sampled from !! !! Interface: !! source_inter Interface @@ -42,21 +42,19 @@ module IMCSource_class !! type, public,extends(source) :: imcSource private - logical(defBool) :: isMG = .true. - real(defReal), dimension(3) :: bottom = ZERO - real(defReal), dimension(3) :: top = ZERO - real(defReal), dimension(3) :: latPitch = ZERO - integer(shortInt), dimension(:), allocatable :: latSizeN - integer(shortInt) :: G = 0 - integer(shortInt) :: N - integer(shortInt) :: matIdx - real(defReal), dimension(6) :: matBounds = ZERO + logical(defBool) :: isMG = .true. + real(defReal), dimension(3) :: bottom = ZERO + real(defReal), dimension(3) :: top = ZERO + real(defReal), dimension(3) :: latPitch = ZERO + integer(shortInt), dimension(3) :: latSizeN = 0 + integer(shortInt) :: G = 0 + real(defReal), dimension(6) :: bounds = ZERO + integer(shortInt) :: method = REJ contains procedure :: init procedure :: append procedure :: sampleParticle - procedure, private :: samplePosRej - procedure, private :: samplePosLat + procedure, private :: sampleIMC procedure, private :: getMatBounds procedure :: kill end type imcSource @@ -72,79 +70,112 @@ subroutine init(self, dict, geom) class(imcSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom - real(defReal), dimension(6) :: bounds + character(nameLen) :: method character(100), parameter :: Here = 'init (imcSource_class.f90)' + call dict % getOrDefault(self % G, 'G', 1) + ! Provide geometry info to source self % geom => geom - call dict % getOrDefault(self % G, 'G', 1) - ! Set bounding region - bounds = self % geom % bounds() - self % bottom = bounds(1:3) - self % top = bounds(4:6) + self % bounds = self % geom % bounds() + + ! Select method for position sampling + call dict % getOrDefault(method, 'method', 'rejection') + select case(method) + case('rejection') + self % method = REJ - ! Store lattice dimensions for use in position sampling if using a large lattice - ! sizeN automatically added to dict in IMCPhysicsPackage if needed - if (dict % isPresent('sizeN')) then - call dict % get(self % latSizeN, 'sizeN') - self % latPitch = (self % top - self % bottom) / self % latSizeN - end if + case('fast') + self % method = FAST + ! Get lattice dimensions + self % latSizeN = self % geom % latSizeN() + self % latPitch = (self % bounds(4:6) - self % bounds(1:3)) / self % latSizeN + + case default + call fatalError(Here, 'Unrecognised method. Should be "rejection" or "fast"') + end select end subroutine init + !! - !! Generate N particles from material matIdx to add to a particleDungeon without overriding + !! Generate N particles to add to a particleDungeon without overriding !! particles already present. !! !! Args: !! dungeon [inout] -> particle dungeon to be added to !! n [in] -> number of particles to place in dungeon !! rand [inout] -> particle RNG object - !! matIdx [in] -> index of material to sample from !! !! Result: !! A dungeon populated with N particles sampled from the source, plus particles !! already present in dungeon !! - subroutine append(self, dungeon, N, rand, matIdx) + subroutine append(self, dungeon, N, rand) class(imcSource), intent(inout) :: self type(particleDungeon), intent(inout) :: dungeon integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand - integer(shortInt), intent(in), optional :: matIdx - integer(shortInt) :: i + real(defReal), dimension(6) :: bounds + integer(shortInt) :: matIdx, i, Ntemp + real(defReal) :: energy, totalEnergy type(RNG) :: pRand + class(mgIMCDatabase), pointer :: nucData character(100), parameter :: Here = "append (IMCSource_class.f90)" - ! Assert that optional argument matIdx is in fact present - if (.not. present(matIdx)) call fatalError(Here, 'matIdx must be provided for IMC source') - - ! Store inputs for use by sampleParticle subroutine - self % N = N - self % matIdx = matIdx - - ! For a large number of materials (large lattice using discretiseGeom_class) rejection - ! sampling is too slow, so calculate bounding box of material - if (self % latPitch(1) /= 0) then - ! Get material bounds - call self % getMatBounds(matIdx, self % matBounds) - end if - - ! Add N particles to dungeon - !$omp parallel - pRand = rand - !$omp do private(pRand) - do i=1, N - call pRand % stride(i) - call dungeon % detain(self % sampleParticle(pRand)) + ! Get pointer to appropriate nuclear database + nucData => ndReg_getIMCMG() + if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') + + ! Obtain total energy + totalEnergy = nucData % getEmittedRad() + + ! Loop through materials + do matIdx=1, mm_nMat() + + ! Get energy to be emitted from material matIdx + energy = nucData % getEmittedRad(matIdx) + + ! Choose particle numbers in proportion to material energy + if (energy > ZERO) then + Ntemp = int(N * energy / totalEnergy) + ! Enforce at least 1 particle + if (Ntemp == 0) Ntemp = 1 + + ! Set bounds for sampling + if (self % method == FAST) then + bounds = self % getMatBounds(matIdx) + else + bounds = self % bounds + end if + + ! Find energy per particle + energy = energy / Ntemp + + ! Sample particles + do i = 1, Ntemp + call dungeon % detain(self % sampleIMC(pRand, matIdx, energy, bounds)) + end do + + end if end do - !$omp end do - !$omp end parallel + +! ! Add N particles to dungeon +! !$omp parallel +! pRand = rand +! !$omp do private(pRand) +! do i=1, N +! call pRand % stride(i) +! call dungeon % detain(self % sampleParticle(pRand)) +! end do +! !$omp end do +! !$omp end parallel end subroutine append + !! !! Sample particle's phase space co-ordinates !! @@ -154,113 +185,84 @@ function sampleParticle(self, rand) result(p) class(imcSource), intent(inout) :: self class(RNG), intent(inout) :: rand type(particleState) :: p - class(nuclearDatabase), pointer :: nucData - class(IMCMaterial), pointer :: mat - real(defReal), dimension(3) :: r, dir - real(defReal) :: mu, phi - integer(shortInt) :: matIdx, uniqueID - character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' + character(100), parameter :: Here = 'sampleParticle (IMCSource_class.f90)' - ! Get pointer to appropriate nuclear database - nucData => ndReg_getIMCMG() - if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') - - ! Choose position sampling method - if (self % latPitch(1) == ZERO) then - call self % samplePosRej(r, matIdx, uniqueID, rand) - else - call self % samplePosLat(r, matIdx, uniqueID, rand) - end if - - ! Point to material - mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) - if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") - - ! Sample direction - chosen uniformly inside unit sphere - mu = 2 * rand % get() - 1 - phi = rand % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) - - ! Assign basic phase-space coordinates - p % matIdx = matIdx - p % uniqueID = uniqueID - p % time = ZERO - p % type = P_PHOTON - p % r = r - p % dir = dir - p % G = self % G - p % isMG = .true. + ! Should not be called, useful to have extra inputs so use sampleIMC instead + call fatalError(Here, 'Should not be called, sampleIMC should be used instead.') - ! Set weight - p % wgt = mat % getEmittedRad() / self % N + ! Avoid compiler warning + p % G = self % G end function sampleParticle !! - !! Position is sampled by taking a random point from within geometry bounding box - !! If in correct material, position is accepted + !! Sample particle's phase space co-ordinates !! - subroutine samplePosRej(self, r, matIdx, uniqueID, rand) - class(imcSource), intent(inout) :: self - real(defReal), dimension(3), intent(out) :: r - integer(shortInt), intent(out) :: matIdx - integer(shortInt), intent(out) :: uniqueID - class(RNG), intent(inout) :: rand - integer(shortInt) :: i - real(defReal), dimension(3) :: rand3 - character(100), parameter :: Here = 'samplePosRej (IMCSource_class.f90)' - + !! Args: + !! rand [in] -> RNG + !! matIdx [in] -> index of material being sampled from + !! energy [in] -> energy-weight of sampled particle + !! bounds [in] -> bounds for position search, will be bounds of entire geometry if using + !! rejection sampling method, and bounds of single material if using fast + !! + function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) + class(imcSource), intent(inout) :: self + class(RNG), intent(inout) :: rand + integer(shortInt), intent(in) :: targetMatIdx + real(defReal), intent(in) :: energy + real(defReal), dimension(6), intent(in) :: bounds + type(particleState) :: p + real(defReal), dimension(3) :: bottom, top, r, dir, rand3 + real(defReal) :: mu, phi + integer(shortInt) :: i, matIdx, uniqueID + character(100), parameter :: Here = 'sampleIMC (IMCSource_class.f90)' + + ! Sample particle position + bottom = bounds(1:3) + top = bounds(4:6) i = 0 - - rejectionLoop : do - - ! Protect against infinite loop - i = i+1 - if (i > 10000) then - call fatalError(Here, '10,000 failed samples in rejection sampling loop') - end if - - ! Sample Position + rejection:do rand3(1) = rand % get() rand3(2) = rand % get() rand3(3) = rand % get() - r = (self % top - self % bottom) * rand3 + self % bottom + r = (top - bottom) * rand3 + bottom ! Find material under position call self % geom % whatIsAt(matIdx, uniqueID, r) ! Exit if in desired material - if (matIdx == self % matIdx) exit rejectionLoop + if (matIdx == targetMatIdx) exit rejection - end do rejectionLoop + ! Should exit immediately if using fast method as bounds should contain only matIdx + if (self % method == FAST) call fatalError(Here, 'Fast sourcing returned incorrect material') - end subroutine samplePosRej + ! Protect against infinite loop + i = i+1 + if (i > 10000) call fatalError(Here, '10,000 failed attempts in rejection sampling') - !! - !! Sample position without using a rejection sampling method, by calculating the material bounds. - !! - !! Requires geometry to be a uniform lattice, so currently only called when discretiseGeom_class - !! is used to create inputs. - !! - subroutine samplePosLat(self, r, matIdx, uniqueID, rand) - class(imcSource), intent(inout) :: self - real(defReal), dimension(3), intent(out) :: r - integer(shortInt), intent(out) :: matIdx - integer(shortInt), intent(out) :: uniqueID - class(RNG), intent(inout) :: rand - integer(shortInt) :: i - character(100), parameter :: Here = 'samplePosLat (IMCSource_class.f90)' + end do rejection - do i=1, 3 - r(i) = self % matBounds(i) + rand % get() * (self % matBounds(i+3) - self % matBounds(i) - SURF_TOL) + SURF_TOL - end do + ! Sample direction - chosen uniformly inside unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) - call self % geom % whatIsAt(matIdx, uniqueID, r) + ! Assign basic phase-space coordinates + p % matIdx = matIdx + p % uniqueID = uniqueID + p % time = ZERO + p % type = P_PHOTON + p % r = r + p % dir = dir + p % G = self % G + p % isMG = .true. + p % wgt = energy + + end function sampleIMC - end subroutine samplePosLat !! !! Get location of material in lattice for position sampling @@ -272,27 +274,23 @@ end subroutine samplePosLat !! TODO: !! Would be nice to have most of this in a geometry module !! - subroutine getMatBounds(self, matIdx, matBounds) + function getMatBounds(self, matIdx) result(matBounds) class(imcSource), intent(inout) :: self integer(shortInt), intent(in) :: matIdx - real(defReal), dimension(6), intent(out) :: matBounds + real(defReal), dimension(6) :: matBounds integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: latIdx, i - character(nameLen) :: matName + integer(shortInt) :: i character(100), parameter :: Here = 'getMatBounds (imcSourceClass.f90)' - ! Extract lattice position from mat name (e.g. "m106 -> 106") - matName = mm_matName(matIdx) - read (matName(2:), '(I10)') latIdx - ! Set bounds of lattice cell containing matIdx - ijk = get_ijk(latIdx, self % latSizeN) + ijk = get_ijk(matIdx, self % latSizeN) do i=1, 3 - matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bottom(i) - matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bottom(i) + matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bounds(i) + SURF_TOL + matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bounds(i) - SURF_TOL end do - end subroutine getMatBounds + end function getMatBounds + !! !! Return to uninitialised state @@ -303,8 +301,7 @@ elemental subroutine kill(self) call kill_super(self) self % isMG = .true. - self % bottom = ZERO - self % top = ZERO + self % bounds = ZERO self % G = 0 end subroutine kill diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 4483d511e..020beae5f 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -133,12 +133,11 @@ end subroutine init !! If N is given as 0, then N is instead taken from the input dictionary defining this source !! to allow PP to have control over particle numbers !! - subroutine append(self, dungeon, N, rand, matIdx) + subroutine append(self, dungeon, N, rand) class(bbSurfaceSource), intent(inout) :: self type(particleDungeon), intent(inout) :: dungeon integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand - integer(shortInt), intent(in), optional :: matIdx integer(shortInt) :: i type(RNG) :: pRand character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index 641032f54..ae3254059 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -128,30 +128,27 @@ end subroutine generate !! Generate particles to add to a particleDungeon without overriding !! particles already present !! - !! Adds to a particle dungeon n particles, sampled + !! Adds to a particle dungeon N particles, sampled !! from the corresponding source distributions !! !! Args: !! dungeon [inout] -> particle dungeon to be added to !! n [in] -> number of particles to place in dungeon !! rand [inout] -> particle RNG object - !! matIdx [in] -> optional unused argument, here so that subclasses can override to - !! select matIdx to sample from !! !! Result: !! A dungeon populated with n particles sampled from the source, plus !! particles already present in dungeon !! - subroutine append(self, dungeon, n, rand, matIdx) + subroutine append(self, dungeon, N, rand) class(source), intent(inout) :: self type(particleDungeon), intent(inout) :: dungeon - integer(shortInt), intent(in) :: n + integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand - integer(shortInt), intent(in), optional :: matIdx integer(shortInt) :: i ! Generate n particles to populate dungeon - do i = 1, n + do i = 1, N call dungeon % detain(self % sampleParticle(rand)) end do diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 8fb1b2917..9a35269d8 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -39,7 +39,6 @@ module IMCPhysicsPackage_class use nuclearDatabase_inter, only : nuclearDatabase use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast - use mgIMCMaterial_inter, only : mgIMCMaterial ! Operators use collisionOperator_class, only : collisionOperator @@ -134,17 +133,17 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_steps - integer(shortInt) :: i, j, N, Ntemp, num, nParticles + integer(shortInt) :: i, j, N, num, nParticles type(particle), save :: p - real(defReal) :: elapsed_T, end_T, T_toEnd, totEnergy + real(defReal) :: elapsed_T, end_T, T_toEnd real(defReal), dimension(:), allocatable :: tallyEnergy - class(IMCMaterial), pointer, save :: mat + class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='steps (IMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes type(collisionOperator), save :: collOp class(transportOperator), allocatable, save :: transOp type(RNG), target, save :: pRNG - !$omp threadprivate(p, collOp, transOp, pRNG, mat) + !$omp threadprivate(p, collOp, transOp, pRNG) !$omp parallel p % geomIdx = self % geomIdx @@ -179,22 +178,8 @@ subroutine steps(self, tally, tallyAtch, N_steps) N = self % limit - self % thisStep % popSize() - self % nMat - 1 end if - ! Find total energy to be emitted - totEnergy = self % nucData % getTotalEnergy() - - ! Add to particle dungeon - do j=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - if (mat % getTemp() > 0) then - ! Choose particle numbers in proportion to zone energy - Ntemp = int(N * mat % getEmittedRad() / totEnergy) - ! Enforce at least 1 particle - if (Ntemp == 0) Ntemp = 1 - - call self % IMCSource % append(self % thisStep, Ntemp, self % pRNG, j) - - end if - end do + ! Add to dungeon particles emitted from material + call self % IMCSource % append(self % thisStep, N, self % pRNG) ! Generate from input source if( self % sourceGiven ) then @@ -314,7 +299,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) open(unit = 10, file = 'temps.txt') do j = 1, self % nMat mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - !write(10, '(8A)') numToChar(mat % getTemp()) write(10, '(8A)') mm_matName(j), numToChar(mat % getTemp()) end do close(10) @@ -371,7 +355,6 @@ subroutine init(self, dict) character(nameLen) :: nucData, geomName type(outputFile) :: test_out integer(shortInt) :: i - class(IMCMaterial), pointer :: mat character(nameLen), dimension(:), allocatable :: mats integer(shortInt), dimension(:), allocatable :: latSizeN type(dictionary),target :: newGeom, newData @@ -465,9 +448,8 @@ subroutine init(self, dict) ! Initialise IMC source if (dict % isPresent('discretise')) then - ! Store size of lattice to avoid rejection sampling loop in source call locDict1 % init(2) - call locDict1 % store('sizeN', latSizeN) + call locDict1 % store('method', 'fast') else call locDict1 % init(1) end if From 022d7a131bb2602ae1b482fc204ee5789e698758 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 23 May 2023 13:53:57 +0100 Subject: [PATCH 333/373] Fixed a few oversights relating to void regions in lattice and also lattice with Ny or Nz > 1, plus a few other minor changes --- InputFiles/IMC/hohlraum | 2 + InputFiles/IMC/marshakWave | 5 +- ParticleObjects/Source/IMCSource_class.f90 | 66 +++++++++++-------- .../Source/bbSurfaceSource_class.f90 | 6 -- PhysicsPackages/IMCPhysicsPackage_class.f90 | 56 ++++++++-------- 5 files changed, 72 insertions(+), 63 deletions(-) diff --git a/InputFiles/IMC/hohlraum b/InputFiles/IMC/hohlraum index 2f0b180e4..2be0bed98 100644 --- a/InputFiles/IMC/hohlraum +++ b/InputFiles/IMC/hohlraum @@ -18,6 +18,8 @@ transportOperator { grid { dimensions (20 20 1); searchN (10 10 1); } } +matSource { type imcSource; method fast; } + source { type bbSurfaceSource; r (-0.5 -0.5 -0.5 0.5 -0.5 0.5); diff --git a/InputFiles/IMC/marshakWave b/InputFiles/IMC/marshakWave index 55e0667d6..c3d87c7ae 100644 --- a/InputFiles/IMC/marshakWave +++ b/InputFiles/IMC/marshakWave @@ -17,6 +17,9 @@ transportOperator { tally {} +// Material photon source - optional but will default to rejection sampling if method not specified +matSource { type imcSource; method fast; } + // Black body surface source source { type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 10000; } @@ -24,7 +27,7 @@ source { type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 10000; } discretise { dimensions (500 1 1); } // Overlaid grid for hybrid tracking -grid { dimensions (50 1 1); searchN (1000 1 1); } +grid { dimensions (50 1 1); searchN (10 1 1); } geometry { type geometryStd; diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 4143a602b..0cd06b95c 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -16,7 +16,8 @@ module IMCSource_class use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG use nuclearDatabase_inter, only : nuclearDatabase use mgIMCDatabase_inter, only : mgIMCDatabase - use materialMenu_mod, only : mm_nMat => nMat + use materialMenu_mod, only : mm_nMat => nMat, & + mm_matName => matName implicit none private @@ -133,7 +134,7 @@ subroutine append(self, dungeon, N, rand) totalEnergy = nucData % getEmittedRad() ! Loop through materials - do matIdx=1, mm_nMat() + do matIdx = 1, mm_nMat() ! Get energy to be emitted from material matIdx energy = nucData % getEmittedRad(matIdx) @@ -155,23 +156,18 @@ subroutine append(self, dungeon, N, rand) energy = energy / Ntemp ! Sample particles - do i = 1, Ntemp + !$omp parallel + pRand = rand + !$omp do private(pRand) + do i=1, Ntemp + call pRand % stride(i) call dungeon % detain(self % sampleIMC(pRand, matIdx, energy, bounds)) end do + !$omp end do + !$omp end parallel end if end do - -! ! Add N particles to dungeon -! !$omp parallel -! pRand = rand -! !$omp do private(pRand) -! do i=1, N -! call pRand % stride(i) -! call dungeon % detain(self % sampleParticle(pRand)) -! end do -! !$omp end do -! !$omp end parallel end subroutine append @@ -267,6 +263,9 @@ end function sampleIMC !! !! Get location of material in lattice for position sampling !! + !! Note that this may be incorrect depending on how lattice input is given, this function + !! assumes that geometry has been generated by discretiseGeom_class.f90 + !! !! Args: !! matIdx [in] -> matIdx for which to calculate bounds !! matBounds [out] -> boundary of lattice cell, [xmin,ymin,zmin,xmax,ymax,zmax] @@ -279,11 +278,19 @@ function getMatBounds(self, matIdx) result(matBounds) integer(shortInt), intent(in) :: matIdx real(defReal), dimension(6) :: matBounds integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: i + integer(shortInt) :: i, latIdFlipped + character(nameLen) :: matName character(100), parameter :: Here = 'getMatBounds (imcSourceClass.f90)' + ! Extract lattice position from mat name (e.g. "m106 -> 106") + ! This is different from localID in latUniverse_class as is counting from a different + ! corner (see get_ijk function description below) + matName = mm_matName(matIdx) + read (matName(2:), '(I10)') latIdFlipped + ! Set bounds of lattice cell containing matIdx - ijk = get_ijk(matIdx, self % latSizeN) + ijk = get_ijk(latIdFlipped, self % latSizeN) + do i=1, 3 matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bounds(i) + SURF_TOL matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bounds(i) - SURF_TOL @@ -291,7 +298,6 @@ function getMatBounds(self, matIdx) result(matBounds) end function getMatBounds - !! !! Return to uninitialised state !! @@ -306,33 +312,39 @@ elemental subroutine kill(self) end subroutine kill - !! - !! Generate ijk from localID and shape + !! Generate ijk from flipped localID and shape + !! + !! Note that this is NOT the same as get_ijk in latUniverse_class. Lattice is built with first + !! map input as x_min, y_MAX, z_MAX cell, but localID begins at x_min, y_min, z_min cell. In + !! this module we want to find ijk from matIdx, which we convert to a flippedLocalID by + !! offsetting for void regions, which starts counting from the wrong corner. We therefore flip + !! ijk in the y and z directions in this function compared to instances of this function in other + !! modules. !! !! Args: - !! localID [in] -> Local id of the cell between 1 and product(sizeN) - !! sizeN [in] -> Number of cells in each cardinal direction x, y & z + !! flippedlocalID [in] -> Local id of the cell between 1 and product(sizeN), + !! counting from wrong corner + !! sizeN [in] -> Number of cells in each cardinal direction x, y & z !! !! Result: !! Array ijk which has integer position in each cardinal direction !! - pure function get_ijk(localID, sizeN) result(ijk) - integer(shortInt), intent(in) :: localID + pure function get_ijk(flippedLocalID, sizeN) result(ijk) + integer(shortInt), intent(in) :: flippedLocalID integer(shortInt), dimension(3), intent(in) :: sizeN integer(shortInt), dimension(3) :: ijk integer(shortInt) :: temp, base - temp = localID - 1 - + temp = flippedLocalID - 1 base = temp / sizeN(1) ijk(1) = temp - sizeN(1) * base + 1 temp = base base = temp / sizeN(2) - ijk(2) = temp - sizeN(2) * base + 1 + ijk(2) = sizeN(2)*(1 + base) - temp - ijk(3) = base + 1 + ijk(3) = sizeN(3) - base end function get_ijk diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 020beae5f..81f116710 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -74,17 +74,12 @@ module bbSurfaceSource_class !! See source_inter for details !! !! Errors: - !! - error if an unrecognised particle type is provided !! - error if an axis other than x, y, or z is given - !! - error if shape is not square or circle !! subroutine init(self, dict, geom) class(bbSurfaceSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom - character(30) :: type, tempName - integer(shortInt) :: matIdx, uniqueID - logical(defBool) :: isCE, isMG real(defReal), dimension(:), allocatable :: temp integer(shortInt) :: i, dir character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' @@ -249,7 +244,6 @@ subroutine sampleEnergy(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal) :: num p % isMG = .true. p % G = 1 diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index 9a35269d8..bd68ebd08 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -346,7 +346,7 @@ subroutine init(self, dict) class(IMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict class(dictionary), pointer :: tempDict, geomDict, dataDict - type(dictionary) :: locDict1, locDict2, locDict3, locDict4, locDict5 + type(dictionary) :: locDict1, locDict2, locDict3, locDict4 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -438,7 +438,18 @@ subroutine init(self, dict) call newGeom % kill() call newData % kill() - ! Read particle source definition + ! Initialise IMC source + if (dict % isPresent('matSource')) then + tempDict => dict % getDictPtr('matSource') + call new_source(self % IMCSource, tempDict, self % geom) + else + call locDict1 % init(1) + call locDict1 % store('type', 'imcSource') + call new_source(self % IMCSource, locDict1, self % geom) + call locDict1 % kill() + end if + + ! Read external particle source definition if( dict % isPresent('source') ) then tempDict => dict % getDictPtr('source') call tempDict % store('deltaT', self % deltaT) @@ -446,16 +457,6 @@ subroutine init(self, dict) self % sourceGiven = .true. end if - ! Initialise IMC source - if (dict % isPresent('discretise')) then - call locDict1 % init(2) - call locDict1 % store('method', 'fast') - else - call locDict1 % init(1) - end if - call locDict1 % store('type', 'imcSource') - call new_source(self % IMCSource, locDict1, self % geom) - ! Build collision operator tempDict => dict % getDictPtr('collisionOperator') call self % collOp % init(tempDict) @@ -482,26 +483,23 @@ subroutine init(self, dict) mats(i) = mm_matName(i) end do - ! Provide materials with time step - call self % nucData % setTimeStep(self % deltaT) - ! Initialise imcWeight tally attachment - call locDict2 % init(1) - call locDict3 % init(4) - call locDict4 % init(2) - call locDict5 % init(1) - - call locDict5 % store('type', 'weightResponse') - call locDict4 % store('type','materialMap') - call locDict4 % store('materials', [mats]) - call locDict3 % store('response', ['imcWeightResponse']) - call locDict3 % store('imcWeightResponse', locDict5) - call locDict3 % store('type','absorptionClerk') - call locDict3 % store('map', locDict4) - call locDict2 % store('imcWeightTally', locDict3) + call locDict1 % init(1) + call locDict2 % init(4) + call locDict3 % init(2) + call locDict4 % init(1) + + call locDict4 % store('type', 'weightResponse') + call locDict3 % store('type','materialMap') + call locDict3 % store('materials', [mats]) + call locDict2 % store('response', ['imcWeightResponse']) + call locDict2 % store('imcWeightResponse', locDict4) + call locDict2 % store('type','absorptionClerk') + call locDict2 % store('map', locDict3) + call locDict1 % store('imcWeightTally', locDict2) allocate(self % imcWeightAtch) - call self % imcWeightAtch % init(locDict2) + call self % imcWeightAtch % init(locDict1) call self % tally % push(self % imcWeightAtch) From 14bc4a11ed090807ac47bfca699b048cbaeb34c6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 26 May 2023 12:35:26 +0100 Subject: [PATCH 334/373] Cleaned up material class, using IMCSource for ISMC as well as very similar, reset ISMC PP to be in line with IMC PP --- NuclearData/IMCMaterial_inter.f90 | 16 +- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 44 +++ .../baseMgIMC/baseMgIMCMaterial_class.f90 | 240 +++++--------- NuclearData/mgIMCData/mgIMCDatabase_inter.f90 | 32 +- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 16 +- ParticleObjects/Source/IMCSource_class.f90 | 39 ++- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 294 +++++++++--------- 7 files changed, 350 insertions(+), 331 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 85bd741f9..edadeb7c5 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -36,8 +36,8 @@ module IMCMaterial_inter procedure(getFleck), deferred :: getFleck procedure(getEta), deferred :: getEta procedure(getTemp), deferred :: getTemp - procedure(getEnergyDens), deferred :: getEnergyDens - procedure(setType), deferred :: setType + procedure(getMatEnergy), deferred :: getMatEnergy + procedure(setCalcType), deferred :: setCalcType procedure(setTimeStep), deferred :: setTimeStep end type IMCMaterial @@ -116,13 +116,13 @@ function getTemp(self) result(T) end function getTemp !! - !! Return energy per unit volume of material + !! Return material energy !! - function getEnergyDens(self) result(energyDens) + function getMatEnergy(self) result(energy) import :: IMCMaterial, defReal class(IMCMaterial), intent(inout) :: self - real(defReal) :: energyDens - end function getEnergyDens + real(defReal) :: energy + end function getMatEnergy !! !! Set the calculation type to be used @@ -134,11 +134,11 @@ end function getEnergyDens !! Errors: !! Unrecognised option !! - subroutine setType(self, calcType) + subroutine setCalcType(self, calcType) import :: IMCMaterial, shortInt class(IMCMaterial), intent(inout) :: self integer(shortInt), intent(in) :: calcType - end subroutine setType + end subroutine setCalcType !! !! Provide material with time step size diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 30cc86171..3c949d2b8 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -58,8 +58,10 @@ module baseMgIMCDatabase_class procedure :: getNuclide procedure :: getReaction procedure :: getEmittedRad + procedure :: getMaterialEnergy procedure :: updateProperties procedure :: setTimeStep + procedure :: setCalcType procedure :: kill procedure :: init procedure :: activate @@ -229,6 +231,34 @@ function getEmittedRad(self, matIdx) result(energy) end function getEmittedRad + !! + !! Return material energy + !! + !! Args: + !! matIdx [in] [optional] -> If provided, return the energy of only matIdx + !! Otherwise, return total energy of all mats + !! + function getMaterialEnergy(self, matIdx) result(energy) + class(baseMgIMCDatabase), intent(in) :: self + integer(shortInt), intent(in), optional :: matIdx + real(defReal) :: energy + integer(shortInt) :: i + + ! If matIdx provided, return radiation emitted from only that material + if (present(matIdx)) then + energy = self % mats(matIdx) % getMatEnergy() + return + end if + + ! Otherwise, return total energy emitted from all materials + energy = 0 + + do i=1, size(self % mats) + energy = energy + self % mats(i) % getMatEnergy() + end do + + end function getMaterialEnergy + !! !! Update material properties based on energy absorbed during the time step !! @@ -273,6 +303,20 @@ subroutine setTimeStep(self, deltaT) end subroutine setTimeStep + !! + !! Tell each material if we are using IMC or ISMC + !! + subroutine setCalcType(self, type) + class(baseMgIMCDatabase), intent(inout) :: self + integer(shortInt), intent(in) :: type + integer(shortInt) :: i + + do i=1, size(self % mats) + call self % mats(i) % setCalcType(type) + end do + + end subroutine setCalcType + !! !! Return to uninitialised state !! diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index aa1557794..c028160d3 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -29,7 +29,7 @@ module baseMgIMCMaterial_class integer(shortInt), parameter, public :: CAPTURE_XS = 3 integer(shortInt), parameter, public :: PLANCK_XS = 4 - ! IMC Calculation Type + ! Calculation Type integer(shortInt), parameter, public :: IMC = 1 integer(shortInt), parameter, public :: ISMC = 2 @@ -92,19 +92,57 @@ module baseMgIMCMaterial_class procedure :: getFleck procedure :: getEta procedure :: getTemp - procedure :: getEnergyDens - procedure :: setType + procedure :: getMatEnergy + procedure :: setCalcType procedure :: setTimeStep - procedure, private :: updateMatIMC - procedure, private :: updateMatISMC procedure, private :: tempFromEnergy procedure, private :: sigmaFromTemp + procedure, private :: updateFleck end type baseMgIMCMaterial contains + !! + !! Update material properties at each time step + !! First update energy using simple balance, then solve for temperature, + !! then update temperature-dependent properties + !! + !! Args: + !! tallyEnergy [in] -> Energy absorbed into material + !! printUpdate [in, optional] -> Bool, if true then will print updates to screen + !! + subroutine updateMat(self, tallyEnergy, printUpdate) + class(baseMgIMCMaterial),intent(inout) :: self + real(defReal), intent(in) :: tallyEnergy + logical(defBool), intent(in), optional :: printUpdate + character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" + + ! TODO: Print updates if requested + + ! Return if no energy change + if (self % getEmittedRad() == tallyEnergy) return + + ! Update material internal energy + if (self % calcType == IMC) then + self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy + else + self % matEnergy = tallyEnergy + end if + self % energyDens = self % matEnergy / self % V + + ! Update material temperature + self % T = self % tempFromEnergy() + + ! Update sigma + call self % sigmaFromTemp() + + ! Update fleck factor + call self % updateFleck() + + end subroutine updateMat + !! !! Return to uninitialised state !! @@ -224,12 +262,11 @@ subroutine init(self, dict) self % energyDens = poly_eval(self % updateEqn, self % T) self % matEnergy = self % energyDens * self % V - ! Set calculation type (will support ISMC in the future) + ! Default to IMC calculation type self % calcType = IMC end subroutine init - !! !! Provide material with time step size !! @@ -242,30 +279,12 @@ end subroutine init subroutine setTimeStep(self, dt) class(baseMgIMCMaterial), intent(inout) :: self real(defReal), intent(in) :: dt - real(defReal) :: beta, zeta character(100), parameter :: Here = 'setTimeStep (baseMgIMCMaterial_class.f90)' self % deltaT = dt - beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) - - ! Use time step size to calculate fleck factor - if(self % calcType == IMC) then - self % fleck = 1/(1+self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) - - else if(self % calcType == ISMC) then - self % eta = radiationConstant * self % T**4 / self % energyDens - zeta = beta - self % eta - self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) - ! Deal with 0 temperature - needs more consideration for certain cv - if (self % fleck /= self % fleck) then - self % eta = ZERO - self % fleck = 0.70414 - end if - - else - call fatalError(Here, 'Calculation type invalid or not set') - end if + ! Set initial fleck factor + call self % updateFleck() end subroutine setTimeStep @@ -338,128 +357,6 @@ pure function baseMgIMCMaterial_CptrCast(source) result(ptr) end function baseMgIMCMaterial_CptrCast - !! - !! Update material properties at each time step - !! First update energy using simple balance, then solve for temperature, - !! then update temperature-dependent properties - !! - !! Args: - !! tallyEnergy [in] -> Energy absorbed into material - !! printUpdate [in, optional] -> Bool, if true then will print updates to screen - !! - subroutine updateMat(self, tallyEnergy, printUpdate) - class(baseMgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: tallyEnergy - logical(defBool), intent(in), optional :: printUpdate - character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" - - select case (self % calcType) - - case(IMC) - call self % updateMatIMC(tallyEnergy, printUpdate) - - case(ISMC) - call self % updateMatISMC(tallyEnergy, printUpdate) - - case default - call fatalError(Here, "Invalid calculation type") - - end select - - end subroutine updateMat - - !! - !! Material update for IMC calculation - !! - subroutine updateMatIMC(self, tallyEnergy, printUpdate) - class(baseMgIMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: tallyEnergy - logical(defBool), intent(in), optional :: printUpdate - real(defReal) :: beta - character(100), parameter :: Here = "updateMatIMC (baseMgIMCMaterial_class.f90)" - - ! Print current properties - if (present(printUpdate)) then - if (printUpdate .eqv. .True.) then - print *, " T_old = ", self % T - print *, " matEnergy at start of timestep =", self % matEnergy - print *, " emittedRad = ", self % getEmittedRad() - print *, " tallyEnergy = ", tallyEnergy - end if - end if - - ! Return if no energy change - if (self % getEmittedRad() == tallyEnergy) return - - ! Update material internal energy - self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy - self % energyDens = self % matEnergy / self % V - - ! Update material temperature - self % T = self % tempFromEnergy() - - ! Update sigma - call self % sigmaFromTemp() - - if( self % T < 0 ) then - call fatalError(Here, "Temperature is negative") - end if - - beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) - - self % fleck = 1/(1+1*self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) - - ! Print updated properties - if (present(printUpdate)) then - if(printUpdate .eqv. .True.) then - print *, " matEnergy at end of timestep = ", self % matEnergy - print *, " T_new = ", self % T - end if - end if - - end subroutine updateMatIMC - - !! - !! Material update for ISMC calculation - !! - subroutine updateMatISMC(self, tallyEnergy, printUpdate) - class(baseMgIMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: tallyEnergy - real(defReal) :: beta, zeta - logical(defBool), intent(in), optional :: printUpdate - - ! Update material internal energy - self % matEnergy = tallyEnergy - self % energyDens = self % matEnergy / self % V - - ! Update material temperature - self % T = self % tempFromEnergy() - - ! Update sigma - call self % sigmaFromTemp() - - ! Update ISMC equivalent of fleck factor - beta = 4*radiationConstant * self % T**3 / poly_eval(self % cv, self % T) - self % eta = radiationConstant * self % T**4 / self % energyDens - zeta = beta - self % eta - self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) - - ! Deal with 0 temperature - needs more consideration for certain cv - if (self % fleck /= self % fleck) then - self % eta = ZERO - self % fleck = 0.70414 - end if - - ! Print updated properties - if (present(printUpdate)) then - if(printUpdate .eqv. .True.) then - print *, " matEnergy at end of timestep = ", self % matEnergy - print *, " T_new = ", self % T - end if - end if - - end subroutine updateMatISMC - !! !! Calculate the temperature of material from internal energy !! @@ -492,6 +389,35 @@ subroutine sigmaFromTemp(self) end subroutine sigmaFromTemp + !! + !! Update fleck factor + !! + subroutine updateFleck(self) + class(baseMgIMCMaterial), intent(inout) :: self + real(defReal) :: beta, zeta + character(100), parameter :: Here = 'updateFleck (baseMgIMCMaterial_class.f90)' + + ! Calculate beta, ratio of radiation and material heat capacities + beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + + ! Use time step size to calculate fleck factor + select case(self % calcType) + + case(IMC) + self % fleck = 1/(1+self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) + + case(ISMC) + self % eta = radiationConstant * self % T**4 / self % energyDens + zeta = beta - self % eta + self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) + ! TODO: Check that 0 temperature will not cause problems + + case default + call fatalError(Here, 'Unrecognised calculation type') + + end select + + end subroutine updateFleck !! !! Return the energy to be emitted during time step, E_r @@ -544,13 +470,14 @@ end function getTemp !! !! Return energy per unit volume of material !! - function getEnergyDens(self) result(energyDens) + function getMatEnergy(self) result(energy) class(baseMgIMCMaterial), intent(inout) :: self - real(defReal) :: energyDens + real(defReal) :: energy - energyDens = poly_eval(self % updateEqn, self % T) + !energy = poly_eval(self % updateEqn, self % T) * self % V + energy = self % matEnergy - end function getEnergyDens + end function getMatEnergy !! !! Set the calculation type to be used @@ -562,16 +489,15 @@ end function getEnergyDens !! Errors: !! Unrecognised option !! - subroutine setType(self, calcType) + subroutine setCalcType(self, calcType) class(baseMgIMCMaterial), intent(inout) :: self integer(shortInt), intent(in) :: calcType - real(defReal) :: beta, zeta - character(100), parameter :: Here = 'setType (baseMgIMCMaterial_class.f90)' + character(100), parameter :: Here = 'setCalcType (baseMgIMCMaterial_class.f90)' if(calcType /= IMC .and. calcType /= ISMC) call fatalError(Here, 'Invalid calculation type') self % calcType = calcType - end subroutine setType + end subroutine setCalcType end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 index e771c51f6..47d9cd7ce 100644 --- a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 @@ -22,9 +22,11 @@ module mgIMCDatabase_inter type, public, abstract, extends(nuclearDatabase) :: mgIMCDatabase contains - procedure(getEmittedRad), deferred :: getEmittedRad - procedure(updateProperties), deferred :: updateProperties - procedure(setTimeStep), deferred :: setTimeStep + procedure(getEmittedRad), deferred :: getEmittedRad + procedure(getMaterialEnergy), deferred :: getMaterialEnergy + procedure(updateProperties), deferred :: updateProperties + procedure(setTimeStep), deferred :: setTimeStep + procedure(setCalcType), deferred :: setCalcType end type mgIMCDatabase @@ -44,6 +46,21 @@ function getEmittedRad(self, matIdx) result(energy) real(defReal) :: energy end function getEmittedRad + !! + !! Return material energy + !! + !! Args: + !! matIdx [in] [optional] -> If provided, return the energy of only matIdx + !! Otherwise, return total energy of all mats + !! + function getMaterialEnergy(self, matIdx) result(energy) + import :: mgIMCDatabase, shortInt, defReal + class(mgIMCDatabase), intent(in) :: self + integer(shortInt), intent(in), optional :: matIdx + real(defReal) :: energy + end function getMaterialEnergy + + !! !! Update material properties based on energy absorbed during the time step !! @@ -63,6 +80,15 @@ subroutine setTimeStep(self, deltaT) real(defReal), intent(in) :: deltaT end subroutine setTimeStep + !! + !! Tell each material if we are using IMC or ISMC + !! + subroutine setCalcType(self, type) + import mgIMCDatabase, shortInt + class(mgIMCDatabase), intent(inout) :: self + integer(shortInt), intent(in) :: type + end subroutine setCalcType + end interface contains diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 0b158d3e0..ffc87d88f 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -48,8 +48,8 @@ module mgIMCMaterial_inter procedure(getFleck), deferred :: getFleck procedure(getEta), deferred :: getEta procedure(getTemp), deferred :: getTemp - procedure(getEnergyDens), deferred :: getEnergyDens - procedure(setType), deferred :: setType + procedure(getMatEnergy), deferred :: getMatEnergy + procedure(setCalcType), deferred :: setCalcType procedure(setTimeStep), deferred :: setTimeStep end type mgIMCMaterial @@ -150,13 +150,13 @@ function getTemp(self) result(T) end function getTemp !! - !! Return energy per unit volume of material + !! Return material energy !! - function getEnergyDens(self) result(energyDens) + function getMatEnergy(self) result(energy) import :: mgIMCMaterial, defReal class(mgIMCMaterial), intent(inout) :: self - real(defReal) :: energyDens - end function getEnergyDens + real(defReal) :: energy + end function getMatEnergy !! !! Set the calculation type to be used @@ -168,11 +168,11 @@ end function getEnergyDens !! Errors: !! Unrecognised option !! - subroutine setType(self, calcType) + subroutine setCalcType(self, calcType) import :: mgIMCMaterial, shortInt class(mgIMCMaterial), intent(inout) :: self integer(shortInt), intent(in) :: calcType - end subroutine setType + end subroutine setCalcType !! !! Provide material with time step size diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/IMCSource_class.f90 index 0cd06b95c..94314cd8d 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/IMCSource_class.f90 @@ -7,7 +7,7 @@ module IMCSource_class use dictionary_class, only : dictionary use RNG_class, only : RNG - use particle_class, only : particle, particleState, P_PHOTON + use particle_class, only : particle, particleState, P_PHOTON, P_MATERIAL use particleDungeon_class, only : particleDungeon use source_inter, only : source, kill_super => kill @@ -22,7 +22,10 @@ module IMCSource_class implicit none private + ! Position sampling method integer(shortInt), parameter :: REJ = 1, FAST = 2 + ! Calculation type + integer(shortInt), parameter :: IMC = 1, ISMC = 2 !! !! IMC Source for uniform generation of photons within a material @@ -51,6 +54,7 @@ module IMCSource_class integer(shortInt) :: G = 0 real(defReal), dimension(6) :: bounds = ZERO integer(shortInt) :: method = REJ + integer(shortInt) :: calcType = IMC contains procedure :: init procedure :: append @@ -71,7 +75,7 @@ subroutine init(self, dict, geom) class(imcSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom - character(nameLen) :: method + character(nameLen) :: method, calcType character(100), parameter :: Here = 'init (imcSource_class.f90)' call dict % getOrDefault(self % G, 'G', 1) @@ -98,6 +102,17 @@ subroutine init(self, dict, geom) call fatalError(Here, 'Unrecognised method. Should be "rejection" or "fast"') end select + ! Select calculation type + call dict % getOrDefault(calcType, 'calcType', 'IMC') + select case(calcType) + case('IMC') + self % calcType = IMC + case('ISMC') + self % calcType = ISMC + case default + call fatalError(Here, 'Unrecognised calculation type. Should be "IMC" or "ISMC"') + end select + end subroutine init @@ -131,13 +146,21 @@ subroutine append(self, dungeon, N, rand) if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') ! Obtain total energy - totalEnergy = nucData % getEmittedRad() + if (self % calcType == IMC) then + totalEnergy = nucData % getEmittedRad() + else + totalEnergy = nucData % getMaterialEnergy() + end if ! Loop through materials do matIdx = 1, mm_nMat() ! Get energy to be emitted from material matIdx - energy = nucData % getEmittedRad(matIdx) + if (self % calcType == IMC) then + energy = nucData % getEmittedRad(matIdx) + else + energy = nucData % getMaterialEnergy(matIdx) + end if ! Choose particle numbers in proportion to material energy if (energy > ZERO) then @@ -250,13 +273,19 @@ function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) p % matIdx = matIdx p % uniqueID = uniqueID p % time = ZERO - p % type = P_PHOTON p % r = r p % dir = dir p % G = self % G p % isMG = .true. p % wgt = energy + ! Set particle type + if (self % calcType == IMC) then + p % type = P_PHOTON + else + p % type = P_MATERIAL + end if + end function sampleIMC diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 3effead8e..5fe6d1068 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -25,6 +25,7 @@ module ISMCPhysicsPackage_class use geometry_inter, only : geometry use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & gr_geomIdx => geomIdx + use discretiseGeom_class, only : discretise ! Nuclear Data use materialMenu_mod, only : mm_nMat => nMat ,& @@ -36,8 +37,8 @@ module ISMCPhysicsPackage_class ndReg_get => get ,& ndReg_getMatNames => getMatNames use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast - use mgIMCMaterial_inter, only : mgIMCMaterial ! Operators use collisionOperator_class, only : collisionOperator @@ -57,16 +58,15 @@ module ISMCPhysicsPackage_class private - integer(shortInt), parameter :: IMC = 1, ISMC = 2 - !! - !! Physics Package for ISMC calculations + !! Physics Package for IMC calculations !! type, public,extends(physicsPackage) :: ISMCPhysicsPackage private ! Building blocks - class(nuclearDatabase), pointer :: nucData => null() - class(geometry), pointer :: geom => null() +! class(nuclearDatabase), pointer :: nucData => null() + class(mgIMCDatabase), pointer :: nucData => null() + class(geometry), pointer :: geom => null() integer(shortInt) :: geomIdx = 0 type(collisionOperator) :: collOp class(transportOperator), allocatable :: transOp @@ -83,21 +83,16 @@ module ISMCPhysicsPackage_class character(nameLen) :: outputFormat integer(shortInt) :: printSource = 0 integer(shortInt) :: particleType - integer(shortInt) :: imcSourceN logical(defBool) :: sourceGiven = .false. integer(shortInt) :: nMat - integer(shortint) :: printUpdates + integer(shortInt) :: printUpdates ! Calculation components type(particleDungeon), pointer :: thisStep => null() type(particleDungeon), pointer :: nextStep => null() type(particleDungeon), pointer :: temp_dungeon => null() - type(particleDungeon), allocatable :: matPhotons - ! Note that other physics packages used pointers for these particleDungeons ( => null() ) - ! I found it easier to get 'allocatable' to work, unsure if this needs to be changed class(source), allocatable :: inputSource - class(source), allocatable :: ISMCSource - integer(shortInt), dimension(:,:), pointer :: emptyArray => null() + class(source), allocatable :: IMCSource ! Timer bins integer(shortInt) :: timerMain @@ -120,13 +115,13 @@ subroutine run(self) class(ISMCPhysicsPackage), intent(inout) :: self print *, repeat("<>",50) - print *, "/\/\ ISMC CALCULATION /\/\" + print *, "/\/\ IMC CALCULATION /\/\" call self % steps(self % tally, self % imcWeightAtch, self % N_steps) call self % collectResults() print * - print *, "\/\/ END OF ISMC CALCULATION \/\/" + print *, "\/\/ END OF IMC CALCULATION \/\/" print * end subroutine @@ -138,43 +133,37 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_steps - integer(shortInt) :: i, j, matIdx - integer(shortInt), dimension(:), allocatable :: Nm, Np - type(particle) :: p + integer(shortInt) :: i, j, N, num, nParticles + type(particle), save :: p real(defReal) :: elapsed_T, end_T, T_toEnd real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='steps (ISMCPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes + type(collisionOperator), save :: collOp + class(transportOperator), allocatable, save :: transOp + type(RNG), target, save :: pRNG + !$omp threadprivate(p, collOp, transOp, pRNG) - ! Attach nuclear data and RNG to particle - p % pRNG => self % pRNG + !$omp parallel p % geomIdx = self % geomIdx + ! Create a collision + transport operator which can be made thread private + collOp = self % collOp + transOp = self % transOp + + !$omp end parallel + ! Reset and start timer call timerReset(self % timerMain) call timerStart(self % timerMain) allocate(tallyEnergy(self % nMat)) - ! Generate initial material photons - call self % ISMCSource % generate(self % nextStep, self % pop, p % pRNG) - - open(unit = 10, file = 'temps.txt') - open(unit = 11, file = 'pops.txt') - - allocate(Nm(self % nMat)) - allocate(Np(self % nMat)) - - ! Build connections between materials - call self % transOp % buildMajMap(p % pRNG, self % nucData) - do i=1,N_steps - write(10, '(8A)') numToChar(i) - - Nm = 0 - Np = 0 + ! Update tracking grid if needed by transport operator + if (associated(self % transOp % grid)) call self % transOp % grid % update() ! Swap dungeons to store photons remaining from previous time step self % temp_dungeon => self % nextStep @@ -182,43 +171,51 @@ subroutine steps(self, tally, tallyAtch, N_steps) self % thisStep => self % temp_dungeon call self % nextStep % cleanPop() - ! Generate from input source - if( self % sourceGiven ) then - - ! Limit number of particles in each zone - call self % thisStep % reduceSize(self % limit, self % emptyArray) + ! Select total number of particles to generate from material emission + N = self % pop + if (N + self % thisStep % popSize() > self % limit) then + ! Fleck and Cummings IMC Paper, eqn 4.11 + N = self % limit - self % thisStep % popSize() - self % nMat - 1 + end if - ! Generate new particles - call self % inputSource % append(self % thisStep, 0, p % pRNG) + ! Add to dungeon particles emitted from material + call self % IMCSource % append(self % thisStep, N, self % pRNG) + ! Generate from input source + if( self % sourceGiven ) then + call self % inputSource % append(self % thisStep, 0, self % pRNG) end if - !if(self % printSource == 1) then - ! call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) - !end if + if(self % printSource == 1) then + call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + end if call tally % reportCycleStart(self % thisStep) - ! Update majorants for transport operator - call self % transOp % updateMajorants(p % pRNG) + nParticles = self % thisStep % popSize() + + !$omp parallel do schedule(dynamic) + gen: do num = 1, nParticles - ! Assign new maximum particle time - p % timeMax = self % deltaT * i + ! Create RNG which can be thread private + pRNG = self % pRNG + p % pRNG => pRNG + call p % pRNG % stride(num) - gen: do ! Obtain paticle from dungeon call self % thisStep % release(p) call self % geom % placeCoord(p % coords) ! Check particle type - if (p % getType() /= P_PHOTON_MG .and. p % getType() /= P_MATERIAL_MG) then - call fatalError(Here, 'Particle is not of type P_PHOTON_MG or P_MATERIAL_MG') + if (p % getType() /= P_PHOTON_MG) then + call fatalError(Here, 'Particle is not of type P_PHOTON_MG') end if + ! Assign maximum particle time + p % timeMax = self % deltaT * i + ! For newly sourced particles, sample time uniformly within time step - if (p % time /= ZERO .and. p % time /= self % deltaT*(i-1)) then - call fatalError(Here, 'Particle released from dungeon has incorrect time') - else if (p % time == ZERO) then + if (p % time == ZERO) then p % time = (p % pRNG % get() + i-1) * self % deltaT end if @@ -234,45 +231,29 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Transport particle until its death history: do + call transOp % transport(p, tally, self % thisStep, self % nextStep) + if(p % isDead) exit history - call self % transOp % transport(p, tally, self % thisStep, self % nextStep) - if(p % fate == LEAK_FATE) exit history - if(p % fate == AGED_FATE) then - if(p % type == P_PHOTON) then - matIdx = p % matIdx() - Np(matIdx) = Np(matIdx) + 1 - else if( p % type == P_MATERIAL ) then - matIdx = p % matIdx() - Nm(matIdx) = Nm(matIdx) + 1 - else - call fatalError(Here, 'Incorrect type') - end if ! Store particle for use in next time step p % fate = 0 call self % nextStep % detain(p) exit history end if - if (p % type == P_MATERIAL) then - call fatalError(Here, 'Material particle should not undergo collision') - end if - - call self % collOp % collide(p, tally, self % thisStep, self % nextStep) + call collOp % collide(p, tally, self % thisStep, self % nextStep) - if(p % isDead) call fatalError(Here, 'Particle should not be dead, check that collision & - &operator is of type "ISMCMGstd"') + if(p % isDead) exit history end do history - ! When dungeon is empty, exit - if( self % thisStep % isEmpty() ) then - exit gen - end if - end do gen + !$omp end parallel do + + ! Update RNG + call self % pRNG % stride(nParticles) - ! Send end of cycle report + ! Send end of time step report call tally % reportCycleEnd(self % thisStep) ! Calculate times @@ -307,30 +288,20 @@ subroutine steps(self, tally, tallyAtch, N_steps) end select ! Update material properties - do j = 1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - if (j <= self % printUpdates) then - print * - print *, "Material update: ", mm_matName(j) - call mat % updateMat(tallyEnergy(j), .true.) - else - call mat % updateMat(tallyEnergy(j), .false.) - end if - end do - print * + call self % nucData % updateProperties(tallyEnergy, self % printUpdates) - ! Reset tally for next cycle + ! Reset tally for next time step call tallyAtch % reset('imcWeightTally') - print *, 'Completed: ', numToChar(i), ' of ', numToChar(N_steps) - - write(11, '(8A)') 'M ', numToChar(Nm) - write(11, '(8A)') 'P ', numToChar(Np) - end do + ! Output final mat temperatures + open(unit = 10, file = 'temps.txt') + do j = 1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + write(10, '(8A)') mm_matName(j), numToChar(mat % getTemp()) + end do close(10) - close(11) end subroutine steps @@ -372,10 +343,10 @@ end subroutine collectResults !! Initialise from individual components and dictionaries for source and tally !! subroutine init(self, dict) - class(ISMCPhysicsPackage), intent(inout) :: self + class(ISMCPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict - class(dictionary),pointer :: tempDict - type(dictionary) :: locDict1, locDict2, locDict3, locDict4, locDict5 + class(dictionary), pointer :: tempDict, geomDict, dataDict + type(dictionary) :: locDict1, locDict2, locDict3, locDict4 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -385,16 +356,18 @@ subroutine init(self, dict) type(outputFile) :: test_out integer(shortInt) :: i character(nameLen), dimension(:), allocatable :: mats - class(IMCMaterial), pointer :: mat + integer(shortInt), dimension(:), allocatable :: latSizeN + type(dictionary),target :: newGeom, newData + integer(shortInt), parameter :: ISMC = 2 character(100), parameter :: Here ='init (ISMCPhysicsPackage_class.f90)' call cpu_time(self % CPU_time_start) ! Read calculation settings - call dict % get( self % pop,'pop') - call dict % getOrDefault( self % limit, 'limit', self % pop) - call dict % get( self % N_steps,'steps') - call dict % get( self % deltaT,'timeStepSize') + call dict % get(self % pop,'pop') + call dict % get(self % limit, 'limit') + call dict % get(self % N_steps,'steps') + call dict % get(self % deltaT,'timeStepSize') call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) self % particleType = P_PHOTON_MG nucData = 'mg' @@ -428,24 +401,57 @@ subroutine init(self, dict) seed = seed_temp call self % pRNG % init(seed) - ! Read whether to print particle source per cycle + ! Read whether to print particle source each time step call dict % getOrDefault(self % printSource, 'printSource', 0) - ! Build Nuclear Data - call ndReg_init(dict % getDictPtr("nuclearData")) + ! Automatically split geometry into a uniform grid + if (dict % isPresent('discretise')) then + + ! Store dimensions of lattice + tempDict => dict % getDictPtr('discretise') + call tempDict % get(latSizeN, 'dimensions') + + ! Create new input + call discretise(dict, newGeom, newData) + + geomDict => newGeom + dataDict => newData + + else + geomDict => dict % getDictPtr("geometry") + dataDict => dict % getDictPtr("nuclearData") + + end if + + ! Build Nuclear Data + call ndReg_init(dataDict) ! Build geometry - tempDict => dict % getDictPtr('geometry') - geomName = 'ISMCGeom' - call gr_addGeom(geomName, tempDict) + geomName = 'IMCGeom' + call gr_addGeom(geomName, geomDict) 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()) - self % nucData => ndReg_get(self % particleType) + self % nucData => mgIMCDatabase_CptrCast(ndReg_get(self % particleType)) - ! Read particle source definition + call newGeom % kill() + call newData % kill() + + ! Initialise ISMC source + if (dict % isPresent('matSource')) then + tempDict => dict % getDictPtr('matSource') + call new_source(self % IMCSource, tempDict, self % geom) + else + call locDict1 % init(2) + call locDict1 % store('type', 'imcSource') + call locDict1 % store('calcType', 'ISMC') + call new_source(self % IMCSource, locDict1, self % geom) + call locDict1 % kill() + end if + + ! Read external particle source definition if( dict % isPresent('source') ) then tempDict => dict % getDictPtr('source') call tempDict % store('deltaT', self % deltaT) @@ -453,19 +459,12 @@ subroutine init(self, dict) self % sourceGiven = .true. end if - ! Initialise ISMC source - call locDict1 % init(2) - call locDict1 % store('type', 'ismcSource') - call locDict1 % store('N', self % pop) - call new_source(self % ISMCSource, locDict1, self % geom) - ! Build collision operator tempDict => dict % getDictPtr('collisionOperator') call self % collOp % init(tempDict) ! Build transport operator tempDict => dict % getDictPtr('transportOperator') - call tempDict % store('deltaT', self % deltaT) call new_transportOperator(self % transOp, tempDict) ! Initialise tally Admin @@ -473,8 +472,13 @@ subroutine init(self, dict) allocate(self % tally) call self % tally % init(tempDict) + ! Provide materials with calculation type and time step + call self % nucData % setCalcType(ISMC) + call self % nucData % setTimeStep(self % deltaT) + ! Store number of materials self % nMat = mm_nMat() + self % printUpdates = min(self % printUpdates, self % nMat) ! Create array of material names allocate(mats(self % nMat)) @@ -482,40 +486,31 @@ subroutine init(self, dict) mats(i) = mm_matName(i) end do - ! Set calculation type for material objects and provide time step - do i=1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(i)) - call mat % setType(ISMC) - call mat % setTimeStep(self % deltaT) - end do - ! Initialise imcWeight tally attachment - call locDict2 % init(1) - call locDict3 % init(4) - call locDict4 % init(2) - call locDict5 % init(1) - - call locDict5 % store('type', 'weightResponse') - call locDict4 % store('type','materialMap') - call locDict4 % store('materials', [mats]) - call locDict3 % store('response', ['imcWeightResponse']) - call locDict3 % store('imcWeightResponse', locDict5) - call locDict3 % store('type','absorptionClerk') - call locDict3 % store('map', locDict4) - call locDict2 % store('imcWeightTally', locDict3) + call locDict1 % init(1) + call locDict2 % init(4) + call locDict3 % init(2) + call locDict4 % init(1) + + call locDict4 % store('type', 'weightResponse') + call locDict3 % store('type','materialMap') + call locDict3 % store('materials', [mats]) + call locDict2 % store('response', ['imcWeightResponse']) + call locDict2 % store('imcWeightResponse', locDict4) + call locDict2 % store('type','absorptionClerk') + call locDict2 % store('map', locDict3) + call locDict1 % store('imcWeightTally', locDict2) allocate(self % imcWeightAtch) - call self % imcWeightAtch % init(locDict2) + call self % imcWeightAtch % init(locDict1) call self % tally % push(self % imcWeightAtch) - ! Size particle dungeon + ! Size particle dungeons allocate(self % thisStep) - call self % thisStep % init(self % limit * self % nMat *2) + call self % thisStep % init(self % limit) allocate(self % nextStep) - call self % nextStep % init(self % limit * self % nMat *2) - - allocate(self % emptyArray(3, self % limit * self % nMat * 2)) + call self % nextStep % init(self % limit) call self % printSettings() @@ -538,7 +533,7 @@ subroutine printSettings(self) class(ISMCPhysicsPackage), intent(in) :: self print *, repeat("<>",50) - print *, "/\/\ ISMC CALCULATION /\/\" + print *, "/\/\ IMC CALCULATION /\/\" print *, "Source batches: ", numToChar(self % N_steps) print *, "Population per batch: ", numToChar(self % pop) print *, "Initial RNG Seed: ", numToChar(self % pRNG % getSeed()) @@ -546,5 +541,4 @@ subroutine printSettings(self) print *, repeat("<>",50) end subroutine printSettings - end module ISMCPhysicsPackage_class From 19a284cff181f410a95d01a89c9656f64763ec5e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 26 May 2023 17:55:31 +0100 Subject: [PATCH 335/373] ISMC now working correctly --- NuclearData/IMCMaterial_inter.f90 | 12 ++++ .../baseMgIMC/baseMgIMCDatabase_class.f90 | 16 ++++++ .../baseMgIMC/baseMgIMCMaterial_class.f90 | 28 +++++++++- NuclearData/mgIMCData/mgIMCDatabase_inter.f90 | 20 ++++++- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 11 ++++ PhysicsPackages/ISMCPhysicsPackage_class.f90 | 31 +++++----- .../transportOperatorTimeHT_class.f90 | 56 ++++++++++++++++++- 7 files changed, 148 insertions(+), 26 deletions(-) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index edadeb7c5..63ed7bf21 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -39,6 +39,7 @@ module IMCMaterial_inter procedure(getMatEnergy), deferred :: getMatEnergy procedure(setCalcType), deferred :: setCalcType procedure(setTimeStep), deferred :: setTimeStep + procedure(sampleTransformTime), deferred :: sampleTransformTime end type IMCMaterial abstract interface @@ -152,6 +153,17 @@ subroutine setTimeStep(self, dt) real(defReal), intent(in) :: dt end subroutine setTimeStep + !! + !! Sample the time taken for a material particle to transform into a photon + !! Used for ISMC only + !! + function sampleTransformTime(self, rand) result(t) + import :: IMCMaterial, RNG, defReal + class(IMCMaterial), intent(inout) :: self + class(RNG), intent(inout) :: rand + real(defReal) :: t + end function sampleTransformTime + end interface contains diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 3c949d2b8..f4db3dcdf 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -8,6 +8,7 @@ module baseMgIMCDatabase_class use charMap_class, only : charMap use dictionary_class, only : dictionary use dictParser_func, only : fileToDict + use RNG_class, only : RNG ! Nuclear Data Interfaces use nuclearDatabase_inter, only : nuclearDatabase @@ -62,6 +63,7 @@ module baseMgIMCDatabase_class procedure :: updateProperties procedure :: setTimeStep procedure :: setCalcType + procedure :: sampleTransformTime procedure :: kill procedure :: init procedure :: activate @@ -317,6 +319,20 @@ subroutine setCalcType(self, type) end subroutine setCalcType + !! + !! Sample the time taken for a material particle to transform into a photon + !! Used for ISMC only + !! + function sampleTransformTime(self, matIdx, rand) result(t) + class(baseMgIMCDatabase), intent(inout) :: self + integer(shortInt), intent(in) :: matIdx + class(RNG), intent(inout) :: rand + real(defReal) :: t + + t = self % mats(matIdx) % sampleTransformTime(rand) + + end function sampleTransformTime + !! !! Return to uninitialised state !! diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index c028160d3..2de1c411d 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -95,6 +95,7 @@ module baseMgIMCMaterial_class procedure :: getMatEnergy procedure :: setCalcType procedure :: setTimeStep + procedure :: sampleTransformTime procedure, private :: tempFromEnergy procedure, private :: sigmaFromTemp @@ -117,19 +118,22 @@ subroutine updateMat(self, tallyEnergy, printUpdate) class(baseMgIMCMaterial),intent(inout) :: self real(defReal), intent(in) :: tallyEnergy logical(defBool), intent(in), optional :: printUpdate + real(defReal) :: previous character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" ! TODO: Print updates if requested - ! Return if no energy change - if (self % getEmittedRad() == tallyEnergy) return - + previous = self % matEnergy ! Update material internal energy if (self % calcType == IMC) then self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy else self % matEnergy = tallyEnergy end if + + ! Return if no change + if (self % matEnergy == previous) return + self % energyDens = self % matEnergy / self % V ! Update material temperature @@ -500,4 +504,22 @@ subroutine setCalcType(self, calcType) end subroutine setCalcType + !! + !! Sample the time taken for a material particle to transform into a photon + !! Used for ISMC only + !! + function sampleTransformTime(self, rand) result(t) + class(baseMgIMCMaterial), intent(inout) :: self + class(RNG), intent(inout) :: rand + real(defReal) :: t + integer(shortInt) :: G + + G = 1 + + t = -log(rand % get()) / (self % data(CAPTURE_XS,G) * self % fleck * self % eta * lightSpeed) + + ! TODO: consider implications when T = 0 (=> eta = 0) + + end function sampleTransformTime + end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 index 47d9cd7ce..42d8c008f 100644 --- a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 @@ -1,6 +1,7 @@ module mgIMCDatabase_inter use numPrecision + use RNG_class, only : RNG ! Nuclear Data Interfaces & Objects use nuclearDatabase_inter, only : nuclearDatabase @@ -27,6 +28,7 @@ module mgIMCDatabase_inter procedure(updateProperties), deferred :: updateProperties procedure(setTimeStep), deferred :: setTimeStep procedure(setCalcType), deferred :: setCalcType + procedure(sampleTransformTime), deferred :: sampleTransformTime end type mgIMCDatabase @@ -65,7 +67,7 @@ end function getMaterialEnergy !! Update material properties based on energy absorbed during the time step !! subroutine updateProperties(self, tallyEnergy, printUpdates) - import mgIMCDatabase, defReal, shortInt + import :: mgIMCDatabase, defReal, shortInt class(mgIMCDatabase), intent(inout) :: self real(defReal), dimension(:), intent(in) :: tallyEnergy integer(shortInt), intent(in) :: printUpdates @@ -75,7 +77,7 @@ end subroutine updateProperties !! Provide each material with time step to calculate initial fleck factor !! subroutine setTimeStep(self, deltaT) - import mgIMCDatabase, defReal + import :: mgIMCDatabase, defReal class(mgIMCDatabase), intent(inout) :: self real(defReal), intent(in) :: deltaT end subroutine setTimeStep @@ -84,11 +86,23 @@ end subroutine setTimeStep !! Tell each material if we are using IMC or ISMC !! subroutine setCalcType(self, type) - import mgIMCDatabase, shortInt + import :: mgIMCDatabase, shortInt class(mgIMCDatabase), intent(inout) :: self integer(shortInt), intent(in) :: type end subroutine setCalcType + !! + !! Sample the time taken for a material particle to transform into a photon + !! Used for ISMC only + !! + function sampleTransformTime(self, matIdx, rand) result(t) + import :: mgIMCDatabase, shortInt, RNG, defReal + class(mgIMCDatabase), intent(inout) :: self + integer(shortInt), intent(in) :: matIdx + class(RNG), intent(inout) :: rand + real(defReal) :: t + end function sampleTransformTime + end interface contains diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index ffc87d88f..f8c90805f 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -51,6 +51,7 @@ module mgIMCMaterial_inter procedure(getMatEnergy), deferred :: getMatEnergy procedure(setCalcType), deferred :: setCalcType procedure(setTimeStep), deferred :: setTimeStep + procedure(sampleTransformTime), deferred :: sampleTransformTime end type mgIMCMaterial @@ -186,6 +187,16 @@ subroutine setTimeStep(self, dt) real(defReal), intent(in) :: dt end subroutine setTimeStep + !! + !! Sample the time taken for a material particle to transform into a photon + !! Used for ISMC only + !! + function sampleTransformTime(self, rand) result(t) + import :: mgIMCMaterial, RNG, defReal + class(mgIMCMaterial), intent(inout) :: self + class(RNG), intent(inout) :: rand + real(defReal) :: t + end function sampleTransformTime end interface diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 5fe6d1068..042437632 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -160,27 +160,14 @@ subroutine steps(self, tally, tallyAtch, N_steps) allocate(tallyEnergy(self % nMat)) + ! Generate initial population of material particles + call self % IMCSource % append(self % thisStep, self % pop, self % pRNG) + do i=1,N_steps ! Update tracking grid if needed by transport operator if (associated(self % transOp % grid)) call self % transOp % grid % update() - ! Swap dungeons to store photons remaining from previous time step - self % temp_dungeon => self % nextStep - self % nextStep => self % thisStep - self % thisStep => self % temp_dungeon - call self % nextStep % cleanPop() - - ! Select total number of particles to generate from material emission - N = self % pop - if (N + self % thisStep % popSize() > self % limit) then - ! Fleck and Cummings IMC Paper, eqn 4.11 - N = self % limit - self % thisStep % popSize() - self % nMat - 1 - end if - - ! Add to dungeon particles emitted from material - call self % IMCSource % append(self % thisStep, N, self % pRNG) - ! Generate from input source if( self % sourceGiven ) then call self % inputSource % append(self % thisStep, 0, self % pRNG) @@ -207,8 +194,8 @@ subroutine steps(self, tally, tallyAtch, N_steps) call self % geom % placeCoord(p % coords) ! Check particle type - if (p % getType() /= P_PHOTON_MG) then - call fatalError(Here, 'Particle is not of type P_PHOTON_MG') + if (p % getType() /= P_PHOTON_MG .and. p % getType() /= P_MATERIAL_MG) then + call fatalError(Here, 'Particle is not of type P_PHOTON_MG or P_MATERIAL_MG') end if ! Assign maximum particle time @@ -231,6 +218,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Transport particle until its death history: do + call transOp % transport(p, tally, self % thisStep, self % nextStep) if(p % isDead) exit history @@ -293,6 +281,12 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Reset tally for next time step call tallyAtch % reset('imcWeightTally') + ! Swap dungeons in preparation for next time step + self % temp_dungeon => self % nextStep + self % nextStep => self % thisStep + self % thisStep => self % temp_dungeon + call self % nextStep % cleanPop() + end do ! Output final mat temperatures @@ -442,6 +436,7 @@ subroutine init(self, dict) ! Initialise ISMC source if (dict % isPresent('matSource')) then tempDict => dict % getDictPtr('matSource') + call tempDict % store('calcType', 'ISMC') call new_source(self % IMCSource, tempDict, self % geom) else call locDict1 % init(2) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index d96ee6e66..c5533fc62 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -6,7 +6,7 @@ module transportOperatorTimeHT_class use universalVariables use genericProcedures, only : fatalError, numToChar - use particle_class, only : particle, P_PHOTON + use particle_class, only : particle, P_PHOTON, P_MATERIAL use particleDungeon_class, only : particleDungeon use dictionary_class, only : dictionary use rng_class, only : rng @@ -23,6 +23,7 @@ module transportOperatorTimeHT_class ! Nuclear data interfaces use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast implicit none private @@ -48,6 +49,7 @@ module transportOperatorTimeHT_class procedure, private :: surfaceTracking procedure, private :: deltaTracking procedure, private :: getMajInv + procedure, private :: materialTransform end type transportOperatorTimeHT contains @@ -61,6 +63,13 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) real(defReal) :: sigmaT character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' + ! Transform material particles into photons + if (p % type == P_MATERIAL) then + call self % materialTransform(p, tally) + ! Exit at time boundary + if (p % fate == AGED_FATE) return + end if + ! Select action based on specified method - HT and GT start with DT but can switch to ST if (self % method == ST) then call self % surfaceTracking(p) @@ -121,7 +130,7 @@ subroutine surfaceTracking(self, p) else if (dist == dColl) then ! Collision, increase time accordingly if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV & - &after moving dTime') + &after moving dColl') exit STLoop end if @@ -231,6 +240,49 @@ function getMajInv(self, p) result (maj_inv) end function getMajInv + !! + !! Determine when a material particle will transform into a photon for ISMC calculations + !! + !! Args: + !! p [inout] -> material particle to be transformed + !! tally [inout] -> tally to keep track of material particles surviving time step + !! + subroutine materialTransform(self, p, tally) + class(transportOperatorTimeHT), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + real(defReal) :: transformTime, mu, phi + real(defReal), dimension(3) :: dir + class(mgIMCDatabase), pointer :: nucData + character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' + + nucData => mgIMCDatabase_CptrCast(self % xsData) + if (.not. associated(nucData)) call fatalError(Here, 'Unable to find mgIMCDatabase') + + ! Sample time until emission + transformTime = nucData % sampleTransformTime(p % matIdx(), p % pRNG) + p % time = min(p % timeMax, p % time + transformTime) + + ! Exit loop if particle remains material until end of time step + if (p % time == p % timeMax) then + p % fate = AGED_FATE + ! Tally energy for next temperature calculation + call tally % reportHist(p) + + ! Transform into photon + else + p % type = P_PHOTON + ! Resample direction + mu = 2 * p % pRNG % get() - 1 + phi = p % pRNG % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + call p % point(dir) + end if + + end subroutine materialTransform + !! !! Provide transport operator with delta tracking/surface tracking cutoff !! From 61fe3cc716dd6a74e5320cf97300c777c304f1c1 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 27 May 2023 12:51:19 +0100 Subject: [PATCH 336/373] Renamed IMCSource to materialSource --- ParticleObjects/Source/CMakeLists.txt | 2 +- ...rce_class.f90 => materialSource_class.f90} | 43 +++++++++---------- ParticleObjects/Source/sourceFactory_func.f90 | 8 ++-- PhysicsPackages/IMCPhysicsPackage_class.f90 | 10 ++--- PhysicsPackages/ISMCPhysicsPackage_class.f90 | 10 ++--- 5 files changed, 35 insertions(+), 38 deletions(-) rename ParticleObjects/Source/{IMCSource_class.f90 => materialSource_class.f90} (92%) diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index ed45cafaa..80bfa37b5 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -4,7 +4,7 @@ add_sources( source_inter.f90 sourceFactory_func.f90 pointSource_class.f90 fissionSource_class.f90 - IMCSource_class.f90 + materialSource_class.f90 ISMCSource_class.f90 bbSurfaceSource_class.f90 ) diff --git a/ParticleObjects/Source/IMCSource_class.f90 b/ParticleObjects/Source/materialSource_class.f90 similarity index 92% rename from ParticleObjects/Source/IMCSource_class.f90 rename to ParticleObjects/Source/materialSource_class.f90 index 94314cd8d..9d6470668 100644 --- a/ParticleObjects/Source/IMCSource_class.f90 +++ b/ParticleObjects/Source/materialSource_class.f90 @@ -1,4 +1,4 @@ -module IMCSource_class +module materialSource_class use numPrecision use endfConstants @@ -42,9 +42,9 @@ module IMCSource_class !! source_inter Interface !! !! SAMPLE INPUT: - !! imcSource { type IMCSource; } + !! matSource { type materialSource; calcType IMC; method fast; } !! - type, public,extends(source) :: imcSource + type, public,extends(source) :: materialSource private logical(defBool) :: isMG = .true. real(defReal), dimension(3) :: bottom = ZERO @@ -52,6 +52,7 @@ module IMCSource_class real(defReal), dimension(3) :: latPitch = ZERO integer(shortInt), dimension(3) :: latSizeN = 0 integer(shortInt) :: G = 0 + integer(shortInt) :: pType = P_PHOTON real(defReal), dimension(6) :: bounds = ZERO integer(shortInt) :: method = REJ integer(shortInt) :: calcType = IMC @@ -62,7 +63,7 @@ module IMCSource_class procedure, private :: sampleIMC procedure, private :: getMatBounds procedure :: kill - end type imcSource + end type materialSource contains @@ -72,11 +73,11 @@ module IMCSource_class !! See source_inter for details !! subroutine init(self, dict, geom) - class(imcSource), intent(inout) :: self + class(materialSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom character(nameLen) :: method, calcType - character(100), parameter :: Here = 'init (imcSource_class.f90)' + character(100), parameter :: Here = 'init (materialSource_class.f90)' call dict % getOrDefault(self % G, 'G', 1) @@ -107,8 +108,10 @@ subroutine init(self, dict, geom) select case(calcType) case('IMC') self % calcType = IMC + self % pType = P_PHOTON case('ISMC') self % calcType = ISMC + self % pType = P_MATERIAL case default call fatalError(Here, 'Unrecognised calculation type. Should be "IMC" or "ISMC"') end select @@ -130,7 +133,7 @@ end subroutine init !! already present in dungeon !! subroutine append(self, dungeon, N, rand) - class(imcSource), intent(inout) :: self + class(materialSource), intent(inout) :: self type(particleDungeon), intent(inout) :: dungeon integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand @@ -139,7 +142,7 @@ subroutine append(self, dungeon, N, rand) real(defReal) :: energy, totalEnergy type(RNG) :: pRand class(mgIMCDatabase), pointer :: nucData - character(100), parameter :: Here = "append (IMCSource_class.f90)" + character(100), parameter :: Here = "append (materialSource_class.f90)" ! Get pointer to appropriate nuclear database nucData => ndReg_getIMCMG() @@ -201,10 +204,10 @@ end subroutine append !! See source_inter for details !! function sampleParticle(self, rand) result(p) - class(imcSource), intent(inout) :: self + class(materialSource), intent(inout) :: self class(RNG), intent(inout) :: rand type(particleState) :: p - character(100), parameter :: Here = 'sampleParticle (IMCSource_class.f90)' + character(100), parameter :: Here = 'sampleParticle (materialSource_class.f90)' ! Should not be called, useful to have extra inputs so use sampleIMC instead call fatalError(Here, 'Should not be called, sampleIMC should be used instead.') @@ -226,7 +229,7 @@ end function sampleParticle !! rejection sampling method, and bounds of single material if using fast !! function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) - class(imcSource), intent(inout) :: self + class(materialSource), intent(inout) :: self class(RNG), intent(inout) :: rand integer(shortInt), intent(in) :: targetMatIdx real(defReal), intent(in) :: energy @@ -235,7 +238,7 @@ function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) real(defReal), dimension(3) :: bottom, top, r, dir, rand3 real(defReal) :: mu, phi integer(shortInt) :: i, matIdx, uniqueID - character(100), parameter :: Here = 'sampleIMC (IMCSource_class.f90)' + character(100), parameter :: Here = 'sampleIMC (materialSource_class.f90)' ! Sample particle position bottom = bounds(1:3) @@ -278,13 +281,7 @@ function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) p % G = self % G p % isMG = .true. p % wgt = energy - - ! Set particle type - if (self % calcType == IMC) then - p % type = P_PHOTON - else - p % type = P_MATERIAL - end if + p % type = self % pType end function sampleIMC @@ -303,13 +300,13 @@ end function sampleIMC !! Would be nice to have most of this in a geometry module !! function getMatBounds(self, matIdx) result(matBounds) - class(imcSource), intent(inout) :: self + class(materialSource), intent(inout) :: self integer(shortInt), intent(in) :: matIdx real(defReal), dimension(6) :: matBounds integer(shortInt), dimension(3) :: ijk integer(shortInt) :: i, latIdFlipped character(nameLen) :: matName - character(100), parameter :: Here = 'getMatBounds (imcSourceClass.f90)' + character(100), parameter :: Here = 'getMatBounds (materialSourceClass.f90)' ! Extract lattice position from mat name (e.g. "m106 -> 106") ! This is different from localID in latUniverse_class as is counting from a different @@ -331,7 +328,7 @@ end function getMatBounds !! Return to uninitialised state !! elemental subroutine kill(self) - class(imcSource), intent(inout) :: self + class(materialSource), intent(inout) :: self call kill_super(self) @@ -378,4 +375,4 @@ pure function get_ijk(flippedLocalID, sizeN) result(ijk) end function get_ijk -end module IMCSource_class +end module materialSource_class diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index db8f0a674..c27da12c6 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -10,7 +10,7 @@ module sourceFactory_func ! source implementations use pointSource_class, only : pointSource use fissionSource_class, only : fissionSource - use IMCSource_class, only : imcSource + use materialSource_class, only : materialSource use ISMCSource_class, only : ismcSource use bbSurfaceSource_class, only : bbSurfaceSource @@ -29,7 +29,7 @@ module sourceFactory_func ! For now it is necessary to adjust trailing blanks so all entries have the same length character(nameLen),dimension(*),parameter :: AVAILABLE_sources = [ 'pointSource ',& 'fissionSource ',& - 'imcSource ',& + 'materialSource ',& 'ismcSource ',& 'bbsurfaceSource'] @@ -63,8 +63,8 @@ subroutine new_source(new, dict, geom) allocate(fissionSource :: new) call new % init(dict, geom) - case('imcSource') - allocate(imcSource :: new) + case('materialSource') + allocate(materialSource :: new) call new % init(dict, geom) case('ismcSource') diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index bd68ebd08..d2d972f2e 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -92,7 +92,7 @@ module IMCPhysicsPackage_class type(particleDungeon), pointer :: nextStep => null() type(particleDungeon), pointer :: temp_dungeon => null() class(source), allocatable :: inputSource - class(source), allocatable :: IMCSource + class(source), allocatable :: matSource ! Timer bins integer(shortInt) :: timerMain @@ -179,7 +179,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) end if ! Add to dungeon particles emitted from material - call self % IMCSource % append(self % thisStep, N, self % pRNG) + call self % matSource % append(self % thisStep, N, self % pRNG) ! Generate from input source if( self % sourceGiven ) then @@ -441,11 +441,11 @@ subroutine init(self, dict) ! Initialise IMC source if (dict % isPresent('matSource')) then tempDict => dict % getDictPtr('matSource') - call new_source(self % IMCSource, tempDict, self % geom) + call new_source(self % matSource, tempDict, self % geom) else call locDict1 % init(1) - call locDict1 % store('type', 'imcSource') - call new_source(self % IMCSource, locDict1, self % geom) + call locDict1 % store('type', 'materialSource') + call new_source(self % matSource, locDict1, self % geom) call locDict1 % kill() end if diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 index 042437632..27aac26df 100644 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/ISMCPhysicsPackage_class.f90 @@ -92,7 +92,7 @@ module ISMCPhysicsPackage_class type(particleDungeon), pointer :: nextStep => null() type(particleDungeon), pointer :: temp_dungeon => null() class(source), allocatable :: inputSource - class(source), allocatable :: IMCSource + class(source), allocatable :: matSource ! Timer bins integer(shortInt) :: timerMain @@ -161,7 +161,7 @@ subroutine steps(self, tally, tallyAtch, N_steps) allocate(tallyEnergy(self % nMat)) ! Generate initial population of material particles - call self % IMCSource % append(self % thisStep, self % pop, self % pRNG) + call self % matSource % append(self % thisStep, self % pop, self % pRNG) do i=1,N_steps @@ -437,12 +437,12 @@ subroutine init(self, dict) if (dict % isPresent('matSource')) then tempDict => dict % getDictPtr('matSource') call tempDict % store('calcType', 'ISMC') - call new_source(self % IMCSource, tempDict, self % geom) + call new_source(self % matSource, tempDict, self % geom) else call locDict1 % init(2) - call locDict1 % store('type', 'imcSource') + call locDict1 % store('type', 'materialSource') call locDict1 % store('calcType', 'ISMC') - call new_source(self % IMCSource, locDict1, self % geom) + call new_source(self % matSource, locDict1, self % geom) call locDict1 % kill() end if From 4fe46e8247f9ac586021f60361e6c0fabb83cda6 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 15 Jun 2023 19:21:43 +0100 Subject: [PATCH 337/373] No longer incorrectly places material particles that are close to void boundary --- .../CollisionProcessors/IMCMGstd_class.f90 | 9 +++-- .../transportOperatorTimeHT_class.f90 | 35 ++++++++++++++----- 2 files changed, 33 insertions(+), 11 deletions(-) diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index dc19df993..d2dfd6e0d 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -2,6 +2,7 @@ module IMCMGstd_class use numPrecision use endfConstants + use universalVariables, only : VOID_MAT use genericProcedures, only : fatalError, rotateVector, numToChar use dictionary_class, only : dictionary use RNG_class, only : RNG @@ -104,8 +105,11 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) self % xsData => ndReg_getIMCMG() if(.not.associated(self % xsData)) call fatalError(Here, "Failed to get active database for MG IMC") + ! Confirm that particle is in valid material + if (p % matIdx() == VOID_MAT) call fatalError(Here, 'Collision in void material') + ! Get and verify material pointer - self % mat => mgIMCMaterial_CptrCast( self % xsData % getMaterial( p % matIdx())) + self % mat => mgIMCMaterial_CptrCast(self % xsData % getMaterial(p % matIdx())) if(.not.associated(self % mat)) call fatalError(Here, "Failed to get MG IMC Material") r = p % pRNG % get() @@ -159,8 +163,7 @@ subroutine elastic(self, p , collDat, thisCycle, nextCycle) dir(2) = sqrt(1-mu**2) * cos(phi) dir(3) = sqrt(1-mu**2) * sin(phi) - !p % coords % dir = dir - call p % rotate(mu, phi) + call p % point(dir) end subroutine elastic diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index c5533fc62..7c969a742 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -60,7 +60,6 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) type(tallyAdmin), intent(inout) :: tally class(particleDungeon), intent(inout) :: thisCycle class(particleDungeon), intent(inout) :: nextCycle - real(defReal) :: sigmaT character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' ! Transform material particles into photons @@ -106,6 +105,11 @@ subroutine surfaceTracking(self, p) sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) dColl = -log( p % pRNG % get() ) / sigmaT + ! Ensure particle does not remain exactly on a boundary if dColl is close to 0 + if (event == CROSS_EV .and. dColl < SURF_TOL) then + dColl = SURF_TOL + end if + ! Choose minimum distance dist = min(dTime, dColl) @@ -121,22 +125,22 @@ subroutine surfaceTracking(self, p) ! Check result of transport if (dist == dTime) then ! Time boundary - if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV & - &after moving dTime') p % fate = AGED_FATE p % time = p % timeMax exit STLoop else if (dist == dColl) then - ! Collision, increase time accordingly - if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV & - &after moving dColl') + ! Collision exit STLoop end if + if (event == COLL_EV) call fatalError(Here, 'Move outcome should be CROSS_EV or BOUNDARY_EV') + end do STLoop + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV') + end subroutine surfaceTracking !! @@ -254,13 +258,28 @@ subroutine materialTransform(self, p, tally) real(defReal) :: transformTime, mu, phi real(defReal), dimension(3) :: dir class(mgIMCDatabase), pointer :: nucData - character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' + integer(shortInt) :: matIdx, uniqueID + character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' + ! Get pointer to nuclear database nucData => mgIMCDatabase_CptrCast(self % xsData) if (.not. associated(nucData)) call fatalError(Here, 'Unable to find mgIMCDatabase') + ! Material particles can occasionally have coords placed in void if within SURF_TOL of boundary + matIdx = p % matIdx() + ! If so, get matIdx based on exact position (no adjustment for surface tol) + ! NOTE: Doing this for all particles (not just those placed in void) may in theory give very + ! slight accuracy increase for material-material surface crossings as well, but should + ! be negligible and will increase runtimes by calling whatIsAt for every mat particle. + if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) then + call self % geom % whatIsAt(matIdx, uniqueID, p % coords % lvl(1) % r, [ZERO,ZERO,ZERO]) + end if + ! If still in invalid region, call fatalError + if (matIdx == 0) call fatalError(Here, 'Outside material particle') + if (matIdx == VOID_MAT) call fatalError(Here, 'Void material particle') + ! Sample time until emission - transformTime = nucData % sampleTransformTime(p % matIdx(), p % pRNG) + transformTime = nucData % sampleTransformTime(matIdx, p % pRNG) p % time = min(p % timeMax, p % time + transformTime) ! Exit loop if particle remains material until end of time step From dfdf310f4c4052db7d2d059f9649a861dd1eaae4 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 21 Jun 2023 17:26:18 +0100 Subject: [PATCH 338/373] Deleted ISMC source class as uses more general material class instead --- ParticleObjects/Source/CMakeLists.txt | 1 - ParticleObjects/Source/ISMCSource_class.f90 | 179 ------------------ ParticleObjects/Source/sourceFactory_func.f90 | 6 - 3 files changed, 186 deletions(-) delete mode 100644 ParticleObjects/Source/ISMCSource_class.f90 diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index 80bfa37b5..22ef9b317 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -5,6 +5,5 @@ add_sources( source_inter.f90 pointSource_class.f90 fissionSource_class.f90 materialSource_class.f90 - ISMCSource_class.f90 bbSurfaceSource_class.f90 ) diff --git a/ParticleObjects/Source/ISMCSource_class.f90 b/ParticleObjects/Source/ISMCSource_class.f90 deleted file mode 100644 index 4266a48c7..000000000 --- a/ParticleObjects/Source/ISMCSource_class.f90 +++ /dev/null @@ -1,179 +0,0 @@ -module ISMCSource_class - - use numPrecision - use endfConstants - use universalVariables - use genericProcedures, only : fatalError, rotateVector - use dictionary_class, only : dictionary - use RNG_class, only : RNG - - use particle_class, only : particleState, P_MATERIAL - use particleDungeon_class, only : particleDungeon - use source_inter, only : source, kill_super => kill - - use geometry_inter, only : geometry - use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast - use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG - use nuclearDatabase_inter, only : nuclearDatabase - use mgIMCDatabase_inter, only : mgIMCDatabase - use materialMenu_mod, only : MMnMat => nMat - - implicit none - private - - !! - !! ISMC Source for uniform generation of photons within material regions - !! - !! Angular distribution is isotropic. - !! - !! Private members: - !! isMG -> is the source multi-group? (default = .false.) - !! bottom -> Bottom corner (x_min, y_min, z_min) - !! top -> Top corner (x_max, y_max, z_max) - !! E -> Fission site energy [MeV] (default = 1.0E-6) - !! G -> Fission site Group (default = 1) - !! - !! Interface: - !! source_inter Interface - !! - type, public,extends(source) :: ismcSource - private - logical(defBool) :: isMG = .true. - real(defReal), dimension(3) :: bottom = ZERO - real(defReal), dimension(3) :: top = ZERO - real(defReal) :: E = ZERO - integer(shortInt) :: G = 0 - integer(shortInt) :: N = 10 - real(defReal) :: boundingVol = ZERO - contains - procedure :: init - procedure :: sampleParticle - procedure :: kill - end type ismcSource - -contains - - !! - !! Initialise IMC Source - !! - !! See source_inter for details - !! - subroutine init(self, dict, geom) - class(ismcSource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - character(nameLen) :: type - real(defReal), dimension(6) :: bounds - real(defReal), dimension(3) :: boundSize - integer(shortInt) :: i, n - character(100), parameter :: Here = 'init (ismcSource_class.f90)' - - ! Provide geometry info to source - self % geom => geom - - call dict % getOrDefault(self % G, 'G', 1) - call dict % getOrDefault(self % N, 'N', 10) - - ! Set bounding region - bounds = self % geom % bounds() - self % bottom = bounds(1:3) - self % top = bounds(4:6) - - ! Calculate volume of bounding region - boundSize = self % top - self % bottom - self % boundingVol = boundSize(1) * boundSize(2) * boundSize(3) - - end subroutine init - - !! - !! Sample particle's phase space co-ordinates - !! - !! See source_inter for details - !! - function sampleParticle(self, rand) result(p) - class(ismcSource), intent(inout) :: self - class(RNG), intent(inout) :: rand - type(particleState) :: p - class(nuclearDatabase), pointer :: nucData - class(IMCMaterial), pointer :: mat - real(defReal), dimension(3) :: r, rand3, dir - real(defReal) :: mu, phi - integer(shortInt) :: i, matIdx, uniqueID, nucIdx - character(100), parameter :: Here = 'sampleParticle (ismcSource_class.f90)' - - ! Get pointer to appropriate nuclear database - nucData => ndReg_getIMCMG() - if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') - - ! Position is sampled by taking a random point from within geometry bounding box - ! If in valid material, position is accepted - i = 0 - rejection : do - ! Protect against infinite loop - i = i + 1 - if ( i > 200) then - call fatalError(Here, '200 particles in a row sampled in void or outside material.& - & Check that geometry is as intended') - end if - - ! Sample Position - rand3(1) = rand % get() - rand3(2) = rand % get() - rand3(3) = rand % get() - r = (self % top - self % bottom) * rand3 + self % bottom - - ! Find material under position - call self % geom % whatIsAt(matIdx, uniqueID, r) - - ! Reject if there is no material - if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) cycle rejection - - ! Point to material - mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) - if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") - - ! Sample Direction - chosen uniformly inside unit sphere - mu = 2 * rand % get() - 1 - phi = rand % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) - - ! Assign basic phase-space coordinates - p % matIdx = matIdx - p % uniqueID = uniqueID - p % time = ZERO - p % type = P_MATERIAL - p % r = r - p % dir = dir - p % G = self % G - p % isMG = .true. - - ! Set weight to be (energy per unit volume) * (volume per particle) - p % wgt = mat % getEnergyDens() * self % boundingVol / self % N - - ! Exit the loop - exit rejection - - end do rejection - - end function sampleParticle - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(ismcSource), intent(inout) :: self - - !call kill_super(self) - - self % isMG = .true. - self % bottom = ZERO - self % top = ZERO - self % E = ZERO - self % G = 0 - self % N = 10 - - end subroutine kill - -end module ISMCSource_class diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index c27da12c6..7382d122d 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -11,7 +11,6 @@ module sourceFactory_func use pointSource_class, only : pointSource use fissionSource_class, only : fissionSource use materialSource_class, only : materialSource - use ISMCSource_class, only : ismcSource use bbSurfaceSource_class, only : bbSurfaceSource ! geometry @@ -30,7 +29,6 @@ module sourceFactory_func character(nameLen),dimension(*),parameter :: AVAILABLE_sources = [ 'pointSource ',& 'fissionSource ',& 'materialSource ',& - 'ismcSource ',& 'bbsurfaceSource'] contains @@ -67,10 +65,6 @@ subroutine new_source(new, dict, geom) allocate(materialSource :: new) call new % init(dict, geom) - case('ismcSource') - allocate(ismcSource :: new) - call new % init(dict, geom) - case('bbSurfaceSource') allocate(bbSurfaceSource :: new) call new % init(dict, geom) From 033c3ca42c1cc98fe932fc914658a9811f116934 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 28 Jun 2023 15:41:48 +0100 Subject: [PATCH 339/373] No longer need to specify number of particles from bbSurfaceSource in input file, now chooses proportionally to weight of each source type --- .../Source/bbSurfaceSource_class.f90 | 15 ++++++++------- ParticleObjects/Source/source_inter.f90 | 1 + PhysicsPackages/IMCPhysicsPackage_class.f90 | 19 +++++++++++++------ .../transportOperatorTimeHT_class.f90 | 2 +- 4 files changed, 23 insertions(+), 14 deletions(-) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 81f116710..a82df4030 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -82,6 +82,7 @@ subroutine init(self, dict, geom) class(geometry), pointer, intent(in) :: geom real(defReal), dimension(:), allocatable :: temp integer(shortInt) :: i, dir + real(defReal) :: area character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' ! Provide geometry info to source @@ -118,6 +119,12 @@ subroutine init(self, dict, geom) call dict % get(self % deltaT, 'deltaT') ! Automatically added to dict in IMC physics package call dict % getOrDefault(self % N, 'N', 1) + ! Calculate surface area of source + area = product(self % dr, self % dr /= ZERO) + + ! Calculate total source energy + self % sourceWeight = radiationConstant * lightSpeed * self % deltaT * self % T**4 * area / 4 + end subroutine init !! @@ -262,14 +269,8 @@ subroutine sampleWeight(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal) :: area, num - - ! Calculate surface area of source - area = product(self % dr, self % dr /= ZERO) - ! Calculate energy weight per particle - num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * area - p % wgt = num / (4 * self % N) + p % wgt = self % sourceWeight / self % N end subroutine sampleWeight diff --git a/ParticleObjects/Source/source_inter.f90 b/ParticleObjects/Source/source_inter.f90 index ae3254059..458c3d1e6 100644 --- a/ParticleObjects/Source/source_inter.f90 +++ b/ParticleObjects/Source/source_inter.f90 @@ -37,6 +37,7 @@ module source_inter type, public,abstract :: source private class(geometry), pointer, public :: geom => null() + real(defReal), public :: sourceWeight = ZERO contains procedure :: generate procedure :: append diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 index d2d972f2e..bcef48a7b 100644 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ b/PhysicsPackages/IMCPhysicsPackage_class.f90 @@ -64,7 +64,6 @@ module IMCPhysicsPackage_class type, public,extends(physicsPackage) :: IMCPhysicsPackage private ! Building blocks -! class(nuclearDatabase), pointer :: nucData => null() class(mgIMCDatabase), pointer :: nucData => null() class(geometry), pointer :: geom => null() integer(shortInt) :: geomIdx = 0 @@ -133,9 +132,9 @@ subroutine steps(self, tally, tallyAtch, N_steps) type(tallyAdmin), pointer,intent(inout) :: tally type(tallyAdmin), pointer,intent(inout) :: tallyAtch integer(shortInt), intent(in) :: N_steps - integer(shortInt) :: i, j, N, num, nParticles + integer(shortInt) :: i, j, N, nFromMat, num, nParticles type(particle), save :: p - real(defReal) :: elapsed_T, end_T, T_toEnd + real(defReal) :: sourceWeight, elapsed_T, end_T, T_toEnd real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='steps (IMCPhysicsPackage_class.f90)' @@ -171,19 +170,27 @@ subroutine steps(self, tally, tallyAtch, N_steps) self % thisStep => self % temp_dungeon call self % nextStep % cleanPop() - ! Select total number of particles to generate from material emission + ! Reduce number of particles to generate if close to limit N = self % pop if (N + self % thisStep % popSize() > self % limit) then ! Fleck and Cummings IMC Paper, eqn 4.11 N = self % limit - self % thisStep % popSize() - self % nMat - 1 end if + ! Calculate proportion to be generated from input source + sourceWeight = self % inputSource % sourceWeight + if (self % inputSource % sourceWeight == 0) then + nFromMat = N + else + nFromMat = int(N * (1 - sourceWeight/(sourceWeight + self % nucData % getEmittedRad()))) + end if + ! Add to dungeon particles emitted from material - call self % matSource % append(self % thisStep, N, self % pRNG) + call self % matSource % append(self % thisStep, nFromMat, self % pRNG) ! Generate from input source if( self % sourceGiven ) then - call self % inputSource % append(self % thisStep, 0, self % pRNG) + call self % inputSource % append(self % thisStep, N - nFromMat, self % pRNG) end if if(self % printSource == 1) then diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 7c969a742..107c5f4ae 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -269,7 +269,7 @@ subroutine materialTransform(self, p, tally) matIdx = p % matIdx() ! If so, get matIdx based on exact position (no adjustment for surface tol) ! NOTE: Doing this for all particles (not just those placed in void) may in theory give very - ! slight accuracy increase for material-material surface crossings as well, but should + ! slight accuracy increase for particles near material-material boundaries as well, but should ! be negligible and will increase runtimes by calling whatIsAt for every mat particle. if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) then call self % geom % whatIsAt(matIdx, uniqueID, p % coords % lvl(1) % r, [ZERO,ZERO,ZERO]) From 7dfc2f3fca4de362ee29d77a22b83c53d1d82662 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 3 Jul 2023 14:37:18 +0100 Subject: [PATCH 340/373] Combined IMC and ISMC into single PP. Simplified a lot of code with new time step class. No longer have to distinguish IMC and ISMC in CollProc. --- .../CollisionProcessors/IMCMGstd_class.f90 | 15 +- .../collisionProcessorFactory_func.f90 | 9 +- NuclearData/IMCMaterial_inter.f90 | 13 - .../baseMgIMC/baseMgIMCDatabase_class.f90 | 15 - .../baseMgIMC/baseMgIMCMaterial_class.f90 | 34 +- NuclearData/mgIMCData/mgIMCDatabase_inter.f90 | 10 - NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 13 - .../Source/bbSurfaceSource_class.f90 | 22 +- ParticleObjects/Source/configSource_inter.f90 | 16 +- ParticleObjects/Source/ismcNew.f90 | 352 +++++++++++ .../Source/materialSource_class.f90 | 18 +- ParticleObjects/Source/oldIMCSource.f90 | 345 +++++++++++ ParticleObjects/Source/oldSurfaceSource | 359 +++++++++++ PhysicsPackages/CMakeLists.txt | 3 +- .../implicitPhysicsPackage_class.f90 | 584 ++++++++++++++++++ .../physicsPackageFactory_func.f90 | 20 +- SharedModules/CMakeLists.txt | 3 +- SharedModules/simulationTime_class.f90 | 82 +++ 18 files changed, 1782 insertions(+), 131 deletions(-) create mode 100644 ParticleObjects/Source/ismcNew.f90 create mode 100644 ParticleObjects/Source/oldIMCSource.f90 create mode 100644 ParticleObjects/Source/oldSurfaceSource create mode 100644 PhysicsPackages/implicitPhysicsPackage_class.f90 create mode 100644 SharedModules/simulationTime_class.f90 diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index d2dfd6e0d..1838cb596 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -24,8 +24,6 @@ module IMCMGstd_class implicit none private - integer(shortInt), parameter :: IMC = 1, ISMC = 2 - !! !! Standard (default) scalar collision processor for MG IMC !! Determines type of collision as either absorption or effective scattering @@ -42,7 +40,6 @@ module IMCMGstd_class private class(mgIMCDatabase), pointer, public :: xsData => null() class(mgIMCMaterial), pointer, public :: mat => null() - integer(shortInt) :: calcType contains ! Initialisation procedure procedure :: init @@ -65,14 +62,8 @@ module IMCMGstd_class subroutine init(self, dict) class(IMCMGstd), intent(inout) :: self class(dictionary), intent(in) :: dict - character(nameLen) :: calcType character(100), parameter :: Here = 'init (IMCMGstd_class.f90)' - ! Set calculation type - self % calcType = IMC - call dict % get(calcType, 'type') - if(calcType == 'ISMCMGstd') self % calcType = ISMC - ! Call superclass call init_super(self, dict) @@ -194,11 +185,7 @@ subroutine capture(self, p, collDat, thisCycle, nextCycle) class(particleDungeon),intent(inout) :: thisCycle class(particleDungeon),intent(inout) :: nextCycle - if(self % calcType == IMC) then - p % isDead = .true. - else - p % type = P_MATERIAL - end if + p % type = P_MATERIAL end subroutine capture diff --git a/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 b/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 index 6384d7b6f..ce45809e7 100644 --- a/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 +++ b/CollisionOperator/CollisionProcessors/collisionProcessorFactory_func.f90 @@ -26,8 +26,7 @@ module collisionProcessorFactory_func character(nameLen),dimension(*),parameter :: AVALIBLE_collisionProcessors = [ 'neutronCEstd',& 'neutronCEimp',& 'neutronMGstd',& - 'IMCMGstd ',& - 'ISMCMGstd '] + 'IMCMGstd '] contains @@ -66,12 +65,6 @@ subroutine new_collisionProcessor(new,dict) allocate(IMCMGstd :: new) call new % init(dict) - case('ISMCMGstd') - ! Collisions are very similar for IMC and ISMC so both use the same processor - ! Having this as a separate case allows this processor to tell the difference - allocate(IMCMGstd :: new) - call new % init(dict) - !*** NEW COLLISION PROCESSOR TEMPLATE ***! !case('') ! allocate( :: new) diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 63ed7bf21..7480d5e68 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -38,7 +38,6 @@ module IMCMaterial_inter procedure(getTemp), deferred :: getTemp procedure(getMatEnergy), deferred :: getMatEnergy procedure(setCalcType), deferred :: setCalcType - procedure(setTimeStep), deferred :: setTimeStep procedure(sampleTransformTime), deferred :: sampleTransformTime end type IMCMaterial @@ -141,18 +140,6 @@ subroutine setCalcType(self, calcType) integer(shortInt), intent(in) :: calcType end subroutine setCalcType - !! - !! Provide material with time step size - !! - !! Args: - !! dt [in] -> time step size [s] - !! - subroutine setTimeStep(self, dt) - import :: IMCMaterial, defReal - class(IMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: dt - end subroutine setTimeStep - !! !! Sample the time taken for a material particle to transform into a photon !! Used for ISMC only diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index f4db3dcdf..6bf31633e 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -61,7 +61,6 @@ module baseMgIMCDatabase_class procedure :: getEmittedRad procedure :: getMaterialEnergy procedure :: updateProperties - procedure :: setTimeStep procedure :: setCalcType procedure :: sampleTransformTime procedure :: kill @@ -291,20 +290,6 @@ subroutine updateProperties(self, tallyEnergy, printUpdates) end subroutine updateProperties - !! - !! Provide each material with time step to calculate initial fleck factor - !! - subroutine setTimeStep(self, deltaT) - class(baseMgIMCDatabase), intent(inout) :: self - real(defReal), intent(in) :: deltaT - integer(shortInt) :: i - - do i=1, size(self % mats) - call self % mats(i) % setTimeStep(deltaT) - end do - - end subroutine setTimeStep - !! !! Tell each material if we are using IMC or ISMC !! diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 2de1c411d..6bfc2eebf 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -13,6 +13,8 @@ module baseMgIMCMaterial_class use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill use IMCXSPackages_class, only : IMCMacroXSs + use simulationTime_class, only : timeStep + implicit none private @@ -71,7 +73,6 @@ module baseMgIMCMaterial_class real(defReal) :: V real(defReal) :: fleck real(defReal) :: alpha - real(defReal) :: deltaT real(defReal) :: sigmaP real(defReal) :: matEnergy real(defReal) :: energyDens @@ -94,7 +95,6 @@ module baseMgIMCMaterial_class procedure :: getTemp procedure :: getMatEnergy procedure :: setCalcType - procedure :: setTimeStep procedure :: sampleTransformTime procedure, private :: tempFromEnergy @@ -271,27 +271,6 @@ subroutine init(self, dict) end subroutine init - !! - !! Provide material with time step size - !! - !! Args: - !! dt [in] -> time step size [s] - !! - !! Errors: - !! fatalError if calculation type is invalid (valid options are IMC or ISMC) - !! - subroutine setTimeStep(self, dt) - class(baseMgIMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: dt - character(100), parameter :: Here = 'setTimeStep (baseMgIMCMaterial_class.f90)' - - self % deltaT = dt - - ! Set initial fleck factor - call self % updateFleck() - - end subroutine setTimeStep - !! !! Return number of energy groups !! @@ -408,12 +387,12 @@ subroutine updateFleck(self) select case(self % calcType) case(IMC) - self % fleck = 1/(1+self % sigmaP*lightSpeed*beta*self % deltaT*self % alpha) + self % fleck = 1/(1+self % sigmaP*lightSpeed*beta*timeStep()*self % alpha) case(ISMC) self % eta = radiationConstant * self % T**4 / self % energyDens zeta = beta - self % eta - self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*self % deltaT) + self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*timeStep()) ! TODO: Check that 0 temperature will not cause problems case default @@ -432,7 +411,7 @@ function getEmittedRad(self) result(emittedRad) U_r = radiationConstant * (self % T)**4 - emittedRad = lightSpeed * self % deltaT * self % sigmaP * self % fleck * U_r * self % V + emittedRad = lightSpeed * timeStep() * self % sigmaP * self % fleck * U_r * self % V end function getEmittedRad @@ -502,6 +481,9 @@ subroutine setCalcType(self, calcType) self % calcType = calcType + ! Set initial fleck factor + call self % updateFleck() + end subroutine setCalcType !! diff --git a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 index 42d8c008f..96e99f9e8 100644 --- a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 @@ -26,7 +26,6 @@ module mgIMCDatabase_inter procedure(getEmittedRad), deferred :: getEmittedRad procedure(getMaterialEnergy), deferred :: getMaterialEnergy procedure(updateProperties), deferred :: updateProperties - procedure(setTimeStep), deferred :: setTimeStep procedure(setCalcType), deferred :: setCalcType procedure(sampleTransformTime), deferred :: sampleTransformTime @@ -73,15 +72,6 @@ subroutine updateProperties(self, tallyEnergy, printUpdates) integer(shortInt), intent(in) :: printUpdates end subroutine updateProperties - !! - !! Provide each material with time step to calculate initial fleck factor - !! - subroutine setTimeStep(self, deltaT) - import :: mgIMCDatabase, defReal - class(mgIMCDatabase), intent(inout) :: self - real(defReal), intent(in) :: deltaT - end subroutine setTimeStep - !! !! Tell each material if we are using IMC or ISMC !! diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index f8c90805f..539802a23 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -50,7 +50,6 @@ module mgIMCMaterial_inter procedure(getTemp), deferred :: getTemp procedure(getMatEnergy), deferred :: getMatEnergy procedure(setCalcType), deferred :: setCalcType - procedure(setTimeStep), deferred :: setTimeStep procedure(sampleTransformTime), deferred :: sampleTransformTime end type mgIMCMaterial @@ -175,18 +174,6 @@ subroutine setCalcType(self, calcType) integer(shortInt), intent(in) :: calcType end subroutine setCalcType - !! - !! Provide material with time step size - !! - !! Args: - !! dt [in] -> time step size [s] - !! - subroutine setTimeStep(self, dt) - import :: mgIMCMaterial, defReal - class(mgIMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: dt - end subroutine setTimeStep - !! !! Sample the time taken for a material particle to transform into a photon !! Used for ISMC only diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index a82df4030..bb4528bbe 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -9,6 +9,7 @@ module bbSurfaceSource_class use configSource_inter, only : configSource, kill_super => kill use geometry_inter, only : geometry use RNG_class, only : RNG + use simulationTime_class, only : timeStep, timeNow implicit none private @@ -31,6 +32,7 @@ module bbSurfaceSource_class !! sampleEnergyAngle -> sample particle angle !! sampleEnergy -> set particle energy (isMG = .true., G = 1) !! sampleWeight -> set particle energy-weight + !! sampleTime -> set particle time !! kill -> terminate source !! !! Sample Dictionary Input: @@ -41,7 +43,6 @@ module bbSurfaceSource_class !! #dir -1; -> optional, negative will reverse direction in dominant axis !! -> defaults to positive !! temp 1; -> temperature of the black body source - !! #deltaT 0.05; -> time step size, automatically added to dictionary in IMCPhysicsPackage_class.f90 !! N 100; -> number of particles per time step, only used if append is called with N = 0 !! } !! @@ -53,7 +54,6 @@ module bbSurfaceSource_class integer(shortInt) :: particleType = P_PHOTON logical(defBool) :: isMG = .true. real(defReal) :: T = ZERO - real(defReal) :: deltaT = ZERO integer(shortInt) :: N = 0 contains procedure :: init @@ -63,6 +63,7 @@ module bbSurfaceSource_class procedure :: sampleEnergy procedure :: sampleEnergyAngle procedure :: sampleWeight + procedure :: sampleTime procedure :: kill end type bbSurfaceSource @@ -116,14 +117,13 @@ subroutine init(self, dict, geom) ! Get remaining information call dict % get(self % T, 'temp') - call dict % get(self % deltaT, 'deltaT') ! Automatically added to dict in IMC physics package call dict % getOrDefault(self % N, 'N', 1) ! Calculate surface area of source area = product(self % dr, self % dr /= ZERO) ! Calculate total source energy - self % sourceWeight = radiationConstant * lightSpeed * self % deltaT * self % T**4 * area / 4 + self % sourceWeight = radiationConstant * lightSpeed * timeStep() * self % T**4 * area / 4 end subroutine init @@ -274,6 +274,19 @@ subroutine sampleWeight(self, p, rand) end subroutine sampleWeight + !! + !! Sample time uniformly within time step + !! + subroutine sampleTime(self, p, rand) + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + + ! Sample time uniformly within time step + p % time = timeNow() + timeStep() * rand % get() + + end subroutine sampleTime + !! !! Return to uninitialised state !! @@ -290,7 +303,6 @@ elemental subroutine kill(self) self % particleType = P_PHOTON self % isMG = .true. self % T = ZERO - self % deltaT = ZERO self % N = ZERO end subroutine kill diff --git a/ParticleObjects/Source/configSource_inter.f90 b/ParticleObjects/Source/configSource_inter.f90 index 6aa274c80..0436b2530 100644 --- a/ParticleObjects/Source/configSource_inter.f90 +++ b/ParticleObjects/Source/configSource_inter.f90 @@ -33,6 +33,7 @@ module configSource_inter contains procedure :: sampleParticle procedure :: sampleWeight + procedure :: sampleTime procedure(sampleType), deferred :: sampleType procedure(samplePosition), deferred :: samplePosition procedure(sampleEnergy), deferred :: sampleEnergy @@ -135,7 +136,7 @@ function sampleParticle(self, rand) result(p) call self % sampleEnergyAngle(p, rand) call self % sampleEnergy(p, rand) call self % sampleWeight(p, rand) - p % time = ZERO + call self % sampleTime(p, rand) end function sampleParticle @@ -152,6 +153,19 @@ subroutine sampleWeight(self, p, rand) end subroutine sampleWeight + !! + !! Set particle's time to 0 + !! Can be overriden in subclasses if needed + !! + subroutine sampleTime(self, p, rand) + class(configSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + + p % time = ZERO + + end subroutine sampleTime + !! !! Return to uninitialised state !! diff --git a/ParticleObjects/Source/ismcNew.f90 b/ParticleObjects/Source/ismcNew.f90 new file mode 100644 index 000000000..0cd06b95c --- /dev/null +++ b/ParticleObjects/Source/ismcNew.f90 @@ -0,0 +1,352 @@ +module IMCSource_class + + use numPrecision + use endfConstants + use universalVariables + use genericProcedures, only : fatalError, rotateVector + use dictionary_class, only : dictionary + use RNG_class, only : RNG + + use particle_class, only : particle, particleState, P_PHOTON + use particleDungeon_class, only : particleDungeon + use source_inter, only : source, kill_super => kill + + use geometry_inter, only : geometry + use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast + use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase + use materialMenu_mod, only : mm_nMat => nMat, & + mm_matName => matName + + implicit none + private + + integer(shortInt), parameter :: REJ = 1, FAST = 2 + + !! + !! IMC Source for uniform generation of photons within a material + !! + !! Angular distribution is isotropic. + !! + !! Private members: + !! isMG -> is the source multi-group? (default = .true.) + !! bottom -> Bottom corner (x_min, y_min, z_min) + !! top -> Top corner (x_max, y_max, z_max) + !! G -> Group (default = 1) + !! + !! Interface: + !! source_inter Interface + !! + !! SAMPLE INPUT: + !! imcSource { type IMCSource; } + !! + type, public,extends(source) :: imcSource + private + logical(defBool) :: isMG = .true. + real(defReal), dimension(3) :: bottom = ZERO + real(defReal), dimension(3) :: top = ZERO + real(defReal), dimension(3) :: latPitch = ZERO + integer(shortInt), dimension(3) :: latSizeN = 0 + integer(shortInt) :: G = 0 + real(defReal), dimension(6) :: bounds = ZERO + integer(shortInt) :: method = REJ + contains + procedure :: init + procedure :: append + procedure :: sampleParticle + procedure, private :: sampleIMC + procedure, private :: getMatBounds + procedure :: kill + end type imcSource + +contains + + !! + !! Initialise IMC Source + !! + !! See source_inter for details + !! + subroutine init(self, dict, geom) + class(imcSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + character(nameLen) :: method + character(100), parameter :: Here = 'init (imcSource_class.f90)' + + call dict % getOrDefault(self % G, 'G', 1) + + ! Provide geometry info to source + self % geom => geom + + ! Set bounding region + self % bounds = self % geom % bounds() + + ! Select method for position sampling + call dict % getOrDefault(method, 'method', 'rejection') + select case(method) + case('rejection') + self % method = REJ + + case('fast') + self % method = FAST + ! Get lattice dimensions + self % latSizeN = self % geom % latSizeN() + self % latPitch = (self % bounds(4:6) - self % bounds(1:3)) / self % latSizeN + + case default + call fatalError(Here, 'Unrecognised method. Should be "rejection" or "fast"') + end select + + end subroutine init + + + !! + !! Generate N particles to add to a particleDungeon without overriding + !! particles already present. + !! + !! Args: + !! dungeon [inout] -> particle dungeon to be added to + !! n [in] -> number of particles to place in dungeon + !! rand [inout] -> particle RNG object + !! + !! Result: + !! A dungeon populated with N particles sampled from the source, plus particles + !! already present in dungeon + !! + subroutine append(self, dungeon, N, rand) + class(imcSource), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + real(defReal), dimension(6) :: bounds + integer(shortInt) :: matIdx, i, Ntemp + real(defReal) :: energy, totalEnergy + type(RNG) :: pRand + class(mgIMCDatabase), pointer :: nucData + character(100), parameter :: Here = "append (IMCSource_class.f90)" + + ! Get pointer to appropriate nuclear database + nucData => ndReg_getIMCMG() + if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') + + ! Obtain total energy + totalEnergy = nucData % getEmittedRad() + + ! Loop through materials + do matIdx = 1, mm_nMat() + + ! Get energy to be emitted from material matIdx + energy = nucData % getEmittedRad(matIdx) + + ! Choose particle numbers in proportion to material energy + if (energy > ZERO) then + Ntemp = int(N * energy / totalEnergy) + ! Enforce at least 1 particle + if (Ntemp == 0) Ntemp = 1 + + ! Set bounds for sampling + if (self % method == FAST) then + bounds = self % getMatBounds(matIdx) + else + bounds = self % bounds + end if + + ! Find energy per particle + energy = energy / Ntemp + + ! Sample particles + !$omp parallel + pRand = rand + !$omp do private(pRand) + do i=1, Ntemp + call pRand % stride(i) + call dungeon % detain(self % sampleIMC(pRand, matIdx, energy, bounds)) + end do + !$omp end do + !$omp end parallel + + end if + end do + + end subroutine append + + + !! + !! Sample particle's phase space co-ordinates + !! + !! See source_inter for details + !! + function sampleParticle(self, rand) result(p) + class(imcSource), intent(inout) :: self + class(RNG), intent(inout) :: rand + type(particleState) :: p + character(100), parameter :: Here = 'sampleParticle (IMCSource_class.f90)' + + ! Should not be called, useful to have extra inputs so use sampleIMC instead + call fatalError(Here, 'Should not be called, sampleIMC should be used instead.') + + ! Avoid compiler warning + p % G = self % G + + end function sampleParticle + + + !! + !! Sample particle's phase space co-ordinates + !! + !! Args: + !! rand [in] -> RNG + !! matIdx [in] -> index of material being sampled from + !! energy [in] -> energy-weight of sampled particle + !! bounds [in] -> bounds for position search, will be bounds of entire geometry if using + !! rejection sampling method, and bounds of single material if using fast + !! + function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) + class(imcSource), intent(inout) :: self + class(RNG), intent(inout) :: rand + integer(shortInt), intent(in) :: targetMatIdx + real(defReal), intent(in) :: energy + real(defReal), dimension(6), intent(in) :: bounds + type(particleState) :: p + real(defReal), dimension(3) :: bottom, top, r, dir, rand3 + real(defReal) :: mu, phi + integer(shortInt) :: i, matIdx, uniqueID + character(100), parameter :: Here = 'sampleIMC (IMCSource_class.f90)' + + ! Sample particle position + bottom = bounds(1:3) + top = bounds(4:6) + i = 0 + rejection:do + rand3(1) = rand % get() + rand3(2) = rand % get() + rand3(3) = rand % get() + r = (top - bottom) * rand3 + bottom + + ! Find material under position + call self % geom % whatIsAt(matIdx, uniqueID, r) + + ! Exit if in desired material + if (matIdx == targetMatIdx) exit rejection + + ! Should exit immediately if using fast method as bounds should contain only matIdx + if (self % method == FAST) call fatalError(Here, 'Fast sourcing returned incorrect material') + + ! Protect against infinite loop + i = i+1 + if (i > 10000) call fatalError(Here, '10,000 failed attempts in rejection sampling') + + end do rejection + + ! Sample direction - chosen uniformly inside unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + + ! Assign basic phase-space coordinates + p % matIdx = matIdx + p % uniqueID = uniqueID + p % time = ZERO + p % type = P_PHOTON + p % r = r + p % dir = dir + p % G = self % G + p % isMG = .true. + p % wgt = energy + + end function sampleIMC + + + !! + !! Get location of material in lattice for position sampling + !! + !! Note that this may be incorrect depending on how lattice input is given, this function + !! assumes that geometry has been generated by discretiseGeom_class.f90 + !! + !! Args: + !! matIdx [in] -> matIdx for which to calculate bounds + !! matBounds [out] -> boundary of lattice cell, [xmin,ymin,zmin,xmax,ymax,zmax] + !! + !! TODO: + !! Would be nice to have most of this in a geometry module + !! + function getMatBounds(self, matIdx) result(matBounds) + class(imcSource), intent(inout) :: self + integer(shortInt), intent(in) :: matIdx + real(defReal), dimension(6) :: matBounds + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: i, latIdFlipped + character(nameLen) :: matName + character(100), parameter :: Here = 'getMatBounds (imcSourceClass.f90)' + + ! Extract lattice position from mat name (e.g. "m106 -> 106") + ! This is different from localID in latUniverse_class as is counting from a different + ! corner (see get_ijk function description below) + matName = mm_matName(matIdx) + read (matName(2:), '(I10)') latIdFlipped + + ! Set bounds of lattice cell containing matIdx + ijk = get_ijk(latIdFlipped, self % latSizeN) + + do i=1, 3 + matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bounds(i) + SURF_TOL + matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bounds(i) - SURF_TOL + end do + + end function getMatBounds + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(imcSource), intent(inout) :: self + + call kill_super(self) + + self % isMG = .true. + self % bounds = ZERO + self % G = 0 + + end subroutine kill + + !! + !! Generate ijk from flipped localID and shape + !! + !! Note that this is NOT the same as get_ijk in latUniverse_class. Lattice is built with first + !! map input as x_min, y_MAX, z_MAX cell, but localID begins at x_min, y_min, z_min cell. In + !! this module we want to find ijk from matIdx, which we convert to a flippedLocalID by + !! offsetting for void regions, which starts counting from the wrong corner. We therefore flip + !! ijk in the y and z directions in this function compared to instances of this function in other + !! modules. + !! + !! Args: + !! flippedlocalID [in] -> Local id of the cell between 1 and product(sizeN), + !! counting from wrong corner + !! sizeN [in] -> Number of cells in each cardinal direction x, y & z + !! + !! Result: + !! Array ijk which has integer position in each cardinal direction + !! + pure function get_ijk(flippedLocalID, sizeN) result(ijk) + integer(shortInt), intent(in) :: flippedLocalID + integer(shortInt), dimension(3), intent(in) :: sizeN + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: temp, base + + temp = flippedLocalID - 1 + base = temp / sizeN(1) + ijk(1) = temp - sizeN(1) * base + 1 + + temp = base + base = temp / sizeN(2) + ijk(2) = sizeN(2)*(1 + base) - temp + + ijk(3) = sizeN(3) - base + + end function get_ijk + + +end module IMCSource_class diff --git a/ParticleObjects/Source/materialSource_class.f90 b/ParticleObjects/Source/materialSource_class.f90 index 9d6470668..f56ff8b44 100644 --- a/ParticleObjects/Source/materialSource_class.f90 +++ b/ParticleObjects/Source/materialSource_class.f90 @@ -19,6 +19,8 @@ module materialSource_class use materialMenu_mod, only : mm_nMat => nMat, & mm_matName => matName + use simulationTime_class, only : timeStep, timeNow + implicit none private @@ -76,7 +78,7 @@ subroutine init(self, dict, geom) class(materialSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom - character(nameLen) :: method, calcType + character(nameLen) :: method character(100), parameter :: Here = 'init (materialSource_class.f90)' call dict % getOrDefault(self % G, 'G', 1) @@ -104,13 +106,11 @@ subroutine init(self, dict, geom) end select ! Select calculation type - call dict % getOrDefault(calcType, 'calcType', 'IMC') - select case(calcType) - case('IMC') - self % calcType = IMC + call dict % getOrDefault(self % calcType, 'calcType', IMC) + select case(self % calcType) + case(IMC) self % pType = P_PHOTON - case('ISMC') - self % calcType = ISMC + case(ISMC) self % pType = P_MATERIAL case default call fatalError(Here, 'Unrecognised calculation type. Should be "IMC" or "ISMC"') @@ -272,10 +272,12 @@ function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) dir(2) = sqrt(1-mu**2) * cos(phi) dir(3) = sqrt(1-mu**2) * sin(phi) + ! Sample time uniformly within time step + p % time = timeNow() + timeStep() * rand % get() + ! Assign basic phase-space coordinates p % matIdx = matIdx p % uniqueID = uniqueID - p % time = ZERO p % r = r p % dir = dir p % G = self % G diff --git a/ParticleObjects/Source/oldIMCSource.f90 b/ParticleObjects/Source/oldIMCSource.f90 new file mode 100644 index 000000000..e4e44fb51 --- /dev/null +++ b/ParticleObjects/Source/oldIMCSource.f90 @@ -0,0 +1,345 @@ +module IMCSource_class + + use numPrecision + use endfConstants + use universalVariables + use genericProcedures, only : fatalError, rotateVector + use dictionary_class, only : dictionary + use RNG_class, only : RNG + + use particle_class, only : particle, particleState, P_PHOTON + use particleDungeon_class, only : particleDungeon + use source_inter, only : source, kill_super => kill + + use geometry_inter, only : geometry + use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast + use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase + use materialMenu_mod, only : mm_matName => matName + + implicit none + private + + !! + !! IMC Source for uniform generation of photons within a material + !! + !! Angular distribution is isotropic. + !! + !! Private members: + !! isMG -> is the source multi-group? (default = .true.) + !! bottom -> Bottom corner (x_min, y_min, z_min) + !! top -> Top corner (x_max, y_max, z_max) + !! G -> Group (default = 1) + !! N -> number of particles being generated, used to normalise weight in sampleParticle + !! matIdx -> index of material to be sampled from + !! + !! Interface: + !! source_inter Interface + !! + !! SAMPLE INPUT: + !! imcSource { type IMCSource; } + !! + type, public,extends(source) :: imcSource + private + logical(defBool) :: isMG = .true. + real(defReal), dimension(3) :: bottom = ZERO + real(defReal), dimension(3) :: top = ZERO + real(defReal), dimension(3) :: latPitch = ZERO + integer(shortInt), dimension(:), allocatable :: latSizeN + integer(shortInt) :: G = 0 + integer(shortInt) :: N + integer(shortInt) :: matIdx + real(defReal), dimension(6) :: matBounds = ZERO + contains + procedure :: init + procedure :: append + procedure :: sampleParticle + procedure, private :: samplePosRej + procedure, private :: samplePosLat + procedure, private :: getMatBounds + procedure :: kill + end type imcSource + +contains + + !! + !! Initialise IMC Source + !! + !! See source_inter for details + !! + subroutine init(self, dict, geom) + class(imcSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + real(defReal), dimension(6) :: bounds + integer(shortInt), dimension(3) :: latSizeN + character(100), parameter :: Here = 'init (imcSource_class.f90)' + + ! Provide geometry info to source + self % geom => geom + + call dict % getOrDefault(self % G, 'G', 1) + + ! Set bounding region + bounds = self % geom % bounds() + self % bottom = bounds(1:3) + self % top = bounds(4:6) + + ! Store lattice dimensions for use in position sampling if using a large lattice + ! sizeN automatically added to dict in IMCPhysicsPackage if needed + if (dict % isPresent('sizeN')) then + call dict % get(self % latSizeN, 'sizeN') + self % latPitch = (self % top - self % bottom) / self % latSizeN + end if + + end subroutine init + + !! + !! Generate N particles from material matIdx to add to a particleDungeon without overriding + !! particles already present. + !! + !! Args: + !! dungeon [inout] -> particle dungeon to be added to + !! n [in] -> number of particles to place in dungeon + !! rand [inout] -> particle RNG object + !! matIdx [in] -> index of material to sample from + !! + !! Result: + !! A dungeon populated with N particles sampled from the source, plus particles + !! already present in dungeon + !! + subroutine append(self, dungeon, N, rand, matIdx, bounds) + class(imcSource), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + integer(shortInt), intent(in), optional :: matIdx + real(defReal), dimension(6), intent(in), optional :: bounds + integer(shortInt) :: i + type(RNG) :: pRand + character(100), parameter :: Here = "append (IMCSource_class.f90)" + + ! Assert that optional argument matIdx is in fact present + if (.not. present(matIdx)) call fatalError(Here, 'matIdx must be provided for IMC source') + + ! Store inputs for use by sampleParticle subroutine + self % N = N + self % matIdx = matIdx + + ! For a large number of materials (large lattice using discretiseGeom_class) rejection + ! sampling is too slow, so calculate bounding box of material + if (self % latPitch(1) /= 0) then + ! Get material bounds + call self % getMatBounds(matIdx, self % matBounds) + end if + + ! Add N particles to dungeon + !$omp parallel + pRand = rand + !$omp do private(pRand) + do i=1, N + call pRand % stride(i) + call dungeon % detain(self % sampleParticle(pRand)) + end do + !$omp end do + !$omp end parallel + + end subroutine append + + !! + !! Sample particle's phase space co-ordinates + !! + !! See source_inter for details + !! + function sampleParticle(self, rand) result(p) + class(imcSource), intent(inout) :: self + class(RNG), intent(inout) :: rand + type(particleState) :: p + class(nuclearDatabase), pointer :: nucData + class(IMCMaterial), pointer :: mat + real(defReal), dimension(3) :: r, dir + real(defReal) :: mu, phi + integer(shortInt) :: matIdx, uniqueID + character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' + + ! Get pointer to appropriate nuclear database + nucData => ndReg_getIMCMG() + if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') + + ! Choose position sampling method + if (self % latPitch(1) == ZERO) then + call self % samplePosRej(r, matIdx, uniqueID, rand) + else + call self % samplePosLat(r, matIdx, uniqueID, rand) + end if + + ! Point to material + mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) + if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") + + ! Sample direction - chosen uniformly inside unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + + ! Assign basic phase-space coordinates + p % matIdx = matIdx + p % uniqueID = uniqueID + p % time = ZERO + p % type = P_PHOTON + p % r = r + p % dir = dir + p % G = self % G + p % isMG = .true. + + ! Set weight + p % wgt = mat % getEmittedRad() / self % N + + end function sampleParticle + + + !! + !! Position is sampled by taking a random point from within geometry bounding box + !! If in correct material, position is accepted + !! + subroutine samplePosRej(self, r, matIdx, uniqueID, rand) + class(imcSource), intent(inout) :: self + real(defReal), dimension(3), intent(out) :: r + integer(shortInt), intent(out) :: matIdx + integer(shortInt), intent(out) :: uniqueID + class(RNG), intent(inout) :: rand + integer(shortInt) :: i + real(defReal), dimension(3) :: rand3 + character(100), parameter :: Here = 'samplePosRej (IMCSource_class.f90)' + + i = 0 + + rejectionLoop : do + + ! Protect against infinite loop + i = i+1 + if (i > 10000) then + call fatalError(Here, '10,000 failed samples in rejection sampling loop') + end if + + ! Sample Position + rand3(1) = rand % get() + rand3(2) = rand % get() + rand3(3) = rand % get() + r = (self % top - self % bottom) * rand3 + self % bottom + + ! Find material under position + call self % geom % whatIsAt(matIdx, uniqueID, r) + + ! Exit if in desired material + if (matIdx == self % matIdx) exit rejectionLoop + + end do rejectionLoop + + end subroutine samplePosRej + + !! + !! Sample position without using a rejection sampling method, by calculating the material bounds. + !! + !! Requires geometry to be a uniform lattice, so currently only called when discretiseGeom_class + !! is used to create inputs. + !! + subroutine samplePosLat(self, r, matIdx, uniqueID, rand) + class(imcSource), intent(inout) :: self + real(defReal), dimension(3), intent(out) :: r + integer(shortInt), intent(out) :: matIdx + integer(shortInt), intent(out) :: uniqueID + class(RNG), intent(inout) :: rand + integer(shortInt) :: i + character(100), parameter :: Here = 'samplePosLat (IMCSource_class.f90)' + + do i=1, 3 + r(i) = self % matBounds(i) + rand % get() * (self % matBounds(i+3) - self % matBounds(i) - SURF_TOL) + SURF_TOL + end do + + call self % geom % whatIsAt(matIdx, uniqueID, r) + + end subroutine samplePosLat + + !! + !! Get location of material in lattice for position sampling + !! + !! Args: + !! matIdx [in] -> matIdx for which to calculate bounds + !! matBounds [out] -> boundary of lattice cell, [xmin,ymin,zmin,xmax,ymax,zmax] + !! + !! TODO: + !! Would be nice to have most of this in a geometry module + !! + subroutine getMatBounds(self, matIdx, matBounds) + class(imcSource), intent(inout) :: self + integer(shortInt), intent(in) :: matIdx + real(defReal), dimension(6), intent(out) :: matBounds + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: latIdx, i + character(nameLen) :: matName + character(100), parameter :: Here = 'getMatBounds (imcSourceClass.f90)' + + ! Extract lattice position from mat name (e.g. "m106 -> 106") + matName = mm_matName(matIdx) + read (matName(2:), '(I10)') latIdx + + ! Set bounds of lattice cell containing matIdx + ijk = get_ijk(latIdx, self % latSizeN) + do i=1, 3 + matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bottom(i) + matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bottom(i) + end do + + end subroutine getMatBounds + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(imcSource), intent(inout) :: self + + call kill_super(self) + + self % isMG = .true. + self % bottom = ZERO + self % top = ZERO + self % G = 0 + + end subroutine kill + + + !! + !! Generate ijk from localID and shape + !! + !! Args: + !! localID [in] -> Local id of the cell between 1 and product(sizeN) + !! sizeN [in] -> Number of cells in each cardinal direction x, y & z + !! + !! Result: + !! Array ijk which has integer position in each cardinal direction + !! + pure function get_ijk(localID, sizeN) result(ijk) + integer(shortInt), intent(in) :: localID + integer(shortInt), dimension(3), intent(in) :: sizeN + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: temp, base + + temp = localID - 1 + + base = temp / sizeN(1) + ijk(1) = temp - sizeN(1) * base + 1 + + temp = base + base = temp / sizeN(2) + ijk(2) = temp - sizeN(2) * base + 1 + + ijk(3) = base + 1 + + end function get_ijk + + +end module IMCSource_class diff --git a/ParticleObjects/Source/oldSurfaceSource b/ParticleObjects/Source/oldSurfaceSource new file mode 100644 index 000000000..273b7829d --- /dev/null +++ b/ParticleObjects/Source/oldSurfaceSource @@ -0,0 +1,359 @@ +module bbSurfaceSource_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError + use particle_class, only : particleState, P_NEUTRON, P_PHOTON + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use configSource_inter, only : configSource, kill_super => kill + use geometry_inter, only : geometry + use RNG_class, only : RNG + + implicit none + private + + !! + !! Generates a source representing a black body surface + !! Put together quite quickly so very specific in use and not perfect + !! - Currently only allows a circle or square aligned on x y or z axis, with + !! a certain radius or side length + !! - May still contain unnecessary lines of code copied from pointSource_class.f90 + !! + !! Private members: + !! r -> source position + !! dir -> optional source direction + !! particleType -> source particle type + !! isMG -> is the source multi-group? + !! isIsotropic -> is the source isotropic? + !! + !! Interface: + !! init -> initialise point source + !! sampleType -> set particle type + !! samplePosition -> set particle position + !! sampleEnergy -> set particle energy + !! sampleEnergyAngle -> sample particle angle + !! kill -> terminate source + !! + !! Sample Dictionary Input: + !! source { + !! type bbSurfaceSource; + !! shape circle ! circle or square; + !! size 5; ! radius(circle) or side length(square) + !! axis x; ! axis normal to planar shape + !! pos 0; ! distance along axis to place plane + !! T 1; ! temperature of source boundary + !! particle photon; + !! # dir 1; # ! Positive or negative to indicate direction along axis + !! If 0 then emit in both directions + !! # N 100; # ! Number of particles, only used if call to append subroutine uses N=0 + !! } + !! + type, public,extends(configSource) :: bbSurfaceSource + private + real(defReal),dimension(3) :: r = ZERO + real(defReal) :: dir = ZERO + real(defReal) :: surfSize = ZERO + real(defReal) :: area = ZERO + integer(shortInt) :: particleType = P_PHOTON + logical(defBool) :: isMG = .true. + logical(defBool) :: isIsotropic = .false. + integer(shortInt) :: planeShape = 0 ! 0 => square, 1 => circle + integer(shortInt) :: axis = 1 ! 1 => x, 2 => y, 3 => z + real(defReal) :: T = ZERO + real(defReal) :: deltaT = ZERO + integer(shortInt) :: N = 1 + contains + procedure :: init + procedure :: append + procedure :: sampleType + procedure :: samplePosition + procedure :: sampleEnergy + procedure :: sampleEnergyAngle + procedure :: sampleWeight + procedure :: kill + end type bbSurfaceSource + +contains + + !! + !! Initialise from dictionary + !! + !! See source_inter for details + !! + !! Errors: + !! - error if an unrecognised particle type is provided + !! - error if an axis other than x, y, or z is given + !! - error if shape is not square or circle + !! + subroutine init(self, dict, geom) + class(bbSurfaceSource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + character(30) :: type, tempName + integer(shortInt) :: matIdx, uniqueID + logical(defBool) :: isCE, isMG + real(defReal) :: temp + character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' + + ! Provide geometry info to source + self % geom => geom + + ! Identify which particle is used in the source + ! Presently limited to neutron and photon + call dict % getOrDefault(type, 'particle' ,'photon') + select case(type) + case('neutron') + self % particleType = P_NEUTRON + + case('photon') + self % particleType = P_PHOTON + + case default + call fatalError(Here, 'Unrecognised particle type') + + end select + + ! Get position of surface along axis + call dict % get(temp, 'pos') +temp = temp + 2*SURF_TOL + ! Get axis and assign axis position + call dict % getOrDefault(tempName, 'axis', 'x') + select case(tempName) + case('x') + self % r(1) = temp + self % axis = 1 + case('y') + self % r(2) = temp + self % axis = 2 + case('z') + self % r(3) = temp + self % axis = 3 + case default + call fatalError(Here, 'Unrecognised axis, may only be x, y or z') + end select + + ! Get size of boundary surface + call dict % get(self % surfSize, 'size') + + ! Get shape and area of boundary surface + call dict % get(tempName, 'shape') + if (tempName == 'square') then + self % planeShape = 0 + self % area = self % surfSize**2 + else if (tempName == 'circle') then + self % planeShape = 1 + self % area = pi * self % surfSize**2 + else + call fatalError(Here, 'Shape must be "square" or "circle"') + end if + + ! Determine if dir is positive or negative along given axis + ! If equal to 0, emit from both sides + self % isIsotropic = .not. dict % isPresent('dir') + if (.not. self % isIsotropic) then + + call dict % get(temp, 'dir') + + if (temp == 0) then + self % dir = 0 + else + ! Set equal to +1 or -1 + self % dir = temp/abs(temp) + end if + + end if + + call dict % get(self % T, 'T') + call dict % get(self % deltaT, 'deltaT') + call dict % getOrDefault(self % N, 'N', 1) + + self % deltaT = 0.00000000001 + + end subroutine init + + !! + !! Add particles to given dungeon + !! + !! See source_inter for details + !! + !! If N is given as 0, then N is instead taken from the input dictionary defining this source + !! + subroutine append(self, dungeon, N, rand, matIdx) + class(bbSurfaceSource), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + integer(shortInt), intent(in), optional :: matIdx + integer(shortInt) :: i + type(RNG) :: pRand + character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' + + ! Set number to generate. Using 0 in function call will use N from input dictionary + if (N /= 0) self % N = N + + +! TODO Parallel for some reason isn't working here, even though changes are the same as IMCSource ??? + + ! Generate N particles to populate dungeon +! !$omp parallel +! pRand = rand +! !$omp do private(pRand) +! do i = 1, self % N +! call pRand % stride(i) +! call dungeon % detain(self % sampleParticle(pRand)) +! end do +! !$omp end do +! !$omp end parallel + + + do i = 1, self % N + call dungeon % detain(self % sampleParticle(rand)) + end do + + end subroutine append + + !! + !! Provide particle type + !! + !! See configSource_inter for details. + !! + subroutine sampleType(self, p, rand) + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + + p % type = self % particleType + + end subroutine sampleType + + !! + !! Provide particle position + !! + !! See configSource_inter for details. + !! + subroutine samplePosition(self, p, rand) + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal), dimension(3) :: prevPos + real(defReal) :: r1, r2, rad, theta + + if ( self % planeShape == 0 ) then ! Square + + prevPos = self % r + + ! Set new x, y and z coords + self % r(1) = (rand % get()-0.5) * self % surfSize + self % r(2) = (rand % get()-0.5) * self % surfSize + self % r(3) = (rand % get()-0.5) * self % surfSize + ! Leave position along normal axis unchanged + self % r(self % axis) = prevPos(self % axis) + + else ! Circle + rad = rand % get() * self % surfSize + theta = rand % get() * 2 * pi + + r1 = rad * cos(theta) + r2 = rad * sin(theta) + + if(self % axis == 1) then ! Set y and z + self % r(2) = r1 + self % r(3) = r2 + else if(self % axis == 2) then ! Set x and z + self % r(1) = r1 + self % r(3) = r2 + else ! Set x and y + self % r(1) = r1 + self % r(2) = r2 + end if + + end if + + p % r = self % r + + end subroutine samplePosition + + !! + !! Provide angle or sample if isotropic + !! + !! See configSource_inter for details. + !! + !! Only isotropic/fixed direction. Does not sample energy. + !! + subroutine sampleEnergyAngle(self, p, rand) + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: phi, mu + + phi = TWO_PI * rand % get() + mu = sqrt(rand % get()) + + p % dir = [mu, sqrt(1-mu**2)*cos(phi), sqrt(1-mu**2)*sin(phi)] + + ! If dir not equal to zero, adjust so that particles are travelling in correct direction + if (self % dir /= 0) then + p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir + end if + + + end subroutine sampleEnergyAngle + + !! + !! Provide particle energy, currently only a single group + !! + !! See configSource_inter for details. + !! + subroutine sampleEnergy(self, p, rand) + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: num + + p % isMG = .true. + p % G = 1 + + end subroutine sampleEnergy + + !! + !! Provide particle energy-weight + !! + !! Sampled as a black body surface, see "Four Decades of Implicit Monte Carlo", + !! Allan B Wollaber, p.24-25 + !! + !! See configSource_inter for details. + !! + subroutine sampleWeight(self, p, rand) + class(bbSurfaceSource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: num + + num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * self % area + p % wgt = num / (4 * self % N) + + ! If dir = 0 then emit in both directions => double total energy + if (self % dir == 0) p % wgt = 2*p % wgt + + end subroutine sampleWeight + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(bbSurfaceSource), intent(inout) :: self + + ! Kill superclass + call kill_super(self) + + ! Kill local components + self % r = ZERO + self % dir = ZERO + self % particleType = P_PHOTON + self % isMG = .true. + self % isIsotropic = .false. + + end subroutine kill + +end module bbSurfaceSource_class diff --git a/PhysicsPackages/CMakeLists.txt b/PhysicsPackages/CMakeLists.txt index 80ddb378c..8ddb23af6 100644 --- a/PhysicsPackages/CMakeLists.txt +++ b/PhysicsPackages/CMakeLists.txt @@ -4,8 +4,7 @@ add_sources( ./physicsPackage_inter.f90 ./physicsPackageFactory_func.f90 ./eigenPhysicsPackage_class.f90 ./fixedSourcePhysicsPackage_class.f90 - ./IMCPhysicsPackage_class.f90 - ./ISMCPhysicsPackage_class.f90 + ./implicitPhysicsPackage_class.f90 ./vizPhysicsPackage_class.f90 ./rayVolPhysicsPackage_class.f90 ) diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 new file mode 100644 index 000000000..01911bf81 --- /dev/null +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -0,0 +1,584 @@ +module implicitPhysicsPackage_class + + use numPrecision + use universalVariables + use endfConstants + use genericProcedures, only : fatalError, printFishLineR, numToChar, rotateVector + use hashFunctions_func, only : FNV_1 + use dictionary_class, only : dictionary + use outputFile_class, only : outputFile + + ! Timers + use timer_mod, only : registerTimer, timerStart, timerStop, & + timerTime, timerReset, secToChar + + ! Particle classes and Random number generator + use particle_class, only : particle, P_PHOTON, P_MATERIAL + use particleDungeon_class, only : particleDungeon + use source_inter, only : source + use RNG_class, only : RNG + + ! Physics package interface + use physicsPackage_inter, only : physicsPackage + + ! Geometry + use geometry_inter, only : geometry + use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & + gr_geomIdx => geomIdx + use discretiseGeom_class, only : discretise + + ! Nuclear Data + use materialMenu_mod, only : mm_nMat => nMat ,& + mm_matName => matName + use nuclearDataReg_mod, only : ndReg_init => init ,& + ndReg_activate => activate ,& + ndReg_display => display, & + ndReg_kill => kill, & + ndReg_get => get ,& + ndReg_getMatNames => getMatNames + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast + use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast + + ! Operators + use collisionOperator_class, only : collisionOperator + use transportOperator_inter, only : transportOperator + + ! Tallies + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + use tallyResult_class, only : tallyResult + use absorptionClerk_class, only : absClerkResult + + ! Factories + use transportOperatorFactory_func, only : new_transportOperator + use sourceFactory_func, only : new_source + + use simulationTime_class + + implicit none + + private + + ! Calculation Type + integer(shortInt), parameter, public :: IMC = 1 + integer(shortInt), parameter, public :: ISMC = 2 + + !! + !! Physics Package for IMC calculations + !! + type, public,extends(physicsPackage) :: implicitPhysicsPackage + private + ! Building blocks + class(mgIMCDatabase), pointer :: nucData => null() + class(geometry), pointer :: geom => null() + integer(shortInt) :: geomIdx = 0 + type(collisionOperator) :: collOp + class(transportOperator), allocatable :: transOp + class(RNG), pointer :: pRNG => null() + type(tallyAdmin),pointer :: tally => null() + type(tallyAdmin),pointer :: imcWeightAtch => null() + + ! Settings + integer(shortInt) :: N_steps + integer(shortInt) :: pop + integer(shortInt) :: limit + integer(shortInt) :: method + character(pathLen) :: outputFile + character(nameLen) :: outputFormat + integer(shortInt) :: printSource = 0 + logical(defBool) :: sourceGiven = .false. + integer(shortInt) :: nMat + integer(shortInt) :: printUpdates + + ! Calculation components + type(particleDungeon), pointer :: thisStep => null() + type(particleDungeon), pointer :: nextStep => null() + type(particleDungeon), pointer :: temp_dungeon => null() + class(source), allocatable :: inputSource + class(source), allocatable :: matSource + + ! Timer bins + integer(shortInt) :: timerMain + real (defReal) :: CPU_time_start + real (defReal) :: CPU_time_end + + contains + procedure :: init + procedure :: printSettings + procedure :: steps + procedure :: collectResults + procedure :: run + procedure :: kill + + end type implicitPhysicsPackage + +contains + + subroutine run(self) + class(implicitPhysicsPackage), intent(inout) :: self + + print *, repeat("<>",50) + print *, "/\/\ IMPLICIT CALCULATION /\/\" + + call self % steps(self % tally, self % imcWeightAtch, self % N_steps) + call self % collectResults() + + print * + print *, "\/\/ END OF IMPLICIT CALCULATION \/\/" + print * + end subroutine + + !! + !! Run steps for calculation + !! + subroutine steps(self, tally, tallyAtch, N_steps) + class(implicitPhysicsPackage), intent(inout) :: self + type(tallyAdmin), pointer,intent(inout) :: tally + type(tallyAdmin), pointer,intent(inout) :: tallyAtch + integer(shortInt), intent(in) :: N_steps + integer(shortInt) :: i, j, N, nFromMat, num, nParticles + type(particle), save :: p + real(defReal) :: sourceWeight, elapsed_T, end_T, T_toEnd + real(defReal), dimension(:), allocatable :: tallyEnergy + class(IMCMaterial), pointer :: mat + character(100),parameter :: Here ='steps (implicitPhysicsPackage_class.f90)' + class(tallyResult), allocatable :: tallyRes + type(collisionOperator), save :: collOp + class(transportOperator), allocatable, save :: transOp + type(RNG), target, save :: pRNG + !$omp threadprivate(p, collOp, transOp, pRNG) + + !$omp parallel + p % geomIdx = self % geomIdx + + ! Create a collision + transport operator which can be made thread private + collOp = self % collOp + transOp = self % transOp + + !$omp end parallel + + ! Reset and start timer + call timerReset(self % timerMain) + call timerStart(self % timerMain) + + allocate(tallyEnergy(self % nMat)) + + do i=1,N_steps + + ! Update tracking grid if needed by transport operator + if (associated(self % transOp % grid)) call self % transOp % grid % update() + + ! Swap dungeons to store photons remaining from previous time step + self % temp_dungeon => self % nextStep + self % nextStep => self % thisStep + self % thisStep => self % temp_dungeon + call self % nextStep % cleanPop() + + ! Generate particles for IMC from material emission + if (self % method == IMC) then + ! Reduce number of particles to generate if close to limit + N = self % pop + if (N + self % thisStep % popSize() > self % limit) then + ! Fleck and Cummings IMC Paper, eqn 4.11 + N = self % limit - self % thisStep % popSize() - self % nMat - 1 + end if + + ! Calculate proportion to be generated from input source + sourceWeight = self % inputSource % sourceWeight + if (self % inputSource % sourceWeight == 0) then + nFromMat = N + else + nFromMat = int(N * (1 - sourceWeight/(sourceWeight + self % nucData % getEmittedRad()))) + end if + + ! Add to dungeon particles emitted from material + call self % matSource % append(self % thisStep, nFromMat, self % pRNG) + + else if (i == 1) then + ! Generate starting population of material particles for ISMC + call self % matSource % append(self % thisStep, self % pop, self % pRNG) + + end if + + ! Generate from input source + if( self % sourceGiven ) then + call self % inputSource % append(self % thisStep, N - nFromMat, self % pRNG) + end if + + if(self % printSource == 1) then + call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) + end if + + call tally % reportCycleStart(self % thisStep) + + nParticles = self % thisStep % popSize() + + !$omp parallel do schedule(dynamic) + gen: do num = 1, nParticles + + ! Create RNG which can be thread private + pRNG = self % pRNG + p % pRNG => pRNG + call p % pRNG % stride(num) + + ! Obtain paticle from dungeon + call self % thisStep % release(p) + call self % geom % placeCoord(p % coords) + + ! Check particle type + if (p % getType() /= P_PHOTON_MG .and. p % getType() /= P_MATERIAL_MG) then + call fatalError(Here, 'Particle is not of type P_PHOTON_MG or P_MATERIAL_MG') + end if + + ! Assign maximum particle time + p % timeMax = timeStep() * i + + ! For newly sourced particles, sample time uniformly within time step + if (p % time == ZERO) call fatalError(Here, 'Particle time is 0') + + ! Check for time errors + if (p % time >= p % timeMax .or. p % time < timeStep()*(i-1)) then + call fatalError(Here, 'Particle time is not within timestep bounds') + else if (p % time /= p % time) then + call fatalError(Here, 'Particle time is NaN') + end if + + ! Save state + call p % savePreHistory() + + ! Transport particle until its death + history: do + call transOp % transport(p, tally, self % thisStep, self % nextStep) + if(p % isDead) exit history + + if(p % fate == AGED_FATE) then + ! Store particle for use in next time step + p % fate = 0 + call self % nextStep % detain(p) + exit history + end if + + call collOp % collide(p, tally, self % thisStep, self % nextStep) + + ! Cycle if particle history not yet completed + if (self % method == ISMC .or. p % type == P_PHOTON) cycle history + + ! If P_MATERIAL and IMC, kill particle and exit + p % isDead = .true. + p % fate = ABS_FATE + call tally % reportHist(p) + exit history + + end do history + + end do gen + !$omp end parallel do + + ! Update RNG + call self % pRNG % stride(nParticles) + + ! Send end of time step report + call tally % reportCycleEnd(self % thisStep) + + ! Calculate times + call timerStop(self % timerMain) + elapsed_T = timerTime(self % timerMain) + + ! Predict time to end + end_T = real(N_steps,defReal) * elapsed_T / i + T_toEnd = max(ZERO, end_T - elapsed_T) + + ! Display progress + call printFishLineR(i) + print * + print * + print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_steps) + print *, 'Pop: ', numToChar(self % nextStep % popSize()) + 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() + + ! Obtain energy deposition tally results + call tallyAtch % getResult(tallyRes, 'imcWeightTally') + + select type(tallyRes) + class is(absClerkResult) + do j = 1, self % nMat + tallyEnergy(j) = tallyRes % clerkResults(j) + end do + class default + call fatalError(Here, 'Tally result class should be absClerkResult') + end select + + ! Update material properties + call self % nucData % updateProperties(tallyEnergy, self % printUpdates) + + ! Reset tally for next time step + call tallyAtch % reset('imcWeightTally') + + ! Advance to next time step + call nextStep() + + end do + + ! Output final mat temperatures + open(unit = 10, file = 'temps.txt') + do j = 1, self % nMat + mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) + write(10, '(8A)') mm_matName(j), numToChar(mat % getTemp()) + end do + close(10) + + end subroutine steps + + !! + !! Print calculation results to file + !! + subroutine collectResults(self) + class(implicitPhysicsPackage), intent(inout) :: self + type(outputFile) :: out + character(nameLen) :: name + + call out % init(self % outputFormat) + + name = 'seed' + call out % printValue(self % pRNG % getSeed(),name) + + name = 'pop' + call out % printValue(self % pop,name) + + name = 'Source_batches' + call out % printValue(self % N_steps,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 = 'Transport_time' + call out % printValue(timerTime(self % timerMain),name) + + ! Print tally + call self % tally % print(out) + + call out % writeToFile(self % outputFile) + + end subroutine collectResults + + + !! + !! Initialise from individual components and dictionaries for source and tally + !! + subroutine init(self, dict) + class(implicitPhysicsPackage), intent(inout) :: self + class(dictionary), intent(inout) :: dict + class(dictionary), pointer :: tempDict, geomDict, dataDict + type(dictionary) :: locDict1, locDict2, locDict3, locDict4 + integer(shortInt) :: seed_temp + integer(longInt) :: seed + character(10) :: time + character(8) :: date + character(:),allocatable :: string + character(nameLen) :: nucData, geomName + type(outputFile) :: test_out + integer(shortInt) :: i + character(nameLen), dimension(:), allocatable :: mats + integer(shortInt), dimension(:), allocatable :: latSizeN + real(defReal) :: timeStep + type(dictionary),target :: newGeom, newData + character(nameLen) :: method + character(100), parameter :: Here ='init (implicitPhysicsPackage_class.f90)' + + call cpu_time(self % CPU_time_start) + + ! Get method + call dict % getOrDefault(method, 'method', 'IMC') + select case(method) + case ('IMC') + self % method = IMC + case('ISMC') + self % method = ISMC + case default + call fatalError(Here, 'Unrecognised method') + end select + + ! Read calculation settings + call dict % get(self % pop,'pop') + call dict % get(self % limit, 'limit') + call dict % get(self % N_steps,'steps') + call dict % get(timeStep,'timeStepSize') + call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) + nucData = 'mg' + + call setStep(timeStep) + + ! 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) + + ! Register timer + self % timerMain = registerTimer('transportTime') + + ! Initialise RNG + allocate(self % pRNG) + + ! *** It is a bit silly but dictionary cannot store longInt for now + ! so seeds are limited to 32 bits (can be -ve) + 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 % pRNG % init(seed) + + ! Read whether to print particle source each time step + call dict % getOrDefault(self % printSource, 'printSource', 0) + + ! Automatically split geometry into a uniform grid + if (dict % isPresent('discretise')) then + + ! Store dimensions of lattice + tempDict => dict % getDictPtr('discretise') + call tempDict % get(latSizeN, 'dimensions') + + ! Create new input + call discretise(dict, newGeom, newData) + + geomDict => newGeom + dataDict => newData + + else + geomDict => dict % getDictPtr("geometry") + dataDict => dict % getDictPtr("nuclearData") + + end if + + ! Build Nuclear Data + call ndReg_init(dataDict) + + ! Build geometry + geomName = 'IMCGeom' + call gr_addGeom(geomName, geomDict) + self % geomIdx = gr_geomIdx(geomName) + self % geom => gr_geomPtr(self % geomIdx) + + ! Activate Nuclear Data *** All materials are active + call ndReg_activate(P_PHOTON_MG, nucData, self % geom % activeMats()) + self % nucData => mgIMCDatabase_CptrCast(ndReg_get(P_PHOTON_MG)) + + call newGeom % kill() + call newData % kill() + + ! Initialise material source + if (dict % isPresent('matSource')) then + tempDict => dict % getDictPtr('matSource') + call new_source(self % matSource, tempDict, self % geom) + else + call locDict1 % init(2) + call locDict1 % store('type', 'materialSource') + ! Tell source if we are using IMC or ISMC + call locDict1 % store('calcType', self % method) + call new_source(self % matSource, locDict1, self % geom) + call locDict1 % kill() + end if + + ! Read external particle source definition + if( dict % isPresent('source') ) then + tempDict => dict % getDictPtr('source') + call new_source(self % inputSource, tempDict, self % geom) + self % sourceGiven = .true. + end if + + ! Build collision operator + tempDict => dict % getDictPtr('collisionOperator') + call self % collOp % init(tempDict) + + ! Build transport operator + tempDict => dict % getDictPtr('transportOperator') + call new_transportOperator(self % transOp, tempDict) + + ! Initialise tally Admin + tempDict => dict % getDictPtr('tally') + allocate(self % tally) + call self % tally % init(tempDict) + + ! Provide materials with calculation type + call self % nucData % setCalcType(self % method) + + ! Store number of materials + self % nMat = mm_nMat() + self % printUpdates = min(self % printUpdates, self % nMat) + + ! Create array of material names + allocate(mats(self % nMat)) + do i=1, self % nMat + mats(i) = mm_matName(i) + end do + + ! Initialise imcWeight tally attachment + call locDict1 % init(1) + call locDict2 % init(4) + call locDict3 % init(2) + call locDict4 % init(1) + + call locDict4 % store('type', 'weightResponse') + call locDict3 % store('type','materialMap') + call locDict3 % store('materials', [mats]) + call locDict2 % store('response', ['imcWeightResponse']) + call locDict2 % store('imcWeightResponse', locDict4) + call locDict2 % store('type','absorptionClerk') + call locDict2 % store('map', locDict3) + call locDict1 % store('imcWeightTally', locDict2) + + allocate(self % imcWeightAtch) + call self % imcWeightAtch % init(locDict1) + + call self % tally % push(self % imcWeightAtch) + + ! Size particle dungeons + allocate(self % thisStep) + call self % thisStep % init(self % limit) + allocate(self % nextStep) + call self % nextStep % init(self % limit) + + call self % printSettings() + + end subroutine init + + !! + !! Deallocate memory + !! + subroutine kill(self) + class(implicitPhysicsPackage), intent(inout) :: self + + ! TODO: This subroutine + + end subroutine kill + + !! + !! Print settings of the physics package + !! + subroutine printSettings(self) + class(implicitPhysicsPackage), intent(in) :: self + + print *, repeat("<>",50) + print *, "/\/\ IMC CALCULATION /\/\" + print *, "Source batches: ", numToChar(self % N_steps) + print *, "Population per batch: ", numToChar(self % pop) + print *, "Initial RNG Seed: ", numToChar(self % pRNG % getSeed()) + print * + print *, repeat("<>",50) + end subroutine printSettings + +end module implicitPhysicsPackage_class diff --git a/PhysicsPackages/physicsPackageFactory_func.f90 b/PhysicsPackages/physicsPackageFactory_func.f90 index f44bd5e32..e01a1fcaf 100644 --- a/PhysicsPackages/physicsPackageFactory_func.f90 +++ b/PhysicsPackages/physicsPackageFactory_func.f90 @@ -15,8 +15,7 @@ module physicsPackageFactory_func use fixedSourcePhysicsPackage_class, only : fixedSourcePhysicsPackage use vizPhysicsPackage_class, only : vizPhysicsPackage use rayVolPhysicsPackage_class, only : rayVolPhysicsPackage - use IMCPhysicsPackage_class, only : IMCPhysicsPackage - use ISMCPhysicsPackage_class, only : ISMCPhysicsPackage + use implicitPhysicsPackage_class, only : implicitPhysicsPackage implicit none private @@ -28,8 +27,7 @@ module physicsPackageFactory_func ! For now it is necessary to adjust trailing blanks so all enteries have the same length character(nameLen),dimension(*),parameter :: AVAILABLE_physicsPackages = [ 'eigenPhysicsPackage ',& 'fixedSourcePhysicsPackage',& - 'IMCPhysicsPackage ',& - 'ISMCPhysicsPackage ',& + 'implicitPhysicsPackage ',& 'vizPhysicsPackage ',& 'rayVolPhysicsPackage '] @@ -74,19 +72,11 @@ function new_physicsPackage(dict) result(new) call new % init(dict) end select - case('IMCPhysicsPackage') + case('implicitPhysicsPackage') ! Allocate and initialise - allocate( IMCPhysicsPackage :: new) + allocate( implicitPhysicsPackage :: new) select type(new) - type is (IMCPhysicsPackage) - call new % init(dict) - end select - - case('ISMCPhysicsPackage') - ! Allocate and initialise - allocate( ISMCPhysicsPackage :: new) - select type(new) - type is (ISMCPhysicsPackage) + type is (implicitPhysicsPackage) call new % init(dict) end select diff --git a/SharedModules/CMakeLists.txt b/SharedModules/CMakeLists.txt index fd028b8a4..1bb20d435 100644 --- a/SharedModules/CMakeLists.txt +++ b/SharedModules/CMakeLists.txt @@ -13,7 +13,8 @@ add_sources( ./genericProcedures.f90 ./timer_mod.f90 ./charLib_func.f90 ./poly_func.f90 - ./openmp_func.f90) + ./openmp_func.f90 + ./simulationTime_class.f90) add_unit_tests( ./Tests/grid_test.f90 ./Tests/energyGrid_test.f90 diff --git a/SharedModules/simulationTime_class.f90 b/SharedModules/simulationTime_class.f90 new file mode 100644 index 000000000..c9fb5f60f --- /dev/null +++ b/SharedModules/simulationTime_class.f90 @@ -0,0 +1,82 @@ + +module simulationTime_class + + use numPrecision + use genericProcedures, only : fatalError + + implicit none + private + + !! + !! Simple module to keep track of simulation time for time-dependent calculations + !! + !! Allows easy public access to time step and current time, and provides a single interface to + !! change time step for calculations with a variable time step, rather than needing to update the + !! time step separately in all required modules (source, material, etc.) + !! + type, public :: simulationTime + real(defReal) :: step = ONE + real(defReal) :: now = ZERO + end type simulationTime + + type(simulationTime), public :: time + + public :: setStep + public :: nextStep + public :: timeStep + public :: timeNow + public :: timeLeft + +contains + + !! + !! Set time step + !! + subroutine setStep(dt) + real(defReal), intent(in) :: dt + character(100), parameter :: Here = 'set (timeStep_class.f90)' + + if (dt <= ZERO) call fatalError(Here, 'Time step must be positive') + + time % step = dt + + end subroutine setStep + + !! + !! Advance time by one time step + !! + subroutine nextStep() + + time % now = time % now + time % step + + end subroutine nextStep + + !! + !! Return time step size + !! + function timeStep() result(dt) + real(defReal) :: dt + + dt = time % step + + end function timeStep + + function timeNow() result(t) + real(defReal) :: t + + t = time % now + + end function timeNow + + !! + !! Return time remaining until end of time step + !! + function timeLeft(t) result(remaining_t) + real(defReal), intent(in) :: t + real(defReal) :: remaining_t + + remaining_t = time % now + time % step - t + + end function timeLeft + +end module simulationTime_class From b7b0192d3d1c576e631865e37589bbefcfcb531c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Jul 2023 14:13:06 +0100 Subject: [PATCH 341/373] Deleted old PPs, added comments, removed unnecessary code, improved accuracy of time class --- .../Source/bbSurfaceSource_class.f90 | 4 +- .../Source/materialSource_class.f90 | 4 +- PhysicsPackages/IMCPhysicsPackage_class.f90 | 548 ------------------ PhysicsPackages/ISMCPhysicsPackage_class.f90 | 539 ----------------- .../implicitPhysicsPackage_class.f90 | 91 +-- SharedModules/simulationTime_class.f90 | 25 +- 6 files changed, 67 insertions(+), 1144 deletions(-) delete mode 100644 PhysicsPackages/IMCPhysicsPackage_class.f90 delete mode 100644 PhysicsPackages/ISMCPhysicsPackage_class.f90 diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index bb4528bbe..2d6a199fc 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -9,7 +9,7 @@ module bbSurfaceSource_class use configSource_inter, only : configSource, kill_super => kill use geometry_inter, only : geometry use RNG_class, only : RNG - use simulationTime_class, only : timeStep, timeNow + use simulationTime_class implicit none private @@ -283,7 +283,7 @@ subroutine sampleTime(self, p, rand) class(RNG), intent(inout) :: rand ! Sample time uniformly within time step - p % time = timeNow() + timeStep() * rand % get() + p % time = time % stepStart + timeStep() * rand % get() end subroutine sampleTime diff --git a/ParticleObjects/Source/materialSource_class.f90 b/ParticleObjects/Source/materialSource_class.f90 index f56ff8b44..ea191886d 100644 --- a/ParticleObjects/Source/materialSource_class.f90 +++ b/ParticleObjects/Source/materialSource_class.f90 @@ -19,7 +19,7 @@ module materialSource_class use materialMenu_mod, only : mm_nMat => nMat, & mm_matName => matName - use simulationTime_class, only : timeStep, timeNow + use simulationTime_class implicit none private @@ -273,7 +273,7 @@ function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) dir(3) = sqrt(1-mu**2) * sin(phi) ! Sample time uniformly within time step - p % time = timeNow() + timeStep() * rand % get() + p % time = time % stepStart + timeStep() * rand % get() ! Assign basic phase-space coordinates p % matIdx = matIdx diff --git a/PhysicsPackages/IMCPhysicsPackage_class.f90 b/PhysicsPackages/IMCPhysicsPackage_class.f90 deleted file mode 100644 index bcef48a7b..000000000 --- a/PhysicsPackages/IMCPhysicsPackage_class.f90 +++ /dev/null @@ -1,548 +0,0 @@ -module IMCPhysicsPackage_class - - use numPrecision - use universalVariables - use endfConstants - use genericProcedures, only : fatalError, printFishLineR, numToChar, rotateVector - use hashFunctions_func, only : FNV_1 - use dictionary_class, only : dictionary - use outputFile_class, only : outputFile - - ! Timers - use timer_mod, only : registerTimer, timerStart, timerStop, & - timerTime, timerReset, secToChar - - ! Particle classes and Random number generator - use particle_class, only : particle, P_PHOTON - use particleDungeon_class, only : particleDungeon - use source_inter, only : source - use RNG_class, only : RNG - - ! Physics package interface - use physicsPackage_inter, only : physicsPackage - - ! Geometry - use geometry_inter, only : geometry - use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & - gr_geomIdx => geomIdx - use discretiseGeom_class, only : discretise - - ! Nuclear Data - use materialMenu_mod, only : mm_nMat => nMat ,& - mm_matName => matName - use nuclearDataReg_mod, only : ndReg_init => init ,& - ndReg_activate => activate ,& - ndReg_display => display, & - ndReg_kill => kill, & - ndReg_get => get ,& - ndReg_getMatNames => getMatNames - use nuclearDatabase_inter, only : nuclearDatabase - use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast - use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast - - ! Operators - use collisionOperator_class, only : collisionOperator - use transportOperator_inter, only : transportOperator - - ! Tallies - use tallyCodes - use tallyAdmin_class, only : tallyAdmin - use tallyResult_class, only : tallyResult - use absorptionClerk_class, only : absClerkResult - - ! Factories - use transportOperatorFactory_func, only : new_transportOperator - use sourceFactory_func, only : new_source - - implicit none - - private - - !! - !! Physics Package for IMC calculations - !! - type, public,extends(physicsPackage) :: IMCPhysicsPackage - private - ! Building blocks - class(mgIMCDatabase), pointer :: nucData => null() - class(geometry), pointer :: geom => null() - integer(shortInt) :: geomIdx = 0 - type(collisionOperator) :: collOp - class(transportOperator), allocatable :: transOp - class(RNG), pointer :: pRNG => null() - type(tallyAdmin),pointer :: tally => null() - type(tallyAdmin),pointer :: imcWeightAtch => null() - - ! Settings - integer(shortInt) :: N_steps - integer(shortInt) :: pop - integer(shortInt) :: limit - real(defReal) :: deltaT - character(pathLen) :: outputFile - character(nameLen) :: outputFormat - integer(shortInt) :: printSource = 0 - integer(shortInt) :: particleType - logical(defBool) :: sourceGiven = .false. - integer(shortInt) :: nMat - integer(shortInt) :: printUpdates - - ! Calculation components - type(particleDungeon), pointer :: thisStep => null() - type(particleDungeon), pointer :: nextStep => null() - type(particleDungeon), pointer :: temp_dungeon => null() - class(source), allocatable :: inputSource - class(source), allocatable :: matSource - - ! Timer bins - integer(shortInt) :: timerMain - real (defReal) :: CPU_time_start - real (defReal) :: CPU_time_end - - contains - procedure :: init - procedure :: printSettings - procedure :: steps - procedure :: collectResults - procedure :: run - procedure :: kill - - end type IMCPhysicsPackage - -contains - - subroutine run(self) - class(IMCPhysicsPackage), intent(inout) :: self - - print *, repeat("<>",50) - print *, "/\/\ IMC CALCULATION /\/\" - - call self % steps(self % tally, self % imcWeightAtch, self % N_steps) - call self % collectResults() - - print * - print *, "\/\/ END OF IMC CALCULATION \/\/" - print * - end subroutine - - !! - !! Run steps for calculation - !! - subroutine steps(self, tally, tallyAtch, N_steps) - class(IMCPhysicsPackage), intent(inout) :: self - type(tallyAdmin), pointer,intent(inout) :: tally - type(tallyAdmin), pointer,intent(inout) :: tallyAtch - integer(shortInt), intent(in) :: N_steps - integer(shortInt) :: i, j, N, nFromMat, num, nParticles - type(particle), save :: p - real(defReal) :: sourceWeight, elapsed_T, end_T, T_toEnd - real(defReal), dimension(:), allocatable :: tallyEnergy - class(IMCMaterial), pointer :: mat - character(100),parameter :: Here ='steps (IMCPhysicsPackage_class.f90)' - class(tallyResult), allocatable :: tallyRes - type(collisionOperator), save :: collOp - class(transportOperator), allocatable, save :: transOp - type(RNG), target, save :: pRNG - !$omp threadprivate(p, collOp, transOp, pRNG) - - !$omp parallel - p % geomIdx = self % geomIdx - - ! Create a collision + transport operator which can be made thread private - collOp = self % collOp - transOp = self % transOp - - !$omp end parallel - - ! Reset and start timer - call timerReset(self % timerMain) - call timerStart(self % timerMain) - - allocate(tallyEnergy(self % nMat)) - - do i=1,N_steps - - ! Update tracking grid if needed by transport operator - if (associated(self % transOp % grid)) call self % transOp % grid % update() - - ! Swap dungeons to store photons remaining from previous time step - self % temp_dungeon => self % nextStep - self % nextStep => self % thisStep - self % thisStep => self % temp_dungeon - call self % nextStep % cleanPop() - - ! Reduce number of particles to generate if close to limit - N = self % pop - if (N + self % thisStep % popSize() > self % limit) then - ! Fleck and Cummings IMC Paper, eqn 4.11 - N = self % limit - self % thisStep % popSize() - self % nMat - 1 - end if - - ! Calculate proportion to be generated from input source - sourceWeight = self % inputSource % sourceWeight - if (self % inputSource % sourceWeight == 0) then - nFromMat = N - else - nFromMat = int(N * (1 - sourceWeight/(sourceWeight + self % nucData % getEmittedRad()))) - end if - - ! Add to dungeon particles emitted from material - call self % matSource % append(self % thisStep, nFromMat, self % pRNG) - - ! Generate from input source - if( self % sourceGiven ) then - call self % inputSource % append(self % thisStep, N - nFromMat, self % pRNG) - end if - - if(self % printSource == 1) then - call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) - end if - - call tally % reportCycleStart(self % thisStep) - - nParticles = self % thisStep % popSize() - - !$omp parallel do schedule(dynamic) - gen: do num = 1, nParticles - - ! Create RNG which can be thread private - pRNG = self % pRNG - p % pRNG => pRNG - call p % pRNG % stride(num) - - ! Obtain paticle from dungeon - call self % thisStep % release(p) - call self % geom % placeCoord(p % coords) - - ! Check particle type - if (p % getType() /= P_PHOTON_MG) then - call fatalError(Here, 'Particle is not of type P_PHOTON_MG') - end if - - ! Assign maximum particle time - p % timeMax = self % deltaT * i - - ! For newly sourced particles, sample time uniformly within time step - if (p % time == ZERO) then - p % time = (p % pRNG % get() + i-1) * self % deltaT - end if - - ! Check for time errors - if (p % time >= p % timeMax .or. p % time < self % deltaT*(i-1)) then - call fatalError(Here, 'Particle time is not within timestep bounds') - else if (p % time /= p % time) then - call fatalError(Here, 'Particle time is NaN') - end if - - ! Save state - call p % savePreHistory() - - ! Transport particle until its death - history: do - call transOp % transport(p, tally, self % thisStep, self % nextStep) - if(p % isDead) exit history - - if(p % fate == AGED_FATE) then - ! Store particle for use in next time step - p % fate = 0 - call self % nextStep % detain(p) - exit history - end if - - call collOp % collide(p, tally, self % thisStep, self % nextStep) - - if(p % isDead) exit history - - end do history - - end do gen - !$omp end parallel do - - ! Update RNG - call self % pRNG % stride(nParticles) - - ! Send end of time step report - call tally % reportCycleEnd(self % thisStep) - - ! Calculate times - call timerStop(self % timerMain) - elapsed_T = timerTime(self % timerMain) - - ! Predict time to end - end_T = real(N_steps,defReal) * elapsed_T / i - T_toEnd = max(ZERO, end_T - elapsed_T) - - ! Display progress - call printFishLineR(i) - print * - print * - print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_steps) - print *, 'Pop: ', numToChar(self % nextStep % popSize()) - 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() - - ! Obtain energy deposition tally results - call tallyAtch % getResult(tallyRes, 'imcWeightTally') - - select type(tallyRes) - class is(absClerkResult) - do j = 1, self % nMat - tallyEnergy(j) = tallyRes % clerkResults(j) - end do - class default - call fatalError(Here, 'Tally result class should be absClerkResult') - end select - - ! Update material properties - call self % nucData % updateProperties(tallyEnergy, self % printUpdates) - - ! Reset tally for next time step - call tallyAtch % reset('imcWeightTally') - - end do - - ! Output final mat temperatures - open(unit = 10, file = 'temps.txt') - do j = 1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - write(10, '(8A)') mm_matName(j), numToChar(mat % getTemp()) - end do - close(10) - - end subroutine steps - - !! - !! Print calculation results to file - !! - subroutine collectResults(self) - class(IMCPhysicsPackage), intent(inout) :: self - type(outputFile) :: out - character(nameLen) :: name - - call out % init(self % outputFormat) - - name = 'seed' - call out % printValue(self % pRNG % getSeed(),name) - - name = 'pop' - call out % printValue(self % pop,name) - - name = 'Source_batches' - call out % printValue(self % N_steps,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 = 'Transport_time' - call out % printValue(timerTime(self % timerMain),name) - - ! Print tally - call self % tally % print(out) - - call out % writeToFile(self % outputFile) - - end subroutine collectResults - - - !! - !! Initialise from individual components and dictionaries for source and tally - !! - subroutine init(self, dict) - class(IMCPhysicsPackage), intent(inout) :: self - class(dictionary), intent(inout) :: dict - class(dictionary), pointer :: tempDict, geomDict, dataDict - type(dictionary) :: locDict1, locDict2, locDict3, locDict4 - integer(shortInt) :: seed_temp - integer(longInt) :: seed - character(10) :: time - character(8) :: date - character(:),allocatable :: string - character(nameLen) :: nucData, geomName - type(outputFile) :: test_out - integer(shortInt) :: i - character(nameLen), dimension(:), allocatable :: mats - integer(shortInt), dimension(:), allocatable :: latSizeN - type(dictionary),target :: newGeom, newData - character(100), parameter :: Here ='init (IMCPhysicsPackage_class.f90)' - - call cpu_time(self % CPU_time_start) - - ! Read calculation settings - call dict % get(self % pop,'pop') - call dict % get(self % limit, 'limit') - call dict % get(self % N_steps,'steps') - call dict % get(self % deltaT,'timeStepSize') - call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) - self % particleType = P_PHOTON_MG - nucData = 'mg' - - ! 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) - - ! Register timer - self % timerMain = registerTimer('transportTime') - - ! Initialise RNG - allocate(self % pRNG) - - ! *** It is a bit silly but dictionary cannot store longInt for now - ! so seeds are limited to 32 bits (can be -ve) - 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 % pRNG % init(seed) - - ! Read whether to print particle source each time step - call dict % getOrDefault(self % printSource, 'printSource', 0) - - ! Automatically split geometry into a uniform grid - if (dict % isPresent('discretise')) then - - ! Store dimensions of lattice - tempDict => dict % getDictPtr('discretise') - call tempDict % get(latSizeN, 'dimensions') - - ! Create new input - call discretise(dict, newGeom, newData) - - geomDict => newGeom - dataDict => newData - - else - geomDict => dict % getDictPtr("geometry") - dataDict => dict % getDictPtr("nuclearData") - - end if - - ! Build Nuclear Data - call ndReg_init(dataDict) - - ! Build geometry - geomName = 'IMCGeom' - call gr_addGeom(geomName, geomDict) - 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()) - self % nucData => mgIMCDatabase_CptrCast(ndReg_get(self % particleType)) - - call newGeom % kill() - call newData % kill() - - ! Initialise IMC source - if (dict % isPresent('matSource')) then - tempDict => dict % getDictPtr('matSource') - call new_source(self % matSource, tempDict, self % geom) - else - call locDict1 % init(1) - call locDict1 % store('type', 'materialSource') - call new_source(self % matSource, locDict1, self % geom) - call locDict1 % kill() - end if - - ! Read external particle source definition - if( dict % isPresent('source') ) then - tempDict => dict % getDictPtr('source') - call tempDict % store('deltaT', self % deltaT) - call new_source(self % inputSource, tempDict, self % geom) - self % sourceGiven = .true. - end if - - ! Build collision operator - tempDict => dict % getDictPtr('collisionOperator') - call self % collOp % init(tempDict) - - ! Build transport operator - tempDict => dict % getDictPtr('transportOperator') - call new_transportOperator(self % transOp, tempDict) - - ! Initialise tally Admin - tempDict => dict % getDictPtr('tally') - allocate(self % tally) - call self % tally % init(tempDict) - - ! Provide materials with time step - call self % nucData % setTimeStep(self % deltaT) - - ! Store number of materials - self % nMat = mm_nMat() - self % printUpdates = min(self % printUpdates, self % nMat) - - ! Create array of material names - allocate(mats(self % nMat)) - do i=1, self % nMat - mats(i) = mm_matName(i) - end do - - ! Initialise imcWeight tally attachment - call locDict1 % init(1) - call locDict2 % init(4) - call locDict3 % init(2) - call locDict4 % init(1) - - call locDict4 % store('type', 'weightResponse') - call locDict3 % store('type','materialMap') - call locDict3 % store('materials', [mats]) - call locDict2 % store('response', ['imcWeightResponse']) - call locDict2 % store('imcWeightResponse', locDict4) - call locDict2 % store('type','absorptionClerk') - call locDict2 % store('map', locDict3) - call locDict1 % store('imcWeightTally', locDict2) - - allocate(self % imcWeightAtch) - call self % imcWeightAtch % init(locDict1) - - call self % tally % push(self % imcWeightAtch) - - ! Size particle dungeons - allocate(self % thisStep) - call self % thisStep % init(self % limit) - allocate(self % nextStep) - call self % nextStep % init(self % limit) - - call self % printSettings() - - end subroutine init - - !! - !! Deallocate memory - !! - subroutine kill(self) - class(IMCPhysicsPackage), intent(inout) :: self - - ! TODO: This subroutine - - end subroutine kill - - !! - !! Print settings of the physics package - !! - subroutine printSettings(self) - class(IMCPhysicsPackage), intent(in) :: self - - print *, repeat("<>",50) - print *, "/\/\ IMC CALCULATION /\/\" - print *, "Source batches: ", numToChar(self % N_steps) - print *, "Population per batch: ", numToChar(self % pop) - print *, "Initial RNG Seed: ", numToChar(self % pRNG % getSeed()) - print * - print *, repeat("<>",50) - end subroutine printSettings - -end module IMCPhysicsPackage_class diff --git a/PhysicsPackages/ISMCPhysicsPackage_class.f90 b/PhysicsPackages/ISMCPhysicsPackage_class.f90 deleted file mode 100644 index 27aac26df..000000000 --- a/PhysicsPackages/ISMCPhysicsPackage_class.f90 +++ /dev/null @@ -1,539 +0,0 @@ -module ISMCPhysicsPackage_class - - use numPrecision - use universalVariables - use endfConstants - use genericProcedures, only : fatalError, printFishLineR, numToChar, rotateVector - use hashFunctions_func, only : FNV_1 - use dictionary_class, only : dictionary - use outputFile_class, only : outputFile - - ! Timers - use timer_mod, only : registerTimer, timerStart, timerStop, & - timerTime, timerReset, secToChar - - ! Particle classes and Random number generator - use particle_class, only : particle, P_PHOTON, P_MATERIAL - use particleDungeon_class, only : particleDungeon - use source_inter, only : source - use RNG_class, only : RNG - - ! Physics package interface - use physicsPackage_inter, only : physicsPackage - - ! Geometry - use geometry_inter, only : geometry - use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & - gr_geomIdx => geomIdx - use discretiseGeom_class, only : discretise - - ! Nuclear Data - use materialMenu_mod, only : mm_nMat => nMat ,& - mm_matName => matName - use nuclearDataReg_mod, only : ndReg_init => init ,& - ndReg_activate => activate ,& - ndReg_display => display, & - ndReg_kill => kill, & - ndReg_get => get ,& - ndReg_getMatNames => getMatNames - use nuclearDatabase_inter, only : nuclearDatabase - use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast - use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast - - ! Operators - use collisionOperator_class, only : collisionOperator - use transportOperator_inter, only : transportOperator - - ! Tallies - use tallyCodes - use tallyAdmin_class, only : tallyAdmin - use tallyResult_class, only : tallyResult - use absorptionClerk_class, only : absClerkResult - - ! Factories - use transportOperatorFactory_func, only : new_transportOperator - use sourceFactory_func, only : new_source - - implicit none - - private - - !! - !! Physics Package for IMC calculations - !! - type, public,extends(physicsPackage) :: ISMCPhysicsPackage - private - ! Building blocks -! class(nuclearDatabase), pointer :: nucData => null() - class(mgIMCDatabase), pointer :: nucData => null() - class(geometry), pointer :: geom => null() - integer(shortInt) :: geomIdx = 0 - type(collisionOperator) :: collOp - class(transportOperator), allocatable :: transOp - class(RNG), pointer :: pRNG => null() - type(tallyAdmin),pointer :: tally => null() - type(tallyAdmin),pointer :: imcWeightAtch => null() - - ! Settings - integer(shortInt) :: N_steps - integer(shortInt) :: pop - integer(shortInt) :: limit - real(defReal) :: deltaT - character(pathLen) :: outputFile - character(nameLen) :: outputFormat - integer(shortInt) :: printSource = 0 - integer(shortInt) :: particleType - logical(defBool) :: sourceGiven = .false. - integer(shortInt) :: nMat - integer(shortInt) :: printUpdates - - ! Calculation components - type(particleDungeon), pointer :: thisStep => null() - type(particleDungeon), pointer :: nextStep => null() - type(particleDungeon), pointer :: temp_dungeon => null() - class(source), allocatable :: inputSource - class(source), allocatable :: matSource - - ! Timer bins - integer(shortInt) :: timerMain - real (defReal) :: CPU_time_start - real (defReal) :: CPU_time_end - - contains - procedure :: init - procedure :: printSettings - procedure :: steps - procedure :: collectResults - procedure :: run - procedure :: kill - - end type ISMCPhysicsPackage - -contains - - subroutine run(self) - class(ISMCPhysicsPackage), intent(inout) :: self - - print *, repeat("<>",50) - print *, "/\/\ IMC CALCULATION /\/\" - - call self % steps(self % tally, self % imcWeightAtch, self % N_steps) - call self % collectResults() - - print * - print *, "\/\/ END OF IMC CALCULATION \/\/" - print * - end subroutine - - !! - !! Run steps for calculation - !! - subroutine steps(self, tally, tallyAtch, N_steps) - class(ISMCPhysicsPackage), intent(inout) :: self - type(tallyAdmin), pointer,intent(inout) :: tally - type(tallyAdmin), pointer,intent(inout) :: tallyAtch - integer(shortInt), intent(in) :: N_steps - integer(shortInt) :: i, j, N, num, nParticles - type(particle), save :: p - real(defReal) :: elapsed_T, end_T, T_toEnd - real(defReal), dimension(:), allocatable :: tallyEnergy - class(IMCMaterial), pointer :: mat - character(100),parameter :: Here ='steps (ISMCPhysicsPackage_class.f90)' - class(tallyResult), allocatable :: tallyRes - type(collisionOperator), save :: collOp - class(transportOperator), allocatable, save :: transOp - type(RNG), target, save :: pRNG - !$omp threadprivate(p, collOp, transOp, pRNG) - - !$omp parallel - p % geomIdx = self % geomIdx - - ! Create a collision + transport operator which can be made thread private - collOp = self % collOp - transOp = self % transOp - - !$omp end parallel - - ! Reset and start timer - call timerReset(self % timerMain) - call timerStart(self % timerMain) - - allocate(tallyEnergy(self % nMat)) - - ! Generate initial population of material particles - call self % matSource % append(self % thisStep, self % pop, self % pRNG) - - do i=1,N_steps - - ! Update tracking grid if needed by transport operator - if (associated(self % transOp % grid)) call self % transOp % grid % update() - - ! Generate from input source - if( self % sourceGiven ) then - call self % inputSource % append(self % thisStep, 0, self % pRNG) - end if - - if(self % printSource == 1) then - call self % thisStep % printToFile(trim(self % outputFile)//'_source'//numToChar(i)) - end if - - call tally % reportCycleStart(self % thisStep) - - nParticles = self % thisStep % popSize() - - !$omp parallel do schedule(dynamic) - gen: do num = 1, nParticles - - ! Create RNG which can be thread private - pRNG = self % pRNG - p % pRNG => pRNG - call p % pRNG % stride(num) - - ! Obtain paticle from dungeon - call self % thisStep % release(p) - call self % geom % placeCoord(p % coords) - - ! Check particle type - if (p % getType() /= P_PHOTON_MG .and. p % getType() /= P_MATERIAL_MG) then - call fatalError(Here, 'Particle is not of type P_PHOTON_MG or P_MATERIAL_MG') - end if - - ! Assign maximum particle time - p % timeMax = self % deltaT * i - - ! For newly sourced particles, sample time uniformly within time step - if (p % time == ZERO) then - p % time = (p % pRNG % get() + i-1) * self % deltaT - end if - - ! Check for time errors - if (p % time >= p % timeMax .or. p % time < self % deltaT*(i-1)) then - call fatalError(Here, 'Particle time is not within timestep bounds') - else if (p % time /= p % time) then - call fatalError(Here, 'Particle time is NaN') - end if - - ! Save state - call p % savePreHistory() - - ! Transport particle until its death - history: do - - call transOp % transport(p, tally, self % thisStep, self % nextStep) - if(p % isDead) exit history - - if(p % fate == AGED_FATE) then - ! Store particle for use in next time step - p % fate = 0 - call self % nextStep % detain(p) - exit history - end if - - call collOp % collide(p, tally, self % thisStep, self % nextStep) - - if(p % isDead) exit history - - end do history - - end do gen - !$omp end parallel do - - ! Update RNG - call self % pRNG % stride(nParticles) - - ! Send end of time step report - call tally % reportCycleEnd(self % thisStep) - - ! Calculate times - call timerStop(self % timerMain) - elapsed_T = timerTime(self % timerMain) - - ! Predict time to end - end_T = real(N_steps,defReal) * elapsed_T / i - T_toEnd = max(ZERO, end_T - elapsed_T) - - ! Display progress - call printFishLineR(i) - print * - print * - print *, 'Source batch: ', numToChar(i), ' of ', numToChar(N_steps) - print *, 'Pop: ', numToChar(self % nextStep % popSize()) - 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() - - ! Obtain energy deposition tally results - call tallyAtch % getResult(tallyRes, 'imcWeightTally') - - select type(tallyRes) - class is(absClerkResult) - do j = 1, self % nMat - tallyEnergy(j) = tallyRes % clerkResults(j) - end do - class default - call fatalError(Here, 'Tally result class should be absClerkResult') - end select - - ! Update material properties - call self % nucData % updateProperties(tallyEnergy, self % printUpdates) - - ! Reset tally for next time step - call tallyAtch % reset('imcWeightTally') - - ! Swap dungeons in preparation for next time step - self % temp_dungeon => self % nextStep - self % nextStep => self % thisStep - self % thisStep => self % temp_dungeon - call self % nextStep % cleanPop() - - end do - - ! Output final mat temperatures - open(unit = 10, file = 'temps.txt') - do j = 1, self % nMat - mat => IMCMaterial_CptrCast(self % nucData % getMaterial(j)) - write(10, '(8A)') mm_matName(j), numToChar(mat % getTemp()) - end do - close(10) - - end subroutine steps - - !! - !! Print calculation results to file - !! - subroutine collectResults(self) - class(ISMCPhysicsPackage), intent(inout) :: self - type(outputFile) :: out - character(nameLen) :: name - - call out % init(self % outputFormat) - - name = 'seed' - call out % printValue(self % pRNG % getSeed(),name) - - name = 'pop' - call out % printValue(self % pop,name) - - name = 'Source_batches' - call out % printValue(self % N_steps,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 = 'Transport_time' - call out % printValue(timerTime(self % timerMain),name) - - ! Print tally - call self % tally % print(out) - - call out % writeToFile(self % outputFile) - - end subroutine collectResults - - - !! - !! Initialise from individual components and dictionaries for source and tally - !! - subroutine init(self, dict) - class(ISMCPhysicsPackage), intent(inout) :: self - class(dictionary), intent(inout) :: dict - class(dictionary), pointer :: tempDict, geomDict, dataDict - type(dictionary) :: locDict1, locDict2, locDict3, locDict4 - integer(shortInt) :: seed_temp - integer(longInt) :: seed - character(10) :: time - character(8) :: date - character(:),allocatable :: string - character(nameLen) :: nucData, geomName - type(outputFile) :: test_out - integer(shortInt) :: i - character(nameLen), dimension(:), allocatable :: mats - integer(shortInt), dimension(:), allocatable :: latSizeN - type(dictionary),target :: newGeom, newData - integer(shortInt), parameter :: ISMC = 2 - character(100), parameter :: Here ='init (ISMCPhysicsPackage_class.f90)' - - call cpu_time(self % CPU_time_start) - - ! Read calculation settings - call dict % get(self % pop,'pop') - call dict % get(self % limit, 'limit') - call dict % get(self % N_steps,'steps') - call dict % get(self % deltaT,'timeStepSize') - call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) - self % particleType = P_PHOTON_MG - nucData = 'mg' - - ! 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) - - ! Register timer - self % timerMain = registerTimer('transportTime') - - ! Initialise RNG - allocate(self % pRNG) - - ! *** It is a bit silly but dictionary cannot store longInt for now - ! so seeds are limited to 32 bits (can be -ve) - 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 % pRNG % init(seed) - - ! Read whether to print particle source each time step - call dict % getOrDefault(self % printSource, 'printSource', 0) - - ! Automatically split geometry into a uniform grid - if (dict % isPresent('discretise')) then - - ! Store dimensions of lattice - tempDict => dict % getDictPtr('discretise') - call tempDict % get(latSizeN, 'dimensions') - - ! Create new input - call discretise(dict, newGeom, newData) - - geomDict => newGeom - dataDict => newData - - else - geomDict => dict % getDictPtr("geometry") - dataDict => dict % getDictPtr("nuclearData") - - end if - - ! Build Nuclear Data - call ndReg_init(dataDict) - - ! Build geometry - geomName = 'IMCGeom' - call gr_addGeom(geomName, geomDict) - 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()) - self % nucData => mgIMCDatabase_CptrCast(ndReg_get(self % particleType)) - - call newGeom % kill() - call newData % kill() - - ! Initialise ISMC source - if (dict % isPresent('matSource')) then - tempDict => dict % getDictPtr('matSource') - call tempDict % store('calcType', 'ISMC') - call new_source(self % matSource, tempDict, self % geom) - else - call locDict1 % init(2) - call locDict1 % store('type', 'materialSource') - call locDict1 % store('calcType', 'ISMC') - call new_source(self % matSource, locDict1, self % geom) - call locDict1 % kill() - end if - - ! Read external particle source definition - if( dict % isPresent('source') ) then - tempDict => dict % getDictPtr('source') - call tempDict % store('deltaT', self % deltaT) - call new_source(self % inputSource, tempDict, self % geom) - self % sourceGiven = .true. - end if - - ! Build collision operator - tempDict => dict % getDictPtr('collisionOperator') - call self % collOp % init(tempDict) - - ! Build transport operator - tempDict => dict % getDictPtr('transportOperator') - call new_transportOperator(self % transOp, tempDict) - - ! Initialise tally Admin - tempDict => dict % getDictPtr('tally') - allocate(self % tally) - call self % tally % init(tempDict) - - ! Provide materials with calculation type and time step - call self % nucData % setCalcType(ISMC) - call self % nucData % setTimeStep(self % deltaT) - - ! Store number of materials - self % nMat = mm_nMat() - self % printUpdates = min(self % printUpdates, self % nMat) - - ! Create array of material names - allocate(mats(self % nMat)) - do i=1, self % nMat - mats(i) = mm_matName(i) - end do - - ! Initialise imcWeight tally attachment - call locDict1 % init(1) - call locDict2 % init(4) - call locDict3 % init(2) - call locDict4 % init(1) - - call locDict4 % store('type', 'weightResponse') - call locDict3 % store('type','materialMap') - call locDict3 % store('materials', [mats]) - call locDict2 % store('response', ['imcWeightResponse']) - call locDict2 % store('imcWeightResponse', locDict4) - call locDict2 % store('type','absorptionClerk') - call locDict2 % store('map', locDict3) - call locDict1 % store('imcWeightTally', locDict2) - - allocate(self % imcWeightAtch) - call self % imcWeightAtch % init(locDict1) - - call self % tally % push(self % imcWeightAtch) - - ! Size particle dungeons - allocate(self % thisStep) - call self % thisStep % init(self % limit) - allocate(self % nextStep) - call self % nextStep % init(self % limit) - - call self % printSettings() - - end subroutine init - - !! - !! Deallocate memory - !! - subroutine kill(self) - class(ISMCPhysicsPackage), intent(inout) :: self - - ! TODO: This subroutine - - end subroutine kill - - !! - !! Print settings of the physics package - !! - subroutine printSettings(self) - class(ISMCPhysicsPackage), intent(in) :: self - - print *, repeat("<>",50) - print *, "/\/\ IMC CALCULATION /\/\" - print *, "Source batches: ", numToChar(self % N_steps) - print *, "Population per batch: ", numToChar(self % pop) - print *, "Initial RNG Seed: ", numToChar(self % pRNG % getSeed()) - print * - print *, repeat("<>",50) - end subroutine printSettings - -end module ISMCPhysicsPackage_class diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index 01911bf81..d09429bb5 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -65,7 +65,16 @@ module implicitPhysicsPackage_class integer(shortInt), parameter, public :: ISMC = 2 !! - !! Physics Package for IMC calculations + !! Physics Package for Implicit Monte Carlo calculations + !! + !! Settings: + !! method -> IMC or ISMC + !! pop -> For IMC, approx. number of new particles to generate per time step + !! -> For ISMC, starting population of material particles + !! limit -> Size of particle dungeons + !! steps -> Number of time steps to simulate + !! timeStep -> Time step to be used + !! printUpdates (OPTIONAL) -> Prints material update info for first N materials !! type, public,extends(physicsPackage) :: implicitPhysicsPackage private @@ -87,7 +96,6 @@ module implicitPhysicsPackage_class character(pathLen) :: outputFile character(nameLen) :: outputFormat integer(shortInt) :: printSource = 0 - logical(defBool) :: sourceGiven = .false. integer(shortInt) :: nMat integer(shortInt) :: printUpdates @@ -132,6 +140,17 @@ subroutine run(self) !! !! Run steps for calculation !! + !! + !! Notes differences between IMC and ISMC regarding particle generation: + !! + !! -> IMC generates particles from material emission as well as input source, ISMC only + !! generates from input source. + !! + !! -> Particles for IMC are killed when absorbed, but for ISMC remain as material particles. + !! This allows IMC to keep dungeon pop under control far better than ISMC. For ISMC we + !! generate particles such that pop is at limit at end of calculation, with runtime per + !! time step increasing approximatelty linearly as the calculation progresses + !! subroutine steps(self, tally, tallyAtch, N_steps) class(implicitPhysicsPackage), intent(inout) :: self type(tallyAdmin), pointer,intent(inout) :: tally @@ -162,48 +181,46 @@ subroutine steps(self, tally, tallyAtch, N_steps) call timerReset(self % timerMain) call timerStart(self % timerMain) - allocate(tallyEnergy(self % nMat)) + ! Generate starting population of material particles for ISMC + if (self % method == ISMC) then + call self % matSource % append(self % thisStep, self % pop, self % pRNG) + nFromMat = 0 + end if do i=1,N_steps ! Update tracking grid if needed by transport operator if (associated(self % transOp % grid)) call self % transOp % grid % update() - ! Swap dungeons to store photons remaining from previous time step - self % temp_dungeon => self % nextStep - self % nextStep => self % thisStep - self % thisStep => self % temp_dungeon - call self % nextStep % cleanPop() - - ! Generate particles for IMC from material emission + ! Generate particles while staying below dungeon limit (see note in subroutine description) if (self % method == IMC) then + ! Reduce number of particles to generate if close to limit N = self % pop if (N + self % thisStep % popSize() > self % limit) then ! Fleck and Cummings IMC Paper, eqn 4.11 N = self % limit - self % thisStep % popSize() - self % nMat - 1 + N = max(1, N) end if ! Calculate proportion to be generated from input source - sourceWeight = self % inputSource % sourceWeight - if (self % inputSource % sourceWeight == 0) then - nFromMat = N - else + if (allocated(self % inputSource)) then + sourceWeight = self % inputSource % sourceWeight nFromMat = int(N * (1 - sourceWeight/(sourceWeight + self % nucData % getEmittedRad()))) + ! Generate from input source + call self % inputSource % append(self % thisStep, N - nFromMat, self % pRNG) end if ! Add to dungeon particles emitted from material call self % matSource % append(self % thisStep, nFromMat, self % pRNG) - else if (i == 1) then - ! Generate starting population of material particles for ISMC - call self % matSource % append(self % thisStep, self % pop, self % pRNG) + ! ISMC particle generation + else if (allocated(self % inputSource)) then - end if + ! Generate particles such that pop is almost at limit at calculation end + N = (self % limit - self % thisStep % popSize()) / (N_steps-i+1) + call self % inputSource % append(self % thisStep, N, self % pRNG) - ! Generate from input source - if( self % sourceGiven ) then - call self % inputSource % append(self % thisStep, N - nFromMat, self % pRNG) end if if(self % printSource == 1) then @@ -232,16 +249,11 @@ subroutine steps(self, tally, tallyAtch, N_steps) end if ! Assign maximum particle time - p % timeMax = timeStep() * i - - ! For newly sourced particles, sample time uniformly within time step - if (p % time == ZERO) call fatalError(Here, 'Particle time is 0') + p % timeMax = time % stepEnd ! Check for time errors - if (p % time >= p % timeMax .or. p % time < timeStep()*(i-1)) then - call fatalError(Here, 'Particle time is not within timestep bounds') - else if (p % time /= p % time) then - call fatalError(Here, 'Particle time is NaN') + if (p % time < time % stepStart .or. p % time >= time % stepEnd) then + call fatalError(Here, 'Particle time not within time step') end if ! Save state @@ -303,24 +315,26 @@ subroutine steps(self, tally, tallyAtch, N_steps) ! Obtain energy deposition tally results call tallyAtch % getResult(tallyRes, 'imcWeightTally') + ! Update material properties using tallied energy select type(tallyRes) class is(absClerkResult) - do j = 1, self % nMat - tallyEnergy(j) = tallyRes % clerkResults(j) - end do + call self % nucData % updateProperties(tallyRes % clerkResults, self % printUpdates) class default call fatalError(Here, 'Tally result class should be absClerkResult') end select - ! Update material properties - call self % nucData % updateProperties(tallyEnergy, self % printUpdates) - ! Reset tally for next time step call tallyAtch % reset('imcWeightTally') ! Advance to next time step call nextStep() + ! Swap dungeons to store photons remaining from previous time step + self % temp_dungeon => self % nextStep + self % nextStep => self % thisStep + self % thisStep => self % temp_dungeon + call self % nextStep % cleanPop() + end do ! Output final mat temperatures @@ -384,7 +398,6 @@ subroutine init(self, dict) type(outputFile) :: test_out integer(shortInt) :: i character(nameLen), dimension(:), allocatable :: mats - integer(shortInt), dimension(:), allocatable :: latSizeN real(defReal) :: timeStep type(dictionary),target :: newGeom, newData character(nameLen) :: method @@ -407,7 +420,7 @@ subroutine init(self, dict) call dict % get(self % pop,'pop') call dict % get(self % limit, 'limit') call dict % get(self % N_steps,'steps') - call dict % get(timeStep,'timeStepSize') + call dict % get(timeStep,'timeStep') call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) nucData = 'mg' @@ -417,7 +430,7 @@ subroutine init(self, dict) 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) + ! Initialise output file before calculation (so mistake in format will be caught early) call dict % getOrDefault(self % outputFormat, 'outputFormat', 'asciiMATLAB') call test_out % init(self % outputFormat) @@ -450,7 +463,6 @@ subroutine init(self, dict) ! Store dimensions of lattice tempDict => dict % getDictPtr('discretise') - call tempDict % get(latSizeN, 'dimensions') ! Create new input call discretise(dict, newGeom, newData) @@ -497,7 +509,6 @@ subroutine init(self, dict) if( dict % isPresent('source') ) then tempDict => dict % getDictPtr('source') call new_source(self % inputSource, tempDict, self % geom) - self % sourceGiven = .true. end if ! Build collision operator diff --git a/SharedModules/simulationTime_class.f90 b/SharedModules/simulationTime_class.f90 index c9fb5f60f..c54ca9e9f 100644 --- a/SharedModules/simulationTime_class.f90 +++ b/SharedModules/simulationTime_class.f90 @@ -15,8 +15,10 @@ module simulationTime_class !! time step separately in all required modules (source, material, etc.) !! type, public :: simulationTime - real(defReal) :: step = ONE - real(defReal) :: now = ZERO + real(defReal) :: step = ONE + real(defReal) :: stepStart = ZERO + real(defReal) :: stepEnd = ONE + integer(shortInt) :: stepsCompleted = 0 end type simulationTime type(simulationTime), public :: time @@ -24,7 +26,6 @@ module simulationTime_class public :: setStep public :: nextStep public :: timeStep - public :: timeNow public :: timeLeft contains @@ -38,7 +39,8 @@ subroutine setStep(dt) if (dt <= ZERO) call fatalError(Here, 'Time step must be positive') - time % step = dt + time % step = dt + time % stepEnd = dt end subroutine setStep @@ -47,7 +49,11 @@ end subroutine setStep !! subroutine nextStep() - time % now = time % now + time % step + time % stepsCompleted = time % stepsCompleted + 1 + + ! Set step start and end time + time % stepStart = time % step * time % stepsCompleted + time % stepEnd = time % step * (time % stepsCompleted + 1) end subroutine nextStep @@ -61,13 +67,6 @@ function timeStep() result(dt) end function timeStep - function timeNow() result(t) - real(defReal) :: t - - t = time % now - - end function timeNow - !! !! Return time remaining until end of time step !! @@ -75,7 +74,7 @@ function timeLeft(t) result(remaining_t) real(defReal), intent(in) :: t real(defReal) :: remaining_t - remaining_t = time % now + time % step - t + remaining_t = time % stepEnd - t end function timeLeft From b3d9621aeb05ad09ce90ac93ea8f7d4d4a2bf75f Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Jul 2023 18:11:20 +0100 Subject: [PATCH 342/373] Automatically tell source if we are using IMC or ISMC --- ParticleObjects/Source/materialSource_class.f90 | 8 ++++---- PhysicsPackages/implicitPhysicsPackage_class.f90 | 2 ++ 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/ParticleObjects/Source/materialSource_class.f90 b/ParticleObjects/Source/materialSource_class.f90 index ea191886d..c4d152ae5 100644 --- a/ParticleObjects/Source/materialSource_class.f90 +++ b/ParticleObjects/Source/materialSource_class.f90 @@ -44,7 +44,7 @@ module materialSource_class !! source_inter Interface !! !! SAMPLE INPUT: - !! matSource { type materialSource; calcType IMC; method fast; } + !! matSource { type materialSource; method fast; } !! type, public,extends(source) :: materialSource private @@ -105,13 +105,13 @@ subroutine init(self, dict, geom) call fatalError(Here, 'Unrecognised method. Should be "rejection" or "fast"') end select - ! Select calculation type + ! Select calculation type - Automatically added to dict in implicitPhysicsPackage call dict % getOrDefault(self % calcType, 'calcType', IMC) select case(self % calcType) case(IMC) - self % pType = P_PHOTON + self % pType = P_PHOTON case(ISMC) - self % pType = P_MATERIAL + self % pType = P_MATERIAL case default call fatalError(Here, 'Unrecognised calculation type. Should be "IMC" or "ISMC"') end select diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index d09429bb5..bd0154eac 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -495,6 +495,8 @@ subroutine init(self, dict) ! Initialise material source if (dict % isPresent('matSource')) then tempDict => dict % getDictPtr('matSource') + ! Tell source if we are using IMC or ISMC + call tempDict % store('calcType', self % method) call new_source(self % matSource, tempDict, self % geom) else call locDict1 % init(2) From 0d4a2f840414f7fe39bc0956cdbebea51fa576cc Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 10 Jul 2023 18:47:06 +0100 Subject: [PATCH 343/373] Various things to do with reducing dungeon size for ISMC (since absorptions do not kill the particle). None of this is currently very useful and I will probably remove it later, committing for now for easier switching between git branches --- ParticleObjects/particleDungeon_class.f90 | 146 +++++++++++++++++++++- 1 file changed, 143 insertions(+), 3 deletions(-) diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 06ad18951..0ec6de7a1 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -7,6 +7,11 @@ module particleDungeon_class use geometry_inter, only : geometry use universalVariables, only : INF + ! TODO ADDED FOR REDUCESIZE SUBROUTINE, CONSIDER CHANGING/REMOVING LATER + use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG + use mgIMCDatabase_inter, only : mgIMCDatabase + use materialMenu_mod, only : mm_nMat => nMat + implicit none private @@ -97,6 +102,8 @@ module particleDungeon_class procedure :: normWeight procedure :: normSize procedure :: reduceSize + procedure :: reduceSizeNEW + procedure :: closest procedure :: combine procedure :: deleteParticle procedure :: cleanPop @@ -450,6 +457,8 @@ subroutine normSize(self,N,rand) end subroutine normSize + !! + !! TODO DOESN'T WORK PROPERLY, REMOVE BEFORE GIT MERGE !! !! Combines particles such that the max population in any region is N, based on algorithm !! proposed by Elad Steinberg and Shay I. Heizler, A New Discrete Implicit Monte Carlo Scheme @@ -555,6 +564,129 @@ subroutine reduceSize(self, N, emptyArray) end subroutine reduceSize + !! + !! TODO TOO SLOW TO BE USEFUL, CHANGE OR REMOVE BEFORE GIT MERGE + !! + !! N -> target size + !! + subroutine reduceSizeNEW(self, matMax, rand) + class(particleDungeon), intent(inout) :: self + integer(shortInt), intent(in) :: matMax + class(RNG), intent(inout) :: rand + integer(shortInt) :: pop, i, j, idx, numInMat, matIdx + real(defReal) :: matWeight, prob, testVar + class(mgIMCDatabase), pointer :: nucData + character(100), parameter :: Here = 'aiucbniuqbnwionmcas' + + pop = self % pop + print *, 'START:', pop + + nucData => ndReg_getIMCMG() + + ! Consider each material seperately + do j = 1, mm_nMat() + + ! Find number of particles in each material + numInMat = sum(merge(1, 0, self % prisoners(1:self % pop) % matIdx == j)) + if (j == 1) print *, 'mat ', j, numInMat + + ! Skip if reduction not needed + if (numInMat < matMax) cycle + + ! Get sum of energies of material particles within mat - Faster than looping through dungeon + matWeight = nucData % getMaterialEnergy(j) + + ! Loop through particles in material and mark for deletion by setting weight as negative + do i = 1, self % pop + ! Skip if wrong mat + if (self % prisoners(i) % matIdx /= j) cycle + ! Only consider material particles + if (self % prisoners(i) % type /= P_MATERIAL) cycle + ! Delete particles probabilistically based on particle weight + prob = 1 - matMax * self % prisoners(i) % wgt / matWeight + ! Mark for deletion by setting weight negative + if (rand % get() < prob) then + self % prisoners(i) % wgt = - self % prisoners(i) % wgt + end if + end do + + ! TODO If only considering material particles then can get total weight from energy density + ! of material, if wanting to reduce pop of photons as well then could potentially approximate using + ! equilibrium radiation energy density of material (aT^4) + + end do + + ! Loop through dungeon again to combine particles + do i = 1, pop + ! Skip particles to keep + if (self % prisoners(i) % wgt >= ZERO) cycle + matIdx = self % prisoners(i) % matIdx + if (matIdx <= 0) call fatalError(Here, numToChar(matIdx)) + ! Find nearest valid particle to join with + idx = self % closest(i) + ! If no suitable friend found, allow particle to survive + if (idx == 0) then + ! Re-flip weight + self % prisoners(i) % wgt = - self % prisoners(i) % wgt + cycle + end if + ! Combine + call self % combine(idx, i) + end do + + ! Delete dead particles in reverse order to prevent changing indices + do i = 1, pop + idx = pop - i + 1 + if (self % prisoners(idx) % wgt <= ZERO) call self % deleteParticle(idx) + end do + + numInMat = sum(merge(1, 0, self % prisoners(1:self % pop) % matIdx == 1)) + print *, 'mat ', '1', numInMat + + print *, 'END: ', self % pop + + end subroutine reduceSizeNEW + + !! + !! TODO + !! + function closest(self, idx) result(idxClose) + class(particleDungeon), intent(in) :: self + integer(shortInt), intent(in) :: idx + integer(shortInt) :: idxClose, matIdx, type, i + real(defReal), dimension(3) :: r + real(defReal) :: dist, minDist + + ! Get required properties of particle + r = self % prisoners(idx) % r + type = self % prisoners(idx) % type + matIdx = self % prisoners(idx) % matIdx + + minDist = INF + idxClose = 0 + + !$omp parallel + !$omp do private(dist) + do i=1, self % pop + ! Require particles to be of same type and in same matIdx + if (self % prisoners(i) % matIdx /= matIdx) cycle + if (self % prisoners(i) % type /= type) cycle + + ! Require particle to have positive weight + if (self % prisoners(i) % wgt <= ZERO) cycle + + ! Get distance + dist = getDistance(r, self % prisoners(i) % r) + if (dist < minDist) then + minDist = dist + idxClose = i + end if + + end do + !$omp end do + !$omp end parallel + + end function closest !! !! Combine two particles in the dungeon by summing their weight and moving to a weighted- @@ -573,7 +705,7 @@ subroutine combine(self, idx1, idx2) class(particleDungeon), intent(inout) :: self integer(shortInt), intent(in) :: idx1 integer(shortInt), intent(in) :: idx2 - type(particle) :: p1, p2, p3 + type(particle) :: p1, p2 real(defReal), dimension(3) :: r1, r2, rNew ! Get initial particle data @@ -582,6 +714,9 @@ subroutine combine(self, idx1, idx2) r1 = p1 % rGlobal() r2 = p2 % rGlobal() + ! Flip weight of p2 if negative (for reduceSizeNEW) TODO + p2 % w = abs(p2 % w) + ! Move to new combined position rNew = (r1*p1 % w + r2*p2 % w) / (p1 % w + p2 % w) call p1 % teleport(rNew) @@ -601,8 +736,11 @@ end subroutine combine !! subroutine deleteParticle(self, idx) class(particleDungeon), intent(inout) :: self - integer(shortInt), intent(in) :: idx - type(particle) :: p + integer(shortInt), intent(in) :: idx + type(particle) :: p + integer(shortInt) :: matIdx + + matIdx = self % prisoners(self % pop) % matIdx ! Release particle at top of dungeon call self % release(p) @@ -610,6 +748,8 @@ subroutine deleteParticle(self, idx) ! Copy into position of particle to be deleted if (idx /= self % pop + 1) call self % replace(p, idx) + self % prisoners(idx) % matIdx = matIdx + end subroutine deleteParticle !! From 2f45617db4354dc46be612e71c6b9b50a4a97b15 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 12 Jul 2023 11:20:19 +0100 Subject: [PATCH 344/373] Redid temperature calculation to integrate numerically, rather than integrating analytically and then using newton-raphson. This will allow for more complex (non-polynomial) cv functions. --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 88 ++++++++++++++----- 1 file changed, 68 insertions(+), 20 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 6bfc2eebf..9bce2f815 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -65,7 +65,6 @@ module baseMgIMCMaterial_class type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data real(defReal),dimension(:), allocatable :: cv - real(defReal),dimension(:), allocatable :: updateEqn real(defReal),dimension(:), allocatable :: absEqn real(defReal),dimension(:), allocatable :: scattEqn real(defReal),dimension(:), allocatable :: planckEqn @@ -75,6 +74,7 @@ module baseMgIMCMaterial_class real(defReal) :: alpha real(defReal) :: sigmaP real(defReal) :: matEnergy + real(defReal) :: prevMatEnergy real(defReal) :: energyDens real(defReal) :: eta integer(shortInt) :: calcType @@ -118,12 +118,13 @@ subroutine updateMat(self, tallyEnergy, printUpdate) class(baseMgIMCMaterial),intent(inout) :: self real(defReal), intent(in) :: tallyEnergy logical(defBool), intent(in), optional :: printUpdate - real(defReal) :: previous character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" ! TODO: Print updates if requested - previous = self % matEnergy + ! Save previous energy + self % prevMatEnergy = self % matEnergy + ! Update material internal energy if (self % calcType == IMC) then self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy @@ -132,10 +133,13 @@ subroutine updateMat(self, tallyEnergy, printUpdate) end if ! Return if no change - if (self % matEnergy == previous) return + if (abs(self % matEnergy - self % prevMatEnergy) < 0.00001*self % prevMatEnergy) return self % energyDens = self % matEnergy / self % V + ! Confirm new energy density is valid + if (self % energyDens <= ZERO) call fatalError(Here, 'Energy density is not positive') + ! Update material temperature self % T = self % tempFromEnergy() @@ -224,7 +228,8 @@ end function getTotalXS subroutine init(self, dict) class(baseMgIMCMaterial), intent(inout) :: self class(dictionary),target, intent(in) :: dict - integer(shortInt) :: nG, N + integer(shortInt) :: nG, N, i + real(defReal) :: dT, tempT, tempU real(defReal), dimension(:), allocatable :: temp character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' @@ -253,17 +258,22 @@ subroutine init(self, dict) call dict % get(temp, 'cv') self % cv = temp - ! Build update equation - call poly_integrate(temp) - self % updateEqn = temp - ! Read initial temperature and volume call dict % get(self % T, 'T') call dict % get(self % V, 'V') - ! Calculate initial opacities and energy + ! Calculate initial opacities call self % sigmaFromTemp() - self % energyDens = poly_eval(self % updateEqn, self % T) + + ! Calculate initial energy density by integration + dT = self % T / 1000 + tempT = dT/2 + tempU = 0 + do i=1, 1000 + tempU = tempU + dT * poly_eval(self % cv, tempT) + tempT = tempT + dT + end do + self % energyDens = tempU self % matEnergy = self % energyDens * self % V ! Default to IMC calculation type @@ -341,19 +351,58 @@ pure function baseMgIMCMaterial_CptrCast(source) result(ptr) end function baseMgIMCMaterial_CptrCast !! - !! Calculate the temperature of material from internal energy + !! Calculate material temperature from internal energy by integration + !! + !! Step up (or down if energy is lower than in previous step) through temperature in steps of dT + !! and increment energy density by dT*cv(T) until target energy density is reached !! function tempFromEnergy(self) result(T) class(baseMgIMCMaterial), intent(inout) :: self - real(defReal) :: T, energyDens + real(defReal) :: T, dT, tempT, U, tempU, tol, error + integer(shortInt) :: i + character(100), parameter :: Here = 'tempFromEnergy (mgIMCMaterial_class.f90)' - energyDens = self % matEnergy / self % V + ! Parameters affecting accuracy + dT = self % T / 1000 ! Initial temperature step size to take, reduced after overshoot + tol = self % T / 1000000 ! Continue stepping until within tolerance - if (energyDens == 0) then - T = 0 - else - T = poly_solve(self % updateEqn, self % cv, self % T, energyDens) - end if + ! Starting temperature and energy density + T = self % T + U = self % prevMatEnergy / self % V + + ! If starting energy density is higher than target, flip dT to be negative + if (U > self % energyDens) dT = -dT + + i = 0 + + integrate:do + + ! Protect against infinite loop + i = i+1 + if (i > 1000000) call fatalError(Here, "1000,000 iterations without convergence.") + + ! Increment temperature and increment the corresponding energy density + tempT = T + dT/2 + tempU = U + dT * poly_eval(self % cv, tempT) + + error = self % energyDens - tempU + + if (abs(error) < tol) then ! Finished + T = T + dT + exit integrate + end if + + if (error*dT < 0) then ! If error and dT have different signs then we have overshot + ! Decrease dT and try again + dT = dT/2 + cycle integrate + end if + + ! Update temperature and energy and return to start + T = T + dT + U = tempU + + end do integrate end function tempFromEnergy @@ -457,7 +506,6 @@ function getMatEnergy(self) result(energy) class(baseMgIMCMaterial), intent(inout) :: self real(defReal) :: energy - !energy = poly_eval(self % updateEqn, self % T) * self % V energy = self % matEnergy end function getMatEnergy From 781c4c7b6dc68bc7a503e4fa0891213f88ad1e92 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 12 Jul 2023 14:47:44 +0100 Subject: [PATCH 345/373] Commented out surface tol checks for tracking grid, and instead nudge particle by SURF_TOL whenever grid cell is crossed --- TransportOperator/Grid/trackingGrid_class.f90 | 38 +++++++++---------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/TransportOperator/Grid/trackingGrid_class.f90 b/TransportOperator/Grid/trackingGrid_class.f90 index aa9a4a4de..68e54544b 100644 --- a/TransportOperator/Grid/trackingGrid_class.f90 +++ b/TransportOperator/Grid/trackingGrid_class.f90 @@ -102,19 +102,19 @@ function getDistance(self, r, u) result(dist) ! Calculate position from grid corner r_bar = r - self % corner - if (any(r_bar < -SURF_TOL)) call fatalError(Here, 'Point is outside grid geometry') !TODO only checks bottom for now +! if (any(r_bar < -SURF_TOL)) call fatalError(Here, 'Point is outside grid geometry') !TODO only checks bottom for now ! Write as a fraction across cell r_bar = r_bar / self % pitch r_bar = r_bar - floor(r_bar) ! Account for surface tolerance - low = SURF_TOL / self % pitch - high = ONE - low - do i = 1, 3 - if (r_bar(i) < low(i) .and. u(i) < ZERO) r_bar(i) = ONE - if (r_bar(i) > high(i) .and. u(i) > ZERO) r_bar(i) = ZERO - end do +! low = SURF_TOL / self % pitch +! high = ONE - low +! do i = 1, 3 +! if (r_bar(i) < low(i) .and. u(i) < ZERO) r_bar(i) = ONE +! if (r_bar(i) > high(i) .and. u(i) > ZERO) r_bar(i) = ZERO +! end do ! Distance to centre plus distance from centre to required boundary r_bar = (HALF - r_bar + sign(HALF, u)) * self % pitch @@ -171,26 +171,26 @@ function getValue(self, r, u) result(val) ijk = floor((r - self % corner) / self % pitch) + 1 ! Get position wrt middle of the lattice cell - r_bar = r - self % corner - ijk * self % pitch + HALF * self % pitch +! r_bar = r - self % corner - ijk * self % pitch + HALF * self % pitch ! Check if position is within surface tolerance ! If it is, push it to next cell - do i = 1, 3 - if (abs(r_bar(i)) > self % a_bar(i) .and. r_bar(i)*u(i) > ZERO) then +! do i = 1, 3 +! if (abs(r_bar(i)) > self % a_bar(i) .and. r_bar(i)*u(i) > ZERO) then ! Select increment. Ternary expression - if (u(i) < ZERO) then - inc = -1 - else - inc = 1 - end if +! if (u(i) < ZERO) then +! inc = -1 +! else +! inc = 1 +! end if - ijk(i) = ijk(i) + inc +! ijk(i) = ijk(i) + inc - end if - end do +! end if +! end do - ! Set localID & cellIdx + ! Set localID if (any(ijk <= 0 .or. ijk > self % sizeN)) then ! Point is outside grid call fatalError(Here, 'Point is outside grid') From a526aa7f56f229f1bc2704ad19196231c7da7b54 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 15 Jul 2023 12:42:48 +0100 Subject: [PATCH 346/373] Lots of changes towards making IMC multi-frequency. Work in progress. --- .../CollisionProcessors/IMCMGstd_class.f90 | 8 +- NuclearData/mgIMCData/CMakeLists.txt | 3 +- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 43 +++++- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 139 ++++++++++++++--- .../mgIMCData/baseMgIMC/materialEquations.f90 | 145 ++++++++++++++++++ NuclearData/mgIMCData/mgIMCDatabase_inter.f90 | 27 +++- .../Source/bbSurfaceSource_class.f90 | 28 +++- .../Source/materialSource_class.f90 | 12 +- 8 files changed, 364 insertions(+), 41 deletions(-) create mode 100644 NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 diff --git a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 index 1838cb596..7014e5f4b 100644 --- a/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 +++ b/CollisionOperator/CollisionProcessors/IMCMGstd_class.f90 @@ -89,7 +89,8 @@ subroutine sampleCollision(self, p, collDat, thisCycle, nextCycle) ! Verify that particle is MG PHOTON if( .not. p % isMG .or. p % type /= P_PHOTON) then - call fatalError(Here, 'Supports only MG PHOTON. Was given NEUTRON or MATERIAL and/or CE '//printType(p % type)) + call fatalError(Here, 'Supports only MG PHOTON. Was given NEUTRON or MATERIAL and/or CE '& + &//printType(p % type)) end if ! Verify and load nuclear data pointer @@ -147,7 +148,7 @@ subroutine elastic(self, p , collDat, thisCycle, nextCycle) ! Assign MT number collDat % MT = macroAllScatter - ! Sample Direction - chosen uniformly inside unit sphere + ! Sample direction - chosen uniformly inside unit sphere mu = 2 * p % pRNG % get() - 1 phi = p % pRNG % get() * 2*pi dir(1) = mu @@ -156,6 +157,9 @@ subroutine elastic(self, p , collDat, thisCycle, nextCycle) call p % point(dir) + ! Sample new frequency + p % G = self % xsData % sampleEnergyGroup(p % matIdx(), p % pRNG) + end subroutine elastic !! diff --git a/NuclearData/mgIMCData/CMakeLists.txt b/NuclearData/mgIMCData/CMakeLists.txt index dd219aafc..2733f0557 100644 --- a/NuclearData/mgIMCData/CMakeLists.txt +++ b/NuclearData/mgIMCData/CMakeLists.txt @@ -2,7 +2,8 @@ add_sources(./mgIMCMaterial_inter.f90 ./mgIMCDatabase_inter.f90 ./baseMgIMC/baseMgIMCMaterial_class.f90 - ./baseMgIMC/baseMgIMCDatabase_class.f90) + ./baseMgIMC/baseMgIMCDatabase_class.f90 + ./baseMgIMC/materialEquations.f90) # Add tests #add_integration_tests(./baseMgIMC/Tests/baseMgIMCDatabase_iTest.f90) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 6bf31633e..58912cfa9 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -21,6 +21,7 @@ module baseMgIMCDatabase_class ! baseMgIMC Objects use baseMgIMCMaterial_class, only : baseMgIMCMaterial + use materialEquations, only : imcEnergyGrid implicit none private @@ -69,6 +70,7 @@ module baseMgIMCDatabase_class ! Local interface procedure :: nGroups + procedure :: sampleEnergyGroup end type baseMgIMCDatabase @@ -304,6 +306,26 @@ subroutine setCalcType(self, type) end subroutine setCalcType + !! + !! Sample energy group of a particle emitted from material matIdx + !! + !! Args: + !! matIdx [in] -> index of material to sample from + !! rand [in] -> RNG + !! + !! Result: + !! G -> energy group of sampled particle + !! + function sampleEnergyGroup(self, matIdx, rand) result(G) + class(baseMgIMCDatabase), intent(inout) :: self + integer(shortInt), intent(in) :: matIdx + class(RNG), intent(inout) :: rand + integer(shortInt) :: G + + G = self % mats(matIdx) % sampleEnergyGroup(rand) + + end function sampleEnergyGroup + !! !! Sample the time taken for a material particle to transform into a photon !! Used for ISMC only @@ -349,6 +371,7 @@ subroutine init(self, dict, ptr, silent) type(materialItem), pointer :: matDef character(pathLen) :: path type(dictionary) :: tempDict + real(defReal), dimension(:), allocatable :: temp character(100), parameter :: Here = 'init (baseMgIMCDatabase_class.f90)' ! Prevent reallocations @@ -361,6 +384,19 @@ subroutine init(self, dict, ptr, silent) loud = .true. end if + ! Obtain number of groups and initialise energy grid if nG > 1 + matDef => mm_getMatPtr(1) + call matDef % extraInfo % get(path,'xsFile') + call fileToDict(tempDict, path) + call tempDict % get(self % nG, 'numberOfGroups') + if (self % nG > 1) then + call tempDict % get(temp, 'energyBins') + if (size(temp) /= self % nG + 1) call fatalError(Here, 'Should have '//numToChar(self % nG+1)& + &//' energy bins for '//numToChar(self % nG)//' groups. & + &Currently have '//numToChar(size(temp))//'.') + call imcEnergyGrid % init(temp) + end if + ! Find number of materials and allocate space nMat = mm_nMat() @@ -388,14 +424,11 @@ subroutine init(self, dict, ptr, silent) ! Initialise material call self % mats(i) % init(tempDict) - end do - - ! Load and verify number of groups - self % nG = self % mats(1) % nGroups() - do i=2,nMat + ! Verify number of groups if(self % nG /= self % mats(i) % nGroups()) then call fatalError(Here,'Inconsistant # of groups in materials in matIdx'//numToChar(i)) end if + end do end subroutine init diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 9bce2f815..b737a0e24 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -12,6 +12,7 @@ module baseMgIMCMaterial_class use materialHandle_inter, only : materialHandle use mgIMCMaterial_inter, only : mgIMCMaterial, kill_super => kill use IMCXSPackages_class, only : IMCMacroXSs + use materialEquations use simulationTime_class, only : timeStep @@ -29,7 +30,7 @@ module baseMgIMCMaterial_class integer(shortInt), parameter, public :: TOTAL_XS = 1 integer(shortInt), parameter, public :: IESCATTER_XS = 2 integer(shortInt), parameter, public :: CAPTURE_XS = 3 - integer(shortInt), parameter, public :: PLANCK_XS = 4 + integer(shortInt), parameter, public :: EMISSION_PROB = 4 ! Calculation Type integer(shortInt), parameter, public :: IMC = 1 @@ -67,7 +68,7 @@ module baseMgIMCMaterial_class real(defReal),dimension(:), allocatable :: cv real(defReal),dimension(:), allocatable :: absEqn real(defReal),dimension(:), allocatable :: scattEqn - real(defReal),dimension(:), allocatable :: planckEqn + character(nameLen) :: name real(defReal) :: T real(defReal) :: V real(defReal) :: fleck @@ -95,6 +96,7 @@ module baseMgIMCMaterial_class procedure :: getTemp procedure :: getMatEnergy procedure :: setCalcType + procedure :: sampleEnergyGroup procedure :: sampleTransformTime procedure, private :: tempFromEnergy @@ -188,7 +190,6 @@ subroutine getMacroXSs_byG(self, xss, G, rand) xss % elasticScatter = ZERO xss % inelasticScatter = self % data(IESCATTER_XS, G) xss % capture = self % data(CAPTURE_XS, G) - xss % planck = self % data(PLANCK_XS, G) end subroutine getMacroXSs_byG @@ -235,7 +236,7 @@ subroutine init(self, dict) ! Read number of groups call dict % get(nG, 'numberOfGroups') - if(nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) + if (nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) ! Allocate space for data N = 4 @@ -244,15 +245,17 @@ subroutine init(self, dict) ! Store alpha setting call dict % getOrDefault(self % alpha, 'alpha', ONE) - ! Read opacity equations - call dict % get(temp, 'capture') - self % absEqn = temp - call dict % get(temp, 'scatter') - self % scattEqn = temp + ! Get name of equations for cv and opacity calculations + call dict % getOrDefault(self % name, 'equations','none') - ! Build planck opacity equation - ! For grey case, sigmaP = sigmaA. Will become more complicated for frequency-dependent case - self % planckEqn = self % absEqn + if (self % name == 'none') then + call fatalError(Here, 'No name provided for equations') +! ! Read opacity equations +! call dict % get(temp, 'capture') +! self % absEqn = temp +! call dict % get(temp, 'scatter') +! self % scattEqn = temp + end if ! Read heat capacity equation call dict % get(temp, 'cv') @@ -270,7 +273,7 @@ subroutine init(self, dict) tempT = dT/2 tempU = 0 do i=1, 1000 - tempU = tempU + dT * poly_eval(self % cv, tempT) + tempU = tempU + dT * evaluateCv(self % name, tempT) !poly_eval(self % cv, tempT) tempT = tempT + dT end do self % energyDens = tempU @@ -379,11 +382,14 @@ function tempFromEnergy(self) result(T) ! Protect against infinite loop i = i+1 - if (i > 1000000) call fatalError(Here, "1000,000 iterations without convergence.") + if (i > 1000000) then + print *, U, self % energyDens + call fatalError(Here, "1000,000 iterations without convergence.") + end if ! Increment temperature and increment the corresponding energy density tempT = T + dT/2 - tempU = U + dT * poly_eval(self % cv, tempT) + tempU = U + dT * evaluateCv(self % name, tempT) !poly_eval(self % cv, tempT) error = self % energyDens - tempU @@ -411,13 +417,60 @@ end function tempFromEnergy !! subroutine sigmaFromTemp(self) class(baseMgIMCMaterial), intent(inout) :: self + integer(shortInt) :: i + real(defReal) :: sigmaP, E, EStep, increase + + ! Evaluate opacities for grey case + if (self % nGroups() == 1) then + self % data(CAPTURE_XS,1) = evaluateSigma(self % name, self % T, ONE) + self % data(IESCATTER_XS,1) = ZERO + self % data(TOTAL_XS,1) = self % data(CAPTURE_XS,1) + self % data(IESCATTER_XS,1) + ! Planck opacity equal to absorption opacity for single frequency + self % sigmaP = self % data(CAPTURE_XS, 1) + return + end if + + ! Evaluate opacities for frequency-dependent case + do i = 1, self % nGroups() + ! Calculate central energy value of group + E = (imcEnergyGrid % bin(i) + imcEnergyGrid % bin(i+1)) / 2 + ! Evaluate absorption opacity sigma(T, E) + self % data(CAPTURE_XS,i) = evaluateSigma(self % name, self % T, E) + end do + self % data(IESCATTER_XS,:) = ZERO + self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) + + ! Calculate planck opacity - integral over frequency of b * sigma + EStep = imcEnergyGrid % bin(1) / 1000 + E = -EStep / 2 + sigmaP = ZERO + do i = 1, 10000 + E = E + EStep + increase = EStep*normPlanckSpectrum(E, self % T)*evaluateSigma(self % name, self % T, E) + sigmaP = sigmaP + increase + end do + ! Continue with increasing step size to simulate E -> infinity + do i = 1, 1000 + EStep = EStep + imcEnergyGrid % bin(1) / 100 + E = E + EStep + increase = EStep*normPlanckSpectrum(E, self % T)*evaluateSigma(self % name, self % T, E) + sigmaP = sigmaP + increase + end do + + self % sigmaP = sigmaP - self % sigmaP = poly_eval(self % planckEqn, self % T) + ! Calculate probability of emission from each energy group + do i = 1, self % nGroups() + EStep = imcEnergyGrid % bin(i) - imcEnergyGrid % bin(i+1) + E = imcEnergyGrid % bin(i) - 0.5*EStep + self % data(EMISSION_PROB,i) = EStep * normPlanckSpectrum(E, self % T) * & + & evaluateSigma(self % name, self % T, E) + end do + self % data(EMISSION_PROB,:) = self % data(EMISSION_PROB,:) / sum(self % data(EMISSION_PROB,:)) - self % data(CAPTURE_XS,:) = poly_eval(self % absEqn, self % T) - self % data(IESCATTER_XS,:) = poly_eval(self % scattEqn, self % T) - self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) - self % data(PLANCK_XS,:) = poly_eval(self % planckEqn, self % T) +! self % data(CAPTURE_XS,:) = poly_eval(self % absEqn, self % T) +! self % data(IESCATTER_XS,:) = poly_eval(self % scattEqn, self % T) +! self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) end subroutine sigmaFromTemp @@ -430,7 +483,7 @@ subroutine updateFleck(self) character(100), parameter :: Here = 'updateFleck (baseMgIMCMaterial_class.f90)' ! Calculate beta, ratio of radiation and material heat capacities - beta = 4 * radiationConstant * self % T**3 / poly_eval(self % cv, self % T) + beta = 4 * radiationConstant * self % T**3 / evaluateCv(self % name, self % T) !poly_eval(self % cv, self % T) ! Use time step size to calculate fleck factor select case(self % calcType) @@ -534,6 +587,29 @@ subroutine setCalcType(self, calcType) end subroutine setCalcType + !! + !! Sample energy group for a particle emitted from material (and after effective scattering) + !! + function sampleEnergyGroup(self, rand) result(G) + class(baseMgIMCMaterial), intent(inout) :: self + class(RNG), intent(inout) :: rand + integer(shortInt) :: G, i + real(defReal) :: random, cumProb + + random = rand % get() + cumProb = ZERO + + ! Choose based on emission probability of each group + do i = 1, self % nGroups() + cumProb = cumProb + self % data(EMISSION_PROB,i) + if (random < cumProb) then + G = i + return + end if + end do + + end function sampleEnergyGroup + !! !! Sample the time taken for a material particle to transform into a photon !! Used for ISMC only @@ -552,4 +628,25 @@ function sampleTransformTime(self, rand) result(t) end function sampleTransformTime + !! + !! Evaluate frequency-normalised Planck spectrum + !! + !! Args: + !! nu -> frequency + !! T -> temperature + !! + pure function normPlanckSpectrum(E, T) result(b) + real(defReal), intent(in) :: E + real(defReal), intent(in) :: T + real(defReal) :: b + real(defReal) :: nu, nuOverT + + nu = E / planckConst + nuOverT = nu/T + + b = 15 * nuOverT**3 / (pi**4 * T * (exp(nuOverT)-1)) + + end function normPlanckSpectrum + + end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 new file mode 100644 index 000000000..955d6c49c --- /dev/null +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -0,0 +1,145 @@ + +module materialEquations + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError + use energyGrid_class, only : energyGrid + + implicit none + private + + character(nameLen),dimension(*),parameter :: AVAILABLE_equations = ['marshak ',& + 'hohlraum',& + 'olson1D '] + + public :: evaluateCv + public :: evaluateSigma + + type(energyGrid), public :: imcEnergyGrid + + interface evaluateCv + module procedure evaluateCv + end interface + + interface evaluateSigma + module procedure evaluateSigma + end interface + + contains + +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Non-specific interface equations - add new case to each +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Evaluate heat capacity equation at a given temperature + !! + !! Args: + !! equation -> name of the equation to use + !! T -> temperature to evaluate at + !! + function evaluateCv(equation, T) result(cv) + character(*), intent(in) :: equation + real(defReal), intent(in) :: T + real(defReal) :: cv + character(100), parameter :: Here = 'getCv (materialEquations.f90)' + + select case(equation) + + case('marshak') + cv = 7.14 + + case('hohlraum') + cv = 0.3 + + case('olson1D') + cv = cvOlson1D(T) + + case default + cv = ZERO + print *, AVAILABLE_equations + call fatalError(Here, 'Unrecognised equation: '//trim(equation)) + + end select + + end function evaluateCv + + !! + !! Evaluate opacity equation at a given temperature and frequency (energy E) + !! + !! Args: + !! equation -> name of the equation to use + !! T -> temperature to evaluate at + !! nu -> frequency of the particle + !! + function evaluateSigma(equation, T, E) result(sigma) + character(*), intent(in) :: equation + real(defReal), intent(in) :: T + real(defReal), intent(in) :: E + real(defReal) :: sigma + character(100), parameter :: Here = 'getSigma (materialEquations.f90)' + + select case(equation) + + case('marshak') + sigma = 10*T**(-3) + + case('hohlraum') + sigma = 100*T**(-3) + + case('olson1D') + sigma = sigmaOlson1D(T, E) + + case default + sigma = ZERO + print *, AVAILABLE_equations + call fatalError(Here, 'Unrecognised equation: '//trim(equation)) + + end select + + end function evaluateSigma + +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Custom material equations for various input files +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! 1-Dimensional Multi-frequency test by Olson (2020) + !! + !! Olson, G.L., 2020. Stretched and filtered multigroup pn transport for improved positivity + !! and accuracy. Journal of Computational and Theoretical Transport 0, 1–18. + !! + function cvOlson1D(T) result(cv) + real(defReal), intent(in) :: T + real(defReal) :: cv, root, alpha, dAlphadT + + root = sqrt(1+4*exp(0.1/T)) + alpha = 0.5*exp(-0.1/T)*(root-1) + dAlphadT = 0.1*(alpha-1/root)/(T*T) + + cv = 0.1*radiationConstant*(1+alpha+(T+0.1)*dAlphadT) + + end function cvOlson1D + + function sigmaOlson1D(T, E) result(sigma) + real(defReal), intent(in) :: T + real(defReal), intent(in) :: E + real(defReal) :: sigma + + if (E < 0.008) then + sigma = min(1e7_defReal, 1e9_defReal*T*T) + else if (E < 0.3) then + sigma = 192/(E*E*(1+200*T**1.5)) + else + sigma = 192*sqrt(0.3)/(E**2.5*(1+200*T**1.5)) + 4e4_defReal*(0.3/E)**2.5/(1+8000*T**2) + end if + + ! Multiply by density + sigma = 0.01*sigma + + end function sigmaOlson1D + + + +end module materialEquations diff --git a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 index 96e99f9e8..7d8947116 100644 --- a/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCDatabase_inter.f90 @@ -23,10 +23,11 @@ module mgIMCDatabase_inter type, public, abstract, extends(nuclearDatabase) :: mgIMCDatabase contains - procedure(getEmittedRad), deferred :: getEmittedRad - procedure(getMaterialEnergy), deferred :: getMaterialEnergy - procedure(updateProperties), deferred :: updateProperties - procedure(setCalcType), deferred :: setCalcType + procedure(getEmittedRad), deferred :: getEmittedRad + procedure(getMaterialEnergy), deferred :: getMaterialEnergy + procedure(updateProperties), deferred :: updateProperties + procedure(setCalcType), deferred :: setCalcType + procedure(sampleEnergyGroup), deferred :: sampleEnergyGroup procedure(sampleTransformTime), deferred :: sampleTransformTime end type mgIMCDatabase @@ -81,6 +82,24 @@ subroutine setCalcType(self, type) integer(shortInt), intent(in) :: type end subroutine setCalcType + !! + !! Sample energy group of a particle emitted from material matIdx + !! + !! Args: + !! matIdx [in] -> index of material to sample from + !! rand [in] -> RNG + !! + !! Result: + !! G -> energy group of sampled particle + !! + function sampleEnergyGroup(self, matIdx, rand) result(G) + import :: mgIMCDatabase, shortInt, RNG + class(mgIMCDatabase), intent(inout) :: self + integer(shortInt), intent(in) :: matIdx + class(RNG), intent(inout) :: rand + integer(shortInt) :: G + end function sampleEnergyGroup + !! !! Sample the time taken for a material particle to transform into a photon !! Used for ISMC only diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 index 2d6a199fc..5632d5ee1 100644 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ b/ParticleObjects/Source/bbSurfaceSource_class.f90 @@ -243,7 +243,7 @@ subroutine sampleEnergyAngle(self, p, rand) end subroutine sampleEnergyAngle !! - !! Provide particle energy, currently only a single group + !! Provide particle energy !! !! See configSource_inter for details. !! @@ -251,9 +251,31 @@ subroutine sampleEnergy(self, p, rand) class(bbSurfaceSource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand + integer(shortInt) :: N + real(defReal) :: random, sumToN, const, nu - p % isMG = .true. - p % G = 1 + if (self % isMG .eqv. .true.) then + p % isMG = .true. + p % G = 1 + return + end if + + ! Sample frequency from a black body (Planck) spectrum. See Fig. 1 in: + ! "An Implicit Monte Carlo Scheme for Calculating Time and Frequency Dependent + ! Nonlinear Radiation Transport", Fleck and Cummings, 1971 + N = 1 + random = rand % get() + sumToN = 1 + const = 90 / (pi**4) + + sample:do + if (random <= const*sumToN) exit sample + N = N + 1 + sumToN = sumToN + 1 / (N**4) + end do sample + + nu = -log(rand % get() * rand % get() * rand % get() * rand % get()) / N + p % E = planckConst * nu end subroutine sampleEnergy diff --git a/ParticleObjects/Source/materialSource_class.f90 b/ParticleObjects/Source/materialSource_class.f90 index c4d152ae5..dc5f98d25 100644 --- a/ParticleObjects/Source/materialSource_class.f90 +++ b/ParticleObjects/Source/materialSource_class.f90 @@ -138,7 +138,7 @@ subroutine append(self, dungeon, N, rand) integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand real(defReal), dimension(6) :: bounds - integer(shortInt) :: matIdx, i, Ntemp + integer(shortInt) :: matIdx, i, Ntemp, G real(defReal) :: energy, totalEnergy type(RNG) :: pRand class(mgIMCDatabase), pointer :: nucData @@ -184,10 +184,11 @@ subroutine append(self, dungeon, N, rand) ! Sample particles !$omp parallel pRand = rand - !$omp do private(pRand) + !$omp do private(pRand, G) do i=1, Ntemp call pRand % stride(i) - call dungeon % detain(self % sampleIMC(pRand, matIdx, energy, bounds)) + G = nucData % sampleEnergyGroup(matIdx, pRand) + call dungeon % detain(self % sampleIMC(pRand, matIdx, energy, G, bounds)) end do !$omp end do !$omp end parallel @@ -228,11 +229,12 @@ end function sampleParticle !! bounds [in] -> bounds for position search, will be bounds of entire geometry if using !! rejection sampling method, and bounds of single material if using fast !! - function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) + function sampleIMC(self, rand, targetMatIdx, energy, G, bounds) result(p) class(materialSource), intent(inout) :: self class(RNG), intent(inout) :: rand integer(shortInt), intent(in) :: targetMatIdx real(defReal), intent(in) :: energy + integer(shortInt), intent(in) :: G real(defReal), dimension(6), intent(in) :: bounds type(particleState) :: p real(defReal), dimension(3) :: bottom, top, r, dir, rand3 @@ -280,7 +282,7 @@ function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) p % uniqueID = uniqueID p % r = r p % dir = dir - p % G = self % G + p % G = G p % isMG = .true. p % wgt = energy p % type = self % pType From 0476d485673c8f98a9a8fb0ec9d3a96c28ac77c4 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 21 Jul 2023 13:16:39 +0100 Subject: [PATCH 347/373] Various changes for MG work' --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 5 ++++- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 14 ++++++++++++-- .../mgIMCData/baseMgIMC/materialEquations.f90 | 12 +++++++++++- 3 files changed, 27 insertions(+), 4 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 58912cfa9..03bb0e855 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -2,7 +2,7 @@ module baseMgIMCDatabase_class use numPrecision use endfConstants - use universalVariables, only : VOID_MAT + use universalVariables, only : VOID_MAT, OUTSIDE_MAT use genericProcedures, only : fatalError, numToChar use particle_class, only : particle use charMap_class, only : charMap @@ -109,6 +109,9 @@ function getTotalMatXS(self, p, matIdx) result(xs) class(particle), intent(in) :: p integer(shortInt), intent(in) :: matIdx real(defReal) :: xs + character(100), parameter :: Here = 'getTotalMatXS (baseMgIMCDatabase_class.f90)' + + if (matIdx == OUTSIDE_MAT) call fatalError(Here, 'Requesting XS in OUTSIDE_MAT') if (matIdx == VOID_MAT) then xs = ZERO diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index b737a0e24..a69381cc7 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -274,6 +274,7 @@ subroutine init(self, dict) tempU = 0 do i=1, 1000 tempU = tempU + dT * evaluateCv(self % name, tempT) !poly_eval(self % cv, tempT) + if (tempU /= tempU) tempU = ZERO tempT = tempT + dT end do self % energyDens = tempU @@ -361,7 +362,7 @@ end function baseMgIMCMaterial_CptrCast !! function tempFromEnergy(self) result(T) class(baseMgIMCMaterial), intent(inout) :: self - real(defReal) :: T, dT, tempT, U, tempU, tol, error + real(defReal) :: T, dT, tempT, U, tempU, tol, error, increase integer(shortInt) :: i character(100), parameter :: Here = 'tempFromEnergy (mgIMCMaterial_class.f90)' @@ -389,7 +390,9 @@ function tempFromEnergy(self) result(T) ! Increment temperature and increment the corresponding energy density tempT = T + dT/2 - tempU = U + dT * evaluateCv(self % name, tempT) !poly_eval(self % cv, tempT) + increase = dT * evaluateCv(self % name, tempT) + if (increase /= increase) increase = ZERO + tempU = U + increase !poly_eval(self % cv, tempT) error = self % energyDens - tempU @@ -419,6 +422,7 @@ subroutine sigmaFromTemp(self) class(baseMgIMCMaterial), intent(inout) :: self integer(shortInt) :: i real(defReal) :: sigmaP, E, EStep, increase + character(100), parameter :: Here = 'sigmaFromTemp (baseMgIMCMaterial_class.f90)' ! Evaluate opacities for grey case if (self % nGroups() == 1) then @@ -458,6 +462,7 @@ subroutine sigmaFromTemp(self) end do self % sigmaP = sigmaP + if (self % sigmaP == ZERO) call fatalError(Here, 'sigmaP = 0 ???') ! Calculate probability of emission from each energy group do i = 1, self % nGroups() @@ -596,6 +601,11 @@ function sampleEnergyGroup(self, rand) result(G) integer(shortInt) :: G, i real(defReal) :: random, cumProb + if (self % nGroups() == 1) then + G = 1 + return + end if + random = rand % get() cumProb = ZERO diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index 955d6c49c..8eed20ee8 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -1,4 +1,14 @@ - +!! +!! Module to store temperature and/or frequency-dependent equations for materials, especially +!! those too complicated to be easily read in from an input file. Also contains an energy grid to +!! allow materials to access particle energy group bounds for use in evaluating these equations. +!! +!! For a new set of material equations: +!! -> Add name to AVAILABLE_equations +!! -> Add case to evaluateCv and evaluateSigma +!! -> Evaluate simple equations (e.g. 'marshak' or 'hohlraum') in these functions, +!! or can link to new functions (e.g. 'olson1D') +!! module materialEquations use numPrecision From 302ffa789e3b94f39fc17ecb05c18a1c1147f8d2 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 28 Aug 2023 13:22:05 +0100 Subject: [PATCH 348/373] Changes to multi-frequency --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 16 ++++------------ .../mgIMCData/baseMgIMC/materialEquations.f90 | 5 ++++- PhysicsPackages/implicitPhysicsPackage_class.f90 | 11 +++++++++-- 3 files changed, 17 insertions(+), 15 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index a69381cc7..e970f8839 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -273,8 +273,7 @@ subroutine init(self, dict) tempT = dT/2 tempU = 0 do i=1, 1000 - tempU = tempU + dT * evaluateCv(self % name, tempT) !poly_eval(self % cv, tempT) - if (tempU /= tempU) tempU = ZERO + tempU = tempU + dT * evaluateCv(self % name, tempT) tempT = tempT + dT end do self % energyDens = tempU @@ -392,7 +391,7 @@ function tempFromEnergy(self) result(T) tempT = T + dT/2 increase = dT * evaluateCv(self % name, tempT) if (increase /= increase) increase = ZERO - tempU = U + increase !poly_eval(self % cv, tempT) + tempU = U + increase error = self % energyDens - tempU @@ -473,10 +472,6 @@ subroutine sigmaFromTemp(self) end do self % data(EMISSION_PROB,:) = self % data(EMISSION_PROB,:) / sum(self % data(EMISSION_PROB,:)) -! self % data(CAPTURE_XS,:) = poly_eval(self % absEqn, self % T) -! self % data(IESCATTER_XS,:) = poly_eval(self % scattEqn, self % T) -! self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) - end subroutine sigmaFromTemp !! @@ -488,7 +483,7 @@ subroutine updateFleck(self) character(100), parameter :: Here = 'updateFleck (baseMgIMCMaterial_class.f90)' ! Calculate beta, ratio of radiation and material heat capacities - beta = 4 * radiationConstant * self % T**3 / evaluateCv(self % name, self % T) !poly_eval(self % cv, self % T) + beta = 4 * radiationConstant * self % T**3 / evaluateCv(self % name, self % T) ! Use time step size to calculate fleck factor select case(self % calcType) @@ -651,10 +646,7 @@ pure function normPlanckSpectrum(E, T) result(b) real(defReal) :: b real(defReal) :: nu, nuOverT - nu = E / planckConst - nuOverT = nu/T - - b = 15 * nuOverT**3 / (pi**4 * T * (exp(nuOverT)-1)) + b = 15*E**3 / ((pi*T)**4 * (exp(E/T)-1)) end function normPlanckSpectrum diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index 8eed20ee8..a0bb343b7 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -130,6 +130,9 @@ function cvOlson1D(T) result(cv) cv = 0.1*radiationConstant*(1+alpha+(T+0.1)*dAlphadT) + ! Deal with numerical errors from poorly defined regions (e.g. T almost 0) + if (cv /= cv .or. cv > INF) cv = ZERO + end function cvOlson1D function sigmaOlson1D(T, E) result(sigma) @@ -146,7 +149,7 @@ function sigmaOlson1D(T, E) result(sigma) end if ! Multiply by density - sigma = 0.01*sigma + sigma = 0.001*sigma end function sigmaOlson1D diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index bd0154eac..5be10acd3 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -55,6 +55,7 @@ module implicitPhysicsPackage_class use sourceFactory_func, only : new_source use simulationTime_class + use energyGridRegistry_mod, only : define_energyGrid implicit none @@ -159,7 +160,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) integer(shortInt) :: i, j, N, nFromMat, num, nParticles type(particle), save :: p real(defReal) :: sourceWeight, elapsed_T, end_T, T_toEnd - real(defReal), dimension(:), allocatable :: tallyEnergy class(IMCMaterial), pointer :: mat character(100),parameter :: Here ='steps (implicitPhysicsPackage_class.f90)' class(tallyResult), allocatable :: tallyRes @@ -396,7 +396,8 @@ subroutine init(self, dict) character(:),allocatable :: string character(nameLen) :: nucData, geomName type(outputFile) :: test_out - integer(shortInt) :: i + integer(shortInt) :: i, nGroups + real(defReal), dimension(:), allocatable :: energyBins character(nameLen), dimension(:), allocatable :: mats real(defReal) :: timeStep type(dictionary),target :: newGeom, newData @@ -476,6 +477,12 @@ subroutine init(self, dict) end if + ! Initialise energy grid in multi-frequency case + if (dict % isPresent('energyGrid')) then + tempDict => dict % getDictPtr('energyGrid') + call define_energyGrid(nucData, tempDict) + end if + ! Build Nuclear Data call ndReg_init(dataDict) From 9cfeeb868a78e5e1024016a21a2ebd1ecdea7b4c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 28 Aug 2023 22:04:50 +0100 Subject: [PATCH 349/373] Reordered a lot of material class for easier reading, and changed source of info for energy grid --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 29 +-- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 210 ++++++++---------- .../mgIMCData/baseMgIMC/materialEquations.f90 | 30 ++- 3 files changed, 141 insertions(+), 128 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 03bb0e855..5ec01cfba 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -21,7 +21,11 @@ module baseMgIMCDatabase_class ! baseMgIMC Objects use baseMgIMCMaterial_class, only : baseMgIMCMaterial - use materialEquations, only : imcEnergyGrid + use materialEquations, only : mgEnergyGrid + + ! Energy grid for multi-frequency + use energyGrid_class, only : energyGrid + use energyGridRegistry_mod, only : get_energyGrid implicit none private @@ -375,6 +379,9 @@ subroutine init(self, dict, ptr, silent) character(pathLen) :: path type(dictionary) :: tempDict real(defReal), dimension(:), allocatable :: temp + type(energyGrid) :: eGrid + logical(defBool) :: err + character(nameLen) :: gridName character(100), parameter :: Here = 'init (baseMgIMCDatabase_class.f90)' ! Prevent reallocations @@ -387,17 +394,13 @@ subroutine init(self, dict, ptr, silent) loud = .true. end if - ! Obtain number of groups and initialise energy grid if nG > 1 - matDef => mm_getMatPtr(1) - call matDef % extraInfo % get(path,'xsFile') - call fileToDict(tempDict, path) - call tempDict % get(self % nG, 'numberOfGroups') - if (self % nG > 1) then - call tempDict % get(temp, 'energyBins') - if (size(temp) /= self % nG + 1) call fatalError(Here, 'Should have '//numToChar(self % nG+1)& - &//' energy bins for '//numToChar(self % nG)//' groups. & - &Currently have '//numToChar(size(temp))//'.') - call imcEnergyGrid % init(temp) + ! Get energy grid in multi-frequency case + gridName = 'mg' + call get_energyGrid(mgEnergyGrid, gridName, err) + if (err .eqv. .false.) then + self % nG = mgEnergyGrid % getSize() + else + self % nG = 1 end if ! Find number of materials and allocate space @@ -429,7 +432,7 @@ subroutine init(self, dict, ptr, silent) ! Verify number of groups if(self % nG /= self % mats(i) % nGroups()) then - call fatalError(Here,'Inconsistant # of groups in materials in matIdx'//numToChar(i)) + call fatalError(Here,'Inconsistent # of groups in materials in matIdx'//numToChar(i)) end if end do diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index e970f8839..aa2e1c8ad 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -65,9 +65,6 @@ module baseMgIMCMaterial_class !! type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data - real(defReal),dimension(:), allocatable :: cv - real(defReal),dimension(:), allocatable :: absEqn - real(defReal),dimension(:), allocatable :: scattEqn character(nameLen) :: name real(defReal) :: T real(defReal) :: V @@ -107,51 +104,9 @@ module baseMgIMCMaterial_class contains - !! - !! Update material properties at each time step - !! First update energy using simple balance, then solve for temperature, - !! then update temperature-dependent properties - !! - !! Args: - !! tallyEnergy [in] -> Energy absorbed into material - !! printUpdate [in, optional] -> Bool, if true then will print updates to screen - !! - subroutine updateMat(self, tallyEnergy, printUpdate) - class(baseMgIMCMaterial),intent(inout) :: self - real(defReal), intent(in) :: tallyEnergy - logical(defBool), intent(in), optional :: printUpdate - character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" - - ! TODO: Print updates if requested - - ! Save previous energy - self % prevMatEnergy = self % matEnergy - - ! Update material internal energy - if (self % calcType == IMC) then - self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy - else - self % matEnergy = tallyEnergy - end if - - ! Return if no change - if (abs(self % matEnergy - self % prevMatEnergy) < 0.00001*self % prevMatEnergy) return - - self % energyDens = self % matEnergy / self % V - - ! Confirm new energy density is valid - if (self % energyDens <= ZERO) call fatalError(Here, 'Energy density is not positive') - - ! Update material temperature - self % T = self % tempFromEnergy() - - ! Update sigma - call self % sigmaFromTemp() - - ! Update fleck factor - call self % updateFleck() - - end subroutine updateMat +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Standard procedures +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! !! Return to uninitialised state @@ -235,7 +190,7 @@ subroutine init(self, dict) character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' ! Read number of groups - call dict % get(nG, 'numberOfGroups') + nG = mgEnergyGrid % getSize() if (nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) ! Allocate space for data @@ -245,21 +200,8 @@ subroutine init(self, dict) ! Store alpha setting call dict % getOrDefault(self % alpha, 'alpha', ONE) - ! Get name of equations for cv and opacity calculations - call dict % getOrDefault(self % name, 'equations','none') - - if (self % name == 'none') then - call fatalError(Here, 'No name provided for equations') -! ! Read opacity equations -! call dict % get(temp, 'capture') -! self % absEqn = temp -! call dict % get(temp, 'scatter') -! self % scattEqn = temp - end if - - ! Read heat capacity equation - call dict % get(temp, 'cv') - self % cv = temp + ! Get name of equations for heat capacity and opacity calculations + call dict % get(self % name, 'equations') ! Read initial temperature and volume call dict % get(self % T, 'T') @@ -279,9 +221,6 @@ subroutine init(self, dict) self % energyDens = tempU self % matEnergy = self % energyDens * self % V - ! Default to IMC calculation type - self % calcType = IMC - end subroutine init !! @@ -353,6 +292,80 @@ pure function baseMgIMCMaterial_CptrCast(source) result(ptr) end function baseMgIMCMaterial_CptrCast + !! + !! Set the calculation type to be used + !! + !! Current options: + !! IMC + !! ISMC + !! + !! Errors: + !! Unrecognised option + !! + subroutine setCalcType(self, calcType) + class(baseMgIMCMaterial), intent(inout) :: self + integer(shortInt), intent(in) :: calcType + character(100), parameter :: Here = 'setCalcType (baseMgIMCMaterial_class.f90)' + + if(calcType /= IMC .and. calcType /= ISMC) call fatalError(Here, 'Invalid calculation type') + + self % calcType = calcType + + ! Set initial fleck factor + call self % updateFleck() + + end subroutine setCalcType + + +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Material Updates +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Update material properties at each time step + !! First update energy using simple balance, then solve for temperature, + !! then update temperature-dependent properties + !! + !! Args: + !! tallyEnergy [in] -> Energy absorbed into material + !! printUpdate [in, optional] -> Bool, if true then will print updates to screen + !! + subroutine updateMat(self, tallyEnergy, printUpdate) + class(baseMgIMCMaterial),intent(inout) :: self + real(defReal), intent(in) :: tallyEnergy + logical(defBool), intent(in), optional :: printUpdate + character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" + ! TODO: Print updates if requested + + ! Save previous energy + self % prevMatEnergy = self % matEnergy + + ! Update material internal energy + if (self % calcType == IMC) then + self % matEnergy = self % matEnergy - self % getEmittedRad() + tallyEnergy + else + self % matEnergy = tallyEnergy + end if + + self % energyDens = self % matEnergy / self % V + + ! Return if no change + if (abs(self % matEnergy - self % prevMatEnergy) < 0.00001*self % prevMatEnergy) return + + ! Confirm new energy density is valid + if (self % energyDens <= ZERO) call fatalError(Here, 'Energy density is not positive') + + ! Update material temperature + self % T = self % tempFromEnergy() + + ! Update sigma + call self % sigmaFromTemp() + + ! Update fleck factor + call self % updateFleck() + + end subroutine updateMat + !! !! Calculate material temperature from internal energy by integration !! @@ -384,13 +397,14 @@ function tempFromEnergy(self) result(T) i = i+1 if (i > 1000000) then print *, U, self % energyDens - call fatalError(Here, "1000,000 iterations without convergence.") + call fatalError(Here, "1000,000 iterations without convergence") end if ! Increment temperature and increment the corresponding energy density tempT = T + dT/2 increase = dT * evaluateCv(self % name, tempT) - if (increase /= increase) increase = ZERO + ! Protect against division by 0 or other numerical errors + if (increase /= increase .or. increase > INF) increase = ZERO tempU = U + increase error = self % energyDens - tempU @@ -436,7 +450,7 @@ subroutine sigmaFromTemp(self) ! Evaluate opacities for frequency-dependent case do i = 1, self % nGroups() ! Calculate central energy value of group - E = (imcEnergyGrid % bin(i) + imcEnergyGrid % bin(i+1)) / 2 + E = (mgEnergyGrid % bin(i) + mgEnergyGrid % bin(i+1)) / 2 ! Evaluate absorption opacity sigma(T, E) self % data(CAPTURE_XS,i) = evaluateSigma(self % name, self % T, E) end do @@ -444,7 +458,7 @@ subroutine sigmaFromTemp(self) self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) ! Calculate planck opacity - integral over frequency of b * sigma - EStep = imcEnergyGrid % bin(1) / 1000 + EStep = mgEnergyGrid % bin(1) / 1000 E = -EStep / 2 sigmaP = ZERO do i = 1, 10000 @@ -454,7 +468,7 @@ subroutine sigmaFromTemp(self) end do ! Continue with increasing step size to simulate E -> infinity do i = 1, 1000 - EStep = EStep + imcEnergyGrid % bin(1) / 100 + EStep = EStep + mgEnergyGrid % bin(1) / 100 E = E + EStep increase = EStep*normPlanckSpectrum(E, self % T)*evaluateSigma(self % name, self % T, E) sigmaP = sigmaP + increase @@ -465,8 +479,8 @@ subroutine sigmaFromTemp(self) ! Calculate probability of emission from each energy group do i = 1, self % nGroups() - EStep = imcEnergyGrid % bin(i) - imcEnergyGrid % bin(i+1) - E = imcEnergyGrid % bin(i) - 0.5*EStep + EStep = mgEnergyGrid % bin(i) - mgEnergyGrid % bin(i+1) + E = mgEnergyGrid % bin(i) - 0.5*EStep self % data(EMISSION_PROB,i) = EStep * normPlanckSpectrum(E, self % T) * & & evaluateSigma(self % name, self % T, E) end do @@ -504,6 +518,11 @@ subroutine updateFleck(self) end subroutine updateFleck + +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Obtain material info +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + !! !! Return the energy to be emitted during time step, E_r !! @@ -563,29 +582,10 @@ function getMatEnergy(self) result(energy) end function getMatEnergy - !! - !! Set the calculation type to be used - !! - !! Current options: - !! IMC - !! ISMC - !! - !! Errors: - !! Unrecognised option - !! - subroutine setCalcType(self, calcType) - class(baseMgIMCMaterial), intent(inout) :: self - integer(shortInt), intent(in) :: calcType - character(100), parameter :: Here = 'setCalcType (baseMgIMCMaterial_class.f90)' - - if(calcType /= IMC .and. calcType /= ISMC) call fatalError(Here, 'Invalid calculation type') - - self % calcType = calcType - - ! Set initial fleck factor - call self % updateFleck() - end subroutine setCalcType +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Sample emission properties +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! !! Sample energy group for a particle emitted from material (and after effective scattering) @@ -633,22 +633,4 @@ function sampleTransformTime(self, rand) result(t) end function sampleTransformTime - !! - !! Evaluate frequency-normalised Planck spectrum - !! - !! Args: - !! nu -> frequency - !! T -> temperature - !! - pure function normPlanckSpectrum(E, T) result(b) - real(defReal), intent(in) :: E - real(defReal), intent(in) :: T - real(defReal) :: b - real(defReal) :: nu, nuOverT - - b = 15*E**3 / ((pi*T)**4 * (exp(E/T)-1)) - - end function normPlanckSpectrum - - end module baseMgIMCMaterial_class diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index a0bb343b7..6e9080a9d 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -3,6 +3,8 @@ !! those too complicated to be easily read in from an input file. Also contains an energy grid to !! allow materials to access particle energy group bounds for use in evaluating these equations. !! +!! Also stores energy grid for multigroup problems for easy access by materials +!! !! For a new set of material equations: !! -> Add name to AVAILABLE_equations !! -> Add case to evaluateCv and evaluateSigma @@ -25,8 +27,10 @@ module materialEquations public :: evaluateCv public :: evaluateSigma + public :: normPlanckSpectrum - type(energyGrid), public :: imcEnergyGrid + ! Energy grid for multi-frequency problems for easy access by material classes + type(energyGrid), public :: mgEnergyGrid interface evaluateCv module procedure evaluateCv @@ -36,6 +40,10 @@ module materialEquations module procedure evaluateSigma end interface +! interface normPlanckSpectrum +! procedure normPlanckSpectrum +! end interface + contains !!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -154,5 +162,25 @@ function sigmaOlson1D(T, E) result(sigma) end function sigmaOlson1D +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Commonly used equations +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Evaluate frequency-normalised Planck spectrum + !! + !! Args: + !! nu -> frequency + !! T -> temperature + !! + pure function normPlanckSpectrum(E, T) result(b) + real(defReal), intent(in) :: E + real(defReal), intent(in) :: T + real(defReal) :: b + + b = 15*E**3 / ((pi*T)**4 * (exp(E/T)-1)) + + end function normPlanckSpectrum + end module materialEquations From d079dbad7eae819611edd781ec79c5b953865080 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Tue, 29 Aug 2023 23:05:04 +0100 Subject: [PATCH 350/373] More multigroup work --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 6 +- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 58 +++++++++---------- .../mgIMCData/baseMgIMC/materialEquations.f90 | 3 - SharedModules/simulationTime_class.f90 | 8 +++ 4 files changed, 39 insertions(+), 36 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 5ec01cfba..057a1a7d3 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -378,10 +378,8 @@ subroutine init(self, dict, ptr, silent) type(materialItem), pointer :: matDef character(pathLen) :: path type(dictionary) :: tempDict - real(defReal), dimension(:), allocatable :: temp - type(energyGrid) :: eGrid - logical(defBool) :: err - character(nameLen) :: gridName + logical(defBool) :: err + character(nameLen) :: gridName character(100), parameter :: Here = 'init (baseMgIMCDatabase_class.f90)' ! Prevent reallocations diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index aa2e1c8ad..ef76f8952 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -433,8 +433,8 @@ end function tempFromEnergy !! subroutine sigmaFromTemp(self) class(baseMgIMCMaterial), intent(inout) :: self - integer(shortInt) :: i - real(defReal) :: sigmaP, E, EStep, increase + integer(shortInt) :: i, j + real(defReal) :: sigmaP, E, EStep, increase, sigmaA, norm character(100), parameter :: Here = 'sigmaFromTemp (baseMgIMCMaterial_class.f90)' ! Evaluate opacities for grey case @@ -457,34 +457,34 @@ subroutine sigmaFromTemp(self) self % data(IESCATTER_XS,:) = ZERO self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) - ! Calculate planck opacity - integral over frequency of b * sigma - EStep = mgEnergyGrid % bin(1) / 1000 - E = -EStep / 2 - sigmaP = ZERO - do i = 1, 10000 - E = E + EStep - increase = EStep*normPlanckSpectrum(E, self % T)*evaluateSigma(self % name, self % T, E) - sigmaP = sigmaP + increase - end do - ! Continue with increasing step size to simulate E -> infinity - do i = 1, 1000 - EStep = EStep + mgEnergyGrid % bin(1) / 100 - E = E + EStep - increase = EStep*normPlanckSpectrum(E, self % T)*evaluateSigma(self % name, self % T, E) - sigmaP = sigmaP + increase + ! Evaluate opacities + sigmaP = ZERO ! For Planck opacity, integrate over entire frequency domain + do i = 1, self % nGroups() + ! For CAPTURE_XS, integrate over each energy group + sigmaA = ZERO + ! Normalise CAPTURE_XS after weighting with planck spectrum + norm = ZERO + ! 100 integration steps per energy group, chosen arbitrarily + EStep = (mgEnergyGrid % bin(i) - mgEnergyGrid % bin(i+1)) / 100 + E = mgEnergyGrid % bin(i) - 0.5*EStep + do j = 1, 100 + increase = normPlanckSpectrum(E, self % T)*evaluateSigma(self % name, self % T, E) + sigmaP = sigmaP + EStep * increase + norm = norm + normPlanckSpectrum(E, self % T) + sigmaA = sigmaA + increase + E = E - EStep + end do + if (sigmaA /= ZERO) sigmaA = sigmaA / norm + self % data(CAPTURE_XS, i) = sigmaA end do + ! Set cross sections self % sigmaP = sigmaP - if (self % sigmaP == ZERO) call fatalError(Here, 'sigmaP = 0 ???') + self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) + + ! Set emission probability of each group - proportional to sigmaA + self % data(EMISSION_PROB,:) = self % data(CAPTURE_XS,:) / sum(self % data(CAPTURE_XS,:)) - ! Calculate probability of emission from each energy group - do i = 1, self % nGroups() - EStep = mgEnergyGrid % bin(i) - mgEnergyGrid % bin(i+1) - E = mgEnergyGrid % bin(i) - 0.5*EStep - self % data(EMISSION_PROB,i) = EStep * normPlanckSpectrum(E, self % T) * & - & evaluateSigma(self % name, self % T, E) - end do - self % data(EMISSION_PROB,:) = self % data(EMISSION_PROB,:) / sum(self % data(EMISSION_PROB,:)) end subroutine sigmaFromTemp @@ -528,11 +528,11 @@ end subroutine updateFleck !! function getEmittedRad(self) result(emittedRad) class(baseMgIMCMaterial), intent(inout) :: self - real(defReal) :: U_r, emittedRad + real(defReal) :: u_r, emittedRad - U_r = radiationConstant * (self % T)**4 + u_r = radiationConstant * (self % T)**4 - emittedRad = lightSpeed * timeStep() * self % sigmaP * self % fleck * U_r * self % V + emittedRad = lightSpeed * timeStep() * self % sigmaP * self % fleck * u_r * self % V end function getEmittedRad diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index 6e9080a9d..211385bc8 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -40,9 +40,6 @@ module materialEquations module procedure evaluateSigma end interface -! interface normPlanckSpectrum -! procedure normPlanckSpectrum -! end interface contains diff --git a/SharedModules/simulationTime_class.f90 b/SharedModules/simulationTime_class.f90 index c54ca9e9f..72cd1cfa8 100644 --- a/SharedModules/simulationTime_class.f90 +++ b/SharedModules/simulationTime_class.f90 @@ -24,6 +24,7 @@ module simulationTime_class type(simulationTime), public :: time public :: setStep + public :: thisStep public :: nextStep public :: timeStep public :: timeLeft @@ -44,6 +45,13 @@ subroutine setStep(dt) end subroutine setStep + function thisStep() result(i) + integer(shortInt) :: i + + i = time % stepsCompleted + 1 + + end function thisStep + !! !! Advance time by one time step !! From 218400efe14a2bc00fcd02877a2f18077a47f34b Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 31 Aug 2023 12:07:03 +0100 Subject: [PATCH 351/373] Redid black body source class --- ParticleObjects/Source/CMakeLists.txt | 1 + .../Source/blackBodySource_class.f90 | 460 ++++++++++++++++++ ParticleObjects/Source/sourceFactory_func.f90 | 6 + 3 files changed, 467 insertions(+) create mode 100644 ParticleObjects/Source/blackBodySource_class.f90 diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index 22ef9b317..bf036bbc9 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -6,4 +6,5 @@ add_sources( source_inter.f90 fissionSource_class.f90 materialSource_class.f90 bbSurfaceSource_class.f90 + blackBodySource_class.f90 ) diff --git a/ParticleObjects/Source/blackBodySource_class.f90 b/ParticleObjects/Source/blackBodySource_class.f90 new file mode 100644 index 000000000..78fef9e73 --- /dev/null +++ b/ParticleObjects/Source/blackBodySource_class.f90 @@ -0,0 +1,460 @@ +module blackBodySource_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError, numToChar + use particle_class, only : particleState, P_NEUTRON, P_PHOTON + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use configSource_inter, only : configSource, kill_super => kill + use geometry_inter, only : geometry + use RNG_class, only : RNG + use simulationTime_class + + use energyGrid_class, only : energyGrid + use energyGridRegistry_mod, only : get_energyGrid + + use blackBodyPdf_class, only : normPlanck + + implicit none + private + + + ! Options for source distribution + integer(shortInt), parameter, public :: SURFACE = 1 + integer(shortInt), parameter, public :: OLSON1D = 2 + + + !! + !! Generates a source representing a black body surface + !! + !! Private members: + !! r -> bottom corner of source + !! dr -> size of surface, will be 0 in one dimension + !! dir -> direction of dominant movement: [1,0,0], [-1,0,0], [0,1,0], etc. + !! particleType -> source particle type (photon) + !! isMG -> is the source multi-group? (yes) + !! + !! Interface: + !! init -> initialise point source + !! append -> source particles and add to existing dungeon + !! sampleType -> set particle type + !! samplePosition -> set particle position + !! sampleEnergyAngle -> sample particle angle + !! sampleEnergy -> set particle energy (isMG = .true., G = 1) + !! sampleWeight -> set particle energy-weight + !! sampleTime -> set particle time + !! kill -> terminate source + !! + !! Sample Dictionary Input: + !! source { + !! type blackBodySource; + !! distribution surface; + !! surface -x; + !! temp 1; -> temperature of the black body source + !! } + !! + type, public,extends(configSource) :: blackBodySource + private + + ! Settings defining sourced position and direction for surface sources + real(defReal), dimension(3) :: r = ZERO ! Corner position of source + real(defReal), dimension(3) :: dr = ZERO ! Spatial extent from corner + integer(shortInt), dimension(3,3) :: rotation = ZERO ! Direction rotation matrix + ! Other settings + integer(shortInt) :: distribution = SURFACE ! Standard is a black body surface, + ! but can define new custom sources + !if needed + integer(shortInt) :: particleType = P_PHOTON + logical(defBool) :: isMG = .true. + real(defReal) :: T = ZERO ! Source temperature + real(defReal) :: particleWeight = ZERO ! Weight of each particle (= sourceWeight/N) + integer(shortInt) :: timeStepMax = 0 ! Time step to switch source off + ! Probability of emission from each energy group for multi-frequency case + real(defReal), dimension(:), allocatable :: cumEnergyProbs + + contains + procedure :: init + procedure :: initSurface + procedure :: initCustom + procedure :: append + procedure :: sampleType + procedure :: samplePosition + procedure :: sampleEnergy + procedure :: sampleEnergyAngle + procedure :: sampleWeight + procedure :: sampleTime + procedure :: kill + + end type blackBodySource + +contains + + !! + !! Initialise from dictionary + !! + !! See source_inter for details + !! + !! Errors: + !! - error if an axis other than x, y, or z is given + !! + subroutine init(self, dict, geom) + class(blackBodySource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + real(defReal), dimension(:), allocatable :: temp + integer(shortInt) :: i, j, nGroups, dir + real(defReal) :: nu, eStep + type(energyGrid) :: eGrid + logical(defBool) :: err + character(nameLen) :: gridName, distribution + character(100), parameter :: Here = 'init (blackBodySource_class.f90)' + + ! Provide geometry info to source + self % geom => geom + + ! Provide particle type + self % particleType = P_PHOTON + + ! Initialise specifics of source (e.g. position samlping bounds) + call dict % getOrDefault(distribution, 'distribution', 'surface') + select case(distribution) + case('surface') + call self % initSurface(dict) + case default + call self % initCustom(dict) + end select + + ! Get source temperature + call dict % get(self % T, 'temp') + + ! Get time step to turn off source + call dict % getOrDefault(self % timeStepMax, 'untilStep', 0) + + ! Exit in grey case + gridName = 'mg' + call get_energyGrid(eGrid, gridName, err) + if (err .eqv. .true.) return + + ! Calculate emission probability in each energy group + nGroups = eGrid % getSize() + allocate(self % cumEnergyProbs(nGroups)) + + do i=1, nGroups + eStep = (eGrid % bin(i) - eGrid % bin(i+1)) / 1000 + nu = eGrid % bin(i) - eStep/2 + ! Add previous group probability to get cumulative distribution + if (i > 1) self % cumEnergyProbs(i) = self % cumEnergyProbs(i-1) + ! Step through energies + do j=1, 1000 + self % cumEnergyProbs(i) = self % cumEnergyProbs(i) + eStep*normPlanck(nu,self % T) + nu = nu - eStep + end do + end do + + ! Normalise to account for exclusion of tail ends of distribution + ! TODO: should possibly add these tails into outer energy groups rather than normalising over all groups? + self % cumEnergyProbs = self % cumEnergyProbs / self % cumEnergyProbs(nGroups) + + end subroutine init + + !! + !! Add particles to given dungeon + !! + !! See source_inter for details + !! + !! If N is given as 0, then N is instead taken from the input dictionary defining this source + !! to allow PP to have control over particle numbers + !! + subroutine append(self, dungeon, N, rand) + class(blackBodySource), intent(inout) :: self + type(particleDungeon), intent(inout) :: dungeon + integer(shortInt), intent(in) :: N + class(RNG), intent(inout) :: rand + integer(shortInt) :: i + type(RNG) :: pRand + character(100), parameter :: Here = 'append (blackBodySource_class.f90)' + + ! Store N for calculation of each particle weight + self % particleWeight = self % sourceWeight / N + + ! Generate N particles to populate dungeon + !$omp parallel + pRand = rand + !$omp do private(pRand) + do i = 1, N + call pRand % stride(i) + call dungeon % detain(self % sampleParticle(pRand)) + end do + !$omp end do + !$omp end parallel + + ! Turn off for next time step if needed + if (thisStep() == self % timeStepMax) self % sourceWeight = ZERO + + end subroutine append + + !! + !! Provide particle type + !! + !! See configSource_inter for details. + !! + subroutine sampleType(self, p, rand) + class(blackBodySource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + + p % type = self % particleType + + end subroutine sampleType + + !! + !! Provide particle position + !! + !! See configSource_inter for details. + !! + subroutine samplePosition(self, p, rand) + class(blackBodySource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + integer(shortInt) :: i + real(defReal), dimension(3) :: r + real(defReal) :: x + character(100), parameter :: Here = 'samplePosition (blackBodySource_class.f90)' + + select case(self % distribution) + + case(SURFACE) + ! Set new x, y and z coords + do i = 1, 3 + r(i) = self % r(i) + rand % get()*self % dr(i) + end do + + case(OLSON1D) + ! Q(x) proportional to exp(-693x**3) + rejection:do + x = rand % get() * 4.8 + if (rand % get() < exp(-693*x**3)/0.100909) exit + end do rejection + r(1) = x - 2.4 + r(2) = rand % get() - 0.5 + r(3) = rand % get() - 0.5 + + case default + call fatalError(Here, 'Unrecognised source distribution') + + end select + + ! Assign to particle + p % r = r + + end subroutine samplePosition + + !! + !! Sample angle + !! + !! See configSource_inter for details. + !! + subroutine sampleEnergyAngle(self, p, rand) + class(blackBodySource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal), dimension(3) :: dir + real(defReal) :: phi, mu + character(100), parameter :: Here = 'sampleEnergyAngle (blackBodySource_class.f90)' + + ! Sample direction for isotropic source + if (all(self % rotation == ZERO)) then + ! Sample uniformly within unit sphere + mu = 2 * rand % get() - 1 + phi = rand % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + ! Assign to particle + p % dir = dir + return + end if + + ! If not isotropic, sample first with a primary direction of +x + phi = TWO_PI * rand % get() + mu = sqrt(rand % get()) + dir = [mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] + ! Rotate if necessary for different surfaces + p % dir = matmul(self % rotation, dir) + + end subroutine sampleEnergyAngle + + !! + !! Provide particle energy + !! + !! See configSource_inter for details. + !! + subroutine sampleEnergy(self, p, rand) + class(blackBodySource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: random + integer(shortInt) :: i + character(100), parameter :: Here = 'sampleEnergy (blackBodySource_class.f90)' + + p % isMG = .true. + + ! Sample energy group + random = rand % get() + do i=1, size(self % cumEnergyProbs) + if (random <= self % cumEnergyProbs(i)) then + p % G = i + return + end if + end do + + call fatalError(Here, 'Somehow failed to sample particle energy group') + + end subroutine sampleEnergy + + !! + !! Provide particle energy-weight + !! + !! See configSource_inter for details. + !! + subroutine sampleWeight(self, p, rand) + class(blackBodySource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + real(defReal) :: intensity + + p % wgt = self % particleWeight + + end subroutine sampleWeight + + !! + !! Sample time uniformly within time step + !! + subroutine sampleTime(self, p, rand) + class(blackBodySource), intent(inout) :: self + class(particleState), intent(inout) :: p + class(RNG), intent(inout) :: rand + + ! Sample time uniformly within time step + p % time = time % stepStart + timeStep() * rand % get() + + end subroutine sampleTime + + + + subroutine initSurface(self, dict) + class(blackBodySource), intent(inout) :: self + class(dictionary), intent(in) :: dict + real(defReal), dimension(6) :: bounds + character(nameLen) :: whichSurface + integer(shortInt) :: i + integer(shortInt), dimension(9) :: rotation + real(defReal) :: area + character(100), parameter :: Here = 'initSurface (blackBodySource_class.f90)' + + self % distribution = SURFACE + + bounds = self % geom % bounds() + + ! Bottom left corner + self % r = bounds(1:3) + ! Dimensions of bounding box + do i = 1, 3 + self % dr(i) = bounds(i+3) - bounds(i) + end do + + ! Get position bounds + call dict % get(whichSurface, 'surface') + + select case(whichSurface) + case('-x') + ! Set sampling position to be at constant x value + self % dr(1) = ZERO + ! Nudge to ensure sourcing in correct material + self % r(1) = bounds(1) + 2*SURF_TOL + ! Set rotation matrix for direction sampling + rotation = [[1,0,0],[0,1,0],[0,0,1]] + case('-y') + self % dr(2) = ZERO + self % r(2) = bounds(2) + 2*SURF_TOL + rotation = [[0,1,0],[1,0,0],[0,0,1]] + case('-z') + self % dr(3) = ZERO + self % r(3) = bounds(3) + 2*SURF_TOL + rotation = [[0,0,1],[0,1,0],[1,0,0]] + case('+x') + self % r(1) = bounds(4) - 2*SURF_TOL + self % dr(1) = ZERO + rotation = [[-1,0,0],[0,1,0],[0,0,1]] + case('+y') + self % r(2) = bounds(5) - 2*SURF_TOL + self % dr(2) = ZERO + rotation = [[0,-1,0],[1,0,0],[0,0,1]] + case('+z') + self % r(3) = bounds(6) - 2*SURF_TOL + self % dr(3) = ZERO + rotation = [[0,0,-1],[0,1,0],[1,0,0]] + case default + call fatalError(Here, 'Unrecognised surface, must be +/-x,y or z') + end select + + ! Note that reshape fills columns first so the above rotations are [[col1][col2][col3]] + self % rotation = reshape(rotation,[3,3]) + + ! Calculate surface area of source + area = product(self % dr, self % dr /= ZERO) + + ! Calculate total source energy + self % sourceWeight = radiationConstant * lightSpeed * timeStep() * self % T**4 * area / 4 + + end subroutine initSurface + + subroutine initCustom(self, dict) + class(blackBodySource), intent(inout) :: self + class(dictionary), intent(in) :: dict + real(defReal), dimension(6) :: bounds + character(nameLen) :: name + character(100), parameter :: Here = 'initCustom (blackBodySource_class.f90)' + + call dict % get(name, 'distribution') + + select case(name) + + case('olson1D') + self % distribution = OLSON1D + ! Isotropic directional sampling + self % rotation = ZERO + ! Set source weight + !self % sourceWeight = timeStep() * 0.100909 * 15 / (pi**4 * 0.5 * (exp(ONE) - ONE)) + self % sourceWeight = timeStep() * 0.100909 * 15 / (pi**4 * 0.5 * (exp(ONE) - ONE)) + + case default + call fatalError(Here, 'Unrecognised name for custom black body source') + + end select + + end subroutine initCustom + + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(blackBodySource), intent(inout) :: self + + ! Kill superclass + call kill_super(self) + + ! Kill local components + self % r = ZERO + self % dr = ZERO + self % distribution = SURFACE + self % particleType = P_PHOTON + self % isMG = .true. + self % T = ZERO + self % particleWeight = ZERO + + end subroutine kill + +end module blackBodySource_class diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index 7382d122d..e9335d472 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -12,6 +12,7 @@ module sourceFactory_func use fissionSource_class, only : fissionSource use materialSource_class, only : materialSource use bbSurfaceSource_class, only : bbSurfaceSource + use blackBodySource_class, only : blackBodySource ! geometry use geometry_inter, only : geometry @@ -69,6 +70,11 @@ subroutine new_source(new, dict, geom) allocate(bbSurfaceSource :: new) call new % init(dict, geom) + case('blackBodySource') + allocate(blackBodySource :: new) + call new % init(dict, geom) + + !*** NEW SOURCE TEMPLATE ***! !case('') ! allocate( :: new) From a2adecad44a2e1c0999896197f14d7422367bec7 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 31 Aug 2023 14:34:37 +0100 Subject: [PATCH 352/373] Redid tally class to be more name-accurate and to also tally radiation energy, plus other MG changes --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 8 +- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 8 +- .../mgIMCData/baseMgIMC/materialEquations.f90 | 4 +- .../implicitPhysicsPackage_class.f90 | 65 +++---- Tallies/TallyClerks/CMakeLists.txt | 2 +- ..._class.f90 => energyWeightClerk_class.f90} | 168 ++++++++++++------ .../TallyClerks/tallyClerkFactory_func.f90 | 8 +- .../TallyResponses/weightResponse_class.f90 | 4 +- 8 files changed, 169 insertions(+), 98 deletions(-) rename Tallies/TallyClerks/{absorptionClerk_class.f90 => energyWeightClerk_class.f90} (63%) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 057a1a7d3..7e4d70636 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -53,6 +53,7 @@ module baseMgIMCDatabase_class type(baseMgIMCMaterial), dimension(:), pointer :: mats => null() integer(shortInt), dimension(:), allocatable :: activeMats integer(shortInt) :: nG = 0 + type(energyGrid) :: eGrid contains ! Superclass Interface @@ -394,9 +395,10 @@ subroutine init(self, dict, ptr, silent) ! Get energy grid in multi-frequency case gridName = 'mg' - call get_energyGrid(mgEnergyGrid, gridName, err) - if (err .eqv. .false.) then - self % nG = mgEnergyGrid % getSize() + call get_energyGrid(self % eGrid, gridName, err) + if (err .eqv. .false.) then + self % nG = self % eGrid % getSize() + mgEnergyGrid => self % eGrid else self % nG = 1 end if diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index ef76f8952..b9420c9a9 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -190,8 +190,12 @@ subroutine init(self, dict) character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' ! Read number of groups - nG = mgEnergyGrid % getSize() - if (nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) + if (associated(mgEnergyGrid)) then + nG = mgEnergyGrid % getSize() + if (nG < 1) call fatalError(Here,'Number of groups is invalid' // numToChar(nG)) + else + nG = 1 + end if ! Allocate space for data N = 4 diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index 211385bc8..8d2945a42 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -30,7 +30,7 @@ module materialEquations public :: normPlanckSpectrum ! Energy grid for multi-frequency problems for easy access by material classes - type(energyGrid), public :: mgEnergyGrid + type(energyGrid), pointer, public :: mgEnergyGrid => null() interface evaluateCv module procedure evaluateCv @@ -133,7 +133,7 @@ function cvOlson1D(T) result(cv) alpha = 0.5*exp(-0.1/T)*(root-1) dAlphadT = 0.1*(alpha-1/root)/(T*T) - cv = 0.1*radiationConstant*(1+alpha+(T+0.1)*dAlphadT) + cv = 0.1*(1+alpha+(T+0.1)*dAlphadT) ! Deal with numerical errors from poorly defined regions (e.g. T almost 0) if (cv /= cv .or. cv > INF) cv = ZERO diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index 5be10acd3..2b0159191 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -48,7 +48,7 @@ module implicitPhysicsPackage_class use tallyCodes use tallyAdmin_class, only : tallyAdmin use tallyResult_class, only : tallyResult - use absorptionClerk_class, only : absClerkResult + use energyWeightClerk_class, only : energyWeightClerkResult ! Factories use transportOperatorFactory_func, only : new_transportOperator @@ -87,7 +87,7 @@ module implicitPhysicsPackage_class class(transportOperator), allocatable :: transOp class(RNG), pointer :: pRNG => null() type(tallyAdmin),pointer :: tally => null() - type(tallyAdmin),pointer :: imcWeightAtch => null() + type(tallyAdmin),pointer :: energyWeightAtch => null() ! Settings integer(shortInt) :: N_steps @@ -130,7 +130,7 @@ subroutine run(self) print *, repeat("<>",50) print *, "/\/\ IMPLICIT CALCULATION /\/\" - call self % steps(self % tally, self % imcWeightAtch, self % N_steps) + call self % steps(self % tally, self % energyWeightAtch, self % N_steps) call self % collectResults() print * @@ -313,18 +313,18 @@ subroutine steps(self, tally, tallyAtch, N_steps) call tally % display() ! Obtain energy deposition tally results - call tallyAtch % getResult(tallyRes, 'imcWeightTally') + call tallyAtch % getResult(tallyRes, 'energyWeightTally') ! Update material properties using tallied energy select type(tallyRes) - class is(absClerkResult) - call self % nucData % updateProperties(tallyRes % clerkResults, self % printUpdates) + class is(energyWeightClerkResult) + call self % nucData % updateProperties(tallyRes % materialEnergy, self % printUpdates) class default - call fatalError(Here, 'Tally result class should be absClerkResult') + call fatalError(Here, 'Tally result class should be energyWeightClerkResult') end select ! Reset tally for next time step - call tallyAtch % reset('imcWeightTally') + if (i /= N_Steps) call tallyAtch % reset('energyWeightTally') ! Advance to next time step call nextStep() @@ -345,6 +345,16 @@ subroutine steps(self, tally, tallyAtch, N_steps) end do close(10) + ! Output final radiation energies + open(unit = 11, file = 'radEnergy.txt') + select type(tallyRes) + class is(energyWeightClerkResult) + write(11, '(8A)') numToChar(tallyRes % radiationEnergy) + class default + call fatalError(Here, 'Tally result class should be energyWeightClerkResult') + end select + close(11) + end subroutine steps !! @@ -388,7 +398,7 @@ subroutine init(self, dict) class(implicitPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict class(dictionary), pointer :: tempDict, geomDict, dataDict - type(dictionary) :: locDict1, locDict2, locDict3, locDict4 + type(dictionary) :: locDict1, locDict2, locDict3 integer(shortInt) :: seed_temp integer(longInt) :: seed character(10) :: time @@ -396,8 +406,7 @@ subroutine init(self, dict) character(:),allocatable :: string character(nameLen) :: nucData, geomName type(outputFile) :: test_out - integer(shortInt) :: i, nGroups - real(defReal), dimension(:), allocatable :: energyBins + integer(shortInt) :: i character(nameLen), dimension(:), allocatable :: mats real(defReal) :: timeStep type(dictionary),target :: newGeom, newData @@ -459,6 +468,13 @@ subroutine init(self, dict) ! Read whether to print particle source each time step call dict % getOrDefault(self % printSource, 'printSource', 0) + ! Initialise energy grid in multi-frequency case + if (dict % isPresent('energyGrid')) then + tempDict => dict % getDictPtr('energyGrid') + call define_energyGrid(nucData, tempDict) + print *, 'Energy grid defined: ', nucData + end if + ! Automatically split geometry into a uniform grid if (dict % isPresent('discretise')) then @@ -477,12 +493,6 @@ subroutine init(self, dict) end if - ! Initialise energy grid in multi-frequency case - if (dict % isPresent('energyGrid')) then - tempDict => dict % getDictPtr('energyGrid') - call define_energyGrid(nucData, tempDict) - end if - ! Build Nuclear Data call ndReg_init(dataDict) @@ -546,25 +556,20 @@ subroutine init(self, dict) mats(i) = mm_matName(i) end do - ! Initialise imcWeight tally attachment + + ! Initialise energy weight tally attachment call locDict1 % init(1) - call locDict2 % init(4) + call locDict2 % init(2) call locDict3 % init(2) - call locDict4 % init(1) - - call locDict4 % store('type', 'weightResponse') call locDict3 % store('type','materialMap') call locDict3 % store('materials', [mats]) - call locDict2 % store('response', ['imcWeightResponse']) - call locDict2 % store('imcWeightResponse', locDict4) - call locDict2 % store('type','absorptionClerk') + call locDict2 % store('type','energyWeightClerk') call locDict2 % store('map', locDict3) - call locDict1 % store('imcWeightTally', locDict2) - - allocate(self % imcWeightAtch) - call self % imcWeightAtch % init(locDict1) + call locDict1 % store('energyWeightTally', locDict2) - call self % tally % push(self % imcWeightAtch) + allocate(self % energyWeightAtch) + call self % energyWeightAtch % init(locDict1) + call self % tally % push(self % energyWeightAtch) ! Size particle dungeons allocate(self % thisStep) diff --git a/Tallies/TallyClerks/CMakeLists.txt b/Tallies/TallyClerks/CMakeLists.txt index 6da7f659d..308cbeb00 100644 --- a/Tallies/TallyClerks/CMakeLists.txt +++ b/Tallies/TallyClerks/CMakeLists.txt @@ -11,7 +11,7 @@ add_sources(./tallyClerk_inter.f90 ./dancoffBellClerk_class.f90 ./shannonEntropyClerk_class.f90 ./centreOfMassClerk_class.f90 - ./absorptionClerk_class.f90 + ./energyWeightClerk_class.f90 ) add_unit_tests(./Tests/collisionClerk_test.f90 diff --git a/Tallies/TallyClerks/absorptionClerk_class.f90 b/Tallies/TallyClerks/energyWeightClerk_class.f90 similarity index 63% rename from Tallies/TallyClerks/absorptionClerk_class.f90 rename to Tallies/TallyClerks/energyWeightClerk_class.f90 index 65e0d4b46..a2829d257 100644 --- a/Tallies/TallyClerks/absorptionClerk_class.f90 +++ b/Tallies/TallyClerks/energyWeightClerk_class.f90 @@ -1,11 +1,10 @@ -module absorptionClerk_class +module energyWeightClerk_class use numPrecision use tallyCodes - use universalVariables, only : P_MATERIAL_MG use genericProcedures, only : fatalError use dictionary_class, only : dictionary - use particle_class, only : particle, particleState, P_MATERIAL + use particle_class, only : particle, particleState, P_PHOTON use outputFile_class, only : outputFile use scoreMemory_class, only : scoreMemory use tallyClerk_inter, only : tallyClerk, kill_super => kill @@ -46,7 +45,7 @@ module absorptionClerk_class !! SAMPLE DICTIOANRY INPUT: !! !! myAbsorptionClerk { - !! type absorptionClerk; + !! type energyWeightClerk; !! # filter { } # !! # map { } # !! response (resName1 #resName2 ... #) @@ -54,14 +53,14 @@ module absorptionClerk_class !! #resNamew { run-time procedures procedure :: reportHist + procedure :: reportTrans ! Output procedures procedure :: display procedure :: print procedure :: getResult - end type absorptionClerk + end type energyWeightClerk - type,public, extends(tallyResult) :: absClerkResult - real(defReal), dimension(:), allocatable :: clerkResults - end type absClerkResult + type, public, extends(tallyResult) :: energyWeightClerkResult + real(defReal), dimension(:), allocatable :: materialEnergy + real(defReal), dimension(:), allocatable :: radiationEnergy + end type energyWeightClerkResult + + + integer(shortInt), parameter :: MATERIAL_ENERGY = 1 + integer(shortInt), parameter :: RADIATION_ENERGY = 2 contains @@ -95,11 +100,13 @@ module absorptionClerk_class !! See tallyClerk_inter for details !! subroutine init(self, dict, name) - class(absorptionClerk), intent(inout) :: self + class(energyWeightClerk), intent(inout) :: self class(dictionary), intent(in) :: dict character(nameLen), intent(in) :: name character(nameLen),dimension(:),allocatable :: responseNames integer(shortInt) :: i + type(dictionary) :: locDict + character(100), parameter :: Here = 'init (energyWeightClerk_class.f90)' ! Assign name call self % setName(name) @@ -114,17 +121,18 @@ subroutine init(self, dict, name) call new_tallyMap(self % map, dict % getDictPtr('map')) end if - ! Get names of response dictionaries - call dict % get(responseNames,'response') + ! Call error if responses are given + if( dict % isPresent('response')) then + call fatalError(Here, 'Warning: response not needed for energyWeightClerk') + end if - ! Load responses - allocate(self % response(size(responseNames))) - do i=1, size(responseNames) - call self % response(i) % init(dict % getDictPtr( responseNames(i) )) - end do + ! Initialise weight response automatically + call locDict % init(1) + call locDict % store('type','weightResponse') + allocate(self % response(1)) + call self % response(1) % init(locDict) - ! Set width - self % width = size(responseNames) + self % width = 2 end subroutine init @@ -132,7 +140,7 @@ end subroutine init !! Return to uninitialised state !! elemental subroutine kill(self) - class(absorptionClerk), intent(inout) :: self + class(energyWeightClerk), intent(inout) :: self ! Superclass call kill_super(self) @@ -163,10 +171,10 @@ end subroutine kill !! See tallyClerk_inter for details !! function validReports(self) result(validCodes) - class(absorptionClerk),intent(in) :: self + class(energyWeightClerk),intent(in) :: self integer(shortInt),dimension(:),allocatable :: validCodes - validCodes = [hist_CODE] + validCodes = [trans_CODE,hist_CODE] end function validReports @@ -176,21 +184,75 @@ end function validReports !! See tallyClerk_inter for details !! elemental function getSize(self) result(S) - class(absorptionClerk), intent(in) :: self + class(energyWeightClerk), intent(in) :: self integer(shortInt) :: S - S = size(self % response) + S = self % width if(allocated(self % map)) S = S * self % map % bins(0) end function getSize + + + + subroutine reportHist(self, p, xsData, mem) + class(energyWeightClerk), intent(inout) :: self + class(particle), intent(in) :: p + class(nuclearDatabase), intent(inout) :: xsData + type(scoreMemory), intent(inout) :: mem + type(particleState) :: state + integer(shortInt) :: binIdx, i + integer(longInt) :: adrr + real(defReal) :: scoreVal, flx + character(100), parameter :: Here =' reportHist (energyWeightClerk_class.f90)' + + ! Get current particle state + state = p + + if (p % fate == LEAK_FATE) return + + ! 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 + + ! Calculate bin address + adrr = self % getMemAddress() + self % width * (binIdx -1) - 1 + + ! Calculate flux sample 1/totXs + flx = ONE / xsData % getTotalMatXS(p, p % matIdx()) + + ! Append all bins + scoreVal = self % response(1) % get(p, xsData) * p % w * flx + ! Deal with infinite cross sections - may not be the right solution for generality + if (scoreVal /= scoreVal) then + scoreVal = p % w + end if + call mem % score(scoreVal, adrr + MATERIAL_ENERGY) + + end subroutine reportHist + + + + + !! !! Process incoming collision report !! !! See tallyClerk_inter for details !! - subroutine reportHist(self, p, xsData, mem) - class(absorptionClerk), intent(inout) :: self + subroutine reportTrans(self, p, xsData, mem) + class(energyWeightClerk), intent(inout) :: self class(particle), intent(in) :: p class(nuclearDatabase), intent(inout) :: xsData type(scoreMemory), intent(inout) :: mem @@ -198,15 +260,14 @@ subroutine reportHist(self, p, xsData, mem) integer(shortInt) :: binIdx, i integer(longInt) :: adrr real(defReal) :: scoreVal, flx - character(100), parameter :: Here =' reportHist (absorptionClerk_class.f90)' + character(100), parameter :: Here = 'reportTrans (energyWeightClerk_class.f90)' ! Get current particle state state = p - if (p % fate == LEAK_FATE) return - if (p % getType() /= P_MATERIAL_MG .and. .not. p % isDead) then - call fatalError(Here, 'Particle is still alive') - end if + ! Consider only radiation particles (those surviving timestep) + if (p % fate /= AGED_FATE) return + if (p % type /= P_PHOTON) return ! Check if within filter if(allocated( self % filter)) then @@ -230,17 +291,14 @@ subroutine reportHist(self, p, xsData, mem) flx = ONE / xsData % getTotalMatXS(p, p % matIdx()) ! Append all bins - do i=1,self % width - scoreVal = self % response(i) % get(p, xsData) * p % w * flx - ! Deal with infinite cross sections - may not be the right solution for generality - if (scoreVal /= scoreVal) then - scoreVal = p % w - end if - call mem % score(scoreVal, adrr + i) - - end do + scoreVal = self % response(1) % get(p, xsData) * p % w * flx + ! Deal with infinite cross sections - may not be the right solution for generality + if (scoreVal /= scoreVal) then + scoreVal = p % w + end if + call mem % score(scoreVal, adrr + RADIATION_ENERGY) - end subroutine reportHist + end subroutine reportTrans !! !! Display convergance progress on the console @@ -248,10 +306,10 @@ end subroutine reportHist !! See tallyClerk_inter for details !! subroutine display(self, mem) - class(absorptionClerk), intent(in) :: self + class(energyWeightClerk), intent(in) :: self type(scoreMemory), intent(in) :: mem - print *, 'absorptionClerk does not support display yet' + print *, 'energyWeightClerk does not support display yet' end subroutine display @@ -261,7 +319,7 @@ end subroutine display !! See tallyClerk_inter for details !! subroutine print(self, outFile, mem) - class(absorptionClerk), intent(in) :: self + class(energyWeightClerk), intent(in) :: self class(outputFile), intent(inout) :: outFile type(scoreMemory), intent(in) :: mem real(defReal) :: val, std @@ -280,9 +338,9 @@ subroutine print(self, outFile, mem) ! Write results. ! Get shape of result array if(allocated(self % map)) then - resArrayShape = [size(self % response), self % map % binArrayShape()] + resArrayShape = [self % width, self % map % binArrayShape()] else - resArrayShape = [size(self % response)] + resArrayShape = [self % width] end if ! Start array @@ -308,22 +366,24 @@ end subroutine print !! See tallyClerk_inter for details !! pure subroutine getResult(self, res, mem) - class(absorptionClerk), intent(in) :: self + class(energyWeightClerk), intent(in) :: self class(tallyResult), allocatable, intent(inout) :: res type(scoreMemory), intent(in) :: mem - real(defReal), dimension(:), allocatable :: w + real(defReal), dimension(:), allocatable :: mat, rad integer(shortInt) :: i, N - N = self % getSize() - allocate( w(N) ) + N = self % getSize() / 2 + allocate(mat(N)) + allocate(rad(N)) ! Get result value for each material do i = 1, N - call mem % getResult(w(i), self % getMemAddress()+i-1) + call mem % getResult(mat(i), self % getMemAddress()+2*i-2) + call mem % getResult(rad(i), self % getMemAddress()+2*i-1) end do - allocate(res, source = absClerkResult(w)) + allocate(res, source = energyWeightClerkResult(mat,rad)) end subroutine getResult -end module absorptionClerk_class +end module energyWeightClerk_class diff --git a/Tallies/TallyClerks/tallyClerkFactory_func.f90 b/Tallies/TallyClerks/tallyClerkFactory_func.f90 index bc4579273..54c4fffd7 100644 --- a/Tallies/TallyClerks/tallyClerkFactory_func.f90 +++ b/Tallies/TallyClerks/tallyClerkFactory_func.f90 @@ -17,7 +17,7 @@ module tallyClerkFactory_func use dancoffBellClerk_class, only : dancoffBellClerk use shannonEntropyClerk_class, only : shannonEntropyClerk use centreOfMassClerk_class, only : centreOfMassClerk - use absorptionClerk_class, only : absorptionClerk + use energyWeightClerk_class, only : energyWeightClerk implicit none private @@ -38,7 +38,7 @@ module tallyClerkFactory_func 'shannonEntropyClerk ',& 'centreOfMassClerk ',& 'dancoffBellClerk ',& - 'absorptionClerk ' ] + 'energyWeightClerk '] contains @@ -98,8 +98,8 @@ subroutine new_tallyClerk(new, dict, name) allocate(centreOfMassClerk :: new) call new % init(dict, name) - case('absorptionClerk') - allocate(absorptionClerk :: new) + case('energyWeightClerk') + allocate(energyWeightClerk :: new) call new % init(dict, name) !*** NEW TALLY MAP TEMPLATE ***! diff --git a/Tallies/TallyResponses/weightResponse_class.f90 b/Tallies/TallyResponses/weightResponse_class.f90 index 87c599564..87980261e 100644 --- a/Tallies/TallyResponses/weightResponse_class.f90 +++ b/Tallies/TallyResponses/weightResponse_class.f90 @@ -19,7 +19,7 @@ module weightResponse_class !! !! tallyResponse for scoring particle weights - !! Currently supports neutrons only + !! Currently supports neutrons and IMC only !! !! Interface: !! tallyResponse interface @@ -65,7 +65,7 @@ end subroutine init !! See tallyResponse_inter for details !! !! Errors: - !! Return ZERO if particle is not a Neutron + !! Return ZERO if particle is not a Neutron or IMC !! function get(self, p, xsData) result(val) class(weightResponse), intent(in) :: self From 51d65b91f1352389908849b52882ebba7eff86fb Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 31 Aug 2023 15:03:11 +0100 Subject: [PATCH 353/373] Added comments --- .../Source/blackBodySource_class.f90 | 194 +++++++++++------- .../TallyClerks/energyWeightClerk_class.f90 | 41 ++-- 2 files changed, 140 insertions(+), 95 deletions(-) diff --git a/ParticleObjects/Source/blackBodySource_class.f90 b/ParticleObjects/Source/blackBodySource_class.f90 index 78fef9e73..0a773ec74 100644 --- a/ParticleObjects/Source/blackBodySource_class.f90 +++ b/ParticleObjects/Source/blackBodySource_class.f90 @@ -14,17 +14,13 @@ module blackBodySource_class use energyGrid_class, only : energyGrid use energyGridRegistry_mod, only : get_energyGrid - use blackBodyPdf_class, only : normPlanck - implicit none private - ! Options for source distribution integer(shortInt), parameter, public :: SURFACE = 1 integer(shortInt), parameter, public :: OLSON1D = 2 - !! !! Generates a source representing a black body surface !! @@ -41,7 +37,7 @@ module blackBodySource_class !! sampleType -> set particle type !! samplePosition -> set particle position !! sampleEnergyAngle -> sample particle angle - !! sampleEnergy -> set particle energy (isMG = .true., G = 1) + !! sampleEnergy -> set particle energy !! sampleWeight -> set particle energy-weight !! sampleTime -> set particle time !! kill -> terminate source @@ -74,9 +70,11 @@ module blackBodySource_class real(defReal), dimension(:), allocatable :: cumEnergyProbs contains + ! Initialisation procedures procedure :: init procedure :: initSurface procedure :: initCustom + ! Sampling procedures procedure :: append procedure :: sampleType procedure :: samplePosition @@ -90,73 +88,9 @@ module blackBodySource_class contains - !! - !! Initialise from dictionary - !! - !! See source_inter for details - !! - !! Errors: - !! - error if an axis other than x, y, or z is given - !! - subroutine init(self, dict, geom) - class(blackBodySource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - real(defReal), dimension(:), allocatable :: temp - integer(shortInt) :: i, j, nGroups, dir - real(defReal) :: nu, eStep - type(energyGrid) :: eGrid - logical(defBool) :: err - character(nameLen) :: gridName, distribution - character(100), parameter :: Here = 'init (blackBodySource_class.f90)' - - ! Provide geometry info to source - self % geom => geom - - ! Provide particle type - self % particleType = P_PHOTON - - ! Initialise specifics of source (e.g. position samlping bounds) - call dict % getOrDefault(distribution, 'distribution', 'surface') - select case(distribution) - case('surface') - call self % initSurface(dict) - case default - call self % initCustom(dict) - end select - - ! Get source temperature - call dict % get(self % T, 'temp') - - ! Get time step to turn off source - call dict % getOrDefault(self % timeStepMax, 'untilStep', 0) - - ! Exit in grey case - gridName = 'mg' - call get_energyGrid(eGrid, gridName, err) - if (err .eqv. .true.) return - - ! Calculate emission probability in each energy group - nGroups = eGrid % getSize() - allocate(self % cumEnergyProbs(nGroups)) - - do i=1, nGroups - eStep = (eGrid % bin(i) - eGrid % bin(i+1)) / 1000 - nu = eGrid % bin(i) - eStep/2 - ! Add previous group probability to get cumulative distribution - if (i > 1) self % cumEnergyProbs(i) = self % cumEnergyProbs(i-1) - ! Step through energies - do j=1, 1000 - self % cumEnergyProbs(i) = self % cumEnergyProbs(i) + eStep*normPlanck(nu,self % T) - nu = nu - eStep - end do - end do - - ! Normalise to account for exclusion of tail ends of distribution - ! TODO: should possibly add these tails into outer energy groups rather than normalising over all groups? - self % cumEnergyProbs = self % cumEnergyProbs / self % cumEnergyProbs(nGroups) - - end subroutine init +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Particle sampling procedures +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! !! Add particles to given dungeon @@ -280,7 +214,8 @@ subroutine sampleEnergyAngle(self, p, rand) phi = TWO_PI * rand % get() mu = sqrt(rand % get()) dir = [mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] - ! Rotate if necessary for different surfaces + + ! Rotate to direction of surface normal p % dir = matmul(self % rotation, dir) end subroutine sampleEnergyAngle @@ -300,6 +235,12 @@ subroutine sampleEnergy(self, p, rand) p % isMG = .true. + ! Grey case + if (.not.allocated(self % cumEnergyProbs)) then + p % G = 1 + return + end if + ! Sample energy group random = rand % get() do i=1, size(self % cumEnergyProbs) @@ -342,7 +283,88 @@ subroutine sampleTime(self, p, rand) end subroutine sampleTime +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Source initialisation procedures +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Initialise from dictionary + !! + !! See source_inter for details + !! + subroutine init(self, dict, geom) + class(blackBodySource), intent(inout) :: self + class(dictionary), intent(in) :: dict + class(geometry), pointer, intent(in) :: geom + real(defReal), dimension(:), allocatable :: temp + integer(shortInt) :: i, j, nGroups, dir + real(defReal) :: nu, eStep + type(energyGrid) :: eGrid + logical(defBool) :: err + character(nameLen) :: gridName, distribution + character(100), parameter :: Here = 'init (blackBodySource_class.f90)' + + ! Provide geometry info to source + self % geom => geom + + ! Provide particle type + self % particleType = P_PHOTON + ! Initialise specifics of source (e.g. position samlping bounds) + call dict % getOrDefault(distribution, 'distribution', 'surface') + select case(distribution) + case('surface') + call self % initSurface(dict) + case default + call self % initCustom(dict) + end select + + ! Get source temperature + call dict % get(self % T, 'temp') + + ! Get time step to turn off source + call dict % getOrDefault(self % timeStepMax, 'untilStep', 0) + + ! Exit in grey case + gridName = 'mg' + call get_energyGrid(eGrid, gridName, err) + if (err .eqv. .true.) return + + ! Calculate emission probability in each energy group + nGroups = eGrid % getSize() + allocate(self % cumEnergyProbs(nGroups)) + + do i=1, nGroups + eStep = (eGrid % bin(i) - eGrid % bin(i+1)) / 1000 + nu = eGrid % bin(i) - eStep/2 + ! Add previous group probability to get cumulative distribution + if (i > 1) self % cumEnergyProbs(i) = self % cumEnergyProbs(i-1) + ! Step through energies + do j=1, 1000 + self % cumEnergyProbs(i) = self % cumEnergyProbs(i) + eStep*normPlanck(nu,self % T) + nu = nu - eStep + end do + end do + + ! Normalise to account for exclusion of tail ends of distribution + ! TODO: should possibly add these tails into outer energy groups rather than normalising over all groups? + self % cumEnergyProbs = self % cumEnergyProbs / self % cumEnergyProbs(nGroups) + + end subroutine init + + + !! + !! Initialise source for standard black body surface by placing source as one side of + !! bounding bos of geometry + !! + !! Input dict should contain 'surface', corresponding to which side of the box is the source + !! e.g. surface -x; => source placed on negative x side of bounding box + !! surface +z; => source placed on positive z side of bounding box + !! etc. + !! + !! Automatically sets bounds for position sampling, rotation matrix for direction sampling, and + !! total weight emitted from the source during each time step + !! subroutine initSurface(self, dict) class(blackBodySource), intent(inout) :: self class(dictionary), intent(in) :: dict @@ -410,6 +432,13 @@ subroutine initSurface(self, dict) end subroutine initSurface + !! + !! Initialise black body source for more unique cases, e.g. Olson 1D MG benchmark (2020) + !! + !! Rotation matrix of ZERO corresponds to isotropic direction sampling. Set source weight or + !! other settings as required for specific case, and add additional cases to individual samping + !! procedures if needed. + !! subroutine initCustom(self, dict) class(blackBodySource), intent(inout) :: self class(dictionary), intent(in) :: dict @@ -436,7 +465,6 @@ subroutine initCustom(self, dict) end subroutine initCustom - !! !! Return to uninitialised state !! @@ -457,4 +485,22 @@ elemental subroutine kill(self) end subroutine kill + +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! Misc. procedures +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Return the frequency-normalised Planck spectrum evaluated for given frequency + !! nu and temperature T + !! + pure function normPlanck(E, T) result(b) + real(defReal), intent(in) :: E, T + real(defReal) :: b + + b = 15*E**3 / ((pi*T)**4 * (exp(E/T)-1)) + + end function normPlanck + + end module blackBodySource_class diff --git a/Tallies/TallyClerks/energyWeightClerk_class.f90 b/Tallies/TallyClerks/energyWeightClerk_class.f90 index a2829d257..6da618bea 100644 --- a/Tallies/TallyClerks/energyWeightClerk_class.f90 +++ b/Tallies/TallyClerks/energyWeightClerk_class.f90 @@ -30,8 +30,12 @@ module energyWeightClerk_class private !! - !! Colision estimator of reaction rates - !! Calculates flux weighted integral from collisions + !! Clerk for tallying energy weights. Weight response automatically initialised, does not accept + !! additional responses. + !! + !! Tallies two different energies: + !! materialEnergy (reportHist, weight of particles absorbed into material) + !! radiationEnergy (reportTrans, only for particles with fate=AGED_FATE) !! !! Private Members: !! filter -> Space to store tally Filter @@ -42,17 +46,17 @@ module energyWeightClerk_class !! Interface !! tallyClerk Interface !! - !! SAMPLE DICTIOANRY INPUT: + !! SAMPLE DICTIONARY INPUT: !! - !! myAbsorptionClerk { + !! myEnergyWeightClerk { !! type energyWeightClerk; !! # filter { } # !! # map { } # - !! response (resName1 #resName2 ... #) - !! resName1 { } - !! #resNamew { Date: Thu, 31 Aug 2023 18:24:52 +0100 Subject: [PATCH 354/373] Added some comments --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 13 ++--- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 50 +++++++++---------- .../Source/materialSource_class.f90 | 31 ++++++------ .../transportOperatorTimeHT_class.f90 | 9 ++++ 4 files changed, 57 insertions(+), 46 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 7e4d70636..49cbd8e24 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -37,14 +37,15 @@ module baseMgIMCDatabase_class public :: baseMgIMCDatabase_CptrCast !! - !! Basic type of MG nuclear Data for IMCs + !! Database for MG IMC and ISMC calculations !! - !! All materials in aproblem are baseMgMaterials. See its documentation for + !! All materials in a problem are of class baseMgIMCMaterial. See its documentation for !! details on how the physics is handled !! !! Public Members: !! mats -> array containing all defined materials (by matIdx) !! activeMats -> list of matIdxs of materials active in the problem + !! nG -> number of energy groups !! !! Interface: !! nuclearDatabase interface @@ -53,7 +54,7 @@ module baseMgIMCDatabase_class type(baseMgIMCMaterial), dimension(:), pointer :: mats => null() integer(shortInt), dimension(:), allocatable :: activeMats integer(shortInt) :: nG = 0 - type(energyGrid) :: eGrid + type(energyGrid), private :: eGrid contains ! Superclass Interface @@ -219,7 +220,7 @@ end function getReaction !! !! Args: !! matIdx [in] [optional] -> If provided, return the energy to be emitted from only matIdx - !! Otherwise, return total energy to be emitted from all mats + !! Otherwise, return the total energy to be emitted from all mats !! function getEmittedRad(self, matIdx) result(energy) class(baseMgIMCDatabase), intent(in) :: self @@ -247,7 +248,7 @@ end function getEmittedRad !! !! Args: !! matIdx [in] [optional] -> If provided, return the energy of only matIdx - !! Otherwise, return total energy of all mats + !! Otherwise, return the total energy of all mats !! function getMaterialEnergy(self, matIdx) result(energy) class(baseMgIMCDatabase), intent(in) :: self @@ -286,7 +287,7 @@ subroutine updateProperties(self, tallyEnergy, printUpdates) if (printUpdates > size(self % mats)) call fatalError(Here, & &'printUpdates must be <= nMats') - ! Update mats to be printed (if any) + ! Update mats to be printed (if any), not in parallel to allow correct order of console output do i = 1, printUpdates call self % mats(i) % updateMat(tallyEnergy(i), .true.) end do diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index b9420c9a9..9384b971b 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -37,13 +37,9 @@ module baseMgIMCMaterial_class integer(shortInt), parameter, public :: ISMC = 2 !! - !! Basic type of MG material data + !! Material class for MG IMC and ISMC calculations !! !! Stores MG data in a table. - !! All other scattering reactions are lumped into single multiplicative scattering, - !! which is stored as INELASTIC scatering in macroXSs package! After all it is inelastic in - !! the sense that outgoing group can change. Diffrent types of multiplicative scattering can be - !! build. See doc of "init" procedure for details. !! !! Public members: !! data -> Rank 2 array with all XSs data @@ -51,12 +47,17 @@ module baseMgIMCMaterial_class !! Interface: !! materialHandle interface !! mgIMCMaterial interface - !! init -> initialise Basic MG Material from dictionary and config keyword - !! nGroups -> returns number of energy groups - !! updateMat -> update material properties as required for IMC calculation - !! getEmittedRad -> returns the radiation to be emitted in current timestep - !! getFleck -> returns current material Fleck factor - !! getTemp -> returns current material temperature + !! init -> initialise Basic MG Material from dictionary and config keywords + !! nGroups -> returns number of energy groups + !! updateMat -> update material properties as required for IMC calculation + !! getEmittedRad -> returns the radiation to be emitted in current timestep + !! getFleck -> returns current material Fleck factor + !! getEta -> returns current value of eta (ISMC only) + !! getTemp -> returns current material temperature + !! getMatEnergy -> returns energy of material + !! setCalcType -> set to IMC or ISMC + !! sampleEnergyGroup -> return sampled energy group of an emitted photon + !! sampleTransformTime -> return sampled time for transform of P_MATERIAL to P_PHOTON (ISMC) !! !! Note: !! Order of "data" array is: data(XS_type, Group #) @@ -65,17 +66,17 @@ module baseMgIMCMaterial_class !! type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial real(defReal),dimension(:,:), allocatable :: data - character(nameLen) :: name - real(defReal) :: T - real(defReal) :: V - real(defReal) :: fleck - real(defReal) :: alpha - real(defReal) :: sigmaP - real(defReal) :: matEnergy - real(defReal) :: prevMatEnergy - real(defReal) :: energyDens - real(defReal) :: eta - integer(shortInt) :: calcType + character(nameLen) :: name ! Name for update equations (see materialEquations.f90) + real(defReal) :: T ! Temperature + real(defReal) :: V ! Volume + real(defReal) :: fleck ! Fleck factor + real(defReal) :: alpha ! User-defined parameter for fleck factor + real(defReal) :: sigmaP ! Planck opacity + real(defReal) :: matEnergy ! Total energy stored in material + real(defReal) :: prevMatEnergy ! Energy prior to material update + real(defReal) :: energyDens ! Energy density = matEnergy/V + real(defReal) :: eta ! aT^4/energyDens, used for ISMC only + integer(shortInt) :: calcType ! IMC or ISMC contains ! Superclass procedures @@ -170,7 +171,6 @@ function getTotalXS(self, G, rand) result(xs) end function getTotalXS - !! !! Initialise Base MG IMC Material fromdictionary !! @@ -339,6 +339,7 @@ subroutine updateMat(self, tallyEnergy, printUpdate) real(defReal), intent(in) :: tallyEnergy logical(defBool), intent(in), optional :: printUpdate character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" + ! TODO: Print updates if requested ! Save previous energy @@ -513,7 +514,6 @@ subroutine updateFleck(self) self % eta = radiationConstant * self % T**4 / self % energyDens zeta = beta - self % eta self % fleck = 1 / (1 + zeta*self % sigmaP*lightSpeed*timeStep()) - ! TODO: Check that 0 temperature will not cause problems case default call fatalError(Here, 'Unrecognised calculation type') @@ -633,8 +633,6 @@ function sampleTransformTime(self, rand) result(t) t = -log(rand % get()) / (self % data(CAPTURE_XS,G) * self % fleck * self % eta * lightSpeed) - ! TODO: consider implications when T = 0 (=> eta = 0) - end function sampleTransformTime end module baseMgIMCMaterial_class diff --git a/ParticleObjects/Source/materialSource_class.f90 b/ParticleObjects/Source/materialSource_class.f90 index dc5f98d25..26060b9b3 100644 --- a/ParticleObjects/Source/materialSource_class.f90 +++ b/ParticleObjects/Source/materialSource_class.f90 @@ -30,15 +30,23 @@ module materialSource_class integer(shortInt), parameter :: IMC = 1, ISMC = 2 !! - !! IMC Source for uniform generation of photons within a material + !! Source for uniform generation of photons within a material for IMC and ISMC calculations !! - !! Angular distribution is isotropic. + !! Angular distribution is isotropic !! !! Private members: - !! isMG -> is the source multi-group? (default = .true.) - !! bottom -> Bottom corner (x_min, y_min, z_min) - !! top -> Top corner (x_max, y_max, z_max) - !! G -> Group (default = 1) + !! isMG -> is the source multi-group? (default = .true.) + !! bottom -> Bottom corner (x_min, y_min, z_min) + !! top -> Top corner (x_max, y_max, z_max) + !! latPitch -> Pitch of lattice (if using a lattice geom) + !! latSizeN -> Lattice dimensions (if using a lattice geom) + !! G -> Energy group + !! pType -> P_PHOTON for IMC, P_MATERIAL for ISMC + !! bounds -> Bounds of geometry + !! method -> REJ uses rejection sampling for position (VERY slow for many materials) + !! -> FAST samples only within bounds of each material so no rejection needed, + !! currently only works for lattics geometry (hence lattice settings above) + !! calcType -> IMC or ISMC, changes type of material to be sampled !! !! Interface: !! source_inter Interface @@ -70,7 +78,7 @@ module materialSource_class contains !! - !! Initialise IMC Source + !! Initialise material Source !! !! See source_inter for details !! @@ -198,11 +206,8 @@ subroutine append(self, dungeon, N, rand) end subroutine append - - !! - !! Sample particle's phase space co-ordinates !! - !! See source_inter for details + !! Should not be called !! function sampleParticle(self, rand) result(p) class(materialSource), intent(inout) :: self @@ -218,7 +223,6 @@ function sampleParticle(self, rand) result(p) end function sampleParticle - !! !! Sample particle's phase space co-ordinates !! @@ -226,6 +230,7 @@ end function sampleParticle !! rand [in] -> RNG !! matIdx [in] -> index of material being sampled from !! energy [in] -> energy-weight of sampled particle + !! G [in] -> energy group of sampled particle !! bounds [in] -> bounds for position search, will be bounds of entire geometry if using !! rejection sampling method, and bounds of single material if using fast !! @@ -289,7 +294,6 @@ function sampleIMC(self, rand, targetMatIdx, energy, G, bounds) result(p) end function sampleIMC - !! !! Get location of material in lattice for position sampling !! @@ -378,5 +382,4 @@ pure function get_ijk(flippedLocalID, sizeN) result(ijk) end function get_ijk - end module materialSource_class diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 107c5f4ae..f682ed0b0 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -69,6 +69,15 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) if (p % fate == AGED_FATE) return end if + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) then + ! TODO: Figure out why this sometimes happens + print *, 'WARNING: Leak before transport?' + p % fate = LEAK_FATE + p % isDead = .true. + return + end if + ! Select action based on specified method - HT and GT start with DT but can switch to ST if (self % method == ST) then call self % surfaceTracking(p) From 6ad0e40a83ec1dd7f25d0918615cb19098628028 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 2 Sep 2023 00:00:27 +0100 Subject: [PATCH 355/373] Fixed some issues preventing hohlraum benchmark from working --- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 4 +++- ParticleObjects/Source/blackBodySource_class.f90 | 6 +++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 9384b971b..0116a1ea8 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -402,8 +402,10 @@ function tempFromEnergy(self) result(T) i = i+1 if (i > 1000000) then print *, U, self % energyDens - call fatalError(Here, "1000,000 iterations without convergence") + call fatalError(Here, "1,000,000 iterations without convergence") end if + ! Increase step size to avoid lack of convergence due to very small starting temperature + if (mod(i,1000)==0) dT = 10*dT ! Increment temperature and increment the corresponding energy density tempT = T + dT/2 diff --git a/ParticleObjects/Source/blackBodySource_class.f90 b/ParticleObjects/Source/blackBodySource_class.f90 index 0a773ec74..181998b1e 100644 --- a/ParticleObjects/Source/blackBodySource_class.f90 +++ b/ParticleObjects/Source/blackBodySource_class.f90 @@ -310,6 +310,9 @@ subroutine init(self, dict, geom) ! Provide particle type self % particleType = P_PHOTON + ! Get source temperature + call dict % get(self % T, 'temp') + ! Initialise specifics of source (e.g. position samlping bounds) call dict % getOrDefault(distribution, 'distribution', 'surface') select case(distribution) @@ -319,9 +322,6 @@ subroutine init(self, dict, geom) call self % initCustom(dict) end select - ! Get source temperature - call dict % get(self % T, 'temp') - ! Get time step to turn off source call dict % getOrDefault(self % timeStepMax, 'untilStep', 0) From 853a36d475972943f0856d4f7865408a03a75282 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 8 Oct 2023 21:28:51 +0100 Subject: [PATCH 356/373] Added new geometry class, allowed simplification of particle sourcing --- Geometry/CMakeLists.txt | 1 + Geometry/discretiseGeom_class.f90 | 17 +- Geometry/geometryGrid_class.f90 | 622 ++++++++++++++++++ Geometry/geometryReg_mod.f90 | 7 +- Geometry/geometryStd_class.f90 | 39 -- Geometry/geometry_inter.f90 | 13 - NuclearData/materialMenu_mod.f90 | 31 +- .../Source/materialSource_class.f90 | 127 +--- .../implicitPhysicsPackage_class.f90 | 43 +- 9 files changed, 685 insertions(+), 215 deletions(-) create mode 100644 Geometry/geometryGrid_class.f90 diff --git a/Geometry/CMakeLists.txt b/Geometry/CMakeLists.txt index f459c0965..e4932db69 100644 --- a/Geometry/CMakeLists.txt +++ b/Geometry/CMakeLists.txt @@ -10,6 +10,7 @@ add_sources( ./csg_class.f90 ./geometryStd_class.f90 ./geometryReg_mod.f90 ./discretiseGeom_class.f90 + ./geometryGrid_class.f90 ) add_unit_tests( ./Tests/geomGraph_test.f90 diff --git a/Geometry/discretiseGeom_class.f90 b/Geometry/discretiseGeom_class.f90 index f017e17c7..f0d828669 100644 --- a/Geometry/discretiseGeom_class.f90 +++ b/Geometry/discretiseGeom_class.f90 @@ -1,3 +1,13 @@ + + + +!! +!! NOTE: With the addition of geometryGrid_class this module is obsolete. I left it in in case any +!! parts of it might have other uses but feel free to delete if not +!! + + + !! !! Module to help with simplify the process of writing input files, specifically aimed at IMC but !! may be useful for other applications if needed @@ -242,8 +252,13 @@ subroutine writeToFiles(dict) &radii (0); fills (m'//numToChar(i)//');}' ! Material +! write(22, '(8A)') 'm'//numToChar(i)//' {temp '//numToChar(mm_matTemp(matIdx))//'; & +! &composition {} xsFile '//trim(mm_matFile(matIdx))//'; volume '//numToChar(volume)//';}' + + ! Material write(22, '(8A)') 'm'//numToChar(i)//' {temp '//numToChar(mm_matTemp(matIdx))//'; & - &composition {} xsFile '//trim(mm_matFile(matIdx))//'; volume '//numToChar(volume)//';}' + &xsFile '//trim(mm_matFile(matIdx))//'; volume '//numToChar(volume)//';}' + end if end do diff --git a/Geometry/geometryGrid_class.f90 b/Geometry/geometryGrid_class.f90 new file mode 100644 index 000000000..3f4119ad3 --- /dev/null +++ b/Geometry/geometryGrid_class.f90 @@ -0,0 +1,622 @@ +module geometryGrid_class + + use numPrecision + use universalVariables + use genericProcedures, only : fatalError, numToChar + use coord_class, only : coordList, coord + use dictionary_class, only : dictionary + use charMap_class, only : charMap + use geometry_inter, only : geometry, distCache + use csg_class, only : csg + use universe_inter, only : universe + use latUniverse_class, only : latUniverse + use surface_inter, only : surface + + ! Nuclear Data + use materialMenu_mod, only : nMat ,& + mm_matTemp => matTemp ,& + mm_matFile => matFile ,& + mm_init => init ,& + mm_kill => kill,& + mm_matName => matName + + implicit none + private + + !! + !! A very simplified geometry model consisting of a uniform grid. This simplicity means we don't + !! need to worry about nesting levels or complex shapes making things in general much faster. + !! Useful for many IMC benchmarks when we need to split each material region into discrete zones + !! to accurately model a time-evolving temperature field, especially when using a large number of + !! zones. + !! + !! Makes use of csg_class and copies of geometryStd_class functions for initialisation only, such + !! that input files can be virtually identical to geometryStd. + !! + !! Sample Dictionary Input: + !! geometry { + !! type geometryGrid; + !! dimensions (10 10 10); + !! + !! } + !! + !! This sample input will build the CSG geometry as in geometryStd_class, then construct a simple + !! grid geometry automatically by with 10x10x10 cells, with the material in each cell equal to the + !! material at the central point of that grid cell in the original CSG geometry. Each grid cell + !! has a new instance of each material, even if multiple grid cells are contained in a single CSG + !! material. MatIdxs will line up with localID if there are no VOID regions, if void is present + !! then this will become out of sync - however matName e.g. 'mat63' correctly corresponds to + !! position 63 (can be converted to ijk position similar to get_ijk in latUniverse_class). + !! + !! Interface: + !! Geometry Interface + !! + type, public, extends(geometry) :: geometryGrid + type(csg) :: geom + integer(shortInt), dimension(:), allocatable :: latSizeN + real(defReal), dimension(3) :: latPitch + real(defReal), dimension(3) :: corner + integer(shortInt), dimension(:,:,:), allocatable :: mats + real(defReal), dimension(6) :: geomBounds + integer(shortInt), dimension(:), allocatable :: boundary + + contains + ! Superclass procedures + procedure :: init + procedure :: kill + procedure :: placeCoord + procedure :: whatIsAt + procedure :: bounds + procedure :: move_noCache + procedure :: move_withCache + procedure :: moveGlobal + procedure :: teleport + procedure :: activeMats + + ! Public procedure unique to this class + procedure :: matBounds + + ! Private procedures + procedure, private :: explicitBC + procedure, private :: csg_diveToMat + procedure, private :: csg_placeCoord + procedure, private :: csg_whatIsAt + end type geometryGrid + +contains + + !! + !! Initialise geometry + !! + !! See geometry_inter for details + !! + subroutine init(self, dict, mats, silent) + class(geometryGrid), intent(inout) :: self + class(dictionary), intent(in) :: dict + type(charMap), intent(in) :: mats + logical(defBool), optional, intent(in) :: silent + logical(defBool) :: loud + real(defReal), dimension(6) :: bounds + class(surface), pointer :: surf + real(defReal), dimension(3) :: r + type(dictionary) :: matDict, tempDict + real(defReal) :: volume + integer(shortInt) :: i, j, k, z, N, matIdx, uniqueID, idxCounter, voidCounter + character(100), parameter :: Here = 'init (geometryGrid_class.f90)' + + ! Choose whether to display messages + if (present(silent)) then + loud = .not.silent + else + loud = .true. + end if + + ! Build the representation using CSG geometry + call self % geom % init(dict, mats, silent) + + if (loud) then + print *, "/\/\ CONVERTING CSG GEOMETRY TO GRID GEOMETRY /\/\" + end if + + ! Get geometry bounds + surf => self % geom % surfs % getPtr(self % geom % borderIdx) + bounds = surf % boundingBox() + self % geomBounds = bounds + + ! Get geometry discretisation + call dict % get(self % latSizeN, 'dimensions') + if (size(self % latSizeN) /= 3) call fatalError(Here, 'Dimenions must be of size 3') + + do i = 1, 3 + self % latPitch(i) = (bounds(i+3) - bounds(i)) / self % latSizeN(i) + end do + self % corner = bounds(1:3) + volume = product(self % latPitch) + + ! Allocate space for material indexes + allocate(self % mats(self % latSizeN(1),self % latSizeN(2),self % latSizeN(3))) + + ! Initialise dictionary of materials for materialMenu_mod initialisation + N = product(self % latSizeN) + call matDict % init(1) + + ! Loop through each grid cell + idxCounter = 0 + voidCounter = 0 + do k = 1, self % latSizeN(3) + + ! Flip in z axis for consistency with latUniverse_class + z = self % latSizeN(3) - k + 1 + + do j = 1, self % latSizeN(2) + do i = 1, self % latSizeN(1) + + ! Get material at cell centre + r = self % corner + [i-HALF,j-HALF,z-HALF]*self % latPitch + call self % csg_whatIsAt(matIdx, uniqueID, r) + + ! Don't create a new material for void regions + if (matIdx == VOID_MAT) then + self % mats(i,j,z) = VOID_MAT + ! Count number of void regions so that matName will match up with lattice position + ! => easier data processing after obtaining results + voidCounter = voidCounter + 1 + cycle + end if + + ! Next matIdx + idxCounter = idxCounter + 1 + + ! Store in dictionary of new materials + call tempDict % init(3) + call tempDict % store('temp', mm_matTemp(matIdx)) + call tempDict % store('volume', volume) + call tempDict % store('xsFile', mm_matFile(matIdx)) + call matDict % store('mat'//numToChar(idxCounter+voidCounter), tempDict) + call tempDict % kill() + + self % mats(i,j,z) = idxCounter + + end do + end do + end do + + ! Kill current geometry and materials + call self % geom % kill() + call mm_kill() + + ! Initialise new materials + call mm_init(matDict) + + ! Kill material dictionary + call matDict % kill() + + ! Get boundary conditions + call dict % get(self % boundary, 'boundary') + if (size(self % boundary) /= 6) call fatalError(Here, 'boundary should be an array of size 6') + + ! Print finish line + if (loud) then + print *, "\/\/ FINISHED BUILDING GRID GEOMETRY \/\/" + print *, repeat('<>', MAX_COL/2) + end if + + end subroutine init + + !! + !! Return to uninitialised state + !! + elemental subroutine kill(self) + class(geometryGrid), intent(inout) :: self + + call self % geom % kill() + !TODO + + end subroutine kill + + !! + !! Place coordinate list into geometry + !! + !! See geometry_inter for details + !! + subroutine placeCoord(self, coords) + class(geometryGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + integer(shortInt) :: matIdx, uniqueID + character(100), parameter :: Here = 'placeCoord (geometryGrid_class.f90)' + + call self % whatIsAt(matIdx, uniqueID, coords % lvl(1) % r) + coords % matIdx = matIdx + + end subroutine placeCoord + + !! + !! Find material and unique cell at a given location + !! + !! See geometry_inter for details + !! + subroutine whatIsAt(self, matIdx, uniqueID, r, u) + class(geometryGrid), intent(in) :: self + integer(shortInt), intent(out) :: matIdx + integer(shortInt), intent(out) :: uniqueID + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(3), optional, intent(in) :: u + integer(shortInt), dimension(3) :: ijk + + ! Avoid rounding error for leaked particles very close to boundary + if (any(r < self % corner) .or. any(r > self % geomBounds(4:6))) then + matIdx = OUTSIDE_MAT + uniqueID = matIdx + return + end if + + ! Determine ijk location of cell + ijk = floor((r - self % corner) / self % latPitch) + 1 + + ! Get matIdx from array + matIdx = self % mats(ijk(1),ijk(2),ijk(3)) + + ! UniqueID not needed, set equal to matIdx to avoid compiler warning + uniqueID = matIdx + + end subroutine whatIsAt + + !! + !! Return Axis Aligned Bounding Box encompassing the geometry + !! + !! See geometry_inter for details + !! + function bounds(self) + class(geometryGrid), intent(in) :: self + real(defReal), dimension(6) :: bounds + + bounds = self % geomBounds + + end function bounds + + !! + !! Given coordinates placed in the geometry move point through the geometry + !! + !! See geometry_inter for details + !! + !! Uses explicit BC + !! + subroutine move_noCache(self, coords, maxDist, event) + class(geometryGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + real(defReal) :: dist + real(defReal), dimension(3) :: r, u, r_bar + character(100), parameter :: Here = 'move (geometryGrid_class.f90)' + + ! Calculate distance to next cell crossing + r = coords % lvl(1) % r + u = coords % lvl(1) % dir + r_bar = (r - self % corner) / self % latPitch ! Normalise position within grid + r_bar = r_bar - floor(r_bar) ! Normalise position within cell + r_bar = (HALF - r_bar + sign(HALF, u)) * self % latPitch + dist = minval(r_bar / u) ! Which direction will result in crossing + + ! Check that distance is valid + if (dist <= ZERO) then ! TODO: Also add check for maximum distance? + call fatalError(Here, 'Distance invalid: '//numToChar(dist)) + end if + + if (maxDist < dist) then ! Moves within cell + call coords % moveGlobal(maxDist) + event = COLL_EV + maxDist = maxDist ! Left for explicitness and compiler + + else ! Move to next cell, increased by NUDGE to avoid numerical issues + call coords % moveGlobal(dist + NUDGE) + event = CROSS_EV + maxDist = dist + NUDGE + + end if + + ! Set matIdx + call self % placeCoord(coords) + + ! Apply boundary conditions if necessary + if (coords % matIdx == OUTSIDE_MAT) call self % explicitBC(coords) + + end subroutine move_noCache + + !! + !! Given coordinates placed in the geometry move point through the geometry + !! + !! See geometry_inter for details + !! + !! Uses explicit BC + !! + subroutine move_withCache(self, coords, maxDist, event, cache) + class(geometryGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + type(distCache), intent(inout) :: cache + character(100), parameter :: Here = 'move_withCache (geometryGrid_class.f90)' + + ! Unnecessary + call fatalError(Here, 'Should not be called') + + end subroutine move_withCache + + !! + !! Move a particle in the top (global) level in the geometry + !! + !! See geometry_inter for details + !! + !! Uses explicit BC + !! + subroutine moveGlobal(self, coords, maxDist, event) + class(geometryGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(inout) :: maxDist + integer(shortInt), intent(out) :: event + + !TODO + call fatalError('moveGlobal (geomGrid)', 'global') + + end subroutine moveGlobal + + !! + !! Move a particle in the top level without stopping + !! + !! See geometry_inter for details + !! + !! Uses co-ordinate transform boundary XSs + !! + subroutine teleport(self, coords, dist) + class(geometryGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + real(defReal), intent(in) :: dist + + ! Move the coords above the geometry + call coords % moveGlobal(dist) + + ! Place coordinates back into geometry + call self % placeCoord(coords) + + ! If point is outside apply boundary transformations + if (coords % matIdx == OUTSIDE_MAT) then + call self % explicitBC(coords) + call self % placeCoord(coords) + end if + + end subroutine teleport + + !! + !! CSG equivalent normally in surface class, since we are not using surfaces perform boundary + !! transformations here instead + !! + !! Note indexing difference between bounds and boundary: + !! bounds = [xmin, ymin, zmin, xmax, ...] + !! boundary = [x-, x+, y-, y+, z-,z+] + !! + subroutine explicitBC(self, coords) + class(geometryGrid), intent(in) :: self + class(coordList), intent(inout) :: coords + integer(shortInt) :: i + real(defReal) :: outside, move + + ! Loop through axes + do i = 1, 3 + move = ZERO + + ! Negative side of bounding box + outside = (self % geomBounds(i) - coords % lvl(1) % r(i)) + if (outside >= ZERO .and. self % boundary(2*i-1) == 1) move = outside + + ! Positive side of bounding box + outside = (coords % lvl(1) % r(i) - self % geomBounds(i+3)) + if (outside >= ZERO .and. self % boundary(2*i) == 1) move = outside + + ! Move if necessary + if (move > ZERO) then + ! Flip direction + coords % lvl(1) % dir(i) = -coords % lvl(1) % dir(i) + ! Move back into geometry + call self % teleport(coords, 2*move/abs(coords % lvl(1) % dir(i))) + end if + + end do + + end subroutine explicitBC + + !! + !! Returns the list of active materials used in the geometry + !! + !! See geometry_inter for details + !! + !! NOTE: This function uses VOID_MAT and UNDEF_MAT from universalVariables + !! + function activeMats(self) result(matList) + class(geometryGrid), intent(in) :: self + integer(shortInt), dimension(:), allocatable :: matList + + matList = reshape(self % mats, (/1/)) + + end function activeMats + + !! + !! Return position bounds of a material matIdx + !! + !! Result: + !! matBounds -> [xmin,ymin,zmin,xmax,ymax,zmax] + !! + function matBounds(self, matIdx) + class(geometryGrid), intent(in) :: self + integer(shortInt), intent(in) :: matIdx + real(defReal), dimension(6) :: matBounds + integer(shortInt), dimension(3) :: ijk + integer(shortInt) :: i, localID, temp, base + character(nameLen) :: matName + character(100), parameter :: Here = 'matBounds (geometryGrid_class.f90)' + + ! Convert matIdx to positional ID using name (will be different if void regions exist) + matName = mm_matName(matIdx) + read (matName(4:), '(I10)') localID + + ! Convert positional ID to ijk position (same as in latUniverse_class) + temp = localID - 1 + base = temp / self % latSizeN(1) + ijk(1) = temp - self % latSizeN(1) * base + 1 + temp = base + base = temp / self % latSizeN(2) + ijk(2) = temp - self % latSizeN(2) * base + 1 + ijk(3) = base + 1 + + ! Confirm that position is correct + if (self % mats(ijk(1),ijk(2),ijk(3)) /= matIdx) then + call fatalError(Here, 'Obtained matIdx different to requested matIdx') + end if + + ! Set bounds of material + do i=1, 3 + matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % geomBounds(i) + SURF_TOL + matBounds(i+3) = ijk(i) * self % latPitch(i) + self % geomBounds(i) - SURF_TOL + end do + + end function matBounds + + +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> +!! CSG procedures used for initialisation +!!<><><><><><><>><><><><><><><><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> + + !! + !! Descend down the geometry structure untill material is reached + !! + !! Requires strting level to be specified. + !! It is private procedure common to all movment types in geometry. + !! + !! Args: + !! coords [inout] -> CoordList of a particle. Assume thet coords are already valid for all + !! levels above and including start + !! start [in] -> Starting level for meterial search + !! + !! Errors: + !! fatalError if material cell is not found untill maximum nesting is reached + !! + subroutine csg_diveToMat(self, coords, start) + class(geometryGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + integer(shortInt), intent(in) :: start + integer(shortInt) :: rootID, localID, fill, id, i + class(universe), pointer :: uni + real(defReal), dimension(3) :: offset + character(100), parameter :: Here = 'diveToMat (geometryGrid_class.f90)' + + do i = start, HARDCODED_MAX_NEST + ! Find cell fill + rootId = coords % lvl(i) % uniRootID + localID = coords % lvl(i) % localID + call self % geom % graph % getFill(fill, id, rootID, localID) + + if (fill >= 0) then ! Found material cell + coords % matIdx = fill + coords % uniqueID = id + return + + else ! Universe fill descend a level + if (i == HARDCODED_MAX_NEST) exit ! If there is nested universe at the lowest level + + fill = abs(fill) + + ! Get current universe + uni => self % geom % unis % getPtr_fast(coords % lvl(i) % uniIdx) + + ! Get cell offset + offset = uni % cellOffset(coords % lvl(i)) + + ! Get nested universe + uni => self % geom % unis % getPtr_fast(fill) + + ! Enter nested univers + call coords % addLevel() + call uni % enter(coords % lvl(i+1), coords % lvl(i) % r - offset, coords % lvl(i) % dir) + coords % lvl(i+1) % uniRootID = id ! Must be after enter where coord has intent out + + end if + end do + + call fatalError(Here, 'Failed to find material cell. Should not happen after & + &geometry checks during build...') + + end subroutine csg_diveToMat + + + !! + !! Place coordinate list into geometry + !! + !! See geometry_inter for details + !! + subroutine csg_placeCoord(self, coords) + class(geometryGrid), intent(in) :: self + type(coordList), intent(inout) :: coords + class(universe), pointer :: uni + real(defReal), dimension(3) :: r, dir + character(100), parameter :: Here = 'placeCoord (geometryGrid_class.f90)' + + ! Check that coordList is initialised + if (coords % nesting < 1) then + call fatalError(Here, 'CoordList is not initialised. Nesting is: '//& + numToChar(coords % nesting)) + end if + + ! Place coordinates above geometry (in case they were placed) + call coords % takeAboveGeom() + + ! Enter root universe + r = coords % lvl(1) % r + dir = coords % lvl(1) % dir + + uni => self % geom % unis % getPtr_fast(self % geom % rootIdx) + + call uni % enter(coords % lvl(1), r, dir) + + coords % lvl(1) % uniRootID = 1 + + ! Dive to material + call self % csg_diveToMat(coords, 1) + + end subroutine csg_placeCoord + + + !! + !! Find material and unique cell at a given location + !! + !! See geometry_inter for details + !! + subroutine csg_whatIsAt(self, matIdx, uniqueID, r, u) + class(geometryGrid), intent(in) :: self + integer(shortInt), intent(out) :: matIdx + integer(shortInt), intent(out) :: uniqueID + real(defReal), dimension(3), intent(in) :: r + real(defReal), dimension(3), optional, intent(in) :: u + type(coordList) :: coords + real(defReal), dimension(3) :: u_l + + ! Select direction + if (present(u)) then + u_l = u + else + u_l = [ONE, ZERO, ZERO] + end if + + ! Initialise coordinates + call coords % init(r, u_l) + + ! Place coordinates + call self % csg_placeCoord(coords) + + ! Return material & uniqueID + matIdx = coords % matIdx + uniqueID = coords % uniqueID + + end subroutine csg_whatIsAt + + +end module geometryGrid_class diff --git a/Geometry/geometryReg_mod.f90 b/Geometry/geometryReg_mod.f90 index d1ea1aa7e..2bd7788d4 100644 --- a/Geometry/geometryReg_mod.f90 +++ b/Geometry/geometryReg_mod.f90 @@ -38,6 +38,7 @@ module geometryReg_mod ! Geometry use geometry_inter, only : geometry use geometryStd_class, only : geometryStd + use geometryGrid_class, only : geometryGrid ! Fields use field_inter, only : field @@ -74,7 +75,8 @@ module geometryReg_mod public :: kill !! Parameters - character(nameLen), dimension(*), parameter :: AVAILABLE_GEOMETRIES = ['geometryStd'] + character(nameLen), dimension(*), parameter :: AVAILABLE_GEOMETRIES = ['geometryStd ' ,& + 'geometryGrid'] character(nameLen), dimension(*), parameter :: AVAILABLE_FIELDS = ['uniformScalarField',& 'uniformVectorField'] integer(shortInt), parameter :: START_SIZE = 5 @@ -348,6 +350,9 @@ subroutine new_geometry(geom, dict, mats, silent) case ('geometryStd') allocate(geometryStd :: geom) + case ('geometryGrid') + allocate(geometryGrid :: geom) + case default print '(A)', 'AVAILABLE GEOMETRIES' print '(A)', AVAILABLE_GEOMETRIES diff --git a/Geometry/geometryStd_class.f90 b/Geometry/geometryStd_class.f90 index 06ccf5c54..777a6a507 100644 --- a/Geometry/geometryStd_class.f90 +++ b/Geometry/geometryStd_class.f90 @@ -58,7 +58,6 @@ module geometryStd_class procedure :: moveGlobal procedure :: teleport procedure :: activeMats - procedure :: latSizeN ! Private procedures procedure, private :: diveToMat @@ -574,42 +573,4 @@ subroutine closestDist_cache(self, dist, surfIdx, lvl, coords, cache) end do end subroutine closestDist_cache - !! - !! Return dimensions of latUniverse - !! - !! fatalError if no latUniverse found, if there are multiple then it will return dimensions - !! of the first one found, which may not be what is wanted - !! - function latSizeN(self) result(sizeN) - class(geometryStd), intent(in) :: self - integer(shortInt), dimension(3) :: sizeN - integer(shortInt) :: i - class(universe), pointer :: uni - class(latUniverse), pointer :: latUni - character(100), parameter :: Here = 'latSizeN (geometryStd_class.f90)' - - ! Search for latUniverse - do i=1, self % geom % unis % getSize() - - uni => self % geom % unis % getPtr(i) - - select type(uni) - class is(latUniverse) - latUni => uni - exit - - class default - latUni => null() - - end select - end do - - if (.not. associated(latUni)) call fatalError(Here, 'Lattice universe not found') - - ! Find lattice dimensions - sizeN = latUni % getSizeN() - - end function latSizeN - - end module geometryStd_class diff --git a/Geometry/geometry_inter.f90 b/Geometry/geometry_inter.f90 index eb4370248..973007549 100644 --- a/Geometry/geometry_inter.f90 +++ b/Geometry/geometry_inter.f90 @@ -43,7 +43,6 @@ module geometry_inter procedure(moveGlobal), deferred :: moveGlobal procedure(teleport), deferred :: teleport procedure(activeMats), deferred :: activeMats - procedure(latSizeN), deferred :: latSizeN ! Common procedures procedure :: slicePlot @@ -263,18 +262,6 @@ function activeMats(self) result(matList) integer(shortInt), dimension(:), allocatable :: matList end function activeMats - !! - !! Return dimensions of latUniverse - !! - !! fatalError if no latUniverse found, if there are multiple then it will return dimensions - !! of the first one found, which may not be what is wanted - !! - function latSizeN(self) result(sizeN) - import geometry, shortInt - class(geometry), intent(in) :: self - integer(shortInt), dimension(3) :: sizeN - end function latSizeN - end interface contains diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index 36d69f7b0..8094813d3 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -348,8 +348,10 @@ subroutine init_materialItem(self, name, dict) call dict % getOrDefault(self % V, 'volume', ZERO) ! Get composition dictionary and load composition - compDict => dict % getDictPtr('composition') - call compDict % keys(keys) + if (dict % isPresent('composition')) then + compDict => dict % getDictPtr('composition') + call compDict % keys(keys) + end if ! Allocate space for nuclide information allocate(self % nuclides(size(keys))) @@ -364,17 +366,20 @@ subroutine init_materialItem(self, name, dict) end if ! Load definitions - do i =1,size(keys) - ! Check if S(a,b) is on and required for that nuclide - if (hasSab .and. moderDict % isPresent(keys(i))) then - self % nuclides(i) % hasSab = .true. - call moderDict % get(self % nuclides(i) % file_Sab, keys(i)) - end if - - ! Initialise the nuclides - call compDict % get(self % dens(i), keys(i)) - call self % nuclides(i) % init(keys(i)) - end do + if (associated(compDict)) then + do i =1,size(keys) + ! Check if S(a,b) is on and required for that nuclide + if (hasSab .and. moderDict % isPresent(keys(i))) then + self % nuclides(i) % hasSab = .true. + call moderDict % get(self % nuclides(i) % file_Sab, keys(i)) + end if + + ! Initialise the nuclides + call compDict % get(self % dens(i), keys(i)) + call self % nuclides(i) % init(keys(i)) + end do + + end if ! Save dictionary self % extraInfo = dict diff --git a/ParticleObjects/Source/materialSource_class.f90 b/ParticleObjects/Source/materialSource_class.f90 index 26060b9b3..5c4174c07 100644 --- a/ParticleObjects/Source/materialSource_class.f90 +++ b/ParticleObjects/Source/materialSource_class.f90 @@ -12,6 +12,7 @@ module materialSource_class use source_inter, only : source, kill_super => kill use geometry_inter, only : geometry + use geometryGrid_class, only : geometryGrid use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG use nuclearDatabase_inter, only : nuclearDatabase @@ -24,8 +25,6 @@ module materialSource_class implicit none private - ! Position sampling method - integer(shortInt), parameter :: REJ = 1, FAST = 2 ! Calculation type integer(shortInt), parameter :: IMC = 1, ISMC = 2 @@ -38,40 +37,31 @@ module materialSource_class !! isMG -> is the source multi-group? (default = .true.) !! bottom -> Bottom corner (x_min, y_min, z_min) !! top -> Top corner (x_max, y_max, z_max) - !! latPitch -> Pitch of lattice (if using a lattice geom) - !! latSizeN -> Lattice dimensions (if using a lattice geom) !! G -> Energy group !! pType -> P_PHOTON for IMC, P_MATERIAL for ISMC !! bounds -> Bounds of geometry - !! method -> REJ uses rejection sampling for position (VERY slow for many materials) - !! -> FAST samples only within bounds of each material so no rejection needed, - !! currently only works for lattics geometry (hence lattice settings above) !! calcType -> IMC or ISMC, changes type of material to be sampled !! !! Interface: !! source_inter Interface !! !! SAMPLE INPUT: - !! matSource { type materialSource; method fast; } + !! matSource { type materialSource; calcType IMC; } !! type, public,extends(source) :: materialSource private logical(defBool) :: isMG = .true. real(defReal), dimension(3) :: bottom = ZERO real(defReal), dimension(3) :: top = ZERO - real(defReal), dimension(3) :: latPitch = ZERO - integer(shortInt), dimension(3) :: latSizeN = 0 integer(shortInt) :: G = 0 integer(shortInt) :: pType = P_PHOTON real(defReal), dimension(6) :: bounds = ZERO - integer(shortInt) :: method = REJ integer(shortInt) :: calcType = IMC contains procedure :: init procedure :: append procedure :: sampleParticle procedure, private :: sampleIMC - procedure, private :: getMatBounds procedure :: kill end type materialSource @@ -86,7 +76,6 @@ subroutine init(self, dict, geom) class(materialSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom - character(nameLen) :: method character(100), parameter :: Here = 'init (materialSource_class.f90)' call dict % getOrDefault(self % G, 'G', 1) @@ -97,22 +86,6 @@ subroutine init(self, dict, geom) ! Set bounding region self % bounds = self % geom % bounds() - ! Select method for position sampling - call dict % getOrDefault(method, 'method', 'rejection') - select case(method) - case('rejection') - self % method = REJ - - case('fast') - self % method = FAST - ! Get lattice dimensions - self % latSizeN = self % geom % latSizeN() - self % latPitch = (self % bounds(4:6) - self % bounds(1:3)) / self % latSizeN - - case default - call fatalError(Here, 'Unrecognised method. Should be "rejection" or "fast"') - end select - ! Select calculation type - Automatically added to dict in implicitPhysicsPackage call dict % getOrDefault(self % calcType, 'calcType', IMC) select case(self % calcType) @@ -128,8 +101,8 @@ end subroutine init !! - !! Generate N particles to add to a particleDungeon without overriding - !! particles already present. + !! Generate N particles to add to a particleDungeon without overriding particles already present. + !! Note that energy here refers to energy weight rather than group. !! !! Args: !! dungeon [inout] -> particle dungeon to be added to @@ -150,6 +123,7 @@ subroutine append(self, dungeon, N, rand) real(defReal) :: energy, totalEnergy type(RNG) :: pRand class(mgIMCDatabase), pointer :: nucData + class(geometry), pointer :: geom character(100), parameter :: Here = "append (materialSource_class.f90)" ! Get pointer to appropriate nuclear database @@ -180,11 +154,13 @@ subroutine append(self, dungeon, N, rand) if (Ntemp == 0) Ntemp = 1 ! Set bounds for sampling - if (self % method == FAST) then - bounds = self % getMatBounds(matIdx) - else - bounds = self % bounds - end if + geom => self % geom + select type(geom) + class is(geometryGrid) + bounds = geom % matBounds(matIdx) + class default + bounds = self % bounds + end select ! Find energy per particle energy = energy / Ntemp @@ -232,7 +208,7 @@ end function sampleParticle !! energy [in] -> energy-weight of sampled particle !! G [in] -> energy group of sampled particle !! bounds [in] -> bounds for position search, will be bounds of entire geometry if using - !! rejection sampling method, and bounds of single material if using fast + !! geometryStd, and bounds of single material if using geometryGrid !! function sampleIMC(self, rand, targetMatIdx, energy, G, bounds) result(p) class(materialSource), intent(inout) :: self @@ -263,9 +239,6 @@ function sampleIMC(self, rand, targetMatIdx, energy, G, bounds) result(p) ! Exit if in desired material if (matIdx == targetMatIdx) exit rejection - ! Should exit immediately if using fast method as bounds should contain only matIdx - if (self % method == FAST) call fatalError(Here, 'Fast sourcing returned incorrect material') - ! Protect against infinite loop i = i+1 if (i > 10000) call fatalError(Here, '10,000 failed attempts in rejection sampling') @@ -294,44 +267,6 @@ function sampleIMC(self, rand, targetMatIdx, energy, G, bounds) result(p) end function sampleIMC - !! - !! Get location of material in lattice for position sampling - !! - !! Note that this may be incorrect depending on how lattice input is given, this function - !! assumes that geometry has been generated by discretiseGeom_class.f90 - !! - !! Args: - !! matIdx [in] -> matIdx for which to calculate bounds - !! matBounds [out] -> boundary of lattice cell, [xmin,ymin,zmin,xmax,ymax,zmax] - !! - !! TODO: - !! Would be nice to have most of this in a geometry module - !! - function getMatBounds(self, matIdx) result(matBounds) - class(materialSource), intent(inout) :: self - integer(shortInt), intent(in) :: matIdx - real(defReal), dimension(6) :: matBounds - integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: i, latIdFlipped - character(nameLen) :: matName - character(100), parameter :: Here = 'getMatBounds (materialSourceClass.f90)' - - ! Extract lattice position from mat name (e.g. "m106 -> 106") - ! This is different from localID in latUniverse_class as is counting from a different - ! corner (see get_ijk function description below) - matName = mm_matName(matIdx) - read (matName(2:), '(I10)') latIdFlipped - - ! Set bounds of lattice cell containing matIdx - ijk = get_ijk(latIdFlipped, self % latSizeN) - - do i=1, 3 - matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bounds(i) + SURF_TOL - matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bounds(i) - SURF_TOL - end do - - end function getMatBounds - !! !! Return to uninitialised state !! @@ -346,40 +281,4 @@ elemental subroutine kill(self) end subroutine kill - !! - !! Generate ijk from flipped localID and shape - !! - !! Note that this is NOT the same as get_ijk in latUniverse_class. Lattice is built with first - !! map input as x_min, y_MAX, z_MAX cell, but localID begins at x_min, y_min, z_min cell. In - !! this module we want to find ijk from matIdx, which we convert to a flippedLocalID by - !! offsetting for void regions, which starts counting from the wrong corner. We therefore flip - !! ijk in the y and z directions in this function compared to instances of this function in other - !! modules. - !! - !! Args: - !! flippedlocalID [in] -> Local id of the cell between 1 and product(sizeN), - !! counting from wrong corner - !! sizeN [in] -> Number of cells in each cardinal direction x, y & z - !! - !! Result: - !! Array ijk which has integer position in each cardinal direction - !! - pure function get_ijk(flippedLocalID, sizeN) result(ijk) - integer(shortInt), intent(in) :: flippedLocalID - integer(shortInt), dimension(3), intent(in) :: sizeN - integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: temp, base - - temp = flippedLocalID - 1 - base = temp / sizeN(1) - ijk(1) = temp - sizeN(1) * base + 1 - - temp = base - base = temp / sizeN(2) - ijk(2) = sizeN(2)*(1 + base) - temp - - ijk(3) = sizeN(3) - base - - end function get_ijk - end module materialSource_class diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index 2b0159191..a2a9e900f 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -397,7 +397,7 @@ end subroutine collectResults subroutine init(self, dict) class(implicitPhysicsPackage), intent(inout) :: self class(dictionary), intent(inout) :: dict - class(dictionary), pointer :: tempDict, geomDict, dataDict + class(dictionary), pointer :: tempDict type(dictionary) :: locDict1, locDict2, locDict3 integer(shortInt) :: seed_temp integer(longInt) :: seed @@ -475,30 +475,12 @@ subroutine init(self, dict) print *, 'Energy grid defined: ', nucData end if - ! Automatically split geometry into a uniform grid - if (dict % isPresent('discretise')) then - - ! Store dimensions of lattice - tempDict => dict % getDictPtr('discretise') - - ! Create new input - call discretise(dict, newGeom, newData) - - geomDict => newGeom - dataDict => newData - - else - geomDict => dict % getDictPtr("geometry") - dataDict => dict % getDictPtr("nuclearData") - - end if - ! Build Nuclear Data - call ndReg_init(dataDict) + call ndReg_init(dict % getDictPtr('nuclearData')) ! Build geometry geomName = 'IMCGeom' - call gr_addGeom(geomName, geomDict) + call gr_addGeom(geomName, dict % getDictPtr('geometry')) self % geomIdx = gr_geomIdx(geomName) self % geom => gr_geomPtr(self % geomIdx) @@ -510,19 +492,12 @@ subroutine init(self, dict) call newData % kill() ! Initialise material source - if (dict % isPresent('matSource')) then - tempDict => dict % getDictPtr('matSource') - ! Tell source if we are using IMC or ISMC - call tempDict % store('calcType', self % method) - call new_source(self % matSource, tempDict, self % geom) - else - call locDict1 % init(2) - call locDict1 % store('type', 'materialSource') - ! Tell source if we are using IMC or ISMC - call locDict1 % store('calcType', self % method) - call new_source(self % matSource, locDict1, self % geom) - call locDict1 % kill() - end if + call locDict1 % init(2) + call locDict1 % store('type', 'materialSource') + ! Tell source if we are using IMC or ISMC + call locDict1 % store('calcType', self % method) + call new_source(self % matSource, locDict1, self % geom) + call locDict1 % kill() ! Read external particle source definition if( dict % isPresent('source') ) then From b713710e9401ef1fbb52fe7ef43c73c5cd00d855 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 11 Oct 2023 19:36:57 +0100 Subject: [PATCH 357/373] Finished (hopefully?) new geom class --- Geometry/geometryGrid_class.f90 | 66 ++++++++++++++++++++++++--------- 1 file changed, 49 insertions(+), 17 deletions(-) diff --git a/Geometry/geometryGrid_class.f90 b/Geometry/geometryGrid_class.f90 index 3f4119ad3..01791ef8c 100644 --- a/Geometry/geometryGrid_class.f90 +++ b/Geometry/geometryGrid_class.f90 @@ -13,8 +13,7 @@ module geometryGrid_class use surface_inter, only : surface ! Nuclear Data - use materialMenu_mod, only : nMat ,& - mm_matTemp => matTemp ,& + use materialMenu_mod, only : mm_matTemp => matTemp ,& mm_matFile => matFile ,& mm_init => init ,& mm_kill => kill,& @@ -125,7 +124,7 @@ subroutine init(self, dict, mats, silent) ! Get geometry discretisation call dict % get(self % latSizeN, 'dimensions') - if (size(self % latSizeN) /= 3) call fatalError(Here, 'Dimenions must be of size 3') + if (size(self % latSizeN) /= 3) call fatalError(Here, 'Dimensions must be of size 3') do i = 1, 3 self % latPitch(i) = (bounds(i+3) - bounds(i)) / self % latSizeN(i) @@ -175,6 +174,7 @@ subroutine init(self, dict, mats, silent) call matDict % store('mat'//numToChar(idxCounter+voidCounter), tempDict) call tempDict % kill() + ! Store matIdx in material array self % mats(i,j,z) = idxCounter end do @@ -228,6 +228,10 @@ subroutine placeCoord(self, coords) call self % whatIsAt(matIdx, uniqueID, coords % lvl(1) % r) coords % matIdx = matIdx + ! Extra unnecessary info for coords % isPlaced to return true + coords % uniqueID = matIdx + coords % nesting = 1 + end subroutine placeCoord !! @@ -298,28 +302,33 @@ subroutine move_noCache(self, coords, maxDist, event) r_bar = (HALF - r_bar + sign(HALF, u)) * self % latPitch dist = minval(r_bar / u) ! Which direction will result in crossing - ! Check that distance is valid - if (dist <= ZERO) then ! TODO: Also add check for maximum distance? - call fatalError(Here, 'Distance invalid: '//numToChar(dist)) - end if - if (maxDist < dist) then ! Moves within cell call coords % moveGlobal(maxDist) event = COLL_EV maxDist = maxDist ! Left for explicitness and compiler + ! Place coords back into geometry + call self % placeCoord(coords) + else ! Move to next cell, increased by NUDGE to avoid numerical issues call coords % moveGlobal(dist + NUDGE) - event = CROSS_EV maxDist = dist + NUDGE - end if + ! Set matIdx + call self % placeCoord(coords) - ! Set matIdx - call self % placeCoord(coords) + ! Apply boundary conditions if leaving geometry + if (coords % matIdx == OUTSIDE_MAT) then + event = BOUNDARY_EV + call self % explicitBC(coords) - ! Apply boundary conditions if necessary - if (coords % matIdx == OUTSIDE_MAT) call self % explicitBC(coords) + else + ! Cell crossing within geometry - no BCs needed + event = CROSS_EV + + end if + + end if end subroutine move_noCache @@ -355,9 +364,33 @@ subroutine moveGlobal(self, coords, maxDist, event) type(coordList), intent(inout) :: coords real(defReal), intent(inout) :: maxDist integer(shortInt), intent(out) :: event + real(defReal) :: dist + real(defReal), dimension(3) :: r, u, r_bar, geomSize - !TODO - call fatalError('moveGlobal (geomGrid)', 'global') + ! Calculate distance to next cell crossing + r = coords % lvl(1) % r + u = coords % lvl(1) % dir + geomSize = self % geomBounds(4:6) - self % geomBounds(1:3) + r_bar = -r + self % corner + (HALF + sign(HALF, u)) * geomSize + dist = minval(r_bar / u) + + if (maxDist < dist) then ! Moves within geometry + call coords % moveGlobal(maxDist) + event = COLL_EV + maxDist = maxDist ! Left for explicitness and compiler + + ! Place coords back into geometry + call self % placeCoord(coords) + + else ! Hit geometry bounds, increased by NUDGE to avoid numerical issues + call coords % moveGlobal(dist + NUDGE) + event = BOUNDARY_EV + maxDist = dist + NUDGE + + ! Apply boundary conditions + if (coords % matIdx == OUTSIDE_MAT) call self % explicitBC(coords) + + end if end subroutine moveGlobal @@ -382,7 +415,6 @@ subroutine teleport(self, coords, dist) ! If point is outside apply boundary transformations if (coords % matIdx == OUTSIDE_MAT) then call self % explicitBC(coords) - call self % placeCoord(coords) end if end subroutine teleport From a37f88f29d99ae7c1c5a1f10b5aee16133347b8d Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 26 Oct 2023 19:01:42 +0100 Subject: [PATCH 358/373] IMC and ISMC now working on multifrequency benchmarks --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 59 ++++++++----------- .../mgIMCData/baseMgIMC/materialEquations.f90 | 9 ++- .../transportOperatorTimeHT_class.f90 | 2 + 3 files changed, 34 insertions(+), 36 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 0116a1ea8..45343163a 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -186,7 +186,6 @@ subroutine init(self, dict) class(dictionary),target, intent(in) :: dict integer(shortInt) :: nG, N, i real(defReal) :: dT, tempT, tempU - real(defReal), dimension(:), allocatable :: temp character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' ! Read number of groups @@ -400,9 +399,9 @@ function tempFromEnergy(self) result(T) ! Protect against infinite loop i = i+1 - if (i > 1000000) then - print *, U, self % energyDens - call fatalError(Here, "1,000,000 iterations without convergence") + if (i > 100000) then + print *, 'Energy density: ', self % energyDens + call fatalError(Here, "100,000 iterations without convergence, maybe NaN energy density?") end if ! Increase step size to avoid lack of convergence due to very small starting temperature if (mod(i,1000)==0) dT = 10*dT @@ -436,12 +435,12 @@ function tempFromEnergy(self) result(T) end function tempFromEnergy !! - !! Calculate sigma from current temp + !! Calculate opacities from current temp !! subroutine sigmaFromTemp(self) class(baseMgIMCMaterial), intent(inout) :: self - integer(shortInt) :: i, j - real(defReal) :: sigmaP, E, EStep, increase, sigmaA, norm + integer(shortInt) :: i, j, stepsPerGroup + real(defReal) :: sigmaP, E, EStep, increase, upper, lower character(100), parameter :: Here = 'sigmaFromTemp (baseMgIMCMaterial_class.f90)' ! Evaluate opacities for grey case @@ -456,42 +455,35 @@ subroutine sigmaFromTemp(self) ! Evaluate opacities for frequency-dependent case do i = 1, self % nGroups() - ! Calculate central energy value of group - E = (mgEnergyGrid % bin(i) + mgEnergyGrid % bin(i+1)) / 2 - ! Evaluate absorption opacity sigma(T, E) - self % data(CAPTURE_XS,i) = evaluateSigma(self % name, self % T, E) + ! Take geometric mean of upper and lower group boundaries + upper = evaluateSigma(self % name, self % T, mgEnergyGrid % bin(i)) + lower = evaluateSigma(self % name, self % T, mgEnergyGrid % bin(i+1)) + self % data(CAPTURE_XS,i) = sqrt(upper*lower) !min(1e5_defReal, sqrt(o1 * o2)) + + upper = upper * normPlanckSpectrum(mgEnergyGrid % bin(i), self % T) + lower = lower * normPlanckSpectrum(mgEnergyGrid % bin(i+1), self % T) + self % data(EMISSION_PROB,i) = sqrt(upper*lower) + self % data(EMISSION_PROB,i) = self % data(EMISSION_PROB,i)*(mgEnergyGrid % bin(i) - mgEnergyGrid % bin(i+1)) + end do self % data(IESCATTER_XS,:) = ZERO self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) + self % data(EMISSION_PROB,:) = self % data(EMISSION_PROB,:)/sum(self % data(EMISSION_PROB,:)) - ! Evaluate opacities - sigmaP = ZERO ! For Planck opacity, integrate over entire frequency domain + ! Evaluate Planck opacity via a much finer numerical integration + sigmaP = ZERO do i = 1, self % nGroups() - ! For CAPTURE_XS, integrate over each energy group - sigmaA = ZERO - ! Normalise CAPTURE_XS after weighting with planck spectrum - norm = ZERO - ! 100 integration steps per energy group, chosen arbitrarily - EStep = (mgEnergyGrid % bin(i) - mgEnergyGrid % bin(i+1)) / 100 + ! 100 integration steps per energy group seems to give very good accuracy, might be worth playing around with + stepsPerGroup = 100 + EStep = (mgEnergyGrid % bin(i) - mgEnergyGrid % bin(i+1)) / stepsPerGroup E = mgEnergyGrid % bin(i) - 0.5*EStep - do j = 1, 100 + do j = 1, stepsPerGroup increase = normPlanckSpectrum(E, self % T)*evaluateSigma(self % name, self % T, E) sigmaP = sigmaP + EStep * increase - norm = norm + normPlanckSpectrum(E, self % T) - sigmaA = sigmaA + increase E = E - EStep end do - if (sigmaA /= ZERO) sigmaA = sigmaA / norm - self % data(CAPTURE_XS, i) = sigmaA end do - - ! Set cross sections self % sigmaP = sigmaP - self % data(TOTAL_XS,:) = self % data(CAPTURE_XS,:) + self % data(IESCATTER_XS,:) - - ! Set emission probability of each group - proportional to sigmaA - self % data(EMISSION_PROB,:) = self % data(CAPTURE_XS,:) / sum(self % data(CAPTURE_XS,:)) - end subroutine sigmaFromTemp @@ -629,11 +621,8 @@ function sampleTransformTime(self, rand) result(t) class(baseMgIMCMaterial), intent(inout) :: self class(RNG), intent(inout) :: rand real(defReal) :: t - integer(shortInt) :: G - - G = 1 - t = -log(rand % get()) / (self % data(CAPTURE_XS,G) * self % fleck * self % eta * lightSpeed) + t = -log(rand % get()) / (self % sigmaP * self % fleck * self % eta * lightSpeed) end function sampleTransformTime diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index 8d2945a42..2cf3c3de3 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -23,7 +23,8 @@ module materialEquations character(nameLen),dimension(*),parameter :: AVAILABLE_equations = ['marshak ',& 'hohlraum',& - 'olson1D '] + 'olson1D ',& + 'densmore'] public :: evaluateCv public :: evaluateSigma @@ -71,6 +72,9 @@ function evaluateCv(equation, T) result(cv) case('olson1D') cv = cvOlson1D(T) + case('densmore') + cv = 0.1 + case default cv = ZERO print *, AVAILABLE_equations @@ -106,6 +110,9 @@ function evaluateSigma(equation, T, E) result(sigma) case('olson1D') sigma = sigmaOlson1D(T, E) + case('densmore') + sigma = 10 / (E**3 * sqrt(T)) + case default sigma = ZERO print *, AVAILABLE_equations diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index f682ed0b0..4ea6c5d86 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -307,6 +307,8 @@ subroutine materialTransform(self, p, tally) dir(2) = sqrt(1-mu**2) * cos(phi) dir(3) = sqrt(1-mu**2) * sin(phi) call p % point(dir) + ! Resample energy + p % G = nucData % sampleEnergyGroup(matIdx, p % pRNG) end if end subroutine materialTransform From 4564037a34534c4f78c3656cedf44b65715b2274 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 27 Oct 2023 16:57:40 +0100 Subject: [PATCH 359/373] Allow multiplication of cv and sigma by a constant without needing to recompile --- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 45343163a..1ad192483 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -77,6 +77,8 @@ module baseMgIMCMaterial_class real(defReal) :: energyDens ! Energy density = matEnergy/V real(defReal) :: eta ! aT^4/energyDens, used for ISMC only integer(shortInt) :: calcType ! IMC or ISMC + real(defReal) :: sigmaFactor + real(defReal) :: cvFactor contains ! Superclass procedures @@ -206,6 +208,10 @@ subroutine init(self, dict) ! Get name of equations for heat capacity and opacity calculations call dict % get(self % name, 'equations') + ! Get optional multiplication factor for heat capacity and opacity + call dict % getOrDefault(self % sigmaFactor, 'sigmaMultiple', ONE) + call dict % getOrDefault(self % cvFactor, 'cvMultiple', ONE) + ! Read initial temperature and volume call dict % get(self % T, 'T') call dict % get(self % V, 'V') @@ -221,7 +227,7 @@ subroutine init(self, dict) tempU = tempU + dT * evaluateCv(self % name, tempT) tempT = tempT + dT end do - self % energyDens = tempU + self % energyDens = tempU * self % cvFactor self % matEnergy = self % energyDens * self % V end subroutine init @@ -408,7 +414,7 @@ function tempFromEnergy(self) result(T) ! Increment temperature and increment the corresponding energy density tempT = T + dT/2 - increase = dT * evaluateCv(self % name, tempT) + increase = dT * evaluateCv(self % name, tempT) * self % cvFactor ! Protect against division by 0 or other numerical errors if (increase /= increase .or. increase > INF) increase = ZERO tempU = U + increase @@ -445,7 +451,7 @@ subroutine sigmaFromTemp(self) ! Evaluate opacities for grey case if (self % nGroups() == 1) then - self % data(CAPTURE_XS,1) = evaluateSigma(self % name, self % T, ONE) + self % data(CAPTURE_XS,1) = evaluateSigma(self % name, self % T, ONE) * self % sigmaFactor self % data(IESCATTER_XS,1) = ZERO self % data(TOTAL_XS,1) = self % data(CAPTURE_XS,1) + self % data(IESCATTER_XS,1) ! Planck opacity equal to absorption opacity for single frequency @@ -458,7 +464,7 @@ subroutine sigmaFromTemp(self) ! Take geometric mean of upper and lower group boundaries upper = evaluateSigma(self % name, self % T, mgEnergyGrid % bin(i)) lower = evaluateSigma(self % name, self % T, mgEnergyGrid % bin(i+1)) - self % data(CAPTURE_XS,i) = sqrt(upper*lower) !min(1e5_defReal, sqrt(o1 * o2)) + self % data(CAPTURE_XS,i) = sqrt(upper*lower)*self % sigmaFactor !min(1e5_defReal, sqrt(o1 * o2)) upper = upper * normPlanckSpectrum(mgEnergyGrid % bin(i), self % T) lower = lower * normPlanckSpectrum(mgEnergyGrid % bin(i+1), self % T) @@ -483,7 +489,7 @@ subroutine sigmaFromTemp(self) E = E - EStep end do end do - self % sigmaP = sigmaP + self % sigmaP = sigmaP * self % sigmaFactor end subroutine sigmaFromTemp @@ -496,7 +502,7 @@ subroutine updateFleck(self) character(100), parameter :: Here = 'updateFleck (baseMgIMCMaterial_class.f90)' ! Calculate beta, ratio of radiation and material heat capacities - beta = 4 * radiationConstant * self % T**3 / evaluateCv(self % name, self % T) + beta = 4 * radiationConstant * self % T**3 / (evaluateCv(self % name, self % T)*self % cvFactor) ! Use time step size to calculate fleck factor select case(self % calcType) From 3c3078ce4b9b4900ecc351c5277595dc2ebbd2c5 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 11 Nov 2023 14:03:51 +0000 Subject: [PATCH 360/373] Deleted some unnecessary things, confined some functions to be only within subclass --- Geometry/geometryGrid_class.f90 | 3 +- NuclearData/IMCMaterial_inter.f90 | 78 ------------------ .../baseMgIMC/baseMgIMCDatabase_class.f90 | 2 +- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 26 ++---- .../mgIMCData/baseMgIMC/materialEquations.f90 | 2 +- NuclearData/mgIMCData/mgIMCMaterial_inter.f90 | 79 ------------------- .../transportOperatorTimeHT_class.f90 | 2 +- 7 files changed, 11 insertions(+), 181 deletions(-) diff --git a/Geometry/geometryGrid_class.f90 b/Geometry/geometryGrid_class.f90 index 01791ef8c..e013e8df7 100644 --- a/Geometry/geometryGrid_class.f90 +++ b/Geometry/geometryGrid_class.f90 @@ -468,7 +468,8 @@ function activeMats(self) result(matList) class(geometryGrid), intent(in) :: self integer(shortInt), dimension(:), allocatable :: matList - matList = reshape(self % mats, (/1/)) + !TODO: For some reason this gives a warning after compiling, can't figure out why? + matList = reshape(self % mats,[size(self % mats)]) end function activeMats diff --git a/NuclearData/IMCMaterial_inter.f90 b/NuclearData/IMCMaterial_inter.f90 index 7480d5e68..e19d6d06e 100644 --- a/NuclearData/IMCMaterial_inter.f90 +++ b/NuclearData/IMCMaterial_inter.f90 @@ -31,14 +31,8 @@ module IMCMaterial_inter contains generic :: getMacroXSs => getMacroXSs_byP procedure(getMacroXSs_byP), deferred :: getMacroXSs_byP - procedure(updateMat), deferred :: updateMat - procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck - procedure(getEta), deferred :: getEta procedure(getTemp), deferred :: getTemp - procedure(getMatEnergy), deferred :: getMatEnergy - procedure(setCalcType), deferred :: setCalcType - procedure(sampleTransformTime), deferred :: sampleTransformTime end type IMCMaterial abstract interface @@ -61,31 +55,6 @@ subroutine getMacroXSs_byP(self, xss, p) class(particle), intent(in) :: p end subroutine getMacroXSs_byP - !! - !! Update material properties at each time step - !! First update energy using simple balance, then solve for temperature, - !! then update temperature-dependent properties - !! - !! Args: - !! tallyEnergy [in] -> Energy absorbed into material - !! printUpdate [in, optional] -> Bool, if true then will print updates to screen - !! - subroutine updateMat(self, tallyEnergy, printUpdate) - import :: IMCMaterial, defReal, defBool - class(IMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: tallyEnergy - logical(defBool), intent(in), optional :: printUpdate - end subroutine updateMat - - !! - !! Return the equilibrium radiation energy density, U_r - !! - function getEmittedRad(self) result(emittedRad) - import :: IMCMaterial, defReal, RNG - class(IMCMaterial), intent(inout) :: self - real(defReal) :: emittedRad - end function getEmittedRad - !! !! Get Fleck factor of material !! @@ -95,17 +64,6 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck - !! - !! Return eta = aT**4/U_m - !! - !! Currently only used in transportOperatorIMC_class.f90 for ISMC calculations - !! - function getEta(self) result(eta) - import :: IMCMaterial, defReal - class(IMCMaterial),intent(in) :: self - real(defReal) :: eta - end function getEta - !! !! Get temperature of material !! @@ -115,42 +73,6 @@ function getTemp(self) result(T) real(defReal) :: T end function getTemp - !! - !! Return material energy - !! - function getMatEnergy(self) result(energy) - import :: IMCMaterial, defReal - class(IMCMaterial), intent(inout) :: self - real(defReal) :: energy - end function getMatEnergy - - !! - !! Set the calculation type to be used - !! - !! Current options: - !! IMC - !! ISMC - !! - !! Errors: - !! Unrecognised option - !! - subroutine setCalcType(self, calcType) - import :: IMCMaterial, shortInt - class(IMCMaterial), intent(inout) :: self - integer(shortInt), intent(in) :: calcType - end subroutine setCalcType - - !! - !! Sample the time taken for a material particle to transform into a photon - !! Used for ISMC only - !! - function sampleTransformTime(self, rand) result(t) - import :: IMCMaterial, RNG, defReal - class(IMCMaterial), intent(inout) :: self - class(RNG), intent(inout) :: rand - real(defReal) :: t - end function sampleTransformTime - end interface contains diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 49cbd8e24..195545708 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -70,13 +70,13 @@ module baseMgIMCDatabase_class procedure :: updateProperties procedure :: setCalcType procedure :: sampleTransformTime + procedure :: sampleEnergyGroup procedure :: kill procedure :: init procedure :: activate ! Local interface procedure :: nGroups - procedure :: sampleEnergyGroup end type baseMgIMCDatabase diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 1ad192483..67efcca68 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -7,6 +7,7 @@ module baseMgIMCMaterial_class use RNG_class, only : RNG use dictionary_class, only : dictionary use poly_func + use simulationTime_class, only : timeStep ! Nuclear Data Interfaces use materialHandle_inter, only : materialHandle @@ -14,7 +15,6 @@ module baseMgIMCMaterial_class use IMCXSPackages_class, only : IMCMacroXSs use materialEquations - use simulationTime_class, only : timeStep implicit none private @@ -52,7 +52,6 @@ module baseMgIMCMaterial_class !! updateMat -> update material properties as required for IMC calculation !! getEmittedRad -> returns the radiation to be emitted in current timestep !! getFleck -> returns current material Fleck factor - !! getEta -> returns current value of eta (ISMC only) !! getTemp -> returns current material temperature !! getMatEnergy -> returns energy of material !! setCalcType -> set to IMC or ISMC @@ -77,28 +76,28 @@ module baseMgIMCMaterial_class real(defReal) :: energyDens ! Energy density = matEnergy/V real(defReal) :: eta ! aT^4/energyDens, used for ISMC only integer(shortInt) :: calcType ! IMC or ISMC - real(defReal) :: sigmaFactor - real(defReal) :: cvFactor + real(defReal) :: sigmaFactor ! Constant to multiply sigma by + real(defReal) :: cvFactor ! Constant to multiply heat capacity by contains ! Superclass procedures procedure :: kill procedure :: getMacroXSs_byG procedure :: getTotalXS + procedure :: getFleck + procedure :: getTemp ! Local procedures procedure :: init procedure :: nGroups procedure :: updateMat procedure :: getEmittedRad - procedure :: getFleck - procedure :: getEta - procedure :: getTemp procedure :: getMatEnergy procedure :: setCalcType procedure :: sampleEnergyGroup procedure :: sampleTransformTime + ! Private local procedures procedure, private :: tempFromEnergy procedure, private :: sigmaFromTemp procedure, private :: updateFleck @@ -551,19 +550,6 @@ function getFleck(self) result(fleck) end function getFleck - !! - !! Return eta = aT**4/U_m - !! - !! Currently only used in transportOperatorIMC_class.f90 for ISMC calculations - !! - function getEta(self) result(eta) - class(baseMgIMCMaterial),intent(in) :: self - real(defReal) :: eta - - eta = self % eta - - end function getEta - !! !! Get temperature of material !! diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index 2cf3c3de3..93b9ec097 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -111,7 +111,7 @@ function evaluateSigma(equation, T, E) result(sigma) sigma = sigmaOlson1D(T, E) case('densmore') - sigma = 10 / (E**3 * sqrt(T)) + sigma = ONE / (E**3 * sqrt(T)) case default sigma = ZERO diff --git a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 index 539802a23..b1166d9ee 100644 --- a/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 +++ b/NuclearData/mgIMCData/mgIMCMaterial_inter.f90 @@ -43,14 +43,8 @@ module mgIMCMaterial_inter ! Local procedures procedure(getMacroXSs_byG), deferred :: getMacroXSs_byG procedure(getTotalXS), deferred :: getTotalXS - procedure(updateMat), deferred :: updateMat - procedure(getEmittedRad), deferred :: getEmittedRad procedure(getFleck), deferred :: getFleck - procedure(getEta), deferred :: getEta procedure(getTemp), deferred :: getTemp - procedure(getMatEnergy), deferred :: getMatEnergy - procedure(setCalcType), deferred :: setCalcType - procedure(sampleTransformTime), deferred :: sampleTransformTime end type mgIMCMaterial @@ -95,32 +89,6 @@ function getTotalXS(self, G, rand) result(xs) real(defReal) :: xs end function getTotalXS - !! - !! Update material properties at each time step - !! First update energy using simple balance, then solve for temperature, - !! then update temperature-dependent properties - !! - !! Args: - !! tallyEnergy [in] -> Energy absorbed into material - !! printUpdate [in, optional] -> Bool, if true then will print updates to screen - !! - subroutine updateMat(self, tallyEnergy, printUpdate) - import :: mgIMCMaterial, defReal, defBool - class(mgIMCMaterial), intent(inout) :: self - real(defReal), intent(in) :: tallyEnergy - logical(defBool), intent(in), optional :: printUpdate - end subroutine updateMat - - !! - !! Return the equilibrium radiation energy density, U_r - !! - function getEmittedRad(self) result(emittedRad) - import :: mgIMCMaterial, defReal, RNG - class(mgIMCMaterial), intent(inout) :: self - !class(RNG), intent(inout) :: rand - real(defReal) :: emittedRad - end function getEmittedRad - !! !! Return Fleck factor !! @@ -130,17 +98,6 @@ function getFleck(self) result(fleck) real(defReal) :: fleck end function getFleck - !! - !! Return eta = aT**4/U_m - !! - !! Currently only used in transportOperatorIMC_class.f90 for ISMC calculations - !! - function getEta(self) result(eta) - import :: mgIMCMaterial, defReal - class(mgIMCMaterial),intent(in) :: self - real(defReal) :: eta - end function getEta - !! Get temperature of material !! function getTemp(self) result(T) @@ -149,42 +106,6 @@ function getTemp(self) result(T) real(defReal) :: T end function getTemp - !! - !! Return material energy - !! - function getMatEnergy(self) result(energy) - import :: mgIMCMaterial, defReal - class(mgIMCMaterial), intent(inout) :: self - real(defReal) :: energy - end function getMatEnergy - - !! - !! Set the calculation type to be used - !! - !! Current options: - !! IMC - !! ISMC - !! - !! Errors: - !! Unrecognised option - !! - subroutine setCalcType(self, calcType) - import :: mgIMCMaterial, shortInt - class(mgIMCMaterial), intent(inout) :: self - integer(shortInt), intent(in) :: calcType - end subroutine setCalcType - - !! - !! Sample the time taken for a material particle to transform into a photon - !! Used for ISMC only - !! - function sampleTransformTime(self, rand) result(t) - import :: mgIMCMaterial, RNG, defReal - class(mgIMCMaterial), intent(inout) :: self - class(RNG), intent(inout) :: rand - real(defReal) :: t - end function sampleTransformTime - end interface diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index 4ea6c5d86..a650ac6cd 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -329,7 +329,7 @@ subroutine init(self, dict) call init_super(self, dict) ! Get tracking method - call dict % getOrDefault(method, 'method', 'HT') + call dict % getOrDefault(method, 'method', 'ST') select case (method) From a0fa62ff2420f2d22ccd111e3369ef35a7cc4474 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sat, 11 Nov 2023 14:45:18 +0000 Subject: [PATCH 361/373] Allow printing of material updates if requested --- .../baseMgIMC/baseMgIMCDatabase_class.f90 | 5 ++- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 33 +++++++++++++++---- 2 files changed, 30 insertions(+), 8 deletions(-) diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index 195545708..fcbf3208c 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -17,7 +17,7 @@ module baseMgIMCDatabase_class use nuclideHandle_inter, only : nuclideHandle use reactionHandle_inter, only : reactionHandle use materialMenu_mod, only : materialItem, mm_getMatPtr => getMatPtr, mm_nMat => nMat, & - mm_nameMap => nameMap + mm_nameMap => nameMap, mm_matName => matName ! baseMgIMC Objects use baseMgIMCMaterial_class, only : baseMgIMCMaterial @@ -289,7 +289,10 @@ subroutine updateProperties(self, tallyEnergy, printUpdates) ! Update mats to be printed (if any), not in parallel to allow correct order of console output do i = 1, printUpdates + print * + print *, ' Material update for '//trim(mm_matName(i))//':' call self % mats(i) % updateMat(tallyEnergy(i), .true.) + if (i == printUpdates) print * end do ! Update remaining mats diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 67efcca68..ef692440b 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -335,19 +335,19 @@ end subroutine setCalcType !! then update temperature-dependent properties !! !! Args: - !! tallyEnergy [in] -> Energy absorbed into material - !! printUpdate [in, optional] -> Bool, if true then will print updates to screen + !! tallyEnergy [in] -> Energy absorbed into material + !! loud [in, optional] -> Bool, if true then will print updates to screen !! - subroutine updateMat(self, tallyEnergy, printUpdate) + subroutine updateMat(self, tallyEnergy, loud) class(baseMgIMCMaterial),intent(inout) :: self real(defReal), intent(in) :: tallyEnergy - logical(defBool), intent(in), optional :: printUpdate + logical(defBool), intent(in), optional :: loud + real(defReal) :: prevTemp, change character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" - ! TODO: Print updates if requested - - ! Save previous energy + ! Save previous energy and temperature self % prevMatEnergy = self % matEnergy + prevTemp = self % T ! Update material internal energy if (self % calcType == IMC) then @@ -373,6 +373,25 @@ subroutine updateMat(self, tallyEnergy, printUpdate) ! Update fleck factor call self % updateFleck() + ! Print updates if requested + if (present(loud)) then + if (loud) then + change = self % matEnergy - self % prevMatEnergy + if (change < ZERO) then + print *, ' Mat Energy ='//numToChar(self % matEnergy)//' ( -'//numToChar(abs(change))//')' + else + print *, ' Mat Energy ='//numToChar(self % matEnergy)//' ( +'//numToChar(change)//')' + end if + change = self % T - prevTemp + if (change < ZERO) then + print *, ' Mat Temperature ='//numToChar(self % T)//' ( -'//numToChar(abs(change))//')' + else + print *, ' Mat Temperature ='//numToChar(self % T)//' ( +'//numToChar(change)//')' + end if + + end if + end if + end subroutine updateMat !! From 5499152757e553a262bbe7eee792fec0ae584af8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 17 Dec 2023 13:48:10 +0000 Subject: [PATCH 362/373] Simple ST transport operator for perfoming IMC simulations without hybrid tracking --- TransportOperator/CMakeLists.txt | 1 + .../transportOperatorFactory_func.f90 | 6 + .../transportOperatorTimeHT_class.f90 | 3 +- .../transportOperatorTime_class.f90 | 193 ++++++++++++++++++ TransportOperator/transportOperator_inter.f90 | 26 --- 5 files changed, 201 insertions(+), 28 deletions(-) create mode 100644 TransportOperator/transportOperatorTime_class.f90 diff --git a/TransportOperator/CMakeLists.txt b/TransportOperator/CMakeLists.txt index 259e709e5..a35b60f76 100644 --- a/TransportOperator/CMakeLists.txt +++ b/TransportOperator/CMakeLists.txt @@ -5,5 +5,6 @@ add_sources(./transportOperator_inter.f90 # ./transportOperatorDynamicDT_class.f90 ./transportOperatorST_class.f90 ./transportOperatorHT_class.f90 + ./transportOperatorTime_class.f90 ./transportOperatorTimeHT_class.f90 ./Grid/trackingGrid_class.f90) diff --git a/TransportOperator/transportOperatorFactory_func.f90 b/TransportOperator/transportOperatorFactory_func.f90 index 2949c2956..cdf212af8 100644 --- a/TransportOperator/transportOperatorFactory_func.f90 +++ b/TransportOperator/transportOperatorFactory_func.f90 @@ -12,6 +12,7 @@ module transportOperatorFactory_func use transportOperatorST_class, only : transportOperatorST use transportOperatorDT_class, only : transportOperatorDT use transportOperatorHT_class, only : transportOperatorHT + use transportOperatorTime_class, only : transportOperatorTime use transportOperatorTimeHT_class, only : transportOperatorTimeHT !use transportOperatorDynamicDT_class, only : transportOperatorDynamicDT @@ -26,6 +27,7 @@ module transportOperatorFactory_func character(nameLen),dimension(*),parameter :: AVALIBLE_transportOps = [ 'transportOperatorST ', & 'transportOperatorDT ', & 'transportOperatorHT ', & + 'transportOperatorTime ', & 'transportOperatorTimeHT']!, & ! 'dynamicTranspOperDT'] @@ -63,6 +65,10 @@ subroutine new_transportOperator(new, dict) allocate( transportOperatorHT :: new) call new % init(dict) + case('transportOperatorTime') + allocate( transportOperatorTime :: new) + call new % init(dict) + case('transportOperatorTimeHT') allocate( transportOperatorTimeHT :: new) call new % init(dict) diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 index a650ac6cd..07889fd57 100644 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ b/TransportOperator/transportOperatorTimeHT_class.f90 @@ -37,10 +37,9 @@ module transportOperatorTimeHT_class integer(shortInt), parameter :: DT = 4 ! Delta tracking !! - !! Transport operator that moves a particle with using hybrid tracking, up to a time boundary + !! Transport operator that moves a particle using hybrid tracking, up to a time boundary !! type, public, extends(transportOperator) :: transportOperatorTimeHT - real(defReal) :: deltaT real(defReal) :: cutoff integer(shortInt) :: method contains diff --git a/TransportOperator/transportOperatorTime_class.f90 b/TransportOperator/transportOperatorTime_class.f90 new file mode 100644 index 000000000..cd3d96f6b --- /dev/null +++ b/TransportOperator/transportOperatorTime_class.f90 @@ -0,0 +1,193 @@ +!! +!! Surface tracking transport operator for time-dependent problems +!! +module transportOperatorTime_class + use numPrecision + use universalVariables + + use genericProcedures, only : fatalError, numToChar + use particle_class, only : particle, P_PHOTON, P_MATERIAL + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use rng_class, only : rng + + ! Superclass + use transportOperator_inter, only : transportOperator + + ! Geometry interfaces + use geometry_inter, only : geometry + + ! Tally interface + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + + ! Nuclear data interfaces + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast + + implicit none + private + + !! + !! Transport operator that moves a particle using surface tracking, up to a time boundary + !! + type, public, extends(transportOperator) :: transportOperatorTime + contains + procedure :: transit => timeTracking + procedure, private :: surfaceTracking + procedure, private :: materialTransform + end type transportOperatorTime + +contains + + subroutine timeTracking(self, p, tally, thisCycle, nextCycle) + class(transportOperatorTime), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon), intent(inout) :: thisCycle + class(particleDungeon), intent(inout) :: nextCycle + character(100), parameter :: Here = 'timeTracking (transportOperatorTime_class.f90)' + + ! Transform material particles into photons + if (p % type == P_MATERIAL) then + call self % materialTransform(p, tally) + ! Exit at time boundary + if (p % fate == AGED_FATE) return + end if + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) then + ! TODO: Figure out why this sometimes happens + print *, 'WARNING: Leak before transport?' + p % fate = LEAK_FATE + p % isDead = .true. + return + end if + + call self % surfaceTracking(p) + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + end if + + call tally % reportTrans(p) + + end subroutine timeTracking + + !! + !! Perform surface tracking + !! + subroutine surfaceTracking(self, p) + class(transportOperatorTime), intent(inout) :: self + class(particle), intent(inout) :: p + real(defReal) :: dTime, dColl, dist, sigmaT + integer(shortInt) :: event + character(100), parameter :: Here = 'surfaceTracking (transportOperatorTime_class.f90)' + + STLoop:do + + ! Find distance to time boundary + dTime = lightSpeed * (p % timeMax - p % time) + + ! Sample distance to collision + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + dColl = -log( p % pRNG % get() ) / sigmaT + + ! Ensure particle does not remain exactly on a boundary if dColl is close to 0 + if (event == CROSS_EV .and. dColl < SURF_TOL) then + dColl = SURF_TOL + end if + + ! Choose minimum distance + dist = min(dTime, dColl) + + ! Move through geometry using minimum distance + call self % geom % move(p % coords, dist, event) + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return + + ! Increase time based on distance moved + p % time = p % time + dist / lightSpeed + + ! Check result of transport + if (dist == dTime) then + ! Time boundary + p % fate = AGED_FATE + p % time = p % timeMax + exit STLoop + + else if (dist == dColl) then + ! Collision + exit STLoop + + end if + + if (event == COLL_EV) call fatalError(Here, 'Move outcome should be CROSS_EV or BOUNDARY_EV') + + end do STLoop + + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV') + + end subroutine surfaceTracking + + !! + !! Determine when a material particle will transform into a photon for ISMC calculations + !! + !! Args: + !! p [inout] -> material particle to be transformed + !! tally [inout] -> tally to keep track of material particles surviving time step + !! + subroutine materialTransform(self, p, tally) + class(transportOperatorTime), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + real(defReal) :: transformTime, mu, phi + real(defReal), dimension(3) :: dir + class(mgIMCDatabase), pointer :: nucData + integer(shortInt) :: matIdx, uniqueID + character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' + + ! Get pointer to nuclear database + nucData => mgIMCDatabase_CptrCast(self % xsData) + if (.not. associated(nucData)) call fatalError(Here, 'Unable to find mgIMCDatabase') + + ! Material particles can occasionally have coords placed in void if within SURF_TOL of boundary + matIdx = p % matIdx() + ! If so, get matIdx based on exact position (no adjustment for surface tol) + if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) then + call self % geom % whatIsAt(matIdx, uniqueID, p % coords % lvl(1) % r, [ZERO,ZERO,ZERO]) + end if + ! If still in invalid region, call fatalError + if (matIdx == 0) call fatalError(Here, 'Outside material particle') + if (matIdx == VOID_MAT) call fatalError(Here, 'Void material particle') + + ! Sample time until emission + transformTime = nucData % sampleTransformTime(matIdx, p % pRNG) + p % time = min(p % timeMax, p % time + transformTime) + + ! Exit loop if particle remains material until end of time step + if (p % time == p % timeMax) then + p % fate = AGED_FATE + ! Tally energy for next temperature calculation + call tally % reportHist(p) + + ! Transform into photon + else + p % type = P_PHOTON + ! Resample direction + mu = 2 * p % pRNG % get() - 1 + phi = p % pRNG % get() * 2*pi + dir(1) = mu + dir(2) = sqrt(1-mu**2) * cos(phi) + dir(3) = sqrt(1-mu**2) * sin(phi) + call p % point(dir) + ! Resample energy + p % G = nucData % sampleEnergyGroup(matIdx, p % pRNG) + end if + + end subroutine materialTransform + +end module transportOperatorTime_class diff --git a/TransportOperator/transportOperator_inter.f90 b/TransportOperator/transportOperator_inter.f90 index 06942c605..ed55f81e1 100644 --- a/TransportOperator/transportOperator_inter.f90 +++ b/TransportOperator/transportOperator_inter.f90 @@ -60,8 +60,6 @@ module transportOperator_inter ! Extentable initialisation and deconstruction procedure procedure :: init procedure :: kill - procedure :: buildMajMap - procedure :: updateMajorants ! Customisable deferred procedures procedure(transit), deferred :: transit @@ -146,28 +144,4 @@ elemental subroutine kill(self) end subroutine kill - !! - !! Improve majorant estimates for each material. See transportOperatorIMC_class for details. - !! - subroutine buildMajMap(self, rand, xsData) - class(transportOperator), intent(inout) :: self - class(RNG), intent(inout) :: rand - class(nuclearDatabase), intent(in), pointer :: xsData - - ! Do nothing - - end subroutine buildMajMap - - !! - !! Update majorants for each region. See transportOperatorIMC_class for details. - !! - subroutine updateMajorants(self, rand) - class(transportOperator), intent(inout) :: self - class(RNG), intent(inout) :: rand - - ! Do nothing - - end subroutine updateMajorants - - end module transportOperator_inter From 6ae930fac896fafb5e9813a51c7b9f56bf8c11ab Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 20 Dec 2023 16:41:32 +0000 Subject: [PATCH 363/373] Added way option to specify units as ns in input file to avoid having to count 0s in timestep. Would be nice to figure out a neat way to change radiationConstant as well for running marshak wave --- .../implicitPhysicsPackage_class.f90 | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index a2a9e900f..32ca4332d 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -410,7 +410,7 @@ subroutine init(self, dict) character(nameLen), dimension(:), allocatable :: mats real(defReal) :: timeStep type(dictionary),target :: newGeom, newData - character(nameLen) :: method + character(nameLen) :: method, units character(100), parameter :: Here ='init (implicitPhysicsPackage_class.f90)' call cpu_time(self % CPU_time_start) @@ -428,12 +428,27 @@ subroutine init(self, dict) ! Read calculation settings call dict % get(self % pop,'pop') - call dict % get(self % limit, 'limit') + call dict % get(self % limit,'limit') call dict % get(self % N_steps,'steps') call dict % get(timeStep,'timeStep') call dict % getOrDefault(self % printUpdates, 'printUpdates', 0) nucData = 'mg' + ! Set time step after changing units if necessary + call dict % getOrDefault(units, 'units', 'ns') + select case(units) + case('s') + ! No change needed + case('ns') + ! Convert time step from ns to s + timeStep = timeStep/10**9 + case('marshak') + ! Special case where a = c = 1 + timeStep = timeStep/lightSpeed + print *, 'WARNING: For Marshak wave, still need to manually change radiationConstant to 1' + case default + call fatalError(Here, 'Unrecognised units') + end select call setStep(timeStep) ! Read outputfile path From f00e54db3da125c06dc600fca1d2e69c567bef24 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Wed, 20 Dec 2023 17:16:00 +0000 Subject: [PATCH 364/373] Cleaned up input file folder --- InputFiles/IMC/DataFiles/hohlraumData | 21 +- InputFiles/IMC/DataFiles/marshakData | 17 +- InputFiles/IMC/DataFiles/sampleData | 53 +-- .../IMC/DensmoreMF/DataFiles/densmoreDataMid | 7 + .../DensmoreMF/DataFiles/densmoreDataThick | 7 + .../IMC/DensmoreMF/DataFiles/densmoreDataThin | 7 + InputFiles/IMC/DensmoreMF/densmoreMid | 72 ++++ InputFiles/IMC/DensmoreMF/densmoreThick | 72 ++++ InputFiles/IMC/DensmoreMF/densmoreThin | 72 ++++ InputFiles/IMC/DensmoreMF/twoRegion1 | 78 ++++ InputFiles/IMC/SimpleCases/3region | 79 ---- InputFiles/IMC/SimpleCases/dataFiles/imcData | 18 - InputFiles/IMC/SimpleCases/dataFiles/imcData2 | 18 - InputFiles/IMC/SimpleCases/infiniteRegion | 65 ---- InputFiles/IMC/SimpleCases/sphereInCube | 69 ---- InputFiles/IMC/SimpleCases/touchingCubes | 70 ---- InputFiles/IMC/hohlraum | 37 +- InputFiles/IMC/marshakWave | 29 +- InputFiles/IMC/oldInputs/dataFiles/imcData | 18 - InputFiles/IMC/oldInputs/marshakWave128 | 348 ------------------ InputFiles/IMC/oldInputs/marshakWave16 | 104 ------ InputFiles/IMC/oldInputs/marshakWave32 | 139 ------- InputFiles/IMC/oldInputs/marshakWave64 | 208 ----------- InputFiles/IMC/oldInputs/marshakWave8 | 88 ----- InputFiles/IMC/sampleInput | 113 ++---- 25 files changed, 392 insertions(+), 1417 deletions(-) create mode 100644 InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataMid create mode 100644 InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataThick create mode 100644 InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataThin create mode 100644 InputFiles/IMC/DensmoreMF/densmoreMid create mode 100644 InputFiles/IMC/DensmoreMF/densmoreThick create mode 100644 InputFiles/IMC/DensmoreMF/densmoreThin create mode 100644 InputFiles/IMC/DensmoreMF/twoRegion1 delete mode 100644 InputFiles/IMC/SimpleCases/3region delete mode 100644 InputFiles/IMC/SimpleCases/dataFiles/imcData delete mode 100644 InputFiles/IMC/SimpleCases/dataFiles/imcData2 delete mode 100644 InputFiles/IMC/SimpleCases/infiniteRegion delete mode 100644 InputFiles/IMC/SimpleCases/sphereInCube delete mode 100644 InputFiles/IMC/SimpleCases/touchingCubes delete mode 100644 InputFiles/IMC/oldInputs/dataFiles/imcData delete mode 100644 InputFiles/IMC/oldInputs/marshakWave128 delete mode 100644 InputFiles/IMC/oldInputs/marshakWave16 delete mode 100644 InputFiles/IMC/oldInputs/marshakWave32 delete mode 100644 InputFiles/IMC/oldInputs/marshakWave64 delete mode 100644 InputFiles/IMC/oldInputs/marshakWave8 diff --git a/InputFiles/IMC/DataFiles/hohlraumData b/InputFiles/IMC/DataFiles/hohlraumData index 1cdf6c285..8b349c73f 100644 --- a/InputFiles/IMC/DataFiles/hohlraumData +++ b/InputFiles/IMC/DataFiles/hohlraumData @@ -1,22 +1,3 @@ -// This XSS are for a URR-2-1-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 ( - 100 - -3 -); - -scatter ( - 0 - 0 -); - -cv ( - 0.3 //3.00026706e15 - 0 -); +equations hohlraum; diff --git a/InputFiles/IMC/DataFiles/marshakData b/InputFiles/IMC/DataFiles/marshakData index 389b9eaa0..766d2a8d3 100644 --- a/InputFiles/IMC/DataFiles/marshakData +++ b/InputFiles/IMC/DataFiles/marshakData @@ -1,18 +1,3 @@ -numberOfGroups 1; - -capture ( - 10 - -3 -); - -scatter ( - 0 - 0 -); - -cv ( - 7.14 - 0 -); +equations marshak; diff --git a/InputFiles/IMC/DataFiles/sampleData b/InputFiles/IMC/DataFiles/sampleData index 248608a6e..e212109a7 100644 --- a/InputFiles/IMC/DataFiles/sampleData +++ b/InputFiles/IMC/DataFiles/sampleData @@ -1,44 +1,23 @@ + // // Sample material data file for IMC calculations -// +// Very simple, only exists to keep material creation more consistent with other calculation types +// + + + // Set of equations to use for opacities and heat capacities, currently have densmore, marshak and + // holraum. Adding new cases requires recompiling but this allows for complex multi-frequency eqns. +equations densmore; + +/\/\ Optional Inputs /\/\ -numberOfGroups 1; + // Multiple either opacity or heat capacity by a constant. Useful if wanting to change constant + // value in complex equations without having to recompile (e.g. different densmore MF cases) + // Default to 1 +sigmaMultiple 100; +cvMultiple 1; + // Constant in Fleck factor, defaults to 1 alpha = 1; - // Optional setting of alpha used in calculation of fleck factor. If not given, alpha is set at 1. - - - // Set polynomial temperature-dependent opacities for the material. - // Currently have only considered the grey case, if using a frequency dependent opacity - // then this would need to be changed to a more complex input. - // Input should be a 1D array of coefficients followed by exponents, with any polynomial - // length allowed - // e.g. Here, sigmaA = 1 + 2T - -capture ( // Absorption opacity - 1 2 // Coefficients - 0 1 // Exponents -); - -scatter ( // Scattering opacity - 0 - 0 -); - - - // Set temperature-dependent specific heat capacity of the material. - // Same format as above. - // Currently cannot have an exponent of exactly -1, as cv is integrated simply by adding 1 to - // exponents an have not yet allowed T^(-1) to integrate to ln(T). - // After integration, solved by Newton-Raphson solver. Some choices of cv may not converge, - // and some will give negative energies and temperatures. Unsure if this is due to some - // numerical oversight in the way the calculation is done or if these are just unphysical - // choices. - // e.g. Here, cv = 4T^3 - 2T + T^(-0.5) - -cv ( - 4 -2 1 // Coefficients - 3 1 -0.5 // Exponents -); diff --git a/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataMid b/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataMid new file mode 100644 index 000000000..64badbc1d --- /dev/null +++ b/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataMid @@ -0,0 +1,7 @@ +// Data for 1D Olson benchamrk problem +// + +equations densmore; + +sigmaMultiple 100; + diff --git a/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataThick b/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataThick new file mode 100644 index 000000000..5fecc1d40 --- /dev/null +++ b/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataThick @@ -0,0 +1,7 @@ +// Data for 1D Olson benchamrk problem +// + +equations densmore; + +sigmaMultiple 1000; + diff --git a/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataThin b/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataThin new file mode 100644 index 000000000..37e577cb2 --- /dev/null +++ b/InputFiles/IMC/DensmoreMF/DataFiles/densmoreDataThin @@ -0,0 +1,7 @@ +// Data for 1D Olson benchamrk problem +// + +equations densmore; + +sigmaMultiple 10; + diff --git a/InputFiles/IMC/DensmoreMF/densmoreMid b/InputFiles/IMC/DensmoreMF/densmoreMid new file mode 100644 index 000000000..b6a74e137 --- /dev/null +++ b/InputFiles/IMC/DensmoreMF/densmoreMid @@ -0,0 +1,72 @@ + +type implicitPhysicsPackage; + +method IMC; +pop 100000; +limit 300000; +steps 100; +timeStep 0.01; +units ns; +printUpdates 0; + +energyGrid { + grid log; + size 30; + min 0.0001; + max 100; + } + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorTime; + } + +matSource { type materialSource; method fast; } + + +source { type blackBodySource; distribution surface; surface -x; temp 1; } + + +tally { + } + +geometry { + type geometryGrid; + dimensions (250 1 1); + boundary (0 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2.5 0.5 0.5); } + } + + cells {} + + universes + { + root { id 100; type rootUniverse; border 1; fill mat1; } + } + +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; } + } + + + materials { + + mat1 { temp 0.001; composition {} xsFile ./DataFiles/densmoreDataMid; } + + } + +} + + + diff --git a/InputFiles/IMC/DensmoreMF/densmoreThick b/InputFiles/IMC/DensmoreMF/densmoreThick new file mode 100644 index 000000000..8e98aa253 --- /dev/null +++ b/InputFiles/IMC/DensmoreMF/densmoreThick @@ -0,0 +1,72 @@ + +type implicitPhysicsPackage; + +method IMC; +pop 100000; +limit 300000; +steps 100; +timeStep 0.01; +units ns; +printUpdates 0; + +energyGrid { + grid log; + size 30; + min 0.0001; + max 100; + } + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorTime; + } + +matSource { type materialSource; method fast; } + + +source { type blackBodySource; distribution surface; surface -x; temp 1; } + + +tally { + } + +geometry { + type geometryGrid; + dimensions (250 1 1); + boundary (0 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2.5 0.5 0.5); } + } + + cells {} + + universes + { + root { id 100; type rootUniverse; border 1; fill mat1; } + } + +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; } + } + + + materials { + + mat1 { temp 0.001; composition {} xsFile ./DataFiles/densmoreDataThick; } + + } + +} + + + diff --git a/InputFiles/IMC/DensmoreMF/densmoreThin b/InputFiles/IMC/DensmoreMF/densmoreThin new file mode 100644 index 000000000..14c52807c --- /dev/null +++ b/InputFiles/IMC/DensmoreMF/densmoreThin @@ -0,0 +1,72 @@ + +type implicitPhysicsPackage; + +method IMC; +pop 100000; +limit 300000; +steps 100; +timeStep 0.01; +units ns; +printUpdates 0; + +energyGrid { + grid log; + size 30; + min 0.0001; + max 100; + } + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorTime; + } + +matSource { type materialSource; method fast; } + + +source { type blackBodySource; distribution surface; surface -x; temp 1; } + + +tally { + } + +geometry { + type geometryGrid; + dimensions (250 1 1); + boundary (0 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2.5 0.5 0.5); } + } + + cells {} + + universes + { + root { id 100; type rootUniverse; border 1; fill mat1; } + } + +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; } + } + + + materials { + + mat1 { temp 0.001; composition {} xsFile ./DataFiles/densmoreDataThin; } + + } + +} + + + diff --git a/InputFiles/IMC/DensmoreMF/twoRegion1 b/InputFiles/IMC/DensmoreMF/twoRegion1 new file mode 100644 index 000000000..91902af59 --- /dev/null +++ b/InputFiles/IMC/DensmoreMF/twoRegion1 @@ -0,0 +1,78 @@ + +type implicitPhysicsPackage; + +method IMC; +pop 10000; +limit 30000; +steps 100; +timeStep 0.01; +units ns; +printUpdates 0; + +energyGrid { + grid log; + size 30; + min 0.0001; + max 100; + } + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorTime; + } + +matSource { type materialSource; method fast; } + + +source { type blackBodySource; distribution surface; surface -x; temp 1; } + + +tally { + } + +geometry { + type geometryGrid; + dimensions (250 1 1); + boundary (0 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1.5 0.5 0.5); } + sep { id 2; type xPlane; x0 0.5; } + } + + cells { + call1 {id 1; type simpleCell; surfaces (-2); filltype mat; material mat1; } + call2 {id 2; type simpleCell; surfaces (2); filltype mat; material mat2; } + } + + universes + { + root { id 1; type rootUniverse; border 1; fill u<2>; } + cells { id 2; type cellUniverse; cells (1 2); } + } + +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; } + } + + + materials { + + mat1 { temp 0.001; composition {} xsFile ./DataFiles/densmoreDataThin; } + mat2 { temp 0.001; composition {} xsFile ./DataFiles/densmoreDataThick; } + + } + +} + + + diff --git a/InputFiles/IMC/SimpleCases/3region b/InputFiles/IMC/SimpleCases/3region deleted file mode 100644 index 4a17874b1..000000000 --- a/InputFiles/IMC/SimpleCases/3region +++ /dev/null @@ -1,79 +0,0 @@ - -type IMCPhysicsPackage; - -pop 5000; -limit 20000; -steps 50; -timeStepSize 0.1; -printUpdates 3; - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorTimeHT; - } - -tally { - } - -geometry { - type geometryStd; - boundary (1 1 1 1 1 1); - graph {type shrunk;} - - surfaces - { - sep1 { id 1; type xPlane; x0 -0.5; } - sep2 { id 2; type xPlane; x0 0.5; } - outer { id 3; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1.5 0.5 0.5); } - } - cells - { - cell1 { id 1; type simpleCell; surfaces ( -1); filltype mat; material mat1; } - cell2 { id 2; type simpleCell; surfaces (1 -2); filltype mat; material mat2; } - cell3 { id 3; type simpleCell; surfaces ( 2); filltype mat; material mat3; } - } - universes - { - root { id 1; type rootUniverse; border 3; fill u<2>; } - cell { id 2; type cellUniverse; cells ( 1 2 3); } - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat1 { - temp 1; - composition {} - xsFile ./dataFiles/imcData; - volume 1; - } - mat2 { - temp 0.01; - composition {} - xsFile ./dataFiles/imcData; - volume 1; - } - mat3 { - temp 0.01; - composition {} - xsFile ./dataFiles/imcData; - volume 1; - } - - -} - -} - - - diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData b/InputFiles/IMC/SimpleCases/dataFiles/imcData deleted file mode 100644 index 3e5ec6ed5..000000000 --- a/InputFiles/IMC/SimpleCases/dataFiles/imcData +++ /dev/null @@ -1,18 +0,0 @@ - -numberOfGroups 1; - -capture ( - 1 - 0 -); - -scatter ( - 0 - 0 -); - -cv ( - 4 - 3 -); - diff --git a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 b/InputFiles/IMC/SimpleCases/dataFiles/imcData2 deleted file mode 100644 index 0e7f39427..000000000 --- a/InputFiles/IMC/SimpleCases/dataFiles/imcData2 +++ /dev/null @@ -1,18 +0,0 @@ - -numberOfGroups 1; - -capture ( - 1.0 - 0.0 -); - -scatter ( - 0.0 - 0.0 -); - -cv ( - 4.0 3.0 - 3.0 2.0 -); - diff --git a/InputFiles/IMC/SimpleCases/infiniteRegion b/InputFiles/IMC/SimpleCases/infiniteRegion deleted file mode 100644 index 5ec1dde1c..000000000 --- a/InputFiles/IMC/SimpleCases/infiniteRegion +++ /dev/null @@ -1,65 +0,0 @@ - -type IMCPhysicsPackage; - -pop 5000; -limit 20000; -steps 50; -timeStepSize 0.01; -printUpdates 1; - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorTimeHT; - } - -tally { - } - -geometry { - type geometryStd; - boundary (1 1 1 1 1 1); - graph {type shrunk;} - - surfaces - { - squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } - } - cells {} - universes - { - - root - { - id 1; - type rootUniverse; - border 1; - fill mat; - } - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat { - temp 1; - composition {} - xsFile ./dataFiles/imcData; - volume 1; - } - -} - -} - - - diff --git a/InputFiles/IMC/SimpleCases/sphereInCube b/InputFiles/IMC/SimpleCases/sphereInCube deleted file mode 100644 index 556e53737..000000000 --- a/InputFiles/IMC/SimpleCases/sphereInCube +++ /dev/null @@ -1,69 +0,0 @@ - -type IMCPhysicsPackage; - -pop 100; -limit 2000; -steps 500; -timeStepSize 0.1; -printUpdates 2; - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorTimeHT; - } - -tally { - } - -geometry { - type geometryStd; - boundary (1 1 1 1 1 1); - graph {type shrunk;} - - surfaces - { - inner { id 1; type sphere; origin ( 0.0 0.0 0.0); radius 1; } - outer { id 2; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1 1 1); } - } - cells - { - inner_cell { id 1; type simpleCell; surfaces (-1); filltype mat; material mat1; } - outer_cell { id 2; type simpleCell; surfaces ( 1); filltype mat; material mat2; } - } - universes - { - root { id 1; type rootUniverse; border 2; fill u<2>; } - cell { id 2; type cellUniverse; cells ( 1 2 ); } - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat1 { - temp 1; - composition {} - xsFile ./dataFiles/imcData; - volume 4.18879; - } - mat2 { - temp 5; - composition {} - xsFile ./dataFiles/imcData; - volume 3.81121; } - -} - -} - - - diff --git a/InputFiles/IMC/SimpleCases/touchingCubes b/InputFiles/IMC/SimpleCases/touchingCubes deleted file mode 100644 index 3cfbfa1fb..000000000 --- a/InputFiles/IMC/SimpleCases/touchingCubes +++ /dev/null @@ -1,70 +0,0 @@ - -type IMCPhysicsPackage; - -pop 5000; -limit 20000; -steps 50; -timeStepSize 1; -printUpdates 2; - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorTimeHT; - } - -tally { - } - -geometry { - type geometryStd; - boundary (1 1 1 1 1 1); - graph {type shrunk;} - - surfaces - { - sep { id 1; type xPlane; x0 0.0; } - outer { id 2; type box; origin ( 0.0 0.0 0.0); halfwidth ( 1 0.5 0.5); } - } - cells - { - cell1 { id 1; type simpleCell; surfaces (-1); filltype mat; material mat1; } - cell2 { id 2; type simpleCell; surfaces ( 1); filltype mat; material mat2; } - } - universes - { - root { id 1; type rootUniverse; border 2; fill u<2>; } - cell { id 2; type cellUniverse; cells ( 1 2 ); } - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat1 { - temp 1; - composition {} - xsFile ./dataFiles/imcData; - volume 1; - } - mat2 { - temp 0; - composition {} - xsFile ./dataFiles/imcData2; - volume 1; - } - -} - -} - - - diff --git a/InputFiles/IMC/hohlraum b/InputFiles/IMC/hohlraum index 2be0bed98..a71e71344 100644 --- a/InputFiles/IMC/hohlraum +++ b/InputFiles/IMC/hohlraum @@ -1,30 +1,26 @@ -type IMCPhysicsPackage; +type implicitPhysicsPackage; -pop 2000000; -limit 20000000; +method IMC; +pop 500000; +limit 2000000; steps 100; -timeStepSize 0.00000000001; -printUpdates 0; +timeStep 0.01; +units ns; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorTimeHT; - method ST; - cutoff 0.9; - grid { dimensions (20 20 1); searchN (10 10 1); } + type transportOperatorTime; } -matSource { type imcSource; method fast; } - source { - type bbSurfaceSource; - r (-0.5 -0.5 -0.5 0.5 -0.5 0.5); + type blackBodySource; + distribution surface; + surface -x; temp 1; - N 20000; } viz { vizDict { type vtk; corner (-0.5 -0.5 -0.5); width (1 1 1); vox (20 20 1); } } @@ -32,10 +28,9 @@ viz { vizDict { type vtk; corner (-0.5 -0.5 -0.5); width (1 1 1); vox (20 20 1); tally { } -discretise { dimensions (200 200 1); } - geometry { - type geometryStd; + type geometryGrid; + dimensions (200 200 1); boundary (0 0 0 0 1 1); graph {type shrunk;} @@ -90,11 +85,11 @@ nuclearData { materials { - mat1 { temp 0.000000001; composition {} xsFile ./DataFiles/hohlraumData; } + mat1 { temp 0.000001; composition {} xsFile ./DataFiles/hohlraumData; } } } - - - + + + diff --git a/InputFiles/IMC/marshakWave b/InputFiles/IMC/marshakWave index c3d87c7ae..427affb3a 100644 --- a/InputFiles/IMC/marshakWave +++ b/InputFiles/IMC/marshakWave @@ -1,36 +1,29 @@ // Marshak wave IMC benchmark // Requires lightSpeed and radiation constant set to ONE in universalVariables -type IMCPhysicsPackage; +type implicitPhysicsPackage; -pop 1000000; -limit 2500000; -steps 10; -timeStepSize 0.5; -printUpdates 20; +method IMC; +pop 10000; +limit 25000; +steps 5000; +timeStep 0.1; +units marshak; collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorTimeHT; cutoff 0.8; + type transportOperatorTime; } tally {} -// Material photon source - optional but will default to rejection sampling if method not specified -matSource { type imcSource; method fast; } - // Black body surface source -source { type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 10000; } - -// Spatial discretisation -discretise { dimensions (500 1 1); } - -// Overlaid grid for hybrid tracking -grid { dimensions (50 1 1); searchN (10 1 1); } +source { type blackBodySource; distribution surface; surface -x; temp 1; } geometry { - type geometryStd; + type geometryGrid; + dimensions (100 1 1); boundary (0 0 1 1 1 1); graph {type shrunk;} diff --git a/InputFiles/IMC/oldInputs/dataFiles/imcData b/InputFiles/IMC/oldInputs/dataFiles/imcData deleted file mode 100644 index 389b9eaa0..000000000 --- a/InputFiles/IMC/oldInputs/dataFiles/imcData +++ /dev/null @@ -1,18 +0,0 @@ - -numberOfGroups 1; - -capture ( - 10 - -3 -); - -scatter ( - 0 - 0 -); - -cv ( - 7.14 - 0 -); - diff --git a/InputFiles/IMC/oldInputs/marshakWave128 b/InputFiles/IMC/oldInputs/marshakWave128 deleted file mode 100644 index ac169627e..000000000 --- a/InputFiles/IMC/oldInputs/marshakWave128 +++ /dev/null @@ -1,348 +0,0 @@ -// Marshak wave simulation using 128 equal spatial regions -// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** - -type IMCPhysicsPackage; - -pop 10000; -limit 200000; -steps 1000; -timeStepSize 0.5; -printUpdates 4; - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorTimeHT; cutoff 0.9; - } - -source { - type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; -} - -tally { - } - -grid { dimensions (25 1 1); searchN (1000 1 1); } - -geometry { - type geometryStd; - boundary (0 0 1 1 1 1); - graph {type shrunk;} - - surfaces - { - outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } - } - - cells - { - } - universes - { - root { id 1000; type rootUniverse; border 1; fill u<2000>; } - - lat { id 2000; - type latUniverse; - origin (0.0 0.0 0.0); - pitch (0.03125 1.0 1.0); - shape (128 1 1); - padMat void; - map ( 1 2 3 4 5 6 7 8 9 10 - 11 12 13 14 15 16 17 18 19 20 - 21 22 23 24 25 26 27 28 29 30 - 31 32 33 34 35 36 37 38 39 40 - 41 42 43 44 45 46 47 48 49 50 - 51 52 53 54 55 56 57 58 59 60 - 61 62 63 64 65 66 67 68 69 70 - 71 72 73 74 75 76 77 78 79 80 - 81 82 83 84 85 86 87 88 89 90 - 91 92 93 94 95 96 97 98 99 100 - 101 102 103 104 105 106 107 108 109 110 - 111 112 113 114 115 116 117 118 119 120 - 121 122 123 124 125 126 127 128); - } - - zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } - zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } - zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } - zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } - zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } - zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } - zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } - zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } - zone9 { id 9; type pinUniverse; radii (0.0); fills (mat9); } - zone10 { id 10; type pinUniverse; radii (0.0); fills (mat10); } - zone11 { id 11; type pinUniverse; radii (0.0); fills (mat11); } - zone12 { id 12; type pinUniverse; radii (0.0); fills (mat12); } - zone13 { id 13; type pinUniverse; radii (0.0); fills (mat13); } - zone14 { id 14; type pinUniverse; radii (0.0); fills (mat14); } - zone15 { id 15; type pinUniverse; radii (0.0); fills (mat15); } - zone16 { id 16; type pinUniverse; radii (0.0); fills (mat16); } - zone17 { id 17; type pinUniverse; radii (0.0); fills (mat17); } - zone18 { id 18; type pinUniverse; radii (0.0); fills (mat18); } - zone19 { id 19; type pinUniverse; radii (0.0); fills (mat19); } - zone20 { id 20; type pinUniverse; radii (0.0); fills (mat20); } - zone21 { id 21; type pinUniverse; radii (0.0); fills (mat21); } - zone22 { id 22; type pinUniverse; radii (0.0); fills (mat22); } - zone23 { id 23; type pinUniverse; radii (0.0); fills (mat23); } - zone24 { id 24; type pinUniverse; radii (0.0); fills (mat24); } - zone25 { id 25; type pinUniverse; radii (0.0); fills (mat25); } - zone26 { id 26; type pinUniverse; radii (0.0); fills (mat26); } - zone27 { id 27; type pinUniverse; radii (0.0); fills (mat27); } - zone28 { id 28; type pinUniverse; radii (0.0); fills (mat28); } - zone29 { id 29; type pinUniverse; radii (0.0); fills (mat29); } - zone30 { id 30; type pinUniverse; radii (0.0); fills (mat30); } - zone31 { id 31; type pinUniverse; radii (0.0); fills (mat31); } - zone32 { id 32; type pinUniverse; radii (0.0); fills (mat32); } - - zone33 { id 33; type pinUniverse; radii (0.0); fills (mat33); } - zone34 { id 34; type pinUniverse; radii (0.0); fills (mat34); } - zone35 { id 35; type pinUniverse; radii (0.0); fills (mat35); } - zone36 { id 36; type pinUniverse; radii (0.0); fills (mat36); } - zone37 { id 37; type pinUniverse; radii (0.0); fills (mat37); } - zone38 { id 38; type pinUniverse; radii (0.0); fills (mat38); } - zone39 { id 39; type pinUniverse; radii (0.0); fills (mat39); } - zone40 { id 40; type pinUniverse; radii (0.0); fills (mat40); } - zone41 { id 41; type pinUniverse; radii (0.0); fills (mat41); } - zone42 { id 42; type pinUniverse; radii (0.0); fills (mat42); } - zone43 { id 43; type pinUniverse; radii (0.0); fills (mat43); } - zone44 { id 44; type pinUniverse; radii (0.0); fills (mat44); } - zone45 { id 45; type pinUniverse; radii (0.0); fills (mat45); } - zone46 { id 46; type pinUniverse; radii (0.0); fills (mat46); } - zone47 { id 47; type pinUniverse; radii (0.0); fills (mat47); } - zone48 { id 48; type pinUniverse; radii (0.0); fills (mat48); } - zone49 { id 49; type pinUniverse; radii (0.0); fills (mat49); } - zone50 { id 50; type pinUniverse; radii (0.0); fills (mat50); } - zone51 { id 51; type pinUniverse; radii (0.0); fills (mat51); } - zone52 { id 52; type pinUniverse; radii (0.0); fills (mat52); } - zone53 { id 53; type pinUniverse; radii (0.0); fills (mat53); } - zone54 { id 54; type pinUniverse; radii (0.0); fills (mat54); } - zone55 { id 55; type pinUniverse; radii (0.0); fills (mat55); } - zone56 { id 56; type pinUniverse; radii (0.0); fills (mat56); } - zone57 { id 57; type pinUniverse; radii (0.0); fills (mat57); } - zone58 { id 58; type pinUniverse; radii (0.0); fills (mat58); } - zone59 { id 59; type pinUniverse; radii (0.0); fills (mat59); } - zone60 { id 60; type pinUniverse; radii (0.0); fills (mat60); } - zone61 { id 61; type pinUniverse; radii (0.0); fills (mat61); } - zone62 { id 62; type pinUniverse; radii (0.0); fills (mat62); } - zone63 { id 63; type pinUniverse; radii (0.0); fills (mat63); } - zone64 { id 64; type pinUniverse; radii (0.0); fills (mat64); } - - zone65 { id 65; type pinUniverse; radii (0.0); fills (mat65); } - zone66 { id 66; type pinUniverse; radii (0.0); fills (mat66); } - zone67 { id 67; type pinUniverse; radii (0.0); fills (mat67); } - zone68 { id 68; type pinUniverse; radii (0.0); fills (mat68); } - zone69 { id 69; type pinUniverse; radii (0.0); fills (mat69); } - zone70 { id 70; type pinUniverse; radii (0.0); fills (mat70); } - zone71 { id 71; type pinUniverse; radii (0.0); fills (mat71); } - zone72 { id 72; type pinUniverse; radii (0.0); fills (mat72); } - zone73 { id 73; type pinUniverse; radii (0.0); fills (mat73); } - zone74 { id 74; type pinUniverse; radii (0.0); fills (mat74); } - zone75 { id 75; type pinUniverse; radii (0.0); fills (mat75); } - zone76 { id 76; type pinUniverse; radii (0.0); fills (mat76); } - zone77 { id 77; type pinUniverse; radii (0.0); fills (mat77); } - zone78 { id 78; type pinUniverse; radii (0.0); fills (mat78); } - zone79 { id 79; type pinUniverse; radii (0.0); fills (mat79); } - zone80 { id 80; type pinUniverse; radii (0.0); fills (mat80); } - zone81 { id 81; type pinUniverse; radii (0.0); fills (mat81); } - zone82 { id 82; type pinUniverse; radii (0.0); fills (mat82); } - zone83 { id 83; type pinUniverse; radii (0.0); fills (mat83); } - zone84 { id 84; type pinUniverse; radii (0.0); fills (mat84); } - zone85 { id 85; type pinUniverse; radii (0.0); fills (mat85); } - zone86 { id 86; type pinUniverse; radii (0.0); fills (mat86); } - zone87 { id 87; type pinUniverse; radii (0.0); fills (mat87); } - zone88 { id 88; type pinUniverse; radii (0.0); fills (mat88); } - zone89 { id 89; type pinUniverse; radii (0.0); fills (mat89); } - zone90 { id 90; type pinUniverse; radii (0.0); fills (mat90); } - zone91 { id 91; type pinUniverse; radii (0.0); fills (mat91); } - zone92 { id 92; type pinUniverse; radii (0.0); fills (mat92); } - zone93 { id 93; type pinUniverse; radii (0.0); fills (mat93); } - zone94 { id 94; type pinUniverse; radii (0.0); fills (mat94); } - zone95 { id 95; type pinUniverse; radii (0.0); fills (mat95); } - zone96 { id 96; type pinUniverse; radii (0.0); fills (mat96); } - - zone97 { id 97; type pinUniverse; radii (0.0); fills (mat97); } - zone98 { id 98; type pinUniverse; radii (0.0); fills (mat98); } - zone99 { id 99; type pinUniverse; radii (0.0); fills (mat99); } - zone100 { id 100; type pinUniverse; radii (0.0); fills (mat100); } - zone101 { id 101; type pinUniverse; radii (0.0); fills (mat101); } - zone102 { id 102; type pinUniverse; radii (0.0); fills (mat102); } - zone103 { id 103; type pinUniverse; radii (0.0); fills (mat103); } - zone104 { id 104; type pinUniverse; radii (0.0); fills (mat104); } - zone105 { id 105; type pinUniverse; radii (0.0); fills (mat105); } - zone106 { id 106; type pinUniverse; radii (0.0); fills (mat106); } - zone107 { id 107; type pinUniverse; radii (0.0); fills (mat107); } - zone108 { id 108; type pinUniverse; radii (0.0); fills (mat108); } - zone109 { id 109; type pinUniverse; radii (0.0); fills (mat109); } - zone110 { id 110; type pinUniverse; radii (0.0); fills (mat110); } - zone111 { id 111; type pinUniverse; radii (0.0); fills (mat111); } - zone112 { id 112; type pinUniverse; radii (0.0); fills (mat112); } - zone113 { id 113; type pinUniverse; radii (0.0); fills (mat113); } - zone114 { id 114; type pinUniverse; radii (0.0); fills (mat114); } - zone115 { id 115; type pinUniverse; radii (0.0); fills (mat115); } - zone116 { id 116; type pinUniverse; radii (0.0); fills (mat116); } - zone117 { id 117; type pinUniverse; radii (0.0); fills (mat117); } - zone118 { id 118; type pinUniverse; radii (0.0); fills (mat118); } - zone119 { id 119; type pinUniverse; radii (0.0); fills (mat119); } - zone120 { id 120; type pinUniverse; radii (0.0); fills (mat120); } - zone121 { id 121; type pinUniverse; radii (0.0); fills (mat121); } - zone122 { id 122; type pinUniverse; radii (0.0); fills (mat122); } - zone123 { id 123; type pinUniverse; radii (0.0); fills (mat123); } - zone124 { id 124; type pinUniverse; radii (0.0); fills (mat124); } - zone125 { id 125; type pinUniverse; radii (0.0); fills (mat125); } - zone126 { id 126; type pinUniverse; radii (0.0); fills (mat126); } - zone127 { id 127; type pinUniverse; radii (0.0); fills (mat127); } - zone128 { id 128; type pinUniverse; radii (0.0); fills (mat128); } - - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat17 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat18 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat19 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat20 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat21 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat22 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat23 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat24 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat25 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat26 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat30 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - - mat33 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat34 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat35 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat36 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat37 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat38 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat39 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat40 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat41 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat42 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat43 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat44 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat45 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat46 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat47 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat48 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat49 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat50 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat51 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat52 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat53 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat54 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat55 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat56 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat57 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat58 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat59 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat60 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat61 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat62 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat63 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat64 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - - mat65 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat66 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat67 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat68 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat69 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat70 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat71 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat72 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat73 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat74 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat75 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat76 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat77 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat78 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat79 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat80 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat81 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat82 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat83 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat84 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat85 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat86 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat87 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat88 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat89 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat90 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat91 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat92 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat93 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat94 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat95 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat96 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - - mat97 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat98 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat99 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat100 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat101 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat102 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat103 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat104 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat105 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat106 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat107 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat108 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat109 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat110 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat111 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat112 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat113 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat114 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat115 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat116 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat117 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat118 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat119 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat120 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat121 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat122 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat123 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat124 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat125 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat126 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat127 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - mat128 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.03125; } - - } - -} - - - diff --git a/InputFiles/IMC/oldInputs/marshakWave16 b/InputFiles/IMC/oldInputs/marshakWave16 deleted file mode 100644 index 6d4abf262..000000000 --- a/InputFiles/IMC/oldInputs/marshakWave16 +++ /dev/null @@ -1,104 +0,0 @@ -// Marshak wave simulation using 16 equal spatial regions -// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** - -type IMCPhysicsPackage; - -pop 16000; -limit 320000; -steps 1000; -timeStepSize 0.5; -printUpdates 4; - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorTimeHT; cutoff 0.0; - } - -source { - type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; -} - -tally { - } - -geometry { - type geometryStd; - boundary (0 0 1 1 1 1); - graph {type shrunk;} - - surfaces - { - outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } - } - - cells - { - } - universes - { - root { id 100; type rootUniverse; border 1; fill u<200>; } - - lat { id 200; - type latUniverse; - origin (0.0 0.0 0.0); - pitch (0.25 1.0 1.0); - shape (16 1 1); - padMat void; - map ( 1 2 3 4 5 6 7 8 9 10 - 11 12 13 14 15 16); - } - - zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } - zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } - zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } - zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } - zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } - zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } - zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } - zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } - zone9 { id 9; type pinUniverse; radii (0.0); fills (mat9); } - zone10 { id 10; type pinUniverse; radii (0.0); fills (mat10); } - zone11 { id 11; type pinUniverse; radii (0.0); fills (mat11); } - zone12 { id 12; type pinUniverse; radii (0.0); fills (mat12); } - zone13 { id 13; type pinUniverse; radii (0.0); fills (mat13); } - zone14 { id 14; type pinUniverse; radii (0.0); fills (mat14); } - zone15 { id 15; type pinUniverse; radii (0.0); fills (mat15); } - zone16 { id 16; type pinUniverse; radii (0.0); fills (mat16); } - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.25; } - - } - -} - - - diff --git a/InputFiles/IMC/oldInputs/marshakWave32 b/InputFiles/IMC/oldInputs/marshakWave32 deleted file mode 100644 index cfe5c7527..000000000 --- a/InputFiles/IMC/oldInputs/marshakWave32 +++ /dev/null @@ -1,139 +0,0 @@ -// Marshak wave simulation using 32 equal spatial regions -// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** - -type IMCPhysicsPackage; - -pop 5000; -limit 50000; -steps 1000; -timeStepSize 0.5; - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorTimeHT; - } - -source { - type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; -} - -tally { - } - -//grid { dimensions (10 1 1); searchN (100 1 1); } - -geometry { - type geometryStd; - boundary (0 0 1 1 1 1); - graph {type shrunk;} - - surfaces - { - outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } - } - - cells - { - } - universes - { - root { id 100; type rootUniverse; border 1; fill u<200>; } - - lat { id 200; - type latUniverse; - origin (0.0 0.0 0.0); - pitch (0.125 1.0 1.0); - shape (32 1 1); - padMat void; - map ( 1 2 3 4 5 6 7 8 9 10 - 11 12 13 14 15 16 17 18 19 20 - 21 22 23 24 25 26 27 28 29 30 - 31 32); - } - - zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } - zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } - zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } - zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } - zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } - zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } - zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } - zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } - zone9 { id 9; type pinUniverse; radii (0.0); fills (mat9); } - zone10 { id 10; type pinUniverse; radii (0.0); fills (mat10); } - zone11 { id 11; type pinUniverse; radii (0.0); fills (mat11); } - zone12 { id 12; type pinUniverse; radii (0.0); fills (mat12); } - zone13 { id 13; type pinUniverse; radii (0.0); fills (mat13); } - zone14 { id 14; type pinUniverse; radii (0.0); fills (mat14); } - zone15 { id 15; type pinUniverse; radii (0.0); fills (mat15); } - zone16 { id 16; type pinUniverse; radii (0.0); fills (mat16); } - zone17 { id 17; type pinUniverse; radii (0.0); fills (mat17); } - zone18 { id 18; type pinUniverse; radii (0.0); fills (mat18); } - zone19 { id 19; type pinUniverse; radii (0.0); fills (mat19); } - zone20 { id 20; type pinUniverse; radii (0.0); fills (mat20); } - zone21 { id 21; type pinUniverse; radii (0.0); fills (mat21); } - zone22 { id 22; type pinUniverse; radii (0.0); fills (mat22); } - zone23 { id 23; type pinUniverse; radii (0.0); fills (mat23); } - zone24 { id 24; type pinUniverse; radii (0.0); fills (mat24); } - zone25 { id 25; type pinUniverse; radii (0.0); fills (mat25); } - zone26 { id 26; type pinUniverse; radii (0.0); fills (mat26); } - zone27 { id 27; type pinUniverse; radii (0.0); fills (mat27); } - zone28 { id 28; type pinUniverse; radii (0.0); fills (mat28); } - zone29 { id 29; type pinUniverse; radii (0.0); fills (mat29); } - zone30 { id 30; type pinUniverse; radii (0.0); fills (mat30); } - zone31 { id 31; type pinUniverse; radii (0.0); fills (mat31); } - zone32 { id 32; type pinUniverse; radii (0.0); fills (mat32); } - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat17 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat18 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat19 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat20 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat21 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat22 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat23 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat24 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat25 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat26 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat30 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.125; } - - } - -} - - - diff --git a/InputFiles/IMC/oldInputs/marshakWave64 b/InputFiles/IMC/oldInputs/marshakWave64 deleted file mode 100644 index f7f8a66ba..000000000 --- a/InputFiles/IMC/oldInputs/marshakWave64 +++ /dev/null @@ -1,208 +0,0 @@ -// Marshak wave simulation using 64 equal spatial regions -// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** - -type ISMCPhysicsPackage; - -pop 800; -limit 1600; -steps 10000; -timeStepSize 0.05; -printUpdates 8; - -collisionOperator { - photonMG {type ISMCMGstd;} - } - -transportOperator { - type transportOperatorIMC; cutoff 0.9; //majMap { nParticles 5000; lengthScale 0.00625; } - } - -source { - type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; -} - -tally { - } - -geometry { - type geometryStd; - boundary (0 0 1 1 1 1); - graph {type shrunk;} - - surfaces - { - outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } - } - - cells - { - } - universes - { - root { id 100; type rootUniverse; border 1; fill u<200>; } - - lat { id 200; - type latUniverse; - origin (0.0 0.0 0.0); - pitch (0.0625 1.0 1.0); - shape (64 1 1); - padMat void; - map ( 1 2 3 4 5 6 7 8 9 10 - 11 12 13 14 15 16 17 18 19 20 - 21 22 23 24 25 26 27 28 29 30 - 31 32 33 34 35 36 37 38 39 40 - 41 42 43 44 45 46 47 48 49 50 - 51 52 53 54 55 56 57 58 59 60 - 61 62 63 64); - } - - zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } - zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } - zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } - zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } - zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } - zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } - zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } - zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } - zone9 { id 9; type pinUniverse; radii (0.0); fills (mat9); } - zone10 { id 10; type pinUniverse; radii (0.0); fills (mat10); } - zone11 { id 11; type pinUniverse; radii (0.0); fills (mat11); } - zone12 { id 12; type pinUniverse; radii (0.0); fills (mat12); } - zone13 { id 13; type pinUniverse; radii (0.0); fills (mat13); } - zone14 { id 14; type pinUniverse; radii (0.0); fills (mat14); } - zone15 { id 15; type pinUniverse; radii (0.0); fills (mat15); } - zone16 { id 16; type pinUniverse; radii (0.0); fills (mat16); } - zone17 { id 17; type pinUniverse; radii (0.0); fills (mat17); } - zone18 { id 18; type pinUniverse; radii (0.0); fills (mat18); } - zone19 { id 19; type pinUniverse; radii (0.0); fills (mat19); } - zone20 { id 20; type pinUniverse; radii (0.0); fills (mat20); } - zone21 { id 21; type pinUniverse; radii (0.0); fills (mat21); } - zone22 { id 22; type pinUniverse; radii (0.0); fills (mat22); } - zone23 { id 23; type pinUniverse; radii (0.0); fills (mat23); } - zone24 { id 24; type pinUniverse; radii (0.0); fills (mat24); } - zone25 { id 25; type pinUniverse; radii (0.0); fills (mat25); } - zone26 { id 26; type pinUniverse; radii (0.0); fills (mat26); } - zone27 { id 27; type pinUniverse; radii (0.0); fills (mat27); } - zone28 { id 28; type pinUniverse; radii (0.0); fills (mat28); } - zone29 { id 29; type pinUniverse; radii (0.0); fills (mat29); } - zone30 { id 30; type pinUniverse; radii (0.0); fills (mat30); } - zone31 { id 31; type pinUniverse; radii (0.0); fills (mat31); } - zone32 { id 32; type pinUniverse; radii (0.0); fills (mat32); } - - zone33 { id 33; type pinUniverse; radii (0.0); fills (mat33); } - zone34 { id 34; type pinUniverse; radii (0.0); fills (mat34); } - zone35 { id 35; type pinUniverse; radii (0.0); fills (mat35); } - zone36 { id 36; type pinUniverse; radii (0.0); fills (mat36); } - zone37 { id 37; type pinUniverse; radii (0.0); fills (mat37); } - zone38 { id 38; type pinUniverse; radii (0.0); fills (mat38); } - zone39 { id 39; type pinUniverse; radii (0.0); fills (mat39); } - zone40 { id 40; type pinUniverse; radii (0.0); fills (mat40); } - zone41 { id 41; type pinUniverse; radii (0.0); fills (mat41); } - zone42 { id 42; type pinUniverse; radii (0.0); fills (mat42); } - zone43 { id 43; type pinUniverse; radii (0.0); fills (mat43); } - zone44 { id 44; type pinUniverse; radii (0.0); fills (mat44); } - zone45 { id 45; type pinUniverse; radii (0.0); fills (mat45); } - zone46 { id 46; type pinUniverse; radii (0.0); fills (mat46); } - zone47 { id 47; type pinUniverse; radii (0.0); fills (mat47); } - zone48 { id 48; type pinUniverse; radii (0.0); fills (mat48); } - zone49 { id 49; type pinUniverse; radii (0.0); fills (mat49); } - zone50 { id 50; type pinUniverse; radii (0.0); fills (mat50); } - zone51 { id 51; type pinUniverse; radii (0.0); fills (mat51); } - zone52 { id 52; type pinUniverse; radii (0.0); fills (mat52); } - zone53 { id 53; type pinUniverse; radii (0.0); fills (mat53); } - zone54 { id 54; type pinUniverse; radii (0.0); fills (mat54); } - zone55 { id 55; type pinUniverse; radii (0.0); fills (mat55); } - zone56 { id 56; type pinUniverse; radii (0.0); fills (mat56); } - zone57 { id 57; type pinUniverse; radii (0.0); fills (mat57); } - zone58 { id 58; type pinUniverse; radii (0.0); fills (mat58); } - zone59 { id 59; type pinUniverse; radii (0.0); fills (mat59); } - zone60 { id 60; type pinUniverse; radii (0.0); fills (mat60); } - zone61 { id 61; type pinUniverse; radii (0.0); fills (mat61); } - zone62 { id 62; type pinUniverse; radii (0.0); fills (mat62); } - zone63 { id 63; type pinUniverse; radii (0.0); fills (mat63); } - zone64 { id 64; type pinUniverse; radii (0.0); fills (mat64); } - - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat9 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat10 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat11 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat12 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat13 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat14 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat15 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat16 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat17 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat18 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat19 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat20 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat21 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat22 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat23 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat24 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat25 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat26 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat27 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat28 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat29 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat30 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat31 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat32 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - - mat33 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat34 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat35 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat36 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat37 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat38 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat39 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat40 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat41 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat42 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat43 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat44 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat45 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat46 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat47 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat48 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat49 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat50 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat51 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat52 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat53 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat54 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat55 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat56 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat57 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat58 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat59 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat60 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat61 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat62 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat63 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - mat64 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.0625; } - - } - -} - - - diff --git a/InputFiles/IMC/oldInputs/marshakWave8 b/InputFiles/IMC/oldInputs/marshakWave8 deleted file mode 100644 index 76aaf57e1..000000000 --- a/InputFiles/IMC/oldInputs/marshakWave8 +++ /dev/null @@ -1,88 +0,0 @@ -// Marshak wave simulation using 8 equal spatial regions -// *** lightSpeed and radiationConstant must both be changed to ONE in universalVariables *** - -type IMCPhysicsPackage; - -pop 500; -limit 5000; -steps 10000; -timeStepSize 0.05; -printUpdates 8; - -collisionOperator { - photonMG {type IMCMGstd;} - } - -transportOperator { - type transportOperatorTimeHT; - } - -source { - type bbSurfaceSource; r (-2 -2 -0.5 0.5 -0.5 0.5); temp 1; N 1000; -} - -tally { - } - -geometry { - type geometryStd; - boundary (0 0 1 1 1 1); - graph {type shrunk;} - - surfaces - { - outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); } - } - - cells - { - } - universes - { - root { id 100; type rootUniverse; border 1; fill u<200>; } - - lat { id 200; - type latUniverse; - origin (0.0 0.0 0.0); - pitch (0.5 1.0 1.0); - shape (8 1 1); - padMat void; - map ( 1 2 3 4 5 6 7 8); - - } - - zone1 { id 1; type pinUniverse; radii (0.0); fills (mat1); } - zone2 { id 2; type pinUniverse; radii (0.0); fills (mat2); } - zone3 { id 3; type pinUniverse; radii (0.0); fills (mat3); } - zone4 { id 4; type pinUniverse; radii (0.0); fills (mat4); } - zone5 { id 5; type pinUniverse; radii (0.0); fills (mat5); } - zone6 { id 6; type pinUniverse; radii (0.0); fills (mat6); } - zone7 { id 7; type pinUniverse; radii (0.0); fills (mat7); } - zone8 { id 8; type pinUniverse; radii (0.0); fills (mat8); } - } -} - -nuclearData { - - handles { - mg { type baseMgIMCDatabase; } - } - - - materials { - - mat1 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat2 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat3 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat4 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat5 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat6 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat7 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - mat8 { temp 0.01; composition {} xsFile ./dataFiles/imcData; volume 0.5; } - - } - -} - - - diff --git a/InputFiles/IMC/sampleInput b/InputFiles/IMC/sampleInput index 7342876a5..2ffb73035 100644 --- a/InputFiles/IMC/sampleInput +++ b/InputFiles/IMC/sampleInput @@ -1,102 +1,53 @@ -// + // Intended as a sample/tutorial input file for calculations using IMC physics // package, to detail settings that differ to other calculation types -// -// Note that a lot of the input files in this branch require lightSpeed and radiationConstant both -// to be changed to ONE in universalVariables before compiling - -type IMCPhysicsPackage; - -pop 1000; - // Maximum total number of particles to be emitted during each time step from all material. - // This number is split between material regions based on the energy they are emitting and is - // reduced if limit is going to be reached. -limit 10000; - // Sets the maximum size of particle dungeons. Runtime is very dependent on this value so should - // not be set arbitrarily large. +type implicitPhysicsPackage; -steps 50; - // The number of time steps to be used in the calculation +method IMC; // IMC or ISMC +pop 10000; // +limit 25000; // +steps 5000; // Number of timesteps to take +timeStep 0.1; // Timestep for calculation +units marshak; // Units for conversion of timeStep in physicsPackage +printUpdates 2; // Prints first N brief material updates per timestep -timeStepSize 0.1; - // The time step size for the calculation in seconds +// Energy grid for multi-frequency calculations, if not provided then defaults to grey case +energygrid { + grid log; + size 30; + min 0.0001; + max 100; + } -printUpdates 1; - // The number maximum number of material updates to print to screen. If 0, no updates will be - // printed. - -collisionOperator { - photonMG {type IMCMGstd;} - } +collisionOperator { photonMG {type IMCMGstd;} } transportOperator { - type transportOperatorTimeHT; cutoff 0.7; - } - -// No tallies are required for calculation, but empty dictionary must be given -tally { - } + type transportOperatorTime; // Standard transport operator for IMC/ISMC + } +tally {} // Required tallies are defined automatically in physicsPackage -// Geometry is as in all other calculation types. -// Here a simple infinite region is given (a perfectly reflected 1x1x1 cube) +// Black body surface source placed on -x face of geometry bounding box with T = 1 +source { type blackBodySource; distribution surface; surface -x; temp 1; } geometry { - type geometryStd; - boundary (1 1 1 1 1 1); - graph {type shrunk;} - - surfaces { - squareBound { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 0.5 0.5 0.5); } - } + type geometryGrid; // Splits geometry into a uniform grid with the dimensions given below + // Efficient for IMC, see geometryGrid_class.f90 for more detail + dimensions (100 1 1); - cells { - } + boundary (0 0 1 1 1 1); // 0 -> Open boundary, 1 -> Reflective boundary + graph {type shrunk;} - universes { - root { id 1; type rootUniverse; border 1; fill mat; } - } + surfaces { outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2 0.5 0.5); }} + cells {} + universes { root { id 100; type rootUniverse; border 1; fill mat1; }} } nuclearData { + handles { mg { type baseMgIMCDatabase; }} - handles { - mg { type baseMgIMCDatabase; } - } - - // Dictionary containing all materials used in geometry - // If desired to have spatial temperature variation, split geometry (above) into desired cells - // and set each cell fill as a DIFFERENT material (e.g. mat1, mat2, mat3, ...) then define - // all materials here. Even if each each mat input is identical, a unique material object - // will be created allowing for a unique temperature evolution. The same xsFile may be used - // for different materials if desired. - - materials { - - // Example: mat - mat { - - temp 1; - // Initial temperature of material [keV]. - - composition {} - // Empty dictionary required for composition. - - xsFile ./DataFiles/sampleData; - // Location of material data file containing material properties. - - volume 1; - // Total volume that this material occupies [cm3], for now need to calculate by hand - // and enter here. May be room to make this automatic in the future. - - } - - // Example 2: mat2 - //mat2 { temp 1; composition {} xsFile ./DataFiles/sampleData2; volume 1 } - -} - + materials { mat1 { temp 0.01; composition {} xsFile ./DataFiles/sampleData; }} } From 548daaacb8f0e78abec2cb21e40ebb8809c93f74 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Sun, 31 Dec 2023 18:42:34 +0000 Subject: [PATCH 365/373] Redid hybrid tracking bits, needs a few more comments but otherwise working well' --- Geometry/geometryGrid_class.f90 | 68 ++- .../mgIMCData/baseMgIMC/materialEquations.f90 | 5 + ParticleObjects/Source/oldIMCSource.f90 | 345 --------------- .../implicitPhysicsPackage_class.f90 | 3 - TransportOperator/CMakeLists.txt | 4 +- TransportOperator/Grid/trackingGrid_class.f90 | 403 ------------------ .../transportOperatorFactory_func.f90 | 9 +- .../transportOperatorGeomHT_class.f90 | 371 ++++++++++++++++ .../transportOperatorTimeHT_class.f90 | 368 ---------------- TransportOperator/transportOperator_inter.f90 | 6 - TransportOperator/virtualMat_class.f90 | 79 ++++ 11 files changed, 519 insertions(+), 1142 deletions(-) delete mode 100644 ParticleObjects/Source/oldIMCSource.f90 delete mode 100644 TransportOperator/Grid/trackingGrid_class.f90 create mode 100644 TransportOperator/transportOperatorGeomHT_class.f90 delete mode 100644 TransportOperator/transportOperatorTimeHT_class.f90 create mode 100644 TransportOperator/virtualMat_class.f90 diff --git a/Geometry/geometryGrid_class.f90 b/Geometry/geometryGrid_class.f90 index e013e8df7..84e3f2c9e 100644 --- a/Geometry/geometryGrid_class.f90 +++ b/Geometry/geometryGrid_class.f90 @@ -76,6 +76,7 @@ module geometryGrid_class procedure :: matBounds ! Private procedures + procedure, private :: initGridOnly procedure, private :: explicitBC procedure, private :: csg_diveToMat procedure, private :: csg_placeCoord @@ -100,6 +101,7 @@ subroutine init(self, dict, mats, silent) real(defReal), dimension(3) :: r type(dictionary) :: matDict, tempDict real(defReal) :: volume + character(nameLen) :: gridOnly integer(shortInt) :: i, j, k, z, N, matIdx, uniqueID, idxCounter, voidCounter character(100), parameter :: Here = 'init (geometryGrid_class.f90)' @@ -110,6 +112,27 @@ subroutine init(self, dict, mats, silent) loud = .true. end if + ! Get geometry discretisation + call dict % get(self % latSizeN, 'dimensions') + if (size(self % latSizeN) /= 3) call fatalError(Here, 'Dimensions must be of size 3') + + ! Allocate space for material indexes + allocate(self % mats(self % latSizeN(1),self % latSizeN(2),self % latSizeN(3))) + + ! Get boundary conditions + call dict % get(self % boundary, 'boundary') + if (size(self % boundary) /= 6) call fatalError(Here, 'boundary should be an array of size 6') + + ! Determine whether to completely rebuild geometry or to just build a grid + call dict % getOrDefault(gridOnly, 'gridOnly','n') + if (gridOnly == 'y') then + ! Switch to dedicated subroutine + call self % initGridOnly(dict) + return + else if (gridOnly /= 'n') then + call fatalError(Here, 'Unrecognised value for gridOnly setting. Should be y or n.') + end if + ! Build the representation using CSG geometry call self % geom % init(dict, mats, silent) @@ -122,19 +145,12 @@ subroutine init(self, dict, mats, silent) bounds = surf % boundingBox() self % geomBounds = bounds - ! Get geometry discretisation - call dict % get(self % latSizeN, 'dimensions') - if (size(self % latSizeN) /= 3) call fatalError(Here, 'Dimensions must be of size 3') - do i = 1, 3 self % latPitch(i) = (bounds(i+3) - bounds(i)) / self % latSizeN(i) end do self % corner = bounds(1:3) volume = product(self % latPitch) - ! Allocate space for material indexes - allocate(self % mats(self % latSizeN(1),self % latSizeN(2),self % latSizeN(3))) - ! Initialise dictionary of materials for materialMenu_mod initialisation N = product(self % latSizeN) call matDict % init(1) @@ -191,10 +207,6 @@ subroutine init(self, dict, mats, silent) ! Kill material dictionary call matDict % kill() - ! Get boundary conditions - call dict % get(self % boundary, 'boundary') - if (size(self % boundary) /= 6) call fatalError(Here, 'boundary should be an array of size 6') - ! Print finish line if (loud) then print *, "\/\/ FINISHED BUILDING GRID GEOMETRY \/\/" @@ -203,6 +215,40 @@ subroutine init(self, dict, mats, silent) end subroutine init + !! + !! Generate grid geometry without giving any consideration to materials as is done in the full + !! subroutine above. Assigns a unique value to each grid cell so that self % whatIsAt(matIdx) + !! will return useful value. + !! + !! Unlike in full subroutine above, "bounds" is required in input dictionary. + !! + subroutine initGridOnly(self, dict) + class(geometryGrid), intent(inout) :: self + class(dictionary), intent(in) :: dict + real(defReal), dimension(:), allocatable :: bounds + integer(shortInt) :: i, j, k, idxCounter + + ! Get grid bounds and calculate basic properties + call dict % get(bounds, 'bounds') + self % geomBounds = bounds + do i = 1, 3 + self % latPitch(i) = (bounds(i+3) - bounds(i)) / self % latSizeN(i) + end do + self % corner = bounds(1:3) + + ! Assign a unique value to each grid cell + idxCounter = 1 + do k = 1, self % latSizeN(3) + do j = 1, self % latSizeN(2) + do i = 1, self % latSizeN(1) + self % mats(i,j,k) = idxCounter + idxCounter = idxCounter + 1 + end do + end do + end do + + end subroutine initGridOnly + !! !! Return to uninitialised state !! diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index 93b9ec097..b4803b6a5 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -11,6 +11,11 @@ !! -> Evaluate simple equations (e.g. 'marshak' or 'hohlraum') in these functions, !! or can link to new functions (e.g. 'olson1D') !! +!! Virtually all benchmark problems for IMC have a real scattering opactiy of 0, giving only +!! effective absorptions and effective scattering. If desired, incorporating real scattering should +!! be very easy, adding a new equation type in this module and scattering support in material and +!! collision operator. +!! module materialEquations use numPrecision diff --git a/ParticleObjects/Source/oldIMCSource.f90 b/ParticleObjects/Source/oldIMCSource.f90 deleted file mode 100644 index e4e44fb51..000000000 --- a/ParticleObjects/Source/oldIMCSource.f90 +++ /dev/null @@ -1,345 +0,0 @@ -module IMCSource_class - - use numPrecision - use endfConstants - use universalVariables - use genericProcedures, only : fatalError, rotateVector - use dictionary_class, only : dictionary - use RNG_class, only : RNG - - use particle_class, only : particle, particleState, P_PHOTON - use particleDungeon_class, only : particleDungeon - use source_inter, only : source, kill_super => kill - - use geometry_inter, only : geometry - use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast - use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG - use nuclearDatabase_inter, only : nuclearDatabase - use mgIMCDatabase_inter, only : mgIMCDatabase - use materialMenu_mod, only : mm_matName => matName - - implicit none - private - - !! - !! IMC Source for uniform generation of photons within a material - !! - !! Angular distribution is isotropic. - !! - !! Private members: - !! isMG -> is the source multi-group? (default = .true.) - !! bottom -> Bottom corner (x_min, y_min, z_min) - !! top -> Top corner (x_max, y_max, z_max) - !! G -> Group (default = 1) - !! N -> number of particles being generated, used to normalise weight in sampleParticle - !! matIdx -> index of material to be sampled from - !! - !! Interface: - !! source_inter Interface - !! - !! SAMPLE INPUT: - !! imcSource { type IMCSource; } - !! - type, public,extends(source) :: imcSource - private - logical(defBool) :: isMG = .true. - real(defReal), dimension(3) :: bottom = ZERO - real(defReal), dimension(3) :: top = ZERO - real(defReal), dimension(3) :: latPitch = ZERO - integer(shortInt), dimension(:), allocatable :: latSizeN - integer(shortInt) :: G = 0 - integer(shortInt) :: N - integer(shortInt) :: matIdx - real(defReal), dimension(6) :: matBounds = ZERO - contains - procedure :: init - procedure :: append - procedure :: sampleParticle - procedure, private :: samplePosRej - procedure, private :: samplePosLat - procedure, private :: getMatBounds - procedure :: kill - end type imcSource - -contains - - !! - !! Initialise IMC Source - !! - !! See source_inter for details - !! - subroutine init(self, dict, geom) - class(imcSource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - real(defReal), dimension(6) :: bounds - integer(shortInt), dimension(3) :: latSizeN - character(100), parameter :: Here = 'init (imcSource_class.f90)' - - ! Provide geometry info to source - self % geom => geom - - call dict % getOrDefault(self % G, 'G', 1) - - ! Set bounding region - bounds = self % geom % bounds() - self % bottom = bounds(1:3) - self % top = bounds(4:6) - - ! Store lattice dimensions for use in position sampling if using a large lattice - ! sizeN automatically added to dict in IMCPhysicsPackage if needed - if (dict % isPresent('sizeN')) then - call dict % get(self % latSizeN, 'sizeN') - self % latPitch = (self % top - self % bottom) / self % latSizeN - end if - - end subroutine init - - !! - !! Generate N particles from material matIdx to add to a particleDungeon without overriding - !! particles already present. - !! - !! Args: - !! dungeon [inout] -> particle dungeon to be added to - !! n [in] -> number of particles to place in dungeon - !! rand [inout] -> particle RNG object - !! matIdx [in] -> index of material to sample from - !! - !! Result: - !! A dungeon populated with N particles sampled from the source, plus particles - !! already present in dungeon - !! - subroutine append(self, dungeon, N, rand, matIdx, bounds) - class(imcSource), intent(inout) :: self - type(particleDungeon), intent(inout) :: dungeon - integer(shortInt), intent(in) :: N - class(RNG), intent(inout) :: rand - integer(shortInt), intent(in), optional :: matIdx - real(defReal), dimension(6), intent(in), optional :: bounds - integer(shortInt) :: i - type(RNG) :: pRand - character(100), parameter :: Here = "append (IMCSource_class.f90)" - - ! Assert that optional argument matIdx is in fact present - if (.not. present(matIdx)) call fatalError(Here, 'matIdx must be provided for IMC source') - - ! Store inputs for use by sampleParticle subroutine - self % N = N - self % matIdx = matIdx - - ! For a large number of materials (large lattice using discretiseGeom_class) rejection - ! sampling is too slow, so calculate bounding box of material - if (self % latPitch(1) /= 0) then - ! Get material bounds - call self % getMatBounds(matIdx, self % matBounds) - end if - - ! Add N particles to dungeon - !$omp parallel - pRand = rand - !$omp do private(pRand) - do i=1, N - call pRand % stride(i) - call dungeon % detain(self % sampleParticle(pRand)) - end do - !$omp end do - !$omp end parallel - - end subroutine append - - !! - !! Sample particle's phase space co-ordinates - !! - !! See source_inter for details - !! - function sampleParticle(self, rand) result(p) - class(imcSource), intent(inout) :: self - class(RNG), intent(inout) :: rand - type(particleState) :: p - class(nuclearDatabase), pointer :: nucData - class(IMCMaterial), pointer :: mat - real(defReal), dimension(3) :: r, dir - real(defReal) :: mu, phi - integer(shortInt) :: matIdx, uniqueID - character(100), parameter :: Here = 'sampleParticle (imcSource_class.f90)' - - ! Get pointer to appropriate nuclear database - nucData => ndReg_getIMCMG() - if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') - - ! Choose position sampling method - if (self % latPitch(1) == ZERO) then - call self % samplePosRej(r, matIdx, uniqueID, rand) - else - call self % samplePosLat(r, matIdx, uniqueID, rand) - end if - - ! Point to material - mat => IMCMaterial_CptrCast(nucData % getMaterial(matIdx)) - if (.not.associated(mat)) call fatalError(Here, "Nuclear data did not return IMC material.") - - ! Sample direction - chosen uniformly inside unit sphere - mu = 2 * rand % get() - 1 - phi = rand % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) - - ! Assign basic phase-space coordinates - p % matIdx = matIdx - p % uniqueID = uniqueID - p % time = ZERO - p % type = P_PHOTON - p % r = r - p % dir = dir - p % G = self % G - p % isMG = .true. - - ! Set weight - p % wgt = mat % getEmittedRad() / self % N - - end function sampleParticle - - - !! - !! Position is sampled by taking a random point from within geometry bounding box - !! If in correct material, position is accepted - !! - subroutine samplePosRej(self, r, matIdx, uniqueID, rand) - class(imcSource), intent(inout) :: self - real(defReal), dimension(3), intent(out) :: r - integer(shortInt), intent(out) :: matIdx - integer(shortInt), intent(out) :: uniqueID - class(RNG), intent(inout) :: rand - integer(shortInt) :: i - real(defReal), dimension(3) :: rand3 - character(100), parameter :: Here = 'samplePosRej (IMCSource_class.f90)' - - i = 0 - - rejectionLoop : do - - ! Protect against infinite loop - i = i+1 - if (i > 10000) then - call fatalError(Here, '10,000 failed samples in rejection sampling loop') - end if - - ! Sample Position - rand3(1) = rand % get() - rand3(2) = rand % get() - rand3(3) = rand % get() - r = (self % top - self % bottom) * rand3 + self % bottom - - ! Find material under position - call self % geom % whatIsAt(matIdx, uniqueID, r) - - ! Exit if in desired material - if (matIdx == self % matIdx) exit rejectionLoop - - end do rejectionLoop - - end subroutine samplePosRej - - !! - !! Sample position without using a rejection sampling method, by calculating the material bounds. - !! - !! Requires geometry to be a uniform lattice, so currently only called when discretiseGeom_class - !! is used to create inputs. - !! - subroutine samplePosLat(self, r, matIdx, uniqueID, rand) - class(imcSource), intent(inout) :: self - real(defReal), dimension(3), intent(out) :: r - integer(shortInt), intent(out) :: matIdx - integer(shortInt), intent(out) :: uniqueID - class(RNG), intent(inout) :: rand - integer(shortInt) :: i - character(100), parameter :: Here = 'samplePosLat (IMCSource_class.f90)' - - do i=1, 3 - r(i) = self % matBounds(i) + rand % get() * (self % matBounds(i+3) - self % matBounds(i) - SURF_TOL) + SURF_TOL - end do - - call self % geom % whatIsAt(matIdx, uniqueID, r) - - end subroutine samplePosLat - - !! - !! Get location of material in lattice for position sampling - !! - !! Args: - !! matIdx [in] -> matIdx for which to calculate bounds - !! matBounds [out] -> boundary of lattice cell, [xmin,ymin,zmin,xmax,ymax,zmax] - !! - !! TODO: - !! Would be nice to have most of this in a geometry module - !! - subroutine getMatBounds(self, matIdx, matBounds) - class(imcSource), intent(inout) :: self - integer(shortInt), intent(in) :: matIdx - real(defReal), dimension(6), intent(out) :: matBounds - integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: latIdx, i - character(nameLen) :: matName - character(100), parameter :: Here = 'getMatBounds (imcSourceClass.f90)' - - ! Extract lattice position from mat name (e.g. "m106 -> 106") - matName = mm_matName(matIdx) - read (matName(2:), '(I10)') latIdx - - ! Set bounds of lattice cell containing matIdx - ijk = get_ijk(latIdx, self % latSizeN) - do i=1, 3 - matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bottom(i) - matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bottom(i) - end do - - end subroutine getMatBounds - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(imcSource), intent(inout) :: self - - call kill_super(self) - - self % isMG = .true. - self % bottom = ZERO - self % top = ZERO - self % G = 0 - - end subroutine kill - - - !! - !! Generate ijk from localID and shape - !! - !! Args: - !! localID [in] -> Local id of the cell between 1 and product(sizeN) - !! sizeN [in] -> Number of cells in each cardinal direction x, y & z - !! - !! Result: - !! Array ijk which has integer position in each cardinal direction - !! - pure function get_ijk(localID, sizeN) result(ijk) - integer(shortInt), intent(in) :: localID - integer(shortInt), dimension(3), intent(in) :: sizeN - integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: temp, base - - temp = localID - 1 - - base = temp / sizeN(1) - ijk(1) = temp - sizeN(1) * base + 1 - - temp = base - base = temp / sizeN(2) - ijk(2) = temp - sizeN(2) * base + 1 - - ijk(3) = base + 1 - - end function get_ijk - - -end module IMCSource_class diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index 32ca4332d..93dd7e468 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -189,9 +189,6 @@ subroutine steps(self, tally, tallyAtch, N_steps) do i=1,N_steps - ! Update tracking grid if needed by transport operator - if (associated(self % transOp % grid)) call self % transOp % grid % update() - ! Generate particles while staying below dungeon limit (see note in subroutine description) if (self % method == IMC) then diff --git a/TransportOperator/CMakeLists.txt b/TransportOperator/CMakeLists.txt index a35b60f76..da7047c9d 100644 --- a/TransportOperator/CMakeLists.txt +++ b/TransportOperator/CMakeLists.txt @@ -6,5 +6,5 @@ add_sources(./transportOperator_inter.f90 ./transportOperatorST_class.f90 ./transportOperatorHT_class.f90 ./transportOperatorTime_class.f90 - ./transportOperatorTimeHT_class.f90 - ./Grid/trackingGrid_class.f90) + ./transportOperatorGeomHT_class.f90 + ./virtualMat_class.f90) diff --git a/TransportOperator/Grid/trackingGrid_class.f90 b/TransportOperator/Grid/trackingGrid_class.f90 deleted file mode 100644 index 68e54544b..000000000 --- a/TransportOperator/Grid/trackingGrid_class.f90 +++ /dev/null @@ -1,403 +0,0 @@ -module trackingGrid_class - - use numPrecision - use universalVariables, only : SURF_TOL, P_PHOTON_MG - use genericProcedures, only : fatalError, numToChar - use dictionary_class, only : dictionary - use geometry_inter, only : geometry - use dynArray_class, only : dynIntArray - use nuclearDatabase_inter, only : nuclearDatabase - use particle_class, only : particle - - use geometryReg_mod, only : gr_geomPtr => geomPtr - use nuclearDataReg_mod, only : ndReg_get => get - - !! - !! - !! - type, private :: gridCell - integer(shortInt), dimension(:), allocatable :: mats - real(defReal) :: majorant - - end type gridCell - - !! - !! As in latUniverse_class, idx is 1 in bottom X, Y & Z corner. - !! It increases first with X then Y and lastly Z. - !! - !! sizeN -> array [nx, ny, nz], the dimensions of the grid - !! pitch -> array [dx, dy, dz], the discretisation in each direction - !! bounds -> [x_min, y_min, z_min, z_max, y_max, z_max] as in geometry_inter - !! - type, public :: trackingGrid - class(geometry), pointer :: mainGeom => null() - class(nuclearDatabase), pointer :: xsData => null() - integer(shortInt), dimension(:), allocatable :: sizeN - real(defReal), dimension(3) :: pitch = 0 - real(defReal), dimension(6) :: bounds - real(defReal), dimension(3) :: corner - real(defReal), dimension(3) :: a_bar - type(gridCell), dimension(:), allocatable :: gridCells - - contains - procedure :: init - !procedure :: kill - procedure :: getDistance - procedure :: getValue - procedure :: storeMats - procedure :: update - - end type trackingGrid - -contains - - subroutine init(self, dict, geom, xsData) - class(trackingGrid), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), intent(in), pointer, optional :: geom - class(nuclearDatabase), intent(in), pointer, optional :: xsData - integer(shortInt) :: N - integer(shortInt), dimension(:), allocatable :: searchN - - ! Store pointer to main geometry and data -! self % mainGeom => geom -! self % xsData => xsData - self % xsData => ndReg_get(P_PHOTON_MG) ! TODO: not an ideal way to do this but fine temporarily - self % mainGeom => gr_geomPtr(1) - - ! Store settings - call dict % get(self % sizeN, 'dimensions') - call dict % get(searchN, 'searchN') - - ! Get bounds of grid and calculate discretisations - self % bounds = self % mainGeom % bounds() - - self % pitch(1) = (self % bounds(4) - self % bounds(1)) / self % sizeN(1) - self % pitch(2) = (self % bounds(5) - self % bounds(2)) / self % sizeN(2) - self % pitch(3) = (self % bounds(6) - self % bounds(3)) / self % sizeN(3) - - self % corner = [self % bounds(1), self % bounds(2), self % bounds(3)] - self % a_bar = self % pitch * HALF - SURF_TOL - - ! Allocate space for cells - N = self % sizeN(1) * self % sizeN(2) * self % sizeN(3) - allocate(self % gridCells(N)) - - ! Find material idxs present in each cell - call self % storeMats(searchN) - - end subroutine init - - - !! - !! May have issues with non-box geometry root universe surface with reflective boundary - !! - function getDistance(self, r, u) result(dist) - class(trackingGrid), intent(in) :: self - real(defReal), dimension(3), intent(in) :: r - real(defReal), dimension(3), intent(in) :: u - real(defReal) :: dist - real(defReal), dimension(3) :: r_bar, low, high !, point, corner, ratio - character(100), parameter :: Here = 'getDistance (trackingGrid_class.f90)' - - ! Calculate position from grid corner - r_bar = r - self % corner -! if (any(r_bar < -SURF_TOL)) call fatalError(Here, 'Point is outside grid geometry') !TODO only checks bottom for now - - ! Write as a fraction across cell - r_bar = r_bar / self % pitch - r_bar = r_bar - floor(r_bar) - - ! Account for surface tolerance -! low = SURF_TOL / self % pitch -! high = ONE - low -! do i = 1, 3 -! if (r_bar(i) < low(i) .and. u(i) < ZERO) r_bar(i) = ONE -! if (r_bar(i) > high(i) .and. u(i) > ZERO) r_bar(i) = ZERO -! end do - - ! Distance to centre plus distance from centre to required boundary - r_bar = (HALF - r_bar + sign(HALF, u)) * self % pitch - dist = minval(r_bar / u) - - if (dist <= ZERO) call fatalError(Here, 'Distance invalid: '//numToChar(dist)) - - ! Increase by surface tolerance to ensure that boundary conditions are correctly applied - dist = dist + SURF_TOL - - - ! Round each dimension either up or down depending on which boundary will be hit -! do i = 1, 3 -! if (u(i) >= 0) then -! ! Round each dimension either up or down depending on which boundary will be hit -! do i = 1, 3 -! if (u(i) >= 0) then -! corner(i) = ceiling(point(i)) -! else -! corner(i) = floor(point(i)) -! end if -! ! Adjust if starting position was on boundary -! if (abs(corner(i) - point(i)) < SURF_TOL) then -! corner(i) = corner(i) + sign(ONE, u(i)) -! end if -! end do - -! ! Convert back to spatial coordinates - this is now the coordinates of the corner being travelled towards -! corner = corner * self % pitch - -! ! Determine which axis boundary will be hit first -! ratio = (corner - r_bar) / u - -! dist = minval(ratio) - - - end function getDistance - - - !! - !! Returns value of grid cell at position - !! - function getValue(self, r, u) result(val) - class(trackingGrid), intent(in) :: self - real(defReal), dimension(3), intent(in) :: r - real(defReal), dimension(3), intent(in) :: u - real(defReal) :: val - real(defReal), dimension(3) :: r_bar - integer(shortInt), dimension(3) :: corner, ijk - integer(shortInt) :: i, idx - character(100), parameter :: Here = 'getValue (trackingGrid_class.f90)' - - ! Find lattice location in x,y&z - ijk = floor((r - self % corner) / self % pitch) + 1 - - ! Get position wrt middle of the lattice cell -! r_bar = r - self % corner - ijk * self % pitch + HALF * self % pitch - - ! Check if position is within surface tolerance - ! If it is, push it to next cell -! do i = 1, 3 -! if (abs(r_bar(i)) > self % a_bar(i) .and. r_bar(i)*u(i) > ZERO) then - - ! Select increment. Ternary expression -! if (u(i) < ZERO) then -! inc = -1 -! else -! inc = 1 -! end if - -! ijk(i) = ijk(i) + inc - -! end if -! end do - - ! Set localID - if (any(ijk <= 0 .or. ijk > self % sizeN)) then ! Point is outside grid - call fatalError(Here, 'Point is outside grid') - - else - idx = ijk(1) + self % sizeN(1) * (ijk(2)-1 + self % sizeN(2) * (ijk(3)-1)) - - end if - - - -! ! Get grid cell bottom corner -! r_bar = reposition(r, self % bounds) - self % corner -! corner = floor(r_bar) -! do i = 1, 3 -! if (corner(i) == r_bar(i) .and. u(i) < 0) then -! ! Adjust for point starting on cell boundary -! corner(i) = corner(i) - 1 -! end if -! end do -! -! ! Adjust for bottom corner starting at 1 -! corner = corner + 1 -! -! ! Get grid cell idx -! idx = get_idx(corner, self % sizeN) -! if (idx == 0) call fatalError(Here, 'Point is outside grid: '//numToChar(r)) - - val = self % gridCells(idx) % majorant - - if (val < ZERO) call fatalError(Here, 'Invalid majorant: '//numToChar(val)) - - end function getValue - - !! - !! - !! - subroutine storeMats(self, searchN) - class(trackingGrid), intent(inout) :: self - integer(shortInt), dimension(3), intent(in) :: searchN - real(defReal), dimension(3) :: searchRes - integer(shortInt) :: i, j, k, l, matIdx, uniqueID - real(defReal), dimension(3) :: corner, r - type(dynIntArray) :: mats - - ! Calculate distance between search points - searchRes = self % pitch / (searchN + 1) - - ! Loop through grid cells - do i = 1, size(self % gridCells) - - ! Get cell lower corner - corner = self % corner + self % pitch * (get_ijk(i, self % sizeN) - 1) - - ! Loop through search locations - do j = 1, searchN(1) - do k = 1, searchN(2) - do l = 1, searchN(3) - ! Find matIdx at search location - r = corner + [j, k, l] * searchRes - call self % mainGeom % whatIsAt(matIdx, uniqueID, r) - - ! Add to array if not already present - if (mats % isPresent(matIdx)) then - ! Do nothing - else - call mats % add(matIdx) - end if - - end do - end do - end do - - ! Store matIdx data in grid cell - self % gridCells(i) % mats = mats % expose() - call mats % kill() - - end do - - end subroutine storeMats - - !! - !! - !! - subroutine update(self) - class(trackingGrid), intent(inout) :: self - integer(shortInt) :: i - integer(shortInt), save :: j, matIdx - real(defReal), save :: sigmaT - class(particle), allocatable :: p - !$omp threadprivate(j, matIdx) - - allocate(p) - p % G = 1 - - !$omp parallel do - ! Loop through grid cells - do i = 1, size(self % gridCells) - ! Reset majorant - self % gridCells(i) % majorant = ZERO - - do j = 1, size(self % gridCells(i) % mats) - ! Get opacity of each material - matIdx = self % gridCells(i) % mats(j) - if (matIdx /= 0) then - sigmaT = self % xsData % getTransMatXS(p, matIdx) - ! Update majorant if required - if (sigmaT > self % gridCells(i) % majorant) self % gridCells(i) % majorant = sigmaT - end if - - end do - end do - !$omp end parallel do - - end subroutine update - - - - !! - !! Generate ijk from localID and shape - !! - !! Args: - !! localID [in] -> Local id of the cell between 1 and product(sizeN) - !! sizeN [in] -> Number of cells in each cardinal direction x, y & z - !! - !! Result: - !! Array ijk which has integer position in each cardinal direction - !! - pure function get_ijk(localID, sizeN) result(ijk) - integer(shortInt), intent(in) :: localID - integer(shortInt), dimension(3), intent(in) :: sizeN - integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: temp, base - - temp = localID - 1 - - base = temp / sizeN(1) - ijk(1) = temp - sizeN(1) * base + 1 - - temp = base - base = temp / sizeN(2) - ijk(2) = temp - sizeN(2) * base + 1 - - ijk(3) = base + 1 - - end function get_ijk - - - pure function get_idx(ijk, sizeN) result(idx) - integer(shortInt), dimension(3), intent(in) :: ijk - integer(shortInt), dimension(3), intent(in) :: sizeN - integer(shortInt) :: idx - - if (any(ijk <= 0 .or. ijk > sizeN)) then ! Point is outside grid - idx = 0 - else - idx = ijk(1) + sizeN(1) * (ijk(2)-1 + sizeN(2) * (ijk(3)-1)) - end if - - end function get_idx - - !! - !! Adjustment for surface tolerance used by getValue subroutine - !! - function reposition(r, bounds) result(rNew) - real(defReal), dimension(3), intent(in) :: r - real(defReal), dimension(6), intent(in) :: bounds - real(defReal), dimension(3) :: rNew - integer(shortInt) :: i - - rNew = r - - do i = 1, 3 - if (r(i) < bounds(i) .and. r(i) > bounds(i) -SURF_TOL) rNew(i) = bounds(i) - if (r(i) > bounds(i+3) .and. r(i) < bounds(i+3)+SURF_TOL) rNew(i) = bounds(i+3) - end do - - ! TODO Boundaries between cells rather than just edge of grid - - end function reposition - - !! - !! Adjustment for surface tolerance used by getDistance function. - !! Able to be simpler than repositionLoc as only consider position within cell - !! rather than within grid. - !! - !! Args: - !! r [inout] -> position as a fraction of distance across cell, 0 < r(i), < 1 - !! u [in] -> direction - !! pitch [in] -> grid resolution - !! -! subroutine repositionDist(r_bar, u, pitch) -! real(defReal), dimension(3), intent(inout) :: r_bar -! real(defReal), dimension(3), intent(in) :: u -! real(defReal), dimension(3), intent(in) :: pitch -! real(defReal), dimension(3) :: low, high -! integer(shortInt) :: i -! -! ! Calculate cut-offs -! low = SURF_TOL / pitch -! high = ONE - low -! -! ! Change position if needed -! do i = 1, 3 -! if (r_bar(i) < low(i) .and. u(i) < ZERO) r_bar(i) = ONE -! if (r_bar(i) > high(i) .and. u(i) > ZERO) r_bar(i) = ZERO -! end do -! -! end subroutine repositionDist - -end module trackingGrid_class diff --git a/TransportOperator/transportOperatorFactory_func.f90 b/TransportOperator/transportOperatorFactory_func.f90 index cdf212af8..39246436d 100644 --- a/TransportOperator/transportOperatorFactory_func.f90 +++ b/TransportOperator/transportOperatorFactory_func.f90 @@ -13,7 +13,7 @@ module transportOperatorFactory_func use transportOperatorDT_class, only : transportOperatorDT use transportOperatorHT_class, only : transportOperatorHT use transportOperatorTime_class, only : transportOperatorTime - use transportOperatorTimeHT_class, only : transportOperatorTimeHT + use transportOperatorGeomHT_class, only : transportOperatorGeomHT !use transportOperatorDynamicDT_class, only : transportOperatorDynamicDT implicit none @@ -28,7 +28,7 @@ module transportOperatorFactory_func 'transportOperatorDT ', & 'transportOperatorHT ', & 'transportOperatorTime ', & - 'transportOperatorTimeHT']!, & + 'transportOperatorGeomHT']!, & ! 'dynamicTranspOperDT'] public :: new_transportOperator @@ -69,10 +69,11 @@ subroutine new_transportOperator(new, dict) allocate( transportOperatorTime :: new) call new % init(dict) - case('transportOperatorTimeHT') - allocate( transportOperatorTimeHT :: new) + case('transportOperatorGeomHT') + allocate( transportOperatorGeomHT :: new) call new % init(dict) + ! case('dynamicTranspOperDT') ! allocate( transportOperatorDynamicDT :: new) ! call new % init(dict, geom) diff --git a/TransportOperator/transportOperatorGeomHT_class.f90 b/TransportOperator/transportOperatorGeomHT_class.f90 new file mode 100644 index 000000000..0ed3c840d --- /dev/null +++ b/TransportOperator/transportOperatorGeomHT_class.f90 @@ -0,0 +1,371 @@ +!! +!! Hybrid transport operator using two geometries to switch between delta tracking and surface tracking +!! +module transportOperatorGeomHT_class + use numPrecision + use universalVariables + + use genericProcedures, only : fatalError, numToChar + use particle_class, only : particle, P_PHOTON, P_MATERIAL + use particleDungeon_class, only : particleDungeon + use dictionary_class, only : dictionary + use RNG_class, only : RNG + + ! Superclass + use transportOperator_inter, only : transportOperator, init_super => init + + ! Geometry interfaces + use geometry_inter, only : geometry + use geometryGrid_class, only : geometryGrid + use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & + gr_geomIdx => geomIdx + use coord_class, only : coordList + + ! Tally interface + use tallyCodes + use tallyAdmin_class, only : tallyAdmin + + ! Nuclear data interfaces + use nuclearDatabase_inter, only : nuclearDatabase + use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast + use nuclearDataReg_mod, only : ndReg_get => get + + use virtualMat_class, only : virtualMat + use simulationTime_class + + implicit none + private + + !! + !! Transport operator that moves a particle with using hybrid tracking, up to a time boundary + !! + type, public, extends(transportOperator) :: transportOperatorGeomHT + real(defReal) :: deltaT + real(defReal) :: cutoff + integer(shortInt) :: method + class(geometry), pointer :: upperGeom + integer(shortInt) :: upperGeomIdx + integer(shortInt) :: thisTimeStep + class(virtualMat), dimension(:), allocatable :: virtualMats + contains + procedure :: transit => timeTracking + procedure :: init + procedure, private :: surfaceTracking + procedure, private :: deltaTracking + procedure, private :: getMajInv + end type transportOperatorGeomHT + +contains + + subroutine timeTracking(self, p, tally, thisCycle, nextCycle) + class(transportOperatorGeomHT), intent(inout) :: self + class(particle), intent(inout) :: p + type(tallyAdmin), intent(inout) :: tally + class(particleDungeon), intent(inout) :: thisCycle + class(particleDungeon), intent(inout) :: nextCycle + integer(shortInt) :: i + character(100), parameter :: Here = 'timeTracking (transportOperatorGeomHT_class.f90)' + + ! Material transform not included in this class to avoid complicating any further. Can be + ! essentially copied and pasted from transportOperatorTime_class if desired to use ISMC here + if (p % type == P_MATERIAL) call fatalError(Here, 'No support for ISMC in this transOp') + + ! Update majorants if required - this would be better done at the end of time step in PP + ! to avoid check for each particle but I wanted to keep this class self-contained + if (self % thisTimeStep /= thisStep()) then + self % thisTimeStep = thisStep() + do i = 1, size(self % virtualMats) + call self % virtualMats (i) % updateMajorant() + end do + end if + + call self % deltaTracking(p) + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) then + p % fate = LEAK_FATE + p % isDead = .true. + end if + + call tally % reportTrans(p) + + end subroutine timeTracking + + !! + !! Perform delta tracking + !! + !! Note that the method used of dealing with upper geometry cell changes does lead to potential + !! inaccuracy if a particle can change upperGeom cells and then return to the original one in the + !! same move, for example if upperGeom is curved or if there is a reflection. For now this class + !! requires upperGeom to be geometryGrid_class (no curves) and this sort of reflection should + !! never happen for any vaguely sensible geometry/material choices. One could instead explicitly + !! calculate distance to a new upperGeom cell and compare to dColl and dTime, at the cost of + !! efficiency. + !! + subroutine deltaTracking(self, p) + class(transportOperatorGeomHT), intent(inout) :: self + class(particle), intent(inout) :: p + class(coordList), allocatable :: coords + real(defReal) :: dTime, dColl, sigmaT, majorant_inv, dist, ratio + integer(shortInt) :: virtualMatIdx, testMat, uniqueID, event, i + character(100), parameter :: Here = 'deltaTracking (transportOperatorGeomHT_class.f90)' + + ! Get majorant + call self % getMajInv(p, majorant_inv, virtualMatIdx) + + ! Get initial local opacity + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + + DTLoop:do + + ! Switch to surface tracking if delta tracking is unsuitable + ratio = sigmaT*majorant_inv + if (ratio > ONE) call fatalError(Here, 'Local opacity greater than majorant') + if (ratio < self % cutoff .or. majorant_inv == ZERO) then + call self % surfaceTracking(p) + return + end if + + ! Find distance to time boundary + dTime = lightSpeed * (p % timeMax - p % time) + + ! Sample distance to collision + dColl = -log(p % pRNG % get()) * majorant_inv + + ! Move copy of coords by minimum distance without considering surface crossings + coords = p % coords + dist = min(dColl, dTime) + call self % geom % teleport(coords, dist) + + ! Check for particle leakage + if (coords % matIdx == OUTSIDE_FILL) then + p % coords = coords + return + end if + + ! Check for change of upper geometry + call self % upperGeom % whatIsAt(testMat, uniqueID, coords % lvl(1) % r, coords % lvl(1) % dir) + if (testMat /= virtualMatIdx) then + ! Move would take particle to a new cell + call self % upperGeom % move(p % coords, dist, event) + ! Get new majorant (particle already placed in upper geometry) + virtualMatIdx = p % matIdx() + majorant_inv = self % virtualMats(virtualMatIdx) % majorant_inv + !call self % getMajInv(p, majorant_inv, virtualMatIdx) + ! Update particle time and place back in lower geometry + p % time = p % time + dist / lightSpeed + call self % geom % placeCoord(p % coords) + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + ! Return to start of loop + cycle DTLoop + end if + + ! Move accepted, move p + p % coords = coords + + ! Update particle time + p % time = p % time + dist / lightSpeed + + ! Act based on distance moved + if (dist == dTime) then + ! Update particle fate and exit + p % fate = AGED_FATE + p % time = p % timeMax + exit DTLoop + + else if (dist == dColl) then! Dist == dColl + ! Get local opacity and check for real or virtual collision + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + if (p % pRNG % get() < sigmaT * majorant_inv) exit DTLoop + + else + call fatalError(Here, 'aaa') + + end if + + end do DTLoop + + end subroutine deltaTracking + + !! + !! Perform standard surface tracking using only the lower geometry. + !! Once in this loop, delta tracking is not used again. + !! + subroutine surfaceTracking(self, p) + class(transportOperatorGeomHT), intent(inout) :: self + class(particle), intent(inout) :: p + real(defReal) :: dTime, dColl, dist, sigmaT + integer(shortInt) :: event + character(100), parameter :: Here = 'surfaceTracking (transportOperatorGeomHT_class.f90)' + + STLoop:do + + ! Find distance to time boundary + dTime = lightSpeed * (p % timeMax - p % time) + + ! Sample distance to collision + sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) + dColl = -log( p % pRNG % get() ) / sigmaT + + ! Ensure particle does not remain exactly on a boundary if dColl is close to 0 + if (event == CROSS_EV .and. dColl < SURF_TOL) then + dColl = SURF_TOL + end if + + ! Choose minimum distance + dist = min(dTime, dColl) + + ! Move through geometry using minimum distance + call self % geom % move(p % coords, dist, event) + + ! Check for particle leakage + if (p % matIdx() == OUTSIDE_FILL) return + + ! Increase time based on distance moved + p % time = p % time + dist / lightSpeed + + ! Check result of transport + if (dist == dTime) then + ! Time boundary + p % fate = AGED_FATE + p % time = p % timeMax + exit STLoop + + else if (dist == dColl) then + ! Collision + exit STLoop + + end if + + if (event == COLL_EV) call fatalError(Here, 'Move outcome should be CROSS_EV or BOUNDARY_EV') + + end do STLoop + + if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV') + + end subroutine surfaceTracking + + + !! + !! Return the inverse majorant opacity + !! For DT or HT this will be constant, for GT this will be dependent on position + !! + !! Args: + !! p [in] -> particle + !! + !! Result: + !! maj_inv -> 1 / majorant opacity + !! + subroutine getMajInv(self, p, majorant_inv, virtualMatIdx) + class(transportOperatorGeomHT), intent(in) :: self + class(particle), intent(in) :: p + real(defReal), intent(out) :: majorant_inv + integer(shortInt), intent(out) :: virtualMatIdx + real(defReal), dimension(3) :: r, dir + integer(shortInt) :: uniqueID + + ! Get index of virtual material + r = p % coords % lvl(1) % r + dir = p % coords % lvl(1) % dir + call self % upperGeom % whatIsAt(virtualMatIdx, uniqueID, r, dir) + + ! Get 1/majorant + majorant_inv = self % virtualMats(virtualMatIdx) % majorant_inv + + end subroutine getMajInv + + !! + !! Provide transport operator with delta tracking/surface tracking cutoff + !! + !! Cutoff of 1 gives exclusively delta tracking, cutoff of 0 gives exclusively surface tracking + !! + subroutine init(self, dict) + class(transportOperatorGeomHT), intent(inout) :: self + class(dictionary), intent(in) :: dict + character(nameLen) :: geomName + class(dictionary),pointer :: tempdict + class(geometry), pointer :: upperGeom + integer(shortInt), dimension(:), allocatable :: dimensions, searchN + integer(shortInt), dimension(3) :: searchN3 + integer(shortInt) :: N, i, j, k + integer(shortInt) :: realMatIdx, virtualMatIdx, uniqueID + real(defReal), dimension(6) :: bounds + real(defReal), dimension(3) :: corner, extent, searchRes, r + character(100), parameter :: Here = "init (transportOperatorGeomHT_class.f90)" + + ! Initialise superclass + call init_super(self, dict) + + ! Get cutoff value + call dict % getOrDefault(self % cutoff, 'cutoff', 0.3_defReal) + ! Flip to be consistent with transportOperatorHT_class + self % cutoff = ONE - self % cutoff + + ! Build upper level geometry + geomName = 'surfaceGeom' + tempDict => dict % getDictPtr('geometry') + call gr_addGeom(geomName, tempDict) + self % upperGeomIdx = gr_geomIdx(geomName) + upperGeom => gr_geomPtr(self % upperGeomIdx) + self % upperGeom => upperGeom + + ! Provide access to lower (standard) geometry + ! TODO: This assumes that there is only 1 other defined geometry + self % geom => gr_geomPtr(1) + self % xsData => ndReg_get(P_PHOTON_MG) + + ! For now limited to grid geometry + select type(upperGeom) + class is(geometryGrid) + ! Get some basic geometry info + corner = upperGeom % corner + class default + call fatalError(Here, 'Geometry class should be geometryGrid') + end select + + ! Initialise a virtual material object for each cell + call tempDict % get(dimensions,'dimensions') + N = dimensions(1) * dimensions(2) * dimensions(3) + allocate(self % virtualMats(N)) + do i = 1, N + call self % virtualMats(i) % init(self % xsData) + end do + + ! Get resolution to search through grid + call dict % get(searchN, 'searchN') + if (size(searchN) == 3) then + searchN3 = searchN + else if (size(searchN) == 1) then + do i = 1, 3 + searchN3(i) = searchN(1) + end do + else + call fatalError(Here, 'searchN must be of size 1 or 3') + end if + if (any(searchN3 < 1)) call fatalError(Here, 'Invalid searchN') + + ! Search grid to assign real materials to virtual materials + bounds = upperGeom % bounds() + do i = 1, 3 + extent(i) = bounds(i+3) - bounds(i) + end do + searchRes = extent / (searchN3 + 1) + do i = 1, searchN3(1) + do j = 1, searchN3(2) + do k = 1, searchN3(3) + ! Find matIdx at search location + r = corner + [i, j, k] * searchRes + call self % geom % whatIsAt(realMatIdx, uniqueID, r) + call upperGeom % whatIsAt(virtualMatIdx, uniqueID, r) + call self % virtualMats(virtualMatIdx) % addRealMat(realMatIdx) + end do + end do + end do + + do i = 1, size(self % virtualMats) + call self % virtualMats (i) % updateMajorant() + end do + + end subroutine init + +end module transportOperatorGeomHT_class diff --git a/TransportOperator/transportOperatorTimeHT_class.f90 b/TransportOperator/transportOperatorTimeHT_class.f90 deleted file mode 100644 index 07889fd57..000000000 --- a/TransportOperator/transportOperatorTimeHT_class.f90 +++ /dev/null @@ -1,368 +0,0 @@ -!! -!! Transport operator for time-dependent problems using a hybrid of delta tracking and surface tracking -!! -module transportOperatorTimeHT_class - use numPrecision - use universalVariables - - use genericProcedures, only : fatalError, numToChar - use particle_class, only : particle, P_PHOTON, P_MATERIAL - use particleDungeon_class, only : particleDungeon - use dictionary_class, only : dictionary - use rng_class, only : rng - - ! Superclass - use transportOperator_inter, only : transportOperator, init_super => init - - ! Geometry interfaces - use geometry_inter, only : geometry - - ! Tally interface - use tallyCodes - use tallyAdmin_class, only : tallyAdmin - - ! Nuclear data interfaces - use nuclearDatabase_inter, only : nuclearDatabase - use mgIMCDatabase_inter, only : mgIMCDatabase, mgIMCDatabase_CptrCast - - implicit none - private - - !! - !! Tracking method - !! - integer(shortInt), parameter :: HT = 1 ! Hybrid tracking - integer(shortInt), parameter :: GT = 2 ! Grid tracking - integer(shortInt), parameter :: ST = 3 ! Surface tracking - integer(shortInt), parameter :: DT = 4 ! Delta tracking - - !! - !! Transport operator that moves a particle using hybrid tracking, up to a time boundary - !! - type, public, extends(transportOperator) :: transportOperatorTimeHT - real(defReal) :: cutoff - integer(shortInt) :: method - contains - procedure :: transit => timeTracking - procedure :: init - procedure, private :: surfaceTracking - procedure, private :: deltaTracking - procedure, private :: getMajInv - procedure, private :: materialTransform - end type transportOperatorTimeHT - -contains - - subroutine timeTracking(self, p, tally, thisCycle, nextCycle) - class(transportOperatorTimeHT), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - class(particleDungeon), intent(inout) :: thisCycle - class(particleDungeon), intent(inout) :: nextCycle - character(100), parameter :: Here = 'timeTracking (transportOperatorTimeHT_class.f90)' - - ! Transform material particles into photons - if (p % type == P_MATERIAL) then - call self % materialTransform(p, tally) - ! Exit at time boundary - if (p % fate == AGED_FATE) return - end if - - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) then - ! TODO: Figure out why this sometimes happens - print *, 'WARNING: Leak before transport?' - p % fate = LEAK_FATE - p % isDead = .true. - return - end if - - ! Select action based on specified method - HT and GT start with DT but can switch to ST - if (self % method == ST) then - call self % surfaceTracking(p) - else - call self % deltaTracking(p) - end if - - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) then - p % fate = LEAK_FATE - p % isDead = .true. - end if - - call tally % reportTrans(p) - - end subroutine timeTracking - - !! - !! Perform surface tracking - !! - subroutine surfaceTracking(self, p) - class(transportOperatorTimeHT), intent(inout) :: self - class(particle), intent(inout) :: p - real(defReal) :: dTime, dColl, dist, sigmaT - integer(shortInt) :: event - character(100), parameter :: Here = 'surfaceTracking (transportOperatorTimeHT_class.f90)' - - STLoop:do - - ! Find distance to time boundary - dTime = lightSpeed * (p % timeMax - p % time) - - ! Sample distance to collision - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - dColl = -log( p % pRNG % get() ) / sigmaT - - ! Ensure particle does not remain exactly on a boundary if dColl is close to 0 - if (event == CROSS_EV .and. dColl < SURF_TOL) then - dColl = SURF_TOL - end if - - ! Choose minimum distance - dist = min(dTime, dColl) - - ! Move through geometry using minimum distance - call self % geom % move(p % coords, dist, event) - - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) return - - ! Increase time based on distance moved - p % time = p % time + dist / lightSpeed - - ! Check result of transport - if (dist == dTime) then - ! Time boundary - p % fate = AGED_FATE - p % time = p % timeMax - exit STLoop - - else if (dist == dColl) then - ! Collision - exit STLoop - - end if - - if (event == COLL_EV) call fatalError(Here, 'Move outcome should be CROSS_EV or BOUNDARY_EV') - - end do STLoop - - if (event /= COLL_EV) call fatalError(Here, 'Move outcome should be COLL_EV') - - end subroutine surfaceTracking - - !! - !! Perform delta tracking - option to switch to surface tracking for HT and GT methods - !! - subroutine deltaTracking(self, p) - class(transportOperatorTimeHT), intent(inout) :: self - class(particle), intent(inout) :: p - real(defReal) :: dTime, dColl, dGrid, sigmaT, majorant_inv, dist - character(100), parameter :: Here = 'deltaTracking (transportOperatorTimeHT_class.f90)' - - ! Get majorant and grid crossing distance if required - majorant_inv = self % getMajInv(p) - - ! Get initial opacity - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - - ! Check if surface tracking is needed, avoiding unnecessary grid calculations - if (sigmaT * majorant_inv < ONE - self % cutoff) then - call self % surfaceTracking(p) - return - end if - - ! Calculate initial distance to grid - if (self % method == GT) then - dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) - else - dGrid = INF - end if - - DTLoop:do - - ! Find distance to time boundary - dTime = lightSpeed * (p % timeMax - p % time) - - ! Sample distance to collision - dColl = -log( p % pRNG % get() ) * majorant_inv - - ! Select particle by minimum distance - dist = min(dColl, dTime, dGrid) - call self % geom % teleport(p % coords, dist) - p % time = p % time + dist / lightSpeed - - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) return - - ! Act based on distance moved - if (dist == dGrid) then - ! Update values and cycle loop - majorant_inv = self % getMajInv(p) - dGrid = self % grid % getDistance(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - cycle DTLoop - - else if (dist == dTime) then - ! Update particle fate and exit - p % fate = AGED_FATE - p % time = p % timeMax - exit DTLoop - - else ! Dist == dColl - ! Check for real or virtual collision - sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) - if (p % pRNG % get() < sigmaT * majorant_inv) exit DTLoop - ! Update grid distance - dGrid = dGrid - dColl - - end if - - ! Switch to surface tracking if needed - if (sigmaT * majorant_inv < ONE - self % cutoff) then - call self % surfaceTracking(p) - return - end if - - - end do DTLoop - - end subroutine deltaTracking - - !! - !! Return the inverse majorant opacity - !! For DT or HT this will be constant, for GT this will be dependent on position - !! - !! Args: - !! p [in] -> particle - !! - !! Result: - !! maj_inv -> 1 / majorant opacity - !! - function getMajInv(self, p) result (maj_inv) - class(transportOperatorTimeHT), intent(in) :: self - class(particle), intent(in) :: p - real(defReal) :: maj_inv - - if (self % method == GT) then - maj_inv = ONE / self % grid % getValue(p % coords % lvl(1) % r, p % coords % lvl(1) % dir) - else - maj_inv = ONE / self % xsData % getMajorantXS(p) - end if - - end function getMajInv - - !! - !! Determine when a material particle will transform into a photon for ISMC calculations - !! - !! Args: - !! p [inout] -> material particle to be transformed - !! tally [inout] -> tally to keep track of material particles surviving time step - !! - subroutine materialTransform(self, p, tally) - class(transportOperatorTimeHT), intent(inout) :: self - class(particle), intent(inout) :: p - type(tallyAdmin), intent(inout) :: tally - real(defReal) :: transformTime, mu, phi - real(defReal), dimension(3) :: dir - class(mgIMCDatabase), pointer :: nucData - integer(shortInt) :: matIdx, uniqueID - character(100), parameter :: Here = 'materialTransform (transportOperatorIMC_class.f90)' - - ! Get pointer to nuclear database - nucData => mgIMCDatabase_CptrCast(self % xsData) - if (.not. associated(nucData)) call fatalError(Here, 'Unable to find mgIMCDatabase') - - ! Material particles can occasionally have coords placed in void if within SURF_TOL of boundary - matIdx = p % matIdx() - ! If so, get matIdx based on exact position (no adjustment for surface tol) - ! NOTE: Doing this for all particles (not just those placed in void) may in theory give very - ! slight accuracy increase for particles near material-material boundaries as well, but should - ! be negligible and will increase runtimes by calling whatIsAt for every mat particle. - if (matIdx == VOID_MAT .or. matIdx == OUTSIDE_MAT) then - call self % geom % whatIsAt(matIdx, uniqueID, p % coords % lvl(1) % r, [ZERO,ZERO,ZERO]) - end if - ! If still in invalid region, call fatalError - if (matIdx == 0) call fatalError(Here, 'Outside material particle') - if (matIdx == VOID_MAT) call fatalError(Here, 'Void material particle') - - ! Sample time until emission - transformTime = nucData % sampleTransformTime(matIdx, p % pRNG) - p % time = min(p % timeMax, p % time + transformTime) - - ! Exit loop if particle remains material until end of time step - if (p % time == p % timeMax) then - p % fate = AGED_FATE - ! Tally energy for next temperature calculation - call tally % reportHist(p) - - ! Transform into photon - else - p % type = P_PHOTON - ! Resample direction - mu = 2 * p % pRNG % get() - 1 - phi = p % pRNG % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) - call p % point(dir) - ! Resample energy - p % G = nucData % sampleEnergyGroup(matIdx, p % pRNG) - end if - - end subroutine materialTransform - - !! - !! Provide transport operator with delta tracking/surface tracking cutoff - !! - !! Cutoff of 1 gives exclusively delta tracking, cutoff of 0 gives exclusively surface tracking - !! - subroutine init(self, dict) - class(transportOperatorTimeHT), intent(inout) :: self - class(dictionary), intent(in) :: dict - character(nameLen) :: method - class(dictionary),pointer :: tempdict - character(100), parameter :: Here = "init (transportOperatorTimeHT_class.f90)" - - ! Initialise superclass - call init_super(self, dict) - - ! Get tracking method - call dict % getOrDefault(method, 'method', 'ST') - - select case (method) - - ! Hybrid tracking - case ('HT') - self % method = HT - ! Get cutoff value - call dict % get(self % cutoff, 'cutoff') - - ! Grid tracking - case ('GT') - self % method = GT - ! Get cutoff value - call dict % get(self % cutoff, 'cutoff') - - ! Initialise grid for hybrid tracking - tempDict => dict % getDictPtr('grid') - allocate(self % grid) - call self % grid % init(tempDict) - - ! Surface tracking - case ('ST') - self % method = ST - - ! Delta tracking - case ('DT') - self % method = DT - self % cutoff = ONE - - case default - call fatalError(Here, 'Invalid tracking method given. Must be HT, ST or DT.') - - end select - - end subroutine init - -end module transportOperatorTimeHT_class diff --git a/TransportOperator/transportOperator_inter.f90 b/TransportOperator/transportOperator_inter.f90 index ed55f81e1..aaeba6226 100644 --- a/TransportOperator/transportOperator_inter.f90 +++ b/TransportOperator/transportOperator_inter.f90 @@ -20,10 +20,6 @@ module transportOperator_inter use nuclearDataReg_mod, only : ndReg_get => get use nuclearDatabase_inter, only : nuclearDatabase - ! Geometry interfaces - use trackingGrid_class, only : trackingGrid - - implicit none private @@ -51,8 +47,6 @@ module transportOperator_inter !! Geometry pointer -> public so it can be used by subclasses (protected member) class(geometry), pointer :: geom => null() - class(trackingGrid), pointer :: grid => null() - contains ! Public interface procedure, non_overridable :: transport diff --git a/TransportOperator/virtualMat_class.f90 b/TransportOperator/virtualMat_class.f90 new file mode 100644 index 000000000..fb612aa04 --- /dev/null +++ b/TransportOperator/virtualMat_class.f90 @@ -0,0 +1,79 @@ + +module virtualMat_class + + use numPrecision + use universalVariables + + use genericProcedures, only : fatalError, numToChar + + use dynArray_class, only : dynIntArray + + use nuclearDatabase_inter, only : nuclearDatabase + + use particle_class, only : particle, P_PHOTON, P_MATERIAL + + implicit None + private + + !! + !! + !! + type, public :: virtualMat + type(dynIntArray) :: realMats + real(defReal) :: majorant_inv + class(nuclearDatabase), pointer :: xsData + contains + procedure :: init + procedure :: addRealMat + procedure :: updateMajorant + end type virtualMat + +contains + + subroutine init(self, nucData) + class(virtualMat), intent(inout) :: self + class(nuclearDatabase), pointer, intent(in) :: nucData + + self % xsData => nucData + + end subroutine + + + subroutine addRealMat(self, matIdx) + class(virtualMat), intent(inout) :: self + integer(shortInt), intent(in) :: matIdx + + ! Add matIdx to array if not already present + if (.not. self % realMats % isPresent(matIdx)) then + call self % realMats % add(matIdx) + end if + + end subroutine addRealMat + + + subroutine updateMajorant(self) + class(virtualMat), intent(inout) :: self + integer(shortInt) :: i + real(defReal) :: majorant, sigma + class(particle), allocatable :: p + character(100), parameter :: Here = '' + + allocate(p) + !p % type = P_PHOTON + !p % isMG = .true. + ! TODO: Loop through groups when doing MG simulations + p % G = 1 + + majorant = ZERO + + ! Find majorant opacity of virtual material + do i = 1, self % realMats % getSize() + sigma = self % xsData % getTransMatXS(p, self % realMats % get(i)) + if (sigma > majorant) majorant = sigma + end do + + self % majorant_inv = ONE/majorant + + end subroutine updateMajorant + +end module virtualMat_class From 946a2fc1056a20f60f842a49b76a901b852e8ec8 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Mon, 1 Jan 2024 18:57:21 +0000 Subject: [PATCH 366/373] Finally got olson benchmark working, deleted particle combination attempts from dungeon_class --- InputFiles/IMC/DataFiles/olsonData | 6 + InputFiles/IMC/olson1D | 70 ++++++ .../mgIMCData/baseMgIMC/materialEquations.f90 | 2 +- .../Source/blackBodySource_class.f90 | 69 +++--- ParticleObjects/particleDungeon_class.f90 | 210 +----------------- 5 files changed, 125 insertions(+), 232 deletions(-) create mode 100644 InputFiles/IMC/DataFiles/olsonData create mode 100644 InputFiles/IMC/olson1D diff --git a/InputFiles/IMC/DataFiles/olsonData b/InputFiles/IMC/DataFiles/olsonData new file mode 100644 index 000000000..21268ce3c --- /dev/null +++ b/InputFiles/IMC/DataFiles/olsonData @@ -0,0 +1,6 @@ +// Data for 1D Olson benchamrk problem +// + +equations olson1D; + + diff --git a/InputFiles/IMC/olson1D b/InputFiles/IMC/olson1D new file mode 100644 index 000000000..f4168614e --- /dev/null +++ b/InputFiles/IMC/olson1D @@ -0,0 +1,70 @@ + +type implicitPhysicsPackage; + +method IMC; +pop 5000; +limit 1000000; +steps 1333; +timeStep 0.0001; +units ns; +printUpdates 5; + + +energyGrid { + grid unstruct; + bins (17.8 10.0 5.62 3.16 1.78 1.0 0.562 0.316 + 0.178 0.1 0.0562 0.0316 0.0178 0.01 + 0.00562 0.00316 0.00178 0.001 0.0001); + } + +collisionOperator { + photonMG {type IMCMGstd;} + } + +transportOperator { + type transportOperatorTime; + } + +source { type blackBodySource; distribution olson1D; temp 0.5; untilStep 667; } + + +tally { + } + +geometry { + type geometryGrid; + dimensions (100 1 1); + boundary (1 1 1 1 1 1); + graph {type shrunk;} + + surfaces + { + outer { id 1; type box; origin ( 0.0 0.0 0.0); halfwidth ( 2.4 0.5 0.5); } + } + + cells {} + + universes + { + root { id 100; type rootUniverse; border 1; fill mat1; } + } + +} + +nuclearData { + + handles { + mg { type baseMgIMCDatabase; } + } + + + materials { + + mat1 { temp 0.01; composition {} xsFile ./dataFiles/olsonData; } + + } + +} + + + diff --git a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 index b4803b6a5..eb8f4fb32 100644 --- a/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/materialEquations.f90 @@ -145,7 +145,7 @@ function cvOlson1D(T) result(cv) alpha = 0.5*exp(-0.1/T)*(root-1) dAlphadT = 0.1*(alpha-1/root)/(T*T) - cv = 0.1*(1+alpha+(T+0.1)*dAlphadT) + cv = radiationConstant*0.1*(1+alpha+(T+0.1)*dAlphadT) ! Deal with numerical errors from poorly defined regions (e.g. T almost 0) if (cv /= cv .or. cv > INF) cv = ZERO diff --git a/ParticleObjects/Source/blackBodySource_class.f90 b/ParticleObjects/Source/blackBodySource_class.f90 index 181998b1e..db7ef96c2 100644 --- a/ParticleObjects/Source/blackBodySource_class.f90 +++ b/ParticleObjects/Source/blackBodySource_class.f90 @@ -19,10 +19,12 @@ module blackBodySource_class ! Options for source distribution integer(shortInt), parameter, public :: SURFACE = 1 - integer(shortInt), parameter, public :: OLSON1D = 2 + integer(shortInt), parameter, public :: UNIFORM = 2 + integer(shortInt), parameter, public :: OLSON1D = 3 !! - !! Generates a source representing a black body surface + !! Generates a source representing a black body + !! Standard is a surface distribution but can be configured for custom distributions !! !! Private members: !! r -> bottom corner of source @@ -50,6 +52,13 @@ module blackBodySource_class !! temp 1; -> temperature of the black body source !! } !! + !! Current source distributions: + !! surface -> black body surface source placed on the surface indicated + !! uniform -> uniform in space, isotropic + !! olson1D -> 1D multifrequency benchmark source from "Stretched and Filtered Multigroup Pn + !! Transport for Improved Positivity and Accuracy", Olson, Gordon Lee, 2020 + !! See materialEquations.f90 for sigma and cv equations for this benchmark. + !! type, public,extends(configSource) :: blackBodySource private @@ -58,9 +67,7 @@ module blackBodySource_class real(defReal), dimension(3) :: dr = ZERO ! Spatial extent from corner integer(shortInt), dimension(3,3) :: rotation = ZERO ! Direction rotation matrix ! Other settings - integer(shortInt) :: distribution = SURFACE ! Standard is a black body surface, - ! but can define new custom sources - !if needed + integer(shortInt) :: distribution = SURFACE integer(shortInt) :: particleType = P_PHOTON logical(defBool) :: isMG = .true. real(defReal) :: T = ZERO ! Source temperature @@ -158,14 +165,14 @@ subroutine samplePosition(self, p, rand) select case(self % distribution) - case(SURFACE) + case(SURFACE, UNIFORM) ! Set new x, y and z coords do i = 1, 3 r(i) = self % r(i) + rand % get()*self % dr(i) end do case(OLSON1D) - ! Q(x) proportional to exp(-693x**3) + ! Q(x) proportional to exp(-693x**3) (integral from 0 to 4.8 = 0.100909) rejection:do x = rand % get() * 4.8 if (rand % get() < exp(-693*x**3)/0.100909) exit @@ -210,7 +217,7 @@ subroutine sampleEnergyAngle(self, p, rand) return end if - ! If not isotropic, sample first with a primary direction of +x + ! If not isotropic (e.g. surface distribution), sample first with a primary direction of +x phi = TWO_PI * rand % get() mu = sqrt(rand % get()) dir = [mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] @@ -263,7 +270,6 @@ subroutine sampleWeight(self, p, rand) class(blackBodySource), intent(inout) :: self class(particleState), intent(inout) :: p class(RNG), intent(inout) :: rand - real(defReal) :: intensity p % wgt = self % particleWeight @@ -296,8 +302,7 @@ subroutine init(self, dict, geom) class(blackBodySource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom - real(defReal), dimension(:), allocatable :: temp - integer(shortInt) :: i, j, nGroups, dir + integer(shortInt) :: i, j, nGroups real(defReal) :: nu, eStep type(energyGrid) :: eGrid logical(defBool) :: err @@ -355,7 +360,7 @@ end subroutine init !! !! Initialise source for standard black body surface by placing source as one side of - !! bounding bos of geometry + !! bounding box of geometry !! !! Input dict should contain 'surface', corresponding to which side of the box is the source !! e.g. surface -x; => source placed on negative x side of bounding box @@ -440,26 +445,40 @@ end subroutine initSurface !! procedures if needed. !! subroutine initCustom(self, dict) - class(blackBodySource), intent(inout) :: self - class(dictionary), intent(in) :: dict - real(defReal), dimension(6) :: bounds - character(nameLen) :: name + class(blackBodySource), intent(inout) :: self + class(dictionary), intent(in) :: dict + character(nameLen) :: name + integer(shortInt) :: i + real(defReal), dimension(6) :: bounds character(100), parameter :: Here = 'initCustom (blackBodySource_class.f90)' call dict % get(name, 'distribution') select case(name) + case('uniform') + self % distribution = UNIFORM + bounds = self % geom % bounds() + ! Bottom left corner + self % r = bounds(1:3) + ! Dimensions of bounding box + do i = 1, 3 + self % dr(i) = bounds(i+3) - bounds(i) + end do + ! Isotropic direction sampling + self % rotation = ZERO + call dict % get(self % sourceWeight, 'sourceWeight') + case('olson1D') + ! See self % samplePosition for position sampling specifics for Olson1D self % distribution = OLSON1D ! Isotropic directional sampling self % rotation = ZERO ! Set source weight - !self % sourceWeight = timeStep() * 0.100909 * 15 / (pi**4 * 0.5 * (exp(ONE) - ONE)) - self % sourceWeight = timeStep() * 0.100909 * 15 / (pi**4 * 0.5 * (exp(ONE) - ONE)) + self % sourceWeight = radiationConstant * lightSpeed * timeStep() * self % T**4 * 0.100909 case default - call fatalError(Here, 'Unrecognised name for custom black body source') + call fatalError(Here, 'Unrecognised distribution for custom black body source') end select @@ -475,12 +494,12 @@ elemental subroutine kill(self) call kill_super(self) ! Kill local components - self % r = ZERO - self % dr = ZERO - self % distribution = SURFACE - self % particleType = P_PHOTON - self % isMG = .true. - self % T = ZERO + self % r = ZERO + self % dr = ZERO + self % distribution = SURFACE + self % particleType = P_PHOTON + self % isMG = .true. + self % T = ZERO self % particleWeight = ZERO end subroutine kill diff --git a/ParticleObjects/particleDungeon_class.f90 b/ParticleObjects/particleDungeon_class.f90 index 0ec6de7a1..c9a2e646a 100644 --- a/ParticleObjects/particleDungeon_class.f90 +++ b/ParticleObjects/particleDungeon_class.f90 @@ -7,11 +7,6 @@ module particleDungeon_class use geometry_inter, only : geometry use universalVariables, only : INF - ! TODO ADDED FOR REDUCESIZE SUBROUTINE, CONSIDER CHANGING/REMOVING LATER - use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG - use mgIMCDatabase_inter, only : mgIMCDatabase - use materialMenu_mod, only : mm_nMat => nMat - implicit none private @@ -58,8 +53,6 @@ module particleDungeon_class !! normWeight(totWgt) -> normalise dungeon population so its total weight is totWgt !! normSize(N) -> normalise dungeon population so it contains N particles !! does not take nonuniform weight of particles into account - !! reduceSize(N,arr) -> reduce size of dungeon by combining particles such that a max of - !! N particles are present in each material !! combine(idx1,idx2) -> combine 2 particles by summing their weight and moving to a weight- !! averaged position !! deleteParticle(idx) -> deletes particle at idx and reduces dungeon size by 1 @@ -101,8 +94,6 @@ module particleDungeon_class procedure :: isEmpty procedure :: normWeight procedure :: normSize - procedure :: reduceSize - procedure :: reduceSizeNEW procedure :: closest procedure :: combine procedure :: deleteParticle @@ -458,197 +449,7 @@ subroutine normSize(self,N,rand) end subroutine normSize !! - !! TODO DOESN'T WORK PROPERLY, REMOVE BEFORE GIT MERGE - !! - !! Combines particles such that the max population in any region is N, based on algorithm - !! proposed by Elad Steinberg and Shay I. Heizler, A New Discrete Implicit Monte Carlo Scheme - !! for Simulating Radiative Transfer Problems (2022). Currently chooses particles to keep as the - !! first ones found, Steinberg and Heizler suggest choosing using a weighted-probability, can be - !! improved to do this in the future if necessary. - !! - !! Args: - !! N [in] -> Maximum number of particles in each region - !! emptyArray [in] -> Pointer to array of size (3, system limit) to avoid allocating every time - !! - subroutine reduceSize(self, N, emptyArray) - class(particleDungeon), intent(inout) :: self - integer(shortInt), intent(in) :: N - integer(shortInt), dimension(:,:), intent(in), pointer :: emptyArray - integer(shortInt), dimension(:), pointer :: idxArray, toKeep, toRemove - integer(shortInt) :: i, j, idx, idxKeep, idxRemove, pop - real(defReal), dimension(3) :: r - real(defReal) :: dist, minDist - - ! Store initial population - pop = self % pop - - ! Initialise arrays and pointers - emptyArray = 0 - idxArray => emptyArray(1, 1:size(emptyArray,2)) - toKeep => emptyArray(2, 1:size(emptyArray,2)) - toRemove => emptyArray(3, 1:size(emptyArray,2)) - - ! Store particle matIdx in array for easy access - idxArray(1:self % pop) = self % prisoners(1:self % pop) % matIdx - - ! Only consider material particles - idxArray = idxArray * merge(1, 0, self % prisoners(1:self % pop) % type == P_MATERIAL) - - do i=1, maxVal(idxArray) - - ! Manipulate toKeep to be as follows: - ! 0 -> Either not in material i, or not of type P_MATERIAL - ! 1 -> In material i, P_MATERIAL, to be removed - ! 2 -> In material i, P_MATERIAL, to be kept - - ! Set toKeep array to be 1 for mat particles in material i and 0 otherwise - toKeep = merge(1, 0, idxArray == i) - - ! Determine if population needs to be reduced - if (sum(toKeep) > N) then - do j=1, N - ! Select particles being kept and increase flag from 1 to 2 - idx = linFind(toKeep, 1) - toKeep(idx) = 2 - end do - else - ! Increase flags to 2 if no reduction is necessary - toKeep = toKeep * 2 - end if - - reduce:do - ! Exit if material population does not need to be reduced - if (count(toKeep == 1) == 0) exit reduce - - ! Select particle to be removed - idxRemove = linFind(toKeep, 1) - r = self % prisoners(idxRemove) % r - - ! Find minimum distance to a particle being kept - minDist = INF - do j=1, size(toKeep) - if (toKeep(j) == 2) then - dist = getDistance(r, self % prisoners(j) % r) - if (dist < minDist) then - minDist = dist - idxKeep = j - end if - end if - end do - - ! Combine particles - call self % combine(idxKeep, idxRemove) - - ! Store idxRemove for deletion later - toRemove(idxRemove) = 1 - - ! Remove from toKeep - toKeep(idxRemove) = 0 - - end do reduce - - end do - - ! Delete particles starting from highest index - do i=1, size(toRemove) - idx = size(toRemove)-i+1 - if (toRemove(idx) == 1) call self % deleteParticle(idx) - end do - - ! Print reduction - if (self % pop /= pop) then - print * - print *, 'Reduced dungeon size from '//numToChar(pop)//' to '//numToChar(self % pop) - print * - end if - - end subroutine reduceSize - - !! - !! TODO TOO SLOW TO BE USEFUL, CHANGE OR REMOVE BEFORE GIT MERGE - !! - !! N -> target size - !! - subroutine reduceSizeNEW(self, matMax, rand) - class(particleDungeon), intent(inout) :: self - integer(shortInt), intent(in) :: matMax - class(RNG), intent(inout) :: rand - integer(shortInt) :: pop, i, j, idx, numInMat, matIdx - real(defReal) :: matWeight, prob, testVar - class(mgIMCDatabase), pointer :: nucData - character(100), parameter :: Here = 'aiucbniuqbnwionmcas' - - pop = self % pop - print *, 'START:', pop - - nucData => ndReg_getIMCMG() - - ! Consider each material seperately - do j = 1, mm_nMat() - - ! Find number of particles in each material - numInMat = sum(merge(1, 0, self % prisoners(1:self % pop) % matIdx == j)) - if (j == 1) print *, 'mat ', j, numInMat - - ! Skip if reduction not needed - if (numInMat < matMax) cycle - - ! Get sum of energies of material particles within mat - Faster than looping through dungeon - matWeight = nucData % getMaterialEnergy(j) - - ! Loop through particles in material and mark for deletion by setting weight as negative - do i = 1, self % pop - ! Skip if wrong mat - if (self % prisoners(i) % matIdx /= j) cycle - ! Only consider material particles - if (self % prisoners(i) % type /= P_MATERIAL) cycle - ! Delete particles probabilistically based on particle weight - prob = 1 - matMax * self % prisoners(i) % wgt / matWeight - ! Mark for deletion by setting weight negative - if (rand % get() < prob) then - self % prisoners(i) % wgt = - self % prisoners(i) % wgt - end if - end do - - ! TODO If only considering material particles then can get total weight from energy density - ! of material, if wanting to reduce pop of photons as well then could potentially approximate using - ! equilibrium radiation energy density of material (aT^4) - - end do - - ! Loop through dungeon again to combine particles - do i = 1, pop - ! Skip particles to keep - if (self % prisoners(i) % wgt >= ZERO) cycle - matIdx = self % prisoners(i) % matIdx - if (matIdx <= 0) call fatalError(Here, numToChar(matIdx)) - ! Find nearest valid particle to join with - idx = self % closest(i) - ! If no suitable friend found, allow particle to survive - if (idx == 0) then - ! Re-flip weight - self % prisoners(i) % wgt = - self % prisoners(i) % wgt - cycle - end if - ! Combine - call self % combine(idx, i) - end do - - ! Delete dead particles in reverse order to prevent changing indices - do i = 1, pop - idx = pop - i + 1 - if (self % prisoners(idx) % wgt <= ZERO) call self % deleteParticle(idx) - end do - - numInMat = sum(merge(1, 0, self % prisoners(1:self % pop) % matIdx == 1)) - print *, 'mat ', '1', numInMat - - print *, 'END: ', self % pop - - end subroutine reduceSizeNEW - - !! - !! TODO + !! Find the closest particle to particle at idx, that is of the same type and in the same material !! function closest(self, idx) result(idxClose) class(particleDungeon), intent(in) :: self @@ -656,6 +457,7 @@ function closest(self, idx) result(idxClose) integer(shortInt) :: idxClose, matIdx, type, i real(defReal), dimension(3) :: r real(defReal) :: dist, minDist + character(100), parameter :: Here = 'closest (particleDungeon_class.f90)' ! Get required properties of particle r = self % prisoners(idx) % r @@ -672,9 +474,6 @@ function closest(self, idx) result(idxClose) if (self % prisoners(i) % matIdx /= matIdx) cycle if (self % prisoners(i) % type /= type) cycle - ! Require particle to have positive weight - if (self % prisoners(i) % wgt <= ZERO) cycle - ! Get distance dist = getDistance(r, self % prisoners(i) % r) if (dist < minDist) then @@ -686,6 +485,8 @@ function closest(self, idx) result(idxClose) !$omp end do !$omp end parallel + if (idxClose == 0) call fatalError(Here, 'No valid particle found') + end function closest !! @@ -714,9 +515,6 @@ subroutine combine(self, idx1, idx2) r1 = p1 % rGlobal() r2 = p2 % rGlobal() - ! Flip weight of p2 if negative (for reduceSizeNEW) TODO - p2 % w = abs(p2 % w) - ! Move to new combined position rNew = (r1*p1 % w + r2*p2 % w) / (p1 % w + p2 % w) call p1 % teleport(rNew) From ee38a868d5ec8528dfd7aaee1e371d616474c2cf Mon Sep 17 00:00:00 2001 From: ajb343 Date: Thu, 4 Jan 2024 23:28:03 +0000 Subject: [PATCH 367/373] Allowed transportOperatorHT_class to work with multigroup, fixed some numerical issues, added a lot of comments --- Geometry/geometryGrid_class.f90 | 7 +- InputFiles/IMC/DataFiles/olsonData | 1 + InputFiles/IMC/DensmoreMF/densmoreMid | 12 +- .../baseMgIMC/baseMgIMCMaterial_class.f90 | 73 ++-- ParticleObjects/Source/CMakeLists.txt | 1 - .../Source/bbSurfaceSource_class.f90 | 332 ---------------- .../Source/blackBodySource_class.f90 | 20 +- ParticleObjects/Source/ismcNew.f90 | 352 ----------------- ParticleObjects/Source/oldSurfaceSource | 359 ------------------ ParticleObjects/Source/sourceFactory_func.f90 | 7 +- .../implicitPhysicsPackage_class.f90 | 2 +- .../transportOperatorGeomHT_class.f90 | 101 ++--- .../transportOperatorTime_class.f90 | 12 +- TransportOperator/virtualMat_class.f90 | 62 ++- 14 files changed, 175 insertions(+), 1166 deletions(-) delete mode 100644 ParticleObjects/Source/bbSurfaceSource_class.f90 delete mode 100644 ParticleObjects/Source/ismcNew.f90 delete mode 100644 ParticleObjects/Source/oldSurfaceSource diff --git a/Geometry/geometryGrid_class.f90 b/Geometry/geometryGrid_class.f90 index 84e3f2c9e..ee1dddeb8 100644 --- a/Geometry/geometryGrid_class.f90 +++ b/Geometry/geometryGrid_class.f90 @@ -282,6 +282,8 @@ end subroutine placeCoord !! !! Find material and unique cell at a given location + !! Optional direction input is not used to nudge particles across cells. All moves in this class + !! are increased by NUDGE so particles should never be exactly on a surface. !! !! See geometry_inter for details !! @@ -433,11 +435,12 @@ subroutine moveGlobal(self, coords, maxDist, event) event = BOUNDARY_EV maxDist = dist + NUDGE - ! Apply boundary conditions - if (coords % matIdx == OUTSIDE_MAT) call self % explicitBC(coords) + ! Apply boundary conditions + call self % explicitBC(coords) end if + end subroutine moveGlobal !! diff --git a/InputFiles/IMC/DataFiles/olsonData b/InputFiles/IMC/DataFiles/olsonData index 21268ce3c..e3dc09555 100644 --- a/InputFiles/IMC/DataFiles/olsonData +++ b/InputFiles/IMC/DataFiles/olsonData @@ -3,4 +3,5 @@ equations olson1D; +tol 8; diff --git a/InputFiles/IMC/DensmoreMF/densmoreMid b/InputFiles/IMC/DensmoreMF/densmoreMid index b6a74e137..66363399c 100644 --- a/InputFiles/IMC/DensmoreMF/densmoreMid +++ b/InputFiles/IMC/DensmoreMF/densmoreMid @@ -7,7 +7,7 @@ limit 300000; steps 100; timeStep 0.01; units ns; -printUpdates 0; +printUpdates 5; energyGrid { grid log; @@ -22,6 +22,16 @@ collisionOperator { transportOperator { type transportOperatorTime; + + // + // When running with transportOperatorGeomHT with the settings below, occasionally get error + // 'segmentation fault (core dumped)' with no further information, unable to figure out why. + // + //type transportOperatorGeomHT; + cutoff 0.9; + geometry { type geometryGrid; boundary (0 1 1 1 1 1); dimensions (25 1 1); + bounds (-2.5 -0.5 -0.5 2.5 0.5 0.5); gridOnly y; } + searchN (250 1 1); } matSource { type materialSource; method fast; } diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index ef692440b..7931af9aa 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -60,24 +60,37 @@ module baseMgIMCMaterial_class !! !! Note: !! Order of "data" array is: data(XS_type, Group #) - !! Dictionary with data must contain following entries: - !! -> numberOfGroups + !! For multigroup calculations: + !! -> energyGrid { } is given in input file, not in material data file + !! -> if not provided, simulation is done for grey case + !! -> numberOfGroups is automatically extracted from energyGrid + !! + !! Data file sample inputs: + !! equations olson; -> required input, tells code which set of compiled equations to use + !! (see materialEquations.f90 for examples and to add new cases) + !! sigmaFactor 10; -> multiplies sigma equation by a constant, avoids recompiling or + !! duplicating equations + !! cv 1; -> as above, for heat capacity + !! tol 8; -> defaults to 6 if not given. The order of tolerence used in temp + !! calculation, i.e. 8 => 1e-8, this is then multiplied by current temp + !! alpha 0.7; -> optional parameter used to tweak fleck factor, defaults to 1 !! type, public, extends(mgIMCMaterial) :: baseMgIMCMaterial - real(defReal),dimension(:,:), allocatable :: data - character(nameLen) :: name ! Name for update equations (see materialEquations.f90) - real(defReal) :: T ! Temperature - real(defReal) :: V ! Volume - real(defReal) :: fleck ! Fleck factor - real(defReal) :: alpha ! User-defined parameter for fleck factor - real(defReal) :: sigmaP ! Planck opacity - real(defReal) :: matEnergy ! Total energy stored in material - real(defReal) :: prevMatEnergy ! Energy prior to material update - real(defReal) :: energyDens ! Energy density = matEnergy/V - real(defReal) :: eta ! aT^4/energyDens, used for ISMC only - integer(shortInt) :: calcType ! IMC or ISMC - real(defReal) :: sigmaFactor ! Constant to multiply sigma by - real(defReal) :: cvFactor ! Constant to multiply heat capacity by + real(defReal),dimension(:,:), allocatable :: data ! XS (opacity) data for each group + character(nameLen) :: name ! Name for update equations + real(defReal) :: T ! Temperature + real(defReal) :: V ! Volume + real(defReal) :: fleck ! Fleck factor + real(defReal) :: alpha ! User-defined parameter for fleck factor + real(defReal) :: sigmaP ! Planck opacity + real(defReal) :: matEnergy ! Total energy stored in material + real(defReal) :: prevMatEnergy ! Energy prior to material update + real(defReal) :: energyDens ! Energy density = matEnergy/V + real(defReal) :: eta ! aT^4/energyDens (ISMC only) + real(defReal) :: sigmaFactor ! Constant to multiply sigma by + real(defReal) :: cvFactor ! Constant to multiply heat capacity by + real(defReal) :: tol ! Tolerance for calculating temperature + integer(shortInt) :: calcType ! IMC or ISMC contains ! Superclass procedures @@ -186,7 +199,7 @@ subroutine init(self, dict) class(baseMgIMCMaterial), intent(inout) :: self class(dictionary),target, intent(in) :: dict integer(shortInt) :: nG, N, i - real(defReal) :: dT, tempT, tempU + real(defReal) :: dT, tempT, tempU, tol character(100), parameter :: Here = 'init (baseMgIMCMaterial_class.f90)' ! Read number of groups @@ -211,6 +224,10 @@ subroutine init(self, dict) call dict % getOrDefault(self % sigmaFactor, 'sigmaMultiple', ONE) call dict % getOrDefault(self % cvFactor, 'cvMultiple', ONE) + ! Get optional tolerance for temperature calculation + call dict % getOrDefault(tol, 'tol', 6*ONE) + self % tol = 10_defReal**(-tol) + ! Read initial temperature and volume call dict % get(self % T, 'T') call dict % get(self % V, 'V') @@ -358,9 +375,6 @@ subroutine updateMat(self, tallyEnergy, loud) self % energyDens = self % matEnergy / self % V - ! Return if no change - if (abs(self % matEnergy - self % prevMatEnergy) < 0.00001*self % prevMatEnergy) return - ! Confirm new energy density is valid if (self % energyDens <= ZERO) call fatalError(Here, 'Energy density is not positive') @@ -378,15 +392,19 @@ subroutine updateMat(self, tallyEnergy, loud) if (loud) then change = self % matEnergy - self % prevMatEnergy if (change < ZERO) then - print *, ' Mat Energy ='//numToChar(self % matEnergy)//' ( -'//numToChar(abs(change))//')' + print *, ' Mat Energy ='//numToChar(self % matEnergy)//& + ' ( -'//numToChar(abs(change))//' )' else - print *, ' Mat Energy ='//numToChar(self % matEnergy)//' ( +'//numToChar(change)//')' + print *, ' Mat Energy ='//numToChar(self % matEnergy)//& + ' ( +'//numToChar(change)//' )' end if change = self % T - prevTemp if (change < ZERO) then - print *, ' Mat Temperature ='//numToChar(self % T)//' ( -'//numToChar(abs(change))//')' + print *, ' Mat Temperature ='//numToChar(self % T)//& + ' ( -'//numToChar(abs(change))//' )' else - print *, ' Mat Temperature ='//numToChar(self % T)//' ( +'//numToChar(change)//')' + print *, ' Mat Temperature ='//numToChar(self % T)//& + ' ( +'//numToChar(change)//' )' end if end if @@ -406,9 +424,12 @@ function tempFromEnergy(self) result(T) integer(shortInt) :: i character(100), parameter :: Here = 'tempFromEnergy (mgIMCMaterial_class.f90)' + ! Confirm that current temperature is valid + if (self % T <= ZERO) call fatalError(Here, 'Zero temperature') + ! Parameters affecting accuracy - dT = self % T / 1000 ! Initial temperature step size to take, reduced after overshoot - tol = self % T / 1000000 ! Continue stepping until within tolerance + dT = self % T / 1000 ! Initial temperature step size to take, reduced after overshoot + tol = self % T * self % tol ! Continue stepping until within tolerance ! Starting temperature and energy density T = self % T diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index bf036bbc9..b033bf61a 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -5,6 +5,5 @@ add_sources( source_inter.f90 pointSource_class.f90 fissionSource_class.f90 materialSource_class.f90 - bbSurfaceSource_class.f90 blackBodySource_class.f90 ) diff --git a/ParticleObjects/Source/bbSurfaceSource_class.f90 b/ParticleObjects/Source/bbSurfaceSource_class.f90 deleted file mode 100644 index 5632d5ee1..000000000 --- a/ParticleObjects/Source/bbSurfaceSource_class.f90 +++ /dev/null @@ -1,332 +0,0 @@ -module bbSurfaceSource_class - - use numPrecision - use universalVariables - use genericProcedures, only : fatalError, numToChar - use particle_class, only : particleState, P_NEUTRON, P_PHOTON - use particleDungeon_class, only : particleDungeon - use dictionary_class, only : dictionary - use configSource_inter, only : configSource, kill_super => kill - use geometry_inter, only : geometry - use RNG_class, only : RNG - use simulationTime_class - - implicit none - private - - !! - !! Generates a source representing a black body surface - !! - !! Private members: - !! r -> bottom corner of source - !! dr -> size of surface, will be 0 in one dimension - !! dir -> direction of dominant movement: [1,0,0], [-1,0,0], [0,1,0], etc. - !! particleType -> source particle type (photon) - !! isMG -> is the source multi-group? (yes) - !! - !! Interface: - !! init -> initialise point source - !! append -> source particles and add to existing dungeon - !! sampleType -> set particle type - !! samplePosition -> set particle position - !! sampleEnergyAngle -> sample particle angle - !! sampleEnergy -> set particle energy (isMG = .true., G = 1) - !! sampleWeight -> set particle energy-weight - !! sampleTime -> set particle time - !! kill -> terminate source - !! - !! Sample Dictionary Input: - !! source { - !! type bbSurfaceSource; - !! r (x_min x_max y_min y_max z_min z_max); -> Position bounds of surface - !! -> min and max must be equal in one dimension - !! #dir -1; -> optional, negative will reverse direction in dominant axis - !! -> defaults to positive - !! temp 1; -> temperature of the black body source - !! N 100; -> number of particles per time step, only used if append is called with N = 0 - !! } - !! - type, public,extends(configSource) :: bbSurfaceSource - private - real(defReal), dimension(3) :: r = ZERO - real(defReal), dimension(3) :: dr = ZERO - integer(shortInt), dimension(3) :: dir = ZERO - integer(shortInt) :: particleType = P_PHOTON - logical(defBool) :: isMG = .true. - real(defReal) :: T = ZERO - integer(shortInt) :: N = 0 - contains - procedure :: init - procedure :: append - procedure :: sampleType - procedure :: samplePosition - procedure :: sampleEnergy - procedure :: sampleEnergyAngle - procedure :: sampleWeight - procedure :: sampleTime - procedure :: kill - end type bbSurfaceSource - -contains - - !! - !! Initialise from dictionary - !! - !! See source_inter for details - !! - !! Errors: - !! - error if an axis other than x, y, or z is given - !! - subroutine init(self, dict, geom) - class(bbSurfaceSource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - real(defReal), dimension(:), allocatable :: temp - integer(shortInt) :: i, dir - real(defReal) :: area - character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' - - ! Provide geometry info to source - self % geom => geom - - ! Provide particle type - self % particleType = P_PHOTON - - ! Get and check position vector - call dict % get(temp, 'r') - if (size(temp) /= 6) call fatalError(Here, 'r should be of size 6') - do i = 1, 3 - ! Store x_min, y_min, z_min - self % r(i) = temp(2*i-1) - ! Store dx, dy, dz - self % dr(i) = temp(2*i) - temp(2*i-1) - ! Check for compatible min and max - if (self % dr(i) < 0) call fatalError(Here, 'Min > Max along direction '//numToChar(i)) - end do - ! Check that exactly one normal axis is present - if (count(self % dr == 0) /= 1) call fatalError(Here, 'No clearly defined axis extracted') - - ! Get primary direction - call dict % getOrDefault(dir, 'dir', 1) - do i = 1, 3 - if (self % dr(i) == 0) self % dir(i) = sign(1, dir) - end do - - ! Move by 2*SURF_TOL to ensure sourcing in correct material - self % r = self % r + 2*SURF_TOL*self % dir - - ! Get remaining information - call dict % get(self % T, 'temp') - call dict % getOrDefault(self % N, 'N', 1) - - ! Calculate surface area of source - area = product(self % dr, self % dr /= ZERO) - - ! Calculate total source energy - self % sourceWeight = radiationConstant * lightSpeed * timeStep() * self % T**4 * area / 4 - - end subroutine init - - !! - !! Add particles to given dungeon - !! - !! See source_inter for details - !! - !! If N is given as 0, then N is instead taken from the input dictionary defining this source - !! to allow PP to have control over particle numbers - !! - subroutine append(self, dungeon, N, rand) - class(bbSurfaceSource), intent(inout) :: self - type(particleDungeon), intent(inout) :: dungeon - integer(shortInt), intent(in) :: N - class(RNG), intent(inout) :: rand - integer(shortInt) :: i - type(RNG) :: pRand - character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' - - ! Set number to generate. Using 0 in function call will use N from input dictionary - if (N /= 0) self % N = N - ! TODO change so that this override is only temporary, so that can be called with 0 again later - - ! Generate N particles to populate dungeon - !$omp parallel - pRand = rand - !$omp do private(pRand) - do i = 1, self % N - call pRand % stride(i) - call dungeon % detain(self % sampleParticle(pRand)) - end do - !$omp end do - !$omp end parallel - - end subroutine append - - !! - !! Provide particle type - !! - !! See configSource_inter for details. - !! - subroutine sampleType(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - - p % type = self % particleType - - end subroutine sampleType - - !! - !! Provide particle position - !! - !! See configSource_inter for details. - !! - subroutine samplePosition(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - integer(shortInt) :: i - real(defReal), dimension(3) :: r - - ! Set new x, y and z coords - do i = 1, 3 - r(i) = (self % dr(i)) * rand % get() + self % r(i) - end do - - ! Assign to particle - p % r = r - - end subroutine samplePosition - - !! - !! Sample angle - !! - !! See configSource_inter for details. - !! - subroutine sampleEnergyAngle(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - real(defReal), dimension(3) :: dir - real(defReal) :: phi, mu - character(100), parameter :: Here = 'sampleEnergyAngle (bbSurfaceSource_class.f90)' - - ! Sample required phi and mu - phi = TWO_PI * rand % get() - mu = sqrt(rand % get()) - - ! Choose direction based on dominant direction given in self % dir - if (self % dir(1) == 1) then ! Positive x - dir = [ mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] - - else if (self % dir(1) == -1) then ! Negative x - dir = [-mu, sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi)] - - else if (self % dir(2) == 1) then ! Positive y - dir = [sqrt(1-mu*mu)*sin(phi), mu, sqrt(1-mu*mu)*cos(phi)] - - else if (self % dir(2) == -1) then ! Negative y - dir = [sqrt(1-mu*mu)*sin(phi), -mu, sqrt(1-mu*mu)*cos(phi)] - - else if (self % dir(3) == 1) then ! Positive z - dir = [sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi), mu] - - else if (self % dir(3) == -1) then ! Negative z - dir = [sqrt(1-mu*mu)*cos(phi), sqrt(1-mu*mu)*sin(phi), -mu] - - else - call fatalError(Here, 'Invalid direction vector') - end if - - ! Assign to particle - p % dir = dir - - end subroutine sampleEnergyAngle - - !! - !! Provide particle energy - !! - !! See configSource_inter for details. - !! - subroutine sampleEnergy(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - integer(shortInt) :: N - real(defReal) :: random, sumToN, const, nu - - if (self % isMG .eqv. .true.) then - p % isMG = .true. - p % G = 1 - return - end if - - ! Sample frequency from a black body (Planck) spectrum. See Fig. 1 in: - ! "An Implicit Monte Carlo Scheme for Calculating Time and Frequency Dependent - ! Nonlinear Radiation Transport", Fleck and Cummings, 1971 - N = 1 - random = rand % get() - sumToN = 1 - const = 90 / (pi**4) - - sample:do - if (random <= const*sumToN) exit sample - N = N + 1 - sumToN = sumToN + 1 / (N**4) - end do sample - - nu = -log(rand % get() * rand % get() * rand % get() * rand % get()) / N - p % E = planckConst * nu - - end subroutine sampleEnergy - - !! - !! Provide particle energy-weight - !! - !! Sampled as a black body surface, see "Four Decades of Implicit Monte Carlo", - !! Allan B Wollaber, p.24-25 - !! - !! See configSource_inter for details. - !! - subroutine sampleWeight(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - - p % wgt = self % sourceWeight / self % N - - end subroutine sampleWeight - - !! - !! Sample time uniformly within time step - !! - subroutine sampleTime(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - - ! Sample time uniformly within time step - p % time = time % stepStart + timeStep() * rand % get() - - end subroutine sampleTime - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(bbSurfaceSource), intent(inout) :: self - - ! Kill superclass - call kill_super(self) - - ! Kill local components - self % r = ZERO - self % dr = ZERO - self % dir = ZERO - self % particleType = P_PHOTON - self % isMG = .true. - self % T = ZERO - self % N = ZERO - - end subroutine kill - -end module bbSurfaceSource_class diff --git a/ParticleObjects/Source/blackBodySource_class.f90 b/ParticleObjects/Source/blackBodySource_class.f90 index db7ef96c2..703582dea 100644 --- a/ParticleObjects/Source/blackBodySource_class.f90 +++ b/ParticleObjects/Source/blackBodySource_class.f90 @@ -174,12 +174,12 @@ subroutine samplePosition(self, p, rand) case(OLSON1D) ! Q(x) proportional to exp(-693x**3) (integral from 0 to 4.8 = 0.100909) rejection:do - x = rand % get() * 4.8 + x = rand % get() * 4.8_defReal if (rand % get() < exp(-693*x**3)/0.100909) exit end do rejection - r(1) = x - 2.4 - r(2) = rand % get() - 0.5 - r(3) = rand % get() - 0.5 + r(1) = x - 2.4_defReal + r(2) = rand % get() - 0.5_defReal + r(3) = rand % get() - 0.5_defReal case default call fatalError(Here, 'Unrecognised source distribution') @@ -399,27 +399,27 @@ subroutine initSurface(self, dict) ! Set sampling position to be at constant x value self % dr(1) = ZERO ! Nudge to ensure sourcing in correct material - self % r(1) = bounds(1) + 2*SURF_TOL + self % r(1) = bounds(1) + TWO*SURF_TOL ! Set rotation matrix for direction sampling rotation = [[1,0,0],[0,1,0],[0,0,1]] case('-y') self % dr(2) = ZERO - self % r(2) = bounds(2) + 2*SURF_TOL + self % r(2) = bounds(2) + TWO*SURF_TOL rotation = [[0,1,0],[1,0,0],[0,0,1]] case('-z') self % dr(3) = ZERO - self % r(3) = bounds(3) + 2*SURF_TOL + self % r(3) = bounds(3) + TWO*SURF_TOL rotation = [[0,0,1],[0,1,0],[1,0,0]] case('+x') - self % r(1) = bounds(4) - 2*SURF_TOL + self % r(1) = bounds(4) - TWO*SURF_TOL self % dr(1) = ZERO rotation = [[-1,0,0],[0,1,0],[0,0,1]] case('+y') - self % r(2) = bounds(5) - 2*SURF_TOL + self % r(2) = bounds(5) - TWO*SURF_TOL self % dr(2) = ZERO rotation = [[0,-1,0],[1,0,0],[0,0,1]] case('+z') - self % r(3) = bounds(6) - 2*SURF_TOL + self % r(3) = bounds(6) - TWO*SURF_TOL self % dr(3) = ZERO rotation = [[0,0,-1],[0,1,0],[1,0,0]] case default diff --git a/ParticleObjects/Source/ismcNew.f90 b/ParticleObjects/Source/ismcNew.f90 deleted file mode 100644 index 0cd06b95c..000000000 --- a/ParticleObjects/Source/ismcNew.f90 +++ /dev/null @@ -1,352 +0,0 @@ -module IMCSource_class - - use numPrecision - use endfConstants - use universalVariables - use genericProcedures, only : fatalError, rotateVector - use dictionary_class, only : dictionary - use RNG_class, only : RNG - - use particle_class, only : particle, particleState, P_PHOTON - use particleDungeon_class, only : particleDungeon - use source_inter, only : source, kill_super => kill - - use geometry_inter, only : geometry - use IMCMaterial_inter, only : IMCMaterial, IMCMaterial_CptrCast - use nuclearDataReg_mod, only : ndReg_getIMCMG => getIMCMG - use nuclearDatabase_inter, only : nuclearDatabase - use mgIMCDatabase_inter, only : mgIMCDatabase - use materialMenu_mod, only : mm_nMat => nMat, & - mm_matName => matName - - implicit none - private - - integer(shortInt), parameter :: REJ = 1, FAST = 2 - - !! - !! IMC Source for uniform generation of photons within a material - !! - !! Angular distribution is isotropic. - !! - !! Private members: - !! isMG -> is the source multi-group? (default = .true.) - !! bottom -> Bottom corner (x_min, y_min, z_min) - !! top -> Top corner (x_max, y_max, z_max) - !! G -> Group (default = 1) - !! - !! Interface: - !! source_inter Interface - !! - !! SAMPLE INPUT: - !! imcSource { type IMCSource; } - !! - type, public,extends(source) :: imcSource - private - logical(defBool) :: isMG = .true. - real(defReal), dimension(3) :: bottom = ZERO - real(defReal), dimension(3) :: top = ZERO - real(defReal), dimension(3) :: latPitch = ZERO - integer(shortInt), dimension(3) :: latSizeN = 0 - integer(shortInt) :: G = 0 - real(defReal), dimension(6) :: bounds = ZERO - integer(shortInt) :: method = REJ - contains - procedure :: init - procedure :: append - procedure :: sampleParticle - procedure, private :: sampleIMC - procedure, private :: getMatBounds - procedure :: kill - end type imcSource - -contains - - !! - !! Initialise IMC Source - !! - !! See source_inter for details - !! - subroutine init(self, dict, geom) - class(imcSource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - character(nameLen) :: method - character(100), parameter :: Here = 'init (imcSource_class.f90)' - - call dict % getOrDefault(self % G, 'G', 1) - - ! Provide geometry info to source - self % geom => geom - - ! Set bounding region - self % bounds = self % geom % bounds() - - ! Select method for position sampling - call dict % getOrDefault(method, 'method', 'rejection') - select case(method) - case('rejection') - self % method = REJ - - case('fast') - self % method = FAST - ! Get lattice dimensions - self % latSizeN = self % geom % latSizeN() - self % latPitch = (self % bounds(4:6) - self % bounds(1:3)) / self % latSizeN - - case default - call fatalError(Here, 'Unrecognised method. Should be "rejection" or "fast"') - end select - - end subroutine init - - - !! - !! Generate N particles to add to a particleDungeon without overriding - !! particles already present. - !! - !! Args: - !! dungeon [inout] -> particle dungeon to be added to - !! n [in] -> number of particles to place in dungeon - !! rand [inout] -> particle RNG object - !! - !! Result: - !! A dungeon populated with N particles sampled from the source, plus particles - !! already present in dungeon - !! - subroutine append(self, dungeon, N, rand) - class(imcSource), intent(inout) :: self - type(particleDungeon), intent(inout) :: dungeon - integer(shortInt), intent(in) :: N - class(RNG), intent(inout) :: rand - real(defReal), dimension(6) :: bounds - integer(shortInt) :: matIdx, i, Ntemp - real(defReal) :: energy, totalEnergy - type(RNG) :: pRand - class(mgIMCDatabase), pointer :: nucData - character(100), parameter :: Here = "append (IMCSource_class.f90)" - - ! Get pointer to appropriate nuclear database - nucData => ndReg_getIMCMG() - if(.not.associated(nucData)) call fatalError(Here, 'Failed to retrieve Nuclear Database') - - ! Obtain total energy - totalEnergy = nucData % getEmittedRad() - - ! Loop through materials - do matIdx = 1, mm_nMat() - - ! Get energy to be emitted from material matIdx - energy = nucData % getEmittedRad(matIdx) - - ! Choose particle numbers in proportion to material energy - if (energy > ZERO) then - Ntemp = int(N * energy / totalEnergy) - ! Enforce at least 1 particle - if (Ntemp == 0) Ntemp = 1 - - ! Set bounds for sampling - if (self % method == FAST) then - bounds = self % getMatBounds(matIdx) - else - bounds = self % bounds - end if - - ! Find energy per particle - energy = energy / Ntemp - - ! Sample particles - !$omp parallel - pRand = rand - !$omp do private(pRand) - do i=1, Ntemp - call pRand % stride(i) - call dungeon % detain(self % sampleIMC(pRand, matIdx, energy, bounds)) - end do - !$omp end do - !$omp end parallel - - end if - end do - - end subroutine append - - - !! - !! Sample particle's phase space co-ordinates - !! - !! See source_inter for details - !! - function sampleParticle(self, rand) result(p) - class(imcSource), intent(inout) :: self - class(RNG), intent(inout) :: rand - type(particleState) :: p - character(100), parameter :: Here = 'sampleParticle (IMCSource_class.f90)' - - ! Should not be called, useful to have extra inputs so use sampleIMC instead - call fatalError(Here, 'Should not be called, sampleIMC should be used instead.') - - ! Avoid compiler warning - p % G = self % G - - end function sampleParticle - - - !! - !! Sample particle's phase space co-ordinates - !! - !! Args: - !! rand [in] -> RNG - !! matIdx [in] -> index of material being sampled from - !! energy [in] -> energy-weight of sampled particle - !! bounds [in] -> bounds for position search, will be bounds of entire geometry if using - !! rejection sampling method, and bounds of single material if using fast - !! - function sampleIMC(self, rand, targetMatIdx, energy, bounds) result(p) - class(imcSource), intent(inout) :: self - class(RNG), intent(inout) :: rand - integer(shortInt), intent(in) :: targetMatIdx - real(defReal), intent(in) :: energy - real(defReal), dimension(6), intent(in) :: bounds - type(particleState) :: p - real(defReal), dimension(3) :: bottom, top, r, dir, rand3 - real(defReal) :: mu, phi - integer(shortInt) :: i, matIdx, uniqueID - character(100), parameter :: Here = 'sampleIMC (IMCSource_class.f90)' - - ! Sample particle position - bottom = bounds(1:3) - top = bounds(4:6) - i = 0 - rejection:do - rand3(1) = rand % get() - rand3(2) = rand % get() - rand3(3) = rand % get() - r = (top - bottom) * rand3 + bottom - - ! Find material under position - call self % geom % whatIsAt(matIdx, uniqueID, r) - - ! Exit if in desired material - if (matIdx == targetMatIdx) exit rejection - - ! Should exit immediately if using fast method as bounds should contain only matIdx - if (self % method == FAST) call fatalError(Here, 'Fast sourcing returned incorrect material') - - ! Protect against infinite loop - i = i+1 - if (i > 10000) call fatalError(Here, '10,000 failed attempts in rejection sampling') - - end do rejection - - ! Sample direction - chosen uniformly inside unit sphere - mu = 2 * rand % get() - 1 - phi = rand % get() * 2*pi - dir(1) = mu - dir(2) = sqrt(1-mu**2) * cos(phi) - dir(3) = sqrt(1-mu**2) * sin(phi) - - ! Assign basic phase-space coordinates - p % matIdx = matIdx - p % uniqueID = uniqueID - p % time = ZERO - p % type = P_PHOTON - p % r = r - p % dir = dir - p % G = self % G - p % isMG = .true. - p % wgt = energy - - end function sampleIMC - - - !! - !! Get location of material in lattice for position sampling - !! - !! Note that this may be incorrect depending on how lattice input is given, this function - !! assumes that geometry has been generated by discretiseGeom_class.f90 - !! - !! Args: - !! matIdx [in] -> matIdx for which to calculate bounds - !! matBounds [out] -> boundary of lattice cell, [xmin,ymin,zmin,xmax,ymax,zmax] - !! - !! TODO: - !! Would be nice to have most of this in a geometry module - !! - function getMatBounds(self, matIdx) result(matBounds) - class(imcSource), intent(inout) :: self - integer(shortInt), intent(in) :: matIdx - real(defReal), dimension(6) :: matBounds - integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: i, latIdFlipped - character(nameLen) :: matName - character(100), parameter :: Here = 'getMatBounds (imcSourceClass.f90)' - - ! Extract lattice position from mat name (e.g. "m106 -> 106") - ! This is different from localID in latUniverse_class as is counting from a different - ! corner (see get_ijk function description below) - matName = mm_matName(matIdx) - read (matName(2:), '(I10)') latIdFlipped - - ! Set bounds of lattice cell containing matIdx - ijk = get_ijk(latIdFlipped, self % latSizeN) - - do i=1, 3 - matBounds(i) = (ijk(i)-1) * self % latPitch(i) + self % bounds(i) + SURF_TOL - matBounds(i+3) = ijk(i) * self % latPitch(i) + self % bounds(i) - SURF_TOL - end do - - end function getMatBounds - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(imcSource), intent(inout) :: self - - call kill_super(self) - - self % isMG = .true. - self % bounds = ZERO - self % G = 0 - - end subroutine kill - - !! - !! Generate ijk from flipped localID and shape - !! - !! Note that this is NOT the same as get_ijk in latUniverse_class. Lattice is built with first - !! map input as x_min, y_MAX, z_MAX cell, but localID begins at x_min, y_min, z_min cell. In - !! this module we want to find ijk from matIdx, which we convert to a flippedLocalID by - !! offsetting for void regions, which starts counting from the wrong corner. We therefore flip - !! ijk in the y and z directions in this function compared to instances of this function in other - !! modules. - !! - !! Args: - !! flippedlocalID [in] -> Local id of the cell between 1 and product(sizeN), - !! counting from wrong corner - !! sizeN [in] -> Number of cells in each cardinal direction x, y & z - !! - !! Result: - !! Array ijk which has integer position in each cardinal direction - !! - pure function get_ijk(flippedLocalID, sizeN) result(ijk) - integer(shortInt), intent(in) :: flippedLocalID - integer(shortInt), dimension(3), intent(in) :: sizeN - integer(shortInt), dimension(3) :: ijk - integer(shortInt) :: temp, base - - temp = flippedLocalID - 1 - base = temp / sizeN(1) - ijk(1) = temp - sizeN(1) * base + 1 - - temp = base - base = temp / sizeN(2) - ijk(2) = sizeN(2)*(1 + base) - temp - - ijk(3) = sizeN(3) - base - - end function get_ijk - - -end module IMCSource_class diff --git a/ParticleObjects/Source/oldSurfaceSource b/ParticleObjects/Source/oldSurfaceSource deleted file mode 100644 index 273b7829d..000000000 --- a/ParticleObjects/Source/oldSurfaceSource +++ /dev/null @@ -1,359 +0,0 @@ -module bbSurfaceSource_class - - use numPrecision - use universalVariables - use genericProcedures, only : fatalError - use particle_class, only : particleState, P_NEUTRON, P_PHOTON - use particleDungeon_class, only : particleDungeon - use dictionary_class, only : dictionary - use configSource_inter, only : configSource, kill_super => kill - use geometry_inter, only : geometry - use RNG_class, only : RNG - - implicit none - private - - !! - !! Generates a source representing a black body surface - !! Put together quite quickly so very specific in use and not perfect - !! - Currently only allows a circle or square aligned on x y or z axis, with - !! a certain radius or side length - !! - May still contain unnecessary lines of code copied from pointSource_class.f90 - !! - !! Private members: - !! r -> source position - !! dir -> optional source direction - !! particleType -> source particle type - !! isMG -> is the source multi-group? - !! isIsotropic -> is the source isotropic? - !! - !! Interface: - !! init -> initialise point source - !! sampleType -> set particle type - !! samplePosition -> set particle position - !! sampleEnergy -> set particle energy - !! sampleEnergyAngle -> sample particle angle - !! kill -> terminate source - !! - !! Sample Dictionary Input: - !! source { - !! type bbSurfaceSource; - !! shape circle ! circle or square; - !! size 5; ! radius(circle) or side length(square) - !! axis x; ! axis normal to planar shape - !! pos 0; ! distance along axis to place plane - !! T 1; ! temperature of source boundary - !! particle photon; - !! # dir 1; # ! Positive or negative to indicate direction along axis - !! If 0 then emit in both directions - !! # N 100; # ! Number of particles, only used if call to append subroutine uses N=0 - !! } - !! - type, public,extends(configSource) :: bbSurfaceSource - private - real(defReal),dimension(3) :: r = ZERO - real(defReal) :: dir = ZERO - real(defReal) :: surfSize = ZERO - real(defReal) :: area = ZERO - integer(shortInt) :: particleType = P_PHOTON - logical(defBool) :: isMG = .true. - logical(defBool) :: isIsotropic = .false. - integer(shortInt) :: planeShape = 0 ! 0 => square, 1 => circle - integer(shortInt) :: axis = 1 ! 1 => x, 2 => y, 3 => z - real(defReal) :: T = ZERO - real(defReal) :: deltaT = ZERO - integer(shortInt) :: N = 1 - contains - procedure :: init - procedure :: append - procedure :: sampleType - procedure :: samplePosition - procedure :: sampleEnergy - procedure :: sampleEnergyAngle - procedure :: sampleWeight - procedure :: kill - end type bbSurfaceSource - -contains - - !! - !! Initialise from dictionary - !! - !! See source_inter for details - !! - !! Errors: - !! - error if an unrecognised particle type is provided - !! - error if an axis other than x, y, or z is given - !! - error if shape is not square or circle - !! - subroutine init(self, dict, geom) - class(bbSurfaceSource), intent(inout) :: self - class(dictionary), intent(in) :: dict - class(geometry), pointer, intent(in) :: geom - character(30) :: type, tempName - integer(shortInt) :: matIdx, uniqueID - logical(defBool) :: isCE, isMG - real(defReal) :: temp - character(100), parameter :: Here = 'init (bbSurfaceSource_class.f90)' - - ! Provide geometry info to source - self % geom => geom - - ! Identify which particle is used in the source - ! Presently limited to neutron and photon - call dict % getOrDefault(type, 'particle' ,'photon') - select case(type) - case('neutron') - self % particleType = P_NEUTRON - - case('photon') - self % particleType = P_PHOTON - - case default - call fatalError(Here, 'Unrecognised particle type') - - end select - - ! Get position of surface along axis - call dict % get(temp, 'pos') -temp = temp + 2*SURF_TOL - ! Get axis and assign axis position - call dict % getOrDefault(tempName, 'axis', 'x') - select case(tempName) - case('x') - self % r(1) = temp - self % axis = 1 - case('y') - self % r(2) = temp - self % axis = 2 - case('z') - self % r(3) = temp - self % axis = 3 - case default - call fatalError(Here, 'Unrecognised axis, may only be x, y or z') - end select - - ! Get size of boundary surface - call dict % get(self % surfSize, 'size') - - ! Get shape and area of boundary surface - call dict % get(tempName, 'shape') - if (tempName == 'square') then - self % planeShape = 0 - self % area = self % surfSize**2 - else if (tempName == 'circle') then - self % planeShape = 1 - self % area = pi * self % surfSize**2 - else - call fatalError(Here, 'Shape must be "square" or "circle"') - end if - - ! Determine if dir is positive or negative along given axis - ! If equal to 0, emit from both sides - self % isIsotropic = .not. dict % isPresent('dir') - if (.not. self % isIsotropic) then - - call dict % get(temp, 'dir') - - if (temp == 0) then - self % dir = 0 - else - ! Set equal to +1 or -1 - self % dir = temp/abs(temp) - end if - - end if - - call dict % get(self % T, 'T') - call dict % get(self % deltaT, 'deltaT') - call dict % getOrDefault(self % N, 'N', 1) - - self % deltaT = 0.00000000001 - - end subroutine init - - !! - !! Add particles to given dungeon - !! - !! See source_inter for details - !! - !! If N is given as 0, then N is instead taken from the input dictionary defining this source - !! - subroutine append(self, dungeon, N, rand, matIdx) - class(bbSurfaceSource), intent(inout) :: self - type(particleDungeon), intent(inout) :: dungeon - integer(shortInt), intent(in) :: N - class(RNG), intent(inout) :: rand - integer(shortInt), intent(in), optional :: matIdx - integer(shortInt) :: i - type(RNG) :: pRand - character(100), parameter :: Here = 'append (bbSurfaceSource_class.f90)' - - ! Set number to generate. Using 0 in function call will use N from input dictionary - if (N /= 0) self % N = N - - -! TODO Parallel for some reason isn't working here, even though changes are the same as IMCSource ??? - - ! Generate N particles to populate dungeon -! !$omp parallel -! pRand = rand -! !$omp do private(pRand) -! do i = 1, self % N -! call pRand % stride(i) -! call dungeon % detain(self % sampleParticle(pRand)) -! end do -! !$omp end do -! !$omp end parallel - - - do i = 1, self % N - call dungeon % detain(self % sampleParticle(rand)) - end do - - end subroutine append - - !! - !! Provide particle type - !! - !! See configSource_inter for details. - !! - subroutine sampleType(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - - p % type = self % particleType - - end subroutine sampleType - - !! - !! Provide particle position - !! - !! See configSource_inter for details. - !! - subroutine samplePosition(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - real(defReal), dimension(3) :: prevPos - real(defReal) :: r1, r2, rad, theta - - if ( self % planeShape == 0 ) then ! Square - - prevPos = self % r - - ! Set new x, y and z coords - self % r(1) = (rand % get()-0.5) * self % surfSize - self % r(2) = (rand % get()-0.5) * self % surfSize - self % r(3) = (rand % get()-0.5) * self % surfSize - ! Leave position along normal axis unchanged - self % r(self % axis) = prevPos(self % axis) - - else ! Circle - rad = rand % get() * self % surfSize - theta = rand % get() * 2 * pi - - r1 = rad * cos(theta) - r2 = rad * sin(theta) - - if(self % axis == 1) then ! Set y and z - self % r(2) = r1 - self % r(3) = r2 - else if(self % axis == 2) then ! Set x and z - self % r(1) = r1 - self % r(3) = r2 - else ! Set x and y - self % r(1) = r1 - self % r(2) = r2 - end if - - end if - - p % r = self % r - - end subroutine samplePosition - - !! - !! Provide angle or sample if isotropic - !! - !! See configSource_inter for details. - !! - !! Only isotropic/fixed direction. Does not sample energy. - !! - subroutine sampleEnergyAngle(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - real(defReal) :: phi, mu - - phi = TWO_PI * rand % get() - mu = sqrt(rand % get()) - - p % dir = [mu, sqrt(1-mu**2)*cos(phi), sqrt(1-mu**2)*sin(phi)] - - ! If dir not equal to zero, adjust so that particles are travelling in correct direction - if (self % dir /= 0) then - p % dir(self % axis) = abs(p % dir(self % axis)) * self % dir - end if - - - end subroutine sampleEnergyAngle - - !! - !! Provide particle energy, currently only a single group - !! - !! See configSource_inter for details. - !! - subroutine sampleEnergy(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - real(defReal) :: num - - p % isMG = .true. - p % G = 1 - - end subroutine sampleEnergy - - !! - !! Provide particle energy-weight - !! - !! Sampled as a black body surface, see "Four Decades of Implicit Monte Carlo", - !! Allan B Wollaber, p.24-25 - !! - !! See configSource_inter for details. - !! - subroutine sampleWeight(self, p, rand) - class(bbSurfaceSource), intent(inout) :: self - class(particleState), intent(inout) :: p - class(RNG), intent(inout) :: rand - real(defReal) :: num - - num = radiationConstant * lightSpeed * self % deltaT * self % T**4 * self % area - p % wgt = num / (4 * self % N) - - ! If dir = 0 then emit in both directions => double total energy - if (self % dir == 0) p % wgt = 2*p % wgt - - end subroutine sampleWeight - - !! - !! Return to uninitialised state - !! - elemental subroutine kill(self) - class(bbSurfaceSource), intent(inout) :: self - - ! Kill superclass - call kill_super(self) - - ! Kill local components - self % r = ZERO - self % dir = ZERO - self % particleType = P_PHOTON - self % isMG = .true. - self % isIsotropic = .false. - - end subroutine kill - -end module bbSurfaceSource_class diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index e9335d472..118377b18 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -11,7 +11,6 @@ module sourceFactory_func use pointSource_class, only : pointSource use fissionSource_class, only : fissionSource use materialSource_class, only : materialSource - use bbSurfaceSource_class, only : bbSurfaceSource use blackBodySource_class, only : blackBodySource ! geometry @@ -30,7 +29,7 @@ module sourceFactory_func character(nameLen),dimension(*),parameter :: AVAILABLE_sources = [ 'pointSource ',& 'fissionSource ',& 'materialSource ',& - 'bbsurfaceSource'] + 'blackBodySource'] contains @@ -66,10 +65,6 @@ subroutine new_source(new, dict, geom) allocate(materialSource :: new) call new % init(dict, geom) - case('bbSurfaceSource') - allocate(bbSurfaceSource :: new) - call new % init(dict, geom) - case('blackBodySource') allocate(blackBodySource :: new) call new % init(dict, geom) diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index 93dd7e468..692e265b5 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -438,7 +438,7 @@ subroutine init(self, dict) ! No change needed case('ns') ! Convert time step from ns to s - timeStep = timeStep/10**9 + timeStep = timeStep * 1e-9_defReal case('marshak') ! Special case where a = c = 1 timeStep = timeStep/lightSpeed diff --git a/TransportOperator/transportOperatorGeomHT_class.f90 b/TransportOperator/transportOperatorGeomHT_class.f90 index 0ed3c840d..d531e15db 100644 --- a/TransportOperator/transportOperatorGeomHT_class.f90 +++ b/TransportOperator/transportOperatorGeomHT_class.f90 @@ -37,7 +37,37 @@ module transportOperatorGeomHT_class private !! - !! Transport operator that moves a particle with using hybrid tracking, up to a time boundary + !! Transport operator that moves a particle using hybrid tracking, up to a time boundary. + !! + !! Overlays a second geometry (currently only able to be geometryGrid_class) onto the primary + !! geometry. This second geometry is filled with fake materials (see virtualMat_class) to give + !! information about the primary geometry. A particle begins with delta tracking, using the + !! majorant of only the current cell in the upper (fake) geometry. If it would cross into a new + !! upper cell, it is moved in the upper geometry and the majorant is used accordingly. If the + !! acceptance probability is ever below the user-supplied cutoff (actually 1 - cutoff), standard + !! surface tracking is used in the lower geometry, for the rest of the particle's motion. + !! + !! In order to determine which real mats are in which virtual cell, input searchN = (Nx, Ny, Nz) + !! is provided, and Nx*Ny*Nz points are generated and used to map between the two geometries. If + !! searchN is too small then materials may be missed! (fatalError will be called if local opacity + !! is greater than majorant opacity for any particle, which will be the result of missed mats). + !! If searchN = (N) is given (size-1 array) then Nx = Ny = Nz = N. + !! + !! Sample Dictionary Input: + !! transportOperator { + !! type transportOperatorGeomHT; + !! cutoff 0.5; + !! geometry { type geometryGrid; + !! bounds (-2.4 -0.5 -0.5 2.4 0.5 0.5); => Should match primary geometry + !! boundary (1 1 1 1 1 1); => Should match primary geometry + !! gridOnly y; => Stops materials being overwritten + !! dimensions (25 1 1); } => Number of tracking cells + !! searchN (100); + !! } + !! + !! TODO There is a bug somewhere, potentially in this module, causing segmentation faults in + !! certain situations, but I haven't been able to figure out where and why. + !! See InputFiles/IMC/DensmoreMF/densmoreMid for the input that leads to this fault. !! type, public, extends(transportOperator) :: transportOperatorGeomHT real(defReal) :: deltaT @@ -46,18 +76,20 @@ module transportOperatorGeomHT_class class(geometry), pointer :: upperGeom integer(shortInt) :: upperGeomIdx integer(shortInt) :: thisTimeStep - class(virtualMat), dimension(:), allocatable :: virtualMats + class(virtualMat), dimension(:), pointer :: virtualMats contains - procedure :: transit => timeTracking + procedure :: transit => multiGeomTracking procedure :: init procedure, private :: surfaceTracking procedure, private :: deltaTracking - procedure, private :: getMajInv end type transportOperatorGeomHT contains - subroutine timeTracking(self, p, tally, thisCycle, nextCycle) + !! + !! Update virtual materials if needed, and then begin particle journey with delta tracking. + !! + subroutine multiGeomTracking(self, p, tally, thisCycle, nextCycle) class(transportOperatorGeomHT), intent(inout) :: self class(particle), intent(inout) :: p type(tallyAdmin), intent(inout) :: tally @@ -70,8 +102,9 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) ! essentially copied and pasted from transportOperatorTime_class if desired to use ISMC here if (p % type == P_MATERIAL) call fatalError(Here, 'No support for ISMC in this transOp') - ! Update majorants if required - this would be better done at the end of time step in PP - ! to avoid check for each particle but I wanted to keep this class self-contained + ! Update majorants if required - this would be better done at the end of time step in PP to + ! avoid check for each particle and repetion in parallel but I wanted to keep this class + ! self-contained for now if (self % thisTimeStep /= thisStep()) then self % thisTimeStep = thisStep() do i = 1, size(self % virtualMats) @@ -89,7 +122,7 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) call tally % reportTrans(p) - end subroutine timeTracking + end subroutine multiGeomTracking !! !! Perform delta tracking @@ -107,11 +140,12 @@ subroutine deltaTracking(self, p) class(particle), intent(inout) :: p class(coordList), allocatable :: coords real(defReal) :: dTime, dColl, sigmaT, majorant_inv, dist, ratio - integer(shortInt) :: virtualMatIdx, testMat, uniqueID, event, i + integer(shortInt) :: virtualMatIdx, testMat, uniqueID, event character(100), parameter :: Here = 'deltaTracking (transportOperatorGeomHT_class.f90)' - ! Get majorant - call self % getMajInv(p, majorant_inv, virtualMatIdx) + ! Get index of virtual material and majorant inverse + call self % upperGeom % whatIsAt(virtualMatIdx, uniqueID, p % coords % lvl(1) % r) + majorant_inv = self % virtualMats(virtualMatIdx) % majorant_inv(p % G) ! Get initial local opacity sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) @@ -119,7 +153,7 @@ subroutine deltaTracking(self, p) DTLoop:do ! Switch to surface tracking if delta tracking is unsuitable - ratio = sigmaT*majorant_inv + ratio = sigmaT * majorant_inv if (ratio > ONE) call fatalError(Here, 'Local opacity greater than majorant') if (ratio < self % cutoff .or. majorant_inv == ZERO) then call self % surfaceTracking(p) @@ -144,14 +178,13 @@ subroutine deltaTracking(self, p) end if ! Check for change of upper geometry - call self % upperGeom % whatIsAt(testMat, uniqueID, coords % lvl(1) % r, coords % lvl(1) % dir) + call self % upperGeom % whatIsAt(testMat, uniqueID, coords % lvl(1) % r) if (testMat /= virtualMatIdx) then ! Move would take particle to a new cell call self % upperGeom % move(p % coords, dist, event) ! Get new majorant (particle already placed in upper geometry) virtualMatIdx = p % matIdx() - majorant_inv = self % virtualMats(virtualMatIdx) % majorant_inv - !call self % getMajInv(p, majorant_inv, virtualMatIdx) + majorant_inv = self % virtualMats(virtualMatIdx) % majorant_inv(p % G) ! Update particle time and place back in lower geometry p % time = p % time + dist / lightSpeed call self % geom % placeCoord(p % coords) @@ -173,14 +206,13 @@ subroutine deltaTracking(self, p) p % time = p % timeMax exit DTLoop - else if (dist == dColl) then! Dist == dColl + else if (dist == dColl) then ! Get local opacity and check for real or virtual collision sigmaT = self % xsData % getTransMatXS(p, p % matIdx()) if (p % pRNG % get() < sigmaT * majorant_inv) exit DTLoop else - call fatalError(Here, 'aaa') - + call fatalError(Here, 'Peculiar distance moved') end if end do DTLoop @@ -245,35 +277,6 @@ subroutine surfaceTracking(self, p) end subroutine surfaceTracking - - !! - !! Return the inverse majorant opacity - !! For DT or HT this will be constant, for GT this will be dependent on position - !! - !! Args: - !! p [in] -> particle - !! - !! Result: - !! maj_inv -> 1 / majorant opacity - !! - subroutine getMajInv(self, p, majorant_inv, virtualMatIdx) - class(transportOperatorGeomHT), intent(in) :: self - class(particle), intent(in) :: p - real(defReal), intent(out) :: majorant_inv - integer(shortInt), intent(out) :: virtualMatIdx - real(defReal), dimension(3) :: r, dir - integer(shortInt) :: uniqueID - - ! Get index of virtual material - r = p % coords % lvl(1) % r - dir = p % coords % lvl(1) % dir - call self % upperGeom % whatIsAt(virtualMatIdx, uniqueID, r, dir) - - ! Get 1/majorant - majorant_inv = self % virtualMats(virtualMatIdx) % majorant_inv - - end subroutine getMajInv - !! !! Provide transport operator with delta tracking/surface tracking cutoff !! @@ -310,7 +313,8 @@ subroutine init(self, dict) self % upperGeom => upperGeom ! Provide access to lower (standard) geometry - ! TODO: This assumes that there is only 1 other defined geometry + ! TODO: Really geometry and xsData should be inputs to init, but would need to change all + ! other transport operators self % geom => gr_geomPtr(1) self % xsData => ndReg_get(P_PHOTON_MG) @@ -365,6 +369,7 @@ subroutine init(self, dict) do i = 1, size(self % virtualMats) call self % virtualMats (i) % updateMajorant() end do + self % thisTimeStep = thisStep() end subroutine init diff --git a/TransportOperator/transportOperatorTime_class.f90 b/TransportOperator/transportOperatorTime_class.f90 index cd3d96f6b..cda201b59 100644 --- a/TransportOperator/transportOperatorTime_class.f90 +++ b/TransportOperator/transportOperatorTime_class.f90 @@ -48,22 +48,14 @@ subroutine timeTracking(self, p, tally, thisCycle, nextCycle) class(particleDungeon), intent(inout) :: nextCycle character(100), parameter :: Here = 'timeTracking (transportOperatorTime_class.f90)' - ! Transform material particles into photons + ! Transform material particles into photons - for use in ISMC if (p % type == P_MATERIAL) then call self % materialTransform(p, tally) ! Exit at time boundary if (p % fate == AGED_FATE) return end if - ! Check for particle leakage - if (p % matIdx() == OUTSIDE_FILL) then - ! TODO: Figure out why this sometimes happens - print *, 'WARNING: Leak before transport?' - p % fate = LEAK_FATE - p % isDead = .true. - return - end if - + ! Perform tracking call self % surfaceTracking(p) ! Check for particle leakage diff --git a/TransportOperator/virtualMat_class.f90 b/TransportOperator/virtualMat_class.f90 index fb612aa04..fe16d3771 100644 --- a/TransportOperator/virtualMat_class.f90 +++ b/TransportOperator/virtualMat_class.f90 @@ -1,4 +1,3 @@ - module virtualMat_class use numPrecision @@ -12,16 +11,22 @@ module virtualMat_class use particle_class, only : particle, P_PHOTON, P_MATERIAL + use materialEquations, only : mgEnergyGrid + implicit None private !! + !! Fake material class used for multiGeom delta tracking. Fills upper geometry cells, and stores + !! information about the real materials overlapped in the lower geometry, specifically which + !! materials these are and the majorant_inv within the upper geometry cell. !! + !! See transportOperatorGeomHT_class.f90 for example of use. !! - type, public :: virtualMat - type(dynIntArray) :: realMats - real(defReal) :: majorant_inv - class(nuclearDatabase), pointer :: xsData + type, public :: virtualMat + type(dynIntArray) :: realMats + real(defReal), dimension(:), allocatable :: majorant_inv + class(nuclearDatabase), pointer :: xsData contains procedure :: init procedure :: addRealMat @@ -30,15 +35,32 @@ module virtualMat_class contains + !! + !! Allocate space for majorants + !! subroutine init(self, nucData) class(virtualMat), intent(inout) :: self class(nuclearDatabase), pointer, intent(in) :: nucData + integer(shortInt) :: nG self % xsData => nucData - end subroutine + ! Allocate space for majorants + ! TODO: Currently this method of obtaining nG is specific to MG IMC + if(associated(mgEnergyGrid)) then + nG = mgEnergyGrid % getSize() + else + nG = 1 + end if + allocate(self % majorant_inv(nG)) + + end subroutine + !! + !! Add matIdx to the list of real materials in the underlying geometry that overlap with the + !! region occupied by this virtual material. + !! subroutine addRealMat(self, matIdx) class(virtualMat), intent(inout) :: self integer(shortInt), intent(in) :: matIdx @@ -50,29 +72,33 @@ subroutine addRealMat(self, matIdx) end subroutine addRealMat - + !! + !! Update the majorant_inv for each group + !! subroutine updateMajorant(self) class(virtualMat), intent(inout) :: self - integer(shortInt) :: i + integer(shortInt) :: i, G real(defReal) :: majorant, sigma class(particle), allocatable :: p character(100), parameter :: Here = '' + ! Create particle for call to obtain XS - no data needed except p % G allocate(p) - !p % type = P_PHOTON - !p % isMG = .true. - ! TODO: Loop through groups when doing MG simulations - p % G = 1 + p % isMG = .true. majorant = ZERO - ! Find majorant opacity of virtual material - do i = 1, self % realMats % getSize() - sigma = self % xsData % getTransMatXS(p, self % realMats % get(i)) - if (sigma > majorant) majorant = sigma - end do + ! Find majorant opacity of virtual material for each group + do G = 1, size(self % majorant_inv) + p % G = G + do i = 1, self % realMats % getSize() + sigma = self % xsData % getTransMatXS(p, self % realMats % get(i)) + if (sigma > majorant) majorant = sigma + end do - self % majorant_inv = ONE/majorant + self % majorant_inv(G) = ONE/majorant + + end do end subroutine updateMajorant From fe2b5a53659326af062f4bfb8bb025143ff9390e Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 5 Jan 2024 18:27:56 +0000 Subject: [PATCH 368/373] Fixed numerical issue causing errors when a virtual mat sat entirely on a void region --- Geometry/geometryGrid_class.f90 | 3 ++- InputFiles/IMC/hohlraum | 7 ++++++- Tallies/TallyClerks/energyWeightClerk_class.f90 | 2 +- TransportOperator/transportOperatorGeomHT_class.f90 | 2 +- TransportOperator/virtualMat_class.f90 | 8 +++++++- 5 files changed, 17 insertions(+), 5 deletions(-) diff --git a/Geometry/geometryGrid_class.f90 b/Geometry/geometryGrid_class.f90 index ee1dddeb8..c5a3e0292 100644 --- a/Geometry/geometryGrid_class.f90 +++ b/Geometry/geometryGrid_class.f90 @@ -256,7 +256,7 @@ elemental subroutine kill(self) class(geometryGrid), intent(inout) :: self call self % geom % kill() - !TODO + deallocate(self % mats) end subroutine kill @@ -512,6 +512,7 @@ end subroutine explicitBC !! See geometry_inter for details !! !! NOTE: This function uses VOID_MAT and UNDEF_MAT from universalVariables + !! VOID_MAT will be listed multiple times if it occurs in multiple locations !! function activeMats(self) result(matList) class(geometryGrid), intent(in) :: self diff --git a/InputFiles/IMC/hohlraum b/InputFiles/IMC/hohlraum index a71e71344..8b1701bc0 100644 --- a/InputFiles/IMC/hohlraum +++ b/InputFiles/IMC/hohlraum @@ -13,7 +13,12 @@ collisionOperator { } transportOperator { - type transportOperatorTime; + //type transportOperatorTime; + type transportOperatorGeomHT; + cutoff 0.5; + geometry { type geometryGrid; boundary (0 0 0 0 1 1); dimensions (40 40 1); + bounds (-0.5 -0.5 -0.5 0.5 0.5 0.5); gridOnly y; } + searchN (200 200 1); } source { diff --git a/Tallies/TallyClerks/energyWeightClerk_class.f90 b/Tallies/TallyClerks/energyWeightClerk_class.f90 index 6da618bea..6f12fec0e 100644 --- a/Tallies/TallyClerks/energyWeightClerk_class.f90 +++ b/Tallies/TallyClerks/energyWeightClerk_class.f90 @@ -86,7 +86,7 @@ module energyWeightClerk_class end type energyWeightClerk !! - !! Result class, gives access to tallied material energy and radiatino energy + !! Result class, gives access to tallied material energy and radiation energy !! type, public, extends(tallyResult) :: energyWeightClerkResult real(defReal), dimension(:), allocatable :: materialEnergy diff --git a/TransportOperator/transportOperatorGeomHT_class.f90 b/TransportOperator/transportOperatorGeomHT_class.f90 index d531e15db..d0be410d5 100644 --- a/TransportOperator/transportOperatorGeomHT_class.f90 +++ b/TransportOperator/transportOperatorGeomHT_class.f90 @@ -155,7 +155,7 @@ subroutine deltaTracking(self, p) ! Switch to surface tracking if delta tracking is unsuitable ratio = sigmaT * majorant_inv if (ratio > ONE) call fatalError(Here, 'Local opacity greater than majorant') - if (ratio < self % cutoff .or. majorant_inv == ZERO) then + if (ratio <= self % cutoff .or. majorant_inv == ZERO) then call self % surfaceTracking(p) return end if diff --git a/TransportOperator/virtualMat_class.f90 b/TransportOperator/virtualMat_class.f90 index fe16d3771..06111eb1d 100644 --- a/TransportOperator/virtualMat_class.f90 +++ b/TransportOperator/virtualMat_class.f90 @@ -96,7 +96,13 @@ subroutine updateMajorant(self) if (sigma > majorant) majorant = sigma end do - self % majorant_inv(G) = ONE/majorant + ! Avoid infinite maj_inv for virtualMat cells containing only void + if (majorant == ZERO) then + ! maj_inv = 0 forces particle to default to ST in transport operator to avoid issues + self % majorant_inv(G) = ZERO + else + self % majorant_inv(G) = ONE/majorant + end if end do From ac9de16280e493a36eacf50f7c0e703a3b3a94be Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 5 Jan 2024 19:07:42 +0000 Subject: [PATCH 369/373] Removed unnecessary function --- NuclearData/materialMenu_mod.f90 | 32 +------------------ .../baseMgIMC/baseMgIMCDatabase_class.f90 | 2 +- 2 files changed, 2 insertions(+), 32 deletions(-) diff --git a/NuclearData/materialMenu_mod.f90 b/NuclearData/materialMenu_mod.f90 index 8094813d3..45f51bd78 100644 --- a/NuclearData/materialMenu_mod.f90 +++ b/NuclearData/materialMenu_mod.f90 @@ -17,7 +17,6 @@ !! nMat -> Return number of materials !! matName -> Return material Name given Index !! matTemp -> Return material Temperature given Index -!! matVol -> Return material Volume given Index !! matFile -> Return file path to material data given matIdx !! matIdx -> Return material Index given Name !! @@ -118,7 +117,6 @@ module materialMenu_mod public :: nMat public :: matName public :: matTemp - public :: matVol public :: matFile public :: matIdx @@ -254,31 +252,6 @@ function matTemp(idx) result(T) end function matTemp - !! - !! Return volume of material given index - !! - !! Args: - !! idx [in] -> Material Index - !! - !! Result: - !! Volume of material as given in input file - !! - !! Errors: - !! If idx is -ve or larger then number of defined materials - !! then -1 is returned as its volume - !! - function matVol(idx) result(vol) - integer(shortInt), intent(in) :: idx - real(defReal) :: vol - - if( idx <= 0 .or. nMat() < idx) then - vol = -ONE - else - vol = materialDefs(idx) % V - end if - - end function matVol - !! !! Return file path to material XS data given index !! @@ -342,7 +315,7 @@ subroutine init_materialItem(self, name, dict) ! Return to initial state call self % kill() - ! Load easy components c + ! Load easy components self % name = name call dict % get(self % T,'temp') call dict % getOrDefault(self % V, 'volume', ZERO) @@ -384,9 +357,6 @@ subroutine init_materialItem(self, name, dict) ! Save dictionary self % extraInfo = dict - ! TODO: Remove composition subdictionary from extraInfo - ! Or rather do not copy it in the first place - end subroutine init_materialItem !! diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 index fcbf3208c..b7ff9391a 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCDatabase_class.f90 @@ -429,7 +429,7 @@ subroutine init(self, dict, ptr, silent) ! Add temperature and volume into dictionary call tempDict % store('T', matDef % T) - call tempDict % store('V', matdef % V) + call tempDict % store('V', matDef % V) ! Initialise material call self % mats(i) % init(tempDict) From ef00ba1d16e2acab66008b725bdda9676a7e4b07 Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 5 Jan 2024 21:03:39 +0000 Subject: [PATCH 370/373] Fixed CMakeLists --- ParticleObjects/Source/CMakeLists.txt | 2 +- SharedModules/CMakeLists.txt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ParticleObjects/Source/CMakeLists.txt b/ParticleObjects/Source/CMakeLists.txt index 9d47d2efd..0fd52efa7 100644 --- a/ParticleObjects/Source/CMakeLists.txt +++ b/ParticleObjects/Source/CMakeLists.txt @@ -5,6 +5,6 @@ add_sources( source_inter.f90 pointSource_class.f90 fissionSource_class.f90 materialSource_class.f90 - IMCMaterialSource_class.f90 + imcMaterialSource_class.f90 blackBodySource_class.f90 ) diff --git a/SharedModules/CMakeLists.txt b/SharedModules/CMakeLists.txt index 7bd2eb155..8320d6e8d 100644 --- a/SharedModules/CMakeLists.txt +++ b/SharedModules/CMakeLists.txt @@ -12,7 +12,7 @@ add_sources( ./genericProcedures.f90 ./timer_mod.f90 ./charLib_func.f90 ./openmp_func.f90 - ./simulationTime_class.f90) + ./simulationTime_class.f90 ./errors_mod.f90) add_unit_tests( ./Tests/grid_test.f90 From 610a9952f90d279a5da9c91ac436b12afad2d42c Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 5 Jan 2024 21:43:04 +0000 Subject: [PATCH 371/373] Fixed remaining errors from merge, code now compiling and running --- Geometry/discretiseGeom_class.f90 | 5 +++-- Geometry/geometryReg_mod.f90 | 5 ----- NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 | 5 ++--- ParticleObjects/Source/blackBodySource_class.f90 | 2 +- ParticleObjects/Source/sourceFactory_func.f90 | 2 +- PhysicsPackages/implicitPhysicsPackage_class.f90 | 5 +++-- Tallies/TallyClerks/tallyClerkFactory_func.f90 | 2 +- TransportOperator/transportOperatorGeomHT_class.f90 | 5 +++-- 8 files changed, 14 insertions(+), 17 deletions(-) diff --git a/Geometry/discretiseGeom_class.f90 b/Geometry/discretiseGeom_class.f90 index f0d828669..1de86bf70 100644 --- a/Geometry/discretiseGeom_class.f90 +++ b/Geometry/discretiseGeom_class.f90 @@ -23,9 +23,10 @@ module discretiseGeom_class ! Geometry use geometry_inter, only : geometry use geometryReg_mod, only : gr_geomPtr => geomPtr, & - gr_addGeom => addGeom, & gr_geomIdx => geomIdx, & gr_kill => kill + use geometryFactory_func, only : new_geometry + ! Nuclear Data use materialMenu_mod, only : mm_matTemp => matTemp ,& mm_matFile => matFile @@ -90,7 +91,7 @@ subroutine discretise(dict, newGeom, newData) ! Build geometry using input tempDict => dict % getDictPtr('geometry') geomName = 'inputGeom' - call gr_addGeom(geomName, tempDict) + call new_geometry(tempDict, geomName) inputGeomIdx = gr_geomIdx(geomName) inputGeom => gr_geomPtr(inputGeomIdx) diff --git a/Geometry/geometryReg_mod.f90 b/Geometry/geometryReg_mod.f90 index 4c3a1607b..153bd4443 100644 --- a/Geometry/geometryReg_mod.f90 +++ b/Geometry/geometryReg_mod.f90 @@ -34,11 +34,6 @@ module geometryReg_mod ! Geometry use geometry_inter, only : geometry -<<<<<<< HEAD - use geometryStd_class, only : geometryStd - use geometryGrid_class, only : geometryGrid -======= ->>>>>>> SCONE/main ! Fields use field_inter, only : field diff --git a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 index 7931af9aa..bf2ee5521 100644 --- a/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 +++ b/NuclearData/mgIMCData/baseMgIMC/baseMgIMCMaterial_class.f90 @@ -6,7 +6,6 @@ module baseMgIMCMaterial_class use genericProcedures, only : fatalError, numToChar use RNG_class, only : RNG use dictionary_class, only : dictionary - use poly_func use simulationTime_class, only : timeStep ! Nuclear Data Interfaces @@ -360,7 +359,7 @@ subroutine updateMat(self, tallyEnergy, loud) real(defReal), intent(in) :: tallyEnergy logical(defBool), intent(in), optional :: loud real(defReal) :: prevTemp, change - character(100), parameter :: Here = "updateMat (baseMgIMCMaterial_class.f90)" + character(100), parameter :: Here = 'updateMat (baseMgIMCMaterial_class.f90)' ! Save previous energy and temperature self % prevMatEnergy = self % matEnergy @@ -446,7 +445,7 @@ function tempFromEnergy(self) result(T) i = i+1 if (i > 100000) then print *, 'Energy density: ', self % energyDens - call fatalError(Here, "100,000 iterations without convergence, maybe NaN energy density?") + call fatalError(Here, '100,000 iterations without convergence, maybe NaN energy density?') end if ! Increase step size to avoid lack of convergence due to very small starting temperature if (mod(i,1000)==0) dT = 10*dT diff --git a/ParticleObjects/Source/blackBodySource_class.f90 b/ParticleObjects/Source/blackBodySource_class.f90 index 703582dea..4d24790b0 100644 --- a/ParticleObjects/Source/blackBodySource_class.f90 +++ b/ParticleObjects/Source/blackBodySource_class.f90 @@ -34,7 +34,7 @@ module blackBodySource_class !! isMG -> is the source multi-group? (yes) !! !! Interface: - !! init -> initialise point source + !! init -> initialise source !! append -> source particles and add to existing dungeon !! sampleType -> set particle type !! samplePosition -> set particle position diff --git a/ParticleObjects/Source/sourceFactory_func.f90 b/ParticleObjects/Source/sourceFactory_func.f90 index 6c7c93aac..c279a694d 100644 --- a/ParticleObjects/Source/sourceFactory_func.f90 +++ b/ParticleObjects/Source/sourceFactory_func.f90 @@ -66,7 +66,7 @@ subroutine new_source(new, dict, geom) allocate(blackBodySource :: new) case('imcMaterialSource') - allocate(blackBodySource :: new) + allocate(imcMaterialSource :: new) case default print *, AVAILABLE_sources diff --git a/PhysicsPackages/implicitPhysicsPackage_class.f90 b/PhysicsPackages/implicitPhysicsPackage_class.f90 index acf61ae23..f83092b8c 100644 --- a/PhysicsPackages/implicitPhysicsPackage_class.f90 +++ b/PhysicsPackages/implicitPhysicsPackage_class.f90 @@ -23,8 +23,9 @@ module implicitPhysicsPackage_class ! Geometry use geometry_inter, only : geometry - use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & + use geometryReg_mod, only : gr_geomPtr => geomPtr, & gr_geomIdx => geomIdx + use geometryFactory_func, only : new_geometry use discretiseGeom_class, only : discretise ! Nuclear Data @@ -492,7 +493,7 @@ subroutine init(self, dict) ! Build geometry geomName = 'IMCGeom' - call gr_addGeom(geomName, dict % getDictPtr('geometry')) + call new_geometry(dict % getDictPtr('geometry'), geomName) self % geomIdx = gr_geomIdx(geomName) self % geom => gr_geomPtr(self % geomIdx) diff --git a/Tallies/TallyClerks/tallyClerkFactory_func.f90 b/Tallies/TallyClerks/tallyClerkFactory_func.f90 index c8b5c9bf4..71a2003bc 100644 --- a/Tallies/TallyClerks/tallyClerkFactory_func.f90 +++ b/Tallies/TallyClerks/tallyClerkFactory_func.f90 @@ -38,7 +38,7 @@ module tallyClerkFactory_func 'shannonEntropyClerk ',& 'centreOfMassClerk ',& 'dancoffBellClerk ',& - 'energyWeightClerk '] + 'energyWeightClerk ',& 'mgXsClerk '] contains diff --git a/TransportOperator/transportOperatorGeomHT_class.f90 b/TransportOperator/transportOperatorGeomHT_class.f90 index d0be410d5..63fe2ad4a 100644 --- a/TransportOperator/transportOperatorGeomHT_class.f90 +++ b/TransportOperator/transportOperatorGeomHT_class.f90 @@ -17,8 +17,9 @@ module transportOperatorGeomHT_class ! Geometry interfaces use geometry_inter, only : geometry use geometryGrid_class, only : geometryGrid - use geometryReg_mod, only : gr_geomPtr => geomPtr, gr_addGeom => addGeom, & + use geometryReg_mod, only : gr_geomPtr => geomPtr, & gr_geomIdx => geomIdx + use geometryFactory_func, only : new_geometry use coord_class, only : coordList ! Tally interface @@ -307,7 +308,7 @@ subroutine init(self, dict) ! Build upper level geometry geomName = 'surfaceGeom' tempDict => dict % getDictPtr('geometry') - call gr_addGeom(geomName, tempDict) + call new_geometry(tempDict, geomName) self % upperGeomIdx = gr_geomIdx(geomName) upperGeom => gr_geomPtr(self % upperGeomIdx) self % upperGeom => upperGeom From b48c57ef582166ee4abdd1586a833bf27a5b3dcc Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 5 Jan 2024 23:25:18 +0000 Subject: [PATCH 372/373] Minor input file changes --- InputFiles/IMC/marshakWave | 8 ++++---- InputFiles/IMC/olson1D | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/InputFiles/IMC/marshakWave b/InputFiles/IMC/marshakWave index 427affb3a..216fe6912 100644 --- a/InputFiles/IMC/marshakWave +++ b/InputFiles/IMC/marshakWave @@ -4,10 +4,10 @@ type implicitPhysicsPackage; method IMC; -pop 10000; -limit 25000; -steps 5000; -timeStep 0.1; +pop 100000; +limit 250000; +steps 1000; +timeStep 0.5; units marshak; collisionOperator { photonMG {type IMCMGstd;} } diff --git a/InputFiles/IMC/olson1D b/InputFiles/IMC/olson1D index f4168614e..e8bd2b347 100644 --- a/InputFiles/IMC/olson1D +++ b/InputFiles/IMC/olson1D @@ -1,7 +1,7 @@ type implicitPhysicsPackage; -method IMC; +method ISMC; pop 5000; limit 1000000; steps 1333; @@ -60,7 +60,7 @@ nuclearData { materials { - mat1 { temp 0.01; composition {} xsFile ./dataFiles/olsonData; } + mat1 { temp 0.01; composition {} xsFile ./DataFiles/olsonData; } } From 5b2611815d7fd2f505675fb92adf9f6a9e91b6ad Mon Sep 17 00:00:00 2001 From: ajb343 Date: Fri, 5 Jan 2024 23:35:16 +0000 Subject: [PATCH 373/373] Adjusted alignment slightly --- ParticleObjects/Source/imcMaterialSource_class.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ParticleObjects/Source/imcMaterialSource_class.f90 b/ParticleObjects/Source/imcMaterialSource_class.f90 index 3c661de41..ef8cf4e17 100644 --- a/ParticleObjects/Source/imcMaterialSource_class.f90 +++ b/ParticleObjects/Source/imcMaterialSource_class.f90 @@ -73,7 +73,7 @@ module imcMaterialSource_class !! See source_inter for details !! subroutine init(self, dict, geom) - class(imcMaterialSource), intent(inout) :: self + class(imcMaterialSource), intent(inout) :: self class(dictionary), intent(in) :: dict class(geometry), pointer, intent(in) :: geom character(100), parameter :: Here = 'init (imcMaterialSource_class.f90)' @@ -114,7 +114,7 @@ end subroutine init !! already present in dungeon !! subroutine append(self, dungeon, N, rand) - class(imcMaterialSource), intent(inout) :: self + class(imcMaterialSource), intent(inout) :: self type(particleDungeon), intent(inout) :: dungeon integer(shortInt), intent(in) :: N class(RNG), intent(inout) :: rand @@ -187,8 +187,8 @@ end subroutine append !! function sampleParticle(self, rand) result(p) class(imcMaterialSource), intent(inout) :: self - class(RNG), intent(inout) :: rand - type(particleState) :: p + class(RNG), intent(inout) :: rand + type(particleState) :: p character(100), parameter :: Here = 'sampleParticle (imcMaterialSource_class.f90)' ! Should not be called, useful to have extra inputs so use sampleIMC instead @@ -211,7 +211,7 @@ end function sampleParticle !! geometryStd, and bounds of single material if using geometryGrid !! function sampleIMC(self, rand, targetMatIdx, energy, G, bounds) result(p) - class(imcMaterialSource), intent(inout) :: self + class(imcMaterialSource), intent(inout) :: self class(RNG), intent(inout) :: rand integer(shortInt), intent(in) :: targetMatIdx real(defReal), intent(in) :: energy