From 8c43a32130664e6173d1448727f83c2717e2f81c Mon Sep 17 00:00:00 2001 From: Adam Nelson Date: Fri, 12 Feb 2016 21:44:21 -0500 Subject: [PATCH] Resolved almost all of the comments from @paulromano, save for rejection sampling of the Legendre polynomial. also fixed @samuelshaner comment about the pincell_multigroup problem --- docs/source/usersguide/mgxs_library.rst | 6 +- .../python/pincell_multigroup/build-xml.py | 15 +- examples/xml/pincell_multigroup/materials.xml | 4 +- .../pincell_multigroup/mg_cross_sections.xml | 32 +-- src/input_xml.F90 | 5 +- src/macroxs_header.F90 | 162 +++++++++++- src/macroxs_operations.F90 | 243 ------------------ src/math.F90 | 27 ++ src/nuclide_header.F90 | 50 +--- src/physics_mg.F90 | 9 +- src/scattdata_header.F90 | 164 +++++++++++- src/tracking.F90 | 6 +- 12 files changed, 400 insertions(+), 323 deletions(-) delete mode 100644 src/macroxs_operations.F90 diff --git a/docs/source/usersguide/mgxs_library.rst b/docs/source/usersguide/mgxs_library.rst index 478b060024..ae4ee6681e 100644 --- a/docs/source/usersguide/mgxs_library.rst +++ b/docs/source/usersguide/mgxs_library.rst @@ -82,7 +82,11 @@ well as the actual cross section data. The following are the attributes/sub-elements required to describe the meta-data: :name: - The name of the microscopic or macroscopic data set. + The name of the microscopic or macroscopic data set. An extension to the + name must be provided (e.g., the ``.70m`` in ``UO2.70m``). This extension, + similar to the equivalent in the continuous-energy ``cross_sections.xml`` + file is used to denote variants of the particular nuclide or material of + interest (i.e. the ``UO2`` in this example). *Default*: None, this must be provided. diff --git a/examples/python/pincell_multigroup/build-xml.py b/examples/python/pincell_multigroup/build-xml.py index 17fbae9941..7b8926c346 100644 --- a/examples/python/pincell_multigroup/build-xml.py +++ b/examples/python/pincell_multigroup/build-xml.py @@ -1,5 +1,7 @@ import openmc import openmc.mgxs +from openmc.source import Source +from openmc.stats import Box import numpy as np ############################################################################### @@ -20,7 +22,7 @@ groups = openmc.mgxs.EnergyGroups(group_edges=[1E-11, 0.0635E-6, 10.0E-6, 1.0E-4, 1.0E-3, 0.5, 1.0, 20.0]) # Instantiate the 7-group (C5G7) cross section data -uo2_xsdata = openmc.XSdata('UO2.300K', groups) +uo2_xsdata = openmc.XSdata('UO2.70m', groups) uo2_xsdata.order = 0 uo2_xsdata.total = np.array([0.1779492, 0.3298048, 0.4803882, 0.5543674, 0.3118013, 0.3951678, 0.5644058]) @@ -43,7 +45,7 @@ uo2_xsdata.nu_fission = np.array([2.005998E-02, 2.027303E-03, 1.570599E-02, uo2_xsdata.chi = np.array([5.8791E-01, 4.1176E-01, 3.3906E-04, 1.1761E-07, 0.0000E+00, 0.0000E+00, 0.0000E+00]) -h2o_xsdata = openmc.XSdata('LWTR.300K', groups) +h2o_xsdata = openmc.XSdata('LWTR.70m', groups) h2o_xsdata.order = 0 h2o_xsdata.total = np.array([0.15920605, 0.412969593, 0.59030986, 0.58435, 0.718, 1.2544497, 2.650379]) @@ -69,8 +71,8 @@ mg_cross_sections_file.export_to_xml() ############################################################################### # Instantiate some Macroscopic Data -uo2_data = openmc.Macroscopic('UO2', '300K') -h2o_data = openmc.Macroscopic('LWTR', '300K') +uo2_data = openmc.Macroscopic('UO2', '70m') +h2o_data = openmc.Macroscopic('LWTR', '70m') # Instantiate some Materials and register the appropriate Macroscopic objects uo2 = openmc.Material(material_id=1, name='UO2 fuel') @@ -83,7 +85,7 @@ water.add_macroscopic(h2o_data) # Instantiate a MaterialsFile, register all Materials, and export to XML materials_file = openmc.MaterialsFile() -materials_file.default_xs = '300K' +materials_file.default_xs = '70m' materials_file.add_materials([uo2, water]) materials_file.export_to_xml() @@ -143,8 +145,7 @@ settings_file.cross_sections = "./mg_cross_sections.xml" settings_file.batches = batches settings_file.inactive = inactive settings_file.particles = particles -settings_file.set_source_space('box', [-0.63, -0.63, -1, \ - 0.63, 0.63, 1]) +settings_file.source = Source(space=Box([-0.63, -0.63, -1.], [0.63, 0.63, 1.])) ############################################################################### # Exporting to OpenMC tallies.xml File diff --git a/examples/xml/pincell_multigroup/materials.xml b/examples/xml/pincell_multigroup/materials.xml index 4b14f4a795..c94629665b 100644 --- a/examples/xml/pincell_multigroup/materials.xml +++ b/examples/xml/pincell_multigroup/materials.xml @@ -1,7 +1,7 @@ - - 300K + + 70m diff --git a/examples/xml/pincell_multigroup/mg_cross_sections.xml b/examples/xml/pincell_multigroup/mg_cross_sections.xml index ec85d4b593..d38d2d9c21 100644 --- a/examples/xml/pincell_multigroup/mg_cross_sections.xml +++ b/examples/xml/pincell_multigroup/mg_cross_sections.xml @@ -11,8 +11,8 @@ --> - UO2.71c - UO2.71c + UO2.70m + UO2.70m 2.53E-8 0 true @@ -67,8 +67,8 @@ - MOX1.71c - MOX1.71c + MOX1.70m + MOX1.70m 2.53E-8 0 true @@ -124,8 +124,8 @@ - MOX2.71c - MOX2.71c + MOX2.70m + MOX2.70m 2.53E-8 0 true @@ -180,8 +180,8 @@ - MOX3.71c - MOX3.71c + MOX3.70m + MOX3.70m 2.53E-8 0 true @@ -236,8 +236,8 @@ - FC.71c - FC.71c + FC.70m + FC.70m 2.53E-8 0 true @@ -286,8 +286,8 @@ - GT.71c - GT.71c + GT.70m + GT.70m 2.53E-8 0 false @@ -318,8 +318,8 @@ - LWTR.71c - LWTR.71c + LWTR.70m + LWTR.70m 2.53E-8 0 false @@ -351,8 +351,8 @@ - CR.71c - CR.71c + CR.70m + CR.70m 2.53E-8 0 false diff --git a/src/input_xml.F90 b/src/input_xml.F90 index eca7e8ca15..9fc490a33b 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -2063,7 +2063,10 @@ contains ! as nuclides internally. ! Get pointer list of XML call get_node_list(node_mat, "macroscopic", node_macro_list) - if (get_list_size(node_macro_list) > 1) then + if (run_CE .and. (get_list_size(node_macro_list) > 0)) then + call fatal_error("Macroscopic can not be used in continuous-energy& + & mode!") + else if (get_list_size(node_macro_list) > 1) then call fatal_error("Only one macroscopic object permitted per material, " & // trim(to_str(mat % id))) else if (get_list_size(node_macro_list) == 1) then diff --git a/src/macroxs_header.F90 b/src/macroxs_header.F90 index c435686b5d..2a12345108 100644 --- a/src/macroxs_header.F90 +++ b/src/macroxs_header.F90 @@ -3,8 +3,9 @@ module macroxs_header use constants, only: MAX_FILE_LEN, ZERO, ONE, TWO, PI use list_header, only: ListInt use material_header, only: material - use math, only: calc_pn, calc_rn, expand_harmonic + use math, only: calc_pn, calc_rn, expand_harmonic, find_angle use nuclide_header + use random_lcg, only: prn use scattdata_header implicit none @@ -19,8 +20,14 @@ module macroxs_header integer :: order contains - procedure(macroxs_init_), deferred :: init ! initializes object - procedure(macroxs_get_xs_), deferred :: get_xs ! Return xs + procedure(macroxs_init_), deferred :: init ! initializes object + procedure(macroxs_get_xs_), deferred :: get_xs ! Return xs + ! Sample the outgoing energy from a fission event + procedure(macroxs_sample_fission_), deferred :: sample_fission_energy + ! Sample the outgoing energy and angle from a scatter event + procedure(macroxs_sample_scatter_), deferred :: sample_scatter + ! Calculate the material specific MGXS data from the nuclides + procedure(macroxs_calculate_xs_), deferred :: calculate_xs end type MacroXS abstract interface @@ -50,6 +57,33 @@ module macroxs_header real(8), optional, intent(in) :: uvw(3) ! Requested Angle real(8) :: xs ! Resultant xs end function macroxs_get_xs_ + + function macroxs_sample_fission_(this, gin, uvw) result(gout) + import MacroXS + class(MacroXS), intent(in) :: this ! Data to work with + integer, intent(in) :: gin ! Incoming energy group + real(8), intent(in) :: uvw(3) ! Particle Direction + integer :: gout ! Sampled outgoing group + + end function macroxs_sample_fission_ + + subroutine macroxs_sample_scatter_(this, uvw, gin, gout, mu, wgt) + import MacroXS + class(MacroXS), intent(in) :: this + real(8), intent(in) :: uvw(3) ! Incoming neutron direction + integer, intent(in) :: gin ! Incoming neutron group + integer, intent(out) :: gout ! Sampled outgoin group + real(8), intent(out) :: mu ! Sampled change in angle + real(8), intent(inout) :: wgt ! Particle weight + end subroutine macroxs_sample_scatter_ + + subroutine macroxs_calculate_xs_(this, gin, uvw, xs) + import MacroXS, MaterialMacroXS + class(MacroXS), intent(in) :: this + integer, intent(in) :: gin ! Incoming neutron group + real(8), intent(in) :: uvw(3) ! Incoming neutron direction + type(MaterialMacroXS), intent(inout) :: xs + end subroutine macroxs_calculate_xs_ end interface type, extends(MacroXS) :: MacroXSIso @@ -64,8 +98,11 @@ module macroxs_header real(8), allocatable :: chi(:,:) ! fission spectra contains - procedure :: init => macroxsiso_init ! inits object - procedure :: get_xs => macroxsiso_get_xs ! Returns xs + procedure :: init => macroxsiso_init ! inits object + procedure :: get_xs => macroxsiso_get_xs ! Returns xs + procedure :: sample_fission_energy => macroxsiso_sample_fission_energy + procedure :: sample_scatter => macroxsiso_sample_scatter + procedure :: calculate_xs => macroxsiso_calculate_xs end type MacroXSIso type, extends(MacroXS) :: MacroXSAngle @@ -84,6 +121,9 @@ module macroxs_header contains procedure :: init => macroxsangle_init ! inits object procedure :: get_xs => macroxsangle_get_xs ! Returns xs + procedure :: sample_fission_energy => macroxsangle_sample_fission_energy + procedure :: sample_scatter => macroxsangle_sample_scatter + procedure :: calculate_xs => macroxsangle_calculate_xs end type MacroXSAngle !=============================================================================== @@ -705,4 +745,116 @@ contains end function macroxsangle_get_xs +!=============================================================================== +! MACROXS_*_SAMPLE_FISSION_ENERGY samples the outgoing energy from a fission +! event +!=============================================================================== + + function macroxsiso_sample_fission_energy(this, gin, uvw) result(gout) + class(MacroXSIso), intent(in) :: this ! Data to work with + integer, intent(in) :: gin ! Incoming energy group + real(8), intent(in) :: uvw(3) ! Particle Direction + integer :: gout ! Sampled outgoing group + real(8) :: xi ! Our random number + real(8) :: prob ! Running probability + + xi = prn() + prob = ZERO + gout = 0 + + do while (prob < xi) + gout = gout + 1 + prob = prob + this % chi(gout,gin) + end do + + end function macroxsiso_sample_fission_energy + + function macroxsangle_sample_fission_energy(this, gin, uvw) result(gout) + class(MacroXSAngle), intent(in) :: this ! Data to work with + integer, intent(in) :: gin ! Incoming energy group + real(8), intent(in) :: uvw(3) ! Particle Direction + integer :: gout ! Sampled outgoing group + real(8) :: xi ! Our random number + real(8) :: prob ! Running probability + integer :: iazi, ipol + + call find_angle(this % polar, this % azimuthal, uvw, iazi, ipol) + + xi = prn() + prob = ZERO + gout = 0 + + do while (prob < xi) + gout = gout + 1 + prob = prob + this % chi(gout,gin,iazi,ipol) + end do + + end function macroxsangle_sample_fission_energy + +!=============================================================================== +! MACROXS*_SAMPLE_SCATTER Selects outgoing energy and angle after a scatter +! event +!=============================================================================== + + subroutine macroxsiso_sample_scatter(this, uvw, gin, gout, mu, wgt) + class(MacroXSIso), intent(in) :: this + real(8), intent(in) :: uvw(3) ! Incoming neutron direction + integer, intent(in) :: gin ! Incoming neutron group + integer, intent(out) :: gout ! Sampled outgoin group + real(8), intent(out) :: mu ! Sampled change in angle + real(8), intent(inout) :: wgt ! Particle weight + + call this % scatter % sample(gin, gout, mu, wgt) + + end subroutine macroxsiso_sample_scatter + + subroutine macroxsangle_sample_scatter(this, uvw, gin, gout, mu, wgt) + class(MacroXSAngle), intent(in) :: this + real(8), intent(in) :: uvw(3) ! Incoming neutron direction + integer, intent(in) :: gin ! Incoming neutron group + integer, intent(out) :: gout ! Sampled outgoin group + real(8), intent(out) :: mu ! Sampled change in angle + real(8), intent(inout) :: wgt ! Particle weight + + integer :: iazi, ipol ! Angular indices + + call find_angle(this % polar, this % azimuthal, uvw, iazi, ipol) + call this % scatter(iazi,ipol) % obj % sample(gin,gout,mu,wgt) + + end subroutine macroxsangle_sample_scatter + +!=============================================================================== +! MACROXS*_CALCULATE_XS determines the multi-group macroscopic cross sections +! for the material the particle is currently traveling through. +!=============================================================================== + + subroutine macroxsiso_calculate_xs(this, gin, uvw, xs) + class(MacroXSIso), intent(in) :: this + integer, intent(in) :: gin ! Incoming neutron group + real(8), intent(in) :: uvw(3) ! Incoming neutron direction + type(MaterialMacroXS), intent(inout) :: xs ! Resultant MacroXS Data + + xs % total = this % total(gin) + xs % elastic = this % scattxs(gin) + xs % absorption = this % absorption(gin) + xs % nu_fission = this % nu_fission(gin) + + end subroutine macroxsiso_calculate_xs + + subroutine macroxsangle_calculate_xs(this, gin, uvw, xs) + class(MacroXSAngle), intent(in) :: this + integer, intent(in) :: gin ! Incoming neutron group + real(8), intent(in) :: uvw(3) ! Incoming neutron direction + type(MaterialMacroXS), intent(inout) :: xs ! Resultant MacroXS Data + + integer :: iazi, ipol + + call find_angle(this % polar, this % azimuthal, uvw, iazi, ipol) + xs % total = this % total(gin, iazi, ipol) + xs % elastic = this % scattxs(gin, iazi, ipol) + xs % absorption = this % absorption(gin, iazi, ipol) + xs % nu_fission = this % nu_fission(gin, iazi, ipol) + + end subroutine macroxsangle_calculate_xs + end module macroxs_header diff --git a/src/macroxs_operations.F90 b/src/macroxs_operations.F90 deleted file mode 100644 index 4fc13910ca..0000000000 --- a/src/macroxs_operations.F90 +++ /dev/null @@ -1,243 +0,0 @@ -module macroxs_operations - - use constants - use macroxs_header, only: MacroXS, MacroXSIso, MacroXSAngle, & - expand_harmonic - use material_header, only: Material - use math - use nuclide_header, only: find_angle, MaterialMacroXS, NuclideMicroXS, & - NuclideMG, NuclideMGContainer - use random_lcg, only: prn - use scattdata_header - use search - - implicit none - -contains - -!=============================================================================== -! UPDATE_XS stores the xs to work with -!=============================================================================== - - subroutine calculate_mgxs(this, gin, uvw, xs) - class(MacroXS), intent(in) :: this - integer, intent(in) :: gin ! Incoming neutron group - real(8), intent(in) :: uvw(3) ! Incoming neutron direction - type(MaterialMacroXS), intent(inout) :: xs - - integer :: iazi, ipol - - select type(this) - type is (MacroXSIso) - xs % total = this % total(gin) - xs % elastic = this % scattxs(gin) - xs % absorption = this % absorption(gin) - xs % nu_fission = this % nu_fission(gin) - - type is (MacroXSAngle) - call find_angle(this % polar, this % azimuthal, uvw, iazi, ipol) - xs % total = this % total(gin, iazi, ipol) - xs % elastic = this % scattxs(gin, iazi, ipol) - xs % absorption = this % absorption(gin, iazi, ipol) - xs % nu_fission = this % nu_fission(gin, iazi, ipol) - end select - - end subroutine calculate_mgxs - - -!=============================================================================== -! SAMPLE_FISSION_ENERGY acts as a templating code for macroxs_*_sample_fission_energy -!=============================================================================== - - function sample_fission_energy(this, gin, uvw) result(gout) - class(MacroXS), intent(in) :: this ! Data to work with - integer, intent(in) :: gin ! Incoming energy group - real(8), intent(in) :: uvw(3) ! Particle Direction - integer :: gout ! Sampled outgoing group - - select type(this) - type is (MacroXSIso) - gout = macroxsiso_sample_fission_energy(this, gin, uvw) - type is (MacroXSAngle) - gout = macroxsangle_sample_fission_energy(this, gin, uvw) - end select - - end function sample_fission_energy - -!=============================================================================== -! MACROXS_*_SAMPLE_FISSION_ENERGY samples the outgoing energy and mu from a scatter event. -! Implemented as % scatter. -!=============================================================================== - - function macroxsiso_sample_fission_energy(this, gin, uvw) result(gout) - class(MacroXSIso), intent(in) :: this ! Data to work with - integer, intent(in) :: gin ! Incoming energy group - real(8), intent(in) :: uvw(3) ! Particle Direction - integer :: gout ! Sampled outgoing group - real(8) :: xi ! Our random number - real(8) :: prob ! Running probability - - xi = prn() - prob = ZERO - gout = 0 - - do while (prob < xi) - gout = gout + 1 - prob = prob + this % chi(gout,gin) - end do - - end function macroxsiso_sample_fission_energy - - function macroxsangle_sample_fission_energy(this, gin, uvw) result(gout) - class(MacroXSAngle), intent(in) :: this ! Data to work with - integer, intent(in) :: gin ! Incoming energy group - real(8), intent(in) :: uvw(3) ! Particle Direction - integer :: gout ! Sampled outgoing group - real(8) :: xi ! Our random number - real(8) :: prob ! Running probability - integer :: iazi, ipol - - call find_angle(this % polar, this % azimuthal, uvw, iazi, ipol) - - xi = prn() - prob = ZERO - gout = 0 - - do while (prob < xi) - gout = gout + 1 - prob = prob + this % chi(gout,gin,iazi,ipol) - end do - - end function macroxsangle_sample_fission_energy - -!=============================================================================== -! SAMPLE_SCATTER acts as a templating code for macroxs_*_sample_scatter -!=============================================================================== - - subroutine sample_scatter(this, uvw, gin, gout, mu, wgt) - class(MacroXS), intent(in) :: this - real(8), intent(in) :: uvw(3) ! Incoming neutron direction - integer, intent(in) :: gin ! Incoming neutron group - integer, intent(out) :: gout ! Sampled outgoin group - real(8), intent(out) :: mu ! Sampled change in angle - real(8), intent(inout) :: wgt ! Particle weight - - integer :: iazi, ipol ! Angular indices - - select type(this) - type is (MacroXSIso) - call macroxs_sample_scatter(this % scatter, gin, gout, mu, wgt) - type is (MacroXSAngle) - call find_angle(this % polar, this % azimuthal, uvw, iazi, ipol) - call macroxs_sample_scatter(this % scatter(iazi,ipol) % obj,gin,gout,mu,wgt) - end select - - end subroutine sample_scatter - -!=============================================================================== -! MACROXS_SAMPLE_SCATTER performs the work with ScattData to sample outgoing -! energy and change in angle. -!=============================================================================== - - subroutine macroxs_sample_scatter(scatt, gin, gout, mu, wgt) - class(ScattData), intent(in) :: scatt ! Scattering Object to Use - integer, intent(in) :: gin ! Incoming neutron group - integer, intent(out) :: gout ! Sampled outgoin group - real(8), intent(out) :: mu ! Sampled change in angle - real(8), intent(inout) :: wgt ! Particle weight - - real(8) :: xi ! Our random number - real(8) :: prob ! Running probability - integer :: imu - real(8) :: u, f, M - real(8) :: mu0, frac, mu1 - real(8) :: c_k, c_k1, p0, p1 - integer :: k, NP, samples - - xi = prn() - prob = ZERO - gout = 0 - - do while (prob < xi) - gout = gout + 1 - prob = prob + scatt % energy(gout,gin) - end do - - select type (scatt) - type is (ScattDataHistogram) - xi = prn() - if (xi < scatt % data(1,gout,gin)) then - imu = 1 - else - imu = binary_search(scatt % data(:,gout,gin), & - size(scatt % data(:,gout,gin)), xi) - end if - - ! Randomly select a mu in this bin. - mu = prn() * scatt % dmu + scatt % mu(imu) - - type is (ScattDataTabular) - ! determine outgoing cosine bin - NP = size(scatt % data(:,gout,gin)) - xi = prn() - - c_k = scatt % data(1,gout,gin) - do k = 1, NP - 1 - c_k1 = scatt % data(k+1,gout,gin) - if (xi < c_k1) exit - c_k = c_k1 - end do - - ! check to make sure k is <= NP - 1 - k = min(k, NP - 1) - - p0 = scatt % fmu(k,gout,gin) - mu0 = scatt % mu(k) - ! Linear-linear interpolation to find mu value w/in bin. - p1 = scatt % fmu(k+1,gout,gin) - mu1 = scatt % mu(k+1) - - frac = (p1 - p0)/(mu1 - mu0) - - if (frac == ZERO) then - mu = mu0 + (xi - c_k)/p0 - else - mu = mu0 + (sqrt(max(ZERO, p0*p0 + TWO*frac*(xi - c_k))) - p0)/frac - end if - - if (mu <= -ONE) then - mu = -ONE - else if (mu >= ONE) then - mu = ONE - end if - - type is (ScattDataLegendre) - ! Now we can sample mu using the legendre representation of the scattering - ! kernel in data(1:this % order) - - ! Do with rejection sampling - ! Set upper bound (instead of searching for max - though this is inefficient) - M = 4.0_8 - samples = 0 - do - mu = TWO * prn() - ONE - f = scatt % calc_f(gin,gout,mu) - if (f > ZERO) then - u = prn() * M - if (u <= f) then - exit - end if - end if - samples = samples + 1 - if (samples > MAX_SAMPLE) then - ! Exit with an isotropic event. - exit - end if - end do - end select - - wgt = wgt * scatt % mult(gout,gin) - - end subroutine macroxs_sample_scatter - -end module macroxs_operations \ No newline at end of file diff --git a/src/math.F90 b/src/math.F90 index c7ede8d2a5..f49220da76 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -702,4 +702,31 @@ contains end function watt_spectrum + +!=============================================================================== +! find_angle finds the closest angle on the data grid and returns that index +!=============================================================================== + + pure subroutine find_angle(polar, azimuthal, uvw, i_azi, i_pol) + real(8), intent(in) :: polar(:) ! Polar angles [0,pi] + real(8), intent(in) :: azimuthal(:) ! Azi. angles [-pi,pi] + real(8), intent(in) :: uvw(3) ! Direction of motion + integer, intent(inout) :: i_pol ! Closest polar bin + integer, intent(inout) :: i_azi ! Closest azi bin + + real(8) :: my_pol, my_azi, dangle + + ! Convert uvw to polar and azi + + my_pol = acos(uvw(3)) + my_azi = atan2(uvw(2), uvw(1)) + + ! Search for equi-binned angles + dangle = PI / real(size(polar),8) + i_pol = floor(my_pol / dangle + ONE) + dangle = TWO * PI / real(size(azimuthal),8) + i_azi = floor((my_azi + PI) / dangle + ONE) + + end subroutine find_angle + end module math diff --git a/src/nuclide_header.F90 b/src/nuclide_header.F90 index 7569d9ea80..9bcce57a75 100644 --- a/src/nuclide_header.F90 +++ b/src/nuclide_header.F90 @@ -7,9 +7,10 @@ module nuclide_header use endf, only: reaction_name use error, only: fatal_error use list_header, only: ListInt - use math, only: evaluate_legendre + use math, only: evaluate_legendre, find_angle use string use xml_interface + implicit none !=============================================================================== @@ -300,12 +301,9 @@ module nuclide_header ! NUCLIDE_*_INIT reads in the data from the XML file, as already accessed !=============================================================================== - subroutine nuclidemg_init(this, node_xsdata, groups, get_kfiss, get_fiss) + subroutine nuclidemg_init(this, node_xsdata) class(NuclideMG), intent(inout) :: this ! Working Object type(Node), pointer, intent(in) :: node_xsdata ! Data from MGXS xml - integer, intent(in) :: groups ! Number of Energy groups - logical, intent(in) :: get_kfiss ! Need Kappa-Fission? - logical, intent(in) :: get_fiss ! Should we get fiss data? type(Node), pointer :: node_legendre_mu character(MAX_LINE_LEN) :: temp_str @@ -403,7 +401,7 @@ module nuclide_header integer :: order_dim ! Call generic data gathering routine - call nuclidemg_init(this, node_xsdata, groups, get_kfiss, get_fiss) + call nuclidemg_init(this, node_xsdata) ! Load the more specific data if (this % fissionable) then @@ -525,7 +523,7 @@ module nuclide_header integer :: order_dim ! Call generic data gathering routine - call nuclidemg_init(this, node_xsdata, groups, get_kfiss, get_fiss) + call nuclidemg_init(this, node_xsdata) if (this % scatt_type == ANGLE_LEGENDRE) then order_dim = this % order + 1 @@ -1043,13 +1041,13 @@ module nuclide_header if (this % scatt_type == ANGLE_LEGENDRE) then f = evaluate_legendre(this % scatter(gout,gin,:), mu) else if (this % scatt_type == ANGLE_TABULAR) then - dmu = TWO / real(this % order - 1) + dmu = TWO / real(this % order - 1,8) ! Find mu bin algebraically, knowing that the spacing is equal f = (mu + ONE) / dmu + ONE imu = floor(f) ! But save the amount that mu is past the previous index ! so we can use interpolation later. - f = f - real(imu) + f = f - real(imu,8) ! Adjust so interpolation works on the last bin if necessary if (imu == size(this % scatter, dim=3)) then imu = imu - 1 @@ -1060,7 +1058,7 @@ module nuclide_header f = (ONE - r) * this % scatter(gout,gin,imu) + & r * this % scatter(gout,gin,imu+1) else ! (ANGLE_HISTOGRAM) - dmu = TWO / real(this % order) + dmu = TWO / real(this % order,8) ! Find mu bin algebraically, knowing that the spacing is equal imu = floor((mu + ONE) / dmu + ONE) ! Adjust so interpolation works on the last bin if necessary @@ -1097,13 +1095,13 @@ module nuclide_header if (this % scatt_type == ANGLE_LEGENDRE) then f = evaluate_legendre(this % scatter(gout,gin,:,i_azi_,i_pol_), mu) else if (this % scatt_type == ANGLE_TABULAR) then - dmu = TWO / real(this % order - 1) + dmu = TWO / real(this % order - 1,8) ! Find mu bin algebraically, knowing that the spacing is equal f = (mu + ONE) / dmu + ONE imu = floor(f) ! But save the amount that mu is past the previous index ! so we can use interpolation later. - f = f - real(imu) + f = f - real(imu,8) ! Adjust so interpolation works on the last bin if necessary if (imu == size(this % scatter, dim=3)) then imu = imu - 1 @@ -1114,7 +1112,7 @@ module nuclide_header f = (ONE - r) * this % scatter(gout,gin,imu,i_azi_,i_pol_) + & r * this % scatter(gout,gin,imu+1,i_azi_,i_pol_) else ! (ANGLE_HISTOGRAM) - dmu = TWO / real(this % order) + dmu = TWO / real(this % order,8) ! Find mu bin algebraically, knowing that the spacing is equal imu = floor((mu + ONE) / dmu + ONE) ! Adjust so interpolation works on the last bin if necessary @@ -1127,30 +1125,4 @@ module nuclide_header end function nuclideangle_calc_f -!=============================================================================== -! find_angle finds the closest angle on the data grid and returns that index -!=============================================================================== - - pure subroutine find_angle(polar, azimuthal, uvw, i_azi, i_pol) - real(8), intent(in) :: polar(:) ! Polar angles [0,pi] - real(8), intent(in) :: azimuthal(:) ! Azi. angles [-pi,pi] - real(8), intent(in) :: uvw(3) ! Direction of motion - integer, intent(inout) :: i_pol ! Closest polar bin - integer, intent(inout) :: i_azi ! Closest azi bin - - real(8) my_pol, my_azi, dangle - - ! Convert uvw to polar and azi - - my_pol = acos(uvw(3)) - my_azi = atan2(uvw(2), uvw(1)) - - ! Search for equi-binned angles - dangle = PI / real(size(polar),8) - i_pol = floor(my_pol / dangle + ONE) - dangle = TWO * PI / real(size(azimuthal),8) - i_azi = floor((my_azi + PI) / dangle + ONE) - - end subroutine find_angle - end module nuclide_header diff --git a/src/physics_mg.F90 b/src/physics_mg.F90 index a0d8eb6e1d..ce296c48e6 100644 --- a/src/physics_mg.F90 +++ b/src/physics_mg.F90 @@ -6,7 +6,6 @@ module physics_mg use error, only: fatal_error, warning use global use macroxs_header, only: MacroXS, MacroXSContainer - use macroxs_operations, only: sample_fission_energy, sample_scatter use material_header, only: Material use math, only: rotate_angle use mesh, only: get_mesh_indices @@ -146,9 +145,9 @@ contains type(Particle), intent(inout) :: p - call sample_scatter(macro_xs(p % material) % obj, & - p % coord(1) % uvw, p % last_g, p % g, & - p % mu, p % wgt) + call macro_xs(p % material) % obj % sample_scatter(p % coord(1) % uvw, & + p % last_g, p % g, & + p % mu, p % wgt) ! Update energy value for downstream compatability (in tallying) p % E = energy_bin_avg(p % g) @@ -256,7 +255,7 @@ contains ! Sample secondary energy distribution for fission reaction and set energy ! in fission bank - bank_array(i) % g = sample_fission_energy(xs, p % g, fission_bank(i) % uvw) + bank_array(i) % g = xs % sample_fission_energy(p % g, fission_bank(i) % uvw) bank_array(i) % E = energy_bin_avg(fission_bank(i) % g) end do diff --git a/src/scattdata_header.F90 b/src/scattdata_header.F90 index b9dcdadd41..e02ba9172f 100644 --- a/src/scattdata_header.F90 +++ b/src/scattdata_header.F90 @@ -1,7 +1,10 @@ module scattdata_header - use math use constants + use error, only: fatal_error + use math + use random_lcg, only: prn + use search, only: binary_search implicit none @@ -19,6 +22,7 @@ module scattdata_header contains procedure(init_), deferred :: init ! Initializes ScattData procedure(calc_f_), deferred :: calc_f ! Calculates f, given mu + procedure(sample_), deferred :: sample ! sample the scatter event end type ScattData abstract interface @@ -40,12 +44,22 @@ module scattdata_header real(8) :: f ! Return value of f(mu) end function calc_f_ + + subroutine sample_(this, gin, gout, mu, wgt) + import ScattData + class(ScattData), intent(in) :: this ! Scattering Object to Use + integer, intent(in) :: gin ! Incoming neutron group + integer, intent(out) :: gout ! Sampled outgoin group + real(8), intent(out) :: mu ! Sampled change in angle + real(8), intent(inout) :: wgt ! Particle weight + end subroutine sample_ end interface type, extends(ScattData) :: ScattDataLegendre contains procedure :: init => scattdatalegendre_init procedure :: calc_f => scattdatalegendre_calc_f + procedure :: sample => scattdatalegendre_sample end type ScattDataLegendre type, extends(ScattData) :: ScattDataHistogram @@ -54,6 +68,7 @@ module scattdata_header contains procedure :: init => scattdatahistogram_init procedure :: calc_f => scattdatahistogram_calc_f + procedure :: sample => scattdatahistogram_sample end type ScattDataHistogram type, extends(ScattData) :: ScattDataTabular @@ -63,6 +78,7 @@ module scattdata_header contains procedure :: init => scattdatatabular_init procedure :: calc_f => scattdatatabular_calc_f + procedure :: sample => scattdatatabular_sample end type ScattDataTabular !=============================================================================== @@ -290,4 +306,150 @@ contains end function scattdatatabular_calc_f +!=============================================================================== +! SCATTDATA*_SCATTER Samples the outgoing energy and change in angle. +!=============================================================================== + + subroutine scattdatalegendre_sample(this, gin, gout, mu, wgt) + class(ScattDataLegendre), intent(in) :: this ! Scattering object to use + integer, intent(in) :: gin ! Incoming neutron group + integer, intent(out) :: gout ! Sampled outgoin group + real(8), intent(out) :: mu ! Sampled change in angle + real(8), intent(inout) :: wgt ! Particle weight + + real(8) :: xi ! Our random number + real(8) :: prob ! Running probability + real(8) :: u, f, M + integer :: samples + + xi = prn() + prob = ZERO + gout = 0 + + do while (prob < xi) + gout = gout + 1 + prob = prob + this % energy(gout,gin) + end do + + ! Now we can sample mu using the legendre representation of the thisering + ! kernel in data(1:this % order) + + ! Do with rejection sampling + ! Set upper bound (instead of searching for max - though this is inefficient) + M = 4.0_8 + samples = 0 + do + mu = TWO * prn() - ONE + f = this % calc_f(gin,gout,mu) + if (f > ZERO) then + u = prn() * M + if (u <= f) then + exit + end if + end if + samples = samples + 1 + if (samples > MAX_SAMPLE) then + call fatal_error("Maximum number of Legendre expansion samples reached!") + end if + end do + + wgt = wgt * this % mult(gout,gin) + + end subroutine scattdatalegendre_sample + + subroutine scattdatahistogram_sample(this, gin, gout, mu, wgt) + class(ScattDataHistogram), intent(in) :: this ! Scattering object to use + integer, intent(in) :: gin ! Incoming neutron group + integer, intent(out) :: gout ! Sampled outgoin group + real(8), intent(out) :: mu ! Sampled change in angle + real(8), intent(inout) :: wgt ! Particle weight + + real(8) :: xi ! Our random number + real(8) :: prob ! Running probability + integer :: imu + + xi = prn() + prob = ZERO + gout = 0 + + do while (prob < xi) + gout = gout + 1 + prob = prob + this % energy(gout,gin) + end do + + xi = prn() + if (xi < this % data(1,gout,gin)) then + imu = 1 + else + imu = binary_search(this % data(:,gout,gin), & + size(this % data(:,gout,gin)), xi) + end if + + ! Randomly select a mu in this bin. + mu = prn() * this % dmu + this % mu(imu) + + wgt = wgt * this % mult(gout,gin) + + end subroutine scattdatahistogram_sample + + subroutine scattdatatabular_sample(this, gin, gout, mu, wgt) + class(ScattDataTabular), intent(in) :: this ! Scattering object to use + integer, intent(in) :: gin ! Incoming neutron group + integer, intent(out) :: gout ! Sampled outgoin group + real(8), intent(out) :: mu ! Sampled change in angle + real(8), intent(inout) :: wgt ! Particle weight + + real(8) :: xi ! Our random number + real(8) :: prob ! Running probability + real(8) :: mu0, frac, mu1 + real(8) :: c_k, c_k1, p0, p1 + integer :: k, NP + + xi = prn() + prob = ZERO + gout = 0 + + do while (prob < xi) + gout = gout + 1 + prob = prob + this % energy(gout,gin) + end do + + ! determine outgoing cosine bin + NP = size(this % data(:,gout,gin)) + xi = prn() + + c_k = this % data(1,gout,gin) + do k = 1, NP - 1 + c_k1 = this % data(k+1,gout,gin) + if (xi < c_k1) exit + c_k = c_k1 + end do + + ! check to make sure k is <= NP - 1 + k = min(k, NP - 1) + + p0 = this % fmu(k,gout,gin) + mu0 = this % mu(k) + ! Linear-linear interpolation to find mu value w/in bin. + p1 = this % fmu(k+1,gout,gin) + mu1 = this % mu(k+1) + + frac = (p1 - p0)/(mu1 - mu0) + + if (frac == ZERO) then + mu = mu0 + (xi - c_k)/p0 + else + mu = mu0 + (sqrt(max(ZERO, p0*p0 + TWO*frac*(xi - c_k))) - p0)/frac + end if + + if (mu <= -ONE) then + mu = -ONE + else if (mu >= ONE) then + mu = ONE + end if + + wgt = wgt * this % mult(gout,gin) + + end subroutine scattdatatabular_sample + end module scattdata_header \ No newline at end of file diff --git a/src/tracking.F90 b/src/tracking.F90 index 98e5483a0a..17fc855591 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -7,7 +7,7 @@ module tracking cross_lattice, check_cell_overlap use geometry_header, only: Universe, BASE_UNIVERSE use global - use macroxs_operations, only: calculate_mgxs + use macroxs_header, only: MacroXS use output, only: write_message use particle_header, only: LocalCoord, Particle use physics, only: collision @@ -92,8 +92,8 @@ contains ! Since the MGXS can be angle dependent, this needs to be done ! After every collision for the MGXS mode if (p % material /= MATERIAL_VOID) then - call calculate_mgxs(macro_xs(p % material) % obj, p % g, & - p % coord(p % n_coord) % uvw, material_xs) + call macro_xs(p % material) % obj % calculate_xs(p % g, & + p % coord(p % n_coord) % uvw, material_xs) else material_xs % total = ZERO material_xs % elastic = ZERO