From 0adc5a6f863793695f07c9e530629702b35dd82d Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Fri, 5 Sep 2025 20:51:24 -0400 Subject: [PATCH 01/12] Update mathieu.h with improved docstrings and comments. --- include/xsf/mathieu.h | 585 ++++++++++++++++++++++++++---------------- 1 file changed, 357 insertions(+), 228 deletions(-) diff --git a/include/xsf/mathieu.h b/include/xsf/mathieu.h index 2431dde44e..b119feca86 100644 --- a/include/xsf/mathieu.h +++ b/include/xsf/mathieu.h @@ -1,228 +1,357 @@ -#pragma once - -#include "error.h" -#include "specfun/specfun.h" - -namespace xsf { - -template -T sem_cva(T m, T q); - -template -void sem(T m, T q, T x, T &csf, T &csd); - -/* Mathieu functions */ -/* Characteristic values */ -template -T cem_cva(T m, T q) { - int int_m, kd = 1; - - if ((m < 0) || (m != floor(m))) { - set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - int_m = (int)m; - if (q < 0) { - /* https://dlmf.nist.gov/28.2#E26 */ - if (int_m % 2 == 0) { - return cem_cva(m, -q); - } else { - return sem_cva(m, -q); - } - } - - if (int_m % 2) { - kd = 2; - } - return specfun::cva2(kd, int_m, q); -} - -template -T sem_cva(T m, T q) { - int int_m, kd = 4; - - if ((m <= 0) || (m != floor(m))) { - set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - int_m = (int)m; - if (q < 0) { - /* https://dlmf.nist.gov/28.2#E26 */ - if (int_m % 2 == 0) { - return sem_cva(m, -q); - } else { - return cem_cva(m, -q); - } - } - if (int_m % 2) { - kd = 3; - } - return specfun::cva2(kd, int_m, q); -} - -/* Mathieu functions */ -template -void cem(T m, T q, T x, T &csf, T &csd) { - int int_m, kf = 1, sgn; - T f = 0.0, d = 0.0; - if ((m < 0) || (m != floor(m))) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_cem", SF_ERROR_DOMAIN, NULL); - } else { - int_m = (int)m; - if (q < 0) { - /* https://dlmf.nist.gov/28.2#E34 */ - if (int_m % 2 == 0) { - sgn = ((int_m / 2) % 2 == 0) ? 1 : -1; - cem(m, -q, 90 - x, f, d); - csf = sgn * f; - csd = -sgn * d; - - } else { - sgn = ((int_m / 2) % 2 == 0) ? 1 : -1; - sem(m, -q, 90 - x, f, d); - csf = sgn * f; - csd = -sgn * d; - } - } else { - using specfun::Status; - Status status = specfun::mtu0(kf, int_m, q, x, &csf, &csd); - if (status != Status::OK) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; - set_error("mathieu_cem", sf_error, NULL); - } - } - } -} - -template -void sem(T m, T q, T x, T &csf, T &csd) { - int int_m, kf = 2, sgn; - T f = 0.0, d = 0.0; - if ((m < 0) || (m != floor(m))) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); - } else { - int_m = (int)m; - if (int_m == 0) { - csf = 0; - csd = 0; - } else if (q < 0) { - /* https://dlmf.nist.gov/28.2#E34 */ - if (int_m % 2 == 0) { - sgn = ((int_m / 2) % 2 == 0) ? -1 : 1; - sem(m, -q, 90 - x, f, d); - csf = sgn * f; - csd = -sgn * d; - } else { - sgn = ((int_m / 2) % 2 == 0) ? 1 : -1; - cem(m, -q, 90 - x, f, d); - csf = sgn * f; - csd = -sgn * d; - } - } else { - using specfun::Status; - Status status = specfun::mtu0(kf, int_m, q, x, &csf, &csd); - if (status != Status::OK) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; - set_error("mathieu_sem", sf_error, NULL); - } - } - } -} - -template -void mcm1(T m, T q, T x, T &f1r, T &d1r) { - int int_m, kf = 1, kc = 1; - T f2r = 0.0, d2r = 0.0; - - if ((m < 0) || (m != floor(m)) || (q < 0)) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_modcem1", SF_ERROR_DOMAIN, NULL); - } else { - using specfun::Status; - int_m = (int)m; - Status status = specfun::mtu12(kf, kc, int_m, q, x, &f1r, &d1r, &f2r, &d2r); - if (status != Status::OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; - set_error("mathieu_modcem1", sf_error, NULL); - } - } -} - -template -void msm1(T m, T q, T x, T &f1r, T &d1r) { - int int_m, kf = 2, kc = 1; - T f2r = 0.0, d2r = 0.0; - - if ((m < 1) || (m != floor(m)) || (q < 0)) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_modsem1", SF_ERROR_DOMAIN, NULL); - } else { - using specfun::Status; - int_m = (int)m; - Status status = specfun::mtu12(kf, kc, int_m, q, x, &f1r, &d1r, &f2r, &d2r); - if (status != Status::OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; - set_error("mathieu_modsem1", sf_error, NULL); - } - } -} - -template -void mcm2(T m, T q, T x, T &f2r, T &d2r) { - int int_m, kf = 1, kc = 2; - T f1r = 0.0, d1r = 0.0; - - if ((m < 0) || (m != floor(m)) || (q < 0)) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_modcem2", SF_ERROR_DOMAIN, NULL); - } else { - using specfun::Status; - int_m = (int)m; - Status status = specfun::mtu12(kf, kc, int_m, q, x, &f1r, &d1r, &f2r, &d2r); - if (status != Status::OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; - set_error("mathieu_modcem2", sf_error, NULL); - } - } -} - -template -void msm2(T m, T q, T x, T &f2r, T &d2r) { - int int_m, kf = 2, kc = 2; - T f1r = 0.0, d1r = 0.0; - - if ((m < 1) || (m != floor(m)) || (q < 0)) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_modsem2", SF_ERROR_DOMAIN, NULL); - } else { - using specfun::Status; - int_m = (int)m; - Status status = specfun::mtu12(kf, kc, int_m, q, x, &f1r, &d1r, &f2r, &d2r); - if (status != Status::OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - sf_error_t sf_error = status == Status::NoMemory ? SF_ERROR_MEMORY : SF_ERROR_OTHER; - set_error("mathieu_modsem2", sf_error, NULL); - } - } -} - -} // namespace xsf +#pragma once + +#include "error.h" +#include "mathieu/matrix_utils.h" +#include "mathieu/make_matrix.h" +#include "mathieu/mathieu_coeffs.h" +#include "mathieu/mathieu_eigs.h" +#include "mathieu/besseljyd.h" +#include "mathieu/mathieu_fcns.h" + +/* + * + * This is part of the Mathieu function suite -- a reimplementation + * of the Mathieu functions for Scipy. This file #includes all the + * fcn impls in the mathieu/ subdirectory, and provides translation + * from the Scipy call to the calling signature I implemented in my + * reimplementation. + * + * Stuart Brorson, Summer 2025. + * + */ + +namespace xsf { + +/* Characteristic values */ +//------------------------------------------------------------- +/** + * Mathieu characteristic values (eigenvalues) for even parity functions. + * + * Even parity characteristic values a. + * + * @param m Eigenvalue order. Must be positive integer less than 500. + * @param q Mathieu parameter q. Real number. + * @return Mathieu eigenvalue a. + */ +template +T cem_cva(T m, T q) { + // This returns the even Mathieu characteristic value (eigenvalue) a. + + // Check for invalid Mathieu order. + if ((m < 0) || (m != floor(m))) { + set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double da; + + int retcode = xsf::mathieu::mathieu_a(im, dq, &da); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T a = static_cast(da); + return a; +} + +//------------------------------------------------------------- +template +/** + * Mathieu characteristic values (eigenvalues) b for odd functions. + * + * + * Odd parity characteristic values b. + * + * @param m Eigenvalue order. Must be positive integer less than 500. + * @param q Mathieu parameter q. Real number. + * @return Mathieu eigenvalue b. + */ +T sem_cva(T m, T q) { + // This returns the odd Mathieu characteristic value (eigenvalue) b. + + // Check for invalid Mathieu order. + if ((m < 1) || (m != floor(m))) { + set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double db; + + int retcode = xsf::mathieu::mathieu_b(im, dq, &db); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T b = static_cast(db); + return b; +} + + +//--------------------------------------------------------------- +/* Mathieu functions */ +/** + * Even parity Mathieu angular function ce(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Real number. + * @param x Angular coordinate x (radians). Real number. + * @param csf Value of function. Real number. + * @param csd Value of derivative w.r.t. x. Real number. + */ +template +void cem(T m, T q, T x, T &csf, T &csd) { + + if ((m < 0) || (m != floor(m))) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dcsf; + double dcsd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); + if (retcode != SF_ERROR_OK) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", (sf_error_t) retcode, NULL); + } else { + csf = static_cast(dcsf); + csd = static_cast(dcsd); + } + } +} + + +//--------------------------------------------------------------- +/** + * Odd parity Mathieu angular function se(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Real number. + * @param x Angular coordinate x (radians). Real number. + * @param ssf Value of function. Real number. + * @param ssd Value of derivative w.r.t. x. Real number + */ +template +void sem(T m, T q, T x, T &ssf, T &ssd) { + + if ((m < 1) || (m != floor(m))) { + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dssf; + double dssd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); + if (retcode != SF_ERROR_OK) { + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", (sf_error_t) retcode, NULL); + } else { + ssf = static_cast(dssf); + ssd = static_cast(dssd); + } + } +} + +//--------------------------------------------------------------- +/** + * Even parity modified (radial) Mathieu function of first kind Mc1(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Positive real number + * @param x Radial coordinate x. Positive real number. + * @param f1r Value of function. Real number. + * @param d1r Value of derivative w.r.t. x. Real number + */ +template +void mcm1(T m, T q, T x, T &f1r, T &d1r) { + + if ((m < 0) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", (sf_error_t) retcode, NULL); + } else { + f1r = static_cast(df1r); + d1r = static_cast(dd1r); + } + } +} + +//--------------------------------------------------------------- +/** + * Odd parity modified (radial) Mathieu function of first kind Ms1(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Positive real number + * @param x Radial coordinate x. Positive real number. + * @param f1r Value of function. Real number. + * @param d1r Value of derivative w.r.t. x. Real number + */ +template +void msm1(T m, T q, T x, T &f1r, T &d1r) { + + if ((m < 1) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", (sf_error_t) retcode, NULL); + } else { + f1r = static_cast(df1r); + d1r = static_cast(dd1r); + } + } + +} + +//--------------------------------------------------------------- +/** + * Even parity modified (radial) Mathieu function of second kind Mc2(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Positive real number + * @param x Radial coordinate x. Positive real number. + * @param f2r Value of function. Real number. + * @param d2r Value of derivative w.r.t. x. Real number + */ +template +void mcm2(T m, T q, T x, T &f2r, T &d2r) { + + if ((m < 0) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", (sf_error_t) retcode, NULL); + } else { + f2r = static_cast(df2r); + d2r = static_cast(dd2r); + } + } + +} + +//--------------------------------------------------------------- +/** + * Odd parity modified (radial) Mathieu function of second kind Ms2(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Positive real number + * @param x Radial coordinate x. Positive real number. + * @param f2r Value of function. Real number. + * @param d2r Value of derivative w.r.t. x. Real number + */ +template +void msm2(T m, T q, T x, T &f2r, T &d2r) { + + if ((m < 1) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", (sf_error_t) retcode, NULL); + } else { + f2r = static_cast(df2r); + d2r = static_cast(dd2r); + } + } +} + + +} // namespace xsf From 9f62cf06e7369b7af9c857dc8c1ac3224b6f5b9b Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Fri, 5 Sep 2025 20:53:38 -0400 Subject: [PATCH 02/12] Add new directory of Mathieu fcn impls. --- include/xsf/mathieu/LICENSE | 21 + include/xsf/mathieu/Makefile | 36 + include/xsf/mathieu/README.md | 39 + include/xsf/mathieu/besseljyd.h | 85 ++ include/xsf/mathieu/main.c | 1357 +++++++++++++++++++++++ include/xsf/mathieu/make_matrix.h | 198 ++++ include/xsf/mathieu/mathieu.h | 255 +++++ include/xsf/mathieu/mathieu_coeffs.h | 292 +++++ include/xsf/mathieu/mathieu_eigs.h | 269 +++++ include/xsf/mathieu/mathieu_fcns.h | 1480 ++++++++++++++++++++++++++ include/xsf/mathieu/matrix_utils.h | 92 ++ 11 files changed, 4124 insertions(+) create mode 100644 include/xsf/mathieu/LICENSE create mode 100644 include/xsf/mathieu/Makefile create mode 100644 include/xsf/mathieu/README.md create mode 100644 include/xsf/mathieu/besseljyd.h create mode 100644 include/xsf/mathieu/main.c create mode 100644 include/xsf/mathieu/make_matrix.h create mode 100644 include/xsf/mathieu/mathieu.h create mode 100644 include/xsf/mathieu/mathieu_coeffs.h create mode 100644 include/xsf/mathieu/mathieu_eigs.h create mode 100644 include/xsf/mathieu/mathieu_fcns.h create mode 100644 include/xsf/mathieu/matrix_utils.h diff --git a/include/xsf/mathieu/LICENSE b/include/xsf/mathieu/LICENSE new file mode 100644 index 0000000000..38a528a5e1 --- /dev/null +++ b/include/xsf/mathieu/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2025 Stuart Brorson + +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 without limitation the rights +to use, copy, modify, merge, publish, 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. diff --git a/include/xsf/mathieu/Makefile b/include/xsf/mathieu/Makefile new file mode 100644 index 0000000000..4e61479814 --- /dev/null +++ b/include/xsf/mathieu/Makefile @@ -0,0 +1,36 @@ +CC := g++ +# CC := gcc +CFLAGS := -O3 -std=c++17 -fno-fast-math -march=x86-64 -m128bit-long-double +#CFLAGS := -O3 -std=c++17 -fno-fast-math -mfpmath=sse -march=x86-64 -m128bit-long-double + +SRCS := $(wildcard *.c) +OBJS := $(SRCS:.c=.o) +EXES := main +TARGETS = main +INCLUDES := -I. -I/usr/include -I/usr/local/include +LDFLAGS := -L/usr/lib/x86_64-linux-gnu/lapack/ +#LDFLAGS := -L/usr/lib/x86_64-linux-gnu/openblas-pthread/ -L/usr/lib -L/usr/local/lib +#INCLUDES := -I. -I/usr/include/x86_64-linux-gnu/ +#LDFLAGS := -L/usr/lib/x86_64-linux-gnu +LIBS := -llapacke -llapack -lblas -lm + + +#================================================= +all: $(TARGETS) + +# Link all object files into the executable +$(TARGETS): $(OBJS) + $(CC) $(OBJS) -o $@ $(CFLAGS) $(LDFLAGS) $(LIBS) + +# Compile each .c into a .o +%.o: %.c %.h + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +# Also handle .c files without headers +%.o: %.c + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +#------------------------------- +# Clean up directory -- remove executables and intermediate files. +clean: + -rm -f *~ *.o *.obj *.out *.map *.h.gch $(TARGETS) $(OBJS) diff --git a/include/xsf/mathieu/README.md b/include/xsf/mathieu/README.md new file mode 100644 index 0000000000..5e22ce0758 --- /dev/null +++ b/include/xsf/mathieu/README.md @@ -0,0 +1,39 @@ +This is an implementation of the Mathieu fcns in C/C++. The +implementation follows the prototype algos created in Matlab and +maintained on GitHub at +https://github.com/brorson/MathieuFcnsFourier. This impl is a +header-only library for compatability with Scipy's xsf library. + +The following Mathieu fcns are implemented: + +* Angular fcn ce(n,q,v) +* Angular fcn se(n,q,v) +* Radial (modified) fcn of first kind mc1(n,q,u) +* Radial (modified) fcn of first kind ms1(n,q,u) +* Radial (modified) fcn of second kind mc2(n,q,u) +* Radial (modified) fcn of second kind ms2(n,q,u) + +Here, n = fcn order, q = frequency (geometry) parmeter, v = angular +coord (radians), u = radial coord (au). + +I also provide the following utility fcns: + +* Eigenvalue a_n(q) +* Eigenvalue b_n(q) +* Fourier coeffs A_n^k(q) for ce fcns +* Fourier coeffs B_n^k(q) for se fcns + +The goal is to provide a replacement of the Mathieu fcn suite used by +Scipy. + +These programs may be built the usual way on a Linux system using the +usual GNU build tools. The main() function runs some simple sanity +checks on the functions. In particular, it verifies some output +values against those computed by the Matlab programs. I did a lot of +verification and accuracy testing on the Matlab implementations. +Therefore, tests run here just make sure the C implementation's +outputs match those from Matlab. The code in main() also shows how to +invoke the various fcns. + +Summer 2025, SDB + diff --git a/include/xsf/mathieu/besseljyd.h b/include/xsf/mathieu/besseljyd.h new file mode 100644 index 0000000000..7f1a4c63de --- /dev/null +++ b/include/xsf/mathieu/besseljyd.h @@ -0,0 +1,85 @@ +#ifndef BESSELJYD_H +#define BESSELJYD_H + +#include "../config.h" +#include "../bessel.h" + + +/* + * + * This is part of the Mathieu function suite -- a reimplementation + * of the Mathieu functions for Scipy. This file holds helpers + * to the Bessel J and Y functions and also returns derivatives + * of those fcns. + * + */ + +namespace xsf { +namespace mathieu { + + //================================================================== + double besselj(int k, double z) { + // This is just a thin wrapper around the Bessel impl in the + // std library. + double v = (double) k; + return xsf::cyl_bessel_j(v, z); + } + + //================================================================== + double bessely(int k, double z) { + // This is just a thin wrapper around the Bessel impl in the + // std library. + double v = (double) k; + return xsf::cyl_bessel_y(v, z); + } + + //================================================================== + double besseljd(int k, double z) { + // This returns the derivative of besselj. The deriv is + // computed using common identities. + double y; + + if (k == 0) { + double v = 1.0d; + y = -besselj(v,z); + } else { + double kp1 = (double) (k+1); + double km1 = (double) (k-1); + y = (besselj(km1,z)-besselj(kp1,z))/2.0d; + } + + // Must flip sign for negative k and odd k. + if (k<0 && ((k % 2) != 0)) { + y = -y; + } + + return y; + } + + //================================================================== + double besselyd(int k, double z) { + // This returns the derivative of besselj. The deriv is + // computed using common identities. + double y; + + if (k == 0) { + double v = 1.0d; + y = -bessely(v,z); + } else { + double kp1 = (double) (k+1); + double km1 = (double) (k-1); + y = (bessely(km1,z)-bessely(kp1,z))/2.0d; + } + + // Must flip sign for negative k and odd k. + if (k<0 && ((k % 2) != 0)) { + y = -y; + } + + return y; + } + +} // namespace xsf +} // namespace mathieu + +#endif // #ifndef BESSELJYD_H diff --git a/include/xsf/mathieu/main.c b/include/xsf/mathieu/main.c new file mode 100644 index 0000000000..73d2e06d39 --- /dev/null +++ b/include/xsf/mathieu/main.c @@ -0,0 +1,1357 @@ +#include +#include + +#include "matrix_utils.h" +#include "make_matrix.h" +#include "mathieu_eigs.h" +#include "mathieu_coeffs.h" +#include "mathieu_fcns.h" +#include "besseljyd.h" + +/* + * + * The goal of main() is to just verify that my C/C++ + * impl of the Mathieu fcns has been carried over from + * my Matlab impl correctly. Therefore, main just calls + * a bunch of golden value tests. The GVs were generated + * using the Matlab impl. I did fairly extensive + * validation of the Matlab impl. Therefore, if the tests + * here show the C impl matches the Matlab impl, then that + * should serve as verification of the C impl's correctness. + * + * A secondary goal is to show how to call the various fcns + * in my API. + * + */ + + +namespace xsf { +namespace mathieu { + + +//------------------------------------------------------------- +extern "C" int main() { + int N = 6; + int pass=0; + int fail=0; + + //******************************************************* + // First print out the recursion matrices. These are + // private -- not public fcns. But I want to see they + // are correct. + //******************************************************* + { + double *A = (double *) calloc(N*N, sizeof(double)); + double q = 2.0d; + + make_matrix_ee(N, q, A); + print_matrix(A, N, N); + printf("----------------------------------------------\n"); + + make_matrix_eo(N, q, A); + print_matrix(A, N, N); + printf("----------------------------------------------\n"); + + make_matrix_oe(N, q, A); + print_matrix(A, N, N); + printf("----------------------------------------------\n"); + + make_matrix_oo(N, q, A); + print_matrix(A, N, N); + printf("----------------------------------------------\n"); + + free(A); + } + + //******************************************************* + // Try computing the eigenvalues. These are public fcns. + //******************************************************* + ///* + printf("==============================================\n"); + printf("Test a eigenvalues\n"); + double a; + { + double q = 0.001; + double tol = 1e-13; + + // Golden values from Matlab. + double a_true[6] = { + -4.999999453125127e-07, + 1.000999874984374, + 4.000000416666611, + 9.000000062515628, + 16.000000033333333, + 25.000000020833337 + }; + printf("q = %f\n", q); + for (int m = 0; m +T cem_cva(T m, T q) { + // This returns the even Mathieu characteristic value (eigenvalue) a. + + // Check for invalid Mathieu order. + if ((m < 0) || (m != floor(m))) { + set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double da; + + int retcode = xsf::mathieu::mathieu_a(im, dq, &da); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T a = static_cast(da); + return a; +} + +//------------------------------------------------------------- +template +T sem_cva(T m, T q) { + // This returns the odd Mathieu characteristic value (eigenvalue) b. + + // Check for invalid Mathieu order. + if ((m < 1) || (m != floor(m))) { + set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double db; + + int retcode = xsf::mathieu::mathieu_b(im, dq, &db); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T b = static_cast(db); + return b; +} + + +//--------------------------------------------------------------- +/* Mathieu functions */ +template +void cem(T m, T q, T x, T &csf, T &csd) { + + if ((m < 0) || (m != floor(m))) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dcsf; + double dcsd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); + if (retcode != SF_ERROR_OK) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", (sf_error_t) retcode, NULL); + } else { + csf = static_cast(dcsf); + csd = static_cast(dcsd); + } + } +} + + +//--------------------------------------------------------------- +template +void sem(T m, T q, T x, T &csf, T &csd) { + + if ((m < 1) || (m != floor(m))) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dcsf; + double dcsd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dcsf, &dcsd); + if (retcode != SF_ERROR_OK) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", (sf_error_t) retcode, NULL); + } else { + csf = static_cast(dcsf); + csd = static_cast(dcsd); + } + } +} + +//--------------------------------------------------------------- +template +void mcm1(T m, T q, T x, T &f1r, T &d1r) { + + if ((m < 0) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", (sf_error_t) retcode, NULL); + } else { + f1r = static_cast(df1r); + d1r = static_cast(dd1r); + } + } +} + +//--------------------------------------------------------------- +template +void msm1(T m, T q, T x, T &f1r, T &d1r) { + + if ((m < 1) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", (sf_error_t) retcode, NULL); + } else { + f1r = static_cast(df1r); + d1r = static_cast(dd1r); + } + } + +} + +//--------------------------------------------------------------- +template +void mcm2(T m, T q, T x, T &f2r, T &d2r) { + + if ((m < 0) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", (sf_error_t) retcode, NULL); + } else { + f2r = static_cast(df2r); + d2r = static_cast(dd2r); + } + } + +} + +//--------------------------------------------------------------- +template +void msm2(T m, T q, T x, T &f2r, T &d2r) { + + if ((m < 1) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", (sf_error_t) retcode, NULL); + } else { + f2r = static_cast(df2r); + d2r = static_cast(dd2r); + } + } +} + + +} // namespace xsf diff --git a/include/xsf/mathieu/mathieu_coeffs.h b/include/xsf/mathieu/mathieu_coeffs.h new file mode 100644 index 0000000000..7df37c4034 --- /dev/null +++ b/include/xsf/mathieu/mathieu_coeffs.h @@ -0,0 +1,292 @@ +#ifndef MATHIEU_COEFFS_H +#define MATHIEU_COEFFS_H + +#include "../config.h" +#include "../error.h" +#include "make_matrix.h" +#include "matrix_utils.h" + +#define SQRT2 1.414213562373095d + +/* + * + * This is part of the Mathieu function suite -- a reimplementation + * of the Mathieu functions for Scipy. This file holds the functions + * which return the Mathieu A and B coefficients used in the Fourier + * series computing the Mathieu fcns. + * + */ + + +/* DSYEV_ prototype */ +#ifdef __cplusplus +extern "C" { +#endif +void dsyev_( char* jobz, char* uplo, int* n, double* a, int* lda, + double* w, double* work, int* lwork, int* info ); +#ifdef __cplusplus +} +#endif + + +namespace xsf { +namespace mathieu { + + //------------------------------------------------------ + int mathieu_coeffs_ee(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order ce_2n Mathieu fcn. + // Allowed value of m = 0, 2, 4, 6, ... + // Inputs: + // N = size of recursion matrix to use. + // q = frequency parameter + // m = order of Mathieu fcn desired. + // Output: + // AA = length N vector preallocated to hold coeffs. + // Returns 0 if all goes well. Must put check on calloc + // here. + + int retcode = 0; + + // Bail out if m is not even. + if (m % 2 != 0) return -1; + + // Allocate recursion matrix + double *A = (double *) calloc(N*N, sizeof(double)); + if (A == NULL) return SF_ERROR_MEMORY; + + // Do EVD + retcode = make_matrix_ee(N,q,A); + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + { + // Work in local scope. + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + double* work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_( V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode ); + lwork = (int)wkopt; + work = (double*)malloc( lwork*sizeof(double) ); + /* Solve eigenproblem */ + dsyev_( V, U, &N, A, &N, AA, work, &lwork, &retcode ); + free(work); + } + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + //print_matrix(AA, N, 1); + + // Undo sqrt(2) in make_matrix by normalizing elet in first col by sqrt(2). + int idx; + int row = m/2; + idx = MATRIX_IDX(N, row, 0); + AA[0] = A[idx]/SQRT2; + // Transfer remaining elets in correct row to coeff vector. + for (int j = 1; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + free(A); + return retcode; + } + + + //------------------------------------------------------ + int mathieu_coeffs_eo(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order ce_2n+1 Mathieu fcn. + // Allowed value of m = 1, 3, 5, 7 ... + + int retcode = 0; + + // Bail out if m is not odd. + if (m % 2 != 1) return -1; + + // Allocate recursion matrix + double *A = (double *) calloc(N*N, sizeof(double)); + if (A == NULL) return SF_ERROR_MEMORY; + + // Do EVD + retcode = make_matrix_eo(N,q,A); + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + { + // Work in local scope. + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + double* work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_( V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode ); + lwork = (int)wkopt; + work = (double*)malloc( lwork*sizeof(double) ); + /* Solve eigenproblem */ + dsyev_( V, U, &N, A, &N, AA, work, &lwork, &retcode ); + free(work); + } + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + //print_matrix(AA, N, 1); + + // Transfer correct row to coeff vector. + int idx; + int row = (m-1)/2; + // Transfer elets in correct row to coeff vector. + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + free(A); + return retcode; + } + + + //------------------------------------------------------ + int mathieu_coeffs_oe(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order se_2n Mathieu fcn. + // Allowed value of m = 2, 4, 6, ... + // Inputs: + // N = size of recursion matrix to use. + // q = frequency parameter + // m = order of Mathieu fcn desired. + // Output: + // AA = length N vector preallocated to hold coeffs. + // Returns 0 if all goes well. Must put check on calloc + // here. + + int retcode = 0; + + // Bail out if m is not even or >= 2. + if ((m % 2 != 0) || (m < 2)) return -1; + + // Allocate recursion matrix + double *A = (double *) calloc(N*N, sizeof(double)); + if (A == NULL) return SF_ERROR_MEMORY; + + // Do EVD + retcode = make_matrix_oe(N,q,A); + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + { + // Work in local scope. + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + double* work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_( V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode ); + lwork = (int)wkopt; + work = (double*)malloc( lwork*sizeof(double) ); + /* Solve eigenproblem */ + dsyev_( V, U, &N, A, &N, AA, work, &lwork, &retcode ); + free(work); + } + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + //print_matrix(AA, N, 1); + + // Transfer remaining elets in correct row to coeff vector. + int idx; + int row = (m-2)/2; + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + free(A); + return retcode; + } + + + //------------------------------------------------------ + int mathieu_coeffs_oo(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order se_2n+1 Mathieu fcn. + // Allowed value of m = 1, 3, 5, 7 ... + + int retcode = 0; + + // Bail out if m is not odd. + if (m % 2 != 1) return -1; + + // Allocate recursion matrix + double *A = (double *) calloc(N*N, sizeof(double)); + if (A == NULL) return SF_ERROR_MEMORY; + + // Do EVD + retcode = make_matrix_oo(N,q,A); + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + { + // Work in local scope + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + double* work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_( V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode ); + lwork = (int)wkopt; + work = (double*)malloc( lwork*sizeof(double) ); + /* Solve eigenproblem */ + dsyev_( V, U, &N, A, &N, AA, work, &lwork, &retcode ); + free(work); + } + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + //print_matrix(AA, N, 1); + + // Transfer correct row to coeff vector. + int idx; + int row = (m-1)/2; + // Transfer elets in correct row to coeff vector. + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + free(A); + return retcode; + } + + +} // namespace mathieu +} // namespace xsf + +#endif // #ifndef MATHIEU_COEFFS_H diff --git a/include/xsf/mathieu/mathieu_eigs.h b/include/xsf/mathieu/mathieu_eigs.h new file mode 100644 index 0000000000..c8a23ed508 --- /dev/null +++ b/include/xsf/mathieu/mathieu_eigs.h @@ -0,0 +1,269 @@ +#ifndef MATHIEU_EIGS_H +#define MATHIEU_EIGS_H + +#include "../config.h" +#include "../error.h" +#include "make_matrix.h" +#include "matrix_utils.h" + + +/* + * + * This is part of the Mathieu function suite -- a reimplementation + * of the Mathieu functions for Scipy. This file holds the functions + * which return the Mathieu eigenvalues (characteristic values) a and + * b as a function of parameter q. + * + */ + + +/* DSYEV_ prototype */ +#ifdef __cplusplus +extern "C" { +#endif +void dsyev_( char* jobz, char* uplo, int* n, double* a, int* lda, + double* w, double* work, int* lwork, int* info ); +#ifdef __cplusplus +} +#endif + + +namespace xsf { +namespace mathieu { + + //------------------------------------------------------ + int mathieu_a(int m, double q, double *a) { + // printf("--> mathieu_a, m = %d, q = %e\n", m, q); + + int N = m+25; // Sets size of recursion matrix + int retcode = SF_ERROR_OK; + + if (m>500) { + // Don't support absurdly larger orders for now. + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + // Allocate recursion matrix + double *A = (double *) calloc(N*N, sizeof(double)); + if (A == NULL) { + *a =std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + // Allocate vector for eigenvalues + double *ww = (double *) calloc(N, sizeof(double)); + if (ww == NULL) { + *a =std::numeric_limits::quiet_NaN(); + free(A); + return SF_ERROR_MEMORY; + } + + // Do EVD + if (m % 2 == 0) { + // Even order m + retcode = make_matrix_ee(N,q,A); + if (retcode != 0){ + *a =std::numeric_limits::quiet_NaN(); + free(A); + free(ww); + return retcode; + } + { + char V = 'V'; + char U = 'U'; + double wkopt; + double* work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_( &V, &U, &N, A, &N, ww, &wkopt, &lwork, &retcode ); + lwork = (int) wkopt; + work = (double*)malloc( lwork*sizeof(double) ); + /* Solve eigenproblem */ + dsyev_( &V, &U, &N, A, &N, ww, work, &lwork, &retcode ); + free(work); + } + if (retcode != 0) { + *a =std::numeric_limits::quiet_NaN(); + free(A); + free(ww); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + quickSort(ww, 0, N-1); + //print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = m/2; + *a = ww[idx]; + + } else { + // Odd order m + retcode = make_matrix_eo(N,q,A); + if (retcode != 0) { + *a =std::numeric_limits::quiet_NaN(); + free(A); + free(ww); + return retcode; + } + { + char V = 'V'; + char U = 'U'; + double wkopt; + double* work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_( &V, &U, &N, A, &N, ww, &wkopt, &lwork, &retcode ); + lwork = (int) wkopt; + work = (double*)malloc( lwork*sizeof(double) ); + /* Solve eigenproblem */ + dsyev_( &V, &U, &N, A, &N, ww, work, &lwork, &retcode ); + free(work); + } + if (retcode != 0) { + *a =std::numeric_limits::quiet_NaN(); + free(A); + free(ww); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + quickSort(ww, 0, N-1); + //print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m-1)/2; + *a = ww[idx]; + } + + free(A); + free(ww); + // printf("<-- mathieu_a\n"); + return retcode; + } + + //------------------------------------------------------ + int mathieu_b(int m, double q, double *b) { + // printf("--> mathieu_b, m = %d, q = %e\n", m, q); + int N = m+25; // Sets size of recursion matrix + int retcode = SF_ERROR_OK; + + if (m>500) { + // Don't support absurdly larger orders for now. + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + // Allocate recursion matrix + double *B = (double *) calloc(N*N, sizeof(double)); + if (B == NULL) { + *b =std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + // Allocate vector for eigenvalues + double *ww = (double *) calloc(N, sizeof(double)); + if (ww == NULL) { + *b =std::numeric_limits::quiet_NaN(); + free(B); + return SF_ERROR_MEMORY; + } + + // Do EVD + if (m % 2 == 0) { + // Even order m + retcode = make_matrix_oe(N,q,B); + if (retcode != 0) { + *b =std::numeric_limits::quiet_NaN(); + free(B); + free(ww); + return retcode; + } + { + char V = 'V'; + char U = 'U'; + double wkopt; + double* work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_( &V, &U, &N, B, &N, ww, &wkopt, &lwork, &retcode ); + lwork = (int) wkopt; + work = (double*)malloc( lwork*sizeof(double) ); + /* Solve eigenproblem */ + dsyev_( &V, &U, &N, B, &N, ww, work, &lwork, &retcode ); + free(work); + } + if (retcode != 0) { + *b =std::numeric_limits::quiet_NaN(); + free(B); + free(ww); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + quickSort(ww, 0, N-1); + //print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m-2)/2; + *b = ww[idx]; + + } else { + // Odd order m + retcode = make_matrix_oo(N,q,B); + if (retcode != 0) { + *b =std::numeric_limits::quiet_NaN(); + free(B); + free(ww); + return retcode; + } + { + char V = 'V'; + char U = 'U'; + double wkopt; + double* work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_( &V, &U, &N, B, &N, ww, &wkopt, &lwork, &retcode ); + lwork = (int) wkopt; + work = (double*)malloc( lwork*sizeof(double) ); + /* Solve eigenproblem */ + dsyev_( &V, &U, &N, B, &N, ww, work, &lwork, &retcode ); + free(work); + } + if (retcode != 0) { + *b =std::numeric_limits::quiet_NaN(); + free(B); + free(ww); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + quickSort(ww, 0, N-1); + //print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m-1)/2; + *b = ww[idx]; + + } + + free(B); + free(ww); + // printf("<-- mathieu_b\n"); + return retcode; + } + +} // namespace mathieu +} // namespace xsf + +#endif // #ifndef MATHIEU_EIGS_H diff --git a/include/xsf/mathieu/mathieu_fcns.h b/include/xsf/mathieu/mathieu_fcns.h new file mode 100644 index 0000000000..9c2110abaf --- /dev/null +++ b/include/xsf/mathieu/mathieu_fcns.h @@ -0,0 +1,1480 @@ +#ifndef MATHIEU_FCNS_H +#define MATHIEU_FCNS_H + +#include "../config.h" +#include "../error.h" +#include +#include "matrix_utils.h" +#include "mathieu_coeffs.h" +#include "besseljyd.h" + + +/* + * + * This is part of the Mathieu function suite -- a reimplementation + * of the Mathieu functions for Scipy. This file holds the function + * implementations themselves. The prototype was written in Matlab + * and validated. This is a translation from Matlab to C. + * + */ + +namespace xsf { +namespace mathieu { + + //================================================================== + int mathieu_ce(int m, double q, double v, double *ce, double *ced) { + // This computes the Mathieu fcn ce + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // v = angle in radians (scalar) + // Outputs: + // ce = value of fcn for these inputs (scalar) + // ced = value of fcn deriv w.r.t. v for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + + // Check input domain and flag any problems. + if (m>500) { + // Don't support absurdly larger orders for now. + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + // abs(q) > 1000 leads to low accuracy. + if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; + + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even ce + double *AA = (double *) calloc(N, sizeof(double)); + if (AA == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_ee(N,q,m, AA); + if (retcode != SF_ERROR_OK) { + free(AA); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, cep, cem, cedp, cedm; + cem = 0.0d; cep = 0.0d; cedm = 0.0d; cedp = 0.0d; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + tt = AA[k]*cos(2.0d*k*v); // Term for Mathieu ce + if (tt<0) { + cem = cem + tt; // Neg running sum + } else { + cep = cep + tt; // Pos running sum + } + + td = -2.0d*k*AA[k]*sin(2.0d*k*v); // Term for deriv + if (td<0) { + cedm = cedm + td; + } else { + cedp = cedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *ce = cep+cem; + *ced = cedp+cedm; + + // Hack -- this makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0d; + for (int l = 0; l=0 ; k--) { + tt = AA[k]*cos((2.0d*k+1.0d)*v); // Term for Mathieu ce + if (tt<0) { + cem = cem + tt; // Neg running sum + } else { + cep = cep + tt; // Pos running sum + } + + td = -(2.0d*k+1.0d)*AA[k]*sin((2.0d*k+1.0d)*v); // Deriv. + if (td<0) { + cedm = cedm + td; + } else { + cedp = cedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *ce = cep+cem; + *ced = cedp+cedm; + + // Hack -- this makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0d; + for (int l = 0; l500) { + // Don't support absurdly larger orders for now. + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + // q>1000 leads to inaccuracy. + if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even se + double *BB = (double *) calloc(N, sizeof(double)); + if (BB == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_oe(N,q,m, BB); + if (retcode != SF_ERROR_OK) { + free(BB); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, sep, sem, sedp, sedm; + sem = 0.0d; sep = 0.0d; sedm = 0.0d; sedp = 0.0d; + + // Sum from smallest to largest coeff. + for (int k=N; k>=1 ; k--) { + tt = BB[k-1]*sin(2.0d*k*v); // Mathieu se term + if (tt<0) { + sem = sem + tt; // Neg running sum + } else { + sep = sep + tt; // Pos running sum + } + + td = 2.0d*k*BB[k-1]*cos(2.0d*k*v); // Deriv term. + if (td<0) { + sedm = sedm + td; + } else { + sedp = sedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *se = sep+sem; + *sed = sedp+sedm; + + // Hack -- this makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0d; + for (int l = 0; l=0 ; k--) { + tt = BB[k]*sin((2.0d*k+1.0d)*v); // Mathieu se term + if (tt<0) { + sem = sem + tt; // Neg running sum + } else { + sep = sep + tt; // Pos running sum + } + + td = (2.0d*k+1.0d)*BB[k]*cos((2.0d*k+1.0d)*v); // Deriv term. + if (td<0) { + sedm = sedm + td; + } else { + sedp = sedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *se = sep+sem; + *sed = sedp+sedm; + + // Hack -- this makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0d; + for (int l = 0; l500) { + // Don't support absurdly larger orders for now. + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + if (q<0) return SF_ERROR_DOMAIN; // q<0 is unimplemented + if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; // q>1000 is inaccurate + if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq*expmu; + double t = sqq*exppu; + + // This is used for the adaptive computation. + // I set the offset used in Bessel sum depending upon order m. + // The offset depends upon exactly where in the [q,m] plane lives + // the input args. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. + if ( (m>5 && q<.001) || + (m>7 && q<.01) || + (m>10 && q<.1) || + (m>15 && q<1) || + (m>20 && q<10) || + (m>30 && q<100) ) { + c = m/2; + } else { + c = 0; + } + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even modmc1 + double *AA = (double *) calloc(N, sizeof(double)); + if (AA == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_ee(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + free(AA); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign, and I want to + // avoid catastrophic cancellation. + _Float128 mc1p, mc1m, mc1dp, mc1dm; + mc1p = 0.0; mc1m = 0.0; mc1dp = 0.0; mc1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Jkt = besselj(k,t); + double Jdks = besseljd(k,s); + double Jdkt = besseljd(k,t); + + _Float128 tt = AA[k]*(Jks*Jkt); + _Float128 ttd = AA[k]*(exppu*Jks*Jdkt - expmu*Jdks*Jkt); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c,s); + double Jkpct = besselj(k+c,t); + double Jkmct = besselj(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c,s); + double Jdkpct = besseljd(k+c,t); + double Jdkmct = besseljd(k-c,t); + + _Float128 tt = AA[k]*(Jkmcs*Jkpct + Jkpcs*Jkmct); + _Float128 ttd = AA[k]* + (exppu*(Jkmcs*Jdkpct + Jkpcs*Jdkmct) - + expmu*(Jdkmcs*Jkpct + Jdkpcs*Jkmct)) ; + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *mc1 = static_cast(mc1p+mc1m); + *mc1d = static_cast(mc1dp+mc1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = m/2; + if (sgn%2 == 0) { + *mc1 = (*mc1)/AA[c]; + *mc1d = sqq*(*mc1d)/AA[c]; + } else { + *mc1 = -(*mc1)/AA[c]; + *mc1d = -sqq*(*mc1d)/AA[c]; + } + + free(AA); + + } else { + // Odd -- m = 1, 3, 5, 7 ... + + // Get coeff vector for even modmc1 + double *AA = (double *) calloc(N, sizeof(double)); + if (AA == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_eo(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + free(AA); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 mc1p, mc1m, mc1dp, mc1dm; + mc1p = 0.0; mc1m = 0.0; mc1dp = 0.0; mc1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Jkp1s = besselj(k+1,s); + double Jkt = besselj(k,t); + double Jkp1t = besselj(k+1,t); + + double Jdks = besseljd(k,s); + double Jdkp1s = besseljd(k+1,s); + double Jdkt = besseljd(k,t); + double Jdkp1t = besseljd(k+1,t); + + _Float128 tt = AA[k]*(Jks*Jkp1t + Jkp1s*Jkt); + _Float128 ttd = AA[k]* + (exppu*(Jks*Jdkp1t + Jkp1s*Jdkt) - + expmu*(Jdks*Jkp1t + Jdkp1s*Jkt) ) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c+1,s); + double Jkpct = besselj(k+c+1,t); + double Jkmct = besselj(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c+1,s); + double Jdkpct = besseljd(k+c+1,t); + double Jdkmct = besseljd(k-c,t); + + _Float128 tt = AA[k]*(Jkmcs*Jkpct + Jkpcs*Jkmct); + _Float128 ttd = AA[k]* + (exppu*(Jkmcs*Jdkpct + Jkpcs*Jdkmct) - + expmu*(Jdkmcs*Jkpct + Jdkpcs*Jkmct)) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *mc1 = static_cast(mc1p+mc1m); + *mc1d = static_cast(mc1dp+mc1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-1)/2; + if (sgn%2 == 0) { + *mc1 = (*mc1)/AA[c]; + *mc1d = sqq*(*mc1d)/AA[c]; + } else { + *mc1 = -(*mc1)/AA[c]; + *mc1d = -sqq*(*mc1d)/AA[c]; + } + + free(AA); + } + + return retcode; + } // int mathieu_modmc1 + + + //================================================================== + int mathieu_modms1(int m, double q, double u, double *ms1, double *ms1d) { + // This computes the Mathieu fcn modms1 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // ms1 = value of fcn for these inputs (scalar) + // ms1d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check input domain and flag any problems + if (m>500) { + // Don't support absurdly larger orders for now. + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + if (q<0) return SF_ERROR_DOMAIN; // q < 0 is currently unimplemented + if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; + if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq*expmu; + double t = sqq*exppu; + + // This is used for the adaptive computation. + // I set the offset used in Bessel fcn depending upon order m. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. + if ( (m>5 && q<.001) || + (m>7 && q<.01) || + (m>10 && q<.1) || + (m>15 && q<1) || + (m>20 && q<10) || + (m>30 && q<100) ) { + c = m/2; + } else { + c = 0; + } + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even modms1 + double *BB = (double *) calloc(N, sizeof(double)); + if (BB == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_oe(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + free(BB); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 ms1p, ms1m, ms1dp, ms1dm; + ms1p = 0.0; ms1m = 0.0; ms1dp = 0.0; ms1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Jkp2t = besselj(k+2,t); + double Jkp2s = besselj(k+2,s); + double Jkt = besselj(k,t); + + double Jdks = besseljd(k,s); + double Jdkp2t = besseljd(k+2,t); + double Jdkp2s = besseljd(k+2,s); + double Jdkt = besseljd(k,t); + + _Float128 tt = BB[k]*(Jks*Jkp2t - Jkp2s*Jkt); + _Float128 ttd = BB[k]* + (exppu*(Jks*Jdkp2t - Jkp2s*Jdkt) - + expmu*(Jdks*Jkp2t - Jdkp2s*Jkt)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpct = besselj(k+c+2,t); + double Jkpcs = besselj(k+c+2,s); + double Jkmct = besselj(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpct = besseljd(k+c+2,t); + double Jdkpcs = besseljd(k+c+2,s); + double Jdkmct = besseljd(k-c,t); + + _Float128 tt = BB[k]*(Jkmcs*Jkpct - Jkpcs*Jkmct); + _Float128 ttd = BB[k]* + (exppu*(Jkmcs*Jdkpct - Jkpcs*Jdkmct) - + expmu*(Jdkmcs*Jkpct - Jdkpcs*Jkmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *ms1 = static_cast(ms1p+ms1m); + *ms1d = static_cast(ms1dp+ms1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-2)/2; + if (sgn%2 == 0) { + *ms1 = (*ms1)/BB[c]; + *ms1d = sqq*(*ms1d)/BB[c]; + } else { + *ms1 = -(*ms1)/BB[c]; + *ms1d = -sqq*(*ms1d)/BB[c]; + } + + free(BB); + + } else { + // Odd -- m = 1, 3, 5, 7 ... + + // Get coeff vector for even modms1 + double *BB = (double *) calloc(N, sizeof(double)); + if (BB == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_oo(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + free(BB); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 ms1p, ms1m, ms1dp, ms1dm; + ms1p = 0.0; ms1m = 0.0; ms1dp = 0.0; ms1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Jkt = besselj(k,t); + double Jkp1s = besselj(k+1,s); + double Jkp1t = besselj(k+1,t); + + double Jdks = besseljd(k,s); + double Jdkt = besseljd(k,t); + double Jdkp1s = besseljd(k+1,s); + double Jdkp1t = besseljd(k+1,t); + + _Float128 tt = BB[k]*(Jks*Jkp1t - Jkp1s*Jkt); + _Float128 ttd = BB[k]* + (exppu*(Jks*Jdkp1t - Jkp1s*Jdkt) - + expmu*(Jdks*Jkp1t - Jdkp1s*Jkt)); + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c+1,s); + double Jkpct = besselj(k+c+1,t); + double Jkmct = besselj(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c+1,s); + double Jdkpct = besseljd(k+c+1,t); + double Jdkmct = besseljd(k-c,t); + + _Float128 tt = BB[k]*(Jkmcs*Jkpct - Jkpcs*Jkmct); + _Float128 ttd = BB[k]* + (exppu*(Jkmcs*Jdkpct - Jkpcs*Jdkmct) - + expmu*(Jdkmcs*Jkpct - Jdkpcs*Jkmct)) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *ms1 = static_cast(ms1p+ms1m); + *ms1d = static_cast(ms1dp+ms1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-1)/2; + if (sgn%2 == 0) { + *ms1 = (*ms1)/BB[c]; + *ms1d = sqq*(*ms1d)/BB[c]; + } else { + *ms1 = -(*ms1)/BB[c]; + *ms1d = -sqq*(*ms1d)/BB[c]; + } + + free(BB); + } + + return retcode; + } // int mathieu_modms1 + + + //================================================================== + int mathieu_modmc2(int m, double q, double u, double *mc2, double *mc2d) { + // This computes the Mathieu fcn modmc2 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // mc2 = value of fcn for these inputs (scalar) + // mc2d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check input domain and flag any problems + if (m>500) { + // Don't support absurdly larger orders for now. + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + if (q<0) return SF_ERROR_DOMAIN; // q<0 is currently unimplemented + if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; + if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq*expmu; + double t = sqq*exppu; + + // This is used for the adaptive computation. + // I set the offset used in Bessel fcn depending upon order m. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. + if ( (m>5 && q<.001) || + (m>7 && q<.01) || + (m>10 && q<.1) || + (m>15 && q<1) || + (m>20 && q<10) || + (m>30 && q<100) ) { + c = m/2; + } else { + c = 0; + } + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even modmc2 + double *AA = (double *) calloc(N, sizeof(double)); + if (AA == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_ee(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + free(AA); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 mc2p, mc2m, mc2dp, mc2dm; + + // Sum from smallest to largest coeff. + mc2p = 0.0; mc2m = 0.0; mc2dp = 0.0; mc2dm = 0.0; + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Ykt = bessely(k,t); + double Jdks = besseljd(k,s); + double Ydkt = besselyd(k,t); + + _Float128 tt = AA[k]*Jks*Ykt ; + _Float128 ttd = AA[k]*(exppu*Jks*Ydkt - expmu*Jdks*Ykt) ; + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c,s); + double Ykpct = bessely(k+c,t); + double Ykmct = bessely(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c,s); + double Ydkpct = besselyd(k+c,t); + double Ydkmct = besselyd(k-c,t); + + _Float128 tt = AA[k]*(Jkmcs*Ykpct + Jkpcs*Ykmct); + _Float128 ttd = AA[k]* + (exppu*(Jkmcs*Ydkpct + Jkpcs*Ydkmct) - + expmu*(Jdkmcs*Ykpct + Jdkpcs*Ykmct)) ; + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *mc2 = static_cast(mc2p+mc2m); + *mc2d = static_cast(mc2dp+mc2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = m/2; + if (sgn%2 == 0) { + *mc2 = (*mc2)/AA[c]; + *mc2d = sqq*(*mc2d)/AA[c]; + } else { + *mc2 = -(*mc2)/AA[c]; + *mc2d = -sqq*(*mc2d)/AA[c]; + } + + free(AA); + + } else { + // Odd -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd mc2 + double *AA = (double *) calloc(N, sizeof(double)); + if (AA == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_eo(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + free(AA); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 mc2p, mc2m, mc2dp, mc2dm; + mc2p = 0.0; mc2m = 0.0; mc2dp = 0.0; mc2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Ykt = bessely(k,t); + double Jkp1s = besselj(k+1,s); + double Ykp1t = bessely(k+1,t); + + double Jdks = besseljd(k,s); + double Ydkt = besselyd(k,t); + double Jdkp1s = besseljd(k+1,s); + double Ydkp1t = besselyd(k+1,t); + + _Float128 tt = AA[k]*(Jks*Ykp1t + Jkp1s*Ykt); + _Float128 ttd = AA[k]* + (exppu*(Jks*Ydkp1t + Jkp1s*Ydkt) - + expmu*(Jdks*Ykp1t + Jdkp1s*Ykt) ) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c+1,s); + double Ykpct = bessely(k+c+1,t); + double Ykmct = bessely(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c+1,s); + double Ydkpct = besselyd(k+c+1,t); + double Ydkmct = besselyd(k-c,t); + + _Float128 tt = AA[k]*(Jkmcs*Ykpct + Jkpcs*Ykmct); + _Float128 ttd = AA[k]* + (exppu*(Jkmcs*Ydkpct + Jkpcs*Ydkmct) - + expmu*(Jdkmcs*Ykpct + Jdkpcs*Ykmct) ) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *mc2 = static_cast(mc2p+mc2m); + *mc2d = static_cast(mc2dp+mc2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-1)/2; + if (sgn%2 == 0) { + *mc2 = (*mc2)/AA[c]; + *mc2d = sqq*(*mc2d)/AA[c]; + } else { + *mc2 = -(*mc2)/AA[c]; + *mc2d = -sqq*(*mc2d)/AA[c]; + } + + free(AA); + } + + return retcode; + } // int mathieu_modmc2 + + + //================================================================== + int mathieu_modms2(int m, double q, double u, double *ms2, double *ms2d) { + // This computes the Mathieu fcn modms2 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // ms2 = value of fcn for these inputs (scalar) + // ms2d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check input domain and flag any problems + if (m>500) { + // Don't support absurdly larger orders for now. + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + if (q<0) return SF_ERROR_DOMAIN; // q<0 is currently unimplemented + if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; + if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq*expmu; + double t = sqq*exppu; + + // This is used for the adaptive computation. + // I set the offset used in Bessel fcn depending upon order m. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. + if ( (m>5 && q<.001) || + (m>7 && q<.01) || + (m>10 && q<.1) || + (m>15 && q<1) || + (m>20 && q<10) || + (m>30 && q<100) ) { + c = m/2; + } else { + c = 0; + } + c = 0; + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even modms2 + double *BB = (double *) calloc(N, sizeof(double)); + if (BB == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_oe(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + free(BB); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 ms2p, ms2m, ms2dp, ms2dm; + ms2p = 0.0; ms2m = 0.0; ms2dp = 0.0; ms2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Ykp2t = bessely(k+2,t); + double Jkp2s = besselj(k+2,s); + double Ykt = bessely(k,t); + + double Jdks = besseljd(k,s); + double Ydkp2t = besselyd(k+2,t); + double Jdkp2s = besseljd(k+2,s); + double Ydkt = besselyd(k,t); + + _Float128 tt = BB[k]*(Jks*Ykp2t - Jkp2s*Ykt); + _Float128 ttd = BB[k]* + (exppu*(Jks*Ydkp2t - Jkp2s*Ydkt) - + expmu*(Jdks*Ykp2t - Jdkp2s*Ykt)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Ykpct = bessely(k+c+2,t); + double Jkpcs = besselj(k+c+2,s); + double Ykmct = bessely(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Ydkpct = besselyd(k+c+2,t); + double Jdkpcs = besseljd(k+c+2,s); + double Ydkmct = besselyd(k-c,t); + + _Float128 tt = BB[k]*(Jkmcs*Ykpct - Jkpcs*Ykmct); + _Float128 ttd = BB[k]* + (exppu*(Jkmcs*Ydkpct - Jkpcs*Ydkmct) - + expmu*(Jdkmcs*Ykpct - Jdkpcs*Ykmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *ms2 = static_cast(ms2p+ms2m); + *ms2d = static_cast(ms2dp+ms2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-2)/2; + if (sgn%2 == 0) { + *ms2 = (*ms2)/BB[c]; + *ms2d = sqq*(*ms2d)/BB[c]; + } else { + *ms2 = -(*ms2)/BB[c]; + *ms2d = -sqq*(*ms2d)/BB[c]; + } + + free(BB); + + } else { + // Odd -- m = 1, 3, 5, 7 ... + + // Get coeff vector for even modms2 + double *BB = (double *) calloc(N, sizeof(double)); + if (BB == NULL) return SF_ERROR_MEMORY; + retcode = mathieu_coeffs_oo(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + free(BB); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 ms2p, ms2m, ms2dp, ms2dm; + ms2p = 0.0; ms2m = 0.0; ms2dp = 0.0; ms2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Ykt = bessely(k,t); + double Jkp1s = besselj(k+1,s); + double Ykp1t = bessely(k+1,t); + + double Jdks = besseljd(k,s); + double Ydkt = besselyd(k,t); + double Jdkp1s = besseljd(k+1,s); + double Ydkp1t = besselyd(k+1,t); + + _Float128 tt = BB[k]*(Jks*Ykp1t - Jkp1s*Ykt); + _Float128 ttd = BB[k]* + (exppu*(Jks*Ydkp1t - Jkp1s*Ydkt) - + expmu*(Jdks*Ykp1t - Jdkp1s*Ykt)); + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c+1,s); + double Ykpct = bessely(k+c+1,t); + double Ykmct = bessely(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c+1,s); + double Ydkpct = besselyd(k+c+1,t); + double Ydkmct = besselyd(k-c,t); + + _Float128 tt = BB[k]*(Jkmcs*Ykpct - Jkpcs*Ykmct); + _Float128 ttd = BB[k]* + (exppu*(Jkmcs*Ydkpct - Jkpcs*Ydkmct) - + expmu*(Jdkmcs*Ykpct - Jdkpcs*Ykmct) ) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *ms2 = static_cast(ms2p+ms2m); + *ms2d = static_cast(ms2dp+ms2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-1)/2; + if (sgn%2 == 0) { + *ms2 = (*ms2)/BB[c]; + *ms2d = sqq*(*ms2d)/BB[c]; + } else { + *ms2 = -(*ms2)/BB[c]; + *ms2d = -sqq*(*ms2d)/BB[c]; + } + + free(BB); + } + + return retcode; + } // int mathieu_modms2 + + + +} // namespace mathieu +} // namespace xsf + +#endif // #ifndef MATHIEU_FCNS_H + diff --git a/include/xsf/mathieu/matrix_utils.h b/include/xsf/mathieu/matrix_utils.h new file mode 100644 index 0000000000..5e16a489aa --- /dev/null +++ b/include/xsf/mathieu/matrix_utils.h @@ -0,0 +1,92 @@ +#ifndef MATRIX_UTILS_H +#define MATRIX_UTILS_H + +#include +#include +#include "matrix_utils.h" + +// These fcns are meant to make it easier to deal with +// matrices in C. We use col major format since that's +// what underlies Lapack. + +// returns +/-1 depending upon sign of x +#define SIGN(x) (((x) > 0) - ((x) < 0)) + +// Macros to extract matrix index and element. +// Matrix is NxN, i = row idx, j = col idx. +// MATRIX_IDX is where col major format is enforced. +#define MATRIX_IDX(N, I, J) (((N)*(I)) + (J)) +#define MATRIX_ELEMENT(A, m, n, i, j) A[ MATRIX_IDX(n, i, j) ] + +// Min and max macros for scalars. +#define MIN(a,b) (((a)<(b))?(a):(b)) +#define MAX(a,b) (((a)>(b))?(a):(b)) + +//=========================================================== +// This file holds utility functions for dealing with vectors +// and matrices. The idea is to be able to reuse common matrix +// operations. I will name the utils analogously to their names +// in Matlab. +// Note that C matrices are row-major. + + +namespace xsf { +namespace mathieu { + +//----------------------------------------------------- +void print_matrix(const double* A, int m, int n) { + // prints matrix as 2-dimensional tablei -- this is how we + // usually think of matrices. + int i, j; + for (i = 0; i < m; i++) { + for (j = 0; j < n; j++) { + printf("% 10.4e ", MATRIX_ELEMENT(A, m, n, i, j)); + } + printf("\n"); + } +} + + +//----------------------------------------------------- +// Stuff to sort a vector. +// Function to swap two elements +void swap(double* a, double* b) { + double temp = *a; + *a = *b; + *b = temp; +} + +// Partition function for quicksort +int partition(double *arr, int low, int high) { + double pivot = arr[high]; // Choose last element as pivot + int i = (low - 1); // Index of smaller element + + for (int j = low; j <= high - 1; j++) { + // If current element is smaller than or equal to pivot + if (arr[j] <= pivot) { + i++; + swap(&arr[i], &arr[j]); + } + } + swap(&arr[i + 1], &arr[high]); + return (i + 1); +} + +// Quicksort function +void quickSort(double *arr, int low, int high) { + if (low < high) { + // Partition the array and get pivot index + int pivotIndex = partition(arr, low, high); + + // Recursively sort elements before and after partition + quickSort(arr, low, pivotIndex - 1); + quickSort(arr, pivotIndex + 1, high); + } +} + + +} // namespace mathieu +} // namespace xsf + + +#endif // #ifndef MATRIX_UTILS_H From 204e09ddd331641ec8e47c62bcae874a57733317 Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Fri, 5 Sep 2025 21:35:29 -0400 Subject: [PATCH 03/12] Make sure we return nan when error is encountered. --- include/xsf/mathieu/make_matrix.h | 2 + include/xsf/mathieu/mathieu.h | 124 ++++++++++++++++++++-- include/xsf/mathieu/mathieu_coeffs.h | 2 + include/xsf/mathieu/mathieu_eigs.h | 26 ++--- include/xsf/mathieu/mathieu_fcns.h | 148 ++++++++++++++++++++++++--- 5 files changed, 262 insertions(+), 40 deletions(-) diff --git a/include/xsf/mathieu/make_matrix.h b/include/xsf/mathieu/make_matrix.h index 23eda562d5..9acc626300 100644 --- a/include/xsf/mathieu/make_matrix.h +++ b/include/xsf/mathieu/make_matrix.h @@ -10,6 +10,8 @@ * This is part of the Mathieu function suite -- a reimplementation * of the Mathieu functions for Scipy. This file holds the functions * which make the recursion matrices. + * + * Stuart Brorson, Summer 2025. * */ diff --git a/include/xsf/mathieu/mathieu.h b/include/xsf/mathieu/mathieu.h index fa23a754ab..b119feca86 100644 --- a/include/xsf/mathieu/mathieu.h +++ b/include/xsf/mathieu/mathieu.h @@ -8,11 +8,31 @@ #include "mathieu/besseljyd.h" #include "mathieu/mathieu_fcns.h" -namespace xsf { +/* + * + * This is part of the Mathieu function suite -- a reimplementation + * of the Mathieu functions for Scipy. This file #includes all the + * fcn impls in the mathieu/ subdirectory, and provides translation + * from the Scipy call to the calling signature I implemented in my + * reimplementation. + * + * Stuart Brorson, Summer 2025. + * + */ +namespace xsf { /* Characteristic values */ //------------------------------------------------------------- +/** + * Mathieu characteristic values (eigenvalues) for even parity functions. + * + * Even parity characteristic values a. + * + * @param m Eigenvalue order. Must be positive integer less than 500. + * @param q Mathieu parameter q. Real number. + * @return Mathieu eigenvalue a. + */ template T cem_cva(T m, T q) { // This returns the even Mathieu characteristic value (eigenvalue) a. @@ -41,6 +61,16 @@ T cem_cva(T m, T q) { //------------------------------------------------------------- template +/** + * Mathieu characteristic values (eigenvalues) b for odd functions. + * + * + * Odd parity characteristic values b. + * + * @param m Eigenvalue order. Must be positive integer less than 500. + * @param q Mathieu parameter q. Real number. + * @return Mathieu eigenvalue b. + */ T sem_cva(T m, T q) { // This returns the odd Mathieu characteristic value (eigenvalue) b. @@ -69,6 +99,18 @@ T sem_cva(T m, T q) { //--------------------------------------------------------------- /* Mathieu functions */ +/** + * Even parity Mathieu angular function ce(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Real number. + * @param x Angular coordinate x (radians). Real number. + * @param csf Value of function. Real number. + * @param csd Value of derivative w.r.t. x. Real number. + */ template void cem(T m, T q, T x, T &csf, T &csd) { @@ -100,12 +142,24 @@ void cem(T m, T q, T x, T &csf, T &csd) { //--------------------------------------------------------------- +/** + * Odd parity Mathieu angular function se(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Real number. + * @param x Angular coordinate x (radians). Real number. + * @param ssf Value of function. Real number. + * @param ssd Value of derivative w.r.t. x. Real number + */ template -void sem(T m, T q, T x, T &csf, T &csd) { +void sem(T m, T q, T x, T &ssf, T &ssd) { if ((m < 1) || (m != floor(m))) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); } else { @@ -113,23 +167,35 @@ void sem(T m, T q, T x, T &csf, T &csd) { int im = static_cast(m); double dq = static_cast(q); double dx = static_cast(x); - double dcsf; - double dcsd; + double dssf; + double dssd; // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dcsf, &dcsd); + int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); if (retcode != SF_ERROR_OK) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); set_error("mathieu_sem", (sf_error_t) retcode, NULL); } else { - csf = static_cast(dcsf); - csd = static_cast(dcsd); + ssf = static_cast(dssf); + ssd = static_cast(dssd); } } } //--------------------------------------------------------------- +/** + * Even parity modified (radial) Mathieu function of first kind Mc1(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Positive real number + * @param x Radial coordinate x. Positive real number. + * @param f1r Value of function. Real number. + * @param d1r Value of derivative w.r.t. x. Real number + */ template void mcm1(T m, T q, T x, T &f1r, T &d1r) { @@ -160,6 +226,18 @@ void mcm1(T m, T q, T x, T &f1r, T &d1r) { } //--------------------------------------------------------------- +/** + * Odd parity modified (radial) Mathieu function of first kind Ms1(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Positive real number + * @param x Radial coordinate x. Positive real number. + * @param f1r Value of function. Real number. + * @param d1r Value of derivative w.r.t. x. Real number + */ template void msm1(T m, T q, T x, T &f1r, T &d1r) { @@ -191,6 +269,18 @@ void msm1(T m, T q, T x, T &f1r, T &d1r) { } //--------------------------------------------------------------- +/** + * Even parity modified (radial) Mathieu function of second kind Mc2(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Positive real number + * @param x Radial coordinate x. Positive real number. + * @param f2r Value of function. Real number. + * @param d2r Value of derivative w.r.t. x. Real number + */ template void mcm2(T m, T q, T x, T &f2r, T &d2r) { @@ -222,6 +312,18 @@ void mcm2(T m, T q, T x, T &f2r, T &d2r) { } //--------------------------------------------------------------- +/** + * Odd parity modified (radial) Mathieu function of second kind Ms2(m, q, x) + * + * This implementation of ce follows the definitions on the + * DLMF, https://dlmf.nist.gov/28 + * + * @param m Function order. Must be positive integer less than 500. + * @param q Parameter q. Positive real number + * @param x Radial coordinate x. Positive real number. + * @param f2r Value of function. Real number. + * @param d2r Value of derivative w.r.t. x. Real number + */ template void msm2(T m, T q, T x, T &f2r, T &d2r) { diff --git a/include/xsf/mathieu/mathieu_coeffs.h b/include/xsf/mathieu/mathieu_coeffs.h index 7df37c4034..5feaafd0e9 100644 --- a/include/xsf/mathieu/mathieu_coeffs.h +++ b/include/xsf/mathieu/mathieu_coeffs.h @@ -14,6 +14,8 @@ * of the Mathieu functions for Scipy. This file holds the functions * which return the Mathieu A and B coefficients used in the Fourier * series computing the Mathieu fcns. + * + * Stuart Brorson, Summer 2025. * */ diff --git a/include/xsf/mathieu/mathieu_eigs.h b/include/xsf/mathieu/mathieu_eigs.h index c8a23ed508..28aafb4180 100644 --- a/include/xsf/mathieu/mathieu_eigs.h +++ b/include/xsf/mathieu/mathieu_eigs.h @@ -13,6 +13,8 @@ * of the Mathieu functions for Scipy. This file holds the functions * which return the Mathieu eigenvalues (characteristic values) a and * b as a function of parameter q. + * + * Stuart Brorson, summer 2025. * */ @@ -47,14 +49,14 @@ namespace mathieu { // Allocate recursion matrix double *A = (double *) calloc(N*N, sizeof(double)); if (A == NULL) { - *a =std::numeric_limits::quiet_NaN(); + *a = std::numeric_limits::quiet_NaN(); return SF_ERROR_MEMORY; } // Allocate vector for eigenvalues double *ww = (double *) calloc(N, sizeof(double)); if (ww == NULL) { - *a =std::numeric_limits::quiet_NaN(); + *a = std::numeric_limits::quiet_NaN(); free(A); return SF_ERROR_MEMORY; } @@ -64,7 +66,7 @@ namespace mathieu { // Even order m retcode = make_matrix_ee(N,q,A); if (retcode != 0){ - *a =std::numeric_limits::quiet_NaN(); + *a = std::numeric_limits::quiet_NaN(); free(A); free(ww); return retcode; @@ -86,7 +88,7 @@ namespace mathieu { free(work); } if (retcode != 0) { - *a =std::numeric_limits::quiet_NaN(); + *a = std::numeric_limits::quiet_NaN(); free(A); free(ww); return SF_ERROR_NO_RESULT; @@ -104,7 +106,7 @@ namespace mathieu { // Odd order m retcode = make_matrix_eo(N,q,A); if (retcode != 0) { - *a =std::numeric_limits::quiet_NaN(); + *a = std::numeric_limits::quiet_NaN(); free(A); free(ww); return retcode; @@ -126,7 +128,7 @@ namespace mathieu { free(work); } if (retcode != 0) { - *a =std::numeric_limits::quiet_NaN(); + *a = std::numeric_limits::quiet_NaN(); free(A); free(ww); return SF_ERROR_NO_RESULT; @@ -162,14 +164,14 @@ namespace mathieu { // Allocate recursion matrix double *B = (double *) calloc(N*N, sizeof(double)); if (B == NULL) { - *b =std::numeric_limits::quiet_NaN(); + *b = std::numeric_limits::quiet_NaN(); return SF_ERROR_MEMORY; } // Allocate vector for eigenvalues double *ww = (double *) calloc(N, sizeof(double)); if (ww == NULL) { - *b =std::numeric_limits::quiet_NaN(); + *b = std::numeric_limits::quiet_NaN(); free(B); return SF_ERROR_MEMORY; } @@ -179,7 +181,7 @@ namespace mathieu { // Even order m retcode = make_matrix_oe(N,q,B); if (retcode != 0) { - *b =std::numeric_limits::quiet_NaN(); + *b = std::numeric_limits::quiet_NaN(); free(B); free(ww); return retcode; @@ -201,7 +203,7 @@ namespace mathieu { free(work); } if (retcode != 0) { - *b =std::numeric_limits::quiet_NaN(); + *b = std::numeric_limits::quiet_NaN(); free(B); free(ww); return SF_ERROR_NO_RESULT; @@ -219,7 +221,7 @@ namespace mathieu { // Odd order m retcode = make_matrix_oo(N,q,B); if (retcode != 0) { - *b =std::numeric_limits::quiet_NaN(); + *b = std::numeric_limits::quiet_NaN(); free(B); free(ww); return retcode; @@ -241,7 +243,7 @@ namespace mathieu { free(work); } if (retcode != 0) { - *b =std::numeric_limits::quiet_NaN(); + *b = std::numeric_limits::quiet_NaN(); free(B); free(ww); return SF_ERROR_NO_RESULT; diff --git a/include/xsf/mathieu/mathieu_fcns.h b/include/xsf/mathieu/mathieu_fcns.h index 9c2110abaf..61f59f1065 100644 --- a/include/xsf/mathieu/mathieu_fcns.h +++ b/include/xsf/mathieu/mathieu_fcns.h @@ -15,6 +15,8 @@ * of the Mathieu functions for Scipy. This file holds the function * implementations themselves. The prototype was written in Matlab * and validated. This is a translation from Matlab to C. + * + * Stuart Brorson, Summer 2025. * */ @@ -32,7 +34,7 @@ namespace mathieu { // ce = value of fcn for these inputs (scalar) // ced = value of fcn deriv w.r.t. v for these inputs (scalar) // Return code: - // Success = 0 + // Codes in error.h. int retcode = SF_ERROR_OK; @@ -59,9 +61,16 @@ namespace mathieu { // Get coeff vector for even ce double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) return SF_ERROR_MEMORY; + if (AA == NULL) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_ee(N,q,m, AA); if (retcode != SF_ERROR_OK) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); free(AA); return retcode; } @@ -106,9 +115,16 @@ namespace mathieu { // Get coeff vector for odd ce double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) return SF_ERROR_MEMORY; + if (AA == NULL) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_eo(N,q,m, AA); if (retcode != SF_ERROR_OK) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); free(AA); return retcode; } @@ -191,9 +207,16 @@ namespace mathieu { // Get coeff vector for even se double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) return SF_ERROR_MEMORY; + if (BB == NULL) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_oe(N,q,m, BB); if (retcode != SF_ERROR_OK) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); free(BB); return retcode; } @@ -238,9 +261,16 @@ namespace mathieu { // Get coeff vector for odd se double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) return SF_ERROR_MEMORY; + if (BB == NULL) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_oo(N,q,m, BB); if (retcode != SF_ERROR_OK) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); free(BB); return retcode; } @@ -309,7 +339,14 @@ namespace mathieu { *mc1d = std::numeric_limits::quiet_NaN(); return SF_ERROR_DOMAIN; } - if (q<0) return SF_ERROR_DOMAIN; // q<0 is unimplemented + + if (q<0) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to return for these, just set retcode. if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; // q>1000 is inaccurate if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; @@ -351,9 +388,16 @@ namespace mathieu { // Get coeff vector for even modmc1 double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) return SF_ERROR_MEMORY; + if (AA == NULL) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_ee(N, q, m, AA); if (retcode != SF_ERROR_OK) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); free(AA); return retcode; } @@ -465,9 +509,16 @@ namespace mathieu { // Get coeff vector for even modmc1 double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) return SF_ERROR_MEMORY; + if (AA == NULL) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_eo(N, q, m, AA); if (retcode != SF_ERROR_OK) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); free(AA); return retcode; } @@ -604,7 +655,14 @@ namespace mathieu { *ms1d = std::numeric_limits::quiet_NaN(); return SF_ERROR_DOMAIN; } - if (q<0) return SF_ERROR_DOMAIN; // q < 0 is currently unimplemented + + if (q<0) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to return immediately for these. if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; @@ -644,9 +702,16 @@ namespace mathieu { // Get coeff vector for even modms1 double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) return SF_ERROR_MEMORY; + if (BB == NULL) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_oe(N, q, m, BB); if (retcode != SF_ERROR_OK) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); free(BB); return retcode; } @@ -764,9 +829,16 @@ namespace mathieu { // Get coeff vector for even modms1 double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) return SF_ERROR_MEMORY; + if (BB == NULL) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_oo(N, q, m, BB); if (retcode != SF_ERROR_OK) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); free(BB); return retcode; } @@ -903,7 +975,14 @@ namespace mathieu { *mc2d = std::numeric_limits::quiet_NaN(); return SF_ERROR_DOMAIN; } - if (q<0) return SF_ERROR_DOMAIN; // q<0 is currently unimplemented + + if (q<0) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to return immediate for these. if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; @@ -943,9 +1022,16 @@ namespace mathieu { // Get coeff vector for even modmc2 double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) return SF_ERROR_MEMORY; + if (AA == NULL) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_ee(N, q, m, AA); if (retcode != SF_ERROR_OK) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); free(AA); return retcode; } @@ -1056,9 +1142,16 @@ namespace mathieu { // Get coeff vector for odd mc2 double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) return SF_ERROR_MEMORY; + if (AA == NULL) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_eo(N, q, m, AA); if (retcode != SF_ERROR_OK) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); free(AA); return retcode; } @@ -1195,7 +1288,14 @@ namespace mathieu { *ms2d = std::numeric_limits::quiet_NaN(); return SF_ERROR_DOMAIN; } - if (q<0) return SF_ERROR_DOMAIN; // q<0 is currently unimplemented + + if (q<0) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to return immediately from these. if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; @@ -1236,9 +1336,16 @@ namespace mathieu { // Get coeff vector for even modms2 double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) return SF_ERROR_MEMORY; + if (BB == NULL) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_oe(N, q, m, BB); if (retcode != SF_ERROR_OK) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); free(BB); return retcode; } @@ -1356,9 +1463,16 @@ namespace mathieu { // Get coeff vector for even modms2 double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) return SF_ERROR_MEMORY; + if (BB == NULL) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + retcode = mathieu_coeffs_oo(N, q, m, BB); if (retcode != SF_ERROR_OK) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); free(BB); return retcode; } From b09c2800084dc5acc20ba78fec6f9455a5f287f0 Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Sun, 7 Sep 2025 19:33:07 -0400 Subject: [PATCH 04/12] Remove non-standard d in double constant literals. --- include/xsf/mathieu/besseljyd.h | 8 +++---- include/xsf/mathieu/make_matrix.h | 32 ++++++++++++++-------------- include/xsf/mathieu/mathieu_coeffs.h | 2 +- include/xsf/mathieu/mathieu_fcns.h | 32 ++++++++++++++-------------- 4 files changed, 37 insertions(+), 37 deletions(-) diff --git a/include/xsf/mathieu/besseljyd.h b/include/xsf/mathieu/besseljyd.h index 7f1a4c63de..a139aa1730 100644 --- a/include/xsf/mathieu/besseljyd.h +++ b/include/xsf/mathieu/besseljyd.h @@ -40,12 +40,12 @@ namespace mathieu { double y; if (k == 0) { - double v = 1.0d; + double v = 1.0; y = -besselj(v,z); } else { double kp1 = (double) (k+1); double km1 = (double) (k-1); - y = (besselj(km1,z)-besselj(kp1,z))/2.0d; + y = (besselj(km1,z)-besselj(kp1,z))/2.0; } // Must flip sign for negative k and odd k. @@ -63,12 +63,12 @@ namespace mathieu { double y; if (k == 0) { - double v = 1.0d; + double v = 1.0; y = -bessely(v,z); } else { double kp1 = (double) (k+1); double km1 = (double) (k-1); - y = (bessely(km1,z)-bessely(kp1,z))/2.0d; + y = (bessely(km1,z)-bessely(kp1,z))/2.0; } // Must flip sign for negative k and odd k. diff --git a/include/xsf/mathieu/make_matrix.h b/include/xsf/mathieu/make_matrix.h index 9acc626300..ef139b1c88 100644 --- a/include/xsf/mathieu/make_matrix.h +++ b/include/xsf/mathieu/make_matrix.h @@ -15,7 +15,7 @@ * */ -#define SQRT2 1.414213562373095d +#define SQRT2 1.414213562373095 namespace xsf { namespace mathieu { @@ -41,7 +41,7 @@ namespace mathieu { i = MATRIX_IDX(N, 1, 0); A[i] = SQRT2*q; i = MATRIX_IDX(N, 1, 1); - A[i] = 4.0d; + A[i] = 4.0; i = MATRIX_IDX(N, 1, 2); A[i] = q; @@ -49,7 +49,7 @@ namespace mathieu { i = MATRIX_IDX(N, j, j-1); A[i] = q; i = MATRIX_IDX(N, j, j); - A[i] = (2.0d*j)*(2.0d*j); + A[i] = (2.0*j)*(2.0*j); i = MATRIX_IDX(N, j, j+1); A[i] = q; } @@ -57,7 +57,7 @@ namespace mathieu { i = MATRIX_IDX(N, N-1, N-2); A[i] = q; i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0d*(N-1))*(2.0d*(N-1)); + A[i] = (2.0*(N-1))*(2.0*(N-1)); return 0; } @@ -78,13 +78,13 @@ namespace mathieu { int i; i = MATRIX_IDX(N, 0, 0); - A[i] = 1.0d+q; + A[i] = 1.0+q; i = MATRIX_IDX(N, 0, 1); A[i] = q; i = MATRIX_IDX(N, 1, 0); A[i] = q; i = MATRIX_IDX(N, 1, 1); - A[i] = 9.0d; + A[i] = 9.0; i = MATRIX_IDX(N, 1, 2); A[i] = q; @@ -92,7 +92,7 @@ namespace mathieu { i = MATRIX_IDX(N, j, j-1); A[i] = q; i = MATRIX_IDX(N, j, j); - A[i] = (2.0d*j+1.0d)*(2.0d*j+1.0d); + A[i] = (2.0*j+1.0)*(2.0*j+1.0); i = MATRIX_IDX(N, j, j+1); A[i] = q; } @@ -100,7 +100,7 @@ namespace mathieu { i = MATRIX_IDX(N, N-1, N-2); A[i] = q; i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0d*(N-1)+1.0d)*(2.0d*(N-1)+1.0d); + A[i] = (2.0*(N-1)+1.0)*(2.0*(N-1)+1.0); return 0; } @@ -122,13 +122,13 @@ namespace mathieu { int i; i = MATRIX_IDX(N, 0, 0); - A[i] = 4.0d; + A[i] = 4.0; i = MATRIX_IDX(N, 0, 1); A[i] = q; i = MATRIX_IDX(N, 1, 0); A[i] = q; i = MATRIX_IDX(N, 1, 1); - A[i] = 16.0d; + A[i] = 16.0; i = MATRIX_IDX(N, 1, 2); A[i] = q; @@ -136,7 +136,7 @@ namespace mathieu { i = MATRIX_IDX(N, j, j-1); A[i] = q; i = MATRIX_IDX(N, j, j); - A[i] = (2.0d*(j+1))*(2.0d*(j+1)); + A[i] = (2.0*(j+1))*(2.0*(j+1)); i = MATRIX_IDX(N, j, j+1); A[i] = q; } @@ -144,7 +144,7 @@ namespace mathieu { i = MATRIX_IDX(N, N-1, N-2); A[i] = q; i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0d*N)*(2.0d*N); + A[i] = (2.0*N)*(2.0*N); return 0; } @@ -166,13 +166,13 @@ namespace mathieu { int i; i = MATRIX_IDX(N, 0, 0); - A[i] = 1.0d - q; + A[i] = 1.0 - q; i = MATRIX_IDX(N, 0, 1); A[i] = q; i = MATRIX_IDX(N, 1, 0); A[i] = q; i = MATRIX_IDX(N, 1, 1); - A[i] = 9.0d; + A[i] = 9.0; i = MATRIX_IDX(N, 1, 2); A[i] = q; @@ -180,7 +180,7 @@ namespace mathieu { i = MATRIX_IDX(N, j, j-1); A[i] = q; i = MATRIX_IDX(N, j, j); - A[i] = (2.0d*j+1.0d)*(2.0d*j+1.0d); + A[i] = (2.0*j+1.0)*(2.0*j+1.0); i = MATRIX_IDX(N, j, j+1); A[i] = q; } @@ -188,7 +188,7 @@ namespace mathieu { i = MATRIX_IDX(N, N-1, N-2); A[i] = q; i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0d*N-1.0d)*(2.0d*N-1.0d); + A[i] = (2.0*N-1.0)*(2.0*N-1.0); return 0; } diff --git a/include/xsf/mathieu/mathieu_coeffs.h b/include/xsf/mathieu/mathieu_coeffs.h index 5feaafd0e9..96db71b56f 100644 --- a/include/xsf/mathieu/mathieu_coeffs.h +++ b/include/xsf/mathieu/mathieu_coeffs.h @@ -6,7 +6,7 @@ #include "make_matrix.h" #include "matrix_utils.h" -#define SQRT2 1.414213562373095d +#define SQRT2 1.414213562373095 /* * diff --git a/include/xsf/mathieu/mathieu_fcns.h b/include/xsf/mathieu/mathieu_fcns.h index 61f59f1065..babfa7cf88 100644 --- a/include/xsf/mathieu/mathieu_fcns.h +++ b/include/xsf/mathieu/mathieu_fcns.h @@ -77,18 +77,18 @@ namespace mathieu { // Local scope variables used in summing the Fourier series. double tt, td, cep, cem, cedp, cedm; - cem = 0.0d; cep = 0.0d; cedm = 0.0d; cedp = 0.0d; + cem = 0.0; cep = 0.0; cedm = 0.0; cedp = 0.0; // Sum from smallest to largest coeff. for (int k=(N-1); k>=0 ; k--) { - tt = AA[k]*cos(2.0d*k*v); // Term for Mathieu ce + tt = AA[k]*cos(2.0*k*v); // Term for Mathieu ce if (tt<0) { cem = cem + tt; // Neg running sum } else { cep = cep + tt; // Pos running sum } - td = -2.0d*k*AA[k]*sin(2.0d*k*v); // Term for deriv + td = -2.0*k*AA[k]*sin(2.0*k*v); // Term for deriv if (td<0) { cedm = cedm + td; } else { @@ -102,7 +102,7 @@ namespace mathieu { // Hack -- this makes sure the fcn has the right overall sign for q<0. // Someday combine this with the above sums into the same for loop. - double s = 0.0d; + double s = 0.0; for (int l = 0; l=0 ; k--) { - tt = AA[k]*cos((2.0d*k+1.0d)*v); // Term for Mathieu ce + tt = AA[k]*cos((2.0*k+1.0)*v); // Term for Mathieu ce if (tt<0) { cem = cem + tt; // Neg running sum } else { cep = cep + tt; // Pos running sum } - td = -(2.0d*k+1.0d)*AA[k]*sin((2.0d*k+1.0d)*v); // Deriv. + td = -(2.0*k+1.0)*AA[k]*sin((2.0*k+1.0)*v); // Deriv. if (td<0) { cedm = cedm + td; } else { @@ -156,7 +156,7 @@ namespace mathieu { // Hack -- this makes sure the fcn has the right overall sign for q<0. // Someday combine this with the above sums into the same for loop. - double s = 0.0d; + double s = 0.0; for (int l = 0; l=1 ; k--) { - tt = BB[k-1]*sin(2.0d*k*v); // Mathieu se term + tt = BB[k-1]*sin(2.0*k*v); // Mathieu se term if (tt<0) { sem = sem + tt; // Neg running sum } else { sep = sep + tt; // Pos running sum } - td = 2.0d*k*BB[k-1]*cos(2.0d*k*v); // Deriv term. + td = 2.0*k*BB[k-1]*cos(2.0*k*v); // Deriv term. if (td<0) { sedm = sedm + td; } else { @@ -248,7 +248,7 @@ namespace mathieu { // Hack -- this makes sure the fcn has the right overall sign for q<0. // Someday combine this with the above sums into the same for loop. - double s = 0.0d; + double s = 0.0; for (int l = 0; l=0 ; k--) { - tt = BB[k]*sin((2.0d*k+1.0d)*v); // Mathieu se term + tt = BB[k]*sin((2.0*k+1.0)*v); // Mathieu se term if (tt<0) { sem = sem + tt; // Neg running sum } else { sep = sep + tt; // Pos running sum } - td = (2.0d*k+1.0d)*BB[k]*cos((2.0d*k+1.0d)*v); // Deriv term. + td = (2.0*k+1.0)*BB[k]*cos((2.0*k+1.0)*v); // Deriv term. if (td<0) { sedm = sedm + td; } else { @@ -302,7 +302,7 @@ namespace mathieu { // Hack -- this makes sure the fcn has the right overall sign for q<0. // Someday combine this with the above sums into the same for loop. - double s = 0.0d; + double s = 0.0; for (int l = 0; l Date: Wed, 10 Sep 2025 19:28:02 -0400 Subject: [PATCH 05/12] Remove license file and place code under whatever license xsf uses. --- include/xsf/mathieu/LICENSE | 21 --------------------- 1 file changed, 21 deletions(-) delete mode 100644 include/xsf/mathieu/LICENSE diff --git a/include/xsf/mathieu/LICENSE b/include/xsf/mathieu/LICENSE deleted file mode 100644 index 38a528a5e1..0000000000 --- a/include/xsf/mathieu/LICENSE +++ /dev/null @@ -1,21 +0,0 @@ -MIT License - -Copyright (c) 2025 Stuart Brorson - -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 without limitation the rights -to use, copy, modify, merge, publish, 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. From 5cbf45c559e5c19d8f007321a05bed8a6e2f8422 Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Wed, 10 Sep 2025 20:58:43 -0400 Subject: [PATCH 06/12] I removed my Makefile since it's not used in the Scipy CI tool. I moved main.c to test_mathieu.cpp in the tests dir. I ran clang-format on all .h files. --- include/xsf/mathieu.h | 375 +- include/xsf/mathieu/Makefile | 36 - include/xsf/mathieu/besseljyd.h | 117 +- include/xsf/mathieu/make_matrix.h | 336 +- include/xsf/mathieu/mathieu.h | 375 +- include/xsf/mathieu/mathieu_coeffs.h | 509 +-- include/xsf/mathieu/mathieu_eigs.h | 443 ++- include/xsf/mathieu/mathieu_fcns.h | 3142 +++++++++-------- include/xsf/mathieu/matrix_utils.h | 104 +- .../scipy_special_tests/test_mathieu.cpp | 13 +- 10 files changed, 2698 insertions(+), 2752 deletions(-) delete mode 100644 include/xsf/mathieu/Makefile rename include/xsf/mathieu/main.c => tests/scipy_special_tests/test_mathieu.cpp (99%) diff --git a/include/xsf/mathieu.h b/include/xsf/mathieu.h index b119feca86..c5ce88155d 100644 --- a/include/xsf/mathieu.h +++ b/include/xsf/mathieu.h @@ -1,12 +1,12 @@ #pragma once #include "error.h" -#include "mathieu/matrix_utils.h" +#include "mathieu/besseljyd.h" #include "mathieu/make_matrix.h" #include "mathieu/mathieu_coeffs.h" #include "mathieu/mathieu_eigs.h" -#include "mathieu/besseljyd.h" #include "mathieu/mathieu_fcns.h" +#include "mathieu/matrix_utils.h" /* * @@ -17,7 +17,7 @@ * reimplementation. * * Stuart Brorson, Summer 2025. - * + * */ namespace xsf { @@ -35,31 +35,31 @@ namespace xsf { */ template T cem_cva(T m, T q) { - // This returns the even Mathieu characteristic value (eigenvalue) a. - - // Check for invalid Mathieu order. - if ((m < 0) || (m != floor(m))) { - set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double da; - - int retcode = xsf::mathieu::mathieu_a(im, dq, &da); - if (retcode != SF_ERROR_OK) { - set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Now cast back. - T a = static_cast(da); - return a; + // This returns the even Mathieu characteristic value (eigenvalue) a. + + // Check for invalid Mathieu order. + if ((m < 0) || (m != floor(m))) { + set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double da; + + int retcode = xsf::mathieu::mathieu_a(im, dq, &da); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T a = static_cast(da); + return a; } -//------------------------------------------------------------- +//------------------------------------------------------------- template /** * Mathieu characteristic values (eigenvalues) b for odd functions. @@ -72,30 +72,29 @@ template * @return Mathieu eigenvalue b. */ T sem_cva(T m, T q) { - // This returns the odd Mathieu characteristic value (eigenvalue) b. - - // Check for invalid Mathieu order. - if ((m < 1) || (m != floor(m))) { - set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double db; - - int retcode = xsf::mathieu::mathieu_b(im, dq, &db); - if (retcode != SF_ERROR_OK) { - set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Now cast back. - T b = static_cast(db); - return b; -} + // This returns the odd Mathieu characteristic value (eigenvalue) b. + // Check for invalid Mathieu order. + if ((m < 1) || (m != floor(m))) { + set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double db; + + int retcode = xsf::mathieu::mathieu_b(im, dq, &db); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T b = static_cast(db); + return b; +} //--------------------------------------------------------------- /* Mathieu functions */ @@ -114,34 +113,33 @@ T sem_cva(T m, T q) { template void cem(T m, T q, T x, T &csf, T &csd) { - if ((m < 0) || (m != floor(m))) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double dcsf; - double dcsd; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); - if (retcode != SF_ERROR_OK) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_ce", (sf_error_t) retcode, NULL); + if ((m < 0) || (m != floor(m))) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); } else { - csf = static_cast(dcsf); - csd = static_cast(dcsd); + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dcsf; + double dcsd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); + if (retcode != SF_ERROR_OK) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", (sf_error_t)retcode, NULL); + } else { + csf = static_cast(dcsf); + csd = static_cast(dcsd); + } } - } } - -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity Mathieu angular function se(m, q, x) * @@ -157,33 +155,33 @@ void cem(T m, T q, T x, T &csf, T &csd) { template void sem(T m, T q, T x, T &ssf, T &ssd) { - if ((m < 1) || (m != floor(m))) { - ssf = std::numeric_limits::quiet_NaN(); - ssd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double dssf; - double dssd; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); - if (retcode != SF_ERROR_OK) { - ssf = std::numeric_limits::quiet_NaN(); - ssd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", (sf_error_t) retcode, NULL); + if ((m < 1) || (m != floor(m))) { + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); } else { - ssf = static_cast(dssf); - ssd = static_cast(dssd); + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dssf; + double dssd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); + if (retcode != SF_ERROR_OK) { + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", (sf_error_t)retcode, NULL); + } else { + ssf = static_cast(dssf); + ssd = static_cast(dssd); + } } - } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Even parity modified (radial) Mathieu function of first kind Mc1(m, q, x) * @@ -199,33 +197,33 @@ void sem(T m, T q, T x, T &ssf, T &ssd) { template void mcm1(T m, T q, T x, T &f1r, T &d1r) { - if ((m < 0) || (m != floor(m))) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df1r; - double dd1r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); - if (retcode != SF_ERROR_OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm1", (sf_error_t) retcode, NULL); + if ((m < 0) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); } else { - f1r = static_cast(df1r); - d1r = static_cast(dd1r); + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", (sf_error_t)retcode, NULL); + } else { + f1r = static_cast(df1r); + d1r = static_cast(dd1r); + } } - } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity modified (radial) Mathieu function of first kind Ms1(m, q, x) * @@ -241,34 +239,33 @@ void mcm1(T m, T q, T x, T &f1r, T &d1r) { template void msm1(T m, T q, T x, T &f1r, T &d1r) { - if ((m < 1) || (m != floor(m))) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df1r; - double dd1r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); - if (retcode != SF_ERROR_OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm1", (sf_error_t) retcode, NULL); + if ((m < 1) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); } else { - f1r = static_cast(df1r); - d1r = static_cast(dd1r); - } - } + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", (sf_error_t)retcode, NULL); + } else { + f1r = static_cast(df1r); + d1r = static_cast(dd1r); + } + } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Even parity modified (radial) Mathieu function of second kind Mc2(m, q, x) * @@ -284,34 +281,33 @@ void msm1(T m, T q, T x, T &f1r, T &d1r) { template void mcm2(T m, T q, T x, T &f2r, T &d2r) { - if ((m < 0) || (m != floor(m))) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df2r; - double dd2r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); - if (retcode != SF_ERROR_OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm2", (sf_error_t) retcode, NULL); + if ((m < 0) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); } else { - f2r = static_cast(df2r); - d2r = static_cast(dd2r); - } - } + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", (sf_error_t)retcode, NULL); + } else { + f2r = static_cast(df2r); + d2r = static_cast(dd2r); + } + } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity modified (radial) Mathieu function of second kind Ms2(m, q, x) * @@ -327,31 +323,30 @@ void mcm2(T m, T q, T x, T &f2r, T &d2r) { template void msm2(T m, T q, T x, T &f2r, T &d2r) { - if ((m < 1) || (m != floor(m))) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df2r; - double dd2r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); - if (retcode != SF_ERROR_OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm2", (sf_error_t) retcode, NULL); + if ((m < 1) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); } else { - f2r = static_cast(df2r); - d2r = static_cast(dd2r); + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", (sf_error_t)retcode, NULL); + } else { + f2r = static_cast(df2r); + d2r = static_cast(dd2r); + } } - } } - } // namespace xsf diff --git a/include/xsf/mathieu/Makefile b/include/xsf/mathieu/Makefile deleted file mode 100644 index 4e61479814..0000000000 --- a/include/xsf/mathieu/Makefile +++ /dev/null @@ -1,36 +0,0 @@ -CC := g++ -# CC := gcc -CFLAGS := -O3 -std=c++17 -fno-fast-math -march=x86-64 -m128bit-long-double -#CFLAGS := -O3 -std=c++17 -fno-fast-math -mfpmath=sse -march=x86-64 -m128bit-long-double - -SRCS := $(wildcard *.c) -OBJS := $(SRCS:.c=.o) -EXES := main -TARGETS = main -INCLUDES := -I. -I/usr/include -I/usr/local/include -LDFLAGS := -L/usr/lib/x86_64-linux-gnu/lapack/ -#LDFLAGS := -L/usr/lib/x86_64-linux-gnu/openblas-pthread/ -L/usr/lib -L/usr/local/lib -#INCLUDES := -I. -I/usr/include/x86_64-linux-gnu/ -#LDFLAGS := -L/usr/lib/x86_64-linux-gnu -LIBS := -llapacke -llapack -lblas -lm - - -#================================================= -all: $(TARGETS) - -# Link all object files into the executable -$(TARGETS): $(OBJS) - $(CC) $(OBJS) -o $@ $(CFLAGS) $(LDFLAGS) $(LIBS) - -# Compile each .c into a .o -%.o: %.c %.h - $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ - -# Also handle .c files without headers -%.o: %.c - $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ - -#------------------------------- -# Clean up directory -- remove executables and intermediate files. -clean: - -rm -f *~ *.o *.obj *.out *.map *.h.gch $(TARGETS) $(OBJS) diff --git a/include/xsf/mathieu/besseljyd.h b/include/xsf/mathieu/besseljyd.h index a139aa1730..fad2576549 100644 --- a/include/xsf/mathieu/besseljyd.h +++ b/include/xsf/mathieu/besseljyd.h @@ -1,9 +1,8 @@ #ifndef BESSELJYD_H #define BESSELJYD_H -#include "../config.h" #include "../bessel.h" - +#include "../config.h" /* * @@ -11,75 +10,75 @@ * of the Mathieu functions for Scipy. This file holds helpers * to the Bessel J and Y functions and also returns derivatives * of those fcns. - * + * */ namespace xsf { namespace mathieu { - //================================================================== - double besselj(int k, double z) { - // This is just a thin wrapper around the Bessel impl in the - // std library. - double v = (double) k; - return xsf::cyl_bessel_j(v, z); - } - - //================================================================== - double bessely(int k, double z) { - // This is just a thin wrapper around the Bessel impl in the - // std library. - double v = (double) k; - return xsf::cyl_bessel_y(v, z); - } - - //================================================================== - double besseljd(int k, double z) { - // This returns the derivative of besselj. The deriv is - // computed using common identities. - double y; - - if (k == 0) { - double v = 1.0; - y = -besselj(v,z); - } else { - double kp1 = (double) (k+1); - double km1 = (double) (k-1); - y = (besselj(km1,z)-besselj(kp1,z))/2.0; + //================================================================== + double besselj(int k, double z) { + // This is just a thin wrapper around the Bessel impl in the + // std library. + double v = (double)k; + return xsf::cyl_bessel_j(v, z); } - // Must flip sign for negative k and odd k. - if (k<0 && ((k % 2) != 0)) { - y = -y; + //================================================================== + double bessely(int k, double z) { + // This is just a thin wrapper around the Bessel impl in the + // std library. + double v = (double)k; + return xsf::cyl_bessel_y(v, z); } - return y; - } + //================================================================== + double besseljd(int k, double z) { + // This returns the derivative of besselj. The deriv is + // computed using common identities. + double y; + + if (k == 0) { + double v = 1.0; + y = -besselj(v, z); + } else { + double kp1 = (double)(k + 1); + double km1 = (double)(k - 1); + y = (besselj(km1, z) - besselj(kp1, z)) / 2.0; + } - //================================================================== - double besselyd(int k, double z) { - // This returns the derivative of besselj. The deriv is - // computed using common identities. - double y; - - if (k == 0) { - double v = 1.0; - y = -bessely(v,z); - } else { - double kp1 = (double) (k+1); - double km1 = (double) (k-1); - y = (bessely(km1,z)-bessely(kp1,z))/2.0; + // Must flip sign for negative k and odd k. + if (k < 0 && ((k % 2) != 0)) { + y = -y; + } + + return y; } - // Must flip sign for negative k and odd k. - if (k<0 && ((k % 2) != 0)) { - y = -y; + //================================================================== + double besselyd(int k, double z) { + // This returns the derivative of besselj. The deriv is + // computed using common identities. + double y; + + if (k == 0) { + double v = 1.0; + y = -bessely(v, z); + } else { + double kp1 = (double)(k + 1); + double km1 = (double)(k - 1); + y = (bessely(km1, z) - bessely(kp1, z)) / 2.0; + } + + // Must flip sign for negative k and odd k. + if (k < 0 && ((k % 2) != 0)) { + y = -y; + } + + return y; } - - return y; - } - -} // namespace xsf + } // namespace mathieu +} // namespace xsf -#endif // #ifndef BESSELJYD_H +#endif // #ifndef BESSELJYD_H diff --git a/include/xsf/mathieu/make_matrix.h b/include/xsf/mathieu/make_matrix.h index ef139b1c88..cad7190712 100644 --- a/include/xsf/mathieu/make_matrix.h +++ b/include/xsf/mathieu/make_matrix.h @@ -12,7 +12,7 @@ * which make the recursion matrices. * * Stuart Brorson, Summer 2025. - * + * */ #define SQRT2 1.414213562373095 @@ -20,181 +20,179 @@ namespace xsf { namespace mathieu { - /*----------------------------------------------- - This creates the recurrence relation matrix for - the even-even Mathieu fcns (ce_2n). - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - Output: - A = recurrence matrix (must be calloc'ed in caller). - Return: - return code = 0 if OK. - -------------------------------------------------*/ - int make_matrix_ee(int N, double q, double *A) { - int j; - int i; - - // Symmetrize matrix here, then fix in caller. - i = MATRIX_IDX(N, 0, 1); - A[i] = SQRT2*q; - i = MATRIX_IDX(N, 1, 0); - A[i] = SQRT2*q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 4.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j=2; j<=N-2; j++) { - i = MATRIX_IDX(N, j, j-1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0*j)*(2.0*j); - i = MATRIX_IDX(N, j, j+1); - A[i] = q; + /*----------------------------------------------- + This creates the recurrence relation matrix for + the even-even Mathieu fcns (ce_2n). + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + Output: + A = recurrence matrix (must be calloc'ed in caller). + Return: + return code = 0 if OK. + -------------------------------------------------*/ + int make_matrix_ee(int N, double q, double *A) { + int j; + int i; + + // Symmetrize matrix here, then fix in caller. + i = MATRIX_IDX(N, 0, 1); + A[i] = SQRT2 * q; + i = MATRIX_IDX(N, 1, 0); + A[i] = SQRT2 * q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 4.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j = 2; j <= N - 2; j++) { + i = MATRIX_IDX(N, j, j - 1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0 * j) * (2.0 * j); + i = MATRIX_IDX(N, j, j + 1); + A[i] = q; + } + + i = MATRIX_IDX(N, N - 1, N - 2); + A[i] = q; + i = MATRIX_IDX(N, N - 1, N - 1); + A[i] = (2.0 * (N - 1)) * (2.0 * (N - 1)); + + return 0; } - i = MATRIX_IDX(N, N-1, N-2); - A[i] = q; - i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0*(N-1))*(2.0*(N-1)); - - return 0; - } - - /*----------------------------------------------- - This creates the recurrence relation matrix for - the even-odd Mathieu fcns (ce_2n+1). - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - Output: - A = recurrence matrix (calloc in caller). - Return: - return code = 0 if OK. - -------------------------------------------------*/ - int make_matrix_eo(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 1.0+q; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 9.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j=2; j<=N-2; j++) { - i = MATRIX_IDX(N, j, j-1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0*j+1.0)*(2.0*j+1.0); - i = MATRIX_IDX(N, j, j+1); - A[i] = q; + /*----------------------------------------------- + This creates the recurrence relation matrix for + the even-odd Mathieu fcns (ce_2n+1). + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + Output: + A = recurrence matrix (calloc in caller). + Return: + return code = 0 if OK. + -------------------------------------------------*/ + int make_matrix_eo(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 1.0 + q; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 9.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j = 2; j <= N - 2; j++) { + i = MATRIX_IDX(N, j, j - 1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0 * j + 1.0) * (2.0 * j + 1.0); + i = MATRIX_IDX(N, j, j + 1); + A[i] = q; + } + + i = MATRIX_IDX(N, N - 1, N - 2); + A[i] = q; + i = MATRIX_IDX(N, N - 1, N - 1); + A[i] = (2.0 * (N - 1) + 1.0) * (2.0 * (N - 1) + 1.0); + + return 0; } - i = MATRIX_IDX(N, N-1, N-2); - A[i] = q; - i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0*(N-1)+1.0)*(2.0*(N-1)+1.0); - - return 0; - } - - /*----------------------------------------------- - This creates the recurrence relation matrix for - the odd-even Mathieu fcns (se_2n) -- sometimes called - se_2n+2. - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - Output: - A = recurrence matrix (calloc in caller). - Return: - return code = 0 if OK. - -------------------------------------------------*/ - int make_matrix_oe(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 4.0; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 16.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j=2; j<=N-2; j++) { - i = MATRIX_IDX(N, j, j-1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0*(j+1))*(2.0*(j+1)); - i = MATRIX_IDX(N, j, j+1); - A[i] = q; + /*----------------------------------------------- + This creates the recurrence relation matrix for + the odd-even Mathieu fcns (se_2n) -- sometimes called + se_2n+2. + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + Output: + A = recurrence matrix (calloc in caller). + Return: + return code = 0 if OK. + -------------------------------------------------*/ + int make_matrix_oe(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 4.0; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 16.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j = 2; j <= N - 2; j++) { + i = MATRIX_IDX(N, j, j - 1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0 * (j + 1)) * (2.0 * (j + 1)); + i = MATRIX_IDX(N, j, j + 1); + A[i] = q; + } + + i = MATRIX_IDX(N, N - 1, N - 2); + A[i] = q; + i = MATRIX_IDX(N, N - 1, N - 1); + A[i] = (2.0 * N) * (2.0 * N); + + return 0; } - i = MATRIX_IDX(N, N-1, N-2); - A[i] = q; - i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0*N)*(2.0*N); - - return 0; - } - - - /*----------------------------------------------- - This creates the recurrence relation matrix for - the odd-odd Mathieu fcns (se_2n+1). - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - Output: - A = recurrence matrix (calloc in caller). - Return: - return code = 0 if OK. - -------------------------------------------------*/ - int make_matrix_oo(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 1.0 - q; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 9.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j=2; j<=N-2; j++) { - i = MATRIX_IDX(N, j, j-1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0*j+1.0)*(2.0*j+1.0); - i = MATRIX_IDX(N, j, j+1); - A[i] = q; + /*----------------------------------------------- + This creates the recurrence relation matrix for + the odd-odd Mathieu fcns (se_2n+1). + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + Output: + A = recurrence matrix (calloc in caller). + Return: + return code = 0 if OK. + -------------------------------------------------*/ + int make_matrix_oo(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 1.0 - q; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 9.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j = 2; j <= N - 2; j++) { + i = MATRIX_IDX(N, j, j - 1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0 * j + 1.0) * (2.0 * j + 1.0); + i = MATRIX_IDX(N, j, j + 1); + A[i] = q; + } + + i = MATRIX_IDX(N, N - 1, N - 2); + A[i] = q; + i = MATRIX_IDX(N, N - 1, N - 1); + A[i] = (2.0 * N - 1.0) * (2.0 * N - 1.0); + + return 0; } - i = MATRIX_IDX(N, N-1, N-2); - A[i] = q; - i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0*N-1.0)*(2.0*N-1.0); - - return 0; - } - - } // namespace mathieu } // namespace xsf - -#endif // #ifndef MAKE_MATRIX_H + +#endif // #ifndef MAKE_MATRIX_H diff --git a/include/xsf/mathieu/mathieu.h b/include/xsf/mathieu/mathieu.h index b119feca86..c5ce88155d 100644 --- a/include/xsf/mathieu/mathieu.h +++ b/include/xsf/mathieu/mathieu.h @@ -1,12 +1,12 @@ #pragma once #include "error.h" -#include "mathieu/matrix_utils.h" +#include "mathieu/besseljyd.h" #include "mathieu/make_matrix.h" #include "mathieu/mathieu_coeffs.h" #include "mathieu/mathieu_eigs.h" -#include "mathieu/besseljyd.h" #include "mathieu/mathieu_fcns.h" +#include "mathieu/matrix_utils.h" /* * @@ -17,7 +17,7 @@ * reimplementation. * * Stuart Brorson, Summer 2025. - * + * */ namespace xsf { @@ -35,31 +35,31 @@ namespace xsf { */ template T cem_cva(T m, T q) { - // This returns the even Mathieu characteristic value (eigenvalue) a. - - // Check for invalid Mathieu order. - if ((m < 0) || (m != floor(m))) { - set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double da; - - int retcode = xsf::mathieu::mathieu_a(im, dq, &da); - if (retcode != SF_ERROR_OK) { - set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Now cast back. - T a = static_cast(da); - return a; + // This returns the even Mathieu characteristic value (eigenvalue) a. + + // Check for invalid Mathieu order. + if ((m < 0) || (m != floor(m))) { + set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double da; + + int retcode = xsf::mathieu::mathieu_a(im, dq, &da); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T a = static_cast(da); + return a; } -//------------------------------------------------------------- +//------------------------------------------------------------- template /** * Mathieu characteristic values (eigenvalues) b for odd functions. @@ -72,30 +72,29 @@ template * @return Mathieu eigenvalue b. */ T sem_cva(T m, T q) { - // This returns the odd Mathieu characteristic value (eigenvalue) b. - - // Check for invalid Mathieu order. - if ((m < 1) || (m != floor(m))) { - set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double db; - - int retcode = xsf::mathieu::mathieu_b(im, dq, &db); - if (retcode != SF_ERROR_OK) { - set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Now cast back. - T b = static_cast(db); - return b; -} + // This returns the odd Mathieu characteristic value (eigenvalue) b. + // Check for invalid Mathieu order. + if ((m < 1) || (m != floor(m))) { + set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double db; + + int retcode = xsf::mathieu::mathieu_b(im, dq, &db); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T b = static_cast(db); + return b; +} //--------------------------------------------------------------- /* Mathieu functions */ @@ -114,34 +113,33 @@ T sem_cva(T m, T q) { template void cem(T m, T q, T x, T &csf, T &csd) { - if ((m < 0) || (m != floor(m))) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double dcsf; - double dcsd; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); - if (retcode != SF_ERROR_OK) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_ce", (sf_error_t) retcode, NULL); + if ((m < 0) || (m != floor(m))) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); } else { - csf = static_cast(dcsf); - csd = static_cast(dcsd); + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dcsf; + double dcsd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); + if (retcode != SF_ERROR_OK) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", (sf_error_t)retcode, NULL); + } else { + csf = static_cast(dcsf); + csd = static_cast(dcsd); + } } - } } - -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity Mathieu angular function se(m, q, x) * @@ -157,33 +155,33 @@ void cem(T m, T q, T x, T &csf, T &csd) { template void sem(T m, T q, T x, T &ssf, T &ssd) { - if ((m < 1) || (m != floor(m))) { - ssf = std::numeric_limits::quiet_NaN(); - ssd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double dssf; - double dssd; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); - if (retcode != SF_ERROR_OK) { - ssf = std::numeric_limits::quiet_NaN(); - ssd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", (sf_error_t) retcode, NULL); + if ((m < 1) || (m != floor(m))) { + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); } else { - ssf = static_cast(dssf); - ssd = static_cast(dssd); + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dssf; + double dssd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); + if (retcode != SF_ERROR_OK) { + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", (sf_error_t)retcode, NULL); + } else { + ssf = static_cast(dssf); + ssd = static_cast(dssd); + } } - } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Even parity modified (radial) Mathieu function of first kind Mc1(m, q, x) * @@ -199,33 +197,33 @@ void sem(T m, T q, T x, T &ssf, T &ssd) { template void mcm1(T m, T q, T x, T &f1r, T &d1r) { - if ((m < 0) || (m != floor(m))) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df1r; - double dd1r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); - if (retcode != SF_ERROR_OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm1", (sf_error_t) retcode, NULL); + if ((m < 0) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); } else { - f1r = static_cast(df1r); - d1r = static_cast(dd1r); + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", (sf_error_t)retcode, NULL); + } else { + f1r = static_cast(df1r); + d1r = static_cast(dd1r); + } } - } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity modified (radial) Mathieu function of first kind Ms1(m, q, x) * @@ -241,34 +239,33 @@ void mcm1(T m, T q, T x, T &f1r, T &d1r) { template void msm1(T m, T q, T x, T &f1r, T &d1r) { - if ((m < 1) || (m != floor(m))) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df1r; - double dd1r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); - if (retcode != SF_ERROR_OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm1", (sf_error_t) retcode, NULL); + if ((m < 1) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); } else { - f1r = static_cast(df1r); - d1r = static_cast(dd1r); - } - } + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", (sf_error_t)retcode, NULL); + } else { + f1r = static_cast(df1r); + d1r = static_cast(dd1r); + } + } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Even parity modified (radial) Mathieu function of second kind Mc2(m, q, x) * @@ -284,34 +281,33 @@ void msm1(T m, T q, T x, T &f1r, T &d1r) { template void mcm2(T m, T q, T x, T &f2r, T &d2r) { - if ((m < 0) || (m != floor(m))) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df2r; - double dd2r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); - if (retcode != SF_ERROR_OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm2", (sf_error_t) retcode, NULL); + if ((m < 0) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); } else { - f2r = static_cast(df2r); - d2r = static_cast(dd2r); - } - } + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", (sf_error_t)retcode, NULL); + } else { + f2r = static_cast(df2r); + d2r = static_cast(dd2r); + } + } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity modified (radial) Mathieu function of second kind Ms2(m, q, x) * @@ -327,31 +323,30 @@ void mcm2(T m, T q, T x, T &f2r, T &d2r) { template void msm2(T m, T q, T x, T &f2r, T &d2r) { - if ((m < 1) || (m != floor(m))) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df2r; - double dd2r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); - if (retcode != SF_ERROR_OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm2", (sf_error_t) retcode, NULL); + if ((m < 1) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); } else { - f2r = static_cast(df2r); - d2r = static_cast(dd2r); + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", (sf_error_t)retcode, NULL); + } else { + f2r = static_cast(df2r); + d2r = static_cast(dd2r); + } } - } } - } // namespace xsf diff --git a/include/xsf/mathieu/mathieu_coeffs.h b/include/xsf/mathieu/mathieu_coeffs.h index 96db71b56f..ee8cf9f36f 100644 --- a/include/xsf/mathieu/mathieu_coeffs.h +++ b/include/xsf/mathieu/mathieu_coeffs.h @@ -16,279 +16,280 @@ * series computing the Mathieu fcns. * * Stuart Brorson, Summer 2025. - * + * */ - /* DSYEV_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyev_( char* jobz, char* uplo, int* n, double* a, int* lda, - double* w, double* work, int* lwork, int* info ); +void dsyev_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); #ifdef __cplusplus } #endif - namespace xsf { namespace mathieu { - //------------------------------------------------------ - int mathieu_coeffs_ee(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order ce_2n Mathieu fcn. - // Allowed value of m = 0, 2, 4, 6, ... - // Inputs: - // N = size of recursion matrix to use. - // q = frequency parameter - // m = order of Mathieu fcn desired. - // Output: - // AA = length N vector preallocated to hold coeffs. - // Returns 0 if all goes well. Must put check on calloc - // here. - - int retcode = 0; - - // Bail out if m is not even. - if (m % 2 != 0) return -1; - - // Allocate recursion matrix - double *A = (double *) calloc(N*N, sizeof(double)); - if (A == NULL) return SF_ERROR_MEMORY; - - // Do EVD - retcode = make_matrix_ee(N,q,A); - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; + //------------------------------------------------------ + int mathieu_coeffs_ee(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order ce_2n Mathieu fcn. + // Allowed value of m = 0, 2, 4, 6, ... + // Inputs: + // N = size of recursion matrix to use. + // q = frequency parameter + // m = order of Mathieu fcn desired. + // Output: + // AA = length N vector preallocated to hold coeffs. + // Returns 0 if all goes well. Must put check on calloc + // here. + + int retcode = 0; + + // Bail out if m is not even. + if (m % 2 != 0) + return -1; + + // Allocate recursion matrix + double *A = (double *)calloc(N * N, sizeof(double)); + if (A == NULL) + return SF_ERROR_MEMORY; + + // Do EVD + retcode = make_matrix_ee(N, q, A); + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + { + // Work in local scope. + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + double *work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_(V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + work = (double *)malloc(lwork * sizeof(double)); + /* Solve eigenproblem */ + dsyev_(V, U, &N, A, &N, AA, work, &lwork, &retcode); + free(work); + } + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + // print_matrix(AA, N, 1); + + // Undo sqrt(2) in make_matrix by normalizing elet in first col by sqrt(2). + int idx; + int row = m / 2; + idx = MATRIX_IDX(N, row, 0); + AA[0] = A[idx] / SQRT2; + // Transfer remaining elets in correct row to coeff vector. + for (int j = 1; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + free(A); + return retcode; } - { - // Work in local scope. - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - double* work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_( V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode ); - lwork = (int)wkopt; - work = (double*)malloc( lwork*sizeof(double) ); - /* Solve eigenproblem */ - dsyev_( V, U, &N, A, &N, AA, work, &lwork, &retcode ); - free(work); - } - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - //print_matrix(AA, N, 1); - - // Undo sqrt(2) in make_matrix by normalizing elet in first col by sqrt(2). - int idx; - int row = m/2; - idx = MATRIX_IDX(N, row, 0); - AA[0] = A[idx]/SQRT2; - // Transfer remaining elets in correct row to coeff vector. - for (int j = 1; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - free(A); - return retcode; - } - - - //------------------------------------------------------ - int mathieu_coeffs_eo(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order ce_2n+1 Mathieu fcn. - // Allowed value of m = 1, 3, 5, 7 ... - - int retcode = 0; - - // Bail out if m is not odd. - if (m % 2 != 1) return -1; - - // Allocate recursion matrix - double *A = (double *) calloc(N*N, sizeof(double)); - if (A == NULL) return SF_ERROR_MEMORY; - - // Do EVD - retcode = make_matrix_eo(N,q,A); - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - { - // Work in local scope. - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - double* work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_( V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode ); - lwork = (int)wkopt; - work = (double*)malloc( lwork*sizeof(double) ); - /* Solve eigenproblem */ - dsyev_( V, U, &N, A, &N, AA, work, &lwork, &retcode ); - free(work); - } - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - //print_matrix(AA, N, 1); - - // Transfer correct row to coeff vector. - int idx; - int row = (m-1)/2; - // Transfer elets in correct row to coeff vector. - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - free(A); - return retcode; - } - - - //------------------------------------------------------ - int mathieu_coeffs_oe(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order se_2n Mathieu fcn. - // Allowed value of m = 2, 4, 6, ... - // Inputs: - // N = size of recursion matrix to use. - // q = frequency parameter - // m = order of Mathieu fcn desired. - // Output: - // AA = length N vector preallocated to hold coeffs. - // Returns 0 if all goes well. Must put check on calloc - // here. - - int retcode = 0; - - // Bail out if m is not even or >= 2. - if ((m % 2 != 0) || (m < 2)) return -1; - - // Allocate recursion matrix - double *A = (double *) calloc(N*N, sizeof(double)); - if (A == NULL) return SF_ERROR_MEMORY; - - // Do EVD - retcode = make_matrix_oe(N,q,A); - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; + //------------------------------------------------------ + int mathieu_coeffs_eo(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order ce_2n+1 Mathieu fcn. + // Allowed value of m = 1, 3, 5, 7 ... + + int retcode = 0; + + // Bail out if m is not odd. + if (m % 2 != 1) + return -1; + + // Allocate recursion matrix + double *A = (double *)calloc(N * N, sizeof(double)); + if (A == NULL) + return SF_ERROR_MEMORY; + + // Do EVD + retcode = make_matrix_eo(N, q, A); + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + { + // Work in local scope. + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + double *work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_(V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + work = (double *)malloc(lwork * sizeof(double)); + /* Solve eigenproblem */ + dsyev_(V, U, &N, A, &N, AA, work, &lwork, &retcode); + free(work); + } + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + // print_matrix(AA, N, 1); + + // Transfer correct row to coeff vector. + int idx; + int row = (m - 1) / 2; + // Transfer elets in correct row to coeff vector. + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + free(A); + return retcode; } - { - // Work in local scope. - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - double* work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_( V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode ); - lwork = (int)wkopt; - work = (double*)malloc( lwork*sizeof(double) ); - /* Solve eigenproblem */ - dsyev_( V, U, &N, A, &N, AA, work, &lwork, &retcode ); - free(work); - } - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - //print_matrix(AA, N, 1); - - // Transfer remaining elets in correct row to coeff vector. - int idx; - int row = (m-2)/2; - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - free(A); - return retcode; - } - - - //------------------------------------------------------ - int mathieu_coeffs_oo(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order se_2n+1 Mathieu fcn. - // Allowed value of m = 1, 3, 5, 7 ... - - int retcode = 0; - - // Bail out if m is not odd. - if (m % 2 != 1) return -1; - - // Allocate recursion matrix - double *A = (double *) calloc(N*N, sizeof(double)); - if (A == NULL) return SF_ERROR_MEMORY; - - // Do EVD - retcode = make_matrix_oo(N,q,A); - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - { - // Work in local scope - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - double* work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_( V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode ); - lwork = (int)wkopt; - work = (double*)malloc( lwork*sizeof(double) ); - /* Solve eigenproblem */ - dsyev_( V, U, &N, A, &N, AA, work, &lwork, &retcode ); - free(work); - } - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - //print_matrix(AA, N, 1); - - // Transfer correct row to coeff vector. - int idx; - int row = (m-1)/2; - // Transfer elets in correct row to coeff vector. - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; + + //------------------------------------------------------ + int mathieu_coeffs_oe(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order se_2n Mathieu fcn. + // Allowed value of m = 2, 4, 6, ... + // Inputs: + // N = size of recursion matrix to use. + // q = frequency parameter + // m = order of Mathieu fcn desired. + // Output: + // AA = length N vector preallocated to hold coeffs. + // Returns 0 if all goes well. Must put check on calloc + // here. + + int retcode = 0; + + // Bail out if m is not even or >= 2. + if ((m % 2 != 0) || (m < 2)) + return -1; + + // Allocate recursion matrix + double *A = (double *)calloc(N * N, sizeof(double)); + if (A == NULL) + return SF_ERROR_MEMORY; + + // Do EVD + retcode = make_matrix_oe(N, q, A); + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + { + // Work in local scope. + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + double *work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_(V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + work = (double *)malloc(lwork * sizeof(double)); + /* Solve eigenproblem */ + dsyev_(V, U, &N, A, &N, AA, work, &lwork, &retcode); + free(work); + } + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + // print_matrix(AA, N, 1); + + // Transfer remaining elets in correct row to coeff vector. + int idx; + int row = (m - 2) / 2; + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + free(A); + return retcode; } - free(A); - return retcode; - } + //------------------------------------------------------ + int mathieu_coeffs_oo(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order se_2n+1 Mathieu fcn. + // Allowed value of m = 1, 3, 5, 7 ... + + int retcode = 0; + + // Bail out if m is not odd. + if (m % 2 != 1) + return -1; + + // Allocate recursion matrix + double *A = (double *)calloc(N * N, sizeof(double)); + if (A == NULL) + return SF_ERROR_MEMORY; + + // Do EVD + retcode = make_matrix_oo(N, q, A); + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + { + // Work in local scope + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + double *work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_(V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + work = (double *)malloc(lwork * sizeof(double)); + /* Solve eigenproblem */ + dsyev_(V, U, &N, A, &N, AA, work, &lwork, &retcode); + free(work); + } + if (retcode != 0) { + free(A); + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + // print_matrix(AA, N, 1); + + // Transfer correct row to coeff vector. + int idx; + int row = (m - 1) / 2; + // Transfer elets in correct row to coeff vector. + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + free(A); + return retcode; + } } // namespace mathieu } // namespace xsf -#endif // #ifndef MATHIEU_COEFFS_H +#endif // #ifndef MATHIEU_COEFFS_H diff --git a/include/xsf/mathieu/mathieu_eigs.h b/include/xsf/mathieu/mathieu_eigs.h index 28aafb4180..34af13cf15 100644 --- a/include/xsf/mathieu/mathieu_eigs.h +++ b/include/xsf/mathieu/mathieu_eigs.h @@ -6,7 +6,6 @@ #include "make_matrix.h" #include "matrix_utils.h" - /* * * This is part of the Mathieu function suite -- a reimplementation @@ -15,256 +14,252 @@ * b as a function of parameter q. * * Stuart Brorson, summer 2025. - * + * */ - /* DSYEV_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyev_( char* jobz, char* uplo, int* n, double* a, int* lda, - double* w, double* work, int* lwork, int* info ); +void dsyev_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); #ifdef __cplusplus } #endif - namespace xsf { namespace mathieu { - //------------------------------------------------------ - int mathieu_a(int m, double q, double *a) { - // printf("--> mathieu_a, m = %d, q = %e\n", m, q); + //------------------------------------------------------ + int mathieu_a(int m, double q, double *a) { + // printf("--> mathieu_a, m = %d, q = %e\n", m, q); - int N = m+25; // Sets size of recursion matrix - int retcode = SF_ERROR_OK; + int N = m + 25; // Sets size of recursion matrix + int retcode = SF_ERROR_OK; - if (m>500) { - // Don't support absurdly larger orders for now. - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - // Allocate recursion matrix - double *A = (double *) calloc(N*N, sizeof(double)); - if (A == NULL) { - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - // Allocate vector for eigenvalues - double *ww = (double *) calloc(N, sizeof(double)); - if (ww == NULL) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - return SF_ERROR_MEMORY; - } + if (m > 500) { + // Don't support absurdly larger orders for now. + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } - // Do EVD - if (m % 2 == 0) { - // Even order m - retcode = make_matrix_ee(N,q,A); - if (retcode != 0){ - *a = std::numeric_limits::quiet_NaN(); - free(A); - free(ww); - return retcode; - } - { - char V = 'V'; - char U = 'U'; - double wkopt; - double* work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_( &V, &U, &N, A, &N, ww, &wkopt, &lwork, &retcode ); - lwork = (int) wkopt; - work = (double*)malloc( lwork*sizeof(double) ); - /* Solve eigenproblem */ - dsyev_( &V, &U, &N, A, &N, ww, work, &lwork, &retcode ); - free(work); - } - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - free(ww); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - quickSort(ww, 0, N-1); - //print_matrix(ww, N, 1); + // Allocate recursion matrix + double *A = (double *)calloc(N * N, sizeof(double)); + if (A == NULL) { + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } - // Now figure out which one to return. - int idx = m/2; - *a = ww[idx]; - - } else { - // Odd order m - retcode = make_matrix_eo(N,q,A); - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - free(ww); - return retcode; - } - { - char V = 'V'; - char U = 'U'; - double wkopt; - double* work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_( &V, &U, &N, A, &N, ww, &wkopt, &lwork, &retcode ); - lwork = (int) wkopt; - work = (double*)malloc( lwork*sizeof(double) ); - /* Solve eigenproblem */ - dsyev_( &V, &U, &N, A, &N, ww, work, &lwork, &retcode ); - free(work); - } - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - free(ww); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - quickSort(ww, 0, N-1); - //print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = (m-1)/2; - *a = ww[idx]; - } + // Allocate vector for eigenvalues + double *ww = (double *)calloc(N, sizeof(double)); + if (ww == NULL) { + *a = std::numeric_limits::quiet_NaN(); + free(A); + return SF_ERROR_MEMORY; + } - free(A); - free(ww); - // printf("<-- mathieu_a\n"); - return retcode; - } + // Do EVD + if (m % 2 == 0) { + // Even order m + retcode = make_matrix_ee(N, q, A); + if (retcode != 0) { + *a = std::numeric_limits::quiet_NaN(); + free(A); + free(ww); + return retcode; + } + { + char V = 'V'; + char U = 'U'; + double wkopt; + double *work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_(&V, &U, &N, A, &N, ww, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + work = (double *)malloc(lwork * sizeof(double)); + /* Solve eigenproblem */ + dsyev_(&V, &U, &N, A, &N, ww, work, &lwork, &retcode); + free(work); + } + if (retcode != 0) { + *a = std::numeric_limits::quiet_NaN(); + free(A); + free(ww); + return SF_ERROR_NO_RESULT; + } - //------------------------------------------------------ - int mathieu_b(int m, double q, double *b) { - // printf("--> mathieu_b, m = %d, q = %e\n", m, q); - int N = m+25; // Sets size of recursion matrix - int retcode = SF_ERROR_OK; + // Sort ww vector from lowest to highest + quickSort(ww, 0, N - 1); + // print_matrix(ww, N, 1); - if (m>500) { - // Don't support absurdly larger orders for now. - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } + // Now figure out which one to return. + int idx = m / 2; + *a = ww[idx]; - // Allocate recursion matrix - double *B = (double *) calloc(N*N, sizeof(double)); - if (B == NULL) { - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } + } else { + // Odd order m + retcode = make_matrix_eo(N, q, A); + if (retcode != 0) { + *a = std::numeric_limits::quiet_NaN(); + free(A); + free(ww); + return retcode; + } + { + char V = 'V'; + char U = 'U'; + double wkopt; + double *work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_(&V, &U, &N, A, &N, ww, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + work = (double *)malloc(lwork * sizeof(double)); + /* Solve eigenproblem */ + dsyev_(&V, &U, &N, A, &N, ww, work, &lwork, &retcode); + free(work); + } + if (retcode != 0) { + *a = std::numeric_limits::quiet_NaN(); + free(A); + free(ww); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + quickSort(ww, 0, N - 1); + // print_matrix(ww, N, 1); - // Allocate vector for eigenvalues - double *ww = (double *) calloc(N, sizeof(double)); - if (ww == NULL) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - return SF_ERROR_MEMORY; + // Now figure out which one to return. + int idx = (m - 1) / 2; + *a = ww[idx]; + } + + free(A); + free(ww); + // printf("<-- mathieu_a\n"); + return retcode; } - // Do EVD - if (m % 2 == 0) { - // Even order m - retcode = make_matrix_oe(N,q,B); - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - free(ww); - return retcode; - } - { - char V = 'V'; - char U = 'U'; - double wkopt; - double* work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_( &V, &U, &N, B, &N, ww, &wkopt, &lwork, &retcode ); - lwork = (int) wkopt; - work = (double*)malloc( lwork*sizeof(double) ); - /* Solve eigenproblem */ - dsyev_( &V, &U, &N, B, &N, ww, work, &lwork, &retcode ); - free(work); - } - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - free(ww); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - quickSort(ww, 0, N-1); - //print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = (m-2)/2; - *b = ww[idx]; - - } else { - // Odd order m - retcode = make_matrix_oo(N,q,B); - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - free(ww); - return retcode; - } - { - char V = 'V'; - char U = 'U'; - double wkopt; - double* work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_( &V, &U, &N, B, &N, ww, &wkopt, &lwork, &retcode ); - lwork = (int) wkopt; - work = (double*)malloc( lwork*sizeof(double) ); - /* Solve eigenproblem */ - dsyev_( &V, &U, &N, B, &N, ww, work, &lwork, &retcode ); - free(work); - } - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - free(ww); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - quickSort(ww, 0, N-1); - //print_matrix(ww, N, 1); + //------------------------------------------------------ + int mathieu_b(int m, double q, double *b) { + // printf("--> mathieu_b, m = %d, q = %e\n", m, q); + int N = m + 25; // Sets size of recursion matrix + int retcode = SF_ERROR_OK; + + if (m > 500) { + // Don't support absurdly larger orders for now. + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + // Allocate recursion matrix + double *B = (double *)calloc(N * N, sizeof(double)); + if (B == NULL) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + // Allocate vector for eigenvalues + double *ww = (double *)calloc(N, sizeof(double)); + if (ww == NULL) { + *b = std::numeric_limits::quiet_NaN(); + free(B); + return SF_ERROR_MEMORY; + } + + // Do EVD + if (m % 2 == 0) { + // Even order m + retcode = make_matrix_oe(N, q, B); + if (retcode != 0) { + *b = std::numeric_limits::quiet_NaN(); + free(B); + free(ww); + return retcode; + } + { + char V = 'V'; + char U = 'U'; + double wkopt; + double *work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_(&V, &U, &N, B, &N, ww, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + work = (double *)malloc(lwork * sizeof(double)); + /* Solve eigenproblem */ + dsyev_(&V, &U, &N, B, &N, ww, work, &lwork, &retcode); + free(work); + } + if (retcode != 0) { + *b = std::numeric_limits::quiet_NaN(); + free(B); + free(ww); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + quickSort(ww, 0, N - 1); + // print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m - 2) / 2; + *b = ww[idx]; + + } else { + // Odd order m + retcode = make_matrix_oo(N, q, B); + if (retcode != 0) { + *b = std::numeric_limits::quiet_NaN(); + free(B); + free(ww); + return retcode; + } + { + char V = 'V'; + char U = 'U'; + double wkopt; + double *work; + /* Query and allocate the optimal workspace */ + // I do this work in an inner scope to make it easy + // to clean up afterwards. + int lwork = -1; + dsyev_(&V, &U, &N, B, &N, ww, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + work = (double *)malloc(lwork * sizeof(double)); + /* Solve eigenproblem */ + dsyev_(&V, &U, &N, B, &N, ww, work, &lwork, &retcode); + free(work); + } + if (retcode != 0) { + *b = std::numeric_limits::quiet_NaN(); + free(B); + free(ww); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + quickSort(ww, 0, N - 1); + // print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m - 1) / 2; + *b = ww[idx]; + } - // Now figure out which one to return. - int idx = (m-1)/2; - *b = ww[idx]; - + free(B); + free(ww); + // printf("<-- mathieu_b\n"); + return retcode; } - free(B); - free(ww); - // printf("<-- mathieu_b\n"); - return retcode; - } - } // namespace mathieu } // namespace xsf diff --git a/include/xsf/mathieu/mathieu_fcns.h b/include/xsf/mathieu/mathieu_fcns.h index babfa7cf88..a0ec56cb3d 100644 --- a/include/xsf/mathieu/mathieu_fcns.h +++ b/include/xsf/mathieu/mathieu_fcns.h @@ -3,11 +3,10 @@ #include "../config.h" #include "../error.h" -#include -#include "matrix_utils.h" -#include "mathieu_coeffs.h" #include "besseljyd.h" - +#include "mathieu_coeffs.h" +#include "matrix_utils.h" +#include /* * @@ -17,1578 +16,1585 @@ * and validated. This is a translation from Matlab to C. * * Stuart Brorson, Summer 2025. - * + * */ namespace xsf { namespace mathieu { - //================================================================== - int mathieu_ce(int m, double q, double v, double *ce, double *ced) { - // This computes the Mathieu fcn ce - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // v = angle in radians (scalar) - // Outputs: - // ce = value of fcn for these inputs (scalar) - // ced = value of fcn deriv w.r.t. v for these inputs (scalar) - // Return code: - // Codes in error.h. - - int retcode = SF_ERROR_OK; - - // Check input domain and flag any problems. - if (m>500) { - // Don't support absurdly larger orders for now. - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - // abs(q) > 1000 leads to low accuracy. - if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; - - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even ce - double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_ee(N,q,m, AA); - if (retcode != SF_ERROR_OK) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, cep, cem, cedp, cedm; - cem = 0.0; cep = 0.0; cedm = 0.0; cedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - tt = AA[k]*cos(2.0*k*v); // Term for Mathieu ce - if (tt<0) { - cem = cem + tt; // Neg running sum - } else { - cep = cep + tt; // Pos running sum - } - - td = -2.0*k*AA[k]*sin(2.0*k*v); // Term for deriv - if (td<0) { - cedm = cedm + td; - } else { - cedp = cedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *ce = cep+cem; - *ced = cedp+cedm; - - // Hack -- this makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_eo(N,q,m, AA); - if (retcode != SF_ERROR_OK) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, cep, cem, cedp, cedm; - cem = 0.0; cep = 0.0; cedm = 0.0; cedp = 0.0; - - // Perform Fourier sum on k = 0, 2, 4, ... - for (int k=(N-1); k>=0 ; k--) { - tt = AA[k]*cos((2.0*k+1.0)*v); // Term for Mathieu ce - if (tt<0) { - cem = cem + tt; // Neg running sum - } else { - cep = cep + tt; // Pos running sum - } - - td = -(2.0*k+1.0)*AA[k]*sin((2.0*k+1.0)*v); // Deriv. - if (td<0) { - cedm = cedm + td; - } else { - cedp = cedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *ce = cep+cem; - *ced = cedp+cedm; - - // Hack -- this makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l500) { - // Don't support absurdly larger orders for now. - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - // q>1000 leads to inaccuracy. - if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even se - double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oe(N,q,m, BB); - if (retcode != SF_ERROR_OK) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, sep, sem, sedp, sedm; - sem = 0.0; sep = 0.0; sedm = 0.0; sedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k=N; k>=1 ; k--) { - tt = BB[k-1]*sin(2.0*k*v); // Mathieu se term - if (tt<0) { - sem = sem + tt; // Neg running sum - } else { - sep = sep + tt; // Pos running sum - } - - td = 2.0*k*BB[k-1]*cos(2.0*k*v); // Deriv term. - if (td<0) { - sedm = sedm + td; - } else { - sedp = sedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *se = sep+sem; - *sed = sedp+sedm; - - // Hack -- this makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oo(N,q,m, BB); - if (retcode != SF_ERROR_OK) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, sep, sem, sedp, sedm; - sem = 0.0; sep = 0.0; sedm = 0.0; sedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - tt = BB[k]*sin((2.0*k+1.0)*v); // Mathieu se term - if (tt<0) { - sem = sem + tt; // Neg running sum - } else { - sep = sep + tt; // Pos running sum - } - - td = (2.0*k+1.0)*BB[k]*cos((2.0*k+1.0)*v); // Deriv term. - if (td<0) { - sedm = sedm + td; - } else { - sedp = sedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *se = sep+sem; - *sed = sedp+sedm; - - // Hack -- this makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l500) { - // Don't support absurdly larger orders for now. - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - if (q<0) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to return for these, just set retcode. - if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; // q>1000 is inaccurate - if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq*expmu; - double t = sqq*exppu; - - // This is used for the adaptive computation. - // I set the offset used in Bessel sum depending upon order m. - // The offset depends upon exactly where in the [q,m] plane lives - // the input args. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. - if ( (m>5 && q<.001) || - (m>7 && q<.01) || - (m>10 && q<.1) || - (m>15 && q<1) || - (m>20 && q<10) || - (m>30 && q<100) ) { - c = m/2; - } else { - c = 0; - } - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even modmc1 - double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_ee(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign, and I want to - // avoid catastrophic cancellation. - _Float128 mc1p, mc1m, mc1dp, mc1dm; - mc1p = 0.0; mc1m = 0.0; mc1dp = 0.0; mc1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Jkt = besselj(k,t); - double Jdks = besseljd(k,s); - double Jdkt = besseljd(k,t); - - _Float128 tt = AA[k]*(Jks*Jkt); - _Float128 ttd = AA[k]*(exppu*Jks*Jdkt - expmu*Jdks*Jkt); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c,s); - double Jkpct = besselj(k+c,t); - double Jkmct = besselj(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c,s); - double Jdkpct = besseljd(k+c,t); - double Jdkmct = besseljd(k-c,t); - - _Float128 tt = AA[k]*(Jkmcs*Jkpct + Jkpcs*Jkmct); - _Float128 ttd = AA[k]* - (exppu*(Jkmcs*Jdkpct + Jkpcs*Jdkmct) - - expmu*(Jdkmcs*Jkpct + Jdkpcs*Jkmct)) ; - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *mc1 = static_cast(mc1p+mc1m); - *mc1d = static_cast(mc1dp+mc1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = m/2; - if (sgn%2 == 0) { - *mc1 = (*mc1)/AA[c]; - *mc1d = sqq*(*mc1d)/AA[c]; - } else { - *mc1 = -(*mc1)/AA[c]; - *mc1d = -sqq*(*mc1d)/AA[c]; - } - - free(AA); - - } else { - // Odd -- m = 1, 3, 5, 7 ... - - // Get coeff vector for even modmc1 - double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_eo(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 mc1p, mc1m, mc1dp, mc1dm; - mc1p = 0.0; mc1m = 0.0; mc1dp = 0.0; mc1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Jkp1s = besselj(k+1,s); - double Jkt = besselj(k,t); - double Jkp1t = besselj(k+1,t); - - double Jdks = besseljd(k,s); - double Jdkp1s = besseljd(k+1,s); - double Jdkt = besseljd(k,t); - double Jdkp1t = besseljd(k+1,t); - - _Float128 tt = AA[k]*(Jks*Jkp1t + Jkp1s*Jkt); - _Float128 ttd = AA[k]* - (exppu*(Jks*Jdkp1t + Jkp1s*Jdkt) - - expmu*(Jdks*Jkp1t + Jdkp1s*Jkt) ) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c+1,s); - double Jkpct = besselj(k+c+1,t); - double Jkmct = besselj(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c+1,s); - double Jdkpct = besseljd(k+c+1,t); - double Jdkmct = besseljd(k-c,t); - - _Float128 tt = AA[k]*(Jkmcs*Jkpct + Jkpcs*Jkmct); - _Float128 ttd = AA[k]* - (exppu*(Jkmcs*Jdkpct + Jkpcs*Jdkmct) - - expmu*(Jdkmcs*Jkpct + Jdkpcs*Jkmct)) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *mc1 = static_cast(mc1p+mc1m); - *mc1d = static_cast(mc1dp+mc1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-1)/2; - if (sgn%2 == 0) { - *mc1 = (*mc1)/AA[c]; - *mc1d = sqq*(*mc1d)/AA[c]; - } else { - *mc1 = -(*mc1)/AA[c]; - *mc1d = -sqq*(*mc1d)/AA[c]; - } - - free(AA); - } - - return retcode; - } // int mathieu_modmc1 - - - //================================================================== - int mathieu_modms1(int m, double q, double u, double *ms1, double *ms1d) { - // This computes the Mathieu fcn modms1 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // ms1 = value of fcn for these inputs (scalar) - // ms1d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check input domain and flag any problems - if (m>500) { - // Don't support absurdly larger orders for now. - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; + //================================================================== + int mathieu_ce(int m, double q, double v, double *ce, double *ced) { + // This computes the Mathieu fcn ce + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // v = angle in radians (scalar) + // Outputs: + // ce = value of fcn for these inputs (scalar) + // ced = value of fcn deriv w.r.t. v for these inputs (scalar) + // Return code: + // Codes in error.h. + + int retcode = SF_ERROR_OK; + + // Check input domain and flag any problems. + if (m > 500) { + // Don't support absurdly larger orders for now. + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + // abs(q) > 1000 leads to low accuracy. + if (abs(q) > 1.0e3d) + retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even ce + double *AA = (double *)calloc(N, sizeof(double)); + if (AA == NULL) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_ee(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + free(AA); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, cep, cem, cedp, cedm; + cem = 0.0; + cep = 0.0; + cedm = 0.0; + cedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + tt = AA[k] * cos(2.0 * k * v); // Term for Mathieu ce + if (tt < 0) { + cem = cem + tt; // Neg running sum + } else { + cep = cep + tt; // Pos running sum + } + + td = -2.0 * k * AA[k] * sin(2.0 * k * v); // Term for deriv + if (td < 0) { + cedm = cedm + td; + } else { + cedp = cedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *ce = cep + cem; + *ced = cedp + cedm; + + // Hack -- this makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l < N; l++) { + s = s + AA[l]; + } + *ce = SIGN(s) * (*ce); + *ced = SIGN(s) * (*ced); + free(AA); + + } else { + // Odd + + // Get coeff vector for odd ce + double *AA = (double *)calloc(N, sizeof(double)); + if (AA == NULL) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_eo(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + free(AA); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, cep, cem, cedp, cedm; + cem = 0.0; + cep = 0.0; + cedm = 0.0; + cedp = 0.0; + + // Perform Fourier sum on k = 0, 2, 4, ... + for (int k = (N - 1); k >= 0; k--) { + tt = AA[k] * cos((2.0 * k + 1.0) * v); // Term for Mathieu ce + if (tt < 0) { + cem = cem + tt; // Neg running sum + } else { + cep = cep + tt; // Pos running sum + } + + td = -(2.0 * k + 1.0) * AA[k] * sin((2.0 * k + 1.0) * v); // Deriv. + if (td < 0) { + cedm = cedm + td; + } else { + cedp = cedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *ce = cep + cem; + *ced = cedp + cedm; + + // Hack -- this makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l < N; l++) { + s = s + AA[l]; + } + *ce = SIGN(s) * (*ce); + *ced = SIGN(s) * (*ced); + + free(AA); + } // if (m % 2 == 0) + + return retcode; } - if (q<0) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to return immediately for these. - if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; - if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq*expmu; - double t = sqq*exppu; - - // This is used for the adaptive computation. - // I set the offset used in Bessel fcn depending upon order m. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. - if ( (m>5 && q<.001) || - (m>7 && q<.01) || - (m>10 && q<.1) || - (m>15 && q<1) || - (m>20 && q<10) || - (m>30 && q<100) ) { - c = m/2; - } else { - c = 0; - } - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even modms1 - double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oe(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 ms1p, ms1m, ms1dp, ms1dm; - ms1p = 0.0; ms1m = 0.0; ms1dp = 0.0; ms1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Jkp2t = besselj(k+2,t); - double Jkp2s = besselj(k+2,s); - double Jkt = besselj(k,t); - - double Jdks = besseljd(k,s); - double Jdkp2t = besseljd(k+2,t); - double Jdkp2s = besseljd(k+2,s); - double Jdkt = besseljd(k,t); - - _Float128 tt = BB[k]*(Jks*Jkp2t - Jkp2s*Jkt); - _Float128 ttd = BB[k]* - (exppu*(Jks*Jdkp2t - Jkp2s*Jdkt) - - expmu*(Jdks*Jkp2t - Jdkp2s*Jkt)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpct = besselj(k+c+2,t); - double Jkpcs = besselj(k+c+2,s); - double Jkmct = besselj(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpct = besseljd(k+c+2,t); - double Jdkpcs = besseljd(k+c+2,s); - double Jdkmct = besseljd(k-c,t); - - _Float128 tt = BB[k]*(Jkmcs*Jkpct - Jkpcs*Jkmct); - _Float128 ttd = BB[k]* - (exppu*(Jkmcs*Jdkpct - Jkpcs*Jdkmct) - - expmu*(Jdkmcs*Jkpct - Jdkpcs*Jkmct)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *ms1 = static_cast(ms1p+ms1m); - *ms1d = static_cast(ms1dp+ms1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-2)/2; - if (sgn%2 == 0) { - *ms1 = (*ms1)/BB[c]; - *ms1d = sqq*(*ms1d)/BB[c]; - } else { - *ms1 = -(*ms1)/BB[c]; - *ms1d = -sqq*(*ms1d)/BB[c]; - } - - free(BB); - - } else { - // Odd -- m = 1, 3, 5, 7 ... - - // Get coeff vector for even modms1 - double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oo(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 ms1p, ms1m, ms1dp, ms1dm; - ms1p = 0.0; ms1m = 0.0; ms1dp = 0.0; ms1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Jkt = besselj(k,t); - double Jkp1s = besselj(k+1,s); - double Jkp1t = besselj(k+1,t); - - double Jdks = besseljd(k,s); - double Jdkt = besseljd(k,t); - double Jdkp1s = besseljd(k+1,s); - double Jdkp1t = besseljd(k+1,t); - - _Float128 tt = BB[k]*(Jks*Jkp1t - Jkp1s*Jkt); - _Float128 ttd = BB[k]* - (exppu*(Jks*Jdkp1t - Jkp1s*Jdkt) - - expmu*(Jdks*Jkp1t - Jdkp1s*Jkt)); - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c+1,s); - double Jkpct = besselj(k+c+1,t); - double Jkmct = besselj(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c+1,s); - double Jdkpct = besseljd(k+c+1,t); - double Jdkmct = besseljd(k-c,t); - - _Float128 tt = BB[k]*(Jkmcs*Jkpct - Jkpcs*Jkmct); - _Float128 ttd = BB[k]* - (exppu*(Jkmcs*Jdkpct - Jkpcs*Jdkmct) - - expmu*(Jdkmcs*Jkpct - Jdkpcs*Jkmct)) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *ms1 = static_cast(ms1p+ms1m); - *ms1d = static_cast(ms1dp+ms1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-1)/2; - if (sgn%2 == 0) { - *ms1 = (*ms1)/BB[c]; - *ms1d = sqq*(*ms1d)/BB[c]; - } else { - *ms1 = -(*ms1)/BB[c]; - *ms1d = -sqq*(*ms1d)/BB[c]; - } - - free(BB); - } - - return retcode; - } // int mathieu_modms1 - - - //================================================================== - int mathieu_modmc2(int m, double q, double u, double *mc2, double *mc2d) { - // This computes the Mathieu fcn modmc2 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // mc2 = value of fcn for these inputs (scalar) - // mc2d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check input domain and flag any problems - if (m>500) { - // Don't support absurdly larger orders for now. - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - if (q<0) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to return immediate for these. - if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; - if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq*expmu; - double t = sqq*exppu; - - // This is used for the adaptive computation. - // I set the offset used in Bessel fcn depending upon order m. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. - if ( (m>5 && q<.001) || - (m>7 && q<.01) || - (m>10 && q<.1) || - (m>15 && q<1) || - (m>20 && q<10) || - (m>30 && q<100) ) { - c = m/2; - } else { - c = 0; - } - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even modmc2 - double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_ee(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 mc2p, mc2m, mc2dp, mc2dm; - - // Sum from smallest to largest coeff. - mc2p = 0.0; mc2m = 0.0; mc2dp = 0.0; mc2dm = 0.0; - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Ykt = bessely(k,t); - double Jdks = besseljd(k,s); - double Ydkt = besselyd(k,t); - - _Float128 tt = AA[k]*Jks*Ykt ; - _Float128 ttd = AA[k]*(exppu*Jks*Ydkt - expmu*Jdks*Ykt) ; - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c,s); - double Ykpct = bessely(k+c,t); - double Ykmct = bessely(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c,s); - double Ydkpct = besselyd(k+c,t); - double Ydkmct = besselyd(k-c,t); - - _Float128 tt = AA[k]*(Jkmcs*Ykpct + Jkpcs*Ykmct); - _Float128 ttd = AA[k]* - (exppu*(Jkmcs*Ydkpct + Jkpcs*Ydkmct) - - expmu*(Jdkmcs*Ykpct + Jdkpcs*Ykmct)) ; - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *mc2 = static_cast(mc2p+mc2m); - *mc2d = static_cast(mc2dp+mc2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = m/2; - if (sgn%2 == 0) { - *mc2 = (*mc2)/AA[c]; - *mc2d = sqq*(*mc2d)/AA[c]; - } else { - *mc2 = -(*mc2)/AA[c]; - *mc2d = -sqq*(*mc2d)/AA[c]; - } - - free(AA); - - } else { - // Odd -- m = 1, 3, 5, 7 ... - - // Get coeff vector for odd mc2 - double *AA = (double *) calloc(N, sizeof(double)); - if (AA == NULL) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_eo(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 mc2p, mc2m, mc2dp, mc2dm; - mc2p = 0.0; mc2m = 0.0; mc2dp = 0.0; mc2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Ykt = bessely(k,t); - double Jkp1s = besselj(k+1,s); - double Ykp1t = bessely(k+1,t); - - double Jdks = besseljd(k,s); - double Ydkt = besselyd(k,t); - double Jdkp1s = besseljd(k+1,s); - double Ydkp1t = besselyd(k+1,t); - - _Float128 tt = AA[k]*(Jks*Ykp1t + Jkp1s*Ykt); - _Float128 ttd = AA[k]* - (exppu*(Jks*Ydkp1t + Jkp1s*Ydkt) - - expmu*(Jdks*Ykp1t + Jdkp1s*Ykt) ) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c+1,s); - double Ykpct = bessely(k+c+1,t); - double Ykmct = bessely(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c+1,s); - double Ydkpct = besselyd(k+c+1,t); - double Ydkmct = besselyd(k-c,t); - - _Float128 tt = AA[k]*(Jkmcs*Ykpct + Jkpcs*Ykmct); - _Float128 ttd = AA[k]* - (exppu*(Jkmcs*Ydkpct + Jkpcs*Ydkmct) - - expmu*(Jdkmcs*Ykpct + Jdkpcs*Ykmct) ) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *mc2 = static_cast(mc2p+mc2m); - *mc2d = static_cast(mc2dp+mc2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-1)/2; - if (sgn%2 == 0) { - *mc2 = (*mc2)/AA[c]; - *mc2d = sqq*(*mc2d)/AA[c]; - } else { - *mc2 = -(*mc2)/AA[c]; - *mc2d = -sqq*(*mc2d)/AA[c]; - } - - free(AA); - } - - return retcode; - } // int mathieu_modmc2 - - - //================================================================== - int mathieu_modms2(int m, double q, double u, double *ms2, double *ms2d) { - // This computes the Mathieu fcn modms2 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // ms2 = value of fcn for these inputs (scalar) - // ms2d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check input domain and flag any problems - if (m>500) { - // Don't support absurdly larger orders for now. - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - if (q<0) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to return immediately from these. - if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; - if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq*expmu; - double t = sqq*exppu; - - // This is used for the adaptive computation. - // I set the offset used in Bessel fcn depending upon order m. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. - if ( (m>5 && q<.001) || - (m>7 && q<.01) || - (m>10 && q<.1) || - (m>15 && q<1) || - (m>20 && q<10) || - (m>30 && q<100) ) { - c = m/2; - } else { - c = 0; - } - c = 0; - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even modms2 - double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oe(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 ms2p, ms2m, ms2dp, ms2dm; - ms2p = 0.0; ms2m = 0.0; ms2dp = 0.0; ms2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Ykp2t = bessely(k+2,t); - double Jkp2s = besselj(k+2,s); - double Ykt = bessely(k,t); - - double Jdks = besseljd(k,s); - double Ydkp2t = besselyd(k+2,t); - double Jdkp2s = besseljd(k+2,s); - double Ydkt = besselyd(k,t); - - _Float128 tt = BB[k]*(Jks*Ykp2t - Jkp2s*Ykt); - _Float128 ttd = BB[k]* - (exppu*(Jks*Ydkp2t - Jkp2s*Ydkt) - - expmu*(Jdks*Ykp2t - Jdkp2s*Ykt)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Ykpct = bessely(k+c+2,t); - double Jkpcs = besselj(k+c+2,s); - double Ykmct = bessely(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Ydkpct = besselyd(k+c+2,t); - double Jdkpcs = besseljd(k+c+2,s); - double Ydkmct = besselyd(k-c,t); - - _Float128 tt = BB[k]*(Jkmcs*Ykpct - Jkpcs*Ykmct); - _Float128 ttd = BB[k]* - (exppu*(Jkmcs*Ydkpct - Jkpcs*Ydkmct) - - expmu*(Jdkmcs*Ykpct - Jdkpcs*Ykmct)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *ms2 = static_cast(ms2p+ms2m); - *ms2d = static_cast(ms2dp+ms2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-2)/2; - if (sgn%2 == 0) { - *ms2 = (*ms2)/BB[c]; - *ms2d = sqq*(*ms2d)/BB[c]; - } else { - *ms2 = -(*ms2)/BB[c]; - *ms2d = -sqq*(*ms2d)/BB[c]; - } - - free(BB); - - } else { - // Odd -- m = 1, 3, 5, 7 ... - - // Get coeff vector for even modms2 - double *BB = (double *) calloc(N, sizeof(double)); - if (BB == NULL) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oo(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 ms2p, ms2m, ms2dp, ms2dm; - ms2p = 0.0; ms2m = 0.0; ms2dp = 0.0; ms2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Ykt = bessely(k,t); - double Jkp1s = besselj(k+1,s); - double Ykp1t = bessely(k+1,t); - - double Jdks = besseljd(k,s); - double Ydkt = besselyd(k,t); - double Jdkp1s = besseljd(k+1,s); - double Ydkp1t = besselyd(k+1,t); - - _Float128 tt = BB[k]*(Jks*Ykp1t - Jkp1s*Ykt); - _Float128 ttd = BB[k]* - (exppu*(Jks*Ydkp1t - Jkp1s*Ydkt) - - expmu*(Jdks*Ykp1t - Jdkp1s*Ykt)); - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c+1,s); - double Ykpct = bessely(k+c+1,t); - double Ykmct = bessely(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c+1,s); - double Ydkpct = besselyd(k+c+1,t); - double Ydkmct = besselyd(k-c,t); - - _Float128 tt = BB[k]*(Jkmcs*Ykpct - Jkpcs*Ykmct); - _Float128 ttd = BB[k]* - (exppu*(Jkmcs*Ydkpct - Jkpcs*Ydkmct) - - expmu*(Jdkmcs*Ykpct - Jdkpcs*Ykmct) ) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *ms2 = static_cast(ms2p+ms2m); - *ms2d = static_cast(ms2dp+ms2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-1)/2; - if (sgn%2 == 0) { - *ms2 = (*ms2)/BB[c]; - *ms2d = sqq*(*ms2d)/BB[c]; - } else { - *ms2 = -(*ms2)/BB[c]; - *ms2d = -sqq*(*ms2d)/BB[c]; - } - - free(BB); - } - - return retcode; - } // int mathieu_modms2 - - + //================================================================== + int mathieu_se(int m, double q, double v, double *se, double *sed) { + // This computes the Mathieu fcn se + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // v = angle in radians (scalar) + // Outputs: + // se = value of fcn for these inputs (scalar) + // sed = value of fcn deriv w.r.t. v for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + + // Check input domain and flag any problems. + if (m > 500) { + // Don't support absurdly larger orders for now. + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + // q>1000 leads to inaccuracy. + if (abs(q) > 1.0e3d) + retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even se + double *BB = (double *)calloc(N, sizeof(double)); + if (BB == NULL) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_oe(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + free(BB); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, sep, sem, sedp, sedm; + sem = 0.0; + sep = 0.0; + sedm = 0.0; + sedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k = N; k >= 1; k--) { + tt = BB[k - 1] * sin(2.0 * k * v); // Mathieu se term + if (tt < 0) { + sem = sem + tt; // Neg running sum + } else { + sep = sep + tt; // Pos running sum + } + + td = 2.0 * k * BB[k - 1] * cos(2.0 * k * v); // Deriv term. + if (td < 0) { + sedm = sedm + td; + } else { + sedp = sedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *se = sep + sem; + *sed = sedp + sedm; + + // Hack -- this makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l < N; l++) { + s = s + BB[l]; + } + *se = SIGN(s) * (*se); + *sed = SIGN(s) * (*sed); + + free(BB); + } else { + // Odd + + // Get coeff vector for odd se + double *BB = (double *)calloc(N, sizeof(double)); + if (BB == NULL) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_oo(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + free(BB); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, sep, sem, sedp, sedm; + sem = 0.0; + sep = 0.0; + sedm = 0.0; + sedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + tt = BB[k] * sin((2.0 * k + 1.0) * v); // Mathieu se term + if (tt < 0) { + sem = sem + tt; // Neg running sum + } else { + sep = sep + tt; // Pos running sum + } + + td = (2.0 * k + 1.0) * BB[k] * cos((2.0 * k + 1.0) * v); // Deriv term. + if (td < 0) { + sedm = sedm + td; + } else { + sedp = sedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *se = sep + sem; + *sed = sedp + sedm; + + // Hack -- this makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l < N; l++) { + s = s + BB[l]; + } + *se = SIGN(s) * (*se); + *sed = SIGN(s) * (*sed); + + free(BB); + } + + return retcode; + } // int mathieu_se + + //================================================================== + int mathieu_modmc1(int m, double q, double u, double *mc1, double *mc1d) { + // This computes the Mathieu fcn modmc1 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // mc1 = value of fcn for these inputs (scalar) + // mc1d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check input domain and flag any problems + if (m > 500) { + // Don't support absurdly larger orders for now. + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + if (q < 0) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to return for these, just set retcode. + if (abs(q) > 1.0e3d) + retcode = SF_ERROR_LOSS; // q>1000 is inaccurate + if (m > 15 && q > 0.1d) + retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq * expmu; + double t = sqq * exppu; + + // This is used for the adaptive computation. + // I set the offset used in Bessel sum depending upon order m. + // The offset depends upon exactly where in the [q,m] plane lives + // the input args. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. + if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || + (m > 20 && q < 10) || (m > 30 && q < 100)) { + c = m / 2; + } else { + c = 0; + } + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even modmc1 + double *AA = (double *)calloc(N, sizeof(double)); + if (AA == NULL) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_ee(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + free(AA); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign, and I want to + // avoid catastrophic cancellation. + _Float128 mc1p, mc1m, mc1dp, mc1dm; + mc1p = 0.0; + mc1m = 0.0; + mc1dp = 0.0; + mc1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Jkt = besselj(k, t); + double Jdks = besseljd(k, s); + double Jdkt = besseljd(k, t); + + _Float128 tt = AA[k] * (Jks * Jkt); + _Float128 ttd = AA[k] * (exppu * Jks * Jdkt - expmu * Jdks * Jkt); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c, s); + double Jkpct = besselj(k + c, t); + double Jkmct = besselj(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c, s); + double Jdkpct = besseljd(k + c, t); + double Jdkmct = besseljd(k - c, t); + + _Float128 tt = AA[k] * (Jkmcs * Jkpct + Jkpcs * Jkmct); + _Float128 ttd = + AA[k] * (exppu * (Jkmcs * Jdkpct + Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct + Jdkpcs * Jkmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *mc1 = static_cast(mc1p + mc1m); + *mc1d = static_cast(mc1dp + mc1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = m / 2; + if (sgn % 2 == 0) { + *mc1 = (*mc1) / AA[c]; + *mc1d = sqq * (*mc1d) / AA[c]; + } else { + *mc1 = -(*mc1) / AA[c]; + *mc1d = -sqq * (*mc1d) / AA[c]; + } + + free(AA); + + } else { + // Odd -- m = 1, 3, 5, 7 ... + + // Get coeff vector for even modmc1 + double *AA = (double *)calloc(N, sizeof(double)); + if (AA == NULL) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_eo(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + free(AA); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 mc1p, mc1m, mc1dp, mc1dm; + mc1p = 0.0; + mc1m = 0.0; + mc1dp = 0.0; + mc1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Jkp1s = besselj(k + 1, s); + double Jkt = besselj(k, t); + double Jkp1t = besselj(k + 1, t); + + double Jdks = besseljd(k, s); + double Jdkp1s = besseljd(k + 1, s); + double Jdkt = besseljd(k, t); + double Jdkp1t = besseljd(k + 1, t); + + _Float128 tt = AA[k] * (Jks * Jkp1t + Jkp1s * Jkt); + _Float128 ttd = + AA[k] * (exppu * (Jks * Jdkp1t + Jkp1s * Jdkt) - expmu * (Jdks * Jkp1t + Jdkp1s * Jkt)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c + 1, s); + double Jkpct = besselj(k + c + 1, t); + double Jkmct = besselj(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c + 1, s); + double Jdkpct = besseljd(k + c + 1, t); + double Jdkmct = besseljd(k - c, t); + + _Float128 tt = AA[k] * (Jkmcs * Jkpct + Jkpcs * Jkmct); + _Float128 ttd = + AA[k] * (exppu * (Jkmcs * Jdkpct + Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct + Jdkpcs * Jkmct)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *mc1 = static_cast(mc1p + mc1m); + *mc1d = static_cast(mc1dp + mc1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 1) / 2; + if (sgn % 2 == 0) { + *mc1 = (*mc1) / AA[c]; + *mc1d = sqq * (*mc1d) / AA[c]; + } else { + *mc1 = -(*mc1) / AA[c]; + *mc1d = -sqq * (*mc1d) / AA[c]; + } + + free(AA); + } + + return retcode; + } // int mathieu_modmc1 + + //================================================================== + int mathieu_modms1(int m, double q, double u, double *ms1, double *ms1d) { + // This computes the Mathieu fcn modms1 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // ms1 = value of fcn for these inputs (scalar) + // ms1d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check input domain and flag any problems + if (m > 500) { + // Don't support absurdly larger orders for now. + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + if (q < 0) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to return immediately for these. + if (abs(q) > 1.0e3d) + retcode = SF_ERROR_LOSS; + if (m > 15 && q > 0.1d) + retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq * expmu; + double t = sqq * exppu; + + // This is used for the adaptive computation. + // I set the offset used in Bessel fcn depending upon order m. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. + if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || + (m > 20 && q < 10) || (m > 30 && q < 100)) { + c = m / 2; + } else { + c = 0; + } + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even modms1 + double *BB = (double *)calloc(N, sizeof(double)); + if (BB == NULL) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_oe(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + free(BB); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 ms1p, ms1m, ms1dp, ms1dm; + ms1p = 0.0; + ms1m = 0.0; + ms1dp = 0.0; + ms1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Jkp2t = besselj(k + 2, t); + double Jkp2s = besselj(k + 2, s); + double Jkt = besselj(k, t); + + double Jdks = besseljd(k, s); + double Jdkp2t = besseljd(k + 2, t); + double Jdkp2s = besseljd(k + 2, s); + double Jdkt = besseljd(k, t); + + _Float128 tt = BB[k] * (Jks * Jkp2t - Jkp2s * Jkt); + _Float128 ttd = + BB[k] * (exppu * (Jks * Jdkp2t - Jkp2s * Jdkt) - expmu * (Jdks * Jkp2t - Jdkp2s * Jkt)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpct = besselj(k + c + 2, t); + double Jkpcs = besselj(k + c + 2, s); + double Jkmct = besselj(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpct = besseljd(k + c + 2, t); + double Jdkpcs = besseljd(k + c + 2, s); + double Jdkmct = besseljd(k - c, t); + + _Float128 tt = BB[k] * (Jkmcs * Jkpct - Jkpcs * Jkmct); + _Float128 ttd = + BB[k] * (exppu * (Jkmcs * Jdkpct - Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct - Jdkpcs * Jkmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *ms1 = static_cast(ms1p + ms1m); + *ms1d = static_cast(ms1dp + ms1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 2) / 2; + if (sgn % 2 == 0) { + *ms1 = (*ms1) / BB[c]; + *ms1d = sqq * (*ms1d) / BB[c]; + } else { + *ms1 = -(*ms1) / BB[c]; + *ms1d = -sqq * (*ms1d) / BB[c]; + } + + free(BB); + + } else { + // Odd -- m = 1, 3, 5, 7 ... + + // Get coeff vector for even modms1 + double *BB = (double *)calloc(N, sizeof(double)); + if (BB == NULL) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_oo(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + free(BB); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 ms1p, ms1m, ms1dp, ms1dm; + ms1p = 0.0; + ms1m = 0.0; + ms1dp = 0.0; + ms1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Jkt = besselj(k, t); + double Jkp1s = besselj(k + 1, s); + double Jkp1t = besselj(k + 1, t); + + double Jdks = besseljd(k, s); + double Jdkt = besseljd(k, t); + double Jdkp1s = besseljd(k + 1, s); + double Jdkp1t = besseljd(k + 1, t); + + _Float128 tt = BB[k] * (Jks * Jkp1t - Jkp1s * Jkt); + _Float128 ttd = + BB[k] * (exppu * (Jks * Jdkp1t - Jkp1s * Jdkt) - expmu * (Jdks * Jkp1t - Jdkp1s * Jkt)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c + 1, s); + double Jkpct = besselj(k + c + 1, t); + double Jkmct = besselj(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c + 1, s); + double Jdkpct = besseljd(k + c + 1, t); + double Jdkmct = besseljd(k - c, t); + + _Float128 tt = BB[k] * (Jkmcs * Jkpct - Jkpcs * Jkmct); + _Float128 ttd = + BB[k] * (exppu * (Jkmcs * Jdkpct - Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct - Jdkpcs * Jkmct)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *ms1 = static_cast(ms1p + ms1m); + *ms1d = static_cast(ms1dp + ms1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 1) / 2; + if (sgn % 2 == 0) { + *ms1 = (*ms1) / BB[c]; + *ms1d = sqq * (*ms1d) / BB[c]; + } else { + *ms1 = -(*ms1) / BB[c]; + *ms1d = -sqq * (*ms1d) / BB[c]; + } + + free(BB); + } + + return retcode; + } // int mathieu_modms1 + + //================================================================== + int mathieu_modmc2(int m, double q, double u, double *mc2, double *mc2d) { + // This computes the Mathieu fcn modmc2 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // mc2 = value of fcn for these inputs (scalar) + // mc2d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check input domain and flag any problems + if (m > 500) { + // Don't support absurdly larger orders for now. + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + if (q < 0) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to return immediate for these. + if (abs(q) > 1.0e3d) + retcode = SF_ERROR_LOSS; + if (m > 15 && q > 0.1d) + retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq * expmu; + double t = sqq * exppu; + + // This is used for the adaptive computation. + // I set the offset used in Bessel fcn depending upon order m. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. + if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || + (m > 20 && q < 10) || (m > 30 && q < 100)) { + c = m / 2; + } else { + c = 0; + } + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even modmc2 + double *AA = (double *)calloc(N, sizeof(double)); + if (AA == NULL) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_ee(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + free(AA); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 mc2p, mc2m, mc2dp, mc2dm; + + // Sum from smallest to largest coeff. + mc2p = 0.0; + mc2m = 0.0; + mc2dp = 0.0; + mc2dm = 0.0; + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Ykt = bessely(k, t); + double Jdks = besseljd(k, s); + double Ydkt = besselyd(k, t); + + _Float128 tt = AA[k] * Jks * Ykt; + _Float128 ttd = AA[k] * (exppu * Jks * Ydkt - expmu * Jdks * Ykt); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c, s); + double Ykpct = bessely(k + c, t); + double Ykmct = bessely(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c, s); + double Ydkpct = besselyd(k + c, t); + double Ydkmct = besselyd(k - c, t); + + _Float128 tt = AA[k] * (Jkmcs * Ykpct + Jkpcs * Ykmct); + _Float128 ttd = + AA[k] * (exppu * (Jkmcs * Ydkpct + Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct + Jdkpcs * Ykmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *mc2 = static_cast(mc2p + mc2m); + *mc2d = static_cast(mc2dp + mc2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = m / 2; + if (sgn % 2 == 0) { + *mc2 = (*mc2) / AA[c]; + *mc2d = sqq * (*mc2d) / AA[c]; + } else { + *mc2 = -(*mc2) / AA[c]; + *mc2d = -sqq * (*mc2d) / AA[c]; + } + + free(AA); + + } else { + // Odd -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd mc2 + double *AA = (double *)calloc(N, sizeof(double)); + if (AA == NULL) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_eo(N, q, m, AA); + if (retcode != SF_ERROR_OK) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + free(AA); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 mc2p, mc2m, mc2dp, mc2dm; + mc2p = 0.0; + mc2m = 0.0; + mc2dp = 0.0; + mc2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Ykt = bessely(k, t); + double Jkp1s = besselj(k + 1, s); + double Ykp1t = bessely(k + 1, t); + + double Jdks = besseljd(k, s); + double Ydkt = besselyd(k, t); + double Jdkp1s = besseljd(k + 1, s); + double Ydkp1t = besselyd(k + 1, t); + + _Float128 tt = AA[k] * (Jks * Ykp1t + Jkp1s * Ykt); + _Float128 ttd = + AA[k] * (exppu * (Jks * Ydkp1t + Jkp1s * Ydkt) - expmu * (Jdks * Ykp1t + Jdkp1s * Ykt)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c + 1, s); + double Ykpct = bessely(k + c + 1, t); + double Ykmct = bessely(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c + 1, s); + double Ydkpct = besselyd(k + c + 1, t); + double Ydkmct = besselyd(k - c, t); + + _Float128 tt = AA[k] * (Jkmcs * Ykpct + Jkpcs * Ykmct); + _Float128 ttd = + AA[k] * (exppu * (Jkmcs * Ydkpct + Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct + Jdkpcs * Ykmct)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *mc2 = static_cast(mc2p + mc2m); + *mc2d = static_cast(mc2dp + mc2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 1) / 2; + if (sgn % 2 == 0) { + *mc2 = (*mc2) / AA[c]; + *mc2d = sqq * (*mc2d) / AA[c]; + } else { + *mc2 = -(*mc2) / AA[c]; + *mc2d = -sqq * (*mc2d) / AA[c]; + } + + free(AA); + } + + return retcode; + } // int mathieu_modmc2 + + //================================================================== + int mathieu_modms2(int m, double q, double u, double *ms2, double *ms2d) { + // This computes the Mathieu fcn modms2 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // ms2 = value of fcn for these inputs (scalar) + // ms2d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check input domain and flag any problems + if (m > 500) { + // Don't support absurdly larger orders for now. + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + if (q < 0) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to return immediately from these. + if (abs(q) > 1.0e3d) + retcode = SF_ERROR_LOSS; + if (m > 15 && q > 0.1d) + retcode = SF_ERROR_LOSS; + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq * expmu; + double t = sqq * exppu; + + // This is used for the adaptive computation. + // I set the offset used in Bessel fcn depending upon order m. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. + if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || + (m > 20 && q < 10) || (m > 30 && q < 100)) { + c = m / 2; + } else { + c = 0; + } + c = 0; + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even + + // Get coeff vector for even modms2 + double *BB = (double *)calloc(N, sizeof(double)); + if (BB == NULL) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_oe(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + free(BB); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 ms2p, ms2m, ms2dp, ms2dm; + ms2p = 0.0; + ms2m = 0.0; + ms2dp = 0.0; + ms2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Ykp2t = bessely(k + 2, t); + double Jkp2s = besselj(k + 2, s); + double Ykt = bessely(k, t); + + double Jdks = besseljd(k, s); + double Ydkp2t = besselyd(k + 2, t); + double Jdkp2s = besseljd(k + 2, s); + double Ydkt = besselyd(k, t); + + _Float128 tt = BB[k] * (Jks * Ykp2t - Jkp2s * Ykt); + _Float128 ttd = + BB[k] * (exppu * (Jks * Ydkp2t - Jkp2s * Ydkt) - expmu * (Jdks * Ykp2t - Jdkp2s * Ykt)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Ykpct = bessely(k + c + 2, t); + double Jkpcs = besselj(k + c + 2, s); + double Ykmct = bessely(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Ydkpct = besselyd(k + c + 2, t); + double Jdkpcs = besseljd(k + c + 2, s); + double Ydkmct = besselyd(k - c, t); + + _Float128 tt = BB[k] * (Jkmcs * Ykpct - Jkpcs * Ykmct); + _Float128 ttd = + BB[k] * (exppu * (Jkmcs * Ydkpct - Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct - Jdkpcs * Ykmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *ms2 = static_cast(ms2p + ms2m); + *ms2d = static_cast(ms2dp + ms2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 2) / 2; + if (sgn % 2 == 0) { + *ms2 = (*ms2) / BB[c]; + *ms2d = sqq * (*ms2d) / BB[c]; + } else { + *ms2 = -(*ms2) / BB[c]; + *ms2d = -sqq * (*ms2d) / BB[c]; + } + + free(BB); + + } else { + // Odd -- m = 1, 3, 5, 7 ... + + // Get coeff vector for even modms2 + double *BB = (double *)calloc(N, sizeof(double)); + if (BB == NULL) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return SF_ERROR_MEMORY; + } + + retcode = mathieu_coeffs_oo(N, q, m, BB); + if (retcode != SF_ERROR_OK) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + free(BB); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 ms2p, ms2m, ms2dp, ms2dm; + ms2p = 0.0; + ms2m = 0.0; + ms2dp = 0.0; + ms2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Ykt = bessely(k, t); + double Jkp1s = besselj(k + 1, s); + double Ykp1t = bessely(k + 1, t); + + double Jdks = besseljd(k, s); + double Ydkt = besselyd(k, t); + double Jdkp1s = besseljd(k + 1, s); + double Ydkp1t = besselyd(k + 1, t); + + _Float128 tt = BB[k] * (Jks * Ykp1t - Jkp1s * Ykt); + _Float128 ttd = + BB[k] * (exppu * (Jks * Ydkp1t - Jkp1s * Ydkt) - expmu * (Jdks * Ykp1t - Jdkp1s * Ykt)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c + 1, s); + double Ykpct = bessely(k + c + 1, t); + double Ykmct = bessely(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c + 1, s); + double Ydkpct = besselyd(k + c + 1, t); + double Ydkmct = besselyd(k - c, t); + + _Float128 tt = BB[k] * (Jkmcs * Ykpct - Jkpcs * Ykmct); + _Float128 ttd = + BB[k] * (exppu * (Jkmcs * Ydkpct - Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct - Jdkpcs * Ykmct)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *ms2 = static_cast(ms2p + ms2m); + *ms2d = static_cast(ms2dp + ms2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 1) / 2; + if (sgn % 2 == 0) { + *ms2 = (*ms2) / BB[c]; + *ms2d = sqq * (*ms2d) / BB[c]; + } else { + *ms2 = -(*ms2) / BB[c]; + *ms2d = -sqq * (*ms2d) / BB[c]; + } + + free(BB); + } + + return retcode; + } // int mathieu_modms2 } // namespace mathieu } // namespace xsf -#endif // #ifndef MATHIEU_FCNS_H - +#endif // #ifndef MATHIEU_FCNS_H diff --git a/include/xsf/mathieu/matrix_utils.h b/include/xsf/mathieu/matrix_utils.h index 5e16a489aa..8bada7bbda 100644 --- a/include/xsf/mathieu/matrix_utils.h +++ b/include/xsf/mathieu/matrix_utils.h @@ -1,9 +1,9 @@ #ifndef MATRIX_UTILS_H #define MATRIX_UTILS_H -#include -#include #include "matrix_utils.h" +#include +#include // These fcns are meant to make it easier to deal with // matrices in C. We use col major format since that's @@ -15,12 +15,12 @@ // Macros to extract matrix index and element. // Matrix is NxN, i = row idx, j = col idx. // MATRIX_IDX is where col major format is enforced. -#define MATRIX_IDX(N, I, J) (((N)*(I)) + (J)) -#define MATRIX_ELEMENT(A, m, n, i, j) A[ MATRIX_IDX(n, i, j) ] +#define MATRIX_IDX(N, I, J) (((N) * (I)) + (J)) +#define MATRIX_ELEMENT(A, m, n, i, j) A[MATRIX_IDX(n, i, j)] // Min and max macros for scalars. -#define MIN(a,b) (((a)<(b))?(a):(b)) -#define MAX(a,b) (((a)>(b))?(a):(b)) +#define MIN(a, b) (((a) < (b)) ? (a) : (b)) +#define MAX(a, b) (((a) > (b)) ? (a) : (b)) //=========================================================== // This file holds utility functions for dealing with vectors @@ -29,64 +29,60 @@ // in Matlab. // Note that C matrices are row-major. - namespace xsf { namespace mathieu { -//----------------------------------------------------- -void print_matrix(const double* A, int m, int n) { - // prints matrix as 2-dimensional tablei -- this is how we - // usually think of matrices. - int i, j; - for (i = 0; i < m; i++) { - for (j = 0; j < n; j++) { - printf("% 10.4e ", MATRIX_ELEMENT(A, m, n, i, j)); - } - printf("\n"); - } -} - + //----------------------------------------------------- + void print_matrix(const double *A, int m, int n) { + // prints matrix as 2-dimensional tablei -- this is how we + // usually think of matrices. + int i, j; + for (i = 0; i < m; i++) { + for (j = 0; j < n; j++) { + printf("% 10.4e ", MATRIX_ELEMENT(A, m, n, i, j)); + } + printf("\n"); + } + } -//----------------------------------------------------- -// Stuff to sort a vector. -// Function to swap two elements -void swap(double* a, double* b) { - double temp = *a; - *a = *b; - *b = temp; -} + //----------------------------------------------------- + // Stuff to sort a vector. + // Function to swap two elements + void swap(double *a, double *b) { + double temp = *a; + *a = *b; + *b = temp; + } -// Partition function for quicksort -int partition(double *arr, int low, int high) { - double pivot = arr[high]; // Choose last element as pivot - int i = (low - 1); // Index of smaller element - - for (int j = low; j <= high - 1; j++) { - // If current element is smaller than or equal to pivot - if (arr[j] <= pivot) { - i++; - swap(&arr[i], &arr[j]); + // Partition function for quicksort + int partition(double *arr, int low, int high) { + double pivot = arr[high]; // Choose last element as pivot + int i = (low - 1); // Index of smaller element + + for (int j = low; j <= high - 1; j++) { + // If current element is smaller than or equal to pivot + if (arr[j] <= pivot) { + i++; + swap(&arr[i], &arr[j]); + } } + swap(&arr[i + 1], &arr[high]); + return (i + 1); } - swap(&arr[i + 1], &arr[high]); - return (i + 1); -} -// Quicksort function -void quickSort(double *arr, int low, int high) { - if (low < high) { - // Partition the array and get pivot index - int pivotIndex = partition(arr, low, high); - - // Recursively sort elements before and after partition - quickSort(arr, low, pivotIndex - 1); - quickSort(arr, pivotIndex + 1, high); - } -} + // Quicksort function + void quickSort(double *arr, int low, int high) { + if (low < high) { + // Partition the array and get pivot index + int pivotIndex = partition(arr, low, high); + // Recursively sort elements before and after partition + quickSort(arr, low, pivotIndex - 1); + quickSort(arr, pivotIndex + 1, high); + } + } } // namespace mathieu } // namespace xsf - -#endif // #ifndef MATRIX_UTILS_H +#endif // #ifndef MATRIX_UTILS_H diff --git a/include/xsf/mathieu/main.c b/tests/scipy_special_tests/test_mathieu.cpp similarity index 99% rename from include/xsf/mathieu/main.c rename to tests/scipy_special_tests/test_mathieu.cpp index 73d2e06d39..881bf3f583 100644 --- a/include/xsf/mathieu/main.c +++ b/tests/scipy_special_tests/test_mathieu.cpp @@ -1,16 +1,13 @@ +#include "../testing_utils.h" + +#include + #include #include -#include "matrix_utils.h" -#include "make_matrix.h" -#include "mathieu_eigs.h" -#include "mathieu_coeffs.h" -#include "mathieu_fcns.h" -#include "besseljyd.h" - /* * - * The goal of main() is to just verify that my C/C++ + * The goal of these tests are to verify that my C/C++ * impl of the Mathieu fcns has been carried over from * my Matlab impl correctly. Therefore, main just calls * a bunch of golden value tests. The GVs were generated From cdf598b831a7c6d00268763365c7ffe1d71229fd Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Thu, 11 Sep 2025 07:51:12 -0400 Subject: [PATCH 07/12] Run clang-format on test_mathieu.cpp so it passes CI. --- tests/scipy_special_tests/test_mathieu.cpp | 2382 +++++++++----------- 1 file changed, 1079 insertions(+), 1303 deletions(-) diff --git a/tests/scipy_special_tests/test_mathieu.cpp b/tests/scipy_special_tests/test_mathieu.cpp index 881bf3f583..3c37f144e2 100644 --- a/tests/scipy_special_tests/test_mathieu.cpp +++ b/tests/scipy_special_tests/test_mathieu.cpp @@ -2,8 +2,8 @@ #include -#include #include +#include /* * @@ -15,1340 +15,1116 @@ * validation of the Matlab impl. Therefore, if the tests * here show the C impl matches the Matlab impl, then that * should serve as verification of the C impl's correctness. - * + * * A secondary goal is to show how to call the various fcns * in my API. * */ - namespace xsf { namespace mathieu { - -//------------------------------------------------------------- -extern "C" int main() { - int N = 6; - int pass=0; - int fail=0; - - //******************************************************* - // First print out the recursion matrices. These are - // private -- not public fcns. But I want to see they - // are correct. - //******************************************************* - { - double *A = (double *) calloc(N*N, sizeof(double)); - double q = 2.0d; + //------------------------------------------------------------- + extern "C" int main() { + int N = 6; + int pass = 0; + int fail = 0; - make_matrix_ee(N, q, A); - print_matrix(A, N, N); - printf("----------------------------------------------\n"); - - make_matrix_eo(N, q, A); - print_matrix(A, N, N); - printf("----------------------------------------------\n"); - - make_matrix_oe(N, q, A); - print_matrix(A, N, N); - printf("----------------------------------------------\n"); - - make_matrix_oo(N, q, A); - print_matrix(A, N, N); - printf("----------------------------------------------\n"); - - free(A); - } - - //******************************************************* - // Try computing the eigenvalues. These are public fcns. - //******************************************************* - ///* - printf("==============================================\n"); - printf("Test a eigenvalues\n"); - double a; - { - double q = 0.001; - double tol = 1e-13; - - // Golden values from Matlab. - double a_true[6] = { - -4.999999453125127e-07, - 1.000999874984374, - 4.000000416666611, - 9.000000062515628, - 16.000000033333333, - 25.000000020833337 - }; - printf("q = %f\n", q); - for (int m = 0; m Date: Fri, 26 Sep 2025 19:43:05 -0400 Subject: [PATCH 08/12] Replaced malloc/free with std::vector, updated some comments, added functions to replace duplicated code. --- include/xsf/mathieu/besseljyd.h | 117 +- include/xsf/mathieu/make_matrix.h | 348 +-- include/xsf/mathieu/mathieu.h | 375 ++-- include/xsf/mathieu/mathieu_coeffs.h | 480 ++-- include/xsf/mathieu/mathieu_eigs.h | 417 ++-- include/xsf/mathieu/mathieu_fcns.h | 3022 ++++++++++++-------------- include/xsf/mathieu/matrix_utils.h | 106 +- 7 files changed, 2351 insertions(+), 2514 deletions(-) diff --git a/include/xsf/mathieu/besseljyd.h b/include/xsf/mathieu/besseljyd.h index fad2576549..1c3d46cef5 100644 --- a/include/xsf/mathieu/besseljyd.h +++ b/include/xsf/mathieu/besseljyd.h @@ -1,8 +1,9 @@ #ifndef BESSELJYD_H #define BESSELJYD_H -#include "../bessel.h" #include "../config.h" +#include "../bessel.h" + /* * @@ -11,74 +12,76 @@ * to the Bessel J and Y functions and also returns derivatives * of those fcns. * + * Stuart Brorson -- Summer and Fall 2025. + * */ namespace xsf { namespace mathieu { - //================================================================== - double besselj(int k, double z) { - // This is just a thin wrapper around the Bessel impl in the - // std library. - double v = (double)k; - return xsf::cyl_bessel_j(v, z); - } - - //================================================================== - double bessely(int k, double z) { - // This is just a thin wrapper around the Bessel impl in the - // std library. - double v = (double)k; - return xsf::cyl_bessel_y(v, z); - } - - //================================================================== - double besseljd(int k, double z) { - // This returns the derivative of besselj. The deriv is - // computed using common identities. - double y; + //================================================================== + double besselj(int k, double z) { + // This is just a thin wrapper around the Bessel impl in the + // xsf library. + double v = (double) k; + return xsf::cyl_bessel_j(v, z); + } - if (k == 0) { - double v = 1.0; - y = -besselj(v, z); - } else { - double kp1 = (double)(k + 1); - double km1 = (double)(k - 1); - y = (besselj(km1, z) - besselj(kp1, z)) / 2.0; - } + //================================================================== + double bessely(int k, double z) { + // This is just a thin wrapper around the Bessel impl in the + // xsf library. + double v = (double) k; + return xsf::cyl_bessel_y(v, z); + } - // Must flip sign for negative k and odd k. - if (k < 0 && ((k % 2) != 0)) { - y = -y; - } - - return y; + //================================================================== + double besseljd(int k, double z) { + // This returns the derivative of besselj. The deriv is + // computed using common identities. + double y; + + if (k == 0) { + double v = 1.0; + y = -besselj(v,z); + } else { + double kp1 = (double) (k+1); + double km1 = (double) (k-1); + y = (besselj(km1,z)-besselj(kp1,z))/2.0; } - //================================================================== - double besselyd(int k, double z) { - // This returns the derivative of besselj. The deriv is - // computed using common identities. - double y; - - if (k == 0) { - double v = 1.0; - y = -bessely(v, z); - } else { - double kp1 = (double)(k + 1); - double km1 = (double)(k - 1); - y = (bessely(km1, z) - bessely(kp1, z)) / 2.0; - } + // Must flip sign for negative k and odd k. + if (k<0 && ((k % 2) != 0)) { + y = -y; + } - // Must flip sign for negative k and odd k. - if (k < 0 && ((k % 2) != 0)) { - y = -y; - } + return y; + } - return y; + //================================================================== + double besselyd(int k, double z) { + // This returns the derivative of besselj. The deriv is + // computed using common identities. + double y; + + if (k == 0) { + double v = 1.0; + y = -bessely(v,z); + } else { + double kp1 = (double) (k+1); + double km1 = (double) (k-1); + y = (bessely(km1,z)-bessely(kp1,z))/2.0; } -} // namespace mathieu + // Must flip sign for negative k and odd k. + if (k<0 && ((k % 2) != 0)) { + y = -y; + } + + return y; + } + } // namespace xsf +} // namespace mathieu -#endif // #ifndef BESSELJYD_H +#endif // #ifndef BESSELJYD_H diff --git a/include/xsf/mathieu/make_matrix.h b/include/xsf/mathieu/make_matrix.h index cad7190712..a327b4c227 100644 --- a/include/xsf/mathieu/make_matrix.h +++ b/include/xsf/mathieu/make_matrix.h @@ -12,7 +12,7 @@ * which make the recursion matrices. * * Stuart Brorson, Summer 2025. - * + * */ #define SQRT2 1.414213562373095 @@ -20,179 +20,193 @@ namespace xsf { namespace mathieu { - /*----------------------------------------------- - This creates the recurrence relation matrix for - the even-even Mathieu fcns (ce_2n). - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - Output: - A = recurrence matrix (must be calloc'ed in caller). - Return: - return code = 0 if OK. - -------------------------------------------------*/ - int make_matrix_ee(int N, double q, double *A) { - int j; - int i; - - // Symmetrize matrix here, then fix in caller. - i = MATRIX_IDX(N, 0, 1); - A[i] = SQRT2 * q; - i = MATRIX_IDX(N, 1, 0); - A[i] = SQRT2 * q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 4.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j = 2; j <= N - 2; j++) { - i = MATRIX_IDX(N, j, j - 1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0 * j) * (2.0 * j); - i = MATRIX_IDX(N, j, j + 1); - A[i] = q; - } - - i = MATRIX_IDX(N, N - 1, N - 2); - A[i] = q; - i = MATRIX_IDX(N, N - 1, N - 1); - A[i] = (2.0 * (N - 1)) * (2.0 * (N - 1)); - - return 0; + /*----------------------------------------------- + This creates the recurrence relation matrix for + the even-even Mathieu fcns (ce_2n). + + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + + Output: + A = recurrence matrix (must be calloc'ed in caller). + + Return: + return code = SF_ERROR_OK if OK. + -------------------------------------------------*/ + int make_matrix_ee(int N, double q, double *A) { + int j; + int i; + + // Symmetrize matrix here, then fix in caller. + i = MATRIX_IDX(N, 0, 1); + A[i] = SQRT2*q; + i = MATRIX_IDX(N, 1, 0); + A[i] = SQRT2*q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 4.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j=2; j<=N-2; j++) { + i = MATRIX_IDX(N, j, j-1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0*j)*(2.0*j); + i = MATRIX_IDX(N, j, j+1); + A[i] = q; } - /*----------------------------------------------- - This creates the recurrence relation matrix for - the even-odd Mathieu fcns (ce_2n+1). - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - Output: - A = recurrence matrix (calloc in caller). - Return: - return code = 0 if OK. - -------------------------------------------------*/ - int make_matrix_eo(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 1.0 + q; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 9.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j = 2; j <= N - 2; j++) { - i = MATRIX_IDX(N, j, j - 1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0 * j + 1.0) * (2.0 * j + 1.0); - i = MATRIX_IDX(N, j, j + 1); - A[i] = q; - } - - i = MATRIX_IDX(N, N - 1, N - 2); - A[i] = q; - i = MATRIX_IDX(N, N - 1, N - 1); - A[i] = (2.0 * (N - 1) + 1.0) * (2.0 * (N - 1) + 1.0); - - return 0; + i = MATRIX_IDX(N, N-1, N-2); + A[i] = q; + i = MATRIX_IDX(N, N-1, N-1); + A[i] = (2.0*(N-1))*(2.0*(N-1)); + + return SF_ERROR_OK; + } + + /*----------------------------------------------- + This creates the recurrence relation matrix for the + even-odd Mathieu fcns (ce_2n+1). + + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + + Output: + A = recurrence matrix (calloc in caller). + + Return: + return code = SF_ERROR_OK if OK. + -------------------------------------------------*/ + int make_matrix_eo(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 1.0+q; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 9.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j=2; j<=N-2; j++) { + i = MATRIX_IDX(N, j, j-1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0*j+1.0)*(2.0*j+1.0); + i = MATRIX_IDX(N, j, j+1); + A[i] = q; } - /*----------------------------------------------- - This creates the recurrence relation matrix for - the odd-even Mathieu fcns (se_2n) -- sometimes called - se_2n+2. - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - Output: - A = recurrence matrix (calloc in caller). - Return: - return code = 0 if OK. - -------------------------------------------------*/ - int make_matrix_oe(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 4.0; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 16.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j = 2; j <= N - 2; j++) { - i = MATRIX_IDX(N, j, j - 1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0 * (j + 1)) * (2.0 * (j + 1)); - i = MATRIX_IDX(N, j, j + 1); - A[i] = q; - } - - i = MATRIX_IDX(N, N - 1, N - 2); - A[i] = q; - i = MATRIX_IDX(N, N - 1, N - 1); - A[i] = (2.0 * N) * (2.0 * N); - - return 0; + i = MATRIX_IDX(N, N-1, N-2); + A[i] = q; + i = MATRIX_IDX(N, N-1, N-1); + A[i] = (2.0*(N-1)+1.0)*(2.0*(N-1)+1.0); + + return SF_ERROR_OK; + } + + /*----------------------------------------------- + This creates the recurrence relation matrix for + the odd-even Mathieu fcns (se_2n) -- sometimes called + se_2n+2. + + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + + Output: + A = recurrence matrix (calloc in caller). + + Return: + return code = SF_ERROR_OK if OK. + -------------------------------------------------*/ + int make_matrix_oe(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 4.0; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 16.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j=2; j<=N-2; j++) { + i = MATRIX_IDX(N, j, j-1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0*(j+1))*(2.0*(j+1)); + i = MATRIX_IDX(N, j, j+1); + A[i] = q; } - /*----------------------------------------------- - This creates the recurrence relation matrix for - the odd-odd Mathieu fcns (se_2n+1). - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - Output: - A = recurrence matrix (calloc in caller). - Return: - return code = 0 if OK. - -------------------------------------------------*/ - int make_matrix_oo(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 1.0 - q; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 9.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j = 2; j <= N - 2; j++) { - i = MATRIX_IDX(N, j, j - 1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0 * j + 1.0) * (2.0 * j + 1.0); - i = MATRIX_IDX(N, j, j + 1); - A[i] = q; - } - - i = MATRIX_IDX(N, N - 1, N - 2); - A[i] = q; - i = MATRIX_IDX(N, N - 1, N - 1); - A[i] = (2.0 * N - 1.0) * (2.0 * N - 1.0); - - return 0; + i = MATRIX_IDX(N, N-1, N-2); + A[i] = q; + i = MATRIX_IDX(N, N-1, N-1); + A[i] = (2.0*N)*(2.0*N); + + return SF_ERROR_OK; + } + + + /*----------------------------------------------- + This creates the recurrence relation matrix for + the odd-odd Mathieu fcns (se_2n+1). + + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + + Output: + A = recurrence matrix (calloc in caller). + + Return: + return code = SF_ERROR_OK if OK. + -------------------------------------------------*/ + int make_matrix_oo(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 1.0 - q; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 9.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j=2; j<=N-2; j++) { + i = MATRIX_IDX(N, j, j-1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0*j+1.0)*(2.0*j+1.0); + i = MATRIX_IDX(N, j, j+1); + A[i] = q; } + i = MATRIX_IDX(N, N-1, N-2); + A[i] = q; + i = MATRIX_IDX(N, N-1, N-1); + A[i] = (2.0*N-1.0)*(2.0*N-1.0); + + return SF_ERROR_OK; + } + + } // namespace mathieu } // namespace xsf - -#endif // #ifndef MAKE_MATRIX_H + +#endif // #ifndef MAKE_MATRIX_H diff --git a/include/xsf/mathieu/mathieu.h b/include/xsf/mathieu/mathieu.h index c5ce88155d..b119feca86 100644 --- a/include/xsf/mathieu/mathieu.h +++ b/include/xsf/mathieu/mathieu.h @@ -1,12 +1,12 @@ #pragma once #include "error.h" -#include "mathieu/besseljyd.h" +#include "mathieu/matrix_utils.h" #include "mathieu/make_matrix.h" #include "mathieu/mathieu_coeffs.h" #include "mathieu/mathieu_eigs.h" +#include "mathieu/besseljyd.h" #include "mathieu/mathieu_fcns.h" -#include "mathieu/matrix_utils.h" /* * @@ -17,7 +17,7 @@ * reimplementation. * * Stuart Brorson, Summer 2025. - * + * */ namespace xsf { @@ -35,31 +35,31 @@ namespace xsf { */ template T cem_cva(T m, T q) { - // This returns the even Mathieu characteristic value (eigenvalue) a. - - // Check for invalid Mathieu order. - if ((m < 0) || (m != floor(m))) { - set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double da; - - int retcode = xsf::mathieu::mathieu_a(im, dq, &da); - if (retcode != SF_ERROR_OK) { - set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Now cast back. - T a = static_cast(da); - return a; + // This returns the even Mathieu characteristic value (eigenvalue) a. + + // Check for invalid Mathieu order. + if ((m < 0) || (m != floor(m))) { + set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double da; + + int retcode = xsf::mathieu::mathieu_a(im, dq, &da); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T a = static_cast(da); + return a; } -//------------------------------------------------------------- +//------------------------------------------------------------- template /** * Mathieu characteristic values (eigenvalues) b for odd functions. @@ -72,30 +72,31 @@ template * @return Mathieu eigenvalue b. */ T sem_cva(T m, T q) { - // This returns the odd Mathieu characteristic value (eigenvalue) b. - - // Check for invalid Mathieu order. - if ((m < 1) || (m != floor(m))) { - set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double db; - - int retcode = xsf::mathieu::mathieu_b(im, dq, &db); - if (retcode != SF_ERROR_OK) { - set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Now cast back. - T b = static_cast(db); - return b; + // This returns the odd Mathieu characteristic value (eigenvalue) b. + + // Check for invalid Mathieu order. + if ((m < 1) || (m != floor(m))) { + set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double db; + + int retcode = xsf::mathieu::mathieu_b(im, dq, &db); + if (retcode != SF_ERROR_OK) { + set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); + return std::numeric_limits::quiet_NaN(); + } + + // Now cast back. + T b = static_cast(db); + return b; } + //--------------------------------------------------------------- /* Mathieu functions */ /** @@ -113,33 +114,34 @@ T sem_cva(T m, T q) { template void cem(T m, T q, T x, T &csf, T &csd) { - if ((m < 0) || (m != floor(m))) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); + if ((m < 0) || (m != floor(m))) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dcsf; + double dcsd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); + if (retcode != SF_ERROR_OK) { + csf = std::numeric_limits::quiet_NaN(); + csd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_ce", (sf_error_t) retcode, NULL); } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double dcsf; - double dcsd; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); - if (retcode != SF_ERROR_OK) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_ce", (sf_error_t)retcode, NULL); - } else { - csf = static_cast(dcsf); - csd = static_cast(dcsd); - } + csf = static_cast(dcsf); + csd = static_cast(dcsd); } + } } + -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity Mathieu angular function se(m, q, x) * @@ -155,33 +157,33 @@ void cem(T m, T q, T x, T &csf, T &csd) { template void sem(T m, T q, T x, T &ssf, T &ssd) { - if ((m < 1) || (m != floor(m))) { - ssf = std::numeric_limits::quiet_NaN(); - ssd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); + if ((m < 1) || (m != floor(m))) { + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double dssf; + double dssd; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); + if (retcode != SF_ERROR_OK) { + ssf = std::numeric_limits::quiet_NaN(); + ssd = std::numeric_limits::quiet_NaN(); + set_error("mathieu_sem", (sf_error_t) retcode, NULL); } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double dssf; - double dssd; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); - if (retcode != SF_ERROR_OK) { - ssf = std::numeric_limits::quiet_NaN(); - ssd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", (sf_error_t)retcode, NULL); - } else { - ssf = static_cast(dssf); - ssd = static_cast(dssd); - } + ssf = static_cast(dssf); + ssd = static_cast(dssd); } + } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Even parity modified (radial) Mathieu function of first kind Mc1(m, q, x) * @@ -197,33 +199,33 @@ void sem(T m, T q, T x, T &ssf, T &ssd) { template void mcm1(T m, T q, T x, T &f1r, T &d1r) { - if ((m < 0) || (m != floor(m))) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); + if ((m < 0) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm1", (sf_error_t) retcode, NULL); } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df1r; - double dd1r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); - if (retcode != SF_ERROR_OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm1", (sf_error_t)retcode, NULL); - } else { - f1r = static_cast(df1r); - d1r = static_cast(dd1r); - } + f1r = static_cast(df1r); + d1r = static_cast(dd1r); } + } } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity modified (radial) Mathieu function of first kind Ms1(m, q, x) * @@ -239,33 +241,34 @@ void mcm1(T m, T q, T x, T &f1r, T &d1r) { template void msm1(T m, T q, T x, T &f1r, T &d1r) { - if ((m < 1) || (m != floor(m))) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); + if ((m < 1) || (m != floor(m))) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df1r; + double dd1r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); + if (retcode != SF_ERROR_OK) { + f1r = std::numeric_limits::quiet_NaN(); + d1r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm1", (sf_error_t) retcode, NULL); } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df1r; - double dd1r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); - if (retcode != SF_ERROR_OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm1", (sf_error_t)retcode, NULL); - } else { - f1r = static_cast(df1r); - d1r = static_cast(dd1r); - } + f1r = static_cast(df1r); + d1r = static_cast(dd1r); } + } + } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Even parity modified (radial) Mathieu function of second kind Mc2(m, q, x) * @@ -281,33 +284,34 @@ void msm1(T m, T q, T x, T &f1r, T &d1r) { template void mcm2(T m, T q, T x, T &f2r, T &d2r) { - if ((m < 0) || (m != floor(m))) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); + if ((m < 0) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_mcm2", (sf_error_t) retcode, NULL); } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df2r; - double dd2r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); - if (retcode != SF_ERROR_OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm2", (sf_error_t)retcode, NULL); - } else { - f2r = static_cast(df2r); - d2r = static_cast(dd2r); - } + f2r = static_cast(df2r); + d2r = static_cast(dd2r); } + } + } -//--------------------------------------------------------------- +//--------------------------------------------------------------- /** * Odd parity modified (radial) Mathieu function of second kind Ms2(m, q, x) * @@ -323,30 +327,31 @@ void mcm2(T m, T q, T x, T &f2r, T &d2r) { template void msm2(T m, T q, T x, T &f2r, T &d2r) { - if ((m < 1) || (m != floor(m))) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); + if ((m < 1) || (m != floor(m))) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); + } else { + + // Must cast to correct types prior to fcn call. + int im = static_cast(m); + double dq = static_cast(q); + double dx = static_cast(x); + double df2r; + double dd2r; + + // Call fcn and cast back. + int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); + if (retcode != SF_ERROR_OK) { + f2r = std::numeric_limits::quiet_NaN(); + d2r = std::numeric_limits::quiet_NaN(); + set_error("mathieu_msm2", (sf_error_t) retcode, NULL); } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df2r; - double dd2r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); - if (retcode != SF_ERROR_OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm2", (sf_error_t)retcode, NULL); - } else { - f2r = static_cast(df2r); - d2r = static_cast(dd2r); - } + f2r = static_cast(df2r); + d2r = static_cast(dd2r); } + } } + } // namespace xsf diff --git a/include/xsf/mathieu/mathieu_coeffs.h b/include/xsf/mathieu/mathieu_coeffs.h index ee8cf9f36f..3b04a74f97 100644 --- a/include/xsf/mathieu/mathieu_coeffs.h +++ b/include/xsf/mathieu/mathieu_coeffs.h @@ -1,6 +1,7 @@ #ifndef MATHIEU_COEFFS_H #define MATHIEU_COEFFS_H +#include #include "../config.h" #include "../error.h" #include "make_matrix.h" @@ -16,280 +17,253 @@ * series computing the Mathieu fcns. * * Stuart Brorson, Summer 2025. - * + * */ + /* DSYEV_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyev_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); +void dsyev_( char* jobz, char* uplo, int* n, double* a, int* lda, + double* w, double* work, int* lwork, int* info ); #ifdef __cplusplus } #endif + namespace xsf { namespace mathieu { - //------------------------------------------------------ - int mathieu_coeffs_ee(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order ce_2n Mathieu fcn. - // Allowed value of m = 0, 2, 4, 6, ... - // Inputs: - // N = size of recursion matrix to use. - // q = frequency parameter - // m = order of Mathieu fcn desired. - // Output: - // AA = length N vector preallocated to hold coeffs. - // Returns 0 if all goes well. Must put check on calloc - // here. - - int retcode = 0; - - // Bail out if m is not even. - if (m % 2 != 0) - return -1; - - // Allocate recursion matrix - double *A = (double *)calloc(N * N, sizeof(double)); - if (A == NULL) - return SF_ERROR_MEMORY; - - // Do EVD - retcode = make_matrix_ee(N, q, A); - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - { - // Work in local scope. - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - double *work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_(V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode); - lwork = (int)wkopt; - work = (double *)malloc(lwork * sizeof(double)); - /* Solve eigenproblem */ - dsyev_(V, U, &N, A, &N, AA, work, &lwork, &retcode); - free(work); - } - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - // print_matrix(AA, N, 1); - - // Undo sqrt(2) in make_matrix by normalizing elet in first col by sqrt(2). - int idx; - int row = m / 2; - idx = MATRIX_IDX(N, row, 0); - AA[0] = A[idx] / SQRT2; - // Transfer remaining elets in correct row to coeff vector. - for (int j = 1; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - free(A); - return retcode; + //------------------------------------------------------ + int mathieu_coeffs_ee(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order ce_2n Mathieu fcn. + // Allowed value of m = 0, 2, 4, 6, ... + // Inputs: + // N = size of recursion matrix to use. + // q = frequency parameter + // m = order of Mathieu fcn desired. + // Output: + // AA = length N vector preallocated to hold coeffs. + // Returns SF_ERROR_OK if all goes well. + + int retcode = SF_ERROR_OK; + + // Bail out if m is not even. + if (m % 2 != 0) return SF_ERROR_ARG; + + // Allocate recursion matrix + std::vector A(N*N); + + // Do EVD + retcode = make_matrix_ee(N,q,A.data()); + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_( V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode ); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_( V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode ); + + // Check return code from dsyev and bail if it's not 0. + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + //print_matrix(AA, N, 1); + + // Undo sqrt(2) in make_matrix by normalizing elet in first col by sqrt(2). + int idx; + int row = m/2; + idx = MATRIX_IDX(N, row, 0); + AA[0] = A[idx]/SQRT2; + // Transfer remaining elets in correct row to coeff vector. + for (int j = 1; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + return retcode; + } + + + //------------------------------------------------------ + int mathieu_coeffs_eo(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order ce_2n+1 Mathieu fcn. + // Allowed value of m = 1, 3, 5, 7 ... + + int retcode = SF_ERROR_OK; + + // Bail out if m is not odd. + if (m % 2 != 1) return SF_ERROR_ARG; + + // Allocate recursion matrix + std::vector A(N*N); + + // Do EVD + retcode = make_matrix_eo(N,q,A.data()); + if (retcode != 0) { + return SF_ERROR_NO_RESULT; } - //------------------------------------------------------ - int mathieu_coeffs_eo(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order ce_2n+1 Mathieu fcn. - // Allowed value of m = 1, 3, 5, 7 ... - - int retcode = 0; - - // Bail out if m is not odd. - if (m % 2 != 1) - return -1; - - // Allocate recursion matrix - double *A = (double *)calloc(N * N, sizeof(double)); - if (A == NULL) - return SF_ERROR_MEMORY; - - // Do EVD - retcode = make_matrix_eo(N, q, A); - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - { - // Work in local scope. - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - double *work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_(V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode); - lwork = (int)wkopt; - work = (double *)malloc(lwork * sizeof(double)); - /* Solve eigenproblem */ - dsyev_(V, U, &N, A, &N, AA, work, &lwork, &retcode); - free(work); - } - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - // print_matrix(AA, N, 1); - - // Transfer correct row to coeff vector. - int idx; - int row = (m - 1) / 2; - // Transfer elets in correct row to coeff vector. - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - free(A); - return retcode; + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_( V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode ); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_( V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode ); + + // Check return code from dsyev and bail if it's not 0. + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + //print_matrix(AA, N, 1); + + // Transfer correct row to coeff vector. + int idx; + int row = (m-1)/2; + // Transfer elets in correct row to coeff vector. + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + return retcode; + } + + + //------------------------------------------------------ + int mathieu_coeffs_oe(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order se_2n Mathieu fcn. + // Allowed value of m = 2, 4, 6, ... + // Inputs: + // N = size of recursion matrix to use. + // q = frequency parameter + // m = order of Mathieu fcn desired. + // Output: + // AA = length N vector preallocated to hold coeffs. + // Returns 0 if all goes well. Must put check on calloc + // here. + + int retcode = SF_ERROR_OK; + + // Bail out if m is not even or >= 2. + if ((m % 2 != 0) || (m < 2)) return SF_ERROR_ARG; + + // Allocate recursion matrix + std::vector A(N*N); + + // Do EVD + retcode = make_matrix_oe(N,q,A.data()); + if (retcode != 0) { + return SF_ERROR_NO_RESULT; } - //------------------------------------------------------ - int mathieu_coeffs_oe(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order se_2n Mathieu fcn. - // Allowed value of m = 2, 4, 6, ... - // Inputs: - // N = size of recursion matrix to use. - // q = frequency parameter - // m = order of Mathieu fcn desired. - // Output: - // AA = length N vector preallocated to hold coeffs. - // Returns 0 if all goes well. Must put check on calloc - // here. - - int retcode = 0; - - // Bail out if m is not even or >= 2. - if ((m % 2 != 0) || (m < 2)) - return -1; - - // Allocate recursion matrix - double *A = (double *)calloc(N * N, sizeof(double)); - if (A == NULL) - return SF_ERROR_MEMORY; - - // Do EVD - retcode = make_matrix_oe(N, q, A); - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - { - // Work in local scope. - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - double *work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_(V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode); - lwork = (int)wkopt; - work = (double *)malloc(lwork * sizeof(double)); - /* Solve eigenproblem */ - dsyev_(V, U, &N, A, &N, AA, work, &lwork, &retcode); - free(work); - } - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - // print_matrix(AA, N, 1); - - // Transfer remaining elets in correct row to coeff vector. - int idx; - int row = (m - 2) / 2; - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - free(A); - return retcode; + // Work in local scope. + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_( V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode ); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_( V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode ); + + // Bail out if dsyev doesn't return 0. + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + //print_matrix(AA, N, 1); + + // Transfer remaining elets in correct row to coeff vector. + int idx; + int row = (m-2)/2; + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; } + return retcode; + } + + + //------------------------------------------------------ + int mathieu_coeffs_oo(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order se_2n+1 Mathieu fcn. + // Allowed value of m = 1, 3, 5, 7 ... + + int retcode = SF_ERROR_OK; - //------------------------------------------------------ - int mathieu_coeffs_oo(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order se_2n+1 Mathieu fcn. - // Allowed value of m = 1, 3, 5, 7 ... - - int retcode = 0; - - // Bail out if m is not odd. - if (m % 2 != 1) - return -1; - - // Allocate recursion matrix - double *A = (double *)calloc(N * N, sizeof(double)); - if (A == NULL) - return SF_ERROR_MEMORY; - - // Do EVD - retcode = make_matrix_oo(N, q, A); - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - { - // Work in local scope - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - double *work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_(V, U, &N, A, &N, AA, &wkopt, &lwork, &retcode); - lwork = (int)wkopt; - work = (double *)malloc(lwork * sizeof(double)); - /* Solve eigenproblem */ - dsyev_(V, U, &N, A, &N, AA, work, &lwork, &retcode); - free(work); - } - if (retcode != 0) { - free(A); - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - // print_matrix(AA, N, 1); - - // Transfer correct row to coeff vector. - int idx; - int row = (m - 1) / 2; - // Transfer elets in correct row to coeff vector. - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - free(A); - return retcode; + // Bail out if m is not odd. + if (m % 2 != 1) return SF_ERROR_ARG; + + // Allocate recursion matrix + std::vector A(N*N); + + // Do EVD + retcode = make_matrix_oo(N,q,A.data()); + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Work in local scope + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_( V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode ); + lwork = (int)wkopt; + std::vector work(lwork); + /* Solve eigenproblem */ + dsyev_( V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode ); + + // Bail out if dsyev didn't return 0; + if (retcode != 0) { + return SF_ERROR_NO_RESULT; } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + //print_matrix(AA, N, 1); + + // Transfer correct row to coeff vector. + int idx; + int row = (m-1)/2; + // Transfer elets in correct row to coeff vector. + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + return retcode; + } + } // namespace mathieu } // namespace xsf -#endif // #ifndef MATHIEU_COEFFS_H +#endif // #ifndef MATHIEU_COEFFS_H diff --git a/include/xsf/mathieu/mathieu_eigs.h b/include/xsf/mathieu/mathieu_eigs.h index 34af13cf15..3b5693968f 100644 --- a/include/xsf/mathieu/mathieu_eigs.h +++ b/include/xsf/mathieu/mathieu_eigs.h @@ -1,11 +1,13 @@ #ifndef MATHIEU_EIGS_H #define MATHIEU_EIGS_H +#include #include "../config.h" #include "../error.h" #include "make_matrix.h" #include "matrix_utils.h" + /* * * This is part of the Mathieu function suite -- a reimplementation @@ -14,252 +16,215 @@ * b as a function of parameter q. * * Stuart Brorson, summer 2025. - * + * */ + /* DSYEV_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyev_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); +void dsyev_( char* jobz, char* uplo, int* n, double* a, int* lda, + double* w, double* work, int* lwork, int* info ); #ifdef __cplusplus } #endif + namespace xsf { namespace mathieu { - //------------------------------------------------------ - int mathieu_a(int m, double q, double *a) { - // printf("--> mathieu_a, m = %d, q = %e\n", m, q); - - int N = m + 25; // Sets size of recursion matrix - int retcode = SF_ERROR_OK; - - if (m > 500) { - // Don't support absurdly larger orders for now. - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - // Allocate recursion matrix - double *A = (double *)calloc(N * N, sizeof(double)); - if (A == NULL) { - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - // Allocate vector for eigenvalues - double *ww = (double *)calloc(N, sizeof(double)); - if (ww == NULL) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - return SF_ERROR_MEMORY; - } - - // Do EVD - if (m % 2 == 0) { - // Even order m - retcode = make_matrix_ee(N, q, A); - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - free(ww); - return retcode; - } - { - char V = 'V'; - char U = 'U'; - double wkopt; - double *work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_(&V, &U, &N, A, &N, ww, &wkopt, &lwork, &retcode); - lwork = (int)wkopt; - work = (double *)malloc(lwork * sizeof(double)); - /* Solve eigenproblem */ - dsyev_(&V, &U, &N, A, &N, ww, work, &lwork, &retcode); - free(work); - } - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - free(ww); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - quickSort(ww, 0, N - 1); - // print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = m / 2; - *a = ww[idx]; - - } else { - // Odd order m - retcode = make_matrix_eo(N, q, A); - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - free(ww); - return retcode; - } - { - char V = 'V'; - char U = 'U'; - double wkopt; - double *work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_(&V, &U, &N, A, &N, ww, &wkopt, &lwork, &retcode); - lwork = (int)wkopt; - work = (double *)malloc(lwork * sizeof(double)); - /* Solve eigenproblem */ - dsyev_(&V, &U, &N, A, &N, ww, work, &lwork, &retcode); - free(work); - } - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - free(A); - free(ww); - return SF_ERROR_NO_RESULT; - } + //------------------------------------------------------ + // This is the Mathieu characteristic value (eigenvalue) + // a for even fcns. + int mathieu_a(int m, double q, double *a) { + // printf("--> mathieu_a, m = %d, q = %e\n", m, q); - // Sort ww vector from lowest to highest - quickSort(ww, 0, N - 1); - // print_matrix(ww, N, 1); + int N = m+25; // Sets size of recursion matrix + int retcode = SF_ERROR_OK; - // Now figure out which one to return. - int idx = (m - 1) / 2; - *a = ww[idx]; - } - - free(A); - free(ww); - // printf("<-- mathieu_a\n"); - return retcode; + if (m>500) { + // Don't support absurdly larger orders for now. + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + // Allocate recursion matrix + std::vector A(N*N); + + // Allocate vector for eigenvalues + std::vector ww(N); + + // Do EVD + if (m % 2 == 0) { + // Even order m + retcode = make_matrix_ee(N,q,A.data()); + if (retcode != SF_ERROR_OK){ + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_OTHER; // Not sure what went wrong. + } + + char V = 'V'; + char U = 'U'; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_( &V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode ); + lwork = (int) wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_( &V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode ); + + // Check if dsyev was successful + if (retcode != 0) { + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + //quickSort(ww, 0, N-1); + //print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = m/2; + *a = ww[idx]; + + } else { + // Odd order m + retcode = make_matrix_eo(N,q,A.data()); + if (retcode != SF_ERROR_OK) { + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_OTHER; + } + + char V = 'V'; + char U = 'U'; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_( &V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode ); + lwork = (int) wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_( &V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode ); + + // Check if dsyev was successful + if (retcode != 0) { + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + //quickSort(ww, 0, N-1); + //print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m-1)/2; + *a = ww[idx]; } - //------------------------------------------------------ - int mathieu_b(int m, double q, double *b) { - // printf("--> mathieu_b, m = %d, q = %e\n", m, q); - int N = m + 25; // Sets size of recursion matrix - int retcode = SF_ERROR_OK; - - if (m > 500) { - // Don't support absurdly larger orders for now. - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - // Allocate recursion matrix - double *B = (double *)calloc(N * N, sizeof(double)); - if (B == NULL) { - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - // Allocate vector for eigenvalues - double *ww = (double *)calloc(N, sizeof(double)); - if (ww == NULL) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - return SF_ERROR_MEMORY; - } - - // Do EVD - if (m % 2 == 0) { - // Even order m - retcode = make_matrix_oe(N, q, B); - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - free(ww); - return retcode; - } - { - char V = 'V'; - char U = 'U'; - double wkopt; - double *work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_(&V, &U, &N, B, &N, ww, &wkopt, &lwork, &retcode); - lwork = (int)wkopt; - work = (double *)malloc(lwork * sizeof(double)); - /* Solve eigenproblem */ - dsyev_(&V, &U, &N, B, &N, ww, work, &lwork, &retcode); - free(work); - } - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - free(ww); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - quickSort(ww, 0, N - 1); - // print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = (m - 2) / 2; - *b = ww[idx]; - - } else { - // Odd order m - retcode = make_matrix_oo(N, q, B); - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - free(ww); - return retcode; - } - { - char V = 'V'; - char U = 'U'; - double wkopt; - double *work; - /* Query and allocate the optimal workspace */ - // I do this work in an inner scope to make it easy - // to clean up afterwards. - int lwork = -1; - dsyev_(&V, &U, &N, B, &N, ww, &wkopt, &lwork, &retcode); - lwork = (int)wkopt; - work = (double *)malloc(lwork * sizeof(double)); - /* Solve eigenproblem */ - dsyev_(&V, &U, &N, B, &N, ww, work, &lwork, &retcode); - free(work); - } - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - free(B); - free(ww); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - quickSort(ww, 0, N - 1); - // print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = (m - 1) / 2; - *b = ww[idx]; - } + // printf("<-- mathieu_a\n"); + return retcode; + } + + //------------------------------------------------------ + int mathieu_b(int m, double q, double *b) { + // This computes the Mathieu characteristic value (eigenvalue) + // for odd fcns. + // printf("--> mathieu_b, m = %d, q = %e\n", m, q); + int N = m+25; // Sets size of recursion matrix + int retcode = SF_ERROR_OK; + + if (m>500) { + // Don't support absurdly larger orders for now. + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } - free(B); - free(ww); - // printf("<-- mathieu_b\n"); - return retcode; + // Allocate recursion matrix + std::vector B(N*N); + + // Allocate vector for eigenvalues + std::vector ww(N); + + // Do EVD + if (m % 2 == 0) { + // Even order m + retcode = make_matrix_oe(N,q,B.data()); + if (retcode != SF_ERROR_OK) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_OTHER; + } + + char V = 'V'; + char U = 'U'; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_( &V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode ); + lwork = (int) wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_( &V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode ); + + if (retcode != 0) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + // quickSort(ww, 0, N-1); + //print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m-2)/2; + *b = ww[idx]; + + } else { + // Odd order m + retcode = make_matrix_oo(N,q,B.data()); + if (retcode != SF_ERROR_OK) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_OTHER; + } + + char V = 'V'; + char U = 'U'; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_( &V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode ); + lwork = (int) wkopt; + std::vector work(lwork); + /* Solve eigenproblem */ + dsyev_( &V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode ); + + if (retcode != 0) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + //quickSort(ww, 0, N-1); + //print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m-1)/2; + *b = ww[idx]; + } + // printf("<-- mathieu_b\n"); + return retcode; + } + } // namespace mathieu } // namespace xsf diff --git a/include/xsf/mathieu/mathieu_fcns.h b/include/xsf/mathieu/mathieu_fcns.h index a0ec56cb3d..30f58179f5 100644 --- a/include/xsf/mathieu/mathieu_fcns.h +++ b/include/xsf/mathieu/mathieu_fcns.h @@ -1,1600 +1,1472 @@ #ifndef MATHIEU_FCNS_H #define MATHIEU_FCNS_H +#include #include "../config.h" #include "../error.h" -#include "besseljyd.h" -#include "mathieu_coeffs.h" -#include "matrix_utils.h" #include +#include "matrix_utils.h" +#include "mathieu_coeffs.h" +#include "besseljyd.h" + /* * * This is part of the Mathieu function suite -- a reimplementation * of the Mathieu functions for Scipy. This file holds the function * implementations themselves. The prototype was written in Matlab - * and validated. This is a translation from Matlab to C. + * and validated. This is a translation from Matlab to C++. * * Stuart Brorson, Summer 2025. - * + * */ namespace xsf { namespace mathieu { - //================================================================== - int mathieu_ce(int m, double q, double v, double *ce, double *ced) { - // This computes the Mathieu fcn ce - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // v = angle in radians (scalar) - // Outputs: - // ce = value of fcn for these inputs (scalar) - // ced = value of fcn deriv w.r.t. v for these inputs (scalar) - // Return code: - // Codes in error.h. - - int retcode = SF_ERROR_OK; - - // Check input domain and flag any problems. - if (m > 500) { - // Don't support absurdly larger orders for now. - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - // abs(q) > 1000 leads to low accuracy. - if (abs(q) > 1.0e3d) - retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m + 25; // N = size of recursion matrix to use. - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even ce - double *AA = (double *)calloc(N, sizeof(double)); - if (AA == NULL) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_ee(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, cep, cem, cedp, cedm; - cem = 0.0; - cep = 0.0; - cedm = 0.0; - cedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - tt = AA[k] * cos(2.0 * k * v); // Term for Mathieu ce - if (tt < 0) { - cem = cem + tt; // Neg running sum - } else { - cep = cep + tt; // Pos running sum - } - - td = -2.0 * k * AA[k] * sin(2.0 * k * v); // Term for deriv - if (td < 0) { - cedm = cedm + td; - } else { - cedp = cedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *ce = cep + cem; - *ced = cedp + cedm; - - // Hack -- this makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l < N; l++) { - s = s + AA[l]; - } - *ce = SIGN(s) * (*ce); - *ced = SIGN(s) * (*ced); - free(AA); - - } else { - // Odd - - // Get coeff vector for odd ce - double *AA = (double *)calloc(N, sizeof(double)); - if (AA == NULL) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_eo(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, cep, cem, cedp, cedm; - cem = 0.0; - cep = 0.0; - cedm = 0.0; - cedp = 0.0; - - // Perform Fourier sum on k = 0, 2, 4, ... - for (int k = (N - 1); k >= 0; k--) { - tt = AA[k] * cos((2.0 * k + 1.0) * v); // Term for Mathieu ce - if (tt < 0) { - cem = cem + tt; // Neg running sum - } else { - cep = cep + tt; // Pos running sum - } - - td = -(2.0 * k + 1.0) * AA[k] * sin((2.0 * k + 1.0) * v); // Deriv. - if (td < 0) { - cedm = cedm + td; - } else { - cedp = cedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *ce = cep + cem; - *ced = cedp + cedm; - - // Hack -- this makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l < N; l++) { - s = s + AA[l]; - } - *ce = SIGN(s) * (*ce); - *ced = SIGN(s) * (*ced); - - free(AA); - } // if (m % 2 == 0) - - return retcode; + // Forward declarations + int check_angular_fcn_domain(int m, double q); + int check_modified_fcn_domain(int m, double q); + int set_adaptive_offset_c(int m, double q); + + //================================================================== + int mathieu_ce(int m, double q, double v, double *ce, double *ced) { + // This computes the Mathieu fcn ce + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // v = angle in radians (scalar) + // Outputs: + // ce = value of fcn for these inputs (scalar) + // ced = value of fcn deriv w.r.t. v for these inputs (scalar) + // Return code: + // Codes in error.h. + + int retcode = SF_ERROR_OK; + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_angular_fcn_domain(m,q); + if (retcode == SF_ERROR_DOMAIN) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order + + // Get coeff vector for even ce + std::vector AA(N); + retcode = mathieu_coeffs_ee(N,q,m, AA.data()); + if (retcode != SF_ERROR_OK) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, cep, cem, cedp, cedm; + cem = 0.0; cep = 0.0; cedm = 0.0; cedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + tt = AA[k]*cos(2.0*k*v); // Term for Mathieu ce + if (tt<0) { + cem = cem + tt; // Neg running sum + } else { + cep = cep + tt; // Pos running sum + } + + td = -2.0*k*AA[k]*sin(2.0*k*v); // Term for deriv + if (td<0) { + cedm = cedm + td; + } else { + cedp = cedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *ce = cep+cem; + *ced = cedp+cedm; + + // This makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l AA(N); + + retcode = mathieu_coeffs_eo(N,q,m, AA.data()); + if (retcode != SF_ERROR_OK) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, cep, cem, cedp, cedm; + cem = 0.0; cep = 0.0; cedm = 0.0; cedp = 0.0; + + // Perform Fourier sum on k = 0, 2, 4, ... + for (int k=(N-1); k>=0 ; k--) { + tt = AA[k]*cos((2.0*k+1.0)*v); // Term for Mathieu ce + if (tt<0) { + cem = cem + tt; // Neg running sum + } else { + cep = cep + tt; // Pos running sum + } + + td = -(2.0*k+1.0)*AA[k]*sin((2.0*k+1.0)*v); // Deriv. + if (td<0) { + cedm = cedm + td; + } else { + cedp = cedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *ce = cep+cem; + *ced = cedp+cedm; + + // This makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order. + + // Get coeff vector for even se + std::vector BB(N); + + retcode = mathieu_coeffs_oe(N,q,m, BB.data()); + if (retcode != SF_ERROR_OK) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, sep, sem, sedp, sedm; + sem = 0.0; sep = 0.0; sedm = 0.0; sedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k=N; k>=1 ; k--) { + tt = BB[k-1]*sin(2.0*k*v); // Mathieu se term + if (tt<0) { + sem = sem + tt; // Neg running sum + } else { + sep = sep + tt; // Pos running sum + } + + td = 2.0*k*BB[k-1]*cos(2.0*k*v); // Deriv term. + if (td<0) { + sedm = sedm + td; + } else { + sedp = sedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *se = sep+sem; + *sed = sedp+sedm; + + // This makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l BB(N); + + retcode = mathieu_coeffs_oo(N,q,m, BB.data()); + if (retcode != SF_ERROR_OK) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, sep, sem, sedp, sedm; + sem = 0.0; sep = 0.0; sedm = 0.0; sedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + tt = BB[k]*sin((2.0*k+1.0)*v); // Mathieu se term + if (tt<0) { + sem = sem + tt; // Neg running sum + } else { + sep = sep + tt; // Pos running sum + } + + td = (2.0*k+1.0)*BB[k]*cos((2.0*k+1.0)*v); // Deriv term. + if (td<0) { + sedm = sedm + td; + } else { + sedp = sedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *se = sep+sem; + *sed = sedp+sedm; + + // This makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq*expmu; + double t = sqq*exppu; + + // Set offset c for adaptive calc. + c = set_adaptive_offset_c(m, q); + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order + + // Get coeff vector for even modmc1 + std::vector AA(N); + retcode = mathieu_coeffs_ee(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign, and I want to + // avoid catastrophic cancellation. + _Float128 mc1p, mc1m, mc1dp, mc1dm; + mc1p = 0.0; mc1m = 0.0; mc1dp = 0.0; mc1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Jkt = besselj(k,t); + double Jdks = besseljd(k,s); + double Jdkt = besseljd(k,t); + + _Float128 tt = AA[k]*(Jks*Jkt); + _Float128 ttd = AA[k]*(exppu*Jks*Jdkt - expmu*Jdks*Jkt); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c,s); + double Jkpct = besselj(k+c,t); + double Jkmct = besselj(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c,s); + double Jdkpct = besseljd(k+c,t); + double Jdkmct = besseljd(k-c,t); + + _Float128 tt = AA[k]*(Jkmcs*Jkpct + Jkpcs*Jkmct); + _Float128 ttd = AA[k]* + (exppu*(Jkmcs*Jdkpct + Jkpcs*Jdkmct) - + expmu*(Jdkmcs*Jkpct + Jdkpcs*Jkmct)) ; + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *mc1 = static_cast(mc1p+mc1m); + *mc1d = static_cast(mc1dp+mc1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = m/2; + if (sgn%2 == 0) { + *mc1 = (*mc1)/AA[c]; + *mc1d = sqq*(*mc1d)/AA[c]; + } else { + *mc1 = -(*mc1)/AA[c]; + *mc1d = -sqq*(*mc1d)/AA[c]; + } + + } else { + // Odd order -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd modmc1 + std::vector AA(N); + retcode = mathieu_coeffs_eo(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 mc1p, mc1m, mc1dp, mc1dm; + mc1p = 0.0; mc1m = 0.0; mc1dp = 0.0; mc1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Jkp1s = besselj(k+1,s); + double Jkt = besselj(k,t); + double Jkp1t = besselj(k+1,t); + + double Jdks = besseljd(k,s); + double Jdkp1s = besseljd(k+1,s); + double Jdkt = besseljd(k,t); + double Jdkp1t = besseljd(k+1,t); + + _Float128 tt = AA[k]*(Jks*Jkp1t + Jkp1s*Jkt); + _Float128 ttd = AA[k]* + (exppu*(Jks*Jdkp1t + Jkp1s*Jdkt) - + expmu*(Jdks*Jkp1t + Jdkp1s*Jkt) ) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c+1,s); + double Jkpct = besselj(k+c+1,t); + double Jkmct = besselj(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c+1,s); + double Jdkpct = besseljd(k+c+1,t); + double Jdkmct = besseljd(k-c,t); + + _Float128 tt = AA[k]*(Jkmcs*Jkpct + Jkpcs*Jkmct); + _Float128 ttd = AA[k]* + (exppu*(Jkmcs*Jdkpct + Jkpcs*Jdkmct) - + expmu*(Jdkmcs*Jkpct + Jdkpcs*Jkmct)) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *mc1 = static_cast(mc1p+mc1m); + *mc1d = static_cast(mc1dp+mc1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-1)/2; + if (sgn%2 == 0) { + *mc1 = (*mc1)/AA[c]; + *mc1d = sqq*(*mc1d)/AA[c]; + } else { + *mc1 = -(*mc1)/AA[c]; + *mc1d = -sqq*(*mc1d)/AA[c]; + } + + } + + return retcode; + } // int mathieu_modmc1 + + + //================================================================== + int mathieu_modms1(int m, double q, double u, double *ms1, double *ms1d) { + // This computes the Mathieu fcn modms1 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // ms1 = value of fcn for these inputs (scalar) + // ms1d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_modified_fcn_domain(m,q); + if (retcode == SF_ERROR_DOMAIN) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return retcode; } - //================================================================== - int mathieu_se(int m, double q, double v, double *se, double *sed) { - // This computes the Mathieu fcn se - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // v = angle in radians (scalar) - // Outputs: - // se = value of fcn for these inputs (scalar) - // sed = value of fcn deriv w.r.t. v for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - - // Check input domain and flag any problems. - if (m > 500) { - // Don't support absurdly larger orders for now. - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - // q>1000 leads to inaccuracy. - if (abs(q) > 1.0e3d) - retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m + 25; // N = size of recursion matrix to use. - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even se - double *BB = (double *)calloc(N, sizeof(double)); - if (BB == NULL) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oe(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, sep, sem, sedp, sedm; - sem = 0.0; - sep = 0.0; - sedm = 0.0; - sedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k = N; k >= 1; k--) { - tt = BB[k - 1] * sin(2.0 * k * v); // Mathieu se term - if (tt < 0) { - sem = sem + tt; // Neg running sum - } else { - sep = sep + tt; // Pos running sum - } - - td = 2.0 * k * BB[k - 1] * cos(2.0 * k * v); // Deriv term. - if (td < 0) { - sedm = sedm + td; - } else { - sedp = sedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *se = sep + sem; - *sed = sedp + sedm; - - // Hack -- this makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l < N; l++) { - s = s + BB[l]; - } - *se = SIGN(s) * (*se); - *sed = SIGN(s) * (*sed); - - free(BB); - } else { - // Odd - - // Get coeff vector for odd se - double *BB = (double *)calloc(N, sizeof(double)); - if (BB == NULL) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oo(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, sep, sem, sedp, sedm; - sem = 0.0; - sep = 0.0; - sedm = 0.0; - sedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - tt = BB[k] * sin((2.0 * k + 1.0) * v); // Mathieu se term - if (tt < 0) { - sem = sem + tt; // Neg running sum - } else { - sep = sep + tt; // Pos running sum - } - - td = (2.0 * k + 1.0) * BB[k] * cos((2.0 * k + 1.0) * v); // Deriv term. - if (td < 0) { - sedm = sedm + td; - } else { - sedp = sedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *se = sep + sem; - *sed = sedp + sedm; - - // Hack -- this makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l < N; l++) { - s = s + BB[l]; - } - *se = SIGN(s) * (*se); - *sed = SIGN(s) * (*sed); - - free(BB); - } - - return retcode; - } // int mathieu_se - - //================================================================== - int mathieu_modmc1(int m, double q, double u, double *mc1, double *mc1d) { - // This computes the Mathieu fcn modmc1 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // mc1 = value of fcn for these inputs (scalar) - // mc1d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check input domain and flag any problems - if (m > 500) { - // Don't support absurdly larger orders for now. - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - if (q < 0) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to return for these, just set retcode. - if (abs(q) > 1.0e3d) - retcode = SF_ERROR_LOSS; // q>1000 is inaccurate - if (m > 15 && q > 0.1d) - retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m + 25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq * expmu; - double t = sqq * exppu; - - // This is used for the adaptive computation. - // I set the offset used in Bessel sum depending upon order m. - // The offset depends upon exactly where in the [q,m] plane lives - // the input args. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. - if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || - (m > 20 && q < 10) || (m > 30 && q < 100)) { - c = m / 2; - } else { - c = 0; - } - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even modmc1 - double *AA = (double *)calloc(N, sizeof(double)); - if (AA == NULL) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_ee(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign, and I want to - // avoid catastrophic cancellation. - _Float128 mc1p, mc1m, mc1dp, mc1dm; - mc1p = 0.0; - mc1m = 0.0; - mc1dp = 0.0; - mc1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - if (c == 0) { - // Non-adaptive calc - double Jks = besselj(k, s); - double Jkt = besselj(k, t); - double Jdks = besseljd(k, s); - double Jdkt = besseljd(k, t); - - _Float128 tt = AA[k] * (Jks * Jkt); - _Float128 ttd = AA[k] * (exppu * Jks * Jdkt - expmu * Jdks * Jkt); - - // Even terms have + sign, odd terms have - sign - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k - c, s); - double Jkpcs = besselj(k + c, s); - double Jkpct = besselj(k + c, t); - double Jkmct = besselj(k - c, t); - - double Jdkmcs = besseljd(k - c, s); - double Jdkpcs = besseljd(k + c, s); - double Jdkpct = besseljd(k + c, t); - double Jdkmct = besseljd(k - c, t); - - _Float128 tt = AA[k] * (Jkmcs * Jkpct + Jkpcs * Jkmct); - _Float128 ttd = - AA[k] * (exppu * (Jkmcs * Jdkpct + Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct + Jdkpcs * Jkmct)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *mc1 = static_cast(mc1p + mc1m); - *mc1d = static_cast(mc1dp + mc1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = m / 2; - if (sgn % 2 == 0) { - *mc1 = (*mc1) / AA[c]; - *mc1d = sqq * (*mc1d) / AA[c]; - } else { - *mc1 = -(*mc1) / AA[c]; - *mc1d = -sqq * (*mc1d) / AA[c]; - } - - free(AA); - - } else { - // Odd -- m = 1, 3, 5, 7 ... - - // Get coeff vector for even modmc1 - double *AA = (double *)calloc(N, sizeof(double)); - if (AA == NULL) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_eo(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 mc1p, mc1m, mc1dp, mc1dm; - mc1p = 0.0; - mc1m = 0.0; - mc1dp = 0.0; - mc1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - if (c == 0) { - // Non-adaptive calc - double Jks = besselj(k, s); - double Jkp1s = besselj(k + 1, s); - double Jkt = besselj(k, t); - double Jkp1t = besselj(k + 1, t); - - double Jdks = besseljd(k, s); - double Jdkp1s = besseljd(k + 1, s); - double Jdkt = besseljd(k, t); - double Jdkp1t = besseljd(k + 1, t); - - _Float128 tt = AA[k] * (Jks * Jkp1t + Jkp1s * Jkt); - _Float128 ttd = - AA[k] * (exppu * (Jks * Jdkp1t + Jkp1s * Jdkt) - expmu * (Jdks * Jkp1t + Jdkp1s * Jkt)); - - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k - c, s); - double Jkpcs = besselj(k + c + 1, s); - double Jkpct = besselj(k + c + 1, t); - double Jkmct = besselj(k - c, t); - - double Jdkmcs = besseljd(k - c, s); - double Jdkpcs = besseljd(k + c + 1, s); - double Jdkpct = besseljd(k + c + 1, t); - double Jdkmct = besseljd(k - c, t); - - _Float128 tt = AA[k] * (Jkmcs * Jkpct + Jkpcs * Jkmct); - _Float128 ttd = - AA[k] * (exppu * (Jkmcs * Jdkpct + Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct + Jdkpcs * Jkmct)); - - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *mc1 = static_cast(mc1p + mc1m); - *mc1d = static_cast(mc1dp + mc1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m - 1) / 2; - if (sgn % 2 == 0) { - *mc1 = (*mc1) / AA[c]; - *mc1d = sqq * (*mc1d) / AA[c]; - } else { - *mc1 = -(*mc1) / AA[c]; - *mc1d = -sqq * (*mc1d) / AA[c]; - } - - free(AA); - } - - return retcode; - } // int mathieu_modmc1 - - //================================================================== - int mathieu_modms1(int m, double q, double u, double *ms1, double *ms1d) { - // This computes the Mathieu fcn modms1 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // ms1 = value of fcn for these inputs (scalar) - // ms1d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check input domain and flag any problems - if (m > 500) { - // Don't support absurdly larger orders for now. - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - if (q < 0) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to return immediately for these. - if (abs(q) > 1.0e3d) - retcode = SF_ERROR_LOSS; - if (m > 15 && q > 0.1d) - retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m + 25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq * expmu; - double t = sqq * exppu; - - // This is used for the adaptive computation. - // I set the offset used in Bessel fcn depending upon order m. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. - if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || - (m > 20 && q < 10) || (m > 30 && q < 100)) { - c = m / 2; - } else { - c = 0; - } - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even modms1 - double *BB = (double *)calloc(N, sizeof(double)); - if (BB == NULL) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oe(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 ms1p, ms1m, ms1dp, ms1dm; - ms1p = 0.0; - ms1m = 0.0; - ms1dp = 0.0; - ms1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - if (c == 0) { - // Non-adaptive calc - double Jks = besselj(k, s); - double Jkp2t = besselj(k + 2, t); - double Jkp2s = besselj(k + 2, s); - double Jkt = besselj(k, t); - - double Jdks = besseljd(k, s); - double Jdkp2t = besseljd(k + 2, t); - double Jdkp2s = besseljd(k + 2, s); - double Jdkt = besseljd(k, t); - - _Float128 tt = BB[k] * (Jks * Jkp2t - Jkp2s * Jkt); - _Float128 ttd = - BB[k] * (exppu * (Jks * Jdkp2t - Jkp2s * Jdkt) - expmu * (Jdks * Jkp2t - Jdkp2s * Jkt)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k - c, s); - double Jkpct = besselj(k + c + 2, t); - double Jkpcs = besselj(k + c + 2, s); - double Jkmct = besselj(k - c, t); - - double Jdkmcs = besseljd(k - c, s); - double Jdkpct = besseljd(k + c + 2, t); - double Jdkpcs = besseljd(k + c + 2, s); - double Jdkmct = besseljd(k - c, t); - - _Float128 tt = BB[k] * (Jkmcs * Jkpct - Jkpcs * Jkmct); - _Float128 ttd = - BB[k] * (exppu * (Jkmcs * Jdkpct - Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct - Jdkpcs * Jkmct)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *ms1 = static_cast(ms1p + ms1m); - *ms1d = static_cast(ms1dp + ms1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m - 2) / 2; - if (sgn % 2 == 0) { - *ms1 = (*ms1) / BB[c]; - *ms1d = sqq * (*ms1d) / BB[c]; - } else { - *ms1 = -(*ms1) / BB[c]; - *ms1d = -sqq * (*ms1d) / BB[c]; - } - - free(BB); - - } else { - // Odd -- m = 1, 3, 5, 7 ... - - // Get coeff vector for even modms1 - double *BB = (double *)calloc(N, sizeof(double)); - if (BB == NULL) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oo(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 ms1p, ms1m, ms1dp, ms1dm; - ms1p = 0.0; - ms1m = 0.0; - ms1dp = 0.0; - ms1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - if (c == 0) { - // Non-adaptive calc - double Jks = besselj(k, s); - double Jkt = besselj(k, t); - double Jkp1s = besselj(k + 1, s); - double Jkp1t = besselj(k + 1, t); - - double Jdks = besseljd(k, s); - double Jdkt = besseljd(k, t); - double Jdkp1s = besseljd(k + 1, s); - double Jdkp1t = besseljd(k + 1, t); - - _Float128 tt = BB[k] * (Jks * Jkp1t - Jkp1s * Jkt); - _Float128 ttd = - BB[k] * (exppu * (Jks * Jdkp1t - Jkp1s * Jdkt) - expmu * (Jdks * Jkp1t - Jdkp1s * Jkt)); - - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k - c, s); - double Jkpcs = besselj(k + c + 1, s); - double Jkpct = besselj(k + c + 1, t); - double Jkmct = besselj(k - c, t); - - double Jdkmcs = besseljd(k - c, s); - double Jdkpcs = besseljd(k + c + 1, s); - double Jdkpct = besseljd(k + c + 1, t); - double Jdkmct = besseljd(k - c, t); - - _Float128 tt = BB[k] * (Jkmcs * Jkpct - Jkpcs * Jkmct); - _Float128 ttd = - BB[k] * (exppu * (Jkmcs * Jdkpct - Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct - Jdkpcs * Jkmct)); - - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *ms1 = static_cast(ms1p + ms1m); - *ms1d = static_cast(ms1dp + ms1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m - 1) / 2; - if (sgn % 2 == 0) { - *ms1 = (*ms1) / BB[c]; - *ms1d = sqq * (*ms1d) / BB[c]; - } else { - *ms1 = -(*ms1) / BB[c]; - *ms1d = -sqq * (*ms1d) / BB[c]; - } - - free(BB); - } - - return retcode; - } // int mathieu_modms1 - - //================================================================== - int mathieu_modmc2(int m, double q, double u, double *mc2, double *mc2d) { - // This computes the Mathieu fcn modmc2 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // mc2 = value of fcn for these inputs (scalar) - // mc2d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check input domain and flag any problems - if (m > 500) { - // Don't support absurdly larger orders for now. - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - if (q < 0) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to return immediate for these. - if (abs(q) > 1.0e3d) - retcode = SF_ERROR_LOSS; - if (m > 15 && q > 0.1d) - retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m + 25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq * expmu; - double t = sqq * exppu; - - // This is used for the adaptive computation. - // I set the offset used in Bessel fcn depending upon order m. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. - if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || - (m > 20 && q < 10) || (m > 30 && q < 100)) { - c = m / 2; - } else { - c = 0; - } - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even modmc2 - double *AA = (double *)calloc(N, sizeof(double)); - if (AA == NULL) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_ee(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 mc2p, mc2m, mc2dp, mc2dm; - - // Sum from smallest to largest coeff. - mc2p = 0.0; - mc2m = 0.0; - mc2dp = 0.0; - mc2dm = 0.0; - for (int k = (N - 1); k >= 0; k--) { - if (c == 0) { - // Non-adaptive calc - double Jks = besselj(k, s); - double Ykt = bessely(k, t); - double Jdks = besseljd(k, s); - double Ydkt = besselyd(k, t); - - _Float128 tt = AA[k] * Jks * Ykt; - _Float128 ttd = AA[k] * (exppu * Jks * Ydkt - expmu * Jdks * Ykt); - - // Even terms have + sign, odd terms have - sign - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k - c, s); - double Jkpcs = besselj(k + c, s); - double Ykpct = bessely(k + c, t); - double Ykmct = bessely(k - c, t); - - double Jdkmcs = besseljd(k - c, s); - double Jdkpcs = besseljd(k + c, s); - double Ydkpct = besselyd(k + c, t); - double Ydkmct = besselyd(k - c, t); - - _Float128 tt = AA[k] * (Jkmcs * Ykpct + Jkpcs * Ykmct); - _Float128 ttd = - AA[k] * (exppu * (Jkmcs * Ydkpct + Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct + Jdkpcs * Ykmct)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *mc2 = static_cast(mc2p + mc2m); - *mc2d = static_cast(mc2dp + mc2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = m / 2; - if (sgn % 2 == 0) { - *mc2 = (*mc2) / AA[c]; - *mc2d = sqq * (*mc2d) / AA[c]; - } else { - *mc2 = -(*mc2) / AA[c]; - *mc2d = -sqq * (*mc2d) / AA[c]; - } - - free(AA); - - } else { - // Odd -- m = 1, 3, 5, 7 ... - - // Get coeff vector for odd mc2 - double *AA = (double *)calloc(N, sizeof(double)); - if (AA == NULL) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_eo(N, q, m, AA); - if (retcode != SF_ERROR_OK) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - free(AA); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 mc2p, mc2m, mc2dp, mc2dm; - mc2p = 0.0; - mc2m = 0.0; - mc2dp = 0.0; - mc2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - if (c == 0) { - // Non-adaptive calc - double Jks = besselj(k, s); - double Ykt = bessely(k, t); - double Jkp1s = besselj(k + 1, s); - double Ykp1t = bessely(k + 1, t); - - double Jdks = besseljd(k, s); - double Ydkt = besselyd(k, t); - double Jdkp1s = besseljd(k + 1, s); - double Ydkp1t = besselyd(k + 1, t); - - _Float128 tt = AA[k] * (Jks * Ykp1t + Jkp1s * Ykt); - _Float128 ttd = - AA[k] * (exppu * (Jks * Ydkp1t + Jkp1s * Ydkt) - expmu * (Jdks * Ykp1t + Jdkp1s * Ykt)); - - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k - c, s); - double Jkpcs = besselj(k + c + 1, s); - double Ykpct = bessely(k + c + 1, t); - double Ykmct = bessely(k - c, t); - - double Jdkmcs = besseljd(k - c, s); - double Jdkpcs = besseljd(k + c + 1, s); - double Ydkpct = besselyd(k + c + 1, t); - double Ydkmct = besselyd(k - c, t); - - _Float128 tt = AA[k] * (Jkmcs * Ykpct + Jkpcs * Ykmct); - _Float128 ttd = - AA[k] * (exppu * (Jkmcs * Ydkpct + Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct + Jdkpcs * Ykmct)); - - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *mc2 = static_cast(mc2p + mc2m); - *mc2d = static_cast(mc2dp + mc2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m - 1) / 2; - if (sgn % 2 == 0) { - *mc2 = (*mc2) / AA[c]; - *mc2d = sqq * (*mc2d) / AA[c]; - } else { - *mc2 = -(*mc2) / AA[c]; - *mc2d = -sqq * (*mc2d) / AA[c]; - } - - free(AA); - } - - return retcode; - } // int mathieu_modmc2 - - //================================================================== - int mathieu_modms2(int m, double q, double u, double *ms2, double *ms2d) { - // This computes the Mathieu fcn modms2 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // ms2 = value of fcn for these inputs (scalar) - // ms2d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check input domain and flag any problems - if (m > 500) { - // Don't support absurdly larger orders for now. - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - if (q < 0) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to return immediately from these. - if (abs(q) > 1.0e3d) - retcode = SF_ERROR_LOSS; - if (m > 15 && q > 0.1d) - retcode = SF_ERROR_LOSS; - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m + 25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq * expmu; - double t = sqq * exppu; - - // This is used for the adaptive computation. - // I set the offset used in Bessel fcn depending upon order m. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. - if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || - (m > 20 && q < 10) || (m > 30 && q < 100)) { - c = m / 2; - } else { - c = 0; - } - c = 0; - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even - - // Get coeff vector for even modms2 - double *BB = (double *)calloc(N, sizeof(double)); - if (BB == NULL) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oe(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 ms2p, ms2m, ms2dp, ms2dm; - ms2p = 0.0; - ms2m = 0.0; - ms2dp = 0.0; - ms2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - if (c == 0) { - // Non-adaptive calc - double Jks = besselj(k, s); - double Ykp2t = bessely(k + 2, t); - double Jkp2s = besselj(k + 2, s); - double Ykt = bessely(k, t); - - double Jdks = besseljd(k, s); - double Ydkp2t = besselyd(k + 2, t); - double Jdkp2s = besseljd(k + 2, s); - double Ydkt = besselyd(k, t); - - _Float128 tt = BB[k] * (Jks * Ykp2t - Jkp2s * Ykt); - _Float128 ttd = - BB[k] * (exppu * (Jks * Ydkp2t - Jkp2s * Ydkt) - expmu * (Jdks * Ykp2t - Jdkp2s * Ykt)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k - c, s); - double Ykpct = bessely(k + c + 2, t); - double Jkpcs = besselj(k + c + 2, s); - double Ykmct = bessely(k - c, t); - - double Jdkmcs = besseljd(k - c, s); - double Ydkpct = besselyd(k + c + 2, t); - double Jdkpcs = besseljd(k + c + 2, s); - double Ydkmct = besselyd(k - c, t); - - _Float128 tt = BB[k] * (Jkmcs * Ykpct - Jkpcs * Ykmct); - _Float128 ttd = - BB[k] * (exppu * (Jkmcs * Ydkpct - Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct - Jdkpcs * Ykmct)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *ms2 = static_cast(ms2p + ms2m); - *ms2d = static_cast(ms2dp + ms2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m - 2) / 2; - if (sgn % 2 == 0) { - *ms2 = (*ms2) / BB[c]; - *ms2d = sqq * (*ms2d) / BB[c]; - } else { - *ms2 = -(*ms2) / BB[c]; - *ms2d = -sqq * (*ms2d) / BB[c]; - } - - free(BB); - - } else { - // Odd -- m = 1, 3, 5, 7 ... - - // Get coeff vector for even modms2 - double *BB = (double *)calloc(N, sizeof(double)); - if (BB == NULL) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return SF_ERROR_MEMORY; - } - - retcode = mathieu_coeffs_oo(N, q, m, BB); - if (retcode != SF_ERROR_OK) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - free(BB); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 ms2p, ms2m, ms2dp, ms2dm; - ms2p = 0.0; - ms2m = 0.0; - ms2dp = 0.0; - ms2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k = (N - 1); k >= 0; k--) { - if (c == 0) { - // Non-adaptive calc - double Jks = besselj(k, s); - double Ykt = bessely(k, t); - double Jkp1s = besselj(k + 1, s); - double Ykp1t = bessely(k + 1, t); - - double Jdks = besseljd(k, s); - double Ydkt = besselyd(k, t); - double Jdkp1s = besseljd(k + 1, s); - double Ydkp1t = besselyd(k + 1, t); - - _Float128 tt = BB[k] * (Jks * Ykp1t - Jkp1s * Ykt); - _Float128 ttd = - BB[k] * (exppu * (Jks * Ydkp1t - Jkp1s * Ydkt) - expmu * (Jdks * Ykp1t - Jdkp1s * Ykt)); - - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k - c, s); - double Jkpcs = besselj(k + c + 1, s); - double Ykpct = bessely(k + c + 1, t); - double Ykmct = bessely(k - c, t); - - double Jdkmcs = besseljd(k - c, s); - double Jdkpcs = besseljd(k + c + 1, s); - double Ydkpct = besselyd(k + c + 1, t); - double Ydkmct = besselyd(k - c, t); - - _Float128 tt = BB[k] * (Jkmcs * Ykpct - Jkpcs * Ykmct); - _Float128 ttd = - BB[k] * (exppu * (Jkmcs * Ydkpct - Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct - Jdkpcs * Ykmct)); - - int sgn = (k % 2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn * tt; - if (tt < 0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn * ttd; - if (ttd < 0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *ms2 = static_cast(ms2p + ms2m); - *ms2d = static_cast(ms2dp + ms2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m - 1) / 2; - if (sgn % 2 == 0) { - *ms2 = (*ms2) / BB[c]; - *ms2d = sqq * (*ms2d) / BB[c]; - } else { - *ms2 = -(*ms2) / BB[c]; - *ms2d = -sqq * (*ms2d) / BB[c]; - } - - free(BB); - } - - return retcode; - } // int mathieu_modms2 + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq*expmu; + double t = sqq*exppu; + + // Set offset c for adaptive calc. + c = set_adaptive_offset_c(m, q); + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order + + // Get coeff vector for even modms1 + std::vector BB(N); + retcode = mathieu_coeffs_oe(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 ms1p, ms1m, ms1dp, ms1dm; + ms1p = 0.0; ms1m = 0.0; ms1dp = 0.0; ms1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Jkp2t = besselj(k+2,t); + double Jkp2s = besselj(k+2,s); + double Jkt = besselj(k,t); + + double Jdks = besseljd(k,s); + double Jdkp2t = besseljd(k+2,t); + double Jdkp2s = besseljd(k+2,s); + double Jdkt = besseljd(k,t); + + _Float128 tt = BB[k]*(Jks*Jkp2t - Jkp2s*Jkt); + _Float128 ttd = BB[k]* + (exppu*(Jks*Jdkp2t - Jkp2s*Jdkt) - + expmu*(Jdks*Jkp2t - Jdkp2s*Jkt)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpct = besselj(k+c+2,t); + double Jkpcs = besselj(k+c+2,s); + double Jkmct = besselj(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpct = besseljd(k+c+2,t); + double Jdkpcs = besseljd(k+c+2,s); + double Jdkmct = besseljd(k-c,t); + + _Float128 tt = BB[k]*(Jkmcs*Jkpct - Jkpcs*Jkmct); + _Float128 ttd = BB[k]* + (exppu*(Jkmcs*Jdkpct - Jkpcs*Jdkmct) - + expmu*(Jdkmcs*Jkpct - Jdkpcs*Jkmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *ms1 = static_cast(ms1p+ms1m); + *ms1d = static_cast(ms1dp+ms1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-2)/2; + if (sgn%2 == 0) { + *ms1 = (*ms1)/BB[c]; + *ms1d = sqq*(*ms1d)/BB[c]; + } else { + *ms1 = -(*ms1)/BB[c]; + *ms1d = -sqq*(*ms1d)/BB[c]; + } + + } else { + // Odd order -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd modms1 + std::vector BB(N); + retcode = mathieu_coeffs_oo(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 ms1p, ms1m, ms1dp, ms1dm; + ms1p = 0.0; ms1m = 0.0; ms1dp = 0.0; ms1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Jkt = besselj(k,t); + double Jkp1s = besselj(k+1,s); + double Jkp1t = besselj(k+1,t); + + double Jdks = besseljd(k,s); + double Jdkt = besseljd(k,t); + double Jdkp1s = besseljd(k+1,s); + double Jdkp1t = besseljd(k+1,t); + + _Float128 tt = BB[k]*(Jks*Jkp1t - Jkp1s*Jkt); + _Float128 ttd = BB[k]* + (exppu*(Jks*Jdkp1t - Jkp1s*Jdkt) - + expmu*(Jdks*Jkp1t - Jdkp1s*Jkt)); + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c+1,s); + double Jkpct = besselj(k+c+1,t); + double Jkmct = besselj(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c+1,s); + double Jdkpct = besseljd(k+c+1,t); + double Jdkmct = besseljd(k-c,t); + + _Float128 tt = BB[k]*(Jkmcs*Jkpct - Jkpcs*Jkmct); + _Float128 ttd = BB[k]* + (exppu*(Jkmcs*Jdkpct - Jkpcs*Jdkmct) - + expmu*(Jdkmcs*Jkpct - Jdkpcs*Jkmct)) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *ms1 = static_cast(ms1p+ms1m); + *ms1d = static_cast(ms1dp+ms1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-1)/2; + if (sgn%2 == 0) { + *ms1 = (*ms1)/BB[c]; + *ms1d = sqq*(*ms1d)/BB[c]; + } else { + *ms1 = -(*ms1)/BB[c]; + *ms1d = -sqq*(*ms1d)/BB[c]; + } + + } + + return retcode; + } // int mathieu_modms1 + + + //================================================================== + int mathieu_modmc2(int m, double q, double u, double *mc2, double *mc2d) { + // This computes the Mathieu fcn modmc2 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // mc2 = value of fcn for these inputs (scalar) + // mc2d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_modified_fcn_domain(m,q); + if (retcode == SF_ERROR_DOMAIN) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq*expmu; + double t = sqq*exppu; + + // Set offset c for adaptive calc. + c = set_adaptive_offset_c(m, q); + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order + + // Get coeff vector for even modmc2 + std::vector AA(N); + retcode = mathieu_coeffs_ee(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 mc2p, mc2m, mc2dp, mc2dm; + + // Sum from smallest to largest coeff. + mc2p = 0.0; mc2m = 0.0; mc2dp = 0.0; mc2dm = 0.0; + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Ykt = bessely(k,t); + double Jdks = besseljd(k,s); + double Ydkt = besselyd(k,t); + + _Float128 tt = AA[k]*Jks*Ykt ; + _Float128 ttd = AA[k]*(exppu*Jks*Ydkt - expmu*Jdks*Ykt) ; + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c,s); + double Ykpct = bessely(k+c,t); + double Ykmct = bessely(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c,s); + double Ydkpct = besselyd(k+c,t); + double Ydkmct = besselyd(k-c,t); + + _Float128 tt = AA[k]*(Jkmcs*Ykpct + Jkpcs*Ykmct); + _Float128 ttd = AA[k]* + (exppu*(Jkmcs*Ydkpct + Jkpcs*Ydkmct) - + expmu*(Jdkmcs*Ykpct + Jdkpcs*Ykmct)) ; + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *mc2 = static_cast(mc2p+mc2m); + *mc2d = static_cast(mc2dp+mc2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = m/2; + if (sgn%2 == 0) { + *mc2 = (*mc2)/AA[c]; + *mc2d = sqq*(*mc2d)/AA[c]; + } else { + *mc2 = -(*mc2)/AA[c]; + *mc2d = -sqq*(*mc2d)/AA[c]; + } + + } else { + // Odd order -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd mc2 + std::vector AA(N); + retcode = mathieu_coeffs_eo(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 mc2p, mc2m, mc2dp, mc2dm; + mc2p = 0.0; mc2m = 0.0; mc2dp = 0.0; mc2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Ykt = bessely(k,t); + double Jkp1s = besselj(k+1,s); + double Ykp1t = bessely(k+1,t); + + double Jdks = besseljd(k,s); + double Ydkt = besselyd(k,t); + double Jdkp1s = besseljd(k+1,s); + double Ydkp1t = besselyd(k+1,t); + + _Float128 tt = AA[k]*(Jks*Ykp1t + Jkp1s*Ykt); + _Float128 ttd = AA[k]* + (exppu*(Jks*Ydkp1t + Jkp1s*Ydkt) - + expmu*(Jdks*Ykp1t + Jdkp1s*Ykt) ) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c+1,s); + double Ykpct = bessely(k+c+1,t); + double Ykmct = bessely(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c+1,s); + double Ydkpct = besselyd(k+c+1,t); + double Ydkmct = besselyd(k-c,t); + + _Float128 tt = AA[k]*(Jkmcs*Ykpct + Jkpcs*Ykmct); + _Float128 ttd = AA[k]* + (exppu*(Jkmcs*Ydkpct + Jkpcs*Ydkmct) - + expmu*(Jdkmcs*Ykpct + Jdkpcs*Ykmct) ) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *mc2 = static_cast(mc2p+mc2m); + *mc2d = static_cast(mc2dp+mc2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-1)/2; + if (sgn%2 == 0) { + *mc2 = (*mc2)/AA[c]; + *mc2d = sqq*(*mc2d)/AA[c]; + } else { + *mc2 = -(*mc2)/AA[c]; + *mc2d = -sqq*(*mc2d)/AA[c]; + } + + } + + return retcode; + } // int mathieu_modmc2 + + + //================================================================== + int mathieu_modms2(int m, double q, double u, double *ms2, double *ms2d) { + // This computes the Mathieu fcn modms2 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // ms2 = value of fcn for these inputs (scalar) + // ms2d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_modified_fcn_domain(m,q); + if (retcode == SF_ERROR_DOMAIN) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m+25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq*expmu; + double t = sqq*exppu; + + // Set offset c for adaptive calc. + //c = set_adaptive_offset_c(m, q); + c = 0; // Turn off adaptive c in modms2 for now ... + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order m. + + // Get coeff vector for even modms2 + std::vector BB(N); + retcode = mathieu_coeffs_oe(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 ms2p, ms2m, ms2dp, ms2dm; + ms2p = 0.0; ms2m = 0.0; ms2dp = 0.0; ms2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Ykp2t = bessely(k+2,t); + double Jkp2s = besselj(k+2,s); + double Ykt = bessely(k,t); + + double Jdks = besseljd(k,s); + double Ydkp2t = besselyd(k+2,t); + double Jdkp2s = besseljd(k+2,s); + double Ydkt = besselyd(k,t); + + _Float128 tt = BB[k]*(Jks*Ykp2t - Jkp2s*Ykt); + _Float128 ttd = BB[k]* + (exppu*(Jks*Ydkp2t - Jkp2s*Ydkt) - + expmu*(Jdks*Ykp2t - Jdkp2s*Ykt)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Ykpct = bessely(k+c+2,t); + double Jkpcs = besselj(k+c+2,s); + double Ykmct = bessely(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Ydkpct = besselyd(k+c+2,t); + double Jdkpcs = besseljd(k+c+2,s); + double Ydkmct = besselyd(k-c,t); + + _Float128 tt = BB[k]*(Jkmcs*Ykpct - Jkpcs*Ykmct); + _Float128 ttd = BB[k]* + (exppu*(Jkmcs*Ydkpct - Jkpcs*Ydkmct) - + expmu*(Jdkmcs*Ykpct - Jdkpcs*Ykmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *ms2 = static_cast(ms2p+ms2m); + *ms2d = static_cast(ms2dp+ms2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-2)/2; + if (sgn%2 == 0) { + *ms2 = (*ms2)/BB[c]; + *ms2d = sqq*(*ms2d)/BB[c]; + } else { + *ms2 = -(*ms2)/BB[c]; + *ms2d = -sqq*(*ms2d)/BB[c]; + } + + } else { + // Odd order -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd modms2 + std::vector BB(N); + retcode = mathieu_coeffs_oo(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 ms2p, ms2m, ms2dp, ms2dm; + ms2p = 0.0; ms2m = 0.0; ms2dp = 0.0; ms2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k=(N-1); k>=0 ; k--) { + if (c==0) { + // Non-adaptive calc + double Jks = besselj(k,s); + double Ykt = bessely(k,t); + double Jkp1s = besselj(k+1,s); + double Ykp1t = bessely(k+1,t); + + double Jdks = besseljd(k,s); + double Ydkt = besselyd(k,t); + double Jdkp1s = besseljd(k+1,s); + double Ydkp1t = besselyd(k+1,t); + + _Float128 tt = BB[k]*(Jks*Ykp1t - Jkp1s*Ykt); + _Float128 ttd = BB[k]* + (exppu*(Jks*Ydkp1t - Jkp1s*Ydkt) - + expmu*(Jdks*Ykp1t - Jdkp1s*Ykt)); + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k-c,s); + double Jkpcs = besselj(k+c+1,s); + double Ykpct = bessely(k+c+1,t); + double Ykmct = bessely(k-c,t); + + double Jdkmcs = besseljd(k-c,s); + double Jdkpcs = besseljd(k+c+1,s); + double Ydkpct = besselyd(k+c+1,t); + double Ydkmct = besselyd(k-c,t); + + _Float128 tt = BB[k]*(Jkmcs*Ykpct - Jkpcs*Ykmct); + _Float128 ttd = BB[k]* + (exppu*(Jkmcs*Ydkpct - Jkpcs*Ydkmct) - + expmu*(Jdkmcs*Ykpct - Jdkpcs*Ykmct) ) ; + + int sgn = (k%2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn*tt; + if (tt<0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn*ttd; + if (ttd<0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *ms2 = static_cast(ms2p+ms2m); + *ms2d = static_cast(ms2dp+ms2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m-1)/2; + if (sgn%2 == 0) { + *ms2 = (*ms2)/BB[c]; + *ms2d = sqq*(*ms2d)/BB[c]; + } else { + *ms2 = -(*ms2)/BB[c]; + *ms2d = -sqq*(*ms2d)/BB[c]; + } + + } + + return retcode; + } // int mathieu_modms2 + + //================================================================ + // Helper fcns -- these help reduce the amount of redundant code. + + int check_angular_fcn_domain(int m, double q) { + // Verify inputs are OK. If not indicate err. + int retcode = SF_ERROR_OK; + + if (m>500) { + // Don't support absurdly larger orders for now. + return SF_ERROR_DOMAIN; + } + + // abs(q) > 1000 leads to low accuracy. + if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; + + return retcode; + } + + //--------------------------------------------------- + int check_modified_fcn_domain(int m, double q) { + int retcode = SF_ERROR_OK; + + // Check input domain and flag any problems + if (m>500) { + return SF_ERROR_DOMAIN; + } + + if (q<0) { + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } + + // Don't need to bail out of main computation for these, just set retcode. + if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; // q>1000 is inaccurate + if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; + + return retcode; + } + + //--------------------------------------------------- + int set_adaptive_offset_c(int m, double q) { + // This is used to set the c used in the adaptive computation. + // I set the offset used in Bessel fcn depending upon order m + // and shape/frequency parameter q. This improves the accuracy + // for larger values of m. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. The values I use here + // were found from experiment using my Matlab prototype. However, + // better values are likely -- finding them is a future project. + int c; + + if ( (m>5 && q<.001) || + (m>7 && q<.01) || + (m>10 && q<.1) || + (m>15 && q<1) || + (m>20 && q<10) || + (m>30 && q<100) ) { + c = m/2; + } else { + c = 0; + } + + return c; + } + } // namespace mathieu } // namespace xsf -#endif // #ifndef MATHIEU_FCNS_H +#endif // #ifndef MATHIEU_FCNS_H + diff --git a/include/xsf/mathieu/matrix_utils.h b/include/xsf/mathieu/matrix_utils.h index 8bada7bbda..ee6add4ed6 100644 --- a/include/xsf/mathieu/matrix_utils.h +++ b/include/xsf/mathieu/matrix_utils.h @@ -1,12 +1,12 @@ #ifndef MATRIX_UTILS_H #define MATRIX_UTILS_H -#include "matrix_utils.h" -#include #include +#include +#include "matrix_utils.h" // These fcns are meant to make it easier to deal with -// matrices in C. We use col major format since that's +// matrices in C/C++. We use col major format since that's // what underlies Lapack. // returns +/-1 depending upon sign of x @@ -15,12 +15,12 @@ // Macros to extract matrix index and element. // Matrix is NxN, i = row idx, j = col idx. // MATRIX_IDX is where col major format is enforced. -#define MATRIX_IDX(N, I, J) (((N) * (I)) + (J)) -#define MATRIX_ELEMENT(A, m, n, i, j) A[MATRIX_IDX(n, i, j)] +#define MATRIX_IDX(N, I, J) (((N)*(I)) + (J)) +#define MATRIX_ELEMENT(A, m, n, i, j) A[ MATRIX_IDX(n, i, j) ] // Min and max macros for scalars. -#define MIN(a, b) (((a) < (b)) ? (a) : (b)) -#define MAX(a, b) (((a) > (b)) ? (a) : (b)) +#define MIN(a,b) (((a)<(b))?(a):(b)) +#define MAX(a,b) (((a)>(b))?(a):(b)) //=========================================================== // This file holds utility functions for dealing with vectors @@ -29,60 +29,64 @@ // in Matlab. // Note that C matrices are row-major. + namespace xsf { namespace mathieu { - //----------------------------------------------------- - void print_matrix(const double *A, int m, int n) { - // prints matrix as 2-dimensional tablei -- this is how we - // usually think of matrices. - int i, j; - for (i = 0; i < m; i++) { - for (j = 0; j < n; j++) { - printf("% 10.4e ", MATRIX_ELEMENT(A, m, n, i, j)); - } - printf("\n"); - } - } +//----------------------------------------------------- +void print_matrix(const double* A, int m, int n) { + // prints matrix as 2-dimensional tablei -- this is how we + // usually think of matrices. + int i, j; + for (i = 0; i < m; i++) { + for (j = 0; j < n; j++) { + printf("% 10.4e ", MATRIX_ELEMENT(A, m, n, i, j)); + } + printf("\n"); + } +} - //----------------------------------------------------- - // Stuff to sort a vector. - // Function to swap two elements - void swap(double *a, double *b) { - double temp = *a; - *a = *b; - *b = temp; - } - // Partition function for quicksort - int partition(double *arr, int low, int high) { - double pivot = arr[high]; // Choose last element as pivot - int i = (low - 1); // Index of smaller element - - for (int j = low; j <= high - 1; j++) { - // If current element is smaller than or equal to pivot - if (arr[j] <= pivot) { - i++; - swap(&arr[i], &arr[j]); - } +//----------------------------------------------------- +// Stuff to sort a vector. +// Function to swap two elements +void swap(double* a, double* b) { + double temp = *a; + *a = *b; + *b = temp; +} + +// Partition function for quicksort +int partition(double *arr, int low, int high) { + double pivot = arr[high]; // Choose last element as pivot + int i = (low - 1); // Index of smaller element + + for (int j = low; j <= high - 1; j++) { + // If current element is smaller than or equal to pivot + if (arr[j] <= pivot) { + i++; + swap(&arr[i], &arr[j]); } - swap(&arr[i + 1], &arr[high]); - return (i + 1); } + swap(&arr[i + 1], &arr[high]); + return (i + 1); +} - // Quicksort function - void quickSort(double *arr, int low, int high) { - if (low < high) { - // Partition the array and get pivot index - int pivotIndex = partition(arr, low, high); - - // Recursively sort elements before and after partition - quickSort(arr, low, pivotIndex - 1); - quickSort(arr, pivotIndex + 1, high); - } +// Quicksort function +void quickSort(double *arr, int low, int high) { + if (low < high) { + // Partition the array and get pivot index + int pivotIndex = partition(arr, low, high); + + // Recursively sort elements before and after partition + quickSort(arr, low, pivotIndex - 1); + quickSort(arr, pivotIndex + 1, high); } +} + } // namespace mathieu } // namespace xsf -#endif // #ifndef MATRIX_UTILS_H + +#endif // #ifndef MATRIX_UTILS_H From e32d63c05ef5c11a1b05938e2b551c01a20b64f9 Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Fri, 26 Sep 2025 20:02:02 -0400 Subject: [PATCH 09/12] Remove mathieu.h since it doesn't belong in this dir. --- include/xsf/mathieu/mathieu.h | 357 ---------------------------------- 1 file changed, 357 deletions(-) delete mode 100644 include/xsf/mathieu/mathieu.h diff --git a/include/xsf/mathieu/mathieu.h b/include/xsf/mathieu/mathieu.h deleted file mode 100644 index b119feca86..0000000000 --- a/include/xsf/mathieu/mathieu.h +++ /dev/null @@ -1,357 +0,0 @@ -#pragma once - -#include "error.h" -#include "mathieu/matrix_utils.h" -#include "mathieu/make_matrix.h" -#include "mathieu/mathieu_coeffs.h" -#include "mathieu/mathieu_eigs.h" -#include "mathieu/besseljyd.h" -#include "mathieu/mathieu_fcns.h" - -/* - * - * This is part of the Mathieu function suite -- a reimplementation - * of the Mathieu functions for Scipy. This file #includes all the - * fcn impls in the mathieu/ subdirectory, and provides translation - * from the Scipy call to the calling signature I implemented in my - * reimplementation. - * - * Stuart Brorson, Summer 2025. - * - */ - -namespace xsf { - -/* Characteristic values */ -//------------------------------------------------------------- -/** - * Mathieu characteristic values (eigenvalues) for even parity functions. - * - * Even parity characteristic values a. - * - * @param m Eigenvalue order. Must be positive integer less than 500. - * @param q Mathieu parameter q. Real number. - * @return Mathieu eigenvalue a. - */ -template -T cem_cva(T m, T q) { - // This returns the even Mathieu characteristic value (eigenvalue) a. - - // Check for invalid Mathieu order. - if ((m < 0) || (m != floor(m))) { - set_error("mathieu_a", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double da; - - int retcode = xsf::mathieu::mathieu_a(im, dq, &da); - if (retcode != SF_ERROR_OK) { - set_error("mathieu_a", SF_ERROR_NO_RESULT, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Now cast back. - T a = static_cast(da); - return a; -} - -//------------------------------------------------------------- -template -/** - * Mathieu characteristic values (eigenvalues) b for odd functions. - * - * - * Odd parity characteristic values b. - * - * @param m Eigenvalue order. Must be positive integer less than 500. - * @param q Mathieu parameter q. Real number. - * @return Mathieu eigenvalue b. - */ -T sem_cva(T m, T q) { - // This returns the odd Mathieu characteristic value (eigenvalue) b. - - // Check for invalid Mathieu order. - if ((m < 1) || (m != floor(m))) { - set_error("mathieu_b", SF_ERROR_DOMAIN, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double db; - - int retcode = xsf::mathieu::mathieu_b(im, dq, &db); - if (retcode != SF_ERROR_OK) { - set_error("mathieu_b", SF_ERROR_NO_RESULT, NULL); - return std::numeric_limits::quiet_NaN(); - } - - // Now cast back. - T b = static_cast(db); - return b; -} - - -//--------------------------------------------------------------- -/* Mathieu functions */ -/** - * Even parity Mathieu angular function ce(m, q, x) - * - * This implementation of ce follows the definitions on the - * DLMF, https://dlmf.nist.gov/28 - * - * @param m Function order. Must be positive integer less than 500. - * @param q Parameter q. Real number. - * @param x Angular coordinate x (radians). Real number. - * @param csf Value of function. Real number. - * @param csd Value of derivative w.r.t. x. Real number. - */ -template -void cem(T m, T q, T x, T &csf, T &csd) { - - if ((m < 0) || (m != floor(m))) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_ce", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double dcsf; - double dcsd; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_ce(im, dq, dx, &dcsf, &dcsd); - if (retcode != SF_ERROR_OK) { - csf = std::numeric_limits::quiet_NaN(); - csd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_ce", (sf_error_t) retcode, NULL); - } else { - csf = static_cast(dcsf); - csd = static_cast(dcsd); - } - } -} - - -//--------------------------------------------------------------- -/** - * Odd parity Mathieu angular function se(m, q, x) - * - * This implementation of ce follows the definitions on the - * DLMF, https://dlmf.nist.gov/28 - * - * @param m Function order. Must be positive integer less than 500. - * @param q Parameter q. Real number. - * @param x Angular coordinate x (radians). Real number. - * @param ssf Value of function. Real number. - * @param ssd Value of derivative w.r.t. x. Real number - */ -template -void sem(T m, T q, T x, T &ssf, T &ssd) { - - if ((m < 1) || (m != floor(m))) { - ssf = std::numeric_limits::quiet_NaN(); - ssd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double dssf; - double dssd; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_se(im, dq, dx, &dssf, &dssd); - if (retcode != SF_ERROR_OK) { - ssf = std::numeric_limits::quiet_NaN(); - ssd = std::numeric_limits::quiet_NaN(); - set_error("mathieu_sem", (sf_error_t) retcode, NULL); - } else { - ssf = static_cast(dssf); - ssd = static_cast(dssd); - } - } -} - -//--------------------------------------------------------------- -/** - * Even parity modified (radial) Mathieu function of first kind Mc1(m, q, x) - * - * This implementation of ce follows the definitions on the - * DLMF, https://dlmf.nist.gov/28 - * - * @param m Function order. Must be positive integer less than 500. - * @param q Parameter q. Positive real number - * @param x Radial coordinate x. Positive real number. - * @param f1r Value of function. Real number. - * @param d1r Value of derivative w.r.t. x. Real number - */ -template -void mcm1(T m, T q, T x, T &f1r, T &d1r) { - - if ((m < 0) || (m != floor(m))) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm1", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df1r; - double dd1r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modmc1(im, dq, dx, &df1r, &dd1r); - if (retcode != SF_ERROR_OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm1", (sf_error_t) retcode, NULL); - } else { - f1r = static_cast(df1r); - d1r = static_cast(dd1r); - } - } -} - -//--------------------------------------------------------------- -/** - * Odd parity modified (radial) Mathieu function of first kind Ms1(m, q, x) - * - * This implementation of ce follows the definitions on the - * DLMF, https://dlmf.nist.gov/28 - * - * @param m Function order. Must be positive integer less than 500. - * @param q Parameter q. Positive real number - * @param x Radial coordinate x. Positive real number. - * @param f1r Value of function. Real number. - * @param d1r Value of derivative w.r.t. x. Real number - */ -template -void msm1(T m, T q, T x, T &f1r, T &d1r) { - - if ((m < 1) || (m != floor(m))) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm1", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df1r; - double dd1r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modms1(im, dq, dx, &df1r, &dd1r); - if (retcode != SF_ERROR_OK) { - f1r = std::numeric_limits::quiet_NaN(); - d1r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm1", (sf_error_t) retcode, NULL); - } else { - f1r = static_cast(df1r); - d1r = static_cast(dd1r); - } - } - -} - -//--------------------------------------------------------------- -/** - * Even parity modified (radial) Mathieu function of second kind Mc2(m, q, x) - * - * This implementation of ce follows the definitions on the - * DLMF, https://dlmf.nist.gov/28 - * - * @param m Function order. Must be positive integer less than 500. - * @param q Parameter q. Positive real number - * @param x Radial coordinate x. Positive real number. - * @param f2r Value of function. Real number. - * @param d2r Value of derivative w.r.t. x. Real number - */ -template -void mcm2(T m, T q, T x, T &f2r, T &d2r) { - - if ((m < 0) || (m != floor(m))) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm2", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df2r; - double dd2r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modmc2(im, dq, dx, &df2r, &dd2r); - if (retcode != SF_ERROR_OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_mcm2", (sf_error_t) retcode, NULL); - } else { - f2r = static_cast(df2r); - d2r = static_cast(dd2r); - } - } - -} - -//--------------------------------------------------------------- -/** - * Odd parity modified (radial) Mathieu function of second kind Ms2(m, q, x) - * - * This implementation of ce follows the definitions on the - * DLMF, https://dlmf.nist.gov/28 - * - * @param m Function order. Must be positive integer less than 500. - * @param q Parameter q. Positive real number - * @param x Radial coordinate x. Positive real number. - * @param f2r Value of function. Real number. - * @param d2r Value of derivative w.r.t. x. Real number - */ -template -void msm2(T m, T q, T x, T &f2r, T &d2r) { - - if ((m < 1) || (m != floor(m))) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm2", SF_ERROR_DOMAIN, NULL); - } else { - - // Must cast to correct types prior to fcn call. - int im = static_cast(m); - double dq = static_cast(q); - double dx = static_cast(x); - double df2r; - double dd2r; - - // Call fcn and cast back. - int retcode = xsf::mathieu::mathieu_modms2(im, dq, dx, &df2r, &dd2r); - if (retcode != SF_ERROR_OK) { - f2r = std::numeric_limits::quiet_NaN(); - d2r = std::numeric_limits::quiet_NaN(); - set_error("mathieu_msm2", (sf_error_t) retcode, NULL); - } else { - f2r = static_cast(df2r); - d2r = static_cast(dd2r); - } - } -} - - -} // namespace xsf From 7614c4e33a90edb2020ea155d6a787400afe3e64 Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Fri, 26 Sep 2025 20:08:40 -0400 Subject: [PATCH 10/12] run clang-format on all .h files. --- include/xsf/mathieu/besseljyd.h | 117 +- include/xsf/mathieu/make_matrix.h | 360 ++-- include/xsf/mathieu/mathieu_coeffs.h | 451 ++-- include/xsf/mathieu/mathieu_eigs.h | 383 ++-- include/xsf/mathieu/mathieu_fcns.h | 2882 +++++++++++++------------- include/xsf/mathieu/matrix_utils.h | 104 +- 6 files changed, 2145 insertions(+), 2152 deletions(-) diff --git a/include/xsf/mathieu/besseljyd.h b/include/xsf/mathieu/besseljyd.h index 1c3d46cef5..f47c4f44cb 100644 --- a/include/xsf/mathieu/besseljyd.h +++ b/include/xsf/mathieu/besseljyd.h @@ -1,9 +1,8 @@ #ifndef BESSELJYD_H #define BESSELJYD_H -#include "../config.h" #include "../bessel.h" - +#include "../config.h" /* * @@ -13,75 +12,75 @@ * of those fcns. * * Stuart Brorson -- Summer and Fall 2025. - * + * */ namespace xsf { namespace mathieu { - //================================================================== - double besselj(int k, double z) { - // This is just a thin wrapper around the Bessel impl in the - // xsf library. - double v = (double) k; - return xsf::cyl_bessel_j(v, z); - } - - //================================================================== - double bessely(int k, double z) { - // This is just a thin wrapper around the Bessel impl in the - // xsf library. - double v = (double) k; - return xsf::cyl_bessel_y(v, z); - } - - //================================================================== - double besseljd(int k, double z) { - // This returns the derivative of besselj. The deriv is - // computed using common identities. - double y; - - if (k == 0) { - double v = 1.0; - y = -besselj(v,z); - } else { - double kp1 = (double) (k+1); - double km1 = (double) (k-1); - y = (besselj(km1,z)-besselj(kp1,z))/2.0; + //================================================================== + double besselj(int k, double z) { + // This is just a thin wrapper around the Bessel impl in the + // xsf library. + double v = (double)k; + return xsf::cyl_bessel_j(v, z); } - // Must flip sign for negative k and odd k. - if (k<0 && ((k % 2) != 0)) { - y = -y; + //================================================================== + double bessely(int k, double z) { + // This is just a thin wrapper around the Bessel impl in the + // xsf library. + double v = (double)k; + return xsf::cyl_bessel_y(v, z); } - return y; - } + //================================================================== + double besseljd(int k, double z) { + // This returns the derivative of besselj. The deriv is + // computed using common identities. + double y; + + if (k == 0) { + double v = 1.0; + y = -besselj(v, z); + } else { + double kp1 = (double)(k + 1); + double km1 = (double)(k - 1); + y = (besselj(km1, z) - besselj(kp1, z)) / 2.0; + } - //================================================================== - double besselyd(int k, double z) { - // This returns the derivative of besselj. The deriv is - // computed using common identities. - double y; - - if (k == 0) { - double v = 1.0; - y = -bessely(v,z); - } else { - double kp1 = (double) (k+1); - double km1 = (double) (k-1); - y = (bessely(km1,z)-bessely(kp1,z))/2.0; + // Must flip sign for negative k and odd k. + if (k < 0 && ((k % 2) != 0)) { + y = -y; + } + + return y; } - // Must flip sign for negative k and odd k. - if (k<0 && ((k % 2) != 0)) { - y = -y; + //================================================================== + double besselyd(int k, double z) { + // This returns the derivative of besselj. The deriv is + // computed using common identities. + double y; + + if (k == 0) { + double v = 1.0; + y = -bessely(v, z); + } else { + double kp1 = (double)(k + 1); + double km1 = (double)(k - 1); + y = (bessely(km1, z) - bessely(kp1, z)) / 2.0; + } + + // Must flip sign for negative k and odd k. + if (k < 0 && ((k % 2) != 0)) { + y = -y; + } + + return y; } - - return y; - } - -} // namespace xsf + } // namespace mathieu +} // namespace xsf -#endif // #ifndef BESSELJYD_H +#endif // #ifndef BESSELJYD_H diff --git a/include/xsf/mathieu/make_matrix.h b/include/xsf/mathieu/make_matrix.h index a327b4c227..bfd012c4ef 100644 --- a/include/xsf/mathieu/make_matrix.h +++ b/include/xsf/mathieu/make_matrix.h @@ -12,7 +12,7 @@ * which make the recursion matrices. * * Stuart Brorson, Summer 2025. - * + * */ #define SQRT2 1.414213562373095 @@ -20,193 +20,191 @@ namespace xsf { namespace mathieu { - /*----------------------------------------------- - This creates the recurrence relation matrix for - the even-even Mathieu fcns (ce_2n). - - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - - Output: - A = recurrence matrix (must be calloc'ed in caller). - - Return: - return code = SF_ERROR_OK if OK. - -------------------------------------------------*/ - int make_matrix_ee(int N, double q, double *A) { - int j; - int i; - - // Symmetrize matrix here, then fix in caller. - i = MATRIX_IDX(N, 0, 1); - A[i] = SQRT2*q; - i = MATRIX_IDX(N, 1, 0); - A[i] = SQRT2*q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 4.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j=2; j<=N-2; j++) { - i = MATRIX_IDX(N, j, j-1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0*j)*(2.0*j); - i = MATRIX_IDX(N, j, j+1); - A[i] = q; + /*----------------------------------------------- + This creates the recurrence relation matrix for + the even-even Mathieu fcns (ce_2n). + + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + + Output: + A = recurrence matrix (must be calloc'ed in caller). + + Return: + return code = SF_ERROR_OK if OK. + -------------------------------------------------*/ + int make_matrix_ee(int N, double q, double *A) { + int j; + int i; + + // Symmetrize matrix here, then fix in caller. + i = MATRIX_IDX(N, 0, 1); + A[i] = SQRT2 * q; + i = MATRIX_IDX(N, 1, 0); + A[i] = SQRT2 * q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 4.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j = 2; j <= N - 2; j++) { + i = MATRIX_IDX(N, j, j - 1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0 * j) * (2.0 * j); + i = MATRIX_IDX(N, j, j + 1); + A[i] = q; + } + + i = MATRIX_IDX(N, N - 1, N - 2); + A[i] = q; + i = MATRIX_IDX(N, N - 1, N - 1); + A[i] = (2.0 * (N - 1)) * (2.0 * (N - 1)); + + return SF_ERROR_OK; } - i = MATRIX_IDX(N, N-1, N-2); - A[i] = q; - i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0*(N-1))*(2.0*(N-1)); - - return SF_ERROR_OK; - } - - /*----------------------------------------------- - This creates the recurrence relation matrix for the - even-odd Mathieu fcns (ce_2n+1). - - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - - Output: - A = recurrence matrix (calloc in caller). - - Return: - return code = SF_ERROR_OK if OK. - -------------------------------------------------*/ - int make_matrix_eo(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 1.0+q; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 9.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j=2; j<=N-2; j++) { - i = MATRIX_IDX(N, j, j-1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0*j+1.0)*(2.0*j+1.0); - i = MATRIX_IDX(N, j, j+1); - A[i] = q; + /*----------------------------------------------- + This creates the recurrence relation matrix for the + even-odd Mathieu fcns (ce_2n+1). + + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + + Output: + A = recurrence matrix (calloc in caller). + + Return: + return code = SF_ERROR_OK if OK. + -------------------------------------------------*/ + int make_matrix_eo(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 1.0 + q; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 9.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j = 2; j <= N - 2; j++) { + i = MATRIX_IDX(N, j, j - 1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0 * j + 1.0) * (2.0 * j + 1.0); + i = MATRIX_IDX(N, j, j + 1); + A[i] = q; + } + + i = MATRIX_IDX(N, N - 1, N - 2); + A[i] = q; + i = MATRIX_IDX(N, N - 1, N - 1); + A[i] = (2.0 * (N - 1) + 1.0) * (2.0 * (N - 1) + 1.0); + + return SF_ERROR_OK; } - i = MATRIX_IDX(N, N-1, N-2); - A[i] = q; - i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0*(N-1)+1.0)*(2.0*(N-1)+1.0); - - return SF_ERROR_OK; - } - - /*----------------------------------------------- - This creates the recurrence relation matrix for - the odd-even Mathieu fcns (se_2n) -- sometimes called - se_2n+2. - - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - - Output: - A = recurrence matrix (calloc in caller). - - Return: - return code = SF_ERROR_OK if OK. - -------------------------------------------------*/ - int make_matrix_oe(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 4.0; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 16.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j=2; j<=N-2; j++) { - i = MATRIX_IDX(N, j, j-1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0*(j+1))*(2.0*(j+1)); - i = MATRIX_IDX(N, j, j+1); - A[i] = q; + /*----------------------------------------------- + This creates the recurrence relation matrix for + the odd-even Mathieu fcns (se_2n) -- sometimes called + se_2n+2. + + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + + Output: + A = recurrence matrix (calloc in caller). + + Return: + return code = SF_ERROR_OK if OK. + -------------------------------------------------*/ + int make_matrix_oe(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 4.0; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 16.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j = 2; j <= N - 2; j++) { + i = MATRIX_IDX(N, j, j - 1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0 * (j + 1)) * (2.0 * (j + 1)); + i = MATRIX_IDX(N, j, j + 1); + A[i] = q; + } + + i = MATRIX_IDX(N, N - 1, N - 2); + A[i] = q; + i = MATRIX_IDX(N, N - 1, N - 1); + A[i] = (2.0 * N) * (2.0 * N); + + return SF_ERROR_OK; } - i = MATRIX_IDX(N, N-1, N-2); - A[i] = q; - i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0*N)*(2.0*N); - - return SF_ERROR_OK; - } - - - /*----------------------------------------------- - This creates the recurrence relation matrix for - the odd-odd Mathieu fcns (se_2n+1). - - Inputs: - N = matrix size (related to max order desired). - q = shape parameter. - - Output: - A = recurrence matrix (calloc in caller). - - Return: - return code = SF_ERROR_OK if OK. - -------------------------------------------------*/ - int make_matrix_oo(int N, double q, double *A) { - int j; - int i; - - i = MATRIX_IDX(N, 0, 0); - A[i] = 1.0 - q; - i = MATRIX_IDX(N, 0, 1); - A[i] = q; - i = MATRIX_IDX(N, 1, 0); - A[i] = q; - i = MATRIX_IDX(N, 1, 1); - A[i] = 9.0; - i = MATRIX_IDX(N, 1, 2); - A[i] = q; - - for (j=2; j<=N-2; j++) { - i = MATRIX_IDX(N, j, j-1); - A[i] = q; - i = MATRIX_IDX(N, j, j); - A[i] = (2.0*j+1.0)*(2.0*j+1.0); - i = MATRIX_IDX(N, j, j+1); - A[i] = q; + /*----------------------------------------------- + This creates the recurrence relation matrix for + the odd-odd Mathieu fcns (se_2n+1). + + Inputs: + N = matrix size (related to max order desired). + q = shape parameter. + + Output: + A = recurrence matrix (calloc in caller). + + Return: + return code = SF_ERROR_OK if OK. + -------------------------------------------------*/ + int make_matrix_oo(int N, double q, double *A) { + int j; + int i; + + i = MATRIX_IDX(N, 0, 0); + A[i] = 1.0 - q; + i = MATRIX_IDX(N, 0, 1); + A[i] = q; + i = MATRIX_IDX(N, 1, 0); + A[i] = q; + i = MATRIX_IDX(N, 1, 1); + A[i] = 9.0; + i = MATRIX_IDX(N, 1, 2); + A[i] = q; + + for (j = 2; j <= N - 2; j++) { + i = MATRIX_IDX(N, j, j - 1); + A[i] = q; + i = MATRIX_IDX(N, j, j); + A[i] = (2.0 * j + 1.0) * (2.0 * j + 1.0); + i = MATRIX_IDX(N, j, j + 1); + A[i] = q; + } + + i = MATRIX_IDX(N, N - 1, N - 2); + A[i] = q; + i = MATRIX_IDX(N, N - 1, N - 1); + A[i] = (2.0 * N - 1.0) * (2.0 * N - 1.0); + + return SF_ERROR_OK; } - i = MATRIX_IDX(N, N-1, N-2); - A[i] = q; - i = MATRIX_IDX(N, N-1, N-1); - A[i] = (2.0*N-1.0)*(2.0*N-1.0); - - return SF_ERROR_OK; - } - - } // namespace mathieu } // namespace xsf - -#endif // #ifndef MAKE_MATRIX_H + +#endif // #ifndef MAKE_MATRIX_H diff --git a/include/xsf/mathieu/mathieu_coeffs.h b/include/xsf/mathieu/mathieu_coeffs.h index 3b04a74f97..3450ca0b9e 100644 --- a/include/xsf/mathieu/mathieu_coeffs.h +++ b/include/xsf/mathieu/mathieu_coeffs.h @@ -1,11 +1,11 @@ #ifndef MATHIEU_COEFFS_H #define MATHIEU_COEFFS_H -#include #include "../config.h" #include "../error.h" #include "make_matrix.h" #include "matrix_utils.h" +#include #define SQRT2 1.414213562373095 @@ -17,253 +17,250 @@ * series computing the Mathieu fcns. * * Stuart Brorson, Summer 2025. - * + * */ - /* DSYEV_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyev_( char* jobz, char* uplo, int* n, double* a, int* lda, - double* w, double* work, int* lwork, int* info ); +void dsyev_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); #ifdef __cplusplus } #endif - namespace xsf { namespace mathieu { - //------------------------------------------------------ - int mathieu_coeffs_ee(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order ce_2n Mathieu fcn. - // Allowed value of m = 0, 2, 4, 6, ... - // Inputs: - // N = size of recursion matrix to use. - // q = frequency parameter - // m = order of Mathieu fcn desired. - // Output: - // AA = length N vector preallocated to hold coeffs. - // Returns SF_ERROR_OK if all goes well. - - int retcode = SF_ERROR_OK; - - // Bail out if m is not even. - if (m % 2 != 0) return SF_ERROR_ARG; - - // Allocate recursion matrix - std::vector A(N*N); - - // Do EVD - retcode = make_matrix_ee(N,q,A.data()); - if (retcode != 0) { - return SF_ERROR_NO_RESULT; - } - - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - /* Query and allocate the optimal workspace */ - int lwork = -1; - dsyev_( V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode ); - lwork = (int)wkopt; - std::vector work(lwork); - - /* Solve eigenproblem */ - dsyev_( V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode ); - - // Check return code from dsyev and bail if it's not 0. - if (retcode != 0) { - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - //print_matrix(AA, N, 1); - - // Undo sqrt(2) in make_matrix by normalizing elet in first col by sqrt(2). - int idx; - int row = m/2; - idx = MATRIX_IDX(N, row, 0); - AA[0] = A[idx]/SQRT2; - // Transfer remaining elets in correct row to coeff vector. - for (int j = 1; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - return retcode; - } - - - //------------------------------------------------------ - int mathieu_coeffs_eo(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order ce_2n+1 Mathieu fcn. - // Allowed value of m = 1, 3, 5, 7 ... - - int retcode = SF_ERROR_OK; - - // Bail out if m is not odd. - if (m % 2 != 1) return SF_ERROR_ARG; - - // Allocate recursion matrix - std::vector A(N*N); - - // Do EVD - retcode = make_matrix_eo(N,q,A.data()); - if (retcode != 0) { - return SF_ERROR_NO_RESULT; - } - - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - - /* Query and allocate the optimal workspace */ - int lwork = -1; - dsyev_( V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode ); - lwork = (int)wkopt; - std::vector work(lwork); - - /* Solve eigenproblem */ - dsyev_( V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode ); - - // Check return code from dsyev and bail if it's not 0. - if (retcode != 0) { - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - //print_matrix(AA, N, 1); - - // Transfer correct row to coeff vector. - int idx; - int row = (m-1)/2; - // Transfer elets in correct row to coeff vector. - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; - } - return retcode; - } - - - //------------------------------------------------------ - int mathieu_coeffs_oe(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order se_2n Mathieu fcn. - // Allowed value of m = 2, 4, 6, ... - // Inputs: - // N = size of recursion matrix to use. - // q = frequency parameter - // m = order of Mathieu fcn desired. - // Output: - // AA = length N vector preallocated to hold coeffs. - // Returns 0 if all goes well. Must put check on calloc - // here. - - int retcode = SF_ERROR_OK; - - // Bail out if m is not even or >= 2. - if ((m % 2 != 0) || (m < 2)) return SF_ERROR_ARG; - - // Allocate recursion matrix - std::vector A(N*N); - - // Do EVD - retcode = make_matrix_oe(N,q,A.data()); - if (retcode != 0) { - return SF_ERROR_NO_RESULT; + //------------------------------------------------------ + int mathieu_coeffs_ee(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order ce_2n Mathieu fcn. + // Allowed value of m = 0, 2, 4, 6, ... + // Inputs: + // N = size of recursion matrix to use. + // q = frequency parameter + // m = order of Mathieu fcn desired. + // Output: + // AA = length N vector preallocated to hold coeffs. + // Returns SF_ERROR_OK if all goes well. + + int retcode = SF_ERROR_OK; + + // Bail out if m is not even. + if (m % 2 != 0) + return SF_ERROR_ARG; + + // Allocate recursion matrix + std::vector A(N * N); + + // Do EVD + retcode = make_matrix_ee(N, q, A.data()); + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + + // Check return code from dsyev and bail if it's not 0. + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + // print_matrix(AA, N, 1); + + // Undo sqrt(2) in make_matrix by normalizing elet in first col by sqrt(2). + int idx; + int row = m / 2; + idx = MATRIX_IDX(N, row, 0); + AA[0] = A[idx] / SQRT2; + // Transfer remaining elets in correct row to coeff vector. + for (int j = 1; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + return retcode; } - // Work in local scope. - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - - /* Query and allocate the optimal workspace */ - int lwork = -1; - dsyev_( V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode ); - lwork = (int)wkopt; - std::vector work(lwork); - - /* Solve eigenproblem */ - dsyev_( V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode ); - - // Bail out if dsyev doesn't return 0. - if (retcode != 0) { - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - //print_matrix(AA, N, 1); - - // Transfer remaining elets in correct row to coeff vector. - int idx; - int row = (m-2)/2; - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; + //------------------------------------------------------ + int mathieu_coeffs_eo(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order ce_2n+1 Mathieu fcn. + // Allowed value of m = 1, 3, 5, 7 ... + + int retcode = SF_ERROR_OK; + + // Bail out if m is not odd. + if (m % 2 != 1) + return SF_ERROR_ARG; + + // Allocate recursion matrix + std::vector A(N * N); + + // Do EVD + retcode = make_matrix_eo(N, q, A.data()); + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + + // Check return code from dsyev and bail if it's not 0. + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + // print_matrix(AA, N, 1); + + // Transfer correct row to coeff vector. + int idx; + int row = (m - 1) / 2; + // Transfer elets in correct row to coeff vector. + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + return retcode; } - return retcode; - } - - //------------------------------------------------------ - int mathieu_coeffs_oo(int N, double q, int m, double *AA) { - // Returns Fourier coeffs for the mth order se_2n+1 Mathieu fcn. - // Allowed value of m = 1, 3, 5, 7 ... - - int retcode = SF_ERROR_OK; - - // Bail out if m is not odd. - if (m % 2 != 1) return SF_ERROR_ARG; - - // Allocate recursion matrix - std::vector A(N*N); - - // Do EVD - retcode = make_matrix_oo(N,q,A.data()); - if (retcode != 0) { - return SF_ERROR_NO_RESULT; + //------------------------------------------------------ + int mathieu_coeffs_oe(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order se_2n Mathieu fcn. + // Allowed value of m = 2, 4, 6, ... + // Inputs: + // N = size of recursion matrix to use. + // q = frequency parameter + // m = order of Mathieu fcn desired. + // Output: + // AA = length N vector preallocated to hold coeffs. + // Returns 0 if all goes well. Must put check on calloc + // here. + + int retcode = SF_ERROR_OK; + + // Bail out if m is not even or >= 2. + if ((m % 2 != 0) || (m < 2)) + return SF_ERROR_ARG; + + // Allocate recursion matrix + std::vector A(N * N); + + // Do EVD + retcode = make_matrix_oe(N, q, A.data()); + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Work in local scope. + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + + // Bail out if dsyev doesn't return 0. + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + // print_matrix(AA, N, 1); + + // Transfer remaining elets in correct row to coeff vector. + int idx; + int row = (m - 2) / 2; + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + return retcode; } - // Work in local scope - char V[1] = {'V'}; - char U[1] = {'U'}; - double wkopt; - - /* Query and allocate the optimal workspace */ - int lwork = -1; - dsyev_( V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode ); - lwork = (int)wkopt; - std::vector work(lwork); - /* Solve eigenproblem */ - dsyev_( V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode ); - - // Bail out if dsyev didn't return 0; - if (retcode != 0) { - return SF_ERROR_NO_RESULT; - } - - // Sort AA vector from lowest to highest - // quickSort(AA, 0, N-1); - //print_matrix(AA, N, 1); - - // Transfer correct row to coeff vector. - int idx; - int row = (m-1)/2; - // Transfer elets in correct row to coeff vector. - for (int j = 0; j < N; j++) { - idx = MATRIX_IDX(N, row, j); - AA[j] = A[idx]; + //------------------------------------------------------ + int mathieu_coeffs_oo(int N, double q, int m, double *AA) { + // Returns Fourier coeffs for the mth order se_2n+1 Mathieu fcn. + // Allowed value of m = 1, 3, 5, 7 ... + + int retcode = SF_ERROR_OK; + + // Bail out if m is not odd. + if (m % 2 != 1) + return SF_ERROR_ARG; + + // Allocate recursion matrix + std::vector A(N * N); + + // Do EVD + retcode = make_matrix_oo(N, q, A.data()); + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Work in local scope + char V[1] = {'V'}; + char U[1] = {'U'}; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + std::vector work(lwork); + /* Solve eigenproblem */ + dsyev_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + + // Bail out if dsyev didn't return 0; + if (retcode != 0) { + return SF_ERROR_NO_RESULT; + } + + // Sort AA vector from lowest to highest + // quickSort(AA, 0, N-1); + // print_matrix(AA, N, 1); + + // Transfer correct row to coeff vector. + int idx; + int row = (m - 1) / 2; + // Transfer elets in correct row to coeff vector. + for (int j = 0; j < N; j++) { + idx = MATRIX_IDX(N, row, j); + AA[j] = A[idx]; + } + return retcode; } - return retcode; - } - } // namespace mathieu } // namespace xsf -#endif // #ifndef MATHIEU_COEFFS_H +#endif // #ifndef MATHIEU_COEFFS_H diff --git a/include/xsf/mathieu/mathieu_eigs.h b/include/xsf/mathieu/mathieu_eigs.h index 3b5693968f..d78693e2b3 100644 --- a/include/xsf/mathieu/mathieu_eigs.h +++ b/include/xsf/mathieu/mathieu_eigs.h @@ -1,12 +1,11 @@ #ifndef MATHIEU_EIGS_H #define MATHIEU_EIGS_H -#include #include "../config.h" #include "../error.h" #include "make_matrix.h" #include "matrix_utils.h" - +#include /* * @@ -16,215 +15,211 @@ * b as a function of parameter q. * * Stuart Brorson, summer 2025. - * + * */ - /* DSYEV_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyev_( char* jobz, char* uplo, int* n, double* a, int* lda, - double* w, double* work, int* lwork, int* info ); +void dsyev_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); #ifdef __cplusplus } #endif - namespace xsf { namespace mathieu { - //------------------------------------------------------ - // This is the Mathieu characteristic value (eigenvalue) - // a for even fcns. - int mathieu_a(int m, double q, double *a) { - // printf("--> mathieu_a, m = %d, q = %e\n", m, q); - - int N = m+25; // Sets size of recursion matrix - int retcode = SF_ERROR_OK; - - if (m>500) { - // Don't support absurdly larger orders for now. - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; - } - - // Allocate recursion matrix - std::vector A(N*N); - - // Allocate vector for eigenvalues - std::vector ww(N); - - // Do EVD - if (m % 2 == 0) { - // Even order m - retcode = make_matrix_ee(N,q,A.data()); - if (retcode != SF_ERROR_OK){ - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_OTHER; // Not sure what went wrong. - } - - char V = 'V'; - char U = 'U'; - double wkopt; - - /* Query and allocate the optimal workspace */ - int lwork = -1; - dsyev_( &V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode ); - lwork = (int) wkopt; - std::vector work(lwork); - - /* Solve eigenproblem */ - dsyev_( &V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode ); - - // Check if dsyev was successful - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - //quickSort(ww, 0, N-1); - //print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = m/2; - *a = ww[idx]; - - } else { - // Odd order m - retcode = make_matrix_eo(N,q,A.data()); - if (retcode != SF_ERROR_OK) { - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_OTHER; - } - - char V = 'V'; - char U = 'U'; - double wkopt; - - /* Query and allocate the optimal workspace */ - int lwork = -1; - dsyev_( &V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode ); - lwork = (int) wkopt; - std::vector work(lwork); - - /* Solve eigenproblem */ - dsyev_( &V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode ); - - // Check if dsyev was successful - if (retcode != 0) { - *a = std::numeric_limits::quiet_NaN(); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - //quickSort(ww, 0, N-1); - //print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = (m-1)/2; - *a = ww[idx]; - } - - // printf("<-- mathieu_a\n"); - return retcode; - } - - //------------------------------------------------------ - int mathieu_b(int m, double q, double *b) { - // This computes the Mathieu characteristic value (eigenvalue) - // for odd fcns. - // printf("--> mathieu_b, m = %d, q = %e\n", m, q); - int N = m+25; // Sets size of recursion matrix - int retcode = SF_ERROR_OK; - - if (m>500) { - // Don't support absurdly larger orders for now. - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_DOMAIN; + //------------------------------------------------------ + // This is the Mathieu characteristic value (eigenvalue) + // a for even fcns. + int mathieu_a(int m, double q, double *a) { + // printf("--> mathieu_a, m = %d, q = %e\n", m, q); + + int N = m + 25; // Sets size of recursion matrix + int retcode = SF_ERROR_OK; + + if (m > 500) { + // Don't support absurdly larger orders for now. + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + // Allocate recursion matrix + std::vector A(N * N); + + // Allocate vector for eigenvalues + std::vector ww(N); + + // Do EVD + if (m % 2 == 0) { + // Even order m + retcode = make_matrix_ee(N, q, A.data()); + if (retcode != SF_ERROR_OK) { + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_OTHER; // Not sure what went wrong. + } + + char V = 'V'; + char U = 'U'; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); + + // Check if dsyev was successful + if (retcode != 0) { + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + // quickSort(ww, 0, N-1); + // print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = m / 2; + *a = ww[idx]; + + } else { + // Odd order m + retcode = make_matrix_eo(N, q, A.data()); + if (retcode != SF_ERROR_OK) { + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_OTHER; + } + + char V = 'V'; + char U = 'U'; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); + + // Check if dsyev was successful + if (retcode != 0) { + *a = std::numeric_limits::quiet_NaN(); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + // quickSort(ww, 0, N-1); + // print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m - 1) / 2; + *a = ww[idx]; + } + + // printf("<-- mathieu_a\n"); + return retcode; } - // Allocate recursion matrix - std::vector B(N*N); - - // Allocate vector for eigenvalues - std::vector ww(N); - - // Do EVD - if (m % 2 == 0) { - // Even order m - retcode = make_matrix_oe(N,q,B.data()); - if (retcode != SF_ERROR_OK) { - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_OTHER; - } - - char V = 'V'; - char U = 'U'; - double wkopt; - - /* Query and allocate the optimal workspace */ - int lwork = -1; - dsyev_( &V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode ); - lwork = (int) wkopt; - std::vector work(lwork); - - /* Solve eigenproblem */ - dsyev_( &V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode ); - - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - // quickSort(ww, 0, N-1); - //print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = (m-2)/2; - *b = ww[idx]; - - } else { - // Odd order m - retcode = make_matrix_oo(N,q,B.data()); - if (retcode != SF_ERROR_OK) { - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_OTHER; - } - - char V = 'V'; - char U = 'U'; - double wkopt; - - /* Query and allocate the optimal workspace */ - int lwork = -1; - dsyev_( &V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode ); - lwork = (int) wkopt; - std::vector work(lwork); - /* Solve eigenproblem */ - dsyev_( &V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode ); - - if (retcode != 0) { - *b = std::numeric_limits::quiet_NaN(); - return SF_ERROR_NO_RESULT; - } - - // Sort ww vector from lowest to highest - //quickSort(ww, 0, N-1); - //print_matrix(ww, N, 1); - - // Now figure out which one to return. - int idx = (m-1)/2; - *b = ww[idx]; - + //------------------------------------------------------ + int mathieu_b(int m, double q, double *b) { + // This computes the Mathieu characteristic value (eigenvalue) + // for odd fcns. + // printf("--> mathieu_b, m = %d, q = %e\n", m, q); + int N = m + 25; // Sets size of recursion matrix + int retcode = SF_ERROR_OK; + + if (m > 500) { + // Don't support absurdly larger orders for now. + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_DOMAIN; + } + + // Allocate recursion matrix + std::vector B(N * N); + + // Allocate vector for eigenvalues + std::vector ww(N); + + // Do EVD + if (m % 2 == 0) { + // Even order m + retcode = make_matrix_oe(N, q, B.data()); + if (retcode != SF_ERROR_OK) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_OTHER; + } + + char V = 'V'; + char U = 'U'; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + std::vector work(lwork); + + /* Solve eigenproblem */ + dsyev_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); + + if (retcode != 0) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + // quickSort(ww, 0, N-1); + // print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m - 2) / 2; + *b = ww[idx]; + + } else { + // Odd order m + retcode = make_matrix_oo(N, q, B.data()); + if (retcode != SF_ERROR_OK) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_OTHER; + } + + char V = 'V'; + char U = 'U'; + double wkopt; + + /* Query and allocate the optimal workspace */ + int lwork = -1; + dsyev_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + lwork = (int)wkopt; + std::vector work(lwork); + /* Solve eigenproblem */ + dsyev_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); + + if (retcode != 0) { + *b = std::numeric_limits::quiet_NaN(); + return SF_ERROR_NO_RESULT; + } + + // Sort ww vector from lowest to highest + // quickSort(ww, 0, N-1); + // print_matrix(ww, N, 1); + + // Now figure out which one to return. + int idx = (m - 1) / 2; + *b = ww[idx]; + } + + // printf("<-- mathieu_b\n"); + return retcode; } - // printf("<-- mathieu_b\n"); - return retcode; - } - } // namespace mathieu } // namespace xsf diff --git a/include/xsf/mathieu/mathieu_fcns.h b/include/xsf/mathieu/mathieu_fcns.h index 30f58179f5..a6a565460f 100644 --- a/include/xsf/mathieu/mathieu_fcns.h +++ b/include/xsf/mathieu/mathieu_fcns.h @@ -1,14 +1,13 @@ #ifndef MATHIEU_FCNS_H #define MATHIEU_FCNS_H -#include #include "../config.h" #include "../error.h" -#include -#include "matrix_utils.h" -#include "mathieu_coeffs.h" #include "besseljyd.h" - +#include "mathieu_coeffs.h" +#include "matrix_utils.h" +#include +#include /* * @@ -18,1455 +17,1464 @@ * and validated. This is a translation from Matlab to C++. * * Stuart Brorson, Summer 2025. - * + * */ namespace xsf { namespace mathieu { - // Forward declarations - int check_angular_fcn_domain(int m, double q); - int check_modified_fcn_domain(int m, double q); - int set_adaptive_offset_c(int m, double q); - - //================================================================== - int mathieu_ce(int m, double q, double v, double *ce, double *ced) { - // This computes the Mathieu fcn ce - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // v = angle in radians (scalar) - // Outputs: - // ce = value of fcn for these inputs (scalar) - // ced = value of fcn deriv w.r.t. v for these inputs (scalar) - // Return code: - // Codes in error.h. - - int retcode = SF_ERROR_OK; - - // Check inputs. Note that retcode can include SF_ERROR_LOSS - // but the program can keep going in that case. - retcode = check_angular_fcn_domain(m,q); - if (retcode == SF_ERROR_DOMAIN) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return retcode; + // Forward declarations + int check_angular_fcn_domain(int m, double q); + int check_modified_fcn_domain(int m, double q); + int set_adaptive_offset_c(int m, double q); + + //================================================================== + int mathieu_ce(int m, double q, double v, double *ce, double *ced) { + // This computes the Mathieu fcn ce + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // v = angle in radians (scalar) + // Outputs: + // ce = value of fcn for these inputs (scalar) + // ced = value of fcn deriv w.r.t. v for these inputs (scalar) + // Return code: + // Codes in error.h. + + int retcode = SF_ERROR_OK; + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_angular_fcn_domain(m, q); + if (retcode == SF_ERROR_DOMAIN) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order + + // Get coeff vector for even ce + std::vector AA(N); + retcode = mathieu_coeffs_ee(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, cep, cem, cedp, cedm; + cem = 0.0; + cep = 0.0; + cedm = 0.0; + cedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + tt = AA[k] * cos(2.0 * k * v); // Term for Mathieu ce + if (tt < 0) { + cem = cem + tt; // Neg running sum + } else { + cep = cep + tt; // Pos running sum + } + + td = -2.0 * k * AA[k] * sin(2.0 * k * v); // Term for deriv + if (td < 0) { + cedm = cedm + td; + } else { + cedp = cedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *ce = cep + cem; + *ced = cedp + cedm; + + // This makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l < N; l++) { + s = s + AA[l]; + } + *ce = SIGN(s) * (*ce); + *ced = SIGN(s) * (*ced); + + } else { + // Odd order + + // Get coeff vector for odd ce + std::vector AA(N); + + retcode = mathieu_coeffs_eo(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *ce = std::numeric_limits::quiet_NaN(); + *ced = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, cep, cem, cedp, cedm; + cem = 0.0; + cep = 0.0; + cedm = 0.0; + cedp = 0.0; + + // Perform Fourier sum on k = 0, 2, 4, ... + for (int k = (N - 1); k >= 0; k--) { + tt = AA[k] * cos((2.0 * k + 1.0) * v); // Term for Mathieu ce + if (tt < 0) { + cem = cem + tt; // Neg running sum + } else { + cep = cep + tt; // Pos running sum + } + + td = -(2.0 * k + 1.0) * AA[k] * sin((2.0 * k + 1.0) * v); // Deriv. + if (td < 0) { + cedm = cedm + td; + } else { + cedp = cedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *ce = cep + cem; + *ced = cedp + cedm; + + // This makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l < N; l++) { + s = s + AA[l]; + } + *ce = SIGN(s) * (*ce); + *ced = SIGN(s) * (*ced); + + } // if (m % 2 == 0) + + return retcode; } - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even order - - // Get coeff vector for even ce - std::vector AA(N); - retcode = mathieu_coeffs_ee(N,q,m, AA.data()); - if (retcode != SF_ERROR_OK) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, cep, cem, cedp, cedm; - cem = 0.0; cep = 0.0; cedm = 0.0; cedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - tt = AA[k]*cos(2.0*k*v); // Term for Mathieu ce - if (tt<0) { - cem = cem + tt; // Neg running sum - } else { - cep = cep + tt; // Pos running sum - } - - td = -2.0*k*AA[k]*sin(2.0*k*v); // Term for deriv - if (td<0) { - cedm = cedm + td; - } else { - cedp = cedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *ce = cep+cem; - *ced = cedp+cedm; - - // This makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l AA(N); - - retcode = mathieu_coeffs_eo(N,q,m, AA.data()); - if (retcode != SF_ERROR_OK) { - *ce = std::numeric_limits::quiet_NaN(); - *ced = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, cep, cem, cedp, cedm; - cem = 0.0; cep = 0.0; cedm = 0.0; cedp = 0.0; - - // Perform Fourier sum on k = 0, 2, 4, ... - for (int k=(N-1); k>=0 ; k--) { - tt = AA[k]*cos((2.0*k+1.0)*v); // Term for Mathieu ce - if (tt<0) { - cem = cem + tt; // Neg running sum - } else { - cep = cep + tt; // Pos running sum - } - - td = -(2.0*k+1.0)*AA[k]*sin((2.0*k+1.0)*v); // Deriv. - if (td<0) { - cedm = cedm + td; - } else { - cedp = cedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *ce = cep+cem; - *ced = cedp+cedm; - - // This makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even order. - - // Get coeff vector for even se - std::vector BB(N); - - retcode = mathieu_coeffs_oe(N,q,m, BB.data()); - if (retcode != SF_ERROR_OK) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, sep, sem, sedp, sedm; - sem = 0.0; sep = 0.0; sedm = 0.0; sedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k=N; k>=1 ; k--) { - tt = BB[k-1]*sin(2.0*k*v); // Mathieu se term - if (tt<0) { - sem = sem + tt; // Neg running sum - } else { - sep = sep + tt; // Pos running sum - } - - td = 2.0*k*BB[k-1]*cos(2.0*k*v); // Deriv term. - if (td<0) { - sedm = sedm + td; - } else { - sedp = sedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *se = sep+sem; - *sed = sedp+sedm; - - // This makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l BB(N); - - retcode = mathieu_coeffs_oo(N,q,m, BB.data()); - if (retcode != SF_ERROR_OK) { - *se = std::numeric_limits::quiet_NaN(); - *sed = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - double tt, td, sep, sem, sedp, sedm; - sem = 0.0; sep = 0.0; sedm = 0.0; sedp = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - tt = BB[k]*sin((2.0*k+1.0)*v); // Mathieu se term - if (tt<0) { - sem = sem + tt; // Neg running sum - } else { - sep = sep + tt; // Pos running sum - } - - td = (2.0*k+1.0)*BB[k]*cos((2.0*k+1.0)*v); // Deriv term. - if (td<0) { - sedm = sedm + td; - } else { - sedp = sedp + td; - } - } // for (k=(N-1) ... - - // I should do a sort before doing the sum - *se = sep+sem; - *sed = sedp+sedm; - - // This makes sure the fcn has the right overall sign for q<0. - // Someday combine this with the above sums into the same for loop. - double s = 0.0; - for (int l = 0; l::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order. + + // Get coeff vector for even se + std::vector BB(N); + + retcode = mathieu_coeffs_oe(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, sep, sem, sedp, sedm; + sem = 0.0; + sep = 0.0; + sedm = 0.0; + sedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k = N; k >= 1; k--) { + tt = BB[k - 1] * sin(2.0 * k * v); // Mathieu se term + if (tt < 0) { + sem = sem + tt; // Neg running sum + } else { + sep = sep + tt; // Pos running sum + } + + td = 2.0 * k * BB[k - 1] * cos(2.0 * k * v); // Deriv term. + if (td < 0) { + sedm = sedm + td; + } else { + sedp = sedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *se = sep + sem; + *sed = sedp + sedm; + + // This makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l < N; l++) { + s = s + BB[l]; + } + *se = SIGN(s) * (*se); + *sed = SIGN(s) * (*sed); + + } else { + // Odd order + + // Get coeff vector for odd se + std::vector BB(N); + + retcode = mathieu_coeffs_oo(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *se = std::numeric_limits::quiet_NaN(); + *sed = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + double tt, td, sep, sem, sedp, sedm; + sem = 0.0; + sep = 0.0; + sedm = 0.0; + sedp = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + tt = BB[k] * sin((2.0 * k + 1.0) * v); // Mathieu se term + if (tt < 0) { + sem = sem + tt; // Neg running sum + } else { + sep = sep + tt; // Pos running sum + } + + td = (2.0 * k + 1.0) * BB[k] * cos((2.0 * k + 1.0) * v); // Deriv term. + if (td < 0) { + sedm = sedm + td; + } else { + sedp = sedp + td; + } + } // for (k=(N-1) ... + + // I should do a sort before doing the sum + *se = sep + sem; + *sed = sedp + sedm; + + // This makes sure the fcn has the right overall sign for q<0. + // Someday combine this with the above sums into the same for loop. + double s = 0.0; + for (int l = 0; l < N; l++) { + s = s + BB[l]; + } + *se = SIGN(s) * (*se); + *sed = SIGN(s) * (*sed); + } + + return retcode; + } // int mathieu_se + + //================================================================== + int mathieu_modmc1(int m, double q, double u, double *mc1, double *mc1d) { + // This computes the Mathieu fcn modmc1 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // mc1 = value of fcn for these inputs (scalar) + // mc1d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_modified_fcn_domain(m, q); + if (retcode == SF_ERROR_DOMAIN) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq * expmu; + double t = sqq * exppu; + + // Set offset c for adaptive calc. + c = set_adaptive_offset_c(m, q); + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order + + // Get coeff vector for even modmc1 + std::vector AA(N); + retcode = mathieu_coeffs_ee(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Local scope variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign, and I want to + // avoid catastrophic cancellation. + _Float128 mc1p, mc1m, mc1dp, mc1dm; + mc1p = 0.0; + mc1m = 0.0; + mc1dp = 0.0; + mc1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Jkt = besselj(k, t); + double Jdks = besseljd(k, s); + double Jdkt = besseljd(k, t); + + _Float128 tt = AA[k] * (Jks * Jkt); + _Float128 ttd = AA[k] * (exppu * Jks * Jdkt - expmu * Jdks * Jkt); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c, s); + double Jkpct = besselj(k + c, t); + double Jkmct = besselj(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c, s); + double Jdkpct = besseljd(k + c, t); + double Jdkmct = besseljd(k - c, t); + + _Float128 tt = AA[k] * (Jkmcs * Jkpct + Jkpcs * Jkmct); + _Float128 ttd = + AA[k] * (exppu * (Jkmcs * Jdkpct + Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct + Jdkpcs * Jkmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *mc1 = static_cast(mc1p + mc1m); + *mc1d = static_cast(mc1dp + mc1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = m / 2; + if (sgn % 2 == 0) { + *mc1 = (*mc1) / AA[c]; + *mc1d = sqq * (*mc1d) / AA[c]; + } else { + *mc1 = -(*mc1) / AA[c]; + *mc1d = -sqq * (*mc1d) / AA[c]; + } + + } else { + // Odd order -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd modmc1 + std::vector AA(N); + retcode = mathieu_coeffs_eo(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *mc1 = std::numeric_limits::quiet_NaN(); + *mc1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 mc1p, mc1m, mc1dp, mc1dm; + mc1p = 0.0; + mc1m = 0.0; + mc1dp = 0.0; + mc1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Jkp1s = besselj(k + 1, s); + double Jkt = besselj(k, t); + double Jkp1t = besselj(k + 1, t); + + double Jdks = besseljd(k, s); + double Jdkp1s = besseljd(k + 1, s); + double Jdkt = besseljd(k, t); + double Jdkp1t = besseljd(k + 1, t); + + _Float128 tt = AA[k] * (Jks * Jkp1t + Jkp1s * Jkt); + _Float128 ttd = + AA[k] * (exppu * (Jks * Jdkp1t + Jkp1s * Jdkt) - expmu * (Jdks * Jkp1t + Jdkp1s * Jkt)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c + 1, s); + double Jkpct = besselj(k + c + 1, t); + double Jkmct = besselj(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c + 1, s); + double Jdkpct = besseljd(k + c + 1, t); + double Jdkmct = besseljd(k - c, t); + + _Float128 tt = AA[k] * (Jkmcs * Jkpct + Jkpcs * Jkmct); + _Float128 ttd = + AA[k] * (exppu * (Jkmcs * Jdkpct + Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct + Jdkpcs * Jkmct)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc1m = mc1m + tt; + } else { + // Pos terms + mc1p = mc1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc1dm = mc1dm + ttd; + } else { + // Pos terms + mc1dp = mc1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *mc1 = static_cast(mc1p + mc1m); + *mc1d = static_cast(mc1dp + mc1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 1) / 2; + if (sgn % 2 == 0) { + *mc1 = (*mc1) / AA[c]; + *mc1d = sqq * (*mc1d) / AA[c]; + } else { + *mc1 = -(*mc1) / AA[c]; + *mc1d = -sqq * (*mc1d) / AA[c]; + } + } + + return retcode; + } // int mathieu_modmc1 + + //================================================================== + int mathieu_modms1(int m, double q, double u, double *ms1, double *ms1d) { + // This computes the Mathieu fcn modms1 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // ms1 = value of fcn for these inputs (scalar) + // ms1d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_modified_fcn_domain(m, q); + if (retcode == SF_ERROR_DOMAIN) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq * expmu; + double t = sqq * exppu; + + // Set offset c for adaptive calc. + c = set_adaptive_offset_c(m, q); + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order + + // Get coeff vector for even modms1 + std::vector BB(N); + retcode = mathieu_coeffs_oe(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 ms1p, ms1m, ms1dp, ms1dm; + ms1p = 0.0; + ms1m = 0.0; + ms1dp = 0.0; + ms1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Jkp2t = besselj(k + 2, t); + double Jkp2s = besselj(k + 2, s); + double Jkt = besselj(k, t); + + double Jdks = besseljd(k, s); + double Jdkp2t = besseljd(k + 2, t); + double Jdkp2s = besseljd(k + 2, s); + double Jdkt = besseljd(k, t); + + _Float128 tt = BB[k] * (Jks * Jkp2t - Jkp2s * Jkt); + _Float128 ttd = + BB[k] * (exppu * (Jks * Jdkp2t - Jkp2s * Jdkt) - expmu * (Jdks * Jkp2t - Jdkp2s * Jkt)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpct = besselj(k + c + 2, t); + double Jkpcs = besselj(k + c + 2, s); + double Jkmct = besselj(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpct = besseljd(k + c + 2, t); + double Jdkpcs = besseljd(k + c + 2, s); + double Jdkmct = besseljd(k - c, t); + + _Float128 tt = BB[k] * (Jkmcs * Jkpct - Jkpcs * Jkmct); + _Float128 ttd = + BB[k] * (exppu * (Jkmcs * Jdkpct - Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct - Jdkpcs * Jkmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *ms1 = static_cast(ms1p + ms1m); + *ms1d = static_cast(ms1dp + ms1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 2) / 2; + if (sgn % 2 == 0) { + *ms1 = (*ms1) / BB[c]; + *ms1d = sqq * (*ms1d) / BB[c]; + } else { + *ms1 = -(*ms1) / BB[c]; + *ms1d = -sqq * (*ms1d) / BB[c]; + } + + } else { + // Odd order -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd modms1 + std::vector BB(N); + retcode = mathieu_coeffs_oo(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *ms1 = std::numeric_limits::quiet_NaN(); + *ms1d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 ms1p, ms1m, ms1dp, ms1dm; + ms1p = 0.0; + ms1m = 0.0; + ms1dp = 0.0; + ms1dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Jkt = besselj(k, t); + double Jkp1s = besselj(k + 1, s); + double Jkp1t = besselj(k + 1, t); + + double Jdks = besseljd(k, s); + double Jdkt = besseljd(k, t); + double Jdkp1s = besseljd(k + 1, s); + double Jdkp1t = besseljd(k + 1, t); + + _Float128 tt = BB[k] * (Jks * Jkp1t - Jkp1s * Jkt); + _Float128 ttd = + BB[k] * (exppu * (Jks * Jdkp1t - Jkp1s * Jdkt) - expmu * (Jdks * Jkp1t - Jdkp1s * Jkt)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c + 1, s); + double Jkpct = besselj(k + c + 1, t); + double Jkmct = besselj(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c + 1, s); + double Jdkpct = besseljd(k + c + 1, t); + double Jdkmct = besseljd(k - c, t); + + _Float128 tt = BB[k] * (Jkmcs * Jkpct - Jkpcs * Jkmct); + _Float128 ttd = + BB[k] * (exppu * (Jkmcs * Jdkpct - Jkpcs * Jdkmct) - expmu * (Jdkmcs * Jkpct - Jdkpcs * Jkmct)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms1m = ms1m + tt; + } else { + // Pos terms + ms1p = ms1p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms1dm = ms1dm + ttd; + } else { + // Pos terms + ms1dp = ms1dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *ms1 = static_cast(ms1p + ms1m); + *ms1d = static_cast(ms1dp + ms1dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 1) / 2; + if (sgn % 2 == 0) { + *ms1 = (*ms1) / BB[c]; + *ms1d = sqq * (*ms1d) / BB[c]; + } else { + *ms1 = -(*ms1) / BB[c]; + *ms1d = -sqq * (*ms1d) / BB[c]; + } + } + + return retcode; + } // int mathieu_modms1 + + //================================================================== + int mathieu_modmc2(int m, double q, double u, double *mc2, double *mc2d) { + // This computes the Mathieu fcn modmc2 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // mc2 = value of fcn for these inputs (scalar) + // mc2d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_modified_fcn_domain(m, q); + if (retcode == SF_ERROR_DOMAIN) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq * expmu; + double t = sqq * exppu; + + // Set offset c for adaptive calc. + c = set_adaptive_offset_c(m, q); + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order + + // Get coeff vector for even modmc2 + std::vector AA(N); + retcode = mathieu_coeffs_ee(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 mc2p, mc2m, mc2dp, mc2dm; + + // Sum from smallest to largest coeff. + mc2p = 0.0; + mc2m = 0.0; + mc2dp = 0.0; + mc2dm = 0.0; + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Ykt = bessely(k, t); + double Jdks = besseljd(k, s); + double Ydkt = besselyd(k, t); + + _Float128 tt = AA[k] * Jks * Ykt; + _Float128 ttd = AA[k] * (exppu * Jks * Ydkt - expmu * Jdks * Ykt); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c, s); + double Ykpct = bessely(k + c, t); + double Ykmct = bessely(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c, s); + double Ydkpct = besselyd(k + c, t); + double Ydkmct = besselyd(k - c, t); + + _Float128 tt = AA[k] * (Jkmcs * Ykpct + Jkpcs * Ykmct); + _Float128 ttd = + AA[k] * (exppu * (Jkmcs * Ydkpct + Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct + Jdkpcs * Ykmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *mc2 = static_cast(mc2p + mc2m); + *mc2d = static_cast(mc2dp + mc2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = m / 2; + if (sgn % 2 == 0) { + *mc2 = (*mc2) / AA[c]; + *mc2d = sqq * (*mc2d) / AA[c]; + } else { + *mc2 = -(*mc2) / AA[c]; + *mc2d = -sqq * (*mc2d) / AA[c]; + } + + } else { + // Odd order -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd mc2 + std::vector AA(N); + retcode = mathieu_coeffs_eo(N, q, m, AA.data()); + if (retcode != SF_ERROR_OK) { + *mc2 = std::numeric_limits::quiet_NaN(); + *mc2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 mc2p, mc2m, mc2dp, mc2dm; + mc2p = 0.0; + mc2m = 0.0; + mc2dp = 0.0; + mc2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Ykt = bessely(k, t); + double Jkp1s = besselj(k + 1, s); + double Ykp1t = bessely(k + 1, t); + + double Jdks = besseljd(k, s); + double Ydkt = besselyd(k, t); + double Jdkp1s = besseljd(k + 1, s); + double Ydkp1t = besselyd(k + 1, t); + + _Float128 tt = AA[k] * (Jks * Ykp1t + Jkp1s * Ykt); + _Float128 ttd = + AA[k] * (exppu * (Jks * Ydkp1t + Jkp1s * Ydkt) - expmu * (Jdks * Ykp1t + Jdkp1s * Ykt)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c + 1, s); + double Ykpct = bessely(k + c + 1, t); + double Ykmct = bessely(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c + 1, s); + double Ydkpct = besselyd(k + c + 1, t); + double Ydkmct = besselyd(k - c, t); + + _Float128 tt = AA[k] * (Jkmcs * Ykpct + Jkpcs * Ykmct); + _Float128 ttd = + AA[k] * (exppu * (Jkmcs * Ydkpct + Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct + Jdkpcs * Ykmct)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + mc2m = mc2m + tt; + } else { + // Pos terms + mc2p = mc2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + mc2dm = mc2dm + ttd; + } else { + // Pos terms + mc2dp = mc2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *mc2 = static_cast(mc2p + mc2m); + *mc2d = static_cast(mc2dp + mc2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 1) / 2; + if (sgn % 2 == 0) { + *mc2 = (*mc2) / AA[c]; + *mc2d = sqq * (*mc2d) / AA[c]; + } else { + *mc2 = -(*mc2) / AA[c]; + *mc2d = -sqq * (*mc2d) / AA[c]; + } + } + + return retcode; + } // int mathieu_modmc2 + + //================================================================== + int mathieu_modms2(int m, double q, double u, double *ms2, double *ms2d) { + // This computes the Mathieu fcn modms2 + // Inputs: + // m = Mathieu fcn order (scalar) + // q = frequency parameter (scalar) + // u = radial coord (scalar) + // Outputs: + // ms2 = value of fcn for these inputs (scalar) + // ms2d = value of fcn deriv w.r.t. u for these inputs (scalar) + // Return code: + // Success = 0 + + int retcode = SF_ERROR_OK; + int c; // Offset used in adaptive computation. + + // Check inputs. Note that retcode can include SF_ERROR_LOSS + // but the program can keep going in that case. + retcode = check_modified_fcn_domain(m, q); + if (retcode == SF_ERROR_DOMAIN) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // I find the peak Fourier coeff tracks m. Therefore, + // adjust the matrix size based on order m. Later make this + // a fcn of q also since the distribution of coeff mags allegedly + // flattens out for large q. + int N = m + 25; // N = size of recursion matrix to use. + + // Utility vars. + double sqq = sqrt(q); + double exppu = exp(u); + double expmu = exp(-u); + double s = sqq * expmu; + double t = sqq * exppu; + + // Set offset c for adaptive calc. + // c = set_adaptive_offset_c(m, q); + c = 0; // Turn off adaptive c in modms2 for now ... + + // Use different coeffs depending upon whether m is even or odd. + if (m % 2 == 0) { + // Even order m. + + // Get coeff vector for even modms2 + std::vector BB(N); + retcode = mathieu_coeffs_oe(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + // These are Float128 since some of the terms are near + // equal amplitude, but different sign. + _Float128 ms2p, ms2m, ms2dp, ms2dm; + ms2p = 0.0; + ms2m = 0.0; + ms2dp = 0.0; + ms2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Ykp2t = bessely(k + 2, t); + double Jkp2s = besselj(k + 2, s); + double Ykt = bessely(k, t); + + double Jdks = besseljd(k, s); + double Ydkp2t = besselyd(k + 2, t); + double Jdkp2s = besseljd(k + 2, s); + double Ydkt = besselyd(k, t); + + _Float128 tt = BB[k] * (Jks * Ykp2t - Jkp2s * Ykt); + _Float128 ttd = + BB[k] * (exppu * (Jks * Ydkp2t - Jkp2s * Ydkt) - expmu * (Jdks * Ykp2t - Jdkp2s * Ykt)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Ykpct = bessely(k + c + 2, t); + double Jkpcs = besselj(k + c + 2, s); + double Ykmct = bessely(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Ydkpct = besselyd(k + c + 2, t); + double Jdkpcs = besseljd(k + c + 2, s); + double Ydkmct = besselyd(k - c, t); + + _Float128 tt = BB[k] * (Jkmcs * Ykpct - Jkpcs * Ykmct); + _Float128 ttd = + BB[k] * (exppu * (Jkmcs * Ydkpct - Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct - Jdkpcs * Ykmct)); + + // Even terms have + sign, odd terms have - sign + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final result + *ms2 = static_cast(ms2p + ms2m); + *ms2d = static_cast(ms2dp + ms2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 2) / 2; + if (sgn % 2 == 0) { + *ms2 = (*ms2) / BB[c]; + *ms2d = sqq * (*ms2d) / BB[c]; + } else { + *ms2 = -(*ms2) / BB[c]; + *ms2d = -sqq * (*ms2d) / BB[c]; + } + + } else { + // Odd order -- m = 1, 3, 5, 7 ... + + // Get coeff vector for odd modms2 + std::vector BB(N); + retcode = mathieu_coeffs_oo(N, q, m, BB.data()); + if (retcode != SF_ERROR_OK) { + *ms2 = std::numeric_limits::quiet_NaN(); + *ms2d = std::numeric_limits::quiet_NaN(); + return retcode; + } + + // Variables used in summing the Fourier series. + _Float128 ms2p, ms2m, ms2dp, ms2dm; + ms2p = 0.0; + ms2m = 0.0; + ms2dp = 0.0; + ms2dm = 0.0; + + // Sum from smallest to largest coeff. + for (int k = (N - 1); k >= 0; k--) { + if (c == 0) { + // Non-adaptive calc + double Jks = besselj(k, s); + double Ykt = bessely(k, t); + double Jkp1s = besselj(k + 1, s); + double Ykp1t = bessely(k + 1, t); + + double Jdks = besseljd(k, s); + double Ydkt = besselyd(k, t); + double Jdkp1s = besseljd(k + 1, s); + double Ydkp1t = besselyd(k + 1, t); + + _Float128 tt = BB[k] * (Jks * Ykp1t - Jkp1s * Ykt); + _Float128 ttd = + BB[k] * (exppu * (Jks * Ydkp1t - Jkp1s * Ydkt) - expmu * (Jdks * Ykp1t - Jdkp1s * Ykt)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } else { + // Adaptive calc + double Jkmcs = besselj(k - c, s); + double Jkpcs = besselj(k + c + 1, s); + double Ykpct = bessely(k + c + 1, t); + double Ykmct = bessely(k - c, t); + + double Jdkmcs = besseljd(k - c, s); + double Jdkpcs = besseljd(k + c + 1, s); + double Ydkpct = besselyd(k + c + 1, t); + double Ydkmct = besselyd(k - c, t); + + _Float128 tt = BB[k] * (Jkmcs * Ykpct - Jkpcs * Ykmct); + _Float128 ttd = + BB[k] * (exppu * (Jkmcs * Ydkpct - Jkpcs * Ydkmct) - expmu * (Jdkmcs * Ykpct - Jdkpcs * Ykmct)); + + int sgn = (k % 2 == 0) ? 1 : -1; + + // Do sum using separate sums for + and - + tt = sgn * tt; + if (tt < 0) { + // Neg terms + ms2m = ms2m + tt; + } else { + // Pos terms + ms2p = ms2p + tt; + } + + // Do sum using separate sums for + and - + ttd = sgn * ttd; + if (ttd < 0) { + // Neg terms + ms2dm = ms2dm + ttd; + } else { + // Pos terms + ms2dp = ms2dp + ttd; + } + + } // if (c==0) + + } // for (int k=(N-1) ... + + // Sum pos and neg terms to get final answer + *ms2 = static_cast(ms2p + ms2m); + *ms2d = static_cast(ms2dp + ms2dm); + + // Do normalization. Note normalization depends upon c. + int sgn = (m - 1) / 2; + if (sgn % 2 == 0) { + *ms2 = (*ms2) / BB[c]; + *ms2d = sqq * (*ms2d) / BB[c]; + } else { + *ms2 = -(*ms2) / BB[c]; + *ms2d = -sqq * (*ms2d) / BB[c]; + } + } + + return retcode; + } // int mathieu_modms2 + + //================================================================ + // Helper fcns -- these help reduce the amount of redundant code. + + int check_angular_fcn_domain(int m, double q) { + // Verify inputs are OK. If not indicate err. + int retcode = SF_ERROR_OK; + + if (m > 500) { + // Don't support absurdly larger orders for now. + return SF_ERROR_DOMAIN; + } + + // abs(q) > 1000 leads to low accuracy. + if (abs(q) > 1.0e3d) + retcode = SF_ERROR_LOSS; + + return retcode; } - return retcode; - } // int mathieu_se - - - //================================================================== - int mathieu_modmc1(int m, double q, double u, double *mc1, double *mc1d) { - // This computes the Mathieu fcn modmc1 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // mc1 = value of fcn for these inputs (scalar) - // mc1d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check inputs. Note that retcode can include SF_ERROR_LOSS - // but the program can keep going in that case. - retcode = check_modified_fcn_domain(m,q); - if (retcode == SF_ERROR_DOMAIN) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return retcode; - } + //--------------------------------------------------- + int check_modified_fcn_domain(int m, double q) { + int retcode = SF_ERROR_OK; - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq*expmu; - double t = sqq*exppu; - - // Set offset c for adaptive calc. - c = set_adaptive_offset_c(m, q); - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even order - - // Get coeff vector for even modmc1 - std::vector AA(N); - retcode = mathieu_coeffs_ee(N, q, m, AA.data()); - if (retcode != SF_ERROR_OK) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Local scope variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign, and I want to - // avoid catastrophic cancellation. - _Float128 mc1p, mc1m, mc1dp, mc1dm; - mc1p = 0.0; mc1m = 0.0; mc1dp = 0.0; mc1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Jkt = besselj(k,t); - double Jdks = besseljd(k,s); - double Jdkt = besseljd(k,t); - - _Float128 tt = AA[k]*(Jks*Jkt); - _Float128 ttd = AA[k]*(exppu*Jks*Jdkt - expmu*Jdks*Jkt); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c,s); - double Jkpct = besselj(k+c,t); - double Jkmct = besselj(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c,s); - double Jdkpct = besseljd(k+c,t); - double Jdkmct = besseljd(k-c,t); - - _Float128 tt = AA[k]*(Jkmcs*Jkpct + Jkpcs*Jkmct); - _Float128 ttd = AA[k]* - (exppu*(Jkmcs*Jdkpct + Jkpcs*Jdkmct) - - expmu*(Jdkmcs*Jkpct + Jdkpcs*Jkmct)) ; - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *mc1 = static_cast(mc1p+mc1m); - *mc1d = static_cast(mc1dp+mc1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = m/2; - if (sgn%2 == 0) { - *mc1 = (*mc1)/AA[c]; - *mc1d = sqq*(*mc1d)/AA[c]; - } else { - *mc1 = -(*mc1)/AA[c]; - *mc1d = -sqq*(*mc1d)/AA[c]; - } - - } else { - // Odd order -- m = 1, 3, 5, 7 ... - - // Get coeff vector for odd modmc1 - std::vector AA(N); - retcode = mathieu_coeffs_eo(N, q, m, AA.data()); - if (retcode != SF_ERROR_OK) { - *mc1 = std::numeric_limits::quiet_NaN(); - *mc1d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 mc1p, mc1m, mc1dp, mc1dm; - mc1p = 0.0; mc1m = 0.0; mc1dp = 0.0; mc1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Jkp1s = besselj(k+1,s); - double Jkt = besselj(k,t); - double Jkp1t = besselj(k+1,t); - - double Jdks = besseljd(k,s); - double Jdkp1s = besseljd(k+1,s); - double Jdkt = besseljd(k,t); - double Jdkp1t = besseljd(k+1,t); - - _Float128 tt = AA[k]*(Jks*Jkp1t + Jkp1s*Jkt); - _Float128 ttd = AA[k]* - (exppu*(Jks*Jdkp1t + Jkp1s*Jdkt) - - expmu*(Jdks*Jkp1t + Jdkp1s*Jkt) ) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c+1,s); - double Jkpct = besselj(k+c+1,t); - double Jkmct = besselj(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c+1,s); - double Jdkpct = besseljd(k+c+1,t); - double Jdkmct = besseljd(k-c,t); - - _Float128 tt = AA[k]*(Jkmcs*Jkpct + Jkpcs*Jkmct); - _Float128 ttd = AA[k]* - (exppu*(Jkmcs*Jdkpct + Jkpcs*Jdkmct) - - expmu*(Jdkmcs*Jkpct + Jdkpcs*Jkmct)) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc1m = mc1m + tt; - } else { - // Pos terms - mc1p = mc1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc1dm = mc1dm + ttd; - } else { - // Pos terms - mc1dp = mc1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *mc1 = static_cast(mc1p+mc1m); - *mc1d = static_cast(mc1dp+mc1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-1)/2; - if (sgn%2 == 0) { - *mc1 = (*mc1)/AA[c]; - *mc1d = sqq*(*mc1d)/AA[c]; - } else { - *mc1 = -(*mc1)/AA[c]; - *mc1d = -sqq*(*mc1d)/AA[c]; - } + // Check input domain and flag any problems + if (m > 500) { + return SF_ERROR_DOMAIN; + } - } + if (q < 0) { + return SF_ERROR_DOMAIN; // q<0 is unimplemented + } - return retcode; - } // int mathieu_modmc1 - - - //================================================================== - int mathieu_modms1(int m, double q, double u, double *ms1, double *ms1d) { - // This computes the Mathieu fcn modms1 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // ms1 = value of fcn for these inputs (scalar) - // ms1d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check inputs. Note that retcode can include SF_ERROR_LOSS - // but the program can keep going in that case. - retcode = check_modified_fcn_domain(m,q); - if (retcode == SF_ERROR_DOMAIN) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return retcode; - } + // Don't need to bail out of main computation for these, just set retcode. + if (abs(q) > 1.0e3d) + retcode = SF_ERROR_LOSS; // q>1000 is inaccurate + if (m > 15 && q > 0.1d) + retcode = SF_ERROR_LOSS; - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq*expmu; - double t = sqq*exppu; - - // Set offset c for adaptive calc. - c = set_adaptive_offset_c(m, q); - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even order - - // Get coeff vector for even modms1 - std::vector BB(N); - retcode = mathieu_coeffs_oe(N, q, m, BB.data()); - if (retcode != SF_ERROR_OK) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 ms1p, ms1m, ms1dp, ms1dm; - ms1p = 0.0; ms1m = 0.0; ms1dp = 0.0; ms1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Jkp2t = besselj(k+2,t); - double Jkp2s = besselj(k+2,s); - double Jkt = besselj(k,t); - - double Jdks = besseljd(k,s); - double Jdkp2t = besseljd(k+2,t); - double Jdkp2s = besseljd(k+2,s); - double Jdkt = besseljd(k,t); - - _Float128 tt = BB[k]*(Jks*Jkp2t - Jkp2s*Jkt); - _Float128 ttd = BB[k]* - (exppu*(Jks*Jdkp2t - Jkp2s*Jdkt) - - expmu*(Jdks*Jkp2t - Jdkp2s*Jkt)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpct = besselj(k+c+2,t); - double Jkpcs = besselj(k+c+2,s); - double Jkmct = besselj(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpct = besseljd(k+c+2,t); - double Jdkpcs = besseljd(k+c+2,s); - double Jdkmct = besseljd(k-c,t); - - _Float128 tt = BB[k]*(Jkmcs*Jkpct - Jkpcs*Jkmct); - _Float128 ttd = BB[k]* - (exppu*(Jkmcs*Jdkpct - Jkpcs*Jdkmct) - - expmu*(Jdkmcs*Jkpct - Jdkpcs*Jkmct)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *ms1 = static_cast(ms1p+ms1m); - *ms1d = static_cast(ms1dp+ms1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-2)/2; - if (sgn%2 == 0) { - *ms1 = (*ms1)/BB[c]; - *ms1d = sqq*(*ms1d)/BB[c]; - } else { - *ms1 = -(*ms1)/BB[c]; - *ms1d = -sqq*(*ms1d)/BB[c]; - } - - } else { - // Odd order -- m = 1, 3, 5, 7 ... - - // Get coeff vector for odd modms1 - std::vector BB(N); - retcode = mathieu_coeffs_oo(N, q, m, BB.data()); - if (retcode != SF_ERROR_OK) { - *ms1 = std::numeric_limits::quiet_NaN(); - *ms1d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 ms1p, ms1m, ms1dp, ms1dm; - ms1p = 0.0; ms1m = 0.0; ms1dp = 0.0; ms1dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Jkt = besselj(k,t); - double Jkp1s = besselj(k+1,s); - double Jkp1t = besselj(k+1,t); - - double Jdks = besseljd(k,s); - double Jdkt = besseljd(k,t); - double Jdkp1s = besseljd(k+1,s); - double Jdkp1t = besseljd(k+1,t); - - _Float128 tt = BB[k]*(Jks*Jkp1t - Jkp1s*Jkt); - _Float128 ttd = BB[k]* - (exppu*(Jks*Jdkp1t - Jkp1s*Jdkt) - - expmu*(Jdks*Jkp1t - Jdkp1s*Jkt)); - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c+1,s); - double Jkpct = besselj(k+c+1,t); - double Jkmct = besselj(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c+1,s); - double Jdkpct = besseljd(k+c+1,t); - double Jdkmct = besseljd(k-c,t); - - _Float128 tt = BB[k]*(Jkmcs*Jkpct - Jkpcs*Jkmct); - _Float128 ttd = BB[k]* - (exppu*(Jkmcs*Jdkpct - Jkpcs*Jdkmct) - - expmu*(Jdkmcs*Jkpct - Jdkpcs*Jkmct)) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms1m = ms1m + tt; - } else { - // Pos terms - ms1p = ms1p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms1dm = ms1dm + ttd; - } else { - // Pos terms - ms1dp = ms1dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *ms1 = static_cast(ms1p+ms1m); - *ms1d = static_cast(ms1dp+ms1dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-1)/2; - if (sgn%2 == 0) { - *ms1 = (*ms1)/BB[c]; - *ms1d = sqq*(*ms1d)/BB[c]; - } else { - *ms1 = -(*ms1)/BB[c]; - *ms1d = -sqq*(*ms1d)/BB[c]; - } - + return retcode; } - return retcode; - } // int mathieu_modms1 - - - //================================================================== - int mathieu_modmc2(int m, double q, double u, double *mc2, double *mc2d) { - // This computes the Mathieu fcn modmc2 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // mc2 = value of fcn for these inputs (scalar) - // mc2d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check inputs. Note that retcode can include SF_ERROR_LOSS - // but the program can keep going in that case. - retcode = check_modified_fcn_domain(m,q); - if (retcode == SF_ERROR_DOMAIN) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return retcode; + //--------------------------------------------------- + int set_adaptive_offset_c(int m, double q) { + // This is used to set the c used in the adaptive computation. + // I set the offset used in Bessel fcn depending upon order m + // and shape/frequency parameter q. This improves the accuracy + // for larger values of m. + // The idea comes from the book "Accurate Computation of Mathieu Functions", + // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper + // "Accurate calculation of the modified Mathieu functions of + // integer order", Van Buren & Boisvert. The values I use here + // were found from experiment using my Matlab prototype. However, + // better values are likely -- finding them is a future project. + int c; + + if ((m > 5 && q < .001) || (m > 7 && q < .01) || (m > 10 && q < .1) || (m > 15 && q < 1) || + (m > 20 && q < 10) || (m > 30 && q < 100)) { + c = m / 2; + } else { + c = 0; + } + + return c; } - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq*expmu; - double t = sqq*exppu; - - // Set offset c for adaptive calc. - c = set_adaptive_offset_c(m, q); - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even order - - // Get coeff vector for even modmc2 - std::vector AA(N); - retcode = mathieu_coeffs_ee(N, q, m, AA.data()); - if (retcode != SF_ERROR_OK) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 mc2p, mc2m, mc2dp, mc2dm; - - // Sum from smallest to largest coeff. - mc2p = 0.0; mc2m = 0.0; mc2dp = 0.0; mc2dm = 0.0; - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Ykt = bessely(k,t); - double Jdks = besseljd(k,s); - double Ydkt = besselyd(k,t); - - _Float128 tt = AA[k]*Jks*Ykt ; - _Float128 ttd = AA[k]*(exppu*Jks*Ydkt - expmu*Jdks*Ykt) ; - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c,s); - double Ykpct = bessely(k+c,t); - double Ykmct = bessely(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c,s); - double Ydkpct = besselyd(k+c,t); - double Ydkmct = besselyd(k-c,t); - - _Float128 tt = AA[k]*(Jkmcs*Ykpct + Jkpcs*Ykmct); - _Float128 ttd = AA[k]* - (exppu*(Jkmcs*Ydkpct + Jkpcs*Ydkmct) - - expmu*(Jdkmcs*Ykpct + Jdkpcs*Ykmct)) ; - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *mc2 = static_cast(mc2p+mc2m); - *mc2d = static_cast(mc2dp+mc2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = m/2; - if (sgn%2 == 0) { - *mc2 = (*mc2)/AA[c]; - *mc2d = sqq*(*mc2d)/AA[c]; - } else { - *mc2 = -(*mc2)/AA[c]; - *mc2d = -sqq*(*mc2d)/AA[c]; - } - - } else { - // Odd order -- m = 1, 3, 5, 7 ... - - // Get coeff vector for odd mc2 - std::vector AA(N); - retcode = mathieu_coeffs_eo(N, q, m, AA.data()); - if (retcode != SF_ERROR_OK) { - *mc2 = std::numeric_limits::quiet_NaN(); - *mc2d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 mc2p, mc2m, mc2dp, mc2dm; - mc2p = 0.0; mc2m = 0.0; mc2dp = 0.0; mc2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Ykt = bessely(k,t); - double Jkp1s = besselj(k+1,s); - double Ykp1t = bessely(k+1,t); - - double Jdks = besseljd(k,s); - double Ydkt = besselyd(k,t); - double Jdkp1s = besseljd(k+1,s); - double Ydkp1t = besselyd(k+1,t); - - _Float128 tt = AA[k]*(Jks*Ykp1t + Jkp1s*Ykt); - _Float128 ttd = AA[k]* - (exppu*(Jks*Ydkp1t + Jkp1s*Ydkt) - - expmu*(Jdks*Ykp1t + Jdkp1s*Ykt) ) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c+1,s); - double Ykpct = bessely(k+c+1,t); - double Ykmct = bessely(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c+1,s); - double Ydkpct = besselyd(k+c+1,t); - double Ydkmct = besselyd(k-c,t); - - _Float128 tt = AA[k]*(Jkmcs*Ykpct + Jkpcs*Ykmct); - _Float128 ttd = AA[k]* - (exppu*(Jkmcs*Ydkpct + Jkpcs*Ydkmct) - - expmu*(Jdkmcs*Ykpct + Jdkpcs*Ykmct) ) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - mc2m = mc2m + tt; - } else { - // Pos terms - mc2p = mc2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - mc2dm = mc2dm + ttd; - } else { - // Pos terms - mc2dp = mc2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *mc2 = static_cast(mc2p+mc2m); - *mc2d = static_cast(mc2dp+mc2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-1)/2; - if (sgn%2 == 0) { - *mc2 = (*mc2)/AA[c]; - *mc2d = sqq*(*mc2d)/AA[c]; - } else { - *mc2 = -(*mc2)/AA[c]; - *mc2d = -sqq*(*mc2d)/AA[c]; - } - - } - - return retcode; - } // int mathieu_modmc2 - - - //================================================================== - int mathieu_modms2(int m, double q, double u, double *ms2, double *ms2d) { - // This computes the Mathieu fcn modms2 - // Inputs: - // m = Mathieu fcn order (scalar) - // q = frequency parameter (scalar) - // u = radial coord (scalar) - // Outputs: - // ms2 = value of fcn for these inputs (scalar) - // ms2d = value of fcn deriv w.r.t. u for these inputs (scalar) - // Return code: - // Success = 0 - - int retcode = SF_ERROR_OK; - int c; // Offset used in adaptive computation. - - // Check inputs. Note that retcode can include SF_ERROR_LOSS - // but the program can keep going in that case. - retcode = check_modified_fcn_domain(m,q); - if (retcode == SF_ERROR_DOMAIN) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // I find the peak Fourier coeff tracks m. Therefore, - // adjust the matrix size based on order m. Later make this - // a fcn of q also since the distribution of coeff mags allegedly - // flattens out for large q. - int N = m+25; // N = size of recursion matrix to use. - - // Utility vars. - double sqq = sqrt(q); - double exppu = exp(u); - double expmu = exp(-u); - double s = sqq*expmu; - double t = sqq*exppu; - - // Set offset c for adaptive calc. - //c = set_adaptive_offset_c(m, q); - c = 0; // Turn off adaptive c in modms2 for now ... - - // Use different coeffs depending upon whether m is even or odd. - if (m % 2 == 0) { - // Even order m. - - // Get coeff vector for even modms2 - std::vector BB(N); - retcode = mathieu_coeffs_oe(N, q, m, BB.data()); - if (retcode != SF_ERROR_OK) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Variables used in summing the Fourier series. - // These are Float128 since some of the terms are near - // equal amplitude, but different sign. - _Float128 ms2p, ms2m, ms2dp, ms2dm; - ms2p = 0.0; ms2m = 0.0; ms2dp = 0.0; ms2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Ykp2t = bessely(k+2,t); - double Jkp2s = besselj(k+2,s); - double Ykt = bessely(k,t); - - double Jdks = besseljd(k,s); - double Ydkp2t = besselyd(k+2,t); - double Jdkp2s = besseljd(k+2,s); - double Ydkt = besselyd(k,t); - - _Float128 tt = BB[k]*(Jks*Ykp2t - Jkp2s*Ykt); - _Float128 ttd = BB[k]* - (exppu*(Jks*Ydkp2t - Jkp2s*Ydkt) - - expmu*(Jdks*Ykp2t - Jdkp2s*Ykt)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Ykpct = bessely(k+c+2,t); - double Jkpcs = besselj(k+c+2,s); - double Ykmct = bessely(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Ydkpct = besselyd(k+c+2,t); - double Jdkpcs = besseljd(k+c+2,s); - double Ydkmct = besselyd(k-c,t); - - _Float128 tt = BB[k]*(Jkmcs*Ykpct - Jkpcs*Ykmct); - _Float128 ttd = BB[k]* - (exppu*(Jkmcs*Ydkpct - Jkpcs*Ydkmct) - - expmu*(Jdkmcs*Ykpct - Jdkpcs*Ykmct)); - - // Even terms have + sign, odd terms have - sign - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final result - *ms2 = static_cast(ms2p+ms2m); - *ms2d = static_cast(ms2dp+ms2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-2)/2; - if (sgn%2 == 0) { - *ms2 = (*ms2)/BB[c]; - *ms2d = sqq*(*ms2d)/BB[c]; - } else { - *ms2 = -(*ms2)/BB[c]; - *ms2d = -sqq*(*ms2d)/BB[c]; - } - - } else { - // Odd order -- m = 1, 3, 5, 7 ... - - // Get coeff vector for odd modms2 - std::vector BB(N); - retcode = mathieu_coeffs_oo(N, q, m, BB.data()); - if (retcode != SF_ERROR_OK) { - *ms2 = std::numeric_limits::quiet_NaN(); - *ms2d = std::numeric_limits::quiet_NaN(); - return retcode; - } - - // Variables used in summing the Fourier series. - _Float128 ms2p, ms2m, ms2dp, ms2dm; - ms2p = 0.0; ms2m = 0.0; ms2dp = 0.0; ms2dm = 0.0; - - // Sum from smallest to largest coeff. - for (int k=(N-1); k>=0 ; k--) { - if (c==0) { - // Non-adaptive calc - double Jks = besselj(k,s); - double Ykt = bessely(k,t); - double Jkp1s = besselj(k+1,s); - double Ykp1t = bessely(k+1,t); - - double Jdks = besseljd(k,s); - double Ydkt = besselyd(k,t); - double Jdkp1s = besseljd(k+1,s); - double Ydkp1t = besselyd(k+1,t); - - _Float128 tt = BB[k]*(Jks*Ykp1t - Jkp1s*Ykt); - _Float128 ttd = BB[k]* - (exppu*(Jks*Ydkp1t - Jkp1s*Ydkt) - - expmu*(Jdks*Ykp1t - Jdkp1s*Ykt)); - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } else { - // Adaptive calc - double Jkmcs = besselj(k-c,s); - double Jkpcs = besselj(k+c+1,s); - double Ykpct = bessely(k+c+1,t); - double Ykmct = bessely(k-c,t); - - double Jdkmcs = besseljd(k-c,s); - double Jdkpcs = besseljd(k+c+1,s); - double Ydkpct = besselyd(k+c+1,t); - double Ydkmct = besselyd(k-c,t); - - _Float128 tt = BB[k]*(Jkmcs*Ykpct - Jkpcs*Ykmct); - _Float128 ttd = BB[k]* - (exppu*(Jkmcs*Ydkpct - Jkpcs*Ydkmct) - - expmu*(Jdkmcs*Ykpct - Jdkpcs*Ykmct) ) ; - - int sgn = (k%2 == 0) ? 1 : -1; - - // Do sum using separate sums for + and - - tt = sgn*tt; - if (tt<0) { - // Neg terms - ms2m = ms2m + tt; - } else { - // Pos terms - ms2p = ms2p + tt; - } - - // Do sum using separate sums for + and - - ttd = sgn*ttd; - if (ttd<0) { - // Neg terms - ms2dm = ms2dm + ttd; - } else { - // Pos terms - ms2dp = ms2dp + ttd; - } - - } // if (c==0) - - } // for (int k=(N-1) ... - - // Sum pos and neg terms to get final answer - *ms2 = static_cast(ms2p+ms2m); - *ms2d = static_cast(ms2dp+ms2dm); - - // Do normalization. Note normalization depends upon c. - int sgn = (m-1)/2; - if (sgn%2 == 0) { - *ms2 = (*ms2)/BB[c]; - *ms2d = sqq*(*ms2d)/BB[c]; - } else { - *ms2 = -(*ms2)/BB[c]; - *ms2d = -sqq*(*ms2d)/BB[c]; - } - - } - - return retcode; - } // int mathieu_modms2 - - //================================================================ - // Helper fcns -- these help reduce the amount of redundant code. - - int check_angular_fcn_domain(int m, double q) { - // Verify inputs are OK. If not indicate err. - int retcode = SF_ERROR_OK; - - if (m>500) { - // Don't support absurdly larger orders for now. - return SF_ERROR_DOMAIN; - } - - // abs(q) > 1000 leads to low accuracy. - if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; - - return retcode; - } - - //--------------------------------------------------- - int check_modified_fcn_domain(int m, double q) { - int retcode = SF_ERROR_OK; - - // Check input domain and flag any problems - if (m>500) { - return SF_ERROR_DOMAIN; - } - - if (q<0) { - return SF_ERROR_DOMAIN; // q<0 is unimplemented - } - - // Don't need to bail out of main computation for these, just set retcode. - if (abs(q)>1.0e3d) retcode = SF_ERROR_LOSS; // q>1000 is inaccurate - if (m>15 && q>0.1d) retcode = SF_ERROR_LOSS; - - return retcode; - } - - //--------------------------------------------------- - int set_adaptive_offset_c(int m, double q) { - // This is used to set the c used in the adaptive computation. - // I set the offset used in Bessel fcn depending upon order m - // and shape/frequency parameter q. This improves the accuracy - // for larger values of m. - // The idea comes from the book "Accurate Computation of Mathieu Functions", - // Malcolm M. Bibby & Andrew F. Peterson. Also used in the paper - // "Accurate calculation of the modified Mathieu functions of - // integer order", Van Buren & Boisvert. The values I use here - // were found from experiment using my Matlab prototype. However, - // better values are likely -- finding them is a future project. - int c; - - if ( (m>5 && q<.001) || - (m>7 && q<.01) || - (m>10 && q<.1) || - (m>15 && q<1) || - (m>20 && q<10) || - (m>30 && q<100) ) { - c = m/2; - } else { - c = 0; - } - - return c; - } - - } // namespace mathieu } // namespace xsf -#endif // #ifndef MATHIEU_FCNS_H - +#endif // #ifndef MATHIEU_FCNS_H diff --git a/include/xsf/mathieu/matrix_utils.h b/include/xsf/mathieu/matrix_utils.h index ee6add4ed6..ee151ba58e 100644 --- a/include/xsf/mathieu/matrix_utils.h +++ b/include/xsf/mathieu/matrix_utils.h @@ -1,9 +1,9 @@ #ifndef MATRIX_UTILS_H #define MATRIX_UTILS_H -#include -#include #include "matrix_utils.h" +#include +#include // These fcns are meant to make it easier to deal with // matrices in C/C++. We use col major format since that's @@ -15,12 +15,12 @@ // Macros to extract matrix index and element. // Matrix is NxN, i = row idx, j = col idx. // MATRIX_IDX is where col major format is enforced. -#define MATRIX_IDX(N, I, J) (((N)*(I)) + (J)) -#define MATRIX_ELEMENT(A, m, n, i, j) A[ MATRIX_IDX(n, i, j) ] +#define MATRIX_IDX(N, I, J) (((N) * (I)) + (J)) +#define MATRIX_ELEMENT(A, m, n, i, j) A[MATRIX_IDX(n, i, j)] // Min and max macros for scalars. -#define MIN(a,b) (((a)<(b))?(a):(b)) -#define MAX(a,b) (((a)>(b))?(a):(b)) +#define MIN(a, b) (((a) < (b)) ? (a) : (b)) +#define MAX(a, b) (((a) > (b)) ? (a) : (b)) //=========================================================== // This file holds utility functions for dealing with vectors @@ -29,64 +29,60 @@ // in Matlab. // Note that C matrices are row-major. - namespace xsf { namespace mathieu { -//----------------------------------------------------- -void print_matrix(const double* A, int m, int n) { - // prints matrix as 2-dimensional tablei -- this is how we - // usually think of matrices. - int i, j; - for (i = 0; i < m; i++) { - for (j = 0; j < n; j++) { - printf("% 10.4e ", MATRIX_ELEMENT(A, m, n, i, j)); - } - printf("\n"); - } -} - + //----------------------------------------------------- + void print_matrix(const double *A, int m, int n) { + // prints matrix as 2-dimensional tablei -- this is how we + // usually think of matrices. + int i, j; + for (i = 0; i < m; i++) { + for (j = 0; j < n; j++) { + printf("% 10.4e ", MATRIX_ELEMENT(A, m, n, i, j)); + } + printf("\n"); + } + } -//----------------------------------------------------- -// Stuff to sort a vector. -// Function to swap two elements -void swap(double* a, double* b) { - double temp = *a; - *a = *b; - *b = temp; -} + //----------------------------------------------------- + // Stuff to sort a vector. + // Function to swap two elements + void swap(double *a, double *b) { + double temp = *a; + *a = *b; + *b = temp; + } -// Partition function for quicksort -int partition(double *arr, int low, int high) { - double pivot = arr[high]; // Choose last element as pivot - int i = (low - 1); // Index of smaller element - - for (int j = low; j <= high - 1; j++) { - // If current element is smaller than or equal to pivot - if (arr[j] <= pivot) { - i++; - swap(&arr[i], &arr[j]); + // Partition function for quicksort + int partition(double *arr, int low, int high) { + double pivot = arr[high]; // Choose last element as pivot + int i = (low - 1); // Index of smaller element + + for (int j = low; j <= high - 1; j++) { + // If current element is smaller than or equal to pivot + if (arr[j] <= pivot) { + i++; + swap(&arr[i], &arr[j]); + } } + swap(&arr[i + 1], &arr[high]); + return (i + 1); } - swap(&arr[i + 1], &arr[high]); - return (i + 1); -} -// Quicksort function -void quickSort(double *arr, int low, int high) { - if (low < high) { - // Partition the array and get pivot index - int pivotIndex = partition(arr, low, high); - - // Recursively sort elements before and after partition - quickSort(arr, low, pivotIndex - 1); - quickSort(arr, pivotIndex + 1, high); - } -} + // Quicksort function + void quickSort(double *arr, int low, int high) { + if (low < high) { + // Partition the array and get pivot index + int pivotIndex = partition(arr, low, high); + // Recursively sort elements before and after partition + quickSort(arr, low, pivotIndex - 1); + quickSort(arr, pivotIndex + 1, high); + } + } } // namespace mathieu } // namespace xsf - -#endif // #ifndef MATRIX_UTILS_H +#endif // #ifndef MATRIX_UTILS_H From f96e616692d1a5d9e588773b8fc0979307a0db8c Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Thu, 13 Nov 2025 07:40:44 -0500 Subject: [PATCH 11/12] Change dsyev -> dsyevd to speed up calc. --- include/xsf/mathieu/mathieu_coeffs.h | 28 ++++++++++++++-------------- include/xsf/mathieu/mathieu_eigs.h | 24 ++++++++++++------------ 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/include/xsf/mathieu/mathieu_coeffs.h b/include/xsf/mathieu/mathieu_coeffs.h index 3450ca0b9e..858877391f 100644 --- a/include/xsf/mathieu/mathieu_coeffs.h +++ b/include/xsf/mathieu/mathieu_coeffs.h @@ -20,11 +20,11 @@ * */ -/* DSYEV_ prototype */ +/* DSYEVD_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyev_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); +void dsyevd_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); #ifdef __cplusplus } #endif @@ -64,14 +64,14 @@ namespace mathieu { double wkopt; /* Query and allocate the optimal workspace */ int lwork = -1; - dsyev_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + dsyevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyev_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + dsyevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); - // Check return code from dsyev and bail if it's not 0. + // Check return code from dsyevd and bail if it's not 0. if (retcode != 0) { return SF_ERROR_NO_RESULT; } @@ -119,14 +119,14 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyev_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + dsyevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyev_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + dsyevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); - // Check return code from dsyev and bail if it's not 0. + // Check return code from dsyevd and bail if it's not 0. if (retcode != 0) { return SF_ERROR_NO_RESULT; } @@ -181,14 +181,14 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyev_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + dsyevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyev_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + dsyevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); - // Bail out if dsyev doesn't return 0. + // Bail out if dsyevd doesn't return 0. if (retcode != 0) { return SF_ERROR_NO_RESULT; } @@ -234,13 +234,13 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyev_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + dsyevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyev_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + dsyevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); - // Bail out if dsyev didn't return 0; + // Bail out if dsyevd didn't return 0; if (retcode != 0) { return SF_ERROR_NO_RESULT; } diff --git a/include/xsf/mathieu/mathieu_eigs.h b/include/xsf/mathieu/mathieu_eigs.h index d78693e2b3..03e10f6f29 100644 --- a/include/xsf/mathieu/mathieu_eigs.h +++ b/include/xsf/mathieu/mathieu_eigs.h @@ -18,11 +18,11 @@ * */ -/* DSYEV_ prototype */ +/* DSYEVD_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyev_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); +void dsyevd_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); #ifdef __cplusplus } #endif @@ -66,14 +66,14 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyev_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + dsyevd_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyev_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); + dsyevd_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); - // Check if dsyev was successful + // Check if dsyevd was successful if (retcode != 0) { *a = std::numeric_limits::quiet_NaN(); return SF_ERROR_NO_RESULT; @@ -101,14 +101,14 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyev_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + dsyevd_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyev_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); + dsyevd_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); - // Check if dsyev was successful + // Check if dsyevd was successful if (retcode != 0) { *a = std::numeric_limits::quiet_NaN(); return SF_ERROR_NO_RESULT; @@ -162,12 +162,12 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyev_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + dsyevd_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyev_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); + dsyevd_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); if (retcode != 0) { *b = std::numeric_limits::quiet_NaN(); @@ -196,11 +196,11 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyev_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + dsyevd_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyev_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); + dsyevd_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); if (retcode != 0) { *b = std::numeric_limits::quiet_NaN(); From 5ddc97564118c343775df89f8fb59967cc93e0f0 Mon Sep 17 00:00:00 2001 From: Stuart Brorson Date: Thu, 13 Nov 2025 14:26:42 -0500 Subject: [PATCH 12/12] Change dsyevd to dstevd since dstevd is for tridiagonal matrices, and that's what I have. --- include/xsf/mathieu/mathieu_coeffs.h | 28 ++++++++++++++-------------- include/xsf/mathieu/mathieu_eigs.h | 24 ++++++++++++------------ 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/include/xsf/mathieu/mathieu_coeffs.h b/include/xsf/mathieu/mathieu_coeffs.h index 858877391f..e294faac36 100644 --- a/include/xsf/mathieu/mathieu_coeffs.h +++ b/include/xsf/mathieu/mathieu_coeffs.h @@ -20,11 +20,11 @@ * */ -/* DSYEVD_ prototype */ +/* DSTEVD_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyevd_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); +void dstevd_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); #ifdef __cplusplus } #endif @@ -64,14 +64,14 @@ namespace mathieu { double wkopt; /* Query and allocate the optimal workspace */ int lwork = -1; - dsyevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + dstevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + dstevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); - // Check return code from dsyevd and bail if it's not 0. + // Check return code from dstevd and bail if it's not 0. if (retcode != 0) { return SF_ERROR_NO_RESULT; } @@ -119,14 +119,14 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + dstevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + dstevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); - // Check return code from dsyevd and bail if it's not 0. + // Check return code from dstevd and bail if it's not 0. if (retcode != 0) { return SF_ERROR_NO_RESULT; } @@ -181,14 +181,14 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + dstevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + dstevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); - // Bail out if dsyevd doesn't return 0. + // Bail out if dstevd doesn't return 0. if (retcode != 0) { return SF_ERROR_NO_RESULT; } @@ -234,13 +234,13 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); + dstevd_(V, U, &N, A.data(), &N, AA, &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); + dstevd_(V, U, &N, A.data(), &N, AA, work.data(), &lwork, &retcode); - // Bail out if dsyevd didn't return 0; + // Bail out if dstevd didn't return 0; if (retcode != 0) { return SF_ERROR_NO_RESULT; } diff --git a/include/xsf/mathieu/mathieu_eigs.h b/include/xsf/mathieu/mathieu_eigs.h index 03e10f6f29..313a451995 100644 --- a/include/xsf/mathieu/mathieu_eigs.h +++ b/include/xsf/mathieu/mathieu_eigs.h @@ -18,11 +18,11 @@ * */ -/* DSYEVD_ prototype */ +/* DSTEVD_ prototype */ #ifdef __cplusplus extern "C" { #endif -void dsyevd_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); +void dstevd_(char *jobz, char *uplo, int *n, double *a, int *lda, double *w, double *work, int *lwork, int *info); #ifdef __cplusplus } #endif @@ -66,14 +66,14 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyevd_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + dstevd_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyevd_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); + dstevd_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); - // Check if dsyevd was successful + // Check if dstevd was successful if (retcode != 0) { *a = std::numeric_limits::quiet_NaN(); return SF_ERROR_NO_RESULT; @@ -101,14 +101,14 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyevd_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + dstevd_(&V, &U, &N, A.data(), &N, ww.data(), &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyevd_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); + dstevd_(&V, &U, &N, A.data(), &N, ww.data(), work.data(), &lwork, &retcode); - // Check if dsyevd was successful + // Check if dstevd was successful if (retcode != 0) { *a = std::numeric_limits::quiet_NaN(); return SF_ERROR_NO_RESULT; @@ -162,12 +162,12 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyevd_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + dstevd_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyevd_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); + dstevd_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); if (retcode != 0) { *b = std::numeric_limits::quiet_NaN(); @@ -196,11 +196,11 @@ namespace mathieu { /* Query and allocate the optimal workspace */ int lwork = -1; - dsyevd_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); + dstevd_(&V, &U, &N, B.data(), &N, ww.data(), &wkopt, &lwork, &retcode); lwork = (int)wkopt; std::vector work(lwork); /* Solve eigenproblem */ - dsyevd_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); + dstevd_(&V, &U, &N, B.data(), &N, ww.data(), work.data(), &lwork, &retcode); if (retcode != 0) { *b = std::numeric_limits::quiet_NaN();