From 04a37746f800d6cb2011526febefc0b56aa0d1b0 Mon Sep 17 00:00:00 2001 From: "V. Raffuzzi(vr339)" Date: Mon, 5 Feb 2024 17:17:57 +0000 Subject: [PATCH] Add routines to calculate majorant also with ures on --- .../Tests/aceNeutronDatabase_iTest.f90 | 9 + .../Tests/thermalScatteringData_iTest.f90 | 2 +- .../Tests/urrProbabilityTables_iTest.f90 | 2 +- .../aceDatabase/aceNeutronDatabase_class.f90 | 188 ++++++++++++++---- .../aceDatabase/aceNeutronNuclide_class.f90 | 35 ++-- .../urrProbabilityTables_class.f90 | 56 +++++- NuclearData/nuclearDatabase_inter.f90 | 1 + .../testNeutronDatabase_class.f90 | 1 - 8 files changed, 234 insertions(+), 60 deletions(-) diff --git a/NuclearData/ceNeutronData/aceDatabase/Tests/aceNeutronDatabase_iTest.f90 b/NuclearData/ceNeutronData/aceDatabase/Tests/aceNeutronDatabase_iTest.f90 index 697cfcf9b..69a08e08d 100644 --- a/NuclearData/ceNeutronData/aceDatabase/Tests/aceNeutronDatabase_iTest.f90 +++ b/NuclearData/ceNeutronData/aceDatabase/Tests/aceNeutronDatabase_iTest.f90 @@ -223,6 +223,15 @@ subroutine test_aceNeutronDatabase() p % E = 19.9_defReal @assertEqual(ONE, data % getMajorantXS(p)/0.21869599644_defReal , TOL) + ! Check that results are the same with on-the-fly majorant + data % hasMajorant = .false. + + p % E = 1.1E-6_defReal + @assertEqual(ONE, data % getMajorantXS(p) /4.4149556129495560_defReal , TOL) + + p % E = 19.9_defReal + @assertEqual(ONE, data % getMajorantXS(p)/0.21869599644_defReal , TOL) + !<><><><><><><><><><><><><><><><><><><><> ! Test getting Macroscopic XSs ! diff --git a/NuclearData/ceNeutronData/aceDatabase/Tests/thermalScatteringData_iTest.f90 b/NuclearData/ceNeutronData/aceDatabase/Tests/thermalScatteringData_iTest.f90 index 447a5ed8d..61c75c77a 100644 --- a/NuclearData/ceNeutronData/aceDatabase/Tests/thermalScatteringData_iTest.f90 +++ b/NuclearData/ceNeutronData/aceDatabase/Tests/thermalScatteringData_iTest.f90 @@ -66,7 +66,7 @@ subroutine test_thermalScatteringData() ! Initialise data ptr => data call data % init(dataDict, ptr, silent = .true.) - call data % activate(([1,2])) + call data % activate(([1,2]), silent = .true.) !!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! Perform tests diff --git a/NuclearData/ceNeutronData/aceDatabase/Tests/urrProbabilityTables_iTest.f90 b/NuclearData/ceNeutronData/aceDatabase/Tests/urrProbabilityTables_iTest.f90 index 149c6fa2d..6afb16e30 100644 --- a/NuclearData/ceNeutronData/aceDatabase/Tests/urrProbabilityTables_iTest.f90 +++ b/NuclearData/ceNeutronData/aceDatabase/Tests/urrProbabilityTables_iTest.f90 @@ -57,7 +57,7 @@ subroutine test_urrProbabilityTables() ! Initialise data ptr => data call data % init(dataDict, ptr, silent = .true.) - call data % activate([1]) + call data % activate([1], silent = .true.) !!<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> !! Perform tests diff --git a/NuclearData/ceNeutronData/aceDatabase/aceNeutronDatabase_class.f90 b/NuclearData/ceNeutronData/aceDatabase/aceNeutronDatabase_class.f90 index 78280d7d0..a60c49b0a 100644 --- a/NuclearData/ceNeutronData/aceDatabase/aceNeutronDatabase_class.f90 +++ b/NuclearData/ceNeutronData/aceDatabase/aceNeutronDatabase_class.f90 @@ -52,9 +52,6 @@ module aceNeutronDatabase_class !! It's possible to use probability tables in the unresolved resonance range if !! ures is included in the input file !! - !! NOTE: the unionised majorant is not calculated and used if probability tables - !! are on - !! !! Sample input: !! nuclearData { !! handles { @@ -112,8 +109,8 @@ module aceNeutronDatabase_class procedure :: getScattMicroMajXS ! class Procedures - procedure :: init_urr - procedure :: init_DBRC + procedure :: initUrr + procedure :: initDBRC procedure :: initMajorant end type aceNeutronDatabase @@ -446,16 +443,18 @@ subroutine updateTotalNucXS(self, E, nucIdx, rand) ! Check if the nuclide needs ures probability tables at this energy nucCache % needsUrr = (nuc % hasProbTab .and. E >= nuc % urrE(1) .and. E <= nuc % urrE(2)) ! Check if the nuclide needs S(a,b) at this energy - nucCache % needsSabEl = (nuc % hasThData .and. E >= nuc % SabEl(1) .and. E < nuc % SabEl(2)) - nucCache % needsSabInel = (nuc % hasThData .and. E >= nuc % SabInel(1) .and. E < nuc % SabInel(2)) + nucCache % needsSabEl = (nuc % hasThData .and. E >= nuc % SabEl(1) .and. E <= nuc % SabEl(2)) + nucCache % needsSabInel = (nuc % hasThData .and. E >= nuc % SabInel(1) .and. E <= nuc % SabInel(2)) needsSab = (nucCache % needsSabEl .or. nucCache % needsSabInel) if (nucCache % needsUrr .or. needsSab) then call self % updateMicroXSs(E, nucIdx, rand) + else nucCache % E_tot = E call nuc % search(nucCache % idx, nucCache % f, E) nucCache % xss % total = nuc % totalXS(nucCache % idx, nucCache % f) + end if end associate @@ -489,17 +488,23 @@ subroutine updateMicroXSs(self, E, nucIdx, rand) ! Check if probability tables should be read if (nucCache % needsUrr) then associate(zaidCache => cache_zaidCache(self % nucToZaid(nucIdx))) + if (zaidCache % E /= E) then ! Save random number for temperature correlation zaidCache % xi = rand % get() zaidCache % E = E end if + call nuc % getUrrXSs(nucCache % xss, nucCache % idx, nucCache % f, E, zaidCache % xi) + end associate + elseif (nucCache % needsSabEl .or. nucCache % needsSabInel) then call nuc % getThXSs(nucCache % xss, nucCache % idx, nucCache % f, E) + else call nuc % microXSs(nucCache % xss, nucCache % idx, nucCache % f) + end if end associate @@ -642,11 +647,11 @@ subroutine init(self, dict, ptr, silent ) ! Initialise S(alpha,beta) tables if (idx /= 0 ) then call new_moderACE(ACE_Sab, name_file) - call self % nuclides(nucIdx) % init_Sab(ACE_Sab) + call self % nuclides(nucIdx) % initSab(ACE_Sab) end if ! Initialise probability tables - if (self % hasUrr) call self % nuclides(nucIdx) % init_urr(ACE) + if (self % hasUrr) call self % nuclides(nucIdx) % initUrr(ACE) ! Store nucIdx in the dictionary call nucSet % atSet(nucIdx, i) @@ -697,12 +702,12 @@ subroutine init(self, dict, ptr, silent ) ! If on, initialise probability tables for ures if (self % hasUrr) then - call self % init_urr() + call self % initUrr() end if ! If on, initialise DBRC if (self % hasDBRC) then - call self % init_DBRC(nucDBRC, nucSet, self % mapDBRCnuc) + call self % initDBRC(nucDBRC, nucSet, self % mapDBRCnuc) end if !! Clean up @@ -716,7 +721,7 @@ end subroutine init !! NOTE: compares the first 5 letters of the ZAID.TT. It would be wrong with isotopes !! with Z > 99 !! - subroutine init_urr(self) + subroutine initUrr(self) class(aceNeutronDatabase), intent(inout) :: self integer(shortInt) :: i, j character(nameLen) :: zaid @@ -747,12 +752,12 @@ subroutine init_urr(self) end if end do - end subroutine init_urr + end subroutine initUrr !! !! Checks through all nuclides, creates map with nuclides present and corresponding 0K nuclide !! - subroutine init_DBRC(self, nucDBRC, nucSet, map) + subroutine initDBRC(self, nucDBRC, nucSet, map) class(aceNeutronDatabase), intent(inout) :: self character(nameLen), dimension(:), intent(in) :: nucDBRC type(charMap), intent(in) :: nucSet @@ -796,7 +801,7 @@ subroutine init_DBRC(self, nucDBRC, nucSet, map) end do - end subroutine init_DBRC + end subroutine initDBRC !! !! Activate this nuclearDatabase @@ -830,23 +835,8 @@ subroutine activate(self, activeMat, silent) loud = .true. end if - ! Check if probability tables are on - if (self % hasUrr) then - - ! Switch off majorant - self % hasMajorant = .false. - - if (loud) then - print '(A)', 'Unionised majorant cross section will not be contructed & - & due to the use of URR probability tables treatment' - end if - - else - - ! Precompute majorant cross section - call self % initMajorant(loud) - - end if + ! Precompute majorant cross section + call self % initMajorant(loud) end if @@ -861,11 +851,15 @@ subroutine initMajorant(self, loud) class(aceNeutronDatabase), intent(inout) :: self logical(defBool), intent(in) :: loud real(defReal), dimension(:), allocatable :: tmpGrid - integer(shortInt) :: i, j, matIdx, nNuc, nucIdx, isDone, & - sizeGrid, eIdx, nucIdxLast, eIdxLast + integer(shortInt) :: i, j, k, matIdx, nNuc, nucIdx, isDone, & + sizeGrid, eIdx, nucIdxLast, eIdxLast, & + urrIdx type(intMap) :: nucSet - real(defReal) :: eRef, eNuc, E, maj + real(defReal) :: eRef, eNuc, E, maj, total, dens, urrMaj, & + nucXS, f, eMax, eMin + logical(defBool) :: needsUrr integer(shortInt), parameter :: IN_SET = 1, NOT_PRESENT = 0 + real(defReal), parameter :: NUDGE = 1.0e-06_defReal ! Find the size of the unionised energy grid (with duplicates) ! Initialise size @@ -894,6 +888,11 @@ subroutine initMajorant(self, loud) ! Update energy grid size sizeGrid = sizeGrid + size(self % nuclides(nucIdx) % eGrid) + ! If URR probability tables or S(a,b) tables are used, add their energy + ! boundary values to the grid to minimise interpolation errors + if (self % nuclides(nucIdx) % hasProbTab) sizeGrid = sizeGrid + 2 + if (self % nuclides(nucIdx) % hasThData) sizeGrid = sizeGrid + 3 + end if end do @@ -904,7 +903,8 @@ subroutine initMajorant(self, loud) tmpGrid = self % EBounds(2) ! Loop over the energy grid - do i = 1, sizeGrid + i = 1 + do while (i < sizeGrid) ! Loop over all nuclides in the set - here the value of the intMap is used as an energy index j = nucSet % begin() @@ -944,6 +944,76 @@ subroutine initMajorant(self, loud) ! Increment the energy index saved in the intMap for the nuclides whose energy was added call nucSet % add(nucIdxLast, eIdxLast + 1) + ! Loop over all nuclides again to add S(a,b) and ures energy boundaries to grid + j = nucSet % begin() + do while (j /= nucSet % end()) + + ! Retrieve energy in the grid and nuclide information + eMin = tmpGrid(i - 1) + eMax = tmpGrid(i) + nucIdx = nucSet % atKey(j) + + ! Check for URR probability tables + if (self % nuclides(nucIdx) % hasProbTab) then + + ! Lower energy boundary + E = self % nuclides(nucIdx) % urrE(1) + if (E >= eMin .and. E < eMax) then + tmpGrid(i) = E + tmpGrid(i + 1) = eMax + ! Update counter + i = i + 1 + end if + + ! Upper energy boundary + E = self % nuclides(nucIdx) % urrE(2) + if (E >= eMin .and. E < eMax) then + tmpGrid(i) = E + tmpGrid(i + 1) = eMax + ! Update counter + i = i + 1 + end if + + end if + + ! Check for Sab tables + if (self % nuclides(nucIdx) % hasThData) then + + ! Elastic upper energy boundary (NOTE: lower boundary is fixed) + E = self % nuclides(nucIdx) % SabEl(2) + if (E >= eMin .and. E < eMax ) then + tmpGrid(i) = E + tmpGrid(i + 1) = eMax + ! Update counter + i = i + 1 + end if + + ! Inelastic lower energy boundary + E = self % nuclides(nucIdx) % SabInel(1) + if (E >= eMin .and. E < eMax ) then + tmpGrid(i) = E + tmpGrid(i + 1) = eMax + ! Update counter + i = i + 1 + end if + + ! Inelastic upper energy boundary + E = self % nuclides(nucIdx) % SabInel(2) + if (E >= eMin .and. E < eMax ) then + tmpGrid(i) = E + tmpGrid(i + 1) = eMax + ! Update counter + i = i + 1 + end if + + end if + + j = nucSet % next(j) + + end do + + i = i + 1 + end do ! Save final grid and remove duplicates @@ -974,15 +1044,51 @@ subroutine initMajorant(self, loud) ! Get material index matIdx = self % activeMat(j) + total = ZERO + + ! Loop over nuclides + do k = 1, size(self % materials(matIdx) % nuclides) + dens = self % materials(matIdx) % dens(k) + nucIdx = self % materials(matIdx) % nuclides(k) + + associate (nuc => self % nuclides(nucIdx)) + + needsUrr = (nuc % hasProbTab .and. E >= nuc % urrE(1) .and. E <= nuc % urrE(2)) + + ! Check if present nuclide uses URR tabes + if (needsUrr) then + + ! Find maximum URR table total XS + urrIdx = binarySearch(nuc % probTab % eGrid, E) + urrMaj = nuc % probTab % majorant(urrIdx) + + ! Check if URR tables contain xs or multiplicative factor + if (nuc % IFF == 1) then + call nuc % search(eIdx, f, E) + nucXS = nuc % totalXS(eIdx, f) * urrMaj + else + nucXS = urrMaj + end if + + else + call self % updateTotalNucXS(E, nucIdx) + nucXS = cache_nuclideCache(nucIdx) % xss % total + + end if + + end associate + + ! Update total material cross section + total = total + dens * nucXS + + end do - ! Calculate current material cross section and compare - call self % updateTotalMatXS(E, matIdx) - maj = max(maj, cache_materialCache(matIdx) % xss % total) + maj = max(maj, total) end do - ! Save majorant for this energy - self % majorant(i) = maj + ! Save majorant for this energy. Nudge it up to avoid small discrepancies + self % majorant(i) = maj * (ONE + NUDGE) end do diff --git a/NuclearData/ceNeutronData/aceDatabase/aceNeutronNuclide_class.f90 b/NuclearData/ceNeutronData/aceDatabase/aceNeutronNuclide_class.f90 index 27481891b..2438812e3 100644 --- a/NuclearData/ceNeutronData/aceDatabase/aceNeutronNuclide_class.f90 +++ b/NuclearData/ceNeutronData/aceDatabase/aceNeutronNuclide_class.f90 @@ -103,9 +103,9 @@ module aceNeutronNuclide_class !! getThXSs -> return ceNeutronMicroXSs accounting for S(a,b) scattering treatment !! elScatteringMaj -> returns the elastic scattering majorant within an energy range given as input !! init -> build nuclide from aceCard - !! init_urr -> build list and mapping of nuclides to maintain temperature correlation + !! initUrr -> build list and mapping of nuclides to maintain temperature correlation !! when reading ures probability tables - !! init_Sab -> builds S(a,b) propertied from aceCard + !! initSab -> builds S(a,b) propertied from aceCard !! display -> print information about the nuclide to the console !! type, public, extends(ceNeutronNuclide) :: aceNeutronNuclide @@ -147,8 +147,8 @@ module aceNeutronNuclide_class procedure :: getThXSs procedure :: elScatteringMaj procedure :: init - procedure :: init_urr - procedure :: init_Sab + procedure :: initUrr + procedure :: initSab procedure :: display end type aceNeutronNuclide @@ -476,6 +476,7 @@ elemental subroutine getThXSs(self, xss, idx, f, E) ! Retrieve capture and fission cross sections as usual xss % capture = data(CAPTURE_XS, 2) * f + (ONE-f) * data(CAPTURE_XS, 1) + if (self % isFissile()) then xss % fission = data(FISSION_XS, 2) * f + (ONE-f) * data(FISSION_XS, 1) xss % nuFission = data(NU_FISSION, 2) * f + (ONE-f) * data(NU_FISSION, 1) @@ -741,14 +742,14 @@ subroutine init(self, ACE, nucIdx, database) ! Create a stack of MT reactions, devide them into ones that produce 2nd-ary ! particlues and pure absorbtion associate (MTs => ACE % getScatterMTs()) - do i=1,size(MTs) + do i = 1,size(MTs) if (MTs(i) == N_ANYTHING) cycle call scatterMT % push(MTs(i)) end do end associate associate (MTs => [ACE % getFissionMTs(), ACE % getCaptureMTs()]) - do i=1,size(MTs) + do i = 1,size(MTs) if(MTs(i) == N_FISSION) cycle ! MT=18 is already included with FIS block call absMT % push(MTs(i)) end do @@ -760,7 +761,7 @@ subroutine init(self, ACE, nucIdx, database) ! Load scattering reactions N = scatterMT % size() self % nMT = N - do i =1,N + do i = 1,N call scatterMT % pop(MT) self % MTdata(i) % MT = MT self % MTdata(i) % firstIdx = ACE % firstIdxMT(MT) @@ -783,7 +784,7 @@ subroutine init(self, ACE, nucIdx, database) end do ! Calculate Inelastic scattering XS - do i=1,self % nMT + do i = 1,self % nMT do j=1,size(self % mainData, 2) ! Find bottom and Top of the grid bottom = self % MTdata(i) % firstIdx @@ -804,7 +805,7 @@ subroutine init(self, ACE, nucIdx, database) self % mainData(TOTAL_XS, :) = sum(self % mainData(ESCATTER_XS:K,:),1) ! Load Map of MT -> local index of a reaction - do i=1,size(self % MTdata) + do i = 1,size(self % MTdata) call self % idxMT % add(self % MTdata(i) % MT, i) end do @@ -830,7 +831,7 @@ end subroutine init !! Args: !! ACE [inout] -> ACE card !! - subroutine init_urr(self, ACE) + subroutine initUrr(self, ACE) class(aceNeutronNuclide), intent(inout) :: self class(aceCard), intent(inout) :: ACE @@ -841,19 +842,24 @@ subroutine init_urr(self, ACE) ! Initialise probability tables call self % probTab % init(ACE) ! Check if probability tables were read correctly + if (allocated(self % probTab % eGrid)) then self % urrE = self % probTab % getEbounds() self % IFF = self % probTab % getIFF() + else ! Something went wrong! self % hasProbTab = .false. self % urrE = ZERO + end if + else self % urrE = ZERO + end if - end subroutine init_urr + end subroutine initUrr !! !! Initialise thermal scattering tables from ACE card @@ -865,14 +871,15 @@ end subroutine init_urr !! fatalError if the inelastic scattering S(a,b) energy grid starts at a !! lower energy than the nuclide energy grid !! - subroutine init_Sab(self, ACE) + subroutine initSab(self, ACE) class(aceNeutronNuclide), intent(inout) :: self class(aceSabCard), intent(inout) :: ACE - character(100), parameter :: Here = "init_Sab (aceNeutronNuclide_class.f90)" + character(100), parameter :: Here = "initSab (aceNeutronNuclide_class.f90)" ! Initialise S(a,b) class from ACE file call self % thData % init(ACE) self % hasThData = .true. + ! Initialise energy boundaries self % SabInel = self % thData % getEbounds('inelastic') self % SabEl = self % thData % getEbounds('elastic') @@ -882,7 +889,7 @@ subroutine init_Sab(self, ACE) call fatalError(Here, 'S(a,b) low energy boundary is lower than nuclide first energy point') end if - end subroutine init_Sab + end subroutine initSab !! !! A Procedure that displays information about the nuclide to the screen diff --git a/NuclearData/ceNeutronData/aceDatabase/urrProbabilityTables_class.f90 b/NuclearData/ceNeutronData/aceDatabase/urrProbabilityTables_class.f90 index 87f8ce93d..42e292aff 100644 --- a/NuclearData/ceNeutronData/aceDatabase/urrProbabilityTables_class.f90 +++ b/NuclearData/ceNeutronData/aceDatabase/urrProbabilityTables_class.f90 @@ -35,8 +35,9 @@ module urrProbabilityTables_class !! ILF -> Inelatic competition flag (only used to check if inelatic scattering is zero) !! IOA -> Other absorption flag. NOTE: not used in the code !! IFF -> Multiplication factor flag - !! eGrid -> Energy grid - !! table -> Array of probability tables + !! majorant -> Array of maximum table total xs entry per each energy + !! eGrid -> Energy grid + !! table -> Array of probability tables !! !! type, public :: urrProbabilityTables @@ -46,12 +47,14 @@ module urrProbabilityTables_class integer(shortInt) :: ILF integer(shortInt) :: IOA integer(shortInt) :: IFF + real(defReal), dimension(:), allocatable :: majorant real(defReal), dimension(:), allocatable :: eGrid type(urrTable), dimension(:), allocatable :: table contains procedure :: init + procedure :: computeMajorant procedure :: kill procedure :: getEbounds procedure :: getIFF @@ -85,6 +88,9 @@ subroutine init(self, data) call fatalError(Here,'Probability tables cannot be build from '//data % myType()) end select + ! Find majorant + if (allocated(self % table)) call self % computeMajorant + end subroutine init !! @@ -215,21 +221,67 @@ subroutine buildFromACE(self, ACE) print '(A)', "Probability table discarded because CDF is not sorted" call self % kill() return + elseif (abs(self % table(i) % CDF(self % nTable) - ONE) > 1.0E-6_defReal) then print '(A)', "Probability table discarded because CDF does not end with 1.0 " call self % kill() return + elseif (self % table(i) % CDF(self % nTable) < ONE) then ! Adjust CDF if it is within tolerance but smaller than 1 due to floating point error self % table(i) % CDF(self % nTable) = ONE + elseif (any(self % table(i) % tot < ZERO) .or. any(self % table(i) % el < ZERO) .or. & any(self % table(i) % fiss < ZERO) .or. any(self % table(i) % capt < ZERO) ) then print '(A)', "Probability table discarded because negative cross-sections present " call self % kill() return + end if end do end subroutine buildFromACE + !! + !! Build majorant + !! + !! Finds the largest entry stored in each probability table (i.e., per each energy). + !! Each table entry is also compared with the equivalent entry for the following + !! energy; this is done so that interpolation between energies will not be needed + !! when using this majorant to compute the overall cross section majorant + !! + subroutine computeMajorant(self) + class(urrProbabilityTables), intent(inout) :: self + real(defReal) :: majorant + integer(shortInt) :: i, j + + ! Allocate majorant + allocate(self % majorant(self % nGrid)) + + ! Loop over energy grid + do i = 1,self % nGrid + + ! Initialise majorant value + majorant = ZERO + + ! Loop over table elements + do j = 1,self % nTable + + ! Update majorant if needed + majorant = max(majorant,self % table(i) % tot(j)) + + ! Check energy above (avoids the need for energy interpolation later) + if (i < self % nGrid) then + majorant = max(majorant,self % table(i + 1) % tot(j)) + end if + + end do + + ! Save majorant for this energy + self % majorant(i) = majorant + + end do + + end subroutine computeMajorant + end module urrProbabilityTables_class diff --git a/NuclearData/nuclearDatabase_inter.f90 b/NuclearData/nuclearDatabase_inter.f90 index e3a8eeff2..ba70e7bce 100644 --- a/NuclearData/nuclearDatabase_inter.f90 +++ b/NuclearData/nuclearDatabase_inter.f90 @@ -71,6 +71,7 @@ subroutine init(self, dict, ptr, silent) !! !! Args: !! activeMat [in] -> Array of matIdx of materials active in the simulation + !! silent [in] -> Optional. If set to .true. disables console output !! !! Errors: !! fatalError if activeMat contains materials not defined in the instance diff --git a/NuclearData/testNeutronData/testNeutronDatabase_class.f90 b/NuclearData/testNeutronData/testNeutronDatabase_class.f90 index fa91ef9ed..fcfacf7f2 100644 --- a/NuclearData/testNeutronData/testNeutronDatabase_class.f90 +++ b/NuclearData/testNeutronData/testNeutronDatabase_class.f90 @@ -4,7 +4,6 @@ module testNeutronDatabase_class use particle_class, only : particle use dictionary_class, only : dictionary use charMap_class, only : charMap - use RNG_class, only : RNG ! Nuclear Data Interfaces use nuclearDatabase_inter, only : nuclearDatabase