diff --git a/CMakeLists.txt b/CMakeLists.txt index fe22c667b3..c81777198d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -363,7 +363,7 @@ set(LIBOPENMC_FORTRAN_SRC src/mesh_header.F90 src/message_passing.F90 src/mgxs_data.F90 - src/mgxs_header.F90 + src/mgxs_interface.F90 src/multipole_header.F90 src/nuclide_header.F90 src/output.F90 @@ -382,7 +382,6 @@ set(LIBOPENMC_FORTRAN_SRC src/reaction_header.F90 src/relaxng src/sab_header.F90 - src/scattdata_header.F90 src/secondary_correlated.F90 src/secondary_kalbach.F90 src/secondary_nbody.F90 @@ -443,12 +442,17 @@ set(LIBOPENMC_CXX_SRC src/lattice.cpp src/math_functions.cpp src/message_passing.cpp + src/mgxs.cpp + src/mgxs_interface.cpp src/plot.cpp src/random_lcg.cpp + src/scattdata.cpp src/simulation.cpp src/state_point.cpp + src/string_functions.cpp src/surface.cpp src/xml_interface.cpp + src/xsdata.cpp src/pugixml/pugixml.cpp) add_library(libopenmc SHARED ${LIBOPENMC_FORTRAN_SRC} ${LIBOPENMC_CXX_SRC}) set_target_properties(libopenmc PROPERTIES diff --git a/openmc/mesh.py b/openmc/mesh.py index 3f53582d5e..f7cba22f8d 100644 --- a/openmc/mesh.py +++ b/openmc/mesh.py @@ -208,12 +208,12 @@ class Mesh(IDManagerMixin): shape = np.array(lattice.shape) width = lattice.pitch*shape - + mesh = cls(mesh_id, name) mesh.lower_left = lattice.lower_left mesh.upper_right = lattice.lower_left + width mesh.dimension = shape*division - + return mesh def to_xml_element(self): @@ -333,14 +333,16 @@ class Mesh(IDManagerMixin): if n_dim == 1: universe_array = np.array([universes]) elif n_dim == 2: - universe_array = np.empty(self.dimension, dtype=openmc.Universe) + universe_array = np.empty(self.dimension[::-1], + dtype=openmc.Universe) i = 0 for y in range(self.dimension[1] - 1, -1, -1): for x in range(self.dimension[0]): universe_array[y][x] = universes[i] i += 1 else: - universe_array = np.empty(self.dimension, dtype=openmc.Universe) + universe_array = np.empty(self.dimension[::-1], + dtype=openmc.Universe) i = 0 for z in range(self.dimension[2]): for y in range(self.dimension[1] - 1, -1, -1): diff --git a/src/api.F90 b/src/api.F90 index 1ddae68f8b..01bd565b6e 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -130,7 +130,7 @@ contains index_ufs_mesh = -1 keff = ONE legendre_to_tabular = .true. - legendre_to_tabular_points = 33 + legendre_to_tabular_points = C_NONE n_batch_interval = 1 n_lost_particles = 0 n_particles = 0 @@ -312,7 +312,6 @@ contains subroutine free_memory() use cmfd_header - use mgxs_header use photon_header use plot_header use sab_header @@ -332,7 +331,6 @@ contains call free_memory_nuclide() call free_memory_photon() call free_memory_settings() - call free_memory_mgxs() call free_memory_sab() call free_memory_source() call free_memory_mesh() diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 031dc08a43..c1965b2206 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -3,8 +3,8 @@ module cmfd_input use, intrinsic :: ISO_C_BINDING use cmfd_header - use mesh_header, only: mesh_dict - use mgxs_header, only: energy_bins + use mesh_header, only: mesh_dict + use mgxs_interface, only: energy_bins, num_energy_groups use tally use tally_header use timer_header diff --git a/src/constants.F90 b/src/constants.F90 index 6e273e564c..e1b298d5a4 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -420,6 +420,25 @@ module constants DIFF_NUCLIDE_DENSITY = 2, & DIFF_TEMPERATURE = 3 + + ! Mgxs::get_xs enumerated types + integer(C_INT), parameter :: & + MG_GET_XS_TOTAL = 0, & + MG_GET_XS_ABSORPTION = 1, & + MG_GET_XS_INVERSE_VELOCITY = 2, & + MG_GET_XS_DECAY_RATE = 3, & + MG_GET_XS_SCATTER = 4, & + MG_GET_XS_SCATTER_MULT = 5, & + MG_GET_XS_SCATTER_FMU_MULT = 6, & + MG_GET_XS_SCATTER_FMU = 7, & + MG_GET_XS_FISSION = 8, & + MG_GET_XS_KAPPA_FISSION = 9, & + MG_GET_XS_PROMPT_NU_FISSION = 10, & + MG_GET_XS_DELAYED_NU_FISSION = 11, & + MG_GET_XS_NU_FISSION = 12, & + MG_GET_XS_CHI_PROMPT = 13, & + MG_GET_XS_CHI_DELAYED = 14 + ! ============================================================================ ! RANDOM NUMBER STREAM CONSTANTS diff --git a/src/constants.h b/src/constants.h index 685fbcfd72..016a6b3484 100644 --- a/src/constants.h +++ b/src/constants.h @@ -1,10 +1,85 @@ +//! \file constants.h +//! A collection of constants + #ifndef CONSTANTS_H #define CONSTANTS_H +#include +#include #include +#include +namespace openmc { -namespace openmc{ +typedef std::vector double_1dvec; +typedef std::vector > double_2dvec; +typedef std::vector > > double_3dvec; +typedef std::vector > > > double_4dvec; +typedef std::vector > > > > double_5dvec; +typedef std::vector > > > > > double_6dvec; +typedef std::vector int_1dvec; +typedef std::vector > int_2dvec; +typedef std::vector > > int_3dvec; + +constexpr int MAX_SAMPLE {10000}; + +constexpr std::array VERSION {0, 10, 0}; +constexpr std::array VERSION_PARTICLE_RESTART {2, 0}; + +// Maximum number of words in a single line, length of line, and length of +// single word +constexpr int MAX_WORDS {500}; +constexpr int MAX_LINE_LEN {250}; +constexpr int MAX_WORD_LEN {150}; +constexpr int MAX_FILE_LEN {255}; + +// Physical Constants +constexpr double K_BOLTZMANN {8.6173303e-5}; // Boltzmann constant in eV/K + +// Angular distribution type +constexpr int ANGLE_ISOTROPIC {1}; +constexpr int ANGLE_32_EQUI {2}; +constexpr int ANGLE_TABULAR {3}; +constexpr int ANGLE_LEGENDRE {4}; +constexpr int ANGLE_HISTOGRAM {5}; + +// MGXS Table Types +constexpr int MGXS_ISOTROPIC {1}; // Isotroically weighted data +constexpr int MGXS_ANGLE {2}; // Data by angular bins + +// Flag to denote this was a macroscopic data object +constexpr double MACROSCOPIC_AWR {-2.}; + +// Number of mu bins to use when converting Legendres to tabular type +constexpr int DEFAULT_NMU {33}; + +// Temperature treatment method +constexpr int TEMPERATURE_NEAREST {1}; +constexpr int TEMPERATURE_INTERPOLATION {2}; + +// TODO: cmath::M_PI has 3 more digits precision than the Fortran constant we +// use so for now we will reuse the Fortran constant until we are OK with +// modifying test results +constexpr double PI {3.1415926535898}; + +const double SQRT_PI {std::sqrt(PI)}; + +// Mgxs::get_xs enumerated types +constexpr int MG_GET_XS_TOTAL {0}; +constexpr int MG_GET_XS_ABSORPTION {1}; +constexpr int MG_GET_XS_INVERSE_VELOCITY {2}; +constexpr int MG_GET_XS_DECAY_RATE {3}; +constexpr int MG_GET_XS_SCATTER {4}; +constexpr int MG_GET_XS_SCATTER_MULT {5}; +constexpr int MG_GET_XS_SCATTER_FMU_MULT {6}; +constexpr int MG_GET_XS_SCATTER_FMU {7}; +constexpr int MG_GET_XS_FISSION {8}; +constexpr int MG_GET_XS_KAPPA_FISSION {9}; +constexpr int MG_GET_XS_PROMPT_NU_FISSION {10}; +constexpr int MG_GET_XS_DELAYED_NU_FISSION {11}; +constexpr int MG_GET_XS_NU_FISSION {12}; +constexpr int MG_GET_XS_CHI_PROMPT {13}; +constexpr int MG_GET_XS_CHI_DELAYED {14}; extern "C" double FP_COINCIDENT; extern "C" double FP_PRECISION; diff --git a/src/error.F90 b/src/error.F90 index d041051d29..82b142b51e 100644 --- a/src/error.F90 +++ b/src/error.F90 @@ -265,4 +265,13 @@ contains end subroutine write_message + subroutine write_message_from_c(message, message_len, level) bind(C) + integer(C_INT), intent(in), value :: message_len + character(kind=C_CHAR), intent(in) :: message(message_len) + integer(C_INT), intent(in), value :: level + character(message_len+1) :: message_out + write(message_out, *) message + call write_message(message_out, level) + end subroutine write_message_from_c + end module error diff --git a/src/error.h b/src/error.h index 45d8bcdede..356dfd8010 100644 --- a/src/error.h +++ b/src/error.h @@ -11,7 +11,8 @@ namespace openmc { extern "C" void fatal_error_from_c(const char* message, int message_len); extern "C" void warning_from_c(const char* message, int message_len); - +extern "C" void write_message_from_c(const char* message, int message_len, + int level); inline void fatal_error(const char *message) @@ -43,5 +44,23 @@ void warning(const std::stringstream& message) warning(message.str()); } +inline +void write_message(const char* message, int level) +{ + write_message_from_c(message, strlen(message), level); +} + +inline +void write_message(const std::string& message, int level) +{ + write_message_from_c(message.c_str(), message.length(), level); +} + +inline +void write_message(const std::stringstream& message, int level) +{ + write_message(message.str(), level); +} + } // namespace openmc #endif // ERROR_H diff --git a/src/hdf5_interface.cpp b/src/hdf5_interface.cpp index 8a8391bb54..7133ad51ac 100644 --- a/src/hdf5_interface.cpp +++ b/src/hdf5_interface.cpp @@ -447,6 +447,172 @@ read_complex(hid_t obj_id, const char* name, double _Complex* buffer, bool indep } +void +read_nd_vector(hid_t obj_id, const char* name, std::vector& result, + bool must_have) +{ + if (object_exists(obj_id, name)) { + read_double(obj_id, name, result.data(), true); + } else if (must_have) { + fatal_error(std::string("Must provide " + std::string(name) + "!")); + } +} + + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector >& result, bool must_have) +{ + if (object_exists(obj_id, name)) { + int dim1 = result.size(); + int dim2 = result[0].size(); + double temp_arr[dim1 * dim2]; + read_double(obj_id, name, temp_arr, true); + + int temp_idx = 0; + for (int i = 0; i < dim1; i++) { + for (int j = 0; j < dim2; j++) { + result[i][j] = temp_arr[temp_idx++]; + } + } + } else if (must_have) { + fatal_error(std::string("Must provide " + std::string(name) + "!")); + } +} + + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector >& result, bool must_have) +{ + if (object_exists(obj_id, name)) { + int dim1 = result.size(); + int dim2 = result[0].size(); + int temp_arr[dim1 * dim2]; + read_int(obj_id, name, temp_arr, true); + + int temp_idx = 0; + for (int i = 0; i < dim1; i++) { + for (int j = 0; j < dim2; j++) { + result[i][j] = temp_arr[temp_idx++]; + } + } + } else if (must_have) { + fatal_error(std::string("Must provide " + std::string(name) + "!")); + } +} + + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector > >& result, + bool must_have) +{ + if (object_exists(obj_id, name)) { + int dim1 = result.size(); + int dim2 = result[0].size(); + int dim3 = result[0][0].size(); + double temp_arr[dim1 * dim2 * dim3]; + read_double(obj_id, name, temp_arr, true); + + int temp_idx = 0; + for (int i = 0; i < dim1; i++) { + for (int j = 0; j < dim2; j++) { + for (int k = 0; k < dim3; k++) { + result[i][j][k] = temp_arr[temp_idx++]; + } + } + } + } else if (must_have) { + fatal_error(std::string("Must provide " + std::string(name) + "!")); + } +} + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector > >& result, + bool must_have) +{ + if (object_exists(obj_id, name)) { + int dim1 = result.size(); + int dim2 = result[0].size(); + int dim3 = result[0][0].size(); + int temp_arr[dim1 * dim2 * dim3]; + read_int(obj_id, name, temp_arr, true); + + int temp_idx = 0; + for (int i = 0; i < dim1; i++) { + for (int j = 0; j < dim2; j++) { + for (int k = 0; k < dim3; k++) { + result[i][j][k] = temp_arr[temp_idx++]; + } + } + } + } else if (must_have) { + fatal_error(std::string("Must provide " + std::string(name) + "!")); + } +} + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector > > >& result, + bool must_have) +{ + if (object_exists(obj_id, name)) { + int dim1 = result.size(); + int dim2 = result[0].size(); + int dim3 = result[0][0].size(); + int dim4 = result[0][0][0].size(); + double temp_arr[dim1 * dim2 * dim3 * dim4]; + read_double(obj_id, name, temp_arr, true); + + int temp_idx = 0; + for (int i = 0; i < dim1; i++) { + for (int j = 0; j < dim2; j++) { + for (int k = 0; k < dim3; k++) { + for (int l = 0; l < dim4; l++) { + result[i][j][k][l] = temp_arr[temp_idx++]; + } + } + } + } + } else if (must_have) { + fatal_error(std::string("Must provide " + std::string(name) + "!")); + } +} + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector > > > >& result, + bool must_have) +{ + if (object_exists(obj_id, name)) { + int dim1 = result.size(); + int dim2 = result[0].size(); + int dim3 = result[0][0].size(); + int dim4 = result[0][0][0].size(); + int dim5 = result[0][0][0][0].size(); + double temp_arr[dim1 * dim2 * dim3 * dim4 * dim5]; + read_double(obj_id, name, temp_arr, true); + + int temp_idx = 0; + for (int i = 0; i < dim1; i++) { + for (int j = 0; j < dim2; j++) { + for (int k = 0; k < dim3; k++) { + for (int l = 0; l < dim4; l++) { + for (int m = 0; m < dim5; m++) { + result[i][j][k][l][m] = temp_arr[temp_idx++]; + } + } + } + } + } + } else if (must_have) { + fatal_error(std::string("Must provide " + std::string(name) + "!")); + } +} + + void read_tally_results(hid_t group_id, hsize_t n_filter, hsize_t n_score, double* results) { diff --git a/src/hdf5_interface.h b/src/hdf5_interface.h index 353d0137af..b00fe7c879 100644 --- a/src/hdf5_interface.h +++ b/src/hdf5_interface.h @@ -7,6 +7,7 @@ #include #include #include +#include #include @@ -55,6 +56,39 @@ extern "C" void read_string(hid_t obj_id, const char* name, size_t slen, extern "C" void read_complex(hid_t obj_id, const char* name, double _Complex* buffer, bool indep); +void +read_nd_vector(hid_t obj_id, const char* name, std::vector& result, + bool must_have = false); + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector >& result, + bool must_have = false); + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector >& result, bool must_have = false); + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector > >& result, + bool must_have = false); + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector > >& result, + bool must_have = false); + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector > > >& result, + bool must_have = false); + +void +read_nd_vector(hid_t obj_id, const char* name, + std::vector > > > >& result, + bool must_have = false); + extern "C" void read_tally_results(hid_t group_id, hsize_t n_filter, hsize_t n_score, double* results); diff --git a/src/input_xml.F90 b/src/input_xml.F90 index d2b9cc7d9a..c66cc26607 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -19,7 +19,7 @@ module input_xml use mesh_header use message_passing use mgxs_data, only: create_macro_xs, read_mgxs - use mgxs_header + use mgxs_interface use nuclide_header use output, only: title, header, print_plot use photon_header @@ -3567,7 +3567,7 @@ contains if (run_CE) then awr = nuclides(mat % nuclide(j)) % awr else - awr = nuclides_MG(mat % nuclide(j)) % obj % awr + awr = get_awr_c(mat % nuclide(j)) end if ! if given weight percent, convert all values so that they are divided @@ -3592,7 +3592,7 @@ contains if (run_CE) then awr = nuclides(mat % nuclide(j)) % awr else - awr = nuclides_MG(mat % nuclide(j)) % obj % awr + awr = get_awr_c(mat % nuclide(j)) end if x = mat % atom_density(j) sum_percent = sum_percent + x*awr diff --git a/src/material_header.F90 b/src/material_header.F90 index 8d457378ac..1664f75e7f 100644 --- a/src/material_header.F90 +++ b/src/material_header.F90 @@ -39,7 +39,7 @@ module material_header integer, allocatable :: nuclide(:) ! index in nuclides array integer, allocatable :: element(:) ! index in elements array real(8) :: density ! total atom density in atom/b-cm - real(8), allocatable :: atom_density(:) ! nuclide atom density in atom/b-cm + real(C_DOUBLE), allocatable :: atom_density(:) ! nuclide atom density in atom/b-cm real(8) :: density_gpcc ! total density in g/cm^3 ! To improve performance of tallying, we store an array (direct address diff --git a/src/math_functions.cpp b/src/math_functions.cpp index bebfdc316e..d89cd11525 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -97,7 +97,7 @@ void calc_pn_c(int n, double x, double pnx[]) { } // Use recursion relation to build the higher orders - for (int l = 1; l < n; l ++) { + for (int l = 1; l < n; l++) { pnx[l + 1] = ((2 * l + 1) * x * pnx[l] - l * pnx[l - 1]) / (l + 1); } } diff --git a/src/math_functions.h b/src/math_functions.h index 38c367c01b..2e92039c02 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -7,22 +7,12 @@ #include #include +#include "constants.h" #include "random_lcg.h" namespace openmc { -//============================================================================== -// Module constants. -//============================================================================== - -// TODO: cmath::M_PI has 3 more digits precision than the Fortran constant we -// use so for now we will reuse the Fortran constant until we are OK with -// modifying test results -extern "C" constexpr double PI {3.1415926535898}; - -extern "C" const double SQRT_PI {std::sqrt(PI)}; - //============================================================================== //! Calculate the percentile of the standard normal distribution with a //! specified probability level. diff --git a/src/mgxs.cpp b/src/mgxs.cpp new file mode 100644 index 0000000000..3e84f63072 --- /dev/null +++ b/src/mgxs.cpp @@ -0,0 +1,712 @@ +#include +#include +#include +#include + + #ifdef _OPENMP + # include + #endif + +#include "error.h" +#include "math_functions.h" +#include "random_lcg.h" +#include "string_functions.h" +#include "mgxs.h" + + +namespace openmc { + +// Storage for the MGXS data +std::vector nuclides_MG; +std::vector macro_xs; + + +//============================================================================== +// Mgxs base-class methods +//============================================================================== + +void +Mgxs::init(const std::string& in_name, double in_awr, + const double_1dvec& in_kTs, bool in_fissionable, int in_scatter_format, + int in_num_groups, int in_num_delayed_groups, bool in_is_isotropic, + const double_1dvec& in_polar, const double_1dvec& in_azimuthal) +{ + // Set the metadata + name = in_name; + awr = in_awr; + kTs = in_kTs; + fissionable = in_fissionable; + scatter_format = in_scatter_format; + num_groups = in_num_groups; + num_delayed_groups = in_num_delayed_groups; + xs.resize(in_kTs.size()); + is_isotropic = in_is_isotropic; + n_pol = in_polar.size(); + n_azi = in_azimuthal.size(); + polar = in_polar; + azimuthal = in_azimuthal; + + // Set the cross section index cache +#ifdef _OPENMP + int n_threads = omp_get_max_threads(); +#else + int n_threads = 1; +#endif + cache.resize(n_threads); + // std::vector.resize() will value-initialize the members of cache[:] +} + +//============================================================================== + +void +Mgxs::metadata_from_hdf5(hid_t xs_id, int in_num_groups, + int in_num_delayed_groups, const double_1dvec& temperature, + double tolerance, int_1dvec& temps_to_read, int& order_dim, int& method) +{ + // get name + char char_name[MAX_WORD_LEN]; + get_name(xs_id, char_name); + std::string in_name {char_name}; + // remove the leading '/' + in_name = in_name.substr(1); + + // Get the AWR + double in_awr; + if (attribute_exists(xs_id, "atomic_weight_ratio")) { + read_attr_double(xs_id, "atomic_weight_ratio", &in_awr); + } else { + in_awr = MACROSCOPIC_AWR; + } + + // Determine the available temperatures + hid_t kT_group = open_group(xs_id, "kTs"); + int num_temps = get_num_datasets(kT_group); + char* dset_names[num_temps]; + for (int i = 0; i < num_temps; i++) { + dset_names[i] = new char[151]; + } + get_datasets(kT_group, dset_names); + double_1dvec available_temps(num_temps); + for (int i = 0; i < num_temps; i++) { + read_double(kT_group, dset_names[i], &available_temps[i], true); + + // convert eV to Kelvin + available_temps[i] /= K_BOLTZMANN; + + // Done with dset_names, so delete it + delete[] dset_names[i]; + } + std::sort(available_temps.begin(), available_temps.end()); + + // If only one temperature is available, lets just use nearest temperature + // interpolation + if ((num_temps == 1) && (method == TEMPERATURE_INTERPOLATION)) { + warning("Cross sections for " + strtrim(name) + " are only available " + + "at one temperature. Reverting to the nearest temperature " + + "method."); + method = TEMPERATURE_NEAREST; + } + + switch(method) { + case TEMPERATURE_NEAREST: + // Find the minimum difference + for (int i = 0; i < temperature.size(); i++) { + std::valarray temp_diff(available_temps.data(), + available_temps.size()); + temp_diff = std::abs(temp_diff - temperature[i]); + int i_closest = std::min_element(std::begin(temp_diff), std::end(temp_diff)) - + std::begin(temp_diff); + double temp_actual = available_temps[i_closest]; + + if (std::abs(temp_actual - temperature[i]) < tolerance) { + if (std::find(temps_to_read.begin(), temps_to_read.end(), + std::round(temp_actual)) == temps_to_read.end()) { + temps_to_read.push_back(std::round(temp_actual)); + } else { + fatal_error("MGXS Library does not contain cross section for " + + in_name + " at or near " + + std::to_string(std::round(temperature[i])) + " K."); + } + } + } + break; + + case TEMPERATURE_INTERPOLATION: + for (int i = 0; i < temperature.size(); i++) { + for (int j = 0; j < num_temps - 1; j++) { + if ((available_temps[j] <= temperature[i]) && + (temperature[i] < available_temps[j + 1])) { + if (std::find(temps_to_read.begin(), + temps_to_read.end(), + std::round(available_temps[j])) == temps_to_read.end()) { + temps_to_read.push_back(std::round((int)available_temps[j])); + } + + if (std::find(temps_to_read.begin(), temps_to_read.end(), + std::round(available_temps[j + 1])) == temps_to_read.end()) { + temps_to_read.push_back(std::round((int) available_temps[j + 1])); + } + continue; + } + } + + fatal_error("MGXS Library does not contain cross sections for " + + in_name + " at temperatures that bound " + + std::to_string(std::round(temperature[i]))); + } + } + std::sort(temps_to_read.begin(), temps_to_read.end()); + + // Get the library's temperatures + int n_temperature = temps_to_read.size(); + double_1dvec in_kTs(n_temperature); + for (int i = 0; i < n_temperature; i++) { + std::string temp_str(std::to_string(temps_to_read[i]) + "K"); + + //read exact temperature value + read_double(kT_group, temp_str.c_str(), &in_kTs[i], true); + } + close_group(kT_group); + + // Load the remaining metadata + int in_scatter_format; + if (attribute_exists(xs_id, "scatter_format")) { + std::string temp_str(MAX_WORD_LEN, ' '); + read_attr_string(xs_id, "scatter_format", MAX_WORD_LEN, &temp_str[0]); + to_lower(strtrim(temp_str)); + if (temp_str.compare(0, 8, "legendre") == 0) { + in_scatter_format = ANGLE_LEGENDRE; + } else if (temp_str.compare(0, 9, "histogram") == 0) { + in_scatter_format = ANGLE_HISTOGRAM; + } else if (temp_str.compare(0, 7, "tabular") == 0) { + in_scatter_format = ANGLE_TABULAR; + } else { + fatal_error("Invalid scatter_format option!"); + } + } else { + in_scatter_format = ANGLE_LEGENDRE; + } + + if (attribute_exists(xs_id, "scatter_shape")) { + std::string temp_str(MAX_WORD_LEN, ' '); + read_attr_string(xs_id, "scatter_shape", MAX_WORD_LEN, &temp_str[0]); + to_lower(strtrim(temp_str)); + if (temp_str.compare(0, 14, "[g][g\'][order]") != 0) { + fatal_error("Invalid scatter_shape option!"); + } + } + + bool in_fissionable = false; + if (attribute_exists(xs_id, "fissionable")) { + int int_fiss; + read_attr_int(xs_id, "fissionable", &int_fiss); + in_fissionable = int_fiss; + } else { + fatal_error("Fissionable element must be set!"); + } + + // Get the library's value for the order + if (attribute_exists(xs_id, "order")) { + read_attr_int(xs_id, "order", &order_dim); + } else { + fatal_error("Order must be provided!"); + } + + // Store the dimensionality of the data in order_dim. + // For Legendre data, we usually refer to it as Pn where n is the order. + // However Pn has n+1 sets of points (since you need to count the P0 + // moment). Adjust for that. Histogram and Tabular formats dont need this + // adjustment. + if (in_scatter_format == ANGLE_LEGENDRE) { + ++order_dim; + } + + // Get the angular information + int in_n_pol; + int in_n_azi; + bool in_is_isotropic = true; + if (attribute_exists(xs_id, "representation")) { + std::string temp_str(MAX_WORD_LEN, ' '); + read_attr_string(xs_id, "representation", MAX_WORD_LEN, &temp_str[0]); + to_lower(strtrim(temp_str)); + if (temp_str.compare(0, 5, "angle") == 0) { + in_is_isotropic = false; + } else if (temp_str.compare(0, 9, "isotropic") != 0) { + fatal_error("Invalid Data Representation!"); + } + } + + if (!in_is_isotropic) { + if (attribute_exists(xs_id, "num_polar")) { + read_attr_int(xs_id, "num_polar", &in_n_pol); + } else { + fatal_error("num_polar must be provided!"); + } + if (attribute_exists(xs_id, "num_azimuthal")) { + read_attr_int(xs_id, "num_azimuthal", &in_n_azi); + } else { + fatal_error("num_azimuthal must be provided!"); + } + } else { + in_n_pol = 1; + in_n_azi = 1; + } + + // Set the angular bins to use equally-spaced bins + double_1dvec in_polar(in_n_pol); + double dangle = PI / in_n_pol; + for (int p = 0; p < in_n_pol; p++) { + in_polar[p] = (p + 0.5) * dangle; + } + double_1dvec in_azimuthal(in_n_azi); + dangle = 2. * PI / in_n_azi; + for (int a = 0; a < in_n_azi; a++) { + in_azimuthal[a] = (a + 0.5) * dangle - PI; + } + + // Finally use this data to initialize the MGXS Object + init(in_name, in_awr, in_kTs, in_fissionable, in_scatter_format, + in_num_groups, in_num_delayed_groups, in_is_isotropic, in_polar, + in_azimuthal); +} + +//============================================================================== + +Mgxs::Mgxs(hid_t xs_id, int energy_groups, int delayed_groups, + const double_1dvec& temperature, double tolerance, int max_order, + bool legendre_to_tabular, int legendre_to_tabular_points, int& method) +{ + // Call generic data gathering routine (will populate the metadata) + int order_data; + int_1dvec temps_to_read; + metadata_from_hdf5(xs_id, energy_groups, delayed_groups, temperature, + tolerance, temps_to_read, order_data, method); + + // Set number of energy and delayed groups + int final_scatter_format = scatter_format; + if (legendre_to_tabular) { + if (scatter_format == ANGLE_LEGENDRE) final_scatter_format = ANGLE_TABULAR; + } + + // Load the more specific XsData information + for (int t = 0; t < temps_to_read.size(); t++) { + xs[t] = XsData(energy_groups, delayed_groups, fissionable, + final_scatter_format, n_pol, n_azi); + // Get the temperature as a string and then open the HDF5 group + std::string temp_str = std::to_string(temps_to_read[t]) + "K"; + hid_t xsdata_grp = open_group(xs_id, temp_str.c_str()); + + xs[t].from_hdf5(xsdata_grp, fissionable, scatter_format, + final_scatter_format, order_data, max_order, + legendre_to_tabular_points, is_isotropic, n_pol, n_azi); + close_group(xsdata_grp); + + } // end temperature loop + + // Make sure the scattering format is updated to the final case + scatter_format = final_scatter_format; +} + +//============================================================================== + +Mgxs::Mgxs(const std::string& in_name, const double_1dvec& mat_kTs, + const std::vector& micros, const double_1dvec& atom_densities, + double tolerance, int& method) +{ + // Get the minimum data needed to initialize: + // Dont need awr, but lets just initialize it anyways + double in_awr = -1.; + // start with the assumption it is not fissionable + bool in_fissionable = false; + for (int m = 0; m < micros.size(); m++) { + if (micros[m]->fissionable) in_fissionable = true; + } + // Force all of the following data to be the same; these will be verified + // to be true later + int in_scatter_format = micros[0]->scatter_format; + int in_num_groups = micros[0]->num_groups; + int in_num_delayed_groups = micros[0]->num_delayed_groups; + bool in_is_isotropic = micros[0]->is_isotropic; + double_1dvec in_polar = micros[0]->polar; + double_1dvec in_azimuthal = micros[0]->azimuthal; + + init(in_name, in_awr, mat_kTs, in_fissionable, in_scatter_format, + in_num_groups, in_num_delayed_groups, in_is_isotropic, in_polar, + in_azimuthal); + + // Create the xs data for each temperature + for (int t = 0; t < mat_kTs.size(); t++) { + xs[t] = XsData(in_num_groups, in_num_delayed_groups, in_fissionable, + in_scatter_format, in_polar.size(), in_azimuthal.size()); + + // Find the right temperature index to use + double temp_desired = mat_kTs[t]; + + // Create the list of temperature indices and interpolation factors for + // each microscopic data at the material temperature + int_1dvec micro_t(micros.size(), 0); + double_1dvec micro_t_interp(micros.size(), 0.); + for (int m = 0; m < micros.size(); m++) { + switch(method) { + case TEMPERATURE_NEAREST: + { + // Find the nearest temperature + std::valarray temp_diff(micros[m]->kTs.data(), + micros[m]->kTs.size()); + temp_diff = std::abs(temp_diff - temp_desired); + micro_t[m] = std::min_element(std::begin(temp_diff), + std::end(temp_diff)) - + std::begin(temp_diff); + double temp_actual = micros[m]->kTs[micro_t[m]]; + + if (std::abs(temp_actual - temp_desired) >= K_BOLTZMANN * tolerance) { + fatal_error("MGXS Library does not contain cross section for " + + name + " at or near " + + std::to_string(std::round(temp_desired / K_BOLTZMANN)) + + " K."); + } + } + break; + case TEMPERATURE_INTERPOLATION: + // Get a list of bounding temperatures for each actual temperature + // present in the model + for (int k = 0; k < micros[m]->kTs.size() - 1; k++) { + if ((micros[m]->kTs[k] <= temp_desired) && + (temp_desired < micros[m]->kTs[k + 1])) { + micro_t[m] = k; + if (k == 0) { + micro_t_interp[m] = (temp_desired - micros[m]->kTs[k]) / + (micros[m]->kTs[k + 1] - micros[m]->kTs[k]); + } else { + micro_t_interp[m] = 1.; + } + } + } + } // end switch + } // end microscopic temperature loop + + // We are about to loop through each of the microscopic objects + // and incorporate the contribution of each microscopic data at + // one of the two temperature interpolants to this macroscopic quantity. + // If we are doing nearest temperature interpolation, then we don't need + // to do the 2nd temperature + int num_interp_points = 2; + if (method == TEMPERATURE_NEAREST) num_interp_points = 1; + for (int interp_point = 0; interp_point < num_interp_points; interp_point++) { + double_1dvec interp(micros.size()); + double_1dvec temp_indices(micros.size()); + for (int m = 0; m < micros.size(); m++) { + interp[m] = (1. - micro_t_interp[m]) * atom_densities[m]; + temp_indices[m] = micro_t[m] + interp_point; + } + + combine(micros, interp, micro_t, t); + } // end loop to sum all micros across the temperatures + } // end temperature (t) loop +} + +//============================================================================== + +void +Mgxs::combine(const std::vector& micros, const double_1dvec& scalars, + const int_1dvec& micro_ts, int this_t) +{ + // Build the vector of pointers to the xs objects within micros + std::vector those_xs(micros.size()); + for (int i = 0; i < micros.size(); i++) { + if (!xs[this_t].equiv(micros[i]->xs[micro_ts[i]])) { + fatal_error("Cannot combine the Mgxs objects!"); + } + those_xs[i] = &(micros[i]->xs[micro_ts[i]]); + } + + xs[this_t].combine(those_xs, scalars); +} + +//============================================================================== + +double +Mgxs::get_xs(int xstype, int gin, int* gout, double* mu, int* dg) +{ + // This method assumes that the temperature and angle indices are set +#ifdef _OPENMP + int tid = omp_get_thread_num(); + XsData* xs_t = &xs[cache[tid].t]; + int a = cache[tid].a; +#else + XsData* xs_t = &xs[cache[0].t]; + int a = cache[0].a; +#endif + double val; + switch(xstype) { + case MG_GET_XS_TOTAL: + val = xs_t->total[a][gin]; + break; + case MG_GET_XS_NU_FISSION: + val = fissionable ? xs_t->nu_fission[a][gin] : 0.; + break; + case MG_GET_XS_ABSORPTION: + val = xs_t->absorption[a][gin]; + break; + case MG_GET_XS_FISSION: + val = fissionable ? xs_t->fission[a][gin] : 0.; + break; + case MG_GET_XS_KAPPA_FISSION: + val = fissionable ? xs_t->kappa_fission[a][gin] : 0.; + break; + case MG_GET_XS_SCATTER: + case MG_GET_XS_SCATTER_MULT: + case MG_GET_XS_SCATTER_FMU_MULT: + case MG_GET_XS_SCATTER_FMU: + val = xs_t->scatter[a]->get_xs(xstype, gin, gout, mu); + break; + case MG_GET_XS_PROMPT_NU_FISSION: + val = fissionable ? xs_t->prompt_nu_fission[a][gin] : 0.; + break; + case MG_GET_XS_DELAYED_NU_FISSION: + if (fissionable) { + if (dg != nullptr) { + val = xs_t->delayed_nu_fission[a][gin][*dg]; + } else { + val = 0.; + for (auto& num : xs_t->delayed_nu_fission[a][gin]) { + val += num; + } + } + } else { + val = 0.; + } + break; + case MG_GET_XS_CHI_PROMPT: + if (fissionable) { + if (gout != nullptr) { + val = xs_t->chi_prompt[a][gin][*gout]; + } else { + // provide an outgoing group-wise sum + val = 0.; + for (auto& num : xs_t->chi_prompt[a][gin]) { + val += num; + } + } + } else { + val = 0.; + } + break; + case MG_GET_XS_CHI_DELAYED: + if (fissionable) { + if (gout != nullptr) { + if (dg != nullptr) { + val = xs_t->chi_delayed[a][gin][*gout][*dg]; + } else { + val = xs_t->chi_delayed[a][gin][*gout][0]; + } + } else { + if (dg != nullptr) { + val = 0.; + for (int i = 0; i < xs_t->chi_delayed[a][gin].size(); i++) { + val += xs_t->chi_delayed[a][gin][i][*dg]; + } + } else { + val = 0.; + for (int i = 0; i < xs_t->chi_delayed[a][gin].size(); i++) { + for (auto& num : xs_t->chi_delayed[a][gin][i]) { + val += num; + } + } + } + } + } else { + val = 0.; + } + break; + case MG_GET_XS_INVERSE_VELOCITY: + val = xs_t->inverse_velocity[a][gin]; + break; + case MG_GET_XS_DECAY_RATE: + if (dg != nullptr) { + val = xs_t->decay_rate[a][*dg + 1]; + } else { + val = xs_t->decay_rate[a][0]; + } + break; + default: + val = 0.; + } + return val; +} + +//============================================================================== + +void +Mgxs::sample_fission_energy(int gin, int& dg, int& gout) +{ + // This method assumes that the temperature and angle indices are set +#ifdef _OPENMP + int tid = omp_get_thread_num(); +#else + int tid = 0; +#endif + XsData* xs_t = &xs[cache[tid].t]; + double nu_fission = xs_t->nu_fission[cache[tid].a][gin]; + + // Find the probability of having a prompt neutron + double prob_prompt = + xs_t->prompt_nu_fission[cache[tid].a][gin]; + + // sample random numbers + double xi_pd = prn() * nu_fission; + double xi_gout = prn(); + + // Select whether the neutron is prompt or delayed + if (xi_pd <= prob_prompt) { + // the neutron is prompt + + // set the delayed group for the particle to be -1, indicating prompt + dg = -1; + + // sample the outgoing energy group + gout = 0; + double prob_gout = + xs_t->chi_prompt[cache[tid].a][gin][gout]; + while (prob_gout < xi_gout) { + gout++; + prob_gout += xs_t->chi_prompt[cache[tid].a][gin][gout]; + } + + } else { + // the neutron is delayed + + // get the delayed group + dg = 0; + while (xi_pd >= prob_prompt) { + dg++; + prob_prompt += + xs_t->delayed_nu_fission[cache[tid].a][gin][dg]; + } + + // adjust dg in case of round-off error + dg = std::min(dg, num_delayed_groups - 1); + + // sample the outgoing energy group + gout = 0; + double prob_gout = + xs_t->chi_delayed[cache[tid].a][gin][gout][dg]; + while (prob_gout < xi_gout) { + gout++; + prob_gout += + xs_t->chi_delayed[cache[tid].a][gin][gout][dg]; + } + } +} + +//============================================================================== + +void +Mgxs::sample_scatter(int gin, int& gout, double& mu, double& wgt) +{ + // This method assumes that the temperature and angle indices are set + // Sample the data +#ifdef _OPENMP + int tid = omp_get_thread_num(); +#else + int tid = 0; +#endif + xs[cache[tid].t].scatter[cache[tid].a]->sample(gin, gout, mu, wgt); +} + +//============================================================================== + +void +Mgxs::calculate_xs(int gin, double sqrtkT, const double uvw[3], + double& total_xs, double& abs_xs, double& nu_fiss_xs) +{ + // Set our indices +#ifdef _OPENMP + int tid = omp_get_thread_num(); +#else + int tid = 0; +#endif + set_temperature_index(sqrtkT); + set_angle_index(uvw); + XsData* xs_t = &xs[cache[tid].t]; + total_xs = xs_t->total[cache[tid].a][gin]; + abs_xs = xs_t->absorption[cache[tid].a][gin]; + + nu_fiss_xs = fissionable ? xs_t->nu_fission[cache[tid].a][gin] : 0.; +} + +//============================================================================== + +bool +Mgxs::equiv(const Mgxs& that) +{ + return ((num_delayed_groups == that.num_delayed_groups) && + (num_groups == that.num_groups) && + (n_pol == that.n_pol) && + (n_azi == that.n_azi) && + (std::equal(polar.begin(), polar.end(), that.polar.begin())) && + (std::equal(azimuthal.begin(), azimuthal.end(), that.azimuthal.begin())) && + (scatter_format == that.scatter_format)); +} + +//============================================================================== + +void +Mgxs::set_temperature_index(double sqrtkT) +{ + // See if we need to find the new index +#ifdef _OPENMP + int tid = omp_get_thread_num(); +#else + int tid = 0; +#endif + if (sqrtkT != cache[tid].sqrtkT) { + double kT = sqrtkT * sqrtkT; + + // initialize vector for storage of the differences + std::valarray temp_diff(kTs.data(), kTs.size()); + + // Find the minimum difference of kT and kTs + temp_diff = std::abs(temp_diff - kT); + cache[tid].t = std::min_element(std::begin(temp_diff), std::end(temp_diff)) - + std::begin(temp_diff); + + // store this temperature as the last one used + cache[tid].sqrtkT = sqrtkT; + } +} + +//============================================================================== + +void +Mgxs::set_angle_index(const double uvw[3]) +{ + // See if we need to find the new index +#ifdef _OPENMP + int tid = omp_get_thread_num(); +#else + int tid = 0; +#endif + if (!is_isotropic && + ((uvw[0] != cache[tid].u) || (uvw[1] != cache[tid].v) || + (uvw[2] != cache[tid].w))) { + // convert uvw to polar and azimuthal angles + double my_pol = std::acos(uvw[2]); + double my_azi = std::atan2(uvw[1], uvw[0]); + + // Find the location, assuming equal-bin angles + double delta_angle = PI / n_pol; + int p = std::floor(my_pol / delta_angle); + delta_angle = 2. * PI / n_azi; + int a = std::floor((my_azi + PI) / delta_angle); + + cache[tid].a = n_azi * p + a; + + // store this direction as the last one used + cache[tid].u = uvw[0]; + cache[tid].v = uvw[1]; + cache[tid].w = uvw[2]; + } +} + +} // namespace openmc \ No newline at end of file diff --git a/src/mgxs.h b/src/mgxs.h new file mode 100644 index 0000000000..0434bd55d5 --- /dev/null +++ b/src/mgxs.h @@ -0,0 +1,205 @@ +//! \file mgxs.h +//! A collection of classes for Multi-Group Cross Section data + +#ifndef MGXS_H +#define MGXS_H + +#include +#include + +#include "constants.h" +#include "hdf5_interface.h" +#include "xsdata.h" + + +namespace openmc { + +//============================================================================== +// Cache contains the cached data for an MGXS object +//============================================================================== + +struct CacheData { + double sqrtkT; // last temperature corresponding to t + int t; // temperature index + int a; // angle index + // last angle that corresponds to a + double u; + double v; + double w; +}; + +//============================================================================== +// MGXS contains the mgxs data for a nuclide/material +//============================================================================== + +class Mgxs { + private: + + double_1dvec kTs; // temperature in eV (k * T) + int scatter_format; // flag for if this is legendre, histogram, or tabular + int num_delayed_groups; // number of delayed neutron groups + int num_groups; // number of energy groups + std::vector xs; // Cross section data + // MGXS Incoming Flux Angular grid information + bool is_isotropic; // used to skip search for angle indices if isotropic + int n_pol; + int n_azi; + double_1dvec polar; + double_1dvec azimuthal; + + //! \brief Initializes the Mgxs object metadata + //! + //! @param in_name Name of the object. + //! @param in_awr atomic-weight ratio. + //! @param in_kTs temperatures (in units of eV) that data is available. + //! @param in_fissionable Is this item fissionable or not. + //! @param in_scatter_format Denotes whether Legendre, Tabular, or + //! Histogram scattering is used. + //! @param in_num_groups Number of energy groups. + //! @param in_num_delayed_groups Number of delayed groups. + //! @param in_is_isotropic Is this an isotropic or angular with respect to + //! the incoming particle. + //! @param in_polar Polar angle grid. + //! @param in_azimuthal Azimuthal angle grid. + void + init(const std::string& in_name, double in_awr, const double_1dvec& in_kTs, + bool in_fissionable, int in_scatter_format, int in_num_groups, + int in_num_delayed_groups, bool in_is_isotropic, + const double_1dvec& in_polar, const double_1dvec& in_azimuthal); + + //! \brief Initializes the Mgxs object metadata from the HDF5 file + //! + //! @param xs_id HDF5 group id for the cross section data. + //! @param in_num_groups Number of energy groups. + //! @param in_num_delayed_groups Number of delayed groups. + //! @param temperature Temperatures to read. + //! @param tolerance Tolerance of temperature selection method. + //! @param temps_to_read Resultant list of temperatures in the library + //! to read which correspond to the requested temperatures. + //! @param order_dim Resultant dimensionality of the scattering order. + //! @param method Method of choosing nearest temperatures. + void + metadata_from_hdf5(hid_t xs_id, int in_num_groups, + int in_num_delayed_groups, const double_1dvec& temperature, + double tolerance, int_1dvec& temps_to_read, int& order_dim, + int& method); + + //! \brief Performs the actual act of combining the microscopic data for a + //! single temperature. + //! + //! @param micros Microscopic objects to combine. + //! @param scalars Scalars to multiply the microscopic data by. + //! @param micro_ts The temperature index of the microscopic objects that + //! corresponds to the temperature of interest. + //! @param this_t The temperature index of the macroscopic object. + void + combine(const std::vector& micros, const double_1dvec& scalars, + const int_1dvec& micro_ts, int this_t); + + //! \brief Checks to see if this and that are able to be combined + //! + //! This comparison is used when building macroscopic cross sections + //! from microscopic cross sections. + //! @param that The other Mgxs to compare to this one. + //! @return True if they can be combined, False otherwise. + bool equiv(const Mgxs& that); + + public: + + std::string name; // name of dataset, e.g., UO2 + double awr; // atomic weight ratio + bool fissionable; // Is this fissionable + std::vector cache; // index and data cache + + Mgxs() = default; + + //! \brief Constructor that loads the Mgxs object from the HDF5 file + //! + //! @param xs_id HDF5 group id for the cross section data. + //! @param energy_groups Number of energy groups. + //! @param delayed_groups Number of delayed groups. + //! @param temperature Temperatures to read. + //! @param tolerance Tolerance of temperature selection method. + //! @param max_order Maximum order requested by the user; + //! this is only used for Legendre scattering. + //! @param legendre_to_tabular Flag to denote if any Legendre provided + //! should be converted to a Tabular representation. + //! @param legendre_to_tabular_points If a conversion is requested, this + //! provides the number of points to use in the tabular representation. + //! @param method Method of choosing nearest temperatures. + Mgxs(hid_t xs_id, int energy_groups, + int delayed_groups, const double_1dvec& temperature, double tolerance, + int max_order, bool legendre_to_tabular, + int legendre_to_tabular_points, int& method); + + //! \brief Constructor that initializes and populates all data to build a + //! macroscopic cross section from microscopic cross section. + //! + //! @param in_name Name of the object. + //! @param mat_kTs temperatures (in units of eV) that data is needed. + //! @param micros Microscopic objects to combine. + //! @param atom_densities Atom densities of those microscopic quantities. + //! @param tolerance Tolerance of temperature selection method. + //! @param method Method of choosing nearest temperatures. + Mgxs(const std::string& in_name, const double_1dvec& mat_kTs, + const std::vector& micros, const double_1dvec& atom_densities, + double tolerance, int& method); + + //! \brief Provides a cross section value given certain parameters + //! + //! @param xstype Type of cross section requested, according to the + //! enumerated constants. + //! @param gin Incoming energy group. + //! @param gout Outgoing energy group; use nullptr if irrelevant, or if a + //! sum is requested. + //! @param mu Cosine of the change-in-angle, for scattering quantities; + //! use nullptr if irrelevant. + //! @param dg delayed group index; use nullptr if irrelevant. + //! @return Requested cross section value. + double + get_xs(int xstype, int gin, int* gout, double* mu, int* dg); + + //! \brief Samples the fission neutron energy and if prompt or delayed. + //! + //! @param gin Incoming energy group. + //! @param dg Sampled delayed group index. + //! @param gout Sampled outgoing energy group. + void + sample_fission_energy(int gin, int& dg, int& gout); + + //! \brief Samples the outgoing energy and angle from a scatter event. + //! + //! @param gin Incoming energy group. + //! @param gout Sampled outgoing energy group. + //! @param mu Sampled cosine of the change-in-angle. + //! @param wgt Weight of the particle to be adjusted. + void + sample_scatter(int gin, int& gout, double& mu, double& wgt); + + //! \brief Calculates cross section quantities needed for tracking. + //! + //! @param gin Incoming energy group. + //! @param sqrtkT Temperature of the material. + //! @param uvw Incoming particle direction. + //! @param total_xs Resultant total cross section. + //! @param abs_xs Resultant absorption cross section. + //! @param nu_fiss_xs Resultant nu-fission cross section. + void + calculate_xs(int gin, double sqrtkT, const double uvw[3], + double& total_xs, double& abs_xs, double& nu_fiss_xs); + + //! \brief Sets the temperature index in cache given a temperature + //! + //! @param sqrtkT Temperature of the material. + void + set_temperature_index(double sqrtkT); + + //! \brief Sets the angle index in cache given a direction + //! + //! @param uvw Incoming particle direction. + void + set_angle_index(const double uvw[3]); +}; + +} // namespace openmc +#endif // MGXS_H \ No newline at end of file diff --git a/src/mgxs_data.F90 b/src/mgxs_data.F90 index e0631d16c5..1b3ed35113 100644 --- a/src/mgxs_data.F90 +++ b/src/mgxs_data.F90 @@ -1,5 +1,7 @@ module mgxs_data + use, intrinsic :: ISO_C_BINDING + use constants use algorithm, only: find use dict_header, only: DictCharInt @@ -7,11 +9,11 @@ module mgxs_data use geometry_header, only: get_temperatures, cells use hdf5_interface use material_header, only: Material, materials, n_materials - use mgxs_header + use mgxs_interface use nuclide_header, only: n_nuclides use set_header, only: SetChar use settings - use stl_vector, only: VectorReal + use stl_vector, only: VectorReal, VectorChar use string, only: to_lower implicit none @@ -27,14 +29,11 @@ contains integer :: j ! index over nuclides in material integer :: i_nuclide ! index in nuclides array character(20) :: name ! name of library to load - integer :: representation ! Data representation - character(MAX_LINE_LEN) :: temp_str type(Material), pointer :: mat type(SetChar) :: already_read integer(HID_T) :: file_id - integer(HID_T) :: xsdata_group logical :: file_exists - type(VectorReal), allocatable :: temps(:) + type(VectorReal), allocatable, target :: temps(:) character(MAX_WORD_LEN) :: word integer, allocatable :: array(:) @@ -69,9 +68,6 @@ contains &version supported by OpenMC.") end if - ! allocate arrays for MGXS storage and cross section cache - allocate(nuclides_MG(n_nuclides)) - ! ========================================================================== ! READ ALL MGXS CROSS SECTION TABLES @@ -80,89 +76,29 @@ contains mat => materials(i) NUCLIDE_LOOP: do j = 1, mat % n_nuclides - name = mat % names(j) + name = trim(mat % names(j)) // C_NULL_CHAR + i_nuclide = mat % nuclide(j) if (.not. already_read % contains(name)) then - i_nuclide = mat % nuclide(j) + call add_mgxs_c(file_id, name, num_energy_groups, num_delayed_groups, & + temps(i_nuclide) % size(), temps(i_nuclide) % data, & + temperature_tolerance, max_order, & + logical(legendre_to_tabular, C_BOOL), & + legendre_to_tabular_points, temperature_method) - call write_message("Loading " // trim(name) // " data...", 6) - - ! Check to make sure cross section set exists in the library - if (object_exists(file_id, trim(name))) then - xsdata_group = open_group(file_id, trim(name)) - else - call fatal_error("Data for '" // trim(name) // "' does not exist in "& - &// trim(path_cross_sections)) - end if - - ! First find out the data representation - if (attribute_exists(xsdata_group, "representation")) then - - call read_attribute(temp_str, xsdata_group, "representation") - - if (trim(temp_str) == 'isotropic') then - representation = MGXS_ISOTROPIC - else if (trim(temp_str) == 'angle') then - representation = MGXS_ANGLE - else - call fatal_error("Invalid Data Representation!") - end if - else - ! Default to isotropic representation - representation = MGXS_ISOTROPIC - end if - - ! Now allocate accordingly - select case(representation) - - case(MGXS_ISOTROPIC) - allocate(MgxsIso :: nuclides_MG(i_nuclide) % obj) - - case(MGXS_ANGLE) - allocate(MgxsAngle :: nuclides_MG(i_nuclide) % obj) - - end select - - ! Now read in the data specific to the type we just declared - call nuclides_MG(i_nuclide) % obj % from_hdf5(xsdata_group, & - num_energy_groups, num_delayed_groups, temps(i_nuclide), & - temperature_method, temperature_tolerance, max_order, & - legendre_to_tabular, legendre_to_tabular_points) - - ! Add name to dictionary call already_read % add(name) - - call close_group(xsdata_group) - end if end do NUCLIDE_LOOP + + mat % fissionable = query_fissionable_c(mat % n_nuclides, mat % nuclide) + end do MATERIAL_LOOP + call file_close(file_id) + ! Avoid some valgrind leak errors call already_read % clear() - ! Loop around material - MATERIAL_LOOP3: do i = 1, n_materials - - ! Get material - mat => materials(i) - - ! Loop around nuclides in material - NUCLIDE_LOOP2: do j = 1, mat % n_nuclides - - ! Is this fissionable? - if (nuclides_MG(mat % nuclide(j)) % obj % fissionable) then - mat % fissionable = .true. - end if - if (mat % fissionable) then - exit NUCLIDE_LOOP2 - end if - - end do NUCLIDE_LOOP2 - end do MATERIAL_LOOP3 - - call file_close(file_id) - end subroutine read_mgxs !=============================================================================== @@ -173,8 +109,7 @@ contains integer :: i_mat ! index in materials array type(Material), pointer :: mat ! current material type(VectorReal), allocatable :: kTs(:) - - allocate(macro_xs(n_materials)) + character(MAX_WORD_LEN) :: name ! name of material ! Get temperatures to read for each material call get_mat_kTs(kTs) @@ -188,19 +123,13 @@ contains ! Get the material mat => materials(i_mat) - ! Get the scattering type for the first nuclide - select type(nuc => nuclides_MG(mat % nuclide(1)) % obj) - type is (MgxsIso) - allocate(MgxsIso :: macro_xs(i_mat) % obj) - type is (MgxsAngle) - allocate(MgxsAngle :: macro_xs(i_mat) % obj) - end select + name = trim(mat % name) // C_NULL_CHAR ! Do not read materials which we do not actually use in the problem to ! reduce storage if (allocated(kTs(i_mat) % data)) then - call macro_xs(i_mat) % obj % combine(kTs(i_mat), mat, nuclides_MG, & - num_energy_groups, num_delayed_groups, max_order, & + call create_macro_xs_c(name, mat % n_nuclides, mat % nuclide, & + kTs(i_mat) % size(), kTs(i_mat) % data, mat % atom_density, & temperature_tolerance, temperature_method) end if end do diff --git a/src/mgxs_header.F90 b/src/mgxs_header.F90 deleted file mode 100644 index 5abeccbcfa..0000000000 --- a/src/mgxs_header.F90 +++ /dev/null @@ -1,3593 +0,0 @@ -module mgxs_header - - use, intrinsic :: ISO_FORTRAN_ENV - use, intrinsic :: ISO_C_BINDING - - use algorithm, only: find, sort - use constants, only: MAX_WORD_LEN, ZERO, ONE, TWO, PI, MACROSCOPIC_AWR - use error, only: fatal_error - use hdf5_interface - use material_header, only: material - use math, only: evaluate_legendre - use nuclide_header, only: MaterialMacroXS - use random_lcg, only: prn - use scattdata_header - use string - use stl_vector, only: VectorInt, VectorReal - -!=============================================================================== -! XS* contains the temperature-dependent cross section data for an MGXS -!=============================================================================== - - type :: XsDataIso - ! Microscopic cross sections - real(8), allocatable :: total(:) ! total cross section - real(8), allocatable :: absorption(:) ! absorption cross section - class(ScattData), allocatable :: scatter ! scattering info - real(8), allocatable :: delayed_nu_fission(:,:) ! Delayed fission matrix (Dg x Gin) - real(8), allocatable :: prompt_nu_fission(:) ! Prompt fission vector (Gin) - real(8), allocatable :: kappa_fission(:) ! Kappa fission - real(8), allocatable :: fission(:) ! Neutron production - real(8), allocatable :: decay_rate(:) ! Delayed neutron precursor decay rate - real(8), allocatable :: inverse_velocity(:) ! Inverse neutron velocity - real(8), allocatable :: chi_delayed(:, :, :) ! Delayed fission spectra - real(8), allocatable :: chi_prompt(:, :) ! Prompt fission spectra - end type XsDataIso - - type :: XsDataAngle - ! Microscopic cross sections - ! In all cases, right-most indices are theta, phi - real(8), allocatable :: total(:, :, :) ! total cross section - real(8), allocatable :: absorption(:, :, :) ! absorption cross section - type(ScattDataContainer), allocatable :: scatter(:, :) ! scattering info - real(8), allocatable :: delayed_nu_fission(:, :, :, :) ! Delayed fission matrix (Gout x Gin) - real(8), allocatable :: prompt_nu_fission(:, :, :) ! Prompt fission matrix (Gout x Gin) - real(8), allocatable :: kappa_fission(:, :, :) ! Kappa fission - real(8), allocatable :: fission(:, :, :) ! Neutron production - real(8), allocatable :: decay_rate(:, :, :) ! Delayed neutron precursor decay rate - real(8), allocatable :: inverse_velocity(:, :, :) ! Inverse neutron velocity - real(8), allocatable :: chi_delayed(:, :, :, :, :) ! Delayed fission spectra - real(8), allocatable :: chi_prompt(:, :, :, :) ! Prompt fission spectra - end type XsDataAngle - -!=============================================================================== -! MGXS contains the base mgxs data for a nuclide/material -!=============================================================================== - - type, abstract :: Mgxs - character(len=MAX_WORD_LEN) :: name ! name of dataset, e.g. UO2 - real(8) :: awr ! Atomic Weight Ratio - real(8), allocatable :: kTs(:) ! temperature in eV (k*T) - - ! Fission information - logical :: fissionable ! mgxs object is fissionable? - integer :: scatter_format ! either legendre, histogram, or tabular. - integer :: num_delayed_groups ! Num delayed groups - - ! Caching information - integer :: index_temp ! temperature index for nuclide - - contains - procedure(mgxs_from_hdf5_), deferred :: from_hdf5 ! Load the data - procedure(mgxs_combine_), deferred :: combine ! initializes object - procedure(mgxs_get_xs_), deferred :: get_xs ! Get the requested xs - - ! Sample the outgoing energy from a fission event - procedure(mgxs_sample_fission_), deferred :: sample_fission_energy - - ! Sample the outgoing energy and angle from a scatter event - procedure(mgxs_sample_scatter_), deferred :: sample_scatter - - ! Calculate the material specific MGXS data from the nuclides - procedure(mgxs_calculate_xs_), deferred :: calculate_xs - - ! Find the temperature - procedure :: find_temperature => mgxs_find_temperature - end type Mgxs - -!=============================================================================== -! MGXSCONTAINER pointer array for storing Nuclides -!=============================================================================== - - type MgxsContainer - class(Mgxs), pointer :: obj - end type MgxsContainer - -!=============================================================================== -! Interfaces for MGXS -!=============================================================================== - - abstract interface - subroutine mgxs_from_hdf5_(this, xs_id, energy_groups, delayed_groups, & - temperature, method, tolerance, max_order, legendre_to_tabular, & - legendre_to_tabular_points) - import Mgxs, HID_T, VectorReal - class(Mgxs), intent(inout) :: this ! Working Object - integer(HID_T), intent(in) :: xs_id ! Library data - integer, intent(in) :: energy_groups ! Number of energy groups - integer, intent(in) :: delayed_groups ! Number of delayed groups - type(VectorReal), intent(in) :: temperature ! list of desired temperatures - integer, intent(inout) :: method ! Type of temperature access - real(8), intent(in) :: tolerance ! Tolerance on method - integer, intent(in) :: max_order ! Maximum requested order - logical, intent(in) :: legendre_to_tabular ! Convert Legendres to Tabular? - integer, intent(in) :: legendre_to_tabular_points ! Number of points to use - ! in that conversion - end subroutine mgxs_from_hdf5_ - - subroutine mgxs_combine_(this, temps, mat, nuclides, energy_groups, & - delayed_groups, max_order, tolerance, method) - import Mgxs, Material, MgxsContainer, VectorReal - class(Mgxs), intent(inout) :: this ! The Mgxs to initialize - type(VectorReal), intent(in) :: temps ! Temperatures to obtain - type(Material), pointer, intent(in) :: mat ! base material - type(MgxsContainer), intent(in) :: nuclides(:) ! List of nuclides to harvest from - integer, intent(in) :: energy_groups ! Number of energy groups - integer, intent(in) :: delayed_groups ! Number of delayed groups - integer, intent(in) :: max_order ! Maximum requested order - real(8), intent(in) :: tolerance ! Tolerance on method - integer, intent(in) :: method ! Type of temperature access - end subroutine mgxs_combine_ - - pure function mgxs_get_xs_(this, xstype, gin, gout, uvw, mu, dg) result(xs_val) - import Mgxs - class(Mgxs), intent(in) :: this - character(*), intent(in) :: xstype ! Cross Section Type - integer, intent(in) :: gin ! Incoming Energy group - integer, optional, intent(in) :: gout ! Outgoing Group - real(8), optional, intent(in) :: uvw(3) ! Requested Angle - real(8), optional, intent(in) :: mu ! Change in angle - integer, optional, intent(in) :: dg ! Delayed group - real(8) :: xs_val ! Resultant xs - end function mgxs_get_xs_ - - subroutine mgxs_sample_fission_(this, gin, uvw, dg, gout) - import Mgxs - class(Mgxs), intent(in) :: this - integer, intent(in) :: gin ! Incoming energy group - real(8), intent(in) :: uvw(3) ! Particle Direction - integer, intent(out) :: dg ! Delayed group - integer, intent(out) :: gout ! Sampled outgoing group - - end subroutine mgxs_sample_fission_ - - subroutine mgxs_sample_scatter_(this, uvw, gin, gout, mu, wgt) - import Mgxs - class(Mgxs), 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 mgxs_sample_scatter_ - - subroutine mgxs_calculate_xs_(this, gin, sqrtkT, uvw, xs) - import Mgxs, MaterialMacroXS - class(Mgxs), intent(inout) :: this - integer, intent(in) :: gin ! Incoming neutron group - real(8), intent(in) :: sqrtkT ! Material temperature - real(8), intent(in) :: uvw(3) ! Incoming neutron direction - type(MaterialMacroXS), intent(inout) :: xs ! Resultant Mgxs Data - end subroutine mgxs_calculate_xs_ - end interface - -!=============================================================================== -! MGXSISO contains the base MGXS data specifically for -! isotropically weighted MGXS -!=============================================================================== - - type, extends(Mgxs) :: MgxsIso - type(XsDataIso), allocatable :: xs(:) ! One for every temperature - contains - procedure :: from_hdf5 => mgxsiso_from_hdf5 ! Initialize Nuclidic MGXS Data - procedure :: get_xs => mgxsiso_get_xs ! Gets Size of Data w/in Object - procedure :: combine => mgxsiso_combine ! inits object - procedure :: sample_fission_energy => mgxsiso_sample_fission_energy - procedure :: sample_scatter => mgxsiso_sample_scatter - procedure :: calculate_xs => mgxsiso_calculate_xs - end type MgxsIso - -!=============================================================================== -! MGXSANGLE contains the base MGXS data specifically for -! angular flux weighted MGXS -!=============================================================================== - - type, extends(Mgxs) :: MgxsAngle - type(XsDataAngle), allocatable :: xs(:) ! One for every temperature - integer :: n_pol ! Number of polar angles - integer :: n_azi ! Number of azimuthal angles - real(8), allocatable :: polar(:) ! polar angles - real(8), allocatable :: azimuthal(:) ! azimuthal angles - - contains - procedure :: from_hdf5 => mgxsang_from_hdf5 ! Initialize Nuclidic MGXS Data - procedure :: get_xs => mgxsang_get_xs ! Gets Size of Data w/in Object - procedure :: combine => mgxsang_combine ! inits object - procedure :: sample_fission_energy => mgxsang_sample_fission_energy - procedure :: sample_scatter => mgxsang_sample_scatter - procedure :: calculate_xs => mgxsang_calculate_xs - end type MgxsAngle - - ! Cross section arrays - type(MgxsContainer), allocatable, target :: nuclides_MG(:) - - ! Cross section caches - type(MgxsContainer), target, allocatable :: macro_xs(:) - - ! Number of energy groups - integer :: num_energy_groups - - ! Number of delayed groups - integer :: num_delayed_groups - - ! Energy group structure with decreasing energy - real(8), allocatable :: energy_bins(:) - - ! Midpoint of the energy group structure - real(8), allocatable :: energy_bin_avg(:) - - ! Energy group structure with increasing energy - real(8), allocatable :: rev_energy_bins(:) - -contains - -!=============================================================================== -! MGXS*_FROM_HDF5 reads in the data from the HDF5 Library. At the point of entry -! the file would have been opened and metadata read. -!=============================================================================== - - subroutine mgxs_from_hdf5(this, xs_id, temperature, method, tolerance, & - temps_to_read, order_dim) - class(Mgxs), intent(inout) :: this ! Working Object - integer(HID_T), intent(in) :: xs_id ! Group in H5 file - type(VectorReal), intent(in) :: temperature ! list of desired temperatures - integer, intent(inout) :: method ! Type of temperature access - real(8), intent(in) :: tolerance ! Tolerance on method - type(VectorInt), intent(out) :: temps_to_read ! Temperatures to read - integer, intent(out) :: order_dim ! Scattering data order size - - integer(HID_T) :: kT_group - character(MAX_WORD_LEN), allocatable :: dset_names(:) - real(8), allocatable :: temps_available(:) ! temperatures available - real(8) :: temp_desired - real(8) :: temp_actual - character(MAX_WORD_LEN) :: temp_str - real(8) :: dangle - integer :: ipol, iazi - - ! Get name of dataset from group - this % name = get_name(xs_id) - - ! Get rid of leading '/' - this % name = trim(this % name(2:)) - - if (attribute_exists(xs_id, "atomic_weight_ratio")) then - call read_attribute(this % awr, xs_id, "atomic_weight_ratio") - else - this % awr = MACROSCOPIC_AWR - end if - - ! Determine temperatures available - kT_group = open_group(xs_id, 'kTs') - call get_datasets(kT_group, dset_names) - allocate(temps_available(size(dset_names))) - do i = 1, size(dset_names) - ! Read temperature value - call read_dataset(temps_available(i), kT_group, trim(dset_names(i))) - ! Convert eV to Kelvin - temps_available(i) = temps_available(i) / K_BOLTZMANN - end do - call sort(temps_available) - - ! If only one temperature is available, revert to nearest temperature - if (size(temps_available) == 1 .and. & - method == TEMPERATURE_INTERPOLATION) then - call warning("Cross sections for " // trim(this % name) // " are only & - &available at one temperature. Reverting to nearest temperature & - &method.") - method = TEMPERATURE_NEAREST - end if - - select case (method) - case (TEMPERATURE_NEAREST) - ! Determine actual temperatures to read - TEMP_LOOP: do i = 1, temperature % size() - temp_desired = temperature % data(i) - i_closest = minloc(abs(temps_available - temp_desired), dim=1) - temp_actual = temps_available(i_closest) - if (abs(temp_actual - temp_desired) < tolerance) then - if (find(temps_to_read, nint(temp_actual)) == -1) then - call temps_to_read % push_back(nint(temp_actual)) - end if - else - call fatal_error("MGXS library does not contain cross sections & - &for " // trim(this % name) // " at or near " // & - trim(to_str(nint(temp_desired))) // " K.") - end if - end do TEMP_LOOP - - case (TEMPERATURE_INTERPOLATION) - ! If temperature interpolation or multipole is selected, get a list of - ! bounding temperatures for each actual temperature present in the model - TEMPS_LOOP: do i = 1, temperature % size() - temp_desired = temperature % data(i) - - do j = 1, size(temps_available) - 1 - if (temps_available(j) <= temp_desired .and. & - temp_desired < temps_available(j + 1)) then - if (find(temps_to_read, nint(temps_available(j))) == -1) then - call temps_to_read % push_back(nint(temps_available(j))) - end if - if (find(temps_to_read, nint(temps_available(j + 1))) == -1) then - call temps_to_read % push_back(nint(temps_available(j + 1))) - end if - cycle TEMPS_LOOP - end if - end do - - call fatal_error("MGXS library does not contain cross sections & - &for " // trim(this % name) // " at temperatures that bound " // & - trim(to_str(nint(temp_desired))) // " K.") - end do TEMPS_LOOP - end select - - ! Sort temperatures to read - call sort(temps_to_read) - - ! Get temperatures - n_temperature = temps_to_read % size() - allocate(this % kTs(n_temperature)) - do i = 1, n_temperature - ! Get temperature as a string - temp_str = trim(to_str(temps_to_read % data(i))) // "K" - - ! Read exact temperature value - call read_dataset(this % kTs(i), kT_group, trim(temp_str)) - end do - call close_group(kT_group) - - ! Allocate the XS object for the number of temperatures - select type(this) - type is (MgxsIso) - allocate(this % xs(n_temperature)) - type is (MgxsAngle) - allocate(this % xs(n_temperature)) - end select - - ! Load the remaining metadata - if (attribute_exists(xs_id, "scatter_format")) then - call read_attribute(temp_str, xs_id, "scatter_format") - temp_str = trim(temp_str) - if (to_lower(temp_str) == 'legendre') then - this % scatter_format = ANGLE_LEGENDRE - else if (to_lower(temp_str) == 'histogram') then - this % scatter_format = ANGLE_HISTOGRAM - else if (to_lower(temp_str) == 'tabular') then - this % scatter_format = ANGLE_TABULAR - else - call fatal_error("Invalid scatter_format option!") - end if - else - this % scatter_format = ANGLE_LEGENDRE - end if - if (attribute_exists(xs_id, "scatter_shape")) then - call read_attribute(temp_str, xs_id, "scatter_shape") - temp_str = trim(temp_str) - if (to_lower(temp_str) /= "[g][g'][order]") then - call fatal_error("Invalid scatter_shape option!") - end if - end if - if (attribute_exists(xs_id, "fissionable")) then - call read_attribute(this % fissionable, xs_id, "fissionable") - else - call fatal_error("Fissionable element must be set!") - end if - - ! Get the library's value for the order - if (attribute_exists(xs_id, "order")) then - call read_attribute(order_dim, xs_id, "order") - else - call fatal_error("Order must be provided!") - end if - - ! Store the dimensionality of the data in order_dim. - ! For Legendre data, we usually refer to it as Pn where n is the order. - ! However Pn has n+1 sets of points (since you need to count the P0 - ! moment). Adjust for that. Histogram and Tabular formats dont need this - ! adjustment. - if (this % scatter_format == ANGLE_LEGENDRE) then - order_dim = order_dim + 1 - else - order_dim = order_dim - end if - - ! Get angular meta-data and allocate as needed based off of the - ! information therein - select type(this) - type is (MgxsAngle) - if (attribute_exists(xs_id, "num_polar")) then - call read_attribute(this % n_pol, xs_id, "num_polar") - else - call fatal_error("num_polar must be provided!") - end if - - if (attribute_exists(xs_id, "num_azimuthal")) then - call read_attribute(this % n_azi, xs_id, "num_azimuthal") - else - call fatal_error("num_azimuthal must be provided!") - end if - - ! Set angle data to use equally-spaced bins - allocate(this % polar(this % n_pol)) - dangle = PI / real(this % n_pol, 8) - do ipol = 1, this % n_pol - this % polar(ipol) = (real(ipol, 8) - HALF) * dangle - end do - allocate(this % azimuthal(this % n_azi)) - dangle = TWO * PI / real(this % n_azi, 8) - do iazi = 1, this % n_azi - this % azimuthal(iazi) = -PI + (real(iazi, 8) - HALF) * dangle - end do - end select - - end subroutine mgxs_from_hdf5 - - subroutine mgxsiso_from_hdf5(this, xs_id, energy_groups, delayed_groups, & - temperature, method, tolerance, max_order, & - legendre_to_tabular, legendre_to_tabular_points) - class(MgxsIso), intent(inout) :: this ! Working Object - integer(HID_T), intent(in) :: xs_id ! Group in H5 file - integer, intent(in) :: energy_groups ! Number of energy groups - integer, intent(in) :: delayed_groups ! Number of delayed groups - type(VectorReal), intent(in) :: temperature ! list of desired temperatures - integer, intent(inout) :: method ! Type of temperature access - real(8), intent(in) :: tolerance ! Tolerance on method - integer, intent(in) :: max_order ! Maximum requested order - logical, intent(in) :: legendre_to_tabular ! Convert Legendres to Tabular? - integer, intent(in) :: legendre_to_tabular_points ! Number of points to use - ! in that conversion - - character(MAX_LINE_LEN) :: temp_str - integer(HID_T) :: xsdata, xsdata_grp, scatt_grp - integer :: ndims - integer(HSIZE_T) :: dims(2) - real(8), allocatable :: temp_arr(:), temp_2d(:, :) - real(8), allocatable :: temp_beta(:, :), temp_3d(:, :, :) - real(8) :: dmu, mu, norm, chi_sum - integer :: order, order_dim, gin, gout, l, imu, length - type(VectorInt) :: temps_to_read - integer :: t, dg, order_data - type(Jagged2D), allocatable :: input_scatt(:), scatt_coeffs(:) - type(Jagged1D), allocatable :: temp_mult(:) - integer, allocatable :: gmin(:), gmax(:) - - ! Call generic data gathering routine (will populate the metadata) - call mgxs_from_hdf5(this, xs_id, temperature, method, tolerance, & - temps_to_read, order_data) - - ! Set the number of delayed groups - this % num_delayed_groups = delayed_groups - - ! Load the more specific data - do t = 1, temps_to_read % size() - associate(xs => this % xs(t)) - - ! Get temperature as a string - temp_str = trim(to_str(temps_to_read % data(t))) // "K" - xsdata_grp = open_group(xs_id, trim(temp_str)) - - ! Allocate data for all the cross sections - allocate(xs % total(energy_groups)) - allocate(xs % absorption(energy_groups)) - allocate(xs % delayed_nu_fission(delayed_groups, energy_groups)) - allocate(xs % prompt_nu_fission(energy_groups)) - allocate(xs % fission(energy_groups)) - allocate(xs % kappa_fission(energy_groups)) - allocate(xs % decay_rate(delayed_groups)) - allocate(xs % inverse_velocity(energy_groups)) - allocate(xs % chi_delayed(delayed_groups, energy_groups, & - energy_groups)) - allocate(xs % chi_prompt(energy_groups, energy_groups)) - - ! Set all fissionable terms to zero - xs % delayed_nu_fission = ZERO - xs % prompt_nu_fission = ZERO - xs % fission = ZERO - xs % kappa_fission = ZERO - xs % chi_delayed = ZERO - xs % chi_prompt = ZERO - xs % decay_rate = ZERO - xs % inverse_velocity = ZERO - - if (this % fissionable) then - - ! Allocate temporary array for beta - allocate(temp_beta(delayed_groups, energy_groups)) - - ! Set beta - if (object_exists(xsdata_grp, "beta")) then - - ! Get the dimensions of the beta dataset - xsdata = open_dataset(xsdata_grp, "beta") - call get_ndims(xsdata, ndims) - - ! Beta is input as (delayed_groups) - if (ndims == 1) then - - ! Allocate temporary array for beta - allocate(temp_arr(delayed_groups)) - - ! Read beta - call read_dataset(temp_arr, xsdata_grp, "beta") - - do dg = 1, delayed_groups - do gin = 1, energy_groups - temp_beta(dg, gin) = temp_arr(dg) - end do - end do - - ! Deallocate temporary beta array - deallocate(temp_arr) - - ! Beta is input as (delayed_groups, energy_groups) - else if (ndims == 2) then - - ! Allocate temporary array for beta - allocate(temp_arr(delayed_groups * energy_groups)) - - ! Read beta - call read_dataset(temp_arr, xsdata_grp, "beta") - - ! Reshape array and set to dedicated beta array - temp_beta = reshape(temp_arr, (/delayed_groups, energy_groups/)) - - ! Deallocate temporary beta array - deallocate(temp_arr) - - else - call fatal_error("beta must be provided as a 1D or 2D array") - end if - - call close_dataset(xsdata) - else - temp_beta = ZERO - end if - - ! If chi provided, set chi-prompt and chi-delayed - if (object_exists(xsdata_grp, "chi")) then - - ! Allocate temporary array for chi - allocate(temp_arr(energy_groups)) - - ! Read chi - call read_dataset(temp_arr, xsdata_grp, "chi") - - do gin = 1, energy_groups - do gout = 1, energy_groups - xs % chi_prompt(gout, gin) = temp_arr(gout) - end do - - ! Normalize chi-prompt so its CDF goes to 1 - chi_sum =sum(xs % chi_prompt(:, gin)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi for a group that sums to & - &zero") - else - xs % chi_prompt(:, gin) = xs % chi_prompt(:, gin) / chi_sum - end if - end do - - ! Set chi-delayed to chi-prompt - do dg = 1, delayed_groups - xs % chi_delayed(dg, :, :) = xs % chi_prompt(:, :) - end do - - ! Deallocate temporary chi array - deallocate(temp_arr) - end if - - ! If nu-fission provided, set prompt-nu_-ission and - ! delayed-nu-fission. If nu fission is a matrix, set chi-prompt and - ! chi-delayed. - if (object_exists(xsdata_grp, "nu-fission")) then - - ! Get the dimensions of the nu-fission dataset - xsdata = open_dataset(xsdata_grp, "nu-fission") - call get_ndims(xsdata, ndims) - - ! If nu-fission is a vector - if (ndims == 1) then - - ! Get nu-fission - call read_dataset(xs % prompt_nu_fission, xsdata_grp, & - "nu-fission") - - ! Set delayed-nu-fission and correct prompt-nu-fission with - ! beta - do gin = 1, energy_groups - do dg = 1, delayed_groups - - ! Set delayed-nu-fission using delayed neutron fraction - xs % delayed_nu_fission(dg, gin) = temp_beta(dg, gin) * & - xs % prompt_nu_fission(gin) - end do - - ! Correct prompt-nu-fission using delayed neutron fraction - if (delayed_groups > 0) then - xs % prompt_nu_fission(gin) = (1 - sum(temp_beta(:, gin))) & - * xs % prompt_nu_fission(gin) - end if - end do - - ! If nu-fission is a matrix, set prompt-nu-fission, - ! delayed-nu-fission, chi-prompt, and chi-delayed. - else if (ndims == 2) then - - ! chi is embedded in nu-fission -> extract chi - allocate(temp_arr(energy_groups * energy_groups)) - call read_dataset(temp_arr, xsdata_grp, "nu-fission") - allocate(temp_2d(energy_groups, energy_groups)) - temp_2d = reshape(temp_arr, (/energy_groups, energy_groups/)) - - ! Deallocate temporary 1D array for nu-fission matrix - deallocate(temp_arr) - - ! Set the vector nu-fission from the matrix nu-fission - do gin = 1, energy_groups - xs % prompt_nu_fission(gin) = sum(temp_2d(:, gin)) - end do - - ! Set delayed-nu-fission and correct prompt-nu-fission with - ! beta - do gin = 1, energy_groups - do dg = 1, delayed_groups - - ! Set delayed-nu-fission using delayed neutron fraction - xs % delayed_nu_fission(dg, gin) = temp_beta(dg, gin) * & - xs % prompt_nu_fission(gin) - end do - - ! Correct prompt-nu-fission using delayed neutron fraction - if (delayed_groups > 0) then - xs % prompt_nu_fission(gin) = (1 - sum(temp_beta(:, gin))) & - * xs % prompt_nu_fission(gin) - end if - end do - - ! Now pull out information needed for chi - xs % chi_prompt(:, :) = temp_2d - - ! Deallocate temporary 2D array for nu-fission matrix - deallocate(temp_2d) - - ! Normalize chi so its CDF goes to 1 - do gin = 1, energy_groups - chi_sum = sum(xs % chi_prompt(:, gin)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi for a group that sums to & - &zero") - else - xs % chi_prompt(:, gin) = xs % chi_prompt(:, gin) / chi_sum - end if - end do - - ! Set chi-delayed to chi-prompt - do dg = 1, delayed_groups - xs % chi_delayed(dg, :, :) = xs % chi_prompt(:, :) - end do - else - call fatal_error("nu-fission must be provided as a 1D or 2D & - &array") - end if - - call close_dataset(xsdata) - end if - - ! If chi-prompt provided, set chi-prompt - if (object_exists(xsdata_grp, "chi-prompt")) then - - ! Allocate temporary array for chi-prompt - allocate(temp_arr(energy_groups)) - - ! Get array with chi-prompt - call read_dataset(temp_arr, xsdata_grp, "chi-prompt") - - do gin = 1, energy_groups - do gout = 1, energy_groups - xs % chi_prompt(gout, gin) = temp_arr(gout) - end do - - ! Normalize chi so its CDF goes to 1 - chi_sum = sum(xs % chi_prompt(:, gin)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi prompt for a group that & - &sums to zero") - else - xs % chi_prompt(:, gin) = xs % chi_prompt(:, gin) / chi_sum - end if - end do - - ! Deallocate temporary array for chi-prompt - deallocate(temp_arr) - end if - - ! If chi-delayed provided, set chi-delayed - if (object_exists(xsdata_grp, "chi-delayed")) then - - ! Get the dimensions of the chi-delayed dataset - xsdata = open_dataset(xsdata_grp, "chi-delayed") - call get_ndims(xsdata, ndims) - - ! If chi-delayed is a vector - if (ndims == 1) then - - ! Allocate temporary array for chi-delayed - allocate(temp_arr(energy_groups)) - - ! Get chi-delayed - call read_dataset(temp_arr, xsdata_grp, "chi-delayed") - - do dg = 1, delayed_groups - do gin = 1, energy_groups - do gout = 1, energy_groups - xs % chi_delayed(dg, gout, gin) = temp_arr(gout) - end do - - ! Normalize chi so its CDF goes to 1 - chi_sum = sum(xs % chi_delayed(dg, :, gin)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi delayed for a group & - &that sums to zero") - else - xs % chi_delayed(dg, :, gin) = & - xs % chi_delayed(dg, :, gin) / chi_sum - end if - end do - end do - - ! Deallocate temporary array for chi-delayed - deallocate(temp_arr) - - else if (ndims == 2) then - - ! Allocate temporary array for chi-delayed - allocate(temp_arr(delayed_groups * energy_groups)) - - ! Get chi-delayed - call read_dataset(temp_arr, xsdata_grp, "chi-delayed") - allocate(temp_2d(delayed_groups, energy_groups)) - temp_2d = reshape(temp_arr, (/delayed_groups, energy_groups/)) - - do dg = 1, delayed_groups - do gin = 1, energy_groups - do gout = 1, energy_groups - xs % chi_delayed(dg, gout, gin) = temp_2d(dg, gout) - end do - - ! Normalize chi so its CDF goes to 1 - chi_sum = sum(xs % chi_delayed(dg, :, gin)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi delayed for a group & - &that sums to zero") - else - xs % chi_delayed(dg, :, gin) = & - xs % chi_delayed(dg, :, gin) / chi_sum - end if - end do - end do - - ! Deallocate temporary arrays for chi-delayed - deallocate(temp_arr) - deallocate(temp_2d) - - else - call fatal_error("chi-delayed must be provided as a 1D or 2D & - &array") - end if - - call close_dataset(xsdata) - end if - - ! If prompt-nu-fission present, set prompt-nu-fission - if (object_exists(xsdata_grp, "prompt-nu-fission")) then - - ! Get the dimensions of the prompt-nu-fission dataset - xsdata = open_dataset(xsdata_grp, "prompt-nu-fission") - call get_ndims(xsdata, ndims) - - ! If prompt-nu-fission is a vector - if (ndims == 1) then - - ! Set prompt_nu_fission - call read_dataset(xs % prompt_nu_fission, xsdata_grp, & - "prompt-nu-fission") - - ! If prompt-nu-fission is a matrix, set prompt_nu_fission and - ! chi_prompt. - else if (ndims == 2) then - - ! chi_prompt is embedded in prompt_nu_fission -> extract - ! chi_prompt - allocate(temp_arr(energy_groups * energy_groups)) - call read_dataset(temp_arr, xsdata_grp, "prompt-nu-fission") - allocate(temp_2d(energy_groups, energy_groups)) - temp_2d = reshape(temp_arr, (/energy_groups, energy_groups/)) - - ! Deallocate temporary 1D array for prompt_nu_fission matrix - deallocate(temp_arr) - - ! Set the vector prompt-nu-fission from the matrix - ! prompt-nu-fission - do gin = 1, energy_groups - xs % prompt_nu_fission(gin) = sum(temp_2d(:, gin)) - end do - - ! Now pull out information needed for chi - xs % chi_prompt(:, :) = temp_2d - - ! Deallocate temporary 2D array for nu_fission matrix - deallocate(temp_2d) - - ! Normalize chi so its CDF goes to 1 - do gin = 1, energy_groups - chi_sum = sum(xs % chi_prompt(:, gin)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi prompt for a group & - &that sums to zero") - else - xs % chi_prompt(:, gin) = xs % chi_prompt(:, gin) / chi_sum - end if - end do - else - call fatal_error("prompt-nu-fission must be provided as a 1D & - &or 2D array") - end if - - call close_dataset(xsdata) - end if - - ! If delayed-nu-fission provided, set delayed-nu-fission. If - ! delayed-nu-fission is a matrix, set chi-delayed. - if (object_exists(xsdata_grp, "delayed-nu-fission")) then - - ! Get the dimensions of the delayed-nu-fission dataset - xsdata = open_dataset(xsdata_grp, "delayed-nu-fission") - call get_ndims(xsdata, ndims) - - ! If delayed-nu-fission is a vector - if (ndims == 1) then - - ! If beta is zeros, raise error - if (temp_beta(1,1) == ZERO) then - call fatal_error("cannot set delayed-nu-fission with a 1D & - &array if beta not provided") - end if - - ! Allocate temporary array for delayed-nu-fission - allocate(temp_arr(energy_groups)) - - ! Get delayed-nu-fission - call read_dataset(temp_arr, xsdata_grp, "delayed-nu-fission") - - do gin = 1, energy_groups - do dg = 1, delayed_groups - - ! Set delayed-nu-fission using delayed neutron fraction - xs % delayed_nu_fission(dg, gin) = temp_beta(dg, gin) * & - temp_arr(gin) - end do - end do - - ! Deallocate temporary delayed-nu-fission array - deallocate(temp_arr) - - ! If delayed-nu-fission is a (delayed_group, energy_group) - ! matrix, set delayed-nu-fission separately for each delayed - ! group. - else if (ndims == 2) then - - ! Get the shape of delayed-nu-fission - call get_shape(xsdata, dims) - - ! Issue error if 1st dimension not correct - if (dims(1) /= delayed_groups) then - call fatal_error("The delayed-nu-fission matrix was input & - &with a 1st dimension not equal to the number of & - &delayed groups.") - end if - - ! Issue error if 2nd dimension not correct - if (dims(2) /= energy_groups) then - call fatal_error("The delayed-nu-fission matrix was input & - &with a 2nd dimension not equal to the number of & - &energy groups.") - end if - - ! Issue warning if delayed_groups == energy_groups - if (delayed_groups == energy_groups) then - call warning("delayed-nu-fission was input as a dimension & - &2 matrix with the same number of delayed groups and & - &groups. It is important to know that OpenMC assumes & - &the dimensions in the matrix are (delayed_groups, & - &energy_groups). Currently, delayed-nu-fission cannot & - &be set as a group by group matrix.") - end if - - ! Get delayed-nu-fission - allocate(temp_arr(delayed_groups * energy_groups)) - call read_dataset(temp_arr, xsdata_grp, "delayed-nu-fission") - xs % delayed_nu_fission = reshape(temp_arr, (/delayed_groups, & - energy_groups/)) - - ! Deallocate temporary array for delayed-nu-fission matrix - deallocate(temp_arr) - - ! If delayed nu-fission is a 3D matrix, set delayed_nu_fission - ! and chi_delayed. - else if (ndims == 3) then - - ! chi_delayed is embedded in delayed_nu_fission -> extract - ! chi_delayed - allocate(temp_arr(delayed_groups * energy_groups * & - energy_groups)) - call read_dataset(temp_arr, xsdata_grp, "delayed-nu-fission") - allocate(temp_3d(delayed_groups, energy_groups, energy_groups)) - temp_3d = reshape(temp_arr, (/delayed_groups, energy_groups, & - energy_groups/)) - - ! Deallocate temporary 1D array for delayed_nu_fission matrix - deallocate(temp_arr) - - ! Set the 2D delayed-nu-fission matrix and 3D chi_dealyed matrix - ! from the 3D delayed-nu-fission matrix - do dg = 1, delayed_groups - do gin = 1, energy_groups - xs % delayed_nu_fission(dg, gin) = sum(temp_3d(dg, :, gin)) - do gout = 1, energy_groups - xs % chi_delayed(dg, gout, gin) = temp_3d(dg, gout, gin) - end do - end do - end do - - ! Normalize chi_delayed so its CDF goes to 1 - do dg = 1, delayed_groups - do gin = 1, energy_groups - chi_sum = sum(xs % chi_delayed(dg, :, gin)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi delayed for a group & - &that sums to zero") - else - xs % chi_delayed(dg, :, gin) = & - xs % chi_delayed(dg, :, gin) / chi_sum - end if - end do - end do - - ! Deallocate temporary 3D matrix for delayed_nu_fission - deallocate(temp_3d) - else - call fatal_error("delayed-nu-fission must be provided as a & - &1D, 2D, or 3D array") - end if - - call close_dataset(xsdata) - end if - - ! Deallocate temporary beta array - deallocate(temp_beta) - - ! chi-prompt, chi-delayed, prompt-nu-fission, and delayed-nu-fission - ! have been set; Now we will check for the rest of the XS that are - ! unique to fissionable isotopes - - ! Get fission xs - if (object_exists(xsdata_grp, "fission")) then - call read_dataset(xs % fission, xsdata_grp, "fission") - end if - - ! Get kappa-fission xs - if (object_exists(xsdata_grp, "kappa-fission")) then - call read_dataset(xs % kappa_fission, xsdata_grp, "kappa-fission") - end if - - ! Get decay rate xs - if (object_exists(xsdata_grp, "decay rate")) then - call read_dataset(xs % decay_rate, xsdata_grp, "decay rate") - end if - end if - - ! All the XS unique to fissionable isotopes have been set; Now set all - ! the generation XS - - if (object_exists(xsdata_grp, "absorption")) then - call read_dataset(xs % absorption, xsdata_grp, "absorption") - else - call fatal_error("Must provide absorption!") - end if - - ! Get inverse velocity - if (object_exists(xsdata_grp, "inverse-velocity")) then - call read_dataset(xs % inverse_velocity, xsdata_grp, & - "inverse-velocity") - end if - - ! Get scattering data - if (.not. object_exists(xsdata_grp, "scatter_data")) & - call fatal_error("Must provide 'scatter_data'") - - scatt_grp = open_group(xsdata_grp, 'scatter_data') - - ! First get the outgoing group boundary indices - if (object_exists(scatt_grp, "g_min")) then - allocate(gmin(energy_groups)) - call read_dataset(gmin, scatt_grp, "g_min") - else - call fatal_error("'g_min' for the scatter_data must be provided") - end if - - if (object_exists(scatt_grp, "g_max")) then - allocate(gmax(energy_groups)) - call read_dataset(gmax, scatt_grp, "g_max") - else - call fatal_error("'g_max' for the scatter_data must be provided") - end if - - ! Now use this information to find the length of a container array - ! to hold the flattened data - length = 0 - - do gin = 1, energy_groups - length = length + order_data * (gmax(gin) - gmin(gin) + 1) - end do - - ! Allocate flattened array - allocate(temp_arr(length)) - - if (.not. object_exists(scatt_grp, 'scatter_matrix')) & - call fatal_error("'scatter_matrix' must be provided") - call read_dataset(temp_arr, scatt_grp, "scatter_matrix") - - ! Compare the number of orders given with the maximum order of the - ! problem. Strip off the supefluous orders if needed. - if (this % scatter_format == ANGLE_LEGENDRE) then - order = min(order_data - 1, max_order) - order_dim = order + 1 - else - order_dim = order_data - end if - - ! Convert temp_arr to a jagged array ((gin) % data(l, gout)) for - ! passing to ScattData - allocate(input_scatt(energy_groups)) - - index = 1 - do gin = 1, energy_groups - allocate(input_scatt(gin) % data(order_dim, gmin(gin):gmax(gin))) - do gout = gmin(gin), gmax(gin) - do l = 1, order_dim - input_scatt(gin) % data(l, gout) = temp_arr(index) - index = index + 1 - end do - ! Adjust index for the orders we didnt take - index = index + (order_data - order_dim) - end do - end do - - deallocate(temp_arr) - - ! Finally convert the legendre to tabular if needed - allocate(scatt_coeffs(energy_groups)) - - if (this % scatter_format == ANGLE_LEGENDRE .and. & - legendre_to_tabular) then - - this % scatter_format = ANGLE_TABULAR - order_dim = legendre_to_tabular_points - order = order_dim - dmu = TWO / real(order - 1, 8) - - do gin = 1, energy_groups - allocate(scatt_coeffs(gin) % data(order_dim, gmin(gin):gmax(gin))) - do gout = gmin(gin), gmax(gin) - - norm = ZERO - - do imu = 1, order_dim - - if (imu == 1) then - mu = -ONE - else if (imu == order_dim) then - mu = ONE - else - mu = -ONE + real(imu - 1, 8) * dmu - end if - - scatt_coeffs(gin) % data(imu, gout) = & - evaluate_legendre(input_scatt(gin) % data(:, gout), mu) - - ! Ensure positivity of distribution - if (scatt_coeffs(gin) % data(imu, gout) < ZERO) & - scatt_coeffs(gin) % data(imu, gout) = ZERO - - ! And accrue the integral - if (imu > 1) then - norm = norm + HALF * dmu * & - (scatt_coeffs(gin) % data(imu - 1, gout) + & - scatt_coeffs(gin) % data(imu, gout)) - end if - end do ! mu - - ! Now that we have the integral, lets ensure that the - ! distribution is normalized such that it preserves the original - ! scattering xs - if (norm > ZERO) then - scatt_coeffs(gin) % data(:, gout) = & - scatt_coeffs(gin) % data(:, gout) * & - input_scatt(gin) % data(1, gout) / norm - end if - end do ! gout - end do ! gin - else - - ! Sticking with current representation - do gin = 1, energy_groups - allocate(scatt_coeffs(gin) % data(order_dim, gmin(gin):gmax(gin))) - scatt_coeffs(gin) % data(:, :) = & - input_scatt(gin) % data(1:order_dim, :) - end do - end if - - deallocate(input_scatt) - - ! Now get the multiplication matrix - if (object_exists(scatt_grp, 'multiplicity_matrix')) then - - ! Now use this information to find the length of a container array - ! to hold the flattened data - length = 0 - - do gin = 1, energy_groups - length = length + (gmax(gin) - gmin(gin) + 1) - end do - - ! Allocate flattened array - allocate(temp_arr(length)) - call read_dataset(temp_arr, scatt_grp, "multiplicity_matrix") - - ! Convert temp_arr to a jagged array ((gin) % data(gout)) for - ! passing to ScattData - allocate(temp_mult(energy_groups)) - - index = 1 - do gin = 1, energy_groups - - allocate(temp_mult(gin) % data(gmin(gin):gmax(gin))) - - do gout = gmin(gin), gmax(gin) - temp_mult(gin) % data(gout) = temp_arr(index) - index = index + 1 - end do - end do - deallocate(temp_arr) - else - - ! Default to multiplicities of 1.0 - allocate(temp_mult(energy_groups)) - - do gin = 1, energy_groups - allocate(temp_mult(gin) % data(gmin(gin):gmax(gin))) - temp_mult(gin) % data = ONE - end do - end if - - ! Allocate and initialize our ScattData Object. - if (this % scatter_format == ANGLE_HISTOGRAM) then - allocate(ScattDataHistogram :: xs % scatter) - else if (this % scatter_format == ANGLE_TABULAR) then - allocate(ScattDataTabular :: xs % scatter) - else if (this % scatter_format == ANGLE_LEGENDRE) then - allocate(ScattDataLegendre :: xs % scatter) - end if - - ! Initialize the ScattData Object - call xs % scatter % init(gmin, gmax, temp_mult, scatt_coeffs) - - ! Check sigA to ensure it is not 0 since it is - ! often divided by in the tally routines - ! (This may happen with Helium data) - do gin = 1, energy_groups - if (xs % absorption(gin) == ZERO) xs % absorption(gin) = 1E-10_8 - end do - - ! Get, or infer, total xs data. - if (object_exists(xsdata_grp, "total")) then - call read_dataset(xs % total, xsdata_grp, "total") - else - xs % total(:) = xs % absorption(:) + xs % scatter % scattxs(:) - end if - - ! Check sigT to ensure it is not 0 since it is - ! often divided by in the tally routines - do gin = 1, energy_groups - if (xs % total(gin) == ZERO) xs % total(gin) = 1E-10_8 - end do - - ! Close the groups we have opened and deallocate - call close_group(xsdata_grp) - call close_group(scatt_grp) - deallocate(scatt_coeffs, temp_mult) - end associate ! xs - end do ! Temperatures - - end subroutine mgxsiso_from_hdf5 - - subroutine mgxsang_from_hdf5(this, xs_id, energy_groups, delayed_groups, & - temperature, method, tolerance, max_order, legendre_to_tabular, & - legendre_to_tabular_points) - class(MgxsAngle), intent(inout) :: this ! Working Object - integer(HID_T), intent(in) :: xs_id ! Group in H5 file - integer, intent(in) :: energy_groups ! Number of energy groups - integer, intent(in) :: delayed_groups ! Number of energy groups - type(VectorReal), intent(in) :: temperature ! list of desired temperatures - integer, intent(inout) :: method ! Type of temperature access - real(8), intent(in) :: tolerance ! Tolerance on method - integer, intent(in) :: max_order ! Maximum requested order - logical, intent(in) :: legendre_to_tabular ! Convert Legendres to Tabular? - integer, intent(in) :: legendre_to_tabular_points ! Number of points to use - ! in that conversion - - character(MAX_LINE_LEN) :: temp_str - integer(HID_T) :: xsdata, xsdata_grp, scatt_grp - integer :: ndims - integer(HSIZE_T) :: dims(4) - integer, allocatable :: int_arr(:) - real(8), allocatable :: temp_1d(:), temp_3d(:, :, :) - real(8), allocatable :: temp_4d(:, :, :, :), temp_5d(:, :, :, :, :) - real(8), allocatable :: temp_beta(:, :, :, :) - real(8) :: dmu, mu, norm, chi_sum - integer :: order, order_dim, gin, gout, l, imu, dg - type(VectorInt) :: temps_to_read - integer :: t, length, ipol, iazi, order_data - type(Jagged2D), allocatable :: input_scatt(:, :, :), scatt_coeffs(:, :, :) - type(Jagged1D), allocatable :: temp_mult(:, :, :) - integer, allocatable :: gmin(:, :, :), gmax(:, :, :) - - ! Call generic data gathering routine (will populate the metadata) - call mgxs_from_hdf5(this, xs_id, temperature, method, tolerance, & - temps_to_read, order_data) - - ! Set the number of delayed groups - this % num_delayed_groups = delayed_groups - - ! Load the more specific data - do t = 1, temps_to_read % size() - associate(xs => this % xs(t)) - - ! Get temperature as a string - temp_str = trim(to_str(temps_to_read % data(t))) // "K" - xsdata_grp = open_group(xs_id, trim(temp_str)) - - ! Load the more specific data - allocate(xs % prompt_nu_fission(energy_groups, this % n_azi, & - this % n_pol)) - allocate(xs % delayed_nu_fission(delayed_groups, energy_groups, & - this % n_azi, this % n_pol)) - allocate(xs % chi_prompt(energy_groups, energy_groups, this % n_azi, & - this % n_pol)) - allocate(xs % chi_delayed(delayed_groups, energy_groups, & - energy_groups, this % n_azi, this % n_pol)) - allocate(xs % total(energy_groups, this % n_azi, this % n_pol)) - allocate(xs % absorption(energy_groups, this % n_azi, this % n_pol)) - allocate(xs % fission(energy_groups, this % n_azi, this % n_pol)) - allocate(xs % kappa_fission(energy_groups, this % n_azi, & - this % n_pol)) - allocate(xs % decay_rate(delayed_groups, this % n_azi, this % n_pol)) - allocate(xs % inverse_velocity(energy_groups, this % n_azi, & - this % n_pol)) - - ! Set all fissionable terms to zero - xs % delayed_nu_fission = ZERO - xs % prompt_nu_fission = ZERO - xs % fission = ZERO - xs % kappa_fission = ZERO - xs % chi_delayed = ZERO - xs % chi_prompt = ZERO - xs % decay_rate = ZERO - xs % inverse_velocity = ZERO - - if (this % fissionable) then - - ! Allocate temporary array for beta - allocate(temp_beta(delayed_groups, energy_groups, this % n_azi, & - this % n_pol)) - - ! Set beta - if (object_exists(xsdata_grp, "beta")) then - - ! Get the dimensions of the beta dataset - xsdata = open_dataset(xsdata_grp, "beta") - call get_ndims(xsdata, ndims) - - ! Beta is input as (delayed_groups, n_azi, n_pol) - if (ndims == 3) then - - ! Allocate temporary arrays for beta - allocate(temp_1d(delayed_groups * this % n_azi * this % n_pol)) - allocate(temp_3d(delayed_groups, this % n_azi, this % n_pol)) - - ! Read beta - call read_dataset(temp_1d, xsdata_grp, "beta") - temp_3d = reshape(temp_1d, (/delayed_groups, this % n_azi, & - this % n_pol/)) - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do dg = 1, delayed_groups - do gin = 1, energy_groups - temp_beta(dg, gin, iazi, ipol) = temp_3d(dg, iazi, ipol) - end do - end do - end do - end do - - ! Deallocate temporary beta arrays - deallocate(temp_1d) - deallocate(temp_3d) - - ! Beta is input as (delayed_groups, energy_groups, n_azi, n_pol) - else if (ndims == 4) then - - ! Allocate temporary array for beta - allocate(temp_1d(delayed_groups * energy_groups * this % n_azi & - * this % n_pol)) - - ! Read beta - call read_dataset(temp_1d, xsdata_grp, "beta") - - ! Reshape array and set to dedicated beta array - temp_beta = reshape(temp_1d, (/delayed_groups, & - energy_groups, this % n_azi, this % n_pol/)) - - ! Deallocate temporary beta array - deallocate(temp_1d) - - else - call fatal_error("beta must be provided as a 3D or 4D array") - end if - - call close_dataset(xsdata) - else - temp_beta = ZERO - end if - - ! If chi provided, set chi-prompt and chi-delayed - if (object_exists(xsdata_grp, "chi")) then - - ! Allocate temporary array for chi - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - allocate(temp_3d(energy_groups, this % n_azi, this % n_pol)) - - ! Read chi - call read_dataset(temp_1d, xsdata_grp, "chi") - temp_3d = reshape(temp_1d, (/energy_groups, this % n_azi, & - this % n_pol/)) - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - do gout = 1, energy_groups - xs % chi_prompt(gout, gin, iazi, ipol) = & - temp_3d(gout, iazi, ipol) - end do - - ! Normalize chi-prompt so its CDF goes to 1 - chi_sum = sum(xs % chi_prompt(:, gin, iazi, ipol)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi for a group that sums& - & to zero") - else - xs % chi_prompt(:, gin, iazi, ipol) = & - xs % chi_prompt(:, gin, iazi, ipol) / chi_sum - end if - end do - end do - end do - - ! Set chi-delayed to chi-prompt - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do dg = 1, delayed_groups - xs % chi_delayed(dg, :, :, iazi, ipol) = & - xs % chi_prompt(:, :, iazi, ipol) - end do - end do - end do - - ! Deallocate temporary chi arrays - deallocate(temp_1d) - deallocate(temp_3d) - end if - - ! If nu-fission provided, set prompt-nu_-ission and - ! delayed-nu-fission. If nu fission is a matrix, set chi-prompt and - ! chi-delayed. - if (object_exists(xsdata_grp, "nu-fission")) then - - ! Get the dimensions of the nu-fission dataset - xsdata = open_dataset(xsdata_grp, "nu-fission") - call get_ndims(xsdata, ndims) - - ! If nu-fission is a 3D array - if (ndims == 3) then - - ! Get nu-fission - call read_dataset(xs % prompt_nu_fission, xsdata_grp, & - "nu-fission") - - ! Set delayed-nu-fission and correct prompt-nu-fission with - ! beta - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - do dg = 1, delayed_groups - - ! Set delayed-nu-fission using delayed neutron fraction - xs % delayed_nu_fission(dg, gin, iazi, ipol) = & - temp_beta(dg, gin, iazi, ipol) * & - xs % prompt_nu_fission(gin, iazi, ipol) - end do - - ! Correct prompt-nu-fission using delayed neutron fraction - if (delayed_groups > 0) then - xs % prompt_nu_fission(gin, iazi, ipol) = & - (1 - sum(temp_beta(:, gin, iazi, ipol))) * & - xs % prompt_nu_fission(gin, iazi, ipol) - end if - end do - end do - end do - - ! If nu-fission is a matrix, set prompt-nu-fission, - ! delayed-nu-fission, chi-prompt, and chi-delayed. - else if (ndims == 4) then - - ! chi is embedded in nu-fission -> extract chi - allocate(temp_1d(energy_groups * energy_groups * & - this % n_azi * this % n_pol)) - call read_dataset(temp_1d, xsdata_grp, "nu-fission") - allocate(temp_4d(energy_groups, energy_groups, this % n_azi, & - this % n_pol)) - temp_4d = reshape(temp_1d, (/energy_groups, energy_groups, & - this % n_azi, this % n_pol /)) - - ! Deallocate temporary 1D array for nu-fission matrix - deallocate(temp_1d) - - ! Set the vector nu-fission from the matrix nu-fission - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - xs % prompt_nu_fission(gin, iazi, ipol) = & - sum(temp_4d(:, gin, iazi, ipol)) - end do - end do - end do - - ! Set delayed-nu-fission and correct prompt-nu-fission with - ! beta - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - do dg = 1, delayed_groups - - ! Set delayed-nu-fission using delayed neutron fraction - xs % delayed_nu_fission(dg, gin, iazi, ipol) = & - temp_beta(dg, gin, iazi, ipol) * & - xs % prompt_nu_fission(gin, iazi, ipol) - end do - - ! Correct prompt-nu-fission using delayed neutron fraction - if (delayed_groups > 0) then - xs % prompt_nu_fission(gin, iazi, ipol) = & - (1 - sum(temp_beta(:, gin, iazi, ipol))) * & - xs % prompt_nu_fission(gin, iazi, ipol) - end if - end do - end do - end do - - ! Now pull out information needed for chi - xs % chi_prompt(:, :, :, :) = temp_4d - - ! Deallocate temporary 4D array for nu-fission matrix - deallocate(temp_4d) - - ! Normalize chi so its CDF goes to 1 - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - chi_sum = sum(xs % chi_prompt(:, gin, iazi, ipol)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi for a group that & - &sums to zero") - else - xs % chi_prompt(:, gin, iazi, ipol) = & - xs % chi_prompt(:, gin, iazi, ipol) / chi_sum - end if - end do - - ! Set chi-delayed to chi-prompt - do dg = 1, delayed_groups - xs % chi_delayed(dg, :, :, iazi, ipol) = & - xs % chi_prompt(:, :, iazi, ipol) - end do - end do - end do - else - call fatal_error("nu-fission must be provided as a 3D or & - &4D array") - end if - - call close_dataset(xsdata) - end if - - ! If chi-prompt provided, set chi-prompt - if (object_exists(xsdata_grp, "chi-prompt")) then - - ! Allocate temporary array for chi-prompt - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - allocate(temp_3d(energy_groups, this % n_azi, this % n_pol)) - - ! Get array with chi-prompt - call read_dataset(temp_1d, xsdata_grp, "chi-prompt") - temp_3d = reshape(temp_1d, (/energy_groups, this % n_azi, & - this % n_pol/)) - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - do gout = 1, energy_groups - xs % chi_prompt(gout, gin, iazi, ipol) = & - temp_3d(gout, iazi, ipol) - end do - - ! Normalize chi so its CDF goes to 1 - chi_sum = sum(xs % chi_prompt(:, gin, iazi, ipol)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi prompt for a group that& - & sums to zero") - else - xs % chi_prompt(:, gin, iazi, ipol) = & - xs % chi_prompt(:, gin, iazi, ipol) / chi_sum - end if - end do - end do - end do - - ! Deallocate temporary arrays for chi-prompt - deallocate(temp_1d) - deallocate(temp_3d) - end if - - ! If chi-delayed provided, set chi-delayed - if (object_exists(xsdata_grp, "chi-delayed")) then - - ! Get the dimensions of the chi-delayed dataset - xsdata = open_dataset(xsdata_grp, "chi-delayed") - call get_ndims(xsdata, ndims) - - ! chi-delayed is input as (energy_groups, n_azi, n_pol) - if (ndims == 3) then - - ! Allocate temporary array for chi-prompt - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - allocate(temp_3d(energy_groups, this % n_azi, this % n_pol)) - - ! Get array with chi-prompt - call read_dataset(temp_1d, xsdata_grp, "chi-delayed") - temp_3d = reshape(temp_1d, (/energy_groups, this % n_azi, & - this % n_pol/)) - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do dg = 1, delayed_groups - do gin = 1, energy_groups - do gout = 1, energy_groups - xs % chi_delayed(dg, gout, gin, iazi, ipol) = & - temp_3d(gout, iazi, ipol) - end do - - ! Normalize chi so its CDF goes to 1 - chi_sum = sum(xs % chi_delayed(dg, :, gin, iazi, ipol)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi delayed for a group& - & that sums to zero") - else - xs % chi_delayed(dg, :, gin, iazi, ipol) = & - xs % chi_delayed(dg, :, gin, iazi, ipol) / & - chi_sum - end if - end do - end do - end do - end do - - ! Deallocate temporary arrays for chi-delayed - deallocate(temp_1d) - deallocate(temp_3d) - - ! chi-delayed is input as (delayed_groups, energy_groups, n_azi, - ! n_pol) - else if (ndims == 4) then - - ! Allocate temporary array for chi-delayed - allocate(temp_1d(delayed_groups * energy_groups * this % n_azi & - * this % n_pol)) - allocate(temp_4d(delayed_groups, energy_groups, this % n_azi, & - this % n_pol)) - - ! Get chi-delayed - call read_dataset(temp_1d, xsdata_grp, "chi-delayed") - temp_4d = reshape(temp_1d, (/delayed_groups, energy_groups, & - this % n_azi, this % n_pol/)) - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do dg = 1, delayed_groups - do gin = 1, energy_groups - do gout = 1, energy_groups - xs % chi_delayed(dg, gout, gin, iazi, ipol) = & - temp_4d(dg, gout, iazi, ipol) - end do - - ! Normalize chi so its CDF goes to 1 - chi_sum = sum(xs % chi_delayed(dg, :, gin, iazi, ipol)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi delayed for a group& - & that sums to zero") - else - xs % chi_delayed(dg, :, gin, iazi, ipol) = & - xs % chi_delayed(dg, :, gin, iazi, ipol) / & - chi_sum - end if - end do - end do - end do - end do - - ! Deallocate temporary arrays for chi-delayed - deallocate(temp_1d) - deallocate(temp_4d) - - else - call fatal_error("chi-delayed must be provided as a 3D or 4D & - &array") - end if - - call close_dataset(xsdata) - end if - - ! If prompt-nu-fission present, set prompt-nu-fission - if (object_exists(xsdata_grp, "prompt-nu-fission")) then - - ! Get the dimensions of the prompt-nu-fission dataset - xsdata = open_dataset(xsdata_grp, "prompt-nu-fission") - call get_ndims(xsdata, ndims) - - ! If prompt-nu-fission is a vector for each azi and pol - if (ndims == 3) then - - ! Set prompt_nu_fission - call read_dataset(xs % prompt_nu_fission, xsdata_grp, & - "prompt-nu-fission") - - ! If prompt-nu-fission is a matrix for each azi and pol, - ! set prompt_nu_fission and chi_prompt. - else if (ndims == 4) then - - ! chi_prompt is embedded in prompt_nu_fission -> extract - ! chi_prompt - allocate(temp_1d(energy_groups * energy_groups & - * this % n_azi * this % n_pol)) - allocate(temp_4d(energy_groups, energy_groups, this % n_azi, & - this % n_pol)) - call read_dataset(temp_1d, xsdata_grp, "prompt-nu-fission") - temp_4d = reshape(temp_1d, (/energy_groups, energy_groups, & - this % n_azi, this % n_pol/)) - - ! Deallocate temporary 1D array for prompt_nu_fission matrix - deallocate(temp_1d) - - ! Set the vector prompt-nu-fission from the matrix - ! prompt-nu-fission - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - xs % prompt_nu_fission(gin, iazi, ipol) = & - sum(temp_4d(:, gin, iazi, ipol)) - end do - end do - end do - - ! Now pull out information needed for chi - xs % chi_prompt(:, :, :, :) = temp_4d - - ! Deallocate temporary 4D array for nu_fission matrix - deallocate(temp_4d) - - ! Normalize chi so its CDF goes to 1 - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - chi_sum = sum(xs % chi_prompt(:, gin, iazi, ipol)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi prompt for a group & - &that sums to zero") - else - xs % chi_prompt(:, gin, iazi, ipol) = & - xs % chi_prompt(:, gin, iazi, ipol) / chi_sum - end if - end do - end do - end do - else - call fatal_error("prompt-nu-fission must be provided as a 3D & - &or 4D array") - end if - - call close_dataset(xsdata) - end if - - ! If delayed-nu-fission provided, set delayed-nu-fission. If - ! delayed-nu-fission is a matrix, set chi-delayed. - if (object_exists(xsdata_grp, "delayed-nu-fission")) then - - ! Get the dimensions of the delayed-nu-fission dataset - xsdata = open_dataset(xsdata_grp, "delayed-nu-fission") - call get_ndims(xsdata, ndims) - - ! delayed-nu-fission is input as (energy_groups, n_azi, n_pol) - if (ndims == 3) then - - ! If beta is zeros, raise error - if (temp_beta(1,1,1,1) == ZERO) then - call fatal_error("cannot set delayed-nu-fission with a 3D & - &array if beta not provided") - end if - - ! Allocate temporary arrays for delayed-nu-fission - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - allocate(temp_3d(energy_groups, this % n_azi, this % n_pol)) - - ! Get delayed-nu-fission - call read_dataset(temp_1d, xsdata_grp, "delayed-nu-fission") - temp_3d = reshape(temp_1d, (/energy_groups, this % n_azi, & - this % n_pol/)) - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - do dg = 1, delayed_groups - - ! Set delayed-nu-fission using delayed neutron fraction - xs % delayed_nu_fission(dg, gin, iazi, ipol) = & - temp_beta(dg, gin, iazi, ipol) * & - temp_3d(gin, iazi, ipol) - end do - end do - end do - end do - - ! Deallocate temporary delayed-nu-fission arrays - deallocate(temp_1d) - deallocate(temp_3d) - - ! If delayed-nu-fission is a (delayed_group, energy_group, - ! n_azi, n_pol) matrix, set delayed-nu-fission separately for - ! each delayed group. - else if (ndims == 4) then - - ! Get the shape of delayed-nu-fission - call get_shape(xsdata, dims) - - ! Issue error if 1st dimension not correct - if (dims(1) /= delayed_groups) then - call fatal_error("The delayed-nu-fission matrix was input & - &with a 1st dimension not equal to the number of & - &delayed groups.") - end if - - ! Issue error if 2nd dimension not correct - if (dims(2) /= energy_groups) then - call fatal_error("The delayed-nu-fission matrix was input & - &with a 2nd dimension not equal to the number of & - &energy groups.") - end if - - ! Issue warning if delayed_groups == energy_groups - if (delayed_groups == energy_groups) then - call warning("delayed-nu-fission was input as a dimension & - &4 matrix with the same number of delayed groups and & - &groups. It is important to know that OpenMC assumes & - &the dimensions in the matrix are (delayed_groups, & - &energy_groups, n_azi, n_pol). Currently, & - &delayed-nu-fission cannot be set as a group by group & - &matrix.") - end if - - ! Get delayed-nu-fission - allocate(temp_1d(delayed_groups * energy_groups * this % n_azi & - * this % n_pol)) - call read_dataset(temp_1d, xsdata_grp, "delayed-nu-fission") - xs % delayed_nu_fission = reshape(temp_1d, (/delayed_groups, & - energy_groups, this % n_azi, this % n_pol /)) - - ! Deallocate temporary array for delayed-nu-fission matrix - deallocate(temp_1d) - - ! If delayed nu-fission is a 5D matrix, set delayed_nu_fission - ! and chi_delayed. - else if (ndims == 5) then - - ! chi_delayed is embedded in delayed_nu_fission -> extract - ! chi_delayed - allocate(temp_1d(delayed_groups * energy_groups * & - energy_groups * this % n_azi * this % n_pol)) - allocate(temp_5d(delayed_groups, energy_groups, energy_groups, & - this % n_azi, this % n_pol)) - call read_dataset(temp_1d, xsdata_grp, "delayed-nu-fission") - temp_5d = reshape(temp_1d, (/delayed_groups, energy_groups, & - energy_groups, this % n_azi, this % n_pol/)) - - ! Deallocate temporary 1D array for delayed_nu_fission matrix - deallocate(temp_1d) - - ! Set the 4D delayed-nu-fission matrix and 5D chi_delayed matrix - ! from the 5D delayed-nu-fission matrix - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do dg = 1, delayed_groups - do gin = 1, energy_groups - xs % delayed_nu_fission(dg, gin, iazi, ipol) = & - sum(temp_5d(dg, :, gin, iazi, ipol)) - do gout = 1, energy_groups - xs % chi_delayed(dg, gout, gin, iazi, ipol) = & - temp_5d(dg, gout, gin, iazi, ipol) - end do - end do - end do - end do - end do - - ! Normalize chi_delayed so its CDF goes to 1 - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do dg = 1, delayed_groups - do gin = 1, energy_groups - chi_sum = sum(xs % chi_delayed(dg, :, gin, iazi, ipol)) - if (chi_sum == ZERO) then - call fatal_error("Encountered chi delayed for a group& - & that sums to zero") - else - xs % chi_delayed(dg, :, gin, iazi, ipol) = & - xs % chi_delayed(dg, :, gin, iazi, ipol) / & - chi_sum - end if - end do - end do - end do - end do - - ! Deallocate temporary 5D matrix for delayed_nu_fission - deallocate(temp_5d) - else - call fatal_error("delayed-nu-fission must be provided as a & - &3D, 4D, or 5D array") - end if - - call close_dataset(xsdata) - end if - - ! Deallocate temporary beta array - deallocate(temp_beta) - - ! chi-prompt, chi-delayed, prompt-nu-fission, and delayed-nu-fission - ! have been set; Now we will check for the rest of the XS that are - ! unique to fissionable isotopes - - ! Set fission xs - if (object_exists(xsdata_grp, "fission")) then - - ! Allocate temporary array for fission - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - - ! Get fission array - call read_dataset(temp_1d, xsdata_grp, "fission") - xs % fission(:, :, :) = reshape(temp_1d, (/energy_groups, & - this % n_azi, this % n_pol/)) - - ! Deallocate temporary array for fission - deallocate(temp_1d) - end if - - ! Set kappa-fission xs - if (object_exists(xsdata_grp, "kappa-fission")) then - - ! Allocate temporary array for kappa-fission - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - - ! Get kappa-fission array - call read_dataset(temp_1d, xsdata_grp, "kappa-fission") - xs % kappa_fission(:, :, :) = reshape(temp_1d, (/energy_groups, & - this % n_azi, this % n_pol/)) - - ! Deallocate temporary array for kappa-fission - deallocate(temp_1d) - end if - - ! Set decay rate - if (object_exists(xsdata_grp, "decay rate")) then - - ! Allocate temporary array for decay rate - allocate(temp_1d(this % n_azi * this % n_pol * delayed_groups)) - - ! Get decay rate array - call read_dataset(temp_1d, xsdata_grp, "decay rate") - xs % decay_rate(:, :, :) = reshape(temp_1d, (/delayed_groups, & - this % n_azi, this % n_pol/)) - - ! Deallocate temporary array for decay rate - deallocate(temp_1d) - end if - end if - - ! All the XS unique to fissionable isotopes have been set; Now set all - ! the generation XS - - if (object_exists(xsdata_grp, "absorption")) then - - ! Allocate temporary array for absorption xs - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - - ! Read in absorption xs - call read_dataset(temp_1d, xsdata_grp, "absorption") - - xs % absorption = reshape(temp_1d, (/energy_groups, this % n_azi, & - this % n_pol/)) - - ! Deallocate temporary array for absorption xs - deallocate(temp_1d) - else - call fatal_error("Must provide absorption!") - end if - - if (object_exists(xsdata_grp, "inverse-velocity")) then - - ! Allocate temporary array for inverse velocity - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - - ! Read in inverse velocity - call read_dataset(temp_1d, xsdata_grp, "inverse-velocity") - - xs % inverse_velocity = reshape(temp_1d, (/energy_groups, & - this % n_azi, this % n_pol/)) - - ! Deallocate temporary array for inverse velocity - deallocate(temp_1d) - end if - - ! Get scattering data - if (.not. object_exists(xsdata_grp, "scatter_data")) & - call fatal_error("Must provide 'scatter_data'") - - scatt_grp = open_group(xsdata_grp, 'scatter_data') - - ! First get the outgoing group boundary indices - if (object_exists(scatt_grp, "g_min")) then - - allocate(int_arr(energy_groups * this % n_azi * this % n_pol)) - - call read_dataset(int_arr, scatt_grp, "g_min") - allocate(gmin(energy_groups, this % n_azi, this % n_pol)) - gmin = reshape(int_arr, (/energy_groups, this % n_azi, & - this % n_pol/)) - - deallocate(int_arr) - else - call fatal_error("'g_min' for the scatter_data must be provided") - end if - - if (object_exists(scatt_grp, "g_max")) then - - allocate(int_arr(energy_groups * this % n_azi * this % n_pol)) - - call read_dataset(int_arr, scatt_grp, "g_max") - allocate(gmax(energy_groups, this % n_azi, this % n_pol)) - gmax = reshape(int_arr, (/energy_groups, this % n_azi, & - this % n_pol/)) - - deallocate(int_arr) - else - call fatal_error("'g_max' for the scatter_data must be provided") - end if - - ! Now use this information to find the length of a container array - ! to hold the flattened data - length = 0 - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - length = length + order_data * (gmax(gin, iazi, ipol) - & - gmin(gin, iazi, ipol) + 1) - end do - end do - end do - - ! Allocate flattened array - allocate(temp_1d(length)) - - if (.not. object_exists(scatt_grp, 'scatter_matrix')) & - call fatal_error("'scatter_matrix' must be provided") - call read_dataset(temp_1d, scatt_grp, "scatter_matrix") - - ! Compare the number of orders given with the maximum order of the - ! problem. Strip off the superfluous orders if needed. - if (this % scatter_format == ANGLE_LEGENDRE) then - order = min(order_data - 1, max_order) - order_dim = order + 1 - else - order_dim = order_data - end if - - ! Convert temp_1d to a jagged array ((gin) % data(l, gout)) for - ! passing to ScattData - allocate(input_scatt(energy_groups, this % n_azi, this % n_pol)) - - index = 1 - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - allocate(input_scatt(gin, iazi, ipol) % data(order_dim, & - gmin(gin, iazi, ipol):gmax(gin, iazi, ipol))) - do gout = gmin(gin, iazi, ipol), gmax(gin, iazi, ipol) - do l = 1, order_dim - input_scatt(gin, iazi, ipol) % data(l, gout) = & - temp_1d(index) - index = index + 1 - end do ! gout - ! Adjust index for the orders we didnt take - index = index + (order_data - order_dim) - end do ! order - end do ! gin - end do ! iazi - end do ! ipol - - deallocate(temp_1d) - - ! Finally convert the legendre to tabular if needed - allocate(scatt_coeffs(energy_groups, this % n_azi, this % n_pol)) - - if (this % scatter_format == ANGLE_LEGENDRE .and. & - legendre_to_tabular) then - - this % scatter_format = ANGLE_TABULAR - order_dim = legendre_to_tabular_points - order = order_dim - dmu = TWO / real(order - 1, 8) - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - allocate(scatt_coeffs(gin, iazi, ipol) % data(& - order_dim, & - gmin(gin, iazi, ipol):gmax(gin, iazi, ipol))) - - do gout = gmin(gin, iazi, ipol), gmax(gin, iazi, ipol) - norm = ZERO - do imu = 1, order_dim - if (imu == 1) then - mu = -ONE - else if (imu == order_dim) then - mu = ONE - else - mu = -ONE + real(imu - 1, 8) * dmu - end if - - scatt_coeffs(gin, iazi, ipol) % data(imu, gout) = & - evaluate_legendre(& - input_scatt(gin, iazi, ipol) % data(:, gout), mu) - - ! Ensure positivity of distribution - if (scatt_coeffs(gin, iazi, ipol) % data(imu, gout) < ZERO) & - scatt_coeffs(gin, iazi, ipol) % data(imu, gout) = ZERO - - ! And accrue the integral - if (imu > 1) then - norm = norm + HALF * dmu * & - (scatt_coeffs(gin, iazi, ipol) % data(imu - 1, gout) + & - scatt_coeffs(gin, iazi, ipol) % data(imu, gout)) - end if - end do ! mu - - ! Now that we have the integral, lets ensure that the distribution - ! is normalized such that it preserves the original scattering xs - if (norm > ZERO) then - scatt_coeffs(gin, iazi, ipol) % data(:, gout) = & - scatt_coeffs(gin, iazi, ipol) % data(:, gout) * & - input_scatt(gin, iazi, ipol) % data(1, gout) / & - norm - end if - end do ! gout - end do ! gin - end do ! iazi - end do ! ipol - else - ! Sticking with current representation, carry forward - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - allocate(scatt_coeffs(gin, iazi, ipol) % data(order_dim, & - gmin(gin, iazi, ipol):gmax(gin, iazi, ipol))) - scatt_coeffs(gin, iazi, ipol) % data(:, :) = & - input_scatt(gin, iazi, ipol) % data(1:order_dim, :) - end do - end do - end do - end if - - deallocate(input_scatt) - - ! Now get the multiplication matrix - if (object_exists(scatt_grp, 'multiplicity_matrix')) then - - ! Now use this information to find the length of a container array - ! to hold the flattened data - length = 0 - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - length = length + (gmax(gin, iazi, ipol) - gmin(gin, iazi, ipol) + 1) - end do - end do - end do - - ! Allocate flattened array - allocate(temp_1d(length)) - call read_dataset(temp_1d, scatt_grp, "multiplicity_matrix") - - ! Convert temp_1d to a jagged array ((gin) % data(gout)) for passing - ! to ScattData - allocate(temp_mult(energy_groups, this % n_azi, this % n_pol)) - - index = 1 - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - allocate(temp_mult(gin, iazi, ipol) % data( & - gmin(gin, iazi, ipol):gmax(gin, iazi, ipol))) - do gout = gmin(gin, iazi, ipol), gmax(gin, iazi, ipol) - temp_mult(gin, iazi, ipol) % data(gout) = temp_1d(index) - index = index + 1 - end do - end do - end do - end do - deallocate(temp_1d) - else - - allocate(temp_mult(energy_groups, this % n_azi, this % n_pol)) - - ! Default to multiplicities of 1.0 - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - allocate(temp_mult(gin, iazi, ipol) % data( & - gmin(gin, iazi, ipol):gmax(gin, iazi, ipol))) - temp_mult(gin, iazi, ipol) % data = ONE - end do - end do - end do - end if - - ! Allocate and initialize our ScattData Object. - allocate(xs % scatter(this % n_azi, this % n_pol)) - - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - - ! Allocate and initialize our ScattData Object. - if (this % scatter_format == ANGLE_HISTOGRAM) then - allocate(ScattDataHistogram :: xs % scatter(iazi, ipol) % obj) - else if (this % scatter_format == ANGLE_TABULAR) then - allocate(ScattDataTabular :: xs % scatter(iazi, ipol) % obj) - else if (this % scatter_format == ANGLE_LEGENDRE) then - allocate(ScattDataLegendre :: xs % scatter(iazi, ipol) % obj) - end if - - ! Initialize the ScattData Object - call xs % scatter(iazi, ipol) % obj % init(gmin(:, iazi, ipol), & - gmax(:, iazi, ipol), temp_mult(:, iazi, ipol), & - scatt_coeffs(:, iazi, ipol)) - end do - end do - - ! Check sigA to ensure it is not 0 since it is - ! often divided by in the tally routines - ! (This may happen with Helium data) - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - if (xs % absorption(gin, iazi, ipol) == ZERO) then - xs % absorption(gin, iazi, ipol) = 1E-10_8 - end if - end do - end do - end do - - if (object_exists(xsdata_grp, "total")) then - - allocate(temp_1d(energy_groups * this % n_azi * this % n_pol)) - call read_dataset(temp_1d, xsdata_grp, "total") - xs % total = reshape(temp_1d, (/energy_groups, this % n_azi, & - this % n_pol/)) - - deallocate(temp_1d) - else - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - xs % total(:, iazi, ipol) = xs % absorption(:, iazi, ipol) + & - xs % scatter(iazi, ipol) % obj % scattxs(:) - end do - end do - end if - - ! Check sigT to ensure it is not 0 since it is often divided by in - ! the tally routines - do ipol = 1, this % n_pol - do iazi = 1, this % n_azi - do gin = 1, energy_groups - if (xs % total(gin, iazi, ipol) == ZERO) then - xs % total(gin, iazi, ipol) = 1E-10_8 - end if - end do - end do - end do - - ! Close the groups we have opened and deallocate - call close_group(xsdata_grp) - call close_group(scatt_grp) - deallocate(scatt_coeffs, temp_mult) - - end associate ! xs - end do ! Temperatures - end subroutine mgxsang_from_hdf5 - -!=============================================================================== -! MGXS*_COMBINE Builds a macroscopic Mgxs object from microscopic Mgxs objects -!=============================================================================== - - subroutine mgxs_combine(this, temps, mat, nuclides, max_order, & - scatter_format, order_dim) - class(Mgxs), intent(inout) :: this ! The Mgxs to initialize - type(VectorReal), intent(in) :: temps ! Temperatures to obtain - type(Material), pointer, intent(in) :: mat ! base material - type(MgxsContainer), intent(in) :: nuclides(:) ! List of nuclides to harvest from - integer, intent(in) :: max_order ! Maximum requested order - integer, intent(out) :: scatter_format ! Type of scatter - integer, intent(out) :: order_dim ! Scattering data order size - - integer :: t, mat_max_order, order - - ! Fill in meta-data from material information - if (mat % name == "") then - this % name = trim(to_str(mat % id)) - else - this % name = trim(mat % name) - end if - - ! Set whether this material is fissionable - this % fissionable = mat % fissionable - - ! The following info we should initialize, but we dont need it nor - ! does it have guaranteed meaning. - this % awr = -ONE - - allocate(this % kTs(temps % size())) - - do t = 1, temps % size() - this % kTs(t) = temps % data(t) - end do - - ! Allocate the XS object for the number of temperatures - select type(this) - type is (MgxsIso) - allocate(this % xs(temps % size())) - type is (MgxsAngle) - allocate(this % xs(temps % size())) - end select - - ! Determine the scattering type of our data and ensure all scattering orders - ! are the same. - scatter_format = nuclides(mat % nuclide(1)) % obj % scatter_format - - select type(nuc => nuclides(mat % nuclide(1)) % obj) - type is (MgxsIso) - order = size(nuc % xs(1) % scatter % dist(1) % data, dim=1) - type is (MgxsAngle) - order = size(nuc % xs(1) % scatter(1, 1) % obj % dist(1) % data, dim=1) - end select - - ! If we have tabular only data, then make sure all datasets have same size - if (scatter_format == ANGLE_HISTOGRAM) then - ! Check all scattering data to ensure it is the same size - do i = 2, mat % n_nuclides - select type(nuc => nuclides(mat % nuclide(i)) % obj) - type is (MgxsIso) - if (order /= size(nuc % xs(1) % scatter % dist(1) % data, dim=1)) & - call fatal_error("All histogram scattering entries must be& - & same length!") - type is (MgxsAngle) - if (order /= size(nuc % xs(1) % scatter(1, 1) % obj % dist(1) % data, dim=1)) & - call fatal_error("All histogram scattering entries must be& - & same length!") - end select - end do - - ! Ok, got our order, store the dimensionality - order_dim = order - - else if (scatter_format == ANGLE_TABULAR) then - ! Check all scattering data to ensure it is the same size - do i = 2, mat % n_nuclides - select type(nuc => nuclides(mat % nuclide(i)) % obj) - type is (MgxsIso) - if (order /= size(nuc % xs(1) % scatter % dist(1) % data, dim=1)) & - call fatal_error("All tabular scattering entries must be& - & same length!") - type is (MgxsAngle) - if (order /= size(nuc % xs(1) % scatter(1, 1) % obj % dist(1) % data, dim=1)) & - call fatal_error("All tabular scattering entries must be& - & same length!") - end select - end do - - ! Ok, got our order, store the dimensionality - order_dim = order - - else if (scatter_format == ANGLE_LEGENDRE) then - - ! Need to determine the maximum scattering order of all data in this material - mat_max_order = 0 - - do i = 1, mat % n_nuclides - select type(nuc => nuclides(mat % nuclide(i)) % obj) - type is (MgxsIso) - if (size(nuc % xs(1) % scatter % dist(1) % data, & - dim=1) > mat_max_order) & - mat_max_order = size(nuc % xs(1) % scatter % dist(1) % data, & - dim=1) - type is (MgxsAngle) - if (size(nuc % xs(1) % scatter(1, 1) % obj % dist(1) % data, & - dim=1) > mat_max_order) & - mat_max_order = & - size(nuc % xs(1) % scatter(1, 1) % obj % dist(1) % data, & - dim=1) - end select - end do - - ! Now need to compare this material maximum scattering order with - ! the problem wide max scatt order and use whichever is lower - order = min(mat_max_order, max_order + 1) - - ! Ok, got our order, store the dimensionality - order_dim = order - end if - - end subroutine mgxs_combine - - subroutine mgxsiso_combine(this, temps, mat, nuclides, energy_groups, & - delayed_groups, max_order, tolerance, method) - class(MgxsIso), intent(inout) :: this ! The Mgxs to initialize - type(VectorReal), intent(in) :: temps ! Temperatures to obtain [MeV] - type(Material), pointer, intent(in) :: mat ! base material - type(MgxsContainer), intent(in) :: nuclides(:) ! List of nuclides to harvest from - integer, intent(in) :: energy_groups ! Number of energy groups - integer, intent(in) :: delayed_groups ! Number of delayed groups - integer, intent(in) :: max_order ! Maximum requested order - real(8), intent(in) :: tolerance ! Tolerance on method - integer, intent(in) :: method ! Type of temperature access - - integer :: i ! loop index over nuclides - integer :: t ! Index in to temps - integer :: gin, gout ! group indices - integer :: dg ! delayed group index - real(8) :: atom_density ! atom density of a nuclide - real(8) :: norm, nuscatt - integer :: order_dim, nuc_order_dim - real(8), allocatable :: temp_mult(:, :), mult_num(:, :), mult_denom(:, :) - real(8), allocatable :: scatt_coeffs(:, :, :) - integer :: nuc_t - integer, allocatable :: nuc_ts(:) - real(8) :: temp_actual, temp_desired, interp - integer :: scatter_format - type(Jagged2D), allocatable :: nuc_matrix(:) - integer, allocatable :: gmin(:), gmax(:) - type(Jagged2D), allocatable :: jagged_scatt(:) - type(Jagged1D), allocatable :: jagged_mult(:) - - ! Set the meta-data - call mgxs_combine(this, temps, mat, nuclides, max_order, scatter_format, & - order_dim) - - ! Set the number of delayed groups - this % num_delayed_groups = delayed_groups - - ! Create the Xs Data for each temperature - TEMP_LOOP: do t = 1, temps % size() - - ! Allocate and initialize the data needed for macro_xs(i_mat) object - allocate(this % xs(t) % total(energy_groups)) - this % xs(t) % total(:) = ZERO - - allocate(this % xs(t) % absorption(energy_groups)) - this % xs(t) % absorption(:) = ZERO - - allocate(this % xs(t) % fission(energy_groups)) - this % xs(t) % fission(:) = ZERO - - allocate(this % xs(t) % kappa_fission(energy_groups)) - this % xs(t) % kappa_fission(:) = ZERO - - allocate(this % xs(t) % prompt_nu_fission(energy_groups)) - this % xs(t) % prompt_nu_fission(:) = ZERO - - allocate(this % xs(t) % delayed_nu_fission(delayed_groups, & - energy_groups)) - this % xs(t) % delayed_nu_fission(:, :) = ZERO - - allocate(this % xs(t) % chi_prompt(energy_groups, energy_groups)) - this % xs(t) % chi_prompt(:, :) = ZERO - - allocate(this % xs(t) % chi_delayed(delayed_groups, energy_groups, & - energy_groups)) - this % xs(t) % chi_delayed(:, :, :) = ZERO - - allocate(this % xs(t) % inverse_velocity(energy_groups)) - this % xs(t) % inverse_velocity(:) = ZERO - - allocate(this % xs(t) % decay_rate(delayed_groups)) - this % xs(t) % decay_rate(:) = ZERO - - allocate(temp_mult(energy_groups, energy_groups)) - temp_mult(:, :) = ZERO - - allocate(mult_num(energy_groups, energy_groups)) - mult_num(:, :) = ZERO - - allocate(mult_denom(energy_groups, energy_groups)) - mult_denom(:, :) = ZERO - - allocate(scatt_coeffs(order_dim, energy_groups, energy_groups)) - scatt_coeffs(:, :, :) = ZERO - - this % scatter_format = scatter_format - - if (scatter_format == ANGLE_LEGENDRE) then - allocate(ScattDataLegendre :: this % xs(t) % scatter) - else if (scatter_format == ANGLE_TABULAR) then - allocate(ScattDataTabular :: this % xs(t) % scatter) - else if (scatter_format == ANGLE_HISTOGRAM) then - allocate(ScattDataHistogram :: this % xs(t) % scatter) - end if - - ! Add contribution from each nuclide in material - NUC_LOOP: do i = 1, mat % n_nuclides - associate(nuc => nuclides(mat % nuclide(i)) % obj) - - ! Copy atom density of nuclide in material - atom_density = mat % atom_density(i) - - select case (method) - case (TEMPERATURE_NEAREST) - - ! Determine actual temperatures to read - temp_desired = temps % data(i) - allocate(nuc_ts(1)) - - nuc_ts(1) = minloc(abs(nuc % kTs - temp_desired), dim=1) - temp_actual = nuc % kTs(nuc_ts(1)) - - if (abs(temp_actual - temp_desired) >= K_BOLTZMANN * tolerance) then - call fatal_error("MGXS library does not contain cross sections & - &for " // trim(this % name) // " at or near " // & - trim(to_str(nint(temp_desired / K_BOLTZMANN))) // " K.") - end if - - case (TEMPERATURE_INTERPOLATION) - - ! If temperature interpolation or multipole is selected, get a - ! list of bounding temperatures for each actual temperature - ! present in the model - temp_desired = temps % data(i) - allocate(nuc_ts(2)) - - do j = 1, size(nuc % kTs) - 1 - if (nuc % kTs(j) <= temp_desired .and. & - temp_desired < nuc % kTs(j + 1)) then - nuc_ts(1) = j - nuc_ts(2) = j + 1 - end if - end do - - call fatal_error("Nuclear data library does not contain cross sections & - &for " // trim(this % name) // " at temperatures that bound " // & - trim(to_str(nint(temp_desired / K_BOLTZMANN))) // " K.") - end select - - select type(nuc) - type is (MgxsIso) - do j = 1, size(nuc_ts) - - nuc_t = nuc_ts(j) - - if (size(nuc_ts) == 1) then - interp = ONE - else if (j == 1) then - interp = (ONE - (temp_desired - nuc % kTs(nuc_ts(1))) / & - (nuc % kTs(nuc_ts(2)) - nuc % kTs(nuc_ts(1)))) - else - interp = ONE - interp - end if - - ! Perform our operations which depend upon the type - ! Add contributions to total, absorption, and fission data (if necessary) - this % xs(t) % total = this % xs(t) % total + & - atom_density * nuc % xs(nuc_t) % total * interp - - this % xs(t) % absorption = this % xs(t) % absorption + & - atom_density * nuc % xs(nuc_t) % absorption * interp - - this % xs(t) % decay_rate = this % xs(t) % decay_rate + & - atom_density * nuc % xs(nuc_t) % decay_rate * interp - - this % xs(t) % inverse_velocity = & - this % xs(t) % inverse_velocity + & - atom_density * nuc % xs(nuc_t) % inverse_velocity * interp - - if (nuc % fissionable) then - - this % xs(t) % chi_prompt = this % xs(t) % chi_prompt + & - atom_density * nuc % xs(nuc_t) % chi_prompt * interp - - this % xs(t) % chi_delayed = this % xs(t) % chi_delayed + & - atom_density * nuc % xs(nuc_t) % chi_delayed * interp - - this % xs(t) % prompt_nu_fission = this % xs(t) % & - prompt_nu_fission + atom_density * nuc % xs(nuc_t) % & - prompt_nu_fission * interp - - this % xs(t) % delayed_nu_fission = this % xs(t) % & - delayed_nu_fission + atom_density * nuc % xs(nuc_t) % & - delayed_nu_fission * interp - - this % xs(t) % fission = this % xs(t) % fission + & - atom_density * nuc % xs(nuc_t) % fission * interp - - this % xs(t) % kappa_fission = this % xs(t) % kappa_fission +& - atom_density * nuc % xs(nuc_t) % kappa_fission * interp - end if - - ! We will next gather the multiplicity and scattering matrices. - ! To avoid multiple re-allocations as we resize the storage - ! matrix (and/or to avoidlots of duplicate code), we will use a - ! dense matrix for this storage, with a reduction to the sparse - ! format at the end. - - ! Get the multiplicity_matrix - ! To combine from nuclidic data we need to use the final relationship - ! mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / - ! sum_i(N_i*(nuscatt_{i,g,g'} / mult_{i,g,g'})) - ! Developed as follows: - ! mult_{gg'} = nuScatt{g,g'} / Scatt{g,g'} - ! mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / sum(N_i*scatt_{i,g,g'}) - ! mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / - ! sum_i(N_i*(nuscatt_{i,g,g'} / mult_{i,g,g'})) - ! nuscatt_{i,g,g'} can be reconstructed from scatter % energy and - ! scatter % scattxs - do gin = 1, energy_groups - do gout = nuc % xs(nuc_t) % scatter % gmin(gin), nuc % xs(nuc_t) % scatter % gmax(gin) - - nuscatt = nuc % xs(nuc_t) % scatter % scattxs(gin) * & - nuc % xs(nuc_t) % scatter % energy(gin) % data(gout) - - mult_num(gout, gin) = mult_num(gout, gin) + atom_density * & - nuscatt * interp - - if (nuc % xs(nuc_t) % scatter % mult(gin) % data(gout) > ZERO) then - mult_denom(gout, gin) = mult_denom(gout,gin) + atom_density * & - nuscatt / nuc % xs(nuc_t) % scatter % mult(gin) % data(gout) * & - interp - else - ! Avoid division by zero - mult_denom(gout, gin) = mult_denom(gout,gin) + atom_density * & - interp - end if - end do - end do - - ! Get the complete scattering matrix - nuc_order_dim = size(nuc % xs(nuc_t) % scatter % dist(1) % data, dim=1) - nuc_order_dim = min(nuc_order_dim, order_dim) - - call nuc % xs(nuc_t) % scatter % get_matrix(nuc_order_dim, & - nuc_matrix) - - do gin = 1, energy_groups - do gout = nuc % xs(nuc_t) % scatter % gmin(gin), & - nuc % xs(nuc_t) % scatter % gmax(gin) - scatt_coeffs(1:nuc_order_dim, gout, gin) = & - scatt_coeffs(1: nuc_order_dim, gout, gin) + & - atom_density * interp * & - nuc_matrix(gin) % data(1:nuc_order_dim, gout) - end do - end do - end do - - type is (MgxsAngle) - call fatal_error("Invalid passing of MgxsAngle to MgxsIso object") - end select - - ! Obtain temp_mult - do gin = 1, energy_groups - do gout = 1, energy_groups - if (mult_denom(gout, gin) > ZERO) then - temp_mult(gout, gin) = mult_num(gout, gin) / mult_denom(gout, gin) - else - temp_mult(gout, gin) = ONE - end if - end do - end do - - ! Now create our jagged data from the dense data - call jagged_from_dense_2D(scatt_coeffs, jagged_scatt, gmin, gmax) - call jagged_from_dense_1D(temp_mult, jagged_mult) - - ! Initialize the ScattData Object - call this % xs(t) % scatter % init(gmin, gmax, jagged_mult, & - jagged_scatt) - - ! Now normalize chi - if (mat % fissionable) then - do gin = 1, energy_groups - norm = sum(this % xs(t) % chi_prompt(:, gin)) - if (norm > ZERO) then - this % xs(t) % chi_prompt(:, gin) = & - this % xs(t) % chi_prompt(:, gin) / norm - end if - end do - - do dg = 1, delayed_groups - do gin = 1, energy_groups - norm = sum(this % xs(t) % chi_delayed(dg, :, gin)) - if (norm > ZERO) then - this % xs(t) % chi_delayed(dg, :, gin) = & - this % xs(t) % chi_delayed(dg, :, gin) / norm - end if - end do - end do - end if - - ! Deallocate temporaries - deallocate(jagged_mult, jagged_scatt, gmin, gmax, scatt_coeffs, & - temp_mult, mult_num, mult_denom) - end associate ! nuc - end do NUC_LOOP - end do TEMP_LOOP - - end subroutine mgxsiso_combine - - subroutine mgxsang_combine(this, temps, mat, nuclides, energy_groups, & - delayed_groups, max_order, tolerance, method) - class(MgxsAngle), intent(inout) :: this ! The Mgxs to initialize - type(VectorReal), intent(in) :: temps ! Temperatures to obtain - type(Material), pointer, intent(in) :: mat ! base material - type(MgxsContainer), intent(in) :: nuclides(:) ! List of nuclides to harvest from - integer, intent(in) :: energy_groups ! Number of energy groups - integer, intent(in) :: delayed_groups ! Number of delayed groups - integer, intent(in) :: max_order ! Maximum requested order - real(8), intent(in) :: tolerance ! Tolerance on method - integer, intent(in) :: method ! Type of temperature access - - integer :: i ! loop index over nuclides - integer :: t ! temperature loop index - integer :: gin, gout ! group indices - integer :: dg ! delayed group index - real(8) :: atom_density ! atom density of a nuclide - integer :: ipol, iazi, n_pol, n_azi - real(8) :: norm, nuscatt - integer :: order_dim, nuc_order_dim - real(8), allocatable :: temp_mult(:, :, :, :), mult_num(:, :, :, :) - real(8), allocatable :: mult_denom(:, :, :, :), scatt_coeffs(:, :, :, :, :) - integer :: nuc_t - integer, allocatable :: nuc_ts(:) - real(8) :: temp_actual, temp_desired, interp - integer :: scatter_format - type(Jagged2D), allocatable :: nuc_matrix(:) - integer, allocatable :: gmin(:), gmax(:) - type(Jagged2D), allocatable :: jagged_scatt(:) - type(Jagged1D), allocatable :: jagged_mult(:) - - ! Set the meta-data - call mgxs_combine(this, temps, mat, nuclides, max_order, scatter_format, & - order_dim) - - ! Set the number of delayed groups - this % num_delayed_groups = delayed_groups - - ! Get the number of each polar and azi angles and make sure all the - ! NuclideAngle types have the same number of these angles - n_pol = -1 - n_azi = -1 - - do i = 1, mat % n_nuclides - select type(nuc => nuclides(mat % nuclide(i)) % obj) - type is (MgxsAngle) - - if (n_pol == -1) then - n_pol = nuc % n_pol - n_azi = nuc % n_azi - - allocate(this % polar(n_pol)) - this % polar(:) = nuc % polar(:) - - allocate(this % azimuthal(n_azi)) - this % azimuthal(:) = nuc % azimuthal(:) - else - if ((n_pol /= nuc % n_pol) .or. (n_azi /= nuc % n_azi)) then - call fatal_error("All angular data must be same length!") - end if - end if - end select - end do - - ! Create the Xs Data for each temperature - TEMP_LOOP: do t = 1, temps % size() - - ! Allocate and initialize the data needed for macro_xs(i_mat) object - allocate(this % xs(t) % total(energy_groups, n_azi, n_pol)) - this % xs(t) % total = ZERO - - allocate(this % xs(t) % absorption(energy_groups, n_azi, n_pol)) - this % xs(t) % absorption = ZERO - - allocate(this % xs(t) % fission(energy_groups, n_azi, n_pol)) - this % xs(t) % fission = ZERO - - allocate(this % xs(t) % decay_rate(delayed_groups, n_azi, n_pol)) - this % xs(t) % decay_rate = ZERO - - allocate(this % xs(t) % inverse_velocity(energy_groups, n_azi, n_pol)) - this % xs(t) % inverse_velocity = ZERO - - allocate(this % xs(t) % kappa_fission(energy_groups, n_azi, n_pol)) - this % xs(t) % kappa_fission = ZERO - - allocate(this % xs(t) % prompt_nu_fission(energy_groups, n_azi, n_pol)) - this % xs(t) % prompt_nu_fission = ZERO - - allocate(this % xs(t) % delayed_nu_fission(delayed_groups, & - energy_groups, n_azi, n_pol)) - this % xs(t) % delayed_nu_fission = ZERO - - allocate(this % xs(t) % chi_prompt(energy_groups, energy_groups, & - n_azi, n_pol)) - this % xs(t) % chi_prompt = ZERO - - allocate(this % xs(t) % chi_delayed(delayed_groups, energy_groups, & - energy_groups, n_azi, n_pol)) - this % xs(t) % chi_delayed = ZERO - - allocate(temp_mult(energy_groups, energy_groups, n_azi, n_pol)) - temp_mult = ZERO - - allocate(mult_num(energy_groups, energy_groups, n_azi, n_pol)) - mult_num = ZERO - - allocate(mult_denom(energy_groups, energy_groups, n_azi, n_pol)) - mult_denom = ZERO - - allocate(scatt_coeffs(order_dim, energy_groups, energy_groups, n_azi, n_pol)) - scatt_coeffs = ZERO - - allocate(this % xs(t) % scatter(n_azi, n_pol)) - - do ipol = 1, n_pol - do iazi = 1, n_azi - if (scatter_format == ANGLE_LEGENDRE) then - allocate(ScattDataLegendre :: & - this % xs(t) % scatter(iazi, ipol) % obj) - else if (scatter_format == ANGLE_TABULAR) then - allocate(ScattDataTabular :: & - this % xs(t) % scatter(iazi, ipol) % obj) - else if (scatter_format == ANGLE_HISTOGRAM) then - allocate(ScattDataHistogram :: & - this % xs(t) % scatter(iazi, ipol) % obj) - end if - end do - end do - - ! Add contribution from each nuclide in material - NUC_LOOP: do i = 1, mat % n_nuclides - associate(nuc => nuclides(mat % nuclide(i)) % obj) - - select case (method) - case (TEMPERATURE_NEAREST) - - ! Determine actual temperatures to read - temp_desired = temps % data(i) - allocate(nuc_ts(1)) - - nuc_ts(1) = minloc(abs(nuc % kTs - temp_desired), dim=1) - temp_actual = nuc % kTs(nuc_ts(1)) - - if (abs(temp_actual - temp_desired) >= K_BOLTZMANN * tolerance) then - call fatal_error("MGXS library does not contain cross sections & - &for " // trim(this % name) // " at or near " // & - trim(to_str(nint(temp_desired / K_BOLTZMANN))) // " K.") - end if - - case (TEMPERATURE_INTERPOLATION) - - ! If temperature interpolation or multipole is selected, get a - ! list of bounding temperatures for each actual temperature - ! present in the model - temp_desired = temps % data(i) - allocate(nuc_ts(2)) - - do j = 1, size(nuc % kTs) - 1 - if (nuc % kTs(j) <= temp_desired .and. & - temp_desired < nuc % kTs(j + 1)) then - nuc_ts(1) = j - nuc_ts(2) = j + 1 - end if - end do - - call fatal_error("Nuclear data library does not contain cross sections & - &for " // trim(this % name) // " at temperatures that bound " // & - trim(to_str(nint(temp_desired / K_BOLTZMANN))) // " K.") - end select - - ! Copy atom density of nuclide in material - atom_density = mat % atom_density(i) - - select type(nuc) - type is (MgxsAngle) - do j = 1, size(nuc_ts) - - nuc_t = nuc_ts(j) - - if (size(nuc_ts) == 1) then - interp = ONE - else if (j == 1) then - interp = (ONE - (temp_desired - nuc % kTs(nuc_ts(1))) / & - (nuc % kTs(nuc_ts(2)) - nuc % kTs(nuc_ts(1)))) - else - interp = ONE - interp - end if - - ! Perform our operations which depend upon the type - ! Add contributions to total, absorption, and fission data - ! (if necessary) - this % xs(t) % total = this % xs(t) % total + & - atom_density * nuc % xs(nuc_t) % total * interp - - this % xs(t) % absorption = this % xs(t) % absorption + & - atom_density * nuc % xs(nuc_t) % absorption * interp - - this % xs(t) % decay_rate = this % xs(t) % decay_rate + & - atom_density * nuc % xs(nuc_t) % decay_rate * interp - - this % xs(t) % inverse_velocity = & - this % xs(t) % inverse_velocity + & - atom_density * nuc % xs(nuc_t) % inverse_velocity * interp - - if (nuc % fissionable) then - - this % xs(t) % chi_prompt = this % xs(t) % chi_prompt + & - atom_density * nuc % xs(nuc_t) % chi_prompt * interp - - this % xs(t) % chi_delayed = this % xs(t) % chi_delayed + & - atom_density * nuc % xs(nuc_t) % chi_delayed * interp - - this % xs(t) % prompt_nu_fission = & - this % xs(t) % prompt_nu_fission + atom_density * & - nuc % xs(nuc_t) % prompt_nu_fission * interp - - this % xs(t) % delayed_nu_fission = & - this % xs(t) % delayed_nu_fission + atom_density * & - nuc % xs(nuc_t) % delayed_nu_fission * interp - - this % xs(t) % fission = this % xs(t) % fission + & - atom_density * nuc % xs(nuc_t) % fission * interp - - this % xs(t) % kappa_fission = this % xs(t) % kappa_fission & - + atom_density * nuc % xs(nuc_t) % kappa_fission * interp - - end if - - ! We will next gather the multiplicity and scattering matrices. - ! To avoid multiple re-allocations as we resize the storage - ! matrix (and/or to avoidlots of duplicate code), we will use a - ! dense matrix for this storage, with a reduction to the sparse - ! format at the end. - - ! Get the multiplicity_matrix - ! To combine from nuclidic data we need to use the final relationship - ! mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / - ! sum_i(N_i*(nuscatt_{i,g,g'} / mult_{i,g,g'})) - ! Developed as follows: - ! mult_{gg'} = nuScatt{g,g'} / Scatt{g,g'} - ! mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / sum(N_i*scatt_{i,g,g'}) - ! mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / - ! sum_i(N_i*(nuscatt_{i,g,g'} / mult_{i,g,g'})) - ! nuscatt_{i,g,g'} can be reconstructed from scatter % energy and - ! scatter % scattxs - do ipol = 1, n_pol - do iazi = 1, n_azi - do gin = 1, energy_groups - do gout = nuc % xs(nuc_t) % scatter(iazi, ipol) %obj % gmin(gin), & - nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % gmax(gin) - - nuscatt = nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % scattxs(gin) * & - nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % energy(gin) % data(gout) - - mult_num(gout, gin, iazi, ipol) = & - mult_num(gout, gin, iazi, ipol) + atom_density * & - nuscatt * interp - - if (nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % mult(gin) % data(gout) > ZERO) then - mult_denom(gout, gin, iazi, ipol) = & - mult_denom(gout, gin, iazi, ipol) + atom_density * & - interp * nuscatt / & - nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % mult(gin) % data(gout) - else - ! Avoid division by zero - mult_denom(gout, gin, iazi, ipol) = & - mult_denom(gout, gin, iazi, ipol) + atom_density * & - interp - end if - end do - end do - - ! Get the complete scattering matrix - nuc_order_dim = & - size(nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % & - dist(1) % data, dim=1) - nuc_order_dim = min(nuc_order_dim, order_dim) - - call nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % & - get_matrix(nuc_order_dim, nuc_matrix) - - do gin = 1, energy_groups - do gout = & - nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % gmin(gin), & - nuc % xs(nuc_t) % scatter(iazi, ipol) % obj % gmax(gin) - scatt_coeffs(1:nuc_order_dim, gout, gin, iazi, ipol) = & - scatt_coeffs(1: nuc_order_dim, gout, gin, iazi, ipol) + & - atom_density * interp * & - nuc_matrix(gin) % data(1:nuc_order_dim, gout) - end do ! gout - end do ! gin - end do ! iazi - end do ! ipol - end do - type is (MgxsIso) - call fatal_error("Invalid passing of MgxsIso to MgxsAngle object") - end select - - ! Obtain temp_mult, create jaged arrays and initialize the - ! ScattData object. - do ipol = 1, n_pol - do iazi = 1, n_azi - ! Obtain temp_mult - do gin = 1, energy_groups - do gout = 1, energy_groups - if (mult_denom(gout, gin, iazi, ipol) > ZERO) then - temp_mult(gout, gin, iazi, ipol) = & - mult_num(gout, gin, iazi, ipol) / & - mult_denom(gout, gin, iazi, ipol) - else - temp_mult(gout, gin, iazi, ipol) = ONE - end if - end do - end do - - ! Now create our jagged data from the dense data - call jagged_from_dense_2D(scatt_coeffs(:, :, :, iazi, ipol), & - jagged_scatt, gmin, gmax) - call jagged_from_dense_1D(temp_mult(:, :, iazi, ipol), & - jagged_mult) - - ! Initialize the ScattData Object - call this % xs(t) % scatter(iazi, ipol) % obj % init(gmin, & - gmax, jagged_mult, jagged_scatt) - deallocate(jagged_scatt, jagged_mult, gmin, gmax) - end do - end do - - ! Now normalize chi - if (mat % fissionable) then - do ipol = 1, n_pol - do iazi = 1, n_azi - do gin = 1, energy_groups - norm = sum(this % xs(t) % chi_prompt(:, gin, iazi, ipol)) - if (norm > ZERO) then - this % xs(t) % chi_prompt(:, gin, iazi, ipol) = & - this % xs(t) % chi_prompt(:, gin, iazi, ipol) / norm - end if - end do - end do - end do - - do dg = 1, delayed_groups - do ipol = 1, n_pol - do iazi = 1, n_azi - do gin = 1, energy_groups - norm = sum(this % xs(t) % chi_delayed(dg, :, gin, iazi, ipol)) - if (norm > ZERO) then - this % xs(t) % chi_delayed(dg, :, gin, iazi, ipol) = & - this % xs(t) % chi_delayed(dg, :, gin, iazi, ipol)& - / norm - end if - end do - end do - end do - end do - - end if - - ! Deallocate temporaries - deallocate(scatt_coeffs, temp_mult, mult_num, mult_denom) - end associate ! nuc - end do NUC_LOOP - - end do TEMP_LOOP - - end subroutine mgxsang_combine - -!=============================================================================== -! MGXS*_GET_XS returns the requested data cross section data -!=============================================================================== - - pure function mgxsiso_get_xs(this, xstype, gin, gout, uvw, mu, dg) result(xs) - class(MgxsIso), intent(in) :: this ! The Xs to get data from - character(*) , intent(in) :: xstype ! Type of xs requested - integer, intent(in) :: gin ! Incoming Energy group - integer, optional, intent(in) :: gout ! Outgoing Energy group - real(8), optional, intent(in) :: uvw(3) ! Requested Angle - real(8), optional, intent(in) :: mu ! Change in angle - integer, optional, intent(in) :: dg ! Delayed group - real(8) :: xs ! Requested x/s - integer :: t ! temperature index - - t = this % index_temp - - select case(xstype) - - case('total') - xs = this % xs(t) % total(gin) - - case('absorption') - xs = this % xs(t) % absorption(gin) - - case('fission') - xs = this % xs(t) % fission(gin) - - case('kappa-fission') - xs = this % xs(t) % kappa_fission(gin) - - case('inverse-velocity') - xs = this % xs(t) % inverse_velocity(gin) - - case('decay rate') - if (present(dg)) then - xs = this % xs(t) % decay_rate(dg) - else - xs = this % xs(t) % decay_rate(1) - end if - - case('prompt-nu-fission') - xs = this % xs(t) % prompt_nu_fission(gin) - - case('delayed-nu-fission') - if (present(dg)) then - xs = this % xs(t) % delayed_nu_fission(dg, gin) - else - xs = sum(this % xs(t) % delayed_nu_fission(:, gin)) - end if - - case('nu-fission') - xs = this % xs(t) % prompt_nu_fission(gin) + & - sum(this % xs(t) % delayed_nu_fission(:, gin)) - - case('chi-prompt') - if (present(gout)) then - xs = this % xs(t) % chi_prompt(gout,gin) - else - ! Not sure youd want a 1 or a 0, but here you go! - xs = sum(this % xs(t) % chi_prompt(:, gin)) - end if - - case('chi-delayed') - if (present(gout)) then - if (present(dg)) then - xs = this % xs(t) % chi_delayed(dg, gout, gin) - else - xs = this % xs(t) % chi_delayed(1, gout, gin) - end if - else - if (present(dg)) then - xs = sum(this % xs(t) % chi_delayed(dg, :, gin)) - else - xs = sum(this % xs(t) % chi_delayed(dg, :, gin)) - end if - end if - - case('scatter') - if (present(gout)) then - if (gout < this % xs(t) % scatter % gmin(gin) .or. & - gout > this % xs(t) % scatter % gmax(gin)) then - xs = ZERO - else - xs = this % xs(t) % scatter % scattxs(gin) * & - this % xs(t) % scatter % energy(gin) % data(gout) - end if - else - xs = this % xs(t) % scatter % scattxs(gin) - end if - - case('scatter/mult') - if (present(gout)) then - if (gout < this % xs(t) % scatter % gmin(gin) .or. & - gout > this % xs(t) % scatter % gmax(gin)) then - xs = ZERO - else - xs = this % xs(t) % scatter % scattxs(gin) * & - this % xs(t) % scatter % energy(gin) % data(gout) / & - this % xs(t) % scatter % mult(gin) % data(gout) - end if - else - xs = this % xs(t) % scatter % scattxs(gin) / & - (dot_product(this % xs(t) % scatter % mult(gin) % data, & - this % xs(t) % scatter % energy(gin) % data)) - end if - - case('scatter*f_mu/mult','scatter*f_mu') - if (present(gout)) then - if (gout < this % xs(t) % scatter % gmin(gin) .or. & - gout > this % xs(t) % scatter % gmax(gin)) then - xs = ZERO - else - xs = this % xs(t) % scatter % scattxs(gin) * & - this % xs(t) % scatter % energy(gin) % data(gout) * & - this % xs(t) % scatter % calc_f(gin, gout, mu) - if (xstype == 'scatter*f_mu/mult') then - xs = xs / this % xs(t) % scatter % mult(gin) % data(gout) - end if - end if - else - xs = ZERO - ! TODO (Not likely needed) - ! (asking for f_mu without asking for a group or mu would mean the - ! user of this code wants the complete 1-outgoing group distribution - ! which Im not sure what they would do with that. - end if - - case default - xs = ZERO - end select - - end function mgxsiso_get_xs - - pure function mgxsang_get_xs(this, xstype, gin, gout, uvw, mu, dg) result(xs) - class(MgxsAngle), intent(in) :: this ! The Mgxs to initialize - character(*) , intent(in) :: xstype ! Type of xs requested - integer, intent(in) :: gin ! Incoming Energy group - integer, optional, intent(in) :: gout ! Outgoing Energy group - real(8), optional, intent(in) :: uvw(3) ! Requested Angle - real(8), optional, intent(in) :: mu ! Change in angle - integer, optional, intent(in) :: dg ! Delayed group - real(8) :: xs ! Requested x/s - - integer :: iazi, ipol, t - - t = this % index_temp - - if (present(uvw)) then - - call find_angle(this % polar, this % azimuthal, uvw, iazi, ipol) - - select case(xstype) - - case('total') - xs = this % xs(t) % total(gin, iazi, ipol) - - case('absorption') - xs = this % xs(t) % absorption(gin, iazi, ipol) - - case('fission') - xs = this % xs(t) % fission(gin, iazi, ipol) - - case('kappa-fission') - xs = this % xs(t) % kappa_fission(gin, iazi, ipol) - - case('prompt-nu-fission') - xs = this % xs(t) % prompt_nu_fission(gin, iazi, ipol) - - case('delayed-nu-fission') - if (present(dg)) then - xs = this % xs(t) % delayed_nu_fission(dg, gin, iazi, ipol) - else - xs = sum(this % xs(t) % delayed_nu_fission(:, gin, iazi, ipol)) - end if - - case('nu-fission') - xs = this % xs(t) % prompt_nu_fission(gin, iazi, ipol) + & - sum(this % xs(t) % delayed_nu_fission(:, gin, iazi, ipol)) - - case('chi-prompt') - if (present(gout)) then - xs = this % xs(t) % chi_prompt(gout, gin, iazi, ipol) - else - ! Not sure you would want a 1 or a 0, but here you go! - xs = sum(this % xs(t) % chi_prompt(:, gin, iazi, ipol)) - end if - - case('chi-delayed') - if (present(gout)) then - if (present(dg)) then - xs = this % xs(t) % chi_delayed(dg, gout, gin, iazi, ipol) - else - xs = this % xs(t) % chi_delayed(1, gout, gin, iazi, ipol) - end if - else - if (present(dg)) then - xs = sum(this % xs(t) % chi_delayed(dg, :, gin, iazi, ipol)) - else - xs = sum(this % xs(t) % chi_delayed(1, :, gin, iazi, ipol)) - end if - end if - - case('decay rate') - if (present(dg)) then - xs = this % xs(t) % decay_rate(iazi, ipol, dg) - else - xs = this % xs(t) % decay_rate(iazi, ipol, 1) - end if - - case('inverse-velocity') - xs = this % xs(t) % inverse_velocity(gin, iazi, ipol) - - case('scatter') - if (present(gout)) then - if (gout < this % xs(t) % scatter(iazi, ipol) % obj % gmin(gin) .or. & - gout > this % xs(t) % scatter(iazi, ipol) % obj % gmax(gin)) then - xs = ZERO - else - xs = this % xs(t) % scatter(iazi, ipol) % obj % scattxs(gin) * & - this % xs(t) % scatter(iazi, ipol) % obj % energy(gin) % data(gout) - end if - else - xs = this % xs(t) % scatter(iazi, ipol) % obj % scattxs(gin) - end if - - case('scatter/mult') - if (present(gout)) then - if (gout < this % xs(t) % scatter(iazi, ipol) % obj % gmin(gin) .or. & - gout > this % xs(t) % scatter(iazi, ipol) % obj % gmax(gin)) then - xs = ZERO - else - xs = this % xs(t) % scatter(iazi, ipol) % obj % scattxs(gin) * & - this % xs(t) % scatter(iazi, ipol) % obj % energy(gin) % data(gout) / & - this % xs(t) % scatter(iazi, ipol) % obj % mult(gin) % data(gout) - end if - else - xs = this % xs(t) % scatter(iazi, ipol) % obj % scattxs(gin) / & - (dot_product(this % xs(t) % scatter(iazi, ipol) % obj % mult(gin) % data, & - this % xs(t) % scatter(iazi, ipol) % obj % energy(gin) % data)) - end if - - case('scatter*f_mu/mult','scatter*f_mu') - if (present(gout)) then - if (gout < this % xs(t) % scatter(iazi, ipol) % obj % gmin(gin) .or. & - gout > this % xs(t) % scatter(iazi, ipol) % obj % gmax(gin)) then - xs = ZERO - else - xs = this % xs(t) % scatter(iazi, ipol) % obj % scattxs(gin) * & - this % xs(t) % scatter(iazi, ipol) % obj % energy(gin) % data(gout) - xs = xs * this % xs(t) % scatter(iazi, ipol) % obj % calc_f(gin, gout, mu) - if (xstype == 'scatter*f_mu/mult') then - xs = xs / & - this % xs(t) % scatter(iazi, ipol) % obj % mult(gin) % data(gout) - end if - end if - else - xs = ZERO - ! TODO (Not likely needed) - ! (asking for f_mu without asking for a group or mu would mean the - ! user of this code wants the complete 1-outgoing group distribution - ! which Im not sure what they would do with that. - end if - - case default - xs = ZERO - - end select - - else - xs = ZERO - end if - - end function mgxsang_get_xs - -!=============================================================================== -! MGXS*_SAMPLE_FISSION_ENERGY samples the outgoing energy from a fission event -!=============================================================================== - - subroutine mgxsiso_sample_fission_energy(this, gin, uvw, dg, gout) - - class(MgxsIso), intent(in) :: this ! Data to work with - integer, intent(in) :: gin ! Incoming energy group - real(8), intent(in) :: uvw(3) ! Particle Direction - integer, intent(out) :: dg ! Delayed group - integer, intent(out) :: gout ! Sampled outgoing group - real(8) :: xi_pd ! Our random number for prompt/delayed - real(8) :: xi_gout ! Our random number for gout - real(8) :: prob_gout ! Running probability for gout - - ! Get nu and nu_prompt - real(8) :: prob_prompt - - prob_prompt = this % get_xs('prompt-nu-fission', gin) / & - this % get_xs('nu-fission', gin) - - ! Sample random numbers - xi_pd = prn() - xi_gout = prn() - - ! Neutron is born prompt - if (xi_pd <= prob_prompt) then - - ! set the delayed group for the particle born from fission to 0 - dg = 0 - - gout = 1 - prob_gout = this % get_xs('chi-prompt', gin, gout) - - do while (prob_gout < xi_gout) - gout = gout + 1 - prob_gout = prob_gout + this % get_xs('chi-prompt', gin, gout) - end do - - ! Neutron is born delayed - else - - ! Get the delayed group - dg = 0 - - do while (xi_pd >= prob_prompt) - dg = dg + 1 - prob_prompt = prob_prompt + & - this % get_xs('delayed-nu-fission', gin, dg=dg) & - / this % get_xs('nu-fission', gin) - end do - - ! Adjust dg in case of round off error - dg = min(dg, this % num_delayed_groups) - - ! Get the outgoing group - gout = 1 - prob_gout = this % get_xs('chi-delayed', gin, gout, dg=dg) - - do while (prob_gout < xi_gout) - gout = gout + 1 - prob_gout = prob_gout + this % get_xs('chi-delayed', gin, gout, dg=dg) - end do - end if - - end subroutine mgxsiso_sample_fission_energy - - subroutine mgxsang_sample_fission_energy(this, gin, uvw, dg, gout) - class(MgxsAngle), intent(in) :: this ! Data to work with - integer, intent(in) :: gin ! Incoming energy group - real(8), intent(in) :: uvw(3) ! Direction vector - integer, intent(out) :: dg ! Delayed group - integer, intent(out) :: gout ! Sampled outgoing group - real(8) :: xi_pd ! Our random number for prompt/delayed - real(8) :: xi_gout ! Our random number for gout - real(8) :: prob_gout ! Running probability for gout - real(8) :: prob_prompt - - ! Get nu and nu_prompt - prob_prompt = this % get_xs('prompt-nu-fission', gin, uvw=uvw) / & - this % get_xs('nu-fission', gin, uvw=uvw) - - ! Sample random numbers - xi_pd = prn() - xi_gout = prn() - - ! Neutron is born prompt - if (xi_pd <= prob_prompt) then - - ! set the delayed group for the particle born from fission to 0 - dg = 0 - - gout = 1 - prob_gout = this % get_xs('chi-prompt', gin, gout, uvw=uvw) - - do while (prob_gout < xi_gout) - gout = gout + 1 - prob_gout = prob_gout + & - this % get_xs('chi-prompt', gin, gout, uvw=uvw) - end do - - ! Neutron is born delayed - else - - ! Get the delayed group - dg = 0 - - do while (xi_pd >= prob_prompt) - dg = dg + 1 - prob_prompt = prob_prompt + & - this % get_xs('delayed-nu-fission', gin, uvw=uvw, dg=dg) / & - this % get_xs('nu-fission', gin, uvw=uvw) - end do - - ! Adjust dg in case of round off error - dg = min(dg, this % num_delayed_groups) - - ! Get the outgoing group - gout = 1 - prob_gout = this % get_xs('chi-delayed', gin, gout, uvw=uvw, dg=dg) - - do while (prob_gout < xi_gout) - gout = gout + 1 - prob_gout = prob_gout + & - this % get_xs('chi-delayed', gin, gout, uvw=uvw, dg=dg) - end do - end if - - end subroutine mgxsang_sample_fission_energy - -!=============================================================================== -! MGXS*_SAMPLE_SCATTER Selects outgoing energy and angle after a scatter event -!=============================================================================== - - subroutine mgxsiso_sample_scatter(this, uvw, gin, gout, mu, wgt) - class(MgxsIso), 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 % xs(this % index_temp) % scatter % sample(gin, gout, mu, wgt) - - end subroutine mgxsiso_sample_scatter - - subroutine mgxsang_sample_scatter(this, uvw, gin, gout, mu, wgt) - class(MgxsAngle), 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 % xs(this % index_temp) % scatter(iazi, ipol) % obj % sample( & - gin, gout, mu, wgt) - - end subroutine mgxsang_sample_scatter - -!=============================================================================== -! MGXS*_CALCULATE_XS determines the multi-group cross sections -! for the material the particle is currently traveling through. -!=============================================================================== - - subroutine mgxsiso_calculate_xs(this, gin, sqrtkT, uvw, xs) - class(MgxsIso), intent(inout) :: this - integer, intent(in) :: gin ! Incoming neutron group - real(8), intent(in) :: sqrtkT ! Material temperature - real(8), intent(in) :: uvw(3) ! Incoming neutron direction - type(MaterialMacroXS), intent(inout) :: xs ! Resultant Mgxs Data - - ! Update the temperature index - call this % find_temperature(sqrtkT) - - xs % total = this % xs(this % index_temp) % total(gin) - xs % absorption = this % xs(this % index_temp) % absorption(gin) - xs % nu_fission = & - this % xs(this % index_temp) % prompt_nu_fission(gin) + & - sum(this % xs(this % index_temp) % delayed_nu_fission(:, gin)) - - end subroutine mgxsiso_calculate_xs - - subroutine mgxsang_calculate_xs(this, gin, sqrtkT, uvw, xs) - class(MgxsAngle), intent(inout) :: this - integer, intent(in) :: gin ! Incoming neutron group - real(8), intent(in) :: sqrtkT ! Material temperature - real(8), intent(in) :: uvw(3) ! Incoming neutron direction - type(MaterialMacroXS), intent(inout) :: xs ! Resultant Mgxs Data - - integer :: iazi, ipol - - ! Update the temperature and angle indices - call this % find_temperature(sqrtkT) - call find_angle(this % polar, this % azimuthal, uvw, iazi, ipol) - - xs % total = this % xs(this % index_temp) % & - total(gin, iazi, ipol) - xs % absorption = this % xs(this % index_temp) % & - absorption(gin, iazi, ipol) - xs % nu_fission = this % xs(this % index_temp) % & - prompt_nu_fission(gin, iazi, ipol) + & - sum(this % xs(this % index_temp) % & - delayed_nu_fission(:, gin, iazi, ipol)) - - end subroutine mgxsang_calculate_xs - -!=============================================================================== -! MGXS_FIND_TEMPERATURE sets the temperature index for the given -! sqrt(temperature), (with temperature in units of eV) -!=============================================================================== - - subroutine mgxs_find_temperature(this, sqrtkT) - class(Mgxs), intent(inout) :: this - real(8), intent(in) :: sqrtkT ! Temperature (in units of eV) - - this % index_temp = minloc(abs(this % kTs - (sqrtkT * sqrtkT)), dim=1) - - end subroutine mgxs_find_temperature - -!=============================================================================== -! 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 - -!=============================================================================== -! FREE_MEMORY_MGXS deallocates global arrays defined in this module -!=============================================================================== - - subroutine free_memory_mgxs() - if (allocated(nuclides_MG)) deallocate(nuclides_MG) - if (allocated(macro_xs)) deallocate(macro_xs) - if (allocated(energy_bins)) deallocate(energy_bins) - if (allocated(energy_bin_avg)) deallocate(energy_bin_avg) - end subroutine free_memory_mgxs - -end module mgxs_header diff --git a/src/mgxs_interface.F90 b/src/mgxs_interface.F90 new file mode 100644 index 0000000000..2a579e930a --- /dev/null +++ b/src/mgxs_interface.F90 @@ -0,0 +1,164 @@ +module mgxs_interface + + use, intrinsic :: ISO_C_BINDING + + use hdf5_interface + + implicit none + + interface + + subroutine add_mgxs_c(file_id, name, energy_groups, delayed_groups, & + n_temps, temps, tolerance, max_order, legendre_to_tabular, & + legendre_to_tabular_points, method) bind(C) + use ISO_C_BINDING + import HID_T + implicit none + integer(HID_T), value, intent(in) :: file_id + character(kind=C_CHAR),intent(in) :: name(*) + integer(C_INT), value, intent(in) :: energy_groups + integer(C_INT), value, intent(in) :: delayed_groups + integer(C_INT), value, intent(in) :: n_temps + real(C_DOUBLE), intent(in) :: temps(1:n_temps) + real(C_DOUBLE), value, intent(in) :: tolerance + integer(C_INT), value, intent(in) :: max_order + logical(C_BOOL),value, intent(in) :: legendre_to_tabular + integer(C_INT), value, intent(in) :: legendre_to_tabular_points + integer(C_INT), intent(inout) :: method + end subroutine add_mgxs_c + + function query_fissionable_c(n_nuclides, i_nuclides) result(result) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: n_nuclides + integer(C_INT), intent(in) :: i_nuclides(1:n_nuclides) + logical(C_BOOL) :: result + end function query_fissionable_c + + subroutine create_macro_xs_c(name, n_nuclides, i_nuclides, n_temps, temps, & + atom_densities, tolerance, method) bind(C) + use ISO_C_BINDING + implicit none + character(kind=C_CHAR),intent(in) :: name(*) + integer(C_INT), value, intent(in) :: n_nuclides + integer(C_INT), intent(in) :: i_nuclides(1:n_nuclides) + integer(C_INT), value, intent(in) :: n_temps + real(C_DOUBLE), intent(in) :: temps(1:n_temps) + real(C_DOUBLE), intent(in) :: atom_densities(1:n_nuclides) + real(C_DOUBLE), value, intent(in) :: tolerance + integer(C_INT), intent(inout) :: method + end subroutine create_macro_xs_c + + subroutine calculate_xs_c(i_mat, gin, sqrtkT, uvw, total_xs, abs_xs, & + nu_fiss_xs) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: i_mat + integer(C_INT), value, intent(in) :: gin + real(C_DOUBLE), value, intent(in) :: sqrtkT + real(C_DOUBLE), intent(in) :: uvw(1:3) + real(C_DOUBLE), intent(inout) :: total_xs + real(C_DOUBLE), intent(inout) :: abs_xs + real(C_DOUBLE), intent(inout) :: nu_fiss_xs + end subroutine calculate_xs_c + + subroutine sample_scatter_c(i_mat, gin, gout, mu, wgt, uvw) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: i_mat + integer(C_INT), value, intent(in) :: gin + integer(C_INT), intent(inout) :: gout + real(C_DOUBLE), intent(inout) :: mu + real(C_DOUBLE), intent(inout) :: wgt + real(C_DOUBLE), intent(inout) :: uvw(1:3) + end subroutine sample_scatter_c + + subroutine sample_fission_energy_c(i_mat, gin, dg, gout) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: i_mat + integer(C_INT), value, intent(in) :: gin + integer(C_INT), intent(inout) :: dg + integer(C_INT), intent(inout) :: gout + end subroutine sample_fission_energy_c + + subroutine get_name_c(index, name_len, name) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: index + integer(C_INT), value, intent(in) :: name_len + character(kind=C_CHAR), intent(inout) :: name(name_len) + end subroutine get_name_c + + function get_awr_c(index) result(awr) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: index + real(C_DOUBLE) :: awr + end function get_awr_c + + function get_nuclide_xs_c(index, xstype, gin, gout, mu, dg) result(val) & + bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: index + integer(C_INT), value, intent(in) :: xstype + integer(C_INT), value, intent(in) :: gin + integer(C_INT), optional, intent(in) :: gout + real(C_DOUBLE), optional, intent(in) :: mu + integer(C_INT), optional, intent(in) :: dg + real(C_DOUBLE) :: val + end function get_nuclide_xs_c + + function get_macro_xs_c(index, xstype, gin, gout, mu, dg) result(val) & + bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: index + integer(C_INT), value, intent(in) :: xstype + integer(C_INT), value, intent(in) :: gin + integer(C_INT), optional, intent(in) :: gout + real(C_DOUBLE), optional, intent(in) :: mu + integer(C_INT), optional, intent(in) :: dg + real(C_DOUBLE) :: val + end function get_macro_xs_c + + subroutine set_nuclide_angle_index_c(index, uvw) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: index + real(C_DOUBLE), intent(in) :: uvw(1:3) + end subroutine set_nuclide_angle_index_c + + subroutine set_macro_angle_index_c(index, uvw) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: index + real(C_DOUBLE), intent(in) :: uvw(1:3) + end subroutine set_macro_angle_index_c + + subroutine set_nuclide_temperature_index_c(index, sqrtkT) bind(C) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: index + real(C_DOUBLE), value, intent(in) :: sqrtkT + end subroutine set_nuclide_temperature_index_c + + end interface + + ! Number of energy groups + integer(C_INT) :: num_energy_groups + + ! Number of delayed groups + integer(C_INT) :: num_delayed_groups + + ! Energy group structure with decreasing energy + real(8), allocatable :: energy_bins(:) + + ! Midpoint of the energy group structure + real(8), allocatable :: energy_bin_avg(:) + + ! Energy group structure with increasing energy + real(8), allocatable :: rev_energy_bins(:) + +end module mgxs_interface \ No newline at end of file diff --git a/src/mgxs_interface.cpp b/src/mgxs_interface.cpp new file mode 100644 index 0000000000..d875987791 --- /dev/null +++ b/src/mgxs_interface.cpp @@ -0,0 +1,229 @@ +#include + +#include "error.h" +#include "math_functions.h" +#include "mgxs_interface.h" + + +namespace openmc { + +//============================================================================== +// Mgxs data loading interface methods +//============================================================================== + +void +add_mgxs_c(hid_t file_id, const char* name, int energy_groups, + int delayed_groups, int n_temps, const double temps[], double tolerance, + int max_order, bool legendre_to_tabular, int legendre_to_tabular_points, + int& method) +{ + // Convert temps to a vector for the from_hdf5 function + double_1dvec temperature(temps, temps + n_temps); + + write_message("Loading " + std::string(name) + " data...", 6); + + // Check to make sure cross section set exists in the library + hid_t xs_grp; + if (object_exists(file_id, name)) { + xs_grp = open_group(file_id, name); + } else { + fatal_error("Data for " + std::string(name) + " does not exist in " + + "provided MGXS Library"); + } + + Mgxs mg(xs_grp, energy_groups, delayed_groups, temperature, tolerance, + max_order, legendre_to_tabular, legendre_to_tabular_points, method); + + nuclides_MG.push_back(mg); + close_group(xs_grp); +} + +//============================================================================== + +bool +query_fissionable_c(int n_nuclides, const int i_nuclides[]) +{ + bool result = false; + for (int n = 0; n < n_nuclides; n++) { + if (nuclides_MG[i_nuclides[n] - 1].fissionable) result = true; + } + return result; +} + +//============================================================================== + +void +create_macro_xs_c(const char* mat_name, int n_nuclides, const int i_nuclides[], + int n_temps, const double temps[], const double atom_densities[], + double tolerance, int& method) +{ + if (n_temps > 0) { + // // Convert temps to a vector + double_1dvec temperature(temps, temps + n_temps); + + // Convert atom_densities to a vector + double_1dvec atom_densities_vec(atom_densities, + atom_densities + n_nuclides); + + // Build array of pointers to nuclides_MG's Mgxs objects needed for this + // material + std::vector mgxs_ptr(n_nuclides); + for (int n = 0; n < n_nuclides; n++) { + mgxs_ptr[n] = &nuclides_MG[i_nuclides[n] - 1]; + } + + Mgxs macro(mat_name, temperature, mgxs_ptr, atom_densities_vec, + tolerance, method); + macro_xs.emplace_back(macro); + } else { + // Preserve the ordering of materials by including a blank entry + Mgxs macro; + macro_xs.emplace_back(macro); + } +} + +//============================================================================== +// Mgxs tracking/transport/tallying interface methods +//============================================================================== + +void +calculate_xs_c(int i_mat, int gin, double sqrtkT, const double uvw[3], + double& total_xs, double& abs_xs, double& nu_fiss_xs) +{ + macro_xs[i_mat - 1].calculate_xs(gin - 1, sqrtkT, uvw, total_xs, abs_xs, + nu_fiss_xs); +} + +//============================================================================== + +void +sample_scatter_c(int i_mat, int gin, int& gout, double& mu, double& wgt, + double uvw[3]) +{ + int gout_c = gout - 1; + macro_xs[i_mat - 1].sample_scatter(gin - 1, gout_c, mu, wgt); + + // adjust return value for fortran indexing + gout = gout_c + 1; + + // Rotate the angle + rotate_angle_c(uvw, mu, nullptr); +} + +//============================================================================== + +void +sample_fission_energy_c(int i_mat, int gin, int& dg, int& gout) +{ + int dg_c = 0; + int gout_c = 0; + macro_xs[i_mat - 1].sample_fission_energy(gin - 1, dg_c, gout_c); + + // adjust return values for fortran indexing + dg = dg_c + 1; + gout = gout_c + 1; +} + +//============================================================================== + +double +get_nuclide_xs_c(int index, int xstype, int gin, int* gout, double* mu, int* dg) +{ + int gout_c; + int* gout_c_p; + int dg_c; + int* dg_c_p; + if (gout != nullptr) { + gout_c = *gout - 1; + gout_c_p = &gout_c; + } else { + gout_c_p = gout; + } + if (dg != nullptr) { + dg_c = *dg - 1; + dg_c_p = &dg_c; + } else { + dg_c_p = dg; + } + return nuclides_MG[index - 1].get_xs(xstype, gin - 1, gout_c_p, mu, dg_c_p); +} + +//============================================================================== + +double +get_macro_xs_c(int index, int xstype, int gin, int* gout, double* mu, int* dg) +{ + int gout_c; + int* gout_c_p; + int dg_c; + int* dg_c_p; + if (gout != nullptr) { + gout_c = *gout - 1; + gout_c_p = &gout_c; + } else { + gout_c_p = gout; + } + if (dg != nullptr) { + dg_c = *dg - 1; + dg_c_p = &dg_c; + } else { + dg_c_p = dg; + } + return macro_xs[index - 1].get_xs(xstype, gin - 1, gout_c_p, mu, dg_c_p); +} + +//============================================================================== + +void +set_nuclide_angle_index_c(int index, const double uvw[3]) +{ + // Update the values + nuclides_MG[index - 1].set_angle_index(uvw); +} + +//============================================================================== + +void +set_macro_angle_index_c(int index, const double uvw[3]) +{ + // Update the values + macro_xs[index - 1].set_angle_index(uvw); +} + +//============================================================================== + +void +set_nuclide_temperature_index_c(int index, double sqrtkT) +{ + // Update the values + nuclides_MG[index - 1].set_temperature_index(sqrtkT); +} + +//============================================================================== +// General Mgxs methods +//============================================================================== + +void +get_name_c(int index, int name_len, char* name) +{ + // First blank out our input string + std::string str(name_len, ' '); + std::strcpy(name, str.c_str()); + + // Now get the data and copy to the C-string + str = nuclides_MG[index - 1].name; + std::strcpy(name, str.c_str()); + + // Finally, remove the null terminator + name[std::strlen(name)] = ' '; +} + +//============================================================================== + +double +get_awr_c(int index) +{ + return nuclides_MG[index - 1].awr; +} + +} // namespace openmc \ No newline at end of file diff --git a/src/mgxs_interface.h b/src/mgxs_interface.h new file mode 100644 index 0000000000..65afd20f9c --- /dev/null +++ b/src/mgxs_interface.h @@ -0,0 +1,79 @@ +//! \file mgxs_interface.h +//! A collection of C interfaces to the C++ Mgxs class + +#ifndef MGXS_INTERFACE_H +#define MGXS_INTERFACE_H + +#include "hdf5_interface.h" +#include "mgxs.h" + + +namespace openmc { + +//============================================================================== +// Global variables +//============================================================================== + +extern std::vector nuclides_MG; +extern std::vector macro_xs; + +//============================================================================== +// Mgxs data loading interface methods +//============================================================================== + +extern "C" void +add_mgxs_c(hid_t file_id, const char* name, int energy_groups, + int delayed_groups, int n_temps, const double temps[], double tolerance, + int max_order, bool legendre_to_tabular, int legendre_to_tabular_points, + int& method); + +extern "C" bool +query_fissionable_c(int n_nuclides, const int i_nuclides[]); + +extern "C" void +create_macro_xs_c(const char* mat_name, int n_nuclides, const int i_nuclides[], + int n_temps, const double temps[], const double atom_densities[], + double tolerance, int& method); + +//============================================================================== +// Mgxs tracking/transport/tallying interface methods +//============================================================================== + +extern "C" void +calculate_xs_c(int i_mat, int gin, double sqrtkT, const double uvw[3], + double& total_xs, double& abs_xs, double& nu_fiss_xs); + +extern "C" void +sample_scatter_c(int i_mat, int gin, int& gout, double& mu, double& wgt, + double uvw[3]); + +extern "C" void +sample_fission_energy_c(int i_mat, int gin, int& dg, int& gout); + +extern "C" double +get_nuclide_xs_c(int index, int xstype, int gin, int* gout, double* mu, int* dg); + +extern "C" double +get_macro_xs_c(int index, int xstype, int gin, int* gout, double* mu, int* dg); + +extern "C" void +set_nuclide_angle_index_c(int index, const double uvw[3]); + +extern "C" void +set_macro_angle_index_c(int index, const double uvw[3]); + +extern "C" void +set_nuclide_temperature_index_c(int index, double sqrtkT); + +//============================================================================== +// General Mgxs methods +//============================================================================== + +extern "C" void +get_name_c(int index, int name_len, char* name); + +extern "C" double +get_awr_c(int index); + +} // namespace openmc +#endif // MGXS_INTERFACE_H \ No newline at end of file diff --git a/src/nuclide_header.F90 b/src/nuclide_header.F90 index dcadae4a66..8b7e142b0d 100644 --- a/src/nuclide_header.F90 +++ b/src/nuclide_header.F90 @@ -167,17 +167,17 @@ module nuclide_header !=============================================================================== type MaterialMacroXS - real(8) :: total ! macroscopic total xs - real(8) :: absorption ! macroscopic absorption xs - real(8) :: fission ! macroscopic fission xs - real(8) :: nu_fission ! macroscopic production xs - real(8) :: photon_prod ! macroscopic photon production xs + real(C_DOUBLE) :: total ! macroscopic total xs + real(C_DOUBLE) :: absorption ! macroscopic absorption xs + real(C_DOUBLE) :: fission ! macroscopic fission xs + real(C_DOUBLE) :: nu_fission ! macroscopic production xs + real(C_DOUBLE) :: photon_prod ! macroscopic photon production xs ! Photon cross sections - real(8) :: coherent ! macroscopic coherent xs - real(8) :: incoherent ! macroscopic incoherent xs - real(8) :: photoelectric ! macroscopic photoelectric xs - real(8) :: pair_production ! macroscopic pair production xs + real(C_DOUBLE) :: coherent ! macroscopic coherent xs + real(C_DOUBLE) :: incoherent ! macroscopic incoherent xs + real(C_DOUBLE) :: photoelectric ! macroscopic photoelectric xs + real(C_DOUBLE) :: pair_production ! macroscopic pair production xs end type MaterialMacroXS !=============================================================================== diff --git a/src/output.F90 b/src/output.F90 index b1671df984..6197cdc11c 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -12,7 +12,7 @@ module output use math, only: t_percentile use mesh_header, only: RegularMesh, meshes use message_passing, only: master, n_procs - use mgxs_header, only: nuclides_MG + use mgxs_interface use nuclide_header use particle_header, only: LocalCoord, Particle use plot_header @@ -680,6 +680,7 @@ contains character(36) :: score_name ! names of scoring function ! to be applied at write-time type(TallyFilterMatch), allocatable :: matches(:) + character(MAX_WORD_LEN) :: temp_name ! Skip if there are no tallies if (n_tallies == 0) return @@ -843,8 +844,9 @@ contains write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & trim(nuclides(i_nuclide) % name) else + call get_name_c(i_nuclide, len(temp_name), temp_name) write(UNIT=unit_tally, FMT='(1X,2A,1X,A)') repeat(" ", indent), & - trim(nuclides_MG(i_nuclide) % obj % name) + trim(temp_name) end if end if diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index c3d25151b6..200773c256 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -6,7 +6,7 @@ module particle_restart use constants use error, only: write_message use hdf5_interface, only: file_open, file_close, read_dataset, HID_T - use mgxs_header, only: energy_bin_avg + use mgxs_interface, only: energy_bin_avg use nuclide_header, only: micro_xs, n_nuclides use output, only: print_particle use particle_header, only: Particle diff --git a/src/physics_mg.F90 b/src/physics_mg.F90 index e7c0ceb17b..fd7f7d9a91 100644 --- a/src/physics_mg.F90 +++ b/src/physics_mg.F90 @@ -8,13 +8,12 @@ module physics_mg use material_header, only: Material, materials use math, only: rotate_angle use mesh_header, only: meshes - use mgxs_header + use mgxs_interface use message_passing use nuclide_header, only: material_xs use particle_header, only: Particle use physics_common use random_lcg, only: prn - use scattdata_header use settings use simulation_header use string, only: to_str @@ -143,16 +142,12 @@ contains type(Particle), intent(inout) :: p - call macro_xs(p % material) % obj % sample_scatter(p % coord(1) % uvw, & - p % last_g, p % g, & - p % mu, p % wgt) + call sample_scatter_c(p % material, p % last_g, p % g, p % mu, & + p % wgt, p % coord(1) % uvw) ! Update energy value for downstream compatability (in tallying) p % E = energy_bin_avg(p % g) - ! Convert change in angle (mu) to new direction - p % coord(1) % uvw = rotate_angle(p % coord(1) % uvw, p % mu) - ! Set event component p % event = EVENT_SCATTER @@ -178,10 +173,6 @@ contains real(8) :: mu ! fission neutron angular cosine real(8) :: phi ! fission neutron azimuthal angle real(8) :: weight ! weight adjustment for ufs method - class(Mgxs), pointer :: xs - - ! Get Pointers - xs => macro_xs(p % material) % obj ! TODO: Heat generation from fission @@ -264,7 +255,7 @@ contains ! Sample secondary energy distribution for fission reaction and set energy ! in fission bank - call xs % sample_fission_energy(p % g, bank_array(i) % uvw, dg, gout) + call sample_fission_energy_c(p % material, p % g, dg, gout) bank_array(i) % E = real(gout, 8) bank_array(i) % delayed_group = dg diff --git a/src/scattdata.cpp b/src/scattdata.cpp new file mode 100644 index 0000000000..a316eba46d --- /dev/null +++ b/src/scattdata.cpp @@ -0,0 +1,936 @@ +#include +#include +#include + +#include "constants.h" +#include "math_functions.h" +#include "random_lcg.h" +#include "error.h" +#include "scattdata.h" + +namespace openmc { + +//============================================================================== +// ScattData base-class methods +//============================================================================== + +void +ScattData::base_init(int order, const int_1dvec& in_gmin, + const int_1dvec& in_gmax, const double_2dvec& in_energy, + const double_2dvec& in_mult) +{ + int groups = in_energy.size(); + + gmin = in_gmin; + gmax = in_gmax; + energy.resize(groups); + mult.resize(groups); + dist.resize(groups); + + for (int gin = 0; gin < groups; gin++) { + // Store the inputted data + energy[gin] = in_energy[gin]; + mult[gin] = in_mult[gin]; + + // Make sure the energy is normalized + double norm = std::accumulate(energy[gin].begin(), energy[gin].end(), 0.); + + if (norm != 0.) { + for (auto& n : energy[gin]) n /= norm; + } + + // Initialize the distribution data + dist[gin].resize(in_gmax[gin] - in_gmin[gin] + 1); + for (auto& v : dist[gin]) { + v.resize(order); + } + } +} + +//============================================================================== + +void +ScattData::base_combine(int max_order, + const std::vector& those_scatts, const double_1dvec& scalars, + int_1dvec& in_gmin, int_1dvec& in_gmax, double_2dvec& sparse_mult, + double_3dvec& sparse_scatter) +{ + int groups = those_scatts[0] -> energy.size(); + + // Now allocate and zero our storage spaces + double_3dvec this_matrix = double_3dvec(groups, double_2dvec(groups, + double_1dvec(max_order, 0.))); + double_2dvec mult_numer(groups, double_1dvec(groups, 0.)); + double_2dvec mult_denom(groups, double_1dvec(groups, 0.)); + + // Build the dense scattering and multiplicity matrices + // Get the multiplicity_matrix + // To combine from nuclidic data we need to use the final relationship + // mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / + // sum_i(N_i*(nuscatt_{i,g,g'} / mult_{i,g,g'})) + // Developed as follows: + // mult_{gg'} = nuScatt{g,g'} / Scatt{g,g'} + // mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / sum(N_i*scatt_{i,g,g'}) + // mult_{gg'} = sum_i(N_i*nuscatt_{i,g,g'}) / + // sum_i(N_i*(nuscatt_{i,g,g'} / mult_{i,g,g'})) + // nuscatt_{i,g,g'} can be reconstructed from the energy and scattxs member + // variables + for (int i = 0; i < those_scatts.size(); i++) { + ScattData* that = those_scatts[i]; + + // Build the dense matrix for that object + double_3dvec that_matrix = that->get_matrix(max_order); + + // Now add that to this for the scattering and multiplicity + for (int gin = 0; gin < groups; gin++) { + // Only spend time adding that's gmin to gmax data since the rest will + // be zeros + int i_gout = 0; + for (int gout = that->gmin[gin]; gout <= that->gmax[gin]; gout++) { + // Do the scattering matrix + for (int l = 0; l < max_order; l++) { + this_matrix[gin][gout][l] += scalars[i] * that_matrix[gin][gout][l]; + } + + // Incorporate that's contribution to the multiplicity matrix data + double nuscatt = that->scattxs[gin] * that->energy[gin][i_gout]; + mult_numer[gin][gout] += scalars[i] * nuscatt; + if (that->mult[gin][i_gout] > 0.) { + mult_denom[gin][gout] += scalars[i] * nuscatt / that->mult[gin][i_gout]; + } else { + mult_denom[gin][gout] += scalars[i]; + } + i_gout++; + } + } + } + + // Combine mult_numer and mult_denom into the combined multiplicity matrix + double_2dvec this_mult(groups, double_1dvec(groups, 1.)); + for (int gin = 0; gin < groups; gin++) { + for (int gout = 0; gout < groups; gout++) { + if (mult_denom[gin][gout] > 0.) { + this_mult[gin][gout] = mult_numer[gin][gout] / mult_denom[gin][gout]; + } + } + } + mult_numer.clear(); + mult_denom.clear(); + + // We have the data, now we need to convert to a jagged array and then use + // the initialize function to store it on the object. + for (int gin = 0; gin < groups; gin++) { + // Find the minimum and maximum group boundaries + int gmin_; + for (gmin_ = 0; gmin_ < groups; gmin_++) { + bool non_zero = false; + for (int l = 0; l < this_matrix[gin][gmin_].size(); l++) { + if (this_matrix[gin][gmin_][l] != 0.) { + non_zero = true; + break; + } + } + if (non_zero) break; + } + int gmax_; + for (gmax_ = groups - 1; gmax_ >= 0; gmax_--) { + bool non_zero = false; + for (int l = 0; l < this_matrix[gin][gmax_].size(); l++) { + if (this_matrix[gin][gmax_][l] != 0.) { + non_zero = true; + break; + } + } + if (non_zero) break; + } + + // treat the case of all values being 0 + if (gmin_ > gmax_) { + gmin_ = gin; + gmax_ = gin; + } + + // Store the group bounds + in_gmin[gin] = gmin_; + in_gmax[gin] = gmax_; + + // Store the data in the compressed format + sparse_scatter[gin].resize(gmax_ - gmin_ + 1); + sparse_mult[gin].resize(gmax_ - gmin_ + 1); + int i_gout = 0; + for (int gout = gmin_; gout <= gmax_; gout++) { + sparse_scatter[gin][i_gout] = this_matrix[gin][gout]; + sparse_mult[gin][i_gout] = this_mult[gin][gout]; + i_gout++; + } + } +} + +//============================================================================== + +void +ScattData::sample_energy(int gin, int& gout, int& i_gout) +{ + // Sample the outgoing group + double xi = prn(); + + i_gout = 0; + gout = gmin[gin]; + double prob = energy[gin][i_gout]; + while((prob < xi) && (gout < gmax[gin])) { + gout++; + i_gout++; + prob += energy[gin][i_gout]; + } +} + +//============================================================================== + +double +ScattData::get_xs(int xstype, int gin, const int* gout, const double* mu) +{ + // Set the outgoing group offset index as needed + int i_gout = 0; + if (gout != nullptr) { + // short circuit the function if gout is from a zero portion of the + // scattering matrix + if ((*gout < gmin[gin]) || (*gout > gmax[gin])) { // > gmax? + return 0.; + } + i_gout = *gout - gmin[gin]; + } + + double val = scattxs[gin]; + switch(xstype) { + case MG_GET_XS_SCATTER: + if (gout != nullptr) val *= energy[gin][i_gout]; + break; + case MG_GET_XS_SCATTER_MULT: + if (gout != nullptr) { + val *= energy[gin][i_gout] / mult[gin][i_gout]; + } else { + val /= std::inner_product(mult[gin].begin(), mult[gin].end(), + energy[gin].begin(), 0.0); + } + break; + case MG_GET_XS_SCATTER_FMU_MULT: + if ((gout != nullptr) && (mu != nullptr)) { + val *= energy[gin][i_gout] * calc_f(gin, *gout, *mu); + } else { + // This is not an expected path (asking for f_mu without asking for a + // group or mu is not useful + fatal_error("Invalid call to get_xs"); + } + break; + case MG_GET_XS_SCATTER_FMU: + if ((gout != nullptr) && (mu != nullptr)) { + val *= energy[gin][i_gout] * calc_f(gin, *gout, *mu) / mult[gin][i_gout]; + } else { + // This is not an expected path (asking for f_mu without asking for a + // group or mu is not useful + fatal_error("Invalid call to get_xs"); + } + break; + } + return val; +} + +//============================================================================== +// ScattDataLegendre methods +//============================================================================== + +void +ScattDataLegendre::init(const int_1dvec& in_gmin, const int_1dvec& in_gmax, + const double_2dvec& in_mult, const double_3dvec& coeffs) +{ + int groups = coeffs.size(); + int order = coeffs[0][0].size(); + + // make a copy of coeffs that we can use to both extract data and normalize + double_3dvec matrix = coeffs; + + // Get the scattering cross section value by summing the un-normalized P0 + // coefficient in the variable matrix over all outgoing groups. + scattxs.resize(groups); + for (int gin = 0; gin < groups; gin++) { + int num_groups = in_gmax[gin] - in_gmin[gin] + 1; + scattxs[gin] = 0.; + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + scattxs[gin] += matrix[gin][i_gout][0]; + } + } + + // Build the energy transfer matrix from data in the variable matrix while + // also normalizing the variable matrix itself + // (forcing the CDF of f(mu=1) == 1) + double_2dvec in_energy; + in_energy.resize(groups); + for (int gin = 0; gin < groups; gin++) { + int num_groups = in_gmax[gin] - in_gmin[gin] + 1; + in_energy[gin].resize(num_groups); + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + double norm = matrix[gin][i_gout][0]; + in_energy[gin][i_gout] = norm; + if (norm != 0.) { + for (auto& n : matrix[gin][i_gout]) n /= norm; + } + } + } + + // Initialize the base class attributes + ScattData::base_init(order, in_gmin, in_gmax, in_energy, in_mult); + + // Set the distribution (sdata.dist) values and initialize max_val + max_val.resize(groups); + for (int gin = 0; gin < groups; gin++) { + int num_groups = gmax[gin] - gmin[gin] + 1; + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + dist[gin][i_gout] = matrix[gin][i_gout]; + } + max_val[gin].resize(num_groups); + for (auto& n : max_val[gin]) n = 0.; + } + + // Now update the maximum value + update_max_val(); +} + +//============================================================================== + +void +ScattDataLegendre::update_max_val() +{ + int groups = max_val.size(); + // Step through the polynomial with fixed number of points to identify the + // maximal value + int Nmu = 1001; + double dmu = 2. / (Nmu - 1); + for (int gin = 0; gin < groups; gin++) { + int num_groups = gmax[gin] - gmin[gin] + 1; + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + for (int imu = 0; imu < Nmu; imu++) { + double mu; + if (imu == 0) { + mu = -1.; + } else if (imu == (Nmu - 1)) { + mu = 1.; + } else { + mu = -1. + (imu - 1) * dmu; + } + + // Calculate probability + double f = evaluate_legendre_c(dist[gin][i_gout].size() - 1, + dist[gin][i_gout].data(), mu); + + // if this is a new maximum, store it + if (f > max_val[gin][i_gout]) max_val[gin][i_gout] = f; + } // end imu loop + + // Since we may not have caught the true max, add 10% margin + max_val[gin][i_gout] *= 1.1; + } + } +} + +//============================================================================== + +double +ScattDataLegendre::calc_f(int gin, int gout, double mu) +{ + double f; + if ((gout < gmin[gin]) || (gout > gmax[gin])) { + f = 0.; + } else { + int i_gout = gout - gmin[gin]; + f = evaluate_legendre_c(dist[gin][i_gout].size() - 1, + dist[gin][i_gout].data(), mu); + } + return f; +} + +//============================================================================== + +void +ScattDataLegendre::sample(int gin, int& gout, double& mu, double& wgt) +{ + // Sample the outgoing energy using the base-class method + int i_gout; + sample_energy(gin, gout, i_gout); + + // Now we can sample mu using the scattering kernel using rejection + // sampling from a rectangular bounding box + double M = max_val[gin][i_gout]; + int samples = 0; + + while(true) { + mu = 2. * prn() - 1.; + double f = calc_f(gin, gout, mu); + if (f > 0.) { + double u = prn() * M; + if (u <= f) break; + } + samples++; + if (samples > MAX_SAMPLE) { + fatal_error("Maximum number of Legendre expansion samples reached"); + } + }; + + // Update the weight to reflect neutron multiplicity + wgt *= mult[gin][i_gout]; +} + +//============================================================================== + +void +ScattDataLegendre::combine(const std::vector& those_scatts, + const double_1dvec& scalars) +{ + // Find the max order in the data set and make sure we can combine the sets + int max_order = 0; + for (int i = 0; i < those_scatts.size(); i++) { + // Lets also make sure these items are combineable + ScattDataLegendre* that = dynamic_cast(those_scatts[i]); + if (!that) { + fatal_error("Cannot combine the ScattData objects!"); + } + int that_order = that->get_order(); + if (that_order > max_order) max_order = that_order; + } + max_order++; // Add one since this is a Legendre + + int groups = those_scatts[0] -> energy.size(); + + int_1dvec in_gmin(groups); + int_1dvec in_gmax(groups); + double_3dvec sparse_scatter(groups); + double_2dvec sparse_mult(groups); + + // The rest of the steps do not depend on the type of angular representation + // so we use a base class method to sum up xs and create new energy and mult + // matrices + ScattData::base_combine(max_order, those_scatts, scalars, in_gmin, in_gmax, + sparse_mult, sparse_scatter); + + // Got everything we need, store it. + init(in_gmin, in_gmax, sparse_mult, sparse_scatter); +} + +//============================================================================== + +double_3dvec +ScattDataLegendre::get_matrix(int max_order) +{ + // Get the sizes and initialize the data to 0 + int groups = energy.size(); + int order_dim = max_order + 1; + double_3dvec matrix = double_3dvec(groups, double_2dvec(groups, + double_1dvec(order_dim, 0.))); + + for (int gin = 0; gin < groups; gin++) { + for (int i_gout = 0; i_gout < energy[gin].size(); i_gout++) { + int gout = i_gout + gmin[gin]; + for (int l = 0; l < order_dim; l++) { + matrix[gin][gout][l] = scattxs[gin] * energy[gin][i_gout] * + dist[gin][i_gout][l]; + } + } + } + return matrix; +} + +//============================================================================== +// ScattDataHistogram methods +//============================================================================== + +void +ScattDataHistogram::init(const int_1dvec& in_gmin, const int_1dvec& in_gmax, + const double_2dvec& in_mult, const double_3dvec& coeffs) +{ + int groups = coeffs.size(); + int order = coeffs[0][0].size(); + + // make a copy of coeffs that we can use to both extract data and normalize + double_3dvec matrix = coeffs; + + // Get the scattering cross section value by summing the distribution + // over all the histogram bins in angle and outgoing energy groups + scattxs.resize(groups); + for (int gin = 0; gin < groups; gin++) { + scattxs[gin] = 0.; + for (int i_gout = 0; i_gout < matrix[gin].size(); i_gout++) { + scattxs[gin] += std::accumulate(matrix[gin][i_gout].begin(), + matrix[gin][i_gout].end(), 0.); + } + } + + // Build the energy transfer matrix from data in the variable matrix + double_2dvec in_energy; + in_energy.resize(groups); + for (int gin = 0; gin < groups; gin++) { + int num_groups = in_gmax[gin] - in_gmin[gin] + 1; + in_energy[gin].resize(num_groups); + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + double norm = std::accumulate(matrix[gin][i_gout].begin(), + matrix[gin][i_gout].end(), 0.); + in_energy[gin][i_gout] = norm; + if (norm != 0.) { + for (auto& n : matrix[gin][i_gout]) n /= norm; + } + } + } + + // Initialize the base class attributes + ScattData::base_init(order, in_gmin, in_gmax, in_energy, in_mult); + + // Build the angular distribution mu values + mu = double_1dvec(order); + dmu = 2. / order; + mu[0] = -1.; + for (int imu = 1; imu < order; imu++) { + mu[imu] = -1. + imu * dmu; + } + + // Calculate f(mu) and integrate it so we can avoid rejection sampling + fmu.resize(groups); + for (int gin = 0; gin < groups; gin++) { + int num_groups = gmax[gin] - gmin[gin] + 1; + fmu[gin].resize(num_groups); + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + fmu[gin][i_gout].resize(order); + // The variable matrix contains f(mu); so directly assign it + fmu[gin][i_gout] = matrix[gin][i_gout]; + + // Integrate the histogram + dist[gin][i_gout][0] = dmu * matrix[gin][i_gout][0]; + for (int imu = 1; imu < order; imu++) { + dist[gin][i_gout][imu] = dmu * matrix[gin][i_gout][imu] + + dist[gin][i_gout][imu - 1]; + } + + // Now re-normalize for integral to unity + double norm = dist[gin][i_gout][order - 1]; + if (norm > 0.) { + for (int imu = 0; imu < order; imu++) { + fmu[gin][i_gout][imu] /= norm; + dist[gin][i_gout][imu] /= norm; + } + } + } + } +} + +//============================================================================== + +double +ScattDataHistogram::calc_f(int gin, int gout, double mu) +{ + double f; + if ((gout < gmin[gin]) || (gout > gmax[gin])) { + f = 0.; + } else { + // Find mu bin + int i_gout = gout - gmin[gin]; + int imu; + if (mu == 1.) { + // use size -2 to have the index one before the end + imu = this->mu.size() - 2; + } else { + imu = std::floor((mu + 1.) / dmu + 1.) - 1; + } + + f = fmu[gin][i_gout][imu]; + } + return f; +} + +//============================================================================== + +void +ScattDataHistogram::sample(int gin, int& gout, double& mu, double& wgt) +{ + // Sample the outgoing energy using the base-class method + int i_gout; + sample_energy(gin, gout, i_gout); + + // Determine the outgoing cosine bin + double xi = prn(); + + int imu; + if (xi < dist[gin][i_gout][0]) { + imu = 0; + } else { + // TODO lower_bound? + 1? + imu = std::upper_bound(dist[gin][i_gout].begin(), + dist[gin][i_gout].end(), xi) - + dist[gin][i_gout].begin(); + } + + // Randomly select mu within the imu bin + mu = prn() * dmu + this->mu[imu]; + + if (mu < -1.) { + mu = -1.; + } else if (mu > 1.) { + mu = 1.; + } + + // Update the weight to reflect neutron multiplicity + wgt *= mult[gin][i_gout]; +} + +//============================================================================== + +double_3dvec +ScattDataHistogram::get_matrix(int max_order) +{ + // Get the sizes and initialize the data to 0 + int groups = energy.size(); + // We ignore the requested order for Histogram and Tabular representations + int order_dim = get_order(); + double_3dvec matrix = double_3dvec(groups, double_2dvec(groups, + double_1dvec(order_dim, 0.))); + + for (int gin = 0; gin < groups; gin++) { + for (int i_gout = 0; i_gout < energy[gin].size(); i_gout++) { + int gout = i_gout + gmin[gin]; + for (int l = 0; l < order_dim; l++) { + matrix[gin][gout][l] = scattxs[gin] * energy[gin][i_gout] * + fmu[gin][i_gout][l]; + } + } + } + return matrix; +} + +//============================================================================== + +void +ScattDataHistogram::combine(const std::vector& those_scatts, + const double_1dvec& scalars) +{ + // Find the max order in the data set and make sure we can combine the sets + int max_order = those_scatts[0]->get_order(); + for (int i = 0; i < those_scatts.size(); i++) { + // Lets also make sure these items are combineable + ScattDataHistogram* that = dynamic_cast(those_scatts[i]); + if (!that) { + fatal_error("Cannot combine the ScattData objects!"); + } + if (max_order != that->get_order()) { + fatal_error("Cannot combine the ScattData objects!"); + } + } + + int groups = those_scatts[0] -> energy.size(); + + int_1dvec in_gmin(groups); + int_1dvec in_gmax(groups); + double_3dvec sparse_scatter(groups); + double_2dvec sparse_mult(groups); + + // The rest of the steps do not depend on the type of angular representation + // so we use a base class method to sum up xs and create new energy and mult + // matrices + ScattData::base_combine(max_order, those_scatts, scalars, in_gmin, in_gmax, + sparse_mult, sparse_scatter); + + // Got everything we need, store it. + init(in_gmin, in_gmax, sparse_mult, sparse_scatter); +} + +//============================================================================== +// ScattDataTabular methods +//============================================================================== + +void +ScattDataTabular::init(const int_1dvec& in_gmin, const int_1dvec& in_gmax, + const double_2dvec& in_mult, const double_3dvec& coeffs) +{ + int groups = coeffs.size(); + int order = coeffs[0][0].size(); + + // make a copy of coeffs that we can use to both extract data and normalize + double_3dvec matrix = coeffs; + + // Build the angular distribution mu values + mu = double_1dvec(order); + dmu = 2. / (order - 1); + mu[0] = -1.; + for (int imu = 1; imu < order - 1; imu++) { + mu[imu] = -1. + imu * dmu; + } + mu[order - 1] = 1.; + + // Get the scattering cross section value by integrating the distribution + // over all mu points and then combining over all outgoing groups + scattxs.resize(groups); + for (int gin = 0; gin < groups; gin++) { + scattxs[gin] = 0.; + for (int i_gout = 0; i_gout < matrix[gin].size(); i_gout++) { + for (int imu = 1; imu < order; imu++) { + scattxs[gin] += 0.5 * dmu * (matrix[gin][i_gout][imu - 1] + + matrix[gin][i_gout][imu]); + } + } + } + + // Build the energy transfer matrix from data in the variable matrix + double_2dvec in_energy(groups); + for (int gin = 0; gin < groups; gin++) { + int num_groups = in_gmax[gin] - in_gmin[gin] + 1; + in_energy[gin].resize(num_groups); + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + double norm = 0.; + for (int imu = 1; imu < order; imu++) { + norm += 0.5 * dmu * (matrix[gin][i_gout][imu - 1] + + matrix[gin][i_gout][imu]); + } + in_energy[gin][i_gout] = norm; + } + } + + // Initialize the base class attributes + ScattData::base_init(order, in_gmin, in_gmax, in_energy, in_mult); + + // Calculate f(mu) and integrate it so we can avoid rejection sampling + fmu.resize(groups); + for (int gin = 0; gin < groups; gin++) { + int num_groups = gmax[gin] - gmin[gin] + 1; + fmu[gin].resize(num_groups); + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + fmu[gin][i_gout].resize(order); + // The variable matrix contains f(mu); so directly assign it + fmu[gin][i_gout] = matrix[gin][i_gout]; + + // Ensure positivity + for (auto& val : fmu[gin][i_gout]) { + if (val < 0.) val = 0.; + } + + // Now re-normalize for numerical integration issues and to take care of + // the above negative fix-up. Also accrue the CDF + double norm = 0.; + for (int imu = 1; imu < order; imu++) { + norm += 0.5 * dmu * (fmu[gin][i_gout][imu - 1] + + fmu[gin][i_gout][imu]); + // incorporate to the CDF + dist[gin][i_gout][imu] = norm; + } + + // now do the normalization + if (norm > 0.) { + for (int imu = 0; imu < order; imu++) { + fmu[gin][i_gout][imu] /= norm; + dist[gin][i_gout][imu] /= norm; + } + } + } + } +} + +//============================================================================== + +double +ScattDataTabular::calc_f(int gin, int gout, double mu) +{ + double f; + if ((gout < gmin[gin]) || (gout > gmax[gin])) { + f = 0.; + } else { + // Find mu bin + int i_gout = gout - gmin[gin]; + int imu; + if (mu == 1.) { + // use size -2 to have the index one before the end + imu = this->mu.size() - 2; + } else { + imu = std::floor((mu + 1.) / dmu + 1.) - 1; + } + + double r = (mu - this->mu[imu]) / (this->mu[imu + 1] - this->mu[imu]); + f = (1. - r) * fmu[gin][i_gout][imu] + r * fmu[gin][i_gout][imu + 1]; + } + return f; +} + +//============================================================================== + +void +ScattDataTabular::sample(int gin, int& gout, double& mu, double& wgt) +{ + // Sample the outgoing energy using the base-class method + int i_gout; + sample_energy(gin, gout, i_gout); + + // Determine the outgoing cosine bin + int NP = this->mu.size(); + double xi = prn(); + + double c_k = dist[gin][i_gout][0]; + int k; + for (k = 0; k < NP - 1; k++) { + double c_k1 = dist[gin][i_gout][k + 1]; + if (xi < c_k1) break; + c_k = c_k1; + } + + // Check to make sure k is <= NP - 1 + k = std::min(k, NP - 2); + + // Find the pdf values we want + double p0 = fmu[gin][i_gout][k]; + double mu0 = this -> mu[k]; + double p1 = fmu[gin][i_gout][k + 1]; + double mu1 = this -> mu[k + 1]; + + if (p0 == p1) { + mu = mu0 + (xi - c_k) / p0; + } else { + double frac = (p1 - p0) / (mu1 - mu0); + mu = mu0 + (std::sqrt(std::max(0., p0 * p0 + 2. * frac * (xi - c_k))) + - p0) / frac; + } + + if (mu < -1.) { + mu = -1.; + } else if (mu > 1.) { + mu = 1.; + } + + // Update the weight to reflect neutron multiplicity + wgt *= mult[gin][i_gout]; +} + +//============================================================================== + +double_3dvec +ScattDataTabular::get_matrix(int max_order) +{ + // Get the sizes and initialize the data to 0 + int groups = energy.size(); + // We ignore the requested order for Histogram and Tabular representations + int order_dim = get_order(); + double_3dvec matrix = double_3dvec(groups, double_2dvec(groups, + double_1dvec(order_dim, 0.))); + + for (int gin = 0; gin < groups; gin++) { + for (int i_gout = 0; i_gout < energy[gin].size(); i_gout++) { + int gout = i_gout + gmin[gin]; + for (int l = 0; l < order_dim; l++) { + matrix[gin][gout][l] = scattxs[gin] * energy[gin][i_gout] * + fmu[gin][i_gout][l]; + } + } + } + return matrix; +} + +//============================================================================== + +void +ScattDataTabular::combine(const std::vector& those_scatts, + const double_1dvec& scalars) +{ + // Find the max order in the data set and make sure we can combine the sets + int max_order = those_scatts[0]->get_order(); + for (int i = 0; i < those_scatts.size(); i++) { + // Lets also make sure these items are combineable + ScattDataTabular* that = dynamic_cast(those_scatts[i]); + if (!that) { + fatal_error("Cannot combine the ScattData objects!"); + } + if (max_order != that->get_order()) { + fatal_error("Cannot combine the ScattData objects!"); + } + } + + int groups = those_scatts[0] -> energy.size(); + + int_1dvec in_gmin(groups); + int_1dvec in_gmax(groups); + double_3dvec sparse_scatter(groups); + double_2dvec sparse_mult(groups); + + // The rest of the steps do not depend on the type of angular representation + // so we use a base class method to sum up xs and create new energy and mult + // matrices + ScattData::base_combine(max_order, those_scatts, scalars, in_gmin, in_gmax, + sparse_mult, sparse_scatter); + + // Got everything we need, store it. + init(in_gmin, in_gmax, sparse_mult, sparse_scatter); +} + +//============================================================================== +// module-level methods +//============================================================================== + +void +convert_legendre_to_tabular(ScattDataLegendre& leg, ScattDataTabular& tab, + int n_mu) +{ + // See if the user wants us to figure out how many points to use + if (n_mu == C_NONE) { + // then we will use 2 pts if its P0, or the default if a higher order + // TODO use an error minimization algorithm that also picks n_mu + if (leg.get_order() == 0) { + n_mu = 2; + } else { + n_mu = DEFAULT_NMU; + } + } + + tab.base_init(n_mu, leg.gmin, leg.gmax, leg.energy, leg.mult); + tab.scattxs = leg.scattxs; + + // Build mu and dmu + tab.mu = double_1dvec(n_mu); + tab.dmu = 2. / (n_mu - 1); + tab.mu[0] = -1.; + for (int imu = 1; imu < n_mu - 1; imu++) { + tab.mu[imu] = -1. + imu * tab.dmu; + } + tab.mu[n_mu - 1] = 1.; + + // Calculate f(mu) and integrate it so we can avoid rejection sampling + int groups = tab.energy.size(); + tab.fmu.resize(groups); + for (int gin = 0; gin < groups; gin++) { + int num_groups = tab.gmax[gin] - tab.gmin[gin] + 1; + tab.fmu[gin].resize(num_groups); + for (int i_gout = 0; i_gout < num_groups; i_gout++) { + tab.fmu[gin][i_gout].resize(n_mu); + for (int imu = 0; imu < n_mu; imu++) { + tab.fmu[gin][i_gout][imu] = + evaluate_legendre_c(leg.dist[gin][i_gout].size() - 1, + leg.dist[gin][i_gout].data(), tab.mu[imu]); + } + + // Ensure positivity + for (auto& val : tab.fmu[gin][i_gout]) { + if (val < 0.) val = 0.; + } + + // Now re-normalize for numerical integration issues and to take care of + // the above negative fix-up. Also accrue the CDF + double norm = 0.; + tab.dist[gin][i_gout][0] = 0.; + for (int imu = 1; imu < n_mu; imu++) { + norm += 0.5 * tab.dmu * (tab.fmu[gin][i_gout][imu - 1] + + tab.fmu[gin][i_gout][imu]); + // incorporate to the CDF + tab.dist[gin][i_gout][imu] = norm; + } + + // now do the normalization + if (norm > 0.) { + for (int imu = 0; imu < n_mu; imu++) { + tab.fmu[gin][i_gout][imu] /= norm; + tab.dist[gin][i_gout][imu] /= norm; + } + } + } + } +} + +} // namespace openmc diff --git a/src/scattdata.h b/src/scattdata.h new file mode 100644 index 0000000000..72ebaf6771 --- /dev/null +++ b/src/scattdata.h @@ -0,0 +1,258 @@ +//! \file scattdata.h +//! A collection of multi-group scattering data classes + +#ifndef SCATTDATA_H +#define SCATTDATA_H + +#include + +namespace openmc { + +// forward declarations so we can name our friend functions +class ScattDataLegendre; +class ScattDataTabular; + +//============================================================================== +// SCATTDATA contains all the data needed to describe the scattering energy and +// angular distribution data +//============================================================================== + +class ScattData { + protected: + //! \brief Initializes the attributes of the base class. + void + base_init(int order, const int_1dvec& in_gmin, const int_1dvec& in_gmax, + const double_2dvec& in_energy, const double_2dvec& in_mult); + + //! \brief Combines microscopic ScattDatas into a macroscopic one. + void + base_combine(int max_order, const std::vector& those_scatts, + const double_1dvec& scalars, int_1dvec& in_gmin, int_1dvec& in_gmax, + double_2dvec& sparse_mult, double_3dvec& sparse_scatter); + + public: + + double_2dvec energy; // Normalized p0 matrix for sampling Eout + double_2dvec mult; // nu-scatter multiplication (nu-scatt/scatt) + double_3dvec dist; // Angular distribution + int_1dvec gmin; // minimum outgoing group + int_1dvec gmax; // maximum outgoing group + double_1dvec scattxs; // Isotropic Sigma_{s,g_{in}} + + //! \brief Calculates the value of normalized f(mu). + //! + //! The value of f(mu) is normalized as in the integral of f(mu)dmu across + //! [-1,1] is 1. + //! + //! @param gin Incoming energy group of interest. + //! @param gout Outgoing energy group of interest. + //! @param mu Cosine of the change-in-angle of interest. + //! @return The value of f(mu). + virtual double + calc_f(int gin, int gout, double mu) = 0; + + //! \brief Samples the outgoing energy and angle from the ScattData info. + //! + //! @param gin Incoming energy group. + //! @param gout Sampled outgoing energy group. + //! @param mu Sampled cosine of the change-in-angle. + //! @param wgt Weight of the particle to be adjusted. + virtual void + sample(int gin, int& gout, double& mu, double& wgt) = 0; + + //! \brief Initializes the ScattData object from a given scatter and + //! multiplicity matrix. + //! + //! @param in_gmin List of minimum outgoing groups for every incoming group + //! @param in_gmax List of maximum outgoing groups for every incoming group + //! @param in_mult Input sparse multiplicity matrix + //! @param coeffs Input sparse scattering matrix + virtual void + init(const int_1dvec& in_gmin, const int_1dvec& in_gmax, + const double_2dvec& in_mult, const double_3dvec& coeffs) = 0; + + //! \brief Combines the microscopic data. + //! + //! @param those_scatts Microscopic objects to combine. + //! @param scalars Scalars to multiply the microscopic data by. + virtual void + combine(const std::vector& those_scatts, + const double_1dvec& scalars) = 0; + + //! \brief Getter for the dimensionality of the scattering order. + //! + //! If Legendre this is the "n" in "Pn"; for Tabular, this is the number + //! of points, and for Histogram this is the number of bins. + //! + //! @return The order. + virtual int + get_order() = 0; + + //! \brief Builds a dense scattering matrix from the constituent parts + //! + //! @param max_order If Legendre this is the maximum value of "n" in "Pn" + //! requested; ignored otherwise. + //! @return The dense scattering matrix. + virtual double_3dvec + get_matrix(int max_order) = 0; + + //! \brief Samples the outgoing energy from the ScattData info. + //! + //! @param gin Incoming energy group. + //! @param gout Sampled outgoing energy group. + //! @param i_gout Sampled outgoing energy group index. + void + sample_energy(int gin, int& gout, int& i_gout); + + //! \brief Provides a cross section value given certain parameters + //! + //! @param xstype Type of cross section requested, according to the + //! enumerated constants. + //! @param gin Incoming energy group. + //! @param gout Outgoing energy group; use nullptr if irrelevant, or if a + //! sum is requested. + //! @param mu Cosine of the change-in-angle, for scattering quantities; + //! use nullptr if irrelevant. + //! @return Requested cross section value. + double + get_xs(int xstype, int gin, const int* gout, const double* mu); +}; + +//============================================================================== +// ScattDataLegendre represents the angular distributions as Legendre kernels +//============================================================================== + +class ScattDataLegendre: public ScattData { + + protected: + + // Maximal value for rejection sampling from a rectangle + double_2dvec max_val; + + // Friend convert_legendre_to_tabular so it has access to protected + // parameters + friend void + convert_legendre_to_tabular(ScattDataLegendre& leg, + ScattDataTabular& tab, int n_mu); + + public: + + void + init(const int_1dvec& in_gmin, const int_1dvec& in_gmax, + const double_2dvec& in_mult, const double_3dvec& coeffs); + + void + combine(const std::vector& those_scatts, + const double_1dvec& scalars); + + //! \brief Find the maximal value of the angular distribution to use as a + // bounding box with rejection sampling. + void + update_max_val(); + + double + calc_f(int gin, int gout, double mu); + + void + sample(int gin, int& gout, double& mu, double& wgt); + + int + get_order() {return dist[0][0].size() - 1;}; + + double_3dvec + get_matrix(int max_order); +}; + +//============================================================================== +// ScattDataHistogram represents the angular distributions as a histogram, as it +// would be if it came from a "mu" tally in OpenMC +//============================================================================== + +class ScattDataHistogram: public ScattData { + + protected: + + double_1dvec mu; // Angle distribution mu bin boundaries + double dmu; // Quick storage of the spacing between the mu bin points + double_3dvec fmu; // The angular distribution histogram + + public: + + void + init(const int_1dvec& in_gmin, const int_1dvec& in_gmax, + const double_2dvec& in_mult, const double_3dvec& coeffs); + + void + combine(const std::vector& those_scatts, + const double_1dvec& scalars); + + double + calc_f(int gin, int gout, double mu); + + void + sample(int gin, int& gout, double& mu, double& wgt); + + int + get_order() {return dist[0][0].size();}; + + double_3dvec + get_matrix(int max_order); +}; + +//============================================================================== +// ScattDataTabular represents the angular distributions as a table of mu and +// f(mu) +//============================================================================== + +class ScattDataTabular: public ScattData { + + protected: + + double_1dvec mu; // Angle distribution mu grid points + double dmu; // Quick storage of the spacing between the mu points + double_3dvec fmu; // The angular distribution function + + // Friend convert_legendre_to_tabular so it has access to protected + // parameters + friend void + convert_legendre_to_tabular(ScattDataLegendre& leg, + ScattDataTabular& tab, int n_mu); + + public: + + void + init(const int_1dvec& in_gmin, const int_1dvec& in_gmax, + const double_2dvec& in_mult, const double_3dvec& coeffs); + + void + combine(const std::vector& those_scatts, + const double_1dvec& scalars); + + double + calc_f(int gin, int gout, double mu); + + void + sample(int gin, int& gout, double& mu, double& wgt); + + int + get_order() {return dist[0][0].size();}; + + double_3dvec get_matrix(int max_order); +}; + +//============================================================================== +// Function to convert Legendre functions to tabular +//============================================================================== + +//! \brief Converts a ScattDatalegendre to a ScattDataHistogram +//! +//! @param leg The initial ScattDataLegendre object. +//! @param leg The resultant ScattDataTabular object. +//! @param n_mu The number of mu points to use when building the +//! ScattDataTabular object. +void +convert_legendre_to_tabular(ScattDataLegendre& leg, ScattDataTabular& tab, + int n_mu); + +} // namespace openmc +#endif // SCATTDATA_H \ No newline at end of file diff --git a/src/scattdata_header.F90 b/src/scattdata_header.F90 deleted file mode 100644 index 511e2a2376..0000000000 --- a/src/scattdata_header.F90 +++ /dev/null @@ -1,852 +0,0 @@ -module scattdata_header - - use algorithm, only: binary_search - use constants - use error, only: fatal_error - use math - use random_lcg, only: prn - - implicit none - - -!=============================================================================== -! JAGGED1D and JAGGED2D is a type which allows for jagged 1-D or 2-D array. -!=============================================================================== - - type :: Jagged2D - real(8), allocatable :: data(:, :) - end type Jagged2D - - type :: Jagged1D - real(8), allocatable :: data(:) - end type Jagged1D - -!=============================================================================== -! SCATTDATA contains all the data to describe the scattering energy and -! angular distribution -!=============================================================================== - - type, abstract :: ScattData - ! The data attribute of the energy, mult, and dist arrays - ! are not necessarily 1-indexed as they instead will be allocated - ! from a minimum outgoing group to an outgoing minimum group. - ! Normalized p0 matrix on its own for sampling energy - type(Jagged1D), allocatable :: energy(:) ! (Gin % data(Gout)) - ! Nu-scatter multiplication (i.e. nu-scatt/scatt) - type(Jagged1D), allocatable :: mult(:) ! (Gin % data(Gout)) - ! Angular distribution - type(Jagged2D), allocatable :: dist(:) ! (Gin % data(Order/Nmu, Gout) - integer, allocatable :: gmin(:) ! Minimum outgoing group - integer, allocatable :: gmax(:) ! Maximum outgoing group - real(8), allocatable :: scattxs(:) ! Isotropic Sigma_{s,g_{in}} - - contains - procedure(scattdata_init_), deferred :: init ! Initializes ScattData - procedure(scattdata_calc_f_), deferred :: calc_f ! Calculates f, given mu - procedure(scattdata_sample_), deferred :: sample ! sample the scatter event - procedure :: get_matrix => scattdata_get_matrix ! Rebuild scattering matrix - end type ScattData - - abstract interface - subroutine scattdata_init_(this, gmin, gmax, mult, coeffs) - import ScattData, Jagged1D, Jagged2D - class(ScattData), intent(inout) :: this ! Object to work with - integer, intent(in) :: gmin(:) ! Min Gout - integer, intent(in) :: gmax(:) ! Max Gout - type(Jagged1D), intent(in) :: mult(:) ! Scatter Prod'n Matrix - type(Jagged2D), intent(in) :: coeffs(:) ! Coefficients to use - end subroutine scattdata_init_ - - pure function scattdata_calc_f_(this, gin, gout, mu) result(f) - import ScattData - class(ScattData), intent(in) :: this ! Scattering Object to work with - 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 scattdata_calc_f_ - - subroutine scattdata_sample_(this, gin, gout, mu, wgt) - import ScattData - class(ScattData), intent(in) :: this ! Scattering Object to work with - 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 scattdata_sample_ - end interface - - type, extends(ScattData) :: ScattDataLegendre - ! Maximal value for rejection sampling from rectangle - type(Jagged1D), allocatable :: max_val(:) ! (Gin % data(Gout)) - contains - procedure :: init => scattdatalegendre_init - procedure :: calc_f => scattdatalegendre_calc_f - procedure :: sample => scattdatalegendre_sample - end type ScattDataLegendre - - type, extends(ScattData) :: ScattDataHistogram - real(8), allocatable :: mu(:) ! Mu bins - real(8) :: dmu ! Mu spacing - ! Histogram of f(mu) (dist has CDF) - type(Jagged2D), allocatable :: fmu(:) ! (Gin % data(Order/Nmu x Gout) - contains - procedure :: init => scattdatahistogram_init - procedure :: calc_f => scattdatahistogram_calc_f - procedure :: sample => scattdatahistogram_sample - procedure :: get_matrix => scattdatahistogram_get_matrix - end type ScattDataHistogram - - type, extends(ScattData) :: ScattDataTabular - real(8), allocatable :: mu(:) ! Mu bins - real(8) :: dmu ! Mu spacing - ! PDF of f(mu) (dist has CDF) - type(Jagged2D), allocatable :: fmu(:) ! (Gin % data(Order/Nmu x Gout) - contains - procedure :: init => scattdatatabular_init - procedure :: calc_f => scattdatatabular_calc_f - procedure :: sample => scattdatatabular_sample - procedure :: get_matrix => scattdatatabular_get_matrix - end type ScattDataTabular - -!=============================================================================== -! SCATTDATACONTAINER allocatable array for storing ScattData Objects (for angle) -!=============================================================================== - - type ScattDataContainer - class(ScattData), allocatable :: obj - end type ScattDataContainer - -contains - -!=============================================================================== -! SCATTDATA*_INIT builds the scattdata object -!=============================================================================== - - subroutine scattdata_init(this, order, gmin, gmax, energy, mult) - class(ScattData), intent(inout) :: this ! Object to work on - integer, intent(in) :: order ! Data Order - integer, intent(in) :: gmin(:) ! Min Gout - integer, intent(in) :: gmax(:) ! Max Gout - type(Jagged1D), intent(inout) :: energy(:) ! Energy Transfer Matrix - type(Jagged1D), intent(in) :: mult(:) ! Scatter Prod'n Matrix - - integer :: groups, gin - real(8) :: norm - - groups = size(energy, dim=1) - - allocate(this % gmin(groups)) - allocate(this % gmax(groups)) - allocate(this % energy(groups)) - allocate(this % mult(groups)) - allocate(this % dist(groups)) - - this % gmin = gmin - this % gmax = gmax - - ! Set the outgoing energy PDF values - do gin = 1, groups - ! Make sure energy is normalized (i.e., CDF is 1) - norm = sum(energy(gin) % data(:)) - if (norm /= ZERO) energy(gin) % data(:) = energy(gin) % data(:) / norm - ! Set the values - allocate(this % energy(gin) % data(gmin(gin):gmax(gin))) - this % energy(gin) % data(:) = energy(gin) % data(:) - allocate(this % mult(gin) % data(gmin(gin):gmax(gin))) - this % mult(gin) % data(gmin(gin):gmax(gin)) = & - mult(gin) % data(gmin(gin):gmax(gin)) - allocate(this % dist(gin) % data(order, gmin(gin):gmax(gin))) - this % dist(gin) % data = ZERO - end do - end subroutine scattdata_init - - subroutine scattdatalegendre_init(this, gmin, gmax, mult, coeffs) - class(ScattDataLegendre), intent(inout) :: this ! Object to work on - integer, intent(in) :: gmin(:) ! Min Gout - integer, intent(in) :: gmax(:) ! Max Gout - type(Jagged1D), intent(in) :: mult(:) ! Scatter Prod'n Matrix - type(Jagged2D), intent(in) :: coeffs(:) ! Coefficients to use - - real(8) :: dmu, mu, f, norm - integer :: imu, Nmu, gout, gin, groups, order - type(Jagged1D), allocatable :: energy(:) - type(Jagged2D), allocatable :: matrix(:) - - groups = size(coeffs) - order = size(coeffs(1) % data, dim=1) - - ! make a copy of coeffs that we can use to extract data and normalize - allocate(matrix(groups)) - do gin = 1, groups - allocate(matrix(gin) % data(order, gmin(gin):gmax(gin))) - matrix(gin) % data = coeffs(gin) % data - end do - - ! Get scattxs value - allocate(this % scattxs(groups)) - ! Get this by summing the un-normalized P0 coefficient in matrix - ! over all outgoing groups - do gin = 1, groups - this % scattxs(gin) = sum(matrix(gin) % data(1, :), dim=1) - end do - - allocate(energy(groups)) - ! Build energy transfer probability matrix from data in matrix - ! while also normalizing matrix itself (making CDF of f(mu=1)=1) - do gin = 1, groups - allocate(energy(gin) % data(gmin(gin):gmax(gin))) - energy(gin) % data = ZERO - do gout = gmin(gin), gmax(gin) - norm = matrix(gin) % data(1, gout) - energy(gin) % data(gout) = norm - if (norm /= ZERO) then - matrix(gin) % data(:, gout) = matrix(gin) % data(:, gout) / norm - end if - end do - end do - - call scattdata_init(this, order, gmin, gmax, energy, mult) - - allocate(this % max_val(groups)) - ! Set dist values from matrix and initialize max_val - do gin = 1, groups - do gout = gmin(gin), gmax(gin) - this % dist(gin) % data(:, gout) = matrix(gin) % data(:, gout) - end do - allocate(this % max_val(gin) % data(gmin(gin):gmax(gin))) - this % max_val(gin) % data(:) = ZERO - end do - - ! Step through the polynomial with fixed number of points to identify - ! the maximal value. - Nmu = 1001 - dmu = TWO / real(Nmu - 1, 8) - do gin = 1, groups - do gout = gmin(gin), gmax(gin) - do imu = 1, Nmu - ! Update mu. Do first and last seperate to avoid float errors - if (imu == 1) then - mu = -ONE - else if (imu == Nmu) then - mu = ONE - else - mu = -ONE + real(imu - 1, 8) * dmu - end if - ! Calculate probability - f = this % calc_f(gin,gout,mu) - ! If this is a new max, store it. - if (f > this % max_val(gin) % data(gout)) & - this % max_val(gin) % data(gout) = f - end do - ! Finally, since we may not have caught the exact max, add 10% margin - this % max_val(gin) % data(gout) = & - this % max_val(gin) % data(gout) * 1.1_8 - end do - end do - end subroutine scattdatalegendre_init - - subroutine scattdatahistogram_init(this, gmin, gmax, mult, coeffs) - class(ScattDataHistogram), intent(inout) :: this ! Object to work on - integer, intent(in) :: gmin(:) ! Min Gout - integer, intent(in) :: gmax(:) ! Max Gout - type(Jagged1D), intent(in) :: mult(:) ! Scatter Prod'n Matrix - type(Jagged2D), intent(in) :: coeffs(:) ! Coefficients to use - - integer :: imu, gin, gout, groups, order - real(8) :: norm - type(Jagged1D), allocatable :: energy(:) - type(Jagged2D), allocatable :: matrix(:) - - groups = size(coeffs) - order = size(coeffs(1) % data, dim=1) - - ! make a copy of coeffs that we can use to extract data and normalize - allocate(matrix(groups)) - do gin = 1, groups - allocate(matrix(gin) % data(order, gmin(gin):gmax(gin))) - matrix(gin) % data(:, :) = coeffs(gin) % data(:, :) - end do - - ! Get scattxs value - allocate(this % scattxs(groups)) - ! Get this by summing the un-normalized angular distribution in matrix - ! over all outgoing groups - do gin = 1, groups - this % scattxs(gin) = sum(matrix(gin) % data(:, :)) - end do - - allocate(energy(groups)) - ! Build energy transfer probability matrix from data in matrix - ! while also normalizing matrix itself (making CDF of f(mu=1)=1) - do gin = 1, groups - allocate(energy(gin) % data(gmin(gin):gmax(gin))) - do gout = gmin(gin), gmax(gin) - norm = sum(matrix(gin) % data(:, gout)) - energy(gin) % data(gout) = norm - if (norm /= ZERO) then - matrix(gin) % data(:, gout) = matrix(gin) % data(:, gout) / norm - end if - end do - end do - - call scattdata_init(this, order, gmin, gmax, energy, mult) - - allocate(this % mu(order)) - this % dmu = TWO / real(order, 8) - this % mu(1) = -ONE - do imu = 2, order - this % mu(imu) = -ONE + real(imu - 1, 8) * this % dmu - end do - - ! Integrate this histogram so we can avoid rejection sampling while - ! also saving the original histogram in fmu - allocate(this % fmu(groups)) - do gin = 1, groups - allocate(this % fmu(gin) % data(order, gmin(gin):gmax(gin))) - do gout = gmin(gin), gmax(gin) - ! Store the histogram - this % fmu(gin) % data(:, gout) = matrix(gin) % data(:, gout) - ! Integrate the histogram - this % dist(gin) % data(1, gout) = & - this % dmu * matrix(gin) % data(1, gout) - do imu = 2, order - this % dist(gin) % data(imu, gout) = & - this % dmu * matrix(gin) % data(imu, gout) + & - this % dist(gin) % data(imu - 1, gout) - end do - - ! Normalize the integral to unity - norm = this % dist(gin) % data(order, gout) - if (norm > ZERO) then - this % fmu(gin) % data(:, gout) = & - this % fmu(gin) % data(:, gout) / norm - this % dist(gin) % data(:, gout) = & - this % dist(gin) % data(:, gout) / norm - end if - end do - end do - - end subroutine scattdatahistogram_init - - subroutine scattdatatabular_init(this, gmin, gmax, mult, coeffs) - class(ScattDataTabular), intent(inout) :: this ! Object to work on - integer, intent(in) :: gmin(:) ! Min Gout - integer, intent(in) :: gmax(:) ! Max Gout - type(Jagged1D), intent(in) :: mult(:) ! Scatter Prod'n Matrix - type(Jagged2D), intent(in) :: coeffs(:) ! Coefficients to use - - integer :: imu, gin, gout, groups, order - real(8) :: norm - type(Jagged1D), allocatable :: energy(:) - type(Jagged2D), allocatable :: matrix(:) - - groups = size(coeffs) - order = size(coeffs(1) % data, dim=1) - - ! make a copy of coeffs that we can use to extract data and normalize - allocate(matrix(groups)) - do gin = 1, groups - allocate(matrix(gin) % data(order, gmin(gin):gmax(gin))) - matrix(gin) % data = coeffs(gin) % data - end do - - ! Build the angular distribution mu values - allocate(this % mu(order)) - this % dmu = TWO / real(order - 1, 8) - this % mu(1) = -ONE - do imu = 2, order - 1 - this % mu(imu) = -ONE + real(imu - 1, 8) * this % dmu - end do - this % mu(order) = ONE - - ! Get scattxs - allocate(this % scattxs(groups)) - ! Get this by integrating the scattering distribution over all mu points - ! and then combining over all outgoing groups - ! over all outgoing groups - do gin = 1, groups - norm = ZERO - do gout = gmin(gin), gmax(gin) - do imu = 2, order - norm = norm + HALF * this % dmu * & - (matrix(gin) % data(imu - 1, gout) + & - matrix(gin) % data(imu, gout)) - end do - end do - this % scattxs(gin) = norm - end do - - allocate(energy(groups)) - ! Build energy transfer probability matrix from data in matrix - do gin = 1, groups - allocate(energy(gin) % data(gmin(gin):gmax(gin))) - do gout = gmin(gin), gmax(gin) - norm = ZERO - do imu = 2, order - norm = norm + HALF * this % dmu * & - (matrix(gin) % data(imu - 1, gout) + & - matrix(gin) % data(imu, gout)) - end do - energy(gin) % data(gout) = norm - end do - end do - call scattdata_init(this, order, gmin, gmax, energy, mult) - - ! Calculate f(mu) and integrate it so we can avoid rejection sampling - allocate(this % fmu(groups)) - do gin = 1, groups - allocate(this % fmu(gin) % data(order, gmin(gin):gmax(gin))) - do gout = gmin(gin), gmax(gin) - ! Coeffs contain f(mu), put in f(mu) as that is where the - ! PDF lives - this % fmu(gin) % data(:, gout) = matrix(gin) % data(:, gout) - - ! Force positivity - do imu = 1, order - if (this % fmu(gin) % data(imu, gout) < ZERO) then - this % fmu(gin) % data(imu, gout) = ZERO - end if - end do - - ! Re-normalize fmu for numerical integration issues and in case - ! the negative fix-up introduced un-normalized data while - ! accruing the CDF - norm = ZERO - do imu = 2, order - norm = norm + HALF * this % dmu * & - (this % fmu(gin) % data(imu - 1, gout) + & - this % fmu(gin) % data(imu, gout)) - this % dist(gin) % data(imu, gout) = norm - end do - if (norm > ZERO) then - this % fmu(gin) % data(:, gout) = & - this % fmu(gin) % data(:, gout) / norm - this % dist(gin) % data(:, gout) = & - this % dist(gin) % data(:, gout) / norm - end if - end do - end do - end subroutine scattdatatabular_init - -!=============================================================================== -! SCATTDATA_*_CALC_F Calculates the value of f given mu (and gin,gout pair) -!=============================================================================== - - 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 - real(8) :: f ! Return value of f(mu) - - ! Plug mu in to the legendre expansion and go from there - if (gout < this % gmin(gin) .or. gout > this % gmax(gin)) then - f = ZERO - else - f = evaluate_legendre(this % dist(gin) % data(:, gout), mu) - end if - - end function scattdatalegendre_calc_f - - 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 - real(8) :: f ! Return value of f(mu) - - integer :: imu - - if (gout < this % gmin(gin) .or. gout > this % gmax(gin)) then - f = ZERO - else - ! Find mu bin - if (mu == ONE) then - imu = size(this % fmu(gin) % data, dim=1) - else - imu = floor((mu + ONE) / this % dmu + ONE) - end if - - f = this % fmu(gin) % data(imu, gout) - end if - - end function scattdatahistogram_calc_f - - 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 - real(8) :: f ! Return value of f(mu) - - integer :: imu - real(8) :: r - - if (gout < this % gmin(gin) .or. gout > this % gmax(gin)) then - f = ZERO - else - ! Find mu bin - if (mu == ONE) then - imu = size(this % fmu(gin) % data, dim=1) - 1 - else - imu = floor((mu + ONE) / this % dmu + ONE) - end if - - ! Now interpolate to find f(mu) - r = (mu - this % mu(imu)) / (this % mu(imu + 1) - this % mu(imu)) - f = (ONE - r) * this % fmu(gin) % data(imu, gout) + & - r * this % fmu(gin) % data(imu + 1, gout) - end if - - 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() - gout = this % gmin(gin) - prob = this % energy(gin) % data(gout) - - do while ((prob < xi) .and. (gout < this % gmax(gin))) - gout = gout + 1 - prob = prob + this % energy(gin) % data(gout) - end do - - ! Now we can sample mu using the legendre representation of the scattering - ! kernel in data(1:this % order) - - ! Do with rejection sampling from a rectangular bounding box - ! Set maximal value - M = this % max_val(gin) % data(gout) - 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(gin) % data(gout) - - 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() - gout = this % gmin(gin) - prob = this % energy(gin) % data(gout) - - do while ((prob < xi) .and. (gout < this % gmax(gin))) - gout = gout + 1 - prob = prob + this % energy(gin) % data(gout) - end do - - xi = prn() - if (xi < this % dist(gin) % data(1, gout)) then - imu = 1 - else - imu = binary_search(this % dist(gin) % data(:, gout), & - size(this % dist(gin) % data(:, gout)), xi) + 1 - end if - - ! Randomly select a mu in this bin. - mu = prn() * this % dmu + this % mu(imu) - - wgt = wgt * this % mult(gin) % data(gout) - - 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() - gout = this % gmin(gin) - prob = this % energy(gin) % data(gout) - - do while ((prob < xi) .and. (gout < this % gmax(gin))) - gout = gout + 1 - prob = prob + this % energy(gin) % data(gout) - end do - - ! determine outgoing cosine bin - NP = size(this % dist(gin) % data(:, gout)) - xi = prn() - - c_k = this % dist(gin) % data(1, gout) - do k = 1, NP - 1 - c_k1 = this % dist(gin) % data(k + 1, gout) - 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(gin) % data(k, gout) - mu0 = this % mu(k) - ! Linear-linear interpolation to find mu value w/in bin. - p1 = this % fmu(gin) % data(k + 1, gout) - mu1 = this % mu(k + 1) - - if (p0 == p1) then - mu = mu0 + (xi - c_k) / p0 - else - frac = (p1 - p0) / (mu1 - mu0) - 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(gin) % data(gout) - - end subroutine scattdatatabular_sample - -!=============================================================================== -! SCATTDATA*_GET_MATRIX Reproduces the original scattering matrix (densely) -! using ScattData's information of fmu/dist, energy, and scattxs -!=============================================================================== - - subroutine scattdata_get_matrix(this, req_order, matrix) - class(ScattData), intent(in) :: this ! Scattering Object to work with - integer, intent(in) :: req_order ! Requested order of matrix - type(Jagged2D), allocatable, intent(inout) :: matrix(:) ! Resultant matrix just built - - integer :: order, groups, gin, gout - - groups = size(this % energy) - ! Set gin and gout for getting the order - order = min(req_order, size(this % dist(1) % data, dim=1)) - - if (allocated(matrix)) deallocate(matrix) - allocate(matrix(groups)) - ! Initialize to 0; this way the zero entries in the dense matrix dont - ! need to be explicitly set, requiring a significant increase in the - ! lines of code. - do gin = 1, groups - allocate(matrix(gin) % data(order, groups)) - do gout = this % gmin(gin), this % gmax(gin) - matrix(gin) % data(:, gout) = this % scattxs(gin) * & - this % energy(gin) % data(gout) * & - this % dist(gin) % data(1:order, gout) - end do - end do - end subroutine scattdata_get_matrix - - subroutine scattdatahistogram_get_matrix(this, req_order, matrix) - class(ScattDataHistogram), intent(in) :: this ! Scattering Object to work with - integer, intent(in) :: req_order ! Requested order of matrix - type(Jagged2D), allocatable, intent(inout) :: matrix(:) ! Resultant matrix just built - - integer :: order, groups, gin, gout - - groups = size(this % energy) - order = min(req_order, size(this % dist(1) % data, dim=1)) - - if (allocated(matrix)) deallocate(matrix) - allocate(matrix(groups)) - ! Initialize to 0; this way the zero entries in the dense matrix dont - ! need to be explicitly set, requiring a significant increase in the - ! lines of code. - do gin = 1, groups - allocate(matrix(gin) % data(order, groups)) - do gout = this % gmin(gin), this % gmax(gin) - matrix(gin) % data(:, gout) = this % scattxs(gin) * & - this % energy(gin) % data(gout) * & - this % fmu(gin) % data(1:order, gout) - end do - end do - end subroutine scattdatahistogram_get_matrix - - subroutine scattdatatabular_get_matrix(this, req_order, matrix) - class(ScattDataTabular), intent(in) :: this ! Scattering Object to work with - integer, intent(in) :: req_order ! Requested order of matrix - type(Jagged2D), allocatable, intent(inout) :: matrix(:) ! Resultant matrix just built - - integer :: order, groups, gin, gout - - groups = size(this % energy) - order = min(req_order, size(this % dist(1) % data, dim=1)) - - if (allocated(matrix)) deallocate(matrix) - allocate(matrix(groups)) - ! Initialize to 0; this way the zero entries in the dense matrix dont - ! need to be explicitly set, requiring a significant increase in the - ! lines of code. - do gin = 1, groups - allocate(matrix(gin) % data(order, groups)) - do gout = this % gmin(gin), this % gmax(gin) - matrix(gin) % data(:, gout) = this % scattxs(gin) * & - this % energy(gin) % data(gout) * & - this % fmu(gin) % data(1:order, gout) - end do - end do - end subroutine scattdatatabular_get_matrix - -!=============================================================================== -! JAGGED_FROM_DENSE_*D Creates a jagged array from a sparse dense matrix. -! The user can supply a key which indicates the values to remove, but the -! default is ZERO -!=============================================================================== - - subroutine jagged_from_dense_1D(dense, jagged, lo_bounds_, hi_bounds_, key_) - real(8), intent(in) :: dense(:, :) - type(Jagged1D), allocatable, intent(inout) :: jagged(:) - real(8), intent(in), optional :: key_ - integer, intent(inout), allocatable, optional :: lo_bounds_(:) - integer, intent(inout), allocatable, optional :: hi_bounds_(:) - - real(8) :: key - integer :: i, jmin, jmax - integer, allocatable :: lo_bounds(:), hi_bounds(:) - - if (present(key_)) then - key = key_ - else - key = ZERO - end if - - allocate(lo_bounds(size(dense, dim=2))) - allocate(hi_bounds(size(dense, dim=2))) - - if (allocated(jagged)) deallocate(jagged) - allocate(jagged(size(dense, dim=2))) - do i = 1, size(dense, dim=2) - ! Find the min and max j values - do jmin = 1, size(dense, dim=1) - if (dense(jmin, i) /= key) exit - end do - do jmax = size(dense, dim=1), 1, -1 - if (dense(jmax, i) /= key) exit - end do - ! Treat the case of all values matching the key - if (jmin > jmax) then - jmin = i - jmax = i - end if - - ! Now store the jagged row - allocate(jagged(i) % data(jmin:jmax)) - jagged(i) % data(jmin:jmax) = dense(jmin:jmax, i) - - lo_bounds(i) = jmin - hi_bounds(i) = jmax - end do - - if (present(lo_bounds_)) then - if (allocated(lo_bounds_)) deallocate(lo_bounds_) - allocate(lo_bounds_(size(dense, dim=2))) - lo_bounds_ = lo_bounds - end if - if (present(hi_bounds_)) then - if (allocated(hi_bounds_)) deallocate(hi_bounds_) - allocate(hi_bounds_(size(dense, dim=2))) - hi_bounds_ = hi_bounds - end if - - end subroutine jagged_from_dense_1D - - subroutine jagged_from_dense_2D(dense, jagged, lo_bounds_, hi_bounds_, key_) - real(8), intent(in) :: dense(:, :, :) - type(Jagged2D), allocatable, intent(inout) :: jagged(:) - real(8), intent(in), optional :: key_ - integer, intent(inout), allocatable, optional :: lo_bounds_(:) - integer, intent(inout), allocatable, optional :: hi_bounds_(:) - - real(8) :: key - integer :: i, jmin, jmax - integer, allocatable :: lo_bounds(:), hi_bounds(:) - - if (present(key_)) then - key = key_ - else - key = ZERO - end if - - allocate(lo_bounds(size(dense, dim=3))) - allocate(hi_bounds(size(dense, dim=3))) - - if (allocated(jagged)) deallocate(jagged) - allocate(jagged(size(dense, dim=3))) - do i = 1, size(dense, dim=3) - ! Find the min and max j values - do jmin = 1, size(dense, dim=2) - if (any(dense(:, jmin, i) /= key)) exit - end do - do jmax = size(dense, dim=2), 1, -1 - if (any(dense(:, jmax, i) /= key)) exit - end do - ! Treat the case of all values matching the key - if (jmin > jmax) then - jmin = i - jmax = i - end if - - ! Now store the jagged row - allocate(jagged(i) % data(size(dense, dim=1), jmin:jmax)) - jagged(i) % data(:, jmin:jmax) = dense(:, jmin:jmax, i) - - lo_bounds(i) = jmin - hi_bounds(i) = jmax - end do - - if (present(lo_bounds_)) then - if (allocated(lo_bounds_)) deallocate(lo_bounds_) - allocate(lo_bounds_(size(dense, dim=3))) - lo_bounds_ = lo_bounds - end if - if (present(hi_bounds_)) then - if (allocated(hi_bounds_)) deallocate(hi_bounds_) - allocate(hi_bounds_(size(dense, dim=3))) - hi_bounds_ = hi_bounds - end if - - end subroutine jagged_from_dense_2D - -end module scattdata_header diff --git a/src/settings.F90 b/src/settings.F90 index f34d57e186..c1bb09b41d 100644 --- a/src/settings.F90 +++ b/src/settings.F90 @@ -18,9 +18,9 @@ module settings logical :: urr_ptables_on = .true. ! Default temperature and method for choosing temperatures - integer :: temperature_method = TEMPERATURE_NEAREST + integer(C_INT) :: temperature_method = TEMPERATURE_NEAREST logical :: temperature_multipole = .false. - real(8) :: temperature_tolerance = 10.0_8 + real(C_DOUBLE) :: temperature_tolerance = 10.0_8 real(8) :: temperature_default = 293.6_8 real(8) :: temperature_range(2) = [ZERO, ZERO] @@ -33,13 +33,16 @@ module settings ! MULTI-GROUP CROSS SECTION RELATED VARIABLES ! Maximum Data Order - integer :: max_order + integer(C_INT) :: max_order ! Whether or not to convert Legendres to tabulars logical :: legendre_to_tabular = .true. ! Number of points to use in the Legendre to tabular conversion - integer :: legendre_to_tabular_points = 33 + integer(C_INT) :: legendre_to_tabular_points = C_NONE + + ! ============================================================================ + ! SIMULATION VARIABLES ! Assume all tallies are spatially distinct logical :: assume_separate = .false. @@ -47,9 +50,6 @@ module settings ! Use confidence intervals for results instead of standard deviations logical :: confidence_intervals = .false. - ! ============================================================================ - ! SIMULATION VARIABLES - integer(C_INT64_T), bind(C) :: n_particles = 0 ! # of particles per generation integer(C_INT32_T), bind(C) :: n_batches ! # of batches integer(C_INT32_T), bind(C) :: n_inactive ! # of inactive batches diff --git a/src/simulation.F90 b/src/simulation.F90 index a4e0b09b07..e721036f29 100644 --- a/src/simulation.F90 +++ b/src/simulation.F90 @@ -20,7 +20,7 @@ module simulation use geometry_header, only: n_cells use material_header, only: n_materials, materials use message_passing - use mgxs_header, only: energy_bins, energy_bin_avg + use mgxs_interface, only: energy_bins, energy_bin_avg use nuclide_header, only: micro_xs, n_nuclides use output, only: header, print_columns, & print_batch_keff, print_generation, print_runtime, & diff --git a/src/source.F90 b/src/source.F90 index 3683611315..a6b6a92ac2 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -14,7 +14,7 @@ module source use hdf5_interface use math use message_passing, only: rank - use mgxs_header, only: rev_energy_bins, num_energy_groups + use mgxs_interface, only: rev_energy_bins, num_energy_groups use output, only: write_message use particle_header, only: Particle use random_lcg, only: prn, set_particle_seed, prn_set_stream diff --git a/src/state_point.F90 b/src/state_point.F90 index 27fdd969b5..ebb473d496 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -22,7 +22,7 @@ module state_point use hdf5_interface use mesh_header, only: RegularMesh, meshes, n_meshes use message_passing - use mgxs_header, only: nuclides_MG + use mgxs_interface use nuclide_header, only: nuclides use output, only: time_stamp use random_lcg, only: openmc_get_seed, openmc_set_seed @@ -73,6 +73,7 @@ contains character(MAX_WORD_LEN), allocatable :: str_array(:) character(C_CHAR), pointer :: string(:) character(len=:, kind=C_CHAR), allocatable :: filename_ + character(MAX_WORD_LEN, kind=C_CHAR) :: temp_name err = 0 if (present(filename)) then @@ -307,11 +308,13 @@ contains str_array(j) = nuclides(tally % nuclide_bins(j)) % name end if else - i_xs = index(nuclides_MG(tally % nuclide_bins(j)) % obj % name, '.') + call get_name_c(tally % nuclide_bins(j), len(temp_name), & + temp_name) + i_xs = index(temp_name, '.') if (i_xs > 0) then - str_array(j) = nuclides_MG(tally % nuclide_bins(j)) % obj % name(1 : i_xs-1) + str_array(j) = trim(temp_name(1 : i_xs-1)) else - str_array(j) = nuclides_MG(tally % nuclide_bins(j)) % obj % name + str_array(j) = trim(temp_name) end if end if else diff --git a/src/string_functions.cpp b/src/string_functions.cpp new file mode 100644 index 0000000000..f41ec40c1e --- /dev/null +++ b/src/string_functions.cpp @@ -0,0 +1,30 @@ +#include "string_functions.h" + +namespace openmc { + +std::string& strtrim(std::string& s) +{ + const char* t = " \t\n\r\f\v"; + s.erase(s.find_last_not_of(t) + 1); + s.erase(0, s.find_first_not_of(t)); + return s; +} + + +char* strtrim(char* c_str) +{ + std::string std_str; + std_str.assign(c_str); + strtrim(std_str); + int length = std_str.copy(c_str, std_str.size()); + c_str[length] = '\0'; + return c_str; +} + + +void to_lower(std::string& str) +{ + for (int i = 0; i < str.size(); i++) str[i] = std::tolower(str[i]); +} + +} // namespace openmc \ No newline at end of file diff --git a/src/string_functions.h b/src/string_functions.h new file mode 100644 index 0000000000..bf30612fe8 --- /dev/null +++ b/src/string_functions.h @@ -0,0 +1,18 @@ +//! \file string_functions.h +//! A collection of helper routines for C-strings and STL strings + +#ifndef STRING_FUNCTIONS_H +#define STRING_FUNCTIONS_H + +#include + +namespace openmc { + +std::string& strtrim(std::string& s); + +char* strtrim(char* c_str); + +void to_lower(std::string& str); + +} // namespace openmc +#endif // STRING_FUNCTIONS_H diff --git a/src/summary.F90 b/src/summary.F90 index 940e3128ab..062b4efc24 100644 --- a/src/summary.F90 +++ b/src/summary.F90 @@ -8,7 +8,7 @@ module summary use material_header, only: Material, n_materials use mesh_header, only: RegularMesh use message_passing - use mgxs_header, only: nuclides_MG + use mgxs_interface use nuclide_header use output, only: time_stamp use settings, only: run_CE @@ -93,7 +93,7 @@ contains num_nuclides = 0 num_macros = 0 do i = 1, n_nuclides - if (nuclides_MG(i) % obj % awr /= MACROSCOPIC_AWR) then + if (get_awr_c(i) /= MACROSCOPIC_AWR) then num_nuclides = num_nuclides + 1 else num_macros = num_macros + 1 @@ -118,12 +118,14 @@ contains nuc_names(i) = nuclides(i) % name awrs(i) = nuclides(i) % awr else - if (nuclides_MG(i) % obj % awr /= MACROSCOPIC_AWR) then - nuc_names(j) = nuclides_MG(i) % obj % name - awrs(j) = nuclides_MG(i) % obj % awr + if (get_awr_c(i) /= MACROSCOPIC_AWR) then + call get_name_c(i, len(nuc_names(j)), nuc_names(j)) + nuc_names(j) = trim(nuc_names(j)) + awrs(j) = get_awr_c(i) j = j + 1 else - macro_names(k) = nuclides_MG(i) % obj % name + call get_name_c(i, len(macro_names(k)), macro_names(k)) + macro_names(k) = trim(macro_names(k)) k = k + 1 end if end if @@ -353,7 +355,7 @@ contains num_nuclides = 0 num_macros = 0 do j = 1, m % n_nuclides - if (nuclides_MG(m % nuclide(j)) % obj % awr /= MACROSCOPIC_AWR) then + if (get_awr_c(m % nuclide(j)) /= MACROSCOPIC_AWR) then num_nuclides = num_nuclides + 1 else num_macros = num_macros + 1 @@ -379,12 +381,14 @@ contains k = 1 n = 1 do j = 1, m % n_nuclides - if (nuclides_MG(m % nuclide(j)) % obj % awr /= MACROSCOPIC_AWR) then - nuc_names(k) = nuclides_MG(m % nuclide(j)) % obj % name + if (get_awr_c(m % nuclide(j)) /= MACROSCOPIC_AWR) then + call get_name_c(m % nuclide(j), len(nuc_names(k)), nuc_names(k)) + nuc_names(k) = trim(nuc_names(k)) nuc_densities(k) = m % atom_density(j) k = k + 1 else - macro_names(n) = nuclides_MG(m % nuclide(j)) % obj % name + call get_name_c(m % nuclide(j), len(macro_names(n)), macro_names(n)) + macro_names(n) = trim(macro_names(n)) n = n + 1 end if end do diff --git a/src/tallies/tally.F90 b/src/tallies/tally.F90 index 407d25651e..0c9448b4e1 100644 --- a/src/tallies/tally.F90 +++ b/src/tallies/tally.F90 @@ -10,7 +10,7 @@ module tally use math, only: t_percentile use mesh_header, only: RegularMesh, meshes use message_passing - use mgxs_header + use mgxs_interface use nuclide_header use output, only: header use particle_header, only: LocalCoord, Particle @@ -1232,8 +1232,6 @@ contains real(8) :: p_uvw(3) ! Particle's current uvw integer :: p_g ! Particle group to use for getting info ! to tally with. - class(Mgxs), pointer :: matxs - class(Mgxs), pointer :: nucxs ! Set the direction and group to use with get_xs if (t % estimator == ESTIMATOR_ANALOG .or. & @@ -1271,13 +1269,13 @@ contains ! To significantly reduce de-referencing, point matxs to the ! macroscopic Mgxs for the material of interest - matxs => macro_xs(p % material) % obj + call set_macro_angle_index_c(p % material, p_uvw) ! Do same for nucxs, point it to the microscopic nuclide data of interest if (i_nuclide > 0) then - nucxs => nuclides_MG(i_nuclide) % obj ! And since we haven't calculated this temperature index yet, do so now - call nucxs % find_temperature(p % sqrtkT) + call set_nuclide_temperature_index_c(i_nuclide, p % sqrtkT) + call set_nuclide_angle_index_c(i_nuclide, p_uvw) end if i = 0 @@ -1331,14 +1329,14 @@ contains end if if (i_nuclide > 0) then - score = score * atom_density * & - nucxs % get_xs('total', p_g, UVW=p_uvw) / & - matxs % get_xs('total', p_g, UVW=p_uvw) * flux + score = score * flux * atom_density * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_TOTAL, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_TOTAL, p_g) end if else if (i_nuclide > 0) then - score = nucxs % get_xs('total', p_g, UVW=p_uvw) * & + score = get_nuclide_xs_c(i_nuclide, MG_GET_XS_TOTAL, p_g) * & atom_density * flux else score = material_xs % total * flux @@ -1361,19 +1359,23 @@ contains end if if (i_nuclide > 0) then - score = score * nucxs % get_xs('inverse-velocity', p_g, UVW=p_uvw) & - / matxs % get_xs('absorption', p_g, UVW=p_uvw) * flux + score = score * flux * get_nuclide_xs_c(i_nuclide, & + MG_GET_XS_INVERSE_VELOCITY, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else - score = score * matxs % get_xs('inverse-velocity', p_g, UVW=p_uvw) & - / matxs % get_xs('absorption', p_g, UVW=p_uvw) * flux + score = score * flux * get_macro_xs_c(p % material, & + MG_GET_XS_INVERSE_VELOCITY, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if else if (i_nuclide > 0) then - score = flux * nucxs % get_xs('inverse-velocity', p_g, UVW=p_uvw) + score = flux * get_nuclide_xs_c(i_nuclide, & + MG_GET_XS_INVERSE_VELOCITY, p_g) else - score = flux * matxs % get_xs('inverse-velocity', p_g, UVW=p_uvw) + score = flux * get_macro_xs_c(p % material, & + MG_GET_XS_INVERSE_VELOCITY, p_g) end if end if @@ -1395,21 +1397,23 @@ contains ! adjust the score by the actual probability for that nuclide. if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('scatter*f_mu/mult', p % last_g, p % g, & - UVW=p_uvw, MU=p % mu) / & - matxs % get_xs('scatter*f_mu/mult', p % last_g, p % g, & - UVW=p_uvw, MU=p % mu) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_SCATTER_FMU_MULT, & + p % last_g, p % g, MU=p % mu) / & + get_macro_xs_c(p % material, MG_GET_XS_SCATTER_FMU_MULT, & + p % last_g, p % g, MU=p % mu) end if else if (i_nuclide > 0) then score = atom_density * flux * & - nucxs % get_xs('scatter/mult', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_SCATTER_MULT, & + p_g, MU=p % mu) else ! Get the scattering x/s and take away ! the multiplication baked in to sigS score = flux * & - matxs % get_xs('scatter/mult', p_g, UVW=p_uvw) + get_macro_xs_c(p % material, MG_GET_XS_SCATTER_MULT, & + p_g, MU=p % mu) end if end if @@ -1431,19 +1435,20 @@ contains ! adjust the score by the actual probability for that nuclide. if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('scatter*f_mu', p % last_g, p % g, & - UVW=p_uvw, MU=p % mu) / & - matxs % get_xs('scatter*f_mu', p % last_g, p % g, & - UVW=p_uvw, MU=p % mu) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_SCATTER_FMU, & + p % last_g, p % g, MU=p % mu) / & + get_macro_xs_c(p % material, MG_GET_XS_SCATTER_FMU, & + p % last_g, p % g, MU=p % mu) end if else if (i_nuclide > 0) then - score = nucxs % get_xs('scatter', p_g, UVW=p_uvw) * & - atom_density * flux + score = atom_density * flux * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_SCATTER, p_g) else ! Get the scattering x/s, which includes multiplication - score = matxs % get_xs('scatter', p_g, UVW=p_uvw) * flux + score = flux * & + get_macro_xs_c(p % material, MG_GET_XS_SCATTER, p_g) end if end if @@ -1463,13 +1468,13 @@ contains end if if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('absorption', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_ABSORPTION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if else if (i_nuclide > 0) then - score = nucxs % get_xs('absorption', p_g, UVW=p_uvw) * & - atom_density * flux + score = atom_density * flux * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_ABSORPTION, p_g) else score = material_xs % absorption * flux end if @@ -1494,19 +1499,19 @@ contains end if if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else score = score * & - matxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_macro_xs_c(p % material, MG_GET_XS_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if else if (i_nuclide > 0) then - score = nucxs % get_xs('fission', p_g, UVW=p_uvw) * & + score = get_nuclide_xs_c(i_nuclide, MG_GET_XS_FISSION, p_g) * & atom_density * flux else - score = matxs % get_xs('fission', p_g, UVW=p_uvw) * flux + score = get_macro_xs_c(p % material, MG_GET_XS_FISSION, p_g) * flux end if end if @@ -1532,12 +1537,12 @@ contains score = p % absorb_wgt * flux if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('nu-fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_NU_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else score = score * & - matxs % get_xs('nu-fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_macro_xs_c(p % material, MG_GET_XS_NU_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if else ! Skip any non-fission events @@ -1550,17 +1555,17 @@ contains score = keff * p % wgt_bank * flux if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('fission', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_FISSION, p_g) end if end if else if (i_nuclide > 0) then - score = nucxs % get_xs('nu-fission', p_g, UVW=p_uvw) * & + score = get_nuclide_xs_c(i_nuclide, MG_GET_XS_NU_FISSION, p_g) * & atom_density * flux else - score = matxs % get_xs('nu-fission', p_g, UVW=p_uvw) * flux + score = get_macro_xs_c(p % material, MG_GET_XS_NU_FISSION, p_g) * flux end if end if @@ -1586,12 +1591,12 @@ contains score = p % absorb_wgt * flux if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('prompt-nu-fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_PROMPT_NU_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else score = score * & - matxs % get_xs('prompt-nu-fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_macro_xs_c(p % material, MG_GET_XS_PROMPT_NU_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if else ! Skip any non-fission events @@ -1605,17 +1610,17 @@ contains / real(p % n_bank, 8)) * flux if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('fission', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_FISSION, p_g) end if end if else if (i_nuclide > 0) then - score = nucxs % get_xs('prompt-nu-fission', p_g, UVW=p_uvw) * & + score = get_nuclide_xs_c(i_nuclide, MG_GET_XS_PROMPT_NU_FISSION, p_g) * & atom_density * flux else - score = matxs % get_xs('prompt-nu-fission', p_g, UVW=p_uvw) * flux + score = get_macro_xs_c(p % material, MG_GET_XS_PROMPT_NU_FISSION, p_g) * flux end if end if @@ -1641,7 +1646,7 @@ contains ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in ! nu-fission - if (matxs % get_xs('absorption', p_g, UVW=p_uvw) > ZERO) then + if (get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) > ZERO) then if (dg_filter > 0) then select type(filt => filters(t % filter(dg_filter)) % obj) @@ -1656,13 +1661,13 @@ contains score = p % absorb_wgt * flux if (i_nuclide > 0) then - score = score * nucxs % get_xs('delayed-nu-fission', & - p_g, UVW=p_uvw, dg=d) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + score = score * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else - score = score * matxs % get_xs('delayed-nu-fission', & - p_g, UVW=p_uvw, dg=d) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + score = score * & + get_macro_xs_c(p % material, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if call score_fission_delayed_dg(t, d_bin, score, score_index) @@ -1672,11 +1677,13 @@ contains else score = p % absorb_wgt * flux if (i_nuclide > 0) then - score = score * nucxs % get_xs('delayed-nu-fission', p_g, & - UVW=p_uvw) / matxs % get_xs('absorption', p_g, UVW=p_uvw) + score = score * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DELAYED_NU_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else - score = score * matxs % get_xs('delayed-nu-fission', p_g, & - UVW=p_uvw) / matxs % get_xs('absorption', p_g, UVW=p_uvw) + score = score * & + get_macro_xs_c(p % material, MG_GET_XS_DELAYED_NU_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if end if end if @@ -1706,8 +1713,8 @@ contains if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('fission', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_FISSION, p_g) end if call score_fission_delayed_dg(t, d_bin, score, score_index) @@ -1718,8 +1725,8 @@ contains score = keff * p % wgt_bank / p % n_bank * sum(p % n_delayed_bank) * flux if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('fission', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_FISSION, p_g) end if end if end if @@ -1738,11 +1745,11 @@ contains d = filt % groups(d_bin) if (i_nuclide > 0) then - score = nucxs % get_xs('delayed-nu-fission', p_g, & - UVW=p_uvw, dg=d) * atom_density * flux + score = atom_density * flux * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) else - score = matxs % get_xs('delayed-nu-fission', p_g, & - UVW=p_uvw, dg=d) * flux + score = flux * & + get_macro_xs_c(p % material, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) end if call score_fission_delayed_dg(t, d_bin, score, score_index) @@ -1751,11 +1758,12 @@ contains end select else if (i_nuclide > 0) then - score = nucxs % get_xs('delayed-nu-fission', p_g, UVW=p_uvw) & - * atom_density * flux + score = atom_density * flux * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DELAYED_NU_FISSION, p_g) + else - score = matxs % get_xs('delayed-nu-fission', p_g, UVW=p_uvw) & - * flux + score = flux * & + get_macro_xs_c(p % material, MG_GET_XS_DELAYED_NU_FISSION, p_g) end if end if end if @@ -1770,7 +1778,7 @@ contains ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in ! nu-fission - if (matxs % get_xs('absorption', p_g, UVW=p_uvw) > ZERO) then + if (get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) > ZERO) then if (dg_filter > 0) then select type(filt => filters(t % filter(dg_filter)) % obj) @@ -1785,17 +1793,15 @@ contains score = p % absorb_wgt * flux if (i_nuclide > 0) then - score = score * nucxs % get_xs('decay rate', p_g, & - UVW=p_uvw, dg=d) * & - nucxs % get_xs('delayed-nu-fission', p_g, & - UVW=p_uvw, dg=d) / matxs % get_xs('absorption', & - p_g, UVW=p_uvw) + score = score * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else - score = score * matxs % get_xs('decay rate', p_g, & - UVW=p_uvw, dg=d) * & - matxs % get_xs('delayed-nu-fission', p_g, & - UVW=p_uvw, dg=d) / matxs % get_xs('absorption', & - p_g, UVW=p_uvw) + score = score * & + get_macro_xs_c(p % material, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_macro_xs_c(p % material, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if call score_fission_delayed_dg(t, d_bin, score, score_index) @@ -1812,15 +1818,15 @@ contains ! for all delayed groups. do d = 1, num_delayed_groups if (i_nuclide > 0) then - score = score + p % absorb_wgt * & - nucxs % get_xs('decay rate', p_g, UVW=p_uvw, dg=d) * & - nucxs % get_xs('delayed-nu-fission', p_g, UVW=p_uvw, & - dg=d) / matxs % get_xs('absorption', p_g, UVW=p_uvw) * flux + score = score + p % absorb_wgt * flux * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else - score = score + p % absorb_wgt * & - matxs % get_xs('decay rate', p_g, UVW=p_uvw, dg=d) * & - matxs % get_xs('delayed-nu-fission', p_g, UVW=p_uvw, & - dg=d) / matxs % get_xs('absorption', p_g, UVW=p_uvw) * flux + score = score + p % absorb_wgt * flux * & + get_macro_xs_c(p % material, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_macro_xs_c(p % material, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if end do end if @@ -1849,13 +1855,13 @@ contains if (i_nuclide > 0) then score = score + keff * atom_density * & fission_bank(n_bank - p % n_bank + k) % wgt * & - nucxs % get_xs('decay rate', p_g, UVW=p_uvw, dg=g) * & - nucxs % get_xs('fission', p_g, UVW=p_uvw) / & - matxs % get_xs('fission', p_g, UVW=p_uvw) * flux + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_FISSION, p_g) * flux else score = score + keff * & fission_bank(n_bank - p % n_bank + k) % wgt * & - matxs % get_xs('decay rate', p_g, UVW=p_uvw, dg=g) * flux + get_macro_xs_c(p % material, MG_GET_XS_DECAY_RATE, p_g, DG=d) * flux end if ! if the delayed group filter is present, tally to corresponding @@ -1907,13 +1913,13 @@ contains d = filt % groups(d_bin) if (i_nuclide > 0) then - score = nucxs % get_xs('decay rate', p_g, UVW=p_uvw, dg=d) * & - nucxs % get_xs('delayed-nu-fission', p_g, UVW=p_uvw, & - dg=d) * atom_density * flux + score = atom_density * flux * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) else - score = matxs % get_xs('decay rate', p_g, UVW=p_uvw, dg=d) * & - matxs % get_xs('delayed-nu-fission', p_g, UVW=p_uvw, & - dg=d) * flux + score = flux * & + get_macro_xs_c(p % material, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_macro_xs_c(p % material, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) end if call score_fission_delayed_dg(t, d_bin, score, score_index) @@ -1930,12 +1936,12 @@ contains do d = 1, num_delayed_groups if (i_nuclide > 0) then score = score + atom_density * flux * & - nucxs % get_xs('decay rate', p_g, UVW=p_uvw, dg=d) * & - nucxs % get_xs('delayed-nu-fission', p_g, UVW=p_uvw, dg=d) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_nuclide_xs_c(i_nuclide, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) else score = score + flux * & - matxs % get_xs('decay rate', p_g, UVW=p_uvw, dg=d) * & - matxs % get_xs('delayed-nu-fission', p_g, UVW=p_uvw, dg=d) + get_macro_xs_c(p % material, MG_GET_XS_DECAY_RATE, p_g, DG=d) * & + get_macro_xs_c(p % material, MG_GET_XS_DELAYED_NU_FISSION, p_g, DG=d) end if end do end if @@ -1960,19 +1966,20 @@ contains end if if (i_nuclide > 0) then score = score * atom_density * & - nucxs % get_xs('kappa-fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_nuclide_xs_c(i_nuclide, MG_GET_XS_KAPPA_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) else score = score * & - matxs % get_xs('kappa-fission', p_g, UVW=p_uvw) / & - matxs % get_xs('absorption', p_g, UVW=p_uvw) + get_macro_xs_c(p % material, MG_GET_XS_KAPPA_FISSION, p_g) / & + get_macro_xs_c(p % material, MG_GET_XS_ABSORPTION, p_g) end if else if (i_nuclide > 0) then - score = nucxs % get_xs('kappa-fission', p_g, UVW=p_uvw) * & + score = get_nuclide_xs_c(i_nuclide, MG_GET_XS_KAPPA_FISSION, p_g) * & atom_density * flux else - score = matxs % get_xs('kappa-fission', p_g, UVW=p_uvw) * flux + score = flux * & + get_macro_xs_c(p % material, MG_GET_XS_KAPPA_FISSION, p_g) end if end if @@ -1991,8 +1998,6 @@ contains t % results(RESULT_VALUE, score_index, filter_index) + score end do SCORE_LOOP - - nullify(matxs, nucxs) end subroutine score_general_mg !=============================================================================== diff --git a/src/tallies/tally_filter_energy.F90 b/src/tallies/tally_filter_energy.F90 index 93da69edda..f230d438e8 100644 --- a/src/tallies/tally_filter_energy.F90 +++ b/src/tallies/tally_filter_energy.F90 @@ -6,7 +6,7 @@ module tally_filter_energy use constants use error use hdf5_interface - use mgxs_header, only: num_energy_groups, rev_energy_bins + use mgxs_interface, only: num_energy_groups, rev_energy_bins use particle_header, only: Particle use settings, only: run_CE use string, only: to_str diff --git a/src/tracking.F90 b/src/tracking.F90 index 97593df894..f443d71f8f 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -1,5 +1,7 @@ module tracking + use, intrinsic :: ISO_C_BINDING + use constants use error, only: warning, write_message use geometry_header, only: cells @@ -7,7 +9,7 @@ module tracking check_cell_overlap use material_header, only: materials, Material use message_passing - use mgxs_header + use mgxs_interface use nuclide_header use particle_header, only: LocalCoord, Particle use physics, only: collision @@ -118,8 +120,10 @@ contains end if else ! Get the MG data - call macro_xs(p % material) % obj % calculate_xs(p % g, p % sqrtkT, & - p % coord(p % n_coord) % uvw, material_xs) + call calculate_xs_c(p % material, p % g, p % sqrtkT, & + p % coord(p % n_coord) % uvw, material_xs % total, & + material_xs % absorption, material_xs % nu_fission) + ! Finally, update the particle group while we have already checked ! for if multi-group diff --git a/src/xsdata.cpp b/src/xsdata.cpp new file mode 100644 index 0000000000..3482a316a2 --- /dev/null +++ b/src/xsdata.cpp @@ -0,0 +1,713 @@ +#include +#include +#include +#include + +#include "constants.h" +#include "error.h" +#include "math_functions.h" +#include "random_lcg.h" +#include "xsdata.h" + + +namespace openmc { + +//============================================================================== +// XsData class methods +//============================================================================== + +XsData::XsData(int energy_groups, int num_delayed_groups, bool fissionable, + int scatter_format, int n_pol, int n_azi) +{ + int n_ang = n_pol * n_azi; + + // check to make sure scatter format is OK before we allocate + if (scatter_format != ANGLE_HISTOGRAM && scatter_format != ANGLE_TABULAR && + scatter_format != ANGLE_LEGENDRE) { + fatal_error("Invalid scatter_format!"); + } + // allocate all [temperature][phi][theta][in group] quantities + total = double_2dvec(n_ang, double_1dvec(energy_groups, 0.)); + absorption = double_2dvec(n_ang, double_1dvec(energy_groups, 0.)); + inverse_velocity = double_2dvec(n_ang, double_1dvec(energy_groups, 0.)); + if (fissionable) { + fission = double_2dvec(n_ang, double_1dvec(energy_groups, 0.)); + nu_fission = double_2dvec(n_ang, double_1dvec(energy_groups, 0.)); + prompt_nu_fission = double_2dvec(n_ang, double_1dvec(energy_groups, 0.)); + kappa_fission = double_2dvec(n_ang, double_1dvec(energy_groups, 0.)); + } + + // allocate decay_rate; [temperature][phi][theta][delayed group] + decay_rate = double_2dvec(n_ang, double_1dvec(num_delayed_groups, 0.)); + + if (fissionable) { + // allocate delayed_nu_fission; [temperature][phi][theta][in group][delay group] + delayed_nu_fission = double_3dvec(n_ang, double_2dvec(energy_groups, + double_1dvec(num_delayed_groups, 0.))); + + // chi_prompt; [temperature][phi][theta][in group][delayed group] + chi_prompt = double_3dvec(n_ang, double_2dvec(energy_groups, + double_1dvec(energy_groups, 0.))); + + // chi_delayed; [temperature][phi][theta][in group][out group][delay group] + chi_delayed = double_4dvec(n_ang, double_3dvec(energy_groups, + double_2dvec(energy_groups, double_1dvec(num_delayed_groups, 0.)))); + } + + + for (int a = 0; a < n_ang; a++) { + if (scatter_format == ANGLE_HISTOGRAM) { + // scatter[a] = std::make_unique(ScattDataHistogram); + scatter.emplace_back(new ScattDataHistogram); + } else if (scatter_format == ANGLE_TABULAR) { + // scatter[a] = std::make_unique(ScattDataTabular); + scatter.emplace_back(new ScattDataTabular); + } else if (scatter_format == ANGLE_LEGENDRE) { + // scatter[a] = std::make_unique(ScattDataLegendre); + scatter.emplace_back(new ScattDataLegendre); + } + } +} + +//============================================================================== + +void +XsData::from_hdf5(hid_t xsdata_grp, bool fissionable, int scatter_format, + int final_scatter_format, int order_data, int max_order, + int legendre_to_tabular_points, bool is_isotropic, int n_pol, int n_azi) +{ + // Reconstruct the dimension information so it doesn't need to be passed + int n_ang = n_pol * n_azi; + int energy_groups = total[0].size(); + int delayed_groups = decay_rate[0].size(); + + // Set the fissionable-specific data + if (fissionable) { + fission_from_hdf5(xsdata_grp, n_pol, n_azi, energy_groups, delayed_groups, + is_isotropic); + } + // Get the non-fission-specific data + read_nd_vector(xsdata_grp, "decay_rate", decay_rate); + read_nd_vector(xsdata_grp, "absorption", absorption, true); + read_nd_vector(xsdata_grp, "inverse-velocity", inverse_velocity); + + // Get scattering data + scatter_from_hdf5(xsdata_grp, n_pol, n_azi, energy_groups, scatter_format, + final_scatter_format, order_data, max_order, legendre_to_tabular_points); + + // Check absorption to ensure it is not 0 since it is often the + // denominator in tally methods + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + if (absorption[a][gin] == 0.) absorption[a][gin] = 1.e-10; + } + } + + // Get or calculate the total x/s + if (object_exists(xsdata_grp, "total")) { + read_nd_vector(xsdata_grp, "total", total); + } else { + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + total[a][gin] = absorption[a][gin] + scatter[a]->scattxs[gin]; + } + } + } + + // Fix if total is 0, since it is in the denominator when tallying + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + if (total[a][gin] == 0.) total[a][gin] = 1.e-10; + } + } +} + +//============================================================================== + +void +XsData::fission_from_hdf5(hid_t xsdata_grp, int n_pol, int n_azi, + int energy_groups, int delayed_groups, bool is_isotropic) +{ + int n_ang = n_pol * n_azi; + // Get the fission and kappa_fission data xs; these are optional + read_nd_vector(xsdata_grp, "fission", fission); + read_nd_vector(xsdata_grp, "kappa-fission", kappa_fission); + + // Set/get beta + double_3dvec temp_beta =double_3dvec(n_ang, double_2dvec(energy_groups, + double_1dvec(delayed_groups, 0.))); + if (object_exists(xsdata_grp, "beta")) { + hid_t xsdata = open_dataset(xsdata_grp, "beta"); + int ndims = dataset_ndims(xsdata); + + // raise ndims to make the isotropic ndims the same as angular + if (is_isotropic) ndims += 2; + + if (ndims == 3) { + // Beta is input as [delayed group] + double_1dvec temp_arr(n_pol * n_azi * delayed_groups); + read_nd_vector(xsdata_grp, "beta", temp_arr); + + // Broadcast to all incoming groups + int temp_idx = 0; + for (int a = 0; a < n_ang; a++) { + for (int dg = 0; dg < delayed_groups; dg++) { + // Set the first group index and copy the rest + temp_beta[a][0][dg] = temp_arr[temp_idx++]; + for (int gin = 1; gin < energy_groups; gin++) { + temp_beta[a][gin] = temp_beta[a][0]; + } + } + } + } else if (ndims == 4) { + // Beta is input as [in group][delayed group] + read_nd_vector(xsdata_grp, "beta", temp_beta); + } else { + fatal_error("beta must be provided as a 3D or 4D array!"); + } + } + + // If chi is provided, set chi-prompt and chi-delayed + if (object_exists(xsdata_grp, "chi")) { + double_2dvec temp_arr(n_ang, double_1dvec(energy_groups)); + read_nd_vector(xsdata_grp, "chi", temp_arr); + + for (int a = 0; a < n_ang; a++) { + // First set the first group + for (int gout = 0; gout < energy_groups; gout++) { + chi_prompt[a][0][gout] = temp_arr[a][gout]; + } + + // Now normalize this data + double chi_sum = std::accumulate(chi_prompt[a][0].begin(), + chi_prompt[a][0].end(), + 0.); + if (chi_sum <= 0.) { + fatal_error("Encountered chi for a group that is <= 0!"); + } + for (int gout = 0; gout < energy_groups; gout++) { + chi_prompt[a][0][gout] /= chi_sum; + } + + // And extend to the remaining incoming groups + for (int gin = 1; gin < energy_groups; gin++) { + chi_prompt[a][gin] = chi_prompt[a][0]; + } + + // Finally set chi-delayed equal to chi-prompt + // Set chi-delayed to chi-prompt + for(int gin = 0; gin < energy_groups; gin++) { + for (int gout = 0; gout < energy_groups; gout++) { + for (int dg = 0; dg < delayed_groups; dg++) { + chi_delayed[a][gin][gout][dg] = + chi_prompt[a][gin][gout]; + } + } + } + } + } + + // If nu-fission is provided, set prompt- and delayed-nu-fission; + // if nu-fission is a matrix, set chi-prompt and chi-delayed. + if (object_exists(xsdata_grp, "nu-fission")) { + hid_t xsdata = open_dataset(xsdata_grp, "nu-fission"); + int ndims = dataset_ndims(xsdata); + // raise ndims to make the isotropic ndims the same as angular + if (is_isotropic) ndims += 2; + + if (ndims == 3) { + // nu-fission is a 3-d array + read_nd_vector(xsdata_grp, "nu-fission", prompt_nu_fission); + + // set delayed-nu-fission and correct prompt-nu-fission with beta + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + for (int dg = 0; dg < delayed_groups; dg++) { + delayed_nu_fission[a][gin][dg] = + temp_beta[a][gin][dg] * prompt_nu_fission[a][gin]; + } + + // Correct the prompt-nu-fission using the delayed neutron fraction + if (delayed_groups > 0) { + double beta_sum = std::accumulate(temp_beta[a][gin].begin(), + temp_beta[a][gin].end(), 0.); + prompt_nu_fission[a][gin] *= (1. - beta_sum); + } + } + } + + } else if (ndims == 4) { + // nu-fission is a matrix + read_nd_vector(xsdata_grp, "nu-fission", chi_prompt); + + // Normalize the chi info so the CDF is 1. + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + double chi_sum = std::accumulate(chi_prompt[a][gin].begin(), + chi_prompt[a][gin].end(), 0.); + // Set the vector nu-fission from the matrix nu-fission + prompt_nu_fission[a][gin] = chi_sum; + + if (chi_sum >= 0.) { + for (int gout = 0; gout < energy_groups; gout++) { + chi_prompt[a][gin][gout] /= chi_sum; + } + } else { + fatal_error("Encountered chi for a group that is <= 0!"); + } + } + + // set chi-delayed to chi-prompt + for (int gin = 0; gin < energy_groups; gin++) { + for (int gout = 0; gout < energy_groups; gout++) { + for (int dg = 0; dg < delayed_groups; dg++) { + chi_delayed[a][gin][gout][dg] = + chi_prompt[a][gin][gout]; + } + } + } + + // Set the delayed-nu-fission and correct prompt-nu-fission with beta + for (int gin = 0; gin < energy_groups; gin++) { + for (int dg = 0; dg < delayed_groups; dg++) { + delayed_nu_fission[a][gin][dg] = + temp_beta[a][gin][dg] * + prompt_nu_fission[a][gin]; + } + + // Correct prompt-nu-fission using the delayed neutron fraction + if (delayed_groups > 0) { + double beta_sum = std::accumulate(temp_beta[a][gin].begin(), + temp_beta[a][gin].end(), 0.); + prompt_nu_fission[a][gin] *= (1. - beta_sum); + } + } + } + } else { + fatal_error("nu-fission must be provided as a 3D or 4D array!"); + } + + close_dataset(xsdata); + } + + // If chi-prompt is provided, set chi-prompt + if (object_exists(xsdata_grp, "chi-prompt")) { + double_2dvec temp_arr(n_ang, double_1dvec(energy_groups)); + read_nd_vector(xsdata_grp, "chi-prompt", temp_arr); + + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + for (int gout = 0; gout < energy_groups; gout++) { + chi_prompt[a][gin][gout] = temp_arr[a][gout]; + } + + // Normalize chi so its CDF goes to 1 + double chi_sum = std::accumulate(chi_prompt[a][gin].begin(), + chi_prompt[a][gin].end(), 0.); + if (chi_sum >= 0.) { + for (int gout = 0; gout < energy_groups; gout++) { + chi_prompt[a][gin][gout] /= chi_sum; + } + } else { + fatal_error("Encountered chi-prompt for a group that is <= 0.!"); + } + } + } + } + + // If chi-delayed is provided, set chi-delayed + if (object_exists(xsdata_grp, "chi-delayed")) { + hid_t xsdata = open_dataset(xsdata_grp, "chi-delayed"); + int ndims = dataset_ndims(xsdata); + // raise ndims to make the isotropic ndims the same as angular + if (is_isotropic) ndims += 2; + close_dataset(xsdata); + + if (ndims == 3) { + // chi-delayed is a [in group] vector + double_2dvec temp_arr(n_ang, double_1dvec(energy_groups)); + read_nd_vector(xsdata_grp, "chi-delayed", temp_arr); + + for (int a = 0; a < n_ang; a++) { + // normalize the chi CDF to 1 + double chi_sum = std::accumulate(temp_arr[a].begin(), + temp_arr[a].end(), 0.); + if (chi_sum <= 0.) { + fatal_error("Encountered chi-delayed for a group that is <= 0!"); + } + + // set chi-delayed + for (int gin = 0; gin < energy_groups; gin++) { + for (int gout = 0; gout < energy_groups; gout++) { + for (int dg = 0; dg < delayed_groups; dg++) { + chi_delayed[a][gin][gout][dg] = temp_arr[a][gout] / chi_sum; + } + } + } + } + } else if (ndims == 4) { + // chi_delayed is a matrix + read_nd_vector(xsdata_grp, "chi-delayed", chi_delayed); + + // Normalize the chi info so the CDF is 1. + for (int a = 0; a < n_ang; a++) { + for (int dg = 0; dg < delayed_groups; dg++) { + for (int gin = 0; gin < energy_groups; gin++) { + double chi_sum = 0.; + for (int gout = 0; gout < energy_groups; gout++) { + chi_sum += chi_delayed[a][gin][gout][dg]; + } + + if (chi_sum > 0.) { + for (int gout = 0; gout < energy_groups; gout++) { + chi_delayed[a][gin][gout][dg] /= chi_sum; + } + } else { + fatal_error("Encountered chi-delayed for a group that is <= 0!"); + } + } + } + } + } else { + fatal_error("chi-delayed must be provided as a 3D or 4D array!"); + } + } + + // Get prompt-nu-fission, if present + if (object_exists(xsdata_grp, "prompt-nu-fission")) { + hid_t xsdata = open_dataset(xsdata_grp, "prompt-nu-fission"); + int ndims = dataset_ndims(xsdata); + // raise ndims to make the isotropic ndims the same as angular + if (is_isotropic) ndims += 2; + close_dataset(xsdata); + + if (ndims == 3) { + // prompt-nu-fission is a [in group] vector + read_nd_vector(xsdata_grp, "prompt-nu-fission", + prompt_nu_fission); + } else if (ndims == 4) { + // prompt nu fission is a matrix, + // so set prompt_nu_fiss & chi_prompt + double_3dvec temp_arr(n_ang, double_2dvec(energy_groups, + double_1dvec(energy_groups))); + read_nd_vector(xsdata_grp, "prompt-nu-fission", temp_arr); + + // The prompt_nu_fission vector from the matrix form + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + double prompt_sum = std::accumulate(temp_arr[a][gin].begin(), + temp_arr[a][gin].end(), 0.); + prompt_nu_fission[a][gin] = prompt_sum; + } + + // The chi_prompt data is just the normalized fission matrix + for (int gin= 0; gin < energy_groups; gin++) { + if (prompt_nu_fission[a][gin] > 0.) { + for (int gout = 0; gout < energy_groups; gout++) { + chi_prompt[a][gin][gout] = + temp_arr[a][gin][gout] / prompt_nu_fission[a][gin]; + } + } else { + fatal_error("Encountered chi-prompt for a group that is <= 0!"); + } + } + } + + } else { + fatal_error("prompt-nu-fission must be provided as a 3D or 4D array!"); + } + } + + // Get delayed-nu-fission, if present + if (object_exists(xsdata_grp, "delayed-nu-fission")) { + hid_t xsdata = open_dataset(xsdata_grp, "delayed-nu-fission"); + int ndims = dataset_ndims(xsdata); + close_dataset(xsdata); + // raise ndims to make the isotropic ndims the same as angular + if (is_isotropic) ndims += 2; + + if (ndims == 3) { + // delayed-nu-fission is an [in group] vector + if (temp_beta[0][0][0] == 0.) { + fatal_error("cannot set delayed-nu-fission with a 1D array if " + "beta is not provided"); + } + double_2dvec temp_arr(n_ang, double_1dvec(energy_groups)); + read_nd_vector(xsdata_grp, "delayed-nu-fission", temp_arr); + + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + for (int dg = 0; dg < delayed_groups; dg++) { + // Set delayed-nu-fission using beta + delayed_nu_fission[a][gin][dg] = + temp_beta[a][gin][dg] * temp_arr[a][gin]; + } + } + } + + } else if (ndims == 4) { + read_nd_vector(xsdata_grp, "delayed-nu-fission", + delayed_nu_fission); + + } else if (ndims == 5) { + // This will contain delayed-nu-fision and chi-delayed data + double_4dvec temp_arr(n_ang, double_3dvec(energy_groups, + double_2dvec(energy_groups, double_1dvec(delayed_groups)))); + read_nd_vector(xsdata_grp, "delayed-nu-fission", temp_arr); + + // Set the 3D delayed-nu-fission matrix and 4D chi-delayed matrix + // from the 4D delayed-nu-fission matrix + for (int a = 0; a < n_ang; a++) { + for (int dg = 0; dg < delayed_groups; dg++) { + for (int gin = 0; gin < energy_groups; gin++) { + double gout_sum = 0.; + for (int gout = 0; gout < energy_groups; gout++) { + gout_sum += temp_arr[a][gin][gout][dg]; + chi_delayed[a][gin][gout][dg] = temp_arr[a][gin][gout][dg]; + } + delayed_nu_fission[a][gin][dg] = gout_sum; + // Normalize chi-delayed + if (gout_sum > 0.) { + for (int gout = 0; gout < energy_groups; gout++) { + chi_delayed[a][gin][gout][dg] /= gout_sum; + } + } else { + fatal_error("Encountered chi-delayed for a group that is <= 0!"); + } + } + } + } + + } else { + fatal_error("prompt-nu-fission must be provided as a 3D, 4D, or 5D " + "array!"); + } + } + + // Combine prompt_nu_fission and delayed_nu_fission into nu_fission + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + nu_fission[a][gin] = + std::accumulate(delayed_nu_fission[a][gin].begin(), + delayed_nu_fission[a][gin].end(), + prompt_nu_fission[a][gin]); + } + } +} + +//============================================================================== + +void +XsData::scatter_from_hdf5(hid_t xsdata_grp, int n_pol, int n_azi, + int energy_groups, int scatter_format, int final_scatter_format, + int order_data, int max_order, int legendre_to_tabular_points) +{ + int n_ang = n_pol * n_azi; + if (!object_exists(xsdata_grp, "scatter_data")) { + fatal_error("Must provide scatter_data group!"); + } + hid_t scatt_grp = open_group(xsdata_grp, "scatter_data"); + + // Get the outgoing group boundary indices + int_2dvec gmin(n_ang, int_1dvec(energy_groups)); + read_nd_vector(scatt_grp, "g_min", gmin, true); + int_2dvec gmax(n_ang, int_1dvec(energy_groups)); + read_nd_vector(scatt_grp, "g_max", gmax, true); + + // Make gmin and gmax start from 0 vice 1 as they do in the library + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + gmin[a][gin] -= 1; + gmax[a][gin] -= 1; + } + } + + // Now use this info to find the length of a vector to hold the flattened + // data. + int length = 0; + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + length += order_data * (gmax[a][gin] - gmin[a][gin] + 1); + } + } + double_1dvec temp_arr(length); + read_nd_vector(scatt_grp, "scatter_matrix", temp_arr, true); + + // Compare the number of orders given with the max order of the problem; + // strip off the superfluous orders if needed + int order_dim; + if (scatter_format == ANGLE_LEGENDRE) { + order_dim = std::min(order_data - 1, max_order) + 1; + } else { + order_dim = order_data; + } + + // convert the flattened temp_arr to a jagged array for passing to + // scatt data + double_4dvec input_scatt(n_ang, double_3dvec(energy_groups)); + + int temp_idx = 0; + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + input_scatt[a][gin].resize(gmax[a][gin] - gmin[a][gin] + 1); + for (int i_gout = 0; i_gout < input_scatt[a][gin].size(); i_gout++) { + input_scatt[a][gin][i_gout].resize(order_dim); + for (int l = 0; l < order_dim; l++) { + input_scatt[a][gin][i_gout][l] = temp_arr[temp_idx++]; + } + // Adjust index for the orders we didnt take + temp_idx += (order_data - order_dim); + } + } + } + temp_arr.clear(); + + // Get multiplication matrix + double_3dvec temp_mult(n_ang, double_2dvec(energy_groups)); + if (object_exists(scatt_grp, "multiplicity_matrix")) { + temp_arr.resize(length / order_data); + read_nd_vector(scatt_grp, "multiplicity_matrix", temp_arr); + + // convert the flat temp_arr to a jagged array for passing to scatt data + int temp_idx = 0; + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + temp_mult[a][gin].resize(gmax[a][gin] - gmin[a][gin] + 1); + for (int i_gout = 0; i_gout < temp_mult[a][gin].size(); i_gout++) { + temp_mult[a][gin][i_gout] = temp_arr[temp_idx++]; + } + } + } + } else { + // Use a default: multiplicities are 1.0. + for (int a = 0; a < n_ang; a++) { + for (int gin = 0; gin < energy_groups; gin++) { + temp_mult[a][gin].resize(gmax[a][gin] - gmin[a][gin] + 1); + for (int i_gout = 0; i_gout < temp_mult[a][gin].size(); i_gout++) { + temp_mult[a][gin][i_gout] = 1.; + } + } + } + } + temp_arr.clear(); + close_group(scatt_grp); + + // Finally, convert the Legendre data to tabular, if needed + if (scatter_format == ANGLE_LEGENDRE && + final_scatter_format == ANGLE_TABULAR) { + for (int a = 0; a < n_ang; a++) { + ScattDataLegendre legendre_scatt; + legendre_scatt.init(gmin[a], gmax[a], temp_mult[a], input_scatt[a]); + + // Now create a tabular version of legendre_scatt + convert_legendre_to_tabular(legendre_scatt, + *static_cast(scatter[a].get()), + legendre_to_tabular_points); + + scatter_format = final_scatter_format; + } + } else { + // We are sticking with the current representation + // Initialize the ScattData object with this data + for (int a = 0; a < n_ang; a++) { + scatter[a]->init(gmin[a], gmax[a], temp_mult[a], input_scatt[a]); + } + } +} + +//============================================================================== + +void +XsData::combine(const std::vector& those_xs, + const double_1dvec& scalars) +{ + // Combine the non-scattering data + for (int i = 0; i < those_xs.size(); i++) { + XsData* that = those_xs[i]; + if (!equiv(*that)) fatal_error("Cannot combine the XsData objects!"); + double scalar = scalars[i]; + for (int a = 0; a < total.size(); a++) { + for (int gin = 0; gin < total[a].size(); gin++) { + total[a][gin] += scalar * that->total[a][gin]; + absorption[a][gin] += scalar * that->absorption[a][gin]; + if (i == 0) { + inverse_velocity[a][gin] = that->inverse_velocity[a][gin]; + } + if (that->prompt_nu_fission.size() > 0) { + nu_fission[a][gin] += scalar * that->nu_fission[a][gin]; + prompt_nu_fission[a][gin] += + scalar * that->prompt_nu_fission[a][gin]; + kappa_fission[a][gin] += scalar * that->kappa_fission[a][gin]; + fission[a][gin] += scalar * that->fission[a][gin]; + + for (int dg = 0; dg < delayed_nu_fission[a][gin].size(); dg++) { + delayed_nu_fission[a][gin][dg] += + scalar * that->delayed_nu_fission[a][gin][dg]; + } + + for (int gout = 0; gout < chi_prompt[a][gin].size(); gout++) { + chi_prompt[a][gin][gout] += + scalar * that->chi_prompt[a][gin][gout]; + + for (int dg = 0; dg < chi_delayed[a][gin][gout].size(); dg++) { + chi_delayed[a][gin][gout][dg] += + scalar * that->chi_delayed[a][gin][gout][dg]; + } + } + } + } + + for (int dg = 0; dg < decay_rate[a].size(); dg++) { + decay_rate[a][dg] += scalar * that->decay_rate[a][dg]; + } + + // Normalize chi + if (chi_prompt.size() > 0) { + for (int gin = 0; gin < chi_prompt[a].size(); gin++) { + double norm = std::accumulate(chi_prompt[a][gin].begin(), + chi_prompt[a][gin].end(), 0.); + if (norm > 0.) { + for (int gout = 0; gout < chi_prompt[a][gin].size(); gout++) { + chi_prompt[a][gin][gout] /= norm; + } + } + + for (int dg = 0; dg < chi_delayed[a][gin][0].size(); dg++) { + norm = 0.; + for (int gout = 0; gout < chi_delayed[a][gin].size(); gout++) { + norm += chi_delayed[a][gin][gout][dg]; + } + if (norm > 0.) { + for (int gout = 0; gout < chi_delayed[a][gin].size(); gout++) { + chi_delayed[a][gin][gout][dg] /= norm; + } + } + } + } + } + } + } + + // Allow the ScattData object to combine itself + for (int a = 0; a < total.size(); a++) { + // Build vector of the scattering objects to incorporate + std::vector those_scatts(those_xs.size()); + for (int i = 0; i < those_xs.size(); i++) { + those_scatts[i] = those_xs[i]->scatter[a].get(); + } + + // Now combine these guys + scatter[a]->combine(those_scatts, scalars); + } +} + +//============================================================================== + +bool +XsData::equiv(const XsData& that) +{ + return ((absorption.size() == that.absorption.size()) && + (absorption[0].size() == that.absorption[0].size())); +} + +} //namespace openmc diff --git a/src/xsdata.h b/src/xsdata.h new file mode 100644 index 0000000000..c855c67d89 --- /dev/null +++ b/src/xsdata.h @@ -0,0 +1,118 @@ +//! \file xsdata.h +//! A collection of classes for containing the Multi-Group Cross Section data + +#ifndef XSDATA_H +#define XSDATA_H + +#include +#include + +#include "hdf5_interface.h" +#include "scattdata.h" + + +namespace openmc { + +//============================================================================== +// XSDATA contains the temperature-independent cross section data for an MGXS +//============================================================================== + +class XsData { + + private: + //! \brief Reads scattering data from the HDF5 file + void + scatter_from_hdf5(hid_t xsdata_grp, int n_pol, int n_azi, int energy_groups, + int scatter_format, int final_scatter_format, int order_data, + int max_order, int legendre_to_tabular_points); + + //! \brief Reads fission data from the HDF5 file + void + fission_from_hdf5(hid_t xsdata_grp, int n_pol, int n_azi, int energy_groups, + int delayed_groups, bool is_isotropic); + + public: + + // The following quantities have the following dimensions: + // [angle][incoming group] + double_2dvec total; + double_2dvec absorption; + double_2dvec nu_fission; + double_2dvec prompt_nu_fission; + double_2dvec kappa_fission; + double_2dvec fission; + double_2dvec inverse_velocity; + + // decay_rate has the following dimensions: + // [angle][delayed group] + double_2dvec decay_rate; + // delayed_nu_fission has the following dimensions: + // [angle][incoming group][delayed group] + double_3dvec delayed_nu_fission; + // chi_prompt has the following dimensions: + // [angle][incoming group][outgoing group] + double_3dvec chi_prompt; + // chi_delayed has the following dimensions: + // [angle][incoming group][outgoing group][delayed group] + double_4dvec chi_delayed; + // scatter has the following dimensions: [angle] + std::vector > scatter; + + XsData() = default; + + //! \brief Constructs the XsData object metadata. + //! + //! @param num_groups Number of energy groups. + //! @param num_delayed_groups Number of delayed groups. + //! @param fissionable Is this a fissionable data set or not. + //! @param scatter_format The scattering representation of the file. + //! @param n_pol Number of polar angles. + //! @param n_azi Number of azimuthal angles. + XsData(int num_groups, int num_delayed_groups, bool fissionable, + int scatter_format, int n_pol, int n_azi); + + //! \brief Loads the XsData object from the HDF5 file + //! + //! @param xs_id HDF5 group id for the cross section data. + //! @param fissionable Is this a fissionable data set or not. + //! @param scatter_format The scattering representation of the file. + //! @param final_scatter_format The scattering representation after reading; + //! this is different from scatter_format if converting a Legendre to + //! a tabular representation. + //! @param order_data The dimensionality of the scattering data in the file. + //! @param max_order Maximum order requested by the user; + //! this is only used for Legendre scattering. + //! @param legendre_to_tabular Flag to denote if any Legendre provided + //! should be converted to a Tabular representation. + //! @param legendre_to_tabular_points If a conversion is requested, this + //! provides the number of points to use in the tabular representation. + //! @param is_isotropic Is this an isotropic or angular with respect to + //! the incoming particle. + //! @param n_pol Number of polar angles. + //! @param n_azi Number of azimuthal angles. + void + from_hdf5(hid_t xsdata_grp, bool fissionable, int scatter_format, + int final_scatter_format, int order_data, int max_order, + int legendre_to_tabular_points, bool is_isotropic, int n_pol, + int n_azi); + + //! \brief Combines the microscopic data to a macroscopic object. + //! + //! @param micros Microscopic objects to combine. + //! @param scalars Scalars to multiply the microscopic data by. + void + combine(const std::vector& those_xs, const double_1dvec& scalars); + + //! \brief Checks to see if this and that are able to be combined + //! + //! This comparison is used when building macroscopic cross sections + //! from microscopic cross sections. + //! @param that The other XsData to compare to this one. + //! @return True if they can be combined. + bool + equiv(const XsData& that); +}; + + +} //namespace openmc +#endif // XSDATA_H \ No newline at end of file