diff --git a/docs/source/usersguide/output/particle_restart.rst b/docs/source/usersguide/output/particle_restart.rst index eeb40a526e..1ed6077108 100644 --- a/docs/source/usersguide/output/particle_restart.rst +++ b/docs/source/usersguide/output/particle_restart.rst @@ -49,7 +49,7 @@ The current revision of the particle restart file format is 2. Energy of the particle in MeV. This is always provided but only used for continuous-energy mode. -**/energy_group** (*double*) +**/energy_group** (*int*) Energy group of the particle. This is always provided but only used for multi-group mode. diff --git a/src/ace_header.F90 b/src/ace_header.F90 index 497a16d3bf..ae5000e5ab 100644 --- a/src/ace_header.F90 +++ b/src/ace_header.F90 @@ -24,9 +24,8 @@ module ace_header real(8), allocatable :: sigma(:) ! Cross section values type(SecondaryDistribution) :: secondary - ! Type-Bound procedures - contains - procedure :: clear => reaction_clear ! Deallocates Reaction + contains + procedure :: clear => reaction_clear ! Deallocates Reaction end type Reaction !=============================================================================== diff --git a/src/global.F90 b/src/global.F90 index 02f53a4f7d..17477ed80b 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -5,7 +5,7 @@ module global use constants use dict_header, only: DictCharInt, DictIntInt use geometry_header, only: Cell, Universe, Lattice, LatticeContainer - use macroxs_header, only: MacroXS_Base, MacroXSContainer + use macroxs_header, only: MacroXSContainer use material_header, only: Material use mesh_header, only: RegularMesh use nuclide_header diff --git a/src/macroxs_header.F90 b/src/macroxs_header.F90 index 95053789f5..0f838967ea 100644 --- a/src/macroxs_header.F90 +++ b/src/macroxs_header.F90 @@ -14,26 +14,24 @@ module macroxs_header ! particle is traveling through !=============================================================================== - type, abstract :: MacroXS_Base + type, abstract :: MacroXS ! Data Order integer :: order - ! Type-Bound procedures contains - procedure(macroxs_init_), deferred, pass :: init ! initializes object - procedure(macroxs_get_xs_), deferred, pass :: get_xs ! Return xs - end type MacroXS_Base + procedure(macroxs_init_), deferred :: init ! initializes object + procedure(macroxs_get_xs_), deferred :: get_xs ! Return xs + end type MacroXS abstract interface subroutine macroxs_init_(this, mat, nuclides, groups, get_kfiss, get_fiss, & max_order, scatt_type, legendre_mu_points, & error_code, error_text) - - import MacroXS_Base + import MacroXS import Material import NuclideMGContainer import MAX_LINE_LEN - class(MacroXS_Base), intent(inout) :: this ! The MacroXS to initialize + class(MacroXS), intent(inout) :: this ! The MacroXS to initialize type(Material), pointer, intent(in) :: mat ! base material type(NuclideMGContainer), intent(in) :: nuclides(:) ! List of nuclides to harvest from integer, intent(in) :: groups ! Number of E groups @@ -44,47 +42,36 @@ module macroxs_header integer, intent(in) :: legendre_mu_points ! Treat as Leg or Tabular? integer, intent(inout) :: error_code ! Code signifying error character(MAX_LINE_LEN), intent(inout) :: error_text ! Error message to print - end subroutine macroxs_init_ function macroxs_get_xs_(this, g, xstype, gout, uvw) result(xs) - import MacroXS_Base - class(MacroXS_Base), intent(in) :: this ! The MacroXS to initialize + import MacroXS + class(MacroXS), intent(in) :: this ! The MacroXS to initialize integer, intent(in) :: g ! Incoming Energy group character(*) , intent(in) :: xstype ! Cross Section Type integer, optional, intent(in) :: gout ! Outgoing Energy group real(8), optional, intent(in) :: uvw(3) ! Requested Angle real(8) :: xs ! Resultant xs - end function macroxs_get_xs_ - - subroutine macroxs_clear_(this) - - import MacroXS_Base - class(MacroXS_Base), intent(inout) :: this ! The MacroXS to clear - - end subroutine macroxs_clear_ - end interface - type, extends(MacroXS_Base) :: MacroXS_Iso + type, extends(MacroXS) :: MacroXSIso ! Microscopic cross sections real(8), allocatable :: total(:) ! total cross section real(8), allocatable :: absorption(:) ! absorption cross section - class(ScattData_Base), allocatable :: scatter ! scattering information + class(ScattData), allocatable :: scatter ! scattering information real(8), allocatable :: nu_fission(:) ! nu-fission real(8), allocatable :: k_fission(:) ! kappa-fission real(8), allocatable :: fission(:) ! fission x/s real(8), allocatable :: scattxs(:) ! scattering xs real(8), allocatable :: chi(:,:) ! fission spectra - ! Type-Bound procedures contains - procedure, pass :: init => macroxs_iso_init ! inits object - procedure, pass :: get_xs => macroxs_iso_get_xs ! Returns xs - end type MacroXS_Iso + procedure :: init => macroxsiso_init ! inits object + procedure :: get_xs => macroxsiso_get_xs ! Returns xs + end type MacroXSIso - type, extends(MacroXS_Base) :: MacroXS_Angle + type, extends(MacroXS) :: MacroXSAngle ! Macroscopic cross sections real(8), allocatable :: total(:,:,:) ! total cross section real(8), allocatable :: absorption(:,:,:) ! absorption cross section @@ -97,18 +84,17 @@ module macroxs_header real(8), allocatable :: polar(:) ! polar angles real(8), allocatable :: azimuthal(:) ! azimuthal angles - ! Type-Bound procedures contains - procedure, pass :: init => macroxs_angle_init ! inits object - procedure, pass :: get_xs => macroxs_angle_get_xs ! Returns xs - end type MacroXS_Angle + procedure :: init => macroxsangle_init ! inits object + procedure :: get_xs => macroxsangle_get_xs ! Returns xs + end type MacroXSAngle !=============================================================================== ! MACROXSCONTAINER pointer array for storing MacroXS objects. !=============================================================================== type MacroXSContainer - class(MacroXS_Base), allocatable :: obj + class(MacroXS), allocatable :: obj end type MacroXSContainer contains @@ -117,10 +103,9 @@ contains ! MACROXS*_INIT sets the MacroXS Data !=============================================================================== - subroutine macroxs_iso_init(this, mat, nuclides, groups, get_kfiss, get_fiss, & + subroutine macroxsiso_init(this, mat, nuclides, groups, get_kfiss, get_fiss, & max_order, scatt_type, legendre_mu_points, error_code, error_text) - - class(MacroXS_Iso), intent(inout) :: this ! The MacroXS to initialize + class(MacroXSIso), intent(inout) :: this ! The MacroXS to initialize type(Material), pointer, intent(in) :: mat ! base material type(NuclideMGContainer), intent(in) :: nuclides(:) ! List of nuclides to harvest from integer, intent(in) :: groups ! Number of E groups @@ -135,7 +120,6 @@ contains integer :: i ! loop index over nuclides integer :: gin, gout ! group indices real(8) :: atom_density ! atom density of a nuclide - ! class(NuclideBase), pointer :: nuc ! current nuclide integer :: imu real(8) :: norm integer :: mat_max_order, order, l @@ -164,7 +148,7 @@ contains ! Allocate stuff for later allocate(scatt_coeffs(order, groups, groups)) scatt_coeffs = ZERO - allocate(ScattData_Histogram :: this % scatter) + allocate(ScattDataHistogram :: this % scatter) else if (scatt_type == ANGLE_TABULAR) then ! Check all scattering data of same size @@ -182,7 +166,7 @@ contains ! Allocate stuff for later allocate(scatt_coeffs(order, groups, groups)) scatt_coeffs = ZERO - allocate(ScattData_Tabular :: this % scatter) + allocate(ScattDataTabular :: this % scatter) else if (scatt_type == ANGLE_LEGENDRE) then ! Otherwise find the maximum scattering order @@ -203,9 +187,9 @@ contains allocate(scatt_coeffs(order + 1, groups, groups)) scatt_coeffs = ZERO if (legendre_mu_points == 1) then - allocate(ScattData_Legendre :: this % scatter) + allocate(ScattDataLegendre :: this % scatter) else - allocate(ScattData_Tabular :: this % scatter) + allocate(ScattDataTabular :: this % scatter) end if end if @@ -307,7 +291,7 @@ contains end do type is (NuclideAngle) error_code = 1 - error_text = "Invalid Passing of NuclideAngle to MacroXS_Iso Object" + error_text = "Invalid Passing of NuclideAngle to MacroXSIso Object" return end select end do @@ -360,12 +344,11 @@ contains ! Deallocate temporaries for the next material deallocate(scatt_coeffs, temp_energy, temp_mult) - end subroutine macroxs_iso_init + end subroutine macroxsiso_init - subroutine macroxs_angle_init(this, mat, nuclides, groups, get_kfiss, get_fiss, & + subroutine macroxsangle_init(this, mat, nuclides, groups, get_kfiss, get_fiss, & max_order, scatt_type, legendre_mu_points, error_code, error_text) - - class(MacroXS_Angle), intent(inout) :: this ! The MacroXS to initialize + class(MacroXSAngle), intent(inout) :: this ! The MacroXS to initialize type(Material), pointer, intent(in) :: mat ! base material type(NuclideMGContainer), intent(in) :: nuclides(:) ! List of nuclides to harvest from integer, intent(in) :: groups ! Number of E groups @@ -435,7 +418,7 @@ contains allocate(this % scatter(nazi, npol)) do ipol = 1, npol do iazi = 1, nazi - allocate(ScattData_Histogram :: this % scatter(iazi, ipol) % obj) + allocate(ScattDataHistogram :: this % scatter(iazi, ipol) % obj) end do end do @@ -458,7 +441,7 @@ contains allocate(this % scatter(nazi, npol)) do ipol = 1, npol do iazi = 1, nazi - allocate(ScattData_Tabular :: this % scatter(iazi, ipol) % obj) + allocate(ScattDataTabular :: this % scatter(iazi, ipol) % obj) end do end do @@ -484,9 +467,9 @@ contains do ipol = 1, npol do iazi = 1, nazi if (legendre_mu_points == 1) then - allocate(ScattData_Legendre :: this % scatter(iazi, ipol) % obj) + allocate(ScattDataLegendre :: this % scatter(iazi, ipol) % obj) else - allocate(ScattData_Tabular :: this % scatter(iazi, ipol) % obj) + allocate(ScattDataTabular :: this % scatter(iazi, ipol) % obj) end if end do end do @@ -524,7 +507,7 @@ contains select type(nuc => nuclides(mat % nuclide(i)) % obj) type is (NuclideIso) error_code = 1 - error_text = "Invalid Passing of NuclideIso to MacroXS_Angle Object" + error_text = "Invalid Passing of NuclideIso to MacroXSAngle Object" return type is (NuclideAngle) ! Add contributions to total, absorption, and fission data (if necessary) @@ -652,14 +635,14 @@ contains ! Deallocate temporaries for the next material deallocate(scatt_coeffs, temp_energy, temp_mult) - end subroutine macroxs_angle_init + end subroutine macroxsangle_init !=============================================================================== ! MACROXS_*_GET_XS returns the requested data type !=============================================================================== - function macroxs_iso_get_xs(this, g, xstype, gout, uvw) result(xs) - class(MacroXS_Iso), intent(in) :: this ! The MacroXS to initialize + function macroxsiso_get_xs(this, g, xstype, gout, uvw) result(xs) + class(MacroXSIso), intent(in) :: this ! The MacroXS to initialize integer, intent(in) :: g ! Incoming Energy group character(*) , intent(in) :: xstype ! Type of xs requested integer, optional, intent(in) :: gout ! Outgoing Energy group @@ -687,10 +670,10 @@ contains end if end select - end function macroxs_iso_get_xs + end function macroxsiso_get_xs - function macroxs_angle_get_xs(this, g, xstype, gout,uvw) result(xs) - class(MacroXS_Angle), intent(in) :: this ! The MacroXS to initialize + function macroxsangle_get_xs(this, g, xstype, gout,uvw) result(xs) + class(MacroXSAngle), intent(in) :: this ! The MacroXS to initialize integer, intent(in) :: g ! Incoming Energy group character(*) , intent(in) :: xstype ! Type of xs requested integer, optional, intent(in) :: gout ! Outgoing Energy group @@ -723,6 +706,6 @@ contains end select end if - end function macroxs_angle_get_xs + end function macroxsangle_get_xs end module macroxs_header diff --git a/src/macroxs.F90 b/src/macroxs_operations.F90 similarity index 80% rename from src/macroxs.F90 rename to src/macroxs_operations.F90 index 170f5fb19a..4fc13910ca 100644 --- a/src/macroxs.F90 +++ b/src/macroxs_operations.F90 @@ -1,7 +1,7 @@ -module macroxs +module macroxs_operations use constants - use macroxs_header, only: MacroXS_Base, MacroXS_Iso, MacroXS_Angle, & + use macroxs_header, only: MacroXS, MacroXSIso, MacroXSAngle, & expand_harmonic use material_header, only: Material use math @@ -20,7 +20,7 @@ contains !=============================================================================== subroutine calculate_mgxs(this, gin, uvw, xs) - class(MacroXS_Base), intent(in) :: this + 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 @@ -28,13 +28,13 @@ contains integer :: iazi, ipol select type(this) - type is (MacroXS_Iso) + 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 (MacroXS_Angle) + 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) @@ -50,16 +50,16 @@ contains !=============================================================================== function sample_fission_energy(this, gin, uvw) result(gout) - class(MacroXS_Base), intent(in) :: this ! Data to work with + 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 (MacroXS_Iso) - gout = macroxs_iso_sample_fission_energy(this, gin, uvw) - type is (MacroXS_Angle) - gout = macroxs_angle_sample_fission_energy(this, gin, uvw) + 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 @@ -69,11 +69,11 @@ contains ! Implemented as % scatter. !=============================================================================== - function macroxs_iso_sample_fission_energy(this, gin, uvw) result(gout) - class(MacroXS_Iso), 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 + 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 @@ -86,10 +86,10 @@ contains prob = prob + this % chi(gout,gin) end do - end function macroxs_iso_sample_fission_energy + end function macroxsiso_sample_fission_energy - function macroxs_angle_sample_fission_energy(this, gin, uvw) result(gout) - class(MacroXS_Angle), intent(in) :: this ! Data to work with + 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 @@ -108,14 +108,14 @@ contains prob = prob + this % chi(gout,gin,iazi,ipol) end do - end function macroxs_angle_sample_fission_energy + 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_Base), intent(in) :: this + 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 @@ -125,9 +125,9 @@ contains integer :: iazi, ipol ! Angular indices select type(this) - type is (MacroXS_Iso) + type is (MacroXSIso) call macroxs_sample_scatter(this % scatter, gin, gout, mu, wgt) - type is (MacroXS_Angle) + 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 @@ -140,11 +140,11 @@ contains !=============================================================================== subroutine macroxs_sample_scatter(scatt, gin, gout, mu, wgt) - class(ScattData_Base), 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 + 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 @@ -164,7 +164,7 @@ contains end do select type (scatt) - type is (ScattData_Histogram) + type is (ScattDataHistogram) xi = prn() if (xi < scatt % data(1,gout,gin)) then imu = 1 @@ -176,7 +176,7 @@ contains ! Randomly select a mu in this bin. mu = prn() * scatt % dmu + scatt % mu(imu) - type is (ScattData_Tabular) + type is (ScattDataTabular) ! determine outgoing cosine bin NP = size(scatt % data(:,gout,gin)) xi = prn() @@ -211,7 +211,7 @@ contains mu = ONE end if - type is (ScattData_Legendre) + type is (ScattDataLegendre) ! Now we can sample mu using the legendre representation of the scattering ! kernel in data(1:this % order) @@ -240,4 +240,4 @@ contains end subroutine macroxs_sample_scatter -end module macroxs \ No newline at end of file +end module macroxs_operations \ No newline at end of file diff --git a/src/mgxs_data.F90 b/src/mgxs_data.F90 index d9c397f5bb..94546c10dc 100644 --- a/src/mgxs_data.F90 +++ b/src/mgxs_data.F90 @@ -486,7 +486,7 @@ contains return call get_node_array(node_xsdata, "polar", this % polar) else - dangle = PI / (real(this % Npol,8)) + dangle = PI / real(this % Npol,8) do iangle = 1, this % Npol this % polar(iangle) = (real(iangle,8) - 0.5_8) * dangle end do @@ -497,7 +497,7 @@ contains return call get_node_array(node_xsdata, "azimuthal", this % azimuthal) else - dangle = TWO * PI / (real(this % Nazi,8)) + dangle = TWO * PI / real(this % Nazi,8) do iangle = 1, this % Nazi this % azimuthal(iangle) = -PI + (real(iangle,8) - 0.5_8) * dangle end do @@ -685,9 +685,9 @@ contains ! Now allocate accordingly select case(representation) case(MGXS_ISOTROPIC) - allocate(MacroXS_Iso :: macro_xs(i_mat) % obj) + allocate(MacroXSIso :: macro_xs(i_mat) % obj) case(MGXS_ANGLE) - allocate(MacroXS_Angle :: macro_xs(i_mat) % obj) + allocate(MacroXSAngle :: macro_xs(i_mat) % obj) end select call macro_xs(i_mat) % obj % init(mat, nuclides_MG, energy_groups, & diff --git a/src/nuclide_header.F90 b/src/nuclide_header.F90 index 095155a33b..caf0c10729 100644 --- a/src/nuclide_header.F90 +++ b/src/nuclide_header.F90 @@ -12,12 +12,12 @@ module nuclide_header implicit none !=============================================================================== -! NuclideBase contains the base nuclidic data for a nuclide, which does not depend +! Nuclide contains the base nuclidic data for a nuclide, which does not depend ! upon how the nuclear data is represented (i.e., CE, or any variant of MG). ! The extended types, NuclideCE and NuclideMG deal with the rest !=============================================================================== - type, abstract :: NuclideBase + type, abstract :: Nuclide character(12) :: name ! name of nuclide, e.g. 92235.03c integer :: zaid ! Z and A identifier, e.g. 92235 real(8) :: awr ! Atomic Weight Ratio @@ -30,21 +30,21 @@ module nuclide_header ! Fission information logical :: fissionable ! nuclide is fissionable? - contains - procedure(print_nuclide_), deferred, pass :: print ! Writes nuclide info - end type NuclideBase + contains + procedure(print_nuclide_), deferred :: print ! Writes nuclide info + end type Nuclide abstract interface subroutine print_nuclide_(this, unit) - import NuclideBase - class(NuclideBase),intent(in) :: this - integer, optional, intent(in) :: unit + import Nuclide + class(Nuclide),intent(in) :: this + integer, optional, intent(in) :: unit end subroutine print_nuclide_ end interface - type, extends(NuclideBase) :: NuclideCE + type, extends(Nuclide) :: NuclideCE ! Energy grid information integer :: n_grid ! # of nuclide grid points integer, allocatable :: grid_index(:) ! log grid mapping indices @@ -100,13 +100,12 @@ module nuclide_header type(DictIntInt) :: reaction_index ! map MT values to index in reactions ! array; used at tally-time - ! Type-Bound procedures - contains - procedure, pass :: clear => nuclidece_clear - procedure, pass :: print => nuclidece_print + contains + procedure :: clear => nuclidece_clear + procedure :: print => nuclidece_print end type NuclideCE - type, abstract, extends(NuclideBase) :: NuclideMG + type, abstract, extends(Nuclide) :: NuclideMG ! Scattering Order Information integer :: order ! Order of data (Scattering for NuclideIso, ! Number of angles for all in NuclideAngle) @@ -114,10 +113,9 @@ module nuclide_header integer :: legendre_mu_points ! Number of tabular points to use to represent ! Legendre distribs, -1 if sample with the ! Legendres themselves -! Type-Bound procedures - contains - procedure(nuclidemg_get_xs), deferred, pass :: get_xs ! Get the xs - procedure(nuclide_calc_f_), deferred, pass :: calc_f ! Calculates f, given mu + contains + procedure(nuclidemg_get_xs), deferred :: get_xs ! Get the xs + procedure(nuclide_calc_f_), deferred :: calc_f ! Calculates f, given mu end type NuclideMG abstract interface @@ -166,11 +164,10 @@ module nuclide_header real(8), allocatable :: chi(:) ! Fission Spectra real(8), allocatable :: mult(:,:) ! Scatter multiplicity (Gout x Gin) - ! Type-Bound procedures - contains - procedure, pass :: print => nuclideiso_print ! Writes nuclide info - procedure, pass :: get_xs => nuclideiso_get_xs ! Gets Size of Data w/in Object - procedure, pass :: calc_f => nuclideiso_calc_f ! Calcs f given mu + contains + procedure :: print => nuclideiso_print ! Writes nuclide info + procedure :: get_xs => nuclideiso_get_xs ! Gets Size of Data w/in Object + procedure :: calc_f => nuclideiso_calc_f ! Calcs f given mu end type NuclideIso !=============================================================================== @@ -196,11 +193,10 @@ module nuclide_header real(8), allocatable :: polar(:) ! polar angles real(8), allocatable :: azimuthal(:) ! azimuthal angles - ! Type-Bound procedures - contains - procedure, pass :: print => nuclideangle_print ! Gets Size of Data w/in Object - procedure, pass :: get_xs => nuclideangle_get_xs ! Gets Size of Data w/in Object - procedure, pass :: calc_f => nuclideangle_calc_f ! Calcs f given mu + contains + procedure :: print => nuclideangle_print ! Gets Size of Data w/in Object + procedure :: get_xs => nuclideangle_get_xs ! Gets Size of Data w/in Object + procedure :: calc_f => nuclideangle_calc_f ! Calcs f given mu end type NuclideAngle !=============================================================================== @@ -217,14 +213,12 @@ module nuclide_header !=============================================================================== type Nuclide0K - character(10) :: nuclide ! name of nuclide, e.g. U-238 character(16) :: scheme = 'ares' ! target velocity sampling scheme character(10) :: name ! name of nuclide, e.g. 92235.03c character(10) :: name_0K ! name of 0K nuclide, e.g. 92235.00c real(8) :: E_min = 0.01e-6_8 ! lower cutoff energy for res scattering real(8) :: E_max = 1000.0e-6_8 ! upper cutoff energy for res scattering - end type Nuclide0K !=============================================================================== @@ -289,7 +283,7 @@ module nuclide_header contains !=============================================================================== -! NUCLIDECE_CLEAR resets and deallocates data in NuclideBase, NuclideIso +! NUCLIDECE_CLEAR resets and deallocates data in Nuclide, NuclideIso ! or NuclideAngle !=============================================================================== @@ -648,7 +642,7 @@ 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) ! Find mu bin algebraically, knowing that the spacing is equal f = (mu + ONE) / dmu + ONE imu = floor(f) @@ -702,7 +696,7 @@ 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) ! Find mu bin algebraically, knowing that the spacing is equal f = (mu + ONE) / dmu + ONE imu = floor(f) @@ -751,9 +745,9 @@ module nuclide_header my_azi = atan2(uvw(2), uvw(1)) ! Search for equi-binned angles - dangle = PI / (real(size(polar),8)) + dangle = PI / real(size(polar),8) i_pol = floor(my_pol / dangle + ONE) - dangle = TWO * PI / (real(size(azimuthal),8)) + dangle = TWO * PI / real(size(azimuthal),8) i_azi = floor((my_azi + PI) / dangle + ONE) end subroutine find_angle diff --git a/src/particle_header.F90 b/src/particle_header.F90 index 0426acd924..3c687eb02f 100644 --- a/src/particle_header.F90 +++ b/src/particle_header.F90 @@ -94,10 +94,10 @@ module particle_header type(Bank) :: secondary_bank(MAX_SECONDARY) contains - procedure, pass :: initialize => initialize_particle - procedure, pass :: clear => clear_particle - procedure, pass :: initialize_from_source => initialize_from_source - procedure, pass :: create_secondary => create_secondary + procedure :: initialize => initialize_particle + procedure :: clear => clear_particle + procedure :: initialize_from_source => initialize_from_source + procedure :: create_secondary => create_secondary end type Particle contains diff --git a/src/physics_mg.F90 b/src/physics_mg.F90 index 048f3ce54f..a0d8eb6e1d 100644 --- a/src/physics_mg.F90 +++ b/src/physics_mg.F90 @@ -5,8 +5,8 @@ module physics_mg use constants use error, only: fatal_error, warning use global - use macroxs_header, only: MacroXS_Base, MacroXSContainer - use macroxs, only: sample_fission_energy, sample_scatter + 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 @@ -179,7 +179,7 @@ contains real(8) :: phi ! fission neutron azimuthal angle real(8) :: weight ! weight adjustment for ufs method logical :: in_mesh ! source site in ufs mesh? - class(MacroXS_Base), pointer :: xs + class(MacroXS), pointer :: xs ! Get Pointers xs => macro_xs(p % material) % obj diff --git a/src/sab_header.F90 b/src/sab_header.F90 index 56617dd01d..695f735c05 100644 --- a/src/sab_header.F90 +++ b/src/sab_header.F90 @@ -60,8 +60,8 @@ module sab_header real(8), allocatable :: elastic_e_in(:) real(8), allocatable :: elastic_P(:) real(8), allocatable :: elastic_mu(:,:) - contains - procedure, pass :: print => print_sab_table + contains + procedure :: print => print_sab_table end type SAlphaBeta contains diff --git a/src/scattdata_header.F90 b/src/scattdata_header.F90 index 091a77741a..62b382d36c 100644 --- a/src/scattdata_header.F90 +++ b/src/scattdata_header.F90 @@ -10,68 +10,67 @@ module scattdata_header ! angular distribution !=============================================================================== - type, abstract :: ScattData_Base + type, abstract :: ScattData ! p0 matrix on its own for sampling energy real(8), allocatable :: energy(:,:) ! (Gout x Gin) real(8), allocatable :: mult(:,:) ! (Gout x Gin) real(8), allocatable :: data(:,:,:) ! (Order/Nmu x Gout x Gin) - ! Type-Bound procedures contains - procedure(init_), deferred, pass :: init ! Initializes ScattData - procedure(calc_f_), deferred, pass :: calc_f ! Calculates f, given mu - end type ScattData_Base + procedure(init_), deferred :: init ! Initializes ScattData + procedure(calc_f_), deferred :: calc_f ! Calculates f, given mu + end type ScattData abstract interface subroutine init_(this, order, energy, mult, coeffs) - import ScattData_Base - class(ScattData_Base), intent(inout) :: this ! Object to work on - integer, intent(in) :: order ! Data Order - real(8), intent(in) :: energy(:,:) ! Energy Transfer Matrix - real(8), intent(in) :: mult(:,:) ! Scatter Prod'n Matrix - real(8), intent(in) :: coeffs(:,:,:) ! Coefficients to use + import ScattData + class(ScattData), intent(inout) :: this ! Object to work on + integer, intent(in) :: order ! Data Order + real(8), intent(in) :: energy(:,:) ! Energy Transfer Matrix + real(8), intent(in) :: mult(:,:) ! Scatter Prod'n Matrix + real(8), intent(in) :: coeffs(:,:,:) ! Coefficients to use end subroutine init_ pure function calc_f_(this, gin, gout, mu) result(f) - import ScattData_Base - class(ScattData_Base), intent(in) :: this ! The ScattData to evaluate - integer, intent(in) :: gin ! Incoming Energy Group - integer, intent(in) :: gout ! Outgoing Energy Group - real(8), intent(in) :: mu ! Angle of interest - real(8) :: f ! Return value of f(mu) + import ScattData + class(ScattData), intent(in) :: this ! The ScattData to evaluate + integer, intent(in) :: gin ! Incoming Energy Group + integer, intent(in) :: gout ! Outgoing Energy Group + real(8), intent(in) :: mu ! Angle of interest + real(8) :: f ! Return value of f(mu) end function calc_f_ end interface - type, extends(ScattData_Base) :: ScattData_Legendre + type, extends(ScattData) :: ScattDataLegendre contains - procedure, pass :: init => scattdata_legendre_init - procedure, pass :: calc_f => scattdata_legendre_calc_f - end type ScattData_Legendre + procedure :: init => scattdatalegendre_init + procedure :: calc_f => scattdatalegendre_calc_f + end type ScattDataLegendre - type, extends(ScattData_Base) :: ScattData_Histogram - real(8), allocatable :: mu(:) ! Mu bins - real(8) :: dmu ! Mu spacing + type, extends(ScattData) :: ScattDataHistogram + real(8), allocatable :: mu(:) ! Mu bins + real(8) :: dmu ! Mu spacing contains - procedure, pass :: init => scattdata_histogram_init - procedure, pass :: calc_f => scattdata_histogram_calc_f - end type ScattData_Histogram + procedure :: init => scattdatahistogram_init + procedure :: calc_f => scattdatahistogram_calc_f + end type ScattDataHistogram - type, extends(ScattData_Base) :: ScattData_Tabular - real(8), allocatable :: mu(:) ! Mu bins - real(8) :: dmu ! Mu spacing - real(8), allocatable :: fmu(:,:,:) ! PDF of f(mu) + type, extends(ScattData) :: ScattDataTabular + real(8), allocatable :: mu(:) ! Mu bins + real(8) :: dmu ! Mu spacing + real(8), allocatable :: fmu(:,:,:) ! PDF of f(mu) contains - procedure, pass :: init => scattdata_tabular_init - procedure, pass :: calc_f => scattdata_tabular_calc_f - end type ScattData_Tabular + procedure :: init => scattdatatabular_init + procedure :: calc_f => scattdatatabular_calc_f + end type ScattDataTabular !=============================================================================== ! SCATTDATACONTAINER allocatable array for storing ScattData Objects (for angle) !=============================================================================== type ScattDataContainer - class(ScattData_Base), allocatable :: obj + class(ScattData), allocatable :: obj end type ScattDataContainer contains @@ -80,8 +79,8 @@ contains ! SCATTDATA_INIT builds the scattdata object !=============================================================================== - subroutine scattdata_base_init(this, order, energy, mult) - class(ScattData_Base), intent(inout) :: this ! Object to work on + subroutine scattdatabase_init(this, order, energy, mult) + class(ScattData), intent(inout) :: this ! Object to work on integer, intent(in) :: order ! Data Order real(8), intent(in) :: energy(:,:) ! Energy Transfer Matrix real(8), intent(in) :: mult(:,:) ! Scatter Prod'n Matrix @@ -97,23 +96,23 @@ contains allocate(this % data(order, groups, groups)) this % data = ZERO - end subroutine scattdata_base_init + end subroutine scattdatabase_init - subroutine scattdata_legendre_init(this, order, energy, mult, coeffs) - class(ScattData_Legendre), intent(inout) :: this ! Object to work on + subroutine scattdatalegendre_init(this, order, energy, mult, coeffs) + class(ScattDataLegendre), intent(inout) :: this ! Object to work on integer, intent(in) :: order ! Data Order real(8), intent(in) :: energy(:,:) ! Energy Transfer Matrix real(8), intent(in) :: mult(:,:) ! Scatter Prod'n Matrix real(8), intent(in) :: coeffs(:,:,:) ! Coefficients to use - call scattdata_base_init(this, order, energy, mult) + call scattdatabase_init(this, order, energy, mult) this % data = coeffs - end subroutine scattdata_legendre_init + end subroutine scattdatalegendre_init - subroutine scattdata_histogram_init(this, order, energy, mult, coeffs) - class(ScattData_Histogram), intent(inout) :: this ! Object to work on + subroutine scattdatahistogram_init(this, order, energy, mult, coeffs) + class(ScattDataHistogram), intent(inout) :: this ! Object to work on integer, intent(in) :: order ! Data Order real(8), intent(in) :: energy(:,:) ! Energy Transfer Matrix real(8), intent(in) :: mult(:,:) ! Scatter Prod'n Matrix @@ -124,10 +123,10 @@ contains groups = size(energy,dim=1) - call scattdata_base_init(this, order, energy, mult) + call scattdatabase_init(this, order, energy, mult) allocate(this % mu(order)) - this % dmu = TWO / (real(order,8)) + this % dmu = TWO / real(order,8) this % mu(1) = -ONE do imu = 2, order this % mu(imu) = -ONE + (imu - 1) * this % dmu @@ -152,10 +151,10 @@ contains end do end do - end subroutine scattdata_histogram_init + end subroutine scattdatahistogram_init - subroutine scattdata_tabular_init(this, order, energy, mult, coeffs) - class(ScattData_Tabular), intent(inout) :: this ! Object to work on + subroutine scattdatatabular_init(this, order, energy, mult, coeffs) + class(ScattDataTabular), intent(inout) :: this ! Object to work on integer, intent(in) :: order ! Data Order real(8), intent(in) :: energy(:,:) ! Energy Transfer Matrix real(8), intent(in) :: mult(:,:) ! Scatter Prod'n Matrix @@ -176,10 +175,10 @@ contains groups = size(energy,dim=1) - call scattdata_base_init(this, this_order, energy, mult) + call scattdatabase_init(this, this_order, energy, mult) allocate(this % mu(this_order)) - this % dmu = TWO / (real(this_order) - 1) + this % dmu = TWO / real(this_order - 1) do imu = 1, this_order - 1 this % mu(imu) = -ONE + real(imu - 1) * this % dmu end do @@ -228,14 +227,14 @@ contains end do end do - end subroutine scattdata_tabular_init + end subroutine scattdatatabular_init !=============================================================================== ! SCATTDATA_*_CALC_F Calculates the value of f given mu (and gin,gout pair) !=============================================================================== - pure function scattdata_legendre_calc_f(this, gin, gout, mu) result(f) - class(ScattData_Legendre), intent(in) :: this ! The ScattData to evaluate + pure function scattdatalegendre_calc_f(this, gin, gout, mu) result(f) + class(ScattDataLegendre), intent(in) :: this ! The ScattData to evaluate integer, intent(in) :: gin ! Incoming Energy Group integer, intent(in) :: gout ! Outgoing Energy Group real(8), intent(in) :: mu ! Angle of interest @@ -244,10 +243,10 @@ contains ! Plug mu in to the legendre expansion and go from there f = evaluate_legendre(this % data(:, gout, gin), mu) - end function scattdata_legendre_calc_f + end function scattdatalegendre_calc_f - pure function scattdata_histogram_calc_f(this, gin, gout, mu) result(f) - class(ScattData_Histogram), intent(in) :: this ! The ScattData to evaluate + pure function scattdatahistogram_calc_f(this, gin, gout, mu) result(f) + class(ScattDataHistogram), intent(in) :: this ! The ScattData to evaluate integer, intent(in) :: gin ! Incoming Energy Group integer, intent(in) :: gout ! Outgoing Energy Group real(8), intent(in) :: mu ! Angle of interest @@ -265,10 +264,10 @@ contains ! Use histogram interpolation to find f(mu) f = this % data(imu, gout, gin) - end function scattdata_histogram_calc_f + end function scattdatahistogram_calc_f - pure function scattdata_tabular_calc_f(this, gin, gout, mu) result(f) - class(ScattData_Tabular), intent(in) :: this ! The ScattData to evaluate + pure function scattdatatabular_calc_f(this, gin, gout, mu) result(f) + class(ScattDataTabular), intent(in) :: this ! The ScattData to evaluate integer, intent(in) :: gin ! Incoming Energy Group integer, intent(in) :: gout ! Outgoing Energy Group real(8), intent(in) :: mu ! Angle of interest @@ -289,6 +288,6 @@ contains f = (ONE - r) * this % data(imu, gout, gin) + & r * this % data(imu + 1, gout, gin) - end function scattdata_tabular_calc_f + end function scattdatatabular_calc_f end module scattdata_header \ No newline at end of file diff --git a/src/tracking.F90 b/src/tracking.F90 index 0b2719ef5d..98e5483a0a 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -1,23 +1,23 @@ module tracking - use constants, only: MODE_EIGENVALUE - use cross_section, only: calculate_xs - use error, only: fatal_error, warning - use geometry, only: find_cell, distance_to_boundary, cross_surface, & - cross_lattice, check_cell_overlap - use geometry_header, only: Universe, BASE_UNIVERSE + use constants, only: MODE_EIGENVALUE + use cross_section, only: calculate_xs + use error, only: fatal_error, warning + use geometry, only: find_cell, distance_to_boundary, cross_surface, & + cross_lattice, check_cell_overlap + use geometry_header, only: Universe, BASE_UNIVERSE use global - use macroxs, only: calculate_mgxs - use output, only: write_message - use particle_header, only: LocalCoord, Particle - use physics, only: collision - use physics_mg, only: collision_mg - use random_lcg, only: prn - use string, only: to_str - use tally, only: score_analog_tally, score_tracklength_tally, & - score_collision_tally, score_surface_current - use track_output, only: initialize_particle_track, write_particle_track, & - add_particle_track, finalize_particle_track + use macroxs_operations, only: calculate_mgxs + use output, only: write_message + use particle_header, only: LocalCoord, Particle + use physics, only: collision + use physics_mg, only: collision_mg + use random_lcg, only: prn + use string, only: to_str + use tally, only: score_analog_tally, score_tracklength_tally, & + score_collision_tally, score_surface_current + use track_output, only: initialize_particle_track, write_particle_track, & + add_particle_track, finalize_particle_track implicit none