crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-26 13:15:39 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Move tally filter C-API functions to C++

Browse source
This commit is contained in:
Sterling Harper 2018-10-19 15:09:55 -04:00
parent 5a6db8a0de
commit 2fd6a92074
12 changed files with 455 additions and 818 deletions
Download patch file Download diff file Expand all files Collapse all files

2
include/openmc/tallies/tally_filter_sph_harm.h
View file

@ -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") {

5
src/api.F90
View file

@ -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

501
src/tallies/tally_filter.cpp
View file

@ -2,7 +2,9 @@
#include <string>
#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<CellFilter*>(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<LegendreFilter*>(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<LegendreFilter*>(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<MaterialFilter*>(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<MaterialFilter*>(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<MeshFilter*>(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<MeshFilter*>(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<SpatialLegendreFilter*>(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<SpatialLegendreFilter*>(filt);
*axis = static_cast<int>(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<SpatialLegendreFilter*>(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<SpatialLegendreFilter*>(filt);
if (axis) l_filt->axis_ = static_cast<LegendreAxis>(*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<SphericalHarmonicsFilter*>(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<SphericalHarmonicsFilter*>(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<SphericalHarmonicsFilter*>(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<SphericalHarmonicsFilter*>(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<ZernikeFilter*>(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<ZernikeFilter*>(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<ZernikeFilter*>(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<ZernikeFilter*>(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<int>(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<SphericalHarmonicsCosine>(cosine);}
void
sptl_legendre_filter_get_params(SpatialLegendreFilter* filt, int* order,
int* axis, double* min, double* max)
{
*order = filt->order_;
*axis = static_cast<int>(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<LegendreAxis>(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

41
src/tallies/tally_filter_cell.F90
View file

@ -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

31
src/tallies/tally_filter_header.F90
View file

@ -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
!===============================================================================

73
src/tallies/tally_filter_legendre.F90
View file

@ -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

71
src/tallies/tally_filter_material.F90
View file

@ -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

70
src/tallies/tally_filter_mesh.F90
View file

@ -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

80
src/tallies/tally_filter_meshsurface.F90
View file

@ -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

135
src/tallies/tally_filter_sph_harm.F90
View file

@ -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

136
src/tallies/tally_filter_sptl_legendre.F90
View file

@ -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

128
src/tallies/tally_filter_zernike.F90
View file

@ -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