diff --git a/include/openmc/tallies/tally_filter_sph_harm.h b/include/openmc/tallies/tally_filter_sph_harm.h index 7c7ef00d8..43c41ea22 100644 --- a/include/openmc/tallies/tally_filter_sph_harm.h +++ b/include/openmc/tallies/tally_filter_sph_harm.h @@ -29,8 +29,6 @@ public: if (check_for_node(node, "cosine")) { auto cos = get_node_value(node, "cosine", true); - std::cout << cos << "\n"; - std::cout << (cos == "scatter") << " " << (cos == "particle") << "\n"; if (cos == "scatter") { cosine_ = SphericalHarmonicsCosine::scatter; } else if (cos == "particle") { diff --git a/src/api.F90 b/src/api.F90 index 18162e600..b9ccdca48 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -37,7 +37,6 @@ module openmc_api private public :: openmc_calculate_volumes - public :: openmc_cell_filter_get_bins public :: openmc_cell_get_id public :: openmc_cell_set_id public :: openmc_energy_filter_get_bins @@ -71,10 +70,6 @@ module openmc_api public :: openmc_material_set_density public :: openmc_material_set_densities public :: openmc_material_set_id - public :: openmc_material_filter_get_bins - public :: openmc_material_filter_set_bins - public :: openmc_mesh_filter_set_mesh - public :: openmc_meshsurface_filter_set_mesh public :: openmc_next_batch public :: openmc_nuclide_name public :: openmc_plot_geometry diff --git a/src/tallies/tally_filter.cpp b/src/tallies/tally_filter.cpp index 7f615ba54..bb937806f 100644 --- a/src/tallies/tally_filter.cpp +++ b/src/tallies/tally_filter.cpp @@ -2,7 +2,9 @@ #include +#include "openmc/capi.h" #include "openmc/constants.h" // for MAX_LINE_LEN; +#include "openmc/error.h" #include "openmc/tallies/tally_filter_azimuthal.h" #include "openmc/tallies/tally_filter_cell.h" #include "openmc/tallies/tally_filter_cellborn.h" @@ -47,6 +49,397 @@ free_memory_tally_c() tally_filters.clear(); } +//============================================================================== +// C-API functions +//============================================================================== + +// Fortran functions that will be called from C++ +extern "C" int verify_filter(int32_t index); +extern "C" TallyFilter* filter_from_f(int32_t index); +extern "C" void filter_update_n_bins(int32_t index); + +extern "C" { + int + openmc_cell_filter_get_bins(int32_t index, int32_t** cells, int32_t* n) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "cell") { + set_errmsg("Tried to get cells from a non-cell filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto cell_filt = static_cast(filt); + *cells = cell_filt->cells_.data(); + *n = cell_filt->cells_.size(); + return 0; + } + + int + openmc_legendre_filter_get_order(int32_t index, int* order) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "legendre") { + set_errmsg("Tried to get order on a non-expansion filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto l_filt = static_cast(filt); + *order = l_filt->order_; + return 0; + } + + int + openmc_legendre_filter_set_order(int32_t index, int order) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "legendre") { + set_errmsg("Tried to set order on a non-expansion filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto l_filt = static_cast(filt); + l_filt->order_ = order; + l_filt->n_bins_ = order + 1; + filter_update_n_bins(index); + return 0; + } + + int + openmc_material_filter_get_bins(int32_t index, int32_t** bins, int32_t* n) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "material") { + set_errmsg("Tried to get material filter bins on a non-material filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto mat_filt = static_cast(filt); + *bins = mat_filt->materials_.data(); + *n = mat_filt->materials_.size(); + return 0; + } + + int + openmc_material_filter_set_bins(int32_t index, int32_t n, const int32_t* bins) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "material") { + set_errmsg("Tried to set material filter bins on a non-material filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto mat_filt = static_cast(filt); + mat_filt->materials_.clear(); + mat_filt->materials_.resize(n); + for (int i = 0; i < n; i++) mat_filt->materials_[i] = bins[i]; + mat_filt->n_bins_ = mat_filt->materials_.size(); + mat_filt->map_.clear(); + for (int i = 0; i < n; i++) mat_filt->map_[mat_filt->materials_[i]] = i; + filter_update_n_bins(index); + return 0; + } + + int + openmc_mesh_filter_get_mesh(int32_t index, int32_t* index_mesh) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "mesh" && filt->type() != "meshsurface") { + set_errmsg("Tried to get mesh on a non-mesh filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto mesh_filt = static_cast(filt); + *index_mesh = mesh_filt->mesh_; + return 0; + } + + int + openmc_mesh_filter_set_mesh(int32_t index, int32_t index_mesh) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "mesh" && filt->type() != "meshsurface") { + set_errmsg("Tried to set mesh on a non-mesh filter."); + return OPENMC_E_INVALID_TYPE; + } + + if (index_mesh < 0 || index_mesh >= meshes.size()) { + set_errmsg("Index in 'meshes' array is out of bounds."); + return OPENMC_E_OUT_OF_BOUNDS; + } + + auto mesh_filt = static_cast(filt); + mesh_filt->mesh_ = index_mesh; + if (filt->type() == "mesh") { + mesh_filt->n_bins_ = 1; + } else { + filt->n_bins_ = 4 * meshes[index_mesh]->n_dimension_; + } + for (auto dim : meshes[index_mesh]->shape_) mesh_filt->n_bins_ *= dim; + filter_update_n_bins(index); + return 0; + } + + int openmc_meshsurface_filter_get_mesh(int32_t index, int32_t* index_mesh) + {return openmc_mesh_filter_get_mesh(index, index_mesh);} + + int openmc_meshsurface_filter_set_mesh(int32_t index, int32_t index_mesh) + {return openmc_mesh_filter_set_mesh(index, index_mesh);} + + int + openmc_spatial_legendre_filter_get_order(int32_t index, int* order) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "spatiallegendre") { + set_errmsg("Not a spatial Legendre filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto l_filt = static_cast(filt); + *order = l_filt->order_; + return 0; + } + + int + openmc_spatial_legendre_filter_get_params(int32_t index, int* axis, + double* min, double* max) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "spatiallegendre") { + set_errmsg("Not a spatial Legendre filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto l_filt = static_cast(filt); + *axis = static_cast(l_filt->axis_); + *min = l_filt->min_; + *max = l_filt->max_; + return 0; + } + + int + openmc_spatial_legendre_filter_set_order(int32_t index, int order) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "spatiallegendre") { + set_errmsg("Not a spatial Legendre filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto l_filt = static_cast(filt); + l_filt->order_ = order; + l_filt->n_bins_ = order + 1; + filter_update_n_bins(index); + return 0; + } + + int + openmc_spatial_legendre_filter_set_params(int32_t index, const int* axis, + const double* min, const double* max) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "spatiallegendre") { + set_errmsg("Not a spatial Legendre filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto l_filt = static_cast(filt); + if (axis) l_filt->axis_ = static_cast(*axis); + if (min) l_filt->min_ = *min; + if (max) l_filt->max_ = *max; + return 0; + } + + int + openmc_sphharm_filter_get_order(int32_t index, int* order) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "sphericalharmonics") { + set_errmsg("Not a spherical harmonics filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto sph_filt = static_cast(filt); + *order = sph_filt->order_; + return 0; + } + + int + openmc_sphharm_filter_get_cosine(int32_t index, char cosine[]) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "sphericalharmonics") { + set_errmsg("Not a spherical harmonics filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto sph_filt = static_cast(filt); + if (sph_filt->cosine_ == SphericalHarmonicsCosine::scatter) { + strcpy(cosine, "scatter"); + } else { + strcpy(cosine, "particle"); + } + return 0; + } + + int + openmc_sphharm_filter_set_order(int32_t index, int order) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "sphericalharmonics") { + set_errmsg("Not a spherical harmonics filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto sph_filt = static_cast(filt); + sph_filt->order_ = order; + sph_filt->n_bins_ = (order + 1) * (order + 1); + filter_update_n_bins(index); + return 0; + } + + int + openmc_sphharm_filter_set_cosine(int32_t index, const char cosine[]) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "sphericalharmonics") { + set_errmsg("Not a spherical harmonics filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto sph_filt = static_cast(filt); + if (strcmp(cosine, "scatter") == 0) { + sph_filt->cosine_ = SphericalHarmonicsCosine::scatter; + } else if (strcmp(cosine, "particle") == 0) { + sph_filt->cosine_ = SphericalHarmonicsCosine::particle; + } else { + set_errmsg("Invalid spherical harmonics cosine."); + return OPENMC_E_INVALID_ARGUMENT; + } + return 0; + } + + int + openmc_zernike_filter_get_order(int32_t index, int* order) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "zernike" && filt->type() != "zernikeradial") { + set_errmsg("Not a Zernike filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto z_filt = static_cast(filt); + *order = z_filt->order_; + return 0; + } + + int + openmc_zernike_filter_get_params(int32_t index, double* x, double* y, + double* r) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "zernike" && filt->type() != "zernikeradial") { + set_errmsg("Not a Zernike filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto z_filt = static_cast(filt); + *x = z_filt->x_; + *y = z_filt->y_; + *r = z_filt->r_; + return 0; + } + + int + openmc_zernike_filter_set_order(int32_t index, int order) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "zernike" && filt->type() != "zernikeradial") { + set_errmsg("Not a Zernike filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto z_filt = static_cast(filt); + z_filt->order_ = order; + z_filt->calc_n_bins(); + filter_update_n_bins(index); + return 0; + } + + int + openmc_zernike_filter_set_params(int32_t index, const double* x, + const double* y, const double* r) + { + int err = verify_filter(index); + if (err) return err; + + auto filt = filter_from_f(index); + if (filt->type() != "zernike" && filt->type() != "zernikeradial") { + set_errmsg("Not a Zernike filter."); + return OPENMC_E_INVALID_TYPE; + } + + auto z_filt = static_cast(filt); + if (x) z_filt->x_ = *x; + if (y) z_filt->y_ = *y; + if (r) z_filt->r_ = *r; + return 0; + } +} + //============================================================================== // Fortran compatibility functions //============================================================================== @@ -159,118 +552,10 @@ extern "C" { int filter_n_bins(TallyFilter* filt) {return filt->n_bins_;} - void - cell_filter_get_bins(CellFilter* filt, int32_t** cells, int32_t* n) - { - *cells = filt->cells_.data(); - *n = filt->cells_.size(); - } - - int legendre_filter_get_order(LegendreFilter* filt) - {return filt->order_;} - - void - legendre_filter_set_order(LegendreFilter* filt, int order) - { - filt->order_ = order; - filt->n_bins_ = order + 1; - } - - void - material_filter_get_bins(MaterialFilter* filt, int32_t** bins, int32_t* n) - { - *bins = filt->materials_.data(); - *n = filt->materials_.size(); - } - - void - material_filter_set_bins(MaterialFilter* filt, int32_t n, int32_t* bins) - { - filt->materials_.clear(); - filt->materials_.resize(n); - for (int i = 0; i < n; i++) filt->materials_[i] = bins[i]; - filt->n_bins_ = filt->materials_.size(); - filt->map_.clear(); - for (int i = 0; i < n; i++) filt->map_[filt->materials_[i]] = i; - } - int mesh_filter_get_mesh(MeshFilter* filt) {return filt->mesh_;} - void - mesh_filter_set_mesh(MeshFilter* filt, int mesh) - { - filt->mesh_ = mesh; - filt->n_bins_ = 1; - for (auto dim : meshes[mesh]->shape_) filt->n_bins_ *= dim; - } - - int meshsurface_filter_get_mesh(MeshSurfaceFilter* filt) {return filt->mesh_;} - - void - meshsurface_filter_set_mesh(MeshSurfaceFilter* filt, int mesh) - { - filt->mesh_ = mesh; - filt->n_bins_ = 4 * meshes[mesh]->n_dimension_; - for (auto dim : meshes[mesh]->shape_) filt->n_bins_ *= dim; - } - - int sphharm_filter_get_order(SphericalHarmonicsFilter* filt) - {return filt->order_;} - int sphharm_filter_get_cosine(SphericalHarmonicsFilter* filt) {return static_cast(filt->cosine_);} - - void - sphharm_filter_set_order(SphericalHarmonicsFilter* filt, int order) - { - filt->order_ = order; - filt->n_bins_ = (order + 1) * (order + 1); - } - - void sphharm_filter_set_cosine(SphericalHarmonicsFilter* filt, int cosine) - {filt->cosine_ = static_cast(cosine);} - - void - sptl_legendre_filter_get_params(SpatialLegendreFilter* filt, int* order, - int* axis, double* min, double* max) - { - *order = filt->order_; - *axis = static_cast(filt->axis_); - *min = filt->min_; - *max = filt->max_; - } - - void - sptl_legendre_filter_set_params(SpatialLegendreFilter* filt, int order, - int axis, double min, double max) - { - filt->order_ = order; - filt->axis_ = static_cast(axis); - filt->min_ = min; - filt->max_ = max; - filt->n_bins_ = order + 1; - } - - void - zernike_filter_get_params(ZernikeFilter* filt, int* order, double* x, - double* y, double* r) - { - *order = filt->order_; - *x = filt->x_; - *y = filt->y_; - *r = filt->r_; - } - - void - zernike_filter_set_params(ZernikeFilter* filt, int order, double x, - double y, double r) - { - filt->order_ = order; - filt->x_ = x; - filt->y_ = y; - filt->r_ = r; - filt->calc_n_bins(); - } } } // namespace openmc diff --git a/src/tallies/tally_filter_cell.F90 b/src/tallies/tally_filter_cell.F90 index f4201ffb7..808cbaf57 100644 --- a/src/tallies/tally_filter_cell.F90 +++ b/src/tallies/tally_filter_cell.F90 @@ -1,53 +1,14 @@ module tally_filter_cell - use, intrinsic :: ISO_C_BINDING - - use error use tally_filter_header implicit none - private - public :: openmc_cell_filter_get_bins !=============================================================================== ! CELLFILTER specifies which geometric cells tally events reside in. !=============================================================================== - type, public, extends(CppTallyFilter) :: CellFilter + type, extends(CppTallyFilter) :: CellFilter end type CellFilter -contains - -!=============================================================================== -! C API FUNCTIONS -!=============================================================================== - - function openmc_cell_filter_get_bins(index, cells, n) result(err) bind(C) - ! Return the cells associated with a cell filter - integer(C_INT32_T), value :: index - type(C_PTR), intent(out) :: cells - integer(C_INT32_T), intent(out) :: n - integer(C_INT) :: err - - interface - subroutine cell_filter_get_bins(filt, cells, n) bind(C) - import C_PTR, C_INT - type(C_PTR), intent(in), value :: filt - type(C_PTR), intent(out) :: cells - integer(C_INT), intent(out) :: n - end subroutine cell_filter_get_bins - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (CellFilter) - call cell_filter_get_bins(f % ptr, cells, n) - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to get cells from a non-cell filter.") - end select - end if - end function openmc_cell_filter_get_bins - end module tally_filter_cell diff --git a/src/tallies/tally_filter_header.F90 b/src/tallies/tally_filter_header.F90 index 93e1a82d6..a873310ff 100644 --- a/src/tallies/tally_filter_header.F90 +++ b/src/tallies/tally_filter_header.F90 @@ -424,8 +424,8 @@ contains ! array is sufficient and a filter object has already been allocated. !=============================================================================== - function verify_filter(index) result(err) - integer(C_INT32_T), intent(in) :: index + function verify_filter(index) result(err) bind(C) + integer(C_INT32_T), intent(in), value :: index integer(C_INT) :: err err = 0 @@ -440,6 +440,33 @@ contains end if end function verify_filter +!=============================================================================== +! FILTER_FROM_F given a Fortran index, return a pointer to a C++ filter. +!=============================================================================== + + function filter_from_f(index) result(filt) bind(C) + integer(C_INT32_T), intent(in), value :: index + type(C_PTR) :: filt + + filt = C_NULL_PTR + select type(f => filters(index) % obj) + class is (CppTallyFilter) + filt = f % ptr + end select + end function + +!=============================================================================== +! FILTER_UPDATE_N_BINS updates filt % n_bins using C++. +!=============================================================================== + + subroutine filter_update_n_bins(index) bind(C) + integer(C_INT32_T), intent(in), value :: index + select type(f => filters(index) % obj) + class is (CppTallyFilter) + f % n_bins = f % n_bins_cpp() + end select + end subroutine + !=============================================================================== ! C API FUNCTIONS !=============================================================================== diff --git a/src/tallies/tally_filter_legendre.F90 b/src/tallies/tally_filter_legendre.F90 index 60bb59c76..f4d2a3d81 100644 --- a/src/tallies/tally_filter_legendre.F90 +++ b/src/tallies/tally_filter_legendre.F90 @@ -2,13 +2,18 @@ module tally_filter_legendre use, intrinsic :: ISO_C_BINDING - use error use tally_filter_header implicit none - private - public :: openmc_legendre_filter_get_order - public :: openmc_legendre_filter_set_order + + interface + function openmc_legendre_filter_set_order(index, order) result(err) bind(C) + import C_INT32_T, C_INT + integer(C_INT32_T), value :: index + integer(C_INT), value :: order + integer(C_INT) :: err + end function + end interface !=============================================================================== ! LEGENDREFILTER gives Legendre moments of the change in scattering angle @@ -17,64 +22,4 @@ module tally_filter_legendre type, public, extends(CppTallyFilter) :: LegendreFilter end type LegendreFilter -contains - -!=============================================================================== -! C API FUNCTIONS -!=============================================================================== - - function openmc_legendre_filter_get_order(index, order) result(err) bind(C) - ! Get the order of an expansion filter - integer(C_INT32_T), value :: index - integer(C_INT), intent(out) :: order - integer(C_INT) :: err - - interface - function legendre_filter_get_order(filt) result(order) bind(C) - import C_PTR, C_INT - type(C_PTR), value :: filt - integer(C_INT) :: order - end function - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (LegendreFilter) - order = legendre_filter_get_order(f % ptr) - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to get order on a non-expansion filter.") - end select - end if - end function openmc_legendre_filter_get_order - - - function openmc_legendre_filter_set_order(index, order) result(err) bind(C) - ! Set the order of an expansion filter - integer(C_INT32_T), value :: index - integer(C_INT), value :: order - integer(C_INT) :: err - - interface - subroutine legendre_filter_set_order(filt, order) bind(C) - import C_PTR, C_INT - type(C_PTR), value :: filt - integer(C_INT), value :: order - end subroutine legendre_filter_set_order - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (LegendreFilter) - call legendre_filter_set_order(f % ptr, order) - f % n_bins = f % n_bins_cpp() - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to set order on a non-expansion filter.") - end select - end if - end function openmc_legendre_filter_set_order - end module tally_filter_legendre diff --git a/src/tallies/tally_filter_material.F90 b/src/tallies/tally_filter_material.F90 index 9b1b83d2d..f2bd7843c 100644 --- a/src/tallies/tally_filter_material.F90 +++ b/src/tallies/tally_filter_material.F90 @@ -1,8 +1,5 @@ module tally_filter_material - use, intrinsic :: ISO_C_BINDING - - use error use tally_filter_header implicit none @@ -14,72 +11,4 @@ module tally_filter_material type, extends(CppTallyFilter) :: MaterialFilter end type MaterialFilter -contains - -!=============================================================================== -! C API FUNCTIONS -!=============================================================================== - - function openmc_material_filter_get_bins(index, bins, n) result(err) bind(C) - ! Return the bins for a material filter - integer(C_INT32_T), value :: index - type(C_PTR), intent(out) :: bins - integer(C_INT32_T), intent(out) :: n - integer(C_INT) :: err - - interface - subroutine material_filter_get_bins(filt, bins, n) bind(C) - import C_PTR, C_INT32_T - type(C_PTR), value :: filt - type(C_PTR) :: bins - integer(C_INT32_T) :: n - end subroutine material_filter_get_bins - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (MaterialFilter) - call material_filter_get_bins(f % ptr, bins, n) - err = 0 - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to get material filter bins on a & - &non-material filter.") - end select - end if - end function openmc_material_filter_get_bins - - - function openmc_material_filter_set_bins(index, n, bins) result(err) bind(C) - ! Set the materials for the filter - integer(C_INT32_T), value, intent(in) :: index - integer(C_INT32_T), value, intent(in) :: n - integer(C_INT32_T), intent(in) :: bins(n) - integer(C_INT) :: err - - interface - subroutine material_filter_set_bins(filt, n, bins) bind(C) - import C_PTR, C_INT32_T - type(C_PTR), value :: filt - integer(C_INT32_T), value :: n - integer(C_INT32_T) :: bins(n) - end subroutine material_filter_set_bins - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (MaterialFilter) - call material_filter_set_bins(f % ptr, n, bins) - f % n_bins = f % n_bins_cpp() - - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to set material filter bins on a & - &non-material filter.") - end select - end if - end function openmc_material_filter_set_bins - end module tally_filter_material diff --git a/src/tallies/tally_filter_mesh.F90 b/src/tallies/tally_filter_mesh.F90 index 5d2307aef..c26376601 100644 --- a/src/tallies/tally_filter_mesh.F90 +++ b/src/tallies/tally_filter_mesh.F90 @@ -2,15 +2,18 @@ module tally_filter_mesh use, intrinsic :: ISO_C_BINDING - use constants - use error - use mesh_header use tally_filter_header implicit none - private - public :: openmc_mesh_filter_get_mesh - public :: openmc_mesh_filter_set_mesh + + interface + function openmc_mesh_filter_set_mesh(index, index_mesh) result(err) bind(C) + import C_INT32_T, C_INT + integer(C_INT32_T), value, intent(in) :: index + integer(C_INT32_T), value, intent(in) :: index_mesh + integer(C_INT) :: err + end function + end interface !=============================================================================== ! MESHFILTER indexes the location of particle events to a regular mesh. For @@ -38,59 +41,4 @@ contains mesh = mesh_filter_get_mesh(this % ptr) end function get_mesh -!=============================================================================== -! C API FUNCTIONS -!=============================================================================== - - function openmc_mesh_filter_get_mesh(index, index_mesh) result(err) bind(C) - ! Get the mesh for a mesh filter - integer(C_INT32_T), value, intent(in) :: index - integer(C_INT32_T), intent(out) :: index_mesh - integer(C_INT) :: err - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (MeshFilter) - index_mesh = f % mesh() - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to set mesh on a non-mesh filter.") - end select - end if - end function openmc_mesh_filter_get_mesh - - - function openmc_mesh_filter_set_mesh(index, index_mesh) result(err) bind(C) - ! Set the mesh for a mesh filter - integer(C_INT32_T), value, intent(in) :: index - integer(C_INT32_T), value, intent(in) :: index_mesh - integer(C_INT) :: err - - interface - subroutine mesh_filter_set_mesh(filt, mesh) bind(C) - import C_PTR, C_INT - type(C_PTR), value :: filt - integer(C_INT), value :: mesh - end subroutine mesh_filter_set_mesh - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (MeshFilter) - if (index_mesh >= 0 .and. index_mesh < n_meshes()) then - call mesh_filter_set_mesh(f % ptr, index_mesh) - f % n_bins = f % n_bins_cpp() - else - err = E_OUT_OF_BOUNDS - call set_errmsg("Index in 'meshes' array is out of bounds.") - end if - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to set mesh on a non-mesh filter.") - end select - end if - end function openmc_mesh_filter_set_mesh - end module tally_filter_mesh diff --git a/src/tallies/tally_filter_meshsurface.F90 b/src/tallies/tally_filter_meshsurface.F90 index 22453a40f..0b10c9cce 100644 --- a/src/tallies/tally_filter_meshsurface.F90 +++ b/src/tallies/tally_filter_meshsurface.F90 @@ -8,9 +8,16 @@ module tally_filter_meshsurface use tally_filter_header implicit none - private - public :: openmc_meshsurface_filter_get_mesh - public :: openmc_meshsurface_filter_set_mesh + + interface + function openmc_meshsurface_filter_set_mesh(index, index_mesh) result(err) & + bind(C) + import C_INT32_T, C_INT + integer(C_INT32_T), value, intent(in) :: index + integer(C_INT32_T), value, intent(in) :: index_mesh + integer(C_INT) :: err + end function + end interface !=============================================================================== ! MESHFILTER indexes the location of particle events to a regular mesh. For @@ -18,72 +25,7 @@ module tally_filter_meshsurface ! will correspond to the fraction of the track length that lies in that bin. !=============================================================================== - type, public, extends(CppTallyFilter) :: MeshSurfaceFilter + type, extends(CppTallyFilter) :: MeshSurfaceFilter end type MeshSurfaceFilter -contains - -!=============================================================================== -! C API FUNCTIONS -!=============================================================================== - - function openmc_meshsurface_filter_get_mesh(index, index_mesh) result(err) bind(C) - ! Get the mesh for a mesh surface filter - integer(C_INT32_T), value, intent(in) :: index - integer(C_INT32_T), intent(out) :: index_mesh - integer(C_INT) :: err - - interface - function meshsurface_filter_get_mesh(filt) result(index_mesh) bind(C) - import C_PTR, C_INT - type(C_PTR), value :: filt - integer(C_INT) :: index_mesh - end function meshsurface_filter_get_mesh - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (MeshSurfaceFilter) - index_mesh = meshsurface_filter_get_mesh(f % ptr) - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to set mesh on a non-mesh filter.") - end select - end if - end function openmc_meshsurface_filter_get_mesh - - - function openmc_meshsurface_filter_set_mesh(index, index_mesh) result(err) bind(C) - ! Set the mesh for a mesh surface filter - integer(C_INT32_T), value, intent(in) :: index - integer(C_INT32_T), value, intent(in) :: index_mesh - integer(C_INT) :: err - - interface - subroutine meshsurface_filter_set_mesh(filt, mesh) bind(C) - import C_PTR, C_INT - type(C_PTR), value :: filt - integer(C_INT), value :: mesh - end subroutine meshsurface_filter_set_mesh - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (MeshSurfaceFilter) - if (index_mesh >= 0 .and. index_mesh < n_meshes()) then - call meshsurface_filter_set_mesh(f % ptr, index_mesh) - f % n_bins = f % n_bins_cpp() - else - err = E_OUT_OF_BOUNDS - call set_errmsg("Index in 'meshes' array is out of bounds.") - end if - class default - err = E_INVALID_TYPE - call set_errmsg("Tried to set mesh on a non-mesh filter.") - end select - end if - end function openmc_meshsurface_filter_set_mesh - end module tally_filter_meshsurface diff --git a/src/tallies/tally_filter_sph_harm.F90 b/src/tallies/tally_filter_sph_harm.F90 index 59120940c..a2854841c 100644 --- a/src/tallies/tally_filter_sph_harm.F90 +++ b/src/tallies/tally_filter_sph_harm.F90 @@ -2,16 +2,10 @@ module tally_filter_sph_harm use, intrinsic :: ISO_C_BINDING - use error - use string, only: to_str, to_lower, to_f_string use tally_filter_header implicit none private - public :: openmc_sphharm_filter_get_order - public :: openmc_sphharm_filter_get_cosine - public :: openmc_sphharm_filter_set_order - public :: openmc_sphharm_filter_set_cosine integer, public, parameter :: COSINE_SCATTER = 1 integer, public, parameter :: COSINE_PARTICLE = 2 @@ -41,133 +35,4 @@ contains val = sphharm_filter_get_cosine(this % ptr) end function cosine -!=============================================================================== -! C API FUNCTIONS -!=============================================================================== - - function openmc_sphharm_filter_get_order(index, order) result(err) bind(C) - ! Get the order of an expansion filter - integer(C_INT32_T), value :: index - integer(C_INT), intent(out) :: order - integer(C_INT) :: err - - interface - function sphharm_filter_get_order(filt) result(order) bind(C) - import C_PTR, C_INT - type(C_PTR), value :: filt - integer(C_INT) :: order - end function sphharm_filter_get_order - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (SphericalHarmonicsFilter) - order = sphharm_filter_get_order(f % ptr) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a spherical harmonics filter.") - end select - end if - end function openmc_sphharm_filter_get_order - - - function openmc_sphharm_filter_get_cosine(index, cosine) result(err) bind(C) - ! Get the order of an expansion filter - integer(C_INT32_T), value :: index - character(kind=C_CHAR), intent(out) :: cosine(*) - integer(C_INT) :: err - - integer :: i - character(10) :: cosine_ - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (SphericalHarmonicsFilter) - select case (f % cosine()) - case (COSINE_SCATTER) - cosine_ = 'scatter' - case (COSINE_PARTICLE) - cosine_ = 'particle' - end select - - ! Convert to C string - do i = 1, len_trim(cosine_) - cosine(i) = cosine_(i:i) - end do - cosine(len_trim(cosine_) + 1) = C_NULL_CHAR - - class default - err = E_INVALID_TYPE - call set_errmsg("Not a spherical harmonics filter.") - end select - end if - end function openmc_sphharm_filter_get_cosine - - - function openmc_sphharm_filter_set_order(index, order) result(err) bind(C) - ! Set the order of an expansion filter - integer(C_INT32_T), value :: index - integer(C_INT), value :: order - integer(C_INT) :: err - - interface - subroutine sphharm_filter_set_order(filt, order) bind(C) - import C_PTR, C_INT - type(C_PTR), value :: filt - integer(C_INT), value :: order - end subroutine - end interface - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (SphericalHarmonicsFilter) - call sphharm_filter_set_order(f % ptr, order) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a spherical harmonics filter.") - end select - end if - end function openmc_sphharm_filter_set_order - - - function openmc_sphharm_filter_set_cosine(index, cosine) result(err) bind(C) - ! Set the cosine parameter - integer(C_INT32_T), value :: index - character(kind=C_CHAR), intent(in) :: cosine(*) - integer(C_INT) :: err - - character(:), allocatable :: cosine_ - - interface - subroutine sphharm_filter_set_cosine(filt, cosine) bind(C) - import C_PTR, C_INT - type(C_PTR), value :: filt - integer(C_INT), value :: cosine - end subroutine - end interface - - ! Convert C string to Fortran string - cosine_ = to_f_string(cosine) - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (SphericalHarmonicsFilter) - select case (cosine_) - case ('scatter') - call sphharm_filter_set_cosine(f % ptr, COSINE_SCATTER) - case ('particle') - call sphharm_filter_set_cosine(f % ptr, COSINE_PARTICLE) - end select - - class default - err = E_INVALID_TYPE - call set_errmsg("Not a spherical harmonics filter.") - end select - end if - end function openmc_sphharm_filter_set_cosine - end module tally_filter_sph_harm diff --git a/src/tallies/tally_filter_sptl_legendre.F90 b/src/tallies/tally_filter_sptl_legendre.F90 index f883e4aec..f73e2322a 100644 --- a/src/tallies/tally_filter_sptl_legendre.F90 +++ b/src/tallies/tally_filter_sptl_legendre.F90 @@ -1,149 +1,15 @@ module tally_filter_sptl_legendre - use, intrinsic :: ISO_C_BINDING - - use error use tally_filter_header implicit none - private - public :: openmc_spatial_legendre_filter_get_order - public :: openmc_spatial_legendre_filter_get_params - public :: openmc_spatial_legendre_filter_set_order - public :: openmc_spatial_legendre_filter_set_params - - interface - subroutine sptl_legendre_filter_get_params(filt, order, axis, min, max) & - bind(C) - import C_PTR, C_INT, C_DOUBLE - type(C_PTR), value :: filt - integer(C_INT) :: order - integer(C_INT) :: axis - real(C_DOUBLE) :: min - real(C_DOUBLE) :: max - end subroutine - - subroutine sptl_legendre_filter_set_params(filt, order, axis, min, max) & - bind(C) - import C_PTR, C_INT, C_DOUBLE - type(C_PTR), value :: filt - integer(C_INT), value :: order - integer(C_INT), value :: axis - real(C_DOUBLE), value :: min - real(C_DOUBLE), value :: max - end subroutine - end interface !=============================================================================== ! SPATIALLEGENDREFILTER gives Legendre moments of the particle's normalized ! position along an axis !=============================================================================== - type, public, extends(CppTallyFilter) :: SpatialLegendreFilter + type, extends(CppTallyFilter) :: SpatialLegendreFilter end type SpatialLegendreFilter -contains - -!=============================================================================== -! C API FUNCTIONS -!=============================================================================== - - function openmc_spatial_legendre_filter_get_order(index, order) result(err) bind(C) - ! Get the order of an expansion filter - integer(C_INT32_T), value :: index - integer(C_INT), intent(out) :: order - integer(C_INT) :: err - - integer(C_INT) :: axis - real(C_DOUBLE) :: min, max - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (SpatialLegendreFilter) - call sptl_legendre_filter_get_params(f % ptr, order, axis, min, max) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a spatial Legendre filter.") - end select - end if - end function openmc_spatial_legendre_filter_get_order - - - function openmc_spatial_legendre_filter_set_order(index, order) result(err) bind(C) - ! Set the order of an expansion filter - integer(C_INT32_T), value :: index - integer(C_INT), value :: order - integer(C_INT) :: err - - integer(C_INT) :: axis, order_ - real(C_DOUBLE) :: min, max - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - type is (SpatialLegendreFilter) - call sptl_legendre_filter_get_params(f % ptr, order_, axis, min, max) - call sptl_legendre_filter_set_params(f % ptr, order, axis, min, max) - f % n_bins = f % n_bins_cpp() - class default - err = E_INVALID_TYPE - call set_errmsg("Not a spatial Legendre filter.") - end select - end if - end function openmc_spatial_legendre_filter_set_order - - - function openmc_spatial_legendre_filter_get_params(index, axis, min, max) & - result(err) bind(C) - ! Get the parameters for a spatial Legendre filter - integer(C_INT32_T), value :: index - integer(C_INT), intent(out) :: axis - real(C_DOUBLE), intent(out) :: min - real(C_DOUBLE), intent(out) :: max - integer(C_INT) :: err - - integer(C_INT) :: order - - err = verify_filter(index) - if (err == 0) then - select type(f => filters(index) % obj) - type is (SpatialLegendreFilter) - call sptl_legendre_filter_get_params(f % ptr, order, axis, min, max) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a spatial Legendre filter.") - end select - end if - end function openmc_spatial_legendre_filter_get_params - - - function openmc_spatial_legendre_filter_set_params(index, axis, min, max) & - result(err) bind(C) - ! Set the parameters for a spatial Legendre filter - integer(C_INT32_T), value :: index - integer(C_INT), intent(in), optional :: axis - real(C_DOUBLE), intent(in), optional :: min - real(C_DOUBLE), intent(in), optional :: max - integer(C_INT) :: err - - integer(C_INT) :: order, axis_ - real(C_DOUBLE) :: min_, max_ - - err = verify_filter(index) - if (err == 0) then - select type(f => filters(index) % obj) - type is (SpatialLegendreFilter) - call sptl_legendre_filter_get_params(f % ptr, order, axis_, min_, max_) - if (present(axis)) axis_ = axis - if (present(min)) min_ = min - if (present(max)) max_ = max - call sptl_legendre_filter_set_params(f % ptr, order, axis_, min_, max_) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a spatial Legendre filter.") - end select - end if - end function openmc_spatial_legendre_filter_set_params - end module tally_filter_sptl_legendre diff --git a/src/tallies/tally_filter_zernike.F90 b/src/tallies/tally_filter_zernike.F90 index aabb21f3f..c4330120d 100644 --- a/src/tallies/tally_filter_zernike.F90 +++ b/src/tallies/tally_filter_zernike.F90 @@ -1,38 +1,14 @@ module tally_filter_zernike - use, intrinsic :: ISO_C_BINDING - - use error use tally_filter_header implicit none - private - public :: openmc_zernike_filter_get_order - public :: openmc_zernike_filter_get_params - public :: openmc_zernike_filter_set_order - public :: openmc_zernike_filter_set_params - - interface - subroutine zernike_filter_get_params(filt, order, x, y, r) bind(C) - import C_PTR, C_INT, C_DOUBLE - type(C_PTR), value :: filt - integer(C_INT) :: order - real(C_DOUBLE) :: x, y, r - end subroutine - - subroutine zernike_filter_set_params(filt, order, x, y, r) bind(C) - import C_PTR, C_INT, C_DOUBLE - type(C_PTR), value :: filt - integer(C_INT), value :: order - real(C_DOUBLE), value :: x, y, r - end subroutine - end interface !=============================================================================== ! ZERNIKEFILTER gives Zernike polynomial moments of a particle's position !=============================================================================== - type, public, extends(CppTallyFilter) :: ZernikeFilter + type, extends(CppTallyFilter) :: ZernikeFilter end type ZernikeFilter !=============================================================================== @@ -40,107 +16,7 @@ module tally_filter_zernike ! particle's position !=============================================================================== - type, public, extends(ZernikeFilter) :: ZernikeRadialFilter + type, extends(ZernikeFilter) :: ZernikeRadialFilter end type ZernikeRadialFilter -contains - -!=============================================================================== -! C API FUNCTIONS -!=============================================================================== - - function openmc_zernike_filter_get_order(index, order) result(err) bind(C) - ! Get the order of an expansion filter - integer(C_INT32_T), value :: index - integer(C_INT), intent(out) :: order - integer(C_INT) :: err - - real(C_DOUBLE) :: x, y, r - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - class is (ZernikeFilter) - call zernike_filter_get_params(f % ptr, order, x, y, r) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a Zernike filter.") - end select - end if - end function openmc_zernike_filter_get_order - - - function openmc_zernike_filter_get_params(index, x, y, r) result(err) bind(C) - ! Get the Zernike filter parameters - integer(C_INT32_T), value :: index - real(C_DOUBLE), intent(out) :: x - real(C_DOUBLE), intent(out) :: y - real(C_DOUBLE), intent(out) :: r - integer(C_INT) :: err - - integer(C_INT) :: order - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - class is (ZernikeFilter) - call zernike_filter_get_params(f % ptr, order, x, y, r) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a Zernike filter.") - end select - end if - end function openmc_zernike_filter_get_params - - - function openmc_zernike_filter_set_order(index, order) result(err) bind(C) - ! Set the order of an expansion filter - integer(C_INT32_T), value :: index - integer(C_INT), value :: order - integer(C_INT) :: err - - integer(C_INT) :: order_ - real(C_DOUBLE) :: x, y, r - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - class is (ZernikeFilter) - call zernike_filter_get_params(f % ptr, order_, x, y, r) - call zernike_filter_set_params(f % ptr, order, x, y, r) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a Zernike filter.") - end select - end if - end function openmc_zernike_filter_set_order - - - function openmc_zernike_filter_set_params(index, x, y, r) result(err) bind(C) - ! Set the Zernike filter parameters - integer(C_INT32_T), value :: index - real(C_DOUBLE), intent(in), optional :: x - real(C_DOUBLE), intent(in), optional :: y - real(C_DOUBLE), intent(in), optional :: r - integer(C_INT) :: err - - integer(C_INT) :: order - real(C_DOUBLE) :: x_, y_, r_ - - err = verify_filter(index) - if (err == 0) then - select type (f => filters(index) % obj) - class is (ZernikeFilter) - call zernike_filter_get_params(f % ptr, order, x_, y_, r_) - if (present(x)) x_ = x - if (present(y)) y_ = y - if (present(r)) r_ = r - call zernike_filter_set_params(f % ptr, order, x_, y_, r_) - class default - err = E_INVALID_TYPE - call set_errmsg("Not a Zernike filter.") - end select - end if - end function openmc_zernike_filter_set_params - end module tally_filter_zernike