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

Add C API functions for expansion filters

Browse source
This commit is contained in:
Paul Romano 2018-03-30 13:21:15 -05:00
parent f5137f7316
commit a3240b69c3
10 changed files with 475 additions and 157 deletions
Download patch file Download diff file Expand all files Collapse all files

5
docs/source/capi/index.rst
View file

@ -247,11 +247,12 @@ Functions
:return: Return status (negative if an error occurs)
:rtype: int
.. c:function:: int openmc_get_nuclide_index(char name[], int* index)
.. c:function:: int openmc_get_nuclide_index(const char name[], int* index)
Get the index in the nuclides array for a nuclide with a given name
:param char[] name: Name of the nuclide
:param name: Name of the nuclide
:type name: const char[]
:param int* index: Index in the nuclides array
:return: Return status (negative if an error occurs)
:rtype: int

18
include/openmc.h
View file

@ -38,10 +38,12 @@ extern "C" {
void openmc_get_filter_next_id(int32_t* id);
int openmc_get_keff(double k_combined[]);
int openmc_get_material_index(int32_t id, int32_t* index);
int openmc_get_nuclide_index(char name[], int* index);
int openmc_get_nuclide_index(const char name[], int* index);
int openmc_get_tally_index(int32_t id, int32_t* index);
void openmc_hard_reset();
void openmc_init(const int* intracomm);
int openmc_legendre_filter_get_order(int32_t index, int* order);
int openmc_legendre_filter_set_order(int32_t index, int order);
int openmc_load_nuclide(char name[]);
int openmc_material_add_nuclide(int32_t index, const char name[], double density);
int openmc_material_get_densities(int32_t index, int** nuclides, double** densities, int* n);
@ -62,6 +64,15 @@ extern "C" {
void openmc_simulation_init();
int openmc_source_bank(struct Bank** ptr, int64_t* n);
int openmc_source_set_strength(int32_t index, double strength);
int openmc_spatial_legendre_filter_get_order(int32_t index, int* order);
int openmc_spatial_legendre_filter_get_params(int32_t index, int* axis, double* min, double* max);
int openmc_spatial_legendre_filter_set_order(int32_t index, int order);
int openmc_spatial_legendre_filter_set_params(int32_t index, const int* axis,
const double* min, const double* max);
int openmc_sphharm_filter_get_order(int32_t index, int* order);
int openmc_sphharm_filter_get_cosine(int32_t index, char cosine[]);
int openmc_sphharm_filter_set_order(int32_t index, int order);
int openmc_sphharm_filter_set_cosine(int32_t index, const char cosine[]);
void openmc_statepoint_write(const char filename[]);
int openmc_tally_get_id(int32_t index, int32_t* id);
int openmc_tally_get_filters(int32_t index, int32_t** indices, int* n);
@ -73,6 +84,11 @@ extern "C" {
int openmc_tally_set_id(int32_t index, int32_t id);
int openmc_tally_set_nuclides(int32_t index, int n, const char** nuclides);
int openmc_tally_set_scores(int32_t index, int n, const int* scores);
int openmc_zernike_filter_get_order(int32_t index, int* order);
int openmc_zernike_filter_get_params(int32_t index, double* x, double* y, double* r);
int openmc_zernike_filter_set_order(int32_t index, int order);
int openmc_zernike_filter_set_params(int32_t index, const double* x,
const double* y, const double* r);
// Error codes
extern int E_UNASSIGNED;

112
src/tallies/tally_filter.F90
View file

@ -46,68 +46,60 @@ contains
integer :: i
character(20) :: type_
if (index >= 1 .and. index <= n_filters) then
if (allocated(filters(index) % obj)) then
! Get type as a Fortran string
select type (f => filters(index) % obj)
type is (AzimuthalFilter)
type_ = 'azimuthal'
type is (CellFilter)
type_ = 'cell'
type is (CellbornFilter)
type_ = 'cellborn'
type is (CellfromFilter)
type_ = 'cellfrom'
type is (DelayedGroupFilter)
type_ = 'delayedgroup'
type is (DistribcellFilter)
type_ = 'distribcell'
type is (EnergyFilter)
type_ = 'energy'
type is (EnergyoutFilter)
type_ = 'energyout'
type is (EnergyFunctionFilter)
type_ = 'energyfunction'
type is (LegendreFilter)
type_ = 'legendre'
type is (MaterialFilter)
type_ = 'material'
type is (MeshFilter)
type_ = 'mesh'
type is (MeshSurfaceFilter)
type_ = 'meshsurface'
type is (MuFilter)
type_ = 'mu'
type is (PolarFilter)
type_ = 'polar'
type is (SphericalHarmonicsFilter)
type_ = 'sphericalharmonics'
type is (SpatialLegendreFilter)
type_ = 'spatiallegendre'
type is (SurfaceFilter)
type_ = 'surface'
type is (UniverseFilter)
type_ = 'universe'
type is (ZernikeFilter)
type_ = 'zernike'
end select
err = verify_filter(index)
if (err == 0) then
! Get type as a Fortran string
select type (f => filters(index) % obj)
type is (AzimuthalFilter)
type_ = 'azimuthal'
type is (CellFilter)
type_ = 'cell'
type is (CellbornFilter)
type_ = 'cellborn'
type is (CellfromFilter)
type_ = 'cellfrom'
type is (DelayedGroupFilter)
type_ = 'delayedgroup'
type is (DistribcellFilter)
type_ = 'distribcell'
type is (EnergyFilter)
type_ = 'energy'
type is (EnergyoutFilter)
type_ = 'energyout'
type is (EnergyFunctionFilter)
type_ = 'energyfunction'
type is (LegendreFilter)
type_ = 'legendre'
type is (MaterialFilter)
type_ = 'material'
type is (MeshFilter)
type_ = 'mesh'
type is (MeshSurfaceFilter)
type_ = 'meshsurface'
type is (MuFilter)
type_ = 'mu'
type is (PolarFilter)
type_ = 'polar'
type is (SphericalHarmonicsFilter)
type_ = 'sphericalharmonics'
type is (SpatialLegendreFilter)
type_ = 'spatiallegendre'
type is (SurfaceFilter)
type_ = 'surface'
type is (UniverseFilter)
type_ = 'universe'
type is (ZernikeFilter)
type_ = 'zernike'
end select
! Convert Fortran string to null-terminated C string. We assume the
! caller has allocated a char array buffer
do i = 1, len_trim(type_)
type(i) = type_(i:i)
end do
type(len_trim(type_) + 1) = C_NULL_CHAR
err = 0
else
err = E_ALLOCATE
call set_errmsg("Filter type has not been set yet.")
end if
else
err = E_OUT_OF_BOUNDS
call set_errmsg("Index in filters array is out of bounds.")
! Convert Fortran string to null-terminated C string. We assume the
! caller has allocated a char array buffer
do i = 1, len_trim(type_)
type(i) = type_(i:i)
end do
type(len_trim(type_) + 1) = C_NULL_CHAR
end if
end function openmc_filter_get_type

75
src/tallies/tally_filter_energy.F90
View file

@ -204,28 +204,21 @@ contains
integer(C_INT32_T), intent(out) :: n
integer(C_INT) :: err
if (index >= 1 .and. index <= n_filters) then
if (allocated(filters(index) % obj)) then
select type (f => filters(index) % obj)
type is (EnergyFilter)
energies = C_LOC(f % bins)
n = size(f % bins)
err = 0
type is (EnergyoutFilter)
energies = C_LOC(f % bins)
n = size(f % bins)
err = 0
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (EnergyFilter)
energies = C_LOC(f % bins)
n = size(f % bins)
err = 0
type is (EnergyoutFilter)
energies = C_LOC(f % bins)
n = size(f % bins)
err = 0
class default
err = E_INVALID_TYPE
call set_errmsg("Tried to get energy bins on a non-energy filter.")
end select
else
err = E_ALLOCATE
call set_errmsg("Filter type has not been set yet.")
end if
else
err = E_OUT_OF_BOUNDS
call set_errmsg("Index in filters array out of bounds.")
err = E_INVALID_TYPE
call set_errmsg("Tried to get energy bins on a non-energy filter.")
end select
end if
end function openmc_energy_filter_get_bins
@ -237,31 +230,23 @@ contains
real(C_DOUBLE), intent(in) :: energies(n)
integer(C_INT) :: err
err = 0
if (index >= 1 .and. index <= n_filters) then
if (allocated(filters(index) % obj)) then
select type (f => filters(index) % obj)
type is (EnergyFilter)
f % n_bins = n - 1
if (allocated(f % bins)) deallocate(f % bins)
allocate(f % bins(n))
f % bins(:) = energies
type is (EnergyoutFilter)
f % n_bins = n - 1
if (allocated(f % bins)) deallocate(f % bins)
allocate(f % bins(n))
f % bins(:) = energies
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (EnergyFilter)
f % n_bins = n - 1
if (allocated(f % bins)) deallocate(f % bins)
allocate(f % bins(n))
f % bins(:) = energies
type is (EnergyoutFilter)
f % n_bins = n - 1
if (allocated(f % bins)) deallocate(f % bins)
allocate(f % bins(n))
f % bins(:) = energies
class default
err = E_INVALID_TYPE
call set_errmsg("Tried to get energy bins on a non-energy filter.")
end select
else
err = E_ALLOCATE
call set_errmsg("Filter type has not been set yet.")
end if
else
err = E_OUT_OF_BOUNDS
call set_errmsg("Index in filters array out of bounds.")
err = E_INVALID_TYPE
call set_errmsg("Tried to get energy bins on a non-energy filter.")
end select
end if
end function openmc_energy_filter_set_bins

22
src/tallies/tally_filter_header.F90
View file

@ -15,6 +15,7 @@ module tally_filter_header
implicit none
private
public :: free_memory_tally_filter
public :: verify_filter
public :: openmc_extend_filters
public :: openmc_filter_get_id
public :: openmc_filter_set_id
@ -148,6 +149,27 @@ contains
largest_filter_id = 0
end subroutine free_memory_tally_filter
!===============================================================================
! VERIFY_FILTER makes sure that given a filter index, the size of the filters
! array is sufficient and a filter object has already been allocated.
!===============================================================================
function verify_filter(index) result(err)
integer(C_INT32_T), intent(in) :: index
integer(C_INT) :: err
err = 0
if (index >= 1 .and. index <= n_filters) then
if (.not. allocated(filters(index) % obj)) then
err = E_ALLOCATE
call set_errmsg("Filter type has not been set yet.")
end if
else
err = E_OUT_OF_BOUNDS
call set_errmsg("Index in filters array out of bounds.")
end if
end function verify_filter
!===============================================================================
! C API FUNCTIONS
!===============================================================================

41
src/tallies/tally_filter_legendre.F90
View file

@ -15,13 +15,15 @@ module tally_filter_legendre
implicit none
private
public :: openmc_legendre_filter_get_order
public :: openmc_legendre_filter_set_order
!===============================================================================
! LEGENDREFILTER gives Legendre moments of the change in scattering angle
!===============================================================================
type, public, extends(TallyFilter) :: LegendreFilter
integer :: order
integer(C_INT) :: order
contains
procedure :: from_xml
procedure :: get_all_bins
@ -82,5 +84,42 @@ 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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (LegendreFilter)
order = f % order
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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (LegendreFilter)
f % order = order
f % n_bins = order + 1
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

@ -126,25 +126,18 @@ contains
integer(C_INT32_T), intent(out) :: n
integer(C_INT) :: err
if (index >= 1 .and. index <= n_filters) then
if (allocated(filters(index) % obj)) then
select type (f => filters(index) % obj)
type is (MaterialFilter)
bins = C_LOC(f % materials)
n = size(f % materials)
err = 0
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (MaterialFilter)
bins = C_LOC(f % materials)
n = size(f % materials)
err = 0
class default
err = E_INVALID_TYPE
call set_errmsg("Tried to get material filter bins on a &
&non-material filter.")
end select
else
err = E_ALLOCATE
call set_errmsg("Filter type has not been set yet.")
end if
else
err = E_OUT_OF_BOUNDS
call set_errmsg("Index in filters array out of bounds.")
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
@ -158,34 +151,26 @@ contains
integer :: i
err = 0
if (index >= 1 .and. index <= n_filters) then
if (allocated(filters(index) % obj)) then
select type (f => filters(index) % obj)
type is (MaterialFilter)
f % n_bins = n
if (allocated(f % materials)) deallocate(f % materials)
allocate(f % materials(n))
f % materials(:) = bins
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (MaterialFilter)
f % n_bins = n
if (allocated(f % materials)) deallocate(f % materials)
allocate(f % materials(n))
f % materials(:) = bins
! Generate mapping from material indices to filter bins.
call f % map % clear()
do i = 1, n
call f % map % set(f % materials(i), i)
end do
! Generate mapping from material indices to filter bins.
call f % map % clear()
do i = 1, n
call f % map % set(f % materials(i), i)
end do
class default
err = E_INVALID_TYPE
call set_errmsg("Tried to set material filter bins on a &
&non-material filter.")
end select
else
err = E_ALLOCATE
call set_errmsg("Filter type has not been set yet.")
end if
else
err = E_OUT_OF_BOUNDS
call set_errmsg("Index in filters array out of bounds.")
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

108
src/tallies/tally_filter_sph_harm.F90
View file

@ -9,12 +9,16 @@ module tally_filter_sph_harm
use hdf5_interface
use math, only: calc_pn, calc_rn
use particle_header, only: Particle
use string, only: to_str, to_lower
use string, only: to_str, to_lower, to_f_string
use tally_filter_header
use xml_interface
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, parameter :: COSINE_SCATTER = 1
integer, parameter :: COSINE_PARTICLE = 2
@ -132,4 +136,106 @@ contains
! 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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (SphericalHarmonicsFilter)
order = f % order
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_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("Tried to get order on a non-expansion 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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (SphericalHarmonicsFilter)
f % order = order
f % n_bins = (order + 1)**2
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_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_
! 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')
f % cosine = COSINE_SCATTER
case ('particle')
f % cosine = COSINE_PARTICLE
end select
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_sphharm_filter_set_cosine
end module tally_filter_sph_harm

97
src/tallies/tally_filter_sptl_legendre.F90
View file

@ -15,6 +15,10 @@ module tally_filter_sptl_legendre
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
integer, parameter :: AXIS_X = 1
integer, parameter :: AXIS_Y = 2
@ -25,10 +29,10 @@ module tally_filter_sptl_legendre
!===============================================================================
type, public, extends(TallyFilter) :: SpatialLegendreFilter
integer :: order
integer :: axis
real(8) :: min
real(8) :: max
integer(C_INT) :: order
integer(C_INT) :: axis
real(C_DOUBLE) :: min
real(C_DOUBLE) :: max
contains
procedure :: from_xml
procedure :: get_all_bins
@ -121,5 +125,90 @@ 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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (SpatialLegendreFilter)
order = f % order
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_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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (SpatialLegendreFilter)
f % order = order
f % n_bins = order + 1
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_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
err = verify_filter(index)
if (err == 0) then
select type(f => filters(index) % obj)
type is (SpatialLegendreFilter)
axis = f % axis
min = f % min
max = f % max
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_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
err = verify_filter(index)
if (err == 0) then
select type(f => filters(index) % obj)
type is (SpatialLegendreFilter)
if (present(axis)) f % axis = axis
if (present(min)) f % min = min
if (present(max)) f % max = max
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_spatial_legendre_filter_set_params
end module tally_filter_sptl_legendre

83
src/tallies/tally_filter_zernike.F90
View file

@ -117,5 +117,88 @@ 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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (ZernikeFilter)
order = f % order
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_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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (ZernikeFilter)
x = f % x
y = f % y
r = f % r
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_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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (ZernikeFilter)
f % order = order
f % n_bins = ((order + 1)*(order + 2))/2
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_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
err = verify_filter(index)
if (err == 0) then
select type (f => filters(index) % obj)
type is (ZernikeFilter)
if (present(x)) f % x = x
if (present(y)) f % y = y
if (present(r)) f % r = r
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_zernike_filter_set_params
end module tally_filter_zernike