From 600969ce2bb726b812b21d8f5bba263f7dc67817 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Sun, 29 Apr 2018 06:35:56 -0400 Subject: [PATCH 01/15] Exposed math.F90 to C and then created python wrappers around these functions. Seem to work --- openmc/capi/__init__.py | 1 + openmc/capi/math.py | 263 ++++++++++++++++++++++++++ src/api.F90 | 13 ++ src/distribution_multivariate.F90 | 2 +- src/math.F90 | 211 ++++++++++----------- src/physics.F90 | 13 +- src/physics_mg.F90 | 2 +- src/tallies/tally.F90 | 9 +- src/tallies/tally_filter_sph_harm.F90 | 2 +- 9 files changed, 397 insertions(+), 119 deletions(-) create mode 100644 openmc/capi/math.py diff --git a/openmc/capi/__init__.py b/openmc/capi/__init__.py index 217e782a8..672a6e811 100644 --- a/openmc/capi/__init__.py +++ b/openmc/capi/__init__.py @@ -47,3 +47,4 @@ from .mesh import * from .filter import * from .tally import * from .settings import settings +from .math import * diff --git a/openmc/capi/math.py b/openmc/capi/math.py new file mode 100644 index 000000000..d51858fd3 --- /dev/null +++ b/openmc/capi/math.py @@ -0,0 +1,263 @@ +from ctypes import (c_int, c_double, POINTER) + +import numpy as np +from numpy.ctypeslib import ndpointer + +from . import _dll + +_dll.normal_percentile.restype = c_double +_dll.normal_percentile.argtypes = [POINTER(c_double)] +_dll.t_percentile.restype = c_double +_dll.t_percentile.argtypes = [POINTER(c_double), POINTER(c_int)] +_dll.calc_pn.restype = c_double +_dll.calc_pn.argtypes = [POINTER(c_int), POINTER(c_double)] +_dll.calc_rn.restype = None +_dll.calc_rn.argtypes = [POINTER(c_int), ndpointer(c_double), + ndpointer(c_double)] +_dll.calc_zn.restype = None +_dll.calc_zn.argtypes = [POINTER(c_int), POINTER(c_double), POINTER(c_double), + ndpointer(c_double)] +_dll.evaluate_legendre.restype = c_double +_dll.evaluate_legendre.argtypes = [ndpointer(c_double), POINTER(c_double)] +_dll.rotate_angle.restype = None +_dll.rotate_angle.argtypes = [ndpointer(c_double), POINTER(c_double), + ndpointer(c_double), POINTER(c_double)] +_dll.maxwell_spectrum.restype = c_double +_dll.maxwell_spectrum.argtypes = [POINTER(c_double)] +_dll.watt_spectrum.restype = c_double +_dll.watt_spectrum.argtypes = [POINTER(c_double), POINTER(c_double)] +# COMPLEX DATA TYPES? +# _dll.faddeeva.restype = c_double +# _dll.faddeeva.argtypes = [POINTER(c_double)] + +# _dll.w_derivative.restype = c_double +# _dll.w_derivative.argtypes = [POINTER(c_double)] +_dll.broaden_wmp_polynomials.restype = None +_dll.broaden_wmp_polynomials.argtypes = [POINTER(c_double), POINTER(c_double), + POINTER(c_int), ndpointer(c_double)] + + +def normal_percentile(p): + """ Calculate the percentile of the standard normal distribution with a + specified probability level + + Parameters + ---------- + p : float + Probability level + + Returns + ------- + float + Corresponding z-value + + """ + + return _dll.normal_percentile(c_double(p)) + + +def t_percentile(p, df): + """ Calculate the percentile of the Student's t distribution with a + specified probability level and number of degrees of freedom + + Parameters + ---------- + p : float + Probability level + df : int + Degrees of freedom + + Returns + ------- + float + Corresponding t-value + + """ + + return _dll.t_percentile(c_double(p), c_int(df)) + + +def calc_pn(n, x): + """ Calculate the n-th order Legendre polynomial at the value of x. + + Parameters + ---------- + n : int + Legendre order + x : float + Independent variable to evaluate the Legendre at + + Returns + ------- + float + Corresponding Legendre polynomial result + + """ + + return _dll.calc_pn(c_int(n), c_double(x)) + + +def calc_rn(n, uvw): + """ Calculate the n-th order real Spherical Harmonics for a given angle; + all Rn,m values are provided (where -n <= m <= n). + + Parameters + ---------- + n : int + Harmonics order + uvw : iterable of float + Independent variable to evaluate the Legendre at + + Returns + ------- + numpy.ndarray + Corresponding real harmonics value + + """ + + num_nm = 2 * n + 1 + rn = np.empty(num_nm, dtype=np.float64) + uvw_arr = np.array(uvw, dtype=np.float64) + _dll.calc_rn(c_int(n), uvw_arr, rn) + return rn + + +def calc_zn(n, rho, phi): + """ Calculate the n-th order modified Zernike polynomial moment for a + given angle (rho, theta) location in the unit disk. The normalization of + the polynomials is such that the integral of Z_pq*Z_pq over the unit disk + is exactly pi + + Parameters + ---------- + n : int + Maximum order + rho : float + Radial location in the unit disk + phi : float + Theta (radians) location in the unit disk + + Returns + ------- + numpy.ndarray + Corresponding resulting list of coefficients + + """ + + num_bins = ((n + 1) * (n + 2)) / 2 + zn = np.zeros(num_bins, dtype=np.float64) + _dll.calc_zn(c_int(n), c_double(rho), c_double(phi), zn) + return zn + + +def evaluate_legendre(data, x): + """ Finds the value of f(x) given a set of Legendre coefficients + and the value of x. + + Parameters + ---------- + data : iterable of float + Legendre coefficients + x : float + Independent variable to evaluate the Legendre at + + Returns + ------- + float + Corresponding Legendre expansion result + + """ + + data_arr = np.array(data, dtype=np.float64) + return _dll.evaluate_legendre(data_arr, c_double(x)) + + +def rotate_angle(uvw0, mu, phi=None): + """ Rotates direction cosines through a polar angle whose cosine is + mu and through an azimuthal angle sampled uniformly. + + Parameters + ---------- + uvw0 : iterable of float + Original direction cosine + mu : float + Polar angle cosine to rotate + phi : float, optional + Azimuthal angle; if None, one will be sampled uniformly + + Returns + ------- + numpy.ndarray + Rotated direction cosine + + """ + + uvw = np.zeros(3, dtype=np.float64) + uvw0_arr = np.array(uvw0, dtype=np.float64) + _dll.rotate_angle(uvw0_arr, c_double(mu), uvw, c_double(phi)) + return uvw + + +def maxwell_spectrum(T): + """ Samples an energy from the Maxwell fission distribution based + on a direct sampling scheme. + + Parameters + ---------- + T : float + Spectrum parameter + + Returns + ------- + float + Sampled outgoing energy + + """ + + return _dll.maxwell_spectrum(c_double(T)) + + +def watt_spectrum(a, b): + """ Samples an energy from the Watt energy-dependent fission spectrum. + + Parameters + ---------- + a : float + Spectrum parameter a + b : float + Spectrum parameter b + + Returns + ------- + float + Sampled outgoing energy + + """ + + return _dll.watt_spectrum(c_double(a), c_double(b)) + + +def broaden_wmp_polynomials(E, dopp, n): + """ Doppler broadens the windowed multipole curvefit. The curvefit is a + polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... + + Parameters + ---------- + E : float + Energy to evaluate at + dopp : float + sqrt(atomic weight ratio / kT), with kT given in eV + n : int + Number of components to the polynomial + + Returns + ------- + numpy.ndarray + Resultant leading coefficients + + """ + + factors = np.zeros(n, dtype=np.float64) + _dll.broaden_wmp_polynomials(c_double(E), c_double(dopp), c_int(n), + factors) + return factors diff --git a/src/api.F90 b/src/api.F90 index df183c292..30aca6834 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -12,6 +12,7 @@ module openmc_api use geometry_header use hdf5_interface use material_header + use math use mesh_header use message_passing use nuclide_header @@ -97,6 +98,18 @@ module openmc_api public :: openmc_tally_set_nuclides public :: openmc_tally_set_scores public :: openmc_tally_set_type + public :: normal_percentile + public :: t_percentile + public :: calc_pn + public :: calc_rn + public :: calc_zn + public :: evaluate_legendre + public :: rotate_angle + public :: maxwell_spectrum + public :: watt_spectrum + public :: faddeeva + public :: w_derivative + public :: broaden_wmp_polynomials contains diff --git a/src/distribution_multivariate.F90 b/src/distribution_multivariate.F90 index 650ab26fa..4d7d42cc3 100644 --- a/src/distribution_multivariate.F90 +++ b/src/distribution_multivariate.F90 @@ -119,7 +119,7 @@ contains else ! Sample azimuthal angle phi = this % phi % sample() - uvw(:) = rotate_angle(this % reference_uvw, mu, phi) + call rotate_angle(this % reference_uvw, mu, uvw, phi) end if end function polar_azimuthal_sample diff --git a/src/math.F90 b/src/math.F90 index ee8cd0530..47e6acefb 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -6,6 +6,19 @@ module math use random_lcg, only: prn implicit none + private + public :: normal_percentile + public :: t_percentile + public :: calc_pn + public :: calc_rn + public :: calc_zn + public :: evaluate_legendre + public :: rotate_angle + public :: maxwell_spectrum + public :: watt_spectrum + public :: faddeeva + public :: w_derivative + public :: broaden_wmp_polynomials !=============================================================================== ! FADDEEVA_W evaluates the scaled complementary error function. This @@ -29,24 +42,24 @@ contains ! distribution with a specified probability level !=============================================================================== - elemental function normal_percentile(p) result(z) + pure function normal_percentile(p) result(z) bind(C) - real(8), intent(in) :: p ! probability level - real(8) :: z ! corresponding z-value + real(C_DOUBLE), intent(in) :: p ! probability level + real(C_DOUBLE) :: z ! corresponding z-value - real(8) :: q - real(8) :: r - real(8), parameter :: p_low = 0.02425_8 - real(8), parameter :: a(6) = (/ & + real(C_DOUBLE) :: q + real(C_DOUBLE) :: r + real(C_DOUBLE), parameter :: p_low = 0.02425_8 + real(C_DOUBLE), parameter :: a(6) = (/ & -3.969683028665376e1_8, 2.209460984245205e2_8, -2.759285104469687e2_8, & 1.383577518672690e2_8, -3.066479806614716e1_8, 2.506628277459239e0_8 /) - real(8), parameter :: b(5) = (/ & + real(C_DOUBLE), parameter :: b(5) = (/ & -5.447609879822406e1_8, 1.615858368580409e2_8, -1.556989798598866e2_8, & 6.680131188771972e1_8, -1.328068155288572e1_8 /) - real(8), parameter :: c(6) = (/ & + real(C_DOUBLE), parameter :: c(6) = (/ & -7.784894002430293e-3_8, -3.223964580411365e-1_8, -2.400758277161838_8, & -2.549732539343734_8, 4.374664141464968_8, 2.938163982698783_8 /) - real(8), parameter :: d(4) = (/ & + real(C_DOUBLE), parameter :: d(4) = (/ & 7.784695709041462e-3_8, 3.224671290700398e-1_8, & 2.445134137142996_8, 3.754408661907416_8 /) @@ -88,16 +101,16 @@ contains ! specified probability level and number of degrees of freedom !=============================================================================== - elemental function t_percentile(p, df) result(t) + pure function t_percentile(p, df) result(t) bind(C) - real(8), intent(in) :: p ! probability level - integer, intent(in) :: df ! degrees of freedom - real(8) :: t ! corresponding t-value + real(C_DOUBLE), intent(in) :: p ! probability level + integer(C_INT), intent(in) :: df ! degrees of freedom + real(C_DOUBLE) :: t ! corresponding t-value - real(8) :: n ! degrees of freedom as a real(8) - real(8) :: k ! n - 2 - real(8) :: z ! percentile of normal distribution - real(8) :: z2 ! z * z + real(C_DOUBLE) :: n ! degrees of freedom as a real(8) + real(C_DOUBLE) :: k ! n - 2 + real(C_DOUBLE) :: z ! percentile of normal distribution + real(C_DOUBLE) :: z2 ! z * z if (df == 1) then ! For one degree of freedom, the t-distribution becomes a Cauchy @@ -140,12 +153,14 @@ contains ! the return value will be 1.0. !=============================================================================== - elemental function calc_pn(n,x) result(pnx) + pure function calc_pn(n,x) result(pnx) bind(C) - integer, intent(in) :: n ! Legendre order requested - real(8), intent(in) :: x ! Independent variable the Legendre is to be - ! evaluated at; x must be in the domain [-1,1] - real(8) :: pnx ! The Legendre poly of order n evaluated at x + integer(C_INT), intent(in) :: n ! Legendre order requested + real(C_DOUBLE), intent(in) :: x ! Independent variable the Legendre is to + ! be evaluated at; x must be in the + ! domain [-1,1] + real(C_DOUBLE) :: pnx ! The Legendre poly of order n evaluated + ! at x select case(n) case(1) @@ -185,14 +200,16 @@ contains ! (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) !=============================================================================== - pure function calc_rn(n,uvw) result(rn) + subroutine calc_rn(n, uvw, rn) bind(C) - integer, intent(in) :: n ! Order requested - real(8), intent(in) :: uvw(3) ! Direction of travel, assumed to be on unit sphere - real(8) :: rn(2*n + 1) ! The resultant R_n(uvw) + integer(C_INT), intent(in) :: n ! Order requested + real(C_DOUBLE), intent(in) :: uvw(3) ! Direction of travel; + ! assumed to be on unit sphere + real(C_DOUBLE) :: rn(2*n + 1) ! The resultant R_n(uvw) - real(8) :: phi, w ! Azimuthal and Cosine of Polar angles (from uvw) - real(8) :: w2m1 ! (w^2 - 1), frequently used in these + + real(C_DOUBLE) :: phi, w ! Azimuthal and Cosine of Polar angles (from uvw) + real(C_DOUBLE) :: w2m1 ! (w^2 - 1), frequently used in these w = uvw(3) ! z = cos(polar) if (uvw(1) == ZERO) then @@ -572,7 +589,7 @@ contains rn = ONE end select - end function calc_rn + end subroutine calc_rn !=============================================================================== ! CALC_ZN calculates the n-th order modified Zernike polynomial moment for a @@ -581,31 +598,31 @@ contains ! exactly pi !=============================================================================== - subroutine calc_zn(n, rho, phi, zn) + subroutine calc_zn(n, rho, phi, zn) bind(C) ! This procedure uses the modified Kintner's method for calculating Zernike ! polynomials as outlined in Chong, C. W., Raveendran, P., & Mukundan, ! R. (2003). A comparative analysis of algorithms for fast computation of ! Zernike moments. Pattern Recognition, 36(3), 731-742. - integer, intent(in) :: n ! Maximum order - real(8), intent(in) :: rho ! Radial location in the unit disk - real(8), intent(in) :: phi ! Theta (radians) location in the unit disk - real(8), intent(out) :: zn(:) ! The resulting list of coefficients + integer(C_INT), intent(in) :: n ! Maximum order + real(C_DOUBLE), intent(in) :: rho ! Radial location in the unit disk + real(C_DOUBLE), intent(in) :: phi ! Theta (radians) location in the unit disk + real(C_DOUBLE), intent(out) :: zn(:) ! The resulting list of coefficients - real(8) :: sin_phi, cos_phi ! Sine and Cosine of phi - real(8) :: sin_phi_vec(n+1) ! Contains sin(n*phi) - real(8) :: cos_phi_vec(n+1) ! Contains cos(n*phi) - real(8) :: zn_mat(n+1, n+1) ! Matrix form of the coefficients which is - ! easier to work with - real(8) :: k1, k2, k3, k4 ! Variables for R_m_n calculation - real(8) :: sqrt_norm ! normalization for radial moments - integer :: i,p,q ! Loop counters + real(C_DOUBLE) :: sin_phi, cos_phi ! Sine and Cosine of phi + real(C_DOUBLE) :: sin_phi_vec(n+1) ! Contains sin(n*phi) + real(C_DOUBLE) :: cos_phi_vec(n+1) ! Contains cos(n*phi) + real(C_DOUBLE) :: zn_mat(n+1, n+1) ! Matrix form of the coefficients which is + ! easier to work with + real(C_DOUBLE) :: k1, k2, k3, k4 ! Variables for R_m_n calculation + real(C_DOUBLE) :: sqrt_norm ! normalization for radial moments + integer(C_INT) :: i,p,q ! Loop counters - real(8), parameter :: SQRT_N_1(0:10) = [& + real(C_DOUBLE), parameter :: SQRT_N_1(0:10) = [& sqrt(1.0_8), sqrt(2.0_8), sqrt(3.0_8), sqrt(4.0_8), & sqrt(5.0_8), sqrt(6.0_8), sqrt(7.0_8), sqrt(8.0_8), & sqrt(9.0_8), sqrt(10.0_8), sqrt(11.0_8)] - real(8), parameter :: SQRT_2N_2(0:10) = SQRT_N_1*sqrt(2.0_8) + real(C_DOUBLE), parameter :: SQRT_2N_2(0:10) = SQRT_N_1*sqrt(2.0_8) ! n == radial degree ! m == azimuthal frequency @@ -681,41 +698,17 @@ contains end do end subroutine calc_zn -!=============================================================================== -! EXPAND_HARMONIC expands a given series of real spherical harmonics -!=============================================================================== - - pure function expand_harmonic(data, order, uvw) result(val) - real(8), intent(in) :: data(:) - integer, intent(in) :: order - real(8), intent(in) :: uvw(3) - real(8) :: val - - integer :: l, lm_lo, lm_hi - - val = data(1) - lm_lo = 2 - lm_hi = 4 - do l = 1, order - 1 - val = val + sqrt(TWO * real(l,8) + ONE) * & - dot_product(calc_rn(l,uvw), data(lm_lo:lm_hi)) - lm_lo = lm_hi + 1 - lm_hi = lm_lo + 2 * (l + 1) - end do - - end function expand_harmonic - !=============================================================================== ! EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients ! and the value of x !=============================================================================== - pure function evaluate_legendre(data, x) result(val) - real(8), intent(in) :: data(:) - real(8), intent(in) :: x - real(8) :: val + pure function evaluate_legendre(data, x) result(val) bind(C) + real(C_DOUBLE), intent(in) :: data(:) + real(C_DOUBLE), intent(in) :: x + real(C_DOUBLE) :: val - integer :: l + integer(C_INT) :: l val = HALF * data(1) do l = 1, size(data) - 1 @@ -730,20 +723,20 @@ contains ! with direct sampling rather than rejection as is done in MCNP and SERPENT. !=============================================================================== - function rotate_angle(uvw0, mu, phi) result(uvw) - real(8), intent(in) :: uvw0(3) ! directional cosine - real(8), intent(in) :: mu ! cosine of angle in lab or CM - real(8), optional :: phi ! azimuthal angle - real(8) :: uvw(3) ! rotated directional cosine + subroutine rotate_angle(uvw0, mu, uvw, phi) bind(C) + real(C_DOUBLE), intent(in) :: uvw0(3) ! directional cosine + real(C_DOUBLE), intent(in) :: mu ! cosine of angle in lab or CM + real(C_DOUBLE), intent(out) :: uvw(3) ! rotated directional cosine + real(C_DOUBLE), optional :: phi ! azimuthal angle - real(8) :: phi_ ! azimuthal angle - real(8) :: sinphi ! sine of azimuthal angle - real(8) :: cosphi ! cosine of azimuthal angle - real(8) :: a ! sqrt(1 - mu^2) - real(8) :: b ! sqrt(1 - w^2) - real(8) :: u0 ! original cosine in x direction - real(8) :: v0 ! original cosine in y direction - real(8) :: w0 ! original cosine in z direction + real(C_DOUBLE) :: phi_ ! azimuthal angle + real(C_DOUBLE) :: sinphi ! sine of azimuthal angle + real(C_DOUBLE) :: cosphi ! cosine of azimuthal angle + real(C_DOUBLE) :: a ! sqrt(1 - mu^2) + real(C_DOUBLE) :: b ! sqrt(1 - w^2) + real(C_DOUBLE) :: u0 ! original cosine in x direction + real(C_DOUBLE) :: v0 ! original cosine in y direction + real(C_DOUBLE) :: w0 ! original cosine in z direction ! Copy original directional cosines u0 = uvw0(1) @@ -776,7 +769,7 @@ contains uvw(3) = mu*w0 + a*(v0*w0*cosphi - u0*sinphi)/b end if - end function rotate_angle + end subroutine rotate_angle !=============================================================================== ! MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution based @@ -785,13 +778,13 @@ contains ! be sampled using rule C64 in the Monte Carlo Sampler LA-9721-MS. !=============================================================================== - function maxwell_spectrum(T) result(E_out) + function maxwell_spectrum(T) result(E_out) bind(C) - real(8), intent(in) :: T ! tabulated function of incoming E - real(8) :: E_out ! sampled energy + real(C_DOUBLE), intent(in) :: T ! tabulated function of incoming E + real(C_DOUBLE) :: E_out ! sampled energy - real(8) :: r1, r2, r3 ! random numbers - real(8) :: c ! cosine of pi/2*r3 + real(C_DOUBLE) :: r1, r2, r3 ! random numbers + real(C_DOUBLE) :: c ! cosine of pi/2*r3 r1 = prn() r2 = prn() @@ -813,13 +806,13 @@ contains ! original Watt spectrum derivation (See F. Brown's MC lectures). !=============================================================================== - function watt_spectrum(a, b) result(E_out) + function watt_spectrum(a, b) result(E_out) bind(C) - real(8), intent(in) :: a ! Watt parameter a - real(8), intent(in) :: b ! Watt parameter b - real(8) :: E_out ! energy of emitted neutron + real(C_DOUBLE), intent(in) :: a ! Watt parameter a + real(C_DOUBLE), intent(in) :: b ! Watt parameter b + real(C_DOUBLE) :: E_out ! energy of emitted neutron - real(8) :: w ! sampled from Maxwellian + real(C_DOUBLE) :: w ! sampled from Maxwellian w = maxwell_spectrum(a) E_out = w + a*a*b/4. + (TWO*prn() - ONE)*sqrt(a*a*b*w) @@ -830,9 +823,9 @@ contains ! FADDEEVA the Faddeeva function, using Stephen Johnson's implementation !=============================================================================== - function faddeeva(z) result(wv) - complex(C_DOUBLE_COMPLEX), intent(in) :: z ! The point to evaluate Z at - complex(8) :: wv ! The resulting w(z) value + function faddeeva(z) result(wv) bind(C) + complex(C_DOUBLE_COMPLEX), intent(in) :: z ! The point to evaluate Z at + complex(C_DOUBLE_COMPLEX) :: wv ! The resulting w(z) value real(C_DOUBLE) :: relerr ! Target relative error in inner loop of MIT ! Faddeeva @@ -860,10 +853,10 @@ contains end function faddeeva - recursive function w_derivative(z, order) result(wv) + recursive function w_derivative(z, order) result(wv) bind(C) complex(C_DOUBLE_COMPLEX), intent(in) :: z ! The point to evaluate Z at - integer, intent(in) :: order - complex(8) :: wv ! The resulting w(z) value + integer(C_INT), intent(in) :: order + complex(C_DOUBLE_COMPLEX) :: wv ! The resulting w(z) value select case(order) case (0) @@ -882,12 +875,12 @@ contains ! a/E + b/sqrt(E) + c + d sqrt(E) ... !=============================================================================== - subroutine broaden_wmp_polynomials(E, dopp, n, factors) - real(8), intent(in) :: E ! Energy to evaluate at - real(8), intent(in) :: dopp ! sqrt(atomic weight ratio / kT), + subroutine broaden_wmp_polynomials(E, dopp, n, factors) bind(C) + real(C_DOUBLE), intent(in) :: E ! Energy to evaluate at + real(C_DOUBLE), intent(in) :: dopp ! sqrt(atomic weight ratio / kT), ! kT given in eV. - integer, intent(in) :: n ! number of components to polynomial - real(8), intent(out):: factors(n) ! output leading coefficient + integer(C_INT), intent(in) :: n ! number of components to polynomial + real(C_DOUBLE), intent(out):: factors(n) ! output leading coefficient integer :: i diff --git a/src/physics.F90 b/src/physics.F90 index b614b8185..8183435cb 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -495,7 +495,8 @@ contains ! Rotate neutron velocity vector to new angle -- note that the speed of the ! neutron in CM does not change in elastic scattering. However, the speed ! will change when we convert back to LAB - v_n = vel * rotate_angle(uvw_cm, mu_cm) + call rotate_angle(uvw_cm, mu_cm, v_n) + v_n = vel * v_n ! Transform back to LAB frame v_n = v_n + v_cm @@ -785,7 +786,7 @@ contains if (abs(mu) > ONE) mu = sign(ONE,mu) ! change direction of particle - uvw = rotate_angle(uvw, mu) + call rotate_angle(uvw, mu, uvw) end subroutine sab_scatter @@ -976,7 +977,8 @@ contains if (abs(mu) < ONE) then ! set and accept target velocity E_t = E_t / awr - v_target = sqrt(E_t) * rotate_angle(uvw, mu) + call rotate_angle(uvw, mu, v_target) + v_target = sqrt(E_t) * v_target exit ARES_REJECT_LOOP end if end do ARES_REJECT_LOOP @@ -1056,7 +1058,8 @@ contains ! Determine velocity vector of target nucleus based on neutron's velocity ! and the sampled angle between them - v_target = vt * rotate_angle(uvw, mu) + call rotate_angle(uvw, mu, v_target) + v_target = vt * v_target end subroutine sample_cxs_target_velocity @@ -1327,7 +1330,7 @@ contains p % mu = mu ! change direction of particle - p % coord(1) % uvw = rotate_angle(p % coord(1) % uvw, mu) + call rotate_angle(p % coord(1) % uvw, mu, p % coord(1) % uvw) ! evaluate yield yield = rxn % products(1) % yield % evaluate(E_in) diff --git a/src/physics_mg.F90 b/src/physics_mg.F90 index eb8208594..05493af05 100644 --- a/src/physics_mg.F90 +++ b/src/physics_mg.F90 @@ -151,7 +151,7 @@ contains p % E = energy_bin_avg(p % g) ! Convert change in angle (mu) to new direction - p % coord(1) % uvw = rotate_angle(p % coord(1) % uvw, p % mu) + call rotate_angle(p % coord(1) % uvw, p % mu, p % coord(1) % uvw) ! Set event component p % event = EVENT_SCATTER diff --git a/src/tallies/tally.F90 b/src/tallies/tally.F90 index f4d12be7e..f7d3c8a08 100644 --- a/src/tallies/tally.F90 +++ b/src/tallies/tally.F90 @@ -46,6 +46,9 @@ module tally end subroutine score_analog_tally_ end interface + real(C_DOUBLE) :: rn(2 * MAX_ANG_ORDER + 1) +!$omp threadprivate(rn) + contains !=============================================================================== @@ -2131,11 +2134,12 @@ contains num_nm = 2 * n + 1 ! multiply score by the angular flux moments and store + call calc_rn(n, p % last_uvw, rn(1:num_nm)) !$omp critical (score_general_scatt_yn) t % results(RESULT_VALUE, score_index: score_index + num_nm - 1, & filter_index) = t % results(RESULT_VALUE, & score_index: score_index + num_nm - 1, filter_index) & - + score * calc_pn(n, p % mu) * calc_rn(n, p % last_uvw) + + score * calc_pn(n, p % mu) * rn(1:num_nm) !$omp end critical (score_general_scatt_yn) end do i = i + (t % moment_order(i) + 1)**2 - 1 @@ -2159,11 +2163,12 @@ contains num_nm = 2 * n + 1 ! multiply score by the angular flux moments and store + call calc_rn(n, uvw, rn(1:num_nm)) !$omp critical (score_general_flux_tot_yn) t % results(RESULT_VALUE, score_index: score_index + num_nm - 1, & filter_index) = t % results(RESULT_VALUE, & score_index: score_index + num_nm - 1, filter_index) & - + score * calc_rn(n, uvw) + + score * rn(1:num_nm) !$omp end critical (score_general_flux_tot_yn) end do i = i + (t % moment_order(i) + 1)**2 - 1 diff --git a/src/tallies/tally_filter_sph_harm.F90 b/src/tallies/tally_filter_sph_harm.F90 index 5c47c2c71..5faf2b6fd 100644 --- a/src/tallies/tally_filter_sph_harm.F90 +++ b/src/tallies/tally_filter_sph_harm.F90 @@ -91,7 +91,7 @@ contains ! Calculate n-th order spherical harmonics for (u,v,w) num_nm = 2*n + 1 - rn(1:num_nm) = calc_rn(n, p % last_uvw) + call calc_rn(n, p % last_uvw, rn(1:num_nm)) ! Append matching (bin,weight) for each moment do i = 1, num_nm From 7fb5449ca11207d9547ab4a13955b0636212866d Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Mon, 30 Apr 2018 08:54:29 -0400 Subject: [PATCH 02/15] implemented python interface and tests of math.F90 --- openmc/capi/math.py | 13 ++- src/math.F90 | 9 +- src/mgxs_header.F90 | 5 +- src/scattdata_header.F90 | 3 +- tests/unit_tests/test_math.py | 180 ++++++++++++++++++++++++++++++++++ 5 files changed, 200 insertions(+), 10 deletions(-) create mode 100644 tests/unit_tests/test_math.py diff --git a/openmc/capi/math.py b/openmc/capi/math.py index d51858fd3..701fc697f 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -1,4 +1,4 @@ -from ctypes import (c_int, c_double, POINTER) +from ctypes import (c_int, c_double, POINTER, c_void_p) import numpy as np from numpy.ctypeslib import ndpointer @@ -18,7 +18,8 @@ _dll.calc_zn.restype = None _dll.calc_zn.argtypes = [POINTER(c_int), POINTER(c_double), POINTER(c_double), ndpointer(c_double)] _dll.evaluate_legendre.restype = c_double -_dll.evaluate_legendre.argtypes = [ndpointer(c_double), POINTER(c_double)] +_dll.evaluate_legendre.argtypes = [POINTER(c_int), POINTER(c_double), + POINTER(c_double)] _dll.rotate_angle.restype = None _dll.rotate_angle.argtypes = [ndpointer(c_double), POINTER(c_double), ndpointer(c_double), POINTER(c_double)] @@ -169,7 +170,9 @@ def evaluate_legendre(data, x): """ data_arr = np.array(data, dtype=np.float64) - return _dll.evaluate_legendre(data_arr, c_double(x)) + return _dll.evaluate_legendre(c_int(len(data)), + data_arr.ctypes.data_as(POINTER(c_double)), + c_double(x)) def rotate_angle(uvw0, mu, phi=None): @@ -194,7 +197,9 @@ def rotate_angle(uvw0, mu, phi=None): uvw = np.zeros(3, dtype=np.float64) uvw0_arr = np.array(uvw0, dtype=np.float64) - _dll.rotate_angle(uvw0_arr, c_double(mu), uvw, c_double(phi)) + + _dll.rotate_angle(uvw0_arr, c_double(mu), + uvw, c_double(phi)) return uvw diff --git a/src/math.F90 b/src/math.F90 index 47e6acefb..313fe94f1 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -703,16 +703,17 @@ contains ! and the value of x !=============================================================================== - pure function evaluate_legendre(data, x) result(val) bind(C) - real(C_DOUBLE), intent(in) :: data(:) + pure function evaluate_legendre(n, data, x) result(val) bind(C) + integer(C_INT), intent(in) :: n + real(C_DOUBLE), intent(in) :: data(n) real(C_DOUBLE), intent(in) :: x real(C_DOUBLE) :: val integer(C_INT) :: l val = HALF * data(1) - do l = 1, size(data) - 1 - val = val + (real(l,8) + HALF) * data(l + 1) * calc_pn(l,x) + do l = 1, n - 1 + val = val + (real(l, 8) + HALF) * data(l + 1) * calc_pn(l,x) end do end function evaluate_legendre diff --git a/src/mgxs_header.F90 b/src/mgxs_header.F90 index 6eabefae3..9ffb83815 100644 --- a/src/mgxs_header.F90 +++ b/src/mgxs_header.F90 @@ -1097,7 +1097,9 @@ contains end if scatt_coeffs(gin) % data(imu, gout) = & - evaluate_legendre(input_scatt(gin) % data(:, gout), mu) + evaluate_legendre( & + size(input_scatt(gin) % data, dim=1), & + input_scatt(gin) % data(:, gout), mu) ! Ensure positivity of distribution if (scatt_coeffs(gin) % data(imu, gout) < ZERO) & @@ -2079,6 +2081,7 @@ contains scatt_coeffs(gin, iazi, ipol) % data(imu, gout) = & evaluate_legendre(& + size(input_scatt(gin, iazi, ipol) % data, dim=1), & input_scatt(gin, iazi, ipol) % data(:, gout), mu) ! Ensure positivity of distribution diff --git a/src/scattdata_header.F90 b/src/scattdata_header.F90 index 511e2a237..a3108a2df 100644 --- a/src/scattdata_header.F90 +++ b/src/scattdata_header.F90 @@ -445,7 +445,8 @@ contains if (gout < this % gmin(gin) .or. gout > this % gmax(gin)) then f = ZERO else - f = evaluate_legendre(this % dist(gin) % data(:, gout), mu) + f = evaluate_legendre(size(this % dist(gin) % data, dim=1), & + this % dist(gin) % data(:, gout), mu) end if end function scattdatalegendre_calc_f diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py new file mode 100644 index 000000000..17c20fdb5 --- /dev/null +++ b/tests/unit_tests/test_math.py @@ -0,0 +1,180 @@ +import numpy as np +import scipy as sp + +import openmc +import openmc.capi + + +def test_normal_percentile(): + # normal_percentile has three branches to consider: + # p < 0.02425; 0.02425 <= p <= 0.97575; and p > 0.97575 + test_ps = [0.02, 0.4, 0.5, 0.6, 0.98] + + # The reference solutions come from Scipy + ref_zs = [sp.stats.norm.ppf(p) for p in test_ps] + + test_zs = [openmc.capi.math.normal_percentile(p) for p in test_ps] + + assert np.allclose(ref_zs, test_zs) + + +def test_t_percentile(): + # Permutations include 1 DoF, 2 DoF, and > 2 DoF + # We will test 5 p-values at 3-DoF values + test_ps = [0.02, 0.4, 0.5, 0.6, 0.98] + test_dfs = [1, 2, 5] + + # The reference solutions come from Scipy + ref_ts = [[sp.stats.t.ppf(p, df) for p in test_ps] for df in test_dfs] + + test_ts = [[openmc.capi.math.t_percentile(p, df) for p in test_ps] + for df in test_dfs] + + # The 5 DoF approximation in openmc.capi.math.t_percentile is off by up to + # 8e-3 from the scipy solution, so test that one separately with looser + # tolerance + assert np.allclose(ref_ts[:-1], test_ts[:-1]) + assert np.allclose(ref_ts[-1], test_ts[-1], atol=1e-2) + + +def test_calc_pn(): + max_order = 10 + test_ns = np.array([i for i in range(0, max_order + 1)]) + test_xs = np.linspace(-1., 1., num=5, endpoint=True) + + # Reference solutions from scipy + ref_vals = [sp.special.eval_legendre(n, test_xs) for n in test_ns] + + test_vals = [[openmc.capi.math.calc_pn(n, x) for x in test_xs] + for n in test_ns] + + assert np.allclose(ref_vals, test_vals) + + +def test_calc_rn(): + max_order = 10 + test_ns = np.array([i for i in range(0, max_order + 1)]) + azi = 0.1 # Longitude + pol = 0.2 # Latitude + test_uvw = np.array([np.sin(pol) * np.cos(azi), + np.sin(pol) * np.sin(azi), + np.cos(pol)]) + + # Reference solutions from the equations + ref_vals = [] + + def coeff(n, m): + return np.sqrt((2. * n + 1) * sp.special.factorial(n - m) / + (sp.special.factorial(n + m))) + + def pnm_bar(n, m, mu): + val = coeff(n, m) + if m != 0: + val *= np.sqrt(2.) + val *= sp.special.lpmv([m], [n], [mu]) + return val[0] + + ref_vals = [] + for n in test_ns: + for m in range(-n, n + 1): + if m < 0: + ylm = pnm_bar(n, np.abs(m), np.cos(pol)) * \ + np.sin(np.abs(m) * azi) + else: + ylm = pnm_bar(n, m, np.cos(pol)) * np.cos(m * azi) + + # Un-normalize for comparison + ylm /= np.sqrt(2. * n + 1.) + ref_vals.append(ylm) + + test_vals = [] + for n in test_ns: + ylms = openmc.capi.math.calc_rn(n, test_uvw) + test_vals.extend(ylms.tolist()) + + assert np.allclose(ref_vals, test_vals) + + +def test_calc_zn(): + pass + + +def test_evaluate_legendre(): + max_order = 10 + # Coefficients are set to 1, but will incorporate the (2l+1)/2 norm factor + # for the reference solution + test_coeffs = [0.5 * (2. * l + 1.) for l in range(max_order + 1)] + test_xs = np.linspace(-1., 1., num=5, endpoint=True) + + ref_vals = np.polynomial.legendre.legval(test_xs, test_coeffs) + + # Set the coefficients back to 1s for the test values + test_coeffs = [1. for l in range(max_order + 1)] + test_vals = np.array([openmc.capi.math.evaluate_legendre(test_coeffs, x) + for x in test_xs]) + + assert np.allclose(ref_vals, test_vals) + + +def test_rotate_angle(): + uvw0 = np.array([1., 0., 0.]) + phi = 0. + mu = 0. + + # reference: mu of 0 pulls the vector the bottom, so: + ref_uvw = np.array([0., 0., -1.]) + + test_uvw = openmc.capi.math.rotate_angle(uvw0, mu, phi) + + assert np.allclose(ref_uvw, test_uvw) + + # Repeat for mu = 1 (no change) + mu = 1. + ref_uvw = np.array([1., 0., 0.]) + + test_uvw = openmc.capi.math.rotate_angle(uvw0, mu, phi) + + assert np.allclose(ref_uvw, test_uvw) + + # Need to test phi=None somehow... + + +def test_maxwell_spectrum(): + settings = openmc.capi.settings + settings.seed = 1 + T = 0.5 + ref_val = 0.6129982175261098 + test_val = openmc.capi.math.maxwell_spectrum(T) + print(test_val) + assert np.isclose(ref_val, test_val) + + +def test_watt_spectrum(): + settings = openmc.capi.settings + settings.seed = 1 + a = 0.5 + b = 0.75 + ref_val = 0.6247242713640233 + test_val = openmc.capi.math.watt_spectrum(a, b) + print(test_val) + assert np.isclose(ref_val, test_val) + + +def test_broaden_wmp_polynomials(): + # Two branches of the code to worry about, beta > 6 and otherwise + # beta = sqrtE * dopp + # First lets do beta > 6 + test_E = 0.5 + test_dopp = 100. # approximately U235 at room temperature + n = 4 + ref_val = [2., 1.41421356, 1.0001, 0.70731891] + test_val = openmc.capi.math.broaden_wmp_polynomials(test_E, test_dopp, n) + + assert np.allclose(ref_val, test_val) + + # now beta < 6 + test_dopp = 5. + ref_val = [1.99999885, 1.41421356, 1.04, 0.79195959] + test_val = openmc.capi.math.broaden_wmp_polynomials(test_E, test_dopp, n) + + assert np.allclose(ref_val, test_val) From 8e61254e6b5bc5281cfc8f151a35e81c842fb6a7 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Mon, 30 Apr 2018 15:33:36 -0400 Subject: [PATCH 03/15] Added C++ math functions, now to incorporate them one by one.... --- CMakeLists.txt | 2 + openmc/capi/math.py | 2 +- src/math.F90 | 87 +++++ src/math_functions.cpp | 781 +++++++++++++++++++++++++++++++++++++++++ src/math_functions.h | 94 +++++ 5 files changed, 965 insertions(+), 1 deletion(-) create mode 100644 src/math_functions.cpp create mode 100644 src/math_functions.h diff --git a/CMakeLists.txt b/CMakeLists.txt index 1797ae5d3..9f72d5b05 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -438,6 +438,8 @@ set(LIBOPENMC_FORTRAN_SRC set(LIBOPENMC_CXX_SRC src/error.h src/hdf5_interface.h + src/math_functions.h + src/math_functions.cpp src/random_lcg.cpp src/random_lcg.h src/surface.cpp diff --git a/openmc/capi/math.py b/openmc/capi/math.py index 701fc697f..713ef9813 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -1,4 +1,4 @@ -from ctypes import (c_int, c_double, POINTER, c_void_p) +from ctypes import (c_int, c_double, POINTER) import numpy as np from numpy.ctypeslib import ndpointer diff --git a/src/math.F90 b/src/math.F90 index 313fe94f1..76e9fc11a 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -26,6 +26,93 @@ module math !=============================================================================== interface + + pure function t_percentile_cc(p, df) bind(C, name='t_percentile_c') & + result(t) + use ISO_C_BINDING + implicit none + real(C_DOUBLE), value, intent(in) :: p + integer(C_INT), value, intent(in) :: df + real(C_DOUBLE) :: t + end function t_percentile_cc + + pure function calc_pn_cc(n, x) bind(C, name='calc_pn_c') result(pnx) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: n + real(C_DOUBLE), value, intent(in) :: x + real(C_DOUBLE) :: pnx + end function calc_pn_cc + + subroutine calc_rn_cc(n, uvw, rn) bind(C, name='calc_rn_c') + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: n + real(C_DOUBLE), intent(in) :: uvw(3) + real(C_DOUBLE), intent(in) :: rn(2 * n + 1) + end subroutine calc_rn_cc + + pure function evaluate_legendre_cc(n, data, x) & + bind(C, name='evaluate_legendre_c') result(val) + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: n + real(C_DOUBLE), intent(in) :: data(n) + real(C_DOUBLE), value, intent(in) :: x + real(C_DOUBLE) :: val + end function evaluate_legendre_cc + + subroutine rotate_angle_cc(uvw, mu, phi) bind(C, name='rotate_angle_c') + use ISO_C_BINDING + implicit none + real(C_DOUBLE), intent(inout) :: uvw(3) + real(C_DOUBLE), value, intent(in) :: mu + real(C_DOUBLE), value, intent(in) :: phi + end subroutine rotate_angle_cc + + function maxwell_spectrum_cc(T) bind(C, name='maxwell_spectrum_c') & + result(E_out) + use ISO_C_BINDING + implicit none + real(C_DOUBLE), value, intent(in) :: T + real(C_DOUBLE) :: E_out + end function maxwell_spectrum_cc + + function watt_spectrum_cc(a, b) bind(C, name='watt_spectrum_c') & + result(E_out) + use ISO_C_BINDING + implicit none + real(C_DOUBLE), value, intent(in) :: a + real(C_DOUBLE), value, intent(in) :: b + real(C_DOUBLE) :: E_out + end function watt_spectrum_cc + + function faddeeva_cc(z) bind(C, name='faddeeva_c') result(wv) + use ISO_C_BINDING + implicit none + complex(C_DOUBLE_COMPLEX), value, intent(in) :: z + complex(C_DOUBLE_COMPLEX) :: wv + end function faddeeva_cc + + function w_derivative_cc(z, order) bind(C, name='w_derivative_c') & + result(wv) + use ISO_C_BINDING + implicit none + complex(C_DOUBLE_COMPLEX), value, intent(in) :: z + integer(C_INT), value, intent(in) :: order + complex(C_DOUBLE_COMPLEX) :: wv + end function w_derivative_cc + + subroutine broaden_wmp_polynomials_cc(E, dopp, n, factors) & + bind(C, name='broaden_wmp_polynomials_c') + use ISO_C_BINDING + implicit none + real(C_DOUBLE), value, intent(in) :: E + real(C_DOUBLE), value, intent(in) :: dopp + integer(C_INT), value, intent(in) :: n + real(C_DOUBLE), intent(inout) :: factors(n) + end subroutine broaden_wmp_polynomials_cc + function faddeeva_w(z, relerr) bind(C, name='Faddeeva_w') result(w) use ISO_C_BINDING implicit none diff --git a/src/math_functions.cpp b/src/math_functions.cpp new file mode 100644 index 000000000..3b645c772 --- /dev/null +++ b/src/math_functions.cpp @@ -0,0 +1,781 @@ +#include "math_functions.h" + +namespace openmc { + + +//============================================================================== +// NORMAL_PERCENTILE calculates the percentile of the standard normal +// distribution with a specified probability level +//============================================================================== + +double __attribute__ ((const)) normal_percentile_c(double p) { + + // return gsl_cdf_ugaussian_Pinv(p); + + double z; + double q; + double r; + const double p_low = 0.02425; + const double a[6] = {-3.969683028665376e1, 2.209460984245205e2, + -2.759285104469687e2, 1.383577518672690e2, + -3.066479806614716e1, 2.506628277459239e0}; + const double b[5] = {-5.447609879822406e1, 1.615858368580409e2, + -1.556989798598866e2, 6.680131188771972e1, + -1.328068155288572e1}; + const double c[6] = {-7.784894002430293e-3, -3.223964580411365e-1, + -2.400758277161838, -2.549732539343734, + 4.374664141464968, 2.938163982698783}; + const double d[4] = {7.784695709041462e-3, 3.224671290700398e-1, + 2.445134137142996, 3.754408661907416}; + + // The rational approximation used here is from an unpublished work at + // http://home.online.no/~pjacklam/notes/invnorm/ + + if (p < p_low) { + // Rational approximation for lower region. + + q = std::sqrt(-2.0 * std::log(p)); + z = (((((c[0]*q + c[1])*q + c[2])*q + c[3])*q + c[4])*q + c[5]) / + ((((d[0]*q + d[1])*q + d[2])*q + d[3])*q + 1.0); + + } else if (p <= 1.0 - p_low) { + // Rational approximation for central region + + q = p - 0.5; + r = q * q; + z = (((((a[0]*r + a[1])*r + a[2])*r + a[3])*r + a[4])*r + a[5])*q / + (((((b[0]*r + b[1])*r + b[2])*r + b[3])*r + b[4])*r + 1.0); + + } else { + // Rational approximation for upper region + + q = std::sqrt(-2.0*std::log(1.0 - p)); + z = -(((((c[0]*q + c[1])*q + c[2])*q + c[3])*q + c[4])*q + c[5]) / + ((((d[0]*q + d[1])*q + d[2])*q + d[3])*q + 1.0); + } + + // Refinement based on Newton's method + + z = z - (0.5 * std::erfc(-z / std::sqrt(2.0)) - p) * std::sqrt(2.0 * M_PI) * + std::exp(0.5 * z * z); + + return z; + +} + +//============================================================================== +// T_PERCENTILE calculates the percentile of the Student's t distribution with +// a specified probability level and number of degrees of freedom +//============================================================================== + +double __attribute__ ((const)) t_percentile_c(double p, int df){ + + // return gsl_cdf_tdist_Pinv(p, static_cast df); + + double t; + double n; + double k; + double z; + double z2; + + if (df == 1) { + // For one degree of freedom, the t-distribution becomes a Cauchy + // distribution whose cdf we can invert directly + + t = std::tan(M_PI*(p - 0.5)); + } else if (df == 2) { + // For two degrees of freedom, the cdf is given by 1/2 + x/(2*sqrt(x^2 + + // 2)). This can be directly inverted to yield the solution below + + t = 2.0 * std::sqrt(2.0)*(p - 0.5) / + std::sqrt(1. - 4. * std::pow(p - 0.5, 2.)); + } else { + // This approximation is from E. Olusegun George and Meenakshi Sivaram, "A + // modification of the Fisher-Cornish approximation for the student t + // percentiles," Communication in Statistics - Simulation and Computation, + // 16 (4), pp. 1123-1132 (1987). + + n = static_cast(df); + k = 1. / (n - 2.); + z = normal_percentile_c(p); + z2 = z * z; + t = std::sqrt(n * k) * (z + (z2 - 3.) * z * k / 4. + ((5. * z2 - 56.) * z2 + + 75.) * z * k * k / 96. + (((z2 - 27.) * 3. * z2 + 417.) * z2 - 315.) * + z * k * k * k / 384.); + } + + return t; +} + +//============================================================================== +// CALC_PN calculates the n-th order Legendre polynomial at the value of x. +//============================================================================== + +double __attribute__ ((const)) calc_pn_c(int n, double x) { + + // return gsl_sf_legendre_Pl(l, x); + + double pnx; + + switch(n) { + case 0: + pnx = 1.; + break; + case 1: + pnx = x; + break; + case 2: + pnx = 1.5 * x * x - 0.5; + break; + case 3: + pnx = 2.5 * x * x * x - 1.5 * x; + break; + case 4: + pnx = 4.375 * std::pow(x, 4.) - 3.75 * x * x + 0.375; + break; + case 5: + pnx = 7.875 * std::pow(x, 5.) - 8.75 * x * x * x + 1.875 * x; + break; + case 6: + pnx = 14.4375 * std::pow(x, 6.) - 19.6875 * std::pow(x, 4.) + + 6.5625 * x * x - 0.3125; + break; + case 7: + pnx = 26.8125 * std::pow(x, 7.) - 43.3125 * std::pow(x, 5.) + + 19.6875 * x * x * x - 2.1875 * x; + break; + case 8: + pnx = 50.2734375 * std::pow(x, 8.) - 93.84375 * std::pow(x, 6.) + + 54.140625 * std::pow(x, 4.) - 9.84375 * x * x + 0.2734375; + break; + case 9: + pnx = 94.9609375 * std::pow(x, 9.) - 201.09375 * std::pow(x, 7.) + + 140.765625 * std::pow(x, 5.) - 36.09375 * x * x * x + 2.4609375 * x; + break; + case 10: + pnx = 180.42578125 * std::pow(x, 10.) - 427.32421875 * std::pow(x, 8.) + + 351.9140625 * std::pow(x, 6.) - 117.3046875 * std::pow(x, 4.) + + 13.53515625 * x * x - 0.24609375; + } + + return pnx; +} + +//============================================================================== +// CALC_RN calculates the n-th order spherical harmonics for a given angle +// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) +//============================================================================== + +void calc_rn_c(int n, double uvw[3], double rn[]){ + double phi; + double w; + double w2m1; + + // rn[] is assumed to have already been allocated to the correct size + + // Store the cosine of the polar angle and the azimuthal angle + w = uvw[2]; + if (uvw[0] == 0.) { + phi = 0.; + } else { + phi = std::atan2(uvw[1], uvw[0]); + } + + // Store the shorthand of 1-w * w + w2m1 = 1. - w * w; + + // Now evaluate the spherical harmonics function depending on the order + // requested + switch (n) { + case 0: + // l = 0, m = 0 + rn[0] = 1.; + break; + case 1: + // l = 1, m = -1 + rn[0] = -(1.*std::sqrt(w2m1) * std::sin(phi)); + // l = 1, m = 0 + rn[1] = w; + // l = 1, m = 1 + rn[2] = -(1.*std::sqrt(w2m1) * std::cos(phi)); + break; + case 2: + // l = 2, m = -2 + rn[0] = 0.288675134594813 * (-3. * w * w + 3.) * std::sin(2. * phi); + // l = 2, m = -1 + rn[1] = -(1.73205080756888 * w*std::sqrt(w2m1) * std::sin(phi)); + // l = 2, m = 0 + rn[2] = 1.5 * w * w - 0.5; + // l = 2, m = 1 + rn[3] = -(1.73205080756888 * w*std::sqrt(w2m1) * std::cos(phi)); + // l = 2, m = 2 + rn[4] = 0.288675134594813 * (-3. * w * w + 3.) * std::cos(2. * phi); + break; + case 3: + // l = 3, m = -3 + rn[0] = -(0.790569415042095 * std::pow(w2m1, 1.5) * std::sin(3. * phi)); + // l = 3, m = -2 + rn[1] = 1.93649167310371 * w*(w2m1) * std::sin(2.*phi); + // l = 3, m = -1 + rn[2] = -(0.408248290463863*std::sqrt(w2m1)*((7.5)*w * w - 3./2.) * + std::sin(phi)); + // l = 3, m = 0 + rn[3] = 2.5 * std::pow(w, 3) - 1.5 * w; + // l = 3, m = 1 + rn[4] = -(0.408248290463863*std::sqrt(w2m1)*((7.5)*w * w - 3./2.) * + std::cos(phi)); + // l = 3, m = 2 + rn[5] = 1.93649167310371 * w*(w2m1) * std::cos(2.*phi); + // l = 3, m = 3 + rn[6] = -(0.790569415042095 * std::pow(w2m1, 1.5) * std::cos(3.* phi)); + break; + case 4: + // l = 4, m = -4 + rn[0] = 0.739509972887452 * (w2m1 * w2m1) * std::sin(4.0*phi); + // l = 4, m = -3 + rn[1] = -(2.09165006633519 * w * std::pow(w2m1, 1.5) * std::sin(3.* phi)); + // l = 4, m = -2 + rn[2] = 0.074535599249993 * (w2m1)*(52.5 * w * w - 7.5) * std::sin(2. *phi); + // l = 4, m = -1 + rn[3] = -(0.316227766016838*std::sqrt(w2m1)*(17.5 * std::pow(w, 3) - 7.5 * w) * + std::sin(phi)); + // l = 4, m = 0 + rn[4] = 4.375 * std::pow(w, 4) - 3.75 * w * w + 0.375; + // l = 4, m = 1 + rn[5] = -(0.316227766016838*std::sqrt(w2m1)*(17.5 * std::pow(w, 3) - 7.5*w) * + std::cos(phi)); + // l = 4, m = 2 + rn[6] = 0.074535599249993 * (w2m1)*(52.5*w * w - 7.5) * std::cos(2.*phi); + // l = 4, m = 3 + rn[7] = -(2.09165006633519 * w * std::pow(w2m1, 1.5) * std::cos(3.* phi)); + // l = 4, m = 4 + rn[8] = 0.739509972887452 * w2m1 * w2m1 * std::cos(4.0*phi); + break; + case 5: + // l = 5, m = -5 + rn[0] = -(0.701560760020114 * std::pow(w2m1, 2.5) * std::sin(5.0 * phi)); + // l = 5, m = -4 + rn[1] = 2.21852991866236 * w * w2m1 * w2m1 * std::sin(4.0 * phi); + // l = 5, m = -3 + rn[2] = -(0.00996023841111995 * std::pow(w2m1, 1.5) * + ((945.0 /2.)* w * w - 52.5) * std::sin(3.*phi)); + // l = 5, m = -2 + rn[3] = 0.0487950036474267 * (w2m1) + * ((315.0/2.)* std::pow(w, 3) - 52.5 * w) * std::sin(2.*phi); + // l = 5, m = -1 + rn[4] = -(0.258198889747161*std::sqrt(w2m1) * + (39.375 * std::pow(w, 4) - 105.0/4.0 * w * w + 15.0/8.0) * std::sin(phi)); + // l = 5, m = 0 + rn[5] = 7.875 * std::pow(w, 5) - 8.75 * std::pow(w, 3) + 1.875 * w; + // l = 5, m = 1 + rn[6] = -(0.258198889747161 * std::sqrt(w2m1)* + (39.375 * std::pow(w, 4) - 105.0/4.0 * w * w + 15.0/8.0) * std::cos(phi)); + // l = 5, m = 2 + rn[7] = 0.0487950036474267 * (w2m1) * + ((315.0 / 2.) * std::pow(w, 3) - 52.5*w) * std::cos(2.*phi); + // l = 5, m = 3 + rn[8] = -(0.00996023841111995 * std::pow(w2m1, 1.5) * + ((945.0 / 2.) * w * w - 52.5) * std::cos(3.*phi)); + // l = 5, m = 4 + rn[9] = 2.21852991866236 * w * w2m1 * w2m1 * std::cos(4.0*phi); + // l = 5, m = 5 + rn[10] = -(0.701560760020114 * std::pow(w2m1, 2.5) * std::cos(5.0* phi)); + break; + case 6: + // l = 6, m = -6 + rn[0] = 0.671693289381396 * std::pow(w2m1, 3) * std::sin(6.0*phi); + // l = 6, m = -5 + rn[1] = -(2.32681380862329 * w*std::pow(w2m1, 2.5) * std::sin(5.0*phi)); + // l = 6, m = -4 + rn[2] = 0.00104990131391452 * w2m1 * w2m1 * + ((10395.0/2.) * w * w - 945.0/2.) * std::sin(4.0 * phi); + // l = 6, m = -3 + rn[3] = -(0.00575054632785295 * std::pow(w2m1, 1.5) * + ((3465.0/2.) * std::pow(w, 3) - 945.0/2.*w) * std::sin(3.*phi)); + // l = 6, m = -2 + rn[4] = 0.0345032779671177 * (w2m1) * + ((3465.0/8.0)* std::pow(w, 4) - 945.0/4.0 * w * w + 105.0/8.0) * + std::sin(2. * phi); + // l = 6, m = -1 + rn[5] = -(0.218217890235992*std::sqrt(w2m1) * + ((693.0/8.0)* std::pow(w, 5)- 315.0/4.0 * std::pow(w, 3) + (105.0/8.0)*w) * + std::sin(phi)); + // l = 6, m = 0 + rn[6] = 14.4375 * std::pow(w, 6) - 19.6875 * std::pow(w, 4) + 6.5625 * w * w - + 0.3125; + // l = 6, m = 1 + rn[7] = -(0.218217890235992*std::sqrt(w2m1) * + ((693.0/8.0)* std::pow(w, 5)- 315.0/4.0 * std::pow(w, 3) + (105.0/8.0)*w) * + std::cos(phi)); + // l = 6, m = 2 + rn[8] = 0.0345032779671177 * w2m1 * + ((3465.0/8.0)* std::pow(w, 4) -945.0/4.0 * w * w + 105.0/8.0) * + std::cos(2.*phi); + // l = 6, m = 3 + rn[9] = -(0.00575054632785295 * std::pow(w2m1, 1.5) * + ((3465.0/2.) * std::pow(w, 3) - 945.0/2.*w) * std::cos(3.*phi)); + // l = 6, m = 4 + rn[10] = 0.00104990131391452 * w2m1 * w2m1 * + ((10395.0/2.)*w * w - 945.0/2.) * std::cos(4.0*phi); + // l = 6, m = 5 + rn[11] = -(2.32681380862329 * w * std::pow(w2m1, 2.5) * std::cos(5.0*phi)); + // l = 6, m = 6 + rn[12] = 0.671693289381396 * std::pow(w2m1, 3) * std::cos(6.0*phi); + break; + case 7: + // l = 7, m = -7 + rn[0] = -(0.647259849287749 * std::pow(w2m1, 3.5) * std::sin(7.0*phi)); + // l = 7, m = -6 + rn[1] = 2.42182459624969 * w*std::pow(w2m1, 3) * std::sin(6.0*phi); + // l = 7, m = -5 + rn[2] = -(9.13821798555235e-5*std::pow(w2m1, 2.5) * + ((135135.0/2.)*w * w - 10395.0/2.) * std::sin(5.0*phi)); + // l = 7, m = -4 + rn[3] = 0.000548293079133141 * w2m1 * w2m1 * + ((45045.0/2.)*std::pow(w, 3) - 10395.0/2.*w) * std::sin(4.0*phi); + // l = 7, m = -3 + rn[4] = -(0.00363696483726654 * std::pow(w2m1, 1.5) * + ((45045.0/8.0)* std::pow(w, 4) - 10395.0/4.0 * w * w + 945.0/8.0) * + std::sin(3.*phi)); + // l = 7, m = -2 + rn[5] = 0.025717224993682 * (w2m1) * + ((9009.0/8.0)* std::pow(w, 5) -3465.0/4.0 * std::pow(w, 3) + (945.0/8.0)*w) * + std::sin(2.*phi); + // l = 7, m = -1 + rn[6] = -(0.188982236504614*std::sqrt(w2m1) * + ((3003.0/16.0)* std::pow(w, 6) - 3465.0/16.0 * std::pow(w, 4) + + (945.0/16.0)*w * w - 35.0/16.0) * std::sin(phi)); + // l = 7, m = 0 + rn[7] = 26.8125 * std::pow(w, 7) - 43.3125 * std::pow(w, 5) + 19.6875 * std::pow(w, 3) - + 2.1875 * w; + // l = 7, m = 1 + rn[8] = -(0.188982236504614*std::sqrt(w2m1) * ((3003.0/16.0) * std::pow(w, 6) - + 3465.0/16.0 * std::pow(w, 4) + (945.0/16.0)*w * w - 35.0/16.0) * std::cos(phi)); + // l = 7, m = 2 + rn[9] = 0.025717224993682 * (w2m1) * ((9009.0/8.0)* std::pow(w, 5) - + 3465.0/4.0 * std::pow(w, 3) + (945.0/8.0)*w) * std::cos(2.*phi); + // l = 7, m = 3 + rn[10] = -(0.00363696483726654 * std::pow(w2m1, 1.5) * + ((45045.0/8.0)* std::pow(w, 4) - 10395.0/4.0 * w * w + 945.0/8.0) * + std::cos(3.*phi)); + // l = 7, m = 4 + rn[11] = 0.000548293079133141 * w2m1 * w2m1 * + ((45045.0/2.)*std::pow(w, 3) - 10395.0/2.*w) * std::cos(4.0*phi); + // l = 7, m = 5 + rn[12] = -(9.13821798555235e-5*std::pow(w2m1, 2.5) * + ((135135.0/2.)*w * w - 10395.0/2.) * std::cos(5.0*phi)); + // l = 7, m = 6 + rn[13] = 2.42182459624969 * w*std::pow(w2m1, 3) * std::cos(6.0*phi); + // l = 7, m = 7 + rn[14] = -(0.647259849287749 * std::pow(w2m1, 3.5) * std::cos(7.0*phi)); + break; + case 8: + // l = 8, m = -8 + rn[0] = 0.626706654240044 * std::pow(w2m1, 4) * std::sin(8.0*phi); + // l = 8, m = -7 + rn[1] = -(2.50682661696018 * w*std::pow(w2m1, 3.5) * std::sin(7.0*phi)); + // l = 8, m = -6 + rn[2] = 6.77369783729086e-6*std::pow(w2m1, 3)* + ((2027025.0/2.)*w * w - 135135.0/2.) * std::sin(6.0*phi); + // l = 8, m = -5 + rn[3] = -(4.38985792528482e-5*std::pow(w2m1, 2.5) * + ((675675.0/2.)*std::pow(w, 3) - 135135.0/2.*w) * std::sin(5.0*phi)); + // l = 8, m = -4 + rn[4] = 0.000316557156832328 * w2m1 * w2m1 * + ((675675.0/8.0)* std::pow(w, 4) - 135135.0/4.0 * w * w + 10395.0/8.0) * + std::sin(4.0*phi); + // l = 8, m = -3 + rn[5] = -(0.00245204119306875 * std::pow(w2m1, 1.5) * ((135135.0/8.0) * + std::pow(w, 5) - 45045.0/4.0 * std::pow(w, 3) + (10395.0/8.0)*w) * std::sin(3.*phi)); + // l = 8, m = -2 + rn[6] = 0.0199204768222399 * (w2m1) * + ((45045.0/16.0)* std::pow(w, 6)- 45045.0/16.0 * std::pow(w, 4) + + (10395.0/16.0)*w * w - 315.0/16.0) * std::sin(2.*phi); + // l = 8, m = -1 + rn[7] = -(0.166666666666667*std::sqrt(w2m1) * + ((6435.0/16.0)* std::pow(w, 7) - 9009.0/16.0 * std::pow(w, 5) + + (3465.0/16.0)*std::pow(w, 3) - 315.0/16.0 * w) * std::sin(phi)); + // l = 8, m = 0 + rn[8] = 50.2734375 * std::pow(w, 8) - 93.84375 * std::pow(w, 6) + 54.140625 * + std::pow(w, 4) - 9.84375 * w * w + 0.2734375; + // l = 8, m = 1 + rn[9] = -(0.166666666666667*std::sqrt(w2m1) * + ((6435.0/16.0)* std::pow(w, 7) - 9009.0/16.0 * std::pow(w, 5) + + (3465.0/16.0)*std::pow(w, 3) - 315.0/16.0 * w) * std::cos(phi)); + // l = 8, m = 2 + rn[10] = 0.0199204768222399 * (w2m1)*((45045.0/16.0)* std::pow(w, 6)- + 45045.0/16.0 * std::pow(w, 4) + (10395.0/16.0)*w * w - + 315.0/16.0) * std::cos(2.*phi); + // l = 8, m = 3 + rn[11] = -(0.00245204119306875 * std::pow(w2m1, 1.5)* + ((135135.0/8.0) * std::pow(w, 5) - 45045.0/4.0 * std::pow(w, 3) + + (10395.0/8.0)*w) * std::cos(3.*phi)); + // l = 8, m = 4 + rn[12] = 0.000316557156832328 * w2m1 * w2m1*((675675.0/8.0)* std::pow(w, 4) - + 135135.0/4.0 * w * w + 10395.0/8.0) * std::cos(4.0*phi); + // l = 8, m = 5 + rn[13] = -(4.38985792528482e-5*std::pow(w2m1, 2.5)*((675675.0/2.)*std::pow(w, 3) - + 135135.0/2.*w) * std::cos(5.0*phi)); + // l = 8, m = 6 + rn[14] = 6.77369783729086e-6*std::pow(w2m1, 3)*((2027025.0/2.)*w * w - + 135135.0/2.) * std::cos(6.0*phi); + // l = 8, m = 7 + rn[15] = -(2.50682661696018 * w*std::pow(w2m1, 3.5) * std::cos(7.0*phi)); + // l = 8, m = 8 + rn[16] = 0.626706654240044 * std::pow(w2m1, 4) * std::cos(8.0*phi); + break; + case 9: + // l = 9, m = -9 + rn[0] = -(0.609049392175524 * std::pow(w2m1, 4.5) * std::sin(9.0 * phi)); + // l = 9, m = -8 + rn[1] = 2.58397773170915 * w*std::pow(w2m1, 4) * std::sin(8.0 * phi); + // l = 9, m = -7 + rn[2] = -(4.37240315267812e-7*std::pow(w2m1, 3.5) * + ((34459425.0/2.)*w * w - 2027025.0/2.) * std::sin(7.0 * phi)); + // l = 9, m = -6 + rn[3] = 3.02928976464514e-6*std::pow(w2m1, 3)* + ((11486475.0/2.)*std::pow(w, 3) - 2027025.0/2.*w) * std::sin(6.0 * phi); + // l = 9, m = -5 + rn[4] = -(2.34647776186144e-5*std::pow(w2m1, 2.5) * + ((11486475.0/8.0)* std::pow(w, 4) - 2027025.0 / 4.0 * w * w + + 135135.0/8.0) * std::sin(5.0 * phi)); + // l = 9, m = -4 + rn[5] = 0.000196320414650061 * w2m1 * w2m1*((2297295.0/8.0)* std::pow(w, 5) - + 675675.0/4.0 * std::pow(w, 3) + (135135.0/8.0)*w) * std::sin(4.0*phi); + // l = 9, m = -3 + rn[6] = -(0.00173385495536766 * std::pow(w2m1, 1.5) * + ((765765.0/16.0)* std::pow(w, 6) - 675675.0/16.0 * std::pow(w, 4) + + (135135.0/16.0)*w * w - 3465.0/16.0) * std::sin(3. * phi)); + // l = 9, m = -2 + rn[7] = 0.0158910431540932 * (w2m1)*((109395.0/16.0)* std::pow(w, 7)- + 135135.0/16.0 * std::pow(w, 5) + (45045.0/16.0)*std::pow(w, 3) - + 3465.0/16.0 * w) * std::sin(2. * phi); + // l = 9, m = -1 + rn[8] = -(0.149071198499986*std::sqrt(w2m1)*((109395.0/128.0)* std::pow(w, 8) - + 45045.0/32.0 * std::pow(w, 6) + (45045.0/64.0)* std::pow(w, 4) - + 3465.0/32.0 * w * w + 315.0/128.0) * std::sin(phi)); + // l = 9, m = 0 + rn[9] = 94.9609375 * std::pow(w, 9) - 201.09375 * std::pow(w, 7) + + 140.765625 * std::pow(w, 5)- 36.09375 * std::pow(w, 3) + 2.4609375 * w; + // l = 9, m = 1 + rn[10] = -(0.149071198499986*std::sqrt(w2m1)*((109395.0/128.0)* std::pow(w, 8) - + 45045.0/32.0 * std::pow(w, 6) + (45045.0/64.0)* std::pow(w, 4) - + 3465.0/32.0 * w * w + 315.0/128.0) * std::cos(phi)); + // l = 9, m = 2 + rn[11] = 0.0158910431540932 * (w2m1)*((109395.0/16.0)* std::pow(w, 7) - + 135135.0/16.0 * std::pow(w, 5) + (45045.0/16.0)*std::pow(w, 3) - + 3465.0/ 16.0 * w) * std::cos(2. * phi); + // l = 9, m = 3 + rn[12] = -(0.00173385495536766 * std::pow(w2m1, 1.5)*((765765.0/16.0) * + std::pow(w, 6) - 675675.0/16.0 * std::pow(w, 4) + + (135135.0/16.0)* w * w - 3465.0/16.0)* std::cos(3. * phi)); + // l = 9, m = 4 + rn[13] = 0.000196320414650061 * w2m1 * w2m1*((2297295.0/8.0) * std::pow(w, 5) - + 675675.0/4.0 * std::pow(w, 3) + (135135.0/8.0)*w) * std::cos(4.0 * phi); + // l = 9, m = 5 + rn[14] = -(2.34647776186144e-5*std::pow(w2m1, 2.5)*((11486475.0/8.0) * + std::pow(w, 4) - 2027025.0/4.0 * w * w + 135135.0/8.0) * + std::cos(5.0 * phi)); + // l = 9, m = 6 + rn[15] = 3.02928976464514e-6*std::pow(w2m1, 3)*((11486475.0/2.)*std::pow(w, 3) - + 2027025.0/2. * w) * std::cos(6.0 * phi); + // l = 9, m = 7 + rn[16] = -(4.37240315267812e-7*std::pow(w2m1, 3.5)* + ((34459425.0/2.) * w * w - 2027025.0/2.) * std::cos(7.0 * phi)); + // l = 9, m = 8 + rn[17] = 2.58397773170915 * w*std::pow(w2m1, 4) * std::cos(8.0 * phi); + // l = 9, m = 9 + rn[18] = -(0.609049392175524 * std::pow(w2m1, 4.5) * std::cos(9.0 * phi)); + break; + case 10: + // l = 10, m = -10 + rn[0] = 0.593627917136573 * std::pow(w2m1, 5) * std::sin(10.0 * phi); + // l = 10, m = -9 + rn[1] = -(2.65478475211798 * w * std::pow(w2m1, 4.5) * std::sin(9.0 * phi)); + // l = 10, m = -8 + rn[2] = 2.49953651452314e-8 * std::pow(w2m1, 4) * + ((654729075.0/2.) * w * w - 34459425.0/2.) * std::sin(8.0 * phi); + // l = 10, m = -7 + rn[3] = -(1.83677671621093e-7*std::pow(w2m1, 3.5)* + ((218243025.0/2.)*std::pow(w, 3) - 34459425.0/2.*w) * + std::sin(7.0 * phi)); + // l = 10, m = -6 + rn[4] = 1.51464488232257e-6*std::pow(w2m1, 3)*((218243025.0/8.0)* std::pow(w, 4) - + 34459425.0/4.0 * w * w + 2027025.0/8.0) * std::sin(6.0 * phi); + // l = 10, m = -5 + rn[5] = -(1.35473956745817e-5*std::pow(w2m1, 2.5)* + ((43648605.0/8.0)* std::pow(w, 5) - 11486475.0/4.0 * std::pow(w, 3) + + (2027025.0/8.0)*w) * std::sin(5.0 * phi)); + // l = 10, m = -4 + rn[6] = 0.000128521880085575 * w2m1 * w2m1*((14549535.0/16.0)* std::pow(w, 6) - + 11486475.0/16.0 * std::pow(w, 4) + (2027025.0/16.0)*w * w - + 45045.0/16.0) * std::sin(4.0 * phi); + // l = 10, m = -3 + rn[7] = -(0.00127230170115096 * std::pow(w2m1, 1.5)* + ((2078505.0/16.0)* std::pow(w, 7) - 2297295.0/16.0 * std::pow(w, 5) + + (675675.0/16.0)*std::pow(w, 3) - 45045.0/16.0 * w) * std::sin(3. * phi)); + // l = 10, m = -2 + rn[8] = 0.012974982402692 * (w2m1)*((2078505.0/128.0)* std::pow(w, 8) - + 765765.0/32.0 * std::pow(w, 6) + (675675.0/64.0)* std::pow(w, 4) - + 45045.0/32.0 * w * w + 3465.0/128.0) * std::sin(2. * phi); + // l = 10, m = -1 + rn[9] = -(0.134839972492648*std::sqrt(w2m1)*((230945.0/128.0)* std::pow(w, 9) - + 109395.0/32.0 * std::pow(w, 7) + (135135.0/64.0)* std::pow(w, 5) - + 15015.0/32.0 * std::pow(w, 3) + (3465.0/128.0)*w) * std::sin(phi)); + // l = 10, m = 0 + rn[10] = 180.42578125 * std::pow(w, 10) - 427.32421875 * std::pow(w, 8) +351.9140625 + * std::pow(w, 6) - 117.3046875 * std::pow(w, 4) + 13.53515625 * w * w -0.24609375; + // l = 10, m = 1 + rn[11] = -(0.134839972492648*std::sqrt(w2m1)*((230945.0/128.0)* std::pow(w, 9) - + 109395.0/32.0 * std::pow(w, 7) + (135135.0/64.0)* std::pow(w, 5) -15015.0/ + 32.0 * std::pow(w, 3) + (3465.0/128.0)*w) * std::cos(phi)); + // l = 10, m = 2 + rn[12] = 0.012974982402692 * (w2m1)*((2078505.0/128.0)* std::pow(w, 8) - + 765765.0/32.0 * std::pow(w, 6) + (675675.0/64.0)* std::pow(w, 4) - + 45045.0/32.0 * w * w + 3465.0/128.0) * std::cos(2. * phi); + // l = 10, m = 3 + rn[13] = -(0.00127230170115096 * std::pow(w2m1, 1.5)* + ((2078505.0/16.0)* std::pow(w, 7) - 2297295.0/16.0 * std::pow(w, 5) + + (675675.0/16.0)*std::pow(w, 3) - 45045.0/16.0 * w) * std::cos(3. * phi)); + // l = 10, m = 4 + rn[14] = 0.000128521880085575 * w2m1 * w2m1*((14549535.0/16.0)* std::pow(w, 6) - + 11486475.0/16.0 * std::pow(w, 4) + (2027025.0/16.0) * w * w - + 45045.0/16.0) * std::cos(4.0 * phi); + // l = 10, m = 5 + rn[15] = -(1.35473956745817e-5*std::pow(w2m1, 2.5)* + ((43648605.0/8.0)* std::pow(w, 5) - 11486475.0/4.0 * std::pow(w, 3) + + (2027025.0/8.0)*w) * std::cos(5.0 * phi)); + // l = 10, m = 6 + rn[16] = 1.51464488232257e-6*std::pow(w2m1, 3)*((218243025.0/8.0)* std::pow(w, 4) - + 34459425.0/4.0 * w * w + 2027025.0/8.0) * std::cos(6.0 * phi); + // l = 10, m = 7 + rn[17] = -(1.83677671621093e-7*std::pow(w2m1, 3.5) * + ((218243025.0/2.)*std::pow(w, 3) - 34459425.0/2.*w) * std::cos(7.0 * phi)); + // l = 10, m = 8 + rn[18] = 2.49953651452314e-8*std::pow(w2m1, 4)* + ((654729075.0/2.)*w * w - 34459425.0/2.) * std::cos(8.0 * phi); + // l = 10, m = 9 + rn[19] = -(2.65478475211798 * w*std::pow(w2m1, 4.5) * std::cos(9.0 * phi)); + // l = 10, m = 10 + rn[20] = 0.593627917136573 * std::pow(w2m1, 5) * std::cos(10.0 * phi); + } +} + +//============================================================================== +// EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients +// and the value of x +//============================================================================== + +double __attribute__ ((const)) evaluate_legendre_c(int n, double data[], + double x) { + double val; + + val = 0.5 * data[0]; + for (int l = 1; l < n; l++) { + val += (static_cast(l) + 0.5) * data[l] * calc_pn_c(l, x); + } + +} + +//============================================================================== +// ROTATE_ANGLE rotates direction std::cosines through a polar angle whose +// cosine is mu and through an azimuthal angle sampled uniformly. Note that +// this is done with direct sampling rather than rejection as is done in MCNP +// and SERPENT. +//============================================================================== + +void rotate_angle_c(double uvw[3], double mu, double phi) { + double phi_; // azimuthal angle + double sinphi; // std::sine of azimuthal angle + double cosphi; // cosine of azimuthal angle + double a; // sqrt(1 - mu^2) + double b; // sqrt(1 - w^2) + double u0; // original std::cosine in x direction + double v0; // original std::cosine in y direction + double w0; // original std::cosine in z direction + + // Copy original directional std::cosines + u0 = uvw[0]; + v0 = uvw[1]; + w0 = uvw[2]; + + // Sample azimuthal angle in [0,2pi) if none provided + if (phi != -10.) { + phi_ = phi; + } else { + phi_ = 2. * M_PI * prn(); + } + + // Precompute factors to save flops + sinphi = std::sin(phi_); + cosphi = std::cos(phi_); + a = std::sqrt(std::max(0., 1. - mu * mu)); + b = std::sqrt(std::max(0., 1. - w0 * w0)); + + // Need to treat special case where sqrt(1 - w**2) is close to zero by + // expanding about the v component rather than the w component + if (b > 1e-10) { + uvw[0] = mu * u0 + a * (u0 * w0 * cosphi - v0 * sinphi) / b; + uvw[1] = mu * v0 + a * (v0 * w0 * cosphi + u0 * sinphi) / b; + uvw[2] = mu * w0 - a * b * cosphi; + } else { + b = std::sqrt(1. - v0 * v0); + uvw[0] = mu * u0 + a * (u0 * v0 * cosphi + w0 * sinphi) / b; + uvw[1] = mu * v0 - a * b * cosphi; + uvw[2] = mu * w0 + a * (v0 * w0 * cosphi - u0 * sinphi) / b; + } +} + +//============================================================================== +// MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution +// based on a direct sampling scheme. The probability distribution function for +// a Maxwellian is given as p(x) = 2/(T*sqrt(pi))*sqrt(x/T)*exp(-x/T). +// This PDF can be sampled using rule C64 in the Monte Carlo Sampler LA-9721-MS. +//============================================================================== + +double maxwell_spectrum_c(double T) { + double E_out; // Sampled Energy + + double r1; + double r2; + double r3; // random numbers + double c; // cosine of pi/2*r3 + + r1 = prn(); + r2 = prn(); + r3 = prn(); + + // determine cosine of pi/2*r + c = std::cos(M_PI / 2. * r3); + + // determine outgoing energy + E_out = -T * (std::log(r1) + std::log(r2) * c * c); + + return E_out; +} + +//============================================================================== +// WATT_SPECTRUM samples the outgoing energy from a Watt energy-dependent +// fission spectrum. Although fitted parameters exist for many nuclides, +// generally the continuous tabular distributions (LAW 4) should be used in +// lieu of the Watt spectrum. This direct sampling scheme is an unpublished +// scheme based on the original Watt spectrum derivation (See F. Brown's +// MC lectures). +//============================================================================== + +double watt_spectrum_c(double a, double b) { + double E_out; // Sampled Energy + double w; // sampled from Maxwellian + + w = maxwell_spectrum_c(a); + E_out = w + 0.25 * a * a * b + (2. * prn() - 1.) * std::sqrt(a * a * b * w); + + return E_out; +} + +//============================================================================== +// FADDEEVA the Faddeeva function, using Stephen Johnson's implementation +//============================================================================== + +// std::complex faddeeva_c(std::complex z) { +// std::complex wv; // The resultant w(z) value +// double relerr; // Target relative error in the inner loop of MIT Faddeeva + +// // Technically, the value we want is given by the equation: +// // w(z) = I/Pi * Integrate[Exp[-t^2]/(z-t), {t, -Infinity, Infinity}] +// // as shown in Equation 63 from Hwang, R. N. "A rigorous pole +// // representation of multilevel cross sections and its practical +// // applications." Nuclear Science and Engineering 96.3 (1987): 192-209. +// // +// // The MIT Faddeeva function evaluates w(z) = exp(-z^2)erfc(-iz). These +// // two forms of the Faddeeva function are related by a transformation. +// // +// // If we call the integral form w_int, and the function form w_fun: +// // For imag(z) > 0, w_int(z) = w_fun(z) +// // For imag(z) < 0, w_int(z) = -conjg(w_fun(conjg(z))) + +// // Note that faddeeva_w will interpret zero as machine epsilon + +// relerr = 0.; +// if (z.imag() > 0.) { +// wv = Faddeeva::w(z, relerr); +// } else { +// wv = -std::conj(Faddeeva::w(std::conj(z), relerr)); +// } + +// return wv; +// } + +// std::complex w_derivative_c(std::complex z, int order){ +// std::complex wv; // The resultant w(z) value + +// const std::complex twoi_sqrtpi(0.0, 2.0 / std::sqrt(M_PI)); + +// switch(order) { +// case 0: +// wv = faddeeva_c(z); +// break; +// case 1: +// wv = -2. * z * faddeeva_c(z) + twoi_sqrtpi; +// break; +// default: +// wv = -2. * z * w_derivative_c(z, order - 1) - 2. * (order - 1) * +// w_derivative_c(z, order - 2); +// } + +// return wv; +// } + +//============================================================================== +// BROADEN_WMP_POLYNOMIALS Doppler broadens the windowed multipole curvefit. +// The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... +//============================================================================== + +void broaden_wmp_polynomials_c(double E, double dopp, int n, double factors[]) { + // Factors is already pre-allocated + + double sqrtE; // sqrt(energy) + double beta; // sqrt(atomic weight ratio * E / kT) + double half_inv_dopp2; // 0.5 / dopp**2 + double quarter_inv_dopp4; // 0.25 / dopp**4 + double erf_beta; // error function of beta + double exp_m_beta2; // exp(-beta**2) + int i; + + sqrtE = std::sqrt(E); + beta = sqrtE * dopp; + half_inv_dopp2 = 0.5 / (dopp * dopp); + quarter_inv_dopp4 = half_inv_dopp2 * half_inv_dopp2; + + if (beta > 6.0) { + // Save time, ERF(6) is 1 to machine precision. + // beta/sqrtpi*exp(-beta**2) is also approximately 1 machine epsilon. + erf_beta = 1.; + exp_m_beta2 = 0.; + } else { + erf_beta = std::erf(beta); + exp_m_beta2 = std::exp(-beta * beta); + } + + // Assume that, for sure, we'll use a second order (1/E, 1/V, const) + // fit, and no less. + + factors[0] = erf_beta / E; + factors[1] = 1. / sqrtE; + factors[2] = factors[0] * (half_inv_dopp2 + E) + exp_m_beta2 / + (beta * std::sqrt(M_PI)); + + // Perform recursive broadening of high order components + for (i = 0; i < n - 3; i++) { + if (i != 0) { + factors[i + 3] = -factors[i - 1] * (i - 1.) * i * quarter_inv_dopp4 + + factors[i + 1] * (E + (1. + 2. * i) * half_inv_dopp2); + } else { + // Although it's mathematically identical, factors[0] will contain + // nothing, and we don't want to have to worry about memory. + factors[i + 3] = factors[i + 1]*(E + (1. + 2. * i) * half_inv_dopp2); + } + } +} + +} // namespace openmc diff --git a/src/math_functions.h b/src/math_functions.h new file mode 100644 index 000000000..aa048e5f6 --- /dev/null +++ b/src/math_functions.h @@ -0,0 +1,94 @@ +#ifndef MATH_FUNCTIONS_H +#define MATH_FUNCTIONS_H + +#include +#include +#include + +#include "random_lcg.h" +// #include "faddeeva/Faddeeva.hh" + + +namespace openmc { + + +//============================================================================== +// NORMAL_PERCENTILE calculates the percentile of the standard normal +// distribution with a specified probability level +//============================================================================== + +extern "C" double normal_percentile_c(double p) __attribute__ ((const)); + +//============================================================================== +// T_PERCENTILE calculates the percentile of the Student's t distribution with +// a specified probability level and number of degrees of freedom +//============================================================================== + +extern "C" double t_percentile_c(double p, int df) __attribute__ ((const)); + +//============================================================================== +// CALC_PN calculates the n-th order Legendre polynomial at the value of x. +//============================================================================== + +extern "C" double calc_pn_c(int n, double x) __attribute__ ((const)); + +//============================================================================== +// CALC_RN calculates the n-th order spherical harmonics for a given angle +// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) +//============================================================================== + +extern "C" void calc_rn_c(int n, double uvw[3], double rn[]); + +//============================================================================== +// EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients +// and the value of x +//============================================================================== + +extern "C" double evaluate_legendre_c(int n, double data[], double x) + __attribute__ ((const)); + +//============================================================================== +// ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is +// mu and through an azimuthal angle sampled uniformly. Note that this is done +// with direct sampling rather than rejection as is done in MCNP and SERPENT. +//============================================================================== + +extern "C" void rotate_angle_c(double uvw[3], double mu, double phi = -10.); + +//============================================================================== +// MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution +// based on a direct sampling scheme. The probability distribution function for +// a Maxwellian is given as p(x) = 2/(T*sqrt(pi))*sqrt(x/T)*exp(-x/T). +// This PDF can be sampled using rule C64 in the Monte Carlo Sampler LA-9721-MS. +//============================================================================== + +extern "C" double maxwell_spectrum_c(double T); + +//============================================================================== +// WATT_SPECTRUM samples the outgoing energy from a Watt energy-dependent +// fission spectrum. Although fitted parameters exist for many nuclides, +// generally the continuous tabular distributions (LAW 4) should be used in +// lieu of the Watt spectrum. This direct sampling scheme is an unpublished +// scheme based on the original Watt spectrum derivation (See F. Brown's +// MC lectures). +//============================================================================== + +extern "C" double watt_spectrum_c(double a, double b); + +//============================================================================== +// FADDEEVA the Faddeeva function, using Stephen Johnson's implementation +//============================================================================== + +// extern "C" std::complex faddeeva_c(std::complex z); + +// extern "C" std::complex w_derivative_c(std::complex z, int order); + +//============================================================================== +// BROADEN_WMP_POLYNOMIALS Doppler broadens the windowed multipole curvefit. +// The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... +//============================================================================== + +extern "C" void broaden_wmp_polynomials_c(double E, double dopp, int n, double factors[]); + +} // namespace openmc +#endif // MATH_FUNCTIONS_H \ No newline at end of file From 0e3194315a6323a3df88bc59861b9fe3c6f0007a Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Mon, 30 Apr 2018 15:41:20 -0400 Subject: [PATCH 04/15] C++ized t_percentile --- openmc/capi/math.py | 4 +- src/api.F90 | 1 - src/math.F90 | 94 +---------------------------------- tests/unit_tests/test_math.py | 16 +++--- 4 files changed, 11 insertions(+), 104 deletions(-) diff --git a/openmc/capi/math.py b/openmc/capi/math.py index 713ef9813..3d22ccdac 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -5,8 +5,8 @@ from numpy.ctypeslib import ndpointer from . import _dll -_dll.normal_percentile.restype = c_double -_dll.normal_percentile.argtypes = [POINTER(c_double)] +# _dll.normal_percentile.restype = c_double +# _dll.normal_percentile.argtypes = [POINTER(c_double)] _dll.t_percentile.restype = c_double _dll.t_percentile.argtypes = [POINTER(c_double), POINTER(c_int)] _dll.calc_pn.restype = c_double diff --git a/src/api.F90 b/src/api.F90 index 30aca6834..388659f4a 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -98,7 +98,6 @@ module openmc_api public :: openmc_tally_set_nuclides public :: openmc_tally_set_scores public :: openmc_tally_set_type - public :: normal_percentile public :: t_percentile public :: calc_pn public :: calc_rn diff --git a/src/math.F90 b/src/math.F90 index 76e9fc11a..40c2d09dc 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -7,7 +7,6 @@ module math implicit none private - public :: normal_percentile public :: t_percentile public :: calc_pn public :: calc_rn @@ -124,65 +123,6 @@ module math contains -!=============================================================================== -! NORMAL_PERCENTILE calculates the percentile of the standard normal -! distribution with a specified probability level -!=============================================================================== - - pure function normal_percentile(p) result(z) bind(C) - - real(C_DOUBLE), intent(in) :: p ! probability level - real(C_DOUBLE) :: z ! corresponding z-value - - real(C_DOUBLE) :: q - real(C_DOUBLE) :: r - real(C_DOUBLE), parameter :: p_low = 0.02425_8 - real(C_DOUBLE), parameter :: a(6) = (/ & - -3.969683028665376e1_8, 2.209460984245205e2_8, -2.759285104469687e2_8, & - 1.383577518672690e2_8, -3.066479806614716e1_8, 2.506628277459239e0_8 /) - real(C_DOUBLE), parameter :: b(5) = (/ & - -5.447609879822406e1_8, 1.615858368580409e2_8, -1.556989798598866e2_8, & - 6.680131188771972e1_8, -1.328068155288572e1_8 /) - real(C_DOUBLE), parameter :: c(6) = (/ & - -7.784894002430293e-3_8, -3.223964580411365e-1_8, -2.400758277161838_8, & - -2.549732539343734_8, 4.374664141464968_8, 2.938163982698783_8 /) - real(C_DOUBLE), parameter :: d(4) = (/ & - 7.784695709041462e-3_8, 3.224671290700398e-1_8, & - 2.445134137142996_8, 3.754408661907416_8 /) - - ! The rational approximation used here is from an unpublished work at - ! http://home.online.no/~pjacklam/notes/invnorm/ - - if (p < p_low) then - ! Rational approximation for lower region. - - q = sqrt(-TWO*log(p)) - z = (((((c(1)*q + c(2))*q + c(3))*q + c(4))*q + c(5))*q + c(6)) / & - ((((d(1)*q + d(2))*q + d(3))*q + d(4))*q + ONE) - - elseif (p <= ONE - p_low) then - ! Rational approximation for central region - - q = p - HALF - r = q*q - z = (((((a(1)*r + a(2))*r + a(3))*r + a(4))*r + a(5))*r + a(6))*q / & - (((((b(1)*r + b(2))*r + b(3))*r + b(4))*r + b(5))*r + ONE) - - else - ! Rational approximation for upper region - - q = sqrt(-TWO*log(ONE - p)) - z = -(((((c(1)*q + c(2))*q + c(3))*q + c(4))*q + c(5))*q + c(6)) / & - ((((d(1)*q + d(2))*q + d(3))*q + d(4))*q + ONE) - endif - - ! Refinement based on Newton's method -#ifndef NO_F2008 - z = z - (HALF * erfc(-z/sqrt(TWO)) - p) * sqrt(TWO*PI) * exp(HALF*z*z) -#endif - - end function normal_percentile - !=============================================================================== ! T_PERCENTILE calculates the percentile of the Student's t distribution with a ! specified probability level and number of degrees of freedom @@ -194,39 +134,7 @@ contains integer(C_INT), intent(in) :: df ! degrees of freedom real(C_DOUBLE) :: t ! corresponding t-value - real(C_DOUBLE) :: n ! degrees of freedom as a real(8) - real(C_DOUBLE) :: k ! n - 2 - real(C_DOUBLE) :: z ! percentile of normal distribution - real(C_DOUBLE) :: z2 ! z * z - - if (df == 1) then - ! For one degree of freedom, the t-distribution becomes a Cauchy - ! distribution whose cdf we can invert directly - - t = tan(PI*(p - HALF)) - - elseif (df == 2) then - ! For two degrees of freedom, the cdf is given by 1/2 + x/(2*sqrt(x^2 + - ! 2)). This can be directly inverted to yield the solution below - - t = TWO*sqrt(TWO)*(p - HALF)/sqrt(ONE - FOUR*(p - HALF)**2) - - else - - ! This approximation is from E. Olusegun George and Meenakshi Sivaram, "A - ! modification of the Fisher-Cornish approximation for the student t - ! percentiles," Communication in Statistics - Simulation and Computation, - ! 16 (4), pp. 1123-1132 (1987). - - n = real(df,8) - k = ONE/(n - TWO) - z = normal_percentile(p) - z2 = z * z - t = sqrt(n*k) * (z + (z2 - THREE)*z*k/FOUR + ((5._8*z2 - 56._8)*z2 + & - 75._8)*z*k*k/96._8 + (((z2 - 27._8)*THREE*z2 + 417._8)*z2 - 315._8) & - *z*k*k*k/384._8) - - end if + t = t_percentile_cc(p, df) end function t_percentile diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py index 17c20fdb5..98295aefb 100644 --- a/tests/unit_tests/test_math.py +++ b/tests/unit_tests/test_math.py @@ -5,17 +5,17 @@ import openmc import openmc.capi -def test_normal_percentile(): - # normal_percentile has three branches to consider: - # p < 0.02425; 0.02425 <= p <= 0.97575; and p > 0.97575 - test_ps = [0.02, 0.4, 0.5, 0.6, 0.98] +# def test_normal_percentile(): +# # normal_percentile has three branches to consider: +# # p < 0.02425; 0.02425 <= p <= 0.97575; and p > 0.97575 +# test_ps = [0.02, 0.4, 0.5, 0.6, 0.98] - # The reference solutions come from Scipy - ref_zs = [sp.stats.norm.ppf(p) for p in test_ps] +# # The reference solutions come from Scipy +# ref_zs = [sp.stats.norm.ppf(p) for p in test_ps] - test_zs = [openmc.capi.math.normal_percentile(p) for p in test_ps] +# test_zs = [openmc.capi.math.normal_percentile(p) for p in test_ps] - assert np.allclose(ref_zs, test_zs) +# assert np.allclose(ref_zs, test_zs) def test_t_percentile(): From 15b6b1d4eedad8e12e8f323720ccc03635dbd003 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Mon, 30 Apr 2018 16:13:11 -0400 Subject: [PATCH 05/15] CPPized the Pn and Rn functions --- openmc/capi/math.py | 48 ++-- src/math.F90 | 450 ++-------------------------------- src/math_functions.cpp | 31 +-- src/math_functions.h | 14 +- tests/unit_tests/test_math.py | 36 +-- 5 files changed, 84 insertions(+), 495 deletions(-) diff --git a/openmc/capi/math.py b/openmc/capi/math.py index 3d22ccdac..cd7ab4052 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -98,6 +98,30 @@ def calc_pn(n, x): return _dll.calc_pn(c_int(n), c_double(x)) +def evaluate_legendre(data, x): + """ Finds the value of f(x) given a set of Legendre coefficients + and the value of x. + + Parameters + ---------- + data : iterable of float + Legendre coefficients + x : float + Independent variable to evaluate the Legendre at + + Returns + ------- + float + Corresponding Legendre expansion result + + """ + + data_arr = np.array(data, dtype=np.float64) + return _dll.evaluate_legendre(c_int(len(data)), + data_arr.ctypes.data_as(POINTER(c_double)), + c_double(x)) + + def calc_rn(n, uvw): """ Calculate the n-th order real Spherical Harmonics for a given angle; all Rn,m values are provided (where -n <= m <= n). @@ -151,30 +175,6 @@ def calc_zn(n, rho, phi): return zn -def evaluate_legendre(data, x): - """ Finds the value of f(x) given a set of Legendre coefficients - and the value of x. - - Parameters - ---------- - data : iterable of float - Legendre coefficients - x : float - Independent variable to evaluate the Legendre at - - Returns - ------- - float - Corresponding Legendre expansion result - - """ - - data_arr = np.array(data, dtype=np.float64) - return _dll.evaluate_legendre(c_int(len(data)), - data_arr.ctypes.data_as(POINTER(c_double)), - c_double(x)) - - def rotate_angle(uvw0, mu, phi=None): """ Rotates direction cosines through a polar angle whose cosine is mu and through an azimuthal angle sampled uniformly. diff --git a/src/math.F90 b/src/math.F90 index 40c2d09dc..9e1f01de5 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -148,7 +148,7 @@ contains ! the return value will be 1.0. !=============================================================================== - pure function calc_pn(n,x) result(pnx) bind(C) + pure function calc_pn(n, x) result(pnx) bind(C) integer(C_INT), intent(in) :: n ! Legendre order requested real(C_DOUBLE), intent(in) :: x ! Independent variable the Legendre is to @@ -157,39 +157,25 @@ contains real(C_DOUBLE) :: pnx ! The Legendre poly of order n evaluated ! at x - select case(n) - case(1) - pnx = x - case(2) - pnx = 1.5_8 * x * x - HALF - case(3) - pnx = 2.5_8 * x * x * x - 1.5_8 * x - case(4) - pnx = 4.375_8 * (x ** 4) - 3.75_8 * x * x + 0.375_8 - case(5) - pnx = 7.875_8 * (x ** 5) - 8.75_8 * x * x * x + 1.875 * x - case(6) - pnx = 14.4375_8 * (x ** 6) - 19.6875_8 * (x ** 4) + & - 6.5625_8 * x * x - 0.3125_8 - case(7) - pnx = 26.8125_8 * (x ** 7) - 43.3125_8 * (x ** 5) + & - 19.6875_8 * x * x * x - 2.1875_8 * x - case(8) - pnx = 50.2734375_8 * (x ** 8) - 93.84375_8 * (x ** 6) + & - 54.140625 * (x ** 4) - 9.84375_8 * x * x + 0.2734375_8 - case(9) - pnx = 94.9609375_8 * (x ** 9) - 201.09375_8 * (x ** 7) + & - 140.765625_8 * (x ** 5) - 36.09375_8 * x * x * x + 2.4609375_8 * x - case(10) - pnx = 180.42578125_8 * (x ** 10) - 427.32421875_8 * (x ** 8) + & - 351.9140625_8 * (x ** 6) - 117.3046875_8 * (x ** 4) + & - 13.53515625_8 * x * x - 0.24609375_8 - case default - pnx = ONE ! correct for case(0), incorrect for the rest - end select + pnx = calc_pn_cc(n, x) end function calc_pn +!=============================================================================== +! EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients +! and the value of x +!=============================================================================== + + pure function evaluate_legendre(n, data, x) result(val) bind(C) + integer(C_INT), intent(in) :: n + real(C_DOUBLE), intent(in) :: data(n) + real(C_DOUBLE), intent(in) :: x + real(C_DOUBLE) :: val + + val = evaluate_legendre_cc(size(data), data, x) + + end function evaluate_legendre + !=============================================================================== ! CALC_RN calculates the n-th order real spherical harmonics for a given angle ! (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) @@ -202,387 +188,7 @@ contains ! assumed to be on unit sphere real(C_DOUBLE) :: rn(2*n + 1) ! The resultant R_n(uvw) - - real(C_DOUBLE) :: phi, w ! Azimuthal and Cosine of Polar angles (from uvw) - real(C_DOUBLE) :: w2m1 ! (w^2 - 1), frequently used in these - - w = uvw(3) ! z = cos(polar) - if (uvw(1) == ZERO) then - phi = ZERO - else - phi = atan2(uvw(2), uvw(1)) - end if - - w2m1 = (ONE - w**2) - select case(n) - case (0) - ! l = 0, m = 0 - rn(1) = ONE - case (1) - ! l = 1, m = -1 - rn(1) = -(ONE*sqrt(w2m1) * sin(phi)) - ! l = 1, m = 0 - rn(2) = ONE * w - ! l = 1, m = 1 - rn(3) = -(ONE*sqrt(w2m1) * cos(phi)) - case (2) - ! l = 2, m = -2 - rn(1) = 0.288675134594813_8 * (-THREE * w**2 + THREE) * sin(TWO*phi) - ! l = 2, m = -1 - rn(2) = -(1.73205080756888_8 * w*sqrt(w2m1) * sin(phi)) - ! l = 2, m = 0 - rn(3) = 1.5_8 * w**2 - HALF - ! l = 2, m = 1 - rn(4) = -(1.73205080756888_8 * w*sqrt(w2m1) * cos(phi)) - ! l = 2, m = 2 - rn(5) = 0.288675134594813_8 * (-THREE * w**2 + THREE) * cos(TWO*phi) - case (3) - ! l = 3, m = -3 - rn(1) = -(0.790569415042095_8 * (w2m1)**(THREE/TWO) * sin(THREE * phi)) - ! l = 3, m = -2 - rn(2) = 1.93649167310371_8 * w*(w2m1) * sin(TWO*phi) - ! l = 3, m = -1 - rn(3) = -(0.408248290463863_8*sqrt(w2m1)*((15.0_8/TWO)*w**2 - THREE/TWO) * & - sin(phi)) - ! l = 3, m = 0 - rn(4) = 2.5_8 * w**3 - 1.5_8 * w - ! l = 3, m = 1 - rn(5) = -(0.408248290463863_8*sqrt(w2m1)*((15.0_8/TWO)*w**2 - THREE/TWO) * & - cos(phi)) - ! l = 3, m = 2 - rn(6) = 1.93649167310371_8 * w*(w2m1) * cos(TWO*phi) - ! l = 3, m = 3 - rn(7) = -(0.790569415042095_8 * (w2m1)**(THREE/TWO) * cos(THREE* phi)) - case (4) - ! l = 4, m = -4 - rn(1) = 0.739509972887452_8 * (w2m1)**2 * sin(4.0_8*phi) - ! l = 4, m = -3 - rn(2) = -(2.09165006633519_8 * w*(w2m1)**(THREE/TWO) * sin(THREE* phi)) - ! l = 4, m = -2 - rn(3) = 0.074535599249993_8 * (w2m1)*((105.0_8/TWO)*w**2 - 15.0_8/TWO) * & - sin(TWO*phi) - ! l = 4, m = -1 - rn(4) = -(0.316227766016838_8*sqrt(w2m1)*((35.0_8/TWO)*w**3 - 15.0_8/TWO*w)& - * sin(phi)) - ! l = 4, m = 0 - rn(5) = 4.375_8 * w**4 - 3.75_8 * w**2 + 0.375_8 - ! l = 4, m = 1 - rn(6) = -(0.316227766016838_8*sqrt(w2m1)*((35.0_8/TWO)*w**3 - 15.0_8/TWO*w)& - * cos(phi)) - ! l = 4, m = 2 - rn(7) = 0.074535599249993_8 * (w2m1)*((105.0_8/TWO)*w**2 - 15.0_8/TWO) * & - cos(TWO*phi) - ! l = 4, m = 3 - rn(8) = -(2.09165006633519_8 * w*(w2m1)**(THREE/TWO) * cos(THREE* phi)) - ! l = 4, m = 4 - rn(9) = 0.739509972887452_8 * (w2m1)**2 * cos(4.0_8*phi) - case (5) - ! l = 5, m = -5 - rn(1) = -(0.701560760020114_8 * (w2m1)**(5.0_8/TWO) * sin(5.0_8*phi)) - ! l = 5, m = -4 - rn(2) = 2.21852991866236_8 * w*(w2m1)**2 * sin(4.0_8*phi) - ! l = 5, m = -3 - rn(3) = -(0.00996023841111995_8 * (w2m1)**(THREE/TWO)* & - ((945.0_8 /TWO)*w**2 - 105.0_8/TWO) * sin(THREE*phi)) - ! l = 5, m = -2 - rn(4) = 0.0487950036474267_8 * (w2m1) & - * ((315.0_8/TWO)*w**3 - 105.0_8/TWO*w) * sin(TWO*phi) - ! l = 5, m = -1 - rn(5) = -(0.258198889747161_8*sqrt(w2m1)* & - ((315.0_8/8.0_8)*w**4 - 105.0_8/4.0_8 * w**2 + 15.0_8/8.0_8) & - * sin(phi)) - ! l = 5, m = 0 - rn(6) = 7.875_8 * w**5 - 8.75_8 * w**3 + 1.875_8 * w - ! l = 5, m = 1 - rn(7) = -(0.258198889747161_8*sqrt(w2m1)* & - ((315.0_8/8.0_8)*w**4 - 105.0_8/4.0_8 * w**2 + 15.0_8/8.0_8) & - * cos(phi)) - ! l = 5, m = 2 - rn(8) = 0.0487950036474267_8 * (w2m1)* & - ((315.0_8/TWO)*w**3 - 105.0_8/TWO*w) * cos(TWO*phi) - ! l = 5, m = 3 - rn(9) = -(0.00996023841111995_8 * (w2m1)**(THREE/TWO)* & - ((945.0_8 /TWO)*w**2 - 105.0_8/TWO) * cos(THREE*phi)) - ! l = 5, m = 4 - rn(10) = 2.21852991866236_8 * w*(w2m1)**2 * cos(4.0_8*phi) - ! l = 5, m = 5 - rn(11) = -(0.701560760020114_8 * (w2m1)**(5.0_8/TWO) * cos(5.0_8* phi)) - case (6) - ! l = 6, m = -6 - rn(1) = 0.671693289381396_8 * (w2m1)**3 * sin(6.0_8*phi) - ! l = 6, m = -5 - rn(2) = -(2.32681380862329_8 * w*(w2m1)**(5.0_8/TWO) * sin(5.0_8*phi)) - ! l = 6, m = -4 - rn(3) = 0.00104990131391452_8 * (w2m1)**2 * & - ((10395.0_8/TWO)*w**2 - 945.0_8/TWO) * sin(4.0_8*phi) - ! l = 6, m = -3 - rn(4) = -(0.00575054632785295_8 * (w2m1)**(THREE/TWO) * & - ((3465.0_8/TWO)*w**3 - 945.0_8/TWO*w) * sin(THREE*phi)) - ! l = 6, m = -2 - rn(5) = 0.0345032779671177_8 * (w2m1) * & - ((3465.0_8/8.0_8)*w**4 - 945.0_8/4.0_8 * w**2 + 105.0_8/8.0_8) & - * sin(TWO*phi) - ! l = 6, m = -1 - rn(6) = -(0.218217890235992_8*sqrt(w2m1) * & - ((693.0_8/8.0_8)*w**5- 315.0_8/4.0_8 * w**3 + (105.0_8/8.0_8)*w) & - * sin(phi)) - ! l = 6, m = 0 - rn(7) = 14.4375_8 * w**6 - 19.6875_8 * w**4 + 6.5625_8 * w**2 - 0.3125_8 - ! l = 6, m = 1 - rn(8) = -(0.218217890235992_8*sqrt(w2m1) * & - ((693.0_8/8.0_8)*w**5- 315.0_8/4.0_8 * w**3 + (105.0_8/8.0_8)*w) & - * cos(phi)) - ! l = 6, m = 2 - rn(9) = 0.0345032779671177_8 * (w2m1) * & - ((3465.0_8/8.0_8)*w**4 -945.0_8/4.0_8 * w**2 + 105.0_8/8.0_8) & - * cos(TWO*phi) - ! l = 6, m = 3 - rn(10) = -(0.00575054632785295_8 * (w2m1)**(THREE/TWO) * & - ((3465.0_8/TWO)*w**3 - 945.0_8/TWO*w) * cos(THREE*phi)) - ! l = 6, m = 4 - rn(11) = 0.00104990131391452_8 * (w2m1)**2 * & - ((10395.0_8/TWO)*w**2 - 945.0_8/TWO) * cos(4.0_8*phi) - ! l = 6, m = 5 - rn(12) = -(2.32681380862329_8 * w*(w2m1)**(5.0_8/TWO) * cos(5.0_8*phi)) - ! l = 6, m = 6 - rn(13) = 0.671693289381396_8 * (w2m1)**3 * cos(6.0_8*phi) - case (7) - ! l = 7, m = -7 - rn(1) = -(0.647259849287749_8 * (w2m1)**(7.0_8/TWO) * sin(7.0_8*phi)) - ! l = 7, m = -6 - rn(2) = 2.42182459624969_8 * w*(w2m1)**3 * sin(6.0_8*phi) - ! l = 7, m = -5 - rn(3) = -(9.13821798555235d-5*(w2m1)**(5.0_8/TWO)* & - ((135135.0_8/TWO)*w**2 - 10395.0_8/TWO) * sin(5.0_8*phi)) - ! l = 7, m = -4 - rn(4) = 0.000548293079133141_8 * (w2m1)**2* & - ((45045.0_8/TWO)*w**3 - 10395.0_8/TWO*w) * sin(4.0_8*phi) - ! l = 7, m = -3 - rn(5) = -(0.00363696483726654_8 * (w2m1)**(THREE/TWO)* & - ((45045.0_8/8.0_8)*w**4 - 10395.0_8/4.0_8 * w**2 + 945.0_8/8.0_8)* & - sin(THREE*phi)) - ! l = 7, m = -2 - rn(6) = 0.025717224993682_8 * (w2m1)* & - ((9009.0_8/8.0_8)*w**5 -3465.0_8/4.0_8 * w**3 + (945.0_8/8.0_8)*w)* & - sin(TWO*phi) - ! l = 7, m = -1 - rn(7) = -(0.188982236504614_8*sqrt(w2m1)* & - ((3003.0_8/16.0_8)*w**6 - 3465.0_8/16.0_8 * w**4 + & - (945.0_8/16.0_8)*w**2 - 35.0_8/16.0_8) * sin(phi)) - ! l = 7, m = 0 - rn(8) = 26.8125_8 * w**7 - 43.3125_8 * w**5 + 19.6875_8 * w**3 -2.1875_8 & - * w - ! l = 7, m = 1 - rn(9) = -(0.188982236504614_8*sqrt(w2m1)* & - ((3003.0_8/16.0_8)*w**6 - 3465.0_8/16.0_8 * w**4 + & - (945.0_8/16.0_8)*w**2 - 35.0_8/16.0_8) * cos(phi)) - ! l = 7, m = 2 - rn(10) = 0.025717224993682_8 * (w2m1)* & - ((9009.0_8/8.0_8)*w**5 -3465.0_8/4.0_8 * w**3 + (945.0_8/8.0_8)*w)* & - cos(TWO*phi) - ! l = 7, m = 3 - rn(11) = -(0.00363696483726654_8 * (w2m1)**(THREE/TWO)* & - ((45045.0_8/8.0_8)*w**4 - 10395.0_8/4.0_8 * w**2 + 945.0_8/8.0_8)* & - cos(THREE*phi)) - ! l = 7, m = 4 - rn(12) = 0.000548293079133141_8 * (w2m1)**2 * & - ((45045.0_8/TWO)*w**3 - 10395.0_8/TWO*w) * cos(4.0_8*phi) - ! l = 7, m = 5 - rn(13) = -(9.13821798555235d-5*(w2m1)**(5.0_8/TWO)* & - ((135135.0_8/TWO)*w**2 - 10395.0_8/TWO) * cos(5.0_8*phi)) - ! l = 7, m = 6 - rn(14) = 2.42182459624969_8 * w*(w2m1)**3 * cos(6.0_8*phi) - ! l = 7, m = 7 - rn(15) = -(0.647259849287749_8 * (w2m1)**(7.0_8/TWO) * cos(7.0_8*phi)) - case (8) - ! l = 8, m = -8 - rn(1) = 0.626706654240044_8 * (w2m1)**4 * sin(8.0_8*phi) - ! l = 8, m = -7 - rn(2) = -(2.50682661696018_8 * w*(w2m1)**(7.0_8/TWO) * sin(7.0_8*phi)) - ! l = 8, m = -6 - rn(3) = 6.77369783729086d-6*(w2m1)**3* & - ((2027025.0_8/TWO)*w**2 - 135135.0_8/TWO) * sin(6.0_8*phi) - ! l = 8, m = -5 - rn(4) = -(4.38985792528482d-5*(w2m1)**(5.0_8/TWO)* & - ((675675.0_8/TWO)*w**3 - 135135.0_8/TWO*w) * sin(5.0_8*phi)) - ! l = 8, m = -4 - rn(5) = 0.000316557156832328_8 * (w2m1)**2* & - ((675675.0_8/8.0_8)*w**4 - 135135.0_8/4.0_8 * w**2 & - + 10395.0_8/8.0_8) * sin(4.0_8*phi) - ! l = 8, m = -3 - rn(6) = -(0.00245204119306875_8 * (w2m1)**(THREE/TWO)* & - ((135135.0_8/8.0_8)*w**5 - 45045.0_8/4.0_8 * w**3 & - + (10395.0_8/8.0_8)*w) * sin(THREE*phi)) - ! l = 8, m = -2 - rn(7) = 0.0199204768222399_8 * (w2m1)* & - ((45045.0_8/16.0_8)*w**6- 45045.0_8/16.0_8 * w**4 + & - (10395.0_8/16.0_8)*w**2 - 315.0_8/16.0_8) * sin(TWO*phi) - ! l = 8, m = -1 - rn(8) = -(0.166666666666667_8*sqrt(w2m1)* & - ((6435.0_8/16.0_8)*w**7 - 9009.0_8/16.0_8 * w**5 + & - (3465.0_8/16.0_8)*w**3 - 315.0_8/16.0_8 * w) * sin(phi)) - ! l = 8, m = 0 - rn(9) = 50.2734375_8 * w**8 - 93.84375_8 * w**6 + 54.140625_8 * w**4 -& - 9.84375_8 * w**2 + 0.2734375_8 - ! l = 8, m = 1 - rn(10) = -(0.166666666666667_8*sqrt(w2m1)* & - ((6435.0_8/16.0_8)*w**7 - 9009.0_8/16.0_8 * w**5 + & - (3465.0_8/16.0_8)*w**3 - 315.0_8/16.0_8 * w) * cos(phi)) - ! l = 8, m = 2 - rn(11) = 0.0199204768222399_8 * (w2m1)*((45045.0_8/16.0_8)*w**6- & - 45045.0_8/16.0_8 * w**4 + (10395.0_8/16.0_8)*w**2 - & - 315.0_8/16.0_8) * cos(TWO*phi) - ! l = 8, m = 3 - rn(12) = -(0.00245204119306875_8 * (w2m1)**(THREE/TWO)* & - ((135135.0_8/8.0_8)*w**5 - 45045.0_8/4.0_8 * w**3 + & - (10395.0_8/8.0_8)*w) * cos(THREE*phi)) - ! l = 8, m = 4 - rn(13) = 0.000316557156832328_8 * (w2m1)**2*((675675.0_8/8.0_8)*w**4 - & - 135135.0_8/4.0_8 * w**2 + 10395.0_8/8.0_8) * cos(4.0_8*phi) - ! l = 8, m = 5 - rn(14) = -(4.38985792528482d-5*(w2m1)**(5.0_8/TWO)*((675675.0_8/TWO)*w**3 -& - 135135.0_8/TWO*w) * cos(5.0_8*phi)) - ! l = 8, m = 6 - rn(15) = 6.77369783729086d-6*(w2m1)**3*((2027025.0_8/TWO)*w**2 - & - 135135.0_8/TWO) * cos(6.0_8*phi) - ! l = 8, m = 7 - rn(16) = -(2.50682661696018_8 * w*(w2m1)**(7.0_8/TWO) * cos(7.0_8*phi)) - ! l = 8, m = 8 - rn(17) = 0.626706654240044_8 * (w2m1)**4 * cos(8.0_8*phi) - case (9) - ! l = 9, m = -9 - rn(1) = -(0.609049392175524_8 * (w2m1)**(9.0_8/TWO) * sin(9.0_8*phi)) - ! l = 9, m = -8 - rn(2) = 2.58397773170915_8 * w*(w2m1)**4 * sin(8.0_8*phi) - ! l = 9, m = -7 - rn(3) = -(4.37240315267812d-7*(w2m1)**(7.0_8/TWO)* & - ((34459425.0_8/TWO)*w**2 - 2027025.0_8/TWO) * sin(7.0_8*phi)) - ! l = 9, m = -6 - rn(4) = 3.02928976464514d-6*(w2m1)**3* & - ((11486475.0_8/TWO)*w**3 - 2027025.0_8/TWO*w) * sin(6.0_8*phi) - ! l = 9, m = -5 - rn(5) = -(2.34647776186144d-5*(w2m1)**(5.0_8/TWO)* & - ((11486475.0_8/8.0_8)*w**4 - 2027025.0_8/4.0_8 * w**2 + & - 135135.0_8/8.0_8) * sin(5.0_8*phi)) - ! l = 9, m = -4 - rn(6) = 0.000196320414650061_8 * (w2m1)**2*((2297295.0_8/8.0_8)*w**5 - & - 675675.0_8/4.0_8 * w**3 + (135135.0_8/8.0_8)*w) * sin(4.0_8*phi) - ! l = 9, m = -3 - rn(7) = -(0.00173385495536766_8 * (w2m1)**(THREE/TWO)* & - ((765765.0_8/16.0_8)*w**6 - 675675.0_8/16.0_8 * w**4 + & - (135135.0_8/16.0_8)*w**2 - 3465.0_8/16.0_8) * sin(THREE*phi)) - ! l = 9, m = -2 - rn(8) = 0.0158910431540932_8 * (w2m1)*((109395.0_8/16.0_8)*w**7- & - 135135.0_8/16.0_8 * w**5 + (45045.0_8/16.0_8)*w**3 & - - 3465.0_8/16.0_8 * w) * sin(TWO*phi) - ! l = 9, m = -1 - rn(9) = -(0.149071198499986_8*sqrt(w2m1)*((109395.0_8/128.0_8)*w**8 - & - 45045.0_8/32.0_8 * w**6 + (45045.0_8/64.0_8)*w**4 - 3465.0_8/32.0_8 & - * w**2 + 315.0_8/128.0_8) * sin(phi)) - ! l = 9, m = 0 - rn(10) = 94.9609375_8 * w**9 - 201.09375_8 * w**7 + 140.765625_8 * w**5- & - 36.09375_8 * w**3 + 2.4609375_8 * w - ! l = 9, m = 1 - rn(11) = -(0.149071198499986_8*sqrt(w2m1)*((109395.0_8/128.0_8)*w**8 - & - 45045.0_8/32.0_8 * w**6 + (45045.0_8/64.0_8)*w**4 -3465.0_8/32.0_8 & - * w**2 + 315.0_8/128.0_8) * cos(phi)) - ! l = 9, m = 2 - rn(12) = 0.0158910431540932_8 * (w2m1)*((109395.0_8/16.0_8)*w**7 - & - 135135.0_8/16.0_8 * w**5 + (45045.0_8/16.0_8)*w**3 & - - 3465.0_8/ 16.0_8 * w) * cos(TWO*phi) - ! l = 9, m = 3 - rn(13) = -(0.00173385495536766_8 * (w2m1)**(THREE/TWO)*((765765.0_8/16.0_8)& - *w**6 - 675675.0_8/16.0_8 * w**4 + (135135.0_8/16.0_8)*w**2 & - - 3465.0_8/16.0_8)* cos(THREE*phi)) - ! l = 9, m = 4 - rn(14) = 0.000196320414650061_8 * (w2m1)**2*((2297295.0_8/8.0_8)*w**5 - & - 675675.0_8/4.0_8 * w**3 + (135135.0_8/8.0_8)*w) * cos(4.0_8*phi) - ! l = 9, m = 5 - rn(15) = -(2.34647776186144d-5*(w2m1)**(5.0_8/TWO)*((11486475.0_8/8.0_8)* & - w**4 - 2027025.0_8/4.0_8 * w**2 + 135135.0_8/8.0_8) * cos(5.0_8*phi)) - ! l = 9, m = 6 - rn(16) = 3.02928976464514d-6*(w2m1)**3*((11486475.0_8/TWO)*w**3 - & - 2027025.0_8/TWO*w) * cos(6.0_8*phi) - ! l = 9, m = 7 - rn(17) = -(4.37240315267812d-7*(w2m1)**(7.0_8/TWO)* & - ((34459425.0_8/TWO)*w**2 - 2027025.0_8/TWO) * cos(7.0_8*phi)) - ! l = 9, m = 8 - rn(18) = 2.58397773170915_8 * w*(w2m1)**4 * cos(8.0_8*phi) - ! l = 9, m = 9 - rn(19) = -(0.609049392175524_8 * (w2m1)**(9.0_8/TWO) * cos(9.0_8*phi)) - case (10) - ! l = 10, m = -10 - rn(1) = 0.593627917136573_8 * (w2m1)**5 * sin(10.0_8*phi) - ! l = 10, m = -9 - rn(2) = -(2.65478475211798_8 * w*(w2m1)**(9.0_8/TWO) * sin(9.0_8*phi)) - ! l = 10, m = -8 - rn(3) = 2.49953651452314d-8*(w2m1)**4*((654729075.0_8/TWO)*w**2 - & - 34459425.0_8/TWO) * sin(8.0_8*phi) - ! l = 10, m = -7 - rn(4) = -(1.83677671621093d-7*(w2m1)**(7.0_8/TWO)* & - ((218243025.0_8/TWO)*w**3 - 34459425.0_8/TWO*w) * sin(7.0_8*phi)) - ! l = 10, m = -6 - rn(5) = 1.51464488232257d-6*(w2m1)**3*((218243025.0_8/8.0_8)*w**4 - & - 34459425.0_8/4.0_8 * w**2 + 2027025.0_8/8.0_8) * sin(6.0_8*phi) - ! l = 10, m = -5 - rn(6) = -(1.35473956745817d-5*(w2m1)**(5.0_8/TWO)* & - ((43648605.0_8/8.0_8)*w**5 - 11486475.0_8/4.0_8 * w**3 + & - (2027025.0_8/8.0_8)*w) * sin(5.0_8*phi)) - ! l = 10, m = -4 - rn(7) = 0.000128521880085575_8 * (w2m1)**2*((14549535.0_8/16.0_8)*w**6 - & - 11486475.0_8/16.0_8 * w**4 + (2027025.0_8/16.0_8)*w**2 - & - 45045.0_8/16.0_8) * sin(4.0_8*phi) - ! l = 10, m = -3 - rn(8) = -(0.00127230170115096_8 * (w2m1)**(THREE/TWO)* & - ((2078505.0_8/16.0_8)*w**7 - 2297295.0_8/16.0_8 * w**5 + & - (675675.0_8/16.0_8)*w**3 - 45045.0_8/16.0_8 * w) * sin(THREE*phi)) - ! l = 10, m = -2 - rn(9) = 0.012974982402692_8 * (w2m1)*((2078505.0_8/128.0_8)*w**8 - & - 765765.0_8/32.0_8 * w**6 + (675675.0_8/64.0_8)*w**4 - & - 45045.0_8/32.0_8 * w**2 + 3465.0_8/128.0_8) * sin(TWO*phi) - ! l = 10, m = -1 - rn(10) = -(0.134839972492648_8*sqrt(w2m1)*((230945.0_8/128.0_8)*w**9 - & - 109395.0_8/32.0_8 * w**7 + (135135.0_8/64.0_8)*w**5 - & - 15015.0_8/32.0_8 * w**3 + (3465.0_8/128.0_8)*w) * sin(phi)) - ! l = 10, m = 0 - rn(11) = 180.42578125_8 * w**10 - 427.32421875_8 * w**8 +351.9140625_8 & - * w**6 - 117.3046875_8 * w**4 + 13.53515625_8 * w**2 -0.24609375_8 - ! l = 10, m = 1 - rn(12) = -(0.134839972492648_8*sqrt(w2m1)*((230945.0_8/128.0_8)*w**9 - & - 109395.0_8/32.0_8 * w**7 + (135135.0_8/64.0_8)*w**5 -15015.0_8/ & - 32.0_8 * w**3 + (3465.0_8/128.0_8)*w) * cos(phi)) - ! l = 10, m = 2 - rn(13) = 0.012974982402692_8 * (w2m1)*((2078505.0_8/128.0_8)*w**8 - & - 765765.0_8/32.0_8 * w**6 + (675675.0_8/64.0_8)*w**4 -& - 45045.0_8/32.0_8 * w**2 + 3465.0_8/128.0_8) * cos(TWO*phi) - ! l = 10, m = 3 - rn(14) = -(0.00127230170115096_8 * (w2m1)**(THREE/TWO)* & - ((2078505.0_8/16.0_8)*w**7 - 2297295.0_8/16.0_8 * w**5 + & - (675675.0_8/16.0_8)*w**3 - 45045.0_8/16.0_8 * w) * cos(THREE*phi)) - ! l = 10, m = 4 - rn(15) = 0.000128521880085575_8 * (w2m1)**2*((14549535.0_8/16.0_8)*w**6 -& - 11486475.0_8/16.0_8 * w**4 + (2027025.0_8/16.0_8)*w**2 - & - 45045.0_8/16.0_8) * cos(4.0_8*phi) - ! l = 10, m = 5 - rn(16) = -(1.35473956745817d-5*(w2m1)**(5.0_8/TWO)* & - ((43648605.0_8/8.0_8)*w**5 - 11486475.0_8/4.0_8 * w**3 + & - (2027025.0_8/8.0_8)*w) * cos(5.0_8*phi)) - ! l = 10, m = 6 - rn(17) = 1.51464488232257d-6*(w2m1)**3*((218243025.0_8/8.0_8)*w**4 - & - 34459425.0_8/4.0_8 * w**2 + 2027025.0_8/8.0_8) * cos(6.0_8*phi) - ! l = 10, m = 7 - rn(18) = -(1.83677671621093d-7*(w2m1)**(7.0_8/TWO)* & - ((218243025.0_8/TWO)*w**3 - 34459425.0_8/TWO*w) * cos(7.0_8*phi)) - ! l = 10, m = 8 - rn(19) = 2.49953651452314d-8*(w2m1)**4* & - ((654729075.0_8/TWO)*w**2 - 34459425.0_8/TWO) * cos(8.0_8*phi) - ! l = 10, m = 9 - rn(20) = -(2.65478475211798_8 * w*(w2m1)**(9.0_8/TWO) * cos(9.0_8*phi)) - ! l = 10, m = 10 - rn(21) = 0.593627917136573_8 * (w2m1)**5 * cos(10.0_8*phi) - case default - rn = ONE - end select + call calc_rn_cc(n, uvw, rn) end subroutine calc_rn @@ -693,26 +299,6 @@ contains end do end subroutine calc_zn -!=============================================================================== -! EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients -! and the value of x -!=============================================================================== - - pure function evaluate_legendre(n, data, x) result(val) bind(C) - integer(C_INT), intent(in) :: n - real(C_DOUBLE), intent(in) :: data(n) - real(C_DOUBLE), intent(in) :: x - real(C_DOUBLE) :: val - - integer(C_INT) :: l - - val = HALF * data(1) - do l = 1, n - 1 - val = val + (real(l, 8) + HALF) * data(l + 1) * calc_pn(l,x) - end do - - end function evaluate_legendre - !=============================================================================== ! ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is ! mu and through an azimuthal angle sampled uniformly. Note that this is done diff --git a/src/math_functions.cpp b/src/math_functions.cpp index 3b645c772..6ddf944a7 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -161,6 +161,22 @@ double __attribute__ ((const)) calc_pn_c(int n, double x) { return pnx; } +//============================================================================== +// EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients +// and the value of x +//============================================================================== + +double __attribute__ ((const)) evaluate_legendre_c(int n, double data[], + double x) { + double val; + + val = 0.5 * data[0]; + for (int l = 1; l < n; l++) { + val += (static_cast(l) + 0.5) * data[l] * calc_pn_c(l, x); + } + return val; +} + //============================================================================== // CALC_RN calculates the n-th order spherical harmonics for a given angle // (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) @@ -561,21 +577,6 @@ void calc_rn_c(int n, double uvw[3], double rn[]){ } } -//============================================================================== -// EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients -// and the value of x -//============================================================================== - -double __attribute__ ((const)) evaluate_legendre_c(int n, double data[], - double x) { - double val; - - val = 0.5 * data[0]; - for (int l = 1; l < n; l++) { - val += (static_cast(l) + 0.5) * data[l] * calc_pn_c(l, x); - } - -} //============================================================================== // ROTATE_ANGLE rotates direction std::cosines through a polar angle whose diff --git a/src/math_functions.h b/src/math_functions.h index aa048e5f6..bea30cf91 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -32,13 +32,6 @@ extern "C" double t_percentile_c(double p, int df) __attribute__ ((const)); extern "C" double calc_pn_c(int n, double x) __attribute__ ((const)); -//============================================================================== -// CALC_RN calculates the n-th order spherical harmonics for a given angle -// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) -//============================================================================== - -extern "C" void calc_rn_c(int n, double uvw[3], double rn[]); - //============================================================================== // EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients // and the value of x @@ -47,6 +40,13 @@ extern "C" void calc_rn_c(int n, double uvw[3], double rn[]); extern "C" double evaluate_legendre_c(int n, double data[], double x) __attribute__ ((const)); +//============================================================================== +// CALC_RN calculates the n-th order spherical harmonics for a given angle +// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) +//============================================================================== + +extern "C" void calc_rn_c(int n, double uvw[3], double rn[]); + //============================================================================== // ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is // mu and through an azimuthal angle sampled uniformly. Note that this is done diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py index 98295aefb..c8d33e601 100644 --- a/tests/unit_tests/test_math.py +++ b/tests/unit_tests/test_math.py @@ -51,6 +51,25 @@ def test_calc_pn(): assert np.allclose(ref_vals, test_vals) +def test_evaluate_legendre(): + max_order = 10 + # Coefficients are set to 1, but will incorporate the (2l+1)/2 norm factor + # for the reference solution + test_coeffs = [0.5 * (2. * l + 1.) for l in range(max_order + 1)] + test_xs = np.linspace(-1., 1., num=5, endpoint=True) + + ref_vals = np.polynomial.legendre.legval(test_xs, test_coeffs) + + # Set the coefficients back to 1s for the test values since + # evaluate legendre includes the (2l+1)/2 term + test_coeffs = [1. for l in range(max_order + 1)] + + test_vals = np.array([openmc.capi.math.evaluate_legendre(test_coeffs, x) + for x in test_xs]) + + assert np.allclose(ref_vals, test_vals) + + def test_calc_rn(): max_order = 10 test_ns = np.array([i for i in range(0, max_order + 1)]) @@ -99,23 +118,6 @@ def test_calc_zn(): pass -def test_evaluate_legendre(): - max_order = 10 - # Coefficients are set to 1, but will incorporate the (2l+1)/2 norm factor - # for the reference solution - test_coeffs = [0.5 * (2. * l + 1.) for l in range(max_order + 1)] - test_xs = np.linspace(-1., 1., num=5, endpoint=True) - - ref_vals = np.polynomial.legendre.legval(test_xs, test_coeffs) - - # Set the coefficients back to 1s for the test values - test_coeffs = [1. for l in range(max_order + 1)] - test_vals = np.array([openmc.capi.math.evaluate_legendre(test_coeffs, x) - for x in test_xs]) - - assert np.allclose(ref_vals, test_vals) - - def test_rotate_angle(): uvw0 = np.array([1., 0., 0.]) phi = 0. From feecf0134eda55b9cac11107c55ef46c7450ac4f Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Sun, 6 May 2018 11:28:05 -0400 Subject: [PATCH 06/15] Incorporated maxwell and watt_spectrum C++ code, tests pass --- src/math.F90 | 18 ++---------------- src/math_functions.cpp | 12 ++++++------ src/math_functions.h | 4 ++++ tests/unit_tests/test_math.py | 8 ++++---- 4 files changed, 16 insertions(+), 26 deletions(-) diff --git a/src/math.F90 b/src/math.F90 index 6534b66b0..d7e335284 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -364,18 +364,7 @@ contains real(C_DOUBLE), intent(in) :: T ! tabulated function of incoming E real(C_DOUBLE) :: E_out ! sampled energy - real(C_DOUBLE) :: r1, r2, r3 ! random numbers - real(C_DOUBLE) :: c ! cosine of pi/2*r3 - - r1 = prn() - r2 = prn() - r3 = prn() - - ! determine cosine of pi/2*r - c = cos(PI/TWO*r3) - - ! determine outgoing energy - E_out = -T*(log(r1) + log(r2)*c*c) + E_out = maxwell_spectrum_cc(T) end function maxwell_spectrum @@ -393,10 +382,7 @@ contains real(C_DOUBLE), intent(in) :: b ! Watt parameter b real(C_DOUBLE) :: E_out ! energy of emitted neutron - real(C_DOUBLE) :: w ! sampled from Maxwellian - - w = maxwell_spectrum(a) - E_out = w + a*a*b/4. + (TWO*prn() - ONE)*sqrt(a*a*b*w) + E_out = watt_spectrum_cc(a, b) end function watt_spectrum diff --git a/src/math_functions.cpp b/src/math_functions.cpp index 6ddf944a7..1466bde54 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -56,7 +56,7 @@ double __attribute__ ((const)) normal_percentile_c(double p) { // Refinement based on Newton's method - z = z - (0.5 * std::erfc(-z / std::sqrt(2.0)) - p) * std::sqrt(2.0 * M_PI) * + z = z - (0.5 * std::erfc(-z / std::sqrt(2.0)) - p) * std::sqrt(2.0 * PI) * std::exp(0.5 * z * z); return z; @@ -82,7 +82,7 @@ double __attribute__ ((const)) t_percentile_c(double p, int df){ // For one degree of freedom, the t-distribution becomes a Cauchy // distribution whose cdf we can invert directly - t = std::tan(M_PI*(p - 0.5)); + t = std::tan(PI*(p - 0.5)); } else if (df == 2) { // For two degrees of freedom, the cdf is given by 1/2 + x/(2*sqrt(x^2 + // 2)). This can be directly inverted to yield the solution below @@ -604,7 +604,7 @@ void rotate_angle_c(double uvw[3], double mu, double phi) { if (phi != -10.) { phi_ = phi; } else { - phi_ = 2. * M_PI * prn(); + phi_ = 2. * PI * prn(); } // Precompute factors to save flops @@ -647,7 +647,7 @@ double maxwell_spectrum_c(double T) { r3 = prn(); // determine cosine of pi/2*r - c = std::cos(M_PI / 2. * r3); + c = std::cos(PI / 2. * r3); // determine outgoing energy E_out = -T * (std::log(r1) + std::log(r2) * c * c); @@ -710,7 +710,7 @@ double watt_spectrum_c(double a, double b) { // std::complex w_derivative_c(std::complex z, int order){ // std::complex wv; // The resultant w(z) value -// const std::complex twoi_sqrtpi(0.0, 2.0 / std::sqrt(M_PI)); +// const std::complex twoi_sqrtpi(0.0, 2.0 / std::sqrt(PI)); // switch(order) { // case 0: @@ -764,7 +764,7 @@ void broaden_wmp_polynomials_c(double E, double dopp, int n, double factors[]) { factors[0] = erf_beta / E; factors[1] = 1. / sqrtE; factors[2] = factors[0] * (half_inv_dopp2 + E) + exp_m_beta2 / - (beta * std::sqrt(M_PI)); + (beta * std::sqrt(PI)); // Perform recursive broadening of high order components for (i = 0; i < n - 3; i++) { diff --git a/src/math_functions.h b/src/math_functions.h index bea30cf91..aaba08261 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -11,6 +11,10 @@ namespace openmc { +// TODO: cmath::M_PI has 3 more digits precision than the Fortran constant we +// use so for now we will reuse the Fortran constant until we are OK with +// modifying test results +const double PI = 3.1415926535898; //============================================================================== // NORMAL_PERCENTILE calculates the percentile of the standard normal diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py index c8d33e601..bfa021ceb 100644 --- a/tests/unit_tests/test_math.py +++ b/tests/unit_tests/test_math.py @@ -147,8 +147,8 @@ def test_maxwell_spectrum(): T = 0.5 ref_val = 0.6129982175261098 test_val = openmc.capi.math.maxwell_spectrum(T) - print(test_val) - assert np.isclose(ref_val, test_val) + + assert ref_val == test_val def test_watt_spectrum(): @@ -158,8 +158,8 @@ def test_watt_spectrum(): b = 0.75 ref_val = 0.6247242713640233 test_val = openmc.capi.math.watt_spectrum(a, b) - print(test_val) - assert np.isclose(ref_val, test_val) + + assert ref_val == test_val def test_broaden_wmp_polynomials(): From 468126f8c4f3a74e915aba1ddba6f14cc37dfecb Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Sun, 6 May 2018 20:14:54 -0400 Subject: [PATCH 07/15] Added in Zernike polynomials to C++ code --- openmc/capi/math.py | 8 +- src/faddeeva/Faddeeva.h | 8 +- src/math.F90 | 162 ++++++---------------------------- src/math_functions.cpp | 135 ++++++++++++++++++++++++++-- src/math_functions.h | 20 +++-- tests/unit_tests/test_math.py | 39 +++++++- 6 files changed, 211 insertions(+), 161 deletions(-) diff --git a/openmc/capi/math.py b/openmc/capi/math.py index cd7ab4052..4de46691a 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -11,15 +11,15 @@ _dll.t_percentile.restype = c_double _dll.t_percentile.argtypes = [POINTER(c_double), POINTER(c_int)] _dll.calc_pn.restype = c_double _dll.calc_pn.argtypes = [POINTER(c_int), POINTER(c_double)] +_dll.evaluate_legendre.restype = c_double +_dll.evaluate_legendre.argtypes = [POINTER(c_int), POINTER(c_double), + POINTER(c_double)] _dll.calc_rn.restype = None _dll.calc_rn.argtypes = [POINTER(c_int), ndpointer(c_double), ndpointer(c_double)] _dll.calc_zn.restype = None _dll.calc_zn.argtypes = [POINTER(c_int), POINTER(c_double), POINTER(c_double), ndpointer(c_double)] -_dll.evaluate_legendre.restype = c_double -_dll.evaluate_legendre.argtypes = [POINTER(c_int), POINTER(c_double), - POINTER(c_double)] _dll.rotate_angle.restype = None _dll.rotate_angle.argtypes = [ndpointer(c_double), POINTER(c_double), ndpointer(c_double), POINTER(c_double)] @@ -169,7 +169,7 @@ def calc_zn(n, rho, phi): """ - num_bins = ((n + 1) * (n + 2)) / 2 + num_bins = ((n + 1) * (n + 2)) // 2 zn = np.zeros(num_bins, dtype=np.float64) _dll.calc_zn(c_int(n), c_double(rho), c_double(phi), zn) return zn diff --git a/src/faddeeva/Faddeeva.h b/src/faddeeva/Faddeeva.h index 429386190..9e26bc1ed 100644 --- a/src/faddeeva/Faddeeva.h +++ b/src/faddeeva/Faddeeva.h @@ -1,5 +1,5 @@ /* Copyright (c) 2012 Massachusetts Institute of Technology - * + * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including @@ -7,17 +7,17 @@ * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: - * + * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. - * + * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION - * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. */ /* Available at: http://ab-initio.mit.edu/Faddeeva diff --git a/src/math.F90 b/src/math.F90 index d7e335284..a386747a4 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -43,14 +43,6 @@ module math real(C_DOUBLE) :: pnx end function calc_pn_cc - subroutine calc_rn_cc(n, uvw, rn) bind(C, name='calc_rn_c') - use ISO_C_BINDING - implicit none - integer(C_INT), value, intent(in) :: n - real(C_DOUBLE), intent(in) :: uvw(3) - real(C_DOUBLE), intent(in) :: rn(2 * n + 1) - end subroutine calc_rn_cc - pure function evaluate_legendre_cc(n, data, x) & bind(C, name='evaluate_legendre_c') result(val) use ISO_C_BINDING @@ -61,6 +53,23 @@ module math real(C_DOUBLE) :: val end function evaluate_legendre_cc + subroutine calc_rn_cc(n, uvw, rn) bind(C, name='calc_rn_c') + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: n + real(C_DOUBLE), intent(in) :: uvw(3) + real(C_DOUBLE), intent(out) :: rn(2 * n + 1) + end subroutine calc_rn_cc + + subroutine calc_zn_cc(n, rho, phi, zn) bind(C, name='calc_zn_c') + use ISO_C_BINDING + implicit none + integer(C_INT), value, intent(in) :: n + real(C_DOUBLE), value, intent(in) :: rho + real(C_DOUBLE), value, intent(in) :: phi + real(C_DOUBLE), intent(out) :: zn(((n + 1) * (n + 2)) / 2) + end subroutine calc_zn_cc + subroutine rotate_angle_cc(uvw, mu, phi) bind(C, name='rotate_angle_c') use ISO_C_BINDING implicit none @@ -200,102 +209,13 @@ contains !=============================================================================== subroutine calc_zn(n, rho, phi, zn) bind(C) - ! This procedure uses the modified Kintner's method for calculating Zernike - ! polynomials as outlined in Chong, C. W., Raveendran, P., & Mukundan, - ! R. (2003). A comparative analysis of algorithms for fast computation of - ! Zernike moments. Pattern Recognition, 36(3), 731-742. - integer(C_INT), intent(in) :: n ! Maximum order real(C_DOUBLE), intent(in) :: rho ! Radial location in the unit disk real(C_DOUBLE), intent(in) :: phi ! Theta (radians) location in the unit disk - real(C_DOUBLE), intent(out) :: zn(:) ! The resulting list of coefficients + ! The resulting list of coefficients + real(C_DOUBLE), intent(out) :: zn(((n + 1) * (n + 2)) / 2) - real(C_DOUBLE) :: sin_phi, cos_phi ! Sine and Cosine of phi - real(C_DOUBLE) :: sin_phi_vec(n+1) ! Contains sin(n*phi) - real(C_DOUBLE) :: cos_phi_vec(n+1) ! Contains cos(n*phi) - real(C_DOUBLE) :: zn_mat(n+1, n+1) ! Matrix form of the coefficients which is - ! easier to work with - real(C_DOUBLE) :: k1, k2, k3, k4 ! Variables for R_m_n calculation - integer(C_INT) :: i,p,q ! Loop counters - - real(C_DOUBLE), parameter :: SQRT_N_1(0:10) = [& - sqrt(1.0_8), sqrt(2.0_8), sqrt(3.0_8), sqrt(4.0_8), & - sqrt(5.0_8), sqrt(6.0_8), sqrt(7.0_8), sqrt(8.0_8), & - sqrt(9.0_8), sqrt(10.0_8), sqrt(11.0_8)] - real(C_DOUBLE), parameter :: SQRT_2N_2(0:10) = SQRT_N_1*sqrt(2.0_8) - - ! n == radial degree - ! m == azimuthal frequency - - ! ========================================================================== - ! Determine vector of sin(n*phi) and cos(n*phi). This takes advantage of the - ! following recurrence relations so that only a single sin/cos have to be - ! evaluated (http://mathworld.wolfram.com/Multiple-AngleFormulas.html) - ! - ! sin(nx) = 2 cos(x) sin((n-1)x) - sin((n-2)x) - ! cos(nx) = 2 cos(x) cos((n-1)x) - cos((n-2)x) - - sin_phi = sin(phi) - cos_phi = cos(phi) - - sin_phi_vec(1) = 1.0_8 - cos_phi_vec(1) = 1.0_8 - - sin_phi_vec(2) = 2.0_8 * cos_phi - cos_phi_vec(2) = cos_phi - - do i = 3, n+1 - sin_phi_vec(i) = 2.0_8 * cos_phi * sin_phi_vec(i-1) - sin_phi_vec(i-2) - cos_phi_vec(i) = 2.0_8 * cos_phi * cos_phi_vec(i-1) - cos_phi_vec(i-2) - end do - - do i = 1, n+1 - sin_phi_vec(i) = sin_phi_vec(i) * sin_phi - end do - - ! ========================================================================== - ! Calculate R_pq(rho) - - ! Fill the main diagonal first (Eq. 3.9 in Chong) - do p = 0, n - zn_mat(p+1, p+1) = rho**p - end do - - ! Fill in the second diagonal (Eq. 3.10 in Chong) - do q = 0, n-2 - zn_mat(q+2+1, q+1) = (q+2) * zn_mat(q+2+1, q+2+1) - (q+1) * zn_mat(q+1, q+1) - end do - - ! Fill in the rest of the values using the original results (Eq. 3.8 in Chong) - do p = 4, n - k2 = 2 * p * (p - 1) * (p - 2) - do q = p-4, 0, -2 - k1 = (p + q) * (p - q) * (p - 2) / 2 - k3 = -q**2*(p - 1) - p * (p - 1) * (p - 2) - k4 = -p * (p + q - 2) * (p - q - 2) / 2 - zn_mat(p+1, q+1) = ((k2 * rho**2 + k3) * zn_mat(p-2+1, q+1) + k4 * zn_mat(p-4+1, q+1)) / k1 - end do - end do - - ! Roll into a single vector for easier computation later - ! The vector is ordered (0,0), (1,-1), (1,1), (2,-2), (2,0), - ! (2, 2), .... in (n,m) indices - ! Note that the cos and sin vectors are offset by one - ! sin_phi_vec = [sin(x), sin(2x), sin(3x) ...] - ! cos_phi_vec = [1.0, cos(x), cos(2x)... ] - i = 1 - do p = 0, n - do q = -p, p, 2 - if (q < 0) then - zn(i) = zn_mat(p+1, abs(q)+1) * sin_phi_vec(abs(q)) * SQRT_2N_2(p) - else if (q == 0) then - zn(i) = zn_mat(p+1, q+1) * SQRT_N_1(p) - else - zn(i) = zn_mat(p+1, q+1) * cos_phi_vec(abs(q)+1) * SQRT_2N_2(p) - end if - i = i + 1 - end do - end do + call calc_zn_cc(n, rho, phi, zn) end subroutine calc_zn !=============================================================================== @@ -310,44 +230,11 @@ contains real(C_DOUBLE), intent(out) :: uvw(3) ! rotated directional cosine real(C_DOUBLE), optional :: phi ! azimuthal angle - real(C_DOUBLE) :: phi_ ! azimuthal angle - real(C_DOUBLE) :: sinphi ! sine of azimuthal angle - real(C_DOUBLE) :: cosphi ! cosine of azimuthal angle - real(C_DOUBLE) :: a ! sqrt(1 - mu^2) - real(C_DOUBLE) :: b ! sqrt(1 - w^2) - real(C_DOUBLE) :: u0 ! original cosine in x direction - real(C_DOUBLE) :: v0 ! original cosine in y direction - real(C_DOUBLE) :: w0 ! original cosine in z direction - - ! Copy original directional cosines - u0 = uvw0(1) - v0 = uvw0(2) - w0 = uvw0(3) - - ! Sample azimuthal angle in [0,2pi) if none provided + uvw = uvw0 if (present(phi)) then - phi_ = phi + call rotate_angle_cc(uvw, mu, phi) else - phi_ = TWO * PI * prn() - end if - - ! Precompute factors to save flops - sinphi = sin(phi_) - cosphi = cos(phi_) - a = sqrt(max(ZERO, ONE - mu*mu)) - b = sqrt(max(ZERO, ONE - w0*w0)) - - ! Need to treat special case where sqrt(1 - w**2) is close to zero by - ! expanding about the v component rather than the w component - if (b > 1e-10) then - uvw(1) = mu*u0 + a*(u0*w0*cosphi - v0*sinphi)/b - uvw(2) = mu*v0 + a*(v0*w0*cosphi + u0*sinphi)/b - uvw(3) = mu*w0 - a*b*cosphi - else - b = sqrt(ONE - v0*v0) - uvw(1) = mu*u0 + a*(u0*v0*cosphi + w0*sinphi)/b - uvw(2) = mu*v0 - a*b*cosphi - uvw(3) = mu*w0 + a*(v0*w0*cosphi - u0*sinphi)/b + call rotate_angle_cc(uvw, mu, -10._8) end if end subroutine rotate_angle @@ -492,6 +379,9 @@ contains factors(i+3) = factors(i+1)*(E + (ONE + TWO * i) * half_inv_dopp2) end if end do + + ! call broaden_wmp_polynomials_cc(E, dopp, n, factors) + end subroutine broaden_wmp_polynomials end module math diff --git a/src/math_functions.cpp b/src/math_functions.cpp index 1466bde54..9f698f42a 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -169,9 +169,10 @@ double __attribute__ ((const)) calc_pn_c(int n, double x) { double __attribute__ ((const)) evaluate_legendre_c(int n, double data[], double x) { double val; + int l; val = 0.5 * data[0]; - for (int l = 1; l < n; l++) { + for (l = 1; l < n; l++) { val += (static_cast(l) + 0.5) * data[l] * calc_pn_c(l, x); } return val; @@ -577,6 +578,122 @@ void calc_rn_c(int n, double uvw[3], double rn[]){ } } +//============================================================================== +// CALC_ZN calculates the n-th order modified Zernike polynomial moment for a +// given angle (rho, theta) location in the unit disk. The normalization of the +// polynomials is such tha the integral of Z_pq*Z_pq over the unit disk is +// exactly pi +//============================================================================== + +void calc_zn_c(int n, double rho, double phi, double zn[]) { + // This procedure uses the modified Kintner's method for calculating Zernike + // polynomials as outlined in Chong, C. W., Raveendran, P., & Mukundan, + // R. (2003). A comparative analysis of algorithms for fast computation of + // Zernike moments. Pattern Recognition, 36(3), 731-742. + double sin_phi; // Cosine of phi + double cos_phi; // Sine of phi + double sin_phi_vec[n + 1]; // Sin[n * phi] + double cos_phi_vec[n + 1]; // Cos[n * phi] + double zn_mat[n + 1][n + 1]; // Matrix forms of the coefficients which are + // easier to work with + // Variables for R_m_n calculation + double k1; + double k2; + double k3; + double k4; + // Loop counters + int i; + int p; + int q; + + const double SQRT_N_1[11] = + {std::sqrt(1.), std::sqrt(2.), std::sqrt(3.), std::sqrt(4.), + std::sqrt(5.), std::sqrt(6.), std::sqrt(7.), std::sqrt(8.), + std::sqrt(9.), std::sqrt(10.), std::sqrt(11.)}; + + const double SQRT_2N_2[11] = + {std::sqrt(2.) * std::sqrt(1.), std::sqrt(2.) * std::sqrt(2.), + std::sqrt(2.) * std::sqrt(3.), std::sqrt(2.) * std::sqrt(4.), + std::sqrt(2.) * std::sqrt(5.), std::sqrt(2.) * std::sqrt(6.), + std::sqrt(2.) * std::sqrt(7.), std::sqrt(2.) * std::sqrt(8.), + std::sqrt(2.) * std::sqrt(9.), std::sqrt(2.) * std::sqrt(10.), + std::sqrt(2.) * std::sqrt(11.)}; + + // n == radial degree + // m == azimuthal frequency + + // =========================================================================== + // Determine vector of sin(n*phi) and cos(n*phi). This takes advantage of the + // following recurrence relations so that only a single sin/cos have to be + // evaluated (http://mathworld.wolfram.com/Multiple-AngleFormulas.html) + // + // sin(nx) = 2 cos(x) sin((n-1)x) - sin((n-2)x) + // cos(nx) = 2 cos(x) cos((n-1)x) - cos((n-2)x) + + sin_phi = std::sin(phi); + cos_phi = std::cos(phi); + + sin_phi_vec[0] = 1.0; + cos_phi_vec[0] = 1.0; + + sin_phi_vec[1] = 2.0 * cos_phi; + cos_phi_vec[1] = cos_phi; + + for (i = 2; i <= n; i++) { + sin_phi_vec[i] = 2. * cos_phi * sin_phi_vec[i - 1] - sin_phi_vec[i - 2]; + cos_phi_vec[i] = 2. * cos_phi * cos_phi_vec[i - 1] - cos_phi_vec[i - 2]; + } + + for (i = 0; i <= n; i++) { + sin_phi_vec[i] *= sin_phi; + } + + // =========================================================================== + // Calculate R_pq(rho) + + // Fill the main diagonal first (Eq 3.9 in Chong) + for (p = 0; p <= n; p++) { + zn_mat[p][p] = std::pow(rho, p); + } + + // Fill the 2nd diagonal (Eq 3.10 in Chong) + for (q = 0; q <= n - 2; q++) { + zn_mat[q][q+2] = (q + 2) * zn_mat[q+2][q+2] - (q + 1) * zn_mat[q][q]; + } + + // Fill in the rest of the values using the original results (Eq. 3.8 in Chong) + for (p = 4; p <= n; p++) { + k2 = static_cast (2 * p * (p - 1) * (p - 2)); + for (q = p - 4; q >= 0; q -= 2) { + k1 = static_cast((p + q) * (p - q) * (p - 2)) / 2.; + k3 = static_cast(-q * q * (p - 1) - p * (p - 1) * (p - 2)); + k4 = static_cast(-p * (p + q - 2) * (p - q - 2)) / 2.; + zn_mat[q][p] = + ((k2 * rho * rho + k3) * zn_mat[q][p-2] + k4 * zn_mat[q][p-4]) / k1; + } + } + + // Roll into a single vector for easier computation later + // The vector is ordered (0,0), (1,-1), (1,1), (2,-2), (2,0), + // (2, 2), .... in (n,m) indices + // Note that the cos and sin vectors are offset by one + // sin_phi_vec = [sin(x), sin(2x), sin(3x) ...] + // cos_phi_vec = [1.0, cos(x), cos(2x)... ] + i = 0; + for (p = 0; p <= n; p++) { + for (q = -p; q <= p; q += 2) { + if (q < 0) { + zn[i] = zn_mat[std::abs(q)][p] * sin_phi_vec[std::abs(q) - 1] * SQRT_2N_2[p]; + } else if (q == 0) { + zn[i] = zn_mat[q][p] * SQRT_N_1[p]; + } else { + zn[i] = zn_mat[q][p] * cos_phi_vec[q] * SQRT_2N_2[p]; + } + i++; + } + } + +} //============================================================================== // ROTATE_ANGLE rotates direction std::cosines through a polar angle whose @@ -678,8 +795,8 @@ double watt_spectrum_c(double a, double b) { // FADDEEVA the Faddeeva function, using Stephen Johnson's implementation //============================================================================== -// std::complex faddeeva_c(std::complex z) { -// std::complex wv; // The resultant w(z) value +// double complex __attribute__ ((const)) faddeeva_c(double complex z) { +// double complex wv; // The resultant w(z) value // double relerr; // Target relative error in the inner loop of MIT Faddeeva // // Technically, the value we want is given by the equation: @@ -698,19 +815,19 @@ double watt_spectrum_c(double a, double b) { // // Note that faddeeva_w will interpret zero as machine epsilon // relerr = 0.; -// if (z.imag() > 0.) { -// wv = Faddeeva::w(z, relerr); +// if (cimag(z) > 0.) { +// wv = Faddeeva_w(z, relerr); // } else { -// wv = -std::conj(Faddeeva::w(std::conj(z), relerr)); +// wv = -conj(Faddeeva_w(conj(z), relerr)); // } // return wv; // } -// std::complex w_derivative_c(std::complex z, int order){ -// std::complex wv; // The resultant w(z) value +// double complex w_derivative_c(double complex z, int order){ +// double complex wv; // The resultant w(z) value -// const std::complex twoi_sqrtpi(0.0, 2.0 / std::sqrt(PI)); +// const double complex twoi_sqrtpi = 2.0 / std::sqrt(PI) * I; // switch(order) { // case 0: diff --git a/src/math_functions.h b/src/math_functions.h index aaba08261..4e7b2e8c6 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -2,11 +2,11 @@ #define MATH_FUNCTIONS_H #include -#include +#include #include #include "random_lcg.h" -// #include "faddeeva/Faddeeva.hh" +// #include "faddeeva/Faddeeva.h" namespace openmc { @@ -51,6 +51,15 @@ extern "C" double evaluate_legendre_c(int n, double data[], double x) extern "C" void calc_rn_c(int n, double uvw[3], double rn[]); +//============================================================================== +// CALC_ZN calculates the n-th order modified Zernike polynomial moment for a +// given angle (rho, theta) location in the unit disk. The normalization of the +// polynomials is such tha the integral of Z_pq*Z_pq over the unit disk is +// exactly pi +//============================================================================== + +extern "C" void calc_zn_c(int n, double rho, double phi, double zn[]); + //============================================================================== // ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is // mu and through an azimuthal angle sampled uniformly. Note that this is done @@ -83,16 +92,17 @@ extern "C" double watt_spectrum_c(double a, double b); // FADDEEVA the Faddeeva function, using Stephen Johnson's implementation //============================================================================== -// extern "C" std::complex faddeeva_c(std::complex z); +// extern "C" double complex faddeeva_c(double complex z) __attribute__ ((const)); -// extern "C" std::complex w_derivative_c(std::complex z, int order); +// extern "C" double complex w_derivative_c(double complex z, int order); //============================================================================== // BROADEN_WMP_POLYNOMIALS Doppler broadens the windowed multipole curvefit. // The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... //============================================================================== -extern "C" void broaden_wmp_polynomials_c(double E, double dopp, int n, double factors[]); +extern "C" void broaden_wmp_polynomials_c(double E, double dopp, int n, + double factors[]); } // namespace openmc #endif // MATH_FUNCTIONS_H \ No newline at end of file diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py index bfa021ceb..03309bafe 100644 --- a/tests/unit_tests/test_math.py +++ b/tests/unit_tests/test_math.py @@ -115,7 +115,38 @@ def test_calc_rn(): def test_calc_zn(): - pass + n = 10 + rho = 0.5 + phi = 0.5 + + # Reference solution from running the Fortran implementation + ref_vals = np.array( + [1.00000000e+00, 4.79425539e-01, 8.77582562e-01, + 5.15293637e-01, -8.66025404e-01, 3.30866239e-01, + 3.52667735e-01, -8.47512624e-01, -1.55136145e+00, + 2.50093775e-02, 1.79715684e-01, -1.33048245e+00, + -2.79508497e-01, -8.54292956e-01, -8.22482403e-02, + 6.47865100e-02, -1.18780200e+00, 5.18993370e-01, + 9.50010991e-01, -8.42327938e-02, -8.67263404e-02, + 8.25035501e-03, -7.44248626e-01, 1.52505281e+00, + 1.15751620e+00, 9.79225149e-01, 3.40611006e-01, + -5.78783240e-02, -1.09619759e-02, -3.17938327e-01, + 1.90147482e+00, 2.84658914e-01, 5.21064646e-01, + 1.34842791e-01, 4.25607546e-01, -2.92642715e-02, + -1.25423479e-02, -4.67751162e-02, 1.50696182e+00, + -6.13603897e-01, -8.67187500e-01, -3.93990531e-01, + -6.89672461e-01, 3.28139254e-01, -1.08327149e-02, + -8.53837419e-03, 7.04712042e-02, 7.73660979e-01, + -1.63799891e+00, -8.12396290e-01, -1.48708143e+00, + -1.16158437e-01, -1.03565982e+00, 1.88131088e-01, + -1.84122553e-03, -4.39233743e-03, 9.01295675e-02, + 1.32511582e-01, -1.83260987e+00, -7.93994967e-01, + -2.97978009e-01, -5.09818305e-01, 8.38707753e-01, + -9.29602211e-01, 7.78441102e-02, 1.29931014e-03]) + + test_vals = openmc.capi.math.calc_zn(n, rho, phi) + + assert np.allclose(ref_vals, test_vals) def test_rotate_angle(): @@ -128,7 +159,7 @@ def test_rotate_angle(): test_uvw = openmc.capi.math.rotate_angle(uvw0, mu, phi) - assert np.allclose(ref_uvw, test_uvw) + assert np.array_equal(ref_uvw, test_uvw) # Repeat for mu = 1 (no change) mu = 1. @@ -136,7 +167,7 @@ def test_rotate_angle(): test_uvw = openmc.capi.math.rotate_angle(uvw0, mu, phi) - assert np.allclose(ref_uvw, test_uvw) + assert np.array_equal(ref_uvw, test_uvw) # Need to test phi=None somehow... @@ -180,3 +211,5 @@ def test_broaden_wmp_polynomials(): test_val = openmc.capi.math.broaden_wmp_polynomials(test_E, test_dopp, n) assert np.allclose(ref_val, test_val) + +test_calc_zn() \ No newline at end of file From 044934f93d065888d67dec704f0013aa99eca7d3 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Mon, 7 May 2018 20:07:05 -0400 Subject: [PATCH 08/15] Implemented broaden_wmp_polynomials in C++ --- src/math.F90 | 46 +---------------------------------- src/math_functions.cpp | 14 +++++++---- src/math_functions.h | 2 ++ tests/unit_tests/test_math.py | 9 +++---- 4 files changed, 16 insertions(+), 55 deletions(-) diff --git a/src/math.F90 b/src/math.F90 index a386747a4..6edf2f1c3 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -336,51 +336,7 @@ contains integer(C_INT), intent(in) :: n ! number of components to polynomial real(C_DOUBLE), intent(out):: factors(n) ! output leading coefficient - integer :: i - - real(8) :: sqrtE ! sqrt(energy) - real(8) :: beta ! sqrt(atomic weight ratio * E / kT) - real(8) :: half_inv_dopp2 ! 0.5 / dopp**2 - real(8) :: quarter_inv_dopp4 ! 0.25 / dopp**4 - real(8) :: erf_beta ! error function of beta - real(8) :: exp_m_beta2 ! exp(-beta**2) - - sqrtE = sqrt(E) - beta = sqrtE * dopp - half_inv_dopp2 = HALF / dopp**2 - quarter_inv_dopp4 = half_inv_dopp2**2 - - if (beta > 6.0_8) then - ! Save time, ERF(6) is 1 to machine precision. - ! beta/sqrtpi*exp(-beta**2) is also approximately 1 machine epsilon. - erf_beta = ONE - exp_m_beta2 = ZERO - else - erf_beta = erf(beta) - exp_m_beta2 = exp(-beta**2) - end if - - ! Assume that, for sure, we'll use a second order (1/E, 1/V, const) - ! fit, and no less. - - factors(1) = erf_beta / E - factors(2) = ONE / sqrtE - factors(3) = factors(1) * (half_inv_dopp2 + E) & - + exp_m_beta2 / (beta * SQRT_PI) - - ! Perform recursive broadening of high order components - do i = 1, n-3 - if (i /= 1) then - factors(i+3) = -factors(i-1) * (i - ONE) * i * quarter_inv_dopp4 & - + factors(i+1) * (E + (ONE + TWO * i) * half_inv_dopp2) - else - ! Although it's mathematically identical, factors(0) will contain - ! nothing, and we don't want to have to worry about memory. - factors(i+3) = factors(i+1)*(E + (ONE + TWO * i) * half_inv_dopp2) - end if - end do - - ! call broaden_wmp_polynomials_cc(E, dopp, n, factors) + call broaden_wmp_polynomials_cc(E, dopp, n, factors) end subroutine broaden_wmp_polynomials diff --git a/src/math_functions.cpp b/src/math_functions.cpp index 9f698f42a..7ab2a8450 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -827,7 +827,7 @@ double watt_spectrum_c(double a, double b) { // double complex w_derivative_c(double complex z, int order){ // double complex wv; // The resultant w(z) value -// const double complex twoi_sqrtpi = 2.0 / std::sqrt(PI) * I; +// const double complex twoi_sqrtpi = 2.0 / SQRT_PI * I; // switch(order) { // case 0: @@ -859,6 +859,7 @@ void broaden_wmp_polynomials_c(double E, double dopp, int n, double factors[]) { double erf_beta; // error function of beta double exp_m_beta2; // exp(-beta**2) int i; + double ip1_dbl; sqrtE = std::sqrt(E); beta = sqrtE * dopp; @@ -881,17 +882,20 @@ void broaden_wmp_polynomials_c(double E, double dopp, int n, double factors[]) { factors[0] = erf_beta / E; factors[1] = 1. / sqrtE; factors[2] = factors[0] * (half_inv_dopp2 + E) + exp_m_beta2 / - (beta * std::sqrt(PI)); + (beta * SQRT_PI); // Perform recursive broadening of high order components for (i = 0; i < n - 3; i++) { + ip1_dbl = static_cast(i + 1); if (i != 0) { - factors[i + 3] = -factors[i - 1] * (i - 1.) * i * quarter_inv_dopp4 + - factors[i + 1] * (E + (1. + 2. * i) * half_inv_dopp2); + factors[i + 3] = -factors[i - 1] * (ip1_dbl - 1.) * ip1_dbl * + quarter_inv_dopp4 + factors[i + 1] * + (E + (1. + 2. * ip1_dbl) * half_inv_dopp2); } else { // Although it's mathematically identical, factors[0] will contain // nothing, and we don't want to have to worry about memory. - factors[i + 3] = factors[i + 1]*(E + (1. + 2. * i) * half_inv_dopp2); + factors[i + 3] = factors[i + 1] * + (E + (1. + 2. * ip1_dbl) * half_inv_dopp2); } } } diff --git a/src/math_functions.h b/src/math_functions.h index 4e7b2e8c6..ab35d140a 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -16,6 +16,8 @@ namespace openmc { // modifying test results const double PI = 3.1415926535898; +const double SQRT_PI = std::sqrt(PI); + //============================================================================== // NORMAL_PERCENTILE calculates the percentile of the standard normal // distribution with a specified probability level diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py index 03309bafe..99e16712c 100644 --- a/tests/unit_tests/test_math.py +++ b/tests/unit_tests/test_math.py @@ -199,17 +199,16 @@ def test_broaden_wmp_polynomials(): # First lets do beta > 6 test_E = 0.5 test_dopp = 100. # approximately U235 at room temperature - n = 4 - ref_val = [2., 1.41421356, 1.0001, 0.70731891] + n = 6 + + ref_val = [2., 1.41421356, 1.0001, 0.70731891, 0.50030001, 0.353907] test_val = openmc.capi.math.broaden_wmp_polynomials(test_E, test_dopp, n) assert np.allclose(ref_val, test_val) # now beta < 6 test_dopp = 5. - ref_val = [1.99999885, 1.41421356, 1.04, 0.79195959] + ref_val = [1.99999885, 1.41421356, 1.04, 0.79195959, 0.6224, 0.50346003] test_val = openmc.capi.math.broaden_wmp_polynomials(test_E, test_dopp, n) assert np.allclose(ref_val, test_val) - -test_calc_zn() \ No newline at end of file From a73f633d2480d8c64677610f7c4479a3c96d921b Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Sat, 12 May 2018 15:43:05 -0400 Subject: [PATCH 09/15] Converted calc_rn and calc_pn to provide all values at once instead of only for the requested value of n. Also converted calc_pn to use the recursive definition of the legendre polys --- openmc/capi/math.py | 13 +- src/math.F90 | 80 +- src/math_functions.cpp | 851 ++++++++++----------- src/math_functions.h | 32 +- src/tallies/tally.F90 | 2 +- src/tallies/tally_filter_legendre.F90 | 11 +- src/tallies/tally_filter_sph_harm.F90 | 26 +- src/tallies/tally_filter_sptl_legendre.F90 | 15 +- src/tallies/tally_filter_zernike.F90 | 2 +- tests/unit_tests/test_math.py | 17 +- 10 files changed, 514 insertions(+), 535 deletions(-) diff --git a/openmc/capi/math.py b/openmc/capi/math.py index 4de46691a..c46390bce 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -9,8 +9,9 @@ from . import _dll # _dll.normal_percentile.argtypes = [POINTER(c_double)] _dll.t_percentile.restype = c_double _dll.t_percentile.argtypes = [POINTER(c_double), POINTER(c_int)] -_dll.calc_pn.restype = c_double -_dll.calc_pn.argtypes = [POINTER(c_int), POINTER(c_double)] +_dll.calc_pn.restype = None +_dll.calc_pn.argtypes = [POINTER(c_int), POINTER(c_double), + ndpointer(c_double)] _dll.evaluate_legendre.restype = c_double _dll.evaluate_legendre.argtypes = [POINTER(c_int), POINTER(c_double), POINTER(c_double)] @@ -95,7 +96,9 @@ def calc_pn(n, x): """ - return _dll.calc_pn(c_int(n), c_double(x)) + pnx = np.empty(n + 1, dtype=np.float64) + _dll.calc_pn(c_int(n), c_double(x), pnx) + return pnx def evaluate_legendre(data, x): @@ -124,7 +127,7 @@ def evaluate_legendre(data, x): def calc_rn(n, uvw): """ Calculate the n-th order real Spherical Harmonics for a given angle; - all Rn,m values are provided (where -n <= m <= n). + all Rn,m values are provided for all n (where -n <= m <= n). Parameters ---------- @@ -140,7 +143,7 @@ def calc_rn(n, uvw): """ - num_nm = 2 * n + 1 + num_nm = (n + 1) * (n + 1) rn = np.empty(num_nm, dtype=np.float64) uvw_arr = np.array(uvw, dtype=np.float64) _dll.calc_rn(c_int(n), uvw_arr, rn) diff --git a/src/math.F90 b/src/math.F90 index 6edf2f1c3..7be3e5a6d 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -26,24 +26,24 @@ module math interface - pure function t_percentile_cc(p, df) bind(C, name='t_percentile_c') & + pure function t_percentile_c_intfc(p, df) bind(C, name='t_percentile_c') & result(t) use ISO_C_BINDING implicit none real(C_DOUBLE), value, intent(in) :: p integer(C_INT), value, intent(in) :: df real(C_DOUBLE) :: t - end function t_percentile_cc + end function t_percentile_c_intfc - pure function calc_pn_cc(n, x) bind(C, name='calc_pn_c') result(pnx) + pure subroutine calc_pn_c_intfc(n, x, pnx) bind(C, name='calc_pn_c') use ISO_C_BINDING implicit none integer(C_INT), value, intent(in) :: n real(C_DOUBLE), value, intent(in) :: x - real(C_DOUBLE) :: pnx - end function calc_pn_cc + real(C_DOUBLE), intent(out) :: pnx(n + 1) + end subroutine calc_pn_c_intfc - pure function evaluate_legendre_cc(n, data, x) & + pure function evaluate_legendre_c_intfc(n, data, x) & bind(C, name='evaluate_legendre_c') result(val) use ISO_C_BINDING implicit none @@ -51,67 +51,67 @@ module math real(C_DOUBLE), intent(in) :: data(n) real(C_DOUBLE), value, intent(in) :: x real(C_DOUBLE) :: val - end function evaluate_legendre_cc + end function evaluate_legendre_c_intfc - subroutine calc_rn_cc(n, uvw, rn) bind(C, name='calc_rn_c') + pure subroutine calc_rn_c_intfc(n, uvw, rn) bind(C, name='calc_rn_c') use ISO_C_BINDING implicit none integer(C_INT), value, intent(in) :: n real(C_DOUBLE), intent(in) :: uvw(3) real(C_DOUBLE), intent(out) :: rn(2 * n + 1) - end subroutine calc_rn_cc + end subroutine calc_rn_c_intfc - subroutine calc_zn_cc(n, rho, phi, zn) bind(C, name='calc_zn_c') + pure subroutine calc_zn_c_intfc(n, rho, phi, zn) bind(C, name='calc_zn_c') use ISO_C_BINDING implicit none integer(C_INT), value, intent(in) :: n real(C_DOUBLE), value, intent(in) :: rho real(C_DOUBLE), value, intent(in) :: phi real(C_DOUBLE), intent(out) :: zn(((n + 1) * (n + 2)) / 2) - end subroutine calc_zn_cc + end subroutine calc_zn_c_intfc - subroutine rotate_angle_cc(uvw, mu, phi) bind(C, name='rotate_angle_c') + subroutine rotate_angle_c_intfc(uvw, mu, phi) bind(C, name='rotate_angle_c') use ISO_C_BINDING implicit none real(C_DOUBLE), intent(inout) :: uvw(3) real(C_DOUBLE), value, intent(in) :: mu real(C_DOUBLE), value, intent(in) :: phi - end subroutine rotate_angle_cc + end subroutine rotate_angle_c_intfc - function maxwell_spectrum_cc(T) bind(C, name='maxwell_spectrum_c') & + function maxwell_spectrum_c_intfc(T) bind(C, name='maxwell_spectrum_c') & result(E_out) use ISO_C_BINDING implicit none real(C_DOUBLE), value, intent(in) :: T real(C_DOUBLE) :: E_out - end function maxwell_spectrum_cc + end function maxwell_spectrum_c_intfc - function watt_spectrum_cc(a, b) bind(C, name='watt_spectrum_c') & + function watt_spectrum_c_intfc(a, b) bind(C, name='watt_spectrum_c') & result(E_out) use ISO_C_BINDING implicit none real(C_DOUBLE), value, intent(in) :: a real(C_DOUBLE), value, intent(in) :: b real(C_DOUBLE) :: E_out - end function watt_spectrum_cc + end function watt_spectrum_c_intfc - function faddeeva_cc(z) bind(C, name='faddeeva_c') result(wv) + function faddeeva_c_intfc(z) bind(C, name='faddeeva_c') result(wv) use ISO_C_BINDING implicit none complex(C_DOUBLE_COMPLEX), value, intent(in) :: z complex(C_DOUBLE_COMPLEX) :: wv - end function faddeeva_cc + end function faddeeva_c_intfc - function w_derivative_cc(z, order) bind(C, name='w_derivative_c') & + function w_derivative_c_intfc(z, order) bind(C, name='w_derivative_c') & result(wv) use ISO_C_BINDING implicit none complex(C_DOUBLE_COMPLEX), value, intent(in) :: z integer(C_INT), value, intent(in) :: order complex(C_DOUBLE_COMPLEX) :: wv - end function w_derivative_cc + end function w_derivative_c_intfc - subroutine broaden_wmp_polynomials_cc(E, dopp, n, factors) & + subroutine broaden_wmp_polynomials_c_intfc(E, dopp, n, factors) & bind(C, name='broaden_wmp_polynomials_c') use ISO_C_BINDING implicit none @@ -119,7 +119,7 @@ module math real(C_DOUBLE), value, intent(in) :: dopp integer(C_INT), value, intent(in) :: n real(C_DOUBLE), intent(inout) :: factors(n) - end subroutine broaden_wmp_polynomials_cc + end subroutine broaden_wmp_polynomials_c_intfc function faddeeva_w(z, relerr) bind(C, name='Faddeeva_w') result(w) use ISO_C_BINDING @@ -143,7 +143,7 @@ contains integer(C_INT), intent(in) :: df ! degrees of freedom real(C_DOUBLE) :: t ! corresponding t-value - t = t_percentile_cc(p, df) + t = t_percentile_c_intfc(p, df) end function t_percentile @@ -157,18 +157,18 @@ contains ! the return value will be 1.0. !=============================================================================== - pure function calc_pn(n, x) result(pnx) bind(C) + pure subroutine calc_pn(n, x, pnx) bind(C) integer(C_INT), intent(in) :: n ! Legendre order requested real(C_DOUBLE), intent(in) :: x ! Independent variable the Legendre is to ! be evaluated at; x must be in the ! domain [-1,1] - real(C_DOUBLE) :: pnx ! The Legendre poly of order n evaluated - ! at x + real(C_DOUBLE), intent(out) :: pnx(n + 1) ! The Legendre polys of order n + ! evaluated at x - pnx = calc_pn_cc(n, x) + call calc_pn_c_intfc(n, x, pnx) - end function calc_pn + end subroutine calc_pn !=============================================================================== ! EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients @@ -181,7 +181,7 @@ contains real(C_DOUBLE), intent(in) :: x real(C_DOUBLE) :: val - val = evaluate_legendre_cc(size(data), data, x) + val = evaluate_legendre_c_intfc(size(data) - 1, data, x) end function evaluate_legendre @@ -190,14 +190,14 @@ contains ! (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) !=============================================================================== - subroutine calc_rn(n, uvw, rn) bind(C) + pure subroutine calc_rn(n, uvw, rn) bind(C) integer(C_INT), intent(in) :: n ! Order requested real(C_DOUBLE), intent(in) :: uvw(3) ! Direction of travel; ! assumed to be on unit sphere - real(C_DOUBLE) :: rn(2*n + 1) ! The resultant R_n(uvw) + real(C_DOUBLE), intent(out) :: rn(2*n + 1) ! The resultant R_n(uvw) - call calc_rn_cc(n, uvw, rn) + call calc_rn_c_intfc(n, uvw, rn) end subroutine calc_rn @@ -208,14 +208,14 @@ contains ! exactly pi !=============================================================================== - subroutine calc_zn(n, rho, phi, zn) bind(C) + pure subroutine calc_zn(n, rho, phi, zn) bind(C) integer(C_INT), intent(in) :: n ! Maximum order real(C_DOUBLE), intent(in) :: rho ! Radial location in the unit disk real(C_DOUBLE), intent(in) :: phi ! Theta (radians) location in the unit disk ! The resulting list of coefficients real(C_DOUBLE), intent(out) :: zn(((n + 1) * (n + 2)) / 2) - call calc_zn_cc(n, rho, phi, zn) + call calc_zn_c_intfc(n, rho, phi, zn) end subroutine calc_zn !=============================================================================== @@ -232,9 +232,9 @@ contains uvw = uvw0 if (present(phi)) then - call rotate_angle_cc(uvw, mu, phi) + call rotate_angle_c_intfc(uvw, mu, phi) else - call rotate_angle_cc(uvw, mu, -10._8) + call rotate_angle_c_intfc(uvw, mu, -10._8) end if end subroutine rotate_angle @@ -251,7 +251,7 @@ contains real(C_DOUBLE), intent(in) :: T ! tabulated function of incoming E real(C_DOUBLE) :: E_out ! sampled energy - E_out = maxwell_spectrum_cc(T) + E_out = maxwell_spectrum_c_intfc(T) end function maxwell_spectrum @@ -269,7 +269,7 @@ contains real(C_DOUBLE), intent(in) :: b ! Watt parameter b real(C_DOUBLE) :: E_out ! energy of emitted neutron - E_out = watt_spectrum_cc(a, b) + E_out = watt_spectrum_c_intfc(a, b) end function watt_spectrum @@ -336,7 +336,7 @@ contains integer(C_INT), intent(in) :: n ! number of components to polynomial real(C_DOUBLE), intent(out):: factors(n) ! output leading coefficient - call broaden_wmp_polynomials_cc(E, dopp, n, factors) + call broaden_wmp_polynomials_c_intfc(E, dopp, n, factors) end subroutine broaden_wmp_polynomials diff --git a/src/math_functions.cpp b/src/math_functions.cpp index b3478f065..c9d6fc359 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -8,10 +8,7 @@ namespace openmc { // distribution with a specified probability level //============================================================================== -double __attribute__ ((const)) normal_percentile_c(double p) { - - // return gsl_cdf_ugaussian_Pinv(p); - +double __attribute__ ((const)) normal_percentile_c(const double p) { double z; double q; double r; @@ -68,10 +65,7 @@ double __attribute__ ((const)) normal_percentile_c(double p) { // a specified probability level and number of degrees of freedom //============================================================================== -double __attribute__ ((const)) t_percentile_c(double p, int df){ - - // return gsl_cdf_tdist_Pinv(p, static_cast df); - +double __attribute__ ((const)) t_percentile_c(const double p, const int df){ double t; double n; double k; @@ -108,57 +102,23 @@ double __attribute__ ((const)) t_percentile_c(double p, int df){ } //============================================================================== -// CALC_PN calculates the n-th order Legendre polynomial at the value of x. +// CALC_PN calculates the n-th order Legendre polynomials at the value of x. //============================================================================== -double __attribute__ ((const)) calc_pn_c(int n, double x) { +void calc_pn_c(const int n, const double x, double pnx[]) { + int l; - // return gsl_sf_legendre_Pl(l, x); - - double pnx; - - switch(n) { - case 0: - pnx = 1.; - break; - case 1: - pnx = x; - break; - case 2: - pnx = 1.5 * x * x - 0.5; - break; - case 3: - pnx = 2.5 * x * x * x - 1.5 * x; - break; - case 4: - pnx = 4.375 * std::pow(x, 4.) - 3.75 * x * x + 0.375; - break; - case 5: - pnx = 7.875 * std::pow(x, 5.) - 8.75 * x * x * x + 1.875 * x; - break; - case 6: - pnx = 14.4375 * std::pow(x, 6.) - 19.6875 * std::pow(x, 4.) + - 6.5625 * x * x - 0.3125; - break; - case 7: - pnx = 26.8125 * std::pow(x, 7.) - 43.3125 * std::pow(x, 5.) + - 19.6875 * x * x * x - 2.1875 * x; - break; - case 8: - pnx = 50.2734375 * std::pow(x, 8.) - 93.84375 * std::pow(x, 6.) + - 54.140625 * std::pow(x, 4.) - 9.84375 * x * x + 0.2734375; - break; - case 9: - pnx = 94.9609375 * std::pow(x, 9.) - 201.09375 * std::pow(x, 7.) + - 140.765625 * std::pow(x, 5.) - 36.09375 * x * x * x + 2.4609375 * x; - break; - case 10: - pnx = 180.42578125 * std::pow(x, 10.) - 427.32421875 * std::pow(x, 8.) + - 351.9140625 * std::pow(x, 6.) - 117.3046875 * std::pow(x, 4.) + - 13.53515625 * x * x - 0.24609375; + pnx[0] = 1.; + if (n >= 1) { + pnx[1] = x; } - return pnx; + // Use recursion relation to build the higher orders + for (l = 1; l < n; l ++) { + pnx[l + 1] = (static_cast(2 * l + 1) * x * pnx[l] - + static_cast(l) * pnx[l - 1]) / + (static_cast(l + 1)); + } } //============================================================================== @@ -166,27 +126,34 @@ double __attribute__ ((const)) calc_pn_c(int n, double x) { // and the value of x //============================================================================== -double __attribute__ ((const)) evaluate_legendre_c(int n, double data[], - double x) { +double __attribute__ ((const)) evaluate_legendre_c(const int n, + const double data[], + const double x) { double val; int l; + double* pnx = new double[n + 1]; - val = 0.5 * data[0]; - for (l = 1; l < n; l++) { - val += (static_cast(l) + 0.5) * data[l] * calc_pn_c(l, x); + val = 0.0; + calc_pn_c(n, x, pnx); + for (l = 0; l <= n; l++) { + val += (static_cast(l) + 0.5) * data[l] * pnx[l]; } + delete[] pnx; return val; } //============================================================================== // CALC_RN calculates the n-th order spherical harmonics for a given angle -// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) +// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) for n +// all 0 <= n //============================================================================== -void calc_rn_c(int n, double uvw[3], double rn[]){ +void calc_rn_c(const int n, const double uvw[3], double rn[]){ double phi; double w; double w2m1; + int i; + int l; // rn[] is assumed to have already been allocated to the correct size @@ -201,380 +168,383 @@ void calc_rn_c(int n, double uvw[3], double rn[]){ // Store the shorthand of 1-w * w w2m1 = 1. - w * w; - // Now evaluate the spherical harmonics function depending on the order - // requested - switch (n) { - case 0: - // l = 0, m = 0 - rn[0] = 1.; - break; - case 1: - // l = 1, m = -1 - rn[0] = -(1.*std::sqrt(w2m1) * std::sin(phi)); - // l = 1, m = 0 - rn[1] = w; - // l = 1, m = 1 - rn[2] = -(1.*std::sqrt(w2m1) * std::cos(phi)); - break; - case 2: - // l = 2, m = -2 - rn[0] = 0.288675134594813 * (-3. * w * w + 3.) * std::sin(2. * phi); - // l = 2, m = -1 - rn[1] = -(1.73205080756888 * w*std::sqrt(w2m1) * std::sin(phi)); - // l = 2, m = 0 - rn[2] = 1.5 * w * w - 0.5; - // l = 2, m = 1 - rn[3] = -(1.73205080756888 * w*std::sqrt(w2m1) * std::cos(phi)); - // l = 2, m = 2 - rn[4] = 0.288675134594813 * (-3. * w * w + 3.) * std::cos(2. * phi); - break; - case 3: - // l = 3, m = -3 - rn[0] = -(0.790569415042095 * std::pow(w2m1, 1.5) * std::sin(3. * phi)); - // l = 3, m = -2 - rn[1] = 1.93649167310371 * w*(w2m1) * std::sin(2.*phi); - // l = 3, m = -1 - rn[2] = -(0.408248290463863*std::sqrt(w2m1)*((7.5)*w * w - 3./2.) * - std::sin(phi)); - // l = 3, m = 0 - rn[3] = 2.5 * std::pow(w, 3) - 1.5 * w; - // l = 3, m = 1 - rn[4] = -(0.408248290463863*std::sqrt(w2m1)*((7.5)*w * w - 3./2.) * - std::cos(phi)); - // l = 3, m = 2 - rn[5] = 1.93649167310371 * w*(w2m1) * std::cos(2.*phi); - // l = 3, m = 3 - rn[6] = -(0.790569415042095 * std::pow(w2m1, 1.5) * std::cos(3.* phi)); - break; - case 4: - // l = 4, m = -4 - rn[0] = 0.739509972887452 * (w2m1 * w2m1) * std::sin(4.0*phi); - // l = 4, m = -3 - rn[1] = -(2.09165006633519 * w * std::pow(w2m1, 1.5) * std::sin(3.* phi)); - // l = 4, m = -2 - rn[2] = 0.074535599249993 * (w2m1)*(52.5 * w * w - 7.5) * std::sin(2. *phi); - // l = 4, m = -1 - rn[3] = -(0.316227766016838*std::sqrt(w2m1)*(17.5 * std::pow(w, 3) - 7.5 * w) * - std::sin(phi)); - // l = 4, m = 0 - rn[4] = 4.375 * std::pow(w, 4) - 3.75 * w * w + 0.375; - // l = 4, m = 1 - rn[5] = -(0.316227766016838*std::sqrt(w2m1)*(17.5 * std::pow(w, 3) - 7.5*w) * - std::cos(phi)); - // l = 4, m = 2 - rn[6] = 0.074535599249993 * (w2m1)*(52.5*w * w - 7.5) * std::cos(2.*phi); - // l = 4, m = 3 - rn[7] = -(2.09165006633519 * w * std::pow(w2m1, 1.5) * std::cos(3.* phi)); - // l = 4, m = 4 - rn[8] = 0.739509972887452 * w2m1 * w2m1 * std::cos(4.0*phi); - break; - case 5: - // l = 5, m = -5 - rn[0] = -(0.701560760020114 * std::pow(w2m1, 2.5) * std::sin(5.0 * phi)); - // l = 5, m = -4 - rn[1] = 2.21852991866236 * w * w2m1 * w2m1 * std::sin(4.0 * phi); - // l = 5, m = -3 - rn[2] = -(0.00996023841111995 * std::pow(w2m1, 1.5) * - ((945.0 /2.)* w * w - 52.5) * std::sin(3.*phi)); - // l = 5, m = -2 - rn[3] = 0.0487950036474267 * (w2m1) - * ((315.0/2.)* std::pow(w, 3) - 52.5 * w) * std::sin(2.*phi); - // l = 5, m = -1 - rn[4] = -(0.258198889747161*std::sqrt(w2m1) * - (39.375 * std::pow(w, 4) - 105.0/4.0 * w * w + 15.0/8.0) * std::sin(phi)); - // l = 5, m = 0 - rn[5] = 7.875 * std::pow(w, 5) - 8.75 * std::pow(w, 3) + 1.875 * w; - // l = 5, m = 1 - rn[6] = -(0.258198889747161 * std::sqrt(w2m1)* - (39.375 * std::pow(w, 4) - 105.0/4.0 * w * w + 15.0/8.0) * std::cos(phi)); - // l = 5, m = 2 - rn[7] = 0.0487950036474267 * (w2m1) * - ((315.0 / 2.) * std::pow(w, 3) - 52.5*w) * std::cos(2.*phi); - // l = 5, m = 3 - rn[8] = -(0.00996023841111995 * std::pow(w2m1, 1.5) * - ((945.0 / 2.) * w * w - 52.5) * std::cos(3.*phi)); - // l = 5, m = 4 - rn[9] = 2.21852991866236 * w * w2m1 * w2m1 * std::cos(4.0*phi); - // l = 5, m = 5 - rn[10] = -(0.701560760020114 * std::pow(w2m1, 2.5) * std::cos(5.0* phi)); - break; - case 6: - // l = 6, m = -6 - rn[0] = 0.671693289381396 * std::pow(w2m1, 3) * std::sin(6.0*phi); - // l = 6, m = -5 - rn[1] = -(2.32681380862329 * w*std::pow(w2m1, 2.5) * std::sin(5.0*phi)); - // l = 6, m = -4 - rn[2] = 0.00104990131391452 * w2m1 * w2m1 * - ((10395.0/2.) * w * w - 945.0/2.) * std::sin(4.0 * phi); - // l = 6, m = -3 - rn[3] = -(0.00575054632785295 * std::pow(w2m1, 1.5) * - ((3465.0/2.) * std::pow(w, 3) - 945.0/2.*w) * std::sin(3.*phi)); - // l = 6, m = -2 - rn[4] = 0.0345032779671177 * (w2m1) * - ((3465.0/8.0)* std::pow(w, 4) - 945.0/4.0 * w * w + 105.0/8.0) * - std::sin(2. * phi); - // l = 6, m = -1 - rn[5] = -(0.218217890235992*std::sqrt(w2m1) * - ((693.0/8.0)* std::pow(w, 5)- 315.0/4.0 * std::pow(w, 3) + (105.0/8.0)*w) * - std::sin(phi)); - // l = 6, m = 0 - rn[6] = 14.4375 * std::pow(w, 6) - 19.6875 * std::pow(w, 4) + 6.5625 * w * w - - 0.3125; - // l = 6, m = 1 - rn[7] = -(0.218217890235992*std::sqrt(w2m1) * - ((693.0/8.0)* std::pow(w, 5)- 315.0/4.0 * std::pow(w, 3) + (105.0/8.0)*w) * - std::cos(phi)); - // l = 6, m = 2 - rn[8] = 0.0345032779671177 * w2m1 * - ((3465.0/8.0)* std::pow(w, 4) -945.0/4.0 * w * w + 105.0/8.0) * - std::cos(2.*phi); - // l = 6, m = 3 - rn[9] = -(0.00575054632785295 * std::pow(w2m1, 1.5) * - ((3465.0/2.) * std::pow(w, 3) - 945.0/2.*w) * std::cos(3.*phi)); - // l = 6, m = 4 - rn[10] = 0.00104990131391452 * w2m1 * w2m1 * - ((10395.0/2.)*w * w - 945.0/2.) * std::cos(4.0*phi); - // l = 6, m = 5 - rn[11] = -(2.32681380862329 * w * std::pow(w2m1, 2.5) * std::cos(5.0*phi)); - // l = 6, m = 6 - rn[12] = 0.671693289381396 * std::pow(w2m1, 3) * std::cos(6.0*phi); - break; - case 7: - // l = 7, m = -7 - rn[0] = -(0.647259849287749 * std::pow(w2m1, 3.5) * std::sin(7.0*phi)); - // l = 7, m = -6 - rn[1] = 2.42182459624969 * w*std::pow(w2m1, 3) * std::sin(6.0*phi); - // l = 7, m = -5 - rn[2] = -(9.13821798555235e-5*std::pow(w2m1, 2.5) * - ((135135.0/2.)*w * w - 10395.0/2.) * std::sin(5.0*phi)); - // l = 7, m = -4 - rn[3] = 0.000548293079133141 * w2m1 * w2m1 * - ((45045.0/2.)*std::pow(w, 3) - 10395.0/2.*w) * std::sin(4.0*phi); - // l = 7, m = -3 - rn[4] = -(0.00363696483726654 * std::pow(w2m1, 1.5) * - ((45045.0/8.0)* std::pow(w, 4) - 10395.0/4.0 * w * w + 945.0/8.0) * - std::sin(3.*phi)); - // l = 7, m = -2 - rn[5] = 0.025717224993682 * (w2m1) * - ((9009.0/8.0)* std::pow(w, 5) -3465.0/4.0 * std::pow(w, 3) + (945.0/8.0)*w) * - std::sin(2.*phi); - // l = 7, m = -1 - rn[6] = -(0.188982236504614*std::sqrt(w2m1) * - ((3003.0/16.0)* std::pow(w, 6) - 3465.0/16.0 * std::pow(w, 4) + - (945.0/16.0)*w * w - 35.0/16.0) * std::sin(phi)); - // l = 7, m = 0 - rn[7] = 26.8125 * std::pow(w, 7) - 43.3125 * std::pow(w, 5) + 19.6875 * std::pow(w, 3) - - 2.1875 * w; - // l = 7, m = 1 - rn[8] = -(0.188982236504614*std::sqrt(w2m1) * ((3003.0/16.0) * std::pow(w, 6) - - 3465.0/16.0 * std::pow(w, 4) + (945.0/16.0)*w * w - 35.0/16.0) * std::cos(phi)); - // l = 7, m = 2 - rn[9] = 0.025717224993682 * (w2m1) * ((9009.0/8.0)* std::pow(w, 5) - - 3465.0/4.0 * std::pow(w, 3) + (945.0/8.0)*w) * std::cos(2.*phi); - // l = 7, m = 3 - rn[10] = -(0.00363696483726654 * std::pow(w2m1, 1.5) * - ((45045.0/8.0)* std::pow(w, 4) - 10395.0/4.0 * w * w + 945.0/8.0) * - std::cos(3.*phi)); - // l = 7, m = 4 - rn[11] = 0.000548293079133141 * w2m1 * w2m1 * - ((45045.0/2.)*std::pow(w, 3) - 10395.0/2.*w) * std::cos(4.0*phi); - // l = 7, m = 5 - rn[12] = -(9.13821798555235e-5*std::pow(w2m1, 2.5) * - ((135135.0/2.)*w * w - 10395.0/2.) * std::cos(5.0*phi)); - // l = 7, m = 6 - rn[13] = 2.42182459624969 * w*std::pow(w2m1, 3) * std::cos(6.0*phi); - // l = 7, m = 7 - rn[14] = -(0.647259849287749 * std::pow(w2m1, 3.5) * std::cos(7.0*phi)); - break; - case 8: - // l = 8, m = -8 - rn[0] = 0.626706654240044 * std::pow(w2m1, 4) * std::sin(8.0*phi); - // l = 8, m = -7 - rn[1] = -(2.50682661696018 * w*std::pow(w2m1, 3.5) * std::sin(7.0*phi)); - // l = 8, m = -6 - rn[2] = 6.77369783729086e-6*std::pow(w2m1, 3)* - ((2027025.0/2.)*w * w - 135135.0/2.) * std::sin(6.0*phi); - // l = 8, m = -5 - rn[3] = -(4.38985792528482e-5*std::pow(w2m1, 2.5) * - ((675675.0/2.)*std::pow(w, 3) - 135135.0/2.*w) * std::sin(5.0*phi)); - // l = 8, m = -4 - rn[4] = 0.000316557156832328 * w2m1 * w2m1 * - ((675675.0/8.0)* std::pow(w, 4) - 135135.0/4.0 * w * w + 10395.0/8.0) * - std::sin(4.0*phi); - // l = 8, m = -3 - rn[5] = -(0.00245204119306875 * std::pow(w2m1, 1.5) * ((135135.0/8.0) * - std::pow(w, 5) - 45045.0/4.0 * std::pow(w, 3) + (10395.0/8.0)*w) * std::sin(3.*phi)); - // l = 8, m = -2 - rn[6] = 0.0199204768222399 * (w2m1) * - ((45045.0/16.0)* std::pow(w, 6)- 45045.0/16.0 * std::pow(w, 4) + - (10395.0/16.0)*w * w - 315.0/16.0) * std::sin(2.*phi); - // l = 8, m = -1 - rn[7] = -(0.166666666666667*std::sqrt(w2m1) * - ((6435.0/16.0)* std::pow(w, 7) - 9009.0/16.0 * std::pow(w, 5) + - (3465.0/16.0)*std::pow(w, 3) - 315.0/16.0 * w) * std::sin(phi)); - // l = 8, m = 0 - rn[8] = 50.2734375 * std::pow(w, 8) - 93.84375 * std::pow(w, 6) + 54.140625 * - std::pow(w, 4) - 9.84375 * w * w + 0.2734375; - // l = 8, m = 1 - rn[9] = -(0.166666666666667*std::sqrt(w2m1) * - ((6435.0/16.0)* std::pow(w, 7) - 9009.0/16.0 * std::pow(w, 5) + - (3465.0/16.0)*std::pow(w, 3) - 315.0/16.0 * w) * std::cos(phi)); - // l = 8, m = 2 - rn[10] = 0.0199204768222399 * (w2m1)*((45045.0/16.0)* std::pow(w, 6)- - 45045.0/16.0 * std::pow(w, 4) + (10395.0/16.0)*w * w - - 315.0/16.0) * std::cos(2.*phi); - // l = 8, m = 3 - rn[11] = -(0.00245204119306875 * std::pow(w2m1, 1.5)* - ((135135.0/8.0) * std::pow(w, 5) - 45045.0/4.0 * std::pow(w, 3) + - (10395.0/8.0)*w) * std::cos(3.*phi)); - // l = 8, m = 4 - rn[12] = 0.000316557156832328 * w2m1 * w2m1*((675675.0/8.0)* std::pow(w, 4) - - 135135.0/4.0 * w * w + 10395.0/8.0) * std::cos(4.0*phi); - // l = 8, m = 5 - rn[13] = -(4.38985792528482e-5*std::pow(w2m1, 2.5)*((675675.0/2.)*std::pow(w, 3) - - 135135.0/2.*w) * std::cos(5.0*phi)); - // l = 8, m = 6 - rn[14] = 6.77369783729086e-6*std::pow(w2m1, 3)*((2027025.0/2.)*w * w - - 135135.0/2.) * std::cos(6.0*phi); - // l = 8, m = 7 - rn[15] = -(2.50682661696018 * w*std::pow(w2m1, 3.5) * std::cos(7.0*phi)); - // l = 8, m = 8 - rn[16] = 0.626706654240044 * std::pow(w2m1, 4) * std::cos(8.0*phi); - break; - case 9: - // l = 9, m = -9 - rn[0] = -(0.609049392175524 * std::pow(w2m1, 4.5) * std::sin(9.0 * phi)); - // l = 9, m = -8 - rn[1] = 2.58397773170915 * w*std::pow(w2m1, 4) * std::sin(8.0 * phi); - // l = 9, m = -7 - rn[2] = -(4.37240315267812e-7*std::pow(w2m1, 3.5) * - ((34459425.0/2.)*w * w - 2027025.0/2.) * std::sin(7.0 * phi)); - // l = 9, m = -6 - rn[3] = 3.02928976464514e-6*std::pow(w2m1, 3)* - ((11486475.0/2.)*std::pow(w, 3) - 2027025.0/2.*w) * std::sin(6.0 * phi); - // l = 9, m = -5 - rn[4] = -(2.34647776186144e-5*std::pow(w2m1, 2.5) * - ((11486475.0/8.0)* std::pow(w, 4) - 2027025.0 / 4.0 * w * w + - 135135.0/8.0) * std::sin(5.0 * phi)); - // l = 9, m = -4 - rn[5] = 0.000196320414650061 * w2m1 * w2m1*((2297295.0/8.0)* std::pow(w, 5) - - 675675.0/4.0 * std::pow(w, 3) + (135135.0/8.0)*w) * std::sin(4.0*phi); - // l = 9, m = -3 - rn[6] = -(0.00173385495536766 * std::pow(w2m1, 1.5) * - ((765765.0/16.0)* std::pow(w, 6) - 675675.0/16.0 * std::pow(w, 4) + - (135135.0/16.0)*w * w - 3465.0/16.0) * std::sin(3. * phi)); - // l = 9, m = -2 - rn[7] = 0.0158910431540932 * (w2m1)*((109395.0/16.0)* std::pow(w, 7)- - 135135.0/16.0 * std::pow(w, 5) + (45045.0/16.0)*std::pow(w, 3) - - 3465.0/16.0 * w) * std::sin(2. * phi); - // l = 9, m = -1 - rn[8] = -(0.149071198499986*std::sqrt(w2m1)*((109395.0/128.0)* std::pow(w, 8) - - 45045.0/32.0 * std::pow(w, 6) + (45045.0/64.0)* std::pow(w, 4) - - 3465.0/32.0 * w * w + 315.0/128.0) * std::sin(phi)); - // l = 9, m = 0 - rn[9] = 94.9609375 * std::pow(w, 9) - 201.09375 * std::pow(w, 7) + - 140.765625 * std::pow(w, 5)- 36.09375 * std::pow(w, 3) + 2.4609375 * w; - // l = 9, m = 1 - rn[10] = -(0.149071198499986*std::sqrt(w2m1)*((109395.0/128.0)* std::pow(w, 8) - - 45045.0/32.0 * std::pow(w, 6) + (45045.0/64.0)* std::pow(w, 4) - - 3465.0/32.0 * w * w + 315.0/128.0) * std::cos(phi)); - // l = 9, m = 2 - rn[11] = 0.0158910431540932 * (w2m1)*((109395.0/16.0)* std::pow(w, 7) - - 135135.0/16.0 * std::pow(w, 5) + (45045.0/16.0)*std::pow(w, 3) - - 3465.0/ 16.0 * w) * std::cos(2. * phi); - // l = 9, m = 3 - rn[12] = -(0.00173385495536766 * std::pow(w2m1, 1.5)*((765765.0/16.0) * - std::pow(w, 6) - 675675.0/16.0 * std::pow(w, 4) + - (135135.0/16.0)* w * w - 3465.0/16.0)* std::cos(3. * phi)); - // l = 9, m = 4 - rn[13] = 0.000196320414650061 * w2m1 * w2m1*((2297295.0/8.0) * std::pow(w, 5) - - 675675.0/4.0 * std::pow(w, 3) + (135135.0/8.0)*w) * std::cos(4.0 * phi); - // l = 9, m = 5 - rn[14] = -(2.34647776186144e-5*std::pow(w2m1, 2.5)*((11486475.0/8.0) * - std::pow(w, 4) - 2027025.0/4.0 * w * w + 135135.0/8.0) * - std::cos(5.0 * phi)); - // l = 9, m = 6 - rn[15] = 3.02928976464514e-6*std::pow(w2m1, 3)*((11486475.0/2.)*std::pow(w, 3) - - 2027025.0/2. * w) * std::cos(6.0 * phi); - // l = 9, m = 7 - rn[16] = -(4.37240315267812e-7*std::pow(w2m1, 3.5)* - ((34459425.0/2.) * w * w - 2027025.0/2.) * std::cos(7.0 * phi)); - // l = 9, m = 8 - rn[17] = 2.58397773170915 * w*std::pow(w2m1, 4) * std::cos(8.0 * phi); - // l = 9, m = 9 - rn[18] = -(0.609049392175524 * std::pow(w2m1, 4.5) * std::cos(9.0 * phi)); - break; - case 10: - // l = 10, m = -10 - rn[0] = 0.593627917136573 * std::pow(w2m1, 5) * std::sin(10.0 * phi); - // l = 10, m = -9 - rn[1] = -(2.65478475211798 * w * std::pow(w2m1, 4.5) * std::sin(9.0 * phi)); - // l = 10, m = -8 - rn[2] = 2.49953651452314e-8 * std::pow(w2m1, 4) * - ((654729075.0/2.) * w * w - 34459425.0/2.) * std::sin(8.0 * phi); - // l = 10, m = -7 - rn[3] = -(1.83677671621093e-7*std::pow(w2m1, 3.5)* - ((218243025.0/2.)*std::pow(w, 3) - 34459425.0/2.*w) * - std::sin(7.0 * phi)); - // l = 10, m = -6 - rn[4] = 1.51464488232257e-6*std::pow(w2m1, 3)*((218243025.0/8.0)* std::pow(w, 4) - - 34459425.0/4.0 * w * w + 2027025.0/8.0) * std::sin(6.0 * phi); - // l = 10, m = -5 - rn[5] = -(1.35473956745817e-5*std::pow(w2m1, 2.5)* - ((43648605.0/8.0)* std::pow(w, 5) - 11486475.0/4.0 * std::pow(w, 3) + - (2027025.0/8.0)*w) * std::sin(5.0 * phi)); - // l = 10, m = -4 - rn[6] = 0.000128521880085575 * w2m1 * w2m1*((14549535.0/16.0)* std::pow(w, 6) - - 11486475.0/16.0 * std::pow(w, 4) + (2027025.0/16.0)*w * w - - 45045.0/16.0) * std::sin(4.0 * phi); - // l = 10, m = -3 - rn[7] = -(0.00127230170115096 * std::pow(w2m1, 1.5)* - ((2078505.0/16.0)* std::pow(w, 7) - 2297295.0/16.0 * std::pow(w, 5) + - (675675.0/16.0)*std::pow(w, 3) - 45045.0/16.0 * w) * std::sin(3. * phi)); - // l = 10, m = -2 - rn[8] = 0.012974982402692 * (w2m1)*((2078505.0/128.0)* std::pow(w, 8) - - 765765.0/32.0 * std::pow(w, 6) + (675675.0/64.0)* std::pow(w, 4) - - 45045.0/32.0 * w * w + 3465.0/128.0) * std::sin(2. * phi); - // l = 10, m = -1 - rn[9] = -(0.134839972492648*std::sqrt(w2m1)*((230945.0/128.0)* std::pow(w, 9) - - 109395.0/32.0 * std::pow(w, 7) + (135135.0/64.0)* std::pow(w, 5) - - 15015.0/32.0 * std::pow(w, 3) + (3465.0/128.0)*w) * std::sin(phi)); - // l = 10, m = 0 - rn[10] = 180.42578125 * std::pow(w, 10) - 427.32421875 * std::pow(w, 8) +351.9140625 - * std::pow(w, 6) - 117.3046875 * std::pow(w, 4) + 13.53515625 * w * w -0.24609375; - // l = 10, m = 1 - rn[11] = -(0.134839972492648*std::sqrt(w2m1)*((230945.0/128.0)* std::pow(w, 9) - - 109395.0/32.0 * std::pow(w, 7) + (135135.0/64.0)* std::pow(w, 5) -15015.0/ - 32.0 * std::pow(w, 3) + (3465.0/128.0)*w) * std::cos(phi)); - // l = 10, m = 2 - rn[12] = 0.012974982402692 * (w2m1)*((2078505.0/128.0)* std::pow(w, 8) - - 765765.0/32.0 * std::pow(w, 6) + (675675.0/64.0)* std::pow(w, 4) - - 45045.0/32.0 * w * w + 3465.0/128.0) * std::cos(2. * phi); - // l = 10, m = 3 - rn[13] = -(0.00127230170115096 * std::pow(w2m1, 1.5)* - ((2078505.0/16.0)* std::pow(w, 7) - 2297295.0/16.0 * std::pow(w, 5) + - (675675.0/16.0)*std::pow(w, 3) - 45045.0/16.0 * w) * std::cos(3. * phi)); - // l = 10, m = 4 - rn[14] = 0.000128521880085575 * w2m1 * w2m1*((14549535.0/16.0)* std::pow(w, 6) - - 11486475.0/16.0 * std::pow(w, 4) + (2027025.0/16.0) * w * w - - 45045.0/16.0) * std::cos(4.0 * phi); - // l = 10, m = 5 - rn[15] = -(1.35473956745817e-5*std::pow(w2m1, 2.5)* - ((43648605.0/8.0)* std::pow(w, 5) - 11486475.0/4.0 * std::pow(w, 3) + - (2027025.0/8.0)*w) * std::cos(5.0 * phi)); - // l = 10, m = 6 - rn[16] = 1.51464488232257e-6*std::pow(w2m1, 3)*((218243025.0/8.0)* std::pow(w, 4) - - 34459425.0/4.0 * w * w + 2027025.0/8.0) * std::cos(6.0 * phi); - // l = 10, m = 7 - rn[17] = -(1.83677671621093e-7*std::pow(w2m1, 3.5) * - ((218243025.0/2.)*std::pow(w, 3) - 34459425.0/2.*w) * std::cos(7.0 * phi)); - // l = 10, m = 8 - rn[18] = 2.49953651452314e-8*std::pow(w2m1, 4)* - ((654729075.0/2.)*w * w - 34459425.0/2.) * std::cos(8.0 * phi); - // l = 10, m = 9 - rn[19] = -(2.65478475211798 * w*std::pow(w2m1, 4.5) * std::cos(9.0 * phi)); - // l = 10, m = 10 - rn[20] = 0.593627917136573 * std::pow(w2m1, 5) * std::cos(10.0 * phi); + // Now evaluate the spherical harmonics function + rn[0] = 1.; + i = 0; + for (l = 1; l <= n; l++) { + // Set the index to the start of this order + i += 2 * (l - 1) + 1; + + // Now evaluate each + switch (l) { + case 1: + // l = 1, m = -1 + rn[i] = -(std::sqrt(w2m1) * std::sin(phi)); + // l = 1, m = 0 + rn[i + 1] = w; + // l = 1, m = 1 + rn[i + 2] = -(std::sqrt(w2m1) * std::cos(phi)); + break; + case 2: + // l = 2, m = -2 + rn[i] = 0.288675134594813 * (-3. * w * w + 3.) * std::sin(2. * phi); + // l = 2, m = -1 + rn[i + 1] = -(1.73205080756888 * w*std::sqrt(w2m1) * std::sin(phi)); + // l = 2, m = 0 + rn[i + 2] = 1.5 * w * w - 0.5; + // l = 2, m = 1 + rn[i + 3] = -(1.73205080756888 * w*std::sqrt(w2m1) * std::cos(phi)); + // l = 2, m = 2 + rn[i + 4] = 0.288675134594813 * (-3. * w * w + 3.) * std::cos(2. * phi); + break; + case 3: + // l = 3, m = -3 + rn[i] = -(0.790569415042095 * std::pow(w2m1, 1.5) * std::sin(3. * phi)); + // l = 3, m = -2 + rn[i + 1] = 1.93649167310371 * w*(w2m1) * std::sin(2.*phi); + // l = 3, m = -1 + rn[i + 2] = -(0.408248290463863*std::sqrt(w2m1)*((7.5)*w * w - 3./2.) * + std::sin(phi)); + // l = 3, m = 0 + rn[i + 3] = 2.5 * std::pow(w, 3) - 1.5 * w; + // l = 3, m = 1 + rn[i + 4] = -(0.408248290463863*std::sqrt(w2m1)*((7.5)*w * w - 3./2.) * + std::cos(phi)); + // l = 3, m = 2 + rn[i + 5] = 1.93649167310371 * w*(w2m1) * std::cos(2.*phi); + // l = 3, m = 3 + rn[i + 6] = -(0.790569415042095 * std::pow(w2m1, 1.5) * std::cos(3.* phi)); + break; + case 4: + // l = 4, m = -4 + rn[i] = 0.739509972887452 * (w2m1 * w2m1) * std::sin(4.0*phi); + // l = 4, m = -3 + rn[i + 1] = -(2.09165006633519 * w * std::pow(w2m1, 1.5) * std::sin(3.* phi)); + // l = 4, m = -2 + rn[i + 2] = 0.074535599249993 * (w2m1)*(52.5 * w * w - 7.5) * std::sin(2. *phi); + // l = 4, m = -1 + rn[i + 3] = -(0.316227766016838*std::sqrt(w2m1)*(17.5 * std::pow(w, 3) - 7.5 * w) * + std::sin(phi)); + // l = 4, m = 0 + rn[i + 4] = 4.375 * std::pow(w, 4) - 3.75 * w * w + 0.375; + // l = 4, m = 1 + rn[i + 5] = -(0.316227766016838*std::sqrt(w2m1)*(17.5 * std::pow(w, 3) - 7.5*w) * + std::cos(phi)); + // l = 4, m = 2 + rn[i + 6] = 0.074535599249993 * (w2m1)*(52.5*w * w - 7.5) * std::cos(2.*phi); + // l = 4, m = 3 + rn[i + 7] = -(2.09165006633519 * w * std::pow(w2m1, 1.5) * std::cos(3.* phi)); + // l = 4, m = 4 + rn[i + 8] = 0.739509972887452 * w2m1 * w2m1 * std::cos(4.0*phi); + break; + case 5: + // l = 5, m = -5 + rn[i] = -(0.701560760020114 * std::pow(w2m1, 2.5) * std::sin(5.0 * phi)); + // l = 5, m = -4 + rn[i + 1] = 2.21852991866236 * w * w2m1 * w2m1 * std::sin(4.0 * phi); + // l = 5, m = -3 + rn[i + 2] = -(0.00996023841111995 * std::pow(w2m1, 1.5) * + ((945.0 /2.)* w * w - 52.5) * std::sin(3.*phi)); + // l = 5, m = -2 + rn[i + 3] = 0.0487950036474267 * (w2m1) + * ((315.0/2.)* std::pow(w, 3) - 52.5 * w) * std::sin(2.*phi); + // l = 5, m = -1 + rn[i + 4] = -(0.258198889747161*std::sqrt(w2m1) * + (39.375 * std::pow(w, 4) - 105.0/4.0 * w * w + 15.0/8.0) * std::sin(phi)); + // l = 5, m = 0 + rn[i + 5] = 7.875 * std::pow(w, 5) - 8.75 * std::pow(w, 3) + 1.875 * w; + // l = 5, m = 1 + rn[i + 6] = -(0.258198889747161 * std::sqrt(w2m1)* + (39.375 * std::pow(w, 4) - 105.0/4.0 * w * w + 15.0/8.0) * std::cos(phi)); + // l = 5, m = 2 + rn[i + 7] = 0.0487950036474267 * (w2m1) * + ((315.0 / 2.) * std::pow(w, 3) - 52.5*w) * std::cos(2.*phi); + // l = 5, m = 3 + rn[i + 8] = -(0.00996023841111995 * std::pow(w2m1, 1.5) * + ((945.0 / 2.) * w * w - 52.5) * std::cos(3.*phi)); + // l = 5, m = 4 + rn[i + 9] = 2.21852991866236 * w * w2m1 * w2m1 * std::cos(4.0*phi); + // l = 5, m = 5 + rn[i + 10] = -(0.701560760020114 * std::pow(w2m1, 2.5) * std::cos(5.0* phi)); + break; + case 6: + // l = 6, m = -6 + rn[i] = 0.671693289381396 * std::pow(w2m1, 3) * std::sin(6.0*phi); + // l = 6, m = -5 + rn[i + 1] = -(2.32681380862329 * w*std::pow(w2m1, 2.5) * std::sin(5.0*phi)); + // l = 6, m = -4 + rn[i + 2] = 0.00104990131391452 * w2m1 * w2m1 * + ((10395.0/2.) * w * w - 945.0/2.) * std::sin(4.0 * phi); + // l = 6, m = -3 + rn[i + 3] = -(0.00575054632785295 * std::pow(w2m1, 1.5) * + ((3465.0/2.) * std::pow(w, 3) - 945.0/2.*w) * std::sin(3.*phi)); + // l = 6, m = -2 + rn[i + 4] = 0.0345032779671177 * (w2m1) * + ((3465.0/8.0)* std::pow(w, 4) - 945.0/4.0 * w * w + 105.0/8.0) * + std::sin(2. * phi); + // l = 6, m = -1 + rn[i + 5] = -(0.218217890235992*std::sqrt(w2m1) * + ((693.0/8.0)* std::pow(w, 5)- 315.0/4.0 * std::pow(w, 3) + (105.0/8.0)*w) * + std::sin(phi)); + // l = 6, m = 0 + rn[i + 6] = 14.4375 * std::pow(w, 6) - 19.6875 * std::pow(w, 4) + 6.5625 * w * w - + 0.3125; + // l = 6, m = 1 + rn[i + 7] = -(0.218217890235992*std::sqrt(w2m1) * + ((693.0/8.0)* std::pow(w, 5)- 315.0/4.0 * std::pow(w, 3) + (105.0/8.0)*w) * + std::cos(phi)); + // l = 6, m = 2 + rn[i + 8] = 0.0345032779671177 * w2m1 * + ((3465.0/8.0)* std::pow(w, 4) -945.0/4.0 * w * w + 105.0/8.0) * + std::cos(2.*phi); + // l = 6, m = 3 + rn[i + 9] = -(0.00575054632785295 * std::pow(w2m1, 1.5) * + ((3465.0/2.) * std::pow(w, 3) - 945.0/2.*w) * std::cos(3.*phi)); + // l = 6, m = 4 + rn[i + 10] = 0.00104990131391452 * w2m1 * w2m1 * + ((10395.0/2.)*w * w - 945.0/2.) * std::cos(4.0*phi); + // l = 6, m = 5 + rn[i + 11] = -(2.32681380862329 * w * std::pow(w2m1, 2.5) * std::cos(5.0*phi)); + // l = 6, m = 6 + rn[i + 12] = 0.671693289381396 * std::pow(w2m1, 3) * std::cos(6.0*phi); + break; + case 7: + // l = 7, m = -7 + rn[i] = -(0.647259849287749 * std::pow(w2m1, 3.5) * std::sin(7.0*phi)); + // l = 7, m = -6 + rn[i + 1] = 2.42182459624969 * w*std::pow(w2m1, 3) * std::sin(6.0*phi); + // l = 7, m = -5 + rn[i + 2] = -(9.13821798555235e-5*std::pow(w2m1, 2.5) * + ((135135.0/2.)*w * w - 10395.0/2.) * std::sin(5.0*phi)); + // l = 7, m = -4 + rn[i + 3] = 0.000548293079133141 * w2m1 * w2m1 * + ((45045.0/2.)*std::pow(w, 3) - 10395.0/2.*w) * std::sin(4.0*phi); + // l = 7, m = -3 + rn[i + 4] = -(0.00363696483726654 * std::pow(w2m1, 1.5) * + ((45045.0/8.0)* std::pow(w, 4) - 10395.0/4.0 * w * w + 945.0/8.0) * + std::sin(3.*phi)); + // l = 7, m = -2 + rn[i + 5] = 0.025717224993682 * (w2m1) * + ((9009.0/8.0)* std::pow(w, 5) -3465.0/4.0 * std::pow(w, 3) + (945.0/8.0)*w) * + std::sin(2.*phi); + // l = 7, m = -1 + rn[i + 6] = -(0.188982236504614*std::sqrt(w2m1) * + ((3003.0/16.0)* std::pow(w, 6) - 3465.0/16.0 * std::pow(w, 4) + + (945.0/16.0)*w * w - 35.0/16.0) * std::sin(phi)); + // l = 7, m = 0 + rn[i + 7] = 26.8125 * std::pow(w, 7) - 43.3125 * std::pow(w, 5) + 19.6875 * std::pow(w, 3) - + 2.1875 * w; + // l = 7, m = 1 + rn[i + 8] = -(0.188982236504614*std::sqrt(w2m1) * ((3003.0/16.0) * std::pow(w, 6) - + 3465.0/16.0 * std::pow(w, 4) + (945.0/16.0)*w * w - 35.0/16.0) * std::cos(phi)); + // l = 7, m = 2 + rn[i + 9] = 0.025717224993682 * (w2m1) * ((9009.0/8.0)* std::pow(w, 5) - + 3465.0/4.0 * std::pow(w, 3) + (945.0/8.0)*w) * std::cos(2.*phi); + // l = 7, m = 3 + rn[i + 10] = -(0.00363696483726654 * std::pow(w2m1, 1.5) * + ((45045.0/8.0)* std::pow(w, 4) - 10395.0/4.0 * w * w + 945.0/8.0) * + std::cos(3.*phi)); + // l = 7, m = 4 + rn[i + 11] = 0.000548293079133141 * w2m1 * w2m1 * + ((45045.0/2.)*std::pow(w, 3) - 10395.0/2.*w) * std::cos(4.0*phi); + // l = 7, m = 5 + rn[i + 12] = -(9.13821798555235e-5*std::pow(w2m1, 2.5) * + ((135135.0/2.)*w * w - 10395.0/2.) * std::cos(5.0*phi)); + // l = 7, m = 6 + rn[i + 13] = 2.42182459624969 * w*std::pow(w2m1, 3) * std::cos(6.0*phi); + // l = 7, m = 7 + rn[i + 14] = -(0.647259849287749 * std::pow(w2m1, 3.5) * std::cos(7.0*phi)); + break; + case 8: + // l = 8, m = -8 + rn[i] = 0.626706654240044 * std::pow(w2m1, 4) * std::sin(8.0*phi); + // l = 8, m = -7 + rn[i + 1] = -(2.50682661696018 * w*std::pow(w2m1, 3.5) * std::sin(7.0*phi)); + // l = 8, m = -6 + rn[i + 2] = 6.77369783729086e-6*std::pow(w2m1, 3)* + ((2027025.0/2.)*w * w - 135135.0/2.) * std::sin(6.0*phi); + // l = 8, m = -5 + rn[i + 3] = -(4.38985792528482e-5*std::pow(w2m1, 2.5) * + ((675675.0/2.)*std::pow(w, 3) - 135135.0/2.*w) * std::sin(5.0*phi)); + // l = 8, m = -4 + rn[i + 4] = 0.000316557156832328 * w2m1 * w2m1 * + ((675675.0/8.0)* std::pow(w, 4) - 135135.0/4.0 * w * w + 10395.0/8.0) * + std::sin(4.0*phi); + // l = 8, m = -3 + rn[i + 5] = -(0.00245204119306875 * std::pow(w2m1, 1.5) * ((135135.0/8.0) * + std::pow(w, 5) - 45045.0/4.0 * std::pow(w, 3) + (10395.0/8.0)*w) * std::sin(3.*phi)); + // l = 8, m = -2 + rn[i + 6] = 0.0199204768222399 * (w2m1) * + ((45045.0/16.0)* std::pow(w, 6)- 45045.0/16.0 * std::pow(w, 4) + + (10395.0/16.0)*w * w - 315.0/16.0) * std::sin(2.*phi); + // l = 8, m = -1 + rn[i + 7] = -(0.166666666666667*std::sqrt(w2m1) * + ((6435.0/16.0)* std::pow(w, 7) - 9009.0/16.0 * std::pow(w, 5) + + (3465.0/16.0)*std::pow(w, 3) - 315.0/16.0 * w) * std::sin(phi)); + // l = 8, m = 0 + rn[i + 8] = 50.2734375 * std::pow(w, 8) - 93.84375 * std::pow(w, 6) + 54.140625 * + std::pow(w, 4) - 9.84375 * w * w + 0.2734375; + // l = 8, m = 1 + rn[i + 9] = -(0.166666666666667*std::sqrt(w2m1) * + ((6435.0/16.0)* std::pow(w, 7) - 9009.0/16.0 * std::pow(w, 5) + + (3465.0/16.0)*std::pow(w, 3) - 315.0/16.0 * w) * std::cos(phi)); + // l = 8, m = 2 + rn[i + 10] = 0.0199204768222399 * (w2m1)*((45045.0/16.0)* std::pow(w, 6)- + 45045.0/16.0 * std::pow(w, 4) + (10395.0/16.0)*w * w - + 315.0/16.0) * std::cos(2.*phi); + // l = 8, m = 3 + rn[i + 11] = -(0.00245204119306875 * std::pow(w2m1, 1.5)* + ((135135.0/8.0) * std::pow(w, 5) - 45045.0/4.0 * std::pow(w, 3) + + (10395.0/8.0)*w) * std::cos(3.*phi)); + // l = 8, m = 4 + rn[i + 12] = 0.000316557156832328 * w2m1 * w2m1*((675675.0/8.0)* std::pow(w, 4) - + 135135.0/4.0 * w * w + 10395.0/8.0) * std::cos(4.0*phi); + // l = 8, m = 5 + rn[i + 13] = -(4.38985792528482e-5*std::pow(w2m1, 2.5)*((675675.0/2.)*std::pow(w, 3) - + 135135.0/2.*w) * std::cos(5.0*phi)); + // l = 8, m = 6 + rn[i + 14] = 6.77369783729086e-6*std::pow(w2m1, 3)*((2027025.0/2.)*w * w - + 135135.0/2.) * std::cos(6.0*phi); + // l = 8, m = 7 + rn[i + 15] = -(2.50682661696018 * w*std::pow(w2m1, 3.5) * std::cos(7.0*phi)); + // l = 8, m = 8 + rn[i + 16] = 0.626706654240044 * std::pow(w2m1, 4) * std::cos(8.0*phi); + break; + case 9: + // l = 9, m = -9 + rn[i] = -(0.609049392175524 * std::pow(w2m1, 4.5) * std::sin(9.0 * phi)); + // l = 9, m = -8 + rn[i + 1] = 2.58397773170915 * w*std::pow(w2m1, 4) * std::sin(8.0 * phi); + // l = 9, m = -7 + rn[i + 2] = -(4.37240315267812e-7*std::pow(w2m1, 3.5) * + ((34459425.0/2.)*w * w - 2027025.0/2.) * std::sin(7.0 * phi)); + // l = 9, m = -6 + rn[i + 3] = 3.02928976464514e-6*std::pow(w2m1, 3)* + ((11486475.0/2.)*std::pow(w, 3) - 2027025.0/2.*w) * std::sin(6.0 * phi); + // l = 9, m = -5 + rn[i + 4] = -(2.34647776186144e-5*std::pow(w2m1, 2.5) * + ((11486475.0/8.0)* std::pow(w, 4) - 2027025.0 / 4.0 * w * w + + 135135.0/8.0) * std::sin(5.0 * phi)); + // l = 9, m = -4 + rn[i + 5] = 0.000196320414650061 * w2m1 * w2m1*((2297295.0/8.0)* std::pow(w, 5) - + 675675.0/4.0 * std::pow(w, 3) + (135135.0/8.0)*w) * std::sin(4.0*phi); + // l = 9, m = -3 + rn[i + 6] = -(0.00173385495536766 * std::pow(w2m1, 1.5) * + ((765765.0/16.0)* std::pow(w, 6) - 675675.0/16.0 * std::pow(w, 4) + + (135135.0/16.0)*w * w - 3465.0/16.0) * std::sin(3. * phi)); + // l = 9, m = -2 + rn[i + 7] = 0.0158910431540932 * (w2m1)*((109395.0/16.0)* std::pow(w, 7)- + 135135.0/16.0 * std::pow(w, 5) + (45045.0/16.0)*std::pow(w, 3) - + 3465.0/16.0 * w) * std::sin(2. * phi); + // l = 9, m = -1 + rn[i + 8] = -(0.149071198499986*std::sqrt(w2m1)*((109395.0/128.0)* std::pow(w, 8) - + 45045.0/32.0 * std::pow(w, 6) + (45045.0/64.0)* std::pow(w, 4) - + 3465.0/32.0 * w * w + 315.0/128.0) * std::sin(phi)); + // l = 9, m = 0 + rn[i + 9] = 94.9609375 * std::pow(w, 9) - 201.09375 * std::pow(w, 7) + + 140.765625 * std::pow(w, 5)- 36.09375 * std::pow(w, 3) + 2.4609375 * w; + // l = 9, m = 1 + rn[i + 10] = -(0.149071198499986*std::sqrt(w2m1)*((109395.0/128.0)* std::pow(w, 8) - + 45045.0/32.0 * std::pow(w, 6) + (45045.0/64.0)* std::pow(w, 4) - + 3465.0/32.0 * w * w + 315.0/128.0) * std::cos(phi)); + // l = 9, m = 2 + rn[i + 11] = 0.0158910431540932 * (w2m1)*((109395.0/16.0)* std::pow(w, 7) - + 135135.0/16.0 * std::pow(w, 5) + (45045.0/16.0)*std::pow(w, 3) - + 3465.0/ 16.0 * w) * std::cos(2. * phi); + // l = 9, m = 3 + rn[i + 12] = -(0.00173385495536766 * std::pow(w2m1, 1.5)*((765765.0/16.0) * + std::pow(w, 6) - 675675.0/16.0 * std::pow(w, 4) + + (135135.0/16.0)* w * w - 3465.0/16.0)* std::cos(3. * phi)); + // l = 9, m = 4 + rn[i + 13] = 0.000196320414650061 * w2m1 * w2m1*((2297295.0/8.0) * std::pow(w, 5) - + 675675.0/4.0 * std::pow(w, 3) + (135135.0/8.0)*w) * std::cos(4.0 * phi); + // l = 9, m = 5 + rn[i + 14] = -(2.34647776186144e-5*std::pow(w2m1, 2.5)*((11486475.0/8.0) * + std::pow(w, 4) - 2027025.0/4.0 * w * w + 135135.0/8.0) * + std::cos(5.0 * phi)); + // l = 9, m = 6 + rn[i + 15] = 3.02928976464514e-6*std::pow(w2m1, 3)*((11486475.0/2.)*std::pow(w, 3) - + 2027025.0/2. * w) * std::cos(6.0 * phi); + // l = 9, m = 7 + rn[i + 16] = -(4.37240315267812e-7*std::pow(w2m1, 3.5)* + ((34459425.0/2.) * w * w - 2027025.0/2.) * std::cos(7.0 * phi)); + // l = 9, m = 8 + rn[i + 17] = 2.58397773170915 * w*std::pow(w2m1, 4) * std::cos(8.0 * phi); + // l = 9, m = 9 + rn[i + 18] = -(0.609049392175524 * std::pow(w2m1, 4.5) * std::cos(9.0 * phi)); + break; + case 10: + // l = 10, m = -10 + rn[i] = 0.593627917136573 * std::pow(w2m1, 5) * std::sin(10.0 * phi); + // l = 10, m = -9 + rn[i + 1] = -(2.65478475211798 * w * std::pow(w2m1, 4.5) * std::sin(9.0 * phi)); + // l = 10, m = -8 + rn[i + 2] = 2.49953651452314e-8 * std::pow(w2m1, 4) * + ((654729075.0/2.) * w * w - 34459425.0/2.) * std::sin(8.0 * phi); + // l = 10, m = -7 + rn[i + 3] = -(1.83677671621093e-7*std::pow(w2m1, 3.5)* + ((218243025.0/2.)*std::pow(w, 3) - 34459425.0/2.*w) * + std::sin(7.0 * phi)); + // l = 10, m = -6 + rn[i + 4] = 1.51464488232257e-6*std::pow(w2m1, 3)*((218243025.0/8.0)* std::pow(w, 4) - + 34459425.0/4.0 * w * w + 2027025.0/8.0) * std::sin(6.0 * phi); + // l = 10, m = -5 + rn[i + 5] = -(1.35473956745817e-5*std::pow(w2m1, 2.5)* + ((43648605.0/8.0)* std::pow(w, 5) - 11486475.0/4.0 * std::pow(w, 3) + + (2027025.0/8.0)*w) * std::sin(5.0 * phi)); + // l = 10, m = -4 + rn[i + 6] = 0.000128521880085575 * w2m1 * w2m1*((14549535.0/16.0)* std::pow(w, 6) - + 11486475.0/16.0 * std::pow(w, 4) + (2027025.0/16.0)*w * w - + 45045.0/16.0) * std::sin(4.0 * phi); + // l = 10, m = -3 + rn[i + 7] = -(0.00127230170115096 * std::pow(w2m1, 1.5)* + ((2078505.0/16.0)* std::pow(w, 7) - 2297295.0/16.0 * std::pow(w, 5) + + (675675.0/16.0)*std::pow(w, 3) - 45045.0/16.0 * w) * std::sin(3. * phi)); + // l = 10, m = -2 + rn[i + 8] = 0.012974982402692 * (w2m1)*((2078505.0/128.0)* std::pow(w, 8) - + 765765.0/32.0 * std::pow(w, 6) + (675675.0/64.0)* std::pow(w, 4) - + 45045.0/32.0 * w * w + 3465.0/128.0) * std::sin(2. * phi); + // l = 10, m = -1 + rn[i + 9] = -(0.134839972492648*std::sqrt(w2m1)*((230945.0/128.0)* std::pow(w, 9) - + 109395.0/32.0 * std::pow(w, 7) + (135135.0/64.0)* std::pow(w, 5) - + 15015.0/32.0 * std::pow(w, 3) + (3465.0/128.0)*w) * std::sin(phi)); + // l = 10, m = 0 + rn[i + 10] = 180.42578125 * std::pow(w, 10) - 427.32421875 * std::pow(w, 8) +351.9140625 + * std::pow(w, 6) - 117.3046875 * std::pow(w, 4) + 13.53515625 * w * w -0.24609375; + // l = 10, m = 1 + rn[i + 11] = -(0.134839972492648*std::sqrt(w2m1)*((230945.0/128.0)* std::pow(w, 9) - + 109395.0/32.0 * std::pow(w, 7) + (135135.0/64.0)* std::pow(w, 5) -15015.0/ + 32.0 * std::pow(w, 3) + (3465.0/128.0)*w) * std::cos(phi)); + // l = 10, m = 2 + rn[i + 12] = 0.012974982402692 * (w2m1)*((2078505.0/128.0)* std::pow(w, 8) - + 765765.0/32.0 * std::pow(w, 6) + (675675.0/64.0)* std::pow(w, 4) - + 45045.0/32.0 * w * w + 3465.0/128.0) * std::cos(2. * phi); + // l = 10, m = 3 + rn[i + 13] = -(0.00127230170115096 * std::pow(w2m1, 1.5)* + ((2078505.0/16.0)* std::pow(w, 7) - 2297295.0/16.0 * std::pow(w, 5) + + (675675.0/16.0)*std::pow(w, 3) - 45045.0/16.0 * w) * std::cos(3. * phi)); + // l = 10, m = 4 + rn[i + 14] = 0.000128521880085575 * w2m1 * w2m1*((14549535.0/16.0)* std::pow(w, 6) - + 11486475.0/16.0 * std::pow(w, 4) + (2027025.0/16.0) * w * w - + 45045.0/16.0) * std::cos(4.0 * phi); + // l = 10, m = 5 + rn[i + 15] = -(1.35473956745817e-5*std::pow(w2m1, 2.5)* + ((43648605.0/8.0)* std::pow(w, 5) - 11486475.0/4.0 * std::pow(w, 3) + + (2027025.0/8.0)*w) * std::cos(5.0 * phi)); + // l = 10, m = 6 + rn[i + 16] = 1.51464488232257e-6*std::pow(w2m1, 3)*((218243025.0/8.0)* std::pow(w, 4) - + 34459425.0/4.0 * w * w + 2027025.0/8.0) * std::cos(6.0 * phi); + // l = 10, m = 7 + rn[i + 17] = -(1.83677671621093e-7*std::pow(w2m1, 3.5) * + ((218243025.0/2.)*std::pow(w, 3) - 34459425.0/2.*w) * std::cos(7.0 * phi)); + // l = 10, m = 8 + rn[i + 18] = 2.49953651452314e-8*std::pow(w2m1, 4)* + ((654729075.0/2.)*w * w - 34459425.0/2.) * std::cos(8.0 * phi); + // l = 10, m = 9 + rn[i + 19] = -(2.65478475211798 * w*std::pow(w2m1, 4.5) * std::cos(9.0 * phi)); + // l = 10, m = 10 + rn[i + 20] = 0.593627917136573 * std::pow(w2m1, 5) * std::cos(10.0 * phi); + } } } @@ -585,7 +555,7 @@ void calc_rn_c(int n, double uvw[3], double rn[]){ // exactly pi //============================================================================== -void calc_zn_c(int n, double rho, double phi, double zn[]) { +void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { // This procedure uses the modified Kintner's method for calculating Zernike // polynomials as outlined in Chong, C. W., Raveendran, P., & Mukundan, // R. (2003). A comparative analysis of algorithms for fast computation of @@ -689,7 +659,7 @@ void calc_zn_c(int n, double rho, double phi, double zn[]) { // and SERPENT. //============================================================================== -void rotate_angle_c(double uvw[3], double mu, double phi) { +void rotate_angle_c(double uvw[3], const double mu, double phi) { double phi_; // azimuthal angle double sinphi; // std::sine of azimuthal angle double cosphi; // cosine of azimuthal angle @@ -738,7 +708,7 @@ void rotate_angle_c(double uvw[3], double mu, double phi) { // This PDF can be sampled using rule C64 in the Monte Carlo Sampler LA-9721-MS. //============================================================================== -double maxwell_spectrum_c(double T) { +double maxwell_spectrum_c(const double T) { double E_out; // Sampled Energy double r1; @@ -768,7 +738,7 @@ double maxwell_spectrum_c(double T) { // MC lectures). //============================================================================== -double watt_spectrum_c(double a, double b) { +double watt_spectrum_c(const double a, const double b) { double E_out; // Sampled Energy double w; // sampled from Maxwellian @@ -836,7 +806,8 @@ double watt_spectrum_c(double a, double b) { // The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... //============================================================================== -void broaden_wmp_polynomials_c(double E, double dopp, int n, double factors[]) { +void broaden_wmp_polynomials_c(const double E, const double dopp, const int n, + double factors[]) { // Factors is already pre-allocated double sqrtE; // sqrt(energy) diff --git a/src/math_functions.h b/src/math_functions.h index ab35d140a..8df72f56c 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -23,35 +23,37 @@ const double SQRT_PI = std::sqrt(PI); // distribution with a specified probability level //============================================================================== -extern "C" double normal_percentile_c(double p) __attribute__ ((const)); +extern "C" double normal_percentile_c(const double p) __attribute__ ((const)); //============================================================================== // T_PERCENTILE calculates the percentile of the Student's t distribution with // a specified probability level and number of degrees of freedom //============================================================================== -extern "C" double t_percentile_c(double p, int df) __attribute__ ((const)); +extern "C" double t_percentile_c(const double p, const int df) + __attribute__ ((const)); //============================================================================== -// CALC_PN calculates the n-th order Legendre polynomial at the value of x. +// CALC_PN calculates the n-th order Legendre polynomials at the value of x. //============================================================================== -extern "C" double calc_pn_c(int n, double x) __attribute__ ((const)); +extern "C" void calc_pn_c(const int n, const double x, double pnx[]); //============================================================================== // EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients // and the value of x //============================================================================== -extern "C" double evaluate_legendre_c(int n, double data[], double x) - __attribute__ ((const)); +extern "C" double evaluate_legendre_c(const int n, const double data[], + const double x) __attribute__ ((const)); //============================================================================== // CALC_RN calculates the n-th order spherical harmonics for a given angle -// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) +// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) for n +// all 0 <= n //============================================================================== -extern "C" void calc_rn_c(int n, double uvw[3], double rn[]); +extern "C" void calc_rn_c(const int n, const double uvw[3], double rn[]); //============================================================================== // CALC_ZN calculates the n-th order modified Zernike polynomial moment for a @@ -60,7 +62,8 @@ extern "C" void calc_rn_c(int n, double uvw[3], double rn[]); // exactly pi //============================================================================== -extern "C" void calc_zn_c(int n, double rho, double phi, double zn[]); +extern "C" void calc_zn_c(const int n, const double rho, const double phi, + double zn[]); //============================================================================== // ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is @@ -68,7 +71,8 @@ extern "C" void calc_zn_c(int n, double rho, double phi, double zn[]); // with direct sampling rather than rejection as is done in MCNP and SERPENT. //============================================================================== -extern "C" void rotate_angle_c(double uvw[3], double mu, double phi = -10.); +extern "C" void rotate_angle_c(double uvw[3], const double mu, + double phi = -10.); //============================================================================== // MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution @@ -77,7 +81,7 @@ extern "C" void rotate_angle_c(double uvw[3], double mu, double phi = -10.); // This PDF can be sampled using rule C64 in the Monte Carlo Sampler LA-9721-MS. //============================================================================== -extern "C" double maxwell_spectrum_c(double T); +extern "C" double maxwell_spectrum_c(const double T); //============================================================================== // WATT_SPECTRUM samples the outgoing energy from a Watt energy-dependent @@ -88,7 +92,7 @@ extern "C" double maxwell_spectrum_c(double T); // MC lectures). //============================================================================== -extern "C" double watt_spectrum_c(double a, double b); +extern "C" double watt_spectrum_c(const double a, const double b); //============================================================================== // FADDEEVA the Faddeeva function, using Stephen Johnson's implementation @@ -103,8 +107,8 @@ extern "C" double watt_spectrum_c(double a, double b); // The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... //============================================================================== -extern "C" void broaden_wmp_polynomials_c(double E, double dopp, int n, - double factors[]); +extern "C" void broaden_wmp_polynomials_c(const double E, const double dopp, + const int n, double factors[]); } // namespace openmc #endif // MATH_FUNCTIONS_H \ No newline at end of file diff --git a/src/tallies/tally.F90 b/src/tallies/tally.F90 index 2e1d6184c..ef8b5915c 100644 --- a/src/tallies/tally.F90 +++ b/src/tallies/tally.F90 @@ -7,7 +7,7 @@ module tally use dict_header, only: EMPTY use error, only: fatal_error use geometry_header - use math, only: t_percentile, calc_pn, calc_rn + use math, only: t_percentile use mesh_header, only: RegularMesh, meshes use message_passing use mgxs_header diff --git a/src/tallies/tally_filter_legendre.F90 b/src/tallies/tally_filter_legendre.F90 index b4ee7b06b..4663df651 100644 --- a/src/tallies/tally_filter_legendre.F90 +++ b/src/tallies/tally_filter_legendre.F90 @@ -51,13 +51,12 @@ contains type(TallyFilterMatch), intent(inout) :: match integer :: i - real(8) :: wgt + real(C_DOUBLE) :: wgt(this % n_bins) - ! TODO: Use recursive formula to calculate higher orders - do i = 0, this % order - wgt = calc_pn(i, p % mu) - call match % bins % push_back(i + 1) - call match % weights % push_back(wgt) + call calc_pn(this % order, p % mu, wgt) + do i = 1, this % n_bins + call match % bins % push_back(i) + call match % weights % push_back(wgt(i)) end do end subroutine get_all_bins diff --git a/src/tallies/tally_filter_sph_harm.F90 b/src/tallies/tally_filter_sph_harm.F90 index 90f04c488..4a1f43273 100644 --- a/src/tallies/tally_filter_sph_harm.F90 +++ b/src/tallies/tally_filter_sph_harm.F90 @@ -74,30 +74,32 @@ contains integer :: i, j, n integer :: num_nm - real(8) :: wgt - real(8) :: rn(2*this % order + 1) + real(C_DOUBLE) :: wgt(this % order + 1) + real(C_DOUBLE) :: rn(this % n_bins) + + ! Determine cosine term for scatter expansion if necessary + if (this % cosine == COSINE_SCATTER) then + call calc_pn(this % order, p % mu, wgt) + else + wgt = ONE + end if + + ! Find the Rn,m values + call calc_rn(this % order, p % last_uvw, rn) - ! TODO: Use recursive formula to calculate higher orders j = 0 do n = 0, this % order - ! Determine cosine term for scatter expansion if necessary - if (this % cosine == COSINE_SCATTER) then - wgt = calc_pn(n, p % mu) - else - wgt = ONE - end if - ! Calculate n-th order spherical harmonics for (u,v,w) num_nm = 2*n + 1 - call calc_rn(n, p % last_uvw, rn(1:num_nm)) ! Append matching (bin,weight) for each moment do i = 1, num_nm j = j + 1 call match % bins % push_back(j) - call match % weights % push_back(wgt * rn(i)) + call match % weights % push_back(wgt(n + 1) * rn(j)) end do end do + end subroutine get_all_bins subroutine to_statepoint(this, filter_group) diff --git a/src/tallies/tally_filter_sptl_legendre.F90 b/src/tallies/tally_filter_sptl_legendre.F90 index 83db9a864..1bfbd0e3b 100644 --- a/src/tallies/tally_filter_sptl_legendre.F90 +++ b/src/tallies/tally_filter_sptl_legendre.F90 @@ -75,20 +75,19 @@ contains type(TallyFilterMatch), intent(inout) :: match integer :: i - real(8) :: wgt - real(8) :: x ! Position on specified axis - real(8) :: x_norm ! Normalized position + real(C_DOUBLE) :: wgt(this % n_bins) + real(C_DOUBLE) :: x ! Position on specified axis + real(C_DOUBLE) :: x_norm ! Normalized position x = p % coord(1) % xyz(this % axis) if (this % min <= x .and. x <= this % max) then ! Calculate normalized position between min and max x_norm = TWO*(x - this % min)/(this % max - this % min) - ONE - ! TODO: Use recursive formula to calculate higher orders - do i = 0, this % order - wgt = calc_pn(i, x_norm) - call match % bins % push_back(i + 1) - call match % weights % push_back(wgt) + call calc_pn(this % order, x_norm, wgt) + do i = 1, this % n_bins + call match % bins % push_back(i) + call match % weights % push_back(wgt(i)) end do end if end subroutine get_all_bins diff --git a/src/tallies/tally_filter_zernike.F90 b/src/tallies/tally_filter_zernike.F90 index fa205b180..d00541613 100644 --- a/src/tallies/tally_filter_zernike.F90 +++ b/src/tallies/tally_filter_zernike.F90 @@ -61,7 +61,7 @@ contains integer :: i real(8) :: x, y, r, theta - real(8) :: zn(this % n_bins) + real(C_DOUBLE) :: zn(this % n_bins) ! Determine normalized (r,theta) positions x = p % coord(1) % xyz(1) - this % x diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py index ab27437d6..d48119a37 100644 --- a/tests/unit_tests/test_math.py +++ b/tests/unit_tests/test_math.py @@ -39,14 +39,17 @@ def test_t_percentile(): def test_calc_pn(): max_order = 10 - test_ns = np.array([i for i in range(0, max_order + 1)]) test_xs = np.linspace(-1., 1., num=5, endpoint=True) # Reference solutions from scipy - ref_vals = [sp.special.eval_legendre(n, test_xs) for n in test_ns] + ref_vals = np.array([sp.special.eval_legendre(n, test_xs) + for n in range(0, max_order + 1)]) - test_vals = [[openmc.capi.math.calc_pn(n, x) for x in test_xs] - for n in test_ns] + test_vals = [] + for x in test_xs: + test_vals.append(openmc.capi.math.calc_pn(max_order, x).tolist()) + + test_vals = np.swapaxes(np.array(test_vals), 0, 1) assert np.allclose(ref_vals, test_vals) @@ -61,7 +64,7 @@ def test_evaluate_legendre(): ref_vals = np.polynomial.legendre.legval(test_xs, test_coeffs) # Set the coefficients back to 1s for the test values since - # evaluate legendre includes the (2l+1)/2 term + # evaluate legendre incorporates the (2l+1)/2 term on its own test_coeffs = [1. for l in range(max_order + 1)] test_vals = np.array([openmc.capi.math.evaluate_legendre(test_coeffs, x) @@ -107,9 +110,7 @@ def test_calc_rn(): ref_vals.append(ylm) test_vals = [] - for n in test_ns: - ylms = openmc.capi.math.calc_rn(n, test_uvw) - test_vals.extend(ylms.tolist()) + test_vals = openmc.capi.math.calc_rn(max_order, test_uvw) assert np.allclose(ref_vals, test_vals) From a6e75c35098f843cbf6973847749085d7842b6f2 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Sun, 13 May 2018 06:44:48 -0400 Subject: [PATCH 10/15] Cleaned up the optional parameters interface of rotate_angle --- openmc/capi/math.py | 9 ++++++--- src/math.F90 | 17 ++++++++++------- src/math_functions.cpp | 6 +++--- src/math_functions.h | 2 +- tests/unit_tests/test_math.py | 12 +++++++++++- 5 files changed, 31 insertions(+), 15 deletions(-) diff --git a/openmc/capi/math.py b/openmc/capi/math.py index c46390bce..95e30eff3 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -1,4 +1,4 @@ -from ctypes import (c_int, c_double, POINTER) +from ctypes import (c_int, c_double, POINTER, CFUNCTYPE) import numpy as np from numpy.ctypeslib import ndpointer @@ -201,8 +201,11 @@ def rotate_angle(uvw0, mu, phi=None): uvw = np.zeros(3, dtype=np.float64) uvw0_arr = np.array(uvw0, dtype=np.float64) - _dll.rotate_angle(uvw0_arr, c_double(mu), - uvw, c_double(phi)) + if phi is None: + _dll.rotate_angle(uvw0_arr, c_double(mu), uvw, None) + else: + _dll.rotate_angle(uvw0_arr, c_double(mu), uvw, c_double(phi)) + return uvw diff --git a/src/math.F90 b/src/math.F90 index 7be3e5a6d..057ebb213 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -75,7 +75,7 @@ module math implicit none real(C_DOUBLE), intent(inout) :: uvw(3) real(C_DOUBLE), value, intent(in) :: mu - real(C_DOUBLE), value, intent(in) :: phi + real(C_DOUBLE), optional, intent(in) :: phi end subroutine rotate_angle_c_intfc function maxwell_spectrum_c_intfc(T) bind(C, name='maxwell_spectrum_c') & @@ -225,16 +225,19 @@ contains !=============================================================================== subroutine rotate_angle(uvw0, mu, uvw, phi) bind(C) - real(C_DOUBLE), intent(in) :: uvw0(3) ! directional cosine - real(C_DOUBLE), intent(in) :: mu ! cosine of angle in lab or CM - real(C_DOUBLE), intent(out) :: uvw(3) ! rotated directional cosine - real(C_DOUBLE), optional :: phi ! azimuthal angle + real(C_DOUBLE), intent(in) :: uvw0(3) ! directional cosine + real(C_DOUBLE), intent(in) :: mu ! cosine of angle in lab or CM + real(C_DOUBLE), intent(out) :: uvw(3) ! rotated directional cosine + real(C_DOUBLE), target, optional :: phi ! azimuthal angle + + real(C_DOUBLE), pointer :: phi_ptr uvw = uvw0 if (present(phi)) then - call rotate_angle_c_intfc(uvw, mu, phi) + phi_ptr => phi + call rotate_angle_c_intfc(uvw, mu, phi_ptr) else - call rotate_angle_c_intfc(uvw, mu, -10._8) + call rotate_angle_c_intfc(uvw, mu) end if end subroutine rotate_angle diff --git a/src/math_functions.cpp b/src/math_functions.cpp index c9d6fc359..78ff08b05 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -659,7 +659,7 @@ void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { // and SERPENT. //============================================================================== -void rotate_angle_c(double uvw[3], const double mu, double phi) { +void rotate_angle_c(double uvw[3], const double mu, double* phi) { double phi_; // azimuthal angle double sinphi; // std::sine of azimuthal angle double cosphi; // cosine of azimuthal angle @@ -675,8 +675,8 @@ void rotate_angle_c(double uvw[3], const double mu, double phi) { w0 = uvw[2]; // Sample azimuthal angle in [0,2pi) if none provided - if (phi != -10.) { - phi_ = phi; + if (phi != NULL) { + phi_ = (*phi); } else { phi_ = 2. * PI * prn(); } diff --git a/src/math_functions.h b/src/math_functions.h index 8df72f56c..5417281ea 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -72,7 +72,7 @@ extern "C" void calc_zn_c(const int n, const double rho, const double phi, //============================================================================== extern "C" void rotate_angle_c(double uvw[3], const double mu, - double phi = -10.); + double* phi=NULL); //============================================================================== // MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py index d48119a37..487d02b10 100644 --- a/tests/unit_tests/test_math.py +++ b/tests/unit_tests/test_math.py @@ -170,7 +170,17 @@ def test_rotate_angle(): assert np.array_equal(ref_uvw, test_uvw) - # Need to test phi=None somehow... + # Now to test phi is None + mu = 0.9 + settings = openmc.capi.settings + settings.seed = 1 + + # When seed = 1, phi will be sampled as 1.9116495709698769 + # The resultant reference is from hand-calculations given the above + ref_uvw = [0.9, 0.410813051297112, 0.1457142302040] + test_uvw = openmc.capi.math.rotate_angle(uvw0, mu) + + assert np.allclose(ref_uvw, test_uvw) def test_maxwell_spectrum(): From d7b20fb51ea27fefacfd4b4de2210a1a339e4e66 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Sun, 13 May 2018 19:21:36 -0400 Subject: [PATCH 11/15] final preps for a PR --- openmc/capi/math.py | 15 ++++----- src/math_functions.cpp | 63 ++++++----------------------------- src/math_functions.h | 19 ++++------- tests/unit_tests/test_math.py | 13 -------- 4 files changed, 23 insertions(+), 87 deletions(-) diff --git a/openmc/capi/math.py b/openmc/capi/math.py index 95e30eff3..e5ba5fdd6 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -1,39 +1,38 @@ -from ctypes import (c_int, c_double, POINTER, CFUNCTYPE) +from ctypes import (c_int, c_double, POINTER) import numpy as np from numpy.ctypeslib import ndpointer from . import _dll -# _dll.normal_percentile.restype = c_double -# _dll.normal_percentile.argtypes = [POINTER(c_double)] _dll.t_percentile.restype = c_double _dll.t_percentile.argtypes = [POINTER(c_double), POINTER(c_int)] + _dll.calc_pn.restype = None _dll.calc_pn.argtypes = [POINTER(c_int), POINTER(c_double), ndpointer(c_double)] + _dll.evaluate_legendre.restype = c_double _dll.evaluate_legendre.argtypes = [POINTER(c_int), POINTER(c_double), POINTER(c_double)] + _dll.calc_rn.restype = None _dll.calc_rn.argtypes = [POINTER(c_int), ndpointer(c_double), ndpointer(c_double)] + _dll.calc_zn.restype = None _dll.calc_zn.argtypes = [POINTER(c_int), POINTER(c_double), POINTER(c_double), ndpointer(c_double)] + _dll.rotate_angle.restype = None _dll.rotate_angle.argtypes = [ndpointer(c_double), POINTER(c_double), ndpointer(c_double), POINTER(c_double)] _dll.maxwell_spectrum.restype = c_double _dll.maxwell_spectrum.argtypes = [POINTER(c_double)] + _dll.watt_spectrum.restype = c_double _dll.watt_spectrum.argtypes = [POINTER(c_double), POINTER(c_double)] -# COMPLEX DATA TYPES? -# _dll.faddeeva.restype = c_double -# _dll.faddeeva.argtypes = [POINTER(c_double)] -# _dll.w_derivative.restype = c_double -# _dll.w_derivative.argtypes = [POINTER(c_double)] _dll.broaden_wmp_polynomials.restype = None _dll.broaden_wmp_polynomials.argtypes = [POINTER(c_double), POINTER(c_double), POINTER(c_int), ndpointer(c_double)] diff --git a/src/math_functions.cpp b/src/math_functions.cpp index 78ff08b05..9cd52096d 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -2,6 +2,16 @@ namespace openmc { +//============================================================================== +// Module constants. +//============================================================================== + +// TODO: cmath::M_PI has 3 more digits precision than the Fortran constant we +// use so for now we will reuse the Fortran constant until we are OK with +// modifying test results +extern "C" const double PI {3.1415926535898}; + +extern "C" const double SQRT_PI {std::sqrt(PI)}; //============================================================================== // NORMAL_PERCENTILE calculates the percentile of the standard normal @@ -748,59 +758,6 @@ double watt_spectrum_c(const double a, const double b) { return E_out; } -//============================================================================== -// FADDEEVA the Faddeeva function, using Stephen Johnson's implementation -//============================================================================== - -// double complex __attribute__ ((const)) faddeeva_c(double complex z) { -// double complex wv; // The resultant w(z) value -// double relerr; // Target relative error in the inner loop of MIT Faddeeva - -// // Technically, the value we want is given by the equation: -// // w(z) = I/Pi * Integrate[Exp[-t^2]/(z-t), {t, -Infinity, Infinity}] -// // as shown in Equation 63 from Hwang, R. N. "A rigorous pole -// // representation of multilevel cross sections and its practical -// // applications." Nuclear Science and Engineering 96.3 (1987): 192-209. -// // -// // The MIT Faddeeva function evaluates w(z) = exp(-z^2)erfc(-iz). These -// // two forms of the Faddeeva function are related by a transformation. -// // -// // If we call the integral form w_int, and the function form w_fun: -// // For imag(z) > 0, w_int(z) = w_fun(z) -// // For imag(z) < 0, w_int(z) = -conjg(w_fun(conjg(z))) - -// // Note that faddeeva_w will interpret zero as machine epsilon - -// relerr = 0.; -// if (cimag(z) > 0.) { -// wv = Faddeeva_w(z, relerr); -// } else { -// wv = -conj(Faddeeva_w(conj(z), relerr)); -// } - -// return wv; -// } - -// double complex w_derivative_c(double complex z, int order){ -// double complex wv; // The resultant w(z) value - -// const double complex twoi_sqrtpi = 2.0 / SQRT_PI * I; - -// switch(order) { -// case 0: -// wv = faddeeva_c(z); -// break; -// case 1: -// wv = -2. * z * faddeeva_c(z) + twoi_sqrtpi; -// break; -// default: -// wv = -2. * z * w_derivative_c(z, order - 1) - 2. * (order - 1) * -// w_derivative_c(z, order - 2); -// } - -// return wv; -// } - //============================================================================== // BROADEN_WMP_POLYNOMIALS Doppler broadens the windowed multipole curvefit. // The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... diff --git a/src/math_functions.h b/src/math_functions.h index 5417281ea..431e9ddee 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -2,21 +2,22 @@ #define MATH_FUNCTIONS_H #include -#include -#include #include "random_lcg.h" -// #include "faddeeva/Faddeeva.h" namespace openmc { +//============================================================================== +// Module constants. +//============================================================================== + // TODO: cmath::M_PI has 3 more digits precision than the Fortran constant we // use so for now we will reuse the Fortran constant until we are OK with // modifying test results -const double PI = 3.1415926535898; +extern "C" const double PI; -const double SQRT_PI = std::sqrt(PI); +extern "C" const double SQRT_PI; //============================================================================== // NORMAL_PERCENTILE calculates the percentile of the standard normal @@ -94,14 +95,6 @@ extern "C" double maxwell_spectrum_c(const double T); extern "C" double watt_spectrum_c(const double a, const double b); -//============================================================================== -// FADDEEVA the Faddeeva function, using Stephen Johnson's implementation -//============================================================================== - -// extern "C" double complex faddeeva_c(double complex z) __attribute__ ((const)); - -// extern "C" double complex w_derivative_c(double complex z, int order); - //============================================================================== // BROADEN_WMP_POLYNOMIALS Doppler broadens the windowed multipole curvefit. // The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... diff --git a/tests/unit_tests/test_math.py b/tests/unit_tests/test_math.py index 487d02b10..6825f6b93 100644 --- a/tests/unit_tests/test_math.py +++ b/tests/unit_tests/test_math.py @@ -5,19 +5,6 @@ import openmc import openmc.capi -# def test_normal_percentile(): -# # normal_percentile has three branches to consider: -# # p < 0.02425; 0.02425 <= p <= 0.97575; and p > 0.97575 -# test_ps = [0.02, 0.4, 0.5, 0.6, 0.98] - -# # The reference solutions come from Scipy -# ref_zs = [sp.stats.norm.ppf(p) for p in test_ps] - -# test_zs = [openmc.capi.math.normal_percentile(p) for p in test_ps] - -# assert np.allclose(ref_zs, test_zs) - - def test_t_percentile(): # Permutations include 1 DoF, 2 DoF, and > 2 DoF # We will test 5 p-values at 3-DoF values From aaef39d710bce39ddafabad40b1c1ad011320bb2 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Mon, 14 May 2018 07:09:07 -0400 Subject: [PATCH 12/15] fixing compiler errors --- src/math_functions.cpp | 6 +++--- src/math_functions.h | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/math_functions.cpp b/src/math_functions.cpp index 9cd52096d..179c028db 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -685,7 +685,7 @@ void rotate_angle_c(double uvw[3], const double mu, double* phi) { w0 = uvw[2]; // Sample azimuthal angle in [0,2pi) if none provided - if (phi != NULL) { + if (phi != nullptr) { phi_ = (*phi); } else { phi_ = 2. * PI * prn(); @@ -694,8 +694,8 @@ void rotate_angle_c(double uvw[3], const double mu, double* phi) { // Precompute factors to save flops sinphi = std::sin(phi_); cosphi = std::cos(phi_); - a = std::sqrt(std::max(0., 1. - mu * mu)); - b = std::sqrt(std::max(0., 1. - w0 * w0)); + a = std::sqrt(std::fmax(0., 1. - mu * mu)); + b = std::sqrt(std::fmax(0., 1. - w0 * w0)); // Need to treat special case where sqrt(1 - w**2) is close to zero by // expanding about the v component rather than the w component diff --git a/src/math_functions.h b/src/math_functions.h index 431e9ddee..fbebd7dd7 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -73,7 +73,7 @@ extern "C" void calc_zn_c(const int n, const double rho, const double phi, //============================================================================== extern "C" void rotate_angle_c(double uvw[3], const double mu, - double* phi=NULL); + double* phi=nullptr); //============================================================================== // MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution From 235974df668d4193897ec52a90a25edd8d2fd183 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Mon, 14 May 2018 20:24:38 -0400 Subject: [PATCH 13/15] Resolving @smharpers comments, and anticipating this will fix the travis build issue --- src/math.F90 | 16 ---- src/math_functions.cpp | 199 +++++++++++++---------------------------- src/math_functions.h | 121 +++++++++++++++++-------- 3 files changed, 150 insertions(+), 186 deletions(-) diff --git a/src/math.F90 b/src/math.F90 index 057ebb213..cc5732e2d 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -95,22 +95,6 @@ module math real(C_DOUBLE) :: E_out end function watt_spectrum_c_intfc - function faddeeva_c_intfc(z) bind(C, name='faddeeva_c') result(wv) - use ISO_C_BINDING - implicit none - complex(C_DOUBLE_COMPLEX), value, intent(in) :: z - complex(C_DOUBLE_COMPLEX) :: wv - end function faddeeva_c_intfc - - function w_derivative_c_intfc(z, order) bind(C, name='w_derivative_c') & - result(wv) - use ISO_C_BINDING - implicit none - complex(C_DOUBLE_COMPLEX), value, intent(in) :: z - integer(C_INT), value, intent(in) :: order - complex(C_DOUBLE_COMPLEX) :: wv - end function w_derivative_c_intfc - subroutine broaden_wmp_polynomials_c_intfc(E, dopp, n, factors) & bind(C, name='broaden_wmp_polynomials_c') use ISO_C_BINDING diff --git a/src/math_functions.cpp b/src/math_functions.cpp index 179c028db..df5485ce1 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -3,41 +3,29 @@ namespace openmc { //============================================================================== -// Module constants. +// Mathematical methods //============================================================================== -// TODO: cmath::M_PI has 3 more digits precision than the Fortran constant we -// use so for now we will reuse the Fortran constant until we are OK with -// modifying test results -extern "C" const double PI {3.1415926535898}; - -extern "C" const double SQRT_PI {std::sqrt(PI)}; - -//============================================================================== -// NORMAL_PERCENTILE calculates the percentile of the standard normal -// distribution with a specified probability level -//============================================================================== - -double __attribute__ ((const)) normal_percentile_c(const double p) { - double z; - double q; - double r; - const double p_low = 0.02425; - const double a[6] = {-3.969683028665376e1, 2.209460984245205e2, - -2.759285104469687e2, 1.383577518672690e2, - -3.066479806614716e1, 2.506628277459239e0}; - const double b[5] = {-5.447609879822406e1, 1.615858368580409e2, - -1.556989798598866e2, 6.680131188771972e1, - -1.328068155288572e1}; - const double c[6] = {-7.784894002430293e-3, -3.223964580411365e-1, - -2.400758277161838, -2.549732539343734, - 4.374664141464968, 2.938163982698783}; - const double d[4] = {7.784695709041462e-3, 3.224671290700398e-1, - 2.445134137142996, 3.754408661907416}; +double normal_percentile_c(const double p) { + constexpr double p_low = 0.02425; + constexpr double a[6] = {-3.969683028665376e1, 2.209460984245205e2, + -2.759285104469687e2, 1.383577518672690e2, + -3.066479806614716e1, 2.506628277459239e0}; + constexpr double b[5] = {-5.447609879822406e1, 1.615858368580409e2, + -1.556989798598866e2, 6.680131188771972e1, + -1.328068155288572e1}; + constexpr double c[6] = {-7.784894002430293e-3, -3.223964580411365e-1, + -2.400758277161838, -2.549732539343734, + 4.374664141464968, 2.938163982698783}; + constexpr double d[4] = {7.784695709041462e-3, 3.224671290700398e-1, + 2.445134137142996, 3.754408661907416}; // The rational approximation used here is from an unpublished work at // http://home.online.no/~pjacklam/notes/invnorm/ + double z; + double q; + if (p < p_low) { // Rational approximation for lower region. @@ -47,7 +35,7 @@ double __attribute__ ((const)) normal_percentile_c(const double p) { } else if (p <= 1.0 - p_low) { // Rational approximation for central region - + double r; q = p - 0.5; r = q * q; z = (((((a[0]*r + a[1])*r + a[2])*r + a[3])*r + a[4])*r + a[5])*q / @@ -70,17 +58,9 @@ double __attribute__ ((const)) normal_percentile_c(const double p) { } -//============================================================================== -// T_PERCENTILE calculates the percentile of the Student's t distribution with -// a specified probability level and number of degrees of freedom -//============================================================================== -double __attribute__ ((const)) t_percentile_c(const double p, const int df){ +double t_percentile_c(const double p, const int df){ double t; - double n; - double k; - double z; - double z2; if (df == 1) { // For one degree of freedom, the t-distribution becomes a Cauchy @@ -98,7 +78,10 @@ double __attribute__ ((const)) t_percentile_c(const double p, const int df){ // modification of the Fisher-Cornish approximation for the student t // percentiles," Communication in Statistics - Simulation and Computation, // 16 (4), pp. 1123-1132 (1987). - + double n; + double k; + double z; + double z2; n = static_cast(df); k = 1. / (n - 2.); z = normal_percentile_c(p); @@ -111,61 +94,42 @@ double __attribute__ ((const)) t_percentile_c(const double p, const int df){ return t; } -//============================================================================== -// CALC_PN calculates the n-th order Legendre polynomials at the value of x. -//============================================================================== void calc_pn_c(const int n, const double x, double pnx[]) { - int l; - pnx[0] = 1.; if (n >= 1) { pnx[1] = x; } // Use recursion relation to build the higher orders - for (l = 1; l < n; l ++) { + for (int l = 1; l < n; l ++) { pnx[l + 1] = (static_cast(2 * l + 1) * x * pnx[l] - static_cast(l) * pnx[l - 1]) / (static_cast(l + 1)); } } -//============================================================================== -// EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients -// and the value of x -//============================================================================== -double __attribute__ ((const)) evaluate_legendre_c(const int n, +double evaluate_legendre_c(const int n, const double data[], const double x) { double val; - int l; - double* pnx = new double[n + 1]; + double pnx[n + 1]; val = 0.0; calc_pn_c(n, x, pnx); - for (l = 0; l <= n; l++) { + for (int l = 0; l <= n; l++) { val += (static_cast(l) + 0.5) * data[l] * pnx[l]; } - delete[] pnx; return val; } -//============================================================================== -// CALC_RN calculates the n-th order spherical harmonics for a given angle -// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) for n -// all 0 <= n -//============================================================================== void calc_rn_c(const int n, const double uvw[3], double rn[]){ + // rn[] is assumed to have already been allocated to the correct size + double phi; double w; - double w2m1; - int i; - int l; - - // rn[] is assumed to have already been allocated to the correct size // Store the cosine of the polar angle and the azimuthal angle w = uvw[2]; @@ -176,12 +140,14 @@ void calc_rn_c(const int n, const double uvw[3], double rn[]){ } // Store the shorthand of 1-w * w + double w2m1; w2m1 = 1. - w * w; // Now evaluate the spherical harmonics function rn[0] = 1.; + int i; i = 0; - for (l = 1; l <= n; l++) { + for (int l = 1; l <= n; l++) { // Set the index to the start of this order i += 2 * (l - 1) + 1; @@ -558,33 +524,12 @@ void calc_rn_c(const int n, const double uvw[3], double rn[]){ } } -//============================================================================== -// CALC_ZN calculates the n-th order modified Zernike polynomial moment for a -// given angle (rho, theta) location in the unit disk. The normalization of the -// polynomials is such tha the integral of Z_pq*Z_pq over the unit disk is -// exactly pi -//============================================================================== void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { // This procedure uses the modified Kintner's method for calculating Zernike // polynomials as outlined in Chong, C. W., Raveendran, P., & Mukundan, // R. (2003). A comparative analysis of algorithms for fast computation of // Zernike moments. Pattern Recognition, 36(3), 731-742. - double sin_phi; // Cosine of phi - double cos_phi; // Sine of phi - double sin_phi_vec[n + 1]; // Sin[n * phi] - double cos_phi_vec[n + 1]; // Cos[n * phi] - double zn_mat[n + 1][n + 1]; // Matrix forms of the coefficients which are - // easier to work with - // Variables for R_m_n calculation - double k1; - double k2; - double k3; - double k4; - // Loop counters - int i; - int p; - int q; // n == radial degree // m == azimuthal frequency @@ -597,41 +542,50 @@ void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { // sin(nx) = 2 cos(x) sin((n-1)x) - sin((n-2)x) // cos(nx) = 2 cos(x) cos((n-1)x) - cos((n-2)x) + double sin_phi; + double cos_phi; sin_phi = std::sin(phi); cos_phi = std::cos(phi); + double sin_phi_vec[n + 1]; // Sin[n * phi] + double cos_phi_vec[n + 1]; // Cos[n * phi] sin_phi_vec[0] = 1.0; cos_phi_vec[0] = 1.0; - sin_phi_vec[1] = 2.0 * cos_phi; cos_phi_vec[1] = cos_phi; - for (i = 2; i <= n; i++) { + for (int i = 2; i <= n; i++) { sin_phi_vec[i] = 2. * cos_phi * sin_phi_vec[i - 1] - sin_phi_vec[i - 2]; cos_phi_vec[i] = 2. * cos_phi * cos_phi_vec[i - 1] - cos_phi_vec[i - 2]; } - for (i = 0; i <= n; i++) { + for (int i = 0; i <= n; i++) { sin_phi_vec[i] *= sin_phi; } // =========================================================================== // Calculate R_pq(rho) + double zn_mat[n + 1][n + 1]; // Matrix forms of the coefficients which are + // easier to work with // Fill the main diagonal first (Eq 3.9 in Chong) - for (p = 0; p <= n; p++) { + for (int p = 0; p <= n; p++) { zn_mat[p][p] = std::pow(rho, p); } // Fill the 2nd diagonal (Eq 3.10 in Chong) - for (q = 0; q <= n - 2; q++) { + for (int q = 0; q <= n - 2; q++) { zn_mat[q][q+2] = (q + 2) * zn_mat[q+2][q+2] - (q + 1) * zn_mat[q][q]; } // Fill in the rest of the values using the original results (Eq. 3.8 in Chong) - for (p = 4; p <= n; p++) { + double k1; + double k2; + double k3; + double k4; + for (int p = 4; p <= n; p++) { k2 = static_cast (2 * p * (p - 1) * (p - 2)); - for (q = p - 4; q >= 0; q -= 2) { + for (int q = p - 4; q >= 0; q -= 2) { k1 = static_cast((p + q) * (p - q) * (p - 2)) / 2.; k3 = static_cast(-q * q * (p - 1) - p * (p - 1) * (p - 2)); k4 = static_cast(-p * (p + q - 2) * (p - q - 2)) / 2.; @@ -646,9 +600,10 @@ void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { // Note that the cos and sin vectors are offset by one // sin_phi_vec = [sin(x), sin(2x), sin(3x) ...] // cos_phi_vec = [1.0, cos(x), cos(2x)... ] + int i; i = 0; - for (p = 0; p <= n; p++) { - for (q = -p; q <= p; q += 2) { + for (int p = 0; p <= n; p++) { + for (int q = -p; q <= p; q += 2) { if (q < 0) { zn[i] = zn_mat[std::abs(q)][p] * sin_phi_vec[std::abs(q) - 1]; } else if (q == 0) { @@ -662,29 +617,19 @@ void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { } -//============================================================================== -// ROTATE_ANGLE rotates direction std::cosines through a polar angle whose -// cosine is mu and through an azimuthal angle sampled uniformly. Note that -// this is done with direct sampling rather than rejection as is done in MCNP -// and SERPENT. -//============================================================================== void rotate_angle_c(double uvw[3], const double mu, double* phi) { - double phi_; // azimuthal angle - double sinphi; // std::sine of azimuthal angle - double cosphi; // cosine of azimuthal angle - double a; // sqrt(1 - mu^2) - double b; // sqrt(1 - w^2) - double u0; // original std::cosine in x direction - double v0; // original std::cosine in y direction - double w0; // original std::cosine in z direction + // Copy original directional cosines + double u0; // original cosine in x direction + double v0; // original cosine in y direction + double w0; // original cosine in z direction - // Copy original directional std::cosines u0 = uvw[0]; v0 = uvw[1]; w0 = uvw[2]; // Sample azimuthal angle in [0,2pi) if none provided + double phi_; if (phi != nullptr) { phi_ = (*phi); } else { @@ -692,6 +637,10 @@ void rotate_angle_c(double uvw[3], const double mu, double* phi) { } // Precompute factors to save flops + double sinphi; // sine of azimuthal angle + double cosphi; // cosine of azimuthal angle + double a; // sqrt(1 - mu^2) + double b; // sqrt(1 - w^2) sinphi = std::sin(phi_); cosphi = std::cos(phi_); a = std::sqrt(std::fmax(0., 1. - mu * mu)); @@ -711,42 +660,27 @@ void rotate_angle_c(double uvw[3], const double mu, double* phi) { } } -//============================================================================== -// MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution -// based on a direct sampling scheme. The probability distribution function for -// a Maxwellian is given as p(x) = 2/(T*sqrt(pi))*sqrt(x/T)*exp(-x/T). -// This PDF can be sampled using rule C64 in the Monte Carlo Sampler LA-9721-MS. -//============================================================================== double maxwell_spectrum_c(const double T) { - double E_out; // Sampled Energy - double r1; double r2; double r3; // random numbers - double c; // cosine of pi/2*r3 r1 = prn(); r2 = prn(); r3 = prn(); // determine cosine of pi/2*r + double c; c = std::cos(PI / 2. * r3); // determine outgoing energy + double E_out; // Sampled Energy E_out = -T * (std::log(r1) + std::log(r2) * c * c); return E_out; } -//============================================================================== -// WATT_SPECTRUM samples the outgoing energy from a Watt energy-dependent -// fission spectrum. Although fitted parameters exist for many nuclides, -// generally the continuous tabular distributions (LAW 4) should be used in -// lieu of the Watt spectrum. This direct sampling scheme is an unpublished -// scheme based on the original Watt spectrum derivation (See F. Brown's -// MC lectures). -//============================================================================== double watt_spectrum_c(const double a, const double b) { double E_out; // Sampled Energy @@ -758,10 +692,6 @@ double watt_spectrum_c(const double a, const double b) { return E_out; } -//============================================================================== -// BROADEN_WMP_POLYNOMIALS Doppler broadens the windowed multipole curvefit. -// The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... -//============================================================================== void broaden_wmp_polynomials_c(const double E, const double dopp, const int n, double factors[]) { @@ -773,8 +703,6 @@ void broaden_wmp_polynomials_c(const double E, const double dopp, const int n, double quarter_inv_dopp4; // 0.25 / dopp**4 double erf_beta; // error function of beta double exp_m_beta2; // exp(-beta**2) - int i; - double ip1_dbl; sqrtE = std::sqrt(E); beta = sqrtE * dopp; @@ -800,7 +728,8 @@ void broaden_wmp_polynomials_c(const double E, const double dopp, const int n, (beta * SQRT_PI); // Perform recursive broadening of high order components - for (i = 0; i < n - 3; i++) { + double ip1_dbl; + for (int i = 0; i < n - 3; i++) { ip1_dbl = static_cast(i + 1); if (i != 0) { factors[i + 3] = -factors[i - 1] * (ip1_dbl - 1.) * ip1_dbl * diff --git a/src/math_functions.h b/src/math_functions.h index fbebd7dd7..b55715717 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -2,6 +2,7 @@ #define MATH_FUNCTIONS_H #include +#include #include "random_lcg.h" @@ -15,89 +16,139 @@ namespace openmc { // TODO: cmath::M_PI has 3 more digits precision than the Fortran constant we // use so for now we will reuse the Fortran constant until we are OK with // modifying test results -extern "C" const double PI; +extern "C" constexpr double PI {3.1415926535898}; -extern "C" const double SQRT_PI; +extern "C" constexpr double SQRT_PI {std::sqrt(PI)}; //============================================================================== -// NORMAL_PERCENTILE calculates the percentile of the standard normal -// distribution with a specified probability level +//! Calculate the percentile of the standard normal distribution with a +//! specified probability level. +//! +//! @param p The probability level +//! @return The requested percentile //============================================================================== -extern "C" double normal_percentile_c(const double p) __attribute__ ((const)); +extern "C" double normal_percentile_c(const double p); //============================================================================== -// T_PERCENTILE calculates the percentile of the Student's t distribution with -// a specified probability level and number of degrees of freedom +//! Calculate the percentile of the Student's t distribution with a specified +//! probability level and number of degrees of freedom. +//! +//! @param p The probability level +//! @param df The degrees of freedom +//! @return The requested percentile //============================================================================== -extern "C" double t_percentile_c(const double p, const int df) - __attribute__ ((const)); +extern "C" double t_percentile_c(const double p, const int df); //============================================================================== -// CALC_PN calculates the n-th order Legendre polynomials at the value of x. +//! Calculate the n-th order Legendre polynomials at the value of x. +//! +//! @param n The maximum order requested +//! @param x The value to evaluate at; x is expected to be within [-1,1] +//! @param pnx The requested Legendre polynomials of order 0 to n (inclusive) +//! evaluated at x. //============================================================================== extern "C" void calc_pn_c(const int n, const double x, double pnx[]); //============================================================================== -// EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients -// and the value of x +//! Find the value of f(x) given a set of Legendre coefficients and the value +//! of x. +//! +//! @param n The maximum order of the expansion +//! @param data The polynomial expansion coefficient data; without the (2l+1)/2 +//! factor. +//! @param x The value to evaluate at; x is expected to be within [-1,1] +//! @return The requested Legendre polynomials of order 0 to n (inclusive) +//! evaluated at x //============================================================================== extern "C" double evaluate_legendre_c(const int n, const double data[], - const double x) __attribute__ ((const)); + const double x); //============================================================================== -// CALC_RN calculates the n-th order spherical harmonics for a given angle -// (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) for n -// all 0 <= n +//! Calculate the n-th order real spherical harmonics for a given angle (in +//! terms of (u,v,w)) for all 0<=n and -m<=n<=n. +//! +//! @param n The maximum order requested +//! @param uvw[3] The direction the harmonics are requested at +//! @param rn The requested harmonics of order 0 to n (inclusive) +//! evaluated at uvw. //============================================================================== extern "C" void calc_rn_c(const int n, const double uvw[3], double rn[]); //============================================================================== -// CALC_ZN calculates the n-th order modified Zernike polynomial moment for a -// given angle (rho, theta) location in the unit disk. The normalization of the -// polynomials is such tha the integral of Z_pq*Z_pq over the unit disk is -// exactly pi +//! Calculate the n-th order modified Zernike polynomial moment for a given +//! angle (rho, theta) location on the unit disk. +//! +//! The normalization of the polynomials is such that the integral of Z_pq^2 +//! over the unit disk is exactly pi +//! +//! @param n The maximum order requested +//! @param rho The radial parameter to specify location on the unit disk +//! @param phi The angle parameter to specify location on the unit disk +//! @param zn The requested moments of order 0 to n (inclusive) +//! evaluated at rho and phi. //============================================================================== extern "C" void calc_zn_c(const int n, const double rho, const double phi, double zn[]); //============================================================================== -// ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is -// mu and through an azimuthal angle sampled uniformly. Note that this is done -// with direct sampling rather than rejection as is done in MCNP and SERPENT. +//! Rotate the direction cosines through a polar angle whose cosine is mu and +//! through an azimuthal angle sampled uniformly. +//! +//! This is done with direct sampling rather than rejection sampling as is done +//! in MCNP and Serpent. +//! +//! @param uvw[3] The initial, and final, direction vector +//! @param mu The cosine of angle in lab or CM +//! @param phi The azimuthal angle; defaults to a randomly chosen angle //============================================================================== extern "C" void rotate_angle_c(double uvw[3], const double mu, double* phi=nullptr); //============================================================================== -// MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution -// based on a direct sampling scheme. The probability distribution function for -// a Maxwellian is given as p(x) = 2/(T*sqrt(pi))*sqrt(x/T)*exp(-x/T). -// This PDF can be sampled using rule C64 in the Monte Carlo Sampler LA-9721-MS. +//! Samples an energy from the Maxwell fission distribution based on a direct +//! sampling scheme. +//! +//! The probability distribution function for a Maxwellian is given as +//! p(x) = 2/(T*sqrt(pi))*sqrt(x/T)*exp(-x/T). This PDF can be sampled using +//! rule C64 in the Monte Carlo Sampler LA-9721-MS. +//! +//! @param T The tabulated function of the incoming energy +//! @result The sampled outgoing energy //============================================================================== extern "C" double maxwell_spectrum_c(const double T); //============================================================================== -// WATT_SPECTRUM samples the outgoing energy from a Watt energy-dependent -// fission spectrum. Although fitted parameters exist for many nuclides, -// generally the continuous tabular distributions (LAW 4) should be used in -// lieu of the Watt spectrum. This direct sampling scheme is an unpublished -// scheme based on the original Watt spectrum derivation (See F. Brown's -// MC lectures). +//! Samples an energy from a Watt energy-dependent fission distribution. +//! +//! Although fitted parameters exist for many nuclides, generally the +//! continuous tabular distributions (LAW 4) should be used in lieu of the Watt +//! spectrum. This direct sampling scheme is an unpublished scheme based on the +//! original Watt spectrum derivation (See F. Brown's MC lectures). +//! +//! @param a Watt parameter a +//! @param b Watt parameter b +//! @result The sampled outgoing energy //============================================================================== extern "C" double watt_spectrum_c(const double a, const double b); //============================================================================== -// BROADEN_WMP_POLYNOMIALS Doppler broadens the windowed multipole curvefit. -// The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E) ... +//! Doppler broadens the windowed multipole curvefit. +//! +//! The curvefit is a polynomial of the form a/E + b/sqrt(E) + c + d sqrt(E)... +//! +//! @param E The energy to evaluate the broadening at +//! @param dopp sqrt(atomic weight ratio / kT) with kT given in eV +//! @param n The number of components to the polynomial +//! @param factors The output leading coefficient //============================================================================== extern "C" void broaden_wmp_polynomials_c(const double E, const double dopp, From 38c13994bc98589ed1e4521fb0e870bb908db993 Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Wed, 16 May 2018 21:25:29 -0400 Subject: [PATCH 14/15] Implementing comments from @paulromano, @smharper, and @giudgiud. A few remain open, will close in a day or two after some more GitHub discussion --- CMakeLists.txt | 1 - openmc/capi/math.py | 20 +----- src/math.F90 | 7 +- src/math_functions.cpp | 158 ++++++++++++++--------------------------- src/math_functions.h | 36 +++++----- 5 files changed, 73 insertions(+), 149 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index c34dd3770..dc5558de1 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -435,7 +435,6 @@ set(LIBOPENMC_CXX_SRC src/initialize.cpp src/finalize.cpp src/hdf5_interface.cpp - src/math_functions.h src/math_functions.cpp src/message_passing.cpp src/plot.cpp diff --git a/openmc/capi/math.py b/openmc/capi/math.py index e5ba5fdd6..3b0b723b3 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -5,6 +5,7 @@ from numpy.ctypeslib import ndpointer from . import _dll + _dll.t_percentile.restype = c_double _dll.t_percentile.argtypes = [POINTER(c_double), POINTER(c_int)] @@ -38,25 +39,6 @@ _dll.broaden_wmp_polynomials.argtypes = [POINTER(c_double), POINTER(c_double), POINTER(c_int), ndpointer(c_double)] -def normal_percentile(p): - """ Calculate the percentile of the standard normal distribution with a - specified probability level - - Parameters - ---------- - p : float - Probability level - - Returns - ------- - float - Corresponding z-value - - """ - - return _dll.normal_percentile(c_double(p)) - - def t_percentile(p, df): """ Calculate the percentile of the Student's t distribution with a specified probability level and number of degrees of freedom diff --git a/src/math.F90 b/src/math.F90 index cc5732e2d..05942a86e 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -217,12 +217,7 @@ contains real(C_DOUBLE), pointer :: phi_ptr uvw = uvw0 - if (present(phi)) then - phi_ptr => phi - call rotate_angle_c_intfc(uvw, mu, phi_ptr) - else - call rotate_angle_c_intfc(uvw, mu) - end if + call rotate_angle_c_intfc(uvw, mu, phi) end subroutine rotate_angle diff --git a/src/math_functions.cpp b/src/math_functions.cpp index df5485ce1..159e0a4e2 100644 --- a/src/math_functions.cpp +++ b/src/math_functions.cpp @@ -6,7 +6,7 @@ namespace openmc { // Mathematical methods //============================================================================== -double normal_percentile_c(const double p) { +double normal_percentile_c(double p) { constexpr double p_low = 0.02425; constexpr double a[6] = {-3.969683028665376e1, 2.209460984245205e2, -2.759285104469687e2, 1.383577518672690e2, @@ -35,9 +35,8 @@ double normal_percentile_c(const double p) { } else if (p <= 1.0 - p_low) { // Rational approximation for central region - double r; q = p - 0.5; - r = q * q; + double r = q * q; z = (((((a[0]*r + a[1])*r + a[2])*r + a[3])*r + a[4])*r + a[5])*q / (((((b[0]*r + b[1])*r + b[2])*r + b[3])*r + b[4])*r + 1.0); @@ -59,7 +58,7 @@ double normal_percentile_c(const double p) { } -double t_percentile_c(const double p, const int df){ +double t_percentile_c(double p, int df){ double t; if (df == 1) { @@ -78,14 +77,10 @@ double t_percentile_c(const double p, const int df){ // modification of the Fisher-Cornish approximation for the student t // percentiles," Communication in Statistics - Simulation and Computation, // 16 (4), pp. 1123-1132 (1987). - double n; - double k; - double z; - double z2; - n = static_cast(df); - k = 1. / (n - 2.); - z = normal_percentile_c(p); - z2 = z * z; + double n = df; + double k = 1. / (n - 2.); + double z = normal_percentile_c(p); + double z2 = z * z; t = std::sqrt(n * k) * (z + (z2 - 3.) * z * k / 4. + ((5. * z2 - 56.) * z2 + 75.) * z * k * k / 96. + (((z2 - 27.) * 3. * z2 + 417.) * z2 - 315.) * z * k * k * k / 384.); @@ -95,7 +90,7 @@ double t_percentile_c(const double p, const int df){ } -void calc_pn_c(const int n, const double x, double pnx[]) { +void calc_pn_c(int n, double x, double pnx[]) { pnx[0] = 1.; if (n >= 1) { pnx[1] = x; @@ -103,36 +98,28 @@ void calc_pn_c(const int n, const double x, double pnx[]) { // Use recursion relation to build the higher orders for (int l = 1; l < n; l ++) { - pnx[l + 1] = (static_cast(2 * l + 1) * x * pnx[l] - - static_cast(l) * pnx[l - 1]) / - (static_cast(l + 1)); + pnx[l + 1] = ((2 * l + 1) * x * pnx[l] - l * pnx[l - 1]) / (l + 1); } } -double evaluate_legendre_c(const int n, - const double data[], - const double x) { - double val; +double evaluate_legendre_c(int n, const double data[], double x) { double pnx[n + 1]; - - val = 0.0; + double val = 0.0; calc_pn_c(n, x, pnx); for (int l = 0; l <= n; l++) { - val += (static_cast(l) + 0.5) * data[l] * pnx[l]; + val += (l + 0.5) * data[l] * pnx[l]; } return val; } -void calc_rn_c(const int n, const double uvw[3], double rn[]){ +void calc_rn_c(int n, const double uvw[3], double rn[]){ // rn[] is assumed to have already been allocated to the correct size - double phi; - double w; - // Store the cosine of the polar angle and the azimuthal angle - w = uvw[2]; + double w = uvw[2]; + double phi; if (uvw[0] == 0.) { phi = 0.; } else { @@ -140,13 +127,11 @@ void calc_rn_c(const int n, const double uvw[3], double rn[]){ } // Store the shorthand of 1-w * w - double w2m1; - w2m1 = 1. - w * w; + double w2m1 = 1. - w * w; // Now evaluate the spherical harmonics function rn[0] = 1.; - int i; - i = 0; + int i = 0; for (int l = 1; l <= n; l++) { // Set the index to the start of this order i += 2 * (l - 1) + 1; @@ -525,15 +510,7 @@ void calc_rn_c(const int n, const double uvw[3], double rn[]){ } -void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { - // This procedure uses the modified Kintner's method for calculating Zernike - // polynomials as outlined in Chong, C. W., Raveendran, P., & Mukundan, - // R. (2003). A comparative analysis of algorithms for fast computation of - // Zernike moments. Pattern Recognition, 36(3), 731-742. - - // n == radial degree - // m == azimuthal frequency - +void calc_zn_c(int n, double rho, double phi, double zn[]) { // =========================================================================== // Determine vector of sin(n*phi) and cos(n*phi). This takes advantage of the // following recurrence relations so that only a single sin/cos have to be @@ -542,10 +519,8 @@ void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { // sin(nx) = 2 cos(x) sin((n-1)x) - sin((n-2)x) // cos(nx) = 2 cos(x) cos((n-1)x) - cos((n-2)x) - double sin_phi; - double cos_phi; - sin_phi = std::sin(phi); - cos_phi = std::cos(phi); + double sin_phi = std::sin(phi); + double cos_phi = std::cos(phi); double sin_phi_vec[n + 1]; // Sin[n * phi] double cos_phi_vec[n + 1]; // Cos[n * phi] @@ -579,16 +554,12 @@ void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { } // Fill in the rest of the values using the original results (Eq. 3.8 in Chong) - double k1; - double k2; - double k3; - double k4; for (int p = 4; p <= n; p++) { - k2 = static_cast (2 * p * (p - 1) * (p - 2)); + double k2 = 2 * p * (p - 1) * (p - 2); for (int q = p - 4; q >= 0; q -= 2) { - k1 = static_cast((p + q) * (p - q) * (p - 2)) / 2.; - k3 = static_cast(-q * q * (p - 1) - p * (p - 1) * (p - 2)); - k4 = static_cast(-p * (p + q - 2) * (p - q - 2)) / 2.; + double k1 = ((p + q) * (p - q) * (p - 2)) / 2.; + double k3 = -q * q * (p - 1) - p * (p - 1) * (p - 2); + double k4 = (-p * (p + q - 2) * (p - q - 2)) / 2.; zn_mat[q][p] = ((k2 * rho * rho + k3) * zn_mat[q][p-2] + k4 * zn_mat[q][p-4]) / k1; } @@ -600,8 +571,7 @@ void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { // Note that the cos and sin vectors are offset by one // sin_phi_vec = [sin(x), sin(2x), sin(3x) ...] // cos_phi_vec = [1.0, cos(x), cos(2x)... ] - int i; - i = 0; + int i = 0; for (int p = 0; p <= n; p++) { for (int q = -p; q <= p; q += 2) { if (q < 0) { @@ -618,15 +588,11 @@ void calc_zn_c(const int n, const double rho, const double phi, double zn[]) { } -void rotate_angle_c(double uvw[3], const double mu, double* phi) { +void rotate_angle_c(double uvw[3], double mu, double* phi) { // Copy original directional cosines - double u0; // original cosine in x direction - double v0; // original cosine in y direction - double w0; // original cosine in z direction - - u0 = uvw[0]; - v0 = uvw[1]; - w0 = uvw[2]; + double u0 = uvw[0]; // original cosine in x direction + double v0 = uvw[1]; // original cosine in y direction + double w0 = uvw[2]; // original cosine in z direction // Sample azimuthal angle in [0,2pi) if none provided double phi_; @@ -637,14 +603,10 @@ void rotate_angle_c(double uvw[3], const double mu, double* phi) { } // Precompute factors to save flops - double sinphi; // sine of azimuthal angle - double cosphi; // cosine of azimuthal angle - double a; // sqrt(1 - mu^2) - double b; // sqrt(1 - w^2) - sinphi = std::sin(phi_); - cosphi = std::cos(phi_); - a = std::sqrt(std::fmax(0., 1. - mu * mu)); - b = std::sqrt(std::fmax(0., 1. - w0 * w0)); + double sinphi = std::sin(phi_); + double cosphi = std::cos(phi_); + double a = std::sqrt(std::fmax(0., 1. - mu * mu)); + double b = std::sqrt(std::fmax(0., 1. - w0 * w0)); // Need to treat special case where sqrt(1 - w**2) is close to zero by // expanding about the v component rather than the w component @@ -661,54 +623,39 @@ void rotate_angle_c(double uvw[3], const double mu, double* phi) { } -double maxwell_spectrum_c(const double T) { - double r1; - double r2; - double r3; // random numbers - - r1 = prn(); - r2 = prn(); - r3 = prn(); +double maxwell_spectrum_c(double T) { + // Set the random numbers + double r1 = prn(); + double r2 = prn(); + double r3 = prn(); // determine cosine of pi/2*r - double c; - c = std::cos(PI / 2. * r3); + double c = std::cos(PI / 2. * r3); - // determine outgoing energy - double E_out; // Sampled Energy - E_out = -T * (std::log(r1) + std::log(r2) * c * c); + // Determine outgoing energy + double E_out = -T * (std::log(r1) + std::log(r2) * c * c); return E_out; } -double watt_spectrum_c(const double a, const double b) { - double E_out; // Sampled Energy - double w; // sampled from Maxwellian - - w = maxwell_spectrum_c(a); - E_out = w + 0.25 * a * a * b + (2. * prn() - 1.) * std::sqrt(a * a * b * w); +double watt_spectrum_c(double a, double b) { + double w = maxwell_spectrum_c(a); + double E_out = w + 0.25 * a * a * b + (2. * prn() - 1.) * std::sqrt(a * a * b * w); return E_out; } -void broaden_wmp_polynomials_c(const double E, const double dopp, const int n, - double factors[]) { +void broaden_wmp_polynomials_c(double E, double dopp, int n, double factors[]) { // Factors is already pre-allocated + double sqrtE = std::sqrt(E); + double beta = sqrtE * dopp; + double half_inv_dopp2 = 0.5 / (dopp * dopp); + double quarter_inv_dopp4 = half_inv_dopp2 * half_inv_dopp2; - double sqrtE; // sqrt(energy) - double beta; // sqrt(atomic weight ratio * E / kT) - double half_inv_dopp2; // 0.5 / dopp**2 - double quarter_inv_dopp4; // 0.25 / dopp**4 - double erf_beta; // error function of beta - double exp_m_beta2; // exp(-beta**2) - - sqrtE = std::sqrt(E); - beta = sqrtE * dopp; - half_inv_dopp2 = 0.5 / (dopp * dopp); - quarter_inv_dopp4 = half_inv_dopp2 * half_inv_dopp2; - + double erf_beta; // error function of beta + double exp_m_beta2; // exp(-beta**2) if (beta > 6.0) { // Save time, ERF(6) is 1 to machine precision. // beta/sqrtpi*exp(-beta**2) is also approximately 1 machine epsilon. @@ -728,9 +675,8 @@ void broaden_wmp_polynomials_c(const double E, const double dopp, const int n, (beta * SQRT_PI); // Perform recursive broadening of high order components - double ip1_dbl; for (int i = 0; i < n - 3; i++) { - ip1_dbl = static_cast(i + 1); + double ip1_dbl = i + 1; if (i != 0) { factors[i + 3] = -factors[i - 1] * (ip1_dbl - 1.) * ip1_dbl * quarter_inv_dopp4 + factors[i + 1] * diff --git a/src/math_functions.h b/src/math_functions.h index b55715717..18bd02640 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -18,7 +18,7 @@ namespace openmc { // modifying test results extern "C" constexpr double PI {3.1415926535898}; -extern "C" constexpr double SQRT_PI {std::sqrt(PI)}; +extern "C" const double SQRT_PI {std::sqrt(PI)}; //============================================================================== //! Calculate the percentile of the standard normal distribution with a @@ -28,7 +28,7 @@ extern "C" constexpr double SQRT_PI {std::sqrt(PI)}; //! @return The requested percentile //============================================================================== -extern "C" double normal_percentile_c(const double p); +extern "C" double normal_percentile_c(double p); //============================================================================== //! Calculate the percentile of the Student's t distribution with a specified @@ -39,7 +39,7 @@ extern "C" double normal_percentile_c(const double p); //! @return The requested percentile //============================================================================== -extern "C" double t_percentile_c(const double p, const int df); +extern "C" double t_percentile_c(double p, int df); //============================================================================== //! Calculate the n-th order Legendre polynomials at the value of x. @@ -50,7 +50,7 @@ extern "C" double t_percentile_c(const double p, const int df); //! evaluated at x. //============================================================================== -extern "C" void calc_pn_c(const int n, const double x, double pnx[]); +extern "C" void calc_pn_c(int n, double x, double pnx[]); //============================================================================== //! Find the value of f(x) given a set of Legendre coefficients and the value @@ -64,8 +64,7 @@ extern "C" void calc_pn_c(const int n, const double x, double pnx[]); //! evaluated at x //============================================================================== -extern "C" double evaluate_legendre_c(const int n, const double data[], - const double x); +extern "C" double evaluate_legendre_c(int n, const double data[], double x); //============================================================================== //! Calculate the n-th order real spherical harmonics for a given angle (in @@ -77,14 +76,18 @@ extern "C" double evaluate_legendre_c(const int n, const double data[], //! evaluated at uvw. //============================================================================== -extern "C" void calc_rn_c(const int n, const double uvw[3], double rn[]); +extern "C" void calc_rn_c(int n, const double uvw[3], double rn[]); //============================================================================== //! Calculate the n-th order modified Zernike polynomial moment for a given //! angle (rho, theta) location on the unit disk. //! +//! This procedure uses the modified Kintner's method for calculating Zernike +//! polynomials as outlined in Chong, C. W., Raveendran, P., & Mukundan, +//! R. (2003). A comparative analysis of algorithms for fast computation of +//! Zernike moments. Pattern Recognition, 36(3), 731-742. //! The normalization of the polynomials is such that the integral of Z_pq^2 -//! over the unit disk is exactly pi +//! over the unit disk is exactly pi. //! //! @param n The maximum order requested //! @param rho The radial parameter to specify location on the unit disk @@ -93,8 +96,7 @@ extern "C" void calc_rn_c(const int n, const double uvw[3], double rn[]); //! evaluated at rho and phi. //============================================================================== -extern "C" void calc_zn_c(const int n, const double rho, const double phi, - double zn[]); +extern "C" void calc_zn_c(int n, double rho, double phi, double zn[]); //============================================================================== //! Rotate the direction cosines through a polar angle whose cosine is mu and @@ -105,11 +107,11 @@ extern "C" void calc_zn_c(const int n, const double rho, const double phi, //! //! @param uvw[3] The initial, and final, direction vector //! @param mu The cosine of angle in lab or CM -//! @param phi The azimuthal angle; defaults to a randomly chosen angle +//! @param phi The azimuthal angle; will randomly chosen angle if a nullptr +//! is passed //============================================================================== -extern "C" void rotate_angle_c(double uvw[3], const double mu, - double* phi=nullptr); +extern "C" void rotate_angle_c(double uvw[3], double mu, double* phi); //============================================================================== //! Samples an energy from the Maxwell fission distribution based on a direct @@ -123,7 +125,7 @@ extern "C" void rotate_angle_c(double uvw[3], const double mu, //! @result The sampled outgoing energy //============================================================================== -extern "C" double maxwell_spectrum_c(const double T); +extern "C" double maxwell_spectrum_c(double T); //============================================================================== //! Samples an energy from a Watt energy-dependent fission distribution. @@ -138,7 +140,7 @@ extern "C" double maxwell_spectrum_c(const double T); //! @result The sampled outgoing energy //============================================================================== -extern "C" double watt_spectrum_c(const double a, const double b); +extern "C" double watt_spectrum_c(double a, double b); //============================================================================== //! Doppler broadens the windowed multipole curvefit. @@ -151,8 +153,8 @@ extern "C" double watt_spectrum_c(const double a, const double b); //! @param factors The output leading coefficient //============================================================================== -extern "C" void broaden_wmp_polynomials_c(const double E, const double dopp, - const int n, double factors[]); +extern "C" void broaden_wmp_polynomials_c(double E, double dopp, int n, + double factors[]); } // namespace openmc #endif // MATH_FUNCTIONS_H \ No newline at end of file From 890a1b4f55e2964e42f46cb46f8a37b8ee5314fd Mon Sep 17 00:00:00 2001 From: Adam G Nelson Date: Fri, 18 May 2018 19:07:34 -0400 Subject: [PATCH 15/15] Moved math python api to point to the C++ and simplified the fortran methods --- openmc/capi/math.py | 71 ++++++------- src/api.F90 | 11 -- src/distribution_multivariate.F90 | 2 +- src/math.F90 | 168 ++++-------------------------- src/math_functions.h | 3 + src/mgxs_header.F90 | 5 +- src/physics.F90 | 13 +-- src/physics_mg.F90 | 2 +- src/scattdata_header.F90 | 3 +- 9 files changed, 67 insertions(+), 211 deletions(-) diff --git a/openmc/capi/math.py b/openmc/capi/math.py index 3b0b723b3..d1d7abdf6 100644 --- a/openmc/capi/math.py +++ b/openmc/capi/math.py @@ -6,37 +6,33 @@ from numpy.ctypeslib import ndpointer from . import _dll -_dll.t_percentile.restype = c_double -_dll.t_percentile.argtypes = [POINTER(c_double), POINTER(c_int)] +_dll.t_percentile_c.restype = c_double +_dll.t_percentile_c.argtypes = [c_double, c_int] -_dll.calc_pn.restype = None -_dll.calc_pn.argtypes = [POINTER(c_int), POINTER(c_double), - ndpointer(c_double)] +_dll.calc_pn_c.restype = None +_dll.calc_pn_c.argtypes = [c_int, c_double, ndpointer(c_double)] -_dll.evaluate_legendre.restype = c_double -_dll.evaluate_legendre.argtypes = [POINTER(c_int), POINTER(c_double), - POINTER(c_double)] +_dll.evaluate_legendre_c.restype = c_double +_dll.evaluate_legendre_c.argtypes = [c_int, POINTER(c_double), c_double] -_dll.calc_rn.restype = None -_dll.calc_rn.argtypes = [POINTER(c_int), ndpointer(c_double), - ndpointer(c_double)] +_dll.calc_rn_c.restype = None +_dll.calc_rn_c.argtypes = [c_int, ndpointer(c_double), ndpointer(c_double)] -_dll.calc_zn.restype = None -_dll.calc_zn.argtypes = [POINTER(c_int), POINTER(c_double), POINTER(c_double), - ndpointer(c_double)] +_dll.calc_zn_c.restype = None +_dll.calc_zn_c.argtypes = [c_int, c_double, c_double, ndpointer(c_double)] -_dll.rotate_angle.restype = None -_dll.rotate_angle.argtypes = [ndpointer(c_double), POINTER(c_double), - ndpointer(c_double), POINTER(c_double)] -_dll.maxwell_spectrum.restype = c_double -_dll.maxwell_spectrum.argtypes = [POINTER(c_double)] +_dll.rotate_angle_c.restype = None +_dll.rotate_angle_c.argtypes = [ndpointer(c_double), c_double, + POINTER(c_double)] +_dll.maxwell_spectrum_c.restype = c_double +_dll.maxwell_spectrum_c.argtypes = [c_double] -_dll.watt_spectrum.restype = c_double -_dll.watt_spectrum.argtypes = [POINTER(c_double), POINTER(c_double)] +_dll.watt_spectrum_c.restype = c_double +_dll.watt_spectrum_c.argtypes = [c_double, c_double] -_dll.broaden_wmp_polynomials.restype = None -_dll.broaden_wmp_polynomials.argtypes = [POINTER(c_double), POINTER(c_double), - POINTER(c_int), ndpointer(c_double)] +_dll.broaden_wmp_polynomials_c.restype = None +_dll.broaden_wmp_polynomials_c.argtypes = [c_double, c_double, c_int, + ndpointer(c_double)] def t_percentile(p, df): @@ -57,7 +53,7 @@ def t_percentile(p, df): """ - return _dll.t_percentile(c_double(p), c_int(df)) + return _dll.t_percentile_c(p, df) def calc_pn(n, x): @@ -78,7 +74,7 @@ def calc_pn(n, x): """ pnx = np.empty(n + 1, dtype=np.float64) - _dll.calc_pn(c_int(n), c_double(x), pnx) + _dll.calc_pn_c(n, x, pnx) return pnx @@ -101,9 +97,9 @@ def evaluate_legendre(data, x): """ data_arr = np.array(data, dtype=np.float64) - return _dll.evaluate_legendre(c_int(len(data)), - data_arr.ctypes.data_as(POINTER(c_double)), - c_double(x)) + return _dll.evaluate_legendre_c(len(data), + data_arr.ctypes.data_as(POINTER(c_double)), + x) def calc_rn(n, uvw): @@ -127,7 +123,7 @@ def calc_rn(n, uvw): num_nm = (n + 1) * (n + 1) rn = np.empty(num_nm, dtype=np.float64) uvw_arr = np.array(uvw, dtype=np.float64) - _dll.calc_rn(c_int(n), uvw_arr, rn) + _dll.calc_rn_c(n, uvw_arr, rn) return rn @@ -155,7 +151,7 @@ def calc_zn(n, rho, phi): num_bins = ((n + 1) * (n + 2)) // 2 zn = np.zeros(num_bins, dtype=np.float64) - _dll.calc_zn(c_int(n), c_double(rho), c_double(phi), zn) + _dll.calc_zn_c(n, rho, phi, zn) return zn @@ -179,13 +175,13 @@ def rotate_angle(uvw0, mu, phi=None): """ - uvw = np.zeros(3, dtype=np.float64) uvw0_arr = np.array(uvw0, dtype=np.float64) if phi is None: - _dll.rotate_angle(uvw0_arr, c_double(mu), uvw, None) + _dll.rotate_angle_c(uvw0_arr, mu, None) else: - _dll.rotate_angle(uvw0_arr, c_double(mu), uvw, c_double(phi)) + _dll.rotate_angle_c(uvw0_arr, mu, c_double(phi)) + uvw = uvw0_arr return uvw @@ -206,7 +202,7 @@ def maxwell_spectrum(T): """ - return _dll.maxwell_spectrum(c_double(T)) + return _dll.maxwell_spectrum_c(T) def watt_spectrum(a, b): @@ -226,7 +222,7 @@ def watt_spectrum(a, b): """ - return _dll.watt_spectrum(c_double(a), c_double(b)) + return _dll.watt_spectrum_c(a, b) def broaden_wmp_polynomials(E, dopp, n): @@ -250,6 +246,5 @@ def broaden_wmp_polynomials(E, dopp, n): """ factors = np.zeros(n, dtype=np.float64) - _dll.broaden_wmp_polynomials(c_double(E), c_double(dopp), c_int(n), - factors) + _dll.broaden_wmp_polynomials_c(E, dopp, n, factors) return factors diff --git a/src/api.F90 b/src/api.F90 index a06e2f4cc..da50007d6 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -95,17 +95,6 @@ module openmc_api public :: openmc_tally_set_nuclides public :: openmc_tally_set_scores public :: openmc_tally_set_type - public :: t_percentile - public :: calc_pn - public :: calc_rn - public :: calc_zn - public :: evaluate_legendre - public :: rotate_angle - public :: maxwell_spectrum - public :: watt_spectrum - public :: faddeeva - public :: w_derivative - public :: broaden_wmp_polynomials contains diff --git a/src/distribution_multivariate.F90 b/src/distribution_multivariate.F90 index 4d7d42cc3..19db1c297 100644 --- a/src/distribution_multivariate.F90 +++ b/src/distribution_multivariate.F90 @@ -119,7 +119,7 @@ contains else ! Sample azimuthal angle phi = this % phi % sample() - call rotate_angle(this % reference_uvw, mu, uvw, phi) + uvw = rotate_angle(this % reference_uvw, mu, phi) end if end function polar_azimuthal_sample diff --git a/src/math.F90 b/src/math.F90 index 05942a86e..33f1ab4d3 100644 --- a/src/math.F90 +++ b/src/math.F90 @@ -26,22 +26,22 @@ module math interface - pure function t_percentile_c_intfc(p, df) bind(C, name='t_percentile_c') & + pure function t_percentile(p, df) bind(C, name='t_percentile_c') & result(t) use ISO_C_BINDING implicit none real(C_DOUBLE), value, intent(in) :: p integer(C_INT), value, intent(in) :: df real(C_DOUBLE) :: t - end function t_percentile_c_intfc + end function t_percentile - pure subroutine calc_pn_c_intfc(n, x, pnx) bind(C, name='calc_pn_c') + pure subroutine calc_pn(n, x, pnx) bind(C, name='calc_pn_c') use ISO_C_BINDING implicit none integer(C_INT), value, intent(in) :: n real(C_DOUBLE), value, intent(in) :: x real(C_DOUBLE), intent(out) :: pnx(n + 1) - end subroutine calc_pn_c_intfc + end subroutine calc_pn pure function evaluate_legendre_c_intfc(n, data, x) & bind(C, name='evaluate_legendre_c') result(val) @@ -53,22 +53,22 @@ module math real(C_DOUBLE) :: val end function evaluate_legendre_c_intfc - pure subroutine calc_rn_c_intfc(n, uvw, rn) bind(C, name='calc_rn_c') + pure subroutine calc_rn(n, uvw, rn) bind(C, name='calc_rn_c') use ISO_C_BINDING implicit none integer(C_INT), value, intent(in) :: n real(C_DOUBLE), intent(in) :: uvw(3) real(C_DOUBLE), intent(out) :: rn(2 * n + 1) - end subroutine calc_rn_c_intfc + end subroutine calc_rn - pure subroutine calc_zn_c_intfc(n, rho, phi, zn) bind(C, name='calc_zn_c') + pure subroutine calc_zn(n, rho, phi, zn) bind(C, name='calc_zn_c') use ISO_C_BINDING implicit none integer(C_INT), value, intent(in) :: n real(C_DOUBLE), value, intent(in) :: rho real(C_DOUBLE), value, intent(in) :: phi real(C_DOUBLE), intent(out) :: zn(((n + 1) * (n + 2)) / 2) - end subroutine calc_zn_c_intfc + end subroutine calc_zn subroutine rotate_angle_c_intfc(uvw, mu, phi) bind(C, name='rotate_angle_c') use ISO_C_BINDING @@ -78,24 +78,24 @@ module math real(C_DOUBLE), optional, intent(in) :: phi end subroutine rotate_angle_c_intfc - function maxwell_spectrum_c_intfc(T) bind(C, name='maxwell_spectrum_c') & + function maxwell_spectrum(T) bind(C, name='maxwell_spectrum_c') & result(E_out) use ISO_C_BINDING implicit none real(C_DOUBLE), value, intent(in) :: T real(C_DOUBLE) :: E_out - end function maxwell_spectrum_c_intfc + end function maxwell_spectrum - function watt_spectrum_c_intfc(a, b) bind(C, name='watt_spectrum_c') & + function watt_spectrum(a, b) bind(C, name='watt_spectrum_c') & result(E_out) use ISO_C_BINDING implicit none real(C_DOUBLE), value, intent(in) :: a real(C_DOUBLE), value, intent(in) :: b real(C_DOUBLE) :: E_out - end function watt_spectrum_c_intfc + end function watt_spectrum - subroutine broaden_wmp_polynomials_c_intfc(E, dopp, n, factors) & + subroutine broaden_wmp_polynomials(E, dopp, n, factors) & bind(C, name='broaden_wmp_polynomials_c') use ISO_C_BINDING implicit none @@ -103,7 +103,7 @@ module math real(C_DOUBLE), value, intent(in) :: dopp integer(C_INT), value, intent(in) :: n real(C_DOUBLE), intent(inout) :: factors(n) - end subroutine broaden_wmp_polynomials_c_intfc + end subroutine broaden_wmp_polynomials function faddeeva_w(z, relerr) bind(C, name='Faddeeva_w') result(w) use ISO_C_BINDING @@ -116,52 +116,13 @@ module math contains -!=============================================================================== -! T_PERCENTILE calculates the percentile of the Student's t distribution with a -! specified probability level and number of degrees of freedom -!=============================================================================== - - pure function t_percentile(p, df) result(t) bind(C) - - real(C_DOUBLE), intent(in) :: p ! probability level - integer(C_INT), intent(in) :: df ! degrees of freedom - real(C_DOUBLE) :: t ! corresponding t-value - - t = t_percentile_c_intfc(p, df) - - end function t_percentile - -!=============================================================================== -! CALC_PN calculates the n-th order Legendre polynomial at the value of x. -! Since this function is called repeatedly during the neutron transport process, -! neither n or x is checked to see if they are in the applicable range. -! This is left to the client developer to use where applicable. x is to be in -! the domain of [-1,1], and 0<=n<=5. If x is outside of the range, the return -! value will be outside the expected range; if n is outside the stated range, -! the return value will be 1.0. -!=============================================================================== - - pure subroutine calc_pn(n, x, pnx) bind(C) - - integer(C_INT), intent(in) :: n ! Legendre order requested - real(C_DOUBLE), intent(in) :: x ! Independent variable the Legendre is to - ! be evaluated at; x must be in the - ! domain [-1,1] - real(C_DOUBLE), intent(out) :: pnx(n + 1) ! The Legendre polys of order n - ! evaluated at x - - call calc_pn_c_intfc(n, x, pnx) - - end subroutine calc_pn - !=============================================================================== ! EVALUATE_LEGENDRE Find the value of f(x) given a set of Legendre coefficients ! and the value of x !=============================================================================== - pure function evaluate_legendre(n, data, x) result(val) bind(C) - integer(C_INT), intent(in) :: n - real(C_DOUBLE), intent(in) :: data(n) + pure function evaluate_legendre(data, x) result(val) bind(C) + real(C_DOUBLE), intent(in) :: data(:) real(C_DOUBLE), intent(in) :: x real(C_DOUBLE) :: val @@ -169,91 +130,23 @@ contains end function evaluate_legendre -!=============================================================================== -! CALC_RN calculates the n-th order real spherical harmonics for a given angle -! (in terms of (u,v,w)). All Rn,m values are provided (where -n<=m<=n) -!=============================================================================== - - pure subroutine calc_rn(n, uvw, rn) bind(C) - - integer(C_INT), intent(in) :: n ! Order requested - real(C_DOUBLE), intent(in) :: uvw(3) ! Direction of travel; - ! assumed to be on unit sphere - real(C_DOUBLE), intent(out) :: rn(2*n + 1) ! The resultant R_n(uvw) - - call calc_rn_c_intfc(n, uvw, rn) - - end subroutine calc_rn - -!=============================================================================== -! CALC_ZN calculates the n-th order modified Zernike polynomial moment for a -! given angle (rho, theta) location in the unit disk. The normlization of the -! polynomials is such that the integral of Z_pq*Z_pq over the unit disk is -! exactly pi -!=============================================================================== - - pure subroutine calc_zn(n, rho, phi, zn) bind(C) - integer(C_INT), intent(in) :: n ! Maximum order - real(C_DOUBLE), intent(in) :: rho ! Radial location in the unit disk - real(C_DOUBLE), intent(in) :: phi ! Theta (radians) location in the unit disk - ! The resulting list of coefficients - real(C_DOUBLE), intent(out) :: zn(((n + 1) * (n + 2)) / 2) - - call calc_zn_c_intfc(n, rho, phi, zn) - end subroutine calc_zn - !=============================================================================== ! ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is ! mu and through an azimuthal angle sampled uniformly. Note that this is done ! with direct sampling rather than rejection as is done in MCNP and SERPENT. !=============================================================================== - subroutine rotate_angle(uvw0, mu, uvw, phi) bind(C) - real(C_DOUBLE), intent(in) :: uvw0(3) ! directional cosine - real(C_DOUBLE), intent(in) :: mu ! cosine of angle in lab or CM - real(C_DOUBLE), intent(out) :: uvw(3) ! rotated directional cosine - real(C_DOUBLE), target, optional :: phi ! azimuthal angle + function rotate_angle(uvw0, mu, phi) result(uvw) + real(C_DOUBLE), intent(in) :: uvw0(3) ! directional cosine + real(C_DOUBLE), intent(in) :: mu ! cosine of angle in lab or CM + real(C_DOUBLE), intent(in), optional :: phi ! azimuthal angle - real(C_DOUBLE), pointer :: phi_ptr + real(C_DOUBLE) :: uvw(3) ! rotated directional cosine uvw = uvw0 call rotate_angle_c_intfc(uvw, mu, phi) - end subroutine rotate_angle - -!=============================================================================== -! MAXWELL_SPECTRUM samples an energy from the Maxwell fission distribution based -! on a direct sampling scheme. The probability distribution function for a -! Maxwellian is given as p(x) = 2/(T*sqrt(pi))*sqrt(x/T)*exp(-x/T). This PDF can -! be sampled using rule C64 in the Monte Carlo Sampler LA-9721-MS. -!=============================================================================== - - function maxwell_spectrum(T) result(E_out) bind(C) - - real(C_DOUBLE), intent(in) :: T ! tabulated function of incoming E - real(C_DOUBLE) :: E_out ! sampled energy - - E_out = maxwell_spectrum_c_intfc(T) - - end function maxwell_spectrum - -!=============================================================================== -! WATT_SPECTRUM samples the outgoing energy from a Watt energy-dependent fission -! spectrum. Although fitted parameters exist for many nuclides, generally the -! continuous tabular distributions (LAW 4) should be used in lieu of the Watt -! spectrum. This direct sampling scheme is an unpublished scheme based on the -! original Watt spectrum derivation (See F. Brown's MC lectures). -!=============================================================================== - - function watt_spectrum(a, b) result(E_out) bind(C) - - real(C_DOUBLE), intent(in) :: a ! Watt parameter a - real(C_DOUBLE), intent(in) :: b ! Watt parameter b - real(C_DOUBLE) :: E_out ! energy of emitted neutron - - E_out = watt_spectrum_c_intfc(a, b) - - end function watt_spectrum + end function rotate_angle !=============================================================================== ! FADDEEVA the Faddeeva function, using Stephen Johnson's implementation @@ -305,21 +198,4 @@ contains end select end function w_derivative -!=============================================================================== -! BROADEN_WMP_POLYNOMIALS Doppler broadens the windowed multipole curvefit. The -! curvefit is a polynomial of the form -! a/E + b/sqrt(E) + c + d sqrt(E) ... -!=============================================================================== - - subroutine broaden_wmp_polynomials(E, dopp, n, factors) bind(C) - real(C_DOUBLE), intent(in) :: E ! Energy to evaluate at - real(C_DOUBLE), intent(in) :: dopp ! sqrt(atomic weight ratio / kT), - ! kT given in eV. - integer(C_INT), intent(in) :: n ! number of components to polynomial - real(C_DOUBLE), intent(out):: factors(n) ! output leading coefficient - - call broaden_wmp_polynomials_c_intfc(E, dopp, n, factors) - - end subroutine broaden_wmp_polynomials - end module math diff --git a/src/math_functions.h b/src/math_functions.h index 18bd02640..68e89251e 100644 --- a/src/math_functions.h +++ b/src/math_functions.h @@ -1,3 +1,6 @@ +//! \file math_functions.h +//! A collection of elementary math functions. + #ifndef MATH_FUNCTIONS_H #define MATH_FUNCTIONS_H diff --git a/src/mgxs_header.F90 b/src/mgxs_header.F90 index bcdef6c79..5abeccbcf 100644 --- a/src/mgxs_header.F90 +++ b/src/mgxs_header.F90 @@ -1103,9 +1103,7 @@ contains end if scatt_coeffs(gin) % data(imu, gout) = & - evaluate_legendre( & - size(input_scatt(gin) % data, dim=1), & - input_scatt(gin) % data(:, gout), mu) + evaluate_legendre(input_scatt(gin) % data(:, gout), mu) ! Ensure positivity of distribution if (scatt_coeffs(gin) % data(imu, gout) < ZERO) & @@ -2097,7 +2095,6 @@ contains scatt_coeffs(gin, iazi, ipol) % data(imu, gout) = & evaluate_legendre(& - size(input_scatt(gin, iazi, ipol) % data, dim=1), & input_scatt(gin, iazi, ipol) % data(:, gout), mu) ! Ensure positivity of distribution diff --git a/src/physics.F90 b/src/physics.F90 index 8183435cb..b614b8185 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -495,8 +495,7 @@ contains ! Rotate neutron velocity vector to new angle -- note that the speed of the ! neutron in CM does not change in elastic scattering. However, the speed ! will change when we convert back to LAB - call rotate_angle(uvw_cm, mu_cm, v_n) - v_n = vel * v_n + v_n = vel * rotate_angle(uvw_cm, mu_cm) ! Transform back to LAB frame v_n = v_n + v_cm @@ -786,7 +785,7 @@ contains if (abs(mu) > ONE) mu = sign(ONE,mu) ! change direction of particle - call rotate_angle(uvw, mu, uvw) + uvw = rotate_angle(uvw, mu) end subroutine sab_scatter @@ -977,8 +976,7 @@ contains if (abs(mu) < ONE) then ! set and accept target velocity E_t = E_t / awr - call rotate_angle(uvw, mu, v_target) - v_target = sqrt(E_t) * v_target + v_target = sqrt(E_t) * rotate_angle(uvw, mu) exit ARES_REJECT_LOOP end if end do ARES_REJECT_LOOP @@ -1058,8 +1056,7 @@ contains ! Determine velocity vector of target nucleus based on neutron's velocity ! and the sampled angle between them - call rotate_angle(uvw, mu, v_target) - v_target = vt * v_target + v_target = vt * rotate_angle(uvw, mu) end subroutine sample_cxs_target_velocity @@ -1330,7 +1327,7 @@ contains p % mu = mu ! change direction of particle - call rotate_angle(p % coord(1) % uvw, mu, p % coord(1) % uvw) + p % coord(1) % uvw = rotate_angle(p % coord(1) % uvw, mu) ! evaluate yield yield = rxn % products(1) % yield % evaluate(E_in) diff --git a/src/physics_mg.F90 b/src/physics_mg.F90 index 05493af05..eb8208594 100644 --- a/src/physics_mg.F90 +++ b/src/physics_mg.F90 @@ -151,7 +151,7 @@ contains p % E = energy_bin_avg(p % g) ! Convert change in angle (mu) to new direction - call rotate_angle(p % coord(1) % uvw, p % mu, p % coord(1) % uvw) + p % coord(1) % uvw = rotate_angle(p % coord(1) % uvw, p % mu) ! Set event component p % event = EVENT_SCATTER diff --git a/src/scattdata_header.F90 b/src/scattdata_header.F90 index a3108a2df..511e2a237 100644 --- a/src/scattdata_header.F90 +++ b/src/scattdata_header.F90 @@ -445,8 +445,7 @@ contains if (gout < this % gmin(gin) .or. gout > this % gmax(gin)) then f = ZERO else - f = evaluate_legendre(size(this % dist(gin) % data, dim=1), & - this % dist(gin) % data(:, gout), mu) + f = evaluate_legendre(this % dist(gin) % data(:, gout), mu) end if end function scattdatalegendre_calc_f